7

一直使用 SO 作为我工作的资源。感谢您将这样一个伟大的社区团结在一起。

我正在尝试做一些有点复杂的事情，而我现在唯一能想到的方法是使用一对嵌套的 for 循环（我知道这在 R 中是不受欢迎的）......我有 300 万的记录-奇数课程注册：学生用户 ID 与 CourseID 配对。在每一行中，都有一堆数据，包括开始/结束日期和分数等。我需要做的是，对于每次注册，计算该用户在注册课程之前所学课程的平均分数。

我用于 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

这只是我认为解决方案可能需要的概要。为简单起见，我将plyr仅用于说明所需的步骤。

让我们只限于一个学生的情况。如果我们可以为一个学生计算这个，那么通过某种拆分应用来扩展它将是微不足道的。

所以让我们假设我们有一个特定学生的分数，按课程结束日期排序：

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 回答
0

我认为这样的事情应该可以工作，尽管每个用户拥有多个课程的测试数据会很有帮助。还可能需要在 findInterval 中的开始日期 +1 以使条件为 End.Date < Start.Date 而不是 <=。

# in the test data, one is POSIXct and the other a factor
data$Course.Start.Date = as.Date(data$Course.Start.Date)
data$Course.End.Date = as.Date(data$Course.End.Date)
data = data[order(data$Course.End.Date), ]
data$Mean.Prior.Score = ave(seq_along(data$User.ID), data$User.ID, FUN=function(i)
    c(NA, cumsum(data$Score[i]) / seq_along(i))[1L + findInterval(data$Course.Start.Date[i], data$Course.End.Date[i])])
于 2012-08-03T01:03:14.803 回答
0

拥有 300 万行数据，也许数据库会有所帮助。这是一个 sqlite 示例，我相信它会创建类似于您的for循环的内容：

# 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 快十倍。如果这还不够，还可以索引数据库。

于 2012-08-03T02:20:41.610 回答
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并为每个d行子集执行函数User.ID
  • 合并：为一个用户创建两个数据副本，一个以列为后缀.i，另一个.j
  • 子集：从此外部连接中，仅选择与给定不等式匹配的那些
  • mean：计算匹配行的平均值
  • c(...)：为结果列命名
  • res：将是一个带有列的 data.frameUser.ID和Mean.Prior.Score
  • is.nan： mean将为零长度向量返回 NaN，将它们更改为零

我想如果每个 没有太多行，这可能会相当快User.ID。如果这还不够快，data.tables其他答案中提到的可能会有所帮助。

您的代码在所需输出上有点模糊：您将其视为data$Mean.Prior.Score长度为一的变量，但在循环的每次迭代中都为其分配。我假设此分配仅适用于一行。您需要数据框每一行的均值，还是每个用户只需要一个均值？

于 2012-08-03T02:53:25.037 回答