Nothing
######################################################################################################################################
######################################################################################################################################
#Supplemental R code for plotting ICCs, TCCs, IIF, and TIFs from flexMIRT output files
#Authors: Li Cai & Carrie R. Houts
#Date: 10/12/2012
######################################################################################################################################
######################################################################################################################################
#The R programs provided are free software; you can redistribute and/or modify them under the terms of the GNU General Public License
#(http://www.gnu.org/copyleft/gpl.html) as published by the Free Software Foundation; either version 2 of the License, or
#(at your option) any later version. The programs are distributed in the hope that they will be useful, but WITHOUT ANY WARRANTY;
#without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
#See the GNU General Public License for more details.
######################################################################################################################################
######################################################################################################################################
##' Read a flexMIRT PRM file
##'
##' \lifecycle{experimental}
##' This was last updated in 2017 and may no longer work.
##'
##' Load the item parameters from a flexMIRT PRM file.
##' @template detail-group
##'
##' @param fname file name
##' @return a list of groups as described in the details
read.flexmirt <- function(fname) {
groups <- list()
ncol <- max(count.fields(fname, sep = "\t"))
prm <- read.delim(fname,header=F, col.names=1:ncol)
# find out how many rows
nlines <- nrow(prm)
# determine the number of groups
ng <- 0
for (i in 1:nlines) {
if (prm[i,1] == 0) { # group
ng <- ng+1
}
}
for (g in 1:ng) {
# select all items and this group
index <- (prm[,3] == g)
thisGroup <- prm[index,]
g.name <- "?"
g.dist <- list()
g.label <- list()
g.spec <- list()
g.param <- list()
for (i in 1:nrow(thisGroup)) {
spec <- NULL
param <- c()
dims <- thisGroup[i,4]
if (thisGroup[i,1] == 1) { # item
if (thisGroup[i,5] == 1) { # 3PL
# grab item parameters
logitg <- thisGroup[i,7]
c <- thisGroup[i,8]
a <- thisGroup[i,9:(9+dims-1)]
spec <- rpf.drm(factors = dims)
param <- c(unlist(a), c, logitg, logit(1))
}
if (thisGroup[i,5] == 2) { # graded
# grab item parameters
nc <- thisGroup[i,6]
c <- rep(0,nc-1)
for (k in 1:(nc-1)) {
c[k] <- thisGroup[i,6+k]
}
a <- thisGroup[i,(6+nc):(6+nc+dims-1)]
spec <- rpf.grm(outcomes=nc, factors=dims)
param <- c(unlist(a), c)
}
if (thisGroup[i,5] == 3) { # nominal
offset <- 6
# grab item parameters
nc <- thisGroup[i,offset]
offset <- offset+1
Tmat <- thisGroup[i,offset]
offset <- offset+1
if (Tmat == 0) T <- 'trend'
if (Tmat == 1) T <- 'id'
if (Tmat == 2) { # user-defined
v <- matrix(0,nc*(nc-1))
for (k in 1:(nc*(nc-1))) {
v[k] <- thisGroup[i,offset]
offset <- offset+1
}
T <- matrix(c(v), nc, nc-1, byrow=TRUE)
}
# scoring fn
alf <- rep(0,nc-1)
for (k in 1:(nc-1)) {
alf[k] <- thisGroup[i,offset]
offset <- offset+1
}
# slope
a <- thisGroup[i,offset:(offset+dims-1)]
offset <- offset+dims
# intercept
Lmat <- thisGroup[i,offset]
offset <- offset+1
if (Lmat == 0) L <- 'trend'
if (Lmat == 1) L <- 'id'
if (Lmat == 2) { # user-defined
v <- matrix(0,nc*(nc-1))
for (k in 1:(nc*(nc-1))) {
v[k] <- thisGroup[i,offset]
offset <- offset+1
}
L <- matrix(c(v), nc, nc-1, byrow=TRUE)
}
gam <- rep(0,nc-1)
for (k in 1:(nc-1)) {
gam[k] <- thisGroup[i,offset]
offset <- offset+1
}
spec <- rpf.nrm(outcomes = nc, T.a = T, T.c = L)
param <- c(a, alf, gam)
}
if (!is.null(spec)) {
g.label[[i]] <- as.character(thisGroup[i,2])
g.spec[[i]] <- spec
g.param[[i]] <- param
}
} else { # group
cov <- matrix(NA, nrow=dims, ncol=dims)
col <- 6+dims
for (rx in 1:dims) {
for (cx in 1:rx) {
cov[rx,cx] <- thisGroup[i,col]
if (rx != cx) cov[cx,rx] <- thisGroup[i,col]
col <- col+1
}
}
g.dist <- list(mean=unlist(thisGroup[i,6:(6+dims-1)]), cov=cov)
g.name <- thisGroup[i,2]
}
} # for every item
names(g.spec) <- g.label
pmat <- matrix(NA, ncol=length(g.param), nrow=max(vapply(g.param, length, 0)))
for (i in 1:length(g.param)) {
v <- g.param[[i]]
pmat[1:length(v), i] <- v
}
colnames(pmat) <- g.label
groups[[g]] <- list(spec=g.spec, param=pmat, mean=g.dist$mean, cov=g.dist$cov)
names(groups)[[g]] <- as.character(g.name)
} # for every group
groups
}
serialize.T <- function(spec, Tmat, T) {
if (all(abs(T - Tnom.trend(spec@outcomes)) < 1e-4)) {
c(0)
} else if (Tmat == 'a' && all(abs(T - Tnom.ida(spec@outcomes)) < 1e-4)) {
c(1)
} else if (Tmat == 'c' && all(abs(T - Tnom.idc(spec@outcomes)) < 1e-4)) {
c(1)
} else {
c(2, rep(0, dim(T)[1]), t(T))
}
}
##' Write a flexMIRT PRM file
##'
##' \lifecycle{experimental}
##' This was last updated in 2017 and may no longer work.
##'
##' Formats item parameters in the way that flexMIRT expects to read
##' them.
##'
##' NOTE: Support for the graded response model may not be complete.
##' @template detail-group
##'
##' @param groups a list of groups each with items and latent parameters
##' @param file the destination file name
##' @param fileEncoding how to encode the text file (optional)
write.flexmirt <- function(groups, file=NULL, fileEncoding="") {
if (missing(file)) {
stop("You must specify the destination file=")
}
if (file == "")
file <- stdout()
else if (is.character(file)) {
file <- if (nzchar(fileEncoding))
file(file, "w", encoding = fileEncoding)
else file(file, "w")
on.exit(close(file))
}
else if (!isOpen(file, "w")) {
open(file, "w")
on.exit(close(file))
}
if (!inherits(file, "connection"))
stop("'file' must be a character string or connection")
for (gx in 1:length(groups)) {
grp <- groups[[gx]]
for (ix in 1:length(grp$spec)) {
spec <- grp$spec[[ix]]
nfact <- spec@factors
name <- names(grp$spec)[ix]
iparam <- grp$param[,ix]
if (is.null(name)) name <- paste("i",ix,sep="")
if (inherits(spec, "rpf.mdim.drm")) {
if (iparam[4] < 1) warnings("Nonzero upper bound ignored")
if (iparam[3] == 0) {
warnings("Guessing set to 0; using Graded(2) instead")
cat(paste(1, name, gx, nfact, 2, 2, iparam[2], iparam[1], sep="\t"),
file=file, fill=TRUE)
} else {
logitg <- iparam[3]
cat(paste(1, name, gx, nfact, 1, 2, logitg, iparam[2], iparam[1], sep="\t"),
file=file, fill=TRUE)
}
} else if (inherits(spec, "rpf.mdim.grm")) {
if (spec@outcomes > 2) stop("Not implemented")
cat(c(1, name, gx, nfact, 2, spec@outcomes, iparam[(nfact+1):length(iparam)],
iparam[1:nfact]), sep="\t", file=file, fill=TRUE)
} else if (inherits(spec, "rpf.mdim.nrm")) {
T.a <- serialize.T(spec, 'a', getT(spec, 0))
T.c <- serialize.T(spec, 'c', getT(spec, 1))
cat(paste(c(1, name, gx, nfact, 3, spec@outcomes, T.a,
iparam[(spec@factors+1):(spec@outcomes + spec@factors - 1)],
iparam[1:spec@factors],
T.c, iparam[(spec@factors + spec@outcomes):length(iparam)]), sep="\t"),
file=file, fill=TRUE)
} else {
stop(paste("Not implemented for", class(spec)))
}
}
tri <- rep(NA, nfact*(nfact+1)/2)
tx <- 1
for (rx in 1:nfact) {
for (cx in 1:rx) {
tri[tx] <- grp$cov[rx,cx]
tx <- tx+1
}
}
cat(c(0, names(groups)[gx], gx, nfact, 0, grp$mean, tri),
sep="\t", file=file, fill=TRUE)
}
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.