3.0-18

alexanderrobitzsch · Dec 5, 2018 · d845cae · d845cae
1 parent a5396f2
commit d845cae
Show file tree

Hide file tree

Showing 29 changed files with 284 additions and 196 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,8 +1,8 @@
 Package: TAM
 Type: Package
 Title: Test Analysis Modules
-Version: 3.0-12
-Date: 2018-11-15 16:39:49
+Version: 3.0-18
+Date: 2018-12-05 19:43:46
 Author:
     Alexander Robitzsch [aut, cre], Thomas Kiefer [aut], Margaret Wu [aut]
 Maintainer: Alexander Robitzsch <[email protected]>

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

diff --git a/R/designMatrices.mfr.R b/R/designMatrices.mfr.R
@@ -1,5 +1,5 @@
 ## File Name: designMatrices.mfr.R
-## File Version: 9.32
+## File Version: 9.34
 
 
 #########################################################################
@@ -192,7 +192,7 @@ z0 <- tamcat( " ---  col sums (gresp noStep) in X (Rcpp)", z0, tamcat_active )
                             dimnames=list( paste("_step",0:maxK, sep=""),
                                             unique(gsub("-step([[:digit:]])*", "", rownames(x))),
                                             colnames(x) ) )
-       , c(2,1,3)
+     , c(2,1,3)
       ) )
     }
 

diff --git a/R/designMatrices.mfr2.R b/R/designMatrices.mfr2.R
@@ -1,5 +1,5 @@
 ## File Name: designMatrices.mfr2.R
-## File Version: 9.33
+## File Version: 9.35
 
 
 #########################################################################
@@ -202,7 +202,7 @@ designMatrices.mfr2 <- function( resp, formulaA=~ item + item:step, facets=NULL,
                             dimnames=list( paste("_step",0:maxK, sep=""),
                                             unique(gsub("-step([[:digit:]])*", "", rownames(x))),
                                             colnames(x) ) )
-       , c(2,1,3)
+     , c(2,1,3)
       ) )
     }
     # generate B

diff --git a/R/summary.msq.itemfit.R b/R/summary.msq.itemfit.R
@@ -1,13 +1,14 @@
 ## File Name: summary.msq.itemfit.R
