R中字符串/字符数据的逻辑运算答案

【问题标题】：Logic operations with string/character data in RR中字符串/字符数据的逻辑运算
【发布时间】：2021-11-28 17:19:22
【问题描述】：

我想在我在 R 中运行的一个实验中评分。在这个实验中，受试者被问到多项选择题，其中有一个正确答案。他们的回答被保存为 .csv 中的口头数据。这是数据的头部。第一行代表正确答案：

    data <- structure(list(PRE_TR.1 = c(1L, 1L, 1L), PRE_TR.2 = c("B", "{\"WQ2\":\"<strong>B.</strong> You should go to the large office.\"}", 
                                                              "{\"WQ2\":\"<strong>B.</strong> You should go to the large office.\"}"
), PRE_TR.3 = c("A", "{\"WQ3\":\"<strong>A. </strong> The number of days on which mean heights were over 71 inches would be greater for the small post office than for the large post office.\"}", 
                "{\"WQ3\":\"<strong>D.</strong> There is no basis for predicting which post office would have the greater number of days on which mean heights were over 71 inches.\"}"
), PRE_TR.4 = c("B", "{\"WQ4\":\"<strong>B.</strong> The large street\"}", 
                "{\"WQ4\":\"<strong>B.</strong> The large street\"}"), PRE_RULE_LLN = c("A", 
                                                                                        "{\"R2\":\"<strong>A. </strong> As the sample size increases, its mean will tend to be closer to that of the population\"}", 
                                                                                        "{\"R2\":\"<strong>A. </strong> As the sample size increases, its mean will tend to be closer to that of the population\"}"
                ), PRE_IS.1 = c(0L, 2L, 2L), PRE_IS.2 = c(3L, 3L, 3L), PRE_IS.3 = c(0L, 
                                                                                    0L, 3L), PRE_IS.4 = c(3L, 3L, 3L), PRE_IS.5 = c(2L, 2L, 1L), 
PRE_TR.5 = c("C", "{\"WQ1\":\"<strong>A. </strong> a standard deviation equal to 3 inches\"}", 
             "{\"WQ1\":\"<strong>D.</strong> ItÃƒÂ¢Ã¢â\200šÂ¬Ã¢â\200žÂ¢s impossible to predict the value of the standard deviation.\"}"
), PRE_RULE_CLT = c("A", "{\"R1\":\"<strong>A. </strong> As the sample size increases, the distribution of  sample means have a smaller and smaller standard deviation\"}", 
                    "{\"R1\":\"<strong>A. </strong> As the sample size increases, the distribution of  sample means have a smaller and smaller standard deviation\"}"
), PT.1 = c(NA, TRUE, TRUE), PT.2 = c(NA, TRUE, TRUE), PT.3 = c(NA, 
                                                                TRUE, TRUE), PT.4 = c(NA, TRUE, TRUE), PT.5 = c(NA, TRUE, 
                                                                                                                TRUE), PT.6 = c(NA, TRUE, TRUE), PT.7 = c(NA, TRUE, TRUE), 
PT.8 = c(NA, TRUE, TRUE), PT.9 = c(NA, TRUE, TRUE), PT.10 = c(NA, 
                                                              TRUE, FALSE), POST_IS.2 = c(3L, 3L, 0L), POST_IS.3 = c(0L, 
                                                                                                                     0L, 3L), POST_IS.4 = c(3L, 3L, 0L), POST_IS.5 = c(2L, 2L, 
                                                                                                                                                                       0L), POST_IS.1 = c(0L, 0L, 0L), POST_TR.1 = c(1L, 1L, 1L), 
POST_TR.5 = c("C", "{\"WQ1\":\"<strong>A. </strong> a standard deviation equal to 3 inches\"}", 
              "{\"WQ1\":\"<strong>D.</strong> ItÃƒÂ¢Ã¢â\200šÂ¬Ã¢â\200žÂ¢s impossible to predict the value of the standard deviation.\"}"
), POST_TR.2 = c("B", "{\"WQ2\":\"<strong>B.</strong> You should go to the large office.\"}", 
                 "{\"WQ2\":\"<strong>B.</strong> You should go to the large office.\"}"
), POST_TR.3 = c("A", "{\"WQ3\":\"<strong>A. </strong> The number of days on which mean heights were over 71 inches would be greater for the small post office than for the large post office.\"}", 
                 "{\"WQ3\":\"<strong>D.</strong> There is no basis for predicting which post office would have the greater number of days on which mean heights were over 71 inches.\"}"
), POST_TR.4 = c("B", "{\"WQ4\":\"<strong>B.</strong> The large street\"}", 
                 "{\"WQ4\":\"<strong>B.</strong> The large street\"}"), POST_RULE_CLT = c("A", 
                                                                                          "{\"R1\":\"<strong>A. </strong> As the sample size increases, the distribution of  sample means have a smaller and smaller standard deviation\"}", 
                                                                                          "{\"R1\":\"<strong>D.</strong> As the sample size increases, the distribution of sample means have a similar standard deviation to that of the population.\"}"
                 ), POST_RULE_LLN = c("A", "{\"R2\":\"<strong>A. </strong> As the sample size increases, its mean will tend to be closer to that of the population\"}", 
                                      "{\"R2\":\"<strong>A. </strong> As the sample size increases, its mean will tend to be closer to that of the population\"}"
                 ), Exp1 = c("", "{\"Q0\":\"You are drawing a sample that is more like the population in size as well as having more subjects accounts for possibly outliers\"}", 
                             "{\"Q0\":\"\\nif the sample mean increases, will inevitably get closer to the population mean because the sample size is becoming closer to the population size.\"}"
                 ), Exp2 = c("", "{\"Q0\":\"As your sample size increases, the means calculated will be around the population and outliers wonÃ¢â‚¬â„¢t throw off the calculation\"}", 
                             "{\"Q0\":\"\"}"), TIME = c(NA, 508432L, 2180078L)), row.names = c(NA, 
                                                                                               3L), class = "data.frame")

