diff --git a/R/ancova.R b/R/ancova.R index 81ce89d4..ac62a525 100644 --- a/R/ancova.R +++ b/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() } diff --git a/R/anovarepeatedmeasures.R b/R/anovarepeatedmeasures.R index 32c4cb33..402f56bf 100644 --- a/R/anovarepeatedmeasures.R +++ b/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="") diff --git a/R/commonAnovaFreq.R b/R/commonAnovaFreq.R index 5c4eed39..8ca63206 100644 --- a/R/commonAnovaFreq.R +++ b/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) + + } + +} + diff --git a/inst/qml/Ancova.qml b/inst/qml/Ancova.qml index 94478067..52ef36ae 100644 --- a/inst/qml/Ancova.qml +++ b/inst/qml/Ancova.qml @@ -112,4 +112,5 @@ Form source: ["fixedFactors", "randomFactors"] } + Classical.Export { id: exportComponent} } diff --git a/inst/qml/Anova.qml b/inst/qml/Anova.qml index 8bb33531..9667e989 100644 --- a/inst/qml/Anova.qml +++ b/inst/qml/Anova.qml @@ -108,4 +108,7 @@ Form { source: ["fixedFactors", "randomFactors"] } + + Classical.Export { id: exportComponent} + } diff --git a/inst/qml/AnovaRepeatedMeasures.qml b/inst/qml/AnovaRepeatedMeasures.qml index 03999ae0..e215f9dc 100644 --- a/inst/qml/AnovaRepeatedMeasures.qml +++ b/inst/qml/AnovaRepeatedMeasures.qml @@ -72,6 +72,7 @@ Form label: qsTr("Pool error term for follow-up tests") checked: false } + } Section diff --git a/inst/qml/common/classical/Export.qml b/inst/qml/common/classical/Export.qml new file mode 100644 index 00000000..2d56816e --- /dev/null +++ b/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 +// . +// + +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 + } + } + } +} diff --git a/tests/testthat/test-anovarepeatedmeasuresbayesian.R b/tests/testthat/test-anovarepeatedmeasuresbayesian.R index 0f5373a2..64bea684 100644 --- a/tests/testthat/test-anovarepeatedmeasuresbayesian.R +++ b/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.