So I have a function that does lapply's for me based on dimension. Currently
only works for length(pivotColumns)=2 because I haven't fixed the rbinds. I
have two versions. One runs WAYYY faster than the other. And I'm not sure
why.

Fast Version:

fedb.ddplyWrapper2Fast <- function(data, pivotColumns, listNameFunctions,
...){
    lapplyFunctionRecurse <- function(cdata, level=1, ...){
        if(level==1){

return(lapply(split(seq(nrow(cdata)),cdata[,pivotColumns[level]], drop=T),
function(x) lapplyFunctionRecurse(x, level+1, ...)))
        } else if (level==length(pivotColumns)) {
            #
return(lapply(split(cdata,data[cdata,pivotColumns[level]], drop=T),
function(x, ...) listNameFunctions(data[x,], ...)))
            return(lapply(split(cdata,data[cdata,pivotColumns[level]],
drop=T), function(x, ...) c(data[cdata[1],pivotColumns[2]],
data[cdata[1],pivotColumns[1]], sum(data[cdata,"A"], na.rm=T),
sum(data[cdata,"A"], na.rm=T))))
        } else {
            return(lapply(split(cdata,data[cdata,pivotColumns[level]],
drop=T), function(x) lapplyFunctionRecurse(x, level+1, ...)))
        }
    }
    result = lapplyFunctionRecurse(data, ...)
    matrix2 <- do.call('rbind', lapply(result, function(x)
do.call('rbind',x)))
    return(matrix2)
}


dat <- data.frame(D=sample(32000:33000, 666000,
T),Fid=sample(1:10,666000,T), A=sample(1:5,666000,T))
> temp = proc.time(); ret = fedb.ddplyWrapper2(dat, c("D", "Fid"),
function(x) c(sum(x[,"A"], na.rm=T), sum(x[,"A"], na.rm=T)));
proc.time()-temp
   user  system elapsed
 4.616   0.006   4.630
#note in thie case the anonymous function I pass in isn't used because I
hardcode the function into the lapply.

approx 4 seconds

This runs very fast. This runs very slow:

fedb.ddplyWrapper2 <- function(data, pivotColumns, listNameFunctions, ...){
    lapplyFunctionRecurse <- function(cdata, level=1, ...){
        if(level==1){

return(lapply(split(seq(nrow(cdata)),cdata[,pivotColumns[level]], drop=T),
function(x) lapplyFunctionRecurse(x, level+1, ...)))
        } else if (level==length(pivotColumns)) {
            #this line is different. it essentially calls the function you
pass in
            return(lapply(split(cdata,data[cdata,pivotColumns[level]],
drop=T), function(x, ...) listNameFunctions(data[x,], ...)))
        } else {
            return(lapply(split(cdata,data[cdata,pivotColumns[level]],
drop=T), function(x) lapplyFunctionRecurse(x, level+1, ...)))
        }
    }
    result = lapplyFunctionRecurse(data, ...)
    matrix2 <- do.call('rbind', lapply(result, function(x)
do.call('rbind',x)))
    return(matrix2)
}

dat <- data.frame(D=sample(32000:33000, 666000,
T),Fid=sample(1:10,666000,T), A=sample(1:5,666000,T))
> temp = proc.time(); ret = fedb.ddplyWrapper2(dat, c("D", "Fid"),
function(x) c(sum(x[,"A"], na.rm=T), sum(x[,"A"], na.rm=T)));
proc.time()-temp
   user  system elapsed
 16.346  65.059  81.680



Can anyone explain to me why there is a 4x time difference? I don't want to
have to hardcore into the recursion function, but if I have to I will.

Thanks,
Rob

	[[alternative HTML version deleted]]

