mirt (version 1.47)

RCI: Model-based Reliable Change Index

Description

Computes an IRT version of the "reliable change index" (RCI) proposed by Jacobson and Traux (1991) but modified to use IRT information about scores and measurement error (see Jabrayilov, Emons, and Sijtsma (2016)). Main benefit of the IRT approach is the inclusion of response pattern information in the pre/post data score estimates, as well as conditional standard error of measurement information. Models can be specified as separate unidimensional IRT models fitted via mirt (or extracted from multipleGroup via extract.group), or a two-dimensional model where the latent traits correspond to the two test administrations.

Usage

RCI(
  mod_pre,
  predat,
  postdat,
  mod_post = mod_pre,
  cutoffs = NULL,
  SEM.pre = NULL,
  SEM.post = NULL,
  Fisher = FALSE,
  zero_cor = TRUE,
  expected.scores = FALSE,
  shiny = FALSE,
  main = "Test Scores",
  ...
)

Arguments

mod_pre

single-group model fitted by mirt. If not supplied the information will be extracted from the data input objects to compute the classical test theory version of the RCI statistics

predat

a vector (if one individual) or matrix/data.frame of response data to be scored, where each individuals' responses are included in exactly one row.

If total score information only is to be used instead of the complete response matrix then a matrix object with exactly ncol = 1 columns should be provided

postdat

same as predat, but with respect to the post/follow-up measurement. Ignored when a two-dimensional IRT model is included.

For the original RCI approach, a matrix containing the complete responses, or a matrix with one column containing only the total scores, can be provided

mod_post

(optional) IRT model for post-test if different from pre-test; otherwise, the pre-test model will be used. Ignored when a two-dimensional model IRT is included

cutoffs

optional vector of length 2 indicating the type of cut-offs to report (e.g., c(-1.96, 1.96) reflects the 95 percent z-score type cut-off)

SEM.pre

standard error of measurement for the pretest. This can be used instead of rxx.pre and SD.pre

SEM.post

(optional) standard error of measurement for the post-test. Using this will create a pooled version of the SEM; otherwise, SEM.post = SEM.pre

Fisher

logical; use the Fisher/expected information function to compute the SE terms? If FALSE the SE information will be extracted from the select fscores method (default). Only applicable for unidimensional models

zero_cor

logical; when the supplied mod_pre is a two-factor model should the covariance/correlation between the latent traits be forced to be 0?

expected.scores

logical; when using IRT scoring methods, should the expected total scores be reported instead of the scaled (theta) scores returned from fscores? When set to TRUE the factor score estimates are passed to expected.test, and delta method standard error for the difference between teh scores are reported, however the original z and p-value information will be unchanged

shiny

logical; launch an interactive shiny applications for real-time scoring of supplied total-scores or response vectors? Only requires mod_pre and (optional) mod_post inputs

main

main label to use when shiny=TRUE

...

additional arguments passed to fscores

Author

Phil Chalmers

References

Chalmers, R. P. (2012). mirt: A Multidimensional Item Response Theory Package for the R Environment. Journal of Statistical Software, 48(6), 1-29. tools:::Rd_expr_doi("10.18637/jss.v048.i06")

Jacobson, N. S., & Truax, P. (1991). Clinical significance: A statistical approach to defining meaningful change in psychotherapy research. Journal of Consulting and Clinical Psychology, 59, 12-19.

Jabrayilov, R. , Emons, W. H. M., & Sijtsma, K. (2016). Comparison of Classical Test Theory and Item Response Theory in Individual Change Assessment. Applied Psychological Measurement, 40 (8), 559-572.

Examples

# \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')
colnames(dat) <- c(paste0('Item.pre_', 1:20), paste0('Item.post_', 1:20))
itemstats(dat[,1:20])$overall
itemstats(dat[,21:40])$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(-2, -2, -2)))

# 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)

############
# Similar example using the GRM instead, however
#  accounting for missing categories pre-post test (requires
#  the customK technical and strong equality constraints
#  to control the missing parameters)

J <- 20
N <- 500
slopes <- rlnorm(J, .2, .2)
a <- matrix(c(slopes, numeric(J*2), slopes),J*2)
ints <- rnorm(J)
diffs <- t(apply(matrix(runif(20*4, .3, 1), 20), 1, cumsum))
diffs <- -(diffs - rowMeans(diffs))
d <- diffs + rnorm(20)
d <- rbind(d,d)
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 = 'graded')
colnames(dat) <- c(paste0('Item.pre_', 1:20), paste0('Item.post_', 1:20))
itemstats(dat[,1:20])$overall
itemstats(dat[,21:40])$overall

# add missing response elements to dataset
datM <- dat
datM[datM[,1] == 4, 1] <- 3
datM[datM[,2] == 1, 2] <- 0
datM[datM[,3] == 0, 3] <- 1
itemstats(datM[,1:20])

# build equality constraints across time points
constr <- NULL
for(i in (1:J)){
    # constrain slopes across items/dimensions
    constr <- c(constr, paste0("(", i, ',', i+J, ",a1,a2)"))
    # constrain intercepts to be equal (required if any category missing)
    constr <- c(constr, paste0(paste0("(", i, ',', i+J, ",d", 1:4, ")")))
}
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 on original data (no missing responses)
mod <- mirt(dat, model = model, itemtype='graded', SE=TRUE)
coef(mod, printSE=TRUE)
coef(mod, simplify=TRUE)
summary(mod)

# fit on items with missing responses requires customK
modM <- mirt(datM, model = model, itemtype='graded', SE=TRUE,
             technical = list(customK = rep(5, J*2)))

# test data
Theta <- cbind(c(0, 1, 2), c(0,1,2))
nochange <- simdata(a, d, itemtype = 'graded', Theta = Theta)
change <- simdata(a, d, itemtype = 'graded', Theta = Theta +
                      cbind(0, c(-2, -2, -2)))

# 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(modM, predat = nochange)
RCI(modM, predat = change)

# expected total-score metric reported instead
RCI(modM, predat = nochange, expected.scores=TRUE)
RCI(modM, predat = change, expected.scores=TRUE)

# }