我有一个包含数十万行的数据框，但可以在下面举例说明：
> mydata
ID TYPE HEIGHT WEIGHT
1 20 6 194 77.1
2 20 2 175 63.5
3 20 6 197 59.6
4 20 1 185 74.3
5 20 1 162 94.4
6 21 1 188 58.9
7 21 6 182 81.2
8 21 6 169 82.8
9 21 2 151 78.5
这是重现它的代码：
mydata <- data.frame(ID=c(20,20,20,20,20,21,21,21,21),
TYPE=(c(6,2,6,1,1,1,6,6,2)),
HEIGHT=c(194,175,197,185,162,188,182,169,151),
WEIGHT=c(77.1,63.5,59.6,74.3,94.4,58.9,81.2,82.8,78.5))
我需要做的是：对于每个ID，计算WEIGHTS到TYPE，的总和，但仅针对那些元素（在同一ID中）比当前行中包含的值高HEIGHT 。
然后，新数据框应包含三列（每个TYPE一列），最终应如下所示：
> mydata_new
ID TYPE HEIGHT WEIGHT SUM.W.TYPE6 SUM.W.TYPE2 SUM.W.TYPE1
1 20 6 194 77.1 59.6 0.0 0.0
2 20 2 175 63.5 136.7 0.0 74.3
3 20 6 197 59.6 0.0 0.0 0.0
4 20 1 185 74.3 136.7 0.0 0.0
5 20 1 162 94.4 136.7 63.5 74.3
6 21 1 188 58.9 0.0 0.0 0.0
7 21 6 182 81.2 0.0 0.0 58.9
8 21 6 169 82.8 81.2 0.0 59.9
9 21 2 151 78.5 164.0 0.0 58.9
如果可能的话，我想避免通过循环遍历每一行，因为我的广泛数据集，这将花费太长时间。任何智能解决方案也许使用一些合适的软件包，例如dplyr，data.table，或者只使用apply或sapply？
我想了解如何创建基于同一行不同列中的值的累积和，但也依赖于单独的分组（即TYPE）。
答案 0 :(得分：2)
正如OP中所建议的，累积总和在这里起作用：
library(data.table)
setDT(mydata)
ut = sort(unique(mydata$TYPE))
mydata[order(-HEIGHT), paste0("sum_",ut) := lapply(ut,
function(x) shift(cumsum( WEIGHT*(TYPE==x) ), fill=0)
), by=ID]
ID TYPE HEIGHT WEIGHT sum_1 sum_2 sum_6
1: 20 6 194 77.1 0.0 0.0 59.6
2: 20 2 175 63.5 74.3 0.0 136.7
3: 20 6 197 59.6 0.0 0.0 0.0
4: 20 1 185 74.3 0.0 0.0 136.7
5: 20 1 162 94.4 74.3 63.5 136.7
6: 21 1 188 58.9 0.0 0.0 0.0
7: 21 6 182 81.2 58.9 0.0 0.0
8: 21 6 169 82.8 58.9 0.0 81.2
9: 21 2 151 78.5 58.9 0.0 164.0
重复高度测量。到目前为止，只有在每个ID中所有高度都不同时才会起作用（如OP的当前示例中所示）。然而，评论中提到的OP可能会重复高度。感谢@DeanMacGregor，这是该案例的扩展：
# run the code above, and then...
mydata[order(-HEIGHT), paste0('sum_',ut) :=
.SD[.N]
, by=.(ID,TYPE,HEIGHT), .SDcols=paste0('sum_',ut)]
或者在一个by步骤中执行此操作：
ut = sort(unique(mydata$TYPE))
mydata[order(-HEIGHT), paste0("sum_",ut) := {
sd = lapply(ut, function(x) shift(cumsum( WEIGHT*(TYPE==x) ), fill=0))
setDT(sd)[, .SD[1L], by=.(HEIGHT,TYPE)][, c("HEIGHT","TYPE") := NULL]
}, by=ID]
答案 1 :(得分：1)
以下是另一种data.table解决方案。
mydata[, c(.SD, setNames(lapply(sort(unique(TYPE)),
function(type) apply(outer(HEIGHT, HEIGHT, "<"), 1,
function(higher) sum(WEIGHT[TYPE == type & higher]))),
paste0("SUM.W.TYPE", sort(unique(TYPE))))), ID]
# ID TYPE HEIGHT WEIGHT SUM.W.TYPE1 SUM.W.TYPE2 SUM.W.TYPE6
# 1: 20 6 194 77.1 0.0 0.0 59.6
# 2: 20 2 175 63.5 74.3 0.0 136.7
# 3: 20 6 197 59.6 0.0 0.0 0.0
# 4: 20 1 185 74.3 0.0 0.0 136.7
# 5: 20 1 162 94.4 74.3 63.5 136.7
# 6: 21 1 188 58.9 0.0 0.0 0.0
# 7: 21 6 182 81.2 58.9 0.0 0.0
# 8: 21 6 169 82.8 58.9 0.0 81.2
# 9: 21 2 151 78.5 58.9 0.0 164.0
使用outer函数创建一个比较矩阵，以找出存在较大高度行的索引，并将权重子集与该类型相结合以获得总和。
答案 2 :(得分：1)
这是使用最近实现的non-equi联接功能的另一个data.table解决方案。您需要抓住development version of data.table, v1.9.7
require(data.table) # v1.9.7
setDT(mydata) # convert data.frame to data.table without copying
foo <- function(x, val) {
y = x[TYPE == val]
y[x, on = .(ID, HEIGHT > HEIGHT),
.(sum_val = sum(WEIGHT, na.rm = TRUE)),
by = .EACHI
][, sum_val]
}
for (type in unique(mydata$TYPE)) {
cat("type = ", sprintf("%2.0f", type), "\n", sep="")
mydata[, paste("sum", type, sep="_") := foo(mydata, type)][]
}
mydata
# ID TYPE HEIGHT WEIGHT sum_6 sum_2 sum_1
# 1: 20 6 194 77.1 59.6 0.0 0.0
# 2: 20 2 175 63.5 136.7 0.0 74.3
# 3: 20 6 197 59.6 0.0 0.0 0.0
# 4: 20 1 185 74.3 136.7 0.0 0.0
# 5: 20 1 162 94.4 136.7 63.5 74.3
# 6: 21 1 188 58.9 0.0 0.0 0.0
# 7: 21 6 182 81.2 0.0 0.0 58.9
# 8: 21 6 169 82.8 81.2 0.0 58.9
# 9: 21 2 151 78.5 164.0 0.0 58.9
在@Dean的300K行数据集中，每个TYPE需要~19s或~1s。
答案 3 :(得分：0)
发布我最初评论的答案：
{"kv":["24","23","20"],"interface":"dropdown"},{"ma":["2","3","4"],"interface":"button"}
根据数据的范围，初始化将发生变化，并且需要分配的列数也会发生变化。但是，这应该足以让你到那里。
答案 4 :(得分：0)
这是一种类似于@Psidom的方法。
library(data.table)
setDT(mydata)
mydata_new<-mydata[,c(.SD,{ types<-(unique(TYPE));
setNames(lapply(types, function(curtype) {
heights<-(HEIGHT);
sapply(heights, function(curheight) {
sum(WEIGHT[HEIGHT>curheight & TYPE==curtype])
})
}),paste0('SUM.W.TYPE',types))}),by='ID']
不同之处在于我不使用outer，我怀疑这是一个记忆/表现能力。
这是一个基准：
library(data.table)
#create fake data with 300,000 rows
mydata <- data.frame(ID=rep(1:10,30000),
TYPE=rep(1:20,each=15000),
HEIGHT=as.integer(runif(300000,150,200)),
WEIGHT=round(runif(300000,50,100),1))
setDT(mydata)
system.time({
mydata_new<-mydata[,c(.SD,{ types<-(unique(TYPE));
setNames(lapply(types, function(curtype) {
heights<-(HEIGHT);
sapply(heights, function(curheight) {
sum(WEIGHT[HEIGHT>curheight & TYPE==curtype])
})
}),paste0('SUM.W.TYPE',types))}),by='ID']
})
#user system elapsed
#1125.244 1.460 1127.665
system.time({
psidata<-mydata[, c(.SD, setNames(lapply(sort(unique(TYPE)),
function(type) apply(outer(HEIGHT, HEIGHT, "<"), 1,
function(higher) sum(WEIGHT[TYPE == type & higher]))),
paste0("SUM.W.TYPE", sort(unique(TYPE))))), ID]
})
#user system elapsed
#3854.596 731.272 4774.742
all.equal(mydata_new, psidata)
#TRUE
system.time({
frankdata<-copy(mydata)
ut = sort(unique(mydata$TYPE))
frankdata[order(-HEIGHT), paste0("sum_",ut) := lapply(ut,
function(x) shift(cumsum( WEIGHT*(TYPE==x) ), fill=0)
), by=ID]
})
#user system elapsed
#0.148 0.000 0.148
弗兰克是迄今为止表现的赢家。