Add export section for residuals and predictions

R/ancova.R

@@ -72,6 +72,10 @@ AncovaInternal <- function(jaspResults, dataset = NULL, options) {
 
   .BANOVAdescriptives(anovaContainer, dataset, options, list(noVariables=FALSE), "ANCOVA", ready)
 
+  .anovaExportResiduals(anovaContainer, dataset, options, ready)
+
+  .anovaExportPredictions(anovaContainer, dataset, options, ready)
+
   return()
 }
 

R/anovarepeatedmeasures.R

@@ -193,9 +193,16 @@ AnovaRepeatedMeasuresInternal <- function(jaspResults, dataset = NULL, options)
   termsRM.base64 <- c()
   termsRM.normal <- c()
 
+  mainEffects <- unlist(lapply(options$withinModelTerms, function(term) {
+    if (length(term$components) == 1) term$components
+  }))
+
   for (term in options$withinModelTerms) {
 
     components <- unlist(term$components)
+    if (length(components) > 1) # make sure that interaction gets defined in same order as model terms
+      components <- mainEffects[mainEffects %in% components]
+
     termRM.base64 <- paste(.v(components), collapse=":", sep="")
     termRM.normal <- paste(components, collapse=" \u273B ", sep="")
 

R/commonAnovaFreq.R

@@ -271,3 +271,50 @@
 }
 
 
+.anovaExportResiduals <- function(container, dataset, options, ready) {
+
+  if (ready &&
+      isTRUE(options[["residualsSavedToData"]]) &&
+      isTRUE(options[["residualsSavedToDataColumn"]] != "")) {
+
+    model <- container[["model"]]$object
+
+    residuals <- rep(NA, nrow(dataset)) # create vector with MA to account for missinginess
+
+    if (options[["residualsSavedToDataType"]] == "raw") {
+      residuals[as.numeric(rownames(model[["model"]]))] <- model[["residuals"]] # extract residuals
+    } else if (options[["residualsSavedToDataType"]] == "standard") {
+      residuals[as.numeric(rownames(model[["model"]]))] <- rstandard(model)
+    } else if (options[["residualsSavedToDataType"]] == "student") {
+      residuals[as.numeric(rownames(model[["model"]]))] <- rstudent(model)
+    }
+
+    container[["residualsSavedToDataColumn"]] <- createJaspColumn(columnName = options[["residualsSavedToDataColumn"]])
+    container[["residualsSavedToDataColumn"]]$dependOn(options = c("residualsSavedToDataColumn", "residualsSavedToData",
+                                                                   "residualsSavedToDataType",  "modelTerms"))
+    container[["residualsSavedToDataColumn"]]$setScale(residuals)
+
+  }
+
+}
+
+.anovaExportPredictions <- function(container, dataset, options, ready) {
+
+  if (ready &&
+      isTRUE(options[["predictionsSavedToData"]]) &&
+      isTRUE(options[["predictionsSavedToDataColumn"]] != "")) {
+
+
+    model <- container[["model"]]$object
+
+    predictions <- rep(NA, nrow(dataset)) # create vector with MA to account for missinginess
+    predictions[as.numeric(rownames(model[["model"]]))] <- model[["fitted.values"]] # extract predictions
+
+    container[["predictionsSavedToDataColumn"]] <- createJaspColumn(columnName = options[["predictionsSavedToDataColumn"]])
+    container[["predictionsSavedToDataColumn"]]$dependOn(options = c("predictionsSavedToDataColumn", "predictionsSavedToData", "modelTerms"))
+    container[["predictionsSavedToDataColumn"]]$setScale(predictions)
+
+  }
+
+}
+

inst/qml/Ancova.qml

@@ -112,4 +112,5 @@ Form
 		source: ["fixedFactors", "randomFactors"]
 	}
 
+	Classical.Export { id: exportComponent}
 }

inst/qml/Anova.qml

@@ -108,4 +108,7 @@ Form
 	{
 		source: ["fixedFactors", "randomFactors"]
 	}
+
+	Classical.Export { id: exportComponent}
+
 }

inst/qml/AnovaRepeatedMeasures.qml

