如何使用分组数据生成滚动平均值。这是数据
set.seed(31)
dd<-matrix(sample(seq(1:20),30,replace=TRUE),ncol=3)
添加组标识符,并按组标识符
排序du<-sample(seq(1:4),10,replace=TRUE)
d<-cbind(du,dd)
d<-d[order(d[,1]),]
这给出了滚动平均值,但忽略了组bounderis
d_roll_mean <- apply(d[,2:4], 2,
function(x) {
rollapply(zoo(x), 3, mean, partial=TRUE, align='right')
}
)
这给出了以下结果
# cbind(d,d_roll_mean)
# [1,] 1 3 3 12 3.000000 3.000000 12.000000
# [2,] 2 10 13 8 6.500000 8.000000 10.000000
# [3,] 2 17 2 17 10.000000 6.000000 12.333333
# [4,] 3 14 6 3 13.666667 7.000000 9.333333
# [5,] 3 6 20 1 12.333333 9.333333 7.000000
# [6,] 3 1 16 19 7.000000 14.000000 7.666667
# [7,] 3 19 2 11 8.666667 12.666667 10.333333
# [8,] 4 12 1 9 10.666667 6.333333 13.000000
# [9,] 4 10 13 12 13.666667 5.333333 10.666667
# [10,] 4 8 20 7 10.000000 11.333333 9.333333
这里是目标,按组边界滚动平均值
# Desired
# [1,] 1 3 3 12 3.000000 3.000000 12.000000
# [2,] 2 10 13 8 10.000000 13.000000 8.000000
# [3,] 2 17 2 17 13.500000 7.500000 12.500000
# [4,] 3 14 6 3 14.000000 6.000000 3.000000
# [5,] 3 6 20 1 10.000000 13.000000 2.000000
# [6,] 3 1 16 19 7.000000 14.000000 7.666667
# [7,] 3 19 2 11 8.666667 12.666667 10.333333
# [8,] 4 12 1 9 12.000000 1.000000 9.000000
# [9,] 4 10 13 12 11.000000 7.000000 10.500000
# [10,] 4 8 20 7 10.000000 8.000000 9.333333
这很接近,但是按因子生成列表,而不是矩阵
doApply <- function(x) {
apply(x, 2,
function(y) {
rollapply(zoo(y), 3, mean, partial=TRUE, align='right')
})
}
d2_roll_mean <- by(d[,2:4], d[,1], doApply)
所以这个问题有一些答案,这里是他们在执行时间方面的比较
set.seed(31)
nrow=20000
ncol=600
nun=350
nValues = 20
dd<-matrix(sample(seq(1:nValues),nrow*ncol,replace=TRUE),ncol=ncol)
du<-sample(seq(1:nun),nrow,replace=TRUE)
d<-cbind(du,dd)
d<-d[order(d[,1]),]
library(zoo)
doApply <- function(x) {
apply(x, 2,
function(y) {
rollapply(zoo(y), 3, mean, partial=TRUE, align='right')
})
}
library(data.table)
library(caTools)
fun1<-function(d) {by(d[,-1], d[,1], doApply)}
fun2<- function(d){
DT <- data.table(d, key='du')
DT[, lapply(.SD, function(y)
runmean(y, 3, alg='fast',align='right')), by=du]
}
system.time(d2_roll_mean <- fun1(d))
system.time(d2_roll_mean2 <- fun2(d))
时间表明使用数据表比rollapply快10倍。
user system elapsed
fun1 1048.910 0.378 1049.158
fun2 107.296 0.097 107.392
我没有获得平等,但通过检查他们看起来是一样的......
d2a<-do.call(rbind,d2_roll_mean)
d2b<-cbind(1,d2a)
d2c<-data.table(d2b)
setnames(d2c,names(d2c),names(d2_roll_mean2))
all.equal(d2c,d2_roll_mean2)
所有相等的输出是
[1] "Attributes: < Length mismatch: comparison on first 1 components >"
[2] "Component “du”: Mean relative difference: 175.6631"
当上述方法应用于数据时,会生成以下错误
Error in `[<-`(`*tmp*`, (k2 + 1):n, , value = 2) :
subscript out of bounds
此错误是某些因素导致行数过少的结果。删除了那些行,并且该过程有效。参考:How to drop factors that have fewer than n members
答案 0 :(得分:5)
使用data.table
和caTools
library(data.table)
library(caTools)
DT <- data.table(d, key='du')
DT[, lapply(.SD, function(y)
runmean(y, 3, alg='fast',align='right')), by=du]
如果要在现有数据集中创建新列
nm1 <- paste0('V', 2:4)
nm2 <- paste0("V", 4:6)
DT[, (nm1):=lapply(.SD, as.numeric), .SDcols=nm1][,
(nm2):=lapply(.SD, function(y) runmean(y, 3, alg='fast',
align='right')), by=du]
答案 1 :(得分:3)
唯一缺少的是do.call(rbind,d2_roll_mean)
。添加原始数据:
cbind(d,do.call(rbind,d2_roll_mean))
编辑:我通过system.time()
运行了这个更大的例子,它确实花了很多时间:
set.seed(31)
dd <- matrix(sample(seq(1:20),20000*500,replace=TRUE),ncol=500)
du <- sample(seq(1:350),20000,replace=TRUE)
d <- cbind(du,dd)
d <- d[order(d[,1]),]
system.time(d2_roll_mean <- by(d[,-1], d[,1], doApply))
User System elapsed
399.60 0.57 409.91
by()
和apply()
不是最快的功能。实际上使用for
循环遍历列可能会更快,并且依赖于d
按ID排序的事实来强制执行此操作。