R：计算特定事件在未来指定时间发生的次数答案

【问题标题】：R: calculate the number of occurrences of a specific event in a specified time futureR：计算特定事件在未来指定时间发生的次数
【发布时间】：2017-05-26 09:30:18
【问题描述】：

我的简化数据如下所示：

set.seed(1453); x = sample(0:1, 10, TRUE)
date = c('2016-01-01', '2016-01-05', '2016-01-07',  '2016-01-12',  '2016-01-16',  '2016-01-20',
             '2016-01-20',  '2016-01-25',  '2016-01-26',  '2016-01-31')


df = data.frame(x, date = as.Date(date))


df 
x       date
1 2016-01-01
0 2016-01-05
1 2016-01-07
0 2016-01-12
0 2016-01-16
1 2016-01-20
1 2016-01-20
0 2016-01-25
0 2016-01-26
1 2016-01-31

我想计算x == 1 在指定时间段内出现的次数，例如从当前日期起 14 天和 30 天（但不包括当前条目，如果它是 x == 1。所需的输出将如下所示：

solution
x       date x_plus14 x_plus30
1 2016-01-01        1        3
0 2016-01-05        1        4
1 2016-01-07        2        3
0 2016-01-12        2        3
0 2016-01-16        2        3
1 2016-01-20        2        2
1 2016-01-20        1        1
0 2016-01-25        1        1
0 2016-01-26        1        1
1 2016-01-31        0        0

理想情况下，我希望它出现在dplyr 中，但这不是必须的。任何想法如何实现这一目标？非常感谢您的帮助！

【问题讨论】：

两件事。 1）尽量不要以函数命名对象（sample也是函数）。 2）不清楚你在问什么
您需要今天 + 14 次观察（行）还是今天 + 14 天？后者要复杂得多。
你的输出正确吗？ bcoz x_plus14[1] 应该是 2
不确定as_date 来自哪里，但您可以简单地执行sample = data.frame(x, date = as.Date(date))，同时避免依赖并使用cbind 转换为矩阵并返回
感谢所有有用的 cmets。 @Sotos：现在我已经更改了 df 名称

标签： r date dplyr aggregate

【解决方案1】：

基于findInterval添加另一种方法：

cs = cumsum(df$x) # cumulative number of occurences
data.frame(df, 
           plus14 = cs[findInterval(df$date + 14, df$date, left.open = TRUE)] - cs, 
           plus30 = cs[findInterval(df$date + 30, df$date, left.open = TRUE)] - cs)
#   x       date plus14 plus30
#1  1 2016-01-01      1      3
#2  0 2016-01-05      1      4
#3  1 2016-01-07      2      3
#4  0 2016-01-12      2      3
#5  0 2016-01-16      2      3
#6  1 2016-01-20      2      2
#7  1 2016-01-20      1      1
#8  0 2016-01-25      1      1
#9  0 2016-01-26      1      1
#10 1 2016-01-31      0      0

【讨论】：

感谢@alexis_laz 的回答和帮助（再次）！我真的很喜欢它的简单和优雅，它基于基础 R。谢谢一百万！
@KasiaKulma：不客气。 findInterval 在这种情况下确实很方便，而且它还避免将所有日期与所有日期进行比较以返回特定日期的条目数 <。祝你有美好的一天！
这真的很优雅！

【解决方案2】：

之前我没有包括现在的日期，所以数字不匹配。

library(data.table)
setDT(df)[, `:=`(x14 = sum(df$x[between(df$date, date, date + 14, incbounds = FALSE)]), 
                 x30 = sum(df$x[between(df$date, date, date + 30, incbounds = FALSE)])),
              by = date]

#     x       date x14 x30
#  1: 1 2016-01-01   1   3
#  2: 0 2016-01-05   1   4
#  3: 1 2016-01-07   2   3
#  4: 0 2016-01-12   2   3
#  5: 0 2016-01-16   2   3
#  6: 1 2016-01-20   1   1
#  7: 1 2016-01-20   1   1
#  8: 0 2016-01-25   1   1
#  9: 0 2016-01-26   1   1
# 10: 1 2016-01-31   0   0

或适用于任何所需范围的通用解决方案

vec <- c(14, 30) # Specify desired ranges
setDT(df)[, paste0("x", vec) := 
            lapply(vec, function(i) sum(df$x[between(df$date, 
                                                     date, 
                                                     date + i, 
                                                     incbounds = FALSE)])),
            by = date]

【讨论】：

有问题！！我包括现在的日期。只需在between() 中使用date+1 而不是date
@KasiaKulma 需要澄清是否包括当前日期，尽管她在问题中提到过。因为第一行的数字不匹配
谢谢你；是的，现在我编辑了这篇文章，以便澄清当前出现的情况，如果它是“x==1”，则不应包含在计算中。不过，我不会弄乱日期，因为在我的原始数据集中，您可以找到多个具有相同日期的事件，因此如果解决方案包含当前记录，我总是可以提取 1
为了在两行中获得所需的结果，只需指定 incbounds = FALSE 并保留原始范围，例如 between(sample$date, date, date+30, incbounds = FALSE)（这将在第一行中使用 3 而不是 4）
恐怕这给了我不一致的结果：expected_output 用于条目x==1 和expected_output - 1 用于x == 0 的条目

