library(kirkegaard)
## Loading required package: tidyverse
## ── Attaching packages ─────────────────────────────────────── tidyverse 1.3.2 ──
## ✔ ggplot2 3.3.6      ✔ purrr   0.3.5 
## ✔ tibble  3.1.8      ✔ dplyr   1.0.10
## ✔ tidyr   1.2.1      ✔ stringr 1.4.1 
## ✔ readr   2.1.3      ✔ forcats 0.5.2 
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()
## Loading required package: magrittr
## 
## 
## Attaching package: 'magrittr'
## 
## 
## The following object is masked from 'package:purrr':
## 
##     set_names
## 
## 
## The following object is masked from 'package:tidyr':
## 
##     extract
## 
## 
## Loading required package: weights
## 
## Loading required package: Hmisc
## 
## Loading required package: lattice
## 
## Loading required package: survival
## 
## Loading required package: Formula
## 
## 
## Attaching package: 'Hmisc'
## 
## 
## The following objects are masked from 'package:dplyr':
## 
##     src, summarize
## 
## 
## The following objects are masked from 'package:base':
## 
##     format.pval, units
## 
## 
## Loading required package: assertthat
## 
## 
## Attaching package: 'assertthat'
## 
## 
## The following object is masked from 'package:tibble':
## 
##     has_name
## 
## 
## Loading required package: psych
## 
## 
## Attaching package: 'psych'
## 
## 
## The following object is masked from 'package:Hmisc':
## 
##     describe
## 
## 
## The following objects are masked from 'package:ggplot2':
## 
##     %+%, alpha
## 
## 
## 
## Attaching package: 'kirkegaard'
## 
## 
## The following object is masked from 'package:psych':
## 
##     rescale
## 
## 
## The following object is masked from 'package:assertthat':
## 
##     are_equal
## 
## 
## The following objects are masked from 'package:purrr':
## 
##     is_logical, is_numeric
## 
## 
## The following object is masked from 'package:base':
## 
##     +
load_packages(
  MASS,
  doFuture,
  furrr,
  patchwork
)
## 
## Attaching package: 'MASS'
## 
## The following object is masked from 'package:dplyr':
## 
##     select
## 
## Loading required package: foreach
## 
## Attaching package: 'foreach'
## 
## The following objects are masked from 'package:purrr':
## 
##     accumulate, when
## 
## Loading required package: future
## 
## Attaching package: 'future'
## 
## The following object is masked from 'package:survival':
## 
##     cluster
## 
## 
## Attaching package: 'patchwork'
## 
## The following object is masked from 'package:MASS':
## 
##     area
plan(multisession)
doFuture::registerDoFuture()

theme_set(theme_bw())

n_reps = 10000
n_applicants = 10

set.seed(1)
results = future_map_dfr(1:n_reps, .options = furrr_options(seed = T), function(i) {
  #loop across correlation sizes
  map_df(seq(.05, .95, .05), function(r) {
    #simulate persons from MVN
    d = MASS::mvrnorm(n = 10, mu = c(0, 0), Sigma = matrix(c(1, r, r, 1), nrow = 2)) %>% as.data.frame() %>% arrange(-V1)
    
    tibble(
      r = r,
      selected = d$V2[1]
    )
    
  })
})

#plot results
results_means = results %>% group_by(r) %>% summarise(mean_job_perf = mean(selected), n = n()) %>% mutate(rsq = r^2)

r_plot = ggplot(results_means, aes(r, mean_job_perf)) +
  geom_line() +
  scale_y_continuous("Standard deviation gain in job performance compared to random hiring", breaks = seq(0, 2, .1)) +
  scale_x_continuous(breaks = seq(0, 1, .1))

rsq_plot = ggplot(results_means, aes(rsq, mean_job_perf)) +
  geom_line() +
  scale_y_continuous("Standard deviation gain in job performance compared to random hiring", breaks = seq(0, 2, .1)) +
  scale_x_continuous(breaks = seq(0, 1, .1))

r_plot + rsq_plot

GG_save("r_vs_rsq_gains.png")

We can see that rsq is not linearly related to job performance gains.