#############################################################################
# EXAMPLE 1: Fraction Dataset 1
# Unidimensional Models for dichotomous data
#############################################################################
data( data.fraction1 )
dat <- data.fraction1$data
theta.k <- seq( -6 , 6 , len=15 ) # discretized ability
#***
# Model 1: Rasch model (normal distribution)
mod1 <- gdm( dat , irtmodel="1PL" , theta.k=theta.k , skillspace="normal" ,
centered.latent=TRUE)
summary(mod1)
#***
# Model 2: Rasch model (log-linear smoothing)
# set the item difficulty of the 8th item to zero
b.constraint <- matrix( c(8,1,0) , 1 , 3 )
mod2 <- gdm( dat , irtmodel="1PL" , theta.k=theta.k ,
skillspace="loglinear" , b.constraint=b.constraint )
summary(mod2)
#***
# Model 3: 2PL model
mod3 <- gdm( dat , irtmodel="2PL" , theta.k=theta.k ,
skillspace="normal" , standardized.latent=TRUE )
summary(mod3)
#***
# Model 4: include quadratic term in item response function
# using the argument decrease.increments=TRUE leads to a more
# stable estimate
thetaDes <- cbind( theta.k , theta.k^2 )
colnames(thetaDes) <- c( "F1" , "F1q" )
mod4 <- gdm( dat , irtmodel="2PL" , theta.k=theta.k ,
thetaDes = thetaDes , skillspace="normal" ,
standardized.latent=TRUE , decrease.increments=TRUE)
summary(mod4)
#***
# Model 5: step function for ICC
# two different probabilities theta < 0 and theta > 0
thetaDes <- matrix( 1*(theta.k>0) , ncol=1 )
colnames(thetaDes) <- c( "Fgrm1" )
mod5 <- gdm( dat , irtmodel="2PL" , theta.k=theta.k ,
thetaDes = thetaDes , skillspace="normal" )
summary(mod5)
#***
# Model 6: DINA model with din function
mod6 <- din( dat , q.matrix = matrix( 1 , nrow=ncol(dat),ncol=1 ) )
summary(mod6)
#***
# Model 7: Estimating a version of the DINA model with gdm
theta.k <- c(-.5,.5)
mod7 <- gdm( dat , irtmodel="2PL" , theta.k=theta.k , skillspace="loglinear" )
summary(mod7)
#############################################################################
# EXAMPLE 2: Cultural Activities - data.Students
# Unidimensional Models for polytomous data
#############################################################################
data( data.Students )
dat <- data.Students[ , grep( "act" , colnames(data.Students) ) ]
theta.k <- seq( -4 , 4 , len=11 ) # discretized ability
#***
# Model 1: Partial Credit Model (PCM)
mod1 <- gdm( dat , irtmodel="1PL" , theta.k=theta.k , skillspace="normal" ,
centered.latent=TRUE)
summary(mod1)
#***
# Model 1b: PCM using frequency patterns
mod1b <- gdm( dat , irtmodel="1PL" , theta.k=theta.k , skillspace="normal" ,
centered.latent=TRUE , use.freqpatt=TRUE)
summary(mod1b)
#***
# Model 2: PCM with two groups
mod2 <- gdm( dat , irtmodel="1PL" , theta.k=theta.k ,
group=data.Students$urban + 1 , skillspace="normal" ,
centered.latent=TRUE)
summary(mod2)
#***
# Model 3: PCM with loglinear smoothing
b.constraint <- matrix( c(1,2,0) , ncol=3 )
mod3 <- gdm( dat , irtmodel="1PL" , theta.k=theta.k ,
skillspace="loglinear" , b.constraint=b.constraint )
summary(mod3)
#***
# Model 4: Model with pre-specified item weights in Q-matrix
Qmatrix <- array( 1 , dim=c(5,1,2) )
Qmatrix[,1,2] <- 2 # default is score 2 for category 2
# now change the scoring of category 2:
Qmatrix[c(2,4),1,1] <- .74
Qmatrix[c(2,4),1,2] <- 2.3
# for items 2 and 4 the score for category 1 is .74 and for category 2 it is 2.3
mod4 <- gdm( dat , irtmodel="1PL" , theta.k=theta.k , Qmatrix=Qmatrix ,
skillspace="normal" , centered.latent=TRUE)
summary(mod4)
#***
# Model 5: Generalized partial credit model
mod5 <- gdm( dat , irtmodel="2PL" , theta.k=theta.k ,
skillspace="normal" , standardized.latent=TRUE )
summary(mod5)
#***
# Model 6: Item-category slope estimation
mod6 <- gdm( dat , irtmodel="2PLcat" , theta.k=theta.k ,
skillspace="normal" , standardized.latent=TRUE ,
decrease.increments=TRUE)
summary(mod6)
#***
# Models 7: items with different number of categories
dat0 <- dat
dat0[ paste(dat0[,1]) == 2 , 1 ] <- 1 # 1st item has only two categories
dat0[ paste(dat0[,3]) == 2 , 3 ] <- 1 # 3rd item has only two categories
# Model 7a: PCM
mod7a <- gdm( dat0 , irtmodel="1PL" , theta.k=theta.k ,
centered.latent=TRUE )
summary(mod7a)
# Model 7b: Item category slopes
mod7b <- gdm( dat0 , irtmodel="2PLcat" , theta.k=theta.k ,
standardized.latent=TRUE , decrease.increments=TRUE )
summary(mod7b)
#############################################################################
# EXAMPLE 3: Fraction Dataset 2
# Multidimensional Models for dichotomous data
#############################################################################
data( data.fraction2 )
dat <- data.fraction2$data
Qmatrix <- data.fraction2$q.matrix3
#***
# Model 1: One-dimensional Rasch model
theta.k <- seq( -4 , 4 , len=11 ) # discretized ability
mod1 <- gdm( dat , irtmodel = "1PL" , theta.k=theta.k ,
centered.latent=TRUE)
summary(mod1)
#***
# Model 2: One-dimensional 2PL model
mod2 <- gdm( dat , irtmodel = "2PL" , theta.k=theta.k ,
standardized.latent=TRUE)
summary(mod2)
#***
# Model 3: 3-dimensional Rasch Model (normal distribution)
mod3 <- gdm( dat , irtmodel="1PL" , theta.k=theta.k ,
Qmatrix=Qmatrix , centered.latent=TRUE ,
globconv=5*10^(-3) , conv=10^(-4) , maxiter=10 )
summary(mod3)
#***
# Model 4: 3-dimensional Rasch model (loglinear smoothing)
# set some item parameters of items 4,1 and 2 to zero
b.constraint <- cbind( c(4,1,2) , 1 , 0 )
mod4 <- gdm( dat , irtmodel="1PL" , theta.k=theta.k ,
Qmatrix=Qmatrix , b.constraint=b.constraint ,
skillspace="loglinear" , globconv= 5*10^(-2) , conv=10^(-3) )
summary(mod4)
#***
# Model 5: define a different theta grid for each dimension
theta.k <- list( "Dim1"= seq( -5 , 5 , len=11 ) ,
"Dim2"= seq(-5,5,len=8) ,
"Dim3"=seq( -3,3,len=6) )
mod5 <- gdm( dat , irtmodel="1PL" , theta.k=theta.k ,
Qmatrix=Qmatrix , b.constraint=b.constraint ,
skillspace="loglinear" , globconv= 5*10^(-2) , conv=10^(-3) )
summary(mod5)
#***
# Model 6: multdimensional 2PL model (normal distribution)
theta.k <- seq( -5 , 5 , len=13 )
a.constraint <- cbind( c(8,1,3) , 1:3 , 1 , 1 ) # fix some slopes to 1
mod6 <- gdm( dat , irtmodel="2PL" , theta.k=theta.k ,
Qmatrix=Qmatrix , centered.latent=TRUE ,
a.constraint=a.constraint , decrease.increments=TRUE ,
skillspace="normal" , maxiter=400)
summary(mod6)
#***
# Model 7: multdimensional 2PL model (loglinear distribution)
a.constraint <- cbind( c(8,1,3) , 1:3 , 1 , 1 )
b.constraint <- cbind( c(8,1,3) , 1 , 0 )
mod7 <- gdm( dat , irtmodel="2PL" , theta.k=theta.k ,
Qmatrix=Qmatrix , b.constraint=b.constraint ,
a.constraint=a.constraint , decrease.increments=FALSE ,
skillspace="loglinear" , maxiter=400)
summary(mod7)
#############################################################################
# SIMULATED EXAMPLE 4: Unidimensional latent class 1PL IRT model
#############################################################################
# simulate data
set.seed(754)
I <- 20 # number of items
N <- 2000 # number of persons
theta <- c( -2 , 0 , 1 , 2 )
theta <- rep( theta , c(N/4,N/4 , 3*N/8 , N/8) )
b <- seq(-2,2,len=I)
library(sirt) # use function sim.raschtype from sirt package
dat <- sim.raschtype( theta=theta , b=b )
theta.k <- seq(-1 , 1 , len=4) # initial vector of theta
# estimate model
mod1 <- gdm( dat , theta.k = theta.k , skillspace="est" , irtmodel="1PL",
centerintercepts=TRUE , maxiter=200)
summary(mod1)
## Estimated Skill Distribution
## F1 pi.k
## 1 -1.988 0.24813
## 2 -0.055 0.23313
## 3 0.940 0.40059
## 4 2.000 0.11816
#############################################################################
# SIMULATED EXAMPLE 5: Multidimensional latent class IRT model
#############################################################################
# We simulate a two-dimensional IRT model in which theta vectors
# are observed at a fixed discrete grid (see below).
# simulate data
set.seed(754)
I <- 13 # number of items
N <- 2400 # number of persons
# simulate Dimension 1 at 4 discrete theta points
theta <- c( -2 , 0 , 1 , 2 )
theta <- rep( theta , c(N/4,N/4 , 3*N/8 , N/8) )
b <- seq(-2,2,len=I)
library(sirt) # use simulation function from sirt package
dat1 <- sim.raschtype( theta=theta , b=b )
# simulate Dimension 2 at 4 discrete theta points
theta <- c( -3 , 0 , 1.5 , 2 )
theta <- rep( theta , c(N/4,N/4 , 3*N/8 , N/8) )
dat2 <- sim.raschtype( theta=theta , b=b )
colnames(dat2) <- gsub( "I" , "U" , colnames(dat2))
dat <- cbind( dat1 , dat2 )
# define Q-matrix
Qmatrix <- matrix(0,2*I,2)
Qmatrix[ cbind( 1:(2*I) , rep(1:2 , each=I) ) ] <- 1
theta.k <- seq(-1 , 1 , len=4) # initial matrix
theta.k <- cbind( theta.k , theta.k )
colnames(theta.k) <- c("Dim1","Dim2")
# estimate model
mod2 <- gdm( dat , theta.k = theta.k , skillspace="est" , irtmodel="1PL",
Qmatrix=Qmatrix , centerintercepts=TRUE , maxiter=200)
summary(mod2)
## Estimated Skill Distribution
## theta.k.Dim1 theta.k.Dim2 pi.k
## 1 -2.022 -3.035 0.25010
## 2 0.016 0.053 0.24794
## 3 0.956 1.525 0.36401
## 4 1.958 1.919 0.13795
#############################################################################
# EXAMPLE 6: Large-scale dataset data.mg
#############################################################################
data(data.mg)
dat <- data.mg[ , paste0("I" , 1:11 ) ]
theta.k <- seq(-6,6,len=21)
#***
# Model 1: Generalized partial credit model with multiple groups
mod1 <- gdm( dat , irtmodel="2PL" , theta.k=theta.k , group=data.mg$group ,
skillspace="normal" , standardized.latent=TRUE , maxiter=50 )
summary(mod1)
Run the code above in your browser using DataLab