如何为R语言数据框开发相对百分比差异(RPD)函数？

步骤1：加载数据 #

首先用你提供的dput代码重建数据框：

QCandResults <- structure(list(anl_short = c("Water Temp               ", "Water Temp               ", 
"Water Temp               ", "Water Temp               ", "Water Temp               ", 
"Water Temp               "), Sample_Num = c(202309111300030, 
2.02308301e+14, 202308091000030, 202308221000020, 202308031100110, 
202308301000060), QC_SAMPLE = c(202309111341030, 202308301041000, 
202308091041030, 202308221041020, 202308031141110, 202308301041060
), Loc_ID = c("GRR20001", "CFK20001", "CCK20001", "CRR20001", 
"BVR20001", "CFK20001"), Units_QC = c("deg C", "deg C", "deg C", 
"deg C", "deg C", "deg C"), Value_QC = c(19.26, 27.01, 17.19, 
26.39, 8.51, 11.6), Text_Value_QC = c("19.26", "27.01", "17.19", 
"26.39", "8.51", "11.6"), QC_Type = c("DUP", "DUP", "DUP", "DUP", 
"DUP", "DUP"), Units_Results = c("deg C", "deg C", "deg C", "deg C", 
"deg C", "deg C"), Value_Results = c(19.39, 26.95, 17.28, 26.3, 
8.53, 11.53), Text_Value_Results = c("19.39", "26.95", "17.28", 
"26.3", "8.53", "11.53")), row.names = c(1L, 3L, 5L, 7L, 9L, 
11L), class = "data.frame")

步骤2：处理NA值 #

将Value_QC和Value_Results中的NA替换为0，提供两种实现方式：

方法一：用dplyr（代码更直观） #

先安装并加载dplyr包：

install.packages("dplyr")
library(dplyr)

替换NA值：

QCandResults_clean <- QCandResults %>%
  mutate(
    Value_QC = replace_na(Value_QC, 0),  # 把Value_QC的NA替换为0
    Value_Results = replace_na(Value_Results, 0)  # 把Value_Results的NA替换为0
  )

方法二：用基础R（无需额外包） #

QCandResults$Value_QC[is.na(QCandResults$Value_QC)] <- 0
QCandResults$Value_Results[is.na(QCandResults$Value_Results)] <- 0

步骤3：计算相对百分比差异(RPD) #

RPD标准计算公式：

RPD = (|QC值 - 结果值| / ((QC值 + 结果值)/2)) × 100

注意：若QC值和结果值均为0，分母会为0，此时将RPD设为0避免报错。

dplyr版本计算 #

QCandResults_clean <- QCandResults_clean %>%
  mutate(
    RPD = ifelse(
      (Value_QC + Value_Results) == 0,  # 判断是否分母为0
      0,  # 分母为0时RPD设为0
      (abs(Value_QC - Value_Results) / ((Value_QC + Value_Results)/2)) * 100  # 正常计算RPD
    )
  )

基础R版本计算 #

QCandResults$RPD <- ifelse(
  (QCandResults$Value_QC + QCandResults$Value_Results) == 0,
  0,
  (abs(QCandResults$Value_QC - QCandResults$Value_Results) / 
     ((QCandResults$Value_QC + QCandResults$Value_Results)/2)) * 100
)

步骤4：封装为可复用函数 #

把上述步骤打包成函数，方便重复调用：

dplyr版本函数 #

calculate_RPD <- function(df) {
  # 自动安装加载dplyr
  if (!require(dplyr)) {
    install.packages("dplyr")
    library(dplyr)
  }
  
  # 处理NA并计算RPD
  df_processed <- df %>%
    mutate(
      Value_QC = replace_na(Value_QC, 0),
      Value_Results = replace_na(Value_Results, 0)
    ) %>%
    mutate(
      RPD = ifelse(
        (Value_QC + Value_Results) == 0,
        0,
        (abs(Value_QC - Value_Results) / ((Value_QC + Value_Results)/2)) * 100
      )
    )
  
  return(df_processed)
}

# 调用函数
QCandResults_with_RPD <- calculate_RPD(QCandResults)

基础R版本函数 #

calculate_RPD_base <- function(df) {
  # 替换NA为0
  df$Value_QC[is.na(df$Value_QC)] <- 0
  df$Value_Results[is.na(df$Value_Results)] <- 0
  
  # 计算RPD
  df$RPD <- ifelse(
    (df$Value_QC + df$Value_Results) == 0,
    0,
    (abs(df$Value_QC - df$Value_Results) / 
       ((df$Value_QC + df$Value_Results)/2)) * 100
  )
  
  return(df)
}

# 调用函数
QCandResults_with_RPD <- calculate_RPD_base(QCandResults)

查看结果 #

运行函数后，QCandResults_with_RPD会新增RPD列，包含每行的计算结果。例如你提供的样本数据第一行的RPD约为0.67%。

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