r - 日期“参差不齐”的事件的条件滚动总和

Question

介绍

我正在使用 R 来分析非洲抗议运动的“势头”。为此，我正在分析个别抗议事件。我想在一段时间内创建滚动数量（总和）的滚动度量。

Stack Overflow 上的大多数答案都处理以固定间隔观察的数据集（每天或每月一次等）。但是我的数据是“参差不齐的”，因为它们以不同的时间间隔出现。有时观察之间有一天。其他时间有两周。

我想创造什么

过去 10 天内在给定国家/地区发生的抗议事件数量的滚动总和。这将是一个变量的形式，它简单地将过去十天内的事件数量相加，包括当前事件。

数据

这是一组可重现的数据：

df1 <- data.frame(date = c("8/1/2019", "8/2/2019", "8/3/2019", "8/6/2019", "8/15/2019", "8/16/2019", "8/30/2019", "9/1/2019", "9/2/2019", "9/3/2019", "9/4/2019", "6/1/2019", "6/26/2019", "7/1/2019", "7/2/2019", "7/9/2019", "7/10/2019", "8/1/2019", "8/2/2019", "8/15/2019", "8/28/2019", "9/1/2019"),
country = c(rep("Algeria", 11), rep("Benin", 11)),
event = rep("Protest", 22))

我希望数据看起来像什么

date       country   event     roll_sum
--------   -------   -------   --------
8/1/2019   Algeria   Protest   1
8/2/2019   Algeria   Protest   2
8/3/2019   Algeria   Protest   3
8/6/2019   Algeria   Protest   4
8/15/2019  Algeria   Protest   2
8/16/2019  Algeria   Protest   3
8/30/2019  Algeria   Protest   1
9/1/2019   Algeria   Protest   2
9/2/2019   Algeria   Protest   3
9/3/2019   Algeria   Protest   4 
9/4/2019   Algeria   Protest   5
6/1/2019   Benin     Protest   1
6/26/2019  Benin     Protest   1
7/1/2019   Benin     Protest   2
7/2/2019   Benin     Protest   3
7/9/2019   Benin     Protest   3
7/10/2019  Benin     Protest   4
8/1/2019   Benin     Protest   1
8/2/2019   Benin     Protest   2
8/15/2019  Benin     Protest   1
8/28/2019  Benin     Protest   1
9/1/2019   Benin     Protest   2

这一切可能都很简单，但我不知道该怎么做。先感谢您！

Answer 1

用于lubridate将日期字符串转换为使用函数date创建间隔。是一个返回给定日期向量是否在区间内的函数。interval%within%lubridate

创建一个dates列，每行是一个存储该国家/地区所有日期的列表。并用于purrr::pmap()迭代修改后的数据框中的所有行。

library(lubridate)
library(dplyr)
library(purrr)
df1 <- data.frame(date = c("8/1/2019", "8/2/2019", "8/3/2019", "8/6/2019", "8/15/2019", "8/16/2019", "8/30/2019", "9/1/2019", "9/2/2019", "9/3/2019", "9/4/2019", "6/1/2019", "6/26/2019", "7/1/2019", "7/2/2019", "7/9/2019", "7/10/2019", "8/1/2019", "8/2/2019", "8/15/2019", "8/28/2019", "9/1/2019"),
                  country = c(rep("Algeria", 11), rep("Benin", 11)),
                  event = rep("Protest", 22))

df2 <- df1 %>%
    mutate(
        date = mdy(date),
        interval = interval(date -days(10),date)
    ) %>%
    group_by(country) %>%
    mutate(dates = list(date)) %>%
    ungroup()

df2["roll_sum"] <- pmap_dbl(df2,function(...){
    values <- list(...)
    sum(values$dates %within% values$interval)
}) 
df2 %>%
    select(-interval,-dates)

# A tibble: 22 x 4
   date       country event   roll_sum
   <date>     <fct>   <fct>      <dbl>
 1 2019-08-01 Algeria Protest        1
 2 2019-08-02 Algeria Protest        2
 3 2019-08-03 Algeria Protest        3
 4 2019-08-06 Algeria Protest        4
 5 2019-08-15 Algeria Protest        2
 6 2019-08-16 Algeria Protest        3
 7 2019-08-30 Algeria Protest        1
 8 2019-09-01 Algeria Protest        2
 9 2019-09-02 Algeria Protest        3
10 2019-09-03 Algeria Protest        4
# ... with 12 more rows

Answer 2

rollapplyin zoo 接受一个宽度参数，它可以是一个向量，以防每个点具有不同的宽度。为了计算该宽度，w我们将其转换date为Date类，然后用于ave计算每个国家/地区的宽度wfun，用于findInterval查找不迟于 11 天前的最近日期的位置。如果我们从当前位置减去该位置，它将给我们所需的宽度。最后我们运行rollapplyr。

