基于不等式的条件累积和在R中

时间:2013-11-14 22:51:00

标签: r data.table plyr

我一直在努力做代码: 对于每个

equation?

到目前为止,我做到这一点的最好方法是使用循环。这是一个例子

y=rnorm(10)
x=c(1,1,1,2,2,2,3,3,3,4)
z=c(5,5,6,6,7,7,8,8,9,9)
data=data.frame(y,x,z)
n=10

s=rep(NA,length(unique(x))*length(unique(z)))
dim(s)=c(length(unique(x)),length(unique(z)))
for (i in 1:length(unique(x))){
  for (j in 1:length(unique(z))){
       s[i,j]=sum(y*as.numeric((x<=unique(x)[i]))*
                    as.numeric((z<=unique(z)[j])))
}
}

输出就像这样,但是当我的尺寸增大时,这就变得效率低下了。 因为,对于给定的z,这看起来像条件​​累积和,我100%确定有一种更有效的方法,没有循环。

你们有没有任何建议?如果我没有z,我知道我可以使用data.table:

 s=data[order(x)][,lapply(.SD, sum),by=c("x"), .SDcols=c("y")]
  s=s[,lapply(.SD, cumsum), .SDcols=c("y")]

但是有多个索引(x和z,而不仅仅是x)我无法制定程序。

2 个答案:

答案 0 :(得分:8)

我认为你不需要data.table,因为你正在为每个组使用整个“y”。通过一些线性代数更容易实现:

t(y*outer(x, unique(x), '<=')) %*% outer(z, unique(z), '<=')
          [,1]       [,2]       [,3]       [,4]       [,5]
[1,] 0.3538152  0.1762013  0.1762013  0.1762013  0.1762013
[2,] 0.3538152 -0.7308157 -1.2421102 -1.2421102 -1.2421102
[3,] 0.3538152 -0.7308157 -1.2421102 -1.1770919 -1.8315592
[4,] 0.3538152 -0.7308157 -1.2421102 -1.1770919 -4.1171477

以下是您的三维代码版本:

set.seed(1)
y=rnorm(10)
x=c(1,1,1,2,2,2,3,3,3,4)
z=c(5,5,6,6,7,7,8,8,9,9)
w=c(7,7,8,8,9,9,10,10,11,11)
n=10

s=rep(NA,length(unique(w))*length(unique(z))*length(unique(x)))
dim(s)=c(length(unique(w)),length(unique(z)), length(unique(x)))
for (i in 1:length(unique(w))) {
  for (j in 1:length(unique(z))) {
    for (k in 1:length(unique(x))) {
       s[i,j, k]=sum(y*as.numeric((w<=unique(w)[i]))*
                    as.numeric((z<=unique(z)[j]))*
                    as.numeric((x<=unique(x)[k])))
    }
  }
}

以下是您使用与我之前的答案相同的想法来实现这一目标的方法:

t1 <- outer(x, unique(x), '<=')
t2 <- outer(z, unique(z), '<=')
t3 <- outer(w, unique(w), '<=')
lapply(seq_along(unique(x)), function(idx) t(y*t1[,idx]*t2) %*% t3)

这里输出是一个列表(而不是数组),但输出相同,你可以将结果与“s”进行比较。你应该可以从这里拿走它。

答案 1 :(得分:0)

在@Arun争论之后,我设法嵌套了两个lapply函数,以便将解决方案推广到上层维度。

lapply(seq_along(unique(x)), function(idx){lapply(seq_along(unique(r)),
                                              function(idr) t(y*t1[,idx]*t2)%*%(t3
                                              *t4[,idr]))})

为了添加其他维度,我将继续嵌套lapply函数。有更清洁的方法吗?