在R语言中对认知问卷的逗号分隔字符串进行正确字母计分

需求说明 #

• 处理存储在data.frame中的认知问卷答题数据，受试者需输入5个3字母单词
• 正确单词为elk、mop、bat、toe、spy，需按字母位置（第1、2、3位）统计正确字母的数量，生成0-15分的总分
• 单词输入顺序不影响计分

现有问题 #

• 原代码中，第2位目标字母的重复值o会被重复计数（toe和mop的第2位都是o，原代码会计2分，但实际应只计1分）
• 代码冗余度高，重复编写多列的处理逻辑

数据示例 #

dput(head(WRRsp, 10))

structure(list(Subject = c(100101, 100108, 100110, 100114, 100119, 
100123, 100133, 100148, 100155, 100159), WRRsp = c("Elk,Mop,Bat,Sop,Car", 
"Ely,Mop,Bat,Toe,Spy", "Bat,Mop,Spy,Elk,Top", "Spy,Bad,Toe", 
"Elk,Mop,Toe", "Eelk,Spy", "Elk,Toe,Mop,Box,Car", "Mope,Eik", 
"Ee,Elk,Mop,Bat,Fox", "E,L,K,Mop,Spy")), row.names = c(NA, -10L
), class = c("tbl_df", "tbl", "data.frame"))

原冗余代码 #

target1 <- c("e", "m", "b", "t", "s")
target2 <- c("l", "o", "a", "o", "p")
target3 <- c("k", "p", "t", "e", "y")

wrrsp_score <- WRRsp %>%
  separate_wider_delim(
    "WRRsp",
    delim = ",",
    names = c("w1", "w2", "w3", "w4", "w5"),
    too_few = "align_start"
  ) %>%
  mutate(
    col1 = paste(
      str_sub(w1, 1, 1),
      str_sub(w2, 1, 1),
      str_sub(w3, 1, 1),
      str_sub(w4, 1, 1),
      str_sub(w5, 1, 1)
    ),
    col1 = str_remove_all(col1, "NA"),
    # this stuff isn't really necessary
    col1 = str_trim(col1),
    col1 = tolower(col1),
    
    col2 = paste(
      str_sub(w1, 2, 2),
      str_sub(w2, 2, 2),
      str_sub(w3, 2, 2),
      str_sub(w4, 2, 2),
      str_sub(w5, 2, 2)
    ),
    col2 = str_remove_all(col2, "NA"),
    col2 = str_trim(col2),
    col2 = tolower(col2),
    
    col3 = paste(
      str_sub(w1, 3, 3),
      str_sub(w2, 3, 3),
      str_sub(w3, 3, 3),
      str_sub(w4, 3, 3),
      str_sub(w5, 3, 3)
    ),
    col3 = str_remove_all(col3, "NA"),
    col3 = str_trim(col3),
    col3 = tolower(col3)
  ) %>%
  mutate(
    col1_e = ifelse(grepl(target1[1], col1), 1, 0),
    col1_m = ifelse(grepl(target1[2], col1), 1, 0),
    col1_b = ifelse(grepl(target1[3], col1), 1, 0),
    col1_t = ifelse(grepl(target1[4], col1), 1, 0),
    col1_s = ifelse(grepl(target1[5], col1), 1, 0),
    col1_score = rowSums(pick(col1_e:col1_s), na.rm = TRUE),
    
    col2_l  = ifelse(grepl(target2[1], col2), 1, 0),
    col2_o  = ifelse(grepl(target2[2], col2), 1, 0),
    col2_a  = ifelse(grepl(target2[3], col2), 1, 0),
    col2_o2 = ifelse(grepl(target2[4], col2), 1, 0),
    col2_s  = ifelse(grepl(target2[5], col2), 1, 0),
    col2_score = rowSums(pick(col2_l:col2_s), na.rm = TRUE),
    
    col3_k = ifelse(grepl(target3[1], col3), 1, 0),
    col3_p = ifelse(grepl(target3[2], col3), 1, 0),
    col3_t = ifelse(grepl(target3[3], col3), 1, 0),
    col3_e = ifelse(grepl(target3[4], col3), 1, 0),
    col3_y = ifelse(grepl(target3[5], col3), 1, 0),
    col3_score = rowSums(pick(col3_k:col3_y), na.rm = TRUE)
  ) %>%
  mutate(WRRspPerCharAC = rowSums(pick(ends_with("_score")), na.rm = TRUE))

优化后的代码 #

library(tidyverse)

# 从正确单词生成各位置的目标字母集合（自动去重，避免重复计数）
target_words <- c("elk", "mop", "bat", "toe", "spy")
target_chars <- target_words %>%
  map_dfr(~tibble(
    pos1 = str_sub(.x, 1, 1),
    pos2 = str_sub(.x, 2, 2),
    pos3 = str_sub(.x, 3, 3)
  )) %>%
  summarise(across(everything(), ~unique(tolower(.x))))

WRRsp_score <- WRRsp %>%
  mutate(
    # 拆分答案为单词列表并转小写
    words = str_split(tolower(WRRsp), ","),
    # 提取每个单词的三个位置字母，不足三位的自动补NA
    char_pos = map(words, ~map_dfr(.x, ~tibble(
      pos1 = str_sub(.x, 1, 1),
      pos2 = str_sub(.x, 2, 2),
      pos3 = str_sub(.x, 3, 3)
    ))),
    # 统计每个位置匹配的目标字母数量（去重后匹配，避免重复计分）
    pos1_score = map_int(char_pos, ~sum(unique(.x$pos1) %in% target_chars$pos1)),
    pos2_score = map_int(char_pos, ~sum(unique(.x$pos2) %in% target_chars$pos2)),
    pos3_score = map_int(char_pos, ~sum(unique(.x$pos3) %in% target_chars$pos3)),
    # 计算总分
    WRRspPerCharAC = pos1_score + pos2_score + pos3_score
  ) %>%
  # 保留核心列，可根据需求调整
  select(Subject, WRRsp, WRRspPerCharAC)

优化说明 #

1. 解决重复计数问题：从正确单词直接生成目标字母集合时，通过unique()自动去重，确保同一位置的重复字母只计一次
2. 简化代码结构：使用map系列函数批量处理每个受试者的答案，避免重复编写多列的提取和统计逻辑
3. 逻辑清晰连贯：从拆分单词、提取字母位置到统计匹配数，步骤统一，易于维护和修改

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