From 483064dbc9656be8e9941d71f5d2814a147ebfdc Mon Sep 17 00:00:00 2001 From: maltelueken Date: Wed, 20 Sep 2023 10:37:00 +0200 Subject: [PATCH] Rename `.HardCodedModels` to `.procGetHardCodedModel` and `Hmodels` to `.procHardcodedModelNumbers` --- R/HardCodedModels.R | 11 ++++++++++- R/classicProcess.R | 24 +++++++----------------- 2 files changed, 17 insertions(+), 18 deletions(-) diff --git a/R/HardCodedModels.R b/R/HardCodedModels.R index 4562252..a1484f2 100644 --- a/R/HardCodedModels.R +++ b/R/HardCodedModels.R @@ -15,7 +15,16 @@ # along with this program. If not, see . # -.HardCodedModels <- function(number, k) { +# Existing Hayes models +.procHardCodedModelNumbers <- function() { + return(c( + 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18, + 21,22,28,29,58,59,60,61,62,63,64,65,66,67,68,70, + 72,75,76,80,81,82,83,84,85,86,87,88,89,90,91,92 + )) +} + +.procGetHardCodedModel <- function(number, k) { # k = number of mediators diff --git a/R/classicProcess.R b/R/classicProcess.R index 4a2b823..70cf104 100644 --- a/R/classicProcess.R +++ b/R/classicProcess.R @@ -140,16 +140,12 @@ ClassicProcess <- function(jaspResults, dataset = NULL, options) { } .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, - # 71,72,73,75,76,80,81,82,83,84,85,86,87,88,89,90,91,92) processRelationships <- switch(modelOptions[["inputType"]], inputVariables = modelOptions[["processRelationships"]], # 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"]], length(modelOptions[["modelNumberMediators"]])) + inputModelNumber = .procGetHardCodedModel(modelOptions[["modelNumber"]], length(modelOptions[["modelNumberMediators"]])) ) ## TODO: Models involving moderated moderation 19,20,69,71,73 @@ -417,15 +413,15 @@ ClassicProcess <- function(jaspResults, dataset = NULL, options) { .procIsModelNumberGraph <- function(modelNumber, graph, modelOptions, globalDependent) { # Create regList from hard-coded model - regList <- .procProcessRelationshipsToRegList(.HardCodedModels(modelNumber, length(modelOptions[["modelNumberMediators"]]))) - + regList <- .procProcessRelationshipsToRegList(.procGetHardCodedModel(modelNumber, length(modelOptions[["modelNumberMediators"]]))) + # Replace dummy variables in regList regList <- .procRegListInputModelNumber(regList, modelOptions, globalDependent) # Convert hard-coded regList to graph modelNumberGraph <- .procRegListToGraph(regList) # Check if user graph and hard-coded graph are identical (except for order of vertices) isIdentical <- igraph::identical_graphs(modelNumberGraph, graph) - + return(isIdentical) } @@ -433,12 +429,6 @@ ClassicProcess <- function(jaspResults, dataset = NULL, options) { # Create graph from regList specified by user graphM <- .procRegListToGraph(regList) - # Hayes models currently specified in HardCodedModels - Hmodels <- c(1,2,4,5,6,7,8,9,10,14,15,16,17, - 21,22,28,29,58,59,60,61,62,63, - 64,65,66,67,75,76,80,81,82,83, - 84,85,86,87,88,89,90,91,92) - # Get global dependent variable isDep <- sapply(regList, function(row) row$dep) globalDependent <- names(regList)[isDep] @@ -467,17 +457,17 @@ ClassicProcess <- function(jaspResults, dataset = NULL, options) { ) # Check which hard-coded model matches user model - modelMatch <- sapply(Hmodels, .procIsModelNumberGraph, graph = graphM, modelOptions = modelOptions, globalDependent = globalDependent) + modelMatch <- sapply(.procHardCodedModelNumbers(), .procIsModelNumberGraph, graph = graphM, modelOptions = modelOptions, globalDependent = globalDependent) # If no match swap W and Z and check again if (!any(modelMatch)) { modelOptions[["modelNumberModeratorW"]] <- modZ modelOptions[["modelNumberModeratorZ"]] <- modW - modelMatch <- sapply(Hmodels, .procIsModelNumberGraph, graph = graphM, modelOptions = modelOptions, globalDependent = globalDependent) + modelMatch <- sapply(.procHardCodedModelNumbers(), .procIsModelNumberGraph, graph = graphM, modelOptions = modelOptions, globalDependent = globalDependent) } - return(Hmodels[modelMatch]) + return(.procHardCodedModelNumbers()[modelMatch]) } .procAddLavModVar <- function(regList, dependent, variable) {