jamovi

Code: Select all

        - name: dep
          title: "Response Groups"
          type: text
          visible: (modelSelection:multinomial)
          combineBelow: true

Code: Select all

table$addFormat(rowKey=rowKey, col=1, Cell.BEGIN_GROUP)

Code: Select all

Debug
Error in X[ii, ii, drop = FALSE]: (subscript) logical subscript too long

private$.run()
suppressWarnings({
    dep <- self$options$dep
    factors <- self$options$factors
    covs <- self$options$covs
    modelType <- self$options$modelSelection
    modelTerms <- private$.modelTerms()
    if (is.null(dep) || length(modelTerms) == 0) 
        return()
    base::options(contrasts = c("contr.sum", "contr.poly"))
    data <- private$.cleanData()
    data <- mf.checkData(dep, data, modelType)
    if (!is.data.frame(data)) 
        reject(data)
    for (factorName in factors) {
        lvls <- base::levels(data[[factorName]])
        if (length(lvls) == 1) 
            reject("Factor '{}' contains only a single level", factorName = factorName)
        else if (length(lvls) == 0) 
            reject("Factor '{}' contains no data", factorName = factorName)
    }
    anovaTable <- self$results$main
    estimatesTable <- self$results$estimates
    infoTable <- self$results$info
    formula <- jmvcore::constructFormula(dep, modelTerms)
    formula <- stats::as.formula(formula)
    model <- try(private$.estimate(formula, data))
    if (isError(model)) {
        message <- extractErrorMessage(model)
        reject(message)
    }
    private$.model <- model
    self$results$.setModel(model)
    infoTable$setRow(rowKey = "r2", list(value = mi.rsquared(model)))
    infoTable$setRow(rowKey = "aic", list(value = mf.getAIC(model)))
    infoTable$setRow(rowKey = "dev", list(value = model$deviance))
    infoTable$setRow(rowKey = "conv", mi.converged(model))
    anovaResults <- try(mf.anova(model))
    if (isError(anovaResults)) {
        message <- extractErrorMessage(anovaResults)
        anovaTable$setNote("anocrash", message)
        STOP <- TRUE
    }
    rowNames <- rownames(anovaResults)
    for (i in seq_along(rowNames)) {
        rowName <- rowNames[i]
        tableRow <- anovaResults[i, ]
        colnames(tableRow) <- TCONV[["glm.f"]]
        anovaTable$setRow(rowNo = i, tableRow)
    }
    if (mi.aliased(model)) {
        infoTable$setRow(rowKey = "conv", list(comm = "Results may be misleading because of aliased coefficients. See Tables notes"))
        anovaTable$setNote("aliased", WARNS["ano.aliased"])
        estimatesTable$setNote("aliased", WARNS["ano.aliased"])
    }
    parameters <- try(mf.summary(model))
    if (isError(parameters)) {
        message <- extractErrorMessage(parameters)
        estimatesTable$setNote("sumcrash", message)
        STOP <- T
    }
    ciWidth <- self$options$paramCIWidth/100
    if (self$options$showParamsCI) {
        citry <- try({
            ci <- mf.confint(model, level = ciWidth)
            colnames(ci) <- c("cilow", "cihig")
            parameters <- cbind(parameters, ci)
        })
        if (isError(citry)) {
            message <- extractErrorMessage(citry)
            infoTable$setRow(rowKey = "conv", list(value = "no"))
            estimatesTable$setNote("cicrash", paste(message, ". CI cannot be computed"))
        }
    }
    for (i in 1:nrow(parameters)) {
        estimatesTable$setRow(rowNo = i, parameters[i, ])
    }
    if (STOP) 
        return()
    private$.populateSimple(private$.model)
    private$.prepareDescPlots(private$.model)
    private$.populatePostHoc(model)
    private$.populateDescriptives(model)
})
withCallingHandlers(expr, warning = function(w) invokeRestart("muffleWarning"))
private$.populatePostHoc(model)
suppressWarnings({
    none <- mf.posthoc(model, ph, "none")
    bonferroni <- mf.posthoc(model, ph, "bonferroni")
    holm <- mf.posthoc(model, ph, "holm")
})
withCallingHandlers(expr, warning = function(w) invokeRestart("muffleWarning"))
mf.posthoc(model, ph, "none")
.posthoc.multinom(model, ph, "none")
emmeans::emmeans(model, tterm, transform = "response")
ref_grid(object, ...)
regrid(result, transform = transform)
.est.se.df(object, do.se = TRUE)
t(apply(object@linfct[use.elts, , drop = FALSE], 1, function(x) {
    if (!any(is.na(x)) && estimability::is.estble(x, object@nbasis, tol)) {
        x = x[active]
        est = sum(bhat * x)
        if (do.se) {
            se = sqrt(.qf.non0(object@V, x))
            df = object@dffun(x, object@dfargs)
        }
        else se = df = 0
        c(est, se, df)
    }
    else c(NA, NA, NA)
}))
apply(object@linfct[use.elts, , drop = FALSE], 1, function(x) {
    if (!any(is.na(x)) && estimability::is.estble(x, object@nbasis, tol)) {
        x = x[active]
        est = sum(bhat * x)
        if (do.se) {
            se = sqrt(.qf.non0(object@V, x))
            df = object@dffun(x, object@dfargs)
        }
        else se = df = 0
        c(est, se, df)
    }
    else c(NA, NA, NA)
})
FUN(newX[, i], ...)
.qf.non0(object@V, x)