From 116801dece9cc322cdb632647558ac04200f61ca Mon Sep 17 00:00:00 2001 From: Christopher Paciorek Date: Fri, 5 Dec 2025 12:33:50 -0800 Subject: [PATCH 1/6] Remove Laplace-related tooling functions moved/kept in nimble. --- nimbleQuad/R/Laplace.R | 16 ++-- nimbleQuad/R/buildNestedApprox.R | 4 +- nimbleQuad/R/nodeUtils.R | 54 -------------- nimbleQuad/R/normTooling.R | 124 ------------------------------- 4 files changed, 10 insertions(+), 188 deletions(-) delete mode 100644 nimbleQuad/R/nodeUtils.R delete mode 100644 nimbleQuad/R/normTooling.R diff --git a/nimbleQuad/R/Laplace.R b/nimbleQuad/R/Laplace.R index 8f00053..e5c01e1 100644 --- a/nimbleQuad/R/Laplace.R +++ b/nimbleQuad/R/Laplace.R @@ -3293,7 +3293,7 @@ runAGHQ <- function(AGHQ, pStart, #' @param paramNodes a character vector of names of parameter nodes in the #' model; defaults are provided by \code{\link[nimble]{setupMargNodes}}. #' Alternatively, \code{paramNodes} can be a list in the format returned by -#' \code{setupMargNodes}, in which case \code{randomEffectsNodes}, +#' \code{\link[nimble]{setupMargNodes}}, in which case \code{randomEffectsNodes}, #' \code{calcNodes}, and \code{calcNodesOther} are not needed (and will be #' ignored). #' @param randomEffectsNodes a character vector of names of continuous @@ -3394,15 +3394,15 @@ runAGHQ <- function(AGHQ, pStart, #' match those here (except for a few arguments which are taken from control #' list elements here). #' -#' \code{setupMargNodes} tries to give sensible defaults from +#' \code{\link[nimble]{setupMargNodes}} tries to give sensible defaults from #' any combination of \code{paramNodes}, \code{randomEffectsNodes}, #' \code{calcNodes}, and \code{calcNodesOther} that are provided. For example, #' if you provide only \code{randomEffectsNodes} (perhaps you want to #' marginalize over only some of the random effects in your model), -#' \code{setupMargNodes} will try to determine appropriate choices for the +#' \code{\link[nimble]{setupMargNodes}} will try to determine appropriate choices for the #' others. #' -#' \code{setupMargNodes} also determines which integration dimensions are +#' \code{\link[nimble]{setupMargNodes}} also determines which integration dimensions are #' conditionally independent, i.e., which can be done separately from each #' other. For example, when possible, 10 univariate random effects will be split #' into 10 univariate integration problems rather than one 10-dimensional @@ -3420,16 +3420,16 @@ runAGHQ <- function(AGHQ, pStart, #' you must provide a \code{randomEffectsNodes} argument to indicate which #' they are. #' -#' It can be helpful to call \code{setupMargNodes} directly to see exactly how +#' It can be helpful to call \code{\link[nimble]{setupMargNodes}} directly to see exactly how #' nodes will be arranged for Laplace approximation. For example, you may want #' to verify the choice of \code{randomEffectsNodes} or get the order of #' parameters it has established to use for making sense of the MLE and #' results from the \code{summary} method. One can also call -#' \code{setupMargNodes}, customize the returned list, and then provide that +#' \code{\link[nimble]{setupMargNodes}}, customize the returned list, and then provide that #' to \code{buildLaplace} as \code{paramNodes}. In that case, -#' \code{setupMargNodes} will not be called (again) by \code{buildLaplace}. +#' \code{\link[nimble]{setupMargNodes}} will not be called (again) by \code{buildLaplace}. #' -#' If \code{setupMargNodes} is emitting an unnecessary warning, simply use +#' If \code{\link[nimble]{setupMargNodes}} is emitting an unnecessary warning, simply use #' \code{control=list(check=FALSE)}. #' #' @section Managing parameter transformations that may be used internally: diff --git a/nimbleQuad/R/buildNestedApprox.R b/nimbleQuad/R/buildNestedApprox.R index 01cd5f5..31c468a 100644 --- a/nimbleQuad/R/buildNestedApprox.R +++ b/nimbleQuad/R/buildNestedApprox.R @@ -106,12 +106,12 @@ #' Laplace approximation to marginalize over all continuous latent nodes #' (both random and fixed effects) in a model. #' -#' \code{buildNestedApprox} uses \code{setupMargNodes} (in a multi-step process) +#' \code{buildNestedApprox} uses \code{\link[nimble]{setupMargNodes}} (in a multi-step process) #' to try to give sensible defaults from #' any combination of \code{paramNodes}, \code{latentNodes}, #' \code{calcNodes}, and \code{calcNodesOther} that are provided. #' -#' \code{setupMargNodes} also determines which integration dimensions are +#' \code{\link[nimble]{setupMargNodes}} also determines which integration dimensions are #' conditionally independent, i.e., which can be done separately from each #' other. For example, when possible, 10 univariate random effects will be split #' into 10 univariate integration problems rather than one 10-dimensional diff --git a/nimbleQuad/R/nodeUtils.R b/nimbleQuad/R/nodeUtils.R deleted file mode 100644 index 10d9dd3..0000000 --- a/nimbleQuad/R/nodeUtils.R +++ /dev/null @@ -1,54 +0,0 @@ -## TODO: these might be moved to `nimble`. - -makeNodeString <- function(nodes, model) { - if (!length(nodes)) - return("") - elements <- model$expandNodeNames(nodes, returnScalarComponents = TRUE) - vars <- sapply(strsplit(elements, "[", fixed = TRUE), `[[`, 1) - nodesCount <- table(vars) - items <- elements[nodesCount[vars] == 1] - multiples <- names(nodesCount[nodesCount > 1]) - if(length(multiples)) - items <- c(items, paste0(multiples, " (", nodesCount[nodesCount > 1], " elements)")) - return(paste0(items, collapse = ", ")) -} - -splitLatents <- function(model, paramNodes, latentNodes, calcNodes, calcNodesOther, - control = list()) { - stochNodes <- model$getNodeNames(stochOnly = TRUE, includeData = FALSE) - discreteStochNodes <- model$isDiscrete(stochNodes) - if (any(discreteStochNodes)) - stop("splitLatents: found discrete non-data stochastic nodes in processing nodes for quadrature-based posterior approximation: ", - paste0(stochNodes[discreteStochNodes], collapse = ", "), ". Discrete non-data stochastic nodes cannot be handled by the posterior approximation algorithm.") - split <- extractControlElement(control, "split", TRUE) - check <- extractControlElement(control, "check", TRUE) - margNodes <- setupMargNodes(model = model, paramNodes = paramNodes, randomEffectsNodes = latentNodes, - calcNodes = calcNodes, calcNodesOther = calcNodesOther, split = split, check = check) - if (missing(paramNodes) && missing(latentNodes)) { - if (!missing(calcNodes) || !missing(calcNodesOther)) - messageIfVerbose(" [Note] Ignoring provide `calcNodes` and `calcNodesOther` because `paramNodes` and `latentNodes` not provided and are being determined automatically.") - paramNodes <- margNodes$paramNodes - latentNodes <- margNodes$randomEffectsNodes - deps <- model$getDependencies(latentNodes, includeData = FALSE, self = FALSE) - ## By default, we treat "siblings" of latent nodes as latents. - ## This attempts to have fixed effects in latents, - ## along with random effects. - newLatents <- model$getParents(deps, stochOnly = TRUE, includeData = FALSE) - paramNodes <- setdiff(paramNodes, newLatents) - latentNodes <- unique(c(latentNodes, newLatents)) - margNodes <- setupMargNodes(model = model, paramNodes = paramNodes, - randomEffectsNodes = latentNodes, split = split, check = check) - } - - return(margNodes) -} - -nodesToIndices <- function(node, approx) { - Rapprox <- ifelse(methods::is(approx, "nestedApprox"), approx, approx$Robject) - if (!node %in% Rapprox$paramNodesComponents) - stop("`", node, "` not found in model") - index <- paramNodesIndices[which(node == paramNodesComponents)] - if (index == 0) - stop("`", node, "` is part of a multivariate node for which the parameter transformation is not one-to one. Use `sampleLatentNodes()` to sample from the approximate posterior for the parameters.") - return(index) -} diff --git a/nimbleQuad/R/normTooling.R b/nimbleQuad/R/normTooling.R deleted file mode 100644 index 2af154e..0000000 --- a/nimbleQuad/R/normTooling.R +++ /dev/null @@ -1,124 +0,0 @@ -## Tooling that allows us to use known derivative information for latent -## normal nodes in Laplace, rather than computing via AD. - -getParam_BASE <- nimbleFunctionVirtual( - run = function() {}, - methods = list( - getMean = function(index = integer()) { - returnType(double(1)) - }, - getPrecision = function(index = integer()) { - returnType(double(2)) - }, - calcGradient = function(reTransform = double(1), index = integer(), first = integer(), - last = integer()) { - returnType(double(1)) - } - ) -) - -## A place holder to not take up much memory. -emptyParam <- nimbleFunction( - contains = getParam_BASE, - setup = function() {}, - run = function() {}, - methods = list( - getPrecision = function(index = integer()) { - returnType(double(2)) - return(matrix(1, nrow = 1, ncol = 1)) - }, - getMean = function(index = integer()) { - returnType(double(1)) - return(numeric(1, length = 1)) - }, - calcGradient = function(reTransform = double(1), index = integer(), first = integer(), - last = integer()) { - returnType(double(1)) - return(numeric(1, length = 1)) - } - ) -) - -## Need at least one dnorm to use this. NodeNames relate to node names in the -## model that are dmnrom distributed gNodes (length of all randomEffectsNodes) -## indicates a 1 if dmnorm, 0 o/w. This makes it easy to get the correct -## indices when I just pass it the random-effect index in a loop. -gaussParam <- nimbleFunction( - contains = getParam_BASE, - setup = function(model, nodeNames, gNodes) { - indexConvert <- cumsum(gNodes) - }, - run = function() {}, - methods = list( - getPrecision = function(index = integer()) { - i <- indexConvert[index] - Q <- matrix(model$getParam(nodeNames[i], "tau"), nrow = 1, ncol = 1) - returnType(double(2)) - return(Q) - }, - getMean = function(index = integer()) { - i <- indexConvert[index] - mu <- numeric(model$getParam(nodeNames[i], "mean"), length = 1) - returnType(double(1)) - return(mu) - }, - ## Avoid too much memory creation by adding this internal. - calcGradient = function(reTransform = double(1), index = integer(), first = integer(), - last = integer()) { - i <- indexConvert[index] - ans <- -model$getParam(nodeNames[i], "tau") * (reTransform[first] - - model$getParam(nodeNames[i], "mean")) - returnType(double(1)) - return(numeric(value = ans, length = 1)) - } - ) -) - -## Need at least one dmnorm to use this. NodeNames relate to node names in the -## model that are dmnrom distributed gNodes (length of all randomEffectsNodes) -## indicates a 1 if dmnorm, 0 o/w. This makes it easy to get the correct -## indices when I just pass it the random-effect index in a loop. -multiGaussParam <- nimbleFunction( - contains = getParam_BASE, - setup = function(model, nodeNames, gNodes) { - indexConvert <- cumsum(gNodes) - if(length(indexConvert) == 1) - indexConvert <- c(indexConvert, -1) - }, - run = function() {}, - methods = list( - getPrecision = function(index = integer()) { - i <- indexConvert[index] - Q <- model$getParam(nodeNames[i], "prec") - returnType(double(2)) - return(Q) - }, - getMean = function(index = integer()) { - i <- indexConvert[index] - mu <- model$getParam(nodeNames[i], "mean") - returnType(double(1)) - return(mu) - }, - ## Avoid too much memory creation by adding this internal. - calcGradient = function(reTransform = double(1), index = integer(), first = integer(), - last = integer()) { - i <- indexConvert[index] - bstar <- (reTransform[first:last] - model$getParam(nodeNames[i], "mean")) - Q <- model$getParam(nodeNames[i], "prec") - ans <- -(Q %*% bstar)[, 1] - - ## This assumes use of dmnormAD, where `prec` is "free". - ## If we somehow wanted to use this with `dmnorm`, we should - ## create a version of this that uses `cholesky`: - ## U <- model$getParam(nodeNames[i], "cholesky") - ## if (model$getParam(nodeNames[i], "prec_param") == 1) { - ## ans <- -(t(U) %*% (U %*% bstar))[, 1] - ## } else { - ## ans <- -backsolve(U, forwardsolve(t(U), bstar)) - ## } - - returnType(double(1)) - return(ans) - } - ) -) From 89862ca5b9a453ce88a9ffbc0237551ea43be80a Mon Sep 17 00:00:00 2001 From: Christopher Paciorek Date: Fri, 5 Dec 2025 15:10:32 -0800 Subject: [PATCH 2/6] Remove deleted files from DESC collate. --- nimbleQuad/DESCRIPTION | 2 -- 1 file changed, 2 deletions(-) diff --git a/nimbleQuad/DESCRIPTION b/nimbleQuad/DESCRIPTION index afe4c10..2747f3f 100644 --- a/nimbleQuad/DESCRIPTION +++ b/nimbleQuad/DESCRIPTION @@ -22,9 +22,7 @@ RoxygenNote: 7.3.2 Collate: quadratureRules.R quadratureGrids.R - nodeUtils.R Laplace.R buildNestedApprox.R runNestedApprox.R summaryUtils.R - normTooling.R From c21bb1618190b4058c869e9bc5245c8905de357d Mon Sep 17 00:00:00 2001 From: Christopher Paciorek Date: Fri, 12 Dec 2025 07:39:08 -0800 Subject: [PATCH 3/6] Update nimble requirement. --- install_requirements.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/install_requirements.R b/install_requirements.R index d8c0727..ee6e9c2 100644 --- a/install_requirements.R +++ b/install_requirements.R @@ -25,6 +25,6 @@ install.packages('lme4', type = 'source') ## later, remove below: install.packages('devtools') library(devtools) -devtools::install_github('nimble-dev/nimble', ref = 'no-laplace', subdir = 'packages/nimble', INSTALL_opts = c("--install-tests")) +devtools::install_github('nimble-dev/nimble', ref = 'devel', subdir = 'packages/nimble', INSTALL_opts = c("--install-tests")) ## remove until here From fbae0074d5db5cf6ab3b73caa16486eb79e62aa4 Mon Sep 17 00:00:00 2001 From: Christopher Paciorek Date: Sat, 13 Dec 2025 09:59:38 -0800 Subject: [PATCH 4/6] Install nimble from CRAN now that 1.4.0 up. --- install_requirements.R | 12 +++--------- 1 file changed, 3 insertions(+), 9 deletions(-) diff --git a/install_requirements.R b/install_requirements.R index ee6e9c2..0073a2c 100644 --- a/install_requirements.R +++ b/install_requirements.R @@ -4,27 +4,21 @@ requirements <- c( 'igraph', 'coda', 'R6', - ##'nimble', ## add back in later + 'nimble', 'testthat', 'pracma', ## for AD 'numDeriv', ## for AD 'mvQuad', 'RTMB', 'polynom' - ## 'lme4' ## for test-ADlaplace.R + ## 'lme4' ) for(package in requirements) { install.packages(package) } -## Apparently a bug in Matrix (as of early 2024) is causing an issue (https://bioconductor.org/packages/devel/bioc/vignettes/dreamlet/inst/doc/errors.html) that is causing test-ADlaplace.R failures when fitting a model with lmer. +## Apparently a bug in Matrix (as of early 2024) is causing an issue (https://bioconductor.org/packages/devel/bioc/vignettes/dreamlet/inst/doc/errors.html) that is causing Laplace test failures when fitting a model with lmer. install.packages('lme4', type = 'source') -## later, remove below: -install.packages('devtools') -library(devtools) -devtools::install_github('nimble-dev/nimble', ref = 'devel', subdir = 'packages/nimble', INSTALL_opts = c("--install-tests")) -## remove until here - From bede8f2c665f572823dbf9f097dee2bb9f1cca6e Mon Sep 17 00:00:00 2001 From: Christopher Paciorek Date: Sat, 13 Dec 2025 10:25:53 -0800 Subject: [PATCH 5/6] Install NIMBLE tests for CI. --- install_requirements.R | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/install_requirements.R b/install_requirements.R index 0073a2c..0e6e7fc 100644 --- a/install_requirements.R +++ b/install_requirements.R @@ -4,7 +4,6 @@ requirements <- c( 'igraph', 'coda', 'R6', - 'nimble', 'testthat', 'pracma', ## for AD 'numDeriv', ## for AD @@ -18,6 +17,9 @@ for(package in requirements) { install.packages(package) } +## We need NIMBLE's tests installed for `{AD_,}test_utils.R`. +install.packages('nimble', INSTALL_opts = '--install-tests') + ## Apparently a bug in Matrix (as of early 2024) is causing an issue (https://bioconductor.org/packages/devel/bioc/vignettes/dreamlet/inst/doc/errors.html) that is causing Laplace test failures when fitting a model with lmer. install.packages('lme4', type = 'source') From ea4811ffc98b60ede0916c434ef463c0577a6778 Mon Sep 17 00:00:00 2001 From: Christopher Paciorek Date: Sat, 13 Dec 2025 10:42:00 -0800 Subject: [PATCH 6/6] Remove sourcing of {AD_}test_utils.R. --- install_requirements.R | 6 ++---- nimbleQuad/tests/testthat/test-AGHQ.R | 2 -- nimbleQuad/tests/testthat/test-laplace.R | 2 -- nimbleQuad/tests/testthat/test-laplace2.R | 2 -- nimbleQuad/tests/testthat/test-laplace3.R | 2 -- nimbleQuad/tests/testthat/test-nested-fit.R | 2 -- nimbleQuad/tests/testthat/test-nested-interface.R | 2 -- nimbleQuad/tests/testthat/test-quadrature.R | 2 -- 8 files changed, 2 insertions(+), 18 deletions(-) diff --git a/install_requirements.R b/install_requirements.R index 0e6e7fc..cc5b291 100644 --- a/install_requirements.R +++ b/install_requirements.R @@ -9,7 +9,8 @@ requirements <- c( 'numDeriv', ## for AD 'mvQuad', 'RTMB', - 'polynom' + 'polynom', + 'nimble' ## 'lme4' ) @@ -17,9 +18,6 @@ for(package in requirements) { install.packages(package) } -## We need NIMBLE's tests installed for `{AD_,}test_utils.R`. -install.packages('nimble', INSTALL_opts = '--install-tests') - ## Apparently a bug in Matrix (as of early 2024) is causing an issue (https://bioconductor.org/packages/devel/bioc/vignettes/dreamlet/inst/doc/errors.html) that is causing Laplace test failures when fitting a model with lmer. install.packages('lme4', type = 'source') diff --git a/nimbleQuad/tests/testthat/test-AGHQ.R b/nimbleQuad/tests/testthat/test-AGHQ.R index 4428760..4a18612 100644 --- a/nimbleQuad/tests/testthat/test-AGHQ.R +++ b/nimbleQuad/tests/testthat/test-AGHQ.R @@ -1,7 +1,5 @@ library(nimbleQuad) # Tests of AGH Quadrature approximation -source(system.file(file.path('tests', 'testthat', 'test_utils.R'), package = 'nimble')) -source(system.file(file.path('tests', 'testthat', 'AD_test_utils.R'), package = 'nimble')) EDopt <- nimbleOptions("enableDerivs") BMDopt <- nimbleOptions("buildModelDerivs") nimbleOptions(enableDerivs = TRUE) diff --git a/nimbleQuad/tests/testthat/test-laplace.R b/nimbleQuad/tests/testthat/test-laplace.R index e8fc406..4fa3e18 100644 --- a/nimbleQuad/tests/testthat/test-laplace.R +++ b/nimbleQuad/tests/testthat/test-laplace.R @@ -1,7 +1,5 @@ library(nimbleQuad) # to get nimbleQuad's names first # Tests of Laplace approximation -source(system.file(file.path('tests', 'testthat', 'test_utils.R'), package = 'nimble')) -source(system.file(file.path('tests', 'testthat', 'AD_test_utils.R'), package = 'nimble')) EDopt <- nimbleOptions("enableDerivs") BMDopt <- nimbleOptions("buildModelDerivs") nimbleOptions(enableDerivs = TRUE) diff --git a/nimbleQuad/tests/testthat/test-laplace2.R b/nimbleQuad/tests/testthat/test-laplace2.R index d61bbd5..cdae6b5 100644 --- a/nimbleQuad/tests/testthat/test-laplace2.R +++ b/nimbleQuad/tests/testthat/test-laplace2.R @@ -1,7 +1,5 @@ library(nimbleQuad) # to get nimbleQuad's names first # Tests of Laplace approximation -source(system.file(file.path('tests', 'testthat', 'test_utils.R'), package = 'nimble')) -source(system.file(file.path('tests', 'testthat', 'AD_test_utils.R'), package = 'nimble')) EDopt <- nimbleOptions("enableDerivs") BMDopt <- nimbleOptions("buildModelDerivs") nimbleOptions(enableDerivs = TRUE) diff --git a/nimbleQuad/tests/testthat/test-laplace3.R b/nimbleQuad/tests/testthat/test-laplace3.R index eb666bf..9103da2 100644 --- a/nimbleQuad/tests/testthat/test-laplace3.R +++ b/nimbleQuad/tests/testthat/test-laplace3.R @@ -1,7 +1,5 @@ library(nimbleQuad) # to get nimbleQuad's names first # Tests of Laplace approximation -source(system.file(file.path('tests', 'testthat', 'test_utils.R'), package = 'nimble')) -source(system.file(file.path('tests', 'testthat', 'AD_test_utils.R'), package = 'nimble')) EDopt <- nimbleOptions("enableDerivs") BMDopt <- nimbleOptions("buildModelDerivs") nimbleOptions(enableDerivs = TRUE) diff --git a/nimbleQuad/tests/testthat/test-nested-fit.R b/nimbleQuad/tests/testthat/test-nested-fit.R index cc1a2c3..a285fe6 100644 --- a/nimbleQuad/tests/testthat/test-nested-fit.R +++ b/nimbleQuad/tests/testthat/test-nested-fit.R @@ -1,5 +1,3 @@ -source(system.file(file.path('tests', 'testthat', 'test_utils.R'), package = 'nimble')) -source(system.file(file.path('tests', 'testthat', 'AD_test_utils.R'), package = 'nimble')) EDopt <- nimbleOptions("enableDerivs") BMDopt <- nimbleOptions("buildModelDerivs") nimbleOptions(enableDerivs = TRUE) diff --git a/nimbleQuad/tests/testthat/test-nested-interface.R b/nimbleQuad/tests/testthat/test-nested-interface.R index b3cefbb..8067979 100644 --- a/nimbleQuad/tests/testthat/test-nested-interface.R +++ b/nimbleQuad/tests/testthat/test-nested-interface.R @@ -1,5 +1,3 @@ -source(system.file(file.path('tests', 'testthat', 'test_utils.R'), package = 'nimble')) -source(system.file(file.path('tests', 'testthat', 'AD_test_utils.R'), package = 'nimble')) EDopt <- nimbleOptions("enableDerivs") BMDopt <- nimbleOptions("buildModelDerivs") nimbleOptions(enableDerivs = TRUE) diff --git a/nimbleQuad/tests/testthat/test-quadrature.R b/nimbleQuad/tests/testthat/test-quadrature.R index 28de1c7..4ffbb85 100644 --- a/nimbleQuad/tests/testthat/test-quadrature.R +++ b/nimbleQuad/tests/testthat/test-quadrature.R @@ -1,5 +1,3 @@ -library(nimbleQuad) -library(testthat) # Tests of Quadrature Rules and Grids for numerical integration: test_that("Check Basic Quad Rules work.", {