4.1-1

DESCRIPTION

@@ -1,8 +1,8 @@
 Package: TAM
 Type: Package
 Title: Test Analysis Modules
-Version: 4.0-1
-Date: 2021-06-25 14:15:15
+Version: 4.1-1
+Date: 2022-05-15 09:03:38
 Author:
     Alexander Robitzsch [aut,cre] (<https://orcid.org/0000-0002-8226-3132>),
     Thomas Kiefer [aut], 
@@ -27,7 +27,7 @@ Imports:
     graphics, methods, Rcpp, stats, utils
 Suggests: 
     coda, GPArotation, grDevices, lattice, lavaan, MASS, 
-    miceadds, mvtnorm, plyr, psych, sfsmisc, sirt, splines, 
+    miceadds, mvtnorm, plyr, psych, sfsmisc, splines, 
     WrightMap
 LinkingTo: 
     Rcpp, RcppArmadillo

R/IRT.informationCurve.R

@@ -1,5 +1,5 @@
 ## File Name: IRT.informationCurve.R
-## File Version: 9.19
+## File Version: 9.212
 
 
 
@@ -47,25 +47,19 @@ informationCurves_mml <- function( object, h=.0001,
                         B=B, xsi=xsi, theta=theta, nnodes=nnodes,
                         maxK=maxK, recalc=TRUE)
 
-    #****
-    # calculate probabilities
-    if ( class(object) %in% c("tam.mml","tam.mml.2pl",    "tam.mml.mfr") ){
+    #--- calculate probabilities
+    if ( inherits(object, c("tam.mml","tam.mml.2pl", "tam.mml.mfr") ) ){
         fct <- "tam_calc_prob"
-        p0 <- do.call( what=fct, args=calc_args )$rprobs
-        p1 <- do.call( what=fct, args=tam_args_replace_value( args=calc_args,
-                        variable="theta", value=theta+h ) )$rprobs
-        p2 <- do.call( what=fct, args=tam_args_replace_value( args=calc_args,
-                        variable="theta", value=theta-h ) )$rprobs
     }
-    if ( class(object) %in% c("tam.mml.3pl" ) ){
+    if ( inherits(object, c("tam.mml.3pl") ) ){
         calc_args$guess <- guess
         fct <- "tam_mml_3pl_calc_prob"
-        p0 <- do.call( what=fct, args=calc_args )$rprobs
-        p1 <- do.call( what=fct, args=tam_args_replace_value( args=calc_args,
-                        variable="theta", value=theta+h ) )$rprobs
-        p2 <- do.call( what=fct, args=tam_args_replace_value( args=calc_args,
-                        variable="theta", value=theta-h ) )$rprobs
     }
+    p0 <- do.call( what=fct, args=calc_args )$rprobs
+    args1 <- tam_args_replace_value( args=calc_args, variable="theta", value=theta+h )
+    p1 <- do.call( what=fct, args=args1 )$rprobs
+    args2 <- tam_args_replace_value( args=calc_args, variable="theta", value=theta-h )
+    p2 <- do.call( what=fct, args=args2 )$rprobs    
     p0a <- p0
     p0[ is.na(p0) ] <- 0
     p1[ is.na(p1) ] <- 0

R/IRT.residuals.R

@@ -1,5 +1,5 @@
 ## File Name: IRT.residuals.R
-## File Version: 9.15
+## File Version: 9.161
 
 
 #####################################################
@@ -15,7 +15,7 @@ IRT.residuals <- function (object, ...)
 tam.residuals <- function( object, ... )
 {
     tamobj <- object
-    if (class(tamobj)!="tam.jml"){
+    if (! inherits(tamobj,"tam.jml")){
         res <- tam.wle( tamobj, progress=FALSE, output.prob=TRUE, ... )
         probs <- res$probs
         probs[ is.na(probs) ] <- 0

R/IRTLikelihood.cfa.R

@@ -1,5 +1,5 @@
 ## File Name: IRTLikelihood.cfa.R
-## File Version: 9.19
+## File Version: 9.201
 
 #---- IRTLikelihood for fitted CFA model
 IRTLikelihood.cfa <- function( data, cfaobj=NULL,
@@ -25,7 +25,7 @@ IRTLikelihood.cfa <- function( data, cfaobj=NULL,
         }
         theta0 <- snodes.adj * seq(-3,3,len=21)
         if (D>2){
-            r1 <- sirt_import_sfsmisc_QUnif(n=snodes, min=0, max=1, n.min=1, p=D, leap=409)
+            r1 <- tam_import_sfsmisc_QUnif(n=snodes, min=0, max=1, n.min=1, p=D, leap=409)
             theta <- stats::qnorm( r1 )
             for ( dd in 1:D){
                 theta[,dd] <- snodes.adj*theta[,dd]

R/RcppExports.R

@@ -1,5 +1,5 @@
 ## File Name: RcppExports.R
-## File Version: 4.000001
+## File Version: 4.001001
 # Generated by using Rcpp::compileAttributes() -> do not edit by hand
 # Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393
 

R/designMatrices_aux.R

@@ -1,5 +1,5 @@
 ## File Name: designMatrices_aux.R
-## File Version: 9.103
+## File Version: 9.104
 
 #############################################################
 print.designMatrices <-
@@ -215,8 +215,6 @@ if (FALSE){
         ind.mm <- grep(sg, rownames(mm))
         mm.sg.temp <- rbind( 0, apply( mm[ ind.mm,], 2, cumsum ) )
 #        mm.sg.temp <- rbind( 0, colCumsums.sirt( mm[ ind.mm,] ) )
-        # substitute the following line later if the sirt function
-        # colCumsums.sirt is available at CRAN
         #        mm.sg.temp <- rbind( 0, colCumsums.sirt( mm[ grep(sg, rownames(mm)),] ) )
         rownames(mm.sg.temp)[1] <- gsub("step([[:digit:]])*", "step0", sg, fixed=T)
         A <- rbind(A, mm.sg.temp)

R/plotDevianceTAM.R

@@ -1,10 +1,11 @@
 ## File Name: plotDevianceTAM.R
-## File Version: 9.10
-###############################################################################
-plotDevianceTAM   <- function ( tam.obj, omitUntil=1, reverse=TRUE,
+## File Version: 9.111
+
+
+plotDevianceTAM <- function ( tam.obj, omitUntil=1, reverse=TRUE,
             change=TRUE)
 {
-    stopifnot(class(tam.obj) %in% c("tam.mml","tam.mml.2pl","tam.mml.mfr","tam.mml.3pl","tamaan") )
+    stopifnot(inherits(tam.obj, c("tam.mml","tam.mml.2pl","tam.mml.mfr","tam.mml.3pl","tamaan")) )
 
     devhistory <- tam.obj$deviance.history
     if(omitUntil>0)  {
@@ -20,7 +21,7 @@ plotDevianceTAM   <- function ( tam.obj, omitUntil=1, reverse=TRUE,
     }
 
     if(reverse){
-        devChange <- -1 *  devChange
+        devChange <- -devChange
     }
     devChange <- data.frame ( nr=omitUntil + 1:length(devChange), devChange)
     xm <- ceiling( max(devChange[,1])/10 )*10
@@ -41,4 +42,3 @@ plotDevianceTAM   <- function ( tam.obj, omitUntil=1, reverse=TRUE,
     dcr <- devChange[devChange[,2]<0,]
     graphics::points( dcr[,1], dcr[,2], pch=20, cex=cex, col="red")
 }
-###############################################################################

R/summary.tam.R

@@ -1,13 +1,13 @@
 ## File Name: summary.tam.R
-## File Version: 9.586
+## File Version: 9.587
 
 #****** summary for tam object
 summary.tam <- function( object, file=NULL, ...)
 {
     tam_osink(file=file)
 
     latreg <- FALSE
-    if ( class(object)=="tam.latreg" ){
+    if ( inherits(object,"tam.latreg") ){
         latreg <- TRUE
         object$irtmodel <- "tam.latreg"
     }

R/tam.fit.R

@@ -1,12 +1,12 @@
 ## File Name: tam.fit.R
-## File Version: 9.16
+## File Version: 9.171
 tam.fit <- function( tamobj, ... )
 {
     CALL <- match.call()
-    if(class(tamobj)=="tam.mml"){
+    if(inherits(tamobj,"tam.mml")){
         res <- tam.mml.fit( tamobj, ...)
     }
-    if(class(tamobj)=="tam.jml"){
+    if(inherits(tamobj,"tam.jml")){
         res <- tam.jml.fit( tamobj, ...)
     }
     res$CALL <- CALL

R/tam.mml.3pl.R

@@ -1,5 +1,5 @@
 ## File Name: tam.mml.3pl.R
-## File Version: 9.881
+## File Version: 9.882
 
 tam.mml.3pl <- function( resp, Y=NULL, group=NULL,
             formulaY=NULL, dataY=NULL,
@@ -718,7 +718,7 @@ tam.mml.3pl <- function( resp, Y=NULL, group=NULL,
     se.xsi.min -> se.xsi
     se.B.min -> se.B
 
-    #*** include NAs in AXsi    
+    #*** include NAs in AXsi
     AXsi <- tam_mml_include_NA_AXsi(AXsi=AXsi, maxcat=maxK, A=A, xsi=xsi)
 
     #**** standard errors AXsi

R/tam.modelfit.IRT.R

@@ -1,15 +1,14 @@
 ## File Name: tam.modelfit.IRT.R
-## File Version: 0.03
+## File Version: 0.06
 
 
-###############################################################
 tam.modelfit.IRT <- function( object, progress=TRUE )
 {
     resp <- IRT.data(object)
     probs <- IRT.irfprob(object)
     theta <- attr( probs, "theta" )
     post <- IRT.posterior( object )
-    res <- tam.modelfit.args( resp, probs, theta, post, progress)
+    res <- tam.modelfit.args( resp=resp, probs=probs, theta=theta,
+                    post=post, progress=progress)
     return(res)
 }
-#############################################################

R/tam.modelfit.R

@@ -1,5 +1,5 @@
 ## File Name: tam.modelfit.R
-## File Version: 9.38
+## File Version: 9.406
 
 
 # Q3 statistic and model fit statistics for objects of class tam
@@ -127,12 +127,11 @@ tam.modelfit <- function( tamobj, progress=TRUE )
         chisquare.itemfit$p[ii] <- min( stats::p.adjust( h1$p, method="holm") )
     }
     chisquare.itemfit$p.holm <- stats::p.adjust( chisquare.itemfit$p, method="holm")
+
     # maximum chi square
-    modelfit.test <- data.frame(
-                "maxX2"=max( chi2.stat$chi2),
-                "Npairs"=nrow(chi2.stat),
-                "p.holm"=min( chi2.stat$p.holm[pair_exists] )
-                )
+    modelfit.test <- data.frame( maxX2=max( chi2.stat$chi2),
+                            Npairs=nrow(chi2.stat),
+                            p.holm=min( chi2.stat$p.holm[pair_exists] )    )
 
     #** modelfit.stat
     modelfit.stat <- fitstat

R/tam.modelfit.args.R

@@ -1,16 +1,14 @@
 ## File Name: tam.modelfit.args.R
-## File Version: 0.06
+## File Version: 0.08
 
 
-########################################################
-# tam.modelfit with user defined input
+#-- tam.modelfit with user defined input
 tam.modelfit.args <- function( resp, probs, theta, post, progress=TRUE )
 {
     resp.ind <- as.matrix( 1- is.na(resp) )
-    tamobj <- list( resp=resp, rprobs=probs,
-                    theta=theta, hwt=post,
+    tamobj <- list( resp=resp, rprobs=probs, theta=theta, hwt=post,
                     resp.ind=resp.ind )
     res <- tam.modelfit( tamobj=tamobj, progress=progress)
     return(res)
 }
-########################################################
+

R/tam.personfit.R

@@ -1,10 +1,10 @@
 ## File Name: tam.personfit.R
-## File Version: 0.06
+## File Version: 0.07
 
 tam.personfit <- function(tamobj)
 {
     #** WLE estimation in case of MML estimation
-    if ( class(tamobj) !="tam.jml" ){
+    if ( ! inherits(tamobj,"tam.jml") ){
         res <- tam.wle(tamobj, progress=FALSE)
         tamobj$theta <- res$theta
         tamobj$xsi <- tamobj$xsi$xsi

R/tam.pv.R

@@ -1,5 +1,5 @@
 ## File Name: tam.pv.R
-## File Version: 9.466
+## File Version: 9.468
 tam.pv <- function( tamobj, nplausible=10,
             ntheta=2000, normal.approx=FALSE, samp.regr=FALSE,
             theta.model=FALSE, np.adj=8, na.grid=5, verbose=TRUE)
@@ -26,13 +26,13 @@ tam.pv <- function( tamobj, nplausible=10,
     #-- check for recommendation of tam.pv.mcmc
     res <- tam_pv_recommend_tam_pv_mcmc(tamobj=tamobj)
 
-    if ( class(tamobj)=="tam.latreg" ){
+    if ( inherits(tamobj,"tam.latreg") ){
         theta.model <- TRUE
         latreg <- TRUE
         like <- tamobj$like
     }
     if ( ! latreg ){
-        if (class(tamobj)!="tam.mml.3pl"){
+        if ( ! inherits(tamobj,"tam.mml.3pl") ){
             guess <- rep( 0, dim(tamobj$B)[1] )
         } else {
             guess <- tamobj$guess

R/tam.se.R

@@ -1,19 +1,20 @@
 ## File Name: tam.se.R
-## File Version: 9.15
+## File Version: 9.161
+
 tam.se <- function( tamobj, item_pars=TRUE, ...)
 {
     SE.quick <- TRUE
     #-------------------------------
     ## "quick" standard errors
     if(SE.quick){
-        if(class(tamobj) %in% c("tam.mml") ){
+        if(inherits(tamobj,"tam.mml") ){
             res <- tam_mml_se_quick( tamobj=tamobj, item_pars=item_pars, ...)
         }
-        if(class(tamobj) %in% c("tam.latreg") ){
+        if(inherits(tamobj,"tam.latreg") ){
             res <- tam_latreg_se_quick( tamobj=tamobj, ...)
         }
 
-        if(class(tamobj)=="tam.jml"){
+        if(inherits(tamobj,"tam.jml")){
             # res <- tam.jml.se( tamobj, ...)
             ## include standard errors here!!
         }

R/tam.threshold.R

@@ -1,5 +1,5 @@
 ## File Name: tam.threshold.R
-## File Version: 9.15
+## File Version: 9.161
 
 
 #**** Thurstonian thresholds (gammas)
@@ -11,7 +11,7 @@ tam.threshold <- function (tamobj, prob.lvl=0.5)
     maxK <- tamobj$maxK
     AXsi <- tamobj$AXsi
     xsi <- tamobj$xsi
-    if (class(tamobj)!="tam.jml"){
+    if (! inherits(tamobj,"tam.jml")){
         xsi <- xsi[,1]
     }
     A <- tamobj$A

R/tam.wle.R

@@ -1,16 +1,16 @@
 ## File Name: tam.wle.R
-## File Version: 9.16
+## File Version: 9.171
 
 tam.wle <- function( tamobj, ... )
 {
     CALL <- match.call()
-    if(class(tamobj)=="tam.mml"){
+    if(inherits(tamobj,"tam.mml")){
         res <- tam.mml.wle2( tamobj, ...)
     }
-    if(class(tamobj)=="tamaan"){
+    if(inherits(tamobj,"tamaan")){
         res <- tam.mml.wle2( tamobj, ...)
     }
-    if(class(tamobj)=="tam.jml"){
+    if(inherits(tamobj,"tam.jml")){
         res <- tam_jml_wle( tamobj, ...)
     }
     attr(res,"call") <- CALL

R/sirt_import_sfsmisc_QUnif.R → R/tam_import_sfsmisc_QUnif.R

@@ -1,7 +1,7 @@
-## File Name: sirt_import_sfsmisc_QUnif.R
-## File Version: 0.05
+## File Name: tam_import_sfsmisc_QUnif.R
+## File Version: 0.061
 
-sirt_import_sfsmisc_QUnif <- function(n, min=0, max=1, n.min=1, p,
+tam_import_sfsmisc_QUnif <- function(n, min=0, max=1, n.min=1, p,
         leap=409, ...)
 {
     require_namespace_msg("sfsmisc")

R/tam_mml_create_nodes.R

@@ -1,5 +1,5 @@
 ## File Name: tam_mml_create_nodes.R
-## File Version: 0.31
+## File Version: 0.331
 
 tam_mml_create_nodes <- function(snodes, nodes, ndim, QMC,
         skillspace="normal", theta.k=NULL)
@@ -48,7 +48,8 @@ tam_mml_create_nodes <- function(snodes, nodes, ndim, QMC,
         # sampled theta values
         if (QMC){
             fac <- 1
-            r1 <- sirt_import_sfsmisc_QUnif(n=snodes, min=0, max=1, n.min=1, p=ndim, leap=409)
+            r1 <- tam_import_sfsmisc_QUnif(n=snodes, min=0, max=1, n.min=1, 
+                            p=ndim, leap=409)
             theta0.samp <- fac * stats::qnorm(r1)
             if (ndim==1){
                 theta0.samp <- theta0.samp[ order(theta0.samp[,1]), ]

R/tam_osink.R

@@ -1,7 +1,7 @@
 ## File Name: tam_osink.R
-## File Version: 0.04
+## File Version: 0.05
 
-tam_osink <- function(file, suffix="__SUMMARY.Rout")
+tam_osink <- function(file, suffix=".Rout")
 {
     CDM::osink( file=file, suffix=suffix )
 }