如何基于另一个数据库中的记分卡为每个数据框值赋予分数？

编程问答 2022-06-06

问题描述

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

values <- data.frame(A= c(-200,-150,-100,100),B= c(100,-101,-201,-300),C= c(-400,400,500,-500,250),D= c(NA,NA,-1000,-1000),E= c(1000,1000,1,-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]

有什么想法吗？

解决方法

使用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
,

我喜欢Ronak的答案，但这是一个基于申请家庭的解决方案：

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
dataframelapplyrr