## ----include = FALSE----------------------------------------------------------
knitr::opts_chunk$set(collapse = TRUE, comment = "#>")

## -----------------------------------------------------------------------------
library(personnelSelectionUtility)

tr_classic(base_rate = .50, selection_ratio = .20, validity = .35)

## -----------------------------------------------------------------------------
tr_solve(base_rate = .50, selection_ratio = .20, validity = NULL, ppv = .70)

## -----------------------------------------------------------------------------
tr_solve(base_rate = .50, selection_ratio = NULL, validity = .35, ppv = .70)

## -----------------------------------------------------------------------------
R <- matrix(c(
  1.00, .30, .40,
  .30, 1.00, .35,
  .40, .35, 1.00
), nrow = 3, byrow = TRUE)

tr_multivariate(selection_ratios = c(.50, .50), base_rate = .50, R = R)

## -----------------------------------------------------------------------------
R_tog <- matrix(c(
  1.00, .50, .70,
  .50, 1.00, .70,
  .70, .70, 1.00
), nrow = 3, byrow = TRUE)

tog <- tr_multivariate_equal_cutoff(
  joint_selection_ratio = .20,
  base_rate = .60,
  R = R_tog
)

tog

## -----------------------------------------------------------------------------
c(
  marginal_selection_ratio = tog$solved_marginal_selection_ratio,
  joint_selection_ratio    = tog$joint_selection_ratio,
  ppv                      = tog$ppv
)

## -----------------------------------------------------------------------------
# Group-specific evaluation: same predictor structure but different base rates
# across two demographic groups (e.g., focal and reference). The marginal
# selection ratios are common; the base rates and, optionally, the correlation
# matrices may differ.
group_tr_multivariate(
  selection_ratios = c(.35, .35),
  base_rates       = c(.60, .45),
  R_list           = list(R_tog, R_tog),
  group_names      = c("Group A", "Group B")
)

## -----------------------------------------------------------------------------
finite <- tr_binomial_success_probability(n_selected = 20, ppv = .91, at_least = 18)
finite
attr(finite, "probability_at_least")

## -----------------------------------------------------------------------------
R_tog <- matrix(c(
  1.00, .50, .70,
  .50, 1.00, .70,
  .70, .70, 1.00
), nrow = 3, byrow = TRUE)

joint_targets <- c(.20, .50)
tog_grid <- lapply(joint_targets, function(jsr) {
  tr_multivariate_equal_cutoff(
    joint_selection_ratio = jsr,
    base_rate = .60,
    R = R_tog
  )
})

tog_table <- data.frame(
  joint_sr        = joint_targets,
  marginal_sr     = vapply(tog_grid,
                           function(o) o$solved_marginal_selection_ratio,
                           numeric(1)),
  ppv             = vapply(tog_grid, function(o) o$ppv, numeric(1)),
  sensitivity     = vapply(tog_grid, function(o) o$sensitivity, numeric(1)),
  specificity     = vapply(tog_grid, function(o) o$specificity, numeric(1))
)
tog_table

