r - 如何根据排名标准从数据框中执行多数投票

Question

我有以下数据框:

dat <- structure(list(model_name = c("Random Forest", "XGBoost", "XGBoost-reg", 
"Null model", "Plain LM", "Elastic LM", "LM-pep.charge", "LM-rf.10vip"
), RMSE = c(0.853, 0.886, 0.719, 2.41, 16.6, 0.731, 1.16, 1.03
), MAE = c(0.545, 0.708, 0.589, 1.98, 8.6, 0.588, 0.874, 0.729
), `R^2` = c(0.806, 0.865, 0.915, NA, 0.0645, 0.927, 0.8, 0.822
), ccc = c(0.89, 0.928, 0.951, 0, 0.0685, 0.945, 0.847, 0.901
)), row.names = c(NA, -8L), class = c("tbl_df", "tbl", "data.frame"
))

看起来像这样:

  model_name      RMSE   MAE   `R^2`    ccc
  <chr>          <dbl> <dbl>   <dbl>  <dbl>
1 Random Forest  0.853 0.545  0.806  0.89  
2 XGBoost        0.886 0.708  0.865  0.928 
3 XGBoost-reg    0.719 0.589  0.915  0.951 
4 Null model     2.41  1.98  NA      0     
5 Plain LM      16.6   8.6    0.0645 0.0685
6 Elastic LM     0.731 0.588  0.927  0.945 
7 LM-pep.charge  1.16  0.874  0.8    0.847 
8 LM-rf.10vip    1.03  0.729  0.822  0.901 

它存储8个预测模型的评估指标。 我的目标是选择在大多数评估中始终表现出色的最佳模型。

通过手动评估指标，我通过这种方式确定了表现最佳的模型:

Metrics -> Top 1
-----------------
RMSE -> XGBoost-reg 
MAE -> RF
R^2 -> Elastic LM 
CCC -> XGBoost-reg 

# Therefore, the winner is XGBoost-reg

值得注意的是，RMSE 和 MAE 是误差度量，值越低表示性能越好，而 R^2 和 CCC 是相关性度量，值越高表示性能越好。

我如何使用 R 来做到这一点？

Answer 1

我们可以将数据转换为“long”格式，按“name”进行分组并获取具有最低值“value1”的行(在修改 R^2 的大小写之后) ccc - 乘以-1)，然后获取频率count并选择第一行

library(dplyr)
library(tidyr)
dat %>% 
  pivot_longer(cols = -model_name, values_drop_na = TRUE) %>% 
  mutate(value1 = case_when(name %in% c("R^2", "ccc")~ value * -1, 
     TRUE ~ value)) %>% 
  group_by(name) %>% 
  slice_min(n = 1, value1) %>%
  ungroup %>%
  count(model_name, sort = TRUE) %>%
  slice_head(n = 1)

-输出

# A tibble: 1 × 2
  model_name      n
  <chr>       <int>
1 XGBoost-reg     2

---

或者进行汇总，根据最小/最大索引从数字列中选择 model_name，然后在转换为“长”格式后获取计数

dat %>% 
  summarise(across(where(is.numeric), 
  ~ if(cur_column() %in% c("R^2", "ccc")) 
   model_name[which.max(.x)] else model_name[which.min(.x)])) %>% 
  pivot_longer(cols = everything(), names_to = NULL) %>% 
  count(value, sort = TRUE) %>%
  slice_head(n = 1)

-输出

# A tibble: 1 × 2
  value           n
  <chr>       <int>
1 XGBoost-reg     2

---

或者使用基础R

names(which.max(table(dat$model_name[max.col(t(replace(dat[-1], 
   is.na(dat[-1]), -Inf) * list(-1, -1, 1, 1)), 'first')])))
[1] "XGBoost-reg"