Skip to content
Prev 317899 / 398502 Next

cumulative sum by group and under some criteria

Hi,

Try this:
res1<- do.call(rbind,lapply(paste(d3$m1,d3$n1),function(m1) do.call(rbind,lapply(0:(as.numeric(substr(m1,1,1))-1),function(x1) do.call(rbind,lapply(0:(as.numeric(substr(m1,3,3))-1),function(y1) do.call(rbind,lapply((as.numeric(substr(m1,1,1))+2):(7-as.numeric(substr(m1,3,3))),function(m) do.call(rbind,lapply((as.numeric(substr(m1,3,3))+2):(9-m),function(n) 
?do.call(rbind,lapply(x1:(x1+m-as.numeric(substr(m1,1,1))), function(x) 
?do.call(rbind,lapply(y1:(y1+n-as.numeric(substr(m1,3,3))), function(y) 
?expand.grid(m1,x1,y1,m,n,x,y)) )))))))))))))
names(res1)<- c("m1n1","x1","y1","m","n","x","y")
?res1$m1<- NA; res1$n1<- NA
res1[,8:9]<-do.call(rbind,lapply(strsplit(as.character(res1$m1n1)," "),as.numeric))
res2<- res1[,c(8:9,3:7)]
library(plyr)
res2<-join(res1,d3,by=c("m1","n1"),type="full") #Instead of this step, you can paste() the whole row of d3 and make suitable changes to the code above 

?tail(res2)
?# ? m1n1 x1 y1 m n x y m1 n1 cterm1_P0L cterm1_P1L cterm1_P0H cterm1_P1H
#235? 2 3? 1? 2 4 5 2 2? 2? 3???? 0.9025?????? 0.64?? 0.857375????? 0.512
#236? 2 3? 1? 2 4 5 2 3? 2? 3???? 0.9025?????? 0.64?? 0.857375????? 0.512
#237? 2 3? 1? 2 4 5 2 4? 2? 3???? 0.9025?????? 0.64?? 0.857375????? 0.512
#238? 2 3? 1? 2 4 5 3 2? 2? 3???? 0.9025?????? 0.64?? 0.857375????? 0.512
#239? 2 3? 1? 2 4 5 3 3? 2? 3???? 0.9025?????? 0.64?? 0.857375????? 0.512
#240? 2 3? 1? 2 4 5 3 4? 2? 3???? 0.9025?????? 0.64?? 0.857375????? 0.512

A.K.