Psychometrics3.r

user2 — Sep 24, 2013, 10:14 AM

library(ltm)

Loading required package: MASS Loading required package: msm Loading
required package: mvtnorm Loading required package: polycor Loading
required package: sfsmisc

# Code from the PDF:


# Question 3
fit2PL <- ltm(LSAT ~ z1)
plot.ltm(fit2PL, zrange=c(-5,5))

# Question 4
tcc<-function(fit){# begin Test Characteristic Function
  n<-dim(fit$X)[2]; p<-plot(fit, items=1, type="ICC", plot=FALSE)
  r<-length(p[,2]); X<-p[,1]; iccs<-matrix(NA,ncol=n,nrow=r)
  for (i in 1:n) iccs[,i]<-plot(fit,items=i,type="ICC", plot=FALSE)[,2]
  Y<-apply(iccs, MARGIN=1, sum);
  cbind(X,Y)
} # end Test Characteristic Function
plot(tcc(fit2PL))

# Question 5
# Code from PDF:
require("OpenMx")

Loading required package: OpenMx

fit <- fit2PL
n<-dim(fit$X)[2]; p<-plot(fit, items=1, type="ICC", plot=FALSE)
r<-length(p[,2]); X<-p[,1]; iccs<-matrix(NA,ncol=n,nrow=r)
for (i in 1:n) iccs[,i]<-plot(fit,items=i,type="ICC", plot=FALSE)[,2]
Y<-apply(iccs, MARGIN=1, sum);
#Create an MxModel object
oneFactorModel <- mxModel("Common Factor Model Path Specification",
                          type="RAM",
                          mxData(observed=LSAT,type="raw"),
                          manifestVars=c("Item 1", "Item 2", "Item 3", "Item 4", "Item 5"),
                          latentVars="Factor",
                          # residual variances
                          mxPath(from=c("Item 1", "Item 2", "Item 3", "Item 4", "Item 5"),
                                 arrows=2,
                                 free=TRUE,
                                 values=c(1,1,1,1,1),
                                 labels=c("e1","e2","e3","e4","e5")
                          ),
                          # latent variance
                          mxPath(from="Factor",
                                 arrows=2,
                                 free=FALSE,
                                 values=1,
                                 labels ="varFactor"
                          ),
                          # factor loadings
                          mxPath(from="Factor",
                                 to=c("Item 1", "Item 2", "Item 3", "Item 4", "Item 5"),
                                 arrows=1,
                                 free=c(TRUE,TRUE,TRUE,TRUE,TRUE),
                                 values=c(1,1,1,1,1),
                                 labels =c("l1","l2","l3","l4","l5")
                          ),
                          # means
                          mxPath(from="one",
                                 to=c("Item 1", "Item 2", "Item 3", "Item 4", "Item 5","Factor"),
                                 arrows=1,
                                 free=c(TRUE,TRUE,TRUE,TRUE,TRUE,FALSE),
                                 values=c(1,1,1,1,1,0),
                                 labels =c("meanx1","meanx2","meanx3","meanx4","meanx5",NA)
                          )
) # close model
oneFactorFit <- mxRun(oneFactorModel)

Running Common Factor Model Path Specification 

estimates<-oneFactorFit@output$estimate
lambda<-matrix(estimates[1:5],nrow=1)
mu<-matrix(estimates[11:15],nrow=1)
X<-matrix(X,ncol=1)
ones<-matrix(1,ncol=1,nrow=dim(X)[1])
# transform
expected.responses<-ones%*%mu+ X%*%lambda
Y.FA<-apply(expected.responses,1,sum)
plot(X,Y)
points(X,Y.FA,pch="S",col="red")
points(X,5*expected.responses[,1],pch="1")
points(X,5*expected.responses[,2],pch="2")
points(X,5*expected.responses[,3],pch="3")
points(X,5*expected.responses[,4],pch="4")
points(X,5*expected.responses[,5],pch="5")