在R中根据另一数据框替换容差范围内的数值列值

需求 #

给定两个R数据框dat1（示例中的A）和dat2（示例中的B），针对指定或所有数值列，找出两数据框对应位置值的差异在设定容差tol范围内的项，将dat1中的对应值替换为dat2中的值，使两数据框的目标数值列在容差范围内保持一致。

函数定义要求 #

• 函数名：foo
• 参数：
  • dat1：需要修改的目标数据框
  • dat2：提供参考值的对比数据框
  • cols：可选参数，指定要处理的列（支持符号或字符输入），默认处理两个数据框共有的所有数值列
  • tol：容差阈值，当两值绝对差异≤该值时执行替换
• 支持两种调用方式：指定单列/多列，或默认处理所有符合条件的数值列

示例数据 #

# 示例数据框A（dat1）
A <- read.table(header = TRUE, text = "
  task_dif time emmean    SE lower.CL upper.CL
1  complex    1  1.733 0.023 1.686    1.779
2   simple    1  1.734 0.018 1.697    1.770
3  complex    2  1.702 0.025 1.652    1.751
4   simple    2  1.714 0.017 1.680    1.747
5  complex    3  1.757 0.019 1.720    1.794
6   simple    3  1.740 0.027 1.687    1.794
7  complex    4  1.773 0.019 1.735    1.810
8   simple    4  1.764 0.025 1.713    1.814")

# 示例数据框B（dat2）
B <- read.table(header = TRUE, text = "
  order time emmean    SE lower.CL upper.CL
1   c2s    1  1.733 0.023 1.686    1.779
2   s2c    1  1.734 0.018 1.697    1.771
3   c2s    2  1.714 0.017 1.680    1.747
4   s2c    2  1.702 0.025 1.652    1.751
5   c2s    3  1.757 0.019 1.720    1.794
6   s2c    3  1.740 0.027 1.687    1.794
7   c2s    4  1.764 0.025 1.713    1.814
8   s2c    4  1.773 0.019 1.735    1.810")

实现代码 #

foo <- function(dat1, dat2, cols = NULL, tol) {
  # 复制dat1避免修改原数据
  result <- dat1
  
  # 确定要处理的列：如果cols为NULL，取两数据框共有的数值列
  if (is.null(cols)) {
    num_cols_dat1 <- names(dat1)[sapply(dat1, is.numeric)]
    num_cols_dat2 <- names(dat2)[sapply(dat2, is.numeric)]
    target_cols <- intersect(num_cols_dat1, num_cols_dat2)
  } else {
    # 将cols转换为字符（支持符号输入）
    target_cols <- as.character(substitute(cols))
    # 检查列是否存在且为数值型
    valid_cols <- target_cols[target_cols %in% names(dat1) & target_cols %in% names(dat2) & 
                                sapply(dat1[target_cols], is.numeric) & sapply(dat2[target_cols], is.numeric)]
    if (length(valid_cols) == 0) {
      warning("指定的列不存在或非数值型，将不执行任何替换")
      return(result)
    }
    target_cols <- valid_cols
  }
  
  # 遍历目标列执行替换
  for (col in target_cols) {
    diffs <- abs(result[[col]] - dat2[[col]])
    result[[col]][diffs <= tol] <- dat2[[col]][diffs <= tol]
  }
  
  return(result)
}

调用示例 #

# 方式1：指定处理upper.CL列
A_modified1 <- foo(dat1 = A, dat2 = B, cols = upper.CL, tol = 0.002)
# 查看修改后的upper.CL列第2行，已替换为1.771
A_modified1$upper.CL[2]

# 方式2：默认处理所有共有的数值列
A_modified2 <- foo(dat1 = A, dat2 = B, tol = 0.002)

期望结果 #

修改后的A数据框中，upper.CL列第2行的值从1.770替换为B中的1.771，其余符合容差条件的值也会被对应替换，最终目标数值列在容差范围内与B保持一致。

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