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

## -----------------------------------------------------------------------------
library(personnelSelectionUtility)

naylor_shine(validity = .35, selection_ratio = .20)

## -----------------------------------------------------------------------------
selected_mean_z(.20)
.35 * selected_mean_z(.20)

## -----------------------------------------------------------------------------
bcg_utility(
  validity = .35,
  selection_ratio = .20,
  sdy = 50000,
  n_selected = 100,
  tenure = 3,
  cost = 75000
)

## -----------------------------------------------------------------------------
random_baseline <- bcg_utility(
  validity = .35,
  selection_ratio = .20,
  sdy = 50000,
  n_selected = 100,
  tenure = 3,
  cost = 75000
)

operating_baseline <- bcg_utility(
  validity = .35,
  baseline_validity = .20,
  selection_ratio = .20,
  sdy = 50000,
  n_selected = 100,
  tenure = 3,
  cost = 75000
)

c(random   = random_baseline$net_utility,
  operating = operating_baseline$net_utility)

## -----------------------------------------------------------------------------
# 5 employees, 2 output types (e.g., transactions completed and customer-service
# hours); unit_values gives the monetary value of one unit of each type.
sdy_cost_accounting(
  units = matrix(c(2400,  18,
                   3100,  22,
                   1800,  14,
                   2700,  25,
                   2200,  20),
                 ncol = 2, byrow = TRUE),
  unit_values = c(25, 80)
)

## -----------------------------------------------------------------------------
sdy_percentile(p15 = 60000, p85 = 140000)

## -----------------------------------------------------------------------------
sdy_proportional(mean_pay = 80000, multiplier = .40)
sdy_proportional(mean_pay = 80000, multiplier = .70)

## -----------------------------------------------------------------------------
sdy_rbn(mean_pay = 80000, coefficient_variation = .20)

## -----------------------------------------------------------------------------
# CREPID weights activities by time/frequency and importance, distributes the
# average salary across activities, and computes individual-level monetary value.
activities <- data.frame(
  activity        = c("Strategic planning", "Team supervision", "Reporting"),
  time_frequency  = c(.40, .35, .25),
  importance      = c(3, 2, 2)
)
ratings <- matrix(c(
  4, 3, 3,
  5, 4, 4,
  3, 4, 3,
  4, 5, 4,
  5, 5, 5
), nrow = 5, byrow = TRUE)
sdy_crepid(activities, ratings, salary = 80000)

# Superior-equivalents: SDy = (superior - typical) / z_difference, with z_difference
# the standardised distance the analyst assumes separates the two anchors.
sdy_superior_equivalents(superior_value = 140000, typical_value = 100000)

## -----------------------------------------------------------------------------
sdy_observed(c(90000, 110000, 85000, 150000, 125000))

## -----------------------------------------------------------------------------
shp_utility(
  effect_size_d = .50,
  sdy           = 50000,
  n_treated     = 100,
  tenure        = 3,
  cost          = 25000
)

## -----------------------------------------------------------------------------
boudreau_utility(
  validity = .35,
  baseline_validity = .20,
  selection_ratio = .20,
  sdy = 50000,
  n_by_period = c(100, 90, 80, 70),
  contribution_margin = .30,
  tax_rate = .25,
  discount_rate = .08,
  cost_by_period = c(75000, 10000, 10000, 10000)
)

## -----------------------------------------------------------------------------
boudreau_utility(
  delta_z_y = .25,
  sdy = 50000,
  n_by_period = c(100, 90, 80),
  discount_rate = .08,
  cost_by_period = c(75000, 10000, 10000)
)

## -----------------------------------------------------------------------------
inflation_adjusted_rate(discount_rate = .08, inflation_rate = .025)

## -----------------------------------------------------------------------------
weights            <- c(.5, .3, .2)
item_validities    <- c(.40, .30, .25)
item_reliabilities <- c(.85, .80, .75)
item_cor <- matrix(c(
  1.00, .30, .20,
  .30, 1.00, .25,
  .20, .25, 1.00
), 3, 3, byrow = TRUE)

