Question

我正在尝试计算一组时间范围内按组排序的滚动计数/总和。

我有一个数据框，其中包含一些示例数据：

dates = as.Date(c("2011-10-09",
        "2011-10-15",
        "2011-10-16", 
        "2011-10-18", 
        "2011-10-21", 
        "2011-10-22", 
        "2011-10-24"))

group1=c("A",
         "C",
         "A", 
         "A", 
         "L", 
         "F", 
         "A")
group2=c("D",
         "A",
         "B", 
         "H", 
         "A", 
         "A", 
         "E")

df1 <- data.frame(dates, group1, group2)

我为每个唯一的“组”迭代各个数据帧，例如，这就是“A”组的外观（它们存在于每一行，无论是在group1还是group2中）。

我想计算“A”（以及之后的每个小组）在一个时间范围内的事件发生次数 - 事件的“日期”（即当前行日期）和前4天。我想向前滚动，所以例如第1行的计数为1，第2行的计数也为1（除了当前日期过去4天内没有事件），第3行将有2行4将有3等。

对于每一行，我想最后得到一个列，基本上说，在此事件日期，当前日期（如日期列中所示）和过去4天

Answer 1

对于此示例，您可以使用sapply分析每一行，计算当天或最多4天之前的条目数，如下所示：

df1$lastFour <-
  sapply(df1$dates, function(x){
    sum(df1$dates <= x & df1$dates >= x - 4)
  })

df1的结果：

       dates group1 group2 lastFour
1 2011-10-09      A      D        1
2 2011-10-15      C      A        1
3 2011-10-16      A      B        2
4 2011-10-18      A      H        3
5 2011-10-21      L      A        2
6 2011-10-22      F      A        3
7 2011-10-24      A      E        3

如果，正如您的问题所暗示的那样，您的数据来自更大的集合并且您希望对每个组进行分析（从概念上讲，我认为问题是：有多少事件已经这个组在过去的四天里？只询问该组活动的日期），您可以按照以下步骤进行操作。

首先，这里有一些较大的样本数据，其中的组标记为字母表的前10个字母：

biggerData <-
  data.frame(
    dates = sample(seq(as.Date("2011-10-01")
                       , as.Date("2011-10-31")
                       , 1)
                   , 100, TRUE)
    , group1 = sample(LETTERS[1:10], 100, TRUE)
    , group2 = sample(LETTERS[1:10], 100, TRUE)
  )

接下来，我提取数据中的所有组（在这里，我知道它们，但对于您的真实数据，您可能已经或可能没有该组列表）

groupsInData <-
  sort(unique(c(as.character(biggerData$group1)
                , as.character(biggerData$group2))))

然后，我遍历该组名称向量，并将该组中的每个事件作为两个组中的一个提取，添加与上面相同的列，并将单独的data.frames保存在列表中（并命名它们）使其更容易访问/跟踪它们。）

sepGroupCounts <- lapply(groupsInData, function(thisGroup){
  dfTemp <- biggerData[biggerData$group1 == thisGroup | 
                         biggerData$group2 == thisGroup, ]

  dfTemp$lastFour <-
    sapply(dfTemp$dates, function(x){
      sum(dfTemp$dates <= x & dfTemp$dates >= x - 4)
    })
  return(dfTemp)

}) 

names(sepGroupCounts) <- groupsInData

对于数据中的每个组，

就像上面一样返回一个data.frame。

并且，我无法帮助自己，所以这里也是一个dplyr和tidyr解决方案。它与上面基于列表的解决方案没什么不同，除了它返回同一data.frame中的所有内容（这可能是也可能不是一件好事，特别是因为它会以这种方式为每个事件提供两个条目）。 / p>

首先，为简单起见，我定义了一个函数来进行日期检查。这也很容易在上面使用。

myDateCheckFunction <- function(x){
  sapply(x, function(thisX){
    sum(x <= thisX & x >= thisX - 4 )
  })
}

接下来，我正在构建一组逻辑测试，以确定每个组是否存在。这些将用于为每个组生成列，在每个事件中为当前/不存在提供TRUE / FALSE。

dotsConstruct <-
  paste0("group1 == '", groupsInData, "' | "
         , "group2 == '", groupsInData, "'") %>%
  setNames(groupsInData)

最后，将它完全放在一个管道呼叫中。我没有描述，而是评论了每一步。

withLastFour <-
  # Start with data
  biggerData %>%
  # Add a col for each group using Standard Evaluation
  mutate_(.dots = dotsConstruct) %>%
  # convert to long form; one row per group per event
  gather(GroupAnalyzed, Present, -dates, -group1, -group2) %>%
  # Limit to only rows where the `GroupAnalyzed` is present
  filter(Present) %>%
  # Remove the `Present` column, as it is now all "TRUE"
  select(-Present) %>%
  # Group by the groups we are analyzing
  group_by(GroupAnalyzed) %>%
  # Add the column for count in the last four dates
  # `group_by` limits this to just counts within that group
  mutate(lastFour = myDateCheckFunction(dates)) %>%
  # Sort by group and date for prettier checking
  arrange(GroupAnalyzed, dates)

结果类似于上面的list输出，除了一个data.frame中的所有内容，这可以更容易地分析某些功能。顶部看起来像这样：

       dates group1 group2 GroupAnalyzed lastFour
      <date> <fctr> <fctr>         <chr>    <int>
1 2011-10-01      B      A             A        1
2 2011-10-02      J      A             A        2
3 2011-10-05      C      A             A        5
4 2011-10-05      C      A             A        5
5 2011-10-05      G      A             A        5
6 2011-10-08      E      A             A        5

请注意，我的随机样本在10月05日有多个事件，导致这里的数量很大。

Answer 2

我认为，但我不确定，您正在寻找一种方法来计算每个日期（行）和前四天中每种事件类型（字母）的出现次数，无论前四天是否出现在你的数据。如果这是正确的，那么这里有一种方法使用dplyr（为了一般方便），tidyr（使宽数据更长以便于按日期计算），以及zoo（用于rollapply 1}}功能）。

library(dplyr)
library(tidyr)
library(zoo)

df2 <- df1 %>%
  # make the wide data long so we can group and then count by date
  gather(key = group, value = event, group1:group2) %>%
  # group by date
  group_by(dates) %>%
  # count occurrences of the event of interest on each date
  summarise(sum.a = sum(event == "A")) %>%
  # join that set of counts to a complete date sequence
  left_join(data.frame(dates = seq(first(dates), last(dates), by = "day")), .) %>%
  # use rollapply to get sums of those counts across rolling windows that
  # are 4 days wide and right-aligned
  mutate(sum.a = rollapply(sum.a, width = 4, sum, na.rm = TRUE,
                               partial = TRUE, align = "right")) %>%
  # filter back to the original set of dates in df1
  filter(dates %in% df1$dates)

结果：

> df2
       dates sum.a
1 2011-10-09     1
2 2011-10-15     1
3 2011-10-16     2
4 2011-10-18     3
5 2011-10-21     2
6 2011-10-22     2
7 2011-10-24     3

滚动计数事件随着时间的推移

2 个答案: