Reputation: 558
For each level of factor I need to extract values aggregated over all subsets of data.frame except the current one. For example, there is a several subjects doing a reaction time task during several days, and I need to compute mean reaction time for all subjects and all days, but not including the subject for whom the mean is computed. Currently, I do it like this:
library(lme4)
ddply(sleepstudy, .(Subject, Days), summarise,
avg_rt = mean(sleepstudy[sleepstudy$Subject != Subject &
sleepstudy$Days == Days,"Reaction"]), .progress="text")
It works fine for small data sets, but for large ones it can be very slow. Is there a way to do it faster?
Upvotes: 3
Views: 606
Reputation: 132576
#create big dataset
n <- 1e4
set.seed(1)
sleepstudy <- data.frame(Reaction=rnorm(n),Subject=1:4,Days=sort(rep((1:(n/4)),4)))
library(plyr)
system.time(
res <- ddply(sleepstudy, .(Subject, Days), summarise,
avg_rt = mean(sleepstudy[sleepstudy$Subject != Subject &
sleepstudy$Days == Days,"Reaction"]))
)
#User System elapsed
#6.532 0.013 6.556
#use data.table for big datasets
library(data.table)
dt<- as.data.table(sleepstudy)
system.time(
{dt[,avg_rt:=mean(Reaction),by=Days];
dt[,n:=.N,by=Days];
dt[,avg_rt:=(avg_rt*n-Reaction)/(n-1)]}
)
#User System elapsed
#0.005 0.001 0.005
#test if results are equal
dt2 <- as.data.table(res)
setkey(dt2,Subject,Days)
setkey(dt,Subject,Days)
all.equal(dt[,avg_rt],dt2[,avg_rt])
#[1] TRUE
For really large datasets the speed gain should be more pronounced. I just couldn't compare with larger datasets since ddply
is so slow.
Upvotes: 3
Reputation: 81683
Maybe it's faster with lapply
and aggregate
:
do.call("rbind", (lapply(unique(sleepstudy$Subject),
function(x)
cbind(Subject = x,
aggregate(Reaction ~ Days,
subset(sleepstudy, Subject != x),
mean)))))
Update:
I compared both commands with system.time
and it appears the original is slower.
library(lme4)
library(plyr)
system.time(
ddply(sleepstudy, .(Subject, Days), summarise,
avg_rt = mean(sleepstudy[sleepstudy$Subject != Subject &
sleepstudy$Days == Days,"Reaction"]))
)
# user system elapsed
# 0.17 0.00 0.22
system.time(
do.call("rbind", (lapply(unique(sleepstudy$Subject),
function(x)
cbind(Subject = x,
aggregate(Reaction ~ Days,
subset(sleepstudy, Subject != x),
mean)))))
)
# user system elapsed
# 0.12 0.00 0.12
Upvotes: 0