自动化创建多组特定模式气温指标变量的高效实现咨询

需求背景 #

需要基于气温数据生成18组指标变量，参数组合如下：

• 气温变量：tmax（最高温）、tmean（平均温）
• 分位数阈值：90、95、98分位数
• 连续天数要求：1、2、3天
  变量命名格式为[气温变量]_p[分位数]_l[连续天数]（例如tmax_p90_l1、tmean_p98_l3），需避免重复复制代码的冗余写法。

实现步骤 #

1. 预处理：标记暖季时段

这部分为通用逻辑，先统一处理暖季标记：

library(dplyr)
library(purrr)

# 若未定义fcumsum，可使用此替代函数
fcumsum <- function(x, g, na.rm = FALSE) {
  if (na.rm) x[is.na(x)] <- 0
  ave(x, g, FUN = cumsum)
}

# 暖季标记与分组周期计算
temp <- temp %>%
  mutate(
    warm = if_else(month < 3 | month > 8, 1, 0),
    per_warm = case_when(
      warm == 0 ~ 0,
      warm == 1 & month < 3 ~ year - 1991,
      warm == 1 & month >= 9 ~ year - 1990
    )
  ) %>%
  arrange(comuna, year, month, day)

2. 生成参数组合网格

用crossing生成所有参数的笛卡尔积，确保覆盖所有18种组合：

# 定义所有参数组合
param_grid <- crossing(
  temp_var = c("tmax", "tmean"),
  pct = c(90, 95, 98),
  consec_days = c(1, 2, 3)
) %>%
  mutate(
    quant_val = pct / 100,
    var_prefix = paste(temp_var, paste0("p", pct), paste0("l", consec_days), sep = "_")
  )

3. 封装单参数处理函数

将单个参数组合的计算逻辑封装为函数，利用非标准评估动态生成变量名：

process_single_param <- function(temp_data, temp_var, pct, quant_val, var_prefix, consec_days) {
  temp_data %>%
    # 按暖季周期+地区计算分位数阈值
    group_by(per_warm, comuna) %>%
    mutate(!!paste0("p", pct) := round(as.numeric(quantile(.data[[temp_var]], quant_val, na.rm = TRUE)), 1)) %>%
    ungroup() %>%
    # 标记单日超标
    mutate(
      !!paste0("hd", pct) := if_else(.data[[temp_var]] > .data[[paste0("p", pct)]], 1, 0),
      !!paste0("cd", pct) := .data[[paste0("hd", pct)]]
    ) %>%
    # 计算连续超标天数
    group_by(comuna) %>%
    mutate(
      !!paste0("cd", pct) := fcumsum(x = .data[[paste0("hd", pct)]], g = fcumsum(!.data[[paste0("hd", pct)]]), na.rm = TRUE),
      !!paste0("cd", pct) := if_else(warm == 0, 0, .data[[paste0("cd", pct)]]),
      !!paste0("hd", pct) := if_else(warm == 0, 0, .data[[paste0("hd", pct)]])
    ) %>%
    ungroup() %>%
    # 生成最终指标：过去5天内（含当天）是否出现达标连续天数
    group_by(comuna) %>%
    mutate(
      !!var_prefix := case_when(
        .data[[paste0("cd", pct)]] >= consec_days ~ 1,
        lag(.data[[paste0("cd", pct)]], 1, default = 0) >= consec_days ~ 1,
        lag(.data[[paste0("cd", pct)]], 2, default = 0) >= consec_days ~ 1,
        lag(.data[[paste0("cd", pct)]], 3, default = 0) >= consec_days ~ 1,
        lag(.data[[paste0("cd", pct)]], 4, default = 0) >= consec_days ~ 1,
        TRUE ~ 0
      )
    ) %>%
    ungroup() %>%
    # 清理中间变量（可选，若需保留可删除此行）
    select(-all_of(c(paste0("p", pct), paste0("hd", pct), paste0("cd", pct))))
}

4. 批量处理所有参数组合

用pmap遍历参数网格，批量生成所有指标：

# 批量处理并合并结果
result_temp <- param_grid %>%
  pmap_dfr(function(temp_var, pct, consec_days, quant_val, var_prefix) {
    process_single_param(temp, temp_var, pct, quant_val, var_prefix, consec_days)
  }) %>%
  # 按主键合并所有结果（避免重复列）
  reduce(full_join, by = c("comuna", "year", "month", "day", "warm", "per_warm"))

关键技巧说明 #

• 非标准评估：使用!!（注入变量名）和.data[[ ]]（动态引用列）实现变量名的动态生成，避免硬编码。
• 参数网格：crossing自动生成所有参数组合，确保无遗漏且易于扩展。
• 函数封装：将重复逻辑封装为函数，提高代码可读性和可维护性，修改逻辑只需调整函数内部。
• 批量处理：结合purrr的pmap实现批量迭代，替代手动复制粘贴代码。

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