根据查询表使用dplyr重新编码矩阵值

问题描述

我有一个矩阵，其中包含许多案例以及问卷的相应答案。下面的精简示例（raw_responses）包含5个人对5个项目的回答。让我们假设这些是多项选择项，每个选项都有4个可能的答案。如果未处理该商品，则该人将收到代码9。

raw_responses <- data.frame('id' = 1:10,'item_1' =  sample(c(1:4,9),10,replace = TRUE),'item_2' =  sample(c(1:4,'item_3' =  sample(c(1:4,'item_4' =  sample(c(1:4,'item_5' =  sample(c(1:4,replace = TRUE))

正确答案存储在一个单独的表中，该表反映了整个测试设计。再次在下面是一个大大简化的变体（设计），仅包含商品名称和相应的正确答案。

design <- data.frame('item' = c('item_1','item_2','item_3','item_4','item_5'),'key' = sample(1:4,5,replace = TRUE))

最后，目标是一个带有评分答案的表格。正确的答案编码为1，错误的答案编码为0，“空”答案编码为99。例如，下面的for循环就可以使用。

scored_responses <- raw_responses
for(item in colnames(raw_responses)[2:6]) {
  scored_responses[,item] <- ifelse(scored_responses[,item] == design[design$item == item,'key'],1,ifelse(scored_responses[,item] == 9,99,0))
}

但是，我想知道这是否可以与dplyr（包括case_when）和更可能使用purr的更有效的变体一起使用。特别是因为可以通过更长的dplyr-pipe清理非常广泛的答案表，因此如果可以在其中建立计分功能将是一个优势。

在此先感谢您的所有想法和提示。

解决方法

以长格式获取数据，进行联接，重新编码值并以宽格式获取数据。

library(dplyr)
library(tidyr)

raw_responses %>%
  pivot_longer(cols = -id,names_to = 'item') %>%
  left_join(design,by = 'item') %>%
  mutate(value = case_when(value == 9 ~ 99,value == key ~ 1,TRUE ~ 0)) %>%
  select(-key) %>%
  pivot_wider(names_from = 'item')

# A tibble: 10 x 6
#      id item_1 item_2 item_3 item_4 item_5
#   <int>  <dbl>  <dbl>  <dbl>  <dbl>  <dbl>
# 1     1     99     99      1      0      0
# 2     2     99     99     99      0      0
# 3     3      1     99      0     99     99
# 4     4      0      1      1     99      1
# 5     5     99      0      1      0      1
# 6     6      0      1      0      0      1
# 7     7      0      0      0      1     99
# 8     8      1     99      0      0      0
# 9     9      0     99     99      0      1
#10    10     99      1     99      1      0

另一种不将数据转换为宽格式的方法是使用map2_dfc中的purrr：

library(purrr)
map2_dfc(raw_responses[-1],design$key,~case_when(.x == 9 ~ 99,.x == .y ~ 1,TRUE ~ 0))

但是，要使此答案有效，我们需要确保raw_responses和design$item中的列名具有相同的顺序。在此示例中，它们已经按照相同的顺序排列，但是在实际数据中，如果不是这样，我们可以通过执行以下操作来实现：

raw_responses[-1] <- raw_responses[-1][design$key]

dplyr r r recode