missed late-night calls...

R/02b-item_methods.R

@@ -1730,7 +1730,7 @@ setMethod(
     f = "set_null_model",
     signature = signature(x = 'spline'),
     definition = function(x){
-        stop('spline null should not be run')
+        stop('spline null should not be run', call.=FALSE)
     }
 )
 
@@ -2342,7 +2342,7 @@ setMethod("initialize",
           'grsmIRT',
           function(.Object, nfact, ncat){
             if(nfact != 1L)
-                stop('grsmIRT only possible for unidimensional models')
+                stop('grsmIRT only possible for unidimensional models', call.=FALSE)
             stopifnot(ncat >= 2L)
             .Object@par <- c(rep(1, nfact),  seq(1, -1, length.out=ncat-1), 0)
             #.Object@par <- c(rep(1, nfact),  seq(-3, 3, length.out=ncat-1), 0)

R/03-estimation.R

@@ -307,7 +307,8 @@ ESTIMATION <- function(data, model, group, itemtype = NULL, guess = 0, upper = 1
         }
         if(!is.null(latent.regression)){
             if(length(PrepListFull$prodlist))
-                stop('Polynomial combinations currently not supported when latent regression effects are used', call.=FALSE)
+                stop('Polynomial combinations currently not supported when latent regression effects are used',
+                     call.=FALSE)
             lrPars <- make.lrdesign(df=latent.regression$df, formula=latent.regression$formula,
                                     factorNames=PrepListFull$factorNames, EM=latent.regression$EM,
                                     TOL=opts$TOL)
@@ -576,7 +577,7 @@ ESTIMATION <- function(data, model, group, itemtype = NULL, guess = 0, upper = 1
     if(pars[[1]][[length(pars[[1L]])]]@itemclass %in% c(-1L, -999L))
         SLOW.IND <- c(SLOW.IND, length(pars[[1L]]))
     if(opts$dentype != 'Gaussian' && opts$method %in% c('MHRM', 'MIXED', 'SEM'))
-        stop('Non-Gaussian densities not currently supported with MHRM algorithm')
+        stop('Non-Gaussian densities not currently supported with MHRM algorithm', call.=FALSE)
     #warnings
     wmsg <- 'Lower and upper bound parameters (g and u) should use \'norm\' (i.e., logit) prior'
     for(g in seq_len(length(pars))){
@@ -625,7 +626,8 @@ ESTIMATION <- function(data, model, group, itemtype = NULL, guess = 0, upper = 1
             Theta <- opts$technical$customTheta
             opts$quadpts <- nrow(Theta)
             if(pars[[1L]][[1L]]@nfact != ncol(Theta))
-                stop("mirt.model definition does not have same number of traits/attributes as customTheta input", call.=FALSE)
+                stop("mirt.model definition does not have same number of traits/attributes as customTheta input",
+                     call.=FALSE)
         } else {
             if(is.null(opts$quadpts)){
                 tmp <- if(opts$dentype == 'bfactor') PrepList[[1L]]$nfact - attr(model, 'nspec') + 1L
@@ -860,7 +862,7 @@ ESTIMATION <- function(data, model, group, itemtype = NULL, guess = 0, upper = 1
                     if(opts$warn)
                         warning('Very few EM cycles performed. Consider decreasing TOL further to
                             increase EM iteration count or starting farther away from ML estimates by
-                            passing the \'GenRandomPars = TRUE\' argument')
+                            passing the \'GenRandomPars = TRUE\' argument', call.=FALSE)
                 estmat <- matrix(FALSE, length(ESTIMATE$correction), length(ESTIMATE$correction))
                 DM <- estmat + 0
                 diag(estmat) <- TRUE
@@ -945,7 +947,7 @@ ESTIMATION <- function(data, model, group, itemtype = NULL, guess = 0, upper = 1
         } else if(opts$SE.type == 'Fisher' && !(opts$method %in% c('MHRM', 'SEM', 'MIXED'))){
             if(logPrior != 0 && opts$warn)
                 warning('Information matrix with the Fisher method does not
-                        account for prior parameter distribution information')
+                        account for prior parameter distribution information', call.=FALSE)
             ESTIMATE <- SE.Fisher(PrepList=PrepList, ESTIMATE=ESTIMATE, Theta=Theta, Data=Data,
                                   constrain=constrain, Ls=Ls, full=opts$full,
                                   CUSTOM.IND=CUSTOM.IND, SLOW.IND=SLOW.IND, warn=opts$warn,
@@ -1045,7 +1047,7 @@ ESTIMATION <- function(data, model, group, itemtype = NULL, guess = 0, upper = 1
                                                  group=if(length(pars) > 1L) group else NULL)))
         if(is(null.mod, 'try-error')){
             if(opts$warn)
-                warning('Null model calculation did not converge.')
+                warning('Null model calculation did not converge.', call.=FALSE)
             null.mod <- unclass(new('SingleGroupClass'))
         } else if(!is.nan(G2)) {
             TLI.G2 <- tli(X2=G2, X2.null=null.mod@Fit$G2, df=df, df.null=null.mod@Fit$df)

R/06-LoadPars.R

@@ -819,7 +819,7 @@ LoadGroupPars <- function(gmeans, gcov, estgmeans, estgcov, parnumber, parprior,
         }
     } else {
         nfact <- length(gmeans)
-        if (nfact > 1) stop("Multidimensional DC-IRT models are not supported.")
+        if (nfact > 1) stop("Multidimensional DC-IRT models are not supported.", call.=FALSE)
         # DC Density:
         den <- Theta_DC_den
         fn <- paste('COV_', 1L:nfact, sep='')

R/DIF.R

@@ -267,7 +267,7 @@ DIF <- function(MGmodel, which.par, scheme = 'add',
             }
             res <- try(wald(model, L), silent = TRUE)
             if(is(res, 'try-error')){
-                warning(sprintf('Wald test for \'%s\' failed.', itemnames[item]))
+                warning(sprintf('Wald test for \'%s\' failed.', itemnames[item]), call.=FALSE)
                 res <- data.frame(W=NA, df=NA, p=NA)
             }
             return(res)

R/DRF.R

@@ -469,9 +469,9 @@ DRF <- function(mod, draws = NULL, focal_items = 1L:extract.mirt(mod, 'nitems'),
             paste0('Theta.', 1L:ncol(Theta_nodes)) else 'Theta'
     }
     if(extract.mirt(mod, 'nfact') != 1L && plot)
-        stop('plot arguments only supported for unidimensional models')
+        stop('plot arguments only supported for unidimensional models', call.=FALSE)
     if(length(type) > 1L && (plot || !is.null(Theta_nodes)))
-        stop('Multiple type arguments cannot be combined with plot or Theta_nodes arguments')
+        stop('Multiple type arguments cannot be combined with plot or Theta_nodes arguments', call.=FALSE)
     m2v <- mod2values(mod)
     is_logit <- m2v$name %in% c('g', 'u')
     longpars <- do.call(c, lapply(1L:length(groupNames), function(ind)
@@ -489,7 +489,7 @@ DRF <- function(mod, draws = NULL, focal_items = 1L:extract.mirt(mod, 'nitems'),
         if(length(mod@vcov) == 1L)
             stop('Stop an information matrix must be computed', call.=FALSE)
         if(!mod@OptimInfo$secondordertest)
-            stop('ACOV matrix is not positive definite')
+            stop('ACOV matrix is not positive definite', call.=FALSE)
         impute <- TRUE
         covB <- mod@vcov
         names <- colnames(covB)
@@ -787,7 +787,7 @@ draw_parameters <- function(mod, draws, method = c('parametric', 'boostrap'),
 
     if(method == 'parametric'){
         if(!mod@OptimInfo$secondordertest)
-            stop('ACOV matrix is not positive definite')
+            stop('ACOV matrix is not positive definite', call.=FALSE)
         on.exit(reloadPars(longpars=longpars, pars=pars,
                            ngroups=ngroups, J=extract.mirt(mod, 'nitems')), add=TRUE)
         covB <- vcov(mod)
@@ -803,7 +803,7 @@ draw_parameters <- function(mod, draws, method = c('parametric', 'boostrap'),
         if(any(logits))
             ret[,logits] <- antilogit(ret[,logits])
         return(ret)
-    } else stop('bootstrap not supported yet') #TODO
+    } else stop('bootstrap not supported yet', call.=FALSE) #TODO
 
 }
 

R/DTF.R

@@ -162,7 +162,7 @@ DTF <- function(mod, draws = NULL, CI = .95, npts = 1000, theta_lim=c(-6,6), The
     integration <- 'quad'
     type <- 'score'
     if(!(plot %in% c('none', 'func', 'sDTF')))
-        stop('plot type not supported')
+        stop('plot type not supported', call.=FALSE)
     if(!is.null(Theta_nodes)){
         integration <- 'quad'
         if(plot != 'none') message('plots are not drawn when Theta_nodes is included')
@@ -188,7 +188,7 @@ DTF <- function(mod, draws = NULL, CI = .95, npts = 1000, theta_lim=c(-6,6), The
             stop('Must specify number of draws to generate plot confidence intervals', call.=FALSE)
     }
     if(length(type) > 1L && (plot != 'none' || !is.null(Theta_nodes)))
-        stop('Multiple type arguments cannot be combined with plot or Theta_nodes arguments')
+        stop('Multiple type arguments cannot be combined with plot or Theta_nodes arguments', call.=FALSE)
 
     if(is.null(draws)){
         draws <- 1L
@@ -197,7 +197,7 @@ DTF <- function(mod, draws = NULL, CI = .95, npts = 1000, theta_lim=c(-6,6), The
         if(length(mod@vcov) == 1L)
             stop('Stop an information matrix must be computed', call.=FALSE)
         if(!mod@OptimInfo$secondordertest)
-            stop('ACOV matrix is not positive definite')
+            stop('ACOV matrix is not positive definite', call.=FALSE)
         impute <- TRUE
         shortpars <- mod@Internals$shortpars
         covB <- mod@vcov

R/EMstep.group.R

@@ -411,7 +411,7 @@ EM.group <- function(pars, constrain, Ls, Data, PrepList, list, Theta, DERIV, so
         }
         if(cycles == NCYCLES){
             if(list$warn)
-                warning('EM cycles terminated after ', cycles, ' iterations.')
+                warning('EM cycles terminated after ', cycles, ' iterations.', call.=FALSE)
             converge <- FALSE
         } else if(cycles == 1L && !all(!est)){
             if(list$warn && !(is.nan(TOL) || is.na(TOL)) && !list$NULL.MODEL)

R/M2.R

@@ -93,7 +93,7 @@ M2 <- function(obj, type="M2*", calcNull = TRUE, na.rm=FALSE, quadpts = NULL, th
 
     impute <- 0
     if(is(obj, 'MixtureModel'))
-        stop('Mixture IRT models not yet supported')
+        stop('Mixture IRT models not yet supported', call.=FALSE)
     fn <- function(Theta, obj, ...){
         dat <- imputeMissing(obj, Theta, warn=FALSE)
         tmpobj <- obj
@@ -137,7 +137,7 @@ M2 <- function(obj, type="M2*", calcNull = TRUE, na.rm=FALSE, quadpts = NULL, th
         }
         bfactorlist <- obj@Internals$bfactor
         if(.hasSlot(obj@Model$lrPars, 'beta'))
-            stop('Latent regression models not yet supported')
+            stop('Latent regression models not yet supported', call.=FALSE)
         # if(!discrete && obj@ParObjects$pars[[extract.mirt(obj, 'nitems')+1L]]@dentype == 'custom')
         #     stop('M2() does not currently support custom group densities', call.=FALSE)
         if(!discrete && !use_dentype_estimate){
@@ -355,7 +355,7 @@ M2 <- function(obj, type="M2*", calcNull = TRUE, na.rm=FALSE, quadpts = NULL, th
         if(impute == 0)
             stop('Fit statistics cannot be computed when there are missing data.
                  Remove cases row-wise by passing na.rm=TRUE', call.=FALSE)
-        if(residmat) stop('residmat not supported when imputing data')
+        if(residmat) stop('residmat not supported when imputing data', call.=FALSE)
         Theta <- fscores(obj, plausible.draws = impute, QMC=QMC, leave_missing=TRUE, ...)
         collect <- myLapply(Theta, fn, obj=obj, calcNull=calcNull,
                             quadpts=quadpts, QMC=QMC, theta_lim=theta_lim)

R/MDIFF.R

@@ -48,7 +48,8 @@ MDIFF <- function(x, which.items = NULL, group=NULL){
     for(i in seq_len(length(which.items))){
         item <- extract.item(x, which.items[i])
         if(!(class(item) %in% c('dich', 'graded')))
-            stop(sprintf('Item %i is not of class \"graded\" or \"dich\"', which.items[i]))
+            stop(sprintf('Item %i is not of class \"graded\" or \"dich\"', which.items[i]),
+                 call.=FALSE)
         ds <- ExtractZetas(item)
         out[[i]] <- -ds / MD[which.items[i]]
     }

R/MHRM.group.R

@@ -316,7 +316,7 @@ MHRM.group <- function(pars, constrain, Ls, Data, PrepList, list, random = list(
     #Reload final pars list
     if(cycles == NCYCLES + BURNIN + SEMCYCLES && !list$SE && !no_stage_3){
         if(list$warn)
-            warning('MHRM terminated after ', NCYCLES, ' iterations.')
+            warning('MHRM terminated after ', NCYCLES, ' iterations.', call.=FALSE)
         converge <- FALSE
     }
     if(list$SE) longpars <- list$startlongpars

R/Mixture-methods.R

@@ -98,7 +98,7 @@ plot_mixture <- function(x, y, type = 'score', npts = 200, degrees = 45,
     pis <- extract.mirt(x, 'pis')
     if(!(type %in% c('info', 'SE', 'infoSE', 'trace', 'score', 'itemscore',
                      'infocontour', 'infotrace', 'scorecontour')))
-        stop('type supplied is not supported')
+        stop('type supplied is not supported', call.=FALSE)
     if (any(degrees > 90 | degrees < 0))
         stop('Improper angle specified. Must be between 0 and 90.', call.=FALSE)
     rot <- list(x = rot[[1]], y = rot[[2]], z = rot[[3]])

R/PLCI.mirt.R

@@ -246,13 +246,13 @@ PLCI.mirt <- function(mod, parnum = NULL, alpha = .05,
 
     stopifnot(extract.mirt(mod, 'converged'))
     if(.hasSlot(mod@Model$lrPars, 'beta'))
-        stop('Latent regression models not yet supported')
+        stop('Latent regression models not yet supported', call.=FALSE)
     stopifnot(lower | upper)
     dat <- mod@Data$data
     model <- mod@Model$model
     parprior <- mod@Model$parprior
     if(length(parprior))
-        stop('Confidence intervals cannot be computed for models that include priors')
+        stop('Confidence intervals cannot be computed for models that include priors', call.=FALSE)
     if(length(parprior) == 0L) parprior <- NULL
     sv <- mod2values(mod)
     itemtype <- extract.mirt(mod, 'itemtype')

R/RCI.R

@@ -137,7 +137,7 @@ RCI <- function(mod_pre, predat, postdat,
         TS_pre <- rowSums(predat)
         TS_post <- rowSums(postdat)
         if(is.null(SEM.pre))
-            stop('Must include SEM.pre')
+            stop('Must include SEM.pre', call.=FALSE)
         SEM.pre <- unname(SEM.pre)
         stopifnot(is.numeric(SEM.pre) && length(SEM.pre) == 1L)
         if(is.null(SEM.post)) SEM.post <- SEM.pre

R/SIBTEST.R

@@ -593,7 +593,7 @@ SIBTEST <- function(dat, group, suspect_set, match_set, focal_name = unique(grou
         # Multi-group
 
         if(plot != 'none')
-            stop('Multi-group plots not currently supported')
+            stop('Multi-group plots not currently supported', call.=FALSE)
 
         groupnms <- unique(group)
         if(ncol(C) != ngroups)

R/SingleGroup-methods.R

@@ -737,7 +737,7 @@ setMethod(
     {
         dots <- list(...)
         if(.hasSlot(object@Model$lrPars, 'beta'))
-            stop('Latent regression models not yet supported')
+            stop('Latent regression models not yet supported', call.=FALSE)
         discrete <- use_dentype_estimate <- FALSE
         if(!is.null(dots$use_dentype_estimate))
             use_dentype_estimate <- dots$use_dentype_estimate
@@ -1136,7 +1136,7 @@ setMethod(
         if(!(type %in% c('info', 'SE', 'infoSE', 'rxx', 'trace', 'score', 'itemscore',
                        'infocontour', 'infotrace', 'scorecontour', 'empiricalhist', 'Davidian',
                        'EAPsum', 'posteriorTheta')))
-            stop('type supplied is not supported')
+            stop('type supplied is not supported', call.=FALSE)
         if (any(degrees > 90 | degrees < 0))
             stop('Improper angle specified. Must be between 0 and 90.', call.=FALSE)
         rot <- list(x = rot[[1]], y = rot[[2]], z = rot[[3]])

R/boot.mirt.R

@@ -116,7 +116,7 @@ boot.mirt <- function(x, R = 100, boot.fun = NULL, technical = NULL, ...){
     if(missing(x)) missingMsg('x')
     if(x@Options$exploratory)
         warning('Note: bootstrapped standard errors for slope parameters in exploratory
-                       models are not meaningful.')
+                       models are not meaningful.', call.=FALSE)
     dat <- x@Data$data
     itemtype <- x@Model$itemtype
     class <- class(x)

R/empirical_ES.R

@@ -157,7 +157,7 @@ empirical_ES <- function(mod, Theta.focal = NULL,
     } else Theta.focal <- as.matrix(Theta.focal)
     stopifnot("Theta must be a matrix" = is.matrix(Theta.focal))
     if(sum(focal_select) != nrow(Theta.focal))
-        stop('Theta elements do not match the number of individuals in the focal group')
+        stop('Theta elements do not match the number of individuals in the focal group', call.=FALSE)
 
     ############# helper function -  Cohen D ###########
     f.cohen.d <- function (vector.1,vector.2){

R/estfun.R

@@ -106,7 +106,7 @@ estfun.AllModelClass <- function(x, weights = extract.mirt(x, "survey.weights"),
 
   ## check latent regression
   if(length(x@Model$lrPars)) {
-    stop("Scores computations currently not supported for latent regression estimates.")
+    stop("Scores computations currently not supported for latent regression estimates.", call.=FALSE)
   }
   ## check items
   CUSTOM.IND <- x@Internals$CUSTOM.IND
@@ -117,7 +117,7 @@ estfun.AllModelClass <- function(x, weights = extract.mirt(x, "survey.weights"),
   }
   whichitems <- unique(c(CUSTOM.IND, SLOW.IND))
   if(length(whichitems)) {
-    stop("Scores computations currently not supported for at least one of the supplied items.")
+    stop("Scores computations currently not supported for at least one of the supplied items.", call.=FALSE)
   }
   ## get relevant model info
   constrain <- x@Model$constrain

R/fscores.internal.R

@@ -69,7 +69,7 @@ setMethod(
                     mu=fs, sig=fs_acov))
                 if(any(sapply(jit, is.nan)))
                     stop('Could not draw unique plausible values. Response pattern ACOVs may
-                         not be positive definite')
+                         not be positive definite', call.=FALSE)
                 ret <- vector('list', plausible.draws)
                 completely_missing <- extract.mirt(object, 'completely_missing')
                 for(i in seq_len(plausible.draws)){

R/gen.difficulty.R

@@ -80,7 +80,7 @@ gen.difficulty <- function(mod, type = "IRF", interval = c(-30, 30), ...){
                            out
                         })
         ret <- sapply(items, LIIRF_1, ...)
-    } else stop('type not supported')
+    } else stop('type not supported', call.=FALSE)
     names(ret) <- extract.mirt(mod, 'itemnames')
     ret
 }

R/itemfit.R

@@ -519,7 +519,7 @@ itemfit <- function(x, fit_stats = 'S_X2',
                 call.=FALSE)
     mixture <- is(x, 'MixtureClass')
     if(mixture && !all(fit_stats == 'S_X2'))
-        stop("Only S_X2 fit statistic supported for mixture models")
+        stop("Only S_X2 fit statistic supported for mixture models", call.=FALSE)
     pis <- NULL
     if(mixture){
         discrete <- TRUE

R/lagrange.R

@@ -86,7 +86,7 @@ lagrange <- function(mod, parnum, SE.type = 'Oakes', type = 'Richardson', ...){
     if(missing(mod)) missingMsg('mod')
     if(missing(parnum)) missingMsg('parnum')
     if(SE.type %in% c('SEM', 'MHRM', 'FMHRM'))
-        stop('SE.type not supported for Lagrange tests')
+        stop('SE.type not supported for Lagrange tests', call.=FALSE)
     ObJeCtIvE <- extract.mirt(mod, 'logLik')
     group <- extract.mirt(mod, 'group')
     parnum <- as.list(parnum)

R/mixedmirt.R

@@ -374,11 +374,11 @@ mixedmirt <- function(data, covdata = NULL, model = 1, fixed = ~ 1, random = NUL
     if(any(itemtype %in% c('spline', 'ideal'))){
         if(fixed != ~ -1){
             warning(paste0('Unsupported itemtype detected for modeling intercepts.\n',
-                    'fixed = ~ -1 used by default to remove intercept'))
+                    'fixed = ~ -1 used by default to remove intercept'), call.=FALSE)
             fixed <- ~ -1
         }
         if(!is.null(random)){
-            warning('random set to NULL due to unsupported itemtypes')
+            warning('random set to NULL due to unsupported itemtypes', call.=FALSE)
             random <- NULL
         }
     }
@@ -407,7 +407,7 @@ mixedmirt <- function(data, covdata = NULL, model = 1, fixed = ~ 1, random = NUL
     if(length(dropcases) > 0L){
         if(is.null(technical$warn) || technical$warn)
             warning("Missing values in covdata not permitted. Removing all observations row-wise
-                     when rowSums(is.na(covdata)) > 0")
+                     when rowSums(is.na(covdata)) > 0", call.=FALSE)
         data <- data[-dropcases, ]
         covdata <- covdata[-dropcases, ,drop=FALSE]
     }