#single factor
set.seed(12345)
a <- matrix(abs(rnorm(15,1,.3)), ncol=1)
d <- matrix(rnorm(15,0,.7),ncol=1)
itemtype <- rep('dich', nrow(a))
N <- 1000
dataset1 <- simdata(a, d, N, itemtype)
dataset2 <- simdata(a, d, N, itemtype, mu = .1, sigma = matrix(1.5))
dat <- rbind(dataset1, dataset2)
group <- c(rep('D1', N), rep('D2', N))
models <- confmirt.model('F1 = 1-15')
mod_configural <- multipleGroup(dat, models, group = group) #completely separate analyses
# prev.mod can save precious iterations and help to avoid local minimums
mod_metric <- multipleGroup(dat, models, group = group, invariance=c('slopes')) #equal slopes
#equal intercepts, free variance and means
mod_scalar2 <- multipleGroup(dat, models, group = group,
invariance=c('slopes', 'intercepts', 'free_varcov','free_means'))
mod_scalar1 <- multipleGroup(dat, models, group = group, #fixed means
invariance=c('slopes', 'intercepts', 'free_varcov'))
mod_fullconstrain <- multipleGroup(dat, models, group = group,
invariance=c('slopes', 'intercepts'))
summary(mod_scalar2)
coef(mod_scalar2)
residuals(mod_scalar2)
plot(mod_configural)
plot(mod_configural, type = 'score')
itemplot(mod_configural, 2)
itemplot(mod_configural, 2, type = 'RE')
anova(mod_metric, mod_configural) #equal slopes only
anova(mod_scalar2, mod_metric) #equal intercepts, free variance and mean
anova(mod_scalar1, mod_scalar2) #fix mean
anova(mod_fullconstrain, mod_scalar1) #fix variance
#test whether first 6 slopes should be equal across groups
values <- multipleGroup(dat, models, group = group, pars = 'values')
values
constrain <- list(c(1, 63), c(5,67), c(9,71), c(13,75), c(17,79), c(21,83))
equalslopes <- multipleGroup(dat, models, group = group, constrain = constrain)
anova(equalslopes, mod_configural)
#############
#DIF test for each item (using all other items as anchors)
itemnames <- colnames(dat)
refmodel <- multipleGroup(dat, models, group = group,
invariance=c('free_means', 'free_varcov', itemnames))
#loop over items (in practice, run in parallel to increase speed)
estmodels <- vector('list', ncol(dat))
for(i in 1:ncol(dat))
estmodels[[i]] <- multipleGroup(dat, models, group = group, verbose = FALSE,
invariance=c('free_means', 'free_varcov', itemnames[-i]))
(anovas <- lapply(estmodels, anova, object2=refmodel))
#family-wise error control
p <- do.call(rbind, lapply(anovas, function(x) x[2,9]))
p.adjust(p, method = 'BH')
#same as above, except only test if slopes vary (1 df)
#constrain all intercepts
estmodels <- vector('list', ncol(dat))
for(i in 1:ncol(dat))
estmodels[[i]] <- multipleGroup(dat, models, group = group, verbose = FALSE,
invariance=c('free_means', 'free_varcov', 'intercepts',
itemnames[-i]))
(anovas <- lapply(estmodels, anova, object2=refmodel))
#############
#multiple factors
a <- matrix(c(abs(rnorm(5,1,.3)), rep(0,15),abs(rnorm(5,1,.3)),
rep(0,15),abs(rnorm(5,1,.3))), 15, 3)
d <- matrix(rnorm(15,0,.7),ncol=1)
mu <- c(-.4, -.7, .1)
sigma <- matrix(c(1.21,.297,1.232,.297,.81,.252,1.232,.252,1.96),3,3)
itemtype <- rep('dich', nrow(a))
N <- 1000
dataset1 <- simdata(a, d, N, itemtype)
dataset2 <- simdata(a, d, N, itemtype, mu = mu, sigma = sigma)
dat <- rbind(dataset1, dataset2)
group <- c(rep('D1', N), rep('D2', N))
#group models
model <- confmirt.model()
F1 = 1-5
F2 = 6-10
F3 = 11-15
models <- list(D1=model, D2=model) #note the names match the groups
#EM approach (not as accurate with 3 factors, but generally good for quick model comparisons)
mod_configural <- multipleGroup(dat, models, group = group) #completely separate analyses
mod_metric <- multipleGroup(dat, models, group = group, invariance=c('slopes')) #equal slopes
mod_scalar <- multipleGroup(dat, models, group = group, #equal means, slopes, intercepts
invariance=c('slopes', 'intercepts', 'free_varcov'))
mod_fullconstrain <- multipleGroup(dat, models, group = group, #equal means, slopes, intercepts
invariance=c('slopes', 'intercepts'))
anova(mod_metric, mod_configural)
anova(mod_scalar, mod_metric)
anova(mod_fullconstrain, mod_scalar)
#same as above, but with MHRM (more accurate with 3 factors, but slower)
#completely separate analyses
mod_configural <- multipleGroup(dat, models, group = group, method = 'MHRM')
#equal slopes
mod_metric <- multipleGroup(dat, models, group = group, invariance=c('slopes'), method = 'MHRM')
#equal means, slopes, intercepts
mod_scalar <- multipleGroup(dat, models, group = group, method = 'MHRM',
invariance=c('slopes', 'intercepts', 'free_varcov'))
#equal means, slopes, intercepts
mod_fullconstrain <- multipleGroup(dat, models, group = group, method = 'MHRM',
invariance=c('slopes', 'intercepts'))
anova(mod_metric, mod_configural)
anova(mod_scalar, mod_metric)
anova(mod_fullconstrain, mod_scalar)
############
#polytomous item example
set.seed(12345)
a <- matrix(abs(rnorm(15,1,.3)), ncol=1)
d <- matrix(rnorm(15,0,.7),ncol=1)
d <- cbind(d, d-1, d-2)
itemtype <- rep('graded', nrow(a))
N <- 1000
dataset1 <- simdata(a, d, N, itemtype)
dataset2 <- simdata(a, d, N, itemtype, mu = .1, sigma = matrix(1.5))
dat <- rbind(dataset1, dataset2)
group <- c(rep('D1', N), rep('D2', N))
models <- confmirt.model('F1 = 1-15')
models2 <- confmirt.model('
F1 = 1-10
F2 = 10-15')
mod_configural <- multipleGroup(dat, models, group = group)
plot(mod_configural)
plot(mod_configural, type = 'SE')
itemplot(mod_configural, 1)
itemplot(mod_configural, 1, type = 'info')
fs <- fscores(mod_configural)
head(fs[["D1"]])
fscores(mod_configural, method = 'EAPsum')
mod_configural2 <- multipleGroup(dat, models2, group = group)
plot(mod_configural2, type = 'infocontour')
plot(mod_configural2, type = 'SE')
plot(mod_configural2, type = 'RE')
itemplot(mod_configural2, 10)
Run the code above in your browser using DataLab