inst/doc/Plausible_Values.R

In dexter: Data Management and Analysis of Tests

## ----setup, include=FALSE-----------------------------------------------------
library(knitr)
opts_chunk$set(echo = TRUE)

if (requireNamespace("Cairo", quietly = TRUE)) 
{
  opts_chunk$set(dev='CairoPNG')
}
par_hook = function(before, options, envir)
{
  if(before)
  {
    do.call(par, options$par)
  }
}
knit_hooks$set(par = par_hook)

RcppArmadillo::armadillo_throttle_cores(1)

library(dexter)
library(dplyr)
library(tidyr)

select = dplyr::select # fixes a weird bug

## -----------------------------------------------------------------------------
sim_PV = function(theta, delta) {
  nit = length(delta)
  sim_func = r_score( tibble(item_id=1:nit, item_score=1, delta=delta))
  simulated_data = sim_func(theta)
  parms = fit_enorm(simulated_data)
  pv = plausible_values(simulated_data, parms, nPV = 10)
  
  plot(x=c(min(theta)-.5, max(theta)+.5), y = 0:1, 
       main = paste(nit, "items"), type='n',
       xlab=expression(theta), ylab = expression(Fn(theta)))
  
  select(pv, starts_with('PV')) |>
    lapply(function(x) lines(ecdf(x-mean(x)), col=rgb(.7,.7,.7,.5)))

  lines(ecdf(theta-mean(theta)))
}

## ----fig.align='center', fig.height=4,fig.width=4,par=list(bty='l')-----------
nP = 600
theta = rnorm(nP)
delta = runif(50, -2, 2)
sim_PV(theta, delta)

## ----fig.align='center',  fig.width=7,par=list(bty='l')-----------------------
grp = sample(2, nP, replace = TRUE, prob = c(.5,.5))
theta = rnorm(nP, mean = c(-2,2)[grp], sd = c(0.5,1.5)[grp])
plot(density(theta),main='')

## ----fig.align='center',  fig.width=7,par=list(bty='l',mfrow=c(1,3))----------
sim_PV(theta, delta[1:10])
sim_PV(theta, delta[1:20])
sim_PV(theta, delta)

## -----------------------------------------------------------------------------
sim_PV2 = function(theta, delta) {
  nit = length(delta)
  sim_func = r_score( tibble(item_id=1:nit, item_score=1, delta=delta))
  simulated_data = sim_func(theta)
  parms = fit_enorm(simulated_data, method="Bayes", nDraws = 50)
  
  plot(x=c(min(theta)-.5, max(theta)+.5), y=0:1, main=paste(nit, "items"), type='n',
       xlab=expression(theta), ylab = expression(Fn(theta)))
  
  which.draw = 5*(1:10)
  for (iter in 1:10) {
    pv = plausible_values(simulated_data, parms, parms_draw=which.draw[iter])
    lines(ecdf(pv$PV1-mean(pv$PV1)), col=rgb(.7,.7,.7,.5))
  }
  lines(ecdf(theta-mean(theta)))
}

## ----make_pv2, fig.align='center',fig.width=7, par=list(mfrow=c(1,3),bty='l')----
sim_PV2(theta, delta[1:10])
sim_PV2(theta, delta[1:20])
sim_PV2(theta, delta)

## ----make_pv3, fig.align='center',fig.width=7,par=list(mfrow=c(1,3))----------
sim_PV3 = function(theta, delta) {
  nit = length(delta)
  sim_func = r_score( tibble(item_id=1:nit, item_score=1, delta=delta))
  simulated_data = sim_func(theta)
  parms = fit_enorm(simulated_data)
  pv = plausible_values(simulated_data, parms, nPV = 10, prior_dist = "mixture")
  
  plot(x=c(min(theta)-.5, max(theta)+.5), y=0:1, 
       main=paste(nit, "items"), type='n',
       xlab=expression(theta), ylab = expression(Fn(theta)))
  
  select(pv, starts_with('PV')) |>
    lapply(function(x) lines(ecdf(x-mean(x)), col=rgb(.7,.7,.7,.5)))

  lines(ecdf(theta-mean(theta)))
}

sim_PV3(theta, delta[1:10])
sim_PV3(theta, delta[1:20])
sim_PV3(theta, delta)

## ----make_pv4, fig.align='center',fig.width=7,par=list(mfrow=c(1,3),bty='l')----

sim_PV4 = function(theta, delta, group) {
  nit = length(delta)
  sim_func = r_score( tibble(item_id=1:nit, item_score=1, delta=delta))
  
  # turn simulated data into long format
  simulated_data = sim_func(theta) |>
    get_responses() |>
    inner_join(tibble(person_id=1:length(group), group = group), 
               by='person_id')
  
  parms = fit_enorm(simulated_data)
  
  pv = plausible_values(simulated_data, parms, covariates='group',nPV = 10)
  
  plot(x=c(min(theta)-.5, max(theta)+.5), y=0:1, main=paste(nit, "items"), type='n',
       xlab=expression(theta), ylab = expression(Fn(theta)))
  select(pv, starts_with('PV')) |>
    lapply(function(x) lines(ecdf(x-mean(x)), col=rgb(.7,.7,.7,.5)))
  lines(ecdf(theta-mean(theta)))
}

sim_PV4(theta, delta[1:10],grp)
sim_PV4(theta, delta[1:20],grp)
sim_PV4(theta, delta,grp)


## ----include=FALSE------------------------------------------------------------
RcppArmadillo::armadillo_reset_cores()