在问题中显示的所有事件都是Protest，如果总是如此，那么滚动和将相等w，因此我们可以避免最后一行代码中的滚动计算；但是，如果您的完整数据集包含不应计算的其他类型的事件，我们没有进行此类简化。

library(zoo)

df2 <- transform(df1, date = as.Date(date, "%m/%d/%Y"))

wfun <- function(x) seq_along(x) - findInterval(x - 11, x)
w <- with(df2, ave(as.numeric(date), country, FUN = wfun))
transform(df2, roll_sum = rollapplyr(event == "Protest", w, sum))

给予（输出后继续）：

         date country   event roll_sum
1  2019-08-01 Algeria Protest        1
2  2019-08-02 Algeria Protest        2
3  2019-08-03 Algeria Protest        3
4  2019-08-06 Algeria Protest        4
5  2019-08-15 Algeria Protest        2
6  2019-08-16 Algeria Protest        3
7  2019-08-30 Algeria Protest        1
8  2019-09-01 Algeria Protest        2
9  2019-09-02 Algeria Protest        3
10 2019-09-03 Algeria Protest        4
11 2019-09-04 Algeria Protest        5
12 2019-06-01   Benin Protest        1
13 2019-06-26   Benin Protest        1
14 2019-07-01   Benin Protest        2
15 2019-07-02   Benin Protest        3
16 2019-07-09   Benin Protest        3
17 2019-07-10   Benin Protest        4
18 2019-08-01   Benin Protest        1
19 2019-08-02   Benin Protest        2
20 2019-08-15   Benin Protest        1
21 2019-08-28   Benin Protest        1
22 2019-09-01   Benin Protest        2

笔记

w我们可以使用第二种方法进行仔细检查来计算w。这涉及扫描date宽度向量的每个元素的所有内容，因此与上面显示的方法相比，使用以下方法效率相当低findInterval，但只是作为一个不重要的双重检查。

wfun2 <- function(x) sapply(x, function(y) sum(x >= y-10 & x <= y))
w2 <- with(df2, ave(as.numeric(date), country, FUN = wfun2))

identical(w, w2)
## [1] TRUE

Answer 3

dplyr这是使用and的另一种方式purrr::map_int。我们可以group_by country从 current 中找出过去 10 天内数据集中的行数date。

library(dplyr)

df1 %>%
  mutate(date = as.Date(date, "%m/%d/%Y")) %>%
  group_by(country) %>%
  mutate(roll_sum = purrr::map_int(date, ~sum(date >= (.x - 10) & date <= (.x))))

#    date       country event   roll_sum
#   <date>     <fct>   <fct>      <int>
# 1 2019-08-01 Algeria Protest        1
# 2 2019-08-02 Algeria Protest        2
# 3 2019-08-03 Algeria Protest        3
# 4 2019-08-06 Algeria Protest        4
# 5 2019-08-15 Algeria Protest        2
# 6 2019-08-16 Algeria Protest        3
# 7 2019-08-30 Algeria Protest        1
# 8 2019-09-01 Algeria Protest        2
# 9 2019-09-02 Algeria Protest        3
#10 2019-09-03 Algeria Protest        4
# … with 12 more rows

Answer 4

一种base R方法，

df1$date <- as.Date(df1$date,"%m/%d/%Y")

vector <- vector()

for( j in unique(df1$country)) {
    df2 <- df1[df1$country==j,]
    for(i in 1:nrow(df2)) {

     k <- nrow(df2[df2$date<= df2$date[i] & df2$date>=df2$date[i]-10 ,])

     vector <- c(vector, k)

    }
}

df1$roll_sum <- vector

给，

         date country   event roll_sum
1  2019-08-01 Algeria Protest        1
2  2019-08-02 Algeria Protest        2
3  2019-08-03 Algeria Protest        3
4  2019-08-06 Algeria Protest        4
5  2019-08-15 Algeria Protest        2
6  2019-08-16 Algeria Protest        3
7  2019-08-30 Algeria Protest        1
8  2019-09-01 Algeria Protest        2
9  2019-09-02 Algeria Protest        3
10 2019-09-03 Algeria Protest        4
11 2019-09-04 Algeria Protest        5
12 2019-06-01   Benin Protest        1
13 2019-06-26   Benin Protest        1
14 2019-07-01   Benin Protest        2
15 2019-07-02   Benin Protest        3
16 2019-07-09   Benin Protest        3
17 2019-07-10   Benin Protest        4
18 2019-08-01   Benin Protest        1
19 2019-08-02   Benin Protest        2
20 2019-08-15   Benin Protest        1
21 2019-08-28   Benin Protest        1
22 2019-09-01   Benin Protest        2