帮我用"apply"函数替换for循环

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矩阵.

先感谢您

Sha*_*ane 7

这些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)

您可能需要进一步操作输出.


Geo*_*tas 1

另外一个选择

# 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)