# Optimizing a function in R over 10000000 values - follow-up

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

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")
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)

• Should voltoenen be returning a vector of integers? Is this code working? – flodel Nov 23 '15 at 1:06
• The title of your post should be the purpose of the code, not what you want from the review. – Quill Nov 23 '15 at 1:21
• I really would advice not to use c as variable name. It makes things horrible to read. – bdecaf Dec 15 '15 at 10:11
• The link to the data is not working anymore. – Hans Ekbrand Dec 19 '15 at 23:12
• 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. – Dason Jan 25 '16 at 2:52