add topologicallySortNodes and improve efficiency of idempotent case with getNodes

nimbleModel/R/model.R

@@ -381,9 +381,13 @@ getNodes <- function(model, nodes = NULL,
   }
 
   if (!topOnly && !latentOnly && !endOnly) {
-    result <- lapply(nodes, function(node) applyRules(model$modelDef$declRules, node))
-  }
-
+    result <- lapply(nodes, function(node) {
+      if(inherits(node, 'nodeRangeClass')) {
+        return(node)
+      } else return(applyRules(model$modelDef$declRules, node))
+    })
+  }    
+
   if (topOnly) result <- lapply(nodes, function(node) applyRules(model$modelDef$topRules, node))
   if (latentOnly) result <- lapply(nodes, function(node) applyRules(model$modelDef$latentRules, node))
   if (endOnly) result <- lapply(nodes, function(node) applyRules(model$modelDef$endRules, node))
@@ -402,7 +406,7 @@ getNodes <- function(model, nodes = NULL,
   if (includeRHSonly && !stochOnly && !determOnly) { # RHSonly are considered neither determ not stoch.
     rhsResult <- lapply(nodes, function(node) applyRules(model$modelDef$rhsOnlyRules, node))
     if (!.sort) 
-      result <- c(result, flatten(rhsResult))  # TODO: flatten() seems to be deprecated; can we use unlist?
+      result <- c(result, flatten(rhsResult))  
   }
 
   if (.sort) {
@@ -469,3 +473,20 @@ expandNodeNames <- function(model, nodes, returnScalarComponents = FALSE,
   if (unique) result <- unique(result)
   return(result)
 }
+
+# Provided for backward compatibility.
+#' @export
+getNodeNames <- function(model, determOnly = FALSE, stochOnly = FALSE,
+                         includeData = TRUE, dataOnly = FALSE, includeRHSonly = FALSE,
+                         topOnly = FALSE, latentOnly = FALSE, endOnly = FALSE,
+                         includePredictive = TRUE, predictiveOnly = FALSE,
+                         returnType = "names",
+                         returnScalarComponents = FALSE) {
+  if (returnType != "names")
+    stop("In nimble2, one can only request 'names' as the `returnType`")
+  return(getNodes(model, nodes = NULL, determOnly, stochOnly, includeData, dataOnly,
+                  includeRHSonly, topOnly, latentOnly, endOnly,
+                  includePredictive, predictiveOnly,
+                  nodesAsChars = TRUE,
+                  returnScalarComponents, .sort = TRUE))
+}

nimbleModel/R/modelBaseClass.R

@@ -406,6 +406,9 @@ modelBase_nClass <- nClass(
                                returnType = "names", sort = FALSE, unique = TRUE) {
       nimbleModel::expandNodeNames(self, nodes, returnScalarComponents, "names", sort, unique)
     },
+    topologicallySortNodes = function(nodes) {
+      nimbleModel::expandNodeNames(self, nodes, sort = TRUE, unique = TRUE)
+    },
     calc_op = function(instr, fn, fn_cpp) {
       if (missing(instr)) {
         instr <- getVarNames()

nimbleModel/tests/testthat/test-nodeChars.R

@@ -55,9 +55,8 @@ test_that("old model API calls", {
         y[i,j] ~ dnorm(mu + x,1)
     mu ~dnorm(0,1)
   })
-
-
   m <- nimbleModel(code, data = list(y=matrix(rnorm(6),2)))
+
   chars <- m$getNodes(nodesAsChars = TRUE)
   expect_identical(chars, c("lifted_mu_plus_x", "y[1, 1]","y[1, 2]","y[1, 3]", "y[2, 1]", "y[2, 2]", "y[2, 3]", "mu"))
   chars <- m$getNodes(includeRHSonly = TRUE, nodesAsChars = TRUE)
@@ -76,7 +75,9 @@ test_that("old model API calls", {
   expect_identical(chars, c("mu", "y[1, 1]","y[1, 2]","y[1, 3]", "y[2, 1]", "y[2, 2]", "y[2, 3]", "x"))
   chars <- m$expandNodeNames(c('mu','y','x'), sort = TRUE)
   expect_identical(chars, c("x", "mu", "y[1, 1]","y[1, 2]","y[1, 3]", "y[2, 1]", "y[2, 2]", "y[2, 3]"))
-
+  chars <- m$topologicallySortNodes(c('mu','y','x'))
+  expect_identical(chars, c("x", "mu", "y[1, 1]","y[1, 2]","y[1, 3]", "y[2, 1]", "y[2, 2]", "y[2, 3]"))
+
   chars <- m$expandNodeNames(c('y','y[2,1]'))
   expect_identical(chars, c("y[1, 1]","y[1, 2]","y[1, 3]", "y[2, 1]", "y[2, 2]", "y[2, 3]"))
   chars <- m$expandNodeNames(c('y','y[2,1]'), unique = FALSE)
@@ -220,7 +221,8 @@ test_that("Use of .sort in cases with multiple and/or overlapping sortID values"
   expect_identical(m$getNodes(.sort=TRUE,nodesAsChars=TRUE), truth)
   expect_identical(m$getParents('y', .sort=TRUE, nodesAsChars = TRUE, self = TRUE), truth)
   expect_identical(m$getParents('y[4]', .sort=TRUE, nodesAsChars = TRUE, self = TRUE), c('tau','lifted_d1_over_sqrt_oPtau_cP','y[3]','lifted_rho_times_y_oBi_minus_1_cB_L2[4]', 'y[4]'))
-
+  nrs <- m$getNodes()
+  expect_identical(m$topologicallySortNodes(nrs), truth)
 
   code <- nimbleCode({
     for(i in 1:5)