帮我用“apply”替换 for 循环功能

Question

...如果可能的话

我的任务是找到用户连续参与游戏的最长连续天数。

我没有编写 sql 函数，而是选择使用 R 的 rle 函数来获取最长的条纹，然后用结果更新我的数据库表。

（附加的）数据框是这样的：

    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

我尝试了以下方法来获取每个用户最长的条纹

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

不幸的是这个for循环花费的时间太长，我想知道是否有一种方法可以使用“apply”系列中的函数来生成res矩阵。

先感谢您

Answer 1

apply 函数并不总是（甚至通常）比 for 循环更快。这是 R 与 S-Plus 关联的残余（在后者中，apply 比 for 更快）。一个例外是 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))))

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

Answer 2

编辑：已修复。我最初认为我必须修改 rle() 的大部分内容，但事实证明只需要进行一些调整。

这不是关于 *apply 方法的答案，但我想知道这是否不是整个过程的更快方法。正如 Shane 所说，循环并没有那么糟糕。而且......我很少向任何人展示我的代码，所以我很高兴听到对此的一些批评。

#Shane, I told you this was awesome
dat <- getSOTable("http://stackoverflow.com/questions/1504832/help-me-replace-a-for-loop-with-an-apply-function", 1)
colnames(dat) <- c("day", "user_id")
#Convert to dates so that arithmetic works properly on them
dat$day <- as.Date(dat$day)

#Custom rle for dates
rle.date <- function (x)
{
    #Accept only dates
    if (class(x) != "Date")
        stop("'x' must be an object of class \"Date\"")
    n <- length(x)
    if (n == 0L)
        return(list(lengths = integer(0L), values = x))
    #Dates need to be sorted
    x.sort <- sort(x)
    #y is a vector indicating at which indices the date is not consecutive with its predecessor
    y <- x.sort[-1L] != (x.sort + 1)[-n]
    #i returns the indices of y that are TRUE, and appends the index of the last value
    i <- c(which(y | is.na(y)), n)
    #diff tells you the distances in between TRUE/non-consecutive dates. max gets the largest of these.
    max(diff(c(0L, i)))
}

#Loop
max.consec.use <- matrix(nrow = length(unique(dat$user_id)), ncol = 1)
rownames(max.consec.use) <- unique(dat$user_id)

for(i in 1:length(unique(dat$user_id))){
    user <- unique(dat$user_id)[i]
    uses <- subset(dat, user_id %in% user)
    max.consec.use[paste(user), 1] <- rle.date(uses$day)
}

max.consec.use

Answer 3

另一种选择

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

Answer 4

如果您有一个非常长的数据列表，那么听起来可能是一个聚类问题。每个集群将由用户和日期定义，最大间隔距离为 1。然后按用户检索最大的簇。如果我想到具体的方法，我会编辑它。

Answer 5

这是Chris 关于如何获取数据的建议：

dat <- read.table(textConnection(
 "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
 "), header=TRUE)