我需要为这些答案打分。评分系统应该是这样工作的：对于所有以“PRE_TR”开头的列，每个参与者（行）应该通过将他们在这些列中的正确答案相加来获得“TOTAL PRE_TR”的分数。然后，他们需要通过对以“PRE_IS”开头的列中的正确答案求和来获得“TOTAL PRE_IS”的分数，依此类推......下面我展示了我想要的示例输出的标题：

output <- structure(list(PRE_TR.1 = c(1L, 1L), PRE_TR.2 = c("B", "{\"WQ2\":\"<strong>B.</strong> You should go to the large office.\"}"
), PRE_TR.3 = c("A", "{\"WQ3\":\"<strong>A. </strong> The number of days on which mean heights were over 71 inches would be greater for the small post office than for the large post office.\"}"
), PRE_TR.4 = c("B", "{\"WQ4\":\"<strong>B.</strong> The large street\"}"
), PRE_RULE_LLN = c("A", "{\"R2\":\"<strong>A. </strong> As the sample size increases, its mean will tend to be closer to that of the population\"}"
), PRE_IS.1 = c(0L, 2L), PRE_IS.2 = c(3L, 3L), PRE_IS.3 = c(0L, 
                                                            0L), PRE_IS.4 = c(3L, 3L), PRE_IS.5 = c(2L, 2L), PRE_TR.5 = c("C", 
                                                                                                                          "{\"WQ1\":\"<strong>A. </strong> a standard deviation equal to 3 inches\"}"
                                                            ), PRE_RULE_CLT = c("A", "{\"R1\":\"<strong>A. </strong> As the sample size increases, the distribution of  sample means have a smaller and smaller standard deviation\"}"
                                                            ), PT.1 = c(NA, TRUE), PT.2 = c(NA, TRUE), PT.3 = c(NA, TRUE), 
PT.4 = c(NA, TRUE), PT.5 = c(NA, TRUE), PT.6 = c(NA, TRUE
), PT.7 = c(NA, TRUE), PT.8 = c(NA, TRUE), PT.9 = c(NA, TRUE
), PT.10 = c(NA, TRUE), POST_IS.2 = c(3L, 3L), POST_IS.3 = c(0L, 
                                                             0L), POST_IS.4 = c(3L, 3L), POST_IS.5 = c(2L, 2L), POST_IS.1 = c(0L, 
                                                                                                                              0L), POST_TR.1 = c(1L, 1L), POST_TR.5 = c("C", "{\"WQ1\":\"<strong>A. </strong> a standard deviation equal to 3 inches\"}"
                                                                                                                              ), POST_TR.2 = c("B", "{\"WQ2\":\"<strong>B.</strong> You should go to the large office.\"}"
                                                                                                                              ), POST_TR.3 = c("A", "{\"WQ3\":\"<strong>A. </strong> The number of days on which mean heights were over 71 inches would be greater for the small post office than for the large post office.\"}"
                                                                                                                              ), POST_TR.4 = c("B", "{\"WQ4\":\"<strong>B.</strong> The large street\"}"
                                                                                                                              ), POST_RULE_CLT = c("A", "{\"R1\":\"<strong>A. </strong> As the sample size increases, the distribution of  sample means have a smaller and smaller standard deviation\"}"
                                                                                                                              ), POST_RULE_LLN = c("A", "{\"R2\":\"<strong>A. </strong> As the sample size increases, its mean will tend to be closer to that of the population\"}"
                                                                                                                              ), Exp1 = c("", "{\"Q0\":\"You are drawing a sample that is more like the population in size as well as having more subjects accounts for possibly outliers\"}"
                                                                                                                              ), Exp2 = c("", "{\"Q0\":\"As your sample size increases, the means calculated will be around the population and outliers wonÃ¢â‚¬â„¢t throw off the calculation\"}"
                                                                                                                              ), TIME = c(NA, 508432L), TOTAL_PRE_TR = c(NA, 4L), TOTAL_PRE_IS = c(NA, 
                                                                                                                                                                                                   4L), TOTAL_PRE_RULE = c(NA, 1L), TOTAL_T = c(NA, 10L), TOTAL_POST_TR = c(NA, 
                                                                                                                                                                                                                                                                            4L), TOTAL_POST_IS = c(NA, 5L), TOTAL_POST_RULE = c(NA, 2L
                                                                                                                                                                                                                                                                            )), row.names = 1:2, class = "data.frame")

