R语言基于游程编码按条件替换向量值的简洁base R方案

需求说明 #

持有若干仅包含-1、0、1三类取值的不等长数值向量，其中0占绝大多数，需同时满足以下两个规则，将符合条件的0替换为相邻非零值：

• 规则1：连续出现的0的长度小于3
• 规则2：该段连续0的左右两侧为相同的非零值

示例：序列1,1,1,1,0,1,1中的单个0需替换为1；序列1,1,-1,1,0,-1,-1中的0因两侧非零值不同，保持原值不变。
原有实现分两次执行游程编码，分别处理替换为1、替换为-1的场景，代码冗余，尝试合并逻辑时R抛出报错，需要更优雅紧凑的base R原生实现，无需对数据进行两次迭代处理。

测试数据 #

测试输入向量 #

x <- c(1,0,1,1,1,1,0,0,0,0,0,0,0,0,1,1,1,1,0,-1,0,0,0,0,1,1,0,0,0,1)
y <- c(0,0,-1,0,-1,0,-1,-1,-1,0,0,0,0,0,0,0,0,0,0,0,1,0,0,1,0,0,0,0,1,1,0,1,0,0,0)
z <- c(0,0,0,0,1,0,1,0,1,0,1,0,-1,0,1,0,0,0,0,0,0,0,0,0,0,1,0,-1,0,1,0,-1,0,1,0,0,0,0,0,0,0,0,0)
a <- c(0,0,0,0,0,0,1,1,0,0,0,1,0,0,0,0,0,0,1,1,0,0,0,-1,0,0,0,0,0,0)

预期输出 #

x_desired <- c(1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 0, -1, 0, 0, 0, 0, 1, 1, 0, 0, 0, 1)
y_desired <- c(0, 0, -1, -1, -1, -1, -1, -1, -1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 0, 0, 0, 0, 1, 1, 1, 1, 0, 0, 0)
z_desired <- c(0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 0, -1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, -1, 0, 1, 0, -1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0)
a_desired <- c(0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, -1, 0, 0, 0, 0, 0, 0)

原有冗余实现 #

substitute_plus_and_minus <- function(x){
    
  # create the run length encoding
  mod_rle <- rle(x)
  # create an index of 0s to be changed for 1s
  one_substitute <- mod_rle$lengths <3 &
    mod_rle$values == 0 &
    c(utils::tail(mod_rle$values, -1) == 1, FALSE) &
    c(FALSE, utils::head(mod_rle$values, -1) == 1)
  # set the values to 1
  mod_rle$values[one_substitute] <- 1
  # recreate the original vector
  x <- inverse.rle(mod_rle)
  
  # create the run length encoding
  mod_rle <- rle(x)
  # create an index of 0s to be changed for -1s
  minus_one_substitute <- mod_rle$lengths <3 &
    mod_rle$values == 0 &
    c(utils::tail(mod_rle$values, -1) == -1, FALSE) &
    c(FALSE, utils::head(mod_rle$values, -1) == -1)
  # set the values to -1
  mod_rle$values[minus_one_substitute] <- -1
  # recreate the original vector
  x <- inverse.rle(mod_rle)
  
  return(x)
  
}

单次游程编码优化实现 #

不需要分1、-1两次处理，只需要做1次游程编码，统一判断所有中间位置的0游程是否满足替换条件，直接替换为两侧相同的非零值即可：

substitute_single_pass <- function(x) {
  rx <- rle(x)
  run_len <- length(rx$values)
  # 游程总数小于3时不存在夹在两个非零值中间的0段，直接返回原向量
  if (run_len >= 3) {
    # 预存每个游程左右相邻的取值
    left_vals  <- c(NA, rx$values[-run_len])
    right_vals <- c(rx$values[-1], NA)
    # 定位所有满足替换条件的0游程
    replace_pos <- which(
      rx$values == 0 &
      rx$lengths < 3 &
      !is.na(left_vals) & !is.na(right_vals) &
      left_vals == right_vals &
      left_vals != 0
    )
    # 批量替换为两侧相同的非零值
    rx$values[replace_pos] <- left_vals[replace_pos]
  }
  inverse.rle(rx)
}

效果验证 #

对所有测试用例执行校验，结果完全匹配预期输出：

all(
  identical(substitute_single_pass(x), x_desired),
  identical(substitute_single_pass(y), y_desired),
  identical(substitute_single_pass(z), z_desired),
  identical(substitute_single_pass(a), a_desired)
)
# [1] TRUE

方案优势 #

• 仅执行1次游程编码、1次逆解码，无重复迭代处理
• 逻辑统一，不需要分别针对1、-1写分支判断
• 自动跳过首尾位置的0段（无两侧邻居，不满足替换条件）
• 完全基于base R原生函数，无第三方包依赖

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