7

SO を私の仕事のリソースとして常に使用しています。このような素晴らしいコミュニティをまとめてくれてありがとう。

私はちょっと複雑なことをしようとしていますが、今それを行うために考えることができる唯一の方法は、ネストされた for ループのペアを使用することです (R では嫌われていることを知っています)...私は 300 万のレコードを持っています-奇数のコース登録: CourseID とペアになっている学生の UserID。各行には、開始日と終了日、スコアなどを含む一連のデータがあります。私がする必要があるのは、登録ごとに、登録のコースの前に受講したコース全体でそのユーザーの平均スコアを計算することです。

forループに使用しているコードは次のとおりです。

data$Mean.Prior.Score <- 0
for (i in as.numeric(rownames(data)) {
    sum <- 0
    count <- 0
    for (j in as.numeric(rownames(data[data$UserID == data$UserID[i],]))) {
            if (data$Course.End.Date[j] < data$Course.Start.Date[i]) {
                sum <- sum + data$Score[j]
                count <- count + 1
            }
    }
if (count != 0)
    data$Mean.Prior.Score[i] <- sum / count
}

これでうまくいくと確信していますが、実行速度が非常に遅いです... 私のデータ フレームには 300 万行以上ありますが、10 分間ほど処理した後、外側のループは 850 のレコードしか実行していません。特に、各ユーザーが平均して自分の名前のコースを 5 つまたは 6 つしか持っていないことを考えると、時間の複雑さが示唆するよりもかなり遅いようです。

ああ、ループを実行する前に日付文字列を as.POSIXct() で変換したことを言及しておく必要があるので、日付比較ステップはそれほど遅くはありません...

これを行うためのより良い方法が必要です...何か提案はありますか?

編集: mnel のリクエストに応じて...最終的にdputうまくプレイするようになりました。追加する必要がありcontrol = NULLました。ここに「これがあります：

structure(list(Username = structure(1:20, .Label = c("100225", 
"100226", "100228", "1013170", "102876", "105796", "106753", 
"106755", "108568", "109038", "110150", "110200", "110350", "111873", 
"111935", "113579", "113670", "117562", "117869", "118329"), class = "factor"), 
User.ID = c(2313737L, 2314278L, 2314920L, 9708829L, 2325896L, 
2315617L, 2314644L, 2314977L, 2330148L, 2315081L, 2314145L, 
2316213L, 2317734L, 2314363L, 2361187L, 2315374L, 2314250L, 
2361507L, 2325592L, 2360182L), Course.ID = c(2106468L, 2106578L, 
2106493L, 5426406L, 2115455L, 2107320L, 2110286L, 2110101L, 
2118574L, 2106876L, 2110108L, 2110058L, 2109958L, 2108222L, 
2127976L, 2106638L, 2107020L, 2127451L, 2117022L, 2126506L
), Course = structure(c(1L, 7L, 10L, 15L, 11L, 19L, 4L, 6L, 
3L, 12L, 2L, 9L, 17L, 8L, 20L, 18L, 13L, 16L, 5L, 14L), .Label = c("ACCT212_A", 
"BIOS200_N", "BIS220_T", "BUSN115_A", "BUSN115_T", "CARD205_A", 
"CIS211_A", "CIS275_X", "CIS438_S", "ENGL112_A", "ENGL112_B", 
"ENGL227_K", "GM400_A", "GM410_A", "HUMN232_M", "HUMN432_W", 
"HUMN445_A", "MATH100_X", "MM575_A", "PSYC110_Y"), class = "factor"), 
Course.Start.Date = structure(c(1098662400, 1098662400, 1098662400, 
1309737600, 1099267200, 1098662400, 1099267200, 1099267200, 
1098662400, 1098662400, 1099267200, 1099267200, 1099267200, 
1098662400, 1104105600, 1098662400, 1098662400, 1104105600, 
1098662400, 1104105600), class = c("POSIXct", "POSIXt"), tzone = "GMT"), 
Term.ID = c(12056L, 12056L, 12056L, 66282L, 12057L, 12056L, 
12057L, 12057L, 12056L, 12056L, 12057L, 12057L, 12057L, 12056L, 
13469L, 12056L, 12056L, 13469L, 12056L, 13469L), Term.Name = structure(c(2L, 
2L, 2L, 4L, 1L, 2L, 1L, 1L, 2L, 2L, 1L, 1L, 1L, 2L, 3L, 2L, 
2L, 3L, 2L, 3L), .Label = c("Fall 2004", "Fall 2004 Session A", 
"Fall 2004 Session B", "Summer Session A 2011"), class = "factor"), 
Term.Start.Date = structure(c(1L, 1L, 1L, 4L, 2L, 1L, 2L, 
2L, 1L, 1L, 2L, 2L, 2L, 1L, 3L, 1L, 1L, 3L, 1L, 3L), .Label = c("2004-10-21", 
"2004-10-28", "2004-12-27", "2011-06-26"), class = "factor"), 
Score = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.125, 
0, 0, 0, 0, 0), First.Course.Date = structure(c(1L, 1L, 1L, 
4L, 2L, 1L, 2L, 2L, 1L, 1L, 2L, 2L, 2L, 1L, 3L, 1L, 1L, 3L, 
1L, 3L), .Label = c("2004-10-25", "2004-11-01", "2004-12-27", 
"2011-07-04"), class = "factor"), First.Term.Date = structure(c(1L, 
1L, 1L, 4L, 2L, 1L, 2L, 2L, 1L, 1L, 2L, 2L, 2L, 1L, 3L, 1L, 
1L, 3L, 1L, 3L), .Label = c("2004-10-21", "2004-10-28", "2004-12-27", 
"2011-06-26"), class = "factor"), First.Timer = c(TRUE, TRUE, 
TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, 
TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE), Course.Code = structure(c(1L, 
6L, 9L, 13L, 9L, 17L, 4L, 5L, 3L, 10L, 2L, 8L, 15L, 7L, 18L, 
16L, 11L, 14L, 4L, 12L), .Label = c("ACCT212", "BIOS200", 
"BIS220", "BUSN115", "CARD205", "CIS211", "CIS275", "CIS438", 
"ENGL112", "ENGL227", "GM400", "GM410", "HUMN232", "HUMN432", 
"HUMN445", "MATH100", "MM575", "PSYC110"), class = "factor"), 
Course.End.Date = structure(c(1L, 1L, 1L, 4L, 2L, 1L, 2L, 
2L, 1L, 1L, 2L, 2L, 2L, 1L, 3L, 1L, 1L, 3L, 1L, 3L), .Label = c("2004-12-19", 
"2005-02-27", "2005-03-26", "2011-08-28"), class = "factor")), .Names = c("Username", 
"User.ID", "Course.ID", "Course", "Course.Start.Date", "Term.ID", 
"Term.Name", "Term.Start.Date", "Score", "First.Course.Date", 
"First.Term.Date", "First.Timer", "Course.Code", "Course.End.Date"
), row.names = c(NA, 20L), class = "data.frame")
4

