R语言时间序列清洗：筛除无效trial并将区间外异常值设为NA

现有问题说明 #

需要完成两项数据处理任务，现有代码运行存在故障：

• 任务1：剔除无效试次。判定规则为：同一ID、同一trial下，phase_bins == "baseline"对应的nosetip值全部为NA时，删除该试次所有数据。原有剔除代码运行异常。
• 任务2：逐时间点计算nosetip相对前一时间点的差值，将差值超出[-0.5, 0.5]区间的当前nosetip值替换为NA。差值计算步骤可正常运行，但替换步骤不生效。

原有无效试次剔除代码：

df_all_UK2  %>%
  group_by(ID, trial) %>% 
  filter(phase_bins == "baseline") %>% 
  mutate(drop = case_when(sum(is.na(nosetip))= 3 ~ TRUE,
                            TRUE ~ FALSE)) %>% 
  select(drop=="FALSE")

原有差值计算与异常值替换代码：

# for the difference it is crucial that stimuli are in right order
df_all_UK2$time <- factor(df_all_UK$time , levels=c("pre_60", "pre_30","pre", "base1" , "base2" ,"stim1" ,"stim2" , "stim3" , "stim4" , "stim5",  "stim6",  "stim7" , "stim8",  "stim9", "stim10" ,"stim11", "stim12" ,"rec1",   "rec2",   "rec3" ,  "rec4"  ,"rec5",   "rec6",   "bre1"  , "bre2" ,  "bre3" ,  "bre4"  , "bre5" ))


# then compute difference
df_all_UK2 <- df_all_UK2  %>%
  group_by(ID, trial) %>% 
  arrange(ID, cond_f, time) %>% 
  mutate(diff=nosetip-lag(nosetip,default=NA, n=1L))

# set values to NA if difference to value before exceeds is not between -0.5 and 0.5
df_all_UK2 %>% 
  mutate(nosetip = case_when(diff < -0.5 ~ NA, 
                             diff > 0.5 ~ NA, 
                             TRUE ~ nosetip))

错误原因梳理 #

1. 无效试次剔除代码存在3处错误：
   • 判断相等使用了赋值符号=，应使用判断符==
   • 提前用filter(phase_bins == "baseline")过滤了非baseline行，会导致后续无法保留试次完整数据
   • 筛选行误用了select函数（select用于选择列，筛选行应使用filter），且筛选逻辑没有按组匹配需要删除的试次
2. 异常值替换代码存在2处错误：
   • 设置time因子时存在笔误：df_all_UK$time应为df_all_UK2$time
   • 替换操作后没有将结果重新赋值给原数据框，修改不会被保存；且未处理第一个时间点diff为NA的边界情况
   • （可选注意）如果需要实现递推清洗（即某点被设为NA后，下一个点的差值要和最近的非NA有效值计算），原代码基于原始值算lag的逻辑不满足需求。

修正后可运行代码 #

1. 无效试次剔除 #

df_all_UK2 <- df_all_UK2 %>%
  group_by(ID, trial) %>%
  # 按组标记是否为需要剔除的无效试次
  mutate(drop = sum(is.na(nosetip[phase_bins == "baseline"])) == 3) %>%
  # 保留有效试次，删除临时标记列
  filter(!drop) %>%
  select(-drop) %>%
  ungroup()

2. 基于原始值的差值计算与异常值替换 #

如果只需要基于原始时序值计算差值、替换超出范围的点，使用以下代码：

# 修正笔误，设置time因子水平保证时序正确
df_all_UK2$time <- factor(df_all_UK2$time , levels=c("pre_60", "pre_30","pre", "base1" , "base2" ,"stim1" ,"stim2" , "stim3" , "stim4" , "stim5",  "stim6",  "stim7" , "stim8",  "stim9", "stim10" ,"stim11", "stim12" ,"rec1",   "rec2",   "rec3" ,  "rec4"  ,"rec5",   "rec6",   "bre1"  , "bre2" ,  "bre3" ,  "bre4"  , "bre5" ))

# 排序、计算差值、替换异常值
df_all_UK2 <- df_all_UK2  %>%
  group_by(ID, trial) %>% 
  arrange(time, .by_group = TRUE) %>% 
  mutate(
    diff = nosetip - lag(nosetip, default = NA, n = 1L),
    nosetip = case_when(
      is.na(diff) ~ nosetip, # 每个试次第一个时间点无前值，保留原始值
      abs(diff) > 0.5 ~ NA_real_, # 差值超出[-0.5,0.5]时设为NA
      TRUE ~ nosetip
    )
  ) %>%
  ungroup()

3. （可选）递推式异常值替换 #

如果需要实现递推清洗：即某点被设为NA后，后续点的差值需要和最近的非NA有效值比较，使用以下代码：

df_all_UK2 <- df_all_UK2 %>%
  group_by(ID, trial) %>%
  arrange(time, .by_group = TRUE) %>%
  mutate(
    nosetip = accumulate(nosetip, .init = NA_real_, function(prev_valid, curr_val){
      # 当前值本身为NA直接返回NA
      if(is.na(curr_val)) return(NA_real_)
      # 是当前组第一个有效值，直接保留
      if(is.na(prev_valid)) return(curr_val)
      # 和上一个有效值的差值超出范围，返回NA
      if(abs(curr_val - prev_valid) > 0.5) return(NA_real_)
      # 差值符合要求，返回当前值作为下一个点的比较基准
      return(curr_val)
    })[-1] # 去掉初始化生成的第一个多余值
  ) %>%
  ungroup()

使用提供的示例数据测试，原始nosetip序列c(29.4, 29.1, 29.6, 29, 29.1, 29.2, 29.3, NA, NA, NA)运行后，第四个值29和前值29.6的差值为-0.6，超出区间，会被正确替换为NA。

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