如何做到这一点，考虑到口头答案很长，我只想能够在正确的选项中选择一个单词以使其更容易？一种算法，例如“如果 PRE_TR1 列的答案包括“B”，则为分数 TOTAL_PRE_TR 加一分。

【问题讨论】：

我刚刚添加了预期的输出。谢谢！

标签： r string logical-operators

【解决方案1】：

这是我的第一次尝试。这里有改进的余地，但也许它会让你朝着正确的方向前进。这个问题似乎很适合dplyr，我很想看到使用该包的答案。以下是您在 base 中执行此操作的方法：

基本思想是使用grepl() 的模式匹配来检测正确答案。这很简单，因为我们可以使用 apply() 系列将您的响应数据集的每一行与您的正确答案数据集进行比较。

在我看来，具有挑战性的一点是仅在一组答案中对答案进行评分。我在这里使用更多模式匹配来查找唯一组，然后在 for 循环中计算每个组内的分数总和。

这些是您期待的结果吗？

# define dataset of correct answers only
ans <- data[1,]
# define dataset of responses only
data <- data[-1,]

# Get column indices for each group of answers
vars <- unique(gsub(pattern = ".?\\d+", replacement = "", names(data)))
vars
#>  [1] "PRE_TR"        "PRE_RULE_LLN"  "PRE_IS"        "PRE_RULE_CLT" 
#>  [5] "PT"            "POST_IS"       "POST_TR"       "POST_RULE_CLT"
#>  [9] "POST_RULE_LLN" "Ex"            "TIME"
colgroups <- sapply(1:length(vars), FUN = function(x) grep(vars[x], names(data)))

# Detect correct answers
scores <- sapply(1:ncol(data), FUN = function(x) ifelse(grepl(pattern = ans[1,x], x = data[,x]),1,0))
scores
#>      [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12] [,13] [,14]
#> [1,]    1    1    1    1    1    0    1    1    1     1     0     1    NA    NA
#> [2,]    1    1    0    1    1    0    1    0    1     0     0     1    NA    NA
#>      [,15] [,16] [,17] [,18] [,19] [,20] [,21] [,22] [,23] [,24] [,25] [,26]
#> [1,]    NA    NA    NA    NA    NA    NA    NA    NA     1     1     1     1
#> [2,]    NA    NA    NA    NA    NA    NA    NA    NA     0     0     0     0
#>      [,27] [,28] [,29] [,30] [,31] [,32] [,33] [,34] [,35] [,36] [,37]
#> [1,]     1     1     0     1     1     1     1     1     1     1    NA
#> [2,]     1     1     0     1     0     1     1     1     1     1    NA

# Make output dataframe
output <- data.frame(matrix(ncol = length(vars), nrow = nrow(data)))
names(output) <- vars
output
#>   PRE_TR PRE_RULE_LLN PRE_IS PRE_RULE_CLT PT POST_IS POST_TR POST_RULE_CLT
#> 1     NA           NA     NA           NA NA      NA      NA            NA
#> 2     NA           NA     NA           NA NA      NA      NA            NA
#>   POST_RULE_LLN Ex TIME
#> 1            NA NA   NA
#> 2            NA NA   NA

