时间序列行为数据：优化焦点事件前特定延迟个体列表生成代码

问题说明 #

我有一组包含行为发生时间与个体标识的行为时间序列数据，需要列出焦点行为发生前特定延迟窗口内执行该行为的所有个体。当前用tidyverse编写的代码可完成任务，但存在大量重复逻辑，亟需优化。示例数据集包含Lat_1至Lat_7列（对应不同延迟窗口），需遵循以下规则处理：

• 当Lat列值为NA（延迟大于行为起始时间，无影响可能）时，标记为"Y"
• 当Lat列值为0（延迟内无其他行为）时，标记为"Z"
• 其他情况，输出符合条件的历史个体字符串列表

原代码 #

library(tidyverse)

LD_SO <- data.frame(Group = "Gr02",
                    Individual = c("B", "A", "B", "B", "A", "A", "C", "A", "B", "C", "A", "A", "C", "A", "A", "A", "B", "C"),
                    Event_type = "Behaviour1",
                    Start_cor = c(2.25, 2.8, 5.9, 6.1, 30.56, 33.45, 34.12, 35.49, 49.78, 54.89, 55.12, 59.24, 136.45, 137, 138.49, 140.21, 141.73, 200.24),
                    Lat_1 = c(0L, 1L, 0L, 1L, 0L, 0L, 1L, 0L, 0L, 0L, 1L, 0L, 0L, 1L, 0L, 0L, 0L, 0L),
                    Lat_2 = c(0L, 1L, 0L, 1L, 0L, 0L, 1L, 1L, 0L, 0L, 1L, 0L, 0L, 0L, 1L, 1L, 1L, 0L),
                    Lat_3 = c(NA, NA, 0L, 1L, 0L, 1L, 1L, 2L, 0L, 0L, 1L, 0L, 0L, 0L, 2L, 1L, 1L, 0L),
                    Lat_4 = c(NA, NA, 2L, 3L, 0L, 1L, 2L, 2L, 0L, 0L, 1L, 0L, 0L, 0L, 2L, 3L, 2L, 0L),
                    Lat_5 = c(NA, NA, 2L, 3L, 0L, 1L, 2L, 3L, 0L, 0L, 1L, 2L, 0L, 0L, 2L, 3L, 3L, 0L),
                    Lat_6 = c(NA, NA, NA, 3L, 0L, 1L, 2L, 3L, 0L, 1L, 2L, 2L, 0L, 0L, 2L, 3L, 4L, 0L),
                    Lat_7 = c(NA, NA, NA, NA, 0L, 1L, 2L, 3L, 0L, 1L, 2L, 2L, 0L, 0L, 2L, 3L, 4L, 0L))

###
# first step: list all relevant previous individuals
###

