用于计算精度和召回率的Tidyverse语法

我试图计算数据框中每个组的AUC、精度、召回率和准确度（我有一个数据框，其中预测了三个不同模型的数据）

tidyverse的语法是什么？我想使用Max Kuhn的包来计算这些指标

这是一个示例df，这是我到目前为止得到的结果：

> library(tidyverse)
> library(yardstick)
> 
> sample_df <- data_frame(
+     group_type = rep(c('a', 'b', 'c'), each = 5),  # repeats each element 5 times
+     true_label = as.factor(rbinom(15, 1, 0.3)),    # generates 1 with 30% prob
+     pred_prob = runif(15, 0, 1)                    # generates 15 decimals between 0 and 1 from uniform dist
+ ) %>%
+     mutate(pred_label = as.factor(if_else(pred_prob > 0.5, 1, 0)))
> 
> sample_df
# A tibble: 15 x 4
   group_type true_label pred_prob pred_label
   <chr>      <fct>          <dbl> <fct>     
 1 a          1             0.327  0         
 2 a          1             0.286  0         
 3 a          0             0.0662 0         
 4 a          0             0.993  1         
 5 a          0             0.835  1         
 6 b          0             0.975  1         
 7 b          0             0.436  0         
 8 b          0             0.585  1         
 9 b          0             0.478  0         
10 b          1             0.541  1         
11 c          1             0.247  0         
12 c          0             0.608  1         
13 c          0             0.215  0         
14 c          0             0.937  1         
15 c          0             0.819  1         
> 

现在，我如何获得数据集中每个组的这些指标

sample_df %>%
    group_by(group_type) %>%
    summarize(???)

---

我通过将一个数据框映射到一个列表并将函数映射到每个列表元素来实现这一点：

library(tidyverse)
library(yardstick)
sample_df %>%
  split(.$group_type) %>%
  map_dfr(precision, true_label, pred_label) 
#output
## A tibble: 1 x 3
      a     b     c
  <dbl> <dbl> <dbl>
1 0.500 0.667  1.00

---

使用unnest的示例如下：

   sample_df %>% 
     group_by(group_type) %>% 
     do(auc = roc_auc(., true_label, pred_prob),
         acc = accuracy(., true_label, pred_label),
         recall = recall(., true_label, pred_label),
         precision = precision(., true_label, pred_label)) %>% unnest

但是,

实际上，我建议不要使用尺度，因为它不能很好地处理dplyr。实际上，它只是在引擎盖下使用ROCR软件包。我只需要创建包含两个变量的函数

尺度

有缺陷，因为它需要一个

数据帧

作为第一个输入，它试图变得太聪明。在dplyr框架下，这是不必要的，因为函数已经看到

data.frame

中的变量，而没有显式的

data

参数

我在中使用了这个例子 它使用嵌套，但也根据您的要求使用精度

library(tidyverse)
library(yardstick)
sample_df <- data_frame(group_type = rep(c('a', 'b', 'c'), each = 5),  # repeats each element 5 times 
                        true_label = as.factor(rbinom(15, 1, 0.3)),    # generates 1 with 30% prob 
                        pred_prob = runif(15, 0, 1)                    # generates 15 decimals between 0 and 1 from uniform dist 
                        ) %>% 
  mutate(pred_label = as.factor(if_else(pred_prob > 0.5, 1, 0)))

by_group_type <- sample_df %>% group_by(group_type) %>% nest()
stick_m_1 <- function(df){
  precision(df,truth = true_label, estimate = pred_label)
}
models <- map(by_group_type$data,stick_m_1)
models

库（tidyverse）
图书馆（尺度）
样本_df%
变异（pred_label=as.factor（如果其他（pred_prob>0.5,1,0）））
按组类型%group\U按（组类型）%>%nest（）
stick_m_1正如其他人所指出的那样，
尺度
中的函数在分组数据帧中发挥得并不好（至少到目前为止）。解决方法可以是使用嵌套数据

为了减少复制，编写一个简单的包装器函数来计算一次调用中所需的所有摘要指标可能也是一个好主意。下面是一个示例，说明了如何做到这一点：


reprex:：reprex_info（）
#>由reprex软件包v0.1.1.9000于2018-02-09创建

首先建立：

库（tidyverse）
图书馆（尺度）
种子（1）
#给定样本数据
样本_df%
变异（pred_label=as.factor（如果其他（pred_prob>0.5,1,0）））
#>警告：包“bindrcpp”是在R版本3.3.3下生成的

以下是包装纸：

#从同一数据计算多个度量的包装器
性能指标组类型数据精度召回精度roc
#>                                      
#>1 a 0.5000000 0.2500000 0.2 0.5909091
#>2 b 0.66667 0.66667 0.6 0.5909091
#>3 c 0.7500000 0.7500000 0.6 0.5909091
感谢您的回答和基本解释。似乎是最简单、最容易理解的。相对而言，R比较新，并且在R中很少有用于计算这些分类度量的包（rocr、pROC、尺度）。不确定哪一个是好的。ROCR是最快的（尽管情况并非总是如此）。不幸的是，使用IMO也有点笨拙。我只会使用对您来说最简单的方法。这可以解决问题，但不会报告组类型。感谢您提供详细的解决方案。以前从未使用过。直到有新的东西。
   sample_df %>% 
     group_by(group_type) %>% 
     do(auc = roc_auc(., true_label, pred_prob),
         acc = accuracy(., true_label, pred_label),
         recall = recall(., true_label, pred_label),
         precision = precision(., true_label, pred_label)) %>% unnest

library(tidyverse)
library(yardstick)
sample_df <- data_frame(group_type = rep(c('a', 'b', 'c'), each = 5),  # repeats each element 5 times 
                        true_label = as.factor(rbinom(15, 1, 0.3)),    # generates 1 with 30% prob 
                        pred_prob = runif(15, 0, 1)                    # generates 15 decimals between 0 and 1 from uniform dist 
                        ) %>% 
  mutate(pred_label = as.factor(if_else(pred_prob > 0.5, 1, 0)))

by_group_type <- sample_df %>% group_by(group_type) %>% nest()
stick_m_1 <- function(df){
  precision(df,truth = true_label, estimate = pred_label)
}
models <- map(by_group_type$data,stick_m_1)
models