WIP: classic nimble handling of nodes as chars

nimbleModel/NAMESPACE

@@ -70,5 +70,9 @@ export(messageIfVerbose)
 export(calc_dmnormAltParams)
 export(calc_dwishAltParams)
 
+export(nimbleCode)
 export(nimbleModel)
 export(makeInstrList)
+
+export(setNimbleModelOption)
+export(getNimbleModelOption)

nimbleModel/R/model.R

@@ -327,7 +327,10 @@ getNodes <- function(model, nodes = NULL,
                      includeData = TRUE, dataOnly = FALSE,
                      includePredictive = TRUE, predictiveOnly = FALSE,
                      includeRHSonly = FALSE,
-                     topOnly = FALSE, latentOnly = FALSE, endOnly = FALSE) {
+                     topOnly = FALSE, latentOnly = FALSE, endOnly = FALSE,
+                     nodesAsChars = getNimbleModelOption('nodesAsChars'),
+                     returnScalarComponents = FALSE
+                     ) {
   # `nodes` may contain one or more varRanges or varNames.
   if (topOnly + latentOnly + endOnly > 1) {
     stop("only one of `topOnly`, `latentOnly`, `endOnly` can be `TRUE`.")
@@ -393,6 +396,14 @@ getNodes <- function(model, nodes = NULL,
   if (!length(result)) {
     return(NULL)
   }
-
-  return(removeDuplicateVarRanges(result))
+  if (nodesAsChars) {
+    if (returnScalarComponents) {
+      result <- sapply(result, \(x) x$toVarRange()$toVarChars(expandScalars = TRUE))
+    } else result <- sapply(result, \(x) x$toNodeChars())
+    return(unlist(result))
+  } else {
+    if (returnScalarComponents)   # TODO: put into new messaging system
+      warning("one must request result as characters via `nodesAsChars` or `classicNimble` in order to use `returnScalarComponents`")
+  }
+  return(result)                                                  
 }

nimbleModel/R/modelBaseClass.R

@@ -307,23 +307,33 @@ modelBase_nClass <- nClass(
         return(expr)
       }
     },
-    getDependencies = function(nodes, self = TRUE, downstream = FALSE, immediateOnly = FALSE) {
-      nimbleModel::getDependencies(modelDef, nodes, self, downstream, immediateOnly)
+    getDependencies = function(nodes, self = TRUE, downstream = FALSE, immediateOnly = FALSE,
+                               nodesAsChars = getNimbleModelOption('nodesAsChars'),
+                               returnScalarComponents = FALSE
+                               ) {
+      nimbleModel::getDependencies(modelDef, nodes, self, downstream, immediateOnly,
+                                   nodesAsChars, returnScalarComponents)
     },
-    getParents = function(nodes, self = TRUE, upstream = FALSE, immediateOnly = FALSE) {
-      nimbleModel::getParents(modelDef, nodes, self, upstream, immediateOnly)
+    getParents = function(nodes, self = TRUE, upstream = FALSE, immediateOnly = FALSE,
+                          nodesAsChars = getNimbleModelOption('nodesAsChars'),
+                          returnScalarComponents = FALSE
+                          ) {
+      nimbleModel::getParents(modelDef, nodes, self, upstream, immediateOnly,
+                              nodesAsChars, returnScalarComponents)
     },
     # TODO: not working because `nimbleModel::getNodes` needs the model not just modelDef.
     # Once we integrate modelClass with modelBase_nClass, we should be able to pass `self`.
     getNodes = function(nodes = NULL, stochOnly = FALSE, determOnly = FALSE,
                         includeData = TRUE, dataOnly = FALSE,
                         includePredictive = TRUE, predictiveOnly = FALSE,
                         includeRHSonly = FALSE,
-                        topOnly = FALSE, latentOnly = FALSE, endOnly = FALSE) {
+                        topOnly = FALSE, latentOnly = FALSE, endOnly = FALSE,
+                        nodesAsChars = getNimbleModelOption('nodesAsChars'),
+                        returnScalarComponents = FALSE) {
       nimbleModel::getNodes(
         self, nodes, stochOnly, determOnly, includeData, dataOnly,
         includePredictive, predictiveOnly, includeRHSonly,
-        topOnly, latentOnly, endOnly
+        topOnly, latentOnly, endOnly, nodesAsChars, returnScalarComponents
       )
     },
     calc_op = function(instr, fn, fn_cpp) {

nimbleModel/R/modelDef.R

@@ -999,21 +999,29 @@ modelDefClass <- R6Class(
 
 getDependencies <- function(modelDef, nodes,
                             self = TRUE,
-                            downstream = FALSE, immediateOnly = FALSE) {
+                            downstream = FALSE, immediateOnly = FALSE,
+                            nodesAsChars = getNimbleModelOption('nodesAsChars'),
+                            returnScalarComponents = FALSE
+                            ) {
   traverseGraph(modelDef$downstreamRules, modelDef$declRules,
     nodes = nodes,
     down = TRUE, self = self,
-    follow = downstream, immediateOnly = immediateOnly
+    follow = downstream, immediateOnly = immediateOnly,
+    nodesAsChars = nodesAsChars, returnScalarComponents = returnScalarComponents
   )
 }
 
 getParents <- function(modelDef, nodes,
                        self = FALSE,
-                       upstream = FALSE, immediateOnly = FALSE) {
+                       upstream = FALSE, immediateOnly = FALSE,
+                       nodesAsChars = getNimbleModelOption('nodesAsChars'),
+                       returnScalarComponents = FALSE
+                       ) {
   traverseGraph(modelDef$upstreamRules, modelDef$declRules,
     nodes = nodes,
     down = FALSE, self = self,
-    follow = upstream, immediateOnly = immediateOnly
+    follow = upstream, immediateOnly = immediateOnly,
+    nodesAsChars = nodesAsChars, returnScalarComponents = returnScalarComponents
   )
 }
 

nimbleModel/R/options.R

@@ -8,11 +8,13 @@
     # but this has .GlobalEnv as a parent.
     processBackwardsModelIndexRanges = TRUE,
     disallowMultivariateArgumentExpressions = TRUE,
+    nodesAsChars = FALSE,
     verbose = TRUE
   )
 )
 
 # sets a single option
+#' @export
 setNimbleModelOption <- function(name, value) {
   assign(name, value, envir = .nimbleModelOptions)
   invisible(value)

nimbleModel/R/processModelGraph.R

@@ -242,7 +242,10 @@ setSortIDs <- function(calcRules) {
 # pass result through `getNodes`.
 traverseGraph <- function(streamRules, declRules,
                           nodes, down, self = TRUE,
-                          follow = FALSE, immediateOnly = FALSE) {
+                          follow = FALSE, immediateOnly = FALSE,
+                          nodesAsChars = getNimbleModelOption('nodesAsChars'),
+                          returnScalarComponents = FALSE
+                          ) {
   if (inherits(nodes, "varRangeClass")) nodes <- list(nodes) # We use `lapply` on 'nodes' later.
 
   results <- traverseGraphRecurse(streamRules, nodes, down, follow, immediateOnly)
@@ -321,7 +324,14 @@ traverseGraph <- function(streamRules, declRules,
   if (!length(results)) {
     return(NULL)
   }
-  return(removeDuplicateVarRanges(results))
+  results <- removeDuplicateVarRanges(results)
+  if (nodesAsChars) {
+    return(unlist(sapply(results, \(x) x$toVarChars(expandScalars = returnScalarComponents))))
+  } else {
+    if (returnScalarComponents)   # TODO: put into new messaging system
+      warning("one must request result as characters via `nodesAsChars` or `classicNimble` in order to use `returnScalarComponents`")
+  } 
+  return(results)                                                  
 }
 
 traverseGraphRecurse <- function(rules, nodes, down, follow = FALSE, immediateOnly = FALSE, firstPass = TRUE) {