6 に答える 6

2

私はそれがdata.tableうまくいったことを発見しました。

# Create some data.
library(data.table)
set.seed(1)
n=3e6
numCourses=5 # Average courses per student
data=data.table(UserID=as.character(round(runif(n,1,round(n/numCourses)))),course=1:n,Score=runif(n),CourseStartDate=as.Date('2000-01-01')+round(runif(n,1,365)))
data$CourseEndDate=data$CourseStartDate+round(runif(n,1,100))
setkey(data,UserID)
# test=function(CourseEndDate,Score,CourseStartDate) sapply(CourseStartDate, function(y) mean(Score[y>CourseEndDate]))
# I vastly reduced the number of comparisons with a better "test" function.
test2=function(CourseEndDate,Score,CourseStartDate) {
    o.end = order(CourseEndDate)
    run.avg = cumsum(Score[o.end])/seq_along(CourseEndDate)
    idx=findInterval(CourseStartDate,CourseEndDate[o.end])
    idx=ifelse(idx==0,NA,idx)
    run.avg[idx]
}
system.time(data$MeanPriorScore<-data[,test2(CourseEndDate,Score,CourseStartDate),by=UserID]$V1) 
#  For three million courses, at an average of 5 courses per student:
#    user  system elapsed 
#    122.06    0.22  122.45

