diff --git a/R/classicProcess.R b/R/classicProcess.R index 2590904..d7e249c 100644 --- a/R/classicProcess.R +++ b/R/classicProcess.R @@ -427,8 +427,10 @@ ClassicProcess <- function(jaspResults, dataset = NULL, options) { .procReadData <- function(options) { # Read in selected variables from dataset - vars <- c(options[['dependent']], options[['covariates']], options[['factors']]) - dataset <- .readDataSetToEnd(columns = vars) + dataset <- .readDataSetToEnd( + columns = c(options[['dependent']], options[['covariates']]), + columns.as.factor = options[['factors']] + ) # Standardize variables to get standardized estimates if (options$standardizedEstimates != "unstandardized") { @@ -1727,14 +1729,20 @@ ClassicProcess <- function(jaspResults, dataset = NULL, options) { } # Sets container error if invalid - .procIsValidModel(modelContainer, procResults[[i]]) + isValid <- .procIsValidModel(modelContainer, procResults[[i]]) + + if (isValid && !procResults[[i]]@Options[["do.fit"]]) { + next + } + + contrasts <- modelsContainer[[modelNames[i]]][["contrasts"]]$object if (options[["processModels"]][[i]][["localTests"]]) - .procLocalTestTable(modelContainer, dataset, options, procResults[[i]], i) + .procLocalTestTable(modelContainer, dataset, options, procResults[[i]], contrasts, i) } } -.procLocalTestTable <- function(container, dataset, options, procResults, modelIdx) { +.procLocalTestTable <- function(container, dataset, options, procResults, contrasts, modelIdx) { if (!is.null(container[["localTestTable"]])) return() localTestTable <- createJaspTable(title = gettext("Conditional independence tests")) @@ -1751,6 +1759,9 @@ ClassicProcess <- function(jaspResults, dataset = NULL, options) { if (container$getError()) return() + # Only test variables in dataset that are part of model + dataset <- dataset[encodeColNames(procResults@Data@ov$name)] + if (!procResults@Fit@converged) { localTestTable$addFootnote(gettext("Model did not converge.")) } @@ -1805,7 +1816,7 @@ ClassicProcess <- function(jaspResults, dataset = NULL, options) { localTestTable$addColumnInfo(name = "ci.upper", title = gettext("Upper"), type = "number", format = "sf:4;dp:3", overtitle = gettextf("%s%% Confidence Interval", options$ciLevel * 100)) - if (testType == "cis" && any(sapply(dataset, is.factor))) { + if (testType == "cis" && !is.null(contrasts) && length(contrasts) > 0) { localTestTable$setError(gettext("Linear test type cannot be applied to factor variables. Choose a different test type or remove all factor variables from the model.")) return() } @@ -1823,7 +1834,7 @@ ClassicProcess <- function(jaspResults, dataset = NULL, options) { }) parNamesAbbr <- abbreviate(unique(unlist(parTable[c("lhs", "rhs")]))) - + graph <- dagitty::dagitty(paste("dag {", paste(arrows, collapse = "\n")," } ")) localTestResult <- dagitty::localTests( @@ -1853,7 +1864,6 @@ ClassicProcess <- function(jaspResults, dataset = NULL, options) { } } else { localTestTable$setError(gettext("The specified model does not imply any (conditional) independencies that can be tested.")) - } } diff --git a/tests/testthat/test-classic-process-integration-general.R b/tests/testthat/test-classic-process-integration-general.R index 74cfd8b..65bdb11 100644 --- a/tests/testthat/test-classic-process-integration-general.R +++ b/tests/testthat/test-classic-process-integration-general.R @@ -888,3 +888,83 @@ test_that("Not implemented Hayes models error message work", { testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] jaspTools::expect_equal_plots(testPlot, "statistical-path-plot-error-hayes") }) + +test_that("Invalid test type error message work", { + options <- jaspTools::analysisOptions("ClassicProcess") + options$dependent <- "contNormal" + options$covariates <- list("contGamma", "debCollin1", "contcor1", "contNormal") + options$factors <- list("facGender") + options$statisticalPathPlotsCovariances <- TRUE + options$statisticalPathPlotsResidualVariances <- TRUE + options$errorCalculationMethod <- "standard" + options$ciLevel <- 0.95 + options$naAction <- "fiml" + options$emulation <- "lavaan" + options$estimator <- "default" + options$moderationProbes <- list(list(probePercentile = 16, value = "16"), list(probePercentile = 50, + value = "50"), list(probePercentile = 84, value = "84")) + options$pathPlotsLegend <- TRUE + options$pathPlotsColorPalette <- "colorblind" + options$processModels <- list(list(conceptualPathPlot = TRUE, independentCovariances = TRUE, + inputType = "inputVariables", mediationEffects = TRUE, mediatorCovariances = TRUE, + modelNumber = 1, modelNumberCovariates = list(), modelNumberIndependent = "", + modelNumberMediators = list(), modelNumberModeratorW = "", + modelNumberModeratorZ = "", name = "Model 1", pathCoefficients = TRUE, + processRelationships = list(list(processDependent = "contNormal", + processIndependent = "contGamma", processType = "mediators", + processVariable = "debCollin1"), list(processDependent = "contNormal", + processIndependent = "contGamma", processType = "moderators", + processVariable = "facGender")), residualCovariances = TRUE, + statisticalPathPlot = TRUE, totalEffects = TRUE, localTests = TRUE, + localTestType = "cis", localTestBootstrap = FALSE, localTestBootstrapSamples = 1000)) + set.seed(1) + results <- jaspTools::runAnalysis("ClassicProcess", "debug", options) + + refMsg <- gettext("Linear test type cannot be applied to factor variables. Choose a different test type or remove all factor variables from the model.") + + msg <- results[["results"]][["localTestContainer"]][["collection"]][["localTestContainer_Model 1"]][["collection"]][["localTestContainer_Model 1_localTestTable"]][["error"]][["errorMessage"]] + expect_equal(msg, refMsg) + + + table <- results[["results"]][["modelSummaryTable"]][["data"]] + jaspTools::expect_equal_tables(table, + list(605.478429431628, 641.950812035461, 4, "Model 1", 100, -288.739214715814, + 5)) +}) + +test_that("Local tests work for factors with loess test type", { + options <- jaspTools::analysisOptions("ClassicProcess") + options$dependent <- "contNormal" + options$covariates <- list("contGamma", "debCollin1", "contcor1", "contNormal") + options$factors <- list("facGender") + options$statisticalPathPlotsCovariances <- TRUE + options$statisticalPathPlotsResidualVariances <- TRUE + options$errorCalculationMethod <- "standard" + options$ciLevel <- 0.95 + options$naAction <- "fiml" + options$emulation <- "lavaan" + options$estimator <- "default" + options$moderationProbes <- list(list(probePercentile = 16, value = "16"), list(probePercentile = 50, + value = "50"), list(probePercentile = 84, value = "84")) + options$pathPlotsLegend <- TRUE + options$pathPlotsColorPalette <- "colorblind" + options$processModels <- list(list(conceptualPathPlot = TRUE, independentCovariances = TRUE, + inputType = "inputVariables", mediationEffects = TRUE, mediatorCovariances = TRUE, + modelNumber = 1, modelNumberCovariates = list(), modelNumberIndependent = "", + modelNumberMediators = list(), modelNumberModeratorW = "", + modelNumberModeratorZ = "", name = "Model 1", pathCoefficients = TRUE, + processRelationships = list(list(processDependent = "contNormal", + processIndependent = "contGamma", processType = "mediators", + processVariable = "debCollin1"), list(processDependent = "contNormal", + processIndependent = "contGamma", processType = "moderators", + processVariable = "facGender")), residualCovariances = TRUE, + statisticalPathPlot = TRUE, totalEffects = TRUE, localTests = TRUE, + localTestType = "cis.loess", localTestBootstrap = FALSE, localTestBootstrapSamples = 1000)) + set.seed(1) + results <- jaspTools::runAnalysis("ClassicProcess", "debug", options) + table <- results[["results"]][["localTestContainer"]][["collection"]][["localTestContainer_Model 1"]][["collection"]][["localTestContainer_Model 1_localTestTable"]][["data"]] + jaspTools::expect_equal_tables(table, + list(-0.206103108541346, 0.17035274701811, "contGamma", -0.0139864082891252, + "debCollin1", "", "", "facGenderm", 0.0989527098094575 + )) +})