diff --git a/R/classicProcess.R b/R/classicProcess.R index b34136a..666e005 100644 --- a/R/classicProcess.R +++ b/R/classicProcess.R @@ -291,26 +291,32 @@ ClassicProcess <- function(jaspResults, dataset = NULL, options) { igraph::E(graph)$isMod <- FALSE # Which are moderation variables for each edge; NULL if none + igraph::E(graph)$modVars <- NA + for (i in 1:length(igraph::E(graph))) { sourceNode <- igraph::V(graph)[igraph::E(graph)$source[i]] if (sourceNode$isInt) { sourceNodeIntVars <- unlist(sourceNode$intVars) - + for (v in sourceNodeIntVars) { # Set all edges from var interacting with sourceNode to target as isMod igraph::E(graph)[source == v & target == igraph::E(graph)$target[i]]$isMod <- TRUE # Store unique moderating variables - igraph::E(graph)[source == v & target == igraph::E(graph)$target[i]]$modVars <- list( - unique(c( - igraph::E(graph)[source == v & target == igraph::E(graph)$target[i]]$modVars[[1]], - sourceNodeIntVars[sourceNodeIntVars != v] - )) - ) + if (any(is.na(igraph::E(graph)[source == v & target == igraph::E(graph)$target[i]]$modVars))) { + igraph::E(graph)[source == v & target == igraph::E(graph)$target[i]]$modVars <- sourceNodeIntVars[sourceNodeIntVars != v] + } else { + igraph::E(graph)[source == v & target == igraph::E(graph)$target[i]]$modVars <- list( + unique(c( + igraph::E(graph)[source == v & target == igraph::E(graph)$target[i]]$modVars[[1]], + sourceNodeIntVars[sourceNodeIntVars != v] + )) + ) + } } } } - + return(graph) } @@ -472,35 +478,69 @@ ClassicProcess <- function(jaspResults, dataset = NULL, options) { contrastList[[f]] <- do.call(contrasts[[f]], list(levels(as.factor(dataset[[f]])))) } + # We need to make a new graph, otherwise igraph messes up the order of nodes + facGraph <- igraph::make_empty_graph() + # Decode names to match with graph node names (FIXME) names(contrastList) <- decodeColNames(names(contrastList)) + + # Split terms of predictor vars + sourcVarsSplit <- strsplit(unique(igraph::E(graph)$source), ":|__") # Replace dummy-coded variables in graph - for (v in names(contrastList)) { - newNodeNames <- paste0(v, colnames(contrastList[[v]])) - - # If dummy coding needs additional variables add them as nodes with same edges to target variable - if (length(newNodeNames) > 1) { - graph <- igraph::add_vertices(graph, length(newNodeNames[-1]), name = newNodeNames[-1]) - graph <- igraph::add_edges(graph, - edges = as.vector(rbind(newNodeNames[-1], igraph::E(graph)[.from(v)]$source)), - source = newNodeNames[-1], - target = igraph::E(graph)[.from(v)]$source - ) + # Goes through all source variables and replaces them with dummy coded variable names + # if necessary + for (vars in sourcVarsSplit) { + # Concatenate variable with factor levels from contrast list to get dummy variable name + contr <- lapply(vars, function(v) { + if (v %in% names(contrastList)) { + return(paste0(v, colnames(contrastList[[v]]))) + } else { + return(v) + } + }) + + # Concatenate source var and interaction terms in dummy coded variable + if (length(vars) < 3) { + contr <- .doCallPaste(contr, sep = ":") + sourceName <- paste(vars, collapse = ":") + } else { + contr <- .doCallPaste(contr, sep = "__") + sourceName <- paste(vars, collapse = "__") } - - # Update graph attributes with dummy variables - igraph::V(graph)$name <- gsub(v, newNodeNames[1], igraph::V(graph)$name) - igraph::V(graph)$intVars <- sapply(igraph::V(graph)$intVars, function(x) if (!is.null(x)) gsub(v, newNodeNames[1], x)) # Returns a list! - igraph::E(graph)$source <- gsub(v, newNodeNames[1], igraph::E(graph)$source) - igraph::E(graph)$target <- gsub(v, newNodeNames[1], igraph::E(graph)$target) - if (!is.null(igraph::E(graph)$modVars)) { - igraph::E(graph)$modVars <- sapply(igraph::E(graph)$modVars, function(x) if (!is.null(x)) gsub(v, newNodeNames[1], x)) # Returns a list! + + # Add nodes for source variables not in graph + contrNotInGraph <- contr[!contr %in% igraph::V(facGraph)$name] + + if (length(contrNotInGraph) > 0) { + facGraph <- igraph::add_vertices(facGraph, length(contrNotInGraph), name = contrNotInGraph) + } + + # Get target variable + target <- igraph::E(graph)[.from(sourceName)]$target + + # Add nodes for targets not in graph + targetNotInGraph <- target[!target %in% igraph::V(facGraph)$name] + + if (length(targetNotInGraph) > 0) { + facGraph <- igraph::add_vertices(facGraph, length(targetNotInGraph), name = targetNotInGraph) + } + + # Add edges between source and target variables + for (t in target) { + facGraph <- igraph::add_edges(facGraph, + edges = as.vector(rbind(contr, t)), + source = contr, + target = t + ) } } - + + # Add attributes to graph + facGraph <- .procGraphAddAttributes(facGraph) + modelsContainer[[modelName]][["contrasts"]] <- createJaspState(contrastList) - modelsContainer[[modelName]][["graph"]]$object <- graph + modelsContainer[[modelName]][["graph"]]$object <- facGraph } return(dataset) @@ -563,7 +603,7 @@ ClassicProcess <- function(jaspResults, dataset = NULL, options) { ), exitAnalysisIfErrors = TRUE ) - if (length(options[["covariates"]]) > 0) { + if (length(options[["covariates"]]) > 1) { .hasErrors(dataset, "run", type = "varCovData", varCovData.target = options[["covariates"]], @@ -779,7 +819,7 @@ ClassicProcess <- function(jaspResults, dataset = NULL, options) { lhs <- paste(names(path), collapse = "__") # Get moderators on path - modName <- unlist(Filter(Negate(is.null), sapply(2:length(path), function(i) { + modName <- na.omit(unlist(sapply(2:length(path), function(i) { return(igraph::E(graph)[.from(names(path)[i-1]) & .to(names(path)[i])]$modVars) }))) @@ -789,9 +829,9 @@ ClassicProcess <- function(jaspResults, dataset = NULL, options) { pathEdge <- igraph::E(graph)[.from(names(path)[i-1]) & .to(names(path)[i])] # If no moderators on edge, return only parName - if(is.null(pathEdge$modVars[[1]])) return(pathEdge$parName) + if(any(is.na(pathEdge$modVars[[1]]))) return(pathEdge$parName) - modPars <- lapply(pathEdge$modVars[[1]], function(v) { # If moderators + modPars <- lapply(pathEdge$modVars[[1]], function(v) { # If moderators # Get edge for two way interaction between X and M twoWayEdge <- igraph::E(graph)[ .from(paste(names(path)[i-1], v, sep = ":")) & diff --git a/tests/testthat/_snaps/classic-process-integration-general/conceptual-path-plot-facthree-int-factwo.svg b/tests/testthat/_snaps/classic-process-integration-general/conceptual-path-plot-facthree-int-factwo.svg new file mode 100644 index 0000000..4e534d1 --- /dev/null +++ b/tests/testthat/_snaps/classic-process-integration-general/conceptual-path-plot-facthree-int-factwo.svg @@ -0,0 +1,61 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +fcTB +fcTC +cnN +fTE + + +conceptual-path-plot-facThree-int-facTwo + + diff --git a/tests/testthat/_snaps/classic-process-integration-general/conceptual-path-plot-facthree.svg b/tests/testthat/_snaps/classic-process-integration-general/conceptual-path-plot-facthree.svg new file mode 100644 index 0000000..d655a1f --- /dev/null +++ b/tests/testthat/_snaps/classic-process-integration-general/conceptual-path-plot-facthree.svg @@ -0,0 +1,61 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +fcTB +fcTC +cnN +cn1 + + +conceptual-path-plot-facThree + + diff --git a/tests/testthat/_snaps/classic-process-integration-general/conceptual-path-plot-factwo-int-facthree.svg b/tests/testthat/_snaps/classic-process-integration-general/conceptual-path-plot-factwo-int-facthree.svg new file mode 100644 index 0000000..4b38641 --- /dev/null +++ b/tests/testthat/_snaps/classic-process-integration-general/conceptual-path-plot-factwo-int-facthree.svg @@ -0,0 +1,59 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +fcTE +cnN +fTB +fTC + + +conceptual-path-plot-facTwo-int-facThree + + diff --git a/tests/testthat/_snaps/classic-process-integration-general/statistical-path-plot-facthree-int-factwo.svg b/tests/testthat/_snaps/classic-process-integration-general/statistical-path-plot-facthree-int-factwo.svg new file mode 100644 index 0000000..aacfcd9 --- /dev/null +++ b/tests/testthat/_snaps/classic-process-integration-general/statistical-path-plot-facthree-int-factwo.svg @@ -0,0 +1,91 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +c1 +c2 +c3 +c4 +c5 +fcTB +fcTC +cnN +fTE +fTB: +fTC: + + + + + + + + + + + + + + + + + + + + + + + +statistical-path-plot-facThree-int-facTwo + + diff --git a/tests/testthat/_snaps/classic-process-integration-general/statistical-path-plot-facthree.svg b/tests/testthat/_snaps/classic-process-integration-general/statistical-path-plot-facthree.svg new file mode 100644 index 0000000..c433fba --- /dev/null +++ b/tests/testthat/_snaps/classic-process-integration-general/statistical-path-plot-facthree.svg @@ -0,0 +1,91 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +c1 +c2 +c3 +c4 +c5 +fcTB +fcTC +cnN +cn1 +fTB: +fTC: + + + + + + + + + + + + + + + + + + + + + + + +statistical-path-plot-facThree + + diff --git a/tests/testthat/_snaps/classic-process-integration-general/statistical-path-plot-factwo-int-facthree.svg b/tests/testthat/_snaps/classic-process-integration-general/statistical-path-plot-factwo-int-facthree.svg new file mode 100644 index 0000000..42c6909 --- /dev/null +++ b/tests/testthat/_snaps/classic-process-integration-general/statistical-path-plot-factwo-int-facthree.svg @@ -0,0 +1,91 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +c1 +c2 +c3 +c4 +c5 +fcTE +cnN +fTB +fTC +fTE:TB +fTE:TC + + + + + + + + + + + + + + + + + + + + + + + +statistical-path-plot-facTwo-int-facThree + + diff --git a/tests/testthat/test-classic-process-integration-general.R b/tests/testthat/test-classic-process-integration-general.R index e51091b..60329f8 100644 --- a/tests/testthat/test-classic-process-integration-general.R +++ b/tests/testthat/test-classic-process-integration-general.R @@ -42,3 +42,330 @@ test_that("Error handling works - covariance", { results <- jaspTools::runAnalysis("ClassicProcess", "debug", options) expect_identical(results[["status"]], "validationError", label = "Covariance check") }) + +get_fac_df <- function() { + df <- data.frame( + contNormal = rnorm(100), + contcor1 = rnorm(100), + facThree = cut(rnorm(100), breaks = 3, labels = c("A", "B", "C")), + facTwo = sample(c("D", "E"), 100, replace = TRUE) + ) + return(df) +} + +test_that("Factors with more than two levels work", { + set.seed(1) + df <- get_fac_df() + + options <- jaspTools::analysisOptions("ClassicProcess") + options$dependent <- "contNormal" + options$covariates <- list("contcor1") + options$factors <- list("facThree") + options$statisticalPathPlotsCovariances <- TRUE + options$statisticalPathPlotsResidualVariances <- TRUE + options$errorCalculationMethod <- "standard" + 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 = "facThree", processType = "moderators", + processVariable = "contcor1")), residualCovariances = TRUE, + statisticalPathPlot = TRUE, totalEffects = TRUE, localTests = FALSE, + localTestType = "cis", localTestBootstrap = FALSE, localTestBootstrapSamples = 1000)) + set.seed(1) + results <- jaspTools::runAnalysis("ClassicProcess", df, options) + + table <- results[["results"]][["modelSummaryTable"]][["data"]] + jaspTools::expect_equal_tables(table, + list(738.631697493269, 780.314420469079, 6, "Model 1", 100, -353.315848746635, + 2)) + + table <- results[["results"]][["parEstContainer"]][["collection"]][["parEstContainer_Model 1"]][["collection"]][["parEstContainer_Model 1_covariancesTable"]][["data"]] + jaspTools::expect_equal_tables(table, + list(-0.18855287140525, -0.093047091209467, -0.140799981307359, "facThreeC", + "", 7.51558348888182e-09, "facThreeB", 0.0243641671349884, + -5.7789778130836, -0.0429566774419793, 0.137322520212358, 0.0471829213851896, + "contcor1", "", 0.304925061828328, "facThreeB", 0.0459904363234113, + 1.02592897909019, -0.111386692251663, 0.0439392202030715, -0.0337237360242957, + "contcor1", "", 0.394725492097922, "facThreeC", 0.0396246853717531, + -0.851078960196263, 0.166537554341246, 0.294262457180447, 0.230400005760847, + "facThreeB", "", 1.53743684450092e-12, "facThreeB", + 0.0325834821064772, 7.0710676350655, 0.124035773561631, 0.219164194184828, + 0.17159998387323, "facThreeC", "", 1.53743684450092e-12, + "facThreeC", 0.0242679001689719, 7.0710684763996, 0.656578232571939, + 1.1601372201591, 0.90835772636552, "contcor1", "", + 1.53743684450092e-12, "contcor1", 0.128461285911162, 7.07106207074478, + 0.562065668856282, 0.993138292339328, 0.777601980597805, "contNormal", + "", 1.53743684450092e-12, "contNormal", 0.109969526706432, + 7.07106781202798)) + + table <- results[["results"]][["parEstContainer"]][["collection"]][["parEstContainer_Model 1"]][["collection"]][["parEstContainer_Model 1_mediationEffectsTable"]][["data"]] + jaspTools::expect_equal_tables(table, + list(-0.830256392676731, 0.671610737591095, 16, -0.0793228275428182, + "facThreeB", "contNormal", "", 0.835982155918959, 0.383136410187729, + -0.207035472050155, -0.419840075271681, 0.605570327467686, 50, + 0.0928651260980023, "facThreeB", "contNormal", "", + 0.722586733024018, 0.261589093174077, 0.355003815224835, -0.539700679220641, + 1.2482888689735, 84, 0.354294094876428, "facThreeB", "contNormal", + "", 0.437310753173408, 0.456128164164641, 0.776742421782455 + )) + + table <- results[["results"]][["parEstContainer"]][["collection"]][["parEstContainer_Model 1"]][["collection"]][["parEstContainer_Model 1_pathCoefficientsTable"]][["data"]] + jaspTools::expect_equal_tables(table, + list(-0.384277115427941, 0.649582479358737, 0.132652681965398, "facThreeB", + "", 0.61499311862582, "contNormal", 0.263744538915416, + 0.502958971248843, -0.36868442105099, 0.835431543005484, 0.233373560977247, + "facThreeC", "", 0.44741374451908, "contNormal", 0.307178084279708, + 0.759733760058037, -0.772565531217873, 0.487083275478801, -0.142741127869536, + "contcor1", "", 0.656898600865411, "contNormal", 0.321344886087863, + -0.444199158129772, -0.440651907510927, 0.890228809967378, 0.224788451228225, + "facThreeB:contcor1", "", 0.507917529817297, "contNormal", + 0.339516625809485, 0.662083780705226, -0.838061139155147, 0.667651322062499, + -0.0852049085463242, "facThreeC:contcor1", "", 0.824454027131575, + "contNormal", 0.384117379986192, -0.22181997739698)) + + table <- results[["results"]][["parEstContainer"]][["collection"]][["parEstContainer_Model 1"]][["collection"]][["parEstContainer_Model 1_totalEffectsTable"]][["data"]] + jaspTools::expect_equal_tables(table, + list(-0.830256392676731, 0.671610737591095, 16, -0.0793228275428182, + "Total", 0.835982155918959, 0.383136410187729, -0.207035472050155, + -0.419840075271681, 0.605570327467686, 50, 0.0928651260980023, + "Total", 0.722586733024018, 0.261589093174077, 0.355003815224835, + -0.539700679220641, 1.2482888689735, 84, 0.354294094876428, + "Total", 0.437310753173408, 0.456128164164641, 0.776742421782455 + )) + + plotName <- results[["results"]][["pathPlotContainer"]][["collection"]][["pathPlotContainer_Model 1"]][["collection"]][["pathPlotContainer_Model 1_conceptPathPlot"]][["data"]] + testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] + jaspTools::expect_equal_plots(testPlot, "conceptual-path-plot-facThree") + + plotName <- results[["results"]][["pathPlotContainer"]][["collection"]][["pathPlotContainer_Model 1"]][["collection"]][["pathPlotContainer_Model 1_statPathPlot"]][["data"]] + testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] + jaspTools::expect_equal_plots(testPlot, "statistical-path-plot-facThree") +}) + +test_that("Interactions between three-level and two-level factors work", { + set.seed(1) + df <- get_fac_df() + + options <- jaspTools::analysisOptions("ClassicProcess") + options$dependent <- "contNormal" + options$covariates <- list("contcor1") + options$factors <- list("facTwo", "facThree") + options$statisticalPathPlotsCovariances <- TRUE + options$statisticalPathPlotsResidualVariances <- TRUE + options$errorCalculationMethod <- "standard" + 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 = "facThree", processType = "moderators", + processVariable = "facTwo")), residualCovariances = TRUE, + statisticalPathPlot = TRUE, totalEffects = TRUE, localTests = FALSE, + localTestType = "cis", localTestBootstrap = FALSE, localTestBootstrapSamples = 1000)) + set.seed(1) + results <- jaspTools::runAnalysis("ClassicProcess", df, options) + + table <- results[["results"]][["modelSummaryTable"]][["data"]] + jaspTools::expect_equal_tables(table, + list(607.798723015161, 649.48144599097, 6, "Model 1", 100, -287.89936150758, + 2)) + + table <- results[["results"]][["parEstContainer"]][["collection"]][["parEstContainer_Model 1"]][["collection"]][["parEstContainer_Model 1_covariancesTable"]][["data"]] + jaspTools::expect_equal_tables(table, + list(-0.188552899318699, -0.0930470981392201, -0.140799998728959, "facThreeC", + "", 7.51560835787757e-09, "facThreeB", 0.0243641724880702, + -5.77897725842736, -0.0625879470174146, 0.0313879697933625, + -0.015599988612026, "facTwoE", "", 0.515235336014761, + "facThreeB", 0.0239738886918451, -0.650707476477626, -0.00972474511250287, + 0.0721247068049682, 0.0311999808462327, "facTwoE", "", + 0.135116244943659, "facThreeC", 0.0208803459051006, 1.49422720236695, + 0.166537561194698, 0.294262481084964, 0.230400021139831, "facThreeB", + "", 1.53743684450092e-12, "facThreeB", 0.0325834864563185, + 7.07106716307678, 0.124035784194595, 0.219164231272074, 0.171600007733335, + "facThreeC", "", 1.53743684450092e-12, "facThreeC", + 0.0242679069176374, 7.07106749320103, 0.179548301980595, 0.317251715854165, + 0.24840000891738, "facTwoE", "", 1.53743684450092e-12, + "facTwoE", 0.0351290674113803, 7.0710675580562, 0.564294089241247, + 0.99707578530309, 0.780684937272169, "contNormal", "", + 1.53743684450092e-12, "contNormal", 0.110405522620714, 7.0710678120163 + )) + + table <- results[["results"]][["parEstContainer"]][["collection"]][["parEstContainer_Model 1"]][["collection"]][["parEstContainer_Model 1_mediationEffectsTable"]][["data"]] + jaspTools::expect_equal_tables(table, + list(-0.79179509702597, 0.581685251376472, -0.105054922824749, 0, "facThreeB", + "contNormal", "", 0.76430843174253, 0.350384078288244, + -0.299827901250483, -0.346979683280772, 1.19016835503621, 0.421594335877721, + 1, "facThreeB", "contNormal", "", 0.282320764613395, + 0.39213680721733, 1.07512053986828)) + + table <- results[["results"]][["parEstContainer"]][["collection"]][["parEstContainer_Model 1"]][["collection"]][["parEstContainer_Model 1_pathCoefficientsTable"]][["data"]] + jaspTools::expect_equal_tables(table, + list(-0.79179509702597, 0.581685251376472, -0.105054922824749, "facThreeB", + "", 0.76430843174253, "contNormal", 0.350384078288244, + -0.299827901250483, -0.835536962301828, 0.956997866716982, 0.0607304522075771, + "facThreeC", "", 0.894346977764828, "contNormal", 0.457287695885765, + 0.132805786715827, -1.5098265891821, 0.360680618984523, -0.574572985098788, + "facTwoE", "", 0.228549486740747, "contNormal", 0.477178974440588, + -1.20410373439521, -0.504038904791374, 1.55733742219631, 0.52664925870247, + "facThreeB:facTwoE", "", 0.31659480567209, "contNormal", + 0.525870970907517, 1.00147999763822, -0.723522417690523, 1.72846022588973, + 0.502468904099602, "facThreeC:facTwoE", "", 0.421809782363961, + "contNormal", 0.625517270450166, 0.803285421261016)) + + table <- results[["results"]][["parEstContainer"]][["collection"]][["parEstContainer_Model 1"]][["collection"]][["parEstContainer_Model 1_totalEffectsTable"]][["data"]] + jaspTools::expect_equal_tables(table, + list(-0.79179509702597, 0.581685251376472, -0.105054922824749, 0, "Total", + 0.76430843174253, 0.350384078288244, -0.299827901250483, -0.346979683280772, + 1.19016835503621, 0.421594335877721, 1, "Total", 0.282320764613395, + 0.39213680721733, 1.07512053986828)) + + plotName <- results[["results"]][["pathPlotContainer"]][["collection"]][["pathPlotContainer_Model 1"]][["collection"]][["pathPlotContainer_Model 1_conceptPathPlot"]][["data"]] + testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] + jaspTools::expect_equal_plots(testPlot, "conceptual-path-plot-facThree-int-facTwo") + + plotName <- results[["results"]][["pathPlotContainer"]][["collection"]][["pathPlotContainer_Model 1"]][["collection"]][["pathPlotContainer_Model 1_statPathPlot"]][["data"]] + testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] + jaspTools::expect_equal_plots(testPlot, "statistical-path-plot-facThree-int-facTwo") +}) + +test_that("Interactions between two-level and three-level factors work", { + set.seed(1) + df <- get_fac_df() + options <- jaspTools::analysisOptions("ClassicProcess") + options$dependent <- "contNormal" + options$covariates <- list("contcor1") + options$factors <- list("facTwo", "facThree") + options$statisticalPathPlotsCovariances <- TRUE + options$statisticalPathPlotsResidualVariances <- TRUE + options$errorCalculationMethod <- "standard" + 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 = "facTwo", processType = "moderators", + processVariable = "facThree")), residualCovariances = TRUE, + statisticalPathPlot = TRUE, totalEffects = TRUE, localTests = FALSE, + localTestType = "cis", localTestBootstrap = FALSE, localTestBootstrapSamples = 1000)) + set.seed(1) + results <- jaspTools::runAnalysis("ClassicProcess", df, options) + + table <- results[["results"]][["modelSummaryTable"]][["data"]] + jaspTools::expect_equal_tables(table, + list(607.798723015161, 649.48144599097, 6, "Model 1", 100, -287.89936150758, + 2)) + + table <- results[["results"]][["parEstContainer"]][["collection"]][["parEstContainer_Model 1"]][["collection"]][["parEstContainer_Model 1_covariancesTable"]][["data"]] + jaspTools::expect_equal_tables(table, + list(-0.0625879470174092, 0.0313879697933571, -0.015599988612026, "facThreeB", + "", 0.515235336014713, "facTwoE", 0.0239738886918424, + -0.650707476477701, -0.00972474511269001, 0.0721247068051553, + 0.0311999808462326, "facThreeC", "", 0.135116244945445, + "facTwoE", 0.020880345905196, 1.49422720236012, -0.188552899318718, + -0.0930470981392011, -0.140799998728959, "facThreeC", "", + 7.51560835787757e-09, "facThreeB", 0.0243641724880799, -5.77897725842506, + 0.17954830198084, 0.317251715853921, 0.24840000891738, "facTwoE", + "", 1.53743684450092e-12, "facTwoE", 0.0351290674112554, + 7.07106755808134, 0.16653756119465, 0.294262481085012, 0.230400021139831, + "facThreeB", "", 1.53743684450092e-12, "facThreeB", + 0.0325834864563429, 7.07106716307149, 0.124035784194594, 0.219164231272075, + 0.171600007733335, "facThreeC", "", 1.53743684450092e-12, + "facThreeC", 0.024267906917638, 7.07106749320088, 0.564294089243091, + 0.997075785301246, 0.780684937272169, "contNormal", "", + 1.53743684450092e-12, "contNormal", 0.110405522619773, 7.07106781207657 + )) + + table <- results[["results"]][["parEstContainer"]][["collection"]][["parEstContainer_Model 1"]][["collection"]][["parEstContainer_Model 1_mediationEffectsTable"]][["data"]] + jaspTools::expect_equal_tables(table, + list(-1.50982658901334, 0.360680618815769, -0.574572985098788, 0, 0, + "facTwoE", "contNormal", "", 0.228549486656783, 0.477178974354487, + -1.20410373461247, -0.481073569262345, 0.385226116469709, -0.0479237263963183, + 1, 0, "facTwoE", "contNormal", "", 0.828324822977639, + 0.220998878695046, -0.216850540958842, -1.50982658901334, 0.360680618815769, + -0.574572985098788, 0, 0, "facTwoE", "contNormal", "", + 0.228549486656783, 0.477178974354487, -1.20410373461247, -1.50982658901334, + 0.360680618815769, -0.574572985098788, 0, 0, "facTwoE", "contNormal", + "", 0.228549486656783, 0.477178974354487, -1.20410373461247, + -0.481073569262345, 0.385226116469709, -0.0479237263963183, + 1, 0, "facTwoE", "contNormal", "", 0.828324822977639, + 0.220998878695046, -0.216850540958842, -1.50982658901334, 0.360680618815769, + -0.574572985098788, 0, 0, "facTwoE", "contNormal", "", + 0.228549486656783, 0.477178974354487, -1.20410373461247, -0.864792807812527, + 0.720584645814155, -0.0721040809991859, 0, 1, "facTwoE", "contNormal", + "", 0.858502237173678, 0.404440455572637, -0.178281079465939, + -0.845713837967434, 1.754804193374, 0.454545177703284, 1, 1, + "facTwoE", "contNormal", "", 0.493239705610856, 0.663409647282805, + 0.685165160870077, -0.864792807812527, 0.720584645814155, -0.0721040809991859, + 0, 1, "facTwoE", "contNormal", "", 0.858502237173678, + 0.404440455572637, -0.178281079465939)) + + table <- results[["results"]][["parEstContainer"]][["collection"]][["parEstContainer_Model 1"]][["collection"]][["parEstContainer_Model 1_pathCoefficientsTable"]][["data"]] + jaspTools::expect_equal_tables(table, + list(-1.50982658901334, 0.360680618815769, -0.574572985098788, "facTwoE", + "", 0.228549486656783, "contNormal", 0.477178974354487, + -1.20410373461247, -0.791795097032169, 0.581685251382671, -0.105054922824749, + "facThreeB", "", 0.764308431744595, "contNormal", 0.350384078291407, + -0.299827901247776, -0.835536962619522, 0.956997867034676, 0.0607304522075774, + "facThreeC", "", 0.894346977802058, "contNormal", 0.457287696047857, + 0.132805786668753, -0.504038904576221, 1.55733742198116, 0.526649258702469, + "facTwoE:facThreeB", "", 0.316594805571069, "contNormal", + 0.525870970797743, 1.00147999784728, -0.723522417887957, 1.72846022608716, + 0.502468904099602, "facTwoE:facThreeC", "", 0.421809782438714, + "contNormal", 0.625517270550899, 0.803285421131654)) + + table <- results[["results"]][["parEstContainer"]][["collection"]][["parEstContainer_Model 1"]][["collection"]][["parEstContainer_Model 1_totalEffectsTable"]][["data"]] + jaspTools::expect_equal_tables(table, + list(-1.50982658901334, 0.360680618815769, -0.574572985098788, 0, 0, + "Total", 0.228549486656783, 0.477178974354487, -1.20410373461247, + -0.481073569262345, 0.385226116469709, -0.0479237263963183, + 1, 0, "Total", 0.828324822977639, 0.220998878695046, -0.216850540958842, + -1.50982658901334, 0.360680618815769, -0.574572985098788, 0, + 0, "Total", 0.228549486656783, 0.477178974354487, -1.20410373461247, + -1.50982658901334, 0.360680618815769, -0.574572985098788, 0, + 0, "Total", 0.228549486656783, 0.477178974354487, -1.20410373461247, + -0.481073569262345, 0.385226116469709, -0.0479237263963183, + 1, 0, "Total", 0.828324822977639, 0.220998878695046, -0.216850540958842, + -1.50982658901334, 0.360680618815769, -0.574572985098788, 0, + 0, "Total", 0.228549486656783, 0.477178974354487, -1.20410373461247, + -0.864792807812527, 0.720584645814155, -0.0721040809991859, + 0, 1, "Total", 0.858502237173678, 0.404440455572637, -0.178281079465939, + -0.845713837967434, 1.754804193374, 0.454545177703284, 1, 1, + "Total", 0.493239705610856, 0.663409647282805, 0.685165160870077, + -0.864792807812527, 0.720584645814155, -0.0721040809991859, + 0, 1, "Total", 0.858502237173678, 0.404440455572637, -0.178281079465939 + )) + + plotName <- results[["results"]][["pathPlotContainer"]][["collection"]][["pathPlotContainer_Model 1"]][["collection"]][["pathPlotContainer_Model 1_conceptPathPlot"]][["data"]] + testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] + jaspTools::expect_equal_plots(testPlot, "conceptual-path-plot-facTwo-int-facThree") + + plotName <- results[["results"]][["pathPlotContainer"]][["collection"]][["pathPlotContainer_Model 1"]][["collection"]][["pathPlotContainer_Model 1_statPathPlot"]][["data"]] + testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] + jaspTools::expect_equal_plots(testPlot, "statistical-path-plot-facTwo-int-facThree") +})