基于游程编码的R数据框长度列求和：求高效实现方案

现有游程编码格式的数据框df1，定义及数据如下：

df1 <- structure(list(lengths = c(2L, 3L, 2L, 1L, 1L, 1L, 1L, 1L, 2L, 1L, 1L, 3L, 1L), values = c(10, 9, NA, 5, 4, 3, NA, 2, NA, 1, 0, NA, 0)), row.names = c(NA, -13L), class = "data.frame")

输出df1结果：

> df1
   lengths values
1        2     10
2        3      9
3        2     NA
4        1      5
5        1      4
6        1      3
7        1     NA
8        1      2
9        2     NA
10       1      1
11       1      0
12       3     NA
13       1      0

基于阈值0.01生成新列Below_Threshold，代码及结果如下：

df1$Below_Threshold <- ifelse(df1$values <= 0.01, TRUE, FALSE)

输出df1结果：

> df1
   lengths values Below_Threshold
1        2     10           FALSE
2        3      9           FALSE
3        2     NA              NA
4        1      5           FALSE
5        1      4           FALSE
6        1      3           FALSE
7        1     NA              NA
8        1      2           FALSE
9        2     NA              NA
10       1      1           FALSE
11       1      0            TRUE
12       3     NA              NA
13       1      0            TRUE

现在需要对Below_Threshold列执行游程编码逻辑，但不统计出现次数，而是对连续相同的Below_Threshold值对应的lengths列求和，得到如下结果df2：

df2 <- structure(list(values = c(FALSE, NA, FALSE, NA, FALSE, NA, FALSE, TRUE, NA, TRUE), sum = c(5, 2, 3, 1, 1, 2, 1, 1, 3, 1)), class = "data.frame", row.names = c(NA, -10L))

输出df2结果：

> df2
   values sum
1   FALSE   5
2      NA   2
3   FALSE   3
4      NA   1
5   FALSE   1
6      NA   2
7   FALSE   1
8    TRUE   1
9      NA   3
10   TRUE   1

求简洁高效的实现方法，优先使用base R方案，其他方案也可。

Base R 方案 #

借助rle()识别连续游程，再按游程分组求和：

# 提取游程信息
rle_obj <- rle(df1$Below_Threshold)
# 按游程分组对lengths求和
sum_lengths <- tapply(df1$lengths, rep(seq_along(rle_obj$values), rle_obj$lengths), sum)
# 构造结果数据框
df2 <- data.frame(
  values = rle_obj$values,
  sum = as.vector(sum_lengths)
)

执行后输出的df2与目标结果完全一致，该方案逻辑直接，仅依赖base R原生函数，效率较高。

dplyr 方案 #

若习惯tidyverse语法，可通过生成分组标识实现：

library(dplyr)

df2 <- df1 %>%
  # 生成游程分组ID：当当前行与前一行的Below_Threshold值（含NA状态）不同时，分组号递增
  mutate(group = cumsum(
    is.na(Below_Threshold) != is.na(lag(Below_Threshold)) |
    Below_Threshold != lag(Below_Threshold, default = !first(Below_Threshold))
  )) %>%
  group_by(group) %>%
  summarise(
    values = first(Below_Threshold),
    sum = sum(lengths)
  ) %>%
  ungroup() %>%
  select(-group)

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