## ----include = FALSE----------------------------------------------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>",
  fig.width = 6,
  fig.height = 4
)

## ----setup--------------------------------------------------------------------
library(probcal)

## ----simulate-----------------------------------------------------------------
set.seed(2024)
n <- 1200
k <- 3

true_prob <- matrix(stats::runif(n * k), ncol = k)
true_prob <- true_prob / rowSums(true_prob)
labels <- apply(true_prob, 1, function(row) sample.int(k, 1, prob = row))

# An overconfident model: push probabilities toward 0 and 1.
sharpen <- function(p, power = 2.5) {
  q <- p^power
  q / rowSums(q)
}
raw_prob <- sharpen(true_prob)
raw_logits <- log(pmax(raw_prob, 1e-12))

split <- sample(rep(c("calibration", "test"), each = n / 2))
cal <- split == "calibration"
test <- split == "test"

## ----metrics-raw--------------------------------------------------------------
ece(raw_prob[test, ], labels[test], type = "classwise")
ece(raw_prob[test, ], labels[test], type = "confidence")
mmce(raw_prob[test, ], labels[test])

## ----temperature--------------------------------------------------------------
temp_fit <- cal_temperature(raw_logits[cal, ], labels[cal])
temp_fit

temp_pred <- predict(temp_fit, raw_logits[test, ])
ece(temp_pred, labels[test], type = "classwise")

## ----dirichlet----------------------------------------------------------------
dir_fit <- cal_dirichlet(raw_prob[cal, ], labels[cal])
dir_pred <- predict(dir_fit, raw_prob[test, ])
ece(dir_pred, labels[test], type = "classwise")

## ----ovr----------------------------------------------------------------------
ovr_fit <- cal_ovr(raw_prob[cal, ], labels[cal], method = "isotonic")
ovr_pred <- predict(ovr_fit, raw_prob[test, ])
ece(ovr_pred, labels[test], type = "classwise")

## ----compare------------------------------------------------------------------
data.frame(
  method = c("raw", "temperature", "dirichlet", "one-vs-rest"),
  classwise_ece = c(
    ece(raw_prob[test, ], labels[test], type = "classwise"),
    ece(temp_pred, labels[test], type = "classwise"),
    ece(dir_pred, labels[test], type = "classwise"),
    ece(ovr_pred, labels[test], type = "classwise")
  )
)

## ----diagram, fig.alt="Faceted multiclass reliability diagram showing mean predicted probability on the x-axis and observed event frequency on the y-axis for each class, with a diagonal reference line for perfect calibration."----
reliability_diagram(dir_pred, labels[test], bins = 10, type = "classwise")

## ----cv-----------------------------------------------------------------------
cv_fit <- cal_cv(
  raw_prob,
  labels,
  method = "dirichlet",
  folds = 5,
  seed = 1
)
ece(cv_fit$oof_predictions, labels, type = "classwise")