R按规则计算数据框中每一行的最重要值答案

【问题标题】：R Calculate most important value for each row in data frame by rulesR按规则计算数据框中每一行的最重要值
【发布时间】：2018-08-02 09:56:32
【问题描述】：

我有一个问题需要解决。我有一个数据框，我在每行中收集了 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))

提前致谢

【问题讨论】：

如果有人想从这里提取并为每个子列表编写规则，这里就是。如果不编写低质量/非常冗长的代码，我就无法总结（？）子列表/结果。这里有一些 matrix() 滥用。 lapply(1:nrow(sample), function(n) sample[n,,drop=F]) %>% lapply(matrix, ncol = 2, byrow = T) %>% lapply(as.data.frame)
那么你将如何做到这一点（即使是一些长代码也适合第一步）？

标签： r dataframe scoring

【解决方案1】：

就像你一样，我也认为重组数据并聚合它是可行的方法，这就是我在这里所做的：

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()

不是很优雅，但可以完成工作

希望对你有帮助

【讨论】：