R/summary.tam.R

In TAM: Test Analysis Modules

## File Name: summary.tam.R
## File Version: 9.587

#****** summary for tam object
summary.tam <- function( object, file=NULL, ...)
{
    tam_osink(file=file)

    latreg <- FALSE
    if ( inherits(object,"tam.latreg") ){
        latreg <- TRUE
        object$irtmodel <- "tam.latreg"
    }

    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("Multidimensional Item Response Model in TAM \n\n")
    irtmodel <- object$irtmodel
    cat("IRT Model:", irtmodel )

    #--- print call
    tam_print_call(object$CALL)

    cat(sdisplay)
    cat( "Number of iterations", "=", object$iter, "\n" )

    ctr <- object$control
    if (ctr$snodes==0){
        cat("Numeric integration with", dim(object$theta)[1], "integration points\n")
    }
    if (ctr$snodes>0){
        if (ctr$QMC){
            cat("Quasi Monte Carlo integration with", dim(object$theta)[1], "integration points\n")
        }
        if (! ctr$QMC){
            cat("Monte Carlo integration with", dim(object$theta)[1], "integration points\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" )

    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" )
    if (! latreg ){
        cat( "    Item threshold parameters", "=", object$ic$Nparsxsi, "\n" )
        cat( "    Item slope parameters", "=", object$ic$NparsB, "\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, digits_values=digits_ll )

    cat(sdisplay)
    cat("EAP Reliability\n")
    obji <- round( object$EAP.rel, 3 )
    print(obji)

    cat(sdisplay)
    cat("Covariances and Variances\n")
    if ( object$G >1){
        a1 <- stats::aggregate( object$variance, list( object$group ), mean )
        object$variance <- a1[,2]
    }
    obji <- round( object$variance, 3 )
    if ( object$G >1){
        names(obji) <- paste0("Group", object$groups )
    }
    print(obji)

    cat(sdisplay)
    cat("Correlations and Standard Deviations (in the diagonal)\n")
    if ( object$G >1){
        obji <- sqrt(object$variance)
    } else {
        obji <- stats::cov2cor(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(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(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=TRUE)

        # print xsi parameters if
        if( ! is.null( object$formulaA)  ){
            cat("\nItem Facet Parameters Xsi\n")
            obji <- object$xsi.facets
            xsi99 <- sum( object$xsi==99 )
            if ( xsi99 > 0 ){
                cat("\nSome item xsi parameters are not estimable ")
                cat(" which is indicated by values of 99\n\n")
            }
            if ( object$PSF ){
                cat("\nA pseudo facet 'psf' with zero effects with all zero effects\n")
                cat("was created because of non-unique person-facet combinations.\n\n")
            }
            tam_round_data_frame_print(obji=obji, from=3, digits=3)
        }
        if (( object$maxK > 2 ) | ( object$printxsi) ){
            cat("\nItem Parameters Xsi\n")
            obji <- object$xsi
            tam_round_data_frame_print(obji=obji, from=1, digits=3)
        }
        if ( ! is.null(object$item_irt) ){
            cat("\nItem Parameters in IRT parameterization\n")
            obji <- object$item_irt
            tam_round_data_frame_print(obji=obji, from=2, digits=3)
        }


        #*******************
        # output efa
        if ( object$irtmodel %in% c("efa") ){
            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(sdisplay)
            if (irtmodel=="efa"){
                cat("\nStandardized Factor Loadings (Schmid Leimann transformation)\n")
                obji <- object$B.SL
            } else {
                cat("\nStandardized Factor Loadings (Bifactor Model)\n")
                obji <- object$B.stand
            }
            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")
            if (object$maxK==2){
                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)
}
#*******************************************************

summary.tam.mml <- summary.tam
summary.tam.2pl <- summary.tam
summary.tam.mfr <- summary.tam
summary.tam.latreg <- summary.tam