Omit unneeded marginalization nodes and rework messaging

for setupMargNodes warnings.

Author: paciorek

packages/nimble/R/Laplace.R

@@ -2105,11 +2105,12 @@ setupMargNodes <- function(model, paramNodes, randomEffectsNodes, calcNodes,
     if(length(reCheck)) {
       errorNodes <- paste0(head(reCheck, n = 4), sep = "", collapse = ", ")
       if(length(reCheck) > 4) errorNodes <- paste(errorNodes, "...")
-      messageIfVerbose("  [Warning] There are some random effects (latent states) in the model that look\n",
-                       "            like they should be included in `randomEffectsNodes` for Laplace or AGHQ approximation\n",
-                       "            for the provided (or default) `paramNodes`: ", errorNodes, ".\n",
-                       "            To silence this warning, include `check = FALSE` in the control list\n",
-                       "            to `buildLaplace` or as an argument to `setupMargNodes`.")
+      messageIfVerbose("  [Warning] There are some random effects (latent states) in the model that look like\n",
+                       "            they should be marginalized over for the provided (or default) `paramNodes`,\n",
+                       "            but are not included in `randomEffectsNodes`: ", errorNodes, ".\n",
+                       "            To silence this warning, one can usually include `check = FALSE`\n",
+                       "            (potentially in the control list) for the algorithm or as\n",
+                       "            an argument to `setupMargNodes`.")
     }
     # Second check is for random effects that were included but look unnecessary
     reCheck <- setdiff(randomEffectsNodes, reNodesDefault)
@@ -2126,11 +2127,16 @@ setupMargNodes <- function(model, paramNodes, randomEffectsNodes, calcNodes,
       if(length(reCheck)) {
         errorNodes <- paste0(head(reCheck, n = 4), sep = "", collapse = ", ")
         if(length(reCheck) > 4) errorNodes <- paste(errorNodes, "...")
+        extraMsg <- ifelse(getNimbleOption('includeUnneededLatentsForMarg'), "",
+                                "            They will be omitted, but one can force inclusion with\n            `nimbleOptions(omitUnneededLatentsForMarg=FALSE)`.\n")
         messageIfVerbose("  [Warning] There are some `randomEffectsNodes` provided that look like\n",
-                         "            they are not needed for Laplace or AGHQ approximation for the\n",
-                         "            provided (or default) `paramNodes`: ", errorNodes, ".\n",
-                         "            To silence this warning, include `check = FALSE` in the control list\n",
-                         "            to `buildLaplace` or as an argument to `setupMargNodes`.")
+                         "            they are not needed for marginalization for the\n",
+                         "            provided (or default) `paramNodes`: ", errorNodes, ".\n", extraMsg,
+                         "            To silence this warning, one can usually include `check = FALSE`\n",
+                         "            (potentially in the control list) for the algorithm or as\n",
+                         "            an argument to `setupMargNodes`.")
+        if(!getNimbleOption('includeUnneededLatentsForMarg'))
+            randomEffectsNodes <- setdiff(randomEffectsNodes, reCheck)
       }
     }
   }
@@ -2151,10 +2157,11 @@ setupMargNodes <- function(model, paramNodes, randomEffectsNodes, calcNodes,
       errorNodes <- paste0(head(calcCheck, n = 4), sep = "", collapse = ", ")
       if(length(calcCheck) > 4) errorNodes <- paste(errorNodes, "...")
       messageIfVerbose("  [Warning] There are some model nodes that look like they should be\n",
-                       "            included in the `calcNodes` for Laplace or AGHQ approximation because\n",
+                       "            included in the `calcNodes` for marginalization algorithms because\n",
                        "            they are dependencies of some `randomEffectsNodes`: ", errorNodes, ".\n",
-                       "            To silence this warning, include `check = FALSE` in the control list\n",
-                       "            to `buildLaplace` or as an argument to `setupMargNodes`.")
+                       "            To silence this warning, one can usually include `check = FALSE`\n",
+                       "            (potentially in the control list) for the algorithm or as\n",
+                       "            an argument to `setupMargNodes`.")
     }
     # Second check is for calcNodes that look unnecessary
     # If some determ nodes between paramNodes and randomEffectsNodes are provided in calcNodes
