[R-SIG-Finance] Fwd: [R] dynamic runSum

amarjit chandhial a.chandhial at btinternet.com
Fri Aug 8 18:02:51 CEST 2014



Brian,


With respect there's an error in your code. Given that the following may do the trick:


#calculate dynamic runSums:
# for 0 lookback: 0
# for 1 lookback: the price
# for n lookback: sum of n prices
 x$variable_sum <- ifelse( x$Lookback == 0, 
                           0,
                           foreach(i=1:nrow(x), .combine=c) %do% {z <- sum(x$Prices[(i-x$Lookback[i]+1):i])}
                          )

 head(x$variable_sum,25)




Anyways, here's a solution in Rcpp



R FILE
--------


 library(quantstrat)

 symbols = c('^GSPC') 
 
 start.date <- as.Date("2010-01-01")
 end.date <- as.Date("2013-12-31")
 
 getSymbols(symbols, from=as.character(start.date), to=as.character(end.date),adjust=T) 


 library(quantstrat)
 library(Rcpp)

 Sys.setenv("PKG_CXXFLAGS"="-fopenmp")
 Sys.setenv("PKG_LIBS"="-fopenmp")


 setwd( " directory of Rcpp file ")
 sourceCpp("00_acF1_RcppFuns.cpp")
 
 
 "acF1" <- function(x, n1=5, n2=10, n3=20, nacF1=25, n0=20, ...) {

    var1 <- x - lag(x,1,na.pad=T)
    var2 <- runSD(x, n=n1, sample=TRUE, cumulative=FALSE) 
    var3 <- runMean(var2, n=n2, cumulative=FALSE) 

    VL <- ifelse( trunc(n3/(var2/var3))>nacF1, nacF1, trunc(n3/(var2/var3)))

    p_pos <- ifelse(var1>=0, var1, 0)


   #POS
    filt1 <- rep(0, length(x))
    out1 <- ac_computeacF1(nacF1, VL, p_pos, filt1, x)
    out1 <- xts(out1, order.by = index(x))

 
    res <- cbind(var1, var2, var3, VL, p_pos, out1)
    colnames(res) <- c("var1","var2","var3","VL", "p_pos", "out1")
 
    reclass(res)
 }
 
 

 acf1 <- acF1( GSPC[,c("GSPC.Close")], n1=5, n2=10, n3=14, nacF1=30, n0=20)
 acf1



RCPP FILE: 00_acF1_RcppFuns.cpp
----------------------------------------


#include <Rcpp.h>
using namespace Rcpp;


// [[Rcpp::export]]
NumericVector ac_computeacF1(const int nn, NumericVector VL, NumericVector p_pos, NumericVector filt1, NumericVector price) {

  int i; 
  int j;
  int n = price.size();
  int beg = nn;
  filt1[beg] = 0;
  
  
  /* Find first non-NA input value */
    for(i = 0; i <= beg; i++) {	
	
	
        /* Account for leading NAs in input */
        if(ISNA(price[i])) {
            filt1[i] = NA_REAL;
            beg++;
            filt1[beg] = 0;
            continue;
        }
		
		
		/* Set leading NAs in output */
        for(i=0; i<beg; i++) {
            filt1[i] = NA_REAL;
         }
		 
			
		/* get 1st one right */		
        for(i=beg-VL[nn]+1; i<=beg; i++) {
		     filt1[beg] += p_pos[i] ;
			}
		
			
		/* get ALL right */	
		for(j=1; j<=n; j++) {	
			for(i=beg-VL[nn+j]+1+j; i<=beg+j; i++) {
			     filt1[beg+j] += p_pos[i] ;
			}
		}		
 						
			
	}	
			 

    return filt1;  
    }
	
	



Amarjit



----Original message----
>From : brian at braverock.com
Date : 08/08/2014 - 13:51 (GMTST)
To : r-sig-finance at r-project.org
Subject : Re: [R-SIG-Finance] Fwd: [R] dynamic runSum

It doesn't sound like you want the 'running' sum.  It sounds like you 
want the sum with a different lookback.

set.seed(987654)
require(foreach)
x<-xts(cumsum(1+rnorm(100,.5,.1)),order.by=as.Date(1:100))
colnames(x)<-'Prices'
x$Lookback<-round(abs(rnorm(100,5,3)))
x$Lookback[1:15] <- 1:15
x$variable_sum <- foreach(i=1:nrow(x), .combine=c) %do%
                   {z <- sum(x$Prices[(i-x$Lookback[i]):i])}