-## File Version: 9.19
+## File Version: 9.25
 
 #**** summary for msq.itemfit
 summary.msq.itemfit <- function( object, file=NULL,  ... )
 {
 
     tam_osink( file=file)
 
-    cat("------------------------------------------------------------\n")
+    sdisplay <- tam_summary_display()
+    cat(sdisplay)
 
     #- package and R session
     tam_print_package_rsession(pack="TAM")
@@ -19,12 +20,14 @@ summary.msq.itemfit <- function( object, file=NULL,  ... )
     #--- print call
     tam_print_call(object$CALL)
 
-    cat("****************************************************\n")
+    sdisplay2 <- tam_summary_display("*", 52)
+    cat(sdisplay2)
     cat("\nSummary outfit and infit statistic\n")
     obji <- object$summary_itemfit
     tam_round_data_frame_print(obji=obji, from=2, digits=3, rownames_null=TRUE)
+    cat("\n")
 
-    cat("\n****************************************************\n")
+    cat(sdisplay2)
     cat("\nOutfit and infit statistic\n")
     obji <- object$itemfit
     ind <- grep( "fitgroup", colnames(obji) )

diff --git a/R/summary.tam.R b/R/summary.tam.R
@@ -1,18 +1,19 @@
 ## File Name: summary.tam.R
-## File Version: 9.54
+## File Version: 9.582
 
 #****** summary for tam object
 summary.tam <- function( object, file=NULL, ...)
 {
-    tam_osink( file=file)
+    tam_osink(file=file)
 
     latreg <- FALSE
     if ( class(object)=="tam.latreg" ){
         latreg <- TRUE
         object$irtmodel <- "tam.latreg"
     }
 
-    cat("------------------------------------------------------------\n")
+    sdisplay <- tam_summary_display()
+    cat(sdisplay)
 
     #--- package and R session
     tam_print_package_rsession(pack="TAM")
@@ -21,13 +22,13 @@ summary.tam <- function( object, file=NULL, ...)
 
     cat("Multidimensional Item Response Model in TAM \n\n")
     irtmodel <- object$irtmodel
-    cat("IRT Model", irtmodel )
+    cat("IRT Model:", irtmodel )
 
     #--- print call
     tam_print_call(object$CALL)
 
-    cat("------------------------------------------------------------\n")
-    cat( "Number of iterations=", object$iter, "\n" )
+    cat(sdisplay)
+    cat( "Number of iterations", "=", object$iter, "\n" )
 
     ctr <- object$control
     if (ctr$snodes==0){
@@ -42,37 +43,41 @@ summary.tam <- function( object, file=NULL, ...)
         }
     }
 
-    cat( "\nDeviance=", round( object$deviance, 2 ), "\n" )
-    cat( "   Log likelihood=", round( object$ic$loglike, 2 ), "\n" )
+    digits_ll <- 2    # digits after decimal for log-likelihood
+    cat( "\nDeviance", "=", round( object$deviance, digits_ll ), "\n" )
+    cat( "Log likelihood", "=", round( object$ic$loglike, digits_ll ), "\n" )
     # cat( "   Log prior=", round( object$ic$logprior, 2 ), "\n" )
     # cat( "   Log posterior=", round( object$ic$logpost, 2 ), "\n\n" )
 
-    cat( "Number of persons=", object$nstud, "\n" )
-    cat( "Number of persons used=", object$ic$n, "\n" )
+    cat( "Number of persons", "=", object$nstud, "\n" )
+    cat( "Number of persons used", "=", object$ic$n, "\n" )
 
-    if( ! is.null( object$formulaA)  ){
-        cat( "Number of generalized items=", object$nitems, "\n" )
-        cat( "Number of items=", ncol(object$resp_orig), "\n" )
-    } else {
-        cat( "Number of items=", object$nitems, "\n" )
+    if (!latreg){
+        if( ! is.null( object$formulaA)  ){
+            cat( "Number of generalized items", "=", object$nitems, "\n" )
+            cat( "Number of items", "=", ncol(object$resp_orig), "\n" )
+        } else {
+            cat( "Number of items", "=", object$nitems, "\n" )
+        }
     }
 
-    cat( "Number of estimated parameters=", object$ic$Npars, "\n" )
+    cat( "Number of estimated parameters", "=", object$ic$Npars, "\n" )
     if (! latreg ){
-        cat( "    Item threshold parameters=", object$ic$Nparsxsi, "\n" )
-        cat( "    Item slope parameters=", object$ic$NparsB, "\n" )
+        cat( "    Item threshold parameters", "=", object$ic$Nparsxsi, "\n" )
+        cat( "    Item slope parameters", "=", object$ic$NparsB, "\n" )
     }
-    cat( "    Regression parameters=", object$ic$Nparsbeta, "\n" )
-    cat( "    (Co)Variance parameters=", object$ic$Nparscov, "\n\n" )
+    cat( "    Regression parameters", "=", object$ic$Nparsbeta, "\n" )
+    cat( "    Variance/covariance parameters", "=", object$ic$Nparscov, "\n\n" )
 
     #--- print information criteria
-    res <- tam_summary_print_ic( object=object )
+    res <- tam_summary_print_ic( object=object, digits_values=digits_ll )
 
-    cat("------------------------------------------------------------\n")
+    cat(sdisplay)
     cat("EAP Reliability\n")
     obji <- round( object$EAP.rel, 3 )
-    print( obji )
-    cat("------------------------------------------------------------\n")
+    print(obji)
+
+    cat(sdisplay)
     cat("Covariances and Variances\n")
     if ( object$G >1){
         a1 <- stats::aggregate( object$variance, list( object$group ), mean )
@@ -82,29 +87,30 @@ summary.tam <- function( object, file=NULL, ...)
     if ( object$G >1){
         names(obji) <- paste0("Group", object$groups )
     }
-    print( obji )
-    cat("------------------------------------------------------------\n")
+    print(obji)
+
+    cat(sdisplay)
     cat("Correlations and Standard Deviations (in the diagonal)\n")
     if ( object$G >1){
-        obji <- sqrt( object$variance )
+        obji <- sqrt(object$variance)
     } else {
         obji <- stats::cov2cor(object$variance)
-        diag(obji) <- sqrt( diag( object$variance) )
+        diag(obji) <- sqrt( diag(object$variance) )
     }
     if ( object$G >1){
         names(obji) <- paste0("Group", object$groups )
     }
     tam_round_data_frame_print(obji=obji, digits=3)
 
-    cat("------------------------------------------------------------\n")
+    cat(sdisplay)
     cat("Regression Coefficients\n")
     tam_round_data_frame_print(obji=object$beta, digits=5)
 
     #--- print standardized regression coefficients
     summary_tam_print_latreg_stand(object=object, digits_stand=4)
 
     if ( ! latreg ){
-        cat("------------------------------------------------------------\n")
+        cat(sdisplay)
         cat("Item Parameters -A*Xsi\n")
         obji <- object$item
         tam_round_data_frame_print(obji=obji, from=2, to=ncol(obji), digits=3, rownames_null=FALSE)
@@ -132,14 +138,14 @@ summary.tam <- function( object, file=NULL, ...)
         #*******************
         # output efa
         if ( object$irtmodel %in% c("efa") ){
-            cat("------------------------------------------------------------\n")
+            cat(sdisplay)
             cat("\nStandardized Factor Loadings Oblimin Rotation\n")
             print(object$efa.oblimin)
         }
         #*******************
         # output bifactor models
         if ( object$irtmodel %in% c("bifactor1", "bifactor2","efa") ){
-            cat("------------------------------------------------------------\n")
+            cat(sdisplay)
             if (irtmodel=="efa"){
                 cat("\nStandardized Factor Loadings (Schmid Leimann transformation)\n")
                 obji <- object$B.SL
@@ -150,18 +156,18 @@ summary.tam <- function( object, file=NULL, ...)
             tam_round_data_frame_print(obji=obji, digits=3)
             meas <- object$meas
             cat("\nDimensionality/Reliability Statistics\n\n")
-            cat("ECV=", round( meas["ECV"],3 ), "\n")
-            cat("Omega Asymptotical=", round( meas["omega_a"],3 ), "\n")
-            cat("Omega Total=", round( meas["omega_t"],3 ), "\n")
-            cat("Omega Hierarchical=", round( meas["omega_h"],3 ), "\n")
+            cat("ECV", "=", round( meas["ECV"],3), "\n")
+            cat("Omega Asymptotical", "=", round( meas["omega_a"],3), "\n")
+            cat("Omega Total", "=", round( meas["omega_t"],3 ), "\n")
+            cat("Omega Hierarchical", "=", round( meas["omega_h"],3), "\n")
             if (object$maxK==2){
-                cat("Omega Total (GY)=", round( meas["omega_tot_diff"],3 ), "\n")
+                cat("Omega Total (GY)", "=", round( meas["omega_tot_diff"],3), "\n")
                 cat( "  Omega Total GY (Green & Yang, 2009) includes item difficulties\n")
                 cat( "  and estimates the reliability of the sum score.\n")
             }
         }
     }
-    #******
+    #** close sink
     tam_csink(file=file)
 }
 #*******************************************************

diff --git a/R/summary.tam.fit.R b/R/summary.tam.fit.R
@@ -1,16 +1,30 @@
 ## File Name: summary.tam.fit.R
-## File Version: 9.05
+## File Version: 9.17
 
-###################################################
-# summary for tam.fit
-summary.tam.fit <- function( object, ... )
+
+#*** summary for tam.fit
+summary.tam.fit <- function( object, file=NULL, ... )
 {
-    object <- object$itemfit
-    ind <- grep( "pholm", colnames(object) )
-    obji <- object[, - ind ]
-    for ( vv in seq(2,ncol(obji) ) ){
-        obji[,vv] <- round( obji[,vv], 3 )
-    }
-    return(obji)
+    tam_osink(file=file)
+
+    sdisplay <- tam_summary_display()
+    cat(sdisplay)
+
+    #- package and R session
+    tam_print_package_rsession(pack="TAM")
+    #- computation time
+    tam_print_computation_time(object=object)
+
+    cat("Item fit statitics (Function 'tam.fit')")
+
+    #--- print call
+    tam_print_call(object$CALL)
+
+    obji <- object$itemfit
+    ind <- grep( "pholm", colnames(obji) )
+    obji <- obji[, - ind ]
+    tam_round_data_frame_print(obji=obji, digits=3, from=2)
+
+    tam_csink(file=file)
 }
-###################################################
+
diff --git a/R/summary.tam.jml.R b/R/summary.tam.jml.R
@@ -1,7 +1,8 @@
 ## File Name: summary.tam.jml.R
-## File Version: 9.18
-#*******************************************************
-# Summary for tam object                 *
+## File Version: 9.22
+
+
+#***** summary for tam object
 summary.tam.jml <- function( object, file=NULL, ...)
 {
     if ( ! is.null( file ) ){
@@ -23,9 +24,9 @@ summary.tam.jml <- function( object, file=NULL, ...)
     tam_print_call(object$CALL)
 
     cat("------------------------------------------------------------\n")
-    cat( "Number of iterations=", object$iter, "\n" )
+    cat( "Number of iterations=", object$iter, "\n\n" )
 
-    cat( "\nDeviance=", round( object$deviance, 2 ), " | " )
+    cat( "Deviance=", round( object$deviance, 2 ), " | " )
     cat( "Log Likelihood=", round( -object$deviance/2, 2 ), "\n" )
     cat( "Number of persons=", object$nstud, "\n" )
 
@@ -114,4 +115,3 @@ summary.tam.jml <- function( object, file=NULL, ...)
         sink()
     }
 }
-#*******************************************************