Nuts divergences fix

.github/workflows/tests.yaml

@@ -17,7 +17,7 @@ jobs:
       fail-fast: false
       matrix:
         config:
-          - {os: windows-latest, r: '4.4'}
+          - {os: windows-latest, r: '4.6'}
           - {os: macOS-latest,   r: 'release'}
           - {os: ubuntu-24.04,   r: 'release', rspm: "https://packagemanager.rstudio.com/cran/__linux__/noble/latest"}
           - {os: ubuntu-24.04,   r: 'devel',   rspm: "https://packagemanager.rstudio.com/cran/__linux__/noble/latest"}

make_package.R

@@ -13,6 +13,12 @@ setwd('~/github/nimble/nimbleHMC')
 
 devtools::document('nimbleHMC')
 
+## add `import(methods)` to NAMESPACE
+namespaceFilename <- 'nimbleHMC/NAMESPACE'
+namespace <- readLines(namespaceFilename)
+namespace <- c(namespace, 'import(methods)')
+writeLines(namespace, namespaceFilename)
+
 devtools::build('nimbleHMC')
 
 check('nimbleHMC')
@@ -21,7 +27,7 @@ suppressMessages(try(remove.packages('nimbleHMC'), silent = TRUE))
 (tarFiles <- grep('\\.tar\\.gz', list.files(), value = TRUE))
 (lastTarFile <- tarFiles[length(tarFiles)])
 message('installing package version ', gsub('\\.tar\\.gz$', '', lastTarFile))
-system(paste0('R CMD install ', lastTarFile))
+system(paste0('/usr/local/bin/R CMD install ', lastTarFile))
 
 ##devtools::install('nimbleHMC')
 

nimbleHMC/DESCRIPTION

@@ -1,7 +1,7 @@
 Package: nimbleHMC
 Title: Hamiltonian Monte Carlo and Other Gradient-Based MCMC Sampling Algorithms for 'nimble'
-Version: 0.2.4
-Date: 2025-12-15
+Version: 0.2.5
+Date: 2026-07-01
 Authors@R: c(person("Daniel", "Turek", role = c("aut", "cre"), email = "danielturek@gmail.com"),
 	     person("Perry", "de Valpine", role = "aut"),
 	     person("Christopher", "Paciorek", role = "aut"))

nimbleHMC/NAMESPACE

@@ -9,3 +9,4 @@ export(sampler_NUTS_classic)
 export(stateNL_NUTS)
 export(treebranchNL_NUTS)
 import(nimble)
+import(methods)

nimbleHMC/R/HMC_samplers.R

@@ -682,8 +682,6 @@ sampler_NUTS_classic <- nimbleFunction(
                 if(numDivergences  > 1) print('  [Note] NUTS_classic sampler (nodes: ', targetNodesToPrint, ') encountered ', numDivergences, ' divergent paths.')
                 if(numTimesMaxTreeDepth == 1) print('  [Note] NUTS_classic sampler (nodes: ', targetNodesToPrint, ') reached the maximum search tree depth ', numTimesMaxTreeDepth, ' time.')
                 if(numTimesMaxTreeDepth  > 1) print('  [Note] NUTS_classic sampler (nodes: ', targetNodesToPrint, ') reached the maximum search tree depth ', numTimesMaxTreeDepth, ' times.')
-                numDivergences <<- 0           ## reset counters for numDivergences and numTimesMaxTreeDepth,
-                numTimesMaxTreeDepth <<- 0     ## even when using reset=FALSE to continue the same chain
             }
             if(warningInd > 0) {
                 for(i in 1:warningInd) {
@@ -1077,7 +1075,10 @@ sampler_NUTS <- nimbleFunction(
                 new_H <- state_current$H
                 if(is.nan(new_H))   new_H <- Inf
                 deltaH <- new_H - H0
-                if(deltaH > deltaMax)   divergent <<- TRUE
+                if(deltaH > deltaMax) {
+                    divergent <<- TRUE
+                    numDivergences <<- numDivergences + 1
+                }
                 branch$log_sum_wt <- log_sum_exp(branch$log_sum_wt, -deltaH)
                 if((-deltaH) > 0)   sum_metropolis_prob <<- sum_metropolis_prob + 1
                 else                sum_metropolis_prob <<- sum_metropolis_prob + exp(-deltaH)
@@ -1283,8 +1284,6 @@ sampler_NUTS <- nimbleFunction(
                 if(numDivergences  > 1)        print('  [Note] NUTS sampler (nodes: ', targetNodesToPrint, ') encountered ', numDivergences, ' divergent paths.')
                 if(numTimesMaxTreeDepth == 1)  print('  [Note] NUTS sampler (nodes: ', targetNodesToPrint, ') reached the maximum search tree depth ', numTimesMaxTreeDepth, ' time.')
                 if(numTimesMaxTreeDepth  > 1)  print('  [Note] NUTS sampler (nodes: ', targetNodesToPrint, ') reached the maximum search tree depth ', numTimesMaxTreeDepth, ' times.')
-                numDivergences <<- 0           ## reset counters for numDivergences and numTimesMaxTreeDepth,
-                numTimesMaxTreeDepth <<- 0     ## even when using reset=FALSE to continue the same chain
             }
             if(warningInd > 0) {
                 for(i in 1:warningInd) {

nimbleHMC/tests/testthat/test-HMC.R

@@ -259,7 +259,7 @@ test_that('HMC on MVN node', {
     set.seed(0)
     samples <- runMCMC(Cmcmc, niter = 20000, nburnin = 10000)
     expect_equal(as.numeric(apply(samples, 2, mean)), c(10,20,30), tol = .001)
-    expect_equal(as.numeric(apply(samples, 2, var)), diag(solve(Q)), tol = .03)
+    expect_equal(as.numeric(apply(samples, 2, var)), diag(solve(Q)), tol = .065)
     ##
     cat(paste0('testing NUTS sampler\n'))
     Rmodel <- nimbleModel(code, constants, data, inits, buildDerivs = TRUE)