# the values in Lat_1:Lat_7 indicate how many previous events took place within a certain latency [1 to 7 seconds]
LD_SO_step1 <- LD_SO %>%
  mutate(
    # Identify all relevant previous individuals up to 1 second before the focal behaviour
    Infl_1 = case_when(is.na(Lat_1) ~ "Y", # in order to transform NAs into specific letter for later
                       Lat_1 == 0 ~ "Z", # in order to indicate that nobody started the behaviour within that latency
                       Lat_1 == 1 ~ paste0(lag(Individual, 1)), # retrieve the identity of the person performing the previous behaviour
                       Lat_1 == 2 ~ paste0(lag(Individual, 1),
                                           lag(Individual, 2)), # retrieve the identity of the persons performing the two previous behaviours
                       Lat_1 == 3 ~ paste0(lag(Individual, 1),
                                           lag(Individual, 2),
                                           lag(Individual, 3)), # retrieve the identity of the persons performing the three previous behaviours
                       Lat_1 == 4 ~ paste0(lag(Individual, 1),
                                           lag(Individual, 2),
                                           lag(Individual, 3),
                                           lag(Individual, 4))), # and so on
    # Identify all relevant previous individuals up to 2 seconds before the focal behaviour
    Infl_2 = case_when(is.na(Lat_2) ~ "Y",
                       Lat_2 == 0 ~ "Z",
                       Lat_2 == 1 ~ paste0(lag(Individual, 1)),
                       Lat_2 == 2 ~ paste0(lag(Individual, 1),
                                           lag(Individual, 2)),
                       Lat_2 == 3 ~ paste0(lag(Individual, 1),
                                           lag(Individual, 2),
                                           lag(Individual, 3)),
                       Lat_2 == 4 ~ paste0(lag(Individual, 1),
                                           lag(Individual, 2),
                                           lag(Individual, 3),
                                           lag(Individual, 4))),
    # Identify all relevant previous individuals up to 3 seconds before the focal behaviour
    Infl_3 = case_when(is.na(Lat_3) ~ "Y",
                       Lat_3 == 0 ~ "Z",
                       Lat_3 == 1 ~ paste0(lag(Individual, 1)),
                       Lat_3 == 2 ~ paste0(lag(Individual, 1),
                                           lag(Individual, 2)),
                       Lat_3 == 3 ~ paste0(lag(Individual, 1),
                                           lag(Individual, 2),
                                           lag(Individual, 3)),
                       Lat_3 == 4 ~ paste0(lag(Individual, 1),
                                           lag(Individual, 2),
                                           lag(Individual, 3),
                                           lag(Individual, 4))),
    # and so on
    Infl_4 = case_when(is.na(Lat_4) ~ "Y",
                       Lat_4 == 0 ~ "Z",
                       Lat_4 == 1 ~ paste0(lag(Individual, 1)),
                       Lat_4 == 2 ~ paste0(lag(Individual, 1),
                                           lag(Individual, 2)),
                       Lat_4 == 3 ~ paste0(lag(Individual, 1),
                                           lag(Individual, 2),
                                           lag(Individual, 3)),
                       Lat_4 == 4 ~ paste0(lag(Individual, 1),
                                           lag(Individual, 2),
                                           lag(Individual, 3),
                                           lag(Individual, 4))),
    Infl_5 = case_when(is.na(Lat_5) ~ "Y",
                       Lat_5 == 0 ~ "Z",
                       Lat_5 == 1 ~ paste0(lag(Individual, 1)),
                       Lat_5 == 2 ~ paste0(lag(Individual, 1),
                                           lag(Individual, 2)),
                       Lat_5 == 3 ~ paste0(lag(Individual, 1),
                                           lag(Individual, 2),
                                           lag(Individual, 3)),
                       Lat_5 == 4 ~ paste0(lag(Individual, 1),
                                           lag(Individual, 2),
                                           lag(Individual, 3),
                                           lag(Individual, 4))),
    Infl_6 = case_when(is.na(Lat_6) ~ "Y",
                       Lat_6 == 0 ~ "Z",
                       Lat_6 == 1 ~ paste0(lag(Individual, 1)),
                       Lat_6 == 2 ~ paste0(lag(Individual, 1),
                                           lag(Individual, 2)),
                       Lat_6 == 3 ~ paste0(lag(Individual, 1),
                                           lag(Individual, 2),
                                           lag(Individual, 3)),
                       Lat_6 == 4 ~ paste0(lag(Individual, 1),
                                           lag(Individual, 2),
                                           lag(Individual, 3),
                                           lag(Individual, 4))),
    Infl_7 = case_when(is.na(Lat_7) ~ "Y",
                       Lat_7 == 0 ~ "Z",
                       Lat_7 == 1 ~ paste0(lag(Individual, 1)),
                       Lat_7 == 2 ~ paste0(lag(Individual, 1),
                                           lag(Individual, 2)),
                       Lat_7 == 3 ~ paste0(lag(Individual, 1),
                                           lag(Individual, 2),
                                           lag(Individual, 3)),
                       Lat_7 == 4 ~ paste0(lag(Individual, 1),
                                           lag(Individual, 2),
                                           lag(Individual, 3),
                                           lag(Individual, 4))),
    .after = Individual)

