## ----setup, include = FALSE---------------------------------------------------
knitr::opts_chunk$set(collapse = TRUE, comment = "#>", fig.width = 6, fig.height = 4)

## ----data---------------------------------------------------------------------
library(PP)
set.seed(1337)
b  <- seq(-2.5, 2.5, length.out = 20)
sl <- round(runif(20, 0.7, 1.6), 2)
la <- round(runif(20, 0.05, 0.2), 2)
x  <- sim_4pl(beta = b, alpha = sl, lowerA = la, upperA = 1, theta = rnorm(300))
x[1:15, ] <- matrix(rbinom(15 * 20, 1, 0.5), 15)     # random answers

## ----pfit---------------------------------------------------------------------
res <- PP_4pl(respm = x, thres = b, slopes = sl, lowerA = la, type = "wle")
fit <- Pfit(res, fitindices = c("lz", "lzstar", "infit", "outfit"))

## ----parts--------------------------------------------------------------------
head(fit$lzstar)
head(fit$infit)

## ----summary------------------------------------------------------------------
s <- summary(fit, alpha = 0.05)

## ----flagged------------------------------------------------------------------
flag <- which(fit$lzstar[, "lzstar"] < qnorm(0.05))
flag
mean(1:15 %in% flag)

## ----plot, fig.alt = "lz* of all persons against their ability estimate, random responders in red"----
plot(res$estimates$estimate, fit$lzstar[, "lzstar"],
     col = ifelse(seq_len(300) <= 15, "red", "grey40"), pch = 19,
     xlab = "WLE estimate", ylab = "lz*")
abline(h = qnorm(0.05), lty = 2)

## ----profile, fig.width = 7, fig.height = 4, fig.alt = "Observed against expected score of every item for two random responders, with unexpected answers marked"----
plot(res, which = "profile", person = flag[1:2])

## ----se-----------------------------------------------------------------------
fit_se <- Pfit(res, fitindices = c("lzstar", "outfit"), SE = TRUE)
head(fit_se$lzstar)

## ----gpcm---------------------------------------------------------------------
thres <- rbind(c(-1.5, -1, -0.5, 0, 0.5, 1),
               c(0, 0.5, 1, 1.2, 1.5, 2))
xg <- sim_gpcm(thres = thres, alpha = c(1, 1.2, 0.8, 1.1, 0.9, 1), theta = rnorm(200))
xg[sample(length(xg), 100)] <- NA
resg <- PP_gpcm(respm = xg, thres = thres, slopes = c(1, 1.2, 0.8, 1.1, 0.9, 1), type = "mle")
fitg <- Pfit(resg)
summary(fitg)