Add error message for not implemented model numbers

jasp-stats · Sep 20, 2023 · 20f1e22 · 20f1e22
1 parent 5a37ef8
commit 20f1e22
Show file tree

Hide file tree

Showing 2 changed files with 32 additions and 10 deletions.
diff --git a/R/HardCodedModels.R b/R/HardCodedModels.R
@@ -30,6 +30,8 @@
 
   ## TODO: Models involving moderated moderation 19,20,69,71,73
 
+  processRelationships <- NULL
+
   if (number == 1) {
     processRelationships <- list(
       list(
@@ -1703,5 +1705,7 @@
     }
   }
 
+  stopifnot(!is.null(processRelationships))
+
   return(processRelationships)
 }
diff --git a/R/classicProcess.R b/R/classicProcess.R
@@ -128,7 +128,7 @@ ClassicProcess <- function(jaspResults, dataset = NULL, options) {
     modelName <- modelOptions[["name"]]
 
     if (is.null(modelsContainer[[modelName]][["regList"]])) {
-      regList <- .procModelRegListSingleModel(options[["processModels"]][[i]], globalDependent = options[["dependent"]])
+      regList <- try(.procModelRegListSingleModel(options[["processModels"]][[i]], globalDependent = options[["dependent"]]))
       state <- createJaspState(object = regList)
       state$dependOn(
         optionContainsValue = list(processModels = modelOptions),
@@ -139,7 +139,7 @@ ClassicProcess <- function(jaspResults, dataset = NULL, options) {
   }
 }
 
-.procModelRegListSingleModel <- function(modelOptions, globalDependent,options) {
+.procModelRegListSingleModel <- function(modelOptions, globalDependent, options) {
   processRelationships <- switch(modelOptions[["inputType"]],
     inputVariables = modelOptions[["processRelationships"]],
     # Insert function for plotting conceptual hard-coded Hayes model, in case
@@ -275,6 +275,8 @@ ClassicProcess <- function(jaspResults, dataset = NULL, options) {
     modelOptions <- options[["processModels"]][[i]]
     modelName <- modelOptions[["name"]]
 
+    if (inherits(modelsContainer[[modelName]][["regList"]]$object, "try-error")) next
+
     if (is.null(modelsContainer[[modelName]][["modProbes"]])) {
       modProbes <- .procModProbesSingleModel(modelsContainer[[modelName]], dataset, options)
       state <- createJaspState(object = modProbes)
@@ -335,6 +337,8 @@ ClassicProcess <- function(jaspResults, dataset = NULL, options) {
     modelOptions <- options[["processModels"]][[i]]
     modelName <- modelOptions[["name"]]
 
+    if (inherits(modelsContainer[[modelName]][["regList"]]$object, "try-error")) next
+
     if (is.null(modelsContainer[[modelName]][["syntax"]])) {
       syntax <- .procModelSyntaxSingleModel(modelsContainer[[modelName]], modelOptions)
       state <- createJaspState(object = syntax)
@@ -413,7 +417,9 @@ ClassicProcess <- function(jaspResults, dataset = NULL, options) {
 
 .procIsModelNumberGraph <- function(modelNumber, graph, modelOptions, globalDependent) {
   # Create regList from hard-coded model
-  regList <- .procProcessRelationshipsToRegList(.procGetHardCodedModel(modelNumber, length(modelOptions[["modelNumberMediators"]])))
+  regList <- try(.procProcessRelationshipsToRegList(.procGetHardCodedModel(modelNumber, length(modelOptions[["modelNumberMediators"]]))))
+
+  if (inherits(regList, "try-error")) return(FALSE)
 
   # Replace dummy variables in regList
   regList <- .procRegListInputModelNumber(regList, modelOptions, globalDependent)
@@ -485,8 +491,11 @@ ClassicProcess <- function(jaspResults, dataset = NULL, options) {
     modelOptions <- options[["processModels"]][[i]]
     modelName <- modelOptions[["name"]]
 
+    regList <- modelsContainer[[modelName]][["regList"]]$object
+    if (inherits(regList, "try-error")) next
+
     if (is.null(modelsContainer[[modelName]][["syntax"]])) {
-      regList <- .procAddLavModParNamesSingleModel(modelsContainer[[modelName]][["regList"]]$object)
+      regList <- .procAddLavModParNamesSingleModel(regList)
       modelsContainer[[modelName]][["regList"]]$object <- regList
     }
   }
@@ -897,6 +906,7 @@ ClassicProcess <- function(jaspResults, dataset = NULL, options) {
 
 # Results functions ----
 .procCheckFitModel <- function(regList) {
+  if (inherits(regList, "try-error")) return(FALSE)
   return(all(sapply(regList, function(row) {
     varsSplit <- .strsplitColon(row$vars)
     return(all(sapply(varsSplit, .procCheckRegListVars)))
@@ -977,9 +987,9 @@ ClassicProcess <- function(jaspResults, dataset = NULL, options) {
 # Output functions ----
 .procFilterFittedModels <- function(procResults) {
   isFitted <- sapply(procResults, function(mod) {
-    if (!is.character(mod))
+    if (!is.null(mod) && !is.character(mod))
       return(mod@Options[["do.fit"]])
-    return(TRUE)
+    return(FALSE)
   })
 
   return(procResults[isFitted])
@@ -988,14 +998,22 @@ ClassicProcess <- function(jaspResults, dataset = NULL, options) {
 .procModelNumberTable <- function(jaspResults, options, modelsContainer) {
   if (!is.null(jaspResults[["modelNumberTable"]])) return()
 
-  regLists <- lapply(options[["processModels"]], function(mod) modelsContainer[[mod[["name"]]]][["regList"]]$object)
-  if (length(regLists) == 0) return()
-  modelNumbers <- sapply(regLists, .procRecognizeModelNumber)
-
   modelNumberTable <- createJaspTable(title = gettext("Model numbers"))
   modelNumberTable$dependOn(c(.procGetDependencies(), "processModels"))
   modelNumberTable$position <- 0
 
+  modelNumbers <- lapply(options[["processModels"]], function(mod) {
+      if (mod[["inputType"]] == "inputModelNumber") {
+        if (!mod[["modelNumber"]] %in% .procHardCodedModelNumbers()) {
+          modelNumberTable$setError(gettextf("Hayes model number %s for %s not implemented", mod[["modelNumber"]], mod[["name"]]))
+        }
+        return(mod[["modelNumber"]])
+      }
+
+      return(.procRecognizeModelNumber(modelsContainer[[mod[["name"]]]][["regList"]]$object))
+    }
+  )
+
   modelNames <- sapply(options[["processModels"]], function(mod) mod[["name"]])
 
   modelNumberTable$addColumnInfo(name = "model",       title = "Model", type = "string" )