# NOT RUN {
#############################################################################
# EXAMPLE 1: Linking dichotomous data with the 2PL model
#############################################################################
data(data.ex16)
dat <- data.ex16
items <- colnames(dat)[-c(1,2)]
# fit grade 1
rdat1 <- TAM::tam_remove_missings( dat[ dat$grade==1, ], items=items )
mod1 <- TAM::tam.mml.2pl( resp=rdat1$resp[, rdat1$items], pid=rdat1$dat$idstud )
summary(mod1)
# fit grade 2
rdat2 <- TAM::tam_remove_missings( dat[ dat$grade==2, ], items=items )
mod2 <- TAM::tam.mml.2pl( resp=rdat2$resp[, rdat2$items], pid=rdat2$dat$idstud )
summary(mod2)
# fit grade 3
rdat3 <- TAM::tam_remove_missings( dat[ dat$grade==3, ], items=items )
mod3 <- TAM::tam.mml.2pl( resp=rdat3$resp[, rdat3$items], pid=rdat3$dat$idstud )
summary(mod3)
# define list of fitted models
tamobj_list <- list( mod1, mod2, mod3 )
#-- link item response models
lmod <- TAM::tam.linking( tamobj_list)
summary(lmod)
# estimate WLEs based on transformed item parameters
parm_list <- lmod$parameters_list
# WLE grade 1
arglist <- list( resp=mod1$resp, B=parm_list[[1]]$B, AXsi=parm_list[[1]]$AXsi )
wle1 <- TAM::tam.mml.wle(tamobj=arglist)
# WLE grade 2
arglist <- list( resp=mod2$resp, B=parm_list[[2]]$B, AXsi=parm_list[[2]]$AXsi )
wle2 <- TAM::tam.mml.wle(tamobj=arglist)
# WLE grade 3
arglist <- list( resp=mod3$resp, B=parm_list[[3]]$B, AXsi=parm_list[[3]]$AXsi )
wle3 <- TAM::tam.mml.wle(tamobj=arglist)
#############################################################################
# EXAMPLE 2: Linking polytomous data with the partial credit model
#############################################################################
data(data.ex17)
dat <- data.ex17
items <- colnames(dat)[-c(1,2)]
# fit grade 1
rdat1 <- TAM::tam_remove_missings( dat[ dat$grade==1, ], items=items )
mod1 <- TAM::tam.mml.2pl( resp=rdat1$resp[, rdat1$items], pid=rdat1$dat$idstud )
summary(mod1)
# fit grade 2
rdat2 <- TAM::tam_remove_missings( dat[ dat$grade==2, ], items=items )
mod2 <- TAM::tam.mml.2pl( resp=rdat2$resp[, rdat2$items], pid=rdat2$dat$idstud )
summary(mod2)
# fit grade 3
rdat3 <- TAM::tam_remove_missings( dat[ dat$grade==3, ], items=items )
mod3 <- TAM::tam.mml.2pl( resp=rdat3$resp[, rdat3$items], pid=rdat3$dat$idstud )
summary(mod3)
# list of fitted TAM models
tamobj_list <- list( mod1, mod2, mod3 )
#-- linking: fix slope because partial credit model is fitted
lmod <- TAM::tam.linking( tamobj_list, fix.slope=TRUE)
summary(lmod)
# WLEs can be estimated in the same way as in Example 1.
#############################################################################
# EXAMPLE 3: Linking dichotomous data with the multiple group 2PL models
#############################################################################
data(data.ex16)
dat <- data.ex16
items <- colnames(dat)[-c(1,2)]
# fit grade 1
rdat1 <- TAM::tam_remove_missings( dat[ dat$grade==1, ], items=items )
# create some grouping variable
group <- ( seq( 1, nrow( rdat1$dat ) ) %% 3 ) + 1
mod1 <- TAM::tam.mml.2pl( resp=rdat1$resp[, rdat1$items], pid=rdat1$dat$idstud, group=group)
summary(mod1)
# fit grade 2
rdat2 <- TAM::tam_remove_missings( dat[ dat$grade==2, ], items=items )
group <- 1*(rdat2$dat$dat$idstud > 500)
mod2 <- TAM::tam.mml.2pl( resp=rdat2$resp[, rdat2$items], pid=rdat2$dat$dat$idstud, group=group)
summary(mod2)
# fit grade 3
rdat3 <- TAM::tam_remove_missings( dat[ dat$grade==3, ], items=items )
mod3 <- TAM::tam.mml.2pl( resp=rdat3$resp[, rdat3$items], pid=rdat3$dat$idstud )
summary(mod3)
# define list of fitted models
tamobj_list <- list( mod1, mod2, mod3 )
#-- link item response models
lmod <- TAM::tam.linking( tamobj_list)
#############################################################################
# EXAMPLE 4: Linking simulated dichotomous data with two groups
#############################################################################
library(sirt)
#*** simulate data
N <- 3000 # number of persons
I <- 30 # number of items
b <- seq(-2,2, length=I)
# data for group 1
dat1 <- sirt::sim.raschtype( rnorm(N, mean=0, sd=1), b=b )
# data for group 2
dat2 <- sirt::sim.raschtype( rnorm(N, mean=1, sd=.6), b=b )
# fit group 1
mod1 <- TAM::tam.mml.2pl( resp=dat1 )
summary(mod1)
# fit group 2
mod2 <- TAM::tam.mml.2pl( resp=dat2 )
summary(mod2)
# define list of fitted models
tamobj_list <- list( mod1, mod2 )
#-- link item response models
lmod <- TAM::tam.linking( tamobj_list)
summary(lmod)
# estimate WLEs based on transformed item parameters
parm_list <- lmod$parameters_list
# WLE grade 1
arglist <- list( resp=mod1$resp, B=parm_list[[1]]$B, AXsi=parm_list[[1]]$AXsi )
wle1 <- TAM::tam.mml.wle(tamobj=arglist)
# WLE grade 2
arglist <- list( resp=mod2$resp, B=parm_list[[2]]$B, AXsi=parm_list[[2]]$AXsi )
wle2 <- TAM::tam.mml.wle(tamobj=arglist)
summary(wle1)
summary(wle2)
# estimation with linked and fixed item parameters for group 2
B <- parm_list[[2]]$B
xsi.fixed <- cbind( 1:I, -parm_list[[2]]$AXsi[,2] )
mod2f <- TAM::tam.mml( resp=dat2, B=B, xsi.fixed=xsi.fixed )
summary(mod2f)
# }
Run the code above in your browser using DataLab