Implement Balanced Up-Down Walk (Akitaya et al 2026)

NAMESPACE

@@ -168,6 +168,7 @@ export(redist.splits)
 export(redist.subset)
 export(redist.uncoarsen)
 export(redist.wted.adj)
+export(redist_bud)
 export(redist_ci)
 export(redist_constr)
 export(redist_cyclewalk)

R/RcppExports.R

@@ -9,6 +9,10 @@ collapse_adj <- function(graph, idxs) {
     .Call(`_redist_collapse_adj`, graph, idxs)
 }
 
+bud_plans <- function(N, l, init, counties, pop, n_distr, target, lower, upper, compactness, constraints, control, edge_weights, thin, instep, verbosity) {
+    .Call(`_redist_bud_plans`, N, l, init, counties, pop, n_distr, target, lower, upper, compactness, constraints, control, edge_weights, thin, instep, verbosity)
+}
+
 coarsen_adjacency <- function(adj, groups) {
     .Call(`_redist_coarsen_adjacency`, adj, groups)
 }

R/confint.R

@@ -48,7 +48,7 @@
 #' @export
 redist_ci <- function(plans, x, district = 1L, conf = 0.9, by_chain = FALSE) {
     algo = attr(plans, "algorithm")
-    algos_ok = c("smc", "mergesplit", "cyclewalk", "flip")
+    algos_ok = c("smc", "mergesplit", "cyclewalk", "flip", "bud")
 
     x = enquo(x)
 

R/diagnostics.R

@@ -223,14 +223,17 @@ summary.redist_plans <- function(object, district = 1L, all_runs = TRUE, vi_max
             code <- str_glue("plot(<map object>, rowMeans(as.matrix({name}) == <bottleneck iteration>))")
             cli::cat_line("    ", cli::code_highlight(code, "Material"))
         }
-    } else if (algo %in% c("mergesplit", 'flip', 'cyclewalk')) {
+    } else if (algo %in% c("mergesplit", 'flip', 'cyclewalk', 'bud')) {
 
         if (algo == 'mergesplit') {
             cli::cli_text("{.strong Merge-Split MCMC:} {fmt_comma(n_samp)} sampled plans of {n_distr}
                  districts on {fmt_comma(nrow(plans_m))} units")
         } else if (algo == 'flip') {
             cli::cli_text("{.strong Flip MCMC:} {fmt_comma(n_samp)} sampled plans of {n_distr}
                  districts on {fmt_comma(nrow(plans_m))} units")
+        } else if (algo == 'bud') {
+            cli::cli_text("{.strong Balanced Up-Down Walk MCMC:} {fmt_comma(n_samp)} sampled plans of {n_distr}
+                 districts on {fmt_comma(nrow(plans_m))} units")
         } else {  # cyclewalk
             cli::cli_text("{.strong CycleWalk MCMC:} {fmt_comma(n_samp)} sampled plans of {n_distr}
                  districts on {fmt_comma(nrow(plans_m))} units")
@@ -240,6 +243,30 @@ summary.redist_plans <- function(object, district = 1L, all_runs = TRUE, vi_max
         accept_rate <- sprintf("%0.1f%%", 100*attr(object, "mh_acceptance"))
         cli::cli_text("Chain acceptance rate{?s}: {accept_rate}")
 
+        # BUD-specific diagnostics
+        if (algo == 'bud' && !is.null(all_diagn[[1]]$accept)) {
+            cat("\n")
+            cli::cli_text("{.strong BUD diagnostics:}")
+            for (i in seq_along(all_diagn)) {
+                diagn <- all_diagn[[i]]
+                n_accept <- diagn$accept
+                n_reject <- diagn$reject
+                n_trivial <- diagn$trivial
+                n_total <- n_accept + n_reject + n_trivial
+                if (length(all_diagn) > 1) {
+                    cli::cli_text("  Chain {i}:")
+                }
+                cat(sprintf("  Accepted: %d, Rejected: %d, Trivial: %d (total: %d)\n",
+                            n_accept, n_reject, n_trivial, n_total))
+                if (n_total > 0) {
+                    cat(sprintf("  Proposal success rate: %0.1f%%\n",
+                                100 * n_accept / n_total))
+                }
+                if (length(all_diagn) > 1 && i < length(all_diagn)) cat("\n")
+            }
+            cat("\n")
+        }
+
         # CycleWalk-specific diagnostics
         if (algo == 'cyclewalk' && !is.null(all_diagn[[1]]$accept_prob)) {
             cat("\n")