日期为 'ragged' 的事件的条件滚动总和
Conditional rolling sum of events with 'ragged' dates
简介
我正在使用 R 来分析 'momentum' 非洲的抗议运动。为此，我正在分析个别抗议事件。我想创建一个 一段时间内 抗议的滚动数量（总和）的滚动测量值。
Stack Overflow 上的大多数答案都处理以固定间隔进行观察的数据集（每天或每月观察一次，等等）。但我的数据是 'ragged'，因为它们出现在不同的时间间隔。有时两次观察之间间隔一天。其他时间有两周。
我想创造什么
过去 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
这一切可能非常简单，但我不知道该怎么做。提前致谢！
使用 lubridate 将日期字符串转换为 date 并使用 interval 函数创建时间间隔。 %within% 是 lubridate 中的一个函数，它 returns 给定的日期向量是否在区间内。
创建一个 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
rollapply in zoo 采用宽度参数，如果每个点具有不同的宽度，该参数可以是向量。为了计算宽度 w，我们将 date 转换为 Date class，然后使用 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
一种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
这是使用 dplyr 和 purrr::map_int 的另一种方法。我们可以 group_by country 并从当前 date.
中找出过去 10 天数据集中的行数
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
简介
我正在使用 R 来分析 'momentum' 非洲的抗议运动。为此，我正在分析个别抗议事件。我想创建一个 一段时间内 抗议的滚动数量（总和）的滚动测量值。
Stack Overflow 上的大多数答案都处理以固定间隔进行观察的数据集（每天或每月观察一次，等等）。但我的数据是 'ragged'，因为它们出现在不同的时间间隔。有时两次观察之间间隔一天。其他时间有两周。
我想创造什么
过去 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
这一切可能非常简单，但我不知道该怎么做。提前致谢！
使用 lubridate 将日期字符串转换为 date 并使用 interval 函数创建时间间隔。 %within% 是 lubridate 中的一个函数，它 returns 给定的日期向量是否在区间内。
创建一个 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
rollapply in zoo 采用宽度参数，如果每个点具有不同的宽度，该参数可以是向量。为了计算宽度 w，我们将 date 转换为 Date class，然后使用 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
一种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
这是使用 dplyr 和 purrr::map_int 的另一种方法。我们可以 group_by country 并从当前 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