knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>",
  cache = F, 
  fig.width = 7,
  fig.height = 7
)
library(nbs)
library(tidyverse)
library(tidymodels)
ggplot2::theme_set(ggplot2::theme_bw())
data(multi_model_tibble)
multi_model_tibble

# Make sure to set the event as the first level of the `y` factor
multi_model_tibble <- multi_model_tibble %>% 
  dplyr::mutate(y = forcats::fct_rev(y))

# Nest data
dat <- multi_model_tibble %>% 
  tidyr::nest(dat = c(y, pred))

ROC

plotRoc(dat %>% 
          dplyr::mutate(roc = purrr::map(dat, ~ .x %>% yardstick::roc_curve(pred, truth = y))) %>% 
          tidyr::unnest(roc),
        group = "model")

AUROC

dat <- dat %>% 
  dplyr::mutate(auroc = purrr::map_dbl(dat, ~ yardstick::roc_auc_vec(.x$y, .x$pred)))
dat

PRC

plotPrc(dat %>% 
          dplyr::mutate(prc = purrr::map(dat, ~ .x %>% yardstick::pr_curve(pred, truth = y))) %>% 
          tidyr::unnest(prc), 
        group = "model", 
        title = "Precision Recall Curve")

AUPRC

dat <- dat %>% 
  dplyr::mutate(auprc = purrr::map_dbl(dat, ~ yardstick::pr_auc_vec(.x$y, .x$pred)))


mikeniemant/nbs documentation built on June 23, 2022, 4:52 a.m.