Nothing
print.summary.catIrt <-
function(x, digits = max(3, getOption("digits") - 3), ... ){
# Note: Prints "Group Level Summary" and "Individual Level Summary"
# only if both are select. Otherwise, it prints neither.
#~~~~~~~~~~~~~~~~~~~~~#
# Group Level Summary #
#~~~~~~~~~~~~~~~~~~~~~#
y <- x$cat_run
if( x$group == TRUE ){
if( !( is.null(x$ids) | any(x$ids == "none" ) ) ){
cat("\n *************************\n")
cat( " ** Group Level Summary **\n")
cat( " *************************\n")
} # END if STATEMENT
###############
# Model Stuff #
###############
# If the model is binary, we don't need to let them know about the categories:
if( y$mod$mod == "brm" )
cat( "\nModel:\n ",
"Binary response model (brm) with ", x$theta$d_stat["n"], " simulees and ", x$items$bank["n.items"],
" items in the bank.\n\n\n", sep = "" )
# If the model is polytomous, we should let them know about the categories:
else
cat( "\nModel:\n ",
"Graded response model (grm) with ", x$theta$d_stat["n"], " simulees, ", x$items$bank["n.items"],
" items in the bank, and ",x$items$bank["n.params"], " levels per item.\n\n\n", sep = "" )
###############
# Theta Stuff #
###############
cat("## Summary of Theta: ##\n\n")
if( any(rownames(x$theta$sum) == "true") ){
cat( "True Theta:\n", sep = "" )
cat( " Mean = ", m <- round( x$theta$sum["true", "mean"], digits ), " ", sep = "")
cat( "SD = ", round( x$theta$sum["true", "sd"], digits ), "\n", sep = "")
cat( " Min = ", n <- round( x$theta$sum["true", "min"], digits ),
rep(" ", nchar(m) - nchar(n) + 3), sep = "")
cat( "Max = ", round( x$theta$sum["true", "max"], digits ), "\n", sep = "")
} # END if STATEMENT
cat( "Full Bank Theta (using ", y$mod$catTerm$score, " Estimation):\n", sep = "")
cat( " Mean = ", m <- round( x$theta$sum["tot", "mean"], digits ), " ", sep = "")
cat( "SD = ", round( x$theta$sum["tot", "sd"], digits ), "\n", sep = "")
cat( " Min = ", n <- round( x$theta$sum["tot", "min"], digits ),
rep(" ", nchar(m) - nchar(n) + 3), sep = "")
cat( "Max = ", round( x$theta$sum["tot", "max"], digits ), "\n", sep = "")
cat( "CAT Theta (using ", y$mod$catMiddle$score, " Estimation):\n", sep = "")
cat( " Mean = ", m <- round( x$thet$sum["cat", "mean"], digits ), " ", sep = "")
cat( "SD = ", round( x$thet$sum["cat", "sd"], digits ), "\n", sep = "")
cat( " Min = ", n <- round( x$thet$sum["cat", "min"], digits ),
rep(" ", nchar(m) - nchar(n) + 3), sep = "")
cat( "Max = ", round( x$thet$sum["cat", "max"], digits ), "\n", sep = "")
if( any(rownames(x$theta$sum) == "true") ){
cat("CAT Theta vs. True Theta:\n")
cat( " Rsq = ", round(x$theta$e_stat["rsq"], digits), "\n", sep = "")
cat( " Avg Sign Err = ", m <- round(x$theta$e_stat["ase"], digits), " ", sep = "")
cat( "MSE = ", round(x$theta$e_stat["mse"], digits), "\n", sep = "")
cat( " Avg Abs Err = ", n <- round(x$theta$e_stat["aae"], digits),
rep(" ", nchar(m) - nchar(n) + 3), sep = "")
cat( "RMSE = ", round(x$theta$e_stat["rmse"], digits), "\n", sep = "")
} # END if STATEMENT
cat("CAT Theta vs. Full Bank Theta:\n")
cat( " Rsq = ", round(x$theta$d_stat["rsq"], digits), "\n", sep = "")
cat( " Avg Sign Diff = ", m <- round(x$theta$d_stat["asd"], digits), " ", sep = "")
cat( "MSD = ", round(x$theta$d_stat["msd"], digits), "\n", sep = "")
cat( " Avg Abs Diff = ", n <- round(x$theta$d_stat["aad"], digits),
rep(" ", nchar(m) - nchar(n) + 3), sep = "")
cat( "RMSD = ", round(x$theta$d_stat["rmsd"], digits), "\n\n\n", sep = "")
#############
# SEM Stuff #
#############
cat("## Summary of SEM: ##\n\n")
cat( "SEM of Full Bank Theta:\n" )
cat( " Mean = ", m <- round( x$sem$sum["tot", "mean"], digits ), " ", sep = "" )
cat( "SD = ", round( x$sem$sum["tot", "sd"], digits ), "\n", sep = "")
cat( " Min = ", n <- round( x$sem$sum["tot", "min"], digits ),
rep(" ", nchar(m) - nchar(n) + 3), sep = "")
cat( "Max = ", round( x$sem$sum["tot", "max"], digits ), "\n", sep = "" )
cat( "SEM of CAT Theta:\n", sep = "")
cat( " Mean = ", m <- round( x$sem$sum["cat", "mean"], digits ), " ", sep = "")
cat( "SD = ", round( x$sem$sum["cat", "sd"], digits ), "\n", sep = "" )
cat( " Min = ", n <- round( x$sem$sum["cat", "min"], digits ),
rep(" ", nchar(m) - nchar(n) + 3), sep = "")
cat( "Max = ", round( x$sem$sum["cat", "max"], digits ), "\n", sep = "" )
cat("CAT SEM vs. Full Bank SEM:\n")
cat( " Rsq = ", round( x$sem$d_stat["rsq"], digits ), "\n", sep = "" )
cat( " Avg Sign Diff = ", m <- round( x$sem$d_stat["asd"], digits ), " ", sep = "" )
cat( "MSD = ", round( x$sem$d_stat["msd"], digits ), "\n", sep = "" )
cat( " Avg Abs Diff = ", n <- round( x$sem$d_stat["aad"], digits ),
rep(" ", nchar(m) - nchar(n) + 3), sep = "")
cat( "RMSD = ", round( x$sem$d_stat["rmsd"], digits ), "\n\n\n", sep = "" )
###############
# Items Stuff #
###############
cat("Number of Items Administered in the CAT:\n")
cat( " Mean = ", round( x$items$sum["mean"], digits ), "\n", sep = "" )
cat( " SD = ", round( x$items$sum["sd"], digits ), "\n", sep = "" )
cat( " Min = ", round( x$items$sum["min"], digits ), "\n", sep = "" )
cat( " Max = ", round( x$items$sum["max"], digits ), "\n", sep = "" )
########################
# Classification Stuff #
########################
if( any( y$mod$catTerm$term == "class" ) ){
cat("\nNumber of Simulees in Each Category:")
print( x$freq$categ )
}
#####################
# Termination Stuff #
#####################
cat( "\nNumber of Simulees with Each Termination Criterion:" )
print( x$freq$term )
##########################
# Total Bank Information #
##########################
cat("\nMax 'Expected Bank Information' is ", round( unique(max(x$bank_info$info)), digits ),
" at a theta of ", round( x$bank_info$eval[ which.max(x$bank_info$info) ], digits ),
" with an associated SEM of ", round( x$bank_info$sem[ which.max(x$bank_info$info) ], digits ),
".\n\n", sep = "" )
} # END if STATEMENT
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~#
# Individual Level Summaries #
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~#
# If you want individual summaries - print individual summaries:
if( !( is.null(x$ids) | any(x$ids == "none" ) ) ){
if( x$group == TRUE ){
cat("\n")
cat(" ********************************\n")
cat(" ** Individual Level Summaries **\n")
cat(" ********************************\n")
} # END if STATEMENT
resp.all <- unlist( lapply(y$cat_indiv, FUN = function(z) z$cat_resp) )
resp.min <- min(resp.all)
resp.max <- max(resp.all)
# For all people do the following:
# - pull out the id number,
# - give a header of the total bank and CAT bank ability estimates,
# - let people know how the selection criterion, ability estimator, and termination criterion,
# - provide an indication as to the items, responses, and CAT theta updates.
for( i in seq_along(x$ids) ){
################
# Header Stuff #
################
## Summary of Simulee Statement ##
if( length(x$ids) == 1 ){
id.i <- x$ids[i]
cat("\n## Summary of Simulee: ##\n\n", sep = "")
} else{
id.i <- x$ids[i]
cat("\n## Summary of Simulee ", id.i, ": ##\n\n", sep = "")
} # END ifelse STATEMENT
## Printing of Theta and Theta Estimates ##
if( length(y$true_theta) >= 1 & all( !is.na(y$true_theta) ) )
cat("True Theta: ", round(y$true_theta[id.i], digits), "\n", sep = "")
cat( "Full Bank Theta: ", round(y$tot_theta[id.i], digits), "\n", sep = "")
cat( "Final CAT Theta: ", round(y$cat_theta[id.i], digits), "\n\n", sep = "")
##########################
# Generalizing CAT Stuff #
##########################
############
# catStart #
############
start.i <- y$mod$catStart
middle.i <- y$mod$catMiddle
resp.i <- y$cat_indiv[[id.i]]$cat_resp
a <- start.i$n.start
b <- which( { c(FALSE, diff(resp.i) != 0) |
( (resp.i != resp.min) & (resp.i != resp.max) ) } )[1]
# Note: b finds the first instance that:
# - the response changes OR
# - the response isn't equal to the min/max possible response.
# a) n.start in catStart
# b) the first change in the response (min -- not min or max -- not max)
# IF: i) MLE out and score == "MLE" --> then b regardless.
# ii) MLE out and score != "MLE" --> then minimum of a or b.
# iii) !MLE out and score == "MLE" --> then maximum of a or b.
# iv) !MLE out and score != "MLE" --> then a regardless.
s.it <- { if( (start.i$leave.after.MLE) & (middle.i$score == "MLE") ){
b
} else if( (start.i$leave.after.MLE) & (middle.i$score != "MLE") ){
min(a, b)
} else if( !(start.i$leave.after.MLE) & (middle.i$score == "MLE") ){
max(a, b)
} else{
a
} # END ifelse STATEMENTS
}
s.select <- switch( y$mod$catStart$select,
"UW-FI" = "by maximizing Fisher information at",
"LW-FI" = "by maximizing Likelihood-Weighted Fisher information",
"PW-FI" = "by maximizing Posterior-Weighted Fisher information",
"FP-KL" = "by maximizing Fixed Pointwise Kullback-Leibler divergence at",
"VP-KL" = "by maximizing Variable Pointwise Kullback-Leibler divergence at",
"FI-KL" = "by maximizing Fixed Integrated Kullback-Leibler divergence at",
"VI-KL" = "by maximizing Variable Integrated Kullback-Leibler divergence at",
"random" = "randomly" )
if( y$mod$catStart$select != "random" ){
s.at <- switch( y$mod$catStart$at,
theta = " theta",
bounds = " (a) fixed point(s)" )
} else{
s.at <- NULL
} # END ifelse STATEMENT
s.score <- switch( y$mod$catStart$score,
fixed = paste("a fixed value of ", y$mod$catStart$init.theta, sep = ""),
step = paste("increasing or decreasing theta by ", y$mod$catStart$step.size, sep = ""),
random = "randomly",
WLE = "Weighted Likelihood (WL) estimation",
BME = "Bayesian Modal (BM) estimation",
EAP = "Expected A Posteriori (EAP) estimation" )
#############
# catMiddle #
#############
m.select <- switch( y$mod$catMiddle$select,
"UW-FI" = "by maximizing Fisher information at",
"LW-FI" = "by maximizing Likelihood-Weighted Fisher information",
"PW-FI" = "by maximizing Posterior-Weighted Fisher information",
"FP-KL" = "by maximizing Fixed Pointwise Kullback-Leibler divergence at",
"VP-KL" = "by maximizing Variable Pointwise Kullback-Leibler divergence at",
"FI-KL" = "by maximizing Fixed Integrated Kullback-Leibler divergence at",
"VI-KL" = "by maximizing Variable Integrated Kullback-Leibler divergence at",
"random" = "randomly" )
if( y$mod$catMiddle$select != "random" ){
m.at <- switch( y$mod$catMiddle$at,
theta = " theta",
bounds = " (a) fixed point(s)" )
} else{
m.at <- NULL
} # END ifelse STATEMENT
m.score <- switch( y$mod$catMiddle$score,
MLE = "Maximum Likelihood (ML) estimation",
WLE = "Weighted Likelihood (WL) estimation",
BME = "Bayesian Modal (BM) estimation",
EAP = "Expected A Posteriori (EAP) estimation" )
###########
# catTerm #
###########
# For EAP, we terminate slightly differently:
if( y$mod$catMiddle$score == "EAP" ){
sem <- "posterior standard deviation"
} else{
sem <- "standard error of measurement"
} # END ifelse STATEMENT
term <- switch( y$cat_term[id.i],
total = "all of the items in the bank.",
fixed = paste("a fixed number of ", y$mod$catTerm$n.max, " items.", sep = ""),
se_thresh = paste("the ", sem, " was below ", y$mod$catTerm$p.term$crit, ".", sep = ""),
se_change = paste("the ", sem, " changed less than ", y$mod$catTerm$p.term$crit, " between two successive items.", sep = ""),
fi_thresh = paste("Fisher Information was above ", y$mod$catTerm$i.term$crit, ".", sep = ""),
fi_change = paste("Fisher Information changed less than ", y$mod$catTerm$i.term$crit, " between two successive items.", sep = ""),
class = paste("a classification decision of '", y$cat_categ[id.i], "' was made.", sep = "") )
######################
# Printing CAT Stuff #
######################
cat("At the beginning of the CAT (first ", s.it, " items):", sep = "")
cat("\n Items were selected ", s.select, s.at, ".", sep = "")
cat("\n Ability was estimated after each step by ", s.score, ".\n\n", sep = "")
cat("For the rest of the CAT:")
cat("\n Items were selected ", m.select, m.at, ".", sep = "")
cat("\n Ability was estimated after each step by ", m.score, ".\n\n", sep = "")
cat("The CAT was terminated after ", term, "\n", sep = "")
########################
# Specific Items Stuff #
########################
indiv.i <- y$cat_indiv[[id.i]]
mat1 <- c(NA, 1:nrow(indiv.i$cat_params)) # the CAT items
mat2 <- rbind( c(NA, indiv.i$cat_params[ , 1]), # the bank items
c(NA, indiv.i$cat_resp) ) # the responses
mat3 <- rbind( round(indiv.i$cat_theta, 2), # the ability estimates
as.character(round(indiv.i$cat_sem, digits)) # the SEM
)
# I made sure that we "as.charactered" it to prevent the item numbers/responses from having lots of 0s
mat <- rbind(mat1, mat2, mat3)
rownames(mat) <- c("CAT Number", "Bank Number", "Response", "Estimate", "SEM")
colnames(mat) <- rep("", ncol(mat))
print(format(mat, justify = "right"), quote = FALSE)
cat("\n\n")
} # END for LOOP
} # END if STATEMENT
} # END print.summary.catIrt FUNCTION
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.