Nothing
# Main function to run tree based DIF global testing for GPCM models
gpcmtree <- function(formula, data,
weights = NULL, grouppars = FALSE, vcov = TRUE, nullcats = "downcode",
start = NULL, method = "BFGS", maxit = 500L, reltol = 1e-10, minsize = 500L, ...){
## keep call
cl <- match.call(expand.dots = TRUE)
## use dots for setting up mob_control
control <- partykit::mob_control(minsize = minsize, ...)
control$xtype <- "data.frame"
control$ytype <- "matrix"
plcontrol <- list()
## call mob
m <- match.call(expand.dots = FALSE)
## tentative code to match itemtype with glue codes
main_call <- environment()
m$fit <- generate_irtfit(start = main_call$start, weights = main_call$weights, itemtype = "GPCM",
grouppars = main_call$grouppars, vcov = main_call$vcov, method = main_call$method,
maxit = main_call$maxit, reltol = main_call$reltol)
m$control <- control
for(n in names(plcontrol)) {
if(!is.null(plcontrol[[n]])) m[[n]] <- plcontrol[[n]]
}
if("..." %in% names(m)) m[["..."]] <- NULL
m[[1L]] <- as.call(quote(partykit::mob))
rval <- eval(m, parent.frame())
## extend class and keep original call
rval$info$call <- cl
class(rval) <- c("gpcmtree", class(rval))
return(rval)
}
## methods
print.gpcmtree <- function(x,
title = "PL Tree",
objfun = "negative log-likelihood", ...) {
partykit::print.modelparty(x, title = title, objfun = objfun, ...)
}
plot.gpcmtree <- function(x, type = c("regions", "profile"), terminal_panel = NULL,
tp_args = list(...), tnex = 2L, drop_terminal = TRUE, ...)
{
if(!is.null(terminal_panel)) {
if(!missing(type)) warning("only one of 'type' and 'terminal_panel' should be specified")
} else {
terminal_panel <- switch(match.arg(type),
"regions" = node_regionplot,
"profile" = node_profileplot)
}
partykit::plot.modelparty(x, terminal_panel = terminal_panel,
tp_args = tp_args, tnex = tnex, drop_terminal = drop_terminal, ...)
}
itempar.gpcmtree <- function(object, node = NULL, ...) {
if (is.null(node))
node <- partykit::nodeids(object, terminal = TRUE)
cf <- apply_to_models(object, node = node, FUN = function(n) psychotools::itempar(n, ...))
cf
}
threshpar.gpcmtree <- function(object, node = NULL, ...) {
if (is.null(node))
node <- partykit::nodeids(object, terminal = TRUE)
cf <- apply_to_models(object, node = node, FUN = function(n) psychotools::threshpar(n, ...))
cf
}
guesspar.gpcmtree <- function(object, node = NULL, ...) {
if (is.null(node))
node <- partykit::nodeids(object, terminal = TRUE)
cf <- apply_to_models(object, node = node, FUN = function(n) psychotools::guesspar(n, ...))
cf
}
upperpar.gpcmtree <- function(object, node = NULL, ...) {
if (is.null(node))
node <- partykit::nodeids(object, terminal = TRUE)
cf <- apply_to_models(object, node = node, FUN = function(n) psychotools::upperpar(n, ...))
cf
}
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.