如何在R的深度嵌套tibble中对连续非空行求和？

问题背景 #

我有一个存储眼动实验数据的大型tibble，包含多个实验任务，每个任务下有大量被试，每个被试有独立的结果数据集，采用嵌套tibble结构维护。需要为每个被试对连续非空行的值求和（对应被试注视同一区域的帧合并）。

示例数据结构：

library(tidyverse)

df <- tibble(
  task_name = c("task_1", "task_2"),
  task_data = list(
    tibble(
        subject = c("S1", "S2"),
        data = list(
          tibble(
            var_1 = c(NA, 20, 12, NA, NA, NA),
            var_2 = c(NA, NA, NA, NA, 51, 10),
          ),
          tibble(
            var_1 = c(NA, NA, 15, 54, NA, NA),
            var_2 = c(NA, 13, NA, NA, NA, 10),
          )
        )
      ),
    tibble(
        subject = c("S1", "S2"),
        data = list(
          tibble(
            var_3 = c(3,  NA, NA, 10,  5, NA),
            var_4 = c(NA, NA, NA, NA, NA, NA)
          ),
          tibble(
            var_3 = c(3,  NA, NA, NA,  7, NA),
            var_4 = c(NA, NA, 20, 30, NA, NA)
          )
        )
      )
    )
  )

例如，task_1中S1的var_1需将20和12求和为32，var_2需将51和10求和为61，最终生成更短的tibble。

尝试用lag()/lead()创建辅助列求和时，代码报错：

df_summed <- 
  df |>
  rowwise() |>
  mutate(
    task_data = case_when(
      # 仅测试task_1
      task_name == "task_1" ~
        list(
          task_data |>
            rowwise() |>
            mutate(
              data = list(
                data |>
                  mutate(
                    # 生成前一行偏移列
                    behind = lag(var_1), # <1>
                    # NA替换为0
                    behind = if_else(is.na(behind), 0, behind),
                    # 生成后一行偏移列
                    ahead  = lead(var_1),                       
                    ahead  = if_else(is.na(ahead), 0, ahead),  
                    # 非NA值求和，NA值设为0
                    summed = if_else(is.na(var_1), 0, var_1 + behind + ahead)
                  ) |>
                  # 移除辅助列
                  select(!c(var_1, behind, ahead)) |>
                  rename(var_1 = summed) |>
                  # 去重保留唯一行
                  unique()
                )
              )
          ),
      # 暂不处理task_2
      TRUE ~ list(task_data)
    )
  )

报错信息：

Error in `mutate()`:
ℹ In argument: `task_data = case_when(...)`.
Caused by error in `case_watch()`:
! Failed to evaluate the right-hand side of formula 1.
Caused by error in `mutate()`:
ℹ In argument: `data = list(...)`.
Caused by error in `mutate()`:
ℹ In argument: `behind = lag(var_1)`.
Caused by error in `lag()`:
! object 'var_1' not found
Backtrace:
  1. dplyr::mutate(...)
 29. dplyr::lag(var_1)

疑问：

1. 有没有更优的实现方法？
2. 为何变量名不同时case_when()无法隔离变量，导致报错？

解答 #

1. 更优实现方法 #

可以通过长格式转换+连续非NA分组求和的方式实现，该方法无需指定具体变量名，适配不同任务的变量差异，逻辑更清晰：

首先定义一个处理单个被试数据的函数：

sum_consecutive_non_na <- function(data_tbl) {
  data_tbl |>
    # 转成长格式，统一处理所有变量
    pivot_longer(everything(), names_to = "variable", values_to = "value") |>
    group_by(variable) |>
    # 创建连续非NA的分组标识：当当前行NA状态与前一行不同时，分组ID递增
    mutate(
      group_id = cumsum(is.na(value) != lag(is.na(value), default = TRUE))
    ) |>
    # 过滤掉NA行，只保留需要求和的非空值
    filter(!is.na(value)) |>
    # 按变量和连续分组求和
    group_by(variable, group_id) |>
    summarise(summed = sum(value), .groups = "drop") |>
    # 转回宽格式，恢复原变量结构
    pivot_wider(names_from = "variable", values_from = "summed")
}

然后将该函数应用到嵌套tibble的每一层：

df_summed <- df |>
  mutate(
    task_data = map(task_data, function(task_tbl) {
      task_tbl |>
        mutate(data = map(data, sum_consecutive_non_na))
    })
  )

验证结果：比如task_1中S1的var_1会得到32，var_2得到61，完全符合需求。

2. case_when()报错原因 #

dplyr的case_when()是非惰性评估的：所有分支的右侧表达式都会被提前解析和计算，而不是仅执行满足条件的分支。

即使你的条件是task_name == "task_1"，R仍然会尝试解析第一个分支中引用var_1的代码；而task_2的数据集里没有var_1这个变量，因此会触发"object 'var_1' not found"的错误。这就是为什么用case_when()无法实现任务隔离的原因。

如果一定要用case_when()，需要将分支代码包装在if()中（if是惰性评估的），比如：

df_summed <- 
  df |>
  rowwise() |>
  mutate(
    task_data = if (task_name == "task_1") {
        list(
          task_data |>
            rowwise() |>
            mutate(
              data = list(
                data |>
                  mutate(
                    behind = lag(var_1),
                    behind = if_else(is.na(behind), 0, behind),
                    ahead  = lead(var_1),                       
                    ahead  = if_else(is.na(ahead), 0, ahead),  
                    summed = if_else(is.na(var_1), 0, var_1 + behind + ahead)
                  ) |>
                  select(!c(var_1, behind, ahead)) |>
                  rename(var_1 = summed) |>
                  unique()
                )
              )
          )
      } else {
        list(task_data)
      }
  )

但显然这种写法不如前面的通用函数方法简洁。

内容的提问来源于stack exchange，提问作者Maël