## ----include = FALSE----------------------------------------------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)

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

## ----scales-------------------------------------------------------------------
p <- c(0.1, 0.3, 0.7, 0.9)
logits <- logit(p)
round(inv_logit(logits), 3)

## ----comparison---------------------------------------------------------------
set.seed(2027)
n <- 500
predictions <- data.frame(x = rnorm(n)) |>
  mutate(
    true_p = inv_logit(-0.2 + x),
    y = rbinom(n(), 1, true_p),
    raw_logits = 1.6 * (-0.2 + x),
    raw_p = inv_logit(raw_logits),
    split = sample(rep(c("calibration", "test"), length.out = n))
  )

calibration <- predictions |>
  filter(split == "calibration")

test <- predictions |>
  filter(split == "test")

fits <- list(
  platt = cal_platt(calibration$raw_p, calibration$y),
  beta = cal_beta(calibration$raw_p, calibration$y),
  isotonic = cal_isotonic(calibration$raw_p, calibration$y),
  histogram = cal_histogram(calibration$raw_p, calibration$y, bins = 10),
  temperature = cal_temperature(calibration$raw_logits, calibration$y)
)

test <- test |>
  mutate(
    platt = predict(fits$platt, raw_p),
    beta = predict(fits$beta, raw_p),
    isotonic = predict(fits$isotonic, raw_p),
    histogram = predict(fits$histogram, raw_p),
    temperature = predict(fits$temperature, raw_logits)
  )

bind_rows(
  test |> summarise(method = "raw", ece = ece(raw_p, y, bins = 10)),
  test |> summarise(method = "platt", ece = ece(platt, y, bins = 10)),
  test |> summarise(method = "beta", ece = ece(beta, y, bins = 10)),
  test |> summarise(method = "isotonic", ece = ece(isotonic, y, bins = 10)),
  test |> summarise(method = "histogram", ece = ece(histogram, y, bins = 10)),
  test |> summarise(method = "temperature", ece = ece(temperature, y, bins = 10))
) |>
  mutate(ece = round(ece, 3)) |>
  arrange(ece)

## ----cv-----------------------------------------------------------------------
cv_fit <- cal_cv(predictions$raw_p, predictions$y, method = "beta", folds = 5, seed = 1)

predictions |>
  mutate(oof = cv_fit$oof_predictions) |>
  summarise(oof_ece = ece(oof, y, bins = 10))