如何将自定义R函数ehp30_sexual应用于数据框的每行？

问题背景 #

现有EHP30问卷性维度的5项回答数据，评分规则如下：

• 评分范围为0-4，-9代表不相关
• 总分计算规则：
  1. 若存在缺失值（NA），整体输出缺失值
  2. 若所有项均为-9，输出缺失值
  3. 若存在部分-9，忽略这些项，将剩余得分求和后缩放至100分（公式：sum(有效得分) * 100 / (4 * 有效项数)）
  4. 无缺失和-9时，直接求和缩放至100分

已编写自定义函数ehp30_sexual，需将其应用到包含10条数据的data数据框每一行，优先使用mutate实现。

原始数据生成代码：

ans <- c(NA, -9, 0, 1, 2, 3, 4)
set.seed(1)
data <- data.frame(id = 1:10,
                   ePainAfterSex = sample(ans, 10, TRUE),
                   eWorriedSex = sample(ans, 10, TRUE),
                   eAvoidSex = sample(ans, 10, TRUE),
                   eGuiltyNoSex = sample(ans, 10, TRUE),
                   eFrustratedNoSex = sample(ans, 10, TRUE))

自定义函数：

ehp30_sexual <- function(scores = c(0, 0, 0, 0, 0)){
  if(anyNA(scores)){
    return(NA)
  } else if(!all(scores %in% c(-9, 0, 1, 2, 3, 4))){
    stop("Values not in correct range (-9, 0, 1, 2, 3, 4)")
  } else if(length(scores) != 5){
    stop("Must be vector length of 5")
  } else if(all(scores == -9)){
    return(NA)
  } else if(any(scores == -9)){
    newscores <- scores[which(scores != -9)]
    sum(newscores) * 100 / (4 * length(newscores))
  } else {
    sum(scores) * 100 / (4 * length(scores))
  }
}

实现方法 #

方法1：dplyr::rowwise() + 自定义函数 #

这是最直观的方式，逐行处理并调用已有函数：

library(dplyr)

data <- data %>%
  rowwise() %>%
  mutate(ehp_sexual_score = ehp30_sexual(c(ePainAfterSex, eWorriedSex, eAvoidSex, eGuiltyNoSex, eFrustratedNoSex))) %>%
  ungroup()

• 注意调用ungroup()取消行分组，避免后续操作受影响
• 若数据量极大，rowwise()效率会偏低，可选用方法3

方法2：使用apply()函数 #

直接对数据框的行应用函数，需排除id列：

data$ehp_sexual_score <- apply(data[, -1], 1, ehp30_sexual)

• 优点：无需加载dplyr，代码简洁
• 缺点：若数据框列顺序变化（比如新增列），需手动调整索引

方法3：改写函数为向量式操作（高效版） #

针对大数据量优化，避免逐行处理，用dplyr的向量操作实现：

library(dplyr)

data <- data %>%
  mutate(
    # 标记是否有NA
    has_na = if_any(starts_with("e"), is.na),
    # 统计-9的数量
    cnt_minus9 = rowSums(across(starts_with("e"), ~ .x == -9)),
    # 有效得分求和
    sum_valid = rowSums(across(starts_with("e"), ~ ifelse(.x == -9, 0, .x)), na.rm = FALSE),
    # 有效项数
    cnt_valid = 5 - cnt_minus9,
    # 计算得分
    ehp_sexual_score = case_when(
      has_na ~ NA_real_,
      cnt_minus9 == 5 ~ NA_real_,
      TRUE ~ sum_valid * 100 / (4 * cnt_valid)
    )
  ) %>%
  select(-has_na, -cnt_minus9, -sum_valid, -cnt_valid) # 移除中间变量

• 优点：向量式操作，处理大数据集速度远快于rowwise()
• 用starts_with("e")匹配问卷列，无需硬编码列名，扩展性更好

方法4：纯case_when实现（无需自定义函数） #

直接把所有逻辑写入mutate，适合不想维护自定义函数的场景：

library(dplyr)

data <- data %>%
  rowwise() %>%
  mutate(
    scores = c(ePainAfterSex, eWorriedSex, eAvoidSex, eGuiltyNoSex, eFrustratedNoSex),
    ehp_sexual_score = case_when(
      anyNA(scores) ~ NA_real_,
      all(scores == -9) ~ NA_real_,
      any(scores == -9) ~ sum(scores[scores != -9]) * 100 / (4 * sum(scores != -9)),
      TRUE ~ sum(scores) * 100 / 20
    )
  ) %>%
  ungroup() %>%
  select(-scores)

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