如何根据另一个数据库中的记分卡给每个数据框值打分？答案

【问题标题】：How to give a score to each dataframe value based on scorecard in another database?如何根据另一个数据库中的记分卡给每个数据框值打分？
【发布时间】：2020-10-27 15:05:29
【问题描述】：

我正在尝试为 values 相对于 scorecard（以下两者）创建记分卡。

values <- data.frame(A= c(-200,-150,-100,0,100),
                     B= c(100,0,-101,-201,-300),
                     C= c(-400,400,500,-500,250),
                     D= c(NA,NA,-1000,-1000,-1000),
                     E= c(1000,1000,1,-1000,-2000))

scorecard <- data.frame(Names = c("A","B","C","D","E"), 
                        "Score5" = c(-100,-200,-300,-400,-500))

values
     A    B    C     D     E
1 -200  100 -400 -1000  1000
2 -150    0  400 -1000  1000
3 -100 -101  500 -1000     1
4    0 -201 -500 -1000 -1000
5  100 -300  250 -1000 -2000

如果 A 的值 scorecard[1,2]），记分卡数据框应为 5，否则应为 0。我想对所有 A、B、C、D 和 E 执行此操作一个数据框。所需的输出是：

#  A B C  D E
#1 5 0 5 NA 0
#2 5 0 0 NA 0
#3 0 0 0  5 0
#4 0 5 5  5 5
#5 0 5 0  5 5

我尝试了以下方法 - 这需要打包的 xts：install.packages("xts")，但我并没有完全做到。

pointsfunction <- function(value)  {
  points <- c()
  for(i in names) {
    index = which(colnames(value)==i)
    data_start <- which(!is.na(value))[1]
    points[1:(data_start -1)] <- NA
    for(a in (data_start):(length(value))) {
      if(value[a] < scorecard[index, 2]) {
        points[a] <- -5
      } else {
        points[a] <- 0
      }
    }
  }
  points <- reclass(points, value)
  return(points)
}

scorecardpoints <- as.data.frame(lapply(values, pointsfunction))

我收到以下错误：

if (value[a]

有什么想法吗？

【问题讨论】：

您能否对所需的输出更清楚一点？显示示例输入的输出将有很大帮助。 “f A 的值 ”。它总是 5 还是 0？或者是低于记分卡阈值的values 的数量？结果是否应该与scorecard、values 或其他内容具有相同的“形状”（尺寸）？
感谢@GregorThomas。我已经编辑过了。您是否知道如何使用 lapply 解决它？

标签： r dataframe lapply

【解决方案1】：

使用dplyr 和tidyr 你可以试试：

library(dplyr)
library(tidyr)

values %>%
  mutate(row = row_number()) %>%
  pivot_longer(cols = -row, names_to = 'Names') %>%
  left_join(scorecard, by = 'Names') %>%
  mutate(value = if_else(value < Score5, 5, 0)) %>%
  select(-Score5) %>%
  pivot_wider(names_from = Names, values_from = value) %>%
  select(-row)

或者也许是一个更简单的基本 R 选项：

mat <- sweep(values, 2, scorecard$Score5[match(names(values), scorecard$Names)], `<`)
values[mat] <- 5
values[!mat] <- 0
values

#  A B C  D E
#1 5 0 5 NA 0
#2 5 0 0 NA 0
#3 0 0 0  5 0
#4 0 5 5  5 5
#5 0 5 0  5 5

【讨论】：

你可以做mat <- sweep(...) * 5来简化数字转换。
我已经扩展了这个问题。你能帮忙吗？
不要扩展问题，将其作为一个新问题提出。

【解决方案2】：

我喜欢 Ronak 的回答，但这里有一个基于 apply-family 的解决方案：

sapply(names(values), function(x) values[[x]] < scorecard$Score5[scorecard$Names == x]) * 5
#      A B C  D E
# [1,] 5 0 5 NA 0
# [2,] 5 0 0 NA 0
# [3,] 0 0 0  5 0
# [4,] 0 5 5  5 5
# [5,] 0 5 0  5 5

【讨论】：

我已经扩展了这个问题。你能帮忙吗？
您问了一个问题，得到了两个有效的答案，然后更改了问题，使答案不再有效？那不是很好。如果您的原始问题与您的实际问题的范围不匹配，请接受您得到的一个有效答案并提出一个新问题。不要编辑您的问题并“移动球门柱”。
特别是因为这些是对问题的剧烈变化。这从 2 个数据帧之间的简单比较转变为根据结果将 1 个数据帧与其他 3 个数据帧进行比较，并带有几个条件。