fuse_validity(weights, item_cor, item_validities)
fuse_reliability(weights, item_cor, item_reliabilities)

# fuse_composite_cor() returns the correlation matrix between several composites
# whose weights are stacked column-wise. The example below contrasts a unit-weighted
# composite with a validity-weighted composite of the same items.
W <- cbind(unit = c(1, 1, 1), validity_weighted = item_validities)
fuse_composite_cor(weights_matrix = W, item_cor = item_cor)

## -----------------------------------------------------------------------------
disattenuate_correlation(r_observed = .35, reliability_x = .85, reliability_y = .70)

## -----------------------------------------------------------------------------
correct_r_direct_range_restriction(
  r_restricted            = .25,
  range_restriction_ratio = 1.40
)

## -----------------------------------------------------------------------------
# Three-variable example: selection on X1 (cognitive ability, the predictor used as
# the selection variable); incidental restriction on X2 (interview) and Y (criterion).
sigma_star <- matrix(c(
  1.00, .30, .25,
  .30, 1.00, .20,
  .25, .20, 1.00
), 3, 3)
# Unrestricted SD of X1 is 1/.6 times the restricted SD; variance increases by 1/.6^2.
sigma_ss_unrestricted <- matrix(1 / 0.6^2, 1, 1)
correct_r_lawley(
  sigma_restricted      = sigma_star,
  selection_indices     = 1,
  sigma_ss_unrestricted = sigma_ss_unrestricted
)

## -----------------------------------------------------------------------------
S11 <- matrix(c(1, .30, .30, 1), 2, 2)
S12 <- matrix(c(.30, .20, .25, .15), 2, 2)
S22 <- matrix(c(1, .40, .40, 1), 2, 2)

restricted_canonical_validity(S11, S12, S22, criterion_weights = c(.6, .4))

## -----------------------------------------------------------------------------
Rxx <- matrix(c(1, .30, .20,
                .30, 1, .25,
                .20, .25, 1), 3, 3, byrow = TRUE)
Rxy <- matrix(c(.30, .20,
                .25, .15,
                .10, .35), 3, 2, byrow = TRUE)
Ryy <- matrix(c(1, .40, .40, 1), 2, 2)

incremental_validity(
  predictor_cor = Rxx,
  predictor_criterion_cor = Rxy,
  criterion_cor = Ryy,
  criterion_weights = c(.6, .4),
  baseline_predictors = 1:2,
  added_predictors = 3
)

## -----------------------------------------------------------------------------
# For predictor-importance methods, the criterion side collapses to a single
# criterion (e.g., overall job performance):
rxy_single <- c(.30, .25, .35)
relative_weights(predictor_cor = Rxx, criterion_cor = rxy_single)
dominance_analysis(predictor_cor = Rxx, predictor_criterion_cor = rxy_single)

## -----------------------------------------------------------------------------
S11 <- matrix(c(1, .30, .30, 1), 2, 2)
S12 <- matrix(c(.30, .10, .15, .25), 2, 2, byrow = TRUE)
S22 <- matrix(c(1, .40, .40, 1), 2, 2)

s <- sturman_comprehensive(
  validity                       = .35,
  baseline_validity              = .20,
  selection_ratio                = .20,
  sdy                            = 50000,
  n_year_one                     = 100,
  tenure                         = 5,
  fixed_cost                     = 75000,
  hires_per_period               = c(100, 15, 15, 15, 15),
  losses_per_period              = c(0, 15, 15, 15, 15),
  tax_rate                       = .25,
  discount_rate                  = .08,
  predictor_cor                  = S11,
  predictor_criterion_cor        = S12,
  criterion_cor                  = S22,
  criterion_weights              = c(.7, .3),
  probation_cutoff_z             = -1,
  acceptance_rate                = .70,
  quality_acceptance_correlation = -0.20
)

s