Regards,

Brian

On 08/08/2014 07:08 AM, Ilya Kipnis wrote:
> I am echoing this question. The only thing I can think of is to do
> however many separate runSums, and then just loop across columns. It's
> relevant to me due to John Ehlers's algorithms having a dynamic
> lookback period. Thanks.
>
> On Fri, Aug 8, 2014 at 2:49 AM, amarjit chandhial
> <a.chandhial at btinternet.com> wrote:
>>
>> Hello,
>>
>>
>> I am cross-posting to R-finance as this is finance-orientated.
>>
>>
>>
>> Amarjit
>>
>>
>>
>> ----Original message----
>> >From : a.chandhial at btinternet.com
>> Date : 07/08/2014 - 14:32 (GMTST)
>> To : r-help at r-project.org
>> Subject : [R] dynamic runSum
>>
>> Hello,
>> runSum calculates a running sum looking back a fixed distance n, e.g. 20.
>> How do I calculate a dynamic runSum function for an xts object?
>> In
>> otherwords, I want to calculate a running sum at each point in time
>> looking back a variable distance. In this example, values governed by
>> the vector VL.
>> Here's a minimum reproducible example:
>>
>>   library(quantstrat)
>> symbols = c('^GSPC')
>>
>>   start.date <- as.Date("2010-01-01")
>>   end.date <- as.Date("2013-12-31")
>>
>   getSymbols(symbols, from=as.character(start.date), to=as.character(end.date),adjust=T)
>>
>>   "acF1" <- function(x, n1=5, n2=10, n3=20, nacF1=25, n0=20, ...) {
>>      var1 <- x - lag(x,1,na.pad=T)
>>      var2 <- runSD(x, n=n1, sample=TRUE, cumulative=FALSE)
>>      var3 <- runMean(var2, n=n2, cumulative=FALSE)
>>      VL <- ifelse( trunc(n3/(var2/var3))>nacF1, nacF1, trunc(n3/(var2/var3)))
>>      p_pos <- ifelse(var1>=0, var1, 0)
>>      out1 <- runSum(p_pos,  n=n0, cumulative=FALSE)
>>
>>      res <- cbind(var1, var2, var3, VL, p_pos, out1)
>>      colnames(res) <- c("var1","var2","var3","VL", "p_pos", "out1")
>>
>>      reclass(res)
>>   }
>>
>>
>>   acf1 <- acF1( GSPC[,c("GSPC.Close")], n1=5, n2=10, n3=20, nacF1=25, n0=20)
>>   acf1
>>
>>
>> So on
>> 2010-02-02, I want runSum to be looking back 23 points as governed by VL , not 20 points
>> 2010-02-03, I want runSum to be looking back 24 points as governed by VL,  not 20 points
>>   etc etc
>>   2013-12-31, I want runSum to be looking back 25 points as governed by VL, not 20 points
>>
>>
>> Amarjit
>>
>>
>>   ______________________________________________
>> R-help at r-project.org mailing list
>> https://stat.ethz.ch/mailman/listinfo/r-help
>> PLEASE do read the posting guide http://www.R-project.org/posting-guide.html
>> and provide commented, minimal, self-contained, reproducible code.
>>
>> _______________________________________________
>> R-SIG-Finance at r-project.org mailing list
>> https://stat.ethz.ch/mailman/listinfo/r-sig-finance
>> -- Subscriber-posting only. If you want to post, subscribe first.
>> -- Also note that this is not the r-help list where general R questions should go.
>
> _______________________________________________
> R-SIG-Finance at r-project.org mailing list
> https://stat.ethz.ch/mailman/listinfo/r-sig-finance
> -- Subscriber-posting only. If you want to post, subscribe first.
> -- Also note that this is not the r-help list where general R questions should go.
>

-- 
Brian G. Peterson
http://braverock.com/brian/
Ph: 773-459-4973
IM: bgpbraverock

_______________________________________________
R-SIG-Finance at r-project.org mailing list
https://stat.ethz.ch/mailman/listinfo/r-sig-finance
-- Subscriber-posting only. If you want to post, subscribe first.
-- Also note that this is not the r-help list where general R questions should go.



More information about the R-SIG-Finance mailing list