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) diff --git a/nimbleModel/R/instructions.R b/nimbleModel/R/instructions.R index 583acb3..ea89b5f 100644 --- a/nimbleModel/R/instructions.R +++ b/nimbleModel/R/instructions.R @@ -129,7 +129,10 @@ 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. if (inherits(input, "instr_nClass")) { return(list(input)) @@ -166,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) @@ -190,17 +197,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,21 +207,14 @@ 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) 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) } @@ -231,9 +223,9 @@ instr_nClass <- nClass( Rpublic = list( initialize = function(calcRange, instr, ...) { super$initialize(...) - if (!missing(calcRange) || !missing(instr)) { + if(!missing(calcRange) || !missing(instr)) { if(!missing(calcRange)) - instr <- range2instr(calcRange) # This processing could simply be included here in `initialize`. + 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..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 (!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/R/nodeRules.R b/nimbleModel/R/nodeRules.R index aeb778e..64f94a3 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,11 @@ 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]))) + class(results) <- "Rlist_Rinstr" # For ease of determining the type of the object in `makeInstrList`. return(results) } ) 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))))