优化方案 #

核心优化点 #

1. 批量处理列，消除重复逻辑：用across函数一次性处理所有Lat_*列，自动生成对应的Infl_*列，无需重复编写7次相同的case_when逻辑。
2. 通用化历史个体提取：通过行号定位+批量拼接的方式，替代原代码中手动枚举lag(1)到lag(4)的写法，支持任意正整数的Lat值，避免遗漏边界情况。

优化后代码 #

library(tidyverse)

# 示例数据集（修正原代码符号问题）
LD_SO <- data.frame(Group = "Gr02",
                    Individual = c("B", "A", "B", "B", "A", "A", "C", "A", "B", "C", "A", "A", "C", "A", "A", "A", "B", "C"),
                    Event_type = "Behaviour1",
                    Start_cor = c(2.25, 2.8, 5.9, 6.1, 30.56, 33.45, 34.12, 35.49, 49.78, 54.89, 55.12, 59.24, 136.45, 137, 138.49, 140.21, 141.73, 200.24),
                    Lat_1 = c(0L, 1L, 0L, 1L, 0L, 0L, 1L, 0L, 0L, 0L, 1L, 0L, 0L, 1L, 0L, 0L, 0L, 0L),
                    Lat_2 = c(0L, 1L, 0L, 1L, 0L, 0L, 1L, 1L, 0L, 0L, 1L, 0L, 0L, 0L, 1L, 1L, 1L, 0L),
                    Lat_3 = c(NA, NA, 0L, 1L, 0L, 1L, 1L, 2L, 0L, 0L, 1L, 0L, 0L, 0L, 2L, 1L, 1L, 0L),
                    Lat_4 = c(NA, NA, 2L, 3L, 0L, 1L, 2L, 2L, 0L, 0L, 1L, 0L, 0L, 0L, 2L, 3L, 2L, 0L),
                    Lat_5 = c(NA, NA, 2L, 3L, 0L, 1L, 2L, 3L, 0L, 0L, 1L, 2L, 0L, 0L, 2L, 3L, 3L, 0L),
                    Lat_6 = c(NA, NA, NA, 3L, 0L, 1L, 2L, 3L, 0L, 1L, 2L, 2L, 0L, 0L, 2L, 3L, 4L, 0L),
                    Lat_7 = c(NA, NA, NA, NA, 0L, 1L, 2L, 3L, 0L, 1L, 2L, 2L, 0L, 0L, 2L, 3L, 4L, 0L))

# 优化后的处理逻辑
LD_SO_step1 <- LD_SO %>%
  rowwise() %>%
  mutate(
    # 批量处理所有Lat列，生成对应的Infl列
    across(Lat_1:Lat_7,
           ~case_when(
             is.na(.) ~ "Y",
             . == 0 ~ "Z",
             TRUE ~ paste(rev(head(Individual, cur_row() - 1), n = .), collapse = "")
           ),
           .names = "Infl_{str_remove(.col, 'Lat_')}")
  ) %>%
  ungroup() %>%
  # 将生成的Infl列移到Individual之后，与原代码位置一致
  relocate(starts_with("Infl_"), .after = Individual)

代码解释 #

• across(Lat_1:Lat_7, ...)：遍历所有延迟列，对每列执行相同的处理逻辑，通过.names参数自动生成Infl_1到Infl_7的列名。
• cur_row()：获取当前行号，head(Individual, cur_row() - 1)提取当前行之前的所有个体标识。
• rev(..., n = .)：反转前序个体列表后取前n个，保证与原代码中lag(1)（最近的前一个行为）的顺序一致。
• paste(..., collapse = "")：将多个个体标识拼接成单个字符串，替代原代码中手动拼接的重复写法。

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