if (FALSE) {
# example 1: analysis on determinants of anger-related behavior
# load anger data
data(anger)
# estimate a disjunctive LCplfm model with F=2 and T=2
# assume constant situation-feature classification
# and class-specific situation parameters (i.e. model 1)
# use 10 exploratory runs with random starting points
anger.LCplfm.disj<-LCplfm(data=anger$data,F=2, T=2, M=10)
# print the output of the model
print (anger.LCplfm.disj)
# estimate an additive LCplfm model with F=2 and T=2
# assume constant situation-feature classification
# and class-specific situation parameters (i.e. model 1)
# use 10 exploratory runs with random starting points
anger.LCplfm.add<-LCplfm(data=anger$data,F=2, T=2, M=10, maprule="add")
# print the output of the model
print (anger.LCplfm.add)
# estimate a disjunctive LCplfm model with F=4 and T=2
# assume constant situation-feature classifications
# and class-specific situation parameters (i.e. model 1)
# use 20 exploratory runs with random starting points (M=20)
# constrain parameters of subsequent behavior pairs to "load"
# on only one feature
# specify which attribute parameters have to be estimated from the data
update.attribute<-matrix(rep(0,8*4),ncol=4)
update.attribute[1:2,1]<-c(1,1)
update.attribute[3:4,2]<-c(1,1)
update.attribute[5:6,3]<-c(1,1)
update.attribute[7:8,4]<-c(1,1)
# specify starting values for attribute parameters in each of M=20 runs
# for parameters with update.attribute==0 starting values are constrained to 1e-6
# for parameters with update.attribute==1 starting values are sampled from a unif(0,1)
start.attribute<-array(runif(8*4*20),c(8,4,20))
start.attribute[update.attribute%o%rep(1,20)==0]<-1e-6
# estimate the constrained model
anger.LCplfm.constr<-LCplfm(data=anger$data,F=4, T=2, M=20,
update.attributeparameters=update.attribute,
start.attributeparameters=start.attribute)
# estimate a disjunctive LCplfm model with F=4 and T=2
# assume constant situation-feature classifications
# class-specific situation and bahavior parameters (i.e. model 3)
# use 20 exploratory runs with random starting points (M=20)
# constrain parameters of subsequent behavior pairs to "load"
# on only one feature
# specify which attribute parameters have to be estimated from the data
update.attribute<-matrix(rep(0,8*4),ncol=4)
update.attribute[1:2,1]<-c(1,1)
update.attribute[3:4,2]<-c(1,1)
update.attribute[5:6,3]<-c(1,1)
update.attribute[7:8,4]<-c(1,1)
update.attribute<-update.attribute%o%rep(1,2)
# specify starting values for attribute parameters in each of M=20 runs
# for parameters with update.attribute==0 starting values are constrained to 1e-6
# for parameters with update.attribute==1 starting values are sampled from a unif(0,1)
start.attribute<-array(runif(8*4*2*20),c(8,4,2,20))
start.attribute[update.attribute%o%rep(1,20)==0]<-1e-6
# estimate the constrained model
anger.LCplfm.m3.constr<-LCplfm(data=anger$data,F=4, T=2, M=20, model=3,
update.attributeparameters=update.attribute,
start.attributeparameters=start.attribute)
}
if (FALSE) {
# example 2: analysis of car perception data
# load car data
data(car)
# estimate a disjunctive LCplfm with F=3 and T=2
# assume constant attribute-feature classification
# and class-specific car parameters (i.e. model 4)
# use 10 exploratory runs with random starting points
car.LCplfm.disj<-LCplfm(data=car$data3w,F=3, T=2, M=10,model=4)
# print the output of the model
print(car.LCplfm.disj)
# estimate an additive LCplfm with F=3 and T=2
# assume constant attribute-feature classification
# and class-specific car parameters (i.e. model 4)
# use 10 exploratory runs with random starting points
car.LCplfm.add<-LCplfm(data=car$data3w,F=3, T=2, M=10, model=4, maprule="add")
# print the output of the model
print(car.LCplfm.add)
}
if (FALSE) {
# example 3: estimation of multiple classification latent class
# model (Maris, 1999) for cognitive diagnosis
# load subtraction data
library(CDM)
data(fraction.subtraction.data)
data(fraction.subtraction.qmatrix)
# create three-way data as input for LCplfm
I<-536
J<-1
K<-20
data3w<-array(c(as.matrix(fraction.subtraction.data)),c(I,J,K))
# add item labels
itemlabel<-c("5/3 - 3/4",
"3/4 - 3/8",
"5/6 - 1/9",
"3 1/2 - 2 3/2",
"4 3/5 - 3 4/10",
"6/7 - 4/7",
"3 - 2 1/5",
"2/3 - 2/3",
"3 7/8 - 2",
"4 4/12 - 2 7/12",
"4 1/3 - 2 4/3",
"1 1/8 - 1/8",
"3 3/8 - 2 5/6",
"3 4/5 - 3 2/5",
"2 - 1/3",
"4 5/7 - 1 4/7",
"7 3/5 - 4/5",
"4 1/10 - 2 8/10",
"4 - 1 4/3",
"4 1/3 - 1 5/3")
dimnames(data3w)[[3]]<-itemlabel
# estimate multiple classification latent class model (Maris, 1999)
set.seed(537982)
subtract.m1.lst<-stepLCplfm(data3w,minF=3,maxF=5,minT=1,maxT=3,model=1,M=20,maprule="conj")
# print BIC values
sumar<-summary(subtract.m1.lst)
as.matrix(sort(sumar[,5]))
# print output best model
subtract.m1.lst[[5,2]]
# correlation between extracted skills and qmatrix
round(cor(fraction.subtraction.qmatrix,subtract.m1.lst[[5,2]]$attpar),2)
}
Run the code above in your browser using DataLab