使用Tidyverse语法计算精度和召回率。

Question

我正在尝试计算数据框中每个组的AUC、精确度、召回率和准确度（我的数据框中有来自三个不同模型的预测数据连接在一起）。

使用tidyverse语法如何做到这一点？我想使用Max Kuhn的yardstick包来计算这些指标。

这是一个示例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         
> 

指标：

> # metrics for the full data
> precision(sample_df, truth = true_label, estimate = pred_label)
[1] 0.5714286
> recall(sample_df, truth = true_label, estimate = pred_label)
[1] 0.3636364
> accuracy(sample_df, truth = true_label, estimate = pred_label)
[1] 0.3333333
> roc_auc(sample_df, truth = true_label, pred_prob)
[1] 0.7727273
> 

现在我该如何获取数据集中每个组的这些指标？

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

- Abi K

Answer 1

正如其他人所指出的，yardstick中的函数与分组数据框不太兼容（至少目前是这样）。解决方法可能是使用嵌套数据。为了减少重复，最好编写一个简单的包装函数，在一次调用中计算您想要的所有摘要指标。以下是如何执行此操作的示例：

reprex::reprex_info()
#> Created by the reprex package v0.1.1.9000 on 2018-02-09

首先设置：

library(tidyverse)
library(yardstick)
set.seed(1)

# Given sample data
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)))
#> Warning: package 'bindrcpp' was built under R version 3.3.3

这里是包装器：

# Wrapper to calculate several metrics from same data
performance_metrics <- function(data, truth, estimate, prob) {
  metrics <- lst(precision, recall, accuracy)  # these all share arguments
  values <- invoke_map_df(metrics, list(list(data)), truth, estimate)

  roc <- roc_auc(sample_df, truth, prob)  # bit different here
  bind_cols(values, roc_auc = roc)
}

# Wrap the wrapper with default arguments
metrics <- partial(performance_metrics,
                   truth    = "true_label",
                   estimate = "pred_label",
                   prob     = "pred_prob")

并通过嵌套数据将其应用于组：

sample_df %>% 
  nest(-group_type) %>% 
  mutate(metrics = map(data, metrics)) %>% 
  unnest(metrics)
#> # A tibble: 3 x 6
#>   group_type             data precision    recall accuracy   roc_auc
#>        <chr>           <list>     <dbl>     <dbl>    <dbl>     <dbl>
#> 1          a <tibble [5 x 3]> 0.5000000 0.2500000      0.2 0.5909091
#> 2          b <tibble [5 x 3]> 0.6666667 0.6666667      0.6 0.5909091
#> 3          c <tibble [5 x 3]> 0.7500000 0.7500000      0.6 0.5909091

- Mikko Marttila

---

感谢您提供详细的解决方案。我以前从未使用过partial。今天我学到了新东西。 - Abi K

Answer 2

一个使用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

然而，我建议不要使用yardstick，因为它与dplyr summarize不兼容。实际上，它只是在幕后使用ROCR包。我建议您自己编写函数，以接受两个变量。

yardstick存在缺陷，因为它需要一个data.frame作为第一个输入，它试图变得过于聪明。在dplyr框架下，这是不必要的，因为summarize和mutate函数已经可以在没有显式data参数的情况下查看data.frame中的变量。

- thc

---

感谢您的回答和解释。看起来这是最简单和易于理解的方法。我对R相对较新，而且在R中计算这些分类指标的软件包很少（rocr、pROC、yardstick）。不确定哪个是最好的选择。 - Abi K

ROCR是最快的（虽然以前不是这样）。不幸的是，在我看来，它使用起来有点笨拙。我建议你使用最简单的方法。 - thc

Answer 3

我通过将数据框拆分为列表，并将函数映射到每个列表元素来完成它：

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

看起来yardstick函数还不支持group_by。

这个也可以：

sample_df %>%
  split(.$group_type) %>%
  map_dfr(function(x){
    prec = precision(x, true_label, pred_label)
    rec = recall(x, true_label, pred_label)
    return(data.frame(prec, rec))
  })

- missuse

---

这解决了问题，但没有报告组类型。 - Abi K

Answer 4

我使用了http://r4ds.had.co.nz/many-models.html中的示例。 它使用了nest，同时也按照您的要求使用了precision。

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

- Harlan Nelson