# Sum correct answers one group at a time
scores <- data.frame(scores)
for(i in 1:length(colgroups)){
  # We only need to sum if a group has more than one response
  # Multiple respones per group
  if(length(colgroups[[i]]) > 1){
    output[,vars[i]] <- rowSums(scores[,colgroups[[i]]])
  } else {
    # One response per group
    output[,vars[i]] <- scores[,colgroups[[i]]]
  }
}

output
#>   PRE_TR PRE_RULE_LLN PRE_IS PRE_RULE_CLT PT POST_IS POST_TR POST_RULE_CLT
#> 1      4            1      4            1 NA       5       4             1
#> 2      3            1      2            1 NA       1       3             1
#>   POST_RULE_LLN Ex TIME
#> 1             1  2   NA
#> 2             1  2   NA
Created on 2021-10-08 by the reprex package (v2.0.1)

【讨论】：

感谢您的工作！我尝试从头开始运行代码，但收到错误消息“grepl 错误（pattern = ans[1, x], x = data[, x]) : invalid 'pattern' argument"
我建议逐行运行代码并查看每个结果。我在推测，但听起来您可能没有定义 data.frame ans？
原来我在解决方案数据中将一些列留空。看起来您的代码运行良好！非常感谢您出色的工作和解决方案！
不客气！很高兴它对你有用。祝你好运
嗨@gokgok，如果您认为这是您问题的最佳答案，您介意接受它以便未来的读者可以更好地找到它吗？谢谢！

【解决方案2】：

data 
library(tidyverse)

fNoCharacter = function(x) !is.character(x)

dfCorrect = data %>% as_tibble() %>% slice_head() %>% 
  mutate(PRE_TR.1 = PRE_TR.1 %>% paste0()) %>% 
  mutate_if(fNoCharacter, paste0)

dfAnswers = data %>% as_tibble() %>% slice(2:nrow(.)) %>% 
  mutate(id = 1:nrow(.)) %>% 
  mutate_if(fNoCharacter, paste0)

fGetAnswerPRE_TR = function(x) ifelse(is.na(str_match(x, "(<strong>)(.)")[3]), x, 
                                      str_match(x, "(<strong>)(.)")[3])
fGetAnswerPRE_TR = Vectorize(fGetAnswerPRE_TR)

fCorrect = function(val, start_w) val==dfCorrect %>% 
    pivot_longer(starts_with(start_w)) %>% pull(value)
  
dSumCorrect = function(data, AnsName){
  df1<<-data
  data %>% 
  pivot_longer(starts_with(AnsName)) %>% 
  mutate(Correct = fCorrect(fGetAnswerPRE_TR(value), AnsName)) %>% 
  pull(Correct) %>% sum()
}

dfAnswers %>% group_by(id) %>% 
  nest() %>% 
  mutate(`TOTAL PRE_TR` = map(data, ~dSumCorrect(.x,"PRE_TR")),
         `TOTAL PRE_IS` = map(data, ~dSumCorrect(.x,"PRE_IS")),
         `TOTAL PRE_RULE` = map(data, ~dSumCorrect(.x,"PRE_RULE")),
         `TOTAL PT` = map(data, ~dSumCorrect(.x,"PT")),
         `TOTAL POST_IS` = map(data, ~dSumCorrect(.x,"POST_IS")),
         `TOTAL POST_TR` = map(data, ~dSumCorrect(.x,"POST_TR")),
         `TOTAL POST_RULE` = map(data, ~dSumCorrect(.x,"POST_RULE"))) %>%
  unnest(c(`TOTAL PRE_TR`:`TOTAL POST_RULE`))

输出

# A tibble: 2 x 9
# Groups:   id [2]
  id    data              `TOTAL PRE_TR` `TOTAL PRE_IS` `TOTAL PRE_RULE` `TOTAL PT` `TOTAL POST_IS` `TOTAL POST_TR` `TOTAL POST_RULE`
  <chr> <list>                     <int>          <int>            <int>      <int>           <int>           <int>             <int>
1 1     <tibble [1 x 37]>              4              4                2          0               5               4                 2
2 2     <tibble [1 x 37]>              3              2                2          0               1               3                 1

【讨论】：