如何有效地对稀疏数据进行聚合答案

【问题标题】：How to efficiently do aggregate on sparse data如何有效地对稀疏数据进行聚合
【发布时间】：2011-11-01 02:16:44
【问题描述】：

我有一个包含 1008412 个观测值的大型数据集，这些列是customer_id（整数）、visit_date（日期，格式：“2010-04-04”）、visit_spend（浮点数）。

此聚合日期函数将感兴趣的周数映射到 13-65 范围内：

weekofperiod <- function(dt) {
    as.numeric(format(as.Date(dt), "%W")) + 52 * (as.numeric(format(as.Date(dt), "%Y"))-2010)
}

每个 customer_id 在 53 周内的总访问次数不定。对于每个customer_id，我想通过weekofperiod() 获得spend_per_week 的聚合。下面的代码在功能上是正确的，但非常慢 - cmets 让它更快？此外，aggregate() 产生稀疏输出，其中缺少未访问的周数，我将spend_per_week 初始化为 0，然后逐行手动分配来自 aggregate() 的非零结果，以确保结果始终有 53 行。确定可以做得更好吗？

示例数据集行如下所示：

   customer_id visit_date visit_spend 
72          40 2011-03-15       18.38 
73          40 2011-03-20       23.45  
74          79 2010-04-07      150.87 
75          79 2010-04-17      101.90 
76          79 2010-05-02      111.90

这是针对空周的汇总调用和调整的代码：

for (cid in all_tt_cids) {
  print_pnq('Getting statistics for cid', cid)

  # Get row indices of the selected subset, for just this cid's records
  I <- which(tt$customer_id==cid & tt$visit_date<="2011-03-31")

  # (other code to compute other per-cid statistics)

  # spend_per_week (mode;mean;sd)
  # Aggregate spend_per_week, but beware this should be 0 for those week with no visits
  spend_per_week <- data.frame(c(list('weekofperiod'=13:65), list('spendperweek'=0)) )
  nonzero_spends_per_week <- aggregate(tt$visit_spend[I], list('weekofperiod'=weekofperiod(tt$visit_date[I])), FUN="sum")
  for (i in 1:nrow(nonzero_spends_per_week)) {
    spend_per_week[spend_per_week$weekofperiod==nonzero_spends_per_week[i,1],2] <- nonzero_spends_per_week[i,2]
  }
  colnames(spend_per_week)[2] <- 'spend_per_week'

  # (code to compute and store per-cid statistics on spend_per_week)

}

【问题讨论】：

原始数据的来源是什么？一个sql数据库？对于纯粹的速度，我建议使用数据库引擎并返回准备显示结果。此查询并不过分复杂，可以在 SQL 中处理。
纯 .csv。我试图为每个 customer_id 计算 50 个不同的统计信息（这是被省略的代码），所以在 sqldf 中只做这个计算是没有意义的。所以我的限制是原生 R 语言。
@John Colby 下面的回答很好。使用data.table中的东西可能会进一步加快速度？

标签： r dataframe aggregate sparse-matrix

【解决方案1】：

如果您替换 for 循环，您将获得最大的加速。我无法从您的示例中完全看出，因为您会覆盖循环中的每个客户，但如果您想保留所有主题的信息，这是一种方法。

为了测试，先给原来的方法定义函数，再定义一个没有循环的新方法：

weekofperiod <- function(dt) {
  as.numeric(format(as.Date(dt), "%W")) + 52 * (as.numeric(format(as.Date(dt), "%Y"))-2010)
}

FastMethod <- function(tt) {  
  tt$week = weekofperiod(tt$visit_date)
  spend_per_week.tmp = as.data.frame(tapply(tt$visit_spend, tt[,c(1,4)], sum))
  spend_per_week = data.frame(matrix(0, nrow=nrow(spend_per_week.tmp), ncol=length(13:65)))
  colnames(spend_per_week) = 13:65
  rownames(spend_per_week) = rownames(spend_per_week.tmp)
  spend_per_week[, colnames(spend_per_week.tmp)] = spend_per_week.tmp
  spend_per_week
}

OrigMethod <- function(tt) {
  all_tt_cids = unique(tt$customer_id)

  for (cid in all_tt_cids) {
    # Get row indices of the selected subset, for just this cid's records
    I <- which(tt$customer_id==cid & tt$visit_date<="2011-03-31")

    # Aggregate spend_per_week, but beware this should be 0 for those week with no visits
    spend_per_week <- data.frame(c(list('weekofperiod'=13:65), list('spendperweek'=0)))
    nonzero_spends_per_week <- aggregate(tt$visit_spend[I], list('weekofperiod'=weekofperiod(tt$visit_date[I])), FUN="sum")
    for (i in 1:nrow(nonzero_spends_per_week)) {
      spend_per_week[spend_per_week$weekofperiod==nonzero_spends_per_week[i,1],2] <- nonzero_spends_per_week[i,2]
    }
    colnames(spend_per_week)[2] <- 'spend_per_week'
  }
  spend_per_week
}

现在模拟一个更大的数据集，以便比较：

n.row  = 10^4
n.cust = 10^3

customer_id = 1:n.cust
dates = seq(as.Date('2010-04-01'), as.Date('2011-03-31'), by=1)
visit_date = sample(dates, n.row, replace=T)
visit_spend = runif(n.row, 0, 200)

tt = data.frame(customer_id, visit_date, visit_spend)

最后比较一下两种方法：

> system.time(FastMethod(tt))
   user  system elapsed 
  0.082   0.001   0.083 
> system.time(OrigMethod(tt))

   user  system elapsed 
  4.505   0.007   4.514

这已经 快了 50 倍，我敢打赌，您可以通过更多优化使其变得更好。祝你好运！

【讨论】：

非常好，但你能摆脱来自spend_per_week.tmp = as.data.frame(tapply(tt$visit_spend, tt[,c(1,4)], sum)) 的 NA 吗？
事实上，最简单的方法是将 NA 传播到 spend_per_week，然后删除它们：for (w in 1:ncol(spend_per_week)) spend_per_week[is.na(spend_per_week[,w]), w] <- 0

【解决方案2】：

这里有一个使用data.table的更快的方法，也更容易阅读。

FasterMethod <- function(tt){
  # LOAD LIBRARIES
  require(reshape2)
  require(data.table)
  tt <- transform(tt, week_of_period = weekofperiod(visit_date))

  # AGGREGATE SPEND BY CUSTOMER AND WEEK OF PERIOD
  tt <- data.table(tt)
  ans <- tt[,list(spend = sum(visit_spend)), 'customer_id, week_of_period']

  # RESHAPE TO CUSTOMER ID VS. WEEK OF PERIOD
  dcast(ans, customer_id ~ week_of_period, value_var = 'spend')
}

我们可以使用rbenchmark 将其与FastMethod 和OrigMethod 进行基准测试，并看到我们的加速比FastMethod 提高了1.3 倍，整体加速提高了70 倍

library(rbenchmark)
benchmark(FastMethod(tt), FasterMethod(tt), replications = 40)

test             elapsed relative 
FastMethod(tt)    5.594  1.346654     
FasterMethod(tt)  4.154  1.000000

如果您不关心将最终输出重塑为客户 ID 与周期周数，则可以进一步加快速度（与 FastMethod 相比为 2.5 倍）。

【讨论】：