基于rollapply自定义函数的活动起始识别代码全NA问题排查

问题背景 #

现有20天共2790行数据，前四列为原始数据（Day、Hr、Min、Cnts/min），Onset列为期望输出（示例如下）：

目标是识别每日活动起始，步骤为：

1. 将数据重组为宽表，Day、Hr、Min列后每列对应一天；
2. 对每列应用滚动函数：先获取该列最大值，滚动窗口覆盖当前单元格+后续6个单元格，若当前单元格数值大于最大值的20%，且窗口内至少3个单元格数值大于最大值的20%，则返回TRUE（或对应起始时间Hr:Min）。

测试x2列时，执行给定R代码后生成的result列全为NA，需排查解决。

问题根源 #

1. by.column = FALSE参数错误：仅处理单列时，该参数会让rollapply以矩阵形式传入窗口数据，而非预期的向量，引发计算异常。
2. 对齐方式与逻辑不匹配：align = "right"意味着窗口最后一个元素是当前行，与自定义函数中“x[1]为当前行、x[2:7]为后续行”的逻辑完全颠倒，导致判断失效。
3. 未处理NA值：自定义函数的sum操作未设置na.rm = TRUE，若数据存在NA，会直接返回NA，最终导致整列结果为NA。
4. 重复计算最大值（效率问题）：在rollapply的匿名函数中重复计算列最大值，增加不必要的计算开销。

修正后的代码 #

library(zoo)
library(janitor)
library(tidyverse)

# 加载数据
bin10 <- read_csv("./data/bin10.csv", skip=3)

# 转换为宽表
bin10_wide <- bin10 %>%
  group_by(Day, Hr, Min) %>%
  summarize(`Cnts/min` = mean(`Cnts/min`, na.rm = TRUE)) %>%
  pivot_wider(names_from = Day, values_from = `Cnts/min`) %>% 
  clean_names()

# 提前计算目标列的最大值（以x2为例）
max_x2 <- max(bin10_wide$x2, na.rm = TRUE)

# 自定义滚动函数
custom_function <- function(x, max_val) {
  # 当前行数值大于最大值20%时继续判断
  if (x[1] > 0.2 * max_val) {
    # 统计后续6个元素中符合条件的数量，忽略NA
    count <- sum(x[2:7] > 0.2 * max_val, na.rm = TRUE)
    return(count >= 3)
  } else {
    return(FALSE)
  }
}

# 应用滚动函数，修正参数
data <- bin10_wide %>%
  mutate(result = rollapply(x2, 
                            width = 7, 
                            FUN = function(x) custom_function(x, max_x2), 
                            align = "left",  # 窗口从当前行开始，包含后续6行
                            fill = NA,       # 窗口不完整的行填充NA
                            by.column = TRUE))  # 按列处理（单列时可省略，默认TRUE）

额外优化建议 #

• 若需批量处理所有日期列（x1至x20），可使用mutate(across(starts_with("x"), ...))循环处理，避免重复代码。
• 若期望返回起始时间（Hr:Min）而非布尔值，可结合ifelse，当result为TRUE时拼接Hr和Min，否则返回空值。

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