R:如何根据多个标准求和并总结表格

Question

这是我的原始数据框:

df <- read.table(text="
  Date         Index  Event
  2014-03-31   A      x
  2014-03-31   A      x
  2014-03-31   A      y
  2014-04-01   A      y
  2014-04-01   A      x
  2014-04-01   B      x
  2014-04-02   B      x
  2014-04-03   A      x
  2014-09-30   B      x", header = T, stringsAsFactors = F)

date_range <- seq(as.Date(min(df$Date)), as.Date(max(df$Date)), 'days')
indices <- unique(df$Index)
events_table <- unique(df$Event)

我想我需要的输出来概括我的数据帧,并有在每个指标的唯一记录索引和每个日期DATE_RANGE而在events_table在新的一列提供每个事件的累计值之前,在日期列中的值对所有日期.有时每个索引或每个日期都没有记录.

这是我想要的输出:

Date        Index  cumsum(Event = x) cumsum(Event = y)
2014-03-31  A      0                 0
2014-03-31  B      0                 0
2014-04-01  A      2                 1
2014-04-01  B      0                 0
2014-04-02  A      3                 2
2014-04-02  B      1                 0
...  
2014-09-29  A      4                 2
2014-09-29  B      2                 0
2014-09-30  A      4                 2
2014-09-30  B      2                 0

仅供参考 - 这是数据框的简化版本.每年有大约200,000条记录,每个日期有数百个不同的索引字段.

在我的硬盘驱动器使用之前,我已经做过这个,by也许aggregate,但是这个过程非常缓慢,而且这次我无法解决这个问题.我也尝试过ddply,但是我无法cumsum使用它来运行它.使用ddply,我试过类似的东西:

ddply(xo1, .(Date,Index), summarise, 
      sum.x = sum(Event == 'x'), 
      sum.y = sum(Event == 'y'))

无济于事.
通过搜索,我发现 复制一个Excel SUMIFS公式 ,它让我得到了我的项目的累积部分,但有了这个,我无法弄清楚如何将它总结为每个日期/索引组合只有一个记录.我也遇到了基于日期的总和/汇总数据,但是在这里我无法计算动态日期方面.

感谢任何可以提供帮助的人!

Answer 1

library(dplyr)
library(tidyr)

df$Date <- as.Date(df$Date)

第 1 步：生成 {Date, Index} 对的完整列表

full_dat <- expand.grid(
  Date = date_range, 
  Index = indices,
  stringsAsFactors = FALSE
  ) %>% 
  arrange(Date, Index) %>%
  tbl_df

步骤 2：定义一个cumsum()忽略的函数NA

cumsum2 <- function(x){

  x[is.na(x)] <- 0
  cumsum(x)

}

步骤 3：生成每个 {Date, Index} 的总计，与完整的 {Date, Index} 数据连接，并计算滞后累积和。

df %>%
  group_by(Date, Index) %>%
  summarise(
    totx = sum(Event == "x"),
    toty = sum(Event == "y")
    ) %>%
  right_join(full_dat, by = c("Date", "Index")) %>% 
  group_by(Index) %>%
  mutate(
    cumx = lag(cumsum2(totx)),
    cumy = lag(cumsum2(toty))
    ) %>%
  # some clean up.
  select(-starts_with("tot")) %>%
  mutate(
    cumx = ifelse(is.na(cumx), 0, cumx),
    cumy = ifelse(is.na(cumy), 0, cumy)
    )