テストを実行して、コードと同じに見えるかどうかを確認します。

set.seed(1)
n=1e2
data=data.table(UserID=as.character(round(runif(n,1,1000))),course=1:n,Score=runif(n),CourseStartDate=as.Date('2000-01-01')+round(runif(n,1,365)))
data$CourseEndDate=data$CourseStartDate+round(runif(n,1,100))
setkey(data,UserID)
data$MeanPriorScore<-data[,test2(CourseEndDate,Score,CourseStartDate),by=UserID]$V1
data["246"]
#   UserID course     Score CourseStartDate CourseEndDate MeanPriorScore
#1:    246     54 0.4531314      2000-08-09    2000-09-20      0.9437248
#2:    246     89 0.9437248      2000-02-19    2000-03-02             NA

# A comparison with your for loop (slightly modified)
data$MeanPriorScore.old<-NA # Set to NaN instead of zero for easy comparison.
# I think you forgot a bracket here. Also, There is no need to work with the rownames.
for (i in seq(nrow(data))) { 
    sum <- 0
    count <- 0
    # I reduced the complexity of figuring out the vector to loop through.
    # It will result in the exact same thing if there are no rownames.
    for (j in which(data$UserID == data$UserID[i])) {
            if (data$CourseEndDate[j] <= data$CourseStartDate[i]) {
                sum <- sum + data$Score[j]
                count <- count + 1
            }
    }
    # I had to add "[i]" here. I think that is what you meant.
    if (count != 0) data$MeanPriorScore.old[i] <- sum / count 
}
identical(data$MeanPriorScore,data$MeanPriorScore.old)
# [1] TRUE
于 2012-08-03T03:07:35.820 に答える
1

これはあなたが望むもののようです

library(data.table) 
# create a data.table object
DT <- data.table(data)
# key by userID 
setkeyv(DT, 'userID')

# for each userID, where the Course.End.Date < Course.Start.Date
# return the mean score

# This is too simplistic
# DT[Course.End.Date < Course.Start.Date,
#   list(Mean.Prior.Score = mean(Score)) , 
#   by = list(userID)]

@jorans のコメントによると、これは上記のコードよりも複雑になります。

于 2012-08-02T23:21:55.193 に答える
0

あなたのデータはどの組み合わせでも不等式を満たさないように見えるので、これを実際にテストすることはできませんが、次のようなことを試してみます:

library(plyr)
res <- ddply(data, .(User.ID), function(d) {
   with(subset(merge(d, d, by=NULL, suffixes=c(".i", ".j")),
               Course.End.Date.j < Course.Start.Date.i),
        c(Mean.Prior.Score = mean(Score.j)))
})
res$Mean.Prior.Score[is.nan(res$Mean.Prior.Score)] = 0

仕組みは次のとおりです。

  • ddply:行のUser.IDサブセットごとにデータをグループ化し、関数を実行します。dUser.ID
  • マージ: 1 人のユーザーのデータのコピーを 2 つ作成します.i。.j
  • サブセット:この外部結合から、指定された不等式に一致するもののみを選択します
  • mean:一致した行の平均を計算します
  • c(…):結果の列に名前を付けます
  • res:User.ID列と列を持つ data.frame になりますMean.Prior.Score
  • is.nan: mean長さゼロのベクトルに対して NaN を返し、これらをゼロに変更します

