R Рассчитать самое важное значение для каждой строки во фрейме данных по правилам

У меня есть вопрос, где у меня есть некоторые проблемы с его решением. У меня есть фрейм данных, в котором я собрал в каждой строке 4 метки и соответствующие значения оценок. Вот мои образцы данных:

sample = data.frame("label1" = c("name1", "name1", "name3"), "score1" = c(0.88, 0.5, 0.4),
                    "label2" = c("name1", "name1", "name3"), "score2" = c(0.93, 0.6, 0.35),
                    "label3" = c("name2", "name1", "name4"), "score3" = c(0.49, 0.7, 0.8),
                    "label4" = c("name2", "name2", "name1"), "score4" = c(0.81, 0.8, 0.25), stringsAsFactors = FALSE)

Теперь я хотел бы рассчитать для каждой строки окончательную метку и оценить по следующим правилам:

  • если метка появляется более 2 раз, то это последняя метка, и соответствующее значение является средним значением оценок этой метки.
  • если в одной строке есть две разные метки, которые обе появляются два раза, то следует выбрать метку с более высоким средним значением оценки с соответствующим средним значением оценки.
  • если подряд более двух разных меток, непонятно, какую из них выбрать. Таким образом, должно быть NA, и соответствующее значение также NA.

Я подумал о циклическом просмотре кадра данных за строкой и реструктуризации строки для использования aggregate. Вот мой подход к первой строке:

pairs <- as.data.frame(matrix(as.vector(sample[1,]), ncol=2, byrow = TRUE))
pairs = data.frame("label" = unlist(pairs[,1], recursive = FALSE), "score" = unlist(pairs[,2], recursive = FALSE))
pairs$label = as.character(pairs$label)

aggregate(score~label, data=pairs, FUN = function(x) c(mean = mean(x), count = length(x) ))

После этого момента я понятия не имею, как реализовать вышеуказанные правила. Может быть, есть более эффективный способ решить эту проблему? Это мой желаемый результат:

result = data.frame("label" = c("name1", "name1", NA), "score" = c(0.905, 0.6, NA))

заранее спасибо


r dataframe scoring
person WinterMensch    schedule 22.02.2018    source источник
comment
Если кто хочет взять отсюда и написать правила для каждого из подсписков, то вот. Я не могу обобщить (?) Подсписок/результаты, не написав низкокачественный/действительно подробный код. Вот это с некоторыми злоупотреблениями matrix(). lapply(1:nrow(sample), function(n) sample[n,,drop=F]) %>% lapply(matrix, ncol = 2, byrow = T) %>% lapply(as.data.frame)   -  person Vlo    schedule 22.02.2018
comment
Хорошо, как бы вы это сделали (даже длинный код подойдет для первого шага)?   -  person WinterMensch    schedule 23.02.2018

Ответы (1)


arrow_upward
1
arrow_downward

Как и вы, я тоже думаю, что реструктуризация данных и их агрегирование — это правильный путь, и это то, что я сделал здесь:

library(dplyr)
sample$row_num <- 1:nrow(sample)

new_lst <- lapply(1:4, 
              function(x){
                    cols <- names(sample)[grepl(x, names(sample))]
                    sample[, c(cols, "row_num")] %>% 
                      setNames(c( "label", "score", "row_num"))
                  })


sample_2 <- do.call(rbind, new_lst) %>% 
      group_by(row_num, label) %>% 
      summarise(cnt = n(),
                score_avg = mean(score))

и теперь я просматриваю каждую строку и применяю правила, которые я использую в коде if-elseif-else

lapply(1:nrow(sample), 
       function(x){
         dat <- sample_2 %>% filter(row_num == x) 

         if(max(dat$cnt) > 2) {

           label <- as.character(dat[which((dat$cnt) > 2), "label"])
           score <- dat[dat$label == label, "score_avg"]

         } else if (nrow(dat) > 2) {

           label <- NA
           score <- NA

         } else {

           label <- as.character(dat[which.max(dat$score_avg), "label"])
           score <- max(dat$score_avg)

         }
         return(data.frame(# "row_num" = x,  # you can un-comment here to have an indexed output
                           "label" = label, "score" = score))
         }) %>% 
    data.table::rbindlist()

не очень элегантно, но работает

надеюсь это поможет

person DS_UNI    schedule 23.02.2018