Tidyverse syntax for calculating precision and recall

Question

I am trying to calculate AUC, Precision, Recall, Accuracy for every group in my data frame (i have a single data frame that has predicted data from three different models concatenated).

What is the tidyverse syntax to do it? I want to use the yardstick package by Max Kuhn to calculate these metrics.

Here is a sample df and here is where I got so far:

> 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:

> # 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
> 

Now how do i get these metrics for each group in my dataset??

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

Answer 1

As others have noted, the functions in yardstick don't really play nice with grouped data frames (at least as of yet). A workaround could be to work with nested data.

In order to reduce replication, it's probably also a good idea to write a simple wrapper function that calculates all of the summary metrics you want in one call. Here's an example of how you could go about doing just that:

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

Set up first:

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

Here are the wrappers:

# 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")

And apply to groups by nesting the data:

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

Answer 2

I used the example in http://r4ds.had.co.nz/many-models.html It uses nest but also uses precision as you requested.

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

Answer 3

An example using 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

HOWEVER,

I would actually suggest to not use yardstick because it doesn't play nice with dplyr summarize. Actually, it just uses the ROCR package under the hood. I would just make your own functions that take in two variables.

yardstick is flawed because it requires a data.frame as it's first input, it is trying to be too clever. Under the dplyr framework, that isn't necessary because of summarize and mutate as functions already see the variables inside a data.frame without an explicit data parameter.

Answer 4

I managed to do it by spiting a data frame to a list and mapping the function to each list element:

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

it seems group_by is not supported by yardstick functions yet

This also works:

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