Nothing
#' Methods for the scDIFtest-class
#'
#' \code{print}, \code{summary}, and \code{plot} methods for objects of the
#' \code{scDIFtest-class}, as returned by \code{\link{scDIFtest}}. See details
#' for more information about the methods.
#'
#' The \code{print} method, when\code{item_selection = NULL}, gives a summary
#' of all the tests that were executed (i.e., for all items). When specific
#' items are selected, the \code{print} method is called repeatedly for each
#' individual \code{sctest} corresponding with the selected items.
#'
#' The \code{summary} method computes a data frame with a row for each item
#' that was included in the test. The columns are:
#' \describe{
#' \item{item_type}{The estimated IRT model per item}
#' \item{n_est_pars}{The number of estimated parameters per item}
#' \item{stat}{The value for the used statistic per item}
#' \item{p_value}{The p-value per item}
#' \item{p_fdr}{The corrected p-value controlling the false discovery rate
#' (Benjamini & Hochberg, 1995). See \code{\link[stats]{p.adjust}} for
#' details.}
#' }
#'
#' The \code{plot} method call the \code{plot} method repeatedly for the
#' \code{gepf} that corresponds with the executed score test for each of the
#' selected items. When no items are selected, the \code{plot} method results
#' in an error.
#'
#' @references Benjamini, Y., and Hochberg, Y. (1995). Controlling the false
#' discovery rate: a practical and powerful approach to multiple testing.
#' \emph{Journal of the Royal Statistical Society Series B, 57,} 289-300.
#'
#'
#' @param x an object of class \code{scDIFtest}
#' @param object an object of class \code{scDIFtest}
#' @param item_selection either \code{NULL} or an integer vector selecting the
#' item numbers. When \code{items = NULL} (the default), the DIF test
#' is done for all items.
#' @param method one of the strings in \code{p.adjust.methods}.
#' @param ... other arguments passed to the method.
#'
#' @importFrom graphics plot
#' @importFrom stats p.adjust
#'
#' @name scDIFtest-Methods
#'
NULL
#' @rdname scDIFtest-Methods
#' @name print.scDIFtest
#' @export
print.scDIFtest <- function(x, item_selection = NULL, ...){
tests <- x$tests
test_info <- x$info$test_info
if(is.null(item_selection)){
out <- summary(x, ...)
cat("\n")
cat(strwrap(paste0("Score Based DIF-tests for ", dim(out)[1], " items"),
prefix = "\t"), sep = "\n")
cat(strwrap(paste0("Person covariate: ", test_info$DIF_covariate_name),
prefix = "\t"), sep = "\n")
cat(strwrap(paste0("Test statistic type: ", test_info$stat_name),
prefix = "\t"), sep = "\n")
cat("\n")
print(out, ...)
} else {
item_names <- names(tests)
if(is.numeric(item_selection)) item_selection <- item_names[item_selection]
if(length(item_selection) == 1 && item_selection == "all") item_selection <- item_names
stopifnot(item_selection %in% item_names)
for(item in item_selection){
cat("\n")
cat(strwrap(paste0("DIF-test for ", item), prefix = "\t"), sep = "\n")
cat(strwrap(paste0("Person covariate: ", test_info$DIF_covariate_name), prefix = "\t"), sep = "\n")
cat(strwrap(paste0("Test statistic type: ", test_info$stat_name), prefix = "\t"), sep = "\n")
'if'(is.character(tests[[item]]),
{cat("\n")
cat(strwrap(tests[[item]]), sep = "\n")},
print(tests[[item]]$single_test, ...))
}
}
}
#' @rdname scDIFtest-Methods
#' @name summary.scDIFtest
#' @export
summary.scDIFtest <- function(object, method = "fdr", ...){
tests <- object$tests
item_info <- object$info$item_info
summary <- as.data.frame(do.call(rbind, lapply(tests, function(test){
'if'(is.list(test),
unlist(test$single_test[1:2]),
c("statistic.f(efp)" = NaN, p.value = NaN))
})))
summary <- cbind(item_type = item_info$item_type ,
n_est_pars = sapply(item_info$colNrs, length),
summary, p.adjust(summary[,2], method = method))
names(summary) <- c("item_type", "n_est_pars", "stat", "p_value",
paste0("p_", method))
summary
}
#' @rdname scDIFtest-Methods
#' @name plot.scDIFtest
#' @export
plot.scDIFtest <- function(x, item_selection = NULL, ...){
if(is.null(item_selection))
stop("Choose an item for which the empirical fluctuation process shoud ",
"be plotted using the 'item_selection' argument.")
tests <- x$tests
item_names <- names(tests)
if(is.numeric(item_selection)) item_selection <- item_names[item_selection]
if(length(item_selection) == 1 && item_selection == "all") item_selection <- item_names
stopifnot(item_selection %in% item_names)
gefp <- x$gefp
colNrs_list <- x$info$item_info$colNrs
for(item in item_selection){
test <- x$tests[[item]]
if(is.character(test)) {
warning(paste0("Plot not possible for item ",
item, ". ", test))
} else {
single_gefp <- gefp
single_gefp$process <- suppressWarnings(
gefp$process[, colNrs_list[[item]], drop = FALSE])
single_gefp$type.name = paste0(gefp$type.name, " for item ", item)
plot(single_gefp, functional = test$functional, ...)
}
}
}
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.