【解决方案3】：

简洁的dplyr 和purrr 解决方案：

library(tidyverse)

sample %>% 
  mutate(x_plus14 = map(date, ~sum(x == 1 & between(date, . + 1, . + 14))),
         x_plus30 = map(date, ~sum(x == 1 & between(date, . + 1, . + 30))))

   x       date x_plus14 x_plus30
1  1 2016-01-01        1        4
2  0 2016-01-05        1        4
3  1 2016-01-07        2        3
4  0 2016-01-12        2        3
5  0 2016-01-16        2        3
6  1 2016-01-20        1        1
7  1 2016-01-20        1        1
8  0 2016-01-25        1        1
9  0 2016-01-26        1        1
10 1 2016-01-31        0        0

【讨论】：

谢谢@Axeman，为此，我真的很喜欢你的解决方案的清晰和紧凑。但是，我不明白为什么您的（和其他）解决方案在第 6 行给出 x_plus14 == 1 并给出 x_plus30 == 1，因为从那时到月底有 2 个 x == 1 出现（不包括当前的）。更令人惊讶的是，所有其他实例都已正确计算！
这是因为第 6 行和第 7 行中的日期重复。您可以使用between(sample$date, ., . + 14)，但日期本身也会包含在内，我们最终得到 3。
没关系，我总是可以从中提取 1。如果您以这种方式编辑您的答案，我会很乐意接受它
我意识到这种方法给我的结果不一致，这取决于条目是 x==1 还是 `x==0'。任何想法如何解决它？

【解决方案4】：

这是我在 dplyr+purrr 帮助下的尝试。由于辅助函数x_next() 中的<= 和>=，我的计数略有不同，如果您正确调整它们，我认为您应该能够得到您想要的。 hth.

library("tidyverse")
library("lubridate")
set.seed(1453)

x = sample(0:1, 10, TRUE)
dates = c('2016-01-01', '2016-01-05', '2016-01-07',  '2016-01-12',  '2016-01-16',  '2016-01-20',
         '2016-01-20',  '2016-01-25',  '2016-01-26',  '2016-01-31')

df = data_frame(x = x, dates = lubridate::as_date(dates))

# helper function to calculate the sum of xs in the next days_in_future
x_next <- function(d, days_in_future) {

  df %>% 
    # subset on days of interest
    filter(dates > d & dates <= d + days(days_in_future)) %>% 
    # sum up xs
    summarise(sum = sum(x)) %>% 
    # have to unlist them so that the (following) call to mutate works
    unlist(use.names=F)
  }

# mutate your df
df %>% 
  mutate(xplus14 = map(dates, x_next, 14),
         xplus30 = map(dates, x_next, 30))

【讨论】：

我认为您没有考虑到 x 应该是 1。另外，您应该使用 map_dbl。
嘿@Axeman，不明白为什么不赞成投票......我正在考虑你所说的 - sum(x) 显然只会总结所有 x=1。使用map_dbl 是一个的选择，但在这种情况下不是一个错误的选择......
抱歉，我错过了sum(x)。但是您的计数仍然过高？
不用担心，但没有办法撤消否决权？至于结果 - 我将在右侧使用严格的不等式编辑我的答案，我认为它应该是正确的。请注意，原始问题在示例输出中有错误（如果您查看数据，x_plus14 的第 1 行实际上是 2）。
更新：只需重新阅读所有 cmets，所需的解决方案似乎排除当前日期。我更新了我的答案，现在我得到了与您的建议相同的结果。 imo（这只是一个口味问题） - 单独提取匿名函数可以让您更频繁地重用它，而无需复制粘贴代码。

【解决方案5】：

正如其他已经提到的，奇怪的是你不计算日期，你应该避免用函数的名称命名对象（示例）。但是，下面的代码会重现您想要的输出：

set.seed(1453); 
x = sample(0:1, 10, TRUE)
date = c('2016-01-01', '2016-01-05', '2016-01-07',  '2016-01-12',  '2016-01-16',  '2016-01-20',
             '2016-01-20',  '2016-01-25',  '2016-01-26',  '2016-01-31')


sample = data.frame(x = x, date = as.Date(sample$date))

getOccurences <- function(one_row, sample_data, date_range){
  one_date <- as.Date(one_row[2])
  sum(sample$x[sample_data$date > one_date & 
               sample_data$date < one_date + date_range])
}

sample$x_plus14 <- apply(sample,1,getOccurences, sample, 14)
sample$x_plus30 <- apply(sample,1,getOccurences, sample, 30)

sample

   x       date x_plus14 x_plus30
1  1 2016-01-01        1        3
2  0 2016-01-05        1        4
3  1 2016-01-07        2        3
4  0 2016-01-12        2        3
5  0 2016-01-16        2        3
6  1 2016-01-20        1        1
7  1 2016-01-20        1        1
8  0 2016-01-25        1        1
9  0 2016-01-26        1        1
10 1 2016-01-31        0        0

【讨论】：