@@ -72,6 +72,7 @@ Form
 			label: qsTr("Pool error term for follow-up tests")
 			checked: false 
 		}
+
 	}
 
 	Section

inst/qml/common/classical/Export.qml

@@ -0,0 +1,72 @@
+//
+// Copyright (C) 2013-2022 University of Amsterdam
+//
+// This program is free software: you can redistribute it and/or modify
+// it under the terms of the GNU Affero General Public License as
+// published by the Free Software Foundation, either version 3 of the
+// License, or (at your option) any later version.
+//
+// This program is distributed in the hope that it will be useful,
+// but WITHOUT ANY WARRANTY; without even the implied warranty of
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+// GNU Affero General Public License for more details.
+//
+// You should have received a copy of the GNU Affero General Public
+// License along with this program.  If not, see
+// <http://www.gnu.org/licenses/>.
+//
+
+import QtQuick
+import JASP
+import JASP.Controls
+import "./" as Classical
+
+
+Section
+{
+	title: qsTr("Export")
+
+	Group
+	{
+		CheckBox
+		{
+			id:							residualsSavedToData
+			name:						"residualsSavedToData"
+			text:						qsTr("Append residuals to data")
+
+			ComputedColumnField
+			{
+				name:					"residualsSavedToDataColumn"
+				text:					qsTr("Column name")
+				placeholderText:		qsTr("e.g., residuals")
+				fieldWidth:				120
+				enabled:				residualsSavedToData.checked
+			}
+
+			RadioButtonGroup
+			{
+				title: qsTr("Residuals type")
+				name: "residualsSavedToDataType"
+				RadioButton { value: "raw";			label: qsTr("Raw"); checked: true	}
+				RadioButton { value: "standard";	label: qsTr("Studentized")		}
+				RadioButton { value: "student";		label: qsTr("Standardized")		}
+			}
+		}
+
+		CheckBox
+		{
+			id:							predictionsSavedToData
+			name:						"predictionsSavedToData"
+			text:						qsTr("Append predictions to data")
+
+			ComputedColumnField
+			{
+				name:					"predictionsSavedToDataColumn"
+				text:					qsTr("Column name")
+				placeholderText:		qsTr("e.g., predictions")
+				fieldWidth:				120
+				enabled:				predictionsSavedToData.checked
+			}
+		}
+	}
+}

tests/testthat/test-anovarepeatedmeasuresbayesian.R

@@ -169,15 +169,15 @@ test_that("Analysis handles errors", {
 test_that("Analysis fails gracefully if some models error", {
 
   options <- initOpts("AnovaRepeatedMeasuresBayesian")
-  options$covariates = list("contNormal")
-  options$betweenSubjectFactors = list("contBinom")
+  options$covariates = "contNormal"
+  options$betweenSubjectFactors = "contBinom"
   options$effects <- TRUE
-  options$modelTerms = list(list(components = list("RM_FACTOR_1"), isNuisance = FALSE),
-                            list(components = list("contBinom"), isNuisance = FALSE),
-                            list(components = list("contNormal"), isNuisance = FALSE),
-                            list(components = list("RM_FACTOR_1", "contBinom"), isNuisance = FALSE))
-  options$repeatedMeasuresCells = list("contcor1", "contcor2")
-  options$repeatedMeasuresFactors = list(list(levels = list("Level 1", "Level 2"), name = "RM_FACTOR_1"))
+  options$modelTerms = list(list(components = "RM_FACTOR_1", isNuisance = FALSE),
+                            list(components = "contBinom", isNuisance = FALSE),
+                            list(components = "contNormal", isNuisance = FALSE),
+                            list(components = c("RM_FACTOR_1", "contBinom"), isNuisance = FALSE))
+  options$repeatedMeasuresCells = c("contcor1", "contcor2")
+  options$repeatedMeasuresFactors = list(list(levels = c("Level 1", "Level 2"), name = "RM_FACTOR_1"))
 
   # NOTE: the option below makes BayesFactor return NaN as BF for models with covariates.
   # It's a nice hack to test how gracefully the analysis recovers when some but not all BFs could be computed.