在R语言中按组求相邻值为1的列的行累积和最大值

需求说明 #

给定如下数据框，需按group分组，计算每组（每行）中相邻且值为1的列的最长连续长度（即连续1的最大累积和）。例如Group 1中Year1至Year4为连续的1，长度为4，Year6单独为1，因此最大值为4。

示例数据 #

df <- data.frame(group = c(1:6),
                 Year1 = c('1','0','0','0','0','0'),
                 Year2 = c('1','1','1','0','1','1'),
                 Year3 = c('1','1','0','0','1','0'),
                 Year4 = c('1','1','1','0','1','1'),
                 Year5 = c('0','0','1','1','1','1'),
                 Year6 = c('1','0','0','0','0','1'))

# 查看数据
df
#>   group Year1 Year2 Year3 Year4 Year5 Year6
#> 1     1     1     1     1     1     0     1
#> 2     2     0     1     1     1     0     0
#> 3     3     0     1     0     1     1     0
#> 4     4     0     0     0     0     1     0
#> 5     5     0     1     1     1     1     0
#> 6     6     0     1     0     1     1     1

期望结果 #

result <- data.frame(group=c(1:6), value = c(4, 3, 2, 1, 4, 3))

result
#>   group value
#> 1     1     4
#> 2     2     3
#> 3     3     2
#> 4     4     1
#> 5     5     4
#> 6     6     3

解决方案 #

方法1：Base R 实现

通过rle()函数识别连续序列，提取值为1的序列长度并取最大值：

# 将Year列转为数值型
df[, -1] <- lapply(df[, -1], as.numeric)

# 定义函数：计算单行的最长连续1长度
max_consec_ones <- function(x) {
  run_info <- rle(x == 1)
  # 提取所有连续1的长度，无则返回0
  max(run_info$lengths[run_info$values], 0)
}

# 按行应用函数生成结果
result_base <- data.frame(
  group = df$group,
  value = apply(df[, -1], 1, max_consec_ones)
)

result_base

方法2：dplyr + tidyr 实现

将数据转为长格式，按分组和连续序列分组计算长度：

library(dplyr)
library(tidyr)

result_dplyr <- df %>%
  # 转为长格式
  pivot_longer(cols = starts_with("Year"), names_to = "year", values_to = "value") %>%
  mutate(value = as.numeric(value)) %>%
  group_by(group) %>%
  # 标记连续1的分组ID
  mutate(run_id = cumsum(value != lag(value, default = 0))) %>%
  # 仅保留值为1的行
  filter(value == 1) %>%
  # 计算每个连续序列的长度
  group_by(group, run_id) %>%
  summarise(length = n(), .groups = "drop_last") %>%
  # 取每个分组的最大长度
  summarise(value = max(length, 0), .groups = "drop") %>%
  # 确保所有分组都被包含（处理全0的情况）
  right_join(df %>% select(group), by = "group") %>%
  mutate(value = replace_na(value, 0))

result_dplyr

方法3：data.table 实现

利用data.table的高效分组操作完成计算：

library(data.table)

setDT(df)
# 转换Year列为数值型
df[, (paste0("Year", 1:6)) := lapply(.SD, as.numeric), .SDcols = starts_with("Year")]

result_dt <- df %>%
  melt(id.vars = "group", variable.name = "year", value.name = "value") %>%
  .[, run_id := cumsum(value != shift(value, fill = 0)), by = group] %>%
  .[value == 1, .(length = .N), by = .(group, run_id)] %>%
  .[, .(value = max(length)), by = group] %>%
  merge(df[, .(group)], by = "group", all.x = TRUE) %>%
  .[, value := fifelse(is.na(value), 0, value)]

result_dt

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