diff --git a/R/commonglm.R b/R/commonglm.R index 642d765..2d89c8e 100644 --- a/R/commonglm.R +++ b/R/commonglm.R @@ -867,7 +867,14 @@ modelMatrix <- as.data.frame(model.matrix(model)) modelMatrix <- modelMatrix[colnames(modelMatrix) != "(Intercept)"] - influenceResData[["mahalanobis"]] <- mahalanobis(modelMatrix, center = colMeans(modelMatrix), cov = cov(modelMatrix)) + + if (ncol(modelMatrix) > 0) { + influenceResData[["mahalanobis"]] <- mahalanobis(modelMatrix, center = colMeans(modelMatrix), cov = cov(modelMatrix)) + } else if (options[["mahalanobis"]]) { + influenceTable$addFootnote( + gettext("Mahalanobis distance cannot be computed for the intercept only model.") + ) + } if (options$residualCasewiseDiagnosticType == "cooksDistance") index <- which(abs(influenceResData[["cooksDistance"]]) > options$residualCasewiseDiagnosticCooksDistanceThreshold) diff --git a/R/generalizedlinearmodel.R b/R/generalizedlinearmodel.R index b927b82..f29a441 100644 --- a/R/generalizedlinearmodel.R +++ b/R/generalizedlinearmodel.R @@ -102,14 +102,14 @@ GeneralizedLinearModelInternal <- function(jaspResults, dataset = NULL, options, limits.min = 0, limits.max = Inf, exitAnalysisIfErrors = TRUE) - + if (length(options$factors) != 0) .hasErrors(dataset, type = "factorLevels", factorLevels.target = options$factors, factorLevels.amount = '< 2', exitAnalysisIfErrors = TRUE) - + if (options[["family"]] == "bernoulli") { if (length(levels(dataset[, options[["dependent"]]])) != 2) @@ -117,6 +117,9 @@ GeneralizedLinearModelInternal <- function(jaspResults, dataset = NULL, options, } else if (options[["family"]] == "binomial") { + if (any(dataset[, options[["weights"]]] == 0)) + .quitAnalysis(gettext("The Binomial family requires the weights variable (i.e. total number of trials) to be non-zero.")) + if (any(dataset[, options[["dependent"]]] < 0) || any(dataset[, options[["dependent"]]] > 1)) .quitAnalysis(gettext("The Binomial family requires the dependent variable (i.e. proportion of successes) to be between 0 and 1 (inclusive).")) @@ -414,7 +417,11 @@ GeneralizedLinearModelInternal <- function(jaspResults, dataset = NULL, options, rowNames <- rownames(modelSummary) if (options[["coefficientCi"]]) { - coefCiSummary <- confint(fullModel, level = options[["coefficientCiLevel"]]) + coefCiSummary <- try(confint(fullModel, level = options[["coefficientCiLevel"]])) + if (jaspBase::isTryError(coefCiSummary)) { + jaspResults[["estimatesTable"]]$setError("Confidence intervals not available for this model, try other predictors, families, or links.") + return() + } if (length(rowNames) == 1) coefCiSummary <- matrix(coefCiSummary, ncol = 2) } else { coefCiSummary <- matrix(nrow = length(rowNames), @@ -477,14 +484,14 @@ GeneralizedLinearModelInternal <- function(jaspResults, dataset = NULL, options, .glmOutlierTable(jaspResults, dataset, options, ready, position = 8, residType = "standardized deviance") .glmOutlierTable(jaspResults, dataset, options, ready, position = 8, residType = "studentized deviance") - .glmInfluenceTable(jaspResults[["diagnosticsContainer"]], + .glmInfluenceTable(jaspResults[["diagnosticsContainer"]], jaspResults[["glmModels"]][["object"]][["fullModel"]], dataset, options, ready, position = 9) - - .regressionExportResiduals(jaspResults, + + .regressionExportResiduals(jaspResults, jaspResults[["glmModels"]][["object"]][["fullModel"]], dataset, options, ready) - + .glmMulticolliTable(jaspResults, dataset, options, ready, position = 10) return() diff --git a/R/regressionlogistic.R b/R/regressionlogistic.R index 707ed99..9df739d 100644 --- a/R/regressionlogistic.R +++ b/R/regressionlogistic.R @@ -361,9 +361,9 @@ RegressionLogisticInternal <- function(jaspResults, dataset = NULL, options, ... rows <- vector("list", length(glmObj)) for (midx in seq_along(glmObj)) { - + if (options$method == "enter") - .linregAddPredictorsInModelFootnote(jaspResults[["modelSummary"]], + .linregAddPredictorsInModelFootnote(jaspResults[["modelSummary"]], options[["modelTerms"]][[midx]][["components"]], midx) mObj <- glmObj[[midx]] if (midx > 1) { @@ -796,6 +796,9 @@ RegressionLogisticInternal <- function(jaspResults, dataset = NULL, options, ... mObj <- glmObj[[length(glmObj)]] predictors <- character(0) + if (is.null(options$modelTerms[[length(glmObj)]][["components"]])) { + return() + } mComponents <- options$modelTerms[[length(glmObj)]][["components"]] predictors <- unlist(sapply(mComponents, function(x) if(length(x) == 1) x)) @@ -904,7 +907,7 @@ RegressionLogisticInternal <- function(jaspResults, dataset = NULL, options, ... container[["subContainer"]] <- createJaspContainer(gettext("Independent - predicted plots")) subcontainer <- container[["subContainer"]] if(!ready){ - subcontainer[["placeholder"]] <- createJaspPlot(width = 480, height = 320, dependencies = c("independentVsPredictedPlot", + subcontainer[["placeholder"]] <- createJaspPlot(width = 480, height = 320, dependencies = c("independentVsPredictedPlot", "independentVsPredictedPlotIncludeInteractions", "independentVsPredictedPlotUseLogit")) return() @@ -914,32 +917,32 @@ RegressionLogisticInternal <- function(jaspResults, dataset = NULL, options, ... glmObj <- jaspResults[["glmRes"]][["object"]] mObj <- glmObj[[length(glmObj)]] mComponents <- options$modelTerms[[length(glmObj)]][["components"]] - + if (options[["independentVsPredictedPlotIncludeInteractions"]]) { predictors <- sapply(mComponents, function(x) if(length(x) < 3) x) } else { predictors <- sapply(mComponents, function(x) if(length(x) == 1) x) } - + predictions <- predict(mObj, type = "response") if(options[["independentVsPredictedPlotUseLogit"]]) { - predictions <- log(predictions / (1 - predictions)) + predictions <- log(predictions / (1 - predictions)) yName <- "Logit Predicted Probability" } else { yName <- "Predicted Probability" } - + for (pred in predictors) { - + facPredictorIndex <- which(pred %in% options[["factors"]]) - + for (i in seq_along(pred)) { - + predictorLogitPlot <- createJaspPlot(title = paste(c(pred[i], pred[-i]), collapse = " \u273B "), width = 480, height = 320) - predictorLogitPlot$dependOn(c("independentVsPredictedPlot", + predictorLogitPlot$dependOn(c("independentVsPredictedPlot", "independentVsPredictedPlotIncludeInteractions", "independentVsPredictedPlotUseLogit")) - + binContVar <- FALSE if (length(pred) == 1) { groupVar <- groupName <- NULL @@ -967,13 +970,13 @@ RegressionLogisticInternal <- function(jaspResults, dataset = NULL, options, ... yName = yName, addSmooth = TRUE, addSmoothCI = TRUE, - plotAbove = "none", + plotAbove = "none", plotRight = "none", showLegend = length(pred) > 1, legendTitle = if (binContVar) paste0(groupName,"_binned") else groupName, smoothCIValue = 0.95, forceLinearSmooth = options[["independentVsPredictedPlotUseLogit"]])) - + if(isTryError(p)) predictorLogitPlot$setError(.extractErrorMessage(p)) else { @@ -982,10 +985,10 @@ RegressionLogisticInternal <- function(jaspResults, dataset = NULL, options, ... predictorLogitPlot$plotObject <- p } subcontainer[[paste0(indepVar, groupName)]] <- predictorLogitPlot - + } } - + return() }