@@ -2181,10 +2188,11 @@ setupMargNodes <- function(model, paramNodes, randomEffectsNodes, calcNodes,
       outErrorNodes <- paste0(head(errorNodes, n = 4), sep = "", collapse = ", ")
       if(length(errorNodes) > 4) outErrorNodes <- paste(outErrorNodes, "...")
       messageIfVerbose("  [Warning] There are some `calcNodes` provided that look like\n",
-                       "            they are not needed for Laplace or AGHQ approximation over\n",
+                       "            they are not needed for marginalization over\n",
                        "            the provided (or default) `randomEffectsNodes`: ", outErrorNodes, ".\n",
-                       "            To silence this warning, include `check = FALSE` in the control list\n",
-                       "            to `buildLaplace` or as an argument to `setupMargNodes`.")
+                       "            To silence this warning, one can usually include `check = FALSE`\n",
+                       "            (potentially in the control list) for the algorithm or as\n",
+                       "            an argument to `setupMargNodes`.")
     }
   }
   # Finish step 4

packages/nimble/R/options.R

@@ -227,7 +227,8 @@ nimOptimMethod("bobyqa",
         stripUnusedTypeDefs = TRUE,
         digits = NULL,
         enableVirtualNodeFunctionDefs = FALSE,
-        checkDerivsArgs = TRUE
+        checkDerivsArgs = TRUE,
+        includeUnneededLatentsForMarg = FALSE
       )
 )
 

packages/nimble/tests/testthat/test-setupMargNodes.R

@@ -464,3 +464,42 @@ test_that("regression tests that `getConditionallyIndependentSets` works with tr
     expect_length(m$getConditionallyIndependentSets(nodes = latents, givenNodes = given, unknownAsGiven = TRUE), 1)
 })
 
+test_that("`setupMargNodes` handling of missing/extra latents", {
+    code <- nimbleCode({
+        for(i in 1:5)
+            y[i] ~ dnorm(b[k[i]], 1)
+        for(i in 1:3)
+            b[i] ~ dnorm(mu,1)
+        mu ~ dnorm(0,1)
+    })
+    ## Only b[1] and b[2] have data dependents.
+    m <- nimbleModel(code, data = list(y = rnorm(5)), constants = list(k = c(1,1,1,2,2)))
+
+    expect_silent(result <- setupMargNodes(m))
+    expect_identical(result$randomEffectsNodes, c("b[1]","b[2]"))
+    expect_identical(result$paramNodes, c("mu"))
+
+    ## `b[2]` won't be marginalized over, and its dependent `y`s are not in calcNodes.
+    ## Could be user error, but we simply accept the user choices. 
+    expect_silent(result <- setupMargNodes(m, randomEffectsNodes = 'b[1]'))
+    expect_identical(result$randomEffectsNodes, c("b[1]"))
+    expect_identical(result$paramNodes, c("mu"))
+    
+    ## This gives a warning.
+    ## `b[2]` now in `paramNodes`, presumably since its `y`s are in calcNodes.
+    expect_warning(result <- setupMargNodes(m, randomEffectsNodes = 'b[1]', calcNodes = c('b[1]','y')),
+                   "they should be marginalized over")
+    expect_identical(result$randomEffectsNodes, c("b[1]"))
+    expect_identical(result$paramNodes, c("mu", "b[2]"))
+ 
+    expect_message(result <- setupMargNodes(m, randomEffectsNodes = 'b'), "they are not needed for marginalization")
+    expect_identical(result$randomEffectsNodes, c("b[1]", "b[2]"))
+    expect_identical(result$paramNodes, c("mu"))
+
+    nimbleOptions(includeUnneededLatentsForMarg = TRUE)
+    expect_message(result <- setupMargNodes(m, randomEffectsNodes = 'b'), "they are not needed for marginalization")
+    expect_identical(result$randomEffectsNodes, c("b[1]", "b[2]", "b[3]"))
+    expect_identical(result$paramNodes, c("mu"))
+    ## Note `b[3]` is not in `calcNodes` because `predictiveNodes` are excluded.
+})
+