如何迭代计算连续两行的均值以缩减tibble的行数？

原始数据 #

首先生成示例数据：

library(dplyr)
set.seed(1)
my_tib <- tibble(identifier = rep(letters[1:3], each = 4),
       year = rep(seq(2005, 2020, 5), 3),
       value = rnorm(12, mean = 1000, 100) %>% round()
       )

数据结构如下：

# A tibble: 12 × 3
   identifier  year value
   <chr>      <dbl> <dbl>
 1 a           2005   937
 2 a           2010  1018
 3 a           2015   916
 4 a           2020  1160
 5 b           2005  1033
 6 b           2010   918
 7 b           2015  1049
 8 b           2020  1074
 9 c           2005  1058
10 c           2010   969
11 c           2015  1151
12 c           2020  1039

需求说明 #

按每个identifier分组，将连续两年（如2005-2010、2010-2015）作为区间，计算区间内value的均值，并生成year_bracket列标注年份区间。

1. dplyr链式管道实现 #

这是最贴合需求的写法，利用lead获取下一行数据，完成区间拼接和均值计算：

my_new_tib <- my_tib %>%
  group_by(identifier) %>%
  # 生成下一年份和年份区间
  mutate(
    next_year = lead(year),
    year_bracket = paste(year, next_year, sep = "-")
  ) %>%
  # 过滤掉没有下一年的最后一行
  filter(!is.na(next_year)) %>%
  # 计算连续两年的均值
  mutate(value = (value + lead(value)) / 2) %>%
  # 保留需要的列并取消分组
  select(identifier, year_bracket, value) %>%
  ungroup()

# 查看前5行结果
head(my_new_tib, 5)

输出结果：

# A tibble: 9 × 3
  identifier year_bracket value
  <chr>      <chr>        <dbl>
1 a          2005-2010     977.5
2 a          2010-2015     967  
3 a          2015-2020    1038  
4 b          2005-2010     975.5
5 b          2010-2015     983.5

如果需要更灵活的滑动窗口处理，可以用slider包的slide系列函数：

library(slider)

my_new_tib <- my_tib %>%
  group_by(identifier) %>%
  summarize(
    year_bracket = slide_chr(year, ~paste(.x[1], .x[2], sep = "-"), .before = 1, .complete = TRUE),
    value = slide_dbl(value, mean, .before = 1, .complete = TRUE)
  ) %>%
  ungroup()

2. data.table实现 #

适合大数据量的高效处理方式：

library(data.table)

setDT(my_tib)
my_new_tib <- my_tib[, 
  .(
    year_bracket = paste(year, shift(year, type = "lead"), sep = "-"),
    value = (value + shift(value, type = "lead")) / 2
  ), 
  by = identifier
][!is.na(year_bracket)]

# 可选：转换回tibble格式
my_new_tib <- as_tibble(my_new_tib)

3. Base R实现 #

无需额外包的原生写法：

# 按identifier分组处理每个子集
my_new_tib <- do.call(rbind, lapply(split(my_tib, my_tib$identifier), function(df) {
  row_count <- nrow(df)
  # 生成年份区间
  year_bracket <- paste(df$year[-row_count], df$year[-1], sep = "-")
  # 计算连续两年的均值
  value <- rowMeans(cbind(df$value[-row_count], df$value[-1]))
  # 组合结果
  data.frame(identifier = df$identifier[1], year_bracket, value)
}))

# 转换为tibble格式
my_new_tib <- as_tibble(my_new_tib)

内容的提问来源于stack exchange，提问作者Tea Tree