基于日期比例限制的自定义ifelse逻辑实现求助（R语言）

需求说明 #

按区域分组，对每个区域内按日期排序的response值应用规则：

• 若当前日期的response值较前一个保留值高出10%及以上，或低于10%及以上，则保留前一个值
• 否则使用当前日期的新值

（注：根据预期输出补充了低于阈值的判断逻辑，原描述仅提及“高出10%”，但实际需覆盖该场景以匹配结果）

完整代码实现 #

# 加载所需包
library(dplyr)
library(lubridate)
library(purrr) # 提供accumulate累积计算函数

# 构建模拟数据集
area <- c("A","A","A","B","B","B","C","C","C")
dates <- c("05-01-2024","10-01-2024","18-01-2024",
           "05-01-2024","10-01-2024","18-01-2024","05-01-2024",
           "10-01-2024","18-01-2024")
response <- c(63,68,82,77,71,60,79,75,73)
my.ds <- data.frame(area=area,dates=dates,response=response)

# 配置阈值参数并转换日期格式
max.prop <- 0.1
my.ds$dates <- lubridate::dmy(my.ds$dates)

# 应用自定义逻辑生成新数据集
my.ds.new <- my.ds %>%
  # 按区域+日期排序，确保比较顺序正确
  arrange(area, dates) %>%
  # 按区域分组独立处理
  group_by(area) %>%
  # 使用accumulate实现累积判断：每个值依赖前一个修正后的结果
  mutate(response = accumulate(response, function(prev_val, curr_val) {
    # 计算±10%的阈值范围
    upper_limit <- prev_val * (1 + max.prop)
    lower_limit <- prev_val * (1 - max.prop)
    
    # 应用规则：超出阈值则保留前值，否则用当前值
    if (curr_val > upper_limit || curr_val < lower_limit) {
      prev_val
    } else {
      curr_val
    }
  })) %>%
  # 取消分组
  ungroup()

# 查看最终结果
print(my.ds.new)

代码关键说明 #

1. arrange(area, dates)：确保每个区域内的记录按日期升序排列，保证相邻日期的比较顺序正确。
2. group_by(area)：按区域隔离数据，避免跨区域的日期和数值干扰。
3. accumulate()：不同于lag()取原始前值，该函数会使用前一个已经修正后的结果进行判断，确保连续多步的规则应用符合预期。
4. 双阈值判断：通过计算前值的±10%阈值范围，覆盖“高出”和“低于”两种超出幅度的场景，匹配预期输出结果。

输出结果 #

运行代码后将得到与预期一致的数据集：

# A tibble: 9 × 3
  area  dates      response
  <chr> <date>        <dbl>
1 A     2024-01-05       63
2 A     2024-01-10       68
3 A     2024-01-18       68
4 B     2024-01-05       77
5 B     2024-01-10       71
6 B     2024-01-18       71
7 C     2024-01-05       79
8 C     2024-01-10       75
9 C     2024-01-18       73

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