Fix unit tests for blocked models logistic reg

R/commonglm.R

@@ -386,7 +386,9 @@
   if (isFALSE(options[["residualsSavedToData"]]))
     return()
 
-  if (is.null(container[["residualsSavedToDataColumn"]]) && options[["residualsSavedToDataColumn"]] != "") {
+  if (is.null(container[["residualsSavedToDataColumn"]]) && 
+      isFALSE(is.null(options[["residualsSavedToDataColumn"]])) &&
+      options[["residualsSavedToDataColumn"]] != "") {
 
     residuals <- model[["residuals"]] # extract residuals
 
@@ -856,7 +858,7 @@
   colnames(influenceResData)[1:length(colInd)] <- colNames[1:length(colInd)]
 
   influenceResData[["caseN"]] <- seq.int(nrow(influenceResData))
-  influenceResData[["stdResidual"]] <- rstandard(model)
+  influenceResData[["stdResidual"]] <- rstandard(model, type = "deviance")
   influenceResData[["dependent"]] <- model.frame(model)[[options$dependent]]
   influenceResData[["predicted"]] <- model$fitted.values
   influenceResData[["residual"]] <- model$residual

R/regressionlogistic.R

@@ -359,7 +359,8 @@ RegressionLogisticInternal <- function(jaspResults, dataset = NULL, options, ...
         mObj <- glmObj[[midx]]
         if (midx > 1) {
           if (options$method == "forward" ||
-              options$method == "stepwise") {
+              options$method == "stepwise" ||
+              options$method == "enter") {
             fadden <- .mcFadden(mObj, glmObj[[1]])
             nagel  <- .nagelkerke(mObj, glmObj[[1]])
             coxSn  <- .coxSnell(mObj, glmObj[[1]])

inst/qml/RegressionLogistic.qml

@@ -151,7 +151,7 @@ Form
 			CheckBox { name: "hMeasure";		label: qsTr("H-measure")			}
         }
 
-		Common.OutlierComponent { id: outlierComponentt}
+		Common.OutlierComponent { id: outlierComponent}
 
 
 	}

inst/qml/common/OutlierComponent.qml

@@ -30,11 +30,14 @@ Group
 		name: "residualStatistic"     
 		label: qsTr("Statistics") 
 		visible: analysis === Type.Analysis.LinearRegression
+		value: false
 	}
 
 	CheckBox
 	{
-		name: "residualCasewiseDiagnostic";	label: qsTr("Casewise diagnostics")
+		name: "residualCasewiseDiagnostic"
+		label: qsTr("Casewise diagnostics")
+		value: false
 		columns: 2
 		RadioButtonGroup
 		{
@@ -71,6 +74,7 @@ Group
 		id:							residualsSavedToData
 		name:						"residualsSavedToData"
 		text:						qsTr("Append residuals to data")
+		value:                      false
 
 		ComputedColumnField
 		{

tests/testthat/helper-regression.R

@@ -0,0 +1,20 @@
+initClassicalRegressionOptions <- function(analysis = c("RegressionLinear", "RegressionLogistic")) {
+  analysis <- match.arg(analysis)
+  options <- c(
+    jaspTools::analysisOptions(analysis),
+    classicalRegressionCommonOptions()
+  )
+
+  return(options)
+}
+
+classicalRegressionCommonOptions <- function() {
+  path <- testthat::test_path("..", "..", "inst", "qml", "common")
+  files <- list.files(path, full.names = TRUE)
+  options <- lapply(files, jaspTools:::readQML) |>
+    lapply(function(x) {x$plotWidth <- NULL; x$plotHeight <- NULL; return(x)}) |>
+    (function(x) { do.call(c, x)})()
+
+  return(options)
+}
+

tests/testthat/test-regressionlogisticVerification.R

@@ -4,7 +4,7 @@ context("Logistic Regression -- Verification project")
 
 ## Testing Titanice
 
-options <- jaspTools::analysisOptions("RegressionLogistic")
+options <- initClassicalRegressionOptions("RegressionLogistic")
 options$dependent <- "Survived"
 options$factors <- c("PClass", "Sex")
 options$covariates <- "Age"