inst/doc/Vignette.R

In r4lineups: Statistical Inference on Lineup Fairness

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

## ------------------------------------------------------------------------
library(r4lineups)
data(nortje2012)

## ---- echo=FALSE, results='asis'-----------------------------------------
pander::pandoc.table(nortje2012[1:3,], "nortje2012 data")

## ---- include=FALSE------------------------------------------------------
lineup_vec   <- nortje2012$lineup_1
lineup_list  <- as.list(nortje2012)
lineup_table <- table(lineup_vec)

## ------------------------------------------------------------------------
library(r4lineups)

lineup_prop_vec(lineup_vec, target_pos = 3, k = 8)

## ---- indent = "  ", warning=FALSE---------------------------------------
bootobject <- boot::boot(lineup_vec, lineup_prop_boot, target_pos = 3, R = 1000)
bootobject

## ---- indent = "  ", warning=FALSE---------------------------------------
cis <- boot::boot.ci(bootobject, conf = 0.95, type = "bca")
cis

## ------------------------------------------------------------------------
allprop(lineup_vec, k = 8)

## ---- indent = "  "------------------------------------------------------
lineuprops.ci <- lineup_boot_allprop(lineup_vec, target_pos, k = 8)
lineuprops.ci

## ---- indent = "  "------------------------------------------------------
func_size_report(lineup_vec, target_pos = 3, k = 8)

## ---- indent = "  "------------------------------------------------------
esize_m(table(lineup_vec), k = 8, both = TRUE)


## ----indent = "  "-------------------------------------------------------
#Create a dataframe of bootstrapped lineup data
bootdata <- gen_boot_samples(lineup_vec, 1000)

#Calculate effective size for each lineup in bootdata
#Pass bootstrap df to function
#Nominal size is again declared by user
lineupsizes <- gen_esize_m(bootdata, k = 8)

#Pass vector of boostrapped effective sizes to gen_esize_m_ci
#to calculate lower and upper CIs with desired level of alpha
gen_esize_m_ci(lineupsizes, perc = .025)
gen_esize_m_ci(lineupsizes, perc = .975)

## ---- indent = "  "------------------------------------------------------
gen_boot_propmean_se(lineupsizes)

## ------------------------------------------------------------------------
#Compute effective size from a single vector of lineup choices
esize_T(lineup_table)

#Compute bootstrapped effective size
esize_boot <- boot::boot(lineup_table, esize_T_boot, R = 1000)

#View boot object
esize_boot

#Get confidence intervals
esize_boot.ci <- boot::boot.ci(esize_boot)
esize_boot.ci


## ------------------------------------------------------------------------
eff_size_per_foils(lineup_vec, target_pos, k = 8, conf = 0.95)

## ------------------------------------------------------------------------
#Get data
linedf <- nortje2012[1:2]

#Compare effective size
effsize_compare(linedf)

## ---- indent = "  "------------------------------------------------------
#Target present & target absent lineup data for 1 lineup pair 
TP_lineup <- nortje2012$lineup_1
TA_lineup <- nortje2012$lineup_3

#Compute diagnosticity ratio
diag_ratio_W(TP_lineup, TA_lineup, pos_pres = 3, pos_abs = 7, k1 =8, k2 = 8)
diag_ratio_T(TP_lineup, TA_lineup, pos_pres = 3, pos_abs = 7, k1 =8, k2 = 8)


## ---- indent = "  "------------------------------------------------------
var_diag_ratio(TP_lineup, TA_lineup, 3, 7, 8, 8)

## ---- indent = "  "------------------------------------------------------
#Target present data:
TP_lineup1 <-       round(runif(100,1,6))
TP_lineup2 <-       round(runif(70,1,5))
TP_lineup3 <-       round(runif(20,1,4))
lineup_pres_list <- list(TP_lineup1, TP_lineup2, TP_lineup3)

#Target absent data:
TA_lineup1 <-       round(runif(100,1,6))
TA_lineup2 <-       round(runif(70,1,5))
TA_lineup3 <-       round(runif(20,1,4))
lineup_abs_list <-  list(TA_lineup1, TA_lineup2, TA_lineup3)


## ------------------------------------------------------------------------
lineup1_pos <- c(1, 2, 3, 4, 5, 6)
lineup2_pos <- c(1, 2, 3, 4, 5)
lineup3_pos <- c(1, 2, 3, 4)
pos_list    <- list(lineup1_pos, lineup2_pos, lineup3_pos)

## ---- include = FALSE----------------------------------------------------
k <- c(6, 5, 4)

## ---- warning=FALSE------------------------------------------------------
homog_diag(lineup_pres_list, lineup_abs_list, pos_list, k)

## ---- echo=FALSE---------------------------------------------------------
knitr::include_graphics("homog.png", dpi = 120)

## ---- echo = F, results='asis', warning=FALSE----------------------------
#Load ROC data: mickwick sample data
data(mickwick)
pander::pandoc.table(mickwick[1:8,], "Confacc data")

## ---- fig.cap= "ROC Curve for Confidence ~ Accuracy", fig.width= 5, warning=FALSE----
#Call roc function
make_roc(mickwick)

## ------------------------------------------------------------------------
foil1 <- magick::image_read('https://raw.githubusercontent.com/tmnaylor/malpass_foils/master/malp1.jpg')

## ---- fig.align='center'-------------------------------------------------
print(foil1)

## ---- echo=FALSE---------------------------------------------------------
knitr::include_graphics("lineupimage1.png")

## ---- echo = FALSE, fig.cap= "Set of faces is printed to viewer pane"----
knitr::include_graphics("lineupimage2.png", dpi = 100)

## ---- echo = FALSE, fig.cap= "Returns factor loading for each face"------
knitr::include_graphics("lineupimage3.png")