# \donttest{
# simulate some data
N <- 1000
J <- 20 # number of items
a <- matrix(rlnorm(J,.2,.3))
d <- rnorm(J)
theta <- matrix(rnorm(N))
dat_pre <- simdata(a, d, itemtype = '2PL', Theta = theta)
# first 3 cases decrease by 1/2
theta2 <- theta - c(1/2, 1/2, 1/2, numeric(N-3))
dat_post <- simdata(a, d, itemtype = '2PL', Theta = theta2)
mod <- mirt(dat_pre)
# all changes using fitted model from pre data
RCI(mod, predat=dat_pre, postdat=dat_post)
# reported all expected change estimates in the original test-score metric
RCI(mod, predat=dat_pre, postdat=dat_post, expected.scores=TRUE)
# single response pattern change using EAP information
RCI(mod, predat=dat_pre[1,], postdat=dat_post[1,])
# WLE estimator with Fisher information for SE (see Jabrayilov et al. 2016)
RCI(mod, predat = dat_pre[1,], postdat = dat_post[1,],
method = 'WLE', Fisher = TRUE)
# multiple respondents
RCI(mod, predat = dat_pre[1:6,], postdat = dat_post[1:6,])
# include large-sample z-type cutoffs
RCI(mod, predat = dat_pre[1:6,], postdat = dat_post[1:6,],
cutoffs = c(-1.96, 1.96))
######
# CTT version by omitting IRT model
# Requires either sample or population SEM's as input
(istats <- itemstats(dat_pre)$overall)
SEM.alpha <- istats$SEM.alpha # SEM estimate of dat_pre
# assumes SEM.post = SEM.pre
RCI(predat = dat_pre, postdat = dat_post, SEM.pre=SEM.alpha)
# include cutoffs
RCI(predat = dat_pre, postdat = dat_post, SEM.pre=SEM.alpha,
cutoffs=c(-1.96, 1.96))
# allows SEM.post != SEM.pre
(istats.post <- itemstats(dat_post)$overall)
SEM.alpha.post <- istats.post$SEM.alpha
RCI(predat = dat_pre, postdat = dat_post,
SEM.pre=SEM.alpha, SEM.post=SEM.alpha.post)
# Supplying only the total scores
TS_pre <- matrix(rowSums(dat_pre))
TS_post <- matrix(rowSums(dat_post))
RCI(predat = TS_pre, postdat = TS_post,
SEM.pre=SEM.alpha, SEM.post=SEM.alpha.post)
######
# interactive shiny interfaces for live scoring
mod_pre <- mirt(Science)
# (optional) setup mod_post to have medium effect size change (d = 0.5)
sv <- mod2values(mod_pre)
sv$value[sv$name == 'MEAN_1'] <- 0.5
mod_post <- mirt(Science, pars=sv, TOL=NA)
# only use pre-test model for scoring
if(interactive()){
RCI(mod_pre=mod_pre, shiny=TRUE)
# use both pre-test and post-test models for including empirical priors
RCI(mod_pre=mod_pre, mod_post=mod_post, shiny=TRUE,
main='Perceptions of Science and Technology')
}
############################
# Example where individuals take completely different item set pre-post
# but prior calibration has been performed to equate the items
dat <- key2binary(SAT12,
key = c(1,4,5,2,3,1,2,1,3,1,2,4,2,1,5,3,4,4,1,4,3,3,4,1,3,5,1,3,1,5,4,5))
mod <- mirt(dat)
# with N=5 individuals under investigation
predat <- postdat <- dat[1:5,]
predat[, 17:32] <- NA
postdat[, 1:16] <- NA
head(predat)
head(postdat)
RCI(mod, predat, postdat)
# expected scores /32 (even though only /16 items answered)
RCI(mod, predat, postdat, expected.scores=TRUE)
######
# Two-dimensional IRT model for each time point, 20 items (no DIF)
J <- 20
N <- 500
slopes <- rlnorm(J, .2, .2)
a <- matrix(c(slopes, numeric(J*2), slopes),J*2)
ints <- rnorm(J)
d <- matrix(c(ints, ints), ncol=1)
data.frame(a=a, d=d)
# mean effects across time
mu <- c(0, -1/2)
sigma <- matrix(c(1, .7, .7, 1), 2,2)
dat <- simdata(a, d, N, mu=mu, sigma=sigma, itemtype = '2PL')
itemstats(dat)$overall
# build equality constraints across time points
constr <- NULL
for(i in (1:J)){
constr <- c(constr, paste0("(", i, ',', i+J, ",a1,a2)"))
constr <- c(constr, paste0("(", i, ',', i+J, ",d)"))
}
constr <- paste0(constr, collapse=',')
# define model where item parameters constrained over time, and
# latent trait has potential scale-location changes (e.g., regression to the
# mean effects)
model <- sprintf("
thetapre = 1-%i,
thetapost = %i-%i,
COV = thetapre*thetapost, thetapost*thetapost
MEAN = thetapost
CONSTRAIN = %s", J, J+1, 2*J, constr)
cat(model)
# fit the model to calibration data
mod <- mirt(dat, model = model, SE=TRUE)
coef(mod, printSE=TRUE)
coef(mod, simplify=TRUE)
summary(mod)
# test data
Theta <- cbind(c(0, 1, 2), c(0,1,2))
nochange <- simdata(a, d, itemtype = '2PL', Theta = Theta)
change <- simdata(a, d, itemtype = '2PL', Theta = Theta +
cbind(0, c(-1, -1, -1)))
# total score differences
data.frame(pre=rowSums(nochange[,1:J]),
post=rowSums(nochange[,1:J + J]))
data.frame(pre=rowSums(change[,1:J]),
post=rowSums(change[,1:J + J]))
RCI(mod, predat = nochange)
RCI(mod, predat = change)
# expected total-score metric reported instead
RCI(mod, predat = nochange, expected.scores=TRUE)
RCI(mod, predat = change, expected.scores=TRUE)
# }
Run the code above in your browser using DataLab