From d845cae9843842d3154cc3df9b6f4bbf625b52b9 Mon Sep 17 00:00:00 2001 From: alexanderrobitzsch Date: Wed, 5 Dec 2018 19:49:41 +0100 Subject: [PATCH] 3.0-18 --- DESCRIPTION | 4 +- R/RcppExports.R | 2 +- R/designMatrices.mfr.R | 4 +- R/designMatrices.mfr2.R | 4 +- R/summary.msq.itemfit.R | 11 ++- R/summary.tam.R | 82 +++++++++++---------- R/summary.tam.fit.R | 38 +++++++--- R/summary.tam.jml.R | 12 +-- R/summary.tam.mml.3pl.R | 68 +++++++++-------- R/summary_tamaan_3pl_intro.R | 4 +- R/tam.fit.R | 40 ++++++---- R/tam.jml.fit.R | 8 +- R/tam_mml_mfr_proc_create_design_matrices.R | 10 +-- R/tam_summary_display.R | 8 ++ R/tam_summary_print_ic.R | 10 +-- R/tam_summary_print_ic_one_ic.R | 6 +- R/zzz.R | 9 ++- README.md | 4 +- inst/NEWS | 9 +-- man/TAM-package.Rd | 33 ++++----- man/tam.fit.Rd | 5 +- man/tam.linking.Rd | 13 ++-- man/tam.mml.Rd | 54 +++++++++++++- src/RcppExports.cpp | 2 +- src/init.c | 2 +- src/tam_rcpp_mml_3pl.cpp | 4 +- src/tam_rcpp_prior_normal_density.cpp | 6 +- src/tam_rcpp_pv_mcmc.cpp | 4 +- src/tam_rcpp_wle.cpp | 24 ++---- 29 files changed, 284 insertions(+), 196 deletions(-) create mode 100644 R/tam_summary_display.R diff --git a/DESCRIPTION b/DESCRIPTION index ccfa02e..af35798 100644 --- 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 diff --git a/R/RcppExports.R b/R/RcppExports.R index aa8f564..7cc603f 100644 --- 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 index 512a2bb..de8b046 100644 --- 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 index b6980be..2d0c9d7 100644 --- 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 index 706ca43..762d808 100644 --- a/R/summary.msq.itemfit.R +++ b/R/summary.msq.itemfit.R @@ -1,5 +1,5 @@ ## 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, ... ) @@ -7,7 +7,8 @@ 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 index 7c80a6a..e296711 100644 --- a/R/summary.tam.R +++ b/R/summary.tam.R @@ -1,10 +1,10 @@ ## 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" ){ @@ -12,7 +12,8 @@ summary.tam <- function( object, file=NULL, ...) 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,21 +87,22 @@ 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) @@ -104,7 +110,7 @@ summary.tam <- function( object, file=NULL, ...) 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 index c10df2e..e7e6e4b 100644 --- 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 index 5056094..bf0e293 100644 --- 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() } } -#******************************************************* diff --git a/R/summary.tam.mml.3pl.R b/R/summary.tam.mml.3pl.R index b9b71fa..0a7e599 100644 --- a/R/summary.tam.mml.3pl.R +++ b/R/summary.tam.mml.3pl.R @@ -1,14 +1,14 @@ ## File Name: summary.tam.mml.3pl.R -## File Version: 9.33 +## File Version: 9.37 -#******************************************************* -# Summary for tam.mml.3pl object * +# summary for tam.mml.3pl object summary.tam.mml.3pl <- 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") @@ -20,8 +20,8 @@ summary.tam.mml.3pl <- function( object, file=NULL, ...) cat("IRT Model", irtmodel, " (Function 'tam.mml.3pl')") tam_print_call(object$CALL) - cat("------------------------------------------------------------\n") - cat( "Number of iterations=", object$iter, "\n\n" ) + cat(sdisplay) + cat( "Number of iterations", "=", object$iter, "\n\n" ) ctr <- object$control cat("Skill space:", ifelse(object$skillspace=="normal", @@ -40,26 +40,26 @@ summary.tam.mml.3pl <- function( object, file=NULL, ...) } } } - cat( "\nDeviance=", round( object$deviance, 2 ), " | " ) - cat( "Log Likelihood=", round( -object$deviance/2, 2 ), "\n" ) - cat( "Number of persons=", object$nstud, "\n" ) - cat( "Number of persons used=", object$ic$n, "\n" ) + cat( "\nDeviance", "=", round( object$deviance, 2 ), " | " ) + cat( "Log Likelihood", "=", round( -object$deviance/2, 2 ), "\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" ) + 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 items", "=", object$nitems, "\n" ) } - cat( "Number of estimated parameters=", object$ic$Npars, "\n" ) - cat( " Item threshold parameters=", object$ic$Nparsxsi, "\n" ) - cat( " Item slope parameters=", object$ic$NparsB, "\n" ) - cat( " Non-active item slopes=", object$ic$Ngamma.nonactive, "\n" ) - cat( " Item guessing parameters=", object$ic$Nguess, "\n" ) - cat( " Regression parameters=", object$ic$Nparsbeta, "\n" ) - cat( " (Co)Variance parameters=", object$ic$Nparscov, "\n" ) - cat( " Delta parameters =", object$ic$Ndelta, "\n\n" ) + cat( "Number of estimated parameters", "=", object$ic$Npars, "\n" ) + cat( " Item threshold parameters", "=", object$ic$Nparsxsi, "\n" ) + cat( " Item slope parameters", "=", object$ic$NparsB, "\n" ) + cat( " Non-active item slopes", "=", object$ic$Ngamma.nonactive, "\n" ) + cat( " Item guessing parameters", "=", object$ic$Nguess, "\n" ) + cat( " Regression parameters", "=", object$ic$Nparsbeta, "\n" ) + cat( " Variance/covariance parameters", "=", object$ic$Nparscov, "\n" ) + cat( " Delta parameters ", "=", object$ic$Ndelta, "\n\n" ) #--- print information criteria res <- tam_summary_print_ic( object=object ) @@ -70,11 +70,11 @@ summary.tam.mml.3pl <- function( object, file=NULL, ...) G <- object$G if (object$skillspace=="normal"){ - cat("------------------------------------------------------------\n") + cat(sdisplay) cat("EAP Reliability\n") obji <- round( object$EAP.rel, 3 ) print( obji ) - cat("------------------------------------------------------------\n") + cat(sdisplay) cat("Covariances and Variances\n") if ( object$G >1){ group_names <- paste0("Group", object$groups ) @@ -94,7 +94,7 @@ summary.tam.mml.3pl <- function( object, file=NULL, ...) if (G==1){ print( obji ) } - cat("------------------------------------------------------------\n") + cat(sdisplay) cat("Correlations and Standard Deviations (in the diagonal)\n") if ( object$G > 1){ group_names <- paste0("Group", object$groups ) @@ -115,31 +115,31 @@ summary.tam.mml.3pl <- function( object, file=NULL, ...) if (object$G==1){ obji <- round( obji, 3 ) - print( obji ) + print(obji) } - cat("------------------------------------------------------------\n") + cat(sdisplay) cat("Regression Coefficients\n") obji <- round( object$beta, 5 ) - print( obji ) + print(obji) } # end distribution skillspace=="normal" #******************************************************************* if (object$skillspace !="normal"){ - cat("------------------------------------------------------------\n") + cat(sdisplay) cat("Trait distribution parameters delta\n") obji <- round( object$delta, 4 ) colnames(obji) <- paste0("Group", 1:object$G) - print( obji ) + print(obji) TP <- nrow(obji) if ( PK < 10 ){ - cat("------------------------------------------------------------\n") + cat(sdisplay) cat("Full Trait distribution\n") obji <- round( object$pi.k, 4 ) colnames(obji) <- paste0("Group", 1:object$G) if ( TP < 100 ){ print( obji ) } - cat("------------------------------------------------------------\n") + cat(sdisplay) cat("Moments of Trait Distribution\n") obji <- object$pi.k cat( "\nM Trait:\n" ) @@ -157,7 +157,7 @@ summary.tam.mml.3pl <- function( object, file=NULL, ...) } if (PK < 10 ){ - cat("------------------------------------------------------------\n") + cat(sdisplay) cat("Item Parameters -A*Xsi\n") obji <- object$item tam_round_data_frame_print(obji=obji, from=2, digits=3) @@ -173,7 +173,7 @@ summary.tam.mml.3pl <- function( object, file=NULL, ...) tam_round_data_frame_print(obji=obji, from=1, digits=3) } } else { # PK >=10 - cat("------------------------------------------------------------\n") + cat(sdisplay) if (( object$maxK > 2 ) | ( object$printxsi) ){ cat("\nItem Parameters Xsi\n") obji <- object$xsi @@ -190,8 +190,6 @@ summary.tam.mml.3pl <- function( object, file=NULL, ...) obji <- object$gammaslope tam_round_data_frame_print(obji=obji, from=1, digits=3) - #****** tam_csink(file=file) } -#******************************************************* diff --git a/R/summary_tamaan_3pl_intro.R b/R/summary_tamaan_3pl_intro.R index 1a4dc64..a3470ba 100644 --- a/R/summary_tamaan_3pl_intro.R +++ b/R/summary_tamaan_3pl_intro.R @@ -1,5 +1,5 @@ ## File Name: summary_tamaan_3pl_intro.R -## File Version: 9.23 +## File Version: 9.24 ################################################ @@ -55,7 +55,7 @@ summary_tamaan_3pl_intro <- function(object){ cat( " Item guessing parameters=", object$ic$Nguess, "\n" ) cat( " Regression parameters=", object$ic$Nparsbeta, "\n" ) cat( " (Co)Variance parameters=", object$ic$Nparscov, "\n" ) - cat( " Delta parameters =", object$ic$Ndelta, "\n\n" ) + cat( " Delta parameters =", object$ic$Ndelta, "\n\n" ) #--- print information criteria tam_summary_print_ic( object=object ) diff --git a/R/tam.fit.R b/R/tam.fit.R index 7b4cc60..f0011f9 100644 --- a/R/tam.fit.R +++ b/R/tam.fit.R @@ -1,19 +1,23 @@ ## File Name: tam.fit.R -## File Version: 9.12 -tam.fit <- function( tamobj, ... ){ - if(class(tamobj)=="tam.mml"){ - res <- tam.mml.fit( tamobj, ...) - } - if(class(tamobj)=="tam.jml"){ - res <- tam.jml.fit( tamobj, ...) - } - class(res) <- "tam.fit" - return(res) +## File Version: 9.16 +tam.fit <- function( tamobj, ... ) +{ + CALL <- match.call() + if(class(tamobj)=="tam.mml"){ + res <- tam.mml.fit( tamobj, ...) + } + if(class(tamobj)=="tam.jml"){ + res <- tam.jml.fit( tamobj, ...) + } + res$CALL <- CALL + class(res) <- 'tam.fit' + return(res) } -tam.mml.fit <- - function( tamobj, FitMatrix=NULL, Nsimul=NULL, progress=TRUE, - useRcpp=TRUE, seed=NA, fit.facets=TRUE ){ +tam.mml.fit <- function( tamobj, FitMatrix=NULL, Nsimul=NULL, progress=TRUE, + useRcpp=TRUE, seed=NA, fit.facets=TRUE ) +{ + s1 <- Sys.time() ##################################################### # INPUT: # tamobj ... result from tam analysis @@ -239,12 +243,16 @@ tam.mml.fit <- # envir=parent.env(this_envir) ) # assign(".Random.seed", old_seed, envir=globalenv()) - #data.frame( "Outfit"=round(Outfit,2), "Outfit_t"=round(Outfit_t,1), "Infit"=round(Infit,2), Infit_t=round(Infit_t,1) ) - res <- list( "itemfit"=res ) + + s2 <- Sys.time() + v1 <- c(s1, s2 ) + + #--- output + res <- list( "itemfit"=res, time=v1 ) class(res) <- "tam.fit" return(res) - } +} ######################################## diff --git a/R/tam.jml.fit.R b/R/tam.jml.fit.R index 0c9049a..a874672 100644 --- a/R/tam.jml.fit.R +++ b/R/tam.jml.fit.R @@ -1,5 +1,5 @@ ## File Name: tam.jml.fit.R -## File Version: 9.16 +## File Version: 9.18 tam.jml.fit <- function( tamobj ) @@ -8,7 +8,7 @@ tam.jml.fit <- function( tamobj ) # INPUT: # tamobj ... result from tam.jml analysis #################################################### - + s1 <- Sys.time() resp <- tamobj$resp resp.ind <- tamobj$resp.ind A <- tamobj$A @@ -92,6 +92,8 @@ tam.jml.fit <- function( tamobj ) outfitPerson_t=outfitPerson_t, infitPerson=infitPerson, infitPerson_t=infitPerson_t) - res <- list(fit.item=fit.item, fit.person=fit.person) + s2 <- Sys.time() + v1 <- c(s1, s2) + res <- list(fit.item=fit.item, fit.person=fit.person, time=v1) return(res) } diff --git a/R/tam_mml_mfr_proc_create_design_matrices.R b/R/tam_mml_mfr_proc_create_design_matrices.R index a8cef72..6d25de9 100644 --- a/R/tam_mml_mfr_proc_create_design_matrices.R +++ b/R/tam_mml_mfr_proc_create_design_matrices.R @@ -1,5 +1,5 @@ ## File Name: tam_mml_mfr_proc_create_design_matrices.R -## File Version: 0.09 +## File Version: 0.11 tam_mml_mfr_proc_create_design_matrices <- function(pid, maxKi, resp, formulaA, facets, constraint, ndim, Q, A, B, progress, xsi.fixed, resp00, B00, @@ -14,8 +14,7 @@ tam_mml_mfr_proc_create_design_matrices <- function(pid, maxKi, resp, formulaA, if ( var_ki > 1E-3 ){ diffKi <- TRUE design <- designMatrices.mfr2(resp=resp, formulaA=formulaA, facets=facets, - constraint=constraint, ndim=ndim, - Q=Q, A=A, B=B, progress=progress) + constraint=constraint, ndim=ndim, Q=Q, A=A, B=B, progress=progress) xsi.elim <- design$xsi.elim if ( ! is.null(xsi.elim) ){ if ( nrow(xsi.elim) > 0 ){ @@ -60,12 +59,11 @@ tam_mml_mfr_proc_create_design_matrices <- function(pid, maxKi, resp, formulaA, } } # end is.null() if ( is.null( pid ) ){ - pid <- 1:(nrow(gresp) ) + pid <- seq_len( nrow(gresp) ) } design <- NULL if (progress){ - cat(" * Created Design Matrices (", - paste(Sys.time()), ")\n") + cat(" * Created Design Matrices (", paste(Sys.time()), ")\n") utils::flush.console() } #--- OUTPUT diff --git a/R/tam_summary_display.R b/R/tam_summary_display.R new file mode 100644 index 0000000..e10da55 --- /dev/null +++ b/R/tam_summary_display.R @@ -0,0 +1,8 @@ +## File Name: tam_summary_display.R +## File Version: 0.02 + +tam_summary_display <- function(symbol="-", len=60) +{ + res <- paste0( paste0( rep(symbol,len), collapse="" ), "\n") + return(res) +} diff --git a/R/tam_summary_print_ic.R b/R/tam_summary_print_ic.R index 2a85768..8108710 100644 --- a/R/tam_summary_print_ic.R +++ b/R/tam_summary_print_ic.R @@ -1,5 +1,5 @@ ## File Name: tam_summary_print_ic.R -## File Version: 0.24 +## File Version: 0.26 tam_summary_print_ic <- function( object, digits_ic=0, digits_values=2, bayes_crit=FALSE ) { @@ -21,10 +21,10 @@ tam_summary_print_ic <- function( object, digits_ic=0, digits_values=2, bayes_cr if (bayes_crit){ #--- information criteria based on Bayesian inference cat("Criteria based on Fully Bayesian Inference\n") - cat( "\nDbar=", round( object$ic$Dbar, digits_values ) ) - cat( "\nDhat=", round( object$ic$Dhat, digits_values ) ) - cat( "\npD=", round( object$ic$pD, digits_values ) ) - cat( "\nDIC=", round( object$ic$DIC, digits_ic )," | penalty=", + cat( "\nDbar", "=", round( object$ic$Dbar, digits_values ) ) + cat( "\nDhat", "=", round( object$ic$Dhat, digits_values ) ) + cat( "\npD", "=", round( object$ic$pD, digits_values ) ) + cat( "\nDIC", "=", round( object$ic$DIC, digits_ic )," | penalty=", round( 2*object$ic$pD, digits_values ) ) cat(" | DIC=Dhat + 2*pD\n\n" ) } diff --git a/R/tam_summary_print_ic_one_ic.R b/R/tam_summary_print_ic_one_ic.R index 1c7ae90..fded961 100644 --- a/R/tam_summary_print_ic_one_ic.R +++ b/R/tam_summary_print_ic_one_ic.R @@ -1,5 +1,5 @@ ## File Name: tam_summary_print_ic_one_ic.R -## File Version: 0.13 +## File Version: 0.14 tam_summary_print_ic_one_ic <- function(ic, crit, digits_ic=0, digits_penalty=2) { @@ -9,7 +9,7 @@ tam_summary_print_ic_one_ic <- function(ic, crit, digits_ic=0, digits_penalty=2) nc <- nchar(crit) ic_label <- paste0( crit, rep( "", 4 - nc), collapse="") crit_desc <- tam_summary_print_ic_description(crit=crit) - cat( ic_label, "=", round( ic_val, digits_ic ), - " | penalty=", round( penalty, digits_penalty ), + cat( ic_label, "=", round( ic_val, digits_ic), + " | penalty", "=", round( penalty, digits_penalty), " |", crit_desc, "\n" ) } diff --git a/R/zzz.R b/R/zzz.R index d89ffb0..727bb3f 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -1,5 +1,5 @@ ## File Name: zzz.R -## File Version: 9.08 +## File Version: 9.09 # zzz.R # # This function is simply copied from mice package. @@ -24,3 +24,10 @@ version <- function(pkg="TAM"){ paste0("* ", d$Package," ", d$Version," (",d$Date,")" ) ) } +xx <- function(f1=1, f2=1) +{ + v1 <- paste0( rep(" ",f1), collapse="" ) + v2 <- paste0( rep(" ",f2), collapse="" ) + res <- paste0( v1, "=", v2) + return(res) +} diff --git a/README.md b/README.md index 61e13f3..de4d85e 100644 --- a/README.md +++ b/README.md @@ -18,9 +18,9 @@ The CRAN version can be installed from within R using: utils::install.packages("TAM") ``` -#### GitHub version `TAM` 3.0-12 (2018-11-15) +#### GitHub version `TAM` 3.0-18 (2018-12-05) -[![](https://img.shields.io/badge/github%20version-3.0--12-orange.svg)](https://github.com/alexanderrobitzsch/TAM)   +[![](https://img.shields.io/badge/github%20version-3.0--18-orange.svg)](https://github.com/alexanderrobitzsch/TAM)   The version hosted [here](https://github.com/alexanderrobitzsch/TAM) is the development version of `TAM`. The GitHub version can be installed using `devtools` as: diff --git a/inst/NEWS b/inst/NEWS index 0022985..8175aa7 100644 --- a/inst/NEWS +++ b/inst/NEWS @@ -41,7 +41,7 @@ http://www.edmeasurementsurveys.com/TAM/Tutorials/ ------------------------------------------------------------- -VERSIONS TAM 3.0 | 2018-11-15 | Last: TAM 3.0-12 +VERSIONS TAM 3.0 | 2018-12-05 | Last: TAM 3.0-18 ------------------------------------------------------------- FIXED * fixed numerical instabilities in latent regression @@ -51,11 +51,10 @@ FIXED * fixed numerical instabilities in latent regression exported (thanks to Simon Grund). NOTE * renamed weighted_curtosis() into weighted_kurtosis() -DATA * included/modified datasets: --- -EXAMP * included/modified examples: weighted_Stats (1,2) - - +DATA * included/modified datasets: --- +EXAMP * included/modified examples: weighted_Stats (1,2), + tam.mml (26) ------------------------------------------------------------- VERSIONS TAM 2.13 | 2018-09-30 | Last: TAM 2.13-15 diff --git a/man/TAM-package.Rd b/man/TAM-package.Rd index 30a2c0f..7e281e0 100644 --- a/man/TAM-package.Rd +++ b/man/TAM-package.Rd @@ -1,36 +1,33 @@ %% File Name: TAM-package.Rd -%% File Version: 2.62 +%% File Version: 2.64 \name{TAM-package} \alias{TAM-package} \alias{TAM} \docType{package} + \title{ -Test Analysis Modules +\packageTitle{TAM} } + \description{ - Includes marginal maximum likelihood estimation and joint maximum - likelihood estimation for unidimensional and multidimensional - item response models. The package functionality covers the - Rasch model, 2PL model, 3PL model, generalized partial credit model, - multi-faceted Rasch model, nominal item response model, - structured latent class model, mixture distribution IRT models, - and located latent class models. Latent regression models and - plausible value imputation are also supported. For details see - Adams, Wilson, and Wang, 1997, , - Adams, Wilson, and Wu, 1997, , - Formann, 1982, , - Formann, 1992, . +\packageDescription{TAM} +} + +\author{ +\packageAuthor{TAM} + +Maintainer: \packageMaintainer{TAM} } + + + + \details{ See \url{http://www.edmeasurementsurveys.com/TAM/Tutorials/} for tutorials of the \pkg{TAM} package. } -\author{ -Alexander Robitzsch [aut, cre], Thomas Kiefer [aut], Margaret Wu [aut] -Maintainer: Alexander Robitzsch -} \references{ Adams, R. J., Wilson, M., & Wang, W. C. (1997). The multidimensional random coefficients multinomial logit model. \emph{Applied Psychological Measurement, 21}(1), 1-23. diff --git a/man/tam.fit.Rd b/man/tam.fit.Rd index dccc19b..8879e36 100644 --- a/man/tam.fit.Rd +++ b/man/tam.fit.Rd @@ -1,5 +1,5 @@ %% File Name: tam.fit.Rd -%% File Version: 2.52 +%% File Version: 2.54 \name{tam.fit} @@ -26,7 +26,7 @@ tam.mml.fit(tamobj, FitMatrix=NULL, Nsimul=NULL,progress=TRUE, tam.jml.fit(tamobj) -\method{summary}{tam.fit}(object, \dots) +\method{summary}{tam.fit}(object, file=NULL, \dots) } %% tam.jml.fit(tamobj, resp, resp.ind, A, B, nstud, nitems, maxK, ItemScore, @@ -55,6 +55,7 @@ The latter is consistent with \pkg{TAM} (<=1.1).} \item{fit.facets}{An optional logical indicating whether fit for all facet parameters should be computed.} \item{object}{Object of class \code{tam.fit}} +\item{file}{Optional file name for summary output} \item{\dots}{Further arguments to be passed} } diff --git a/man/tam.linking.Rd b/man/tam.linking.Rd index d918231..06fda68 100644 --- a/man/tam.linking.Rd +++ b/man/tam.linking.Rd @@ -1,5 +1,5 @@ %% File Name: tam.linking.Rd -%% File Version: 0.53 +%% File Version: 0.58 \name{tam.linking} \alias{tam.linking} @@ -120,10 +120,13 @@ using IRT-based methods. \emph{Journal of Statistical Software, 35}(12), 1-33. %% ~Make other sections like Warning with \section{Warning }{....} ~ \seealso{ -Linking of item response models can be also conducted with \pkg{plink} -(Weeks, 2010) or \pkg{equateIRT} (Battauz, 2015) packages. See also the -\code{\link[sirt:linking.haberman]{sirt::linking.haberman}} in the \pkg{sirt} -package. +Linking or equating of item response models can be also conducted with \pkg{plink} +(Weeks, 2010), \pkg{equate}, \pkg{equateIRT} (Battauz, 2015), \pkg{equateMultiple}, +\pkg{kequate} and \pkg{irteQ} packages. + +See also the \code{\link[sirt:linking.haberman]{sirt::linking.haberman}} and +\code{\link[sirt:invariance.alignment]{sirt::invariance.alignment}} functions +in the \pkg{sirt} package. } \examples{ diff --git a/man/tam.mml.Rd b/man/tam.mml.Rd index de29b04..89abead 100644 --- a/man/tam.mml.Rd +++ b/man/tam.mml.Rd @@ -1,5 +1,5 @@ %% File Name: tam.mml.Rd -%% File Version: 2.9842 +%% File Version: 2.9846 \name{tam.mml} @@ -2171,6 +2171,58 @@ mod1$AXsi / mod1$B[,2,1] coef(mod2, IRTpars=TRUE) # ltm coef(mod3)[, c(4,1:3)] + +############################################################################# +# EXAMPLE 26: Differential item functioning in multdimensional models +############################################################################# + +data(data.ex08, package="TAM") +formulaA <- ~ item+female+item*female +resp <- data.ex08[["resp"]] +facets <- as.data.frame(data.ex08[["facets"]]) + +#*** Model 8a: investigate gender DIF in undimensional model +mod8a <- TAM::tam.mml.mfr(resp=resp, facets=facets, formulaA=formulaA) +summary(mod8a) + +#*** multidimensional 2PL Model +I <- 10 +Q <- array(0, dim=c(I, 3)) +Q[cbind(1:I, c(rep(1, 3), rep(2, 3), rep(3, 4)))] <- 1 +rownames(Q) <- colnames(resp) +mod3dim2pl <- TAM::tam.mml.2pl(resp=resp, Q=Q, irtmodel="2PL", + control=list(snodes=2000)) + +#*** Combine both approaches +thisRows <- gsub("-.*", "", colnames(mod8a$resp)) #select item names + +#*** uniform DIF (note irtmodel="2PL.groups" & est.slopegroups) +mod3dim2pl_udiff <- TAM::tam.mml.2pl(resp=mod8a$resp, A=mod8a$A, Q=Q[thisRows, ], + irtmodel="2PL.groups", + est.slopegroups=as.numeric(as.factor(thisRows)), + control=list(snodes=2000)) + +#*** non-uniform DIF (?); different slope parameters for each item administered to each group +mod3dim2pl_nudiff <- TAM::tam.mml.2pl(resp=mod8a$resp, A=mod8a$A, Q=Q[thisRows, ], + irtmodel="2PL", control=list(snodes=2000)) + +#*** check results +print(mod8a$xsi) +print(mod3dim2pl_udiff$xsi) +summary(mod3dim2pl_nudiff) + +#*** within item dimensionality (one item loads on two dimensions) +Q2 <- Q +Q2[4,1] <- 1 + +# uniform DIF (note irtmodel="2PL.groups" & est.slopegroups) +mod3dim2pl_udiff2 <- TAM::tam.mml.2pl(resp=mod8a$resp, A=mod8a$A, Q=Q2[thisRows, ], + irtmodel="2PL.groups", + est.slopegroups=as.numeric(as.factor(thisRows)), + control=list(snodes=2000)) +print(mod8a$xsi) +print(mod3dim2pl_udiff2$xsi) +print(mod3dim2pl_udiff2$xsi) } } % Add one or more standard keywords, see file 'KEYWORDS' in the diff --git a/src/RcppExports.cpp b/src/RcppExports.cpp index 25b50fd..8c1c9f5 100644 --- a/src/RcppExports.cpp +++ b/src/RcppExports.cpp @@ -1,5 +1,5 @@ //// File Name: RcppExports.cpp -//// 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/src/init.c b/src/init.c index e7103f7..3043cb7 100644 --- a/src/init.c +++ b/src/init.c @@ -1,5 +1,5 @@ //// File Name: init.c -//// File Version: 3.000012 +//// File Version: 3.000018 #include #include #include // for NULL diff --git a/src/tam_rcpp_mml_3pl.cpp b/src/tam_rcpp_mml_3pl.cpp index 2d49bfb..0c6a4c8 100644 --- a/src/tam_rcpp_mml_3pl.cpp +++ b/src/tam_rcpp_mml_3pl.cpp @@ -1,5 +1,5 @@ //// File Name: tam_rcpp_mml_3pl.cpp -//// File Version: 3.38 +//// File Version: 3.39 #include @@ -142,7 +142,7 @@ Rcpp::List tam_rcpp_mml_3pl_slca_deriv( Rcpp::NumericMatrix XdesM, } // end if guess[ii] = 0 if ( guess[ii] >= eps10 ){ if (hh==1){ - d2b[ll] += std::pow(XdesM(rr,4),2.0) * probs0[ ii + I*hh + I*maxK*tt ] * + d2b[ll] += std::pow(XdesM(rr,4), 2.0) * probs0[ ii + I*hh + I*maxK*tt ] * probs0[ ii + I*0 + I*maxK*tt ] * ( guess[ii] * nik[ii+I*hh+I*maxK*tt] / std::pow( probs[ ii + I*hh + I*maxK*tt ], 2.0) - Nik[ii + I*tt ] ); } diff --git a/src/tam_rcpp_prior_normal_density.cpp b/src/tam_rcpp_prior_normal_density.cpp index 5a8817f..bbaff07 100644 --- a/src/tam_rcpp_prior_normal_density.cpp +++ b/src/tam_rcpp_prior_normal_density.cpp @@ -1,5 +1,5 @@ //// File Name: tam_rcpp_prior_normal_density.cpp -//// File Version: 3.14 +//// File Version: 3.15 #include @@ -33,7 +33,7 @@ Rcpp::NumericMatrix tam_rcpp_prior_normal_density_unequal_means( gwt(nn,qq) += 2*x1[dd1]*x1[dd2] * varInverse(dd1,dd2); } // end dd2 } // end dd1 - gwt(nn,qq) = coeff * exp( -0.5*gwt(nn,qq) ); + gwt(nn,qq) = coeff * std::exp( -0.5*gwt(nn,qq) ); } // end qq } // end nn @@ -69,7 +69,7 @@ Rcpp::NumericVector tam_rcpp_prior_normal_density_equal_means( gwt[qq] += 2*x1[dd1]*x1[dd2] * varInverse(dd1,dd2); } // end dd2 } // end dd1 - gwt[qq] = coeff * exp( -0.5*gwt[qq] ); + gwt[qq] = coeff * std::exp( -0.5*gwt[qq] ); } // end qq //// OUTPUT diff --git a/src/tam_rcpp_pv_mcmc.cpp b/src/tam_rcpp_pv_mcmc.cpp index 6ffdfc1..78bcf76 100644 --- a/src/tam_rcpp_pv_mcmc.cpp +++ b/src/tam_rcpp_pv_mcmc.cpp @@ -1,5 +1,5 @@ //// File Name: tam_rcpp_pv_mcmc.cpp -//// File Version: 0.34 +//// File Version: 0.35 @@ -62,7 +62,7 @@ Rcpp::List tam_rcpp_pv_mcmc_calc_probs_irf_3pl( Btheta[ ind_temp ] = Btheta[ ind_temp ] + B_temp * theta(nn,dd); } // end if B_temp } // end dd - Btheta[ ind_temp ] = exp( Btheta[ ind_temp ] ); + Btheta[ ind_temp ] = std::exp( Btheta[ ind_temp ] ); } // end kk } // end resp(nn,ii) == 1 } // end ii diff --git a/src/tam_rcpp_wle.cpp b/src/tam_rcpp_wle.cpp index 948a84f..4ea3a71 100644 --- a/src/tam_rcpp_wle.cpp +++ b/src/tam_rcpp_wle.cpp @@ -1,5 +1,5 @@ //// File Name: tam_rcpp_wle.cpp -//// File Version: 3.452 +//// File Version: 3.453 // [[Rcpp::depends(RcppArmadillo)]] @@ -15,12 +15,10 @@ Rcpp::List tam_rcpp_wle_suffstat( Rcpp::NumericMatrix RPROBS, Rcpp::NumericMatri Rcpp::NumericMatrix CBB, Rcpp::NumericMatrix CBBB, int cndim, int cnitems, int cmaxK, int cnstud, Rcpp::IntegerMatrix resp_ind ) { - /////////////////////////////////////////////////////////// - // INPUT indices + //--- INPUT indices int citstud = cnitems*cnstud; - //////////////////////////////////////////////////////////// - // define output vectors + //--- define output vectors Rcpp::NumericMatrix B_bari (citstud, cndim); Rcpp::NumericMatrix BB_bari (citstud, cndim*cndim); Rcpp::NumericMatrix BBB_bari (citstud, cndim); @@ -28,9 +26,7 @@ Rcpp::List tam_rcpp_wle_suffstat( Rcpp::NumericMatrix RPROBS, Rcpp::NumericMatri Rcpp::NumericMatrix B2_B (citstud, cndim); Rcpp::NumericMatrix B_Cube (citstud, cndim); - ///////////////////////////////////////////////////////// - // CALCULATIONS - + //--- CALCULATIONS for(int ii=0; ii