From 6219707c6a2714ec900f8da000fb8ca40be6da45 Mon Sep 17 00:00:00 2001 From: perrydv Date: Thu, 5 Nov 2026 05:37:13 -0800 Subject: [PATCH] pass idx by ref and support missing nodes argument as all nodes --- nimbleModel/R/declFunBaseClass.R | 2 +- nimbleModel/R/instructions.R | 7 ++++ nimbleModel/R/modelBaseClass.R | 14 ++++---- nimbleModel/R/nimbleModel.R | 29 ++++++++++------ nimbleModel/tests/testthat/test-instrSteps.R | 36 ++++++++++++++++++++ 5 files changed, 70 insertions(+), 18 deletions(-) diff --git a/nimbleModel/R/declFunBaseClass.R b/nimbleModel/R/declFunBaseClass.R index b729403..3f88602 100644 --- a/nimbleModel/R/declFunBaseClass.R +++ b/nimbleModel/R/declFunBaseClass.R @@ -55,7 +55,7 @@ declFunBase_nClass <- nClass( valuesLength = function(instr) { total <- 0 for (k in seq_len(instr$nNodes)) { - idx <- set_instr_idx(instr, k) # a name, since idx is a refArg + idx <- set_instr_idx(instr, k) total <- total + valuesLength_one(idx) } total diff --git a/nimbleModel/R/instructions.R b/nimbleModel/R/instructions.R index 4b56863..86c238a 100644 --- a/nimbleModel/R/instructions.R +++ b/nimbleModel/R/instructions.R @@ -245,6 +245,13 @@ makeInstrList <- function(model, input, includeData = TRUE, use_vec = FALSE) { return(make_RinstrList(Rlist)) } +# The instrList for all nodes of a model, as used by model$calculate() etc. with no nodes. +# Whole variables keep the input compact (no expansion to node names), and makeInstrList +# drops RHS-only variables. nimble2 uses this as setup code for compiled calls with no nodes. +makeAllNodesInstrList <- function(model, includeData = TRUE) { + makeInstrList(model, model$getVarNames(), includeData = includeData) +} + # Check that each instruction fills as many idx slots as its declaration has loop indices. # That is the length of `idx` the declaration's per-node methods expect, and in compiled code # it determines which runners exist for the declaration (see declFunClass_.h). diff --git a/nimbleModel/R/modelBaseClass.R b/nimbleModel/R/modelBaseClass.R index 77b9d29..9ce4194 100644 --- a/nimbleModel/R/modelBaseClass.R +++ b/nimbleModel/R/modelBaseClass.R @@ -550,10 +550,8 @@ modelBase_nClass <- nClass( ) }, calc_op = function(instr, fn, fn_cpp) { - if (missing(instr)) { - instr <- getVarNames() - } - instrList <- makeInstrList(self, instr) + # No nodes means the whole model. + instrList <- if (missing(instr)) makeAllNodesInstrList(self) else makeInstrList(self, instr) if (isCompiled()) { if (inherits(instrList, "RinstrList") || !nCompiler:::isCompiled(instrList)) { instrList <- makeCompiledInstrList(instrList) @@ -580,10 +578,12 @@ modelBase_nClass <- nClass( return(logProb) }, simulate = function(instrList, includeData = FALSE) { - if (missing(instrList)) { - instrList <- getVarNames() + # No nodes means the whole model. + instrList <- if (missing(instrList)) { + makeAllNodesInstrList(self, includeData) + } else { + makeInstrList(self, instrList, includeData = includeData) } - instrList <- makeInstrList(self, instrList, includeData = includeData) if (is.null(instrList)) { return(invisible(NULL)) } diff --git a/nimbleModel/R/nimbleModel.R b/nimbleModel/R/nimbleModel.R index c541bb6..7edaf99 100644 --- a/nimbleModel/R/nimbleModel.R +++ b/nimbleModel/R/nimbleModel.R @@ -89,9 +89,8 @@ make_modelClass_from_nimbleModel <- function(modelDef, data, inits, name = NULL) unlist() |> unique() |> setdiff(c("idx", "paramID_", "boundID_", "LocalNewLogProb_", "LocalAns_", "model", "param_name_")) %||% character() - # Other method locals (e.g. in getValues_into_one) are named Local*_, and - # nFunction's handling of refArgs adds *_Ref__ names to the uncompiled bodies. - declVars <- declVars[!grepl("^Local[[:alnum:]]*_$", declVars) & !grepl("_Ref__$", declVars)] + # Other method locals (e.g. in getValues_into_one) are named Local*_. + declVars <- declVars[!grepl("^Local[[:alnum:]]*_$", declVars)] declVarInfo <- modelVarInfo$vars[declVars] declID <- as.numeric(declInfo$declRule$ID) # Formerly `sourceLineNumber`, which may not be unique. declFun_membername <- declFunNames[i] @@ -561,6 +560,8 @@ make_decl_method_nFxn <- function(f, name, returnType = "numericScalar") { argTypes = list(idx = "integerVector"), returnType = T(returnType), compileInfo = list(C_fun = Cfun), + refArgs = "idx", + control = list(updateArgPassing = FALSE) ) nFxn } @@ -688,7 +689,8 @@ make_decl_methods_from_declInfo <- function(declInfo) { # setValues_from_one(idx, LocalV_, LocalOff_): the reverse. # These do no checking. The loops over nodes, the offsets and the length checks are hand-coded # in declFunClass_.h, which calls these without virtual dispatch. -# The vector arguments (and idx) are passed by reference, so a loop over nodes doesn't copy them. +# The vector arguments (and idx) are passed by reference in C++, so a loop over nodes doesn't copy them. +# As for the other per-node methods, updateArgPassing = FALSE keeps the uncompiled versions by value. # # The compiled code depends on D, the number of ranges in the LHS: # D = 0 (scalar) and D = 1 use the LHS directly in DSL code. @@ -775,7 +777,7 @@ make_values_one_methods <- function(LHSrep) { C_set <- eval(substitute(function(idx, LocalV_, LocalOff_) BODY, list(BODY = C_set))) } - # Uncompiled versions. R has no pass by reference here, so getValues_into_one returns LocalOut_. + # Uncompiled versions. These take arguments by value (updateArgPassing = FALSE), so getValues_into_one returns LocalOut_. R_len <- substitute(function(idx) { return(length(LHS)) }, list(LHS = LHSrep)) |> eval() @@ -797,7 +799,8 @@ make_values_one_methods <- function(LHSrep) { compileInfo = list(C_fun = C_len), returnType = "numericScalar", # index arithmetic in the DSL is double; declFunClass_ casts to int argTypes = list(idx = "integerVector"), - refArgs = "idx" + refArgs = "idx", + control = list(updateArgPassing = FALSE) ), getValues_into_one = nFunction( name = "getValues_into_one", @@ -805,7 +808,8 @@ make_values_one_methods <- function(LHSrep) { compileInfo = list(C_fun = C_get), returnType = "void", argTypes = list(idx = "integerVector", LocalOut_ = "numericVector", LocalOff_ = "integerScalar"), - refArgs = c("idx", "LocalOut_") + refArgs = c("idx", "LocalOut_"), + control = list(updateArgPassing = FALSE) ), setValues_from_one = nFunction( name = "setValues_from_one", @@ -813,7 +817,8 @@ make_values_one_methods <- function(LHSrep) { compileInfo = list(C_fun = C_set), returnType = "void", argTypes = list(idx = "integerVector", LocalV_ = "numericVector", LocalOff_ = "integerScalar"), - refArgs = c("idx", "LocalV_") + refArgs = c("idx", "LocalV_"), + control = list(updateArgPassing = FALSE) ) ) } @@ -942,7 +947,9 @@ make_getParam_one_nFxn <- function(paramIDs = integer(0), exprs = list(), Rfun, compileInfo = list(C_fun = Cfun), returnType = "ETaccessor()", - argTypes = list(idx = "integerVector", paramID_ = "integerScalar") + argTypes = list(idx = "integerVector", paramID_ = "integerScalar"), + refArgs = "idx", + control = list(updateArgPassing = FALSE) ) } @@ -995,7 +1002,9 @@ make_getBound_one_nFxn <- function(boundExprs = list()) { Rfun, compileInfo = list(C_fun = Cfun), returnType = "numericScalar", - argTypes = list(idx = "integerVector", boundID_ = "integerScalar") + argTypes = list(idx = "integerVector", boundID_ = "integerScalar"), + refArgs = "idx", + control = list(updateArgPassing = FALSE) ) } diff --git a/nimbleModel/tests/testthat/test-instrSteps.R b/nimbleModel/tests/testthat/test-instrSteps.R index c03c229..3de04c1 100644 --- a/nimbleModel/tests/testthat/test-instrSteps.R +++ b/nimbleModel/tests/testthat/test-instrSteps.R @@ -249,3 +249,39 @@ test_that("compiled code can call the *_indexed_impl methods with an instrList_n } expect_error(caller$calc(7L), "outside") }) + +test_that("calculate, calculateDiff, getLogProb and simulate with no nodes use the whole model, uncompiled and compiled", { + code <- nimbleCode({ + mu ~ dnorm(0, sd = s) # s is RHS-only + for (i in 1:4) { + x[i] ~ dnorm(mu, 1) + w[i, 1:2] <- c(x[i], 2 * mu) + } + for (j in 1:3) y[j] ~ dnorm(x[j], 1) + }) + constants <- list(s = 2) + data <- list(y = c(0.5, -1, 2)) + inits <- list(mu = 0.2, x = c(0.1, -0.3, 1, 2)) + m <- nimbleModel(code, constants = constants, data = data, inits = inits) + cm <- nimbleModel(code, constants = constants, data = data, inits = inits, compile = TRUE) + all_nodes <- m$getNodeNames() + expected <- dnorm(0.2, 0, 2, log = TRUE) + sum(dnorm(inits$x, 0.2, 1, log = TRUE)) + + sum(dnorm(data$y, inits$x[1:3], 1, log = TRUE)) + for (model in list(m, cm)) { + expect_equal(model$calculate(), expected) + expect_equal(model$calculate(), model$calculate(all_nodes)) + expect_equal(model$getLogProb(), expected) + expect_equal(model$calculateDiff(), 0) + expect_equal(model$w[, 2], rep(0.4, 4)) + model$simulate() + expect_equal(model$y, data$y) # data are not simulated by default + expect_false(isTRUE(all.equal(model$x, inits$x))) + expect_equal(model$w[, 1], model$x) # deterministic nodes are simulated (calculated) + model$simulate(includeData = TRUE) + expect_false(isTRUE(all.equal(model$y, data$y))) + } + instrList <- nimbleModel:::makeAllNodesInstrList(m) + expect_equal(instrList$nNodes_total, length(all_nodes)) + instrList <- nimbleModel:::makeAllNodesInstrList(m, includeData = FALSE) + expect_equal(instrList$nNodes_total, length(all_nodes) - 3) +})