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

时间:2018-02-09 18:40:21

标签: r dplyr tidyverse yardstick

我正在尝试为我的数据框中的每个组计算AUC,精度,召回,准确度(我有一个数据框,其中包含连接的三个不同模型的预测数据)。

执行此操作的tidyverse语法是什么?我想使用Max Kuhn的yardstick包来计算这些指标。

这是一个示例df,这是我到目前为止的地方:

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

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

let options = new RequestOptions({ headers: new Headers({ 'Authorization': 'Basic xxxx' }) });
this.http.get(this.url,options );

4 个答案:

答案 0 :(得分:1)

使用unexst的示例:

   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包。我只是创建自己的函数,接受两个变量。

yardstick存在缺陷,因为它需要data.frame作为它的第一个输入,它试图太聪明。在dplyr框架下,由于summarizemutate因为函数已经看到data.frame内的变量而没有明确的data参数,因此不是必需的。

答案 1 :(得分: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

答案 2 :(得分:0)

我设法通过将数据框吐出到列表并将函数映射到每个列表元素来实现:

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

答案 3 :(得分:0)

我使用http://r4ds.had.co.nz/many-models.html中的示例 它使用嵌套,但也可以根据您的要求使用精度。

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