それぞれの行が多すぎない場合、これはかなり高速になると思いますUser.ID。これが十分に高速でない場合はdata.tables、他の回答で言及されていることが役立つ場合があります。

あなたのコードは、目的の出力で少しあいまいです。data$Mean.Prior.Score長さ 1 の変数のように扱いますが、ループの反復ごとに代入します。この割り当ては1行のみを対象としていると思います。データ フレームのすべての行に手段が必要ですか、それともユーザーごとに 1 つの手段だけが必要ですか?

于 2012-08-03T02:53:25.037 に答える
0

300 万行あるので、データベースが役立つかもしれません。forここで、ループに似たものを作成すると思われるsqliteの例を示します。

# data.frame for testing
user <- sample.int(10000, 100)
course <- sample.int(10000, 100)
c_start <- sample(
  seq(as.Date("2004-01-01"), by="3 months", length.ou=12), 
  100, replace=TRUE
)
c_end <- c_start + as.difftime(11, units="weeks")
c_idx <- sample.int(100, 1000, replace=TRUE)
enroll <- data.frame(
  user=sample(user, 1000, replace=TRUE), 
  course=course[c_idx], 
  c_start=as.character(c_start[c_idx]), 
  c_end=as.character(c_end[c_idx]), 
  score=runif(1000),
  stringsAsFactors=FALSE
)

#variant 1: for-loop
system.time({
enroll$avg.p.score <- NA
for (i in 1:nrow(enroll)) {
  sum <- 0
  count <- 0
  for (j in which(enroll$user==enroll$user[[i]])) 
    if (enroll$c_end[[j]] < enroll$c_start[[i]]) {
      sum <- sum + enroll$score[[j]]
      count <- count + 1
    }
  if(count !=0) enroll$avg.p.score[[i]] <- sum / count
} 
})

#variant 2: sqlite
system.time({
library(RSQLite)
con <- dbConnect("SQLite", ":memory:")
dbWriteTable(con, "enroll", enroll, overwrite=TRUE)

sql <- paste("Select e.user, e.course, Avg(p.score)",
             "from enroll as e",
             "cross join enroll as p", 
             "where e.user=p.user and p.c_end < e.c_start",
             "group by e.user, e.course;")
res <- dbSendQuery(con, sql)
dat <- fetch(res, n=-1)
})

私のマシンでは、sqlite は 10 倍高速です。それでも不十分な場合は、データベースにインデックスを付けることができます。

于 2012-08-03T02:20:41.610 に答える
0

これは、ソリューションに必要と思われるものの概要にすぎません。plyr簡単にするために、必要な手順を説明するためだけに使用します。

1 人の生徒の場合に限定してみましょう。1 人の生徒についてこれを計算できれば、分割適用のようなもので拡張することは簡単です。

では、特定の学生のスコアがコース終了日でソートされているとします。

d <- sample(seq(as.Date("2011-01-01"),as.Date("2011-01-31"),by = 1),100,replace = TRUE)
dat <- data.frame(date = sort(d),val = rnorm(100))

まず、これを日付別に要約してから、累積実行平均を計算する必要があると思います。

dat_sum <- ddply(dat,.(date),summarise,valsum = sum(val),n = length(val))
dat_sum$mn <- with(dat_sum,cumsum(valsum) / cumsum(n))

最後に、これらの値を元のデータにマージして、日付が重複するようにします。

dat_merge <- merge(dat,dat_sum[,c("date","mn")])

これらすべてのステップを実行する匿名関数を使用してdata.tableでこれを行うものをおそらく書くことができますが、他の人が簡潔で高速な何かを行うことができると思います。(特に、 plyrで実際にこれに取り組むことはお勧めしません。それでも非常に遅いと思われるためです。)

于 2012-08-03T00:34:57.547 に答える