Блог

Значения в вашем примере values объекта не совпадают со значениями data.frame , которые вы присваиваете значениям. Например. посмотрите на 5-е значение A .

Вы могли бы использовать базовый подход R, подобный этому:

 # Look up the scorecard values for a name from the scorecard data.frame
get_scorecard_values <- function(name, card) {
  as.numeric(card[card$Names == name, c(2,3,4)])
}

# translate scorecard values into breakpoints for scoring intervals     
get_breaks <- function(x){
  c((x[1] x[2])/2, (x[2] x[3])/2, x[3])
}

# the value to assign to each scoring interval
my_scores <- c(5,3,1,0)

# given a vector of values, assign a score value to each based on
# the interval that it falls into
get_scores <- function(x, intervals, scores) {
  scores[(findInterval(x, get_breaks(intervals))   1L)]
}

# go across the list of names of variables of the values object.
# for each name, get the values and corresponding scorecard values
# and calculate the score values.
sapply(
  names(values),
  function(val, values, card, scores) {
    get_scores(
      x = values[[val]],
      intervals = get_scorecard_values(name = val, card = card),
      scores = scores
    )
  }, 
  values = values,
  card = scorecard,
  scores = my_scores
)

     A B C  D E
[1,] 5 0 5 NA 0
[2,] 5 0 0 NA 0
[3,] 5 3 0  5 0
[4,] 0 5 5  5 5
[5,] 0 5 0  5 5
  

Я использовал фрейм данных с A5 = -30. Вот базовое решение R

 scoremat <- as.matrix(scorecard[, -1L])
dimnames(scoremat) <- list(scorecard$Names, names(scorecard)[-1L])

vscore <- function(x, nm, scoremat) {
  scores <- c("Score5" = 5, "Score3" = 3, "Score1" = 1)[dimnames(score_mat)[[2L]]]
  conds <- scoremat[rep(nm, length(x)), ]
  i <- as.integer(apply(abs(x - conds), 1L, which.min))
  unname(ifelse(x > conds[, "Score1"] , 0, scores[i]))
}

dscore <- function(df, scoremat) {
  as.data.frame(vapply(
    names(df), 
    function(nm, mat) vscore(df[[nm]], nm, mat), 
    numeric(nrow(df)), 
    scoremat
  ))
}
  

Вывод

 > dscore(values, scoremat)
  A B C  D E
1 5 0 5 NA 0
2 5 0 0 NA 0
3 5 3 0  5 0
4 0 5 5  5 5
5 1 5 0  5 5
  

Сначала мы создаем матрицу оценок следующим образом

 > scoremat
  Score5 Score3 Score1
A   -100    -50    -25
B   -200   -100    -50
C   -300   -150    -75
D   -400   -200   -100
E   -500   -250   -125
  

Обратите внимание, что ваша логика упрощается до

 for any x in, for example, column A
  if x > -25 (i.e. scoremat["A", "Score1"]) then
    return 0
  else 
   calculate distance = abs(x - values in row A of scoremat)
   return the score where the minimum distance is 
  

В принципе, так vscore и работает. Сначала сопоставьте оценки

 scores <- c("Score5" = 5, "Score3" = 3, "Score1" = 1)[dimnames(score_mat)[[2L]]]
  

Затем сопоставьте и повторите строку так, чтобы в conds матрице было столько же строк, сколько и длина вектора x .

 conds <- scoremat[rep(nm, length(x)), ]
  

Затем вычислите abs(x - conds) и получите, где минимум для каждой строки. Например,

 let x = values$A

abs (  x   -           conds      )     =         distance       which.min = i
     -200       -100    -50    -25            100    150    175              1
     -150       -100    -50    -25             50    100    125              1
     -100       -100    -50    -25              0     50     75              1
        0       -100    -50    -25            100     50     25              3
      -30       -100    -50    -25             70     20      5              3
              Score5 Score3 Score1         Score5 Score3 Score1
  

Используется as.integer для преобразования отсутствия совпадений (это происходит, когда в x есть значения NA) в NA значения.

 i <- as.integer(apply(abs(x - conds), 1L, which.min))
  

Наконец, верните результаты на основе логики, показанной выше

 unname(ifelse(x > conds[, "Score1"] , 0, scores[i]))