Nothing
## File Name: smirt_preproc.R
## File Version: 1.11
################################################################
# define estimation functions depending on condensation type
#-#-# calculation of probabilities
.smirt.calcprob <- function( a, b, Q, thetak, c, d, mu.i, irtmodel ){
if ( irtmodel=="noncomp"){
res <- calcprob.noncomp( a, b, Q, thetak, c, d )
}
if ( irtmodel=="comp"){
res <- calcprob.comp( a, b, Q, thetak, c, d )
}
if ( irtmodel=="partcomp"){
res <- calcprob.partcomp( a, b, Q, thetak, c, d, mu.i)
}
return(res)
}
################################################################
#-#-# estimation of b parameters
.smirt.est.b <- function( b, a, c, d, mu.i, Qmatrix, est.b, theta.k,
n.ik, I, K, TP, D, numdiff.parm,
max.increment, msteps, mstepconv, irtmodel, increment.factor ){
if ( irtmodel=="noncomp"){
res <- .smirt.est.b.noncomp( b, a, c, d, Qmatrix, est.b, theta.k,
n.ik, I, K, TP, D, numdiff.parm,
max.increment, msteps, mstepconv, increment.factor)
}
if ( irtmodel=="comp"){
res <- .smirt.est.b.comp( b, a, c, d, Qmatrix, est.b, theta.k,
n.ik, I, K, TP, D, numdiff.parm,
max.increment, msteps, mstepconv, increment.factor)
}
if ( irtmodel=="partcomp"){
res <- .smirt.est.b.partcomp( b, a, c, d, mu.i, Qmatrix, est.b, theta.k,
n.ik, I, K, TP, D, numdiff.parm,
max.increment, msteps, mstepconv, increment.factor)
}
return(res)
}
################################################################
#-#-# estimation of a parameters
.smirt.est.a <- function( b, a, c, d, mu.i, Qmatrix, est.a, theta.k,
n.ik, I, K, TP, D, numdiff.parm,
max.a.increment, msteps, mstepconv, irtmodel, increment.factor){
if ( irtmodel=="noncomp"){
res <- .smirt.est.a.noncomp( b, a, c, d, Qmatrix, est.a, theta.k,
n.ik, I, K, TP, D, numdiff.parm,
max.a.increment, msteps, mstepconv, increment.factor)
}
if ( irtmodel=="comp"){
res <- .smirt.est.a.comp( b, a, c, d, Qmatrix, est.a, theta.k,
n.ik, I, K, TP, D, numdiff.parm,
max.a.increment, msteps, mstepconv, increment.factor)
}
if ( irtmodel=="partcomp"){
res <- .smirt.est.a.partcomp( b, a, c, d, mu.i, Qmatrix, est.a, theta.k,
n.ik, I, K, TP, D, numdiff.parm,
max.a.increment, msteps, mstepconv, increment.factor)
}
return(res)
}
################################################################
#-#-# estimation of c parameters
.smirt.est.c <- function( b, a, c, d, mu.i, Qmatrix, est.c, theta.k,
n.ik, I, K, TP, D, numdiff.parm,
max.increment, msteps, mstepconv, irtmodel, increment.factor){
if ( irtmodel=="noncomp"){
res <- .smirt.est.c.noncomp( b, a, c, d, Qmatrix, est.c, theta.k,
n.ik, I, K, TP, D, numdiff.parm,
max.increment, msteps, mstepconv, increment.factor)
}
if ( irtmodel=="comp"){
res <- .smirt.est.c.comp( b, a, c, d, Qmatrix, est.c, theta.k,
n.ik, I, K, TP, D, numdiff.parm,
max.increment, msteps, mstepconv, increment.factor)
}
if ( irtmodel=="partcomp"){
res <- .smirt.est.c.partcomp( b, a, c, d, mu.i, Qmatrix, est.c, theta.k,
n.ik, I, K, TP, D, numdiff.parm,
max.increment, msteps, mstepconv, increment.factor)
}
return(res)
}
################################################################
#-#-# estimation of d parameters
.smirt.est.d <- function( b, a, c, d, mu.i, Qmatrix, est.d, theta.k,
n.ik, I, K, TP, D, numdiff.parm,
max.increment, msteps, mstepconv, irtmodel, increment.factor ){
if ( irtmodel=="noncomp"){
res <- .smirt.est.d.noncomp( b, a, c, d, Qmatrix, est.d, theta.k,
n.ik, I, K, TP, D, numdiff.parm,
max.increment, msteps, mstepconv, increment.factor)
}
if ( irtmodel=="comp"){
res <- .smirt.est.d.comp( b, a, c, d, Qmatrix, est.d, theta.k,
n.ik, I, K, TP, D, numdiff.parm,
max.increment, msteps, mstepconv, increment.factor)
}
if ( irtmodel=="partcomp"){
res <- .smirt.est.d.partcomp( b, a, c, d, mu.i, Qmatrix, est.d, theta.k,
n.ik, I, K, TP, D, numdiff.parm,
max.increment, msteps, mstepconv, increment.factor)
}
return(res)
}
########################################################################
.smirt.check.inits <- function( a.init, b.init, irtmodel, Qmatrix){
#****** check b.init
if ( ! is.null( b.init) ){
if (irtmodel=="comp"){
if ( is.matrix(b.init) ){
b.init <- b.init[,1]
cat("*** I only use the first column of the b.init matrix \n***",
"because a compensatory model is requested!\n" )
}
} # end comp
if (irtmodel=="noncomp"){
if ( is.vector(b.init) ){
stop("*** A matrix for b.init is required.")
}
} # end noncomp
} # end b.init
#**************
#****** check b.init
if ( ! is.null( a.init) ){
if ( is.vector(a.init) ){
stop("*** A matrix for a.init is required.")
}
if ( is.matrix(a.init) ){
if ( ncol(a.init) !=ncol(Qmatrix) ){
stop("*** Check number of dimensions for specifying a.init.")
}
}
} # end a.init
res <- list("b.init"=b.init, "a.init"=a.init)
return(res)
}
##########################################################
#############################################
# restrict maximum increment
.adj.maxincrement.parameter <- function( oldparm, newparm,
max.increment ){
ISMATR <- is.matrix( oldparm )
max.increment0 <- max.increment
if (ISMATR){
D <- ncol(newparm)
for (dd in 1:D){
if ( is.matrix(max.increment) ){
max.increment <- max.increment0[1,dd]
}
# dd <- 1
increment <- newparm[,dd] - oldparm[,dd]
increment2 <- ifelse( abs(increment) > max.increment,
sign(increment)*max.increment, increment )
newparm[,dd] <- oldparm[,dd] + increment2
}
}
if (!ISMATR){
increment <- newparm - oldparm
increment2 <- ifelse( abs(increment) > max.increment,
sign(increment)*max.increment, increment )
newparm <- oldparm + increment2
}
return(newparm)
}
###########################################################
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.