1
\$\begingroup\$

This is a follow up: Optimization over 7 constants, running a function 10,000,000 times

My data can be downloaded here.

The only kink left is the betaema function, which is still a for loop and hence mildly inefficient, and correcttot which is 7 for loops nested. My current runtime is .352, which means over 50 days if I continue to use the current iteration of correcttot.

setwd("~/Desktop")
dat<-read.csv(file="dat.csv",sep=",",header=T)
attach(dat)
###################################################################################
voltoalph <- function(v,c) {
  # v: a data vector
  # c: a scalar constant
  vc<-max(v, na.rm=TRUE)
  c(0, c[1L] * (v / vc))
}
voltoenen <- function(v,c) {
  # v: a data vector
  # c: a scalar constant
  vc<-max(v, na.rm=TRUE)
  enhelp <- 1 / c(1, abs(v /vc))
  c[1L] * (enhelp / max(enhelp))
}
ema<-function(v,n,a){     
  # v: a data vector
  # n: a scalar constant
  # a: a vector length v of contants
  expt<-c(0:(n-1))
  as<-c(1-a)
  avevec<-c(as^expt)
  sum(avevec*v)/sum(avevec) 
}
betaema<-function(v,n,a,l){ 
  # v: a data vector
  # n: a vector length v of contants
  # a: a vector length v of contants
  # l: a contant, the first value that can have a moving average
  secondvec<-c(rep(0, (length(v)-l)))
  for(i in l:(length(v)-l)){
    secondvec[i+1-l]<-ema(v[(i-n[i]+1):i],n[i],a[(i-n[i]+1):i])
  }
  secondvec
}
#################################################################################################################
howright<-function(v,r,c,l){
  # v: a data vector
  # r: a data vector
  # c: a constant
  # l: a contant, the first value that can have a signal
  v2<-v[1:(length(v)-c)]
  returns2<-r[l+1+c:(length(v)-1)]
  fc <- rep(1/c, c)
  returnav <- filter(returns2, fc, sides=1)
  tot<-v2*returnav 
  length(tot[which(tot>0)])/length(tot)
}
#################################################################################################################
percentcorrect<-function(ca1,ca2,cn1,cn2,e,d,c,v,p,r){
  # ca1: a constant
  # ca2: a constant
  # cn1: a constant
  # cn2: a constant
  # e:   a constant
  # d:   a constant
  # c:   a constant
  # v:   a data vector
  # p:   a data vector
  # r:   a data vector
  als<-c(voltoalph(v,ca1))
  als2<-c(voltoalph(v,ca2))
  n1<-c(voltoenen(v,cn1))
  n2<-c(voltoenen(v,cn2))
  mix<-max(cn1,cn2)
  mox<-max(d,e)
  anotherema1<-betaema(p,n1,als,mix)
  anotherema2<-betaema(p,n2,als2,mix)
  shift1<-c(anotherema1[1:(length(anotherema1)-d)])
  shift2<-c(anotherema2[1:(length(anotherema2)-e)])
  slope1h<-c(anotherema1[(1+d):length(anotherema1)]-shift1)
  slope2h<-c(anotherema2[(1+e):length(anotherema2)]-shift2)
  slope1<-c(slope1h/d)
  slope2<-c(slope2h/e)
  sig<-c(slope1-slope2)
  hvec<-howright(sig,r,c,(mix+mox))
  hvec
}
system.time(percentcorrect(.3,.6,100,200,5,5,1,v,p,r))
##########################################################################################
correcttot<-function(v,p,r){  
  # v:   a data vector
  # p:   a data vector
  # r:   a data vector
  correct3<-array(0,dim=c(10,10,10,10,10,10,10))
  for(i in 1:10){
    for(j in 1:10){
      for(k in 1:10){
        for(l in 1:10){
          for(m in 2:10){
            for(n in 2:10){
              for(o in 1:10){
                correct3[i,j,k,l,m,n,o]<-percentcorrect((i/10),(j/10),(20*k),(20*l),m,n,o,v,p,r)
              }
            }
          }
        }
      }
    }
  }
  print(correct3)
}
newvec2<-correcttot(v,p,r)
which(newvec2==max(newvec2),arr.ind=TRUE)
\$\endgroup\$
  • \$\begingroup\$ Should voltoenen be returning a vector of integers? Is this code working? \$\endgroup\$ – flodel Nov 23 '15 at 1:06
  • 1
    \$\begingroup\$ The title of your post should be the purpose of the code, not what you want from the review. \$\endgroup\$ – Quill Nov 23 '15 at 1:21
  • \$\begingroup\$ I really would advice not to use c as variable name. It makes things horrible to read. \$\endgroup\$ – bdecaf Dec 15 '15 at 10:11
  • 1
    \$\begingroup\$ The link to the data is not working anymore. \$\endgroup\$ – Hans Ekbrand Dec 19 '15 at 23:12
  • \$\begingroup\$ You seem to overuse the c function. For something like 1:(n-1) you don't need to wrap it in c. It's already a vector. The output from rep is also a vector - no need to wrap it in c. If you're just using a single number... no need to wrap it in c. \$\endgroup\$ – Dason Jan 25 '16 at 2:52

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Browse other questions tagged or ask your own question.