5

...それが可能であれば

私の仕事は、ユーザーがゲームに参加した連続日数の最長ストリークを見つけることです。

SQL 関数を記述する代わりに、R の rle 関数を使用して最長のストリークを取得し、その結果で db テーブルを更新することにしました。

（添付された）データフレームは次のようなものです：

    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 ループは時間がかかりすぎるため、「適用」ファミリの関数を使用して res マトリックスを生成する方法があるかどうか疑問に思っています。

前もって感謝します

4

5 に答える 5

8

関数は、ループapplyよりも常に（または一般的に）高速であるとは限りません。forこれは、S-PlusとのRのアソシエートの残骸です（後者の場合、applyはforよりも高速です）。1つの例外は、です。これは、 （Cコードを使用するため） lapplyよりも高速であることがよくあります。この関連する質問を参照してください。for

したがってapply、パフォーマンスを向上させるためではなく、主にコードの明確さを向上させるために使用する必要があります。

ハイパフォーマンスコンピューティングに関するDirkのプレゼンテーションが役立つ場合があります。もう1つの力ずくのアプローチは、ループを処理するように最適化された通常のRバージョンの代わりにRaを使用した「ジャストインタイムコンパイル」です。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))))

おそらく、出力をもう少し操作する必要があります。

于 2009-10-01T16:06:48.170 に答える
3

編集：修正。私は当初、rle() の大部分を変更する必要があると想定していましたが、必要な微調整はほんのわずかであることがわかりました。

これは *apply メソッドに関する回答ではありませんが、これはプロセス全体に対するより高速なアプローチではないのではないかと思います。シェーンが言うように、ループはそれほど悪くありません。そして... 私は自分のコードを誰にも見せることはめったにないので、これについての批評を聞いてうれしいです.

#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
于 2009-10-01T19:40:00.703 に答える
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))
})
于 2010-01-12T07:34:25.133 に答える
0

データのリストが非常に長い場合は、クラスタリングの問題のように思えます。各クラスターは、最大分離距離が 1 のユーザーと日付によって定義されます。次に、ユーザーごとに最大のクラスターを取得します。具体的な方法を思いついたら編集します。

于 2009-10-01T19:48:03.887 に答える
0

これは、データを取得する方法に関する 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)
于 2009-10-01T20:01:03.767 に答える