R 在向量化函数中调用向量化函数

我正在为一系列跨电池的认知测试编写评分代码。在下面的示例中，我有一个名为SHAPES_v1的虚拟测试，但在我的应用程序中，有许多不同版本的不同测试。我正在尝试使用sapply（）和vectorize（）对函数进行矢量化，但输出（

scored\u battery\u 1

）与我试图实现的目标不匹配（

所需的输出

）。当我对一个示例项在每个函数中运行单独的调用时，一切都正常，所以我很确定我的矢量化失败了。我已经实现了Vectorize（），sapply（）被注释掉了。Vectorize（）方法包含正确的输出，但仍然具有初始变量，并且是嵌套列表而不是数据帧。知道我做错了什么吗

library('dplyr')

battery_1 <- data.frame(PID=paste0('PID', 1:5), SHAPES_v1_QID1_RESP=c(rep(4, 3),
  rep(2, 2)), SHAPES_v1_QID2_RESP=c(rep(2, 3), rep(3, 2)),
  LETTERS_v1_QID1_RESP=c(rep(5, 3), rep(2, 2)),
  LETTERS_v1_QID2_RESP=c(rep(5, 1), rep(6, 4)))

SHAPES_v1 <- data.frame(QID=1:2, CorrectResponse=c(4, 3))

LETTERS_v1 <- data.frame(QID=1:2, CorrectResponse=c(5, 6))

########### Simplify names
simpNames <- function(i, varnames) {
  return(paste(varnames[[i]][1], varnames[[i]][2], sep='_'))
}
simpNames <- Vectorize(simpNames, vectorize.args='i', SIMPLIFY=TRUE)

########### Score a specific item
scoreItem <- function(battery, answers, item, num) {
  corrItem <- gsub('RESP', 'CORR', item)
  ans <- answers[answers$QID == num, 'CorrectResponse']
  battery <- battery %>% mutate_at( .funs = funs(ifelse(. == ans,
                            yes = 1, no = 0)), .vars = item)
  names(battery)[names(battery) == item] <- corrItem
  return(battery)
}
scoreItem <- Vectorize(scoreItem, vectorize.args=c('item', 'num'), SIMPLIFY=FALSE)

########### Score a specific test
scoreTest <- function(battery, test) {
  if (exists(test) & length(grep('DISC', test)) == 0) {
    answers <- get(test)

    # List items
    items <- paste0(test, '_', 'QID', answers$QID, '_RESP')
    nums <- answers$QID

    # Score items
    battery <- scoreItem(battery, answers, items, nums)
    #battery <- sapply(1:length(nums), function(i) scoreItem(battery, answers, items[i], nums[i]))
  } else {
    print(paste('Answer key does not exist for', test))
  }
  return(battery)
}
scoreTest <- Vectorize(scoreTest, vectorize.args=c('test'), SIMPLIFY=FALSE)

########### Score the whole battery
score <- function(battery) {
  varnames <- names(battery)[!(names(battery) %in% grep('PID', names(battery), value=TRUE))]
  varnames <- strsplit(varnames, '_')
  varnames <- simpNames(1:length(varnames), varnames)
  tests <- unique(varnames)

  # Score a specific test
  battery <- scoreTest(battery, tests)
  #battery <- sapply(1:length(tests), function(i) scoreTest(battery, tests[i]))

  return(battery)
}

#################### Score the batteries ####################
scored_battery_1 <- score(battery_1)
scored_battery_1

####################### Desired Output ######################
desired_output <- data.frame(PID=paste0('PID', 1:5), SHAPES_v1_QID1_CORR=c(rep(1, 3),
  rep(0, 2)), SHAPES_v1_QID2_CORR=c(rep(0, 3), rep(1, 2)),
  LETTERS_v1_QID1_CORR=c(rep(1, 3), rep(0, 2)),
  LETTERS_v1_QID2_CORR=c(rep(0, 1), rep(1, 4)))
desired_output

库（'dplyr'）
电池1不知何故，我觉得你把一些事情复杂化了。

我已经尝试完成了与您描述的相同的输出。让我知道以下各项是否适用于您：

library(dplyr)
library(tidyr)
library(purrr)

score <- function(battery) {
  battery %>%
    pivot_longer(-PID, names_to = 'response_id', values_to = 'response_value') %>%
    mutate(
      test_name = str_extract(response_id, '^[^_]+_[^_]+(?=_)'),
      QID = as.integer(str_extract(response_id, '(?<=QID)\\d+(?=_)'))
    ) %>%
    filter(test_name %in% ls(envir = .GlobalEnv)) %>%
    split(f = .$test_name) %>%
    imap(.f = function(test_results, test_name){
      test_results %>%
        left_join(get(test_name), by = 'QID') %>%
        filter(!is.na(CorrectResponse)) %>%
        mutate(
          is_correct = as.integer(response_value == CorrectResponse)
        )
    }) %>%
    do.call(bind_rows, .) %>%
    select(PID, response_id, is_correct) %>%
    spread(key = response_id, value = is_correct)
}

库（dplyr）
图书馆（tidyr）
图书馆（purrr）
分数%
pivot_longer（-PID，name_to='response_id'，values_to='response_value'）%>%
变异(
测试名称=str提取（响应id，“^[^[uU]+”（？=）），
QID=as.integer（str_extract（response_id，'（这真是太棒了！谢谢。刚开始强迫自己使用DPLYR。你的代码清楚地说明了很多好处。@ EllynButler如果回答了你的问题，考虑通过点击左边的格雷查来接受它肯定是解决我的问题的方法，但是这对我自己的启发（也希望别人）有用。要知道我的原始代码中有什么地方失败了。我还应该单击灰色检查吗？//将注释移动到您的原始解决方案到实际的帖子中不太了解
矢量化
，在我看来，它试图返回您计算的结果列表，同时循环您声明的变量“矢量输入”在
vectorize.args
（items，nums）中，并将其他输入（电池，答案）视为一维参数。当函数
simpNames
返回可以轻松强制转换为字符向量的简单字符串时，
scoreItem
在每次这样的“迭代”中返回一个数据帧，从而获得这些df的列表。[…续。在下一篇评论中：）[…]您试图解决上述问题的方式（循环电池项目，对每个记录的答案和正确答案进行评分），您正在计算每个步骤中的分数的完整向量（这是您通过变异得到的）如果你真的想坚持这种方法，我认为你可以只返回实际分数的列（仍然接收向量列表），然后col绑定“PID”列和列出的向量放在一起。但在这一点上，我认为我们深入到了过度复杂领域。毕竟，我认为你使用的是向量化，而你并没有真正获得附加值。从技术上讲，你嵌套了两个循环来为给定的电池评分。1）循环测试（如“SHAPES\u V1”）答案存储在单独的df中；2）在属于当前测试的测试项上循环。第一个循环基本上只是帮助您从正确的df加载答案。然后，在第二个循环中，向量化帮助您对该测试项（df中的向量）的所有记录响应进行评分与您的正确结果相反-为此，您已经在使用矢量化的
ifelse
函数谢谢！我的原始代码现在可以工作了，但我确实更喜欢您的解决方案。我只是想知道如何解决我最初的问题。