From 3d8c3b7f580495b753e0052b7eaf2ec1d1a2e802 Mon Sep 17 00:00:00 2001 From: Christopher Paciorek Date: Fri, 17 Jul 2026 09:43:38 -0700 Subject: [PATCH 1/4] Remove bottlenecks when splitting calcRanges with multiple sortIDs for calculation. --- nimbleModel/R/instructions.R | 42 +++++++++++----------------------- nimbleModel/R/modelBaseClass.R | 3 ++- nimbleModel/R/nodeRules.R | 12 +++++++--- 3 files changed, 24 insertions(+), 33 deletions(-) diff --git a/nimbleModel/R/instructions.R b/nimbleModel/R/instructions.R index 583acb3..34163d3 100644 --- a/nimbleModel/R/instructions.R +++ b/nimbleModel/R/instructions.R @@ -130,6 +130,8 @@ makeInstrList <- function(model, input, includeData = TRUE, use_vec = FALSE) { # (3) an nList of (or single) instr_nClass objects (assumed to be in sort order) # (4) an R list of instr_nClass objects (not assumed to be in sort order) + # TODO: do we really need to handle case #4? + # A single instruction. if (inherits(input, "instr_nClass")) { return(list(input)) @@ -190,17 +192,9 @@ makeInstrList <- function(model, input, includeData = TRUE, use_vec = FALSE) { rangesToRemove <- numeric(0) for(i in multiSortID) if(!all(diff(sortIDs[[i]]) == 1, na.rm = TRUE)) { - newRanges <- ranges[[i]]$makeScalars() # Somewhat slow; 5s per 10k items. - # Attempt to avoid repeated identical processing in `range2instr`. - # However, that is not the bottleneck; simply passing the `newRanges` elements into `instr_nClass$new()` - # would not be much slower. For now, leave the approach of using the template. - templateInstr <- range2instr(newRanges[[1]]) - newInstrs <- c(newInstrs, lapply(seq_along(newRanges), - function(idx) { - templateInstr$sortID <- newRanges[[idx]]$sortID - templateInstr$values[[1]] <- newRanges[[idx]]$indexingRange$indexRanges[[1]]$values[1] - return(templateInstr) - })) + # This quickly creates a list of R lists, where the elements mimic instr_nClass objects, + # from a calcRange with multiple sortID values. Creating many calcRanges or instr_nClass objects is slow. + newInstrs <- c(newInstrs, ranges[[i]]$makeScalarInstrInfoLists()) rangesToRemove <- c(rangesToRemove, i) } else { # Check for any overlapping sortID values for the sequential backward dependence calcRange. if(any(sortIDranges[2,-i] > sortIDranges[1,i] & sortIDranges[1,-i] < sortIDranges[2,i])) @@ -208,32 +202,22 @@ makeInstrList <- function(model, input, includeData = TRUE, use_vec = FALSE) { } if(length(rangesToRemove)) ranges <- ranges[-rangesToRemove] - # This is slow - 40 ms per new instr_nClass, regardless of whether pass in a calcRange - # or an R list containing instruction info. - Rlist <- c(lapply(ranges, \(x) instr_nClass$new(x)), - lapply(newInstrs, \(x) instr_nClass$new(instr = x))) - numRanges <- length(Rlist) - sortIDranges <- sapply(Rlist, \(x) min(x$sortID, na.rm = TRUE)) - ord <- order(sortIDranges) - instrList <- nList(instr_nClass)$new() - instrList$setLength(numRanges) - # We need a loop to populate an nList; can't use `input[ord]`. - for (i in seq_len(numRanges)) { - instrList[[i]] <- Rlist[[ord[i]]] - } - return(instrList) + # Again, returning a list of R lists that mimic instr_nClass objects is much faster + # than instantiating instr_nClass objects. + Rlist <- c(newInstrs, lapply(ranges, \(x) range2instr(x))) + sortIDs <- sapply(Rlist, \(x) x$sortID) + return(Rlist[order(sortIDs)]) } instr_nClass <- nClass( classname = "instr_nClass", Rpublic = list( - initialize = function(calcRange, instr, ...) { + initialize = function(calcRange, ...) { super$initialize(...) - if (!missing(calcRange) || !missing(instr)) { - if(!missing(calcRange)) - instr <- range2instr(calcRange) # This processing could simply be included here in `initialize`. + if(!missing(calcRange)) { + instr <- range2instr(calcRange) self$lens <- instr$lens %||% integer() self$index_types <- instr$index_types %||% integer() self$nDim <- instr$nDim %||% 0L diff --git a/nimbleModel/R/modelBaseClass.R b/nimbleModel/R/modelBaseClass.R index dc25ee8..5f9354a 100644 --- a/nimbleModel/R/modelBaseClass.R +++ b/nimbleModel/R/modelBaseClass.R @@ -410,12 +410,13 @@ modelBase_nClass <- nClass( nimbleModel::expandNodeNames(self, nodes, sort = TRUE, unique = TRUE) }, calc_op = function(instr, fn, fn_cpp) { + if(exists('paciorek')) browser() if (missing(instr)) { instr <- getVarNames() } instrList <- makeInstrList(self, instr) if (isCompiled()) { - if (!instrList$isCompiled()) instrList <- makeCompiledInstrList(instrList) + if (is.list(instrList) || !instrList$isCompiled()) instrList <- makeCompiledInstrList(instrList) return(self[[fn_cpp]](instrList)) } logProb <- 0 diff --git a/nimbleModel/R/nodeRules.R b/nimbleModel/R/nodeRules.R index aeb778e..c4bf1e1 100644 --- a/nimbleModel/R/nodeRules.R +++ b/nimbleModel/R/nodeRules.R @@ -376,7 +376,12 @@ calcRangeClass <- R6Class( declID <<- declID multiSortIDindex <<- multiSortIDindex }, - makeScalars = function() { + makeScalarInstrInfoLists = function() { + # This is used to split the calcRange when there are multiple sortID values. + # To avoid overhead (0.5 ms per call) in making many calcRangeClass objects, + # we simply produce a list of lists where each list item is in the form also + # produced by `range2instr()` (i.e., basically an instr_nClass object in R list form). + # Need original indexing because nodeFunctions will use that indexing # (e.g. `y[i+1]` needs value of `i`). if(length(multiSortIDindex) != 1) @@ -384,9 +389,10 @@ calcRangeClass <- R6Class( indices <- c(indexingRange$indexRanges[[indexingRange$indexSlotToRange[multiSortIDindex]]]$getValuesAsMatrix()) if(length(indices) != length(sortID)) stop("mismatch between indexing values and node-based sortIDs") + results <- lapply(seq_along(indices), \(i) - calcRangeClass$new(varName, varRangeClass$new(list(indexRangeMatrixClass$new(matrix(indices[i]), sort=FALSE))), - declID, sortID[i], NULL)) + list(dims = 1, index_types = 2, lens = 1, nDim = 1, slots = 1, sortID = sortID[i], + declID = declID, type = 2, values = list(indices[i]))) return(results) } ) From fe367f16d250abc72ce2f1b00643e87bf6141b65 Mon Sep 17 00:00:00 2001 From: Christopher Paciorek Date: Fri, 17 Jul 2026 10:36:44 -0700 Subject: [PATCH 2/4] Fix makeInstrList to be idempotent with lists of instr_nClass-like R lists. --- nimbleModel/R/instructions.R | 11 +++++++++-- nimbleModel/R/modelBaseClass.R | 1 - nimbleModel/R/nodeRules.R | 1 + 3 files changed, 10 insertions(+), 3 deletions(-) diff --git a/nimbleModel/R/instructions.R b/nimbleModel/R/instructions.R index 34163d3..546c472 100644 --- a/nimbleModel/R/instructions.R +++ b/nimbleModel/R/instructions.R @@ -129,7 +129,8 @@ makeInstrList <- function(model, input, includeData = TRUE, use_vec = FALSE) { # (2) a list of (or single) varRanges # (3) an nList of (or single) instr_nClass objects (assumed to be in sort order) # (4) an R list of instr_nClass objects (not assumed to be in sort order) - + # (5) an R list of instr_nClass-like R lists (produced by makeScalarInstrInfoLists when splitting a calcRange with multiple sortID values. + # TODO: do we really need to handle case #4? # A single instruction. @@ -168,6 +169,10 @@ makeInstrList <- function(model, input, includeData = TRUE, use_vec = FALSE) { return(instrList) } + # An R list of instr_nClass-like R lists + if(inherits(input, "Rlist_Rinstr")) + return(input) + # Finally handle character vectors or varRanges. if (inherits(input, "varRangeClass")) input <- list(input) @@ -207,7 +212,9 @@ makeInstrList <- function(model, input, includeData = TRUE, use_vec = FALSE) { # than instantiating instr_nClass objects. Rlist <- c(newInstrs, lapply(ranges, \(x) range2instr(x))) sortIDs <- sapply(Rlist, \(x) x$sortID) - return(Rlist[order(sortIDs)]) + Rlist <- Rlist[order(sortIDs)] + class(Rlist) <- "Rlist_Rinstr" # For checking idempotency. + return(Rlist) } diff --git a/nimbleModel/R/modelBaseClass.R b/nimbleModel/R/modelBaseClass.R index 5f9354a..9578921 100644 --- a/nimbleModel/R/modelBaseClass.R +++ b/nimbleModel/R/modelBaseClass.R @@ -410,7 +410,6 @@ modelBase_nClass <- nClass( nimbleModel::expandNodeNames(self, nodes, sort = TRUE, unique = TRUE) }, calc_op = function(instr, fn, fn_cpp) { - if(exists('paciorek')) browser() if (missing(instr)) { instr <- getVarNames() } diff --git a/nimbleModel/R/nodeRules.R b/nimbleModel/R/nodeRules.R index c4bf1e1..64f94a3 100644 --- a/nimbleModel/R/nodeRules.R +++ b/nimbleModel/R/nodeRules.R @@ -393,6 +393,7 @@ calcRangeClass <- R6Class( results <- lapply(seq_along(indices), \(i) list(dims = 1, index_types = 2, lens = 1, nDim = 1, slots = 1, sortID = sortID[i], declID = declID, type = 2, values = list(indices[i]))) + class(results) <- "Rlist_Rinstr" # For ease of determining the type of the object in `makeInstrList`. return(results) } ) From 327f54fc0058843e52abdf8a95063c9467447674 Mon Sep 17 00:00:00 2001 From: Christopher Paciorek Date: Fri, 17 Jul 2026 11:08:25 -0700 Subject: [PATCH 3/4] Add back ability to make an instr_nClass object from an R list with instr info. --- nimbleModel/R/instructions.R | 9 +++++---- nimbleModel/R/modelBaseClass.R | 6 ++++-- nimbleModel/tests/testthat/test-nimbleModel.R | 2 +- 3 files changed, 10 insertions(+), 7 deletions(-) diff --git a/nimbleModel/R/instructions.R b/nimbleModel/R/instructions.R index 546c472..ea89b5f 100644 --- a/nimbleModel/R/instructions.R +++ b/nimbleModel/R/instructions.R @@ -211,7 +211,7 @@ makeInstrList <- function(model, input, includeData = TRUE, use_vec = FALSE) { # Again, returning a list of R lists that mimic instr_nClass objects is much faster # than instantiating instr_nClass objects. Rlist <- c(newInstrs, lapply(ranges, \(x) range2instr(x))) - sortIDs <- sapply(Rlist, \(x) x$sortID) + sortIDs <- sapply(Rlist, \(x) min(x$sortID, na.rm = TRUE)) # `min` still needed for case of ascending sortIDs (e.g., dependence on the past), which are not split. Rlist <- Rlist[order(sortIDs)] class(Rlist) <- "Rlist_Rinstr" # For checking idempotency. return(Rlist) @@ -221,10 +221,11 @@ makeInstrList <- function(model, input, includeData = TRUE, use_vec = FALSE) { instr_nClass <- nClass( classname = "instr_nClass", Rpublic = list( - initialize = function(calcRange, ...) { + initialize = function(calcRange, instr, ...) { super$initialize(...) - if(!missing(calcRange)) { - instr <- range2instr(calcRange) + if(!missing(calcRange) || !missing(instr)) { + if(!missing(calcRange)) + instr <- range2instr(calcRange) self$lens <- instr$lens %||% integer() self$index_types <- instr$index_types %||% integer() self$nDim <- instr$nDim %||% 0L diff --git a/nimbleModel/R/modelBaseClass.R b/nimbleModel/R/modelBaseClass.R index 9578921..8702975 100644 --- a/nimbleModel/R/modelBaseClass.R +++ b/nimbleModel/R/modelBaseClass.R @@ -415,7 +415,8 @@ modelBase_nClass <- nClass( } instrList <- makeInstrList(self, instr) if (isCompiled()) { - if (is.list(instrList) || !instrList$isCompiled()) instrList <- makeCompiledInstrList(instrList) + if (inherits(instrList, "Rlist_Rinstr") || !instrList$isCompiled()) + instrList <- makeCompiledInstrList(instrList) return(self[[fn_cpp]](instrList)) } logProb <- 0 @@ -443,7 +444,8 @@ modelBase_nClass <- nClass( instrList <- makeInstrList(self, instr, includeData = includeData) if(is.null(instrList)) return(invisible(NULL)) if (isCompiled()) { - if (!instrList$isCompiled()) instrList <- makeCompiledInstrList(instrList) + if (inherits(instrList, "Rlist_Rinstr") || !instrList$isCompiled()) + instrList <- makeCompiledInstrList(instrList) self$simulate_impl(instrList) } else { for (i in 1:length(instrList)) { diff --git a/nimbleModel/tests/testthat/test-nimbleModel.R b/nimbleModel/tests/testthat/test-nimbleModel.R index 25edf2c..624c70f 100644 --- a/nimbleModel/tests/testthat/test-nimbleModel.R +++ b/nimbleModel/tests/testthat/test-nimbleModel.R @@ -791,7 +791,7 @@ test_that("calculate works correctly for time series/SSM recursion", { "something other than sequential dependence on the past") # Check proper handling when providing list of instructions. - instrList <- makeInstrList(m, lapply(c(5,3,1,2,4), \(i) instrList[[i]])) + instrList <- makeInstrList(m, lapply(c(5,3,1,2,4), \(i) nimbleModel:::instr_nClass$new(instrList[[i]]))) sortIDs <- lapply(instrList, \(x) x$sortID) expect_true(all(diff(sapply(sortIDs, \(x) min(x,na.rm=TRUE))) >= 0)) expect_true(all(sapply(sortIDs, \(x) length(x) == 1 || all(diff(x) >= 1, na.rm=TRUE)))) From 73612338b8e5e070b3b3103cb6d047dffd6f7018 Mon Sep 17 00:00:00 2001 From: Christopher Paciorek Date: Fri, 17 Jul 2026 11:20:30 -0700 Subject: [PATCH 4/4] Fix CI ref to non-existent nCompiler branch. --- .github/workflows/tests.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/tests.yaml b/.github/workflows/tests.yaml index 926b50c..2a6f296 100644 --- a/.github/workflows/tests.yaml +++ b/.github/workflows/tests.yaml @@ -47,7 +47,7 @@ jobs: install.packages('R6') install.packages('nimble') # For now, we use `nimble` for stuff in `miscFunctions.R`. install.packages('inline') # For now, seemingly need for nCompiler. - remotes::install_github("https://github.com/nimble-dev/nCompiler", subdir="nCompiler", ref="nimble-dists") + remotes::install_github("https://github.com/nimble-dev/nCompiler", subdir="nCompiler") shell: Rscript {0} - name: Install nimbleModel (Windows)