Geo*_*tas 4 loops for-loop r apply
......如果可能的话
我的任务是找到用户参与游戏的最长连续日.
我选择使用R的rle函数来获取最长的条纹,然后使用结果更新我的db表,而不是编写sql函数.
(附加的)数据框是这样的:
day user_id
2008/11/01 2001
2008/11/01 2002
2008/11/01 2003
2008/11/01 2004
2008/11/01 2005
2008/11/02 2001
2008/11/02 2005
2008/11/03 2001
2008/11/03 2003
2008/11/03 2004
2008/11/03 2005
2008/11/04 2001
2008/11/04 2003
2008/11/04 2004
2008/11/04 2005
Run Code Online (Sandbox Code Playgroud)
我尝试了以下方法来获得每个用户最长的条纹
# turn it to a contingency table
my_table <- table(user_id, day)
# get the streaks
rle_table <- apply(my_table,1,rle)
# verify the longest streak of "1"s for user 2001
# as.vector(tapply(rle_table$'2001'$lengths, rle_table$'2001'$values, max)["1"])
# loop to get the results
# initiate results matrix
res<-matrix(nrow=dim(my_table)[1], ncol=2)
for (i in 1:dim(my_table)[1]) {
string <- paste("as.vector(tapply(rle_table$'", rownames(my_table)[i], "'$lengths, rle_table$'", rownames(my_table)[i], "'$values, max)['1'])", sep="")
res[i,]<-c(as.integer(rownames(my_table)[i]) , eval(parse(text=string)))
}
Run Code Online (Sandbox Code Playgroud)
不幸的是,这个for循环花了太长时间,我想知道是否有办法使用"apply"系列中的函数生成res矩阵.
先感谢您
这些apply函数并不总是(甚至通常)比for循环更快.这是R与S-Plus的联系的残余(在后者中,申请速度快于).一个例外是lapply,它通常比for(因为它使用C代码)更快. 看到这个相关的问题.
所以你应该apply主要用来提高代码的清晰度,而不是提高性能.
您可能会发现Dirk关于高性能计算的演示非常有用.另一种强力方法是使用Ra而不是普通的R版本进行"即时编译",该版本经过优化以处理for循环.
[编辑:]显然有很多方法可以做到这一点,即使它更紧凑,这也绝不是更好.只需使用您的代码,这是另一种方法:
dt <- data.frame(table(dat))[,2:3]
dt.b <- by(dt[,2], dt[,1], rle)
t(data.frame(lapply(dt.b, function(x) max(x$length))))
Run Code Online (Sandbox Code Playgroud)
您可能需要进一步操作输出.
另外一个选择
# convert to Date
day_table$day <- as.Date(day_table$day, format="%Y/%m/%d")
# split by user and then look for contiguous days
contig <- sapply(split(day_table$day, day_table$user_id), function(.days){
.diff <- cumsum(c(TRUE, diff(.days) != 1))
max(table(.diff))
})
Run Code Online (Sandbox Code Playgroud)