diff --git a/R/HardCodedModels.R b/R/HardCodedModels.R index 07fc744..930e424 100644 --- a/R/HardCodedModels.R +++ b/R/HardCodedModels.R @@ -15,10 +15,11 @@ # along with this program. If not, see . # -.HardCodedModels <- function(number) { +.HardCodedModels <- function(number, k) { + + # k = number of mediators ## TODO: Models involving moderated moderation 19,20,69,71,73 - ## TODO: Models involving flexible amount of mediators 6,80,81 if (number == 1) { processRelationships <- list( @@ -94,26 +95,7 @@ } if (number == 6) { - processRelationships <- list( - list( - processDependent = "Y", - processIndependent = "X", - processType = "mediators", - processVariable = "M1" - ), - list( - processDependent = "Y", - processIndependent = "X", - processType = "mediators", - processVariable = "M2" - ), - list( - processDependent = "Y", - processIndependent = "M1", - processType = "mediators", - processVariable = "M2" - ) - ) + processRelationships <- .generateProcessRelationships_6(k) } if (number == 7) { @@ -966,6 +948,8 @@ ) } + # Enable once multiple moderated moderation is working + # # if (number == 69) { # processRelationships <- list( # list( @@ -1154,85 +1138,11 @@ } if (number == 80) { - processRelationships <- list( - list( - processDependent = "Y", - processIndependent = "X", - processType = "mediators", - processVariable = "M1" - ), - list( - processDependent = "Y", - processIndependent = "X", - processType = "mediators", - processVariable = "Mk" - ), - list( - processDependent = "Mk", - processIndependent = "X", - processType = "mediators", - processVariable = "M1" - ), - list( - processDependent = "Mk", - processIndependent = "X", - processType = "mediators", - processVariable = "Mk-1" - ), - list( - processDependent = "Y", - processIndependent = "M1", - processType = "mediators", - processVariable = "Mk" - ), - list( - processDependent = "Y", - processIndependent = "Mk-1", - processType = "mediators", - processVariable = "Mk" - ) - ) + processRelationships <- .generateProcessRelationships_80(k) } if (number == 81) { - processRelationships <- list( - list( - processDependent = "Y", - processIndependent = "X", - processType = "mediators", - processVariable = "M1" - ), - list( - processDependent = "Y", - processIndependent = "X", - processType = "mediators", - processVariable = "Mk" - ), - list( - processDependent = "M2", - processIndependent = "X", - processType = "mediators", - processVariable = "M1" - ), - list( - processDependent = "Mk", - processIndependent = "X", - processType = "mediators", - processVariable = "M1" - ), - list( - processDependent = "Y", - processIndependent = "M1", - processType = "mediators", - processVariable = "M2" - ), - list( - processDependent = "Y", - processIndependent = "M1", - processType = "mediators", - processVariable = "Mk" - ) - ) + processRelationships <- .generateProcessRelationships_81(k) } if (number == 82) { @@ -1681,3 +1591,138 @@ } return(varNames) } + +# model 6 +.generateProcessRelationships_6 <- function(k) { + + processRelationships <- list() + + if (k >= 3) { + for (i in 1:(k - 2)) { + for (j in (i + 1):(k - 1)) { + for (k in (j + 1):k) { + path <- list( + processDependent = paste("M", k, sep = ""), + processIndependent = paste("M", i, sep = ""), + processType = "mediators", + processVariable = paste("M", j, sep = "") + ) + processRelationships <- append(processRelationships, list(path)) + } + } + } + } + + if (k >= 2) { + for (i in 1:(k - 1)) { + for (j in (i + 1):k) { + path <- list( + processDependent = "Y", + processIndependent = paste("M", i, sep = ""), + processType = "mediators", + processVariable = paste("M", j, sep = "") + ) + processRelationships <- append(processRelationships, list(path)) + } + } + } + + if (k >= 1) { + for (i in 1:k) { + path <- list( + processDependent = "Y", + processIndependent = "X", + processType = "mediators", + processVariable = paste("M", i, sep = "") + ) + processRelationships <- append(processRelationships, list(path)) + } + } + + return(processRelationships) +} + +# model 80 +.generateProcessRelationships_80 <- function(k) { + + processRelationships <- list() + + if (k >= 2) { + for (i in 1:(k)) { + + path1 <- list( + processDependent = "Y", + processIndependent = "X", + processType = "mediators", + processVariable = paste("M", i, sep = "") + ) + + processRelationships <- append(processRelationships, list(path1)) + } + } + + for (i in 1:k) { + for (j in 1:k) { + if (i != j && i < j && j == k ) { + path2 <- list( + processDependent = paste("M", j, sep = ""), + processIndependent = "X", + processType = "mediators", + processVariable = paste("M", i, sep = "") + ) + path3 <- list( + processDependent = "Y", + processIndependent = paste("M", i, sep = ""), + processType = "mediators", + processVariable = paste("M", j, sep = "") + ) + processRelationships <- append(processRelationships, list(path2,path3)) + } + } + } + + return(processRelationships) +} + + +# model 81 +.generateProcessRelationships_81 <- function(k) { + + processRelationships <- list() + + if (k >= 2) { + for (i in 1:(k)) { + + path1 <- list( + processDependent = "Y", + processIndependent = "X", + processType = "mediators", + processVariable = paste("M", i, sep = "") + ) + + processRelationships <- append(processRelationships, list(path1)) + } + } + + for (i in 1:k) { + + if (i > 1 ) { + path2 <- list( + processDependent = paste("M", i, sep = ""), + processIndependent = "X", + processType = "mediators", + processVariable = paste("M1", sep = "") + ) + path3 <- list( + processDependent = "Y", + processIndependent = paste("M1", sep = ""), + processType = "mediators", + processVariable = paste("M", i, sep = "") + ) + processRelationships <- append(processRelationships, list(path2,path3)) + } + + } + + return(processRelationships) +} diff --git a/R/classicProcess.R b/R/classicProcess.R index 22c8dc8..8e3df26 100644 --- a/R/classicProcess.R +++ b/R/classicProcess.R @@ -126,7 +126,7 @@ ClassicProcess <- function(jaspResults, dataset = NULL, options) { for (i in 1:length(options[["processModels"]])) { modelOptions <- options[["processModels"]][[i]] modelName <- modelOptions[["name"]] - + if (is.null(modelsContainer[[modelName]][["regList"]])) { regList <- .procModelRegListSingleModel(options[["processModels"]][[i]], globalDependent = options[["dependent"]]) state <- createJaspState(object = regList) @@ -139,7 +139,7 @@ ClassicProcess <- function(jaspResults, dataset = NULL, options) { } } -.procModelRegListSingleModel <- function(modelOptions, globalDependent) { +.procModelRegListSingleModel <- function(modelOptions, globalDependent,options) { # Existing Hayes models # Hmodels <- c(1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20, # 21,22,28,29,58,59,60,61,62,63,64,65,66,67,68,69,70, @@ -149,7 +149,8 @@ ClassicProcess <- function(jaspResults, dataset = NULL, options) { # Insert function for plotting conceptual hard-coded Hayes model, in case # no estimation takes place yet (because of not having filled in all necessary # variables) - inputModelNumber = .HardCodedModels(modelOptions[["modelNumber"]]) + #inputModelNumber = .HardCodedModels(modelOptions[["modelNumber"]]) + inputModelNumber = .HardCodedModels(modelOptions[["modelNumber"]], length(modelOptions[["modelNumberMediators"]])) ) ## TODO: Models involving moderated moderation 3,11,12,13,18,19,20,68,69,70,71,72,73 ## TODO: Models involving flexible amount of mediators 6,80,81 @@ -220,7 +221,7 @@ ClassicProcess <- function(jaspResults, dataset = NULL, options) { # Split path interactions pathVarsSplit <- strsplit(pathVars, ":|__") # split according to `:` or `__` isThreeWayInt <- grepl("__", pathVars) - + # Replace dummy vars for each term of interactions separately pathVarsSplit <- lapply(pathVarsSplit, .procReplaceDummyVars, modelOptions = modelOptions, globalDependent = globalDependent) @@ -302,7 +303,7 @@ ClassicProcess <- function(jaspResults, dataset = NULL, options) { for (i in 1:length(options[["processModels"]])) { modelOptions <- options[["processModels"]][[i]] modelName <- modelOptions[["name"]] - + if (is.null(modelsContainer[[modelName]][["syntax"]])) { syntax <- .procModelSyntaxSingleModel(modelsContainer[[modelName]], modelOptions) state <- createJaspState(object = syntax) @@ -542,10 +543,10 @@ ClassicProcess <- function(jaspResults, dataset = NULL, options) { } if (type == "moderators") { - # This routine adds three-way interactions (moderated moderation) + # This routine adds three-way interactions (moderated moderation) # which are not available in standard lavaan syntax. These interactions # are represented as separate variables which are products of the three interacting variables. - # The names of these variables are the interacting variable names separated by + # The names of these variables are the interacting variable names separated by # double underscores, e.g.: var1__var2__var3 # Get all existing interaction terms @@ -749,7 +750,7 @@ ClassicProcess <- function(jaspResults, dataset = NULL, options) { if ((length(exoVars) - length(intIdx)) > 1 && includeExo) { exoIdxMat <- which(upper.tri(diag(length(exoVars))), arr.ind = TRUE) exoIdxMat <- exoIdxMat[!exoIdxMat[, 1] %in% intIdx & !exoIdxMat[, 2] %in% intIdx, , drop = FALSE] - + for (i in 1:nrow(exoIdxMat)) { if (!exoVars[exoIdxMat[i, 2]] %in% regList[[exoVars[exoIdxMat[i, 1]]]][["vars"]]) { resCovList[[exoVars[exoIdxMat[i, 1]]]] <- c(resCovList[[exoVars[exoIdxMat[i, 1]]]], exoVars[exoIdxMat[i, 2]]) @@ -879,7 +880,7 @@ ClassicProcess <- function(jaspResults, dataset = NULL, options) { .procResultsFitModel <- function(container, dataset, options) { # Should model be fitted? doFit <- .procCheckFitModel(container[["regList"]]$object) - + if (!doFit) dataset <- NULL @@ -1301,17 +1302,17 @@ ClassicProcess <- function(jaspResults, dataset = NULL, options) { if (!procResults@Fit@converged) { medEffectsTable$addFootnote(gettext("Model did not converge.")) } - + medEffects <- pathCoefs[pathCoefs$op == ":=",] labelSplit <- lapply(strsplit(medEffects$lhs, "\\."), strsplit, split = "__") - + # Only use label splits of length > 1 to omit total effects labelSplit <- labelSplit[sapply(labelSplit, function(path) length(path[[1]])) > 1] - + # Get paths from label of mediation effect medPaths <- lapply(labelSplit, function(path) path[[1]]) - + # Get path lengths medPathLengths <- sapply(medPaths, length) @@ -1726,7 +1727,7 @@ ClassicProcess <- function(jaspResults, dataset = NULL, options) { # Iterate over moderators leaving out the first and last element (independent and dependent variables) for (i in 1:(length(path)-2)) { - # Only add moderators (at index i+1 in path) that are not in the layout yet + # Only add moderators (at index i+1 in path) that are not in the layout yet if (!path[i+1] %in% nodeNames) { # Get index of independent and dependent node in layout # Independent node is at index i and dependent is the last element in path @@ -1817,7 +1818,7 @@ ClassicProcess <- function(jaspResults, dataset = NULL, options) { # This function prunes moderator paths # It finds the longest path and removes all paths that are a subset of this path # leaving longest unique paths - + # Find longest moderator path longestPathIdx <- which.max(sapply(paths, length)) @@ -1826,7 +1827,7 @@ ClassicProcess <- function(jaspResults, dataset = NULL, options) { # Check which other paths are a subset of longest path allVarsInLongestPath <- sapply(paths[-longestPathIdx], function(path) all(path %in% paths[[longestPathIdx]])) - + # If all are a subset, return only longest paths if (all(allVarsInLongestPath)) return(prunedPaths) @@ -1908,10 +1909,10 @@ ClassicProcess <- function(jaspResults, dataset = NULL, options) { # Paths from moderator and interaction term to dep var node modPaths <- paths[isIntPath | paths[, 1] %in% mods, , drop = FALSE] } - + # Filter out non-moderation paths -> main paths mainPaths <- paths[!isIntPath & !paths[, 1] %in% mods[!mods %in% paths[, 2]], , drop = FALSE] - + # Get layout of main paths: matrix with x,y coordinates for each node layout <- .procMainGraphLayout(mainPaths[, 1:2, drop = FALSE], options[["dependent"]]) @@ -1920,7 +1921,7 @@ ClassicProcess <- function(jaspResults, dataset = NULL, options) { # Remove duplicate paths mainPaths <- mainPaths[!duplicated(mainPaths), ] - + # Add layout of moderator nodes if (length(mods) > 0) { # Add dependent variable to end of each moderator path