From 0e6b04e5af85be848e1a0ee61d69901cf609cca0 Mon Sep 17 00:00:00 2001 From: "Philip W. O'Sullivan" Date: Fri, 19 Jul 2024 17:11:59 -0400 Subject: [PATCH 001/324] small tweak to readme --- README.Rmd | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/README.Rmd b/README.Rmd index 4e9c4122c..cc5bf0393 100644 --- a/README.Rmd +++ b/README.Rmd @@ -121,3 +121,8 @@ A more detailed introduction to redistricting methods and the package can be found in the [Get Started](https://alarm-redist.org/redist/articles/redist.html) page. The package [vignettes](https://alarm-redist.org/redist/articles/) contain more detailed information and guides to specific workflows. + + +## About This Branch + +Working on adding a more generalized SMC version. From 2deabd82eee146441377e94a467caedce3185c9b Mon Sep 17 00:00:00 2001 From: "Philip W. O'Sullivan" Date: Thu, 29 Aug 2024 13:07:35 -0400 Subject: [PATCH 002/324] adding code for gsmc method --- R/redist_gsmc.R | 267 +++++++++++ src/generalized_smc.cpp | 808 ++++++++++++++++++++++++++++++++ src/generalized_smc.h | 44 ++ src/generalized_smc_helpers.cpp | 308 ++++++++++++ src/redist_types.cpp | 73 +++ 5 files changed, 1500 insertions(+) create mode 100644 R/redist_gsmc.R create mode 100644 src/generalized_smc.cpp create mode 100644 src/generalized_smc.h create mode 100644 src/generalized_smc_helpers.cpp create mode 100644 src/redist_types.cpp diff --git a/R/redist_gsmc.R b/R/redist_gsmc.R new file mode 100644 index 000000000..393968a0b --- /dev/null +++ b/R/redist_gsmc.R @@ -0,0 +1,267 @@ +##################################################### +# Author: Philip O'Sullivan +# Institution: Harvard University +# Date Created: 2024/08/18 +# Purpose: tidy R wrapper to run gSMC redistricting code +#################################################### + + +#' gSMC Redistricting Sampler +#' +#' +#' @return `redist_smc` returns a [redist_plans] object containing the simulated +#' plans. +#' +#' @export +redist_gsmc <- function(state_map, M, counties = NULL, k_param_val = 6, + resample = TRUE, runs = 1L, ncores = 0L, + verbose = FALSE, silent = FALSE){ + N <- attr(state_map, "ndists") + # no constraints + constraints = list() + + + # make controls intput + lags <- 1 + unique(round((N - 1)^0.8*seq(0, 0.7, length.out = 4)^0.9)) + control = list(lags=lags) + + # verbosity stuff + verbosity <- 1 + if (verbose) verbosity <- 3 + if (silent) verbosity <- 0 + + + # get the map in adjacency form + map <- validate_redist_map(state_map) + V <- nrow(state_map) + adj_list <- get_adj(state_map) + + + + + counties <- rlang::eval_tidy(rlang::enquo(counties), map) + if (is.null(counties)) { + counties <- rep(1, V) + } else { + if (any(is.na(counties))) + cli_abort("County vector must not contain missing values.") + + # handle discontinuous counties + component <- contiguity(adj_list, vctrs::vec_group_id(counties)) + counties <- dplyr::if_else(component > 1, + paste0(as.character(counties), "-", component), + as.character(counties)) %>% + as.factor() %>% + as.integer() + if (any(component > 1)) { + cli_warn("Counties were not contiguous; expect additional splits.") + } + } + + + + # get population stuff + pop_bounds <- attr(map, "pop_bounds") + pop <- map[[attr(map, "pop_col")]] + if (any(pop >= pop_bounds[3])) { + too_big <- as.character(which(pop >= pop_bounds[3])) + cli_abort(c("Unit{?s} {too_big} ha{?ve/s/ve} + population larger than the district target.", + "x" = "Redistricting impossible.")) + } + + # compute lags thing + lags <- 1 + unique(round((N - 1)^0.8*seq(0, 0.7, length.out = 4)^0.9)) + + + # set up parallel + ncores_max <- parallel::detectCores() + ncores_runs <- min(ncores_max, runs) + ncores_per <- as.integer(ncores) + if (ncores_per == 0) { + if (M/100*length(adj_list)/200 < 20) { + ncores_per <- 1L + } else { + ncores_per <- floor(ncores_max/ncores_runs) + } + } + + + if (ncores_runs > 1) { + `%oper%` <- `%dorng%` + of <- if (Sys.info()[["sysname"]] == "Windows") { + tempfile(pattern = paste0("smc_", substr(Sys.time(), 1, 10)), fileext = ".txt") + } else { + "" + } + + if (!silent) + cl <- makeCluster(ncores_runs, outfile = of, methods = FALSE, + useXDR = .Platform$endian != "little") + else + cl <- makeCluster(ncores_runs, methods = FALSE, + useXDR = .Platform$endian != "little") + doParallel::registerDoParallel(cl, cores = ncores_runs) + on.exit(stopCluster(cl)) + } else { + `%oper%` <- `%do%` + } + + + + t1 <- Sys.time() + all_out <- foreach(chain = seq_len(runs), .inorder = FALSE, .packages="redist") %oper% { + + + run_verbosity <- if (chain == 1) verbosity else 0 + t1_run <- Sys.time() + + algout <- redist::generalized_smc_plans( + N=N, + adj_list=adj_list, + counties=counties, + pop=pop, + target=pop_bounds[2], + lower=pop_bounds[1], + upper=pop_bounds[3], + M=M, + k_param = k_param_val, + control = control, + ncores = as.integer(ncores_per), + verbosity=run_verbosity) + + + if (length(algout) == 0) { + cli::cli_process_done() + cli::cli_process_done() + } + + # add a plans matrix + # IMPORTANT: make it 1 indexed + algout$plans <- matrix( + unlist(algout$region_ids_mat[[N-1]]), + ncol = length(algout$region_ids_mat[[N-1]]), + byrow = FALSE) + 1 + + # make parent mat into matrix + algout$parent_index <- matrix( + unlist(algout$parent_index), + ncol = length(algout$parent_index), + byrow = FALSE) + + # pull out the log weights + # IDK why its negative + lr <- algout$log_incremental_weights_mat[[N-1]] + + wgt <- exp(lr - mean(lr)) + n_eff <- length(wgt)*mean(wgt)^2/mean(wgt^2) + + if (any(is.na(lr))) { + cli_abort(c("Sampling probabilities have been corrupted.", + "*" = "Check that none of your constraint weights are too large. + The output of constraint functions multiplied by the weight + should generally fall in the -5 to 5 range.", + "*" = "If you are using custom constraints, make sure that your + constraint function handles all edge cases and never returns + {.val {NA}} or {.val {Inf}}", + "*" = "If you are not using any constraints, please call + {.code rlang::trace_back()} and file an issue at + {.url https://github.com/alarm-redist/redist/issues/new}")) + } + + + + if (resample) { + normalized_wgts <- wgt/sum(wgt) + n_eff <- 1/sum(normalized_wgts^2) + + rs_idx <- resample_lowvar(normalized_wgts) + n_unique <- dplyr::n_distinct(rs_idx) + algout$plans <- algout$plans[, rs_idx, drop = FALSE] + + algout$ancestors <- algout$ancestors[rs_idx, , drop = FALSE] + storage.mode(algout$ancestors) <- "integer" + } + + storage.mode(algout$plans) <- "integer" + t2_run <- Sys.time() + + + if (!is.nan(n_eff) && n_eff/M <= 0.05) + cli_warn(c("Less than 5% resampling efficiency.", + "*" = "Increase the number of samples.", + "*" = "Consider weakening or removing constraints.", + "i" = "If sampling efficiency drops precipitously in the final + iterations, population balance is likely causing a bottleneck. + Try increasing {.arg pop_temper} by 0.01.", + "i" = "If sampling efficiency declines steadily across iterations, + adjusting {.arg seq_alpha} upward may help a bit.")) + + # add the numerically stable weights back + algout$wgt <- wgt + + # add diagnostic stuff + algout$l_diag <- list( + n_eff = n_eff, + step_n_eff = algout$step_n_eff, + adapt_k_thresh = .99, # adapt_k_thresh, NEED TO DEAL WITH + est_k = rep(k_param_val, N-1), # algout$est_k, + accept_rate = algout$acceptance_rates, + sd_lp = c( + sapply(algout$log_incremental_weights_mat, sd) , sd(lr) + ), + sd_temper = rep(NA, N-1), # algout$sd_temper, + unique_survive = c(algout$nunique_parent_indices, n_unique), + ancestors = algout$ancestors, + seq_alpha = .99, + pop_temper = 0, + runtime = as.numeric(t2_run - t1_run, units = "secs"), + district_str_labels = algout$final_region_labs, + nunique_original_ancestors = algout$nunique_original_ancestors, + parent_index_mat = algout$parent_index, + region_dvals_mat = algout$region_dvals_mat, + log_incremental_weights_mat = algout$log_incremental_weights_mat, + region_ids_mat = algout$region_ids_mat, + draw_tries_mat = algout$draw_tries_mat + ) + + algout + + } + + if (verbosity >= 2) { + t2 <- Sys.time() + cli_text("{format(M*runs, big.mark=',')} plans sampled in + {format(t2-t1, digits=2)}") + } + + + plans <- do.call(cbind, lapply(all_out, function(x) x$plans)) + wgt <- do.call(c, lapply(all_out, function(x) x$wgt)) + l_diag <- lapply(all_out, function(x) x$l_diag) + n_dist_act <- dplyr::n_distinct(plans[, 1]) # actual number (for partial plans) + + + out <- new_redist_plans(plans, map, "gsmc", wgt, resample, + ndists = N, + n_eff = all_out[[1]]$n_eff, + compactness = 1, + constraints = constraints, + version = packageVersion("redist"), + diagnostics = l_diag, + pop_bounds = pop_bounds) + + + if (runs > 1) { + out <- mutate(out, chain = rep(seq_len(runs), each = n_dist_act*M)) %>% + dplyr::relocate('chain', .after = "draw") + } + + exist_name <- attr(map, "existing_col") + if (!is.null(exist_name) && !isFALSE(ref_name) && ndists == final_dists) { + ref_name <- if (!is.null(ref_name)) ref_name else exist_name + out <- add_reference(out, map[[exist_name]], ref_name) + } + + out +} diff --git a/src/generalized_smc.cpp b/src/generalized_smc.cpp new file mode 100644 index 000000000..876d9420b --- /dev/null +++ b/src/generalized_smc.cpp @@ -0,0 +1,808 @@ +#include "generalized_smc.h" + + +//' Attempts to cut one region into two from spanning tree +//' +//' Takes a spanning tree `ust` drawn on a specific region and attempts to cut +//' it to produce two new regions using the generalized splitting procedure +//' outlined . This function is based on `cut_districts` in `smc.cpp` +//' +//' @title Attempt Generalized Region split +//' +//' @param ust A directed spanning tree passed by reference +//' @param root The root of the spanning tree +//' @param pop Vector of mapping vertices to population (0-indexed) +//' @param plan A plan object +//' @param region_to_split The label of the region in the plan object we're attempting to split +//' @param lower Acceptable lower bounds on district population +//' @param upper Acceptable upper bounds on district population +//' @param target Target population (probably Total population of map/Num districts ) +//' @param new_region_labels A vector that will be updated by reference to contain the names of +//' the two new split regions if function is successful. +//' +//' @details Modifications +//' - If two new valid regions are split then the plan object is updated accordingly +//' - If two new valid regions are split then the new_region_labels is updated so the +//' first entry is the first new region and the second entry is the second new region +//' +//' @return True if two valid regions were split off false otherwise +//' +bool cut_regions(Tree &ust, int k_param, int root, + const uvec &pop, + Plan &plan, const std::string region_to_split, + double lower, double upper, double target, + std::vector &new_region_labels){ + // Get population of region being split + double total_pop = plan.r_to_pop_map.at(region_to_split); + // Get the number of final districts in region being split + int num_final_districts = plan.r_to_d_map.at(region_to_split); + + // Rcout << "For " << region_to_split << " Total pop is " << total_pop << " and d_nk is " << num_final_districts << "\n"; + + // create list that points to parents & computes population below each vtx + std::vector pop_below(plan.V, 0); + std::vector parent(plan.V); + parent[root] = -1; + tree_pop(ust, root, pop, pop_below, parent); + + // compile a list of: + std::vector candidates; // candidate edges to cut, + std::vector deviances; // how far from target pop. + std::vector is_ok; // whether they meet constraints + std::vector new_d_val; // the new d_n,k value + + // Reserve at least as much space for top k_param of them + candidates.reserve(k_param); + deviances.reserve(k_param); + is_ok.reserve(k_param); + new_d_val.reserve(k_param); + + if(plan.region_labels.at(root) != region_to_split){ + Rcout << "Root vertex is not in region to split!"; + } + + + + // Now loop over all valid edges to cut + for (int i = 1; i <= plan.V; i++) { // 1-indexing here + // Ignore any vertex not in this region or the root vertex as we wont be cutting those + if (plan.region_labels.at(i-1) != region_to_split || i - 1 == root) continue; + + // Get the population of one side of the partition removing that edge would cause + double below = pop_below.at(i - 1); + // Get the population of the other side + double above = total_pop - below; + + // vectors to keep track of value for each d_{n,k} + std::vector devs(num_final_districts-1); + std::vector dev2_bigger(num_final_districts-1); + std::vector are_ok(num_final_districts-1); + + + // Now try each potential d_nk value from 1 up to d_n-1,k -1 + // woops fell for 1 instead of 0 indexing error + for(int potential_d = 1; potential_d < num_final_districts; potential_d++){ + + double dev1 = std::fabs(below - target * potential_d); + double dev2 = std::fabs(above - target * potential_d); + + /* + Rcout << "\nit is " << dev1 << " and " << dev2 << " for " << potential_d << "\n"; + Rcout << std::printf( + "We are on d = %d and upper is %f while lower is %f \n", + potential_d, above, below); + */ + + are_ok[potential_d-1] = lower * potential_d < above && above < upper * potential_d; + + // If dev1 is smaller then we assign d_nk to below + if (dev1 < dev2) { + devs[potential_d-1] = dev1; + dev2_bigger[potential_d-1] = true; + // check in bounds + are_ok[potential_d-1] = lower * potential_d <= below + && below <= upper * potential_d + && lower * (num_final_districts - potential_d) <= above + && above <= upper * (num_final_districts - potential_d); + } else { // Else if dev2 is smaller we assign d_nk to above + devs[potential_d-1] = dev2; + dev2_bigger[potential_d-1] = false; + are_ok[potential_d-1] = lower * potential_d <= above + && above <= upper * potential_d + && lower * (num_final_districts - potential_d) <= below + && below <= upper * (num_final_districts - potential_d); + } + + } + + /* + Rcout << "The full vector is "; + for (auto i: devs) + Rcout << i << ' '; + Rcout << "\n"; + */ + + // Now find the value of d_{n,k} that has the smallest deviation + + std::vector::iterator result = std::min_element(devs.begin(), devs.end()); + int best_potential_d = std::distance(devs.begin(), result); + + /* + Rcout << "min element has value " << *result << " and index [" + << best_potential_d << "]\n"; + */ + + if(dev2_bigger[best_potential_d]){ + candidates.push_back(i); + } else{ + candidates.push_back(-i); + } + + deviances.push_back(devs[best_potential_d]); + is_ok.push_back(are_ok[best_potential_d]); + new_d_val.push_back(best_potential_d+1); + + } + + + if((int) candidates.size() < k_param){ + return false; + } + + int idx = r_int(k_param); + idx = select_k(deviances, idx + 1); + int cut_at = std::fabs(candidates[idx]) - 1; + + + // Rcout << deviances[idx] << "\n"; + // Rcout << is_ok[idx] << " howdy \n"; + // Rcout << "top k element has value " << deviances[idx] << "\n"; + + + // reject sample if not ok + if (!is_ok[idx]){ + return false; + } + + /* + Rcout << "Testing this " << region_to_split + ".R2" << " \n"; + Rcout << "We have Final d =" << new_d_val[idx] << " and " << num_final_districts - new_d_val[idx] << "\n"; + */ + + // find index of node to cut at + std::vector *siblings = &ust[parent[cut_at]]; + int length = siblings->size(); + int j; + for (j = 0; j < length; j++) { + if ((*siblings)[j] == cut_at) break; + } + + siblings->erase(siblings->begin()+j); // remove edge + parent[cut_at] = -1; + + + // update plan with new regions + plan.num_regions++; // increase region count by 1 + plan.num_multidistricts--; // Decrease by one to avoid double counting later + + // Create info for two new districts + int new_region1_d = new_d_val[idx]; + int new_region2_d = num_final_districts - new_region1_d; + + std::string new_region_label1; + std::string new_region_label2; + + // Set label and count depending on if district or multi district + if(new_region1_d == 1){ + plan.num_districts++; + new_region_label1 = region_to_split + "." + std::to_string(plan.num_districts); + }else{ + new_region_label1 = region_to_split + ".R1"; + plan.num_multidistricts++; + } + + // Now do it for second region + if(new_region2_d == 1){ + plan.num_districts++; + new_region_label2 = region_to_split + "." + std::to_string(plan.num_districts); + }else{ + new_region_label2 = region_to_split + ".R2"; + plan.num_multidistricts++; + } + + // Check whether the new regions are districts or multidistricts + + + // Vertex to start traversing tree for updating later + int tree_vertex1; + int tree_vertex2; + + // population and d_nk of new regions + double new_region1_pop; + double new_region2_pop; + + + if (candidates[idx] > 0) { // Means cut below so first vertex is cut_at + tree_vertex1 = cut_at; + tree_vertex2 = root; + + // Set the new populations + new_region1_pop = pop_below.at(cut_at); + new_region2_pop = total_pop - new_region1_pop; + + // return pop_below.at(cut_at); + } else { // Means cut above so first vertex is root + tree_vertex1 = root; + tree_vertex2 = cut_at; + + // Set the new populations + new_region2_pop = pop_below.at(cut_at); + new_region1_pop = total_pop - new_region2_pop; + + } + + bool pop_testing = new_region1_pop/new_region1_d >= lower && new_region1_pop/new_region1_d <= upper && + new_region2_pop/new_region2_d >= lower && new_region2_pop/new_region2_d <= upper; + + if(!pop_testing){ + Rprintf("AHHHHH BADDDDDD!!!!\n\n"); + } + + /* + Rcout << new_region_label1 << " has population " << new_region1_pop << " and "<< new_region_label1 << " is " << new_region2_pop <<"\n"; + Rcout << "R1.R1 has d " << new_region1_d << " and other is " << new_region2_d <<"\n"; + */ + + // update the function parameter with names of new regions + if(new_region_labels.size() != 2){ + Rcout << "For some reason the new_region_labels vector in cut_regions is not size 2!\n"; + } + new_region_labels[0] = new_region_label1; + new_region_labels[1] = new_region_label2; + + // Get the regions current integer id + int old_region_num_id = plan.str_label_to_num_id_map[region_to_split]; + // make the first new region have the same integer id + int new_region_num_id1 = old_region_num_id; + // Second new region has id of the new number of regions minus 1 + int new_region_num_id2 = plan.num_regions - 1; + + // Now update the two cut portions + assign_region(ust, plan, tree_vertex1, new_region_label1, new_region_num_id1, new_region1_pop, new_region1_d); + assign_region(ust, plan, tree_vertex2, new_region_label2, new_region_num_id2, new_region2_pop, new_region2_d); + + // Now update the map objects in the plan + plan.r_to_d_map.erase(region_to_split); + plan.r_to_pop_map.erase(region_to_split); + plan.str_label_to_num_id_map.erase(region_to_split); + plan.num_id_to_str_label_map.erase(old_region_num_id); + + // Add the new region 1 + plan.r_to_d_map[new_region_label1] = new_region1_d; + plan.r_to_pop_map[new_region_label1] = new_region1_pop; + plan.str_label_to_num_id_map[new_region_label1] = new_region_num_id1; + plan.num_id_to_str_label_map[new_region_num_id1] = new_region_label1; + + // Add the new region 2 + plan.r_to_d_map[new_region_label2] = new_region2_d; + plan.r_to_pop_map[new_region_label2] = new_region2_pop; + plan.str_label_to_num_id_map[new_region_label2] = new_region_num_id2; + plan.num_id_to_str_label_map[new_region_num_id2] = new_region_label2; + + return true; + +}; + + + +//' Attempts to split a multi-district into two new regions with valid population +//' bounds +//' +//' Attempts to split a multi-district into two new regions where both regions +//' have valid population bounds. Does this by drawing a spanning tree uniformly +//' at random then calling `cut_regions` on that. If the split it successful it +//' returns true and modifies `plan` and `new_region_labels` accordingly. This +//' is based on the `split_map` function in smc.cpp +//' +//' +//' @title Attempt Generalized Region split of multi-district +//' +//' @param g A graph (adjacency list) passed by reference +//' @param ust A directed tree object (this will be cleared in the function so +//' whatever it was before doesn't matter) +//' @param counties Vector of county labels +//' @param cg multigraph object (not sure why this is needed) +//' @param plan A plan object +//' @param region_to_split The label of the region in the plan object we're attempting to split +//' @param new_region_labels A vector that will be updated by reference to contain the names of +//' the two new split regions if function is successful. +//' @param lower Acceptable lower bounds on district population +//' @param upper Acceptable upper bounds on district population +//' @param target Target population (probably Total population of map/Num districts ) +//' @param k_param The k parameter from the SMC algorithm, you choose among the top k_param edges +//' +//' @details Modifications +//' - If two new valid regions are split then the plan object is updated accordingly +//' - If two new valid regions are split then the new_region_labels is updated so the +//' first entry is the first new region and the second entry is the second new region +//' +//' @return True if two valid regions were split off false otherwise +//' +bool attempt_region_split(const Graph &g, Tree &ust, const uvec &counties, Multigraph &cg, + Plan &plan, const std::string region_to_split, + std::vector &new_region_labels, + std::vector &visited, std::vector &ignore, const uvec &pop, + double &lower, double upper, double target, int k_param) { + int V = g.size(); + + // Mark it as ignore if its not in the region to split + for (int i = 0; i < V; i++){ + ignore[i] = plan.region_labels[i] != region_to_split; + } + + // Get a uniform spanning tree drawn on that region + int root; + clear_tree(ust); + // Get a tree + int result = sample_sub_ust(g, ust, V, root, visited, ignore, pop, lower, upper, counties, cg); + // Return unsuccessful if tree not drawn + if (result != 0) return false; + + // Now try to cut the tree and return that result + return cut_regions(ust, k_param, root, pop, + plan, region_to_split, + lower, upper, target, + new_region_labels); + + +} + + + + + +/* + * Split off a piece from each map in `districts`, + * keeping deviation between `lower` and `upper` + */ + +// This should just update ancestor, lag, and give log prob reason was picked. +// Everything else can happen outside. +// Actually we compute incremental weight in the function. + +void generalized_split_maps( + const Graph &g, const uvec &counties, Multigraph &cg, const uvec &pop, + std::vector &old_plans_vec, std::vector &new_plans_vec, + std::vector &original_ancestor_vec, + std::vector &parent_vec, + const std::vector &prev_ancestor_vec, + std::vector &log_incremental_weights, + const std::vector &unnormalized_weights, + std::vector &normalized_weights_to_fill_in, + std::vector &draw_tries_vec, + double &accept_rate, + int &n_unique_parent_indices, + int &n_unique_original_ancestors, + umat &ancestors, const std::vector &lags, + double lower, double upper, double target, + int k_param, + RcppThread::ThreadPool &pool, + int verbosity + ) { + const int V = g.size(); + const int n_lags = lags.size(); + const int M = old_plans_vec.size(); + const int dist_ctr = old_plans_vec.at(0).num_regions; + + + + + + uvec iters(M, fill::zeros); // how many actual iterations + uvec original_ancestor_uniques(M); // unique original ancestors + uvec parent_index_uniques(M); // unique parent indicies + + umat ancestors_new(M, n_lags); // lags/ancestor thing + + + + + // Create the obj which will sample from the index with probability + // proportional to the weights + std::random_device rd; + std::mt19937 gen(rd()); + std::discrete_distribution<> index_sampler( + unnormalized_weights.begin(), unnormalized_weights.end() + ); + + std::vector p = index_sampler.probabilities(); + + // for(int i=0;i < M, i++){ + // normalized_weights_to_fill_in.at(i) = ; + // } + + // record the normalized weights the sampler is using + int nw_index = 0; + bool print_weights = M < 12 && verbosity > 1; + if(print_weights){ + Rprintf("Unnormalized weights are: "); + for (auto w : unnormalized_weights){ + Rprintf("%.4f, ", w); + } + + Rprintf("\n"); + Rprintf("Normalized weights are: "); + } + for (auto prob : p){ + if(print_weights) Rprintf("%.4f, ", prob); + normalized_weights_to_fill_in.at(nw_index) = prob; + nw_index++; + } + if(print_weights) Rprintf("\n"); + + + const int reject_check_int = 200; // check for interrupts every _ rejections + const int check_int = 50; // check for interrupts every _ iterations + + + RcppThread::ProgressBar bar(M, 1); + pool.parallelFor(0, M, [&] (int i) { + int reject_ct = 0; + bool ok = false; + int idx; + std::string region_to_split; + std::vector new_region_labels(2, "INIT"); + + Tree ust = init_tree(V); + std::vector visited(V); + std::vector ignore(V); + while (!ok) { + // use weights to sample previous plan + idx = index_sampler(gen); + + Plan proposed_new_plan = old_plans_vec[idx]; + + iters[i]++; + + // pick a region to try to split + choose_multidistrict_to_split( + old_plans_vec[idx], region_to_split); + + + // Now try to split that region + ok = attempt_region_split(g, ust, counties, cg, + proposed_new_plan, region_to_split, + new_region_labels, + visited, ignore, pop, + lower, upper, target, k_param); + + // bad sample; try again + if (!ok) { + RcppThread::checkUserInterrupt(++reject_ct % reject_check_int == 0); + continue; + } + + // else update the new plan + new_plans_vec[i] = proposed_new_plan; + + } + + // update the log incremental weights + log_incremental_weights[i] = compute_log_incremental_weight(g, new_plans_vec[i]); + + draw_tries_vec[i] = static_cast(iters[i]); + + original_ancestor_uniques[i] = prev_ancestor_vec[idx]; + parent_index_uniques[i] = idx; + clear_tree(ust); + + // save ancestors/lags + for (int j = 0; j < n_lags; j++) { + if (dist_ctr <= lags[j]) { + ancestors_new(i, j) = i; + } else { + ancestors_new(i, j) = ancestors(idx, j); + } + } + + + // update this particles ancestor to be the ancestor of its previous one + parent_vec[i] = idx; + original_ancestor_vec[i] = prev_ancestor_vec[idx]; + + RcppThread::checkUserInterrupt(i % check_int == 0); + }); + + pool.wait(); + + + + // now replace the old plans with the new ones + for(int i=0; i < M; i++){ + old_plans_vec[i] = new_plans_vec[i]; + } + + + accept_rate = M / (1.0 * sum(iters)); + n_unique_original_ancestors = ((uvec) find_unique(original_ancestor_uniques)).n_elem; + n_unique_parent_indices = ((uvec) find_unique(parent_index_uniques)).n_elem; + if (verbosity >= 3) { + Rprintf("%.2f acceptance rate, %d unique parent indices sampled, and %d unique original ancestors!\n", + 100.0 * accept_rate, (int) n_unique_parent_indices , (int) n_unique_original_ancestors); + } + + if(print_weights){ + Rprintf("Log Incremental weights are: "); + for (auto w : log_incremental_weights){ + Rprintf("%.4f, ", w); + } + Rprintf("\n"); + } + + ancestors = ancestors_new; + + +} + + + +List generalized_smc_plans( + int N, List adj_list, + const arma::uvec &counties, const arma::uvec &pop, + double target, double lower, double upper, + int M, int k_param, // M is Number of particles aka number of different plans + List control, + int ncores, int verbosity){ + + // cores stuff + if (ncores <= 0) ncores = std::thread::hardware_concurrency(); + if (ncores == 1) ncores = 0; + + // lags thing (copied from original smc code, don't understand what its doing) + std::vector lags = as>(control["lags"]); + umat ancestors(M, lags.size(), fill::zeros); + + // Now create data necessary to split the maps + Graph g = list_to_graph(adj_list); + Multigraph cg = county_graph(g, counties); + + int V = g.size(); + double total_pop = sum(pop); + std::vector plans_vec(M, Plan(V, N, total_pop)); + std::vector new_plans_vec(M, Plan(V, N, total_pop)); // New plans + + // OUTDATED ONLY DO FINAL ONE TO SAVE MEMORY + // Create info tracking we will pass out at the end + // This is N-1 by M by V where for each n=1,...,N-1 and m=1,...M it maps vertices to region labels + // std::vector>> plan_region_labels_mat( + // N-1, + // std::vector>( + // M, std::vector (V, "MISSING") + // ) + // + // ); + + + std::vector>final_plan_region_labels( + M, std::vector (V, "MISSING") + ); + + // Create info tracking we will pass out at the end + // This is N-1 by M by V where for each n=1,...,N-1 and m=1,...M it maps vertices to integer id + std::vector>> plan_region_ids_mat( + N-1, + std::vector>( + M, std::vector (V, -1) + ) + + ); + // For integers make default -1 for error tracking + // This is N-1 by M by V where for each n=1,...,N-1 and m=1,...M it maps vertices to region d val + std::vector>> plan_d_vals_mat( + N-1, + std::vector>( + M, std::vector (V, -1) + ) + + ); + + // This is N-1 by M where [i][j] is the index of the parent of particle j on step i + // ie the index of the previous plan that was sampled and used to create particle j on step i + std::vector> parent_index_mat(N-1, std::vector (M, -1)); + // This is N-1 by M where [i][j] is the index of the original (first) ancestor of particle j on step i + std::vector> original_ancestor_mat(N-1, std::vector (M, -1)); + // This is N-1 by M where [i][j] is the number of tries it took to form particle j on iteration i + // Inclusive of the final step. ie if succeeds in one try it would be 1 + std::vector> draw_tries_mat(N-1, std::vector (M, -1)); + + // This is N-1 by M where [i][j] is the log incremental weight of particle j on step i + std::vector> log_incremental_weights_mat(N-1, std::vector (M, -1.0)); + // This is N-1 by M where [i][j] is the normalized weight of particle j on step i + std::vector> normalized_weights_mat(N-1, std::vector (M, -1.0)); + + std::vector acceptance_rates(N-1, -1.0); + std::vector n_eff(N-1, -1.0); + std::vector nunique_parents_vec(N-1, -1); + std::vector nunique_original_ancestors_vec(N-1, -1); + + // Loading Info + if (verbosity >= 1) { + Rcout.imbue(std::locale("")); + Rcout << std::fixed << std::setprecision(0); + Rcout << "GENERALIZED SEQUENTIAL MONTE CARLO\n"; + Rcout << "Sampling " << M << " " << V << "-unit "; + Rcout << "maps with " << N << " districts and population between " + << lower << " and " << upper << " using " << ncores << " cores.\n"; + if (cg.size() > 1){ + Rcout << "Ensuring no more than " << N - 1 << " splits of the " + << cg.size() << " administrative units.\n"; + } + } + + // Start off all the unnormalized weights at 1 + std::vector unnormalized_weights(M, 1.0); + + + // Create a threadpool + + RcppThread::ThreadPool pool(ncores); + + std::string bar_fmt = "Split [{cli::pb_current}/{cli::pb_total}] {cli::pb_bar} | ETA{cli::pb_eta}"; + RObject bar = cli_progress_bar(N-1, cli_config(false, bar_fmt.c_str())); + + // Now for each run through split the map + try { + for(int n=0; n 1){ + Rprintf("Iteration %d \n", n+1); + } + + + // For the first iteration we need to pass a special previous ancestor thing + if(n == 0){ + std::vector dummy_prev_ancestors(M, 1); + // split the map + generalized_split_maps( + g, counties, cg, pop, + plans_vec, new_plans_vec, + original_ancestor_mat[n], + parent_index_mat[n], + dummy_prev_ancestors, + log_incremental_weights_mat[n], + unnormalized_weights, + normalized_weights_mat[n], + draw_tries_mat[n], + acceptance_rates[n], + nunique_parents_vec[n], + nunique_original_ancestors_vec[n], + ancestors, lags, + lower, upper, target, + k_param, + pool, + verbosity + ); + + // For the first ancestor one make every ancestor themselves + std::iota (parent_index_mat[0].begin(), parent_index_mat[0].end(), 0); + std::iota (original_ancestor_mat[0].begin(), original_ancestor_mat[0].end(), 0); + }else{ + // split the map and we can use the previous original ancestor matrix row + generalized_split_maps( + g, counties, cg, pop, + plans_vec, new_plans_vec, + original_ancestor_mat[n], + parent_index_mat[n], + original_ancestor_mat[n-1], + log_incremental_weights_mat[n], + unnormalized_weights, + normalized_weights_mat[n], + draw_tries_mat[n], + acceptance_rates[n], + nunique_parents_vec[n], + nunique_original_ancestors_vec[n], + ancestors, lags, + lower, upper, target, + k_param, + pool, + verbosity + ); + } + + if (verbosity == 1 && CLI_SHOULD_TICK){ + cli_progress_set(bar, n); + } + Rcpp::checkUserInterrupt(); + + + + // Now update the weights, region labels, dval column of the matrix + for(int j=0; j) + (sizeof(int) * plan_region_ids_mat[N-2].size()) +// << " so DONE \n"; +// +// size_t totalSize = sizeof(std::vector); // Size of the vector object itself +// +// Rcout << "The STRING vector size is " +// << totalSize +// << " so DONE \n"; +// +// for (const auto& str : plan_region_ids_mat.at(N-2)) { +// totalSize += sizeof(str); // Size of each std::string object +// totalSize += str.capacity(); // Size of the allocated string data +// } +// +// // auto da_size = sizeof(std::vector) + (sizeof(std::st) * MyVector.size()); +// Rcout << "The string vector size is " +// << totalSize +// << " real DONE \n"; +// +// +// totalSize = sizeof(std::vector); // Size of the vector object itself +// +// Rcout << "The STRING vector size is " +// << totalSize +// << " so DONE \n"; +// +// for (const auto& str : final_plan_region_labels.at(N-2)) { +// totalSize += sizeof(str); // Size of each std::string object +// totalSize += str.capacity(); // Size of the allocated string data +// } +// +// // auto da_size = sizeof(std::vector) + (sizeof(std::st) * MyVector.size()); +// Rcout << "The string vector size is " +// << totalSize +// << " real DONE \n"; + + + // make first number of unique original ancestors just M + nunique_original_ancestors_vec.at(0) = M; + + // Return results + List out = List::create( + _["original_ancestors"] = original_ancestor_mat, + _["parent_index"] = parent_index_mat, + _["final_region_labs"] = final_plan_region_labels, + _["region_ids_mat"] = plan_region_ids_mat, + _["region_dvals_mat"] = plan_d_vals_mat, + _["log_incremental_weights_mat"] = log_incremental_weights_mat, + _["normalized_weights_mat"] = normalized_weights_mat, + _["draw_tries_mat"] = draw_tries_mat, + _["acceptance_rates"] = acceptance_rates, + _["nunique_parent_indices"] = nunique_parents_vec, + _["nunique_original_ancestors"] = nunique_original_ancestors_vec, + _["ancestors"] = ancestors, + _["step_n_eff"] = n_eff + ); + + return out; + +} diff --git a/src/generalized_smc.h b/src/generalized_smc.h new file mode 100644 index 000000000..750fcf48e --- /dev/null +++ b/src/generalized_smc.h @@ -0,0 +1,44 @@ +#pragma once +#ifndef GENERALIZED_SMC_H +#define GENERALIZED_SMC_H + +// [[Rcpp::depends(redistmetrics)]] + +#include "smc_base.h" + +#include +#include +#include +#include +#include +#include +#include + +#include +#include "wilson.h" +#include "tree_op.h" +#include "map_calc.h" +#include "redist_types.h" +#include "generalized_smc_helpers.h" + + +//' @export +// [[Rcpp::export]] +List generalized_smc_plans( + int N, List adj_list, + const arma::uvec &counties, const arma::uvec &pop, + double target, double lower, double upper, + int M, int k_param,// Number of particles aka number of different plans + List control, + int ncores = -1, int verbosity = 3); + + + + +bool attempt_region_split(const Graph &g, Tree &ust, const uvec &counties, Multigraph &cg, + Plan &plan, const std::string region_to_split, + std::vector &new_region_labels, + std::vector &visited, std::vector &ignore, const uvec &pop, + double &lower, double upper, double target, int k_param); + +#endif diff --git a/src/generalized_smc_helpers.cpp b/src/generalized_smc_helpers.cpp new file mode 100644 index 000000000..50e677388 --- /dev/null +++ b/src/generalized_smc_helpers.cpp @@ -0,0 +1,308 @@ +#include "generalized_smc_helpers.h" + + +//' Computes the effective sample size from log incremental weights +//' +//' Takes a vector of log incremental weights and computes the effective sample +//' size which is the sum of the weights squared divided by the sum of squared +//' weights +//' +//' +//' @title Compute Effective Sample Size +//' +//' @param log_wgt vector of log incremental weights +//' +//' @return sum of weights squared over sum of squared weights (sum(wgt)^2 / sum(wgt^2)) +//' +double compute_n_eff(const std::vector &log_wgt) { + double sum_wgt = 0.0; + double sum_wgt_squared = 0.0; + + for (const double& log_w : log_wgt) { + double wgt = std::exp(log_w); + sum_wgt += wgt; + sum_wgt_squared += wgt * wgt; + } + + + return std::exp( + (2 * std::log(sum_wgt)) - std::log(sum_wgt_squared) + ); +} + + + +//' Returns the log of the Count of the number of edges across two regions in +//' the underlying graph. +//' +//' Given a graph and two regions in the graph this function counts the number of +//' edges across the the two regions (ie one vertex in one and the other in +//' the other also know as the grap theoretic length of the boundary) and +//' returns the log of that count. +//' +//' +//' @title Log Region boundary count +//' +//' @param g A graph (adjacency list) passed by reference +//' @param plan A plan object +//' @param region1_label The label of the first region +//' @param region2_label The label of the second region +//' +//' @details Modifications +//' - If two new valid regions are split then the plan object is updated accordingly +//' - If two new valid regions are split then the new_region_labels is updated so the +//' first entry is the first new region and the second entry is the second new region +//' +//' @return True if two valid regions were split off false otherwise +//' + double region_log_boundary(const Graph &g, const Plan &plan, + std::string const®ion1_label, + std::string const®ion2_label + ) { + int V = g.size(); + + double count = 0; // count of number of edges across the two regions + // Iterate over every vertex + for (int i = 0; i < V; i++) { + /* Check vertex if in first region, if not continue + Since edges appear twice in adjcancy list to avoid double + counting we will only count those where first edge is in + region 1 + */ + if (plan.region_labels.at(i) != region1_label) continue; + + + // Get vertices neighbors + std::vector nbors = g[i]; + + // Since edges show up twice to avoid double counting we will only count + // edges where first one is region1_label and second is region2_label + + + + // Now check if neighbors are in second regoin + for (int nbor : nbors) { + if (plan.region_labels.at(nbor) != region2_label) + continue; + // otherwise, boundary with root -> ... -> i -> nbor + count += 1.0; + } + } + + return std::log(count); + } + + + + +//' Selects a multidistrict with probability proportional to its d_nk value and +//' returns the log probability of the selected region +//' +//' Given a plan object with at least one multidistrict this function randomly +//' selects a multidistrict with probability proporitional to its d_nk value +//' (relative to all multidistricts) and returns the log of the probability that +//' region was chosen. +//' +//' +//' @title Choose multidistrict to split +//' +//' @param plan A plan object +//' @param region_to_split a string that will be updated by reference with the +//' name of the region selected to split +//' +//' @details Modifications +//' - sets `region_to_split` to be the region that was selected +//' +//' @return the log of the probability the specific value of `region_to_split` was chosen +//' +double choose_multidistrict_to_split( + Plan const&plan, std::string ®ion_to_split){ + + if(plan.num_multidistricts < 1){ + Rprintf("ERROR: Trying to find multidistrict to split when there are none!\n"); + } + + // count total + int total_multi_ds = 0; + + // make vectors with cumulative d value and region label for later + std::vector multi_d_vals; + std::vector region_labels; + + // Iterate over all regions + for (const auto &[key, value]: plan.r_to_d_map ) { + + // collect info if multidistrict + if(value > 1){ + // Add that regions d value to the total + total_multi_ds += value; + // add the count and label to vector + multi_d_vals.push_back(value); + region_labels.push_back(key); + } + } + + + // Now pick an index proportational to d_nk value + std::random_device rd; + std::mt19937 gen(rd()); + std::discrete_distribution<> d(multi_d_vals.begin(), multi_d_vals.end()); + + int idx = d(gen); + + region_to_split = region_labels[idx]; + double log_prob = std::log( + static_cast(multi_d_vals[idx]) + ) - std::log( + static_cast(total_multi_ds) + ); + + return log_prob; +} + + + + + +/* + * Make the region adjacency graph for `plan` from the overall precinct graph `g` + * where the regions are represented by their integer id representation form + */ +// NOT TESTED but taken from district_graph function which was tested +Graph get_region_graph(const Graph &g, const Plan &plan) { + int V = g.size(); + Graph out; + + std::vector> gr_bool( + plan.num_regions, std::vector(plan.num_regions, false) + ); + + + for (int i = 0; i < V; i++) { + std::vector nbors = g[i]; + // Find out which region this vertex corresponds to + int region_num_i = plan.region_num_ids[i]; + + // now iterate over its neighbors + for (int nbor : nbors) { + // find which region neighbor corresponds to + int region_num_j = plan.region_num_ids[nbor]; + // if they are different regions mark matrix true + if (region_num_i != region_num_j) { + gr_bool.at(region_num_i).at(region_num_j) = true; + } + } + + } + + + for (int i = 0; i < plan.num_regions; i++) { + std::vector tmp; + for (int j = 0; j < plan.num_regions; j++) { + if (gr_bool.at(i).at(j)) { + tmp.push_back(j); + } + } + out.push_back(tmp); + } + + return out; +} + +// Given a plan and two regions get the probability their log 'union' would have +// been selected to be split +double get_log_retroactive_splitting_prob( + const Plan &plan, + const std::string region1_label, const std::string region2_label +){ + // We just want + + // count total + int total_multi_ds = 0; + + + // Iterate over all regions + for (const auto &[key, value]: plan.r_to_d_map ) { + // collect info if multidistrict and not the two we started with + if(value > 1 && key != region1_label && key != region2_label){ + // Add that regions d value to the total + total_multi_ds += value; + } + } + + // Now get the sum of dnk values of two regions + int unioned_region_dnk = plan.r_to_d_map.at(region1_label) + plan.r_to_d_map.at(region2_label); + // update the total number of multi district dvals with the value the union region would have been + total_multi_ds += unioned_region_dnk; + + // so prob of picking is the sum of the two regions dnk over the dnk of all + // multidistricts + + double log_prob = std::log( + static_cast(unioned_region_dnk) + ) - std::log( + static_cast(total_multi_ds) + ); + + return log_prob; + +} + + +// Compute the incremental log weight +double compute_log_incremental_weight(const Graph &g, const Plan &plan){ + Graph rg = get_region_graph(g, plan); + + + // check + if((int)rg.size() != plan.num_regions){ + Rprintf("SOMETHING WENT WRONG IN COMPPUTE LOG INCREMENT WEIGHJT\n"); + } + + // First get all adjacent region pairs + + // Set to store unique pairs of adjacent vertices + std::set> adj_region_pairs; + // Iterate through the adjacency list + for (int u = 0; u < rg.size(); u++){ + // iterate over neighbors + for(auto v: rg[u]){ + if (u < v) { + adj_region_pairs.emplace(u, v); + } else { + adj_region_pairs.emplace(v, u); + } + } + } + + + + double incremental_weight = 0.0; + + + // Now iterate over all pairs + for (const auto& edge : adj_region_pairs) { + // convert to region string label representation + std::string region1_label = plan.num_id_to_str_label_map.at(edge.first); + std::string region2_label = plan.num_id_to_str_label_map.at(edge.second); + // get log of boundary + double log_boundary = region_log_boundary(g, plan, region1_label, region2_label); + // double log_boundary = 0; + // get prob of selecting union of adj regions + double log_splitting_prob = get_log_retroactive_splitting_prob(plan, region1_label, region2_label); + // NO e^J TERM YET + // add the logs, exponentiate and add the sum + incremental_weight += std::exp(log_boundary + log_splitting_prob); + } + + + // Check its not infinity + if(incremental_weight == -std::numeric_limits::infinity()){ + Rprintf("Error! weight is negative infinity for some reason \n"); + } + + + // now return log of the weight + return -std::log(incremental_weight); + +} diff --git a/src/redist_types.cpp b/src/redist_types.cpp new file mode 100644 index 000000000..d65b12e25 --- /dev/null +++ b/src/redist_types.cpp @@ -0,0 +1,73 @@ +/******************************************************** + * Author: Philip O'Sullivan + * Institution: Harvard University + * Date Created: 2024/08 + * Purpose: Sequential Monte Carlo redistricting sampler + ********************************************************/ + +#include "redist_types.h" + + +// Define the constructor template outside the class +// THIS ONLY CONSTRUCTS A ONE REGION MAP. ANYTHING ELSE MUST BE UPDATED +Plan::Plan(int V, int N, double total_map_pop){ + // Check number of regions and districts make sense + /* + if(num_regions < 1){ + RcppThread::Rcerr << "ERROR: Invalid number of regions!\n"; + } + if(num_districts > num_regions){ + RcppThread::Rcout << "ERROR: Invalid number of districts!\n"; + } + */ + + // set number of regions, districts, multidistricts, map pop, and V + num_regions = 1; + num_districts = 0; + num_multidistricts = num_regions - num_districts; + this->V = V; + map_pop = total_map_pop; + this->N = N; + + + + + // Set label to dnk and pop value map + r_to_d_map = std::map {{"R1", N}}; + r_to_pop_map = std::map {{"R1", map_pop}}; + + // Create region labels, pop, and dnk + // THIS ONLY WORKS FOR A BLANK REGION RIGHT NOW + region_labels = std::vector(V, "R1"); + region_num_ids = std::vector(V, 0); + region_dval = std::vector(V, r_to_d_map["R1"]); + region_pop = std::vector(V, r_to_pop_map["R1"]); + + // Set maps allowing going between integer and string region ids + str_label_to_num_id_map = std::map {{"R1", 0}};; // Maps region label values to integer id number + num_id_to_str_label_map = std::map {{0, "R1"}};; // Maps integer id number to region label values + +} + + +// Prints our object using Rcout. Should be used in Rcpp call +void Plan::Rprint() const{ + RcppThread::Rcout << "Plan with " << num_regions << " regions, " << num_districts + << " districts and "<< V << " Vertices.\n["; + + + RcppThread::Rcout << "Region Level Values:"; + for (const auto &[key, value]: r_to_d_map ) { + RcppThread::Rcout << "(" << str_label_to_num_id_map.at(key) << " aka " << key << " also " << + num_id_to_str_label_map.at(str_label_to_num_id_map.at(key)) << ", " << value << ", " << r_to_pop_map.at(key) <<" ), "; + } + RcppThread::Rcout << "\n"; +// +// for(int i = 0; i Date: Thu, 29 Aug 2024 15:20:26 -0400 Subject: [PATCH 003/324] adding some files I forgot to push --- DESCRIPTION | 2 +- NAMESPACE | 2 + R/RcppExports.R | 33 ++++++++ R/confint.R | 4 +- R/diagnostics.R | 146 +++++++++++++++++++++++++++++++--- README.Rmd | 2 +- man/redist_gsmc.Rd | 25 ++++++ src/RcppExports.cpp | 131 ++++++++++++++++++++++++++++++ src/generalized_smc.cpp | 10 +-- src/generalized_smc_helpers.h | 27 +++++++ src/redist_types.h | 39 +++++++++ src/smc.h | 2 + src/tree_op.cpp | 19 +++++ src/tree_op.h | 9 +++ 14 files changed, 431 insertions(+), 20 deletions(-) create mode 100644 man/redist_gsmc.Rd create mode 100644 src/generalized_smc_helpers.h diff --git a/DESCRIPTION b/DESCRIPTION index 0030ec219..f5a42a957 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -64,7 +64,7 @@ NeedsCompilation: yes BugReports: https://github.com/alarm-redist/redist/issues URL: https://alarm-redist.org/redist/ Roxygen: list(markdown = TRUE) -RoxygenNote: 7.3.1 +RoxygenNote: 7.3.2 VignetteBuilder: knitr Encoding: UTF-8 Config/testthat/edition: 3 diff --git a/NAMESPACE b/NAMESPACE index 2a0937910..2ff11fb13 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -84,6 +84,7 @@ export(county_splits) export(distr_compactness) export(filter) export(freeze) +export(generalized_smc_plans) export(get_adj) export(get_existing) export(get_mh_acceptance_rate) @@ -172,6 +173,7 @@ export(redist_ci) export(redist_constr) export(redist_flip) export(redist_flip_anneal) +export(redist_gsmc) export(redist_map) export(redist_mcmc_ci) export(redist_mergesplit) diff --git a/R/RcppExports.R b/R/RcppExports.R index 7dc68c96e..87be6c7df 100644 --- a/R/RcppExports.R +++ b/R/RcppExports.R @@ -53,6 +53,11 @@ dist_dist_diff <- function(p, i_dist, j_dist, x_center, y_center, x, y) { .Call(`_redist_dist_dist_diff`, p, i_dist, j_dist, x_center, y_center, x, y) } +#' @export +generalized_smc_plans <- function(N, adj_list, counties, pop, target, lower, upper, M, k_param, control, ncores = -1L, verbosity = 3L) { + .Call(`_redist_generalized_smc_plans`, N, adj_list, counties, pop, target, lower, upper, M, k_param, control, ncores, verbosity) +} + log_st_map <- function(g, districts, counties, n_distr) { .Call(`_redist_log_st_map`, g, districts, counties, n_distr) } @@ -109,6 +114,34 @@ pareto_dominated <- function(x) { .Call(`_redist_pareto_dominated`, x) } +testing_sample_forest <- function(l, pop, lower, upper, counties, ignore) { + .Call(`_redist_testing_sample_forest`, l, pop, lower, upper, counties, ignore) +} + +plan_class_testing <- function(V, num_regions, num_districts) { + .Call(`_redist_plan_class_testing`, V, num_regions, num_districts) +} + +split_entire_map <- function(N, adj_list, counties, pop, target, lower, upper, verbose = FALSE) { + .Call(`_redist_split_entire_map`, N, adj_list, counties, pop, target, lower, upper, verbose) +} + +split_all_the_way <- function(N, adj_list, counties, pop, target, lower, upper, verbose) { + .Call(`_redist_split_all_the_way`, N, adj_list, counties, pop, target, lower, upper, verbose) +} + +copy_semantics_tester_outer <- function() { + invisible(.Call(`_redist_copy_semantics_tester_outer`)) +} + +test_cpp_discrete_distribution <- function() { + invisible(.Call(`_redist_test_cpp_discrete_distribution`)) +} + +test_region_lev_graph_stuff <- function(N, adj_list, counties, pop, target, lower, upper, verbose) { + .Call(`_redist_test_region_lev_graph_stuff`, N, adj_list, counties, pop, target, lower, upper, verbose) +} + closest_adj_pop <- function(adj, i_dist, g_prop) { .Call(`_redist_closest_adj_pop`, adj, i_dist, g_prop) } diff --git a/R/confint.R b/R/confint.R index 2be132262..e90fd1e09 100644 --- a/R/confint.R +++ b/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", "flip") + algos_ok = c("smc", "gsmc", "mergesplit", "flip") x = enquo(x) @@ -57,6 +57,8 @@ redist_ci <- function(plans, x, district = 1L, conf = 0.9, by_chain = FALSE) { Call {.fn redist_smc_ci} or {.fn redist_mcmc_ci} directly.") } else if (algo == "smc") { redist_smc_ci(plans, !!x, district, conf, by_chain) + } else if (algo == "gsmc") { + redist_smc_ci(plans, !!x, district, conf, by_chain) } else { # MCMC redist_mcmc_ci(plans,!!x, district, conf, by_chain) } diff --git a/R/diagnostics.R b/R/diagnostics.R index f54520c6c..52ae47e2d 100644 --- a/R/diagnostics.R +++ b/R/diagnostics.R @@ -81,7 +81,7 @@ summary.redist_plans <- function(object, district = 1L, all_runs = TRUE, vi_max prec_pop <- attr(object, "prec_pop") if (is.null(prec_pop)) { cli_warn(c("Precinct population missing; plan diversity estimates may be misleading.", - ">" = 'Run `attr({name}, "prec_pop") <- $` to fix.')) + ">" = 'Run `attr({name}, "prec_pop") <- $` to fix.')) prec_pop <- rep(1, nrow(plans_m)) } est_div <- plans_diversity(object, total_pop = prec_pop, n_max = vi_max) @@ -143,11 +143,11 @@ summary.redist_plans <- function(object, district = 1L, all_runs = TRUE, vi_max n_samp <- nrow(diagn$ancestors) run_dfs[[i]] <- tibble(n_eff = c(diagn$step_n_eff, diagn$n_eff), - eff = c(diagn$step_n_eff, diagn$n_eff)/n_samp, - accept_rate = c(diagn$accept_rate, NA), - sd_log_wgt = diagn$sd_lp, - max_unique = diagn$unique_survive, - est_k = c(diagn$est_k, NA)) + eff = c(diagn$step_n_eff, diagn$n_eff)/n_samp, + accept_rate = c(diagn$accept_rate, NA), + sd_log_wgt = diagn$sd_lp, + max_unique = diagn$unique_survive, + est_k = c(diagn$est_k, NA)) tbl_print <- as.data.frame(run_dfs[[i]]) min_n <- max(0.05*n_samp, min(0.4*n_samp, 100)) @@ -155,16 +155,16 @@ summary.redist_plans <- function(object, district = 1L, all_runs = TRUE, vi_max warn_bottlenecks <- warn_bottlenecks || any(bottlenecks) tbl_print$bottleneck <- ifelse(bottlenecks, " * ", "") tbl_print$n_eff <- with(tbl_print, - str_glue("{fmt_comma(n_eff)} ({sprintf('%0.1f%%', 100*eff)})")) + str_glue("{fmt_comma(n_eff)} ({sprintf('%0.1f%%', 100*eff)})")) tbl_print$eff <- NULL tbl_print$accept_rate <- with(tbl_print, sprintf("%0.1f%%", 100*accept_rate)) max_pct <- with(tbl_print, max_unique/(-n_samp * expm1(-1))) tbl_print$max_unique <- with(tbl_print, - str_glue("{fmt_comma(max_unique)} ({sprintf('%3.0f%%', 100*max_pct)})")) + str_glue("{fmt_comma(max_unique)} ({sprintf('%3.0f%%', 100*max_pct)})")) names(tbl_print) <- c("Eff. samples (%)", "Acc. rate", - "Log wgt. sd", " Max. unique", - "Est. k", "") + "Log wgt. sd", " Max. unique", + "Est. k", "") rownames(tbl_print) <- c(paste("Split", seq_len(nrow(tbl_print) - 1)), "Resample") if (i == 1 || isTRUE(all_runs)) { @@ -210,6 +210,132 @@ summary.redist_plans <- function(object, district = 1L, all_runs = TRUE, vi_max code <- str_glue("plot(, rowMeans(as.matrix({name}) == ))") cli::cat_line(" ", cli::code_highlight(code, "Material")) } + } else if(algo == "gsmc") { + pop_lb <- attr(object, "pop_bounds")[1] + pop_ub <- attr(object, "pop_bounds")[3] + + cli_text("{.strong gSMC:} {fmt_comma(n_samp)} sampled plans of {n_distr} + districts on {fmt_comma(nrow(plans_m))} units with a population between {fmt_comma(pop_lb)} and {fmt_comma(pop_ub)}") + cli_text("{.arg k}={all_diagn[[1]]$est_k[1]} ") + cat("\n") + + cli_text("Plan diversity 80% range: {div_rg[1]} to {div_rg[2]}") + if (div_bad) cli::cli_alert_danger("{.strong WARNING:} Low plan diversity") + cat("\n") + + cols <- names(object) + addl_cols <- setdiff(cols, c("chain", "draw", "district", "total_pop")) + warn_converge <- FALSE + if ("chain" %in% cols && length(addl_cols) > 0) { + idx <- seq_len(n_samp) + if ("district" %in% cols) idx <- as.integer(district) + (idx - 1)*n_distr + + const_cols <- vapply(addl_cols, function(col) { + x <- object[[col]][idx] + all(is.na(x)) || all(x == x[1]) || + any(tapply(x, object[['chain']][idx], FUN = function(z) length(unique(z))) == 1) + }, numeric(1)) + addl_cols <- addl_cols[!const_cols] + + rhats <- vapply(addl_cols, function(col) { + x <- object[[col]][idx] + na_omit <- !is.na(x) + diag_rhat(x[na_omit], object$chain[idx][na_omit]) + }, numeric(1)) + names(rhats) <- addl_cols + cat("R-hat values for summary statistics:\n") + rhats_p <- vapply(rhats, function(x){ + ifelse(x < 1.05, sprintf('%.3f', x), paste0('\U274C', round(x, 3))) + }, FUN.VALUE = character(1)) + print(noquote(rhats_p)) + + if (any(na.omit(rhats) >= 1.05)) { + warn_converge <- TRUE + cli::cli_alert_danger("{.strong WARNING:} gSMC runs have not converged.") + } + cat("\n") + + } + + run_dfs <- list() + n_runs <- length(all_diagn) + warn_bottlenecks <- FALSE + + for (i in seq_len(n_runs)) { + diagn <- all_diagn[[i]] + n_samp <- nrow(diagn$ancestors) + + run_dfs[[i]] <- tibble(n_eff = c(diagn$step_n_eff, diagn$n_eff), + eff = c(diagn$step_n_eff, diagn$n_eff)/n_samp, + accept_rate = c(diagn$accept_rate, NA), + sd_log_wgt = diagn$sd_lp, + max_unique = diagn$unique_survive, + est_k = c(diagn$est_k, NA), + unique_original = c(diagn$nunique_original_ancestors, NA)) + + tbl_print <- as.data.frame(run_dfs[[i]]) + min_n <- max(0.05*n_samp, min(0.4*n_samp, 100)) + bottlenecks <- dplyr::coalesce(with(tbl_print, pmin(max_unique, n_eff) < min_n), FALSE) + warn_bottlenecks <- warn_bottlenecks || any(bottlenecks) + tbl_print$bottleneck <- ifelse(bottlenecks, " * ", "") + tbl_print$n_eff <- with(tbl_print, + str_glue("{fmt_comma(n_eff)} ({sprintf('%0.1f%%', 100*eff)})")) + tbl_print$eff <- NULL + tbl_print$accept_rate <- with(tbl_print, sprintf("%0.1f%%", 100*accept_rate)) + max_pct <- with(tbl_print, max_unique/(-n_samp * expm1(-1))) + tbl_print$max_unique <- with(tbl_print, + str_glue("{fmt_comma(max_unique)} ({sprintf('%3.0f%%', 100*max_pct)})")) + + # + + names(tbl_print) <- c("Eff. samples (%)", "Acc. rate", + "Log wgt. sd", " Max. unique", + "k", "Unique Original Ancestors", "") + rownames(tbl_print) <- c(paste("Split", seq_len(nrow(tbl_print) - 1)), "Resample") + + if (i == 1 || isTRUE(all_runs)) { + cli_text("Sampling diagnostics for gSMC run {i} of {n_runs} ({fmt_comma(n_samp)} samples)") + print(tbl_print, digits = 2) + cat("\n") + } + } + out <- bind_rows(run_dfs) + + cli::cli_li(cli::col_grey(" + Watch out for low effective samples, very low acceptance rates (less than 1%), + large std. devs. of the log weights (more than 3 or so), + and low numbers of unique plans. + R-hat values for summary statistics should be between 1 and 1.05.")) + + if (div_bad) { + cli::cli_li("{.strong Low diversity:} Check for potential bottlenecks. + Increase the number of samples. + Examine the diversity plot with + `hist(plans_diversity({name}), breaks=24)`. + Consider weakening or removing constraints, or increasing + the population tolerance. If the acceptance rate drops + quickly in the final splits, try increasing + {.arg pop_temper} by 0.01.") + } + if (warn_converge) { + cli::cli_li("{.strong gSMC convergence:} Increase the number of samples. + If you are experiencing low plan diversity or bottlenecks as well, + address those issues first.") + } + if (warn_bottlenecks) { + cli::cli_li("(*) {.strong Bottlenecks found:} Consider weakening or removing + constraints, or increasing the population tolerance. + If the acceptance rate drops quickly in the final splits, + try increasing {.arg pop_temper} by 0.01. + If the weight variance (Log wgt. sd) increases steadily + or is particularly large for the \"Resample\" step, + consider increasing {.arg seq_alpha}. + To visualize what geographic areas may be causing problems, + try running the following code. Highlighted areas are + those that may be causing the bottleneck.\n\n") + code <- str_glue("plot(, rowMeans(as.matrix({name}) == ))") + cli::cat_line(" ", cli::code_highlight(code, "Material")) + } } else if (algo %in% c("mergesplit", 'flip')) { if (algo == 'mergesplit') { diff --git a/README.Rmd b/README.Rmd index cc5bf0393..47200f3a8 100644 --- a/README.Rmd +++ b/README.Rmd @@ -125,4 +125,4 @@ contain more detailed information and guides to specific workflows. ## About This Branch -Working on adding a more generalized SMC version. +Working on adding a more generalized SMC version. Added a PHIL_TESTING_FOLDER where I do my own stuff diff --git a/man/redist_gsmc.Rd b/man/redist_gsmc.Rd new file mode 100644 index 000000000..a637bb898 --- /dev/null +++ b/man/redist_gsmc.Rd @@ -0,0 +1,25 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/redist_gsmc.R +\name{redist_gsmc} +\alias{redist_gsmc} +\title{gSMC Redistricting Sampler} +\usage{ +redist_gsmc( + state_map, + M, + counties = NULL, + k_param_val = 6, + resample = TRUE, + runs = 1L, + ncores = 0L, + verbose = FALSE, + silent = FALSE +) +} +\value{ +\code{redist_smc} returns a \link{redist_plans} object containing the simulated +plans. +} +\description{ +gSMC Redistricting Sampler +} diff --git a/src/RcppExports.cpp b/src/RcppExports.cpp index 43d3f6045..5da782861 100644 --- a/src/RcppExports.cpp +++ b/src/RcppExports.cpp @@ -191,6 +191,28 @@ BEGIN_RCPP return rcpp_result_gen; END_RCPP } +// generalized_smc_plans +List generalized_smc_plans(int N, List adj_list, const arma::uvec& counties, const arma::uvec& pop, double target, double lower, double upper, int M, int k_param, List control, int ncores, int verbosity); +RcppExport SEXP _redist_generalized_smc_plans(SEXP NSEXP, SEXP adj_listSEXP, SEXP countiesSEXP, SEXP popSEXP, SEXP targetSEXP, SEXP lowerSEXP, SEXP upperSEXP, SEXP MSEXP, SEXP k_paramSEXP, SEXP controlSEXP, SEXP ncoresSEXP, SEXP verbositySEXP) { +BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< int >::type N(NSEXP); + Rcpp::traits::input_parameter< List >::type adj_list(adj_listSEXP); + Rcpp::traits::input_parameter< const arma::uvec& >::type counties(countiesSEXP); + Rcpp::traits::input_parameter< const arma::uvec& >::type pop(popSEXP); + Rcpp::traits::input_parameter< double >::type target(targetSEXP); + Rcpp::traits::input_parameter< double >::type lower(lowerSEXP); + Rcpp::traits::input_parameter< double >::type upper(upperSEXP); + Rcpp::traits::input_parameter< int >::type M(MSEXP); + Rcpp::traits::input_parameter< int >::type k_param(k_paramSEXP); + Rcpp::traits::input_parameter< List >::type control(controlSEXP); + Rcpp::traits::input_parameter< int >::type ncores(ncoresSEXP); + Rcpp::traits::input_parameter< int >::type verbosity(verbositySEXP); + rcpp_result_gen = Rcpp::wrap(generalized_smc_plans(N, adj_list, counties, pop, target, lower, upper, M, k_param, control, ncores, verbosity)); + return rcpp_result_gen; +END_RCPP +} // log_st_map NumericVector log_st_map(const Graph& g, const arma::umat& districts, const arma::uvec& counties, int n_distr); RcppExport SEXP _redist_log_st_map(SEXP gSEXP, SEXP districtsSEXP, SEXP countiesSEXP, SEXP n_distrSEXP) { @@ -380,6 +402,107 @@ BEGIN_RCPP return rcpp_result_gen; END_RCPP } +// testing_sample_forest +Tree testing_sample_forest(List l, const arma::uvec& pop, double lower, double upper, const arma::uvec& counties, const std::vector ignore); +RcppExport SEXP _redist_testing_sample_forest(SEXP lSEXP, SEXP popSEXP, SEXP lowerSEXP, SEXP upperSEXP, SEXP countiesSEXP, SEXP ignoreSEXP) { +BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< List >::type l(lSEXP); + Rcpp::traits::input_parameter< const arma::uvec& >::type pop(popSEXP); + Rcpp::traits::input_parameter< double >::type lower(lowerSEXP); + Rcpp::traits::input_parameter< double >::type upper(upperSEXP); + Rcpp::traits::input_parameter< const arma::uvec& >::type counties(countiesSEXP); + Rcpp::traits::input_parameter< const std::vector >::type ignore(ignoreSEXP); + rcpp_result_gen = Rcpp::wrap(testing_sample_forest(l, pop, lower, upper, counties, ignore)); + return rcpp_result_gen; +END_RCPP +} +// plan_class_testing +List plan_class_testing(int V, int num_regions, int num_districts); +RcppExport SEXP _redist_plan_class_testing(SEXP VSEXP, SEXP num_regionsSEXP, SEXP num_districtsSEXP) { +BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< int >::type V(VSEXP); + Rcpp::traits::input_parameter< int >::type num_regions(num_regionsSEXP); + Rcpp::traits::input_parameter< int >::type num_districts(num_districtsSEXP); + rcpp_result_gen = Rcpp::wrap(plan_class_testing(V, num_regions, num_districts)); + return rcpp_result_gen; +END_RCPP +} +// split_entire_map +List split_entire_map(int N, List adj_list, const arma::uvec& counties, const arma::uvec& pop, double target, double lower, double upper, bool verbose); +RcppExport SEXP _redist_split_entire_map(SEXP NSEXP, SEXP adj_listSEXP, SEXP countiesSEXP, SEXP popSEXP, SEXP targetSEXP, SEXP lowerSEXP, SEXP upperSEXP, SEXP verboseSEXP) { +BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< int >::type N(NSEXP); + Rcpp::traits::input_parameter< List >::type adj_list(adj_listSEXP); + Rcpp::traits::input_parameter< const arma::uvec& >::type counties(countiesSEXP); + Rcpp::traits::input_parameter< const arma::uvec& >::type pop(popSEXP); + Rcpp::traits::input_parameter< double >::type target(targetSEXP); + Rcpp::traits::input_parameter< double >::type lower(lowerSEXP); + Rcpp::traits::input_parameter< double >::type upper(upperSEXP); + Rcpp::traits::input_parameter< bool >::type verbose(verboseSEXP); + rcpp_result_gen = Rcpp::wrap(split_entire_map(N, adj_list, counties, pop, target, lower, upper, verbose)); + return rcpp_result_gen; +END_RCPP +} +// split_all_the_way +List split_all_the_way(int N, List adj_list, const arma::uvec& counties, const arma::uvec& pop, double target, double lower, double upper, bool verbose); +RcppExport SEXP _redist_split_all_the_way(SEXP NSEXP, SEXP adj_listSEXP, SEXP countiesSEXP, SEXP popSEXP, SEXP targetSEXP, SEXP lowerSEXP, SEXP upperSEXP, SEXP verboseSEXP) { +BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< int >::type N(NSEXP); + Rcpp::traits::input_parameter< List >::type adj_list(adj_listSEXP); + Rcpp::traits::input_parameter< const arma::uvec& >::type counties(countiesSEXP); + Rcpp::traits::input_parameter< const arma::uvec& >::type pop(popSEXP); + Rcpp::traits::input_parameter< double >::type target(targetSEXP); + Rcpp::traits::input_parameter< double >::type lower(lowerSEXP); + Rcpp::traits::input_parameter< double >::type upper(upperSEXP); + Rcpp::traits::input_parameter< bool >::type verbose(verboseSEXP); + rcpp_result_gen = Rcpp::wrap(split_all_the_way(N, adj_list, counties, pop, target, lower, upper, verbose)); + return rcpp_result_gen; +END_RCPP +} +// copy_semantics_tester_outer +void copy_semantics_tester_outer(); +RcppExport SEXP _redist_copy_semantics_tester_outer() { +BEGIN_RCPP + Rcpp::RNGScope rcpp_rngScope_gen; + copy_semantics_tester_outer(); + return R_NilValue; +END_RCPP +} +// test_cpp_discrete_distribution +void test_cpp_discrete_distribution(); +RcppExport SEXP _redist_test_cpp_discrete_distribution() { +BEGIN_RCPP + Rcpp::RNGScope rcpp_rngScope_gen; + test_cpp_discrete_distribution(); + return R_NilValue; +END_RCPP +} +// test_region_lev_graph_stuff +List test_region_lev_graph_stuff(int N, List adj_list, const arma::uvec& counties, const arma::uvec& pop, double target, double lower, double upper, bool verbose); +RcppExport SEXP _redist_test_region_lev_graph_stuff(SEXP NSEXP, SEXP adj_listSEXP, SEXP countiesSEXP, SEXP popSEXP, SEXP targetSEXP, SEXP lowerSEXP, SEXP upperSEXP, SEXP verboseSEXP) { +BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< int >::type N(NSEXP); + Rcpp::traits::input_parameter< List >::type adj_list(adj_listSEXP); + Rcpp::traits::input_parameter< const arma::uvec& >::type counties(countiesSEXP); + Rcpp::traits::input_parameter< const arma::uvec& >::type pop(popSEXP); + Rcpp::traits::input_parameter< double >::type target(targetSEXP); + Rcpp::traits::input_parameter< double >::type lower(lowerSEXP); + Rcpp::traits::input_parameter< double >::type upper(upperSEXP); + Rcpp::traits::input_parameter< bool >::type verbose(verboseSEXP); + rcpp_result_gen = Rcpp::wrap(test_region_lev_graph_stuff(N, adj_list, counties, pop, target, lower, upper, verbose)); + return rcpp_result_gen; +END_RCPP +} // closest_adj_pop int closest_adj_pop(IntegerVector adj, int i_dist, NumericVector g_prop); RcppExport SEXP _redist_closest_adj_pop(SEXP adjSEXP, SEXP i_distSEXP, SEXP g_propSEXP) { @@ -645,6 +768,7 @@ static const R_CallMethodDef CallEntries[] = { {"_redist_update_conncomp", (DL_FUNC) &_redist_update_conncomp, 3}, {"_redist_crsg", (DL_FUNC) &_redist_crsg, 9}, {"_redist_dist_dist_diff", (DL_FUNC) &_redist_dist_dist_diff, 7}, + {"_redist_generalized_smc_plans", (DL_FUNC) &_redist_generalized_smc_plans, 12}, {"_redist_log_st_map", (DL_FUNC) &_redist_log_st_map, 4}, {"_redist_n_removed", (DL_FUNC) &_redist_n_removed, 3}, {"_redist_countpartitions", (DL_FUNC) &_redist_countpartitions, 1}, @@ -659,6 +783,13 @@ static const R_CallMethodDef CallEntries[] = { {"_redist_max_dev", (DL_FUNC) &_redist_max_dev, 3}, {"_redist_ms_plans", (DL_FUNC) &_redist_ms_plans, 15}, {"_redist_pareto_dominated", (DL_FUNC) &_redist_pareto_dominated, 1}, + {"_redist_testing_sample_forest", (DL_FUNC) &_redist_testing_sample_forest, 6}, + {"_redist_plan_class_testing", (DL_FUNC) &_redist_plan_class_testing, 3}, + {"_redist_split_entire_map", (DL_FUNC) &_redist_split_entire_map, 8}, + {"_redist_split_all_the_way", (DL_FUNC) &_redist_split_all_the_way, 8}, + {"_redist_copy_semantics_tester_outer", (DL_FUNC) &_redist_copy_semantics_tester_outer, 0}, + {"_redist_test_cpp_discrete_distribution", (DL_FUNC) &_redist_test_cpp_discrete_distribution, 0}, + {"_redist_test_region_lev_graph_stuff", (DL_FUNC) &_redist_test_region_lev_graph_stuff, 8}, {"_redist_closest_adj_pop", (DL_FUNC) &_redist_closest_adj_pop, 3}, {"_redist_rint1", (DL_FUNC) &_redist_rint1, 2}, {"_redist_runif1", (DL_FUNC) &_redist_runif1, 2}, diff --git a/src/generalized_smc.cpp b/src/generalized_smc.cpp index 876d9420b..d37212549 100644 --- a/src/generalized_smc.cpp +++ b/src/generalized_smc.cpp @@ -45,7 +45,7 @@ bool cut_regions(Tree &ust, int k_param, int root, parent[root] = -1; tree_pop(ust, root, pop, pop_below, parent); - // compile a list of: + // compile a list of: things for each edge in tree std::vector candidates; // candidate edges to cut, std::vector deviances; // how far from target pop. std::vector is_ok; // whether they meet constraints @@ -61,8 +61,6 @@ bool cut_regions(Tree &ust, int k_param, int root, Rcout << "Root vertex is not in region to split!"; } - - // Now loop over all valid edges to cut for (int i = 1; i <= plan.V; i++) { // 1-indexing here // Ignore any vertex not in this region or the root vertex as we wont be cutting those @@ -80,7 +78,7 @@ bool cut_regions(Tree &ust, int k_param, int root, // Now try each potential d_nk value from 1 up to d_n-1,k -1 - // woops fell for 1 instead of 0 indexing error + // remember to correct for 0 indexing for(int potential_d = 1; potential_d < num_final_districts; potential_d++){ double dev1 = std::fabs(below - target * potential_d); @@ -93,8 +91,6 @@ bool cut_regions(Tree &ust, int k_param, int root, potential_d, above, below); */ - are_ok[potential_d-1] = lower * potential_d < above && above < upper * potential_d; - // If dev1 is smaller then we assign d_nk to below if (dev1 < dev2) { devs[potential_d-1] = dev1; @@ -123,7 +119,6 @@ bool cut_regions(Tree &ust, int k_param, int root, */ // Now find the value of d_{n,k} that has the smallest deviation - std::vector::iterator result = std::min_element(devs.begin(), devs.end()); int best_potential_d = std::distance(devs.begin(), result); @@ -145,6 +140,7 @@ bool cut_regions(Tree &ust, int k_param, int root, } + // if less than k_param candidates immediately reject if((int) candidates.size() < k_param){ return false; } diff --git a/src/generalized_smc_helpers.h b/src/generalized_smc_helpers.h new file mode 100644 index 000000000..f83bc6842 --- /dev/null +++ b/src/generalized_smc_helpers.h @@ -0,0 +1,27 @@ +#pragma once +#ifndef GENERALIZED_SMC_HELPERS_H +#define GENERALIZED_SMC_HELPERS_H + +// [[Rcpp::depends(redistmetrics)]] + +#include "smc_base.h" + + +#include +#include +#include +#include +#include // for std::pair +#include +#include "redist_types.h" + +double compute_n_eff(const std::vector &log_wgt); + +double choose_multidistrict_to_split( + Plan const&plan, std::string ®ion_to_split); + +double compute_log_incremental_weight(const Graph &g, const Plan &plan); + +Graph get_region_graph(const Graph &g, const Plan &plan); + +#endif diff --git a/src/redist_types.h b/src/redist_types.h index 6a6e2527c..d6f801858 100644 --- a/src/redist_types.h +++ b/src/redist_types.h @@ -9,6 +9,12 @@ #define PRINT_LN Rcout << __func__ << "(), " << __FILE__ << ":" << __LINE__ << "\n"; #include +#include +#include +#include +#include +#include +#include // [[Rcpp::depends(RcppArmadillo)]] @@ -16,4 +22,37 @@ typedef std::vector> Tree; typedef std::vector> Graph; typedef std::vector>> Multigraph; + +class Plan +{ +public: + Plan(int V, int N, double total_map_pop); // constructor for 1 region plan + // attributes + int N; // Number all d_nk must sum to + int V; // Number of nodes in graph + int num_regions; // Number of regions in the plan + int num_districts; // Number of districts in the plan + int num_multidistricts; // Number of multidistricts, always `num_regions` - `num_districts` + double map_pop; // The population of the entire map + + std::vector region_labels; // Representation of regions in string form (easy to trace lineage) + // Regions have R prefix whereas districts are just an integer (in string form). This is a vector length V + // which should have num_regions district values (I DO NOT CHECK THIS RIGHT NOW) + std::vector region_num_ids; // Representation of regions in integer form (not as easy to trace + // lineage). This is a length V vector where ith value maps it the integer id of its region + std::vector region_dval; //Vector of length V mapping vertex to the d value of its region + std::vector region_pop; //Vector of length V mapping vertex to the population of ITS REGION + + std::map r_to_d_map; // Map of region label values to the d_n,k value (number of districts + std::map r_to_pop_map; // Map of region label values to The population of that region + + std::map str_label_to_num_id_map; //Maps region label values to integer id number + std::map num_id_to_str_label_map; //Maps region label values to integer id number + + + // methods + void Rprint() const; + +}; + #endif diff --git a/src/smc.h b/src/smc.h index 5b1b213ea..1757b6caf 100644 --- a/src/smc.h +++ b/src/smc.h @@ -29,6 +29,8 @@ List smc_plans(int N, List l, const arma::uvec &counties, const arma::uvec &pop, arma::umat districts, int n_drawn, int n_steps, List constraints, List control, int verbosity=1); + + /* * Split off a piece from each map in `districts`, * keeping deviation between `lower` and `upper` diff --git a/src/tree_op.cpp b/src/tree_op.cpp index 6c6c78ff9..6547f2b65 100644 --- a/src/tree_op.cpp +++ b/src/tree_op.cpp @@ -174,6 +174,25 @@ void assign_district(const Tree &ust, subview_col &districts, } } + +/* + * Assign `new_region` to all descendants of `root` in `ust` + */ +// TESTED +void assign_region(const Tree &ust, Plan &plan, + int root, + std::string new_region, int new_region_num_id, + double new_region_pop, int new_region_d) { + plan.region_labels.at(root) = new_region; + plan.region_num_ids.at(root) = new_region_num_id; + plan.region_pop.at(root) = new_region_pop; + plan.region_dval.at(root) = new_region_d; + int n_desc = ust.at(root).size(); + for (int i = 0; i < n_desc; i++) { + assign_region(ust, plan, ust.at(root).at(i), new_region, new_region_num_id, new_region_pop, new_region_d); + } +} + /* * Find the root of a subtree. */ diff --git a/src/tree_op.h b/src/tree_op.h index b1c16141f..2589518a3 100644 --- a/src/tree_op.h +++ b/src/tree_op.h @@ -65,6 +65,15 @@ int tree_pop(Tree &ust, int vtx, const uvec &pop, void assign_district(const Tree &ust, subview_col &districts, int root, int district); +/* + * Assign `new_region` to all descendants of `root` in `ust` + */ +// TESTED +void assign_region(const Tree &ust, Plan &plan, + int root, + std::string new_region, int new_region_num_id, + double new_region_pop, int new_region_d); + /* * Find the root of a subtree. */ From 5bfd0d877d655abac4a614aa9e07aec0d7bf2f7f Mon Sep 17 00:00:00 2001 From: "Philip W. O'Sullivan" Date: Sun, 1 Sep 2024 17:26:18 -0400 Subject: [PATCH 004/324] added documentation for new functions. Mostly finished but still a little more to be done --- NAMESPACE | 2 +- R/RcppExports.R | 26 +- R/redist_gsmc.R | 2 +- man/gsmc_plans.Rd | 56 ++++ src/RcppExports.cpp | 10 +- src/generalized_smc.h | 44 --- src/{generalized_smc.cpp => gsmc.cpp} | 259 +++++++++++++----- src/gsmc.h | 68 +++++ ...lized_smc_helpers.cpp => gsmc_helpers.cpp} | 132 ++++++--- ...neralized_smc_helpers.h => gsmc_helpers.h} | 0 10 files changed, 427 insertions(+), 172 deletions(-) create mode 100644 man/gsmc_plans.Rd delete mode 100644 src/generalized_smc.h rename src/{generalized_smc.cpp => gsmc.cpp} (71%) create mode 100644 src/gsmc.h rename src/{generalized_smc_helpers.cpp => gsmc_helpers.cpp} (69%) rename src/{generalized_smc_helpers.h => gsmc_helpers.h} (100%) diff --git a/NAMESPACE b/NAMESPACE index 2ff11fb13..f8fbf4640 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -84,7 +84,6 @@ export(county_splits) export(distr_compactness) export(filter) export(freeze) -export(generalized_smc_plans) export(get_adj) export(get_existing) export(get_mh_acceptance_rate) @@ -94,6 +93,7 @@ export(get_pop_tol) export(get_sampling_info) export(get_target) export(group_frac) +export(gsmc_plans) export(is_contiguous) export(is_county_split) export(last_plan) diff --git a/R/RcppExports.R b/R/RcppExports.R index 87be6c7df..650379000 100644 --- a/R/RcppExports.R +++ b/R/RcppExports.R @@ -53,9 +53,31 @@ dist_dist_diff <- function(p, i_dist, j_dist, x_center, y_center, x, y) { .Call(`_redist_dist_dist_diff`, p, i_dist, j_dist, x_center, y_center, x, y) } +#' Uses gsmc method to generate a sample of `M` plans in `c++` +#' +#' Using the procedure outlined in this function uses Sequential +#' Monte Carlo (SMC) methods to generate a sample of `M` plans +#' +#' @title Run redist gsmc +#' +#' @param N The number of districts the final plans will have +#' @param adj_list A 0-indexed adjacency list representing the undirected graph +#' which represents the underlying map the plans are to be drawn on +#' @param counties Vector of county labels of each vertex in `g` +#' @param pop A vector of the population associated with each vertex in `g` +#' @param target Ideal population of a valid district. This is what deviance is calculated +#' relative to +#' @param lower Acceptable lower bounds on a valid district's population +#' @param upper Acceptable upper bounds on a valid district's population +#' @param M The number of plans (samples) to draw +#' @param k_param The k parameter from the SMC algorithm, you choose among the top k_param edges +#' @param control Named list of additional parameters. +#' @param num_threads The number of threads the threadpool should use +#' @param verbosity What level of detail to print out while the algorithm is +#' running #' @export -generalized_smc_plans <- function(N, adj_list, counties, pop, target, lower, upper, M, k_param, control, ncores = -1L, verbosity = 3L) { - .Call(`_redist_generalized_smc_plans`, N, adj_list, counties, pop, target, lower, upper, M, k_param, control, ncores, verbosity) +gsmc_plans <- function(N, adj_list, counties, pop, target, lower, upper, M, k_param, control, ncores = -1L, verbosity = 3L) { + .Call(`_redist_gsmc_plans`, N, adj_list, counties, pop, target, lower, upper, M, k_param, control, ncores, verbosity) } log_st_map <- function(g, districts, counties, n_distr) { diff --git a/R/redist_gsmc.R b/R/redist_gsmc.R index 393968a0b..adb36fa7e 100644 --- a/R/redist_gsmc.R +++ b/R/redist_gsmc.R @@ -116,7 +116,7 @@ redist_gsmc <- function(state_map, M, counties = NULL, k_param_val = 6, run_verbosity <- if (chain == 1) verbosity else 0 t1_run <- Sys.time() - algout <- redist::generalized_smc_plans( + algout <- redist::gsmc_plans( N=N, adj_list=adj_list, counties=counties, diff --git a/man/gsmc_plans.Rd b/man/gsmc_plans.Rd new file mode 100644 index 000000000..4a84da43d --- /dev/null +++ b/man/gsmc_plans.Rd @@ -0,0 +1,56 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/RcppExports.R +\name{gsmc_plans} +\alias{gsmc_plans} +\title{Run redist gsmc} +\usage{ +gsmc_plans( + N, + adj_list, + counties, + pop, + target, + lower, + upper, + M, + k_param, + control, + ncores = -1L, + verbosity = 3L +) +} +\arguments{ +\item{N}{The number of districts the final plans will have} + +\item{adj_list}{A 0-indexed adjacency list representing the undirected graph +which represents the underlying map the plans are to be drawn on} + +\item{counties}{Vector of county labels of each vertex in \code{g}} + +\item{pop}{A vector of the population associated with each vertex in \code{g}} + +\item{target}{Ideal population of a valid district. This is what deviance is calculated +relative to} + +\item{lower}{Acceptable lower bounds on a valid district's population} + +\item{upper}{Acceptable upper bounds on a valid district's population} + +\item{M}{The number of plans (samples) to draw} + +\item{k_param}{The k parameter from the SMC algorithm, you choose among the top k_param edges} + +\item{control}{Named list of additional parameters.} + +\item{verbosity}{What level of detail to print out while the algorithm is +running \if{html}{\out{}}} + +\item{num_threads}{The number of threads the threadpool should use} +} +\description{ +Uses gsmc method to generate a sample of \code{M} plans in \verb{c++} +} +\details{ +Using the procedure outlined in \if{html}{\out{}} this function uses Sequential +Monte Carlo (SMC) methods to generate a sample of \code{M} plans +} diff --git a/src/RcppExports.cpp b/src/RcppExports.cpp index 5da782861..8a963eba3 100644 --- a/src/RcppExports.cpp +++ b/src/RcppExports.cpp @@ -191,9 +191,9 @@ BEGIN_RCPP return rcpp_result_gen; END_RCPP } -// generalized_smc_plans -List generalized_smc_plans(int N, List adj_list, const arma::uvec& counties, const arma::uvec& pop, double target, double lower, double upper, int M, int k_param, List control, int ncores, int verbosity); -RcppExport SEXP _redist_generalized_smc_plans(SEXP NSEXP, SEXP adj_listSEXP, SEXP countiesSEXP, SEXP popSEXP, SEXP targetSEXP, SEXP lowerSEXP, SEXP upperSEXP, SEXP MSEXP, SEXP k_paramSEXP, SEXP controlSEXP, SEXP ncoresSEXP, SEXP verbositySEXP) { +// gsmc_plans +List gsmc_plans(int N, List adj_list, const arma::uvec& counties, const arma::uvec& pop, double target, double lower, double upper, int M, int k_param, List control, int ncores, int verbosity); +RcppExport SEXP _redist_gsmc_plans(SEXP NSEXP, SEXP adj_listSEXP, SEXP countiesSEXP, SEXP popSEXP, SEXP targetSEXP, SEXP lowerSEXP, SEXP upperSEXP, SEXP MSEXP, SEXP k_paramSEXP, SEXP controlSEXP, SEXP ncoresSEXP, SEXP verbositySEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; @@ -209,7 +209,7 @@ BEGIN_RCPP Rcpp::traits::input_parameter< List >::type control(controlSEXP); Rcpp::traits::input_parameter< int >::type ncores(ncoresSEXP); Rcpp::traits::input_parameter< int >::type verbosity(verbositySEXP); - rcpp_result_gen = Rcpp::wrap(generalized_smc_plans(N, adj_list, counties, pop, target, lower, upper, M, k_param, control, ncores, verbosity)); + rcpp_result_gen = Rcpp::wrap(gsmc_plans(N, adj_list, counties, pop, target, lower, upper, M, k_param, control, ncores, verbosity)); return rcpp_result_gen; END_RCPP } @@ -768,7 +768,7 @@ static const R_CallMethodDef CallEntries[] = { {"_redist_update_conncomp", (DL_FUNC) &_redist_update_conncomp, 3}, {"_redist_crsg", (DL_FUNC) &_redist_crsg, 9}, {"_redist_dist_dist_diff", (DL_FUNC) &_redist_dist_dist_diff, 7}, - {"_redist_generalized_smc_plans", (DL_FUNC) &_redist_generalized_smc_plans, 12}, + {"_redist_gsmc_plans", (DL_FUNC) &_redist_gsmc_plans, 12}, {"_redist_log_st_map", (DL_FUNC) &_redist_log_st_map, 4}, {"_redist_n_removed", (DL_FUNC) &_redist_n_removed, 3}, {"_redist_countpartitions", (DL_FUNC) &_redist_countpartitions, 1}, diff --git a/src/generalized_smc.h b/src/generalized_smc.h deleted file mode 100644 index 750fcf48e..000000000 --- a/src/generalized_smc.h +++ /dev/null @@ -1,44 +0,0 @@ -#pragma once -#ifndef GENERALIZED_SMC_H -#define GENERALIZED_SMC_H - -// [[Rcpp::depends(redistmetrics)]] - -#include "smc_base.h" - -#include -#include -#include -#include -#include -#include -#include - -#include -#include "wilson.h" -#include "tree_op.h" -#include "map_calc.h" -#include "redist_types.h" -#include "generalized_smc_helpers.h" - - -//' @export -// [[Rcpp::export]] -List generalized_smc_plans( - int N, List adj_list, - const arma::uvec &counties, const arma::uvec &pop, - double target, double lower, double upper, - int M, int k_param,// Number of particles aka number of different plans - List control, - int ncores = -1, int verbosity = 3); - - - - -bool attempt_region_split(const Graph &g, Tree &ust, const uvec &counties, Multigraph &cg, - Plan &plan, const std::string region_to_split, - std::vector &new_region_labels, - std::vector &visited, std::vector &ignore, const uvec &pop, - double &lower, double upper, double target, int k_param); - -#endif diff --git a/src/generalized_smc.cpp b/src/gsmc.cpp similarity index 71% rename from src/generalized_smc.cpp rename to src/gsmc.cpp index d37212549..0f4a55eb1 100644 --- a/src/generalized_smc.cpp +++ b/src/gsmc.cpp @@ -1,4 +1,4 @@ -#include "generalized_smc.h" +#include "gsmc.h" //' Attempts to cut one region into two from spanning tree @@ -10,13 +10,15 @@ //' @title Attempt Generalized Region split //' //' @param ust A directed spanning tree passed by reference -//' @param root The root of the spanning tree -//' @param pop Vector of mapping vertices to population (0-indexed) +//' @param k_param The k parameter from the SMC algorithm, you choose among the top k_param edges +//' @param root The root vertex of the spanning tree +//' @param pop A vector of the population associated with each vertex in `g` //' @param plan A plan object //' @param region_to_split The label of the region in the plan object we're attempting to split -//' @param lower Acceptable lower bounds on district population -//' @param upper Acceptable upper bounds on district population -//' @param target Target population (probably Total population of map/Num districts ) +//' @param lower Acceptable lower bounds on a valid district's population +//' @param upper Acceptable upper bounds on a valid district's population +//' @param target Ideal population of a valid district. This is what deviance is calculated +//' relative to //' @param new_region_labels A vector that will be updated by reference to contain the names of //' the two new split regions if function is successful. //' @@ -237,17 +239,6 @@ bool cut_regions(Tree &ust, int k_param, int root, } - bool pop_testing = new_region1_pop/new_region1_d >= lower && new_region1_pop/new_region1_d <= upper && - new_region2_pop/new_region2_d >= lower && new_region2_pop/new_region2_d <= upper; - - if(!pop_testing){ - Rprintf("AHHHHH BADDDDDD!!!!\n\n"); - } - - /* - Rcout << new_region_label1 << " has population " << new_region1_pop << " and "<< new_region_label1 << " is " << new_region2_pop <<"\n"; - Rcout << "R1.R1 has d " << new_region1_d << " and other is " << new_region2_d <<"\n"; - */ // update the function parameter with names of new regions if(new_region_labels.size() != 2){ @@ -291,30 +282,33 @@ bool cut_regions(Tree &ust, int k_param, int root, -//' Attempts to split a multi-district into two new regions with valid population -//' bounds +//' Attempts to split a multi-district within a plan into two new regions with +//' valid population bounds //' -//' Attempts to split a multi-district into two new regions where both regions -//' have valid population bounds. Does this by drawing a spanning tree uniformly -//' at random then calling `cut_regions` on that. If the split it successful it -//' returns true and modifies `plan` and `new_region_labels` accordingly. This -//' is based on the `split_map` function in smc.cpp +//' Given a plan this attempts to split a multi-district in it into two new +//' regions where both regions have valid population bounds. Does this by +//' drawing a spanning tree uniformly at random then calling `cut_regions` on +//' that. If the split it successful it returns true and modifies `plan` and +//' `new_region_labels` accordingly. This is based on the `split_map` function +//' in smc.cpp //' //' -//' @title Attempt Generalized Region split of multi-district +//' @title Attempt Generalized Region split of a multi-district within a plan //' //' @param g A graph (adjacency list) passed by reference //' @param ust A directed tree object (this will be cleared in the function so //' whatever it was before doesn't matter) -//' @param counties Vector of county labels +//' @param counties Vector of county labels of each vertex in `g` //' @param cg multigraph object (not sure why this is needed) //' @param plan A plan object //' @param region_to_split The label of the region in the plan object we're attempting to split //' @param new_region_labels A vector that will be updated by reference to contain the names of //' the two new split regions if function is successful. -//' @param lower Acceptable lower bounds on district population -//' @param upper Acceptable upper bounds on district population -//' @param target Target population (probably Total population of map/Num districts ) +//' @param lower Acceptable lower bounds on a valid district's population +//' @param upper Acceptable upper bounds on a valid district's population +//' @param target Ideal population of a valid district. This is what deviance is calculated +//' relative to +//' Target population (probably Total population of map/Num districts) //' @param k_param The k parameter from the SMC algorithm, you choose among the top k_param edges //' //' @details Modifications @@ -329,6 +323,7 @@ bool attempt_region_split(const Graph &g, Tree &ust, const uvec &counties, Multi std::vector &new_region_labels, std::vector &visited, std::vector &ignore, const uvec &pop, double &lower, double upper, double target, int k_param) { + int V = g.size(); // Mark it as ignore if its not in the region to split @@ -350,7 +345,6 @@ bool attempt_region_split(const Graph &g, Tree &ust, const uvec &counties, Multi lower, upper, target, new_region_labels); - } @@ -366,14 +360,108 @@ bool attempt_region_split(const Graph &g, Tree &ust, const uvec &counties, Multi // Everything else can happen outside. // Actually we compute incremental weight in the function. + +//' Splits a multidistrict in all of the plans +//' +//' Using the procedure outlined in this function attempts to split +//' a multidistrict in a previous steps plan until M successful splits have been made. This +//' is based on the `split_maps` function in smc.cpp +//' +//' @title Split all the maps +//' +//' @param g A graph (adjacency list) passed by reference +//' @param counties Vector of county labels of each vertex in `g` +//' @param cg County level multigraph +//' @param pop A vector of the population associated with each vertex in `g` +//' @param old_plans_vec A vector of plans from the previous step +//' @param new_plans_vec A vector which will be filled with plans that had a +//' multidistrict split to make them +//' @param original_ancestor_vec A vector used to track which original ancestor +//' the new plans descended from. The value of `original_ancestor_vec[i]` +//' is the index of the original ancestor the new plan `new_plans_vec[i]` is +//' descended from. +//' @param parent_vec A vector used to track the index of the previous plan +//' sampled that was successfully split. The value of `parent_vec[i]` is the +//' index of the old plan from which the new plan `new_plans_vec[i]` was +//' successfully split from. In other words `new_plans_vec[i]` is equal to +//' `attempt_region_split(old_plans_vec[parent_vec[i]], ...)` +//' @param prev_ancestor_vec A vector used to track the index of the original +//' ancestor of the previous plans. The value of `prev_ancestor_vec[i]` is the +//' index of the original ancestor of `old_plans_vec[i]` +//' @param new_log_incremental_weights A vector of the new log incremental weights +//' computed for the new plans. The value of `new_log_incremental_weights[i]` is +//' the log incremental weight for `new_plans_vec[i]` +//' @param unnormalized_sampling_weights A vector of weights used to sample indices +//' of the `old_plans_vec`. The value of `unnormalized_sampling_weights[i]` is +//' the unnormalized probability that index i is selected +//' @param normalized_weights_to_fill_in A vector which will be filled with the +//' normalized weights the index sampler uses. The value of +//' `normalized_weights_to_fill_in[i]` is the probability that index i is selected +//' @param draw_tries_vec A vector used to keep track of how many plan split +//' attempts were made for index i. The value `draw_tries_vec[i]` represents how +//' many split attempts were made for the i-th new plan (including the successful +//' split). For example, `draw_tries_vec[i] = 1` means that the first split +//' attempt was successful. +//' @param accept_rate The number of accepted splits over the total number of +//' attempted splits. This is equal to `sum(draw_tries_vec)/M` +//' @param n_unique_parent_indices The number of unique parent indices, ie the +//' number of previous plans that had at least one descendant amongst the new +//' plans. This is equal to `unique(parent_vec)` +//' @param n_unique_original_ancestors The number of unique original ancestors, +//' in the new plans. This is equal to `unique(original_ancestor_vec)` +//' @param ancestors Parameter from older `smc.cpp` code. I DON'T UNDERSTAND +//' WHAT IT IS DOING +//' @param lags Parameter from older `smc.cpp` code. I DON'T UNDERSTAND +//' WHAT IT IS DOING +//' @param lower Acceptable lower bounds on a valid district's population +//' @param upper Acceptable upper bounds on a valid district's population +//' @param target Ideal population of a valid district. This is what deviance is calculated +//' relative to +//' @param k_param The top edges to pick parameter for the region splitting +//' algorithm +//' @param pool A threadpool for multithreading +//' @param verbosity A parameter controlling the amount of detail printed out +//' during the algorithms running +//' +//' @details Modifications +//' - The `new_plans_vec` is updated with all the newly split plans +//' - The `old_plans_vec` is updated with all the newly split plans as well. +//' Note that the reason both this and `new_plans_vec` are updated is because +//' of the nature of the code you need both vectors and so both are passed by +//' reference to save memory. +//' - The `original_ancestor_vec` is updated to contain the indices of the +//' original ancestors of the new plans +//' - The `parent_vec` is updated to contain the indices of the parents of the + //' new plans +//' - If two new valid regions are split then the new_region_labels is updated so the +//' first entry is the first new region and the second entry is the second new region +//' - The `new_log_incremental_weights` is updated to contain the incremental +//' weights of the new plans NOTE: In the future this will be moved to its +//' own function +//' - The `normalized_weights_to_fill_in` is updated to contain the normalized +//' probabilities the index sampler used. This is only collected for diagnostics +//' at this point and should just be equal to `unnormalized_sampling_weights` +//' divided by `sum(unnormalized_sampling_weights)` +//' - The `draw_tries_vec` is updated to contain the number of tries for each +//' of the new plans +//' - The `accept_rate` is updated to contain the average acceptance rate for +//' this iteration +//' - `n_unique_parent_indices` and `n_unique_original_ancestors` are updated +//' with the unique number of parents and original ancestors for all the new +//' plans respectively +//' - `ancestors` is updated to something. THIS IS FROM ORIGINAL SMC CODE, +//' I DO NOT KNOW WHAT IT MEANS +//' +//' @return nothing +//' void generalized_split_maps( const Graph &g, const uvec &counties, Multigraph &cg, const uvec &pop, std::vector &old_plans_vec, std::vector &new_plans_vec, std::vector &original_ancestor_vec, std::vector &parent_vec, const std::vector &prev_ancestor_vec, - std::vector &log_incremental_weights, - const std::vector &unnormalized_weights, + std::vector &new_log_incremental_weights, + const std::vector &unnormalized_sampling_weights, std::vector &normalized_weights_to_fill_in, std::vector &draw_tries_vec, double &accept_rate, @@ -385,44 +473,38 @@ void generalized_split_maps( RcppThread::ThreadPool &pool, int verbosity ) { + // important constants const int V = g.size(); - const int n_lags = lags.size(); const int M = old_plans_vec.size(); - const int dist_ctr = old_plans_vec.at(0).num_regions; + uvec iters(M, fill::zeros); // how many actual iterations, (used to compute acceptance rate) + uvec original_ancestor_uniques(M); // used to compute unique original ancestors + uvec parent_index_uniques(M); // used to compute unique parent indicies - - - uvec iters(M, fill::zeros); // how many actual iterations - uvec original_ancestor_uniques(M); // unique original ancestors - uvec parent_index_uniques(M); // unique parent indicies - + // PREVIOUS SMC CODE I DONT KNOW WHAT IT DOES + const int dist_ctr = old_plans_vec.at(0).num_regions; + const int n_lags = lags.size(); umat ancestors_new(M, n_lags); // lags/ancestor thing - // Create the obj which will sample from the index with probability // proportional to the weights std::random_device rd; std::mt19937 gen(rd()); std::discrete_distribution<> index_sampler( - unnormalized_weights.begin(), unnormalized_weights.end() + unnormalized_sampling_weights.begin(), + unnormalized_sampling_weights.end() ); + // extract and record the normalized weights the sampler is using std::vector p = index_sampler.probabilities(); - - // for(int i=0;i < M, i++){ - // normalized_weights_to_fill_in.at(i) = ; - // } - - // record the normalized weights the sampler is using int nw_index = 0; bool print_weights = M < 12 && verbosity > 1; if(print_weights){ Rprintf("Unnormalized weights are: "); - for (auto w : unnormalized_weights){ + for (auto w : unnormalized_sampling_weights){ Rprintf("%.4f, ", w); } @@ -436,12 +518,15 @@ void generalized_split_maps( } if(print_weights) Rprintf("\n"); - + // Because of multithreading we have to add specific checks for if the user + // wants to quit the program const int reject_check_int = 200; // check for interrupts every _ rejections const int check_int = 50; // check for interrupts every _ iterations + // create a progress bar RcppThread::ProgressBar bar(M, 1); + // Parallel thread pool where all objects in memory shared by default pool.parallelFor(0, M, [&] (int i) { int reject_ct = 0; bool ok = false; @@ -453,18 +538,16 @@ void generalized_split_maps( std::vector visited(V); std::vector ignore(V); while (!ok) { + // increase the iters count by one + iters[i]++; // use weights to sample previous plan idx = index_sampler(gen); - Plan proposed_new_plan = old_plans_vec[idx]; - iters[i]++; - // pick a region to try to split choose_multidistrict_to_split( old_plans_vec[idx], region_to_split); - // Now try to split that region ok = attempt_region_split(g, ust, counties, cg, proposed_new_plan, region_to_split, @@ -478,20 +561,23 @@ void generalized_split_maps( continue; } - // else update the new plan + // else update the new plan and leave the while loop new_plans_vec[i] = proposed_new_plan; } - // update the log incremental weights - log_incremental_weights[i] = compute_log_incremental_weight(g, new_plans_vec[i]); - + // compute the log incremental weight for the new plan + new_log_incremental_weights[i] = compute_log_incremental_weight(g, new_plans_vec[i]); + // Record how many tries needed to create i-th new plan draw_tries_vec[i] = static_cast(iters[i]); - + // Make the new plans original ancestor the same as its parent original_ancestor_uniques[i] = prev_ancestor_vec[idx]; + // record index of new plan's parent parent_index_uniques[i] = idx; + // clear the spanning tree clear_tree(ust); + // ORIGINAL SMC CODE I DONT KNOW WHAT THIS DOES // save ancestors/lags for (int j = 0; j < n_lags; j++) { if (dist_ctr <= lags[j]) { @@ -509,6 +595,7 @@ void generalized_split_maps( RcppThread::checkUserInterrupt(i % check_int == 0); }); + // Wait for all the threads to finish pool.wait(); @@ -519,6 +606,7 @@ void generalized_split_maps( } + // now compute acceptance rate and unique parents and original ancestors accept_rate = M / (1.0 * sum(iters)); n_unique_original_ancestors = ((uvec) find_unique(original_ancestor_uniques)).n_elem; n_unique_parent_indices = ((uvec) find_unique(parent_index_uniques)).n_elem; @@ -529,36 +617,59 @@ void generalized_split_maps( if(print_weights){ Rprintf("Log Incremental weights are: "); - for (auto w : log_incremental_weights){ + for (auto w : new_log_incremental_weights){ Rprintf("%.4f, ", w); } Rprintf("\n"); } + // ORIGINAL SMC CODE I DONT KNOW WHAT IT DOES ancestors = ancestors_new; - } -List generalized_smc_plans( +//' Uses gsmc method to generate a sample of `M` plans in `c++` +//' +//' Using the procedure outlined in this function uses Sequential +//' Monte Carlo (SMC) methods to generate a sample of `M` plans +//' +//' @title Run redist gsmc +//' +//' @param N The number of districts the final plans will have +//' @param adj_list A 0-indexed adjacency list representing the undirected graph +//' which represents the underlying map the plans are to be drawn on +//' @param counties Vector of county labels of each vertex in `g` +//' @param pop A vector of the population associated with each vertex in `g` +//' @param target Ideal population of a valid district. This is what deviance is calculated +//' relative to +//' @param lower Acceptable lower bounds on a valid district's population +//' @param upper Acceptable upper bounds on a valid district's population +//' @param M The number of plans (samples) to draw +//' @param k_param The k parameter from the SMC algorithm, you choose among the top k_param edges +//' @param control Named list of additional parameters. +//' @param num_threads The number of threads the threadpool should use +//' @param verbosity What level of detail to print out while the algorithm is +//' running +//' @export +List gsmc_plans( int N, List adj_list, const arma::uvec &counties, const arma::uvec &pop, double target, double lower, double upper, int M, int k_param, // M is Number of particles aka number of different plans List control, - int ncores, int verbosity){ + int num_threads, int verbosity){ - // cores stuff - if (ncores <= 0) ncores = std::thread::hardware_concurrency(); - if (ncores == 1) ncores = 0; + // set number of threads + if (num_threads <= 0) num_threads = std::thread::hardware_concurrency(); + if (num_threads == 1) num_threads = 0; // lags thing (copied from original smc code, don't understand what its doing) std::vector lags = as>(control["lags"]); umat ancestors(M, lags.size(), fill::zeros); - // Now create data necessary to split the maps + // Create map level graph and county level multigraph Graph g = list_to_graph(adj_list); Multigraph cg = county_graph(g, counties); @@ -628,7 +739,7 @@ List generalized_smc_plans( Rcout << "GENERALIZED SEQUENTIAL MONTE CARLO\n"; Rcout << "Sampling " << M << " " << V << "-unit "; Rcout << "maps with " << N << " districts and population between " - << lower << " and " << upper << " using " << ncores << " cores.\n"; + << lower << " and " << upper << " using " << num_threads << " threads.\n"; if (cg.size() > 1){ Rcout << "Ensuring no more than " << N - 1 << " splits of the " << cg.size() << " administrative units.\n"; @@ -636,12 +747,12 @@ List generalized_smc_plans( } // Start off all the unnormalized weights at 1 - std::vector unnormalized_weights(M, 1.0); + std::vector unnormalized_sampling_weights(M, 1.0); // Create a threadpool - RcppThread::ThreadPool pool(ncores); + RcppThread::ThreadPool pool(num_threads); std::string bar_fmt = "Split [{cli::pb_current}/{cli::pb_total}] {cli::pb_bar} | ETA{cli::pb_eta}"; RObject bar = cli_progress_bar(N-1, cli_config(false, bar_fmt.c_str())); @@ -665,7 +776,7 @@ List generalized_smc_plans( parent_index_mat[n], dummy_prev_ancestors, log_incremental_weights_mat[n], - unnormalized_weights, + unnormalized_sampling_weights, normalized_weights_mat[n], draw_tries_mat[n], acceptance_rates[n], @@ -690,7 +801,7 @@ List generalized_smc_plans( parent_index_mat[n], original_ancestor_mat[n-1], log_incremental_weights_mat[n], - unnormalized_weights, + unnormalized_sampling_weights, normalized_weights_mat[n], draw_tries_mat[n], acceptance_rates[n], @@ -714,8 +825,8 @@ List generalized_smc_plans( // Now update the weights, region labels, dval column of the matrix for(int j=0; j +#include +#include +#include +#include +#include +#include + +#include +#include "wilson.h" +#include "tree_op.h" +#include "map_calc.h" +#include "redist_types.h" +#include "gsmc_helpers.h" + + + + +//' Uses gsmc method to generate a sample of `M` plans in `c++` +//' +//' Using the procedure outlined in this function uses Sequential +//' Monte Carlo (SMC) methods to generate a sample of `M` plans +//' +//' @title Run redist gsmc +//' +//' @param N The number of districts the final plans will have +//' @param adj_list A 0-indexed adjacency list representing the undirected graph +//' which represents the underlying map the plans are to be drawn on +//' @param counties Vector of county labels of each vertex in `g` +//' @param pop A vector of the population associated with each vertex in `g` +//' @param target Ideal population of a valid district. This is what deviance is calculated +//' relative to +//' @param lower Acceptable lower bounds on a valid district's population +//' @param upper Acceptable upper bounds on a valid district's population +//' @param M The number of plans (samples) to draw +//' @param k_param The k parameter from the SMC algorithm, you choose among the top k_param edges +//' @param control Named list of additional parameters. +//' @param num_threads The number of threads the threadpool should use +//' @param verbosity What level of detail to print out while the algorithm is +//' running +//' @export +// [[Rcpp::export]] +List gsmc_plans( + int N, List adj_list, + const arma::uvec &counties, const arma::uvec &pop, + double target, double lower, double upper, + int M, int k_param,// Number of particles aka number of different plans + List control, + int ncores = -1, int verbosity = 3); + + + + +bool attempt_region_split(const Graph &g, Tree &ust, const uvec &counties, Multigraph &cg, + Plan &plan, const std::string region_to_split, + std::vector &new_region_labels, + std::vector &visited, std::vector &ignore, const uvec &pop, + double &lower, double upper, double target, int k_param); + +#endif diff --git a/src/generalized_smc_helpers.cpp b/src/gsmc_helpers.cpp similarity index 69% rename from src/generalized_smc_helpers.cpp rename to src/gsmc_helpers.cpp index 50e677388..88684f575 100644 --- a/src/generalized_smc_helpers.cpp +++ b/src/gsmc_helpers.cpp @@ -1,4 +1,4 @@ -#include "generalized_smc_helpers.h" +#include "gsmc_helpers.h" //' Computes the effective sample size from log incremental weights @@ -12,12 +12,15 @@ //' //' @param log_wgt vector of log incremental weights //' +//' @details No modifications to inputs made +//' //' @return sum of weights squared over sum of squared weights (sum(wgt)^2 / sum(wgt^2)) //' double compute_n_eff(const std::vector &log_wgt) { double sum_wgt = 0.0; double sum_wgt_squared = 0.0; + // compute sum of squares and square of sum for (const double& log_w : log_wgt) { double wgt = std::exp(log_w); sum_wgt += wgt; @@ -32,7 +35,7 @@ double compute_n_eff(const std::vector &log_wgt) { -//' Returns the log of the Count of the number of edges across two regions in +//' Returns the log of the count of the number of edges across two regions in //' the underlying graph. //' //' Given a graph and two regions in the graph this function counts the number of @@ -48,43 +51,37 @@ double compute_n_eff(const std::vector &log_wgt) { //' @param region1_label The label of the first region //' @param region2_label The label of the second region //' -//' @details Modifications -//' - If two new valid regions are split then the plan object is updated accordingly -//' - If two new valid regions are split then the new_region_labels is updated so the -//' first entry is the first new region and the second entry is the second new region +//' @details No modifications to inputs made //' -//' @return True if two valid regions were split off false otherwise +//' @return the log of the boundary count //' double region_log_boundary(const Graph &g, const Plan &plan, std::string const®ion1_label, std::string const®ion2_label ) { - int V = g.size(); - + int V = g.size(); // get number of vertices double count = 0; // count of number of edges across the two regions - // Iterate over every vertex + + // Iterate over every vertex in the graph for (int i = 0; i < V; i++) { /* Check vertex if in first region, if not continue - Since edges appear twice in adjcancy list to avoid double + Since edges appear twice in adjacency list to avoid double counting we will only count those where first edge is in region 1 */ if (plan.region_labels.at(i) != region1_label) continue; - - // Get vertices neighbors + // Get vertice's neighbors std::vector nbors = g[i]; // Since edges show up twice to avoid double counting we will only count // edges where first one is region1_label and second is region2_label - - - // Now check if neighbors are in second regoin + // Now check if neighbors are in second region for (int nbor : nbors) { if (plan.region_labels.at(nbor) != region2_label) continue; - // otherwise, boundary with root -> ... -> i -> nbor + // if they are increase count by one count += 1.0; } } @@ -94,7 +91,6 @@ double compute_n_eff(const std::vector &log_wgt) { - //' Selects a multidistrict with probability proportional to its d_nk value and //' returns the log probability of the selected region //' @@ -110,10 +106,9 @@ double compute_n_eff(const std::vector &log_wgt) { //' @param region_to_split a string that will be updated by reference with the //' name of the region selected to split //' -//' @details Modifications -//' - sets `region_to_split` to be the region that was selected +//' @details No modifications to inputs made //' -//' @return the log of the probability the specific value of `region_to_split` was chosen +//' @return the region level graph //' double choose_multidistrict_to_split( Plan const&plan, std::string ®ion_to_split){ @@ -164,20 +159,33 @@ double choose_multidistrict_to_split( -/* - * Make the region adjacency graph for `plan` from the overall precinct graph `g` - * where the regions are represented by their integer id representation form - */ -// NOT TESTED but taken from district_graph function which was tested + +// NOT FULLY TESTED but taken from district_graph function which was tested + +//' Creates the region level graph of a plan +//' +//' Given a plan object this returns a graph of the regions in the plan using +//' the region ids as indices +//' +//' @title Get Region-Level Graph +//' +//' @param g The graph of the entire map +//' @param plan A plan object +//' +//' @details No modifications to inputs made +//' +//' @return the log of the probability the specific value of `region_to_split` was chosen +//' Graph get_region_graph(const Graph &g, const Plan &plan) { int V = g.size(); Graph out; + // make a matrix where entry i,j represents if region i and j are adjacent std::vector> gr_bool( plan.num_regions, std::vector(plan.num_regions, false) ); - + // iterate over all vertices in g for (int i = 0; i < V; i++) { std::vector nbors = g[i]; // Find out which region this vertex corresponds to @@ -187,18 +195,21 @@ Graph get_region_graph(const Graph &g, const Plan &plan) { for (int nbor : nbors) { // find which region neighbor corresponds to int region_num_j = plan.region_num_ids[nbor]; - // if they are different regions mark matrix true + // if they are different regions mark matrix true since region i + // and region j are adjacent as they share an edge across if (region_num_i != region_num_j) { gr_bool.at(region_num_i).at(region_num_j) = true; } } - } + // Now build the region level graph for (int i = 0; i < plan.num_regions; i++) { + // create vector of i's neighbors std::vector tmp; for (int j = 0; j < plan.num_regions; j++) { + // check if i and j are adjacent, if so add j if (gr_bool.at(i).at(j)) { tmp.push_back(j); } @@ -209,15 +220,29 @@ Graph get_region_graph(const Graph &g, const Plan &plan) { return out; } -// Given a plan and two regions get the probability their log 'union' would have -// been selected to be split + +//' Get the probability the union of two regions was chosen to split +//' +//' Given a plan object and two regions in the plan this returns the probability +//' the union of the two regions was chosen to be split. +//' +//' @title Get Retroactive Split Selection Probability +//' +//' @param plan A plan object +//' @param region1_label The label of the first region to union +//' @param region2_label The label of the second region to union +//' +//' @details No modifications to inputs made +//' +//' @return the log of the probability the union of the two regions would be +//' chosen to split. +//' double get_log_retroactive_splitting_prob( const Plan &plan, const std::string region1_label, const std::string region2_label ){ - // We just want - // count total + // count total dvals of all the multidistricts int total_multi_ds = 0; @@ -230,7 +255,7 @@ double get_log_retroactive_splitting_prob( } } - // Now get the sum of dnk values of two regions + // Now get the sum of dnk values of two regions aka the unioned old region int unioned_region_dnk = plan.r_to_d_map.at(region1_label) + plan.r_to_d_map.at(region2_label); // update the total number of multi district dvals with the value the union region would have been total_multi_ds += unioned_region_dnk; @@ -249,24 +274,41 @@ double get_log_retroactive_splitting_prob( } -// Compute the incremental log weight +//' Compute the log incremental weight of a plan +//' +//' Given a plan object this computes the minimum variance weights as derived in +//' . This is equivalent to the inverse of a sum over all +//' adjacent regions in a plan. +//' +//' @title Compute Incremental Weight of a plan +//' +//' @param plan A plan object +//' @param g The underlying map graph +//' +//' @details No modifications to inputs made +//' +//' @return the log of the incremental weight of the plan +//' double compute_log_incremental_weight(const Graph &g, const Plan &plan){ + // get a region level graph Graph rg = get_region_graph(g, plan); - // check + // sanity check: make sure the region level graph's number of vertices is + // the same as the number of regions in the plan if((int)rg.size() != plan.num_regions){ Rprintf("SOMETHING WENT WRONG IN COMPPUTE LOG INCREMENT WEIGHJT\n"); } - // First get all adjacent region pairs - - // Set to store unique pairs of adjacent vertices + // Now get all unique adjacent region pairs and store them such that + // the first vertex is always the smaller numbered of the edge + // We use a set because it doesn't keep duplicates std::set> adj_region_pairs; // Iterate through the adjacency list for (int u = 0; u < rg.size(); u++){ // iterate over neighbors for(auto v: rg[u]){ + // store the edges such that smaller vertex is always first if (u < v) { adj_region_pairs.emplace(u, v); } else { @@ -280,18 +322,18 @@ double compute_log_incremental_weight(const Graph &g, const Plan &plan){ double incremental_weight = 0.0; - // Now iterate over all pairs + // Now iterate over all adjacent pairs for (const auto& edge : adj_region_pairs) { // convert to region string label representation std::string region1_label = plan.num_id_to_str_label_map.at(edge.first); std::string region2_label = plan.num_id_to_str_label_map.at(edge.second); - // get log of boundary + // get log of boundary length between regions double log_boundary = region_log_boundary(g, plan, region1_label, region2_label); - // double log_boundary = 0; // get prob of selecting union of adj regions double log_splitting_prob = get_log_retroactive_splitting_prob(plan, region1_label, region2_label); - // NO e^J TERM YET - // add the logs, exponentiate and add the sum + // NO e^J TERM YET but can be added + // multiply the boundary length and selection probability by adding the logs + // now exponentiate and add to the sum incremental_weight += std::exp(log_boundary + log_splitting_prob); } @@ -302,7 +344,7 @@ double compute_log_incremental_weight(const Graph &g, const Plan &plan){ } - // now return log of the weight + // now return the log of the inverse of the sum return -std::log(incremental_weight); } diff --git a/src/generalized_smc_helpers.h b/src/gsmc_helpers.h similarity index 100% rename from src/generalized_smc_helpers.h rename to src/gsmc_helpers.h From 1baad5ba657de9e1dc76f1c84a42337a44674af6 Mon Sep 17 00:00:00 2001 From: "Philip W. O'Sullivan" Date: Tue, 3 Sep 2024 12:42:00 -0400 Subject: [PATCH 005/324] removing format library to try to fix compilation issue on FAS cluster --- src/gsmc.cpp | 1 + src/gsmc.h | 1 - 2 files changed, 1 insertion(+), 1 deletion(-) diff --git a/src/gsmc.cpp b/src/gsmc.cpp index 0f4a55eb1..9f430834f 100644 --- a/src/gsmc.cpp +++ b/src/gsmc.cpp @@ -825,6 +825,7 @@ List gsmc_plans( // Now update the weights, region labels, dval column of the matrix for(int j=0; j #include -#include #include #include #include From 1ae29ca875e6cbdb521f95ffbff5cd45403344de Mon Sep 17 00:00:00 2001 From: "Philip W. O'Sullivan" Date: Thu, 5 Sep 2024 19:51:13 -0400 Subject: [PATCH 006/324] added diagnostic flag to make high mem usage optional --- R/RcppExports.R | 4 +- R/redist_gsmc.R | 63 ++++++++++++++---- src/RcppExports.cpp | 9 +-- src/gsmc.cpp | 158 +++++++++++++++++++++----------------------- src/gsmc.h | 2 +- 5 files changed, 134 insertions(+), 102 deletions(-) diff --git a/R/RcppExports.R b/R/RcppExports.R index 650379000..1cf65eeba 100644 --- a/R/RcppExports.R +++ b/R/RcppExports.R @@ -76,8 +76,8 @@ dist_dist_diff <- function(p, i_dist, j_dist, x_center, y_center, x, y) { #' @param verbosity What level of detail to print out while the algorithm is #' running #' @export -gsmc_plans <- function(N, adj_list, counties, pop, target, lower, upper, M, k_param, control, ncores = -1L, verbosity = 3L) { - .Call(`_redist_gsmc_plans`, N, adj_list, counties, pop, target, lower, upper, M, k_param, control, ncores, verbosity) +gsmc_plans <- function(N, adj_list, counties, pop, target, lower, upper, M, k_param, control, ncores = -1L, verbosity = 3L, diagnostic_mode = FALSE) { + .Call(`_redist_gsmc_plans`, N, adj_list, counties, pop, target, lower, upper, M, k_param, control, ncores, verbosity, diagnostic_mode) } log_st_map <- function(g, districts, counties, n_distr) { diff --git a/R/redist_gsmc.R b/R/redist_gsmc.R index adb36fa7e..512fbfd8b 100644 --- a/R/redist_gsmc.R +++ b/R/redist_gsmc.R @@ -15,7 +15,7 @@ #' @export redist_gsmc <- function(state_map, M, counties = NULL, k_param_val = 6, resample = TRUE, runs = 1L, ncores = 0L, - verbose = FALSE, silent = FALSE){ + verbose = FALSE, silent = FALSE, diagnostic_mode = FALSE){ N <- attr(state_map, "ndists") # no constraints constraints = list() @@ -128,7 +128,8 @@ redist_gsmc <- function(state_map, M, counties = NULL, k_param_val = 6, k_param = k_param_val, control = control, ncores = as.integer(ncores_per), - verbosity=run_verbosity) + verbosity=run_verbosity, + diagnostic_mode=diagnostic_mode) if (length(algout) == 0) { @@ -136,12 +137,18 @@ redist_gsmc <- function(state_map, M, counties = NULL, k_param_val = 6, cli::cli_process_done() } - # add a plans matrix - # IMPORTANT: make it 1 indexed - algout$plans <- matrix( - unlist(algout$region_ids_mat[[N-1]]), - ncol = length(algout$region_ids_mat[[N-1]]), - byrow = FALSE) + 1 + + # make each element of region_ids_mat_list a V by M matrix + algout$region_ids_mat_list <- lapply( + algout$region_ids_mat_list, + function(x) matrix(unlist(x), ncol = length(x), byrow = FALSE) + 1 + ) + + # make each element of region_dvals_mat_list a V by M matrix + algout$region_dvals_mat_list <- lapply( + algout$region_dvals_mat_list, + function(x) matrix(unlist(x), ncol = length(x), byrow = FALSE) + ) # make parent mat into matrix algout$parent_index <- matrix( @@ -149,13 +156,45 @@ redist_gsmc <- function(state_map, M, counties = NULL, k_param_val = 6, ncol = length(algout$parent_index), byrow = FALSE) + # make draws tries into a matrix + algout$draw_tries_mat <- matrix( + unlist(algout$draw_tries_mat), + ncol = length(algout$draw_tries_mat), + byrow = FALSE) + + # make the log incremental weights into a matrix + algout$log_incremental_weights_mat <- matrix( + unlist(algout$log_incremental_weights_mat), + ncol = length(algout$log_incremental_weights_mat), + byrow = FALSE) + # pull out the log weights - # IDK why its negative - lr <- algout$log_incremental_weights_mat[[N-1]] + lr <- algout$log_incremental_weights_mat[,N-1] wgt <- exp(lr - mean(lr)) n_eff <- length(wgt)*mean(wgt)^2/mean(wgt^2) + if(diagnostic_mode){ + # add a plans matrix as the final output because first + # N-2 are previous results + algout$plans <- algout$region_ids_mat_list[[N-1]] + + algout$final_region_labs <- algout$final_region_labs <- matrix( + unlist(algout$final_region_labs), + ncol = length(algout$final_region_labs), + byrow = FALSE) + + }else{ + # Just add first element since not diagnostic mode the first N-2 + # steps were not tracked + algout$plans <- algout$region_ids_mat_list[[1]] + + # make the region_ids_mat_list input just null since there's nothing else + algout$region_ids_mat_list <- NULL + algout$region_dvals_mat_list <- NULL + algout$final_region_labs <- NULL + } + if (any(is.na(lr))) { cli_abort(c("Sampling probabilities have been corrupted.", "*" = "Check that none of your constraint weights are too large. @@ -219,9 +258,9 @@ redist_gsmc <- function(state_map, M, counties = NULL, k_param_val = 6, district_str_labels = algout$final_region_labs, nunique_original_ancestors = algout$nunique_original_ancestors, parent_index_mat = algout$parent_index, - region_dvals_mat = algout$region_dvals_mat, + region_dvals_mat_list = algout$region_dvals_mat_list, log_incremental_weights_mat = algout$log_incremental_weights_mat, - region_ids_mat = algout$region_ids_mat, + region_ids_mat_list = algout$region_ids_mat_list, draw_tries_mat = algout$draw_tries_mat ) diff --git a/src/RcppExports.cpp b/src/RcppExports.cpp index 8a963eba3..2374bcbe8 100644 --- a/src/RcppExports.cpp +++ b/src/RcppExports.cpp @@ -192,8 +192,8 @@ BEGIN_RCPP END_RCPP } // gsmc_plans -List gsmc_plans(int N, List adj_list, const arma::uvec& counties, const arma::uvec& pop, double target, double lower, double upper, int M, int k_param, List control, int ncores, int verbosity); -RcppExport SEXP _redist_gsmc_plans(SEXP NSEXP, SEXP adj_listSEXP, SEXP countiesSEXP, SEXP popSEXP, SEXP targetSEXP, SEXP lowerSEXP, SEXP upperSEXP, SEXP MSEXP, SEXP k_paramSEXP, SEXP controlSEXP, SEXP ncoresSEXP, SEXP verbositySEXP) { +List gsmc_plans(int N, List adj_list, const arma::uvec& counties, const arma::uvec& pop, double target, double lower, double upper, int M, int k_param, List control, int ncores, int verbosity, bool diagnostic_mode); +RcppExport SEXP _redist_gsmc_plans(SEXP NSEXP, SEXP adj_listSEXP, SEXP countiesSEXP, SEXP popSEXP, SEXP targetSEXP, SEXP lowerSEXP, SEXP upperSEXP, SEXP MSEXP, SEXP k_paramSEXP, SEXP controlSEXP, SEXP ncoresSEXP, SEXP verbositySEXP, SEXP diagnostic_modeSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; @@ -209,7 +209,8 @@ BEGIN_RCPP Rcpp::traits::input_parameter< List >::type control(controlSEXP); Rcpp::traits::input_parameter< int >::type ncores(ncoresSEXP); Rcpp::traits::input_parameter< int >::type verbosity(verbositySEXP); - rcpp_result_gen = Rcpp::wrap(gsmc_plans(N, adj_list, counties, pop, target, lower, upper, M, k_param, control, ncores, verbosity)); + Rcpp::traits::input_parameter< bool >::type diagnostic_mode(diagnostic_modeSEXP); + rcpp_result_gen = Rcpp::wrap(gsmc_plans(N, adj_list, counties, pop, target, lower, upper, M, k_param, control, ncores, verbosity, diagnostic_mode)); return rcpp_result_gen; END_RCPP } @@ -768,7 +769,7 @@ static const R_CallMethodDef CallEntries[] = { {"_redist_update_conncomp", (DL_FUNC) &_redist_update_conncomp, 3}, {"_redist_crsg", (DL_FUNC) &_redist_crsg, 9}, {"_redist_dist_dist_diff", (DL_FUNC) &_redist_dist_dist_diff, 7}, - {"_redist_gsmc_plans", (DL_FUNC) &_redist_gsmc_plans, 12}, + {"_redist_gsmc_plans", (DL_FUNC) &_redist_gsmc_plans, 13}, {"_redist_log_st_map", (DL_FUNC) &_redist_log_st_map, 4}, {"_redist_n_removed", (DL_FUNC) &_redist_n_removed, 3}, {"_redist_countpartitions", (DL_FUNC) &_redist_countpartitions, 1}, diff --git a/src/gsmc.cpp b/src/gsmc.cpp index 9f430834f..fbb91d849 100644 --- a/src/gsmc.cpp +++ b/src/gsmc.cpp @@ -105,7 +105,7 @@ bool cut_regions(Tree &ust, int k_param, int root, } else { // Else if dev2 is smaller we assign d_nk to above devs[potential_d-1] = dev2; dev2_bigger[potential_d-1] = false; - are_ok[potential_d-1] = lower * potential_d <= above + are_ok[potential_d-1] = lower * potential_d <= above && above <= upper * potential_d && lower * (num_final_districts - potential_d) <= below && below <= upper * (num_final_districts - potential_d); @@ -659,7 +659,7 @@ List gsmc_plans( double target, double lower, double upper, int M, int k_param, // M is Number of particles aka number of different plans List control, - int num_threads, int verbosity){ + int num_threads, int verbosity, bool diagnostic_mode){ // set number of threads if (num_threads <= 0) num_threads = std::thread::hardware_concurrency(); @@ -678,60 +678,85 @@ List gsmc_plans( std::vector plans_vec(M, Plan(V, N, total_pop)); std::vector new_plans_vec(M, Plan(V, N, total_pop)); // New plans - // OUTDATED ONLY DO FINAL ONE TO SAVE MEMORY - // Create info tracking we will pass out at the end - // This is N-1 by M by V where for each n=1,...,N-1 and m=1,...M it maps vertices to region labels - // std::vector>> plan_region_labels_mat( - // N-1, - // std::vector>( - // M, std::vector (V, "MISSING") - // ) - // - // ); - - std::vector>final_plan_region_labels( - M, std::vector (V, "MISSING") - ); - - // Create info tracking we will pass out at the end - // This is N-1 by M by V where for each n=1,...,N-1 and m=1,...M it maps vertices to integer id - std::vector>> plan_region_ids_mat( - N-1, - std::vector>( - M, std::vector (V, -1) - ) - - ); - // For integers make default -1 for error tracking - // This is N-1 by M by V where for each n=1,...,N-1 and m=1,...M it maps vertices to region d val - std::vector>> plan_d_vals_mat( - N-1, - std::vector>( - M, std::vector (V, -1) - ) - - ); + // Define output variables that must always be created // This is N-1 by M where [i][j] is the index of the parent of particle j on step i // ie the index of the previous plan that was sampled and used to create particle j on step i std::vector> parent_index_mat(N-1, std::vector (M, -1)); + // This is N-1 by M where [i][j] is the index of the original (first) ancestor of particle j on step i std::vector> original_ancestor_mat(N-1, std::vector (M, -1)); + // This is N-1 by M where [i][j] is the number of tries it took to form particle j on iteration i // Inclusive of the final step. ie if succeeds in one try it would be 1 std::vector> draw_tries_mat(N-1, std::vector (M, -1)); // This is N-1 by M where [i][j] is the log incremental weight of particle j on step i std::vector> log_incremental_weights_mat(N-1, std::vector (M, -1.0)); + // This is N-1 by M where [i][j] is the normalized weight of particle j on step i std::vector> normalized_weights_mat(N-1, std::vector (M, -1.0)); + + + + // Tracks the acceptance rate - total number of tries over M - for each round std::vector acceptance_rates(N-1, -1.0); + + // Tracks the effective sample size for the weights of each round std::vector n_eff(N-1, -1.0); + + // Tracks the number of unique parent vectors sampled to create the next round std::vector nunique_parents_vec(N-1, -1); + + // Tracks the number of unique ancestors left at each step std::vector nunique_original_ancestors_vec(N-1, -1); + + // Declare variables whose size will depend on whether or not we're in + // diagnostic mode or not + std::vector>> plan_region_ids_mat; + std::vector>> plan_d_vals_mat; + std::vector> final_plan_region_labels; + + + + + // If diagnostic mode track stuff from every round + if(diagnostic_mode){ + // Create info tracking we will pass out at the end + // This is N-1 by M by V where for each n=1,...,N-1 and m=1,...M it maps vertices to integer id + plan_region_ids_mat.resize(N-1, std::vector>( + M, std::vector(V, -1) + )); + // For integers make default -1 for error tracking + // This is N-1 by M by V where for each n=1,...,N-1 and m=1,...M it maps vertices to region d val + plan_d_vals_mat.resize(N-1, std::vector>( + M, std::vector(V, -1) + )); + + // M by V where for each m=1,...M it maps vertices to region labels in a plan + final_plan_region_labels.resize( + M, std::vector (V, "MISSING") + ); + + }else{ // else only track for final round + // Create info tracking we will pass out at the end + // This is M by V where for each m=1,...M it maps vertices to integer id for plan + plan_region_ids_mat.resize(1, std::vector>( + M, std::vector(V, -1) + )); + + // For integers make default -1 for error tracking + // This is M by V where for each m=1,...M it maps vertices to d value for plan + plan_d_vals_mat.resize(1, std::vector>( + M, std::vector(V, -1) + )); + } + + + // Loading Info if (verbosity >= 1) { Rcout.imbue(std::locale("")); @@ -827,11 +852,21 @@ List gsmc_plans( // Make the unnormalized weight just the incremental weight from this round // In the future make standalone function to compute these weights unnormalized_sampling_weights[j] = std::exp( - log_incremental_weights_mat[n][j] // + std::log(unnormalized_sampling_weights[j]) + log_incremental_weights_mat.at(n).at(j) // + std::log(unnormalized_sampling_weights[j]) ); - plan_region_ids_mat[n][j] = plans_vec[j].region_num_ids; - plan_d_vals_mat[n][j] = plans_vec[j].region_dval; + if(diagnostic_mode && n == N-2){ // record if in diagnostic mode and final step + plan_region_ids_mat.at(n).at(j) = plans_vec[j].region_num_ids; + plan_d_vals_mat.at(n).at(j) = plans_vec[j].region_dval; + final_plan_region_labels.at(j) = plans_vec[j].region_labels; + }else if(diagnostic_mode){ // record if in diagnostic mode but not final step + plan_region_ids_mat.at(n).at(j) = plans_vec[j].region_num_ids; + plan_d_vals_mat.at(n).at(j) = plans_vec[j].region_dval; + }else if(n == N-2){ // else if not only record final step + plan_region_ids_mat.at(0).at(j) = plans_vec[j].region_num_ids; + plan_d_vals_mat.at(0).at(j) = plans_vec[j].region_dval; + } + } @@ -847,49 +882,6 @@ List gsmc_plans( cli_progress_done(bar); - for(int j=0; j) + (sizeof(int) * plan_region_ids_mat[N-2].size()) -// << " so DONE \n"; -// -// size_t totalSize = sizeof(std::vector); // Size of the vector object itself -// -// Rcout << "The STRING vector size is " -// << totalSize -// << " so DONE \n"; -// -// for (const auto& str : plan_region_ids_mat.at(N-2)) { -// totalSize += sizeof(str); // Size of each std::string object -// totalSize += str.capacity(); // Size of the allocated string data -// } -// -// // auto da_size = sizeof(std::vector) + (sizeof(std::st) * MyVector.size()); -// Rcout << "The string vector size is " -// << totalSize -// << " real DONE \n"; -// -// -// totalSize = sizeof(std::vector); // Size of the vector object itself -// -// Rcout << "The STRING vector size is " -// << totalSize -// << " so DONE \n"; -// -// for (const auto& str : final_plan_region_labels.at(N-2)) { -// totalSize += sizeof(str); // Size of each std::string object -// totalSize += str.capacity(); // Size of the allocated string data -// } -// -// // auto da_size = sizeof(std::vector) + (sizeof(std::st) * MyVector.size()); -// Rcout << "The string vector size is " -// << totalSize -// << " real DONE \n"; - // make first number of unique original ancestors just M nunique_original_ancestors_vec.at(0) = M; @@ -899,8 +891,8 @@ List gsmc_plans( _["original_ancestors"] = original_ancestor_mat, _["parent_index"] = parent_index_mat, _["final_region_labs"] = final_plan_region_labels, - _["region_ids_mat"] = plan_region_ids_mat, - _["region_dvals_mat"] = plan_d_vals_mat, + _["region_ids_mat_list"] = plan_region_ids_mat, + _["region_dvals_mat_list"] = plan_d_vals_mat, _["log_incremental_weights_mat"] = log_incremental_weights_mat, _["normalized_weights_mat"] = normalized_weights_mat, _["draw_tries_mat"] = draw_tries_mat, diff --git a/src/gsmc.h b/src/gsmc.h index b1dd81ab0..6feda37ad 100644 --- a/src/gsmc.h +++ b/src/gsmc.h @@ -53,7 +53,7 @@ List gsmc_plans( double target, double lower, double upper, int M, int k_param,// Number of particles aka number of different plans List control, - int ncores = -1, int verbosity = 3); + int ncores = -1, int verbosity = 3, bool diagnostic_mode = false); From 4bb758365f27284cda3f1b159c5089157f720bdb Mon Sep 17 00:00:00 2001 From: "Philip W. O'Sullivan" Date: Fri, 6 Sep 2024 13:24:52 -0400 Subject: [PATCH 007/324] fixed sd_lp issue for gsmc in summary --- R/redist_gsmc.R | 2 +- src/gsmc.cpp | 31 ++++++++++++++++++------------- 2 files changed, 19 insertions(+), 14 deletions(-) diff --git a/R/redist_gsmc.R b/R/redist_gsmc.R index 512fbfd8b..2573237bb 100644 --- a/R/redist_gsmc.R +++ b/R/redist_gsmc.R @@ -247,7 +247,7 @@ redist_gsmc <- function(state_map, M, counties = NULL, k_param_val = 6, est_k = rep(k_param_val, N-1), # algout$est_k, accept_rate = algout$acceptance_rates, sd_lp = c( - sapply(algout$log_incremental_weights_mat, sd) , sd(lr) + apply(algout$log_incremental_weights_mat, 2, sd), sd(lr) ), sd_temper = rep(NA, N-1), # algout$sd_temper, unique_survive = c(algout$nunique_parent_indices, n_unique), diff --git a/src/gsmc.cpp b/src/gsmc.cpp index fbb91d849..2b535bb05 100644 --- a/src/gsmc.cpp +++ b/src/gsmc.cpp @@ -675,6 +675,23 @@ List gsmc_plans( int V = g.size(); double total_pop = sum(pop); + + // Loading Info + if (verbosity >= 1) { + Rcout.imbue(std::locale("")); + Rcout << std::fixed << std::setprecision(0); + Rcout << "GENERALIZED SEQUENTIAL MONTE CARLO\n"; + Rcout << "Sampling " << M << " " << V << "-unit "; + Rcout << "maps with " << N << " districts and population between " + << lower << " and " << upper << " using " << num_threads << " threads.\n"; + if (cg.size() > 1){ + Rcout << "Ensuring no more than " << N - 1 << " splits of the " + << cg.size() << " administrative units.\n"; + } + } + + + std::vector plans_vec(M, Plan(V, N, total_pop)); std::vector new_plans_vec(M, Plan(V, N, total_pop)); // New plans @@ -757,19 +774,7 @@ List gsmc_plans( - // Loading Info - if (verbosity >= 1) { - Rcout.imbue(std::locale("")); - Rcout << std::fixed << std::setprecision(0); - Rcout << "GENERALIZED SEQUENTIAL MONTE CARLO\n"; - Rcout << "Sampling " << M << " " << V << "-unit "; - Rcout << "maps with " << N << " districts and population between " - << lower << " and " << upper << " using " << num_threads << " threads.\n"; - if (cg.size() > 1){ - Rcout << "Ensuring no more than " << N - 1 << " splits of the " - << cg.size() << " administrative units.\n"; - } - } + // Start off all the unnormalized weights at 1 std::vector unnormalized_sampling_weights(M, 1.0); From 0e579ebf2ddf96f93bd7ed16764bf99ac21b0baf Mon Sep 17 00:00:00 2001 From: "Philip W. O'Sullivan" Date: Fri, 6 Sep 2024 21:26:48 -0400 Subject: [PATCH 008/324] refactored Plan object code to drastically reduce memory usage --- src/gsmc.cpp | 136 ++++++++++++++++++++++--------------------- src/gsmc.h | 4 +- src/gsmc_helpers.cpp | 59 ++++++++++--------- src/gsmc_helpers.h | 2 +- src/redist_types.cpp | 36 ++++-------- src/redist_types.h | 17 +++--- src/tree_op.cpp | 8 +-- src/tree_op.h | 3 +- 8 files changed, 126 insertions(+), 139 deletions(-) diff --git a/src/gsmc.cpp b/src/gsmc.cpp index 2b535bb05..695a2fb40 100644 --- a/src/gsmc.cpp +++ b/src/gsmc.cpp @@ -14,32 +14,32 @@ //' @param root The root vertex of the spanning tree //' @param pop A vector of the population associated with each vertex in `g` //' @param plan A plan object -//' @param region_to_split The label of the region in the plan object we're attempting to split +//' @param region_id_to_split The id of the region in the plan object we're attempting to split //' @param lower Acceptable lower bounds on a valid district's population //' @param upper Acceptable upper bounds on a valid district's population //' @param target Ideal population of a valid district. This is what deviance is calculated //' relative to -//' @param new_region_labels A vector that will be updated by reference to contain the names of +//' @param new_region_ids A vector that will be updated by reference to contain the names of //' the two new split regions if function is successful. //' //' @details Modifications //' - If two new valid regions are split then the plan object is updated accordingly -//' - If two new valid regions are split then the new_region_labels is updated so the +//' - If two new valid regions are split then the new_region_ids is updated so the //' first entry is the first new region and the second entry is the second new region //' //' @return True if two valid regions were split off false otherwise //' bool cut_regions(Tree &ust, int k_param, int root, const uvec &pop, - Plan &plan, const std::string region_to_split, + Plan &plan, const int region_id_to_split, double lower, double upper, double target, - std::vector &new_region_labels){ + std::vector &new_region_ids){ // Get population of region being split - double total_pop = plan.r_to_pop_map.at(region_to_split); + double total_pop = plan.region_pops.at(region_id_to_split); // Get the number of final districts in region being split - int num_final_districts = plan.r_to_d_map.at(region_to_split); + int num_final_districts = plan.region_dvals.at(region_id_to_split); - // Rcout << "For " << region_to_split << " Total pop is " << total_pop << " and d_nk is " << num_final_districts << "\n"; + // Rcout << "For " << region_id_to_split << " Total pop is " << total_pop << " and d_nk is " << num_final_districts << "\n"; // create list that points to parents & computes population below each vtx std::vector pop_below(plan.V, 0); @@ -59,14 +59,14 @@ bool cut_regions(Tree &ust, int k_param, int root, is_ok.reserve(k_param); new_d_val.reserve(k_param); - if(plan.region_labels.at(root) != region_to_split){ + if(plan.region_num_ids.at(root) != region_id_to_split){ Rcout << "Root vertex is not in region to split!"; } // Now loop over all valid edges to cut for (int i = 1; i <= plan.V; i++) { // 1-indexing here // Ignore any vertex not in this region or the root vertex as we wont be cutting those - if (plan.region_labels.at(i-1) != region_to_split || i - 1 == root) continue; + if (plan.region_num_ids.at(i-1) != region_id_to_split || i - 1 == root) continue; // Get the population of one side of the partition removing that edge would cause double below = pop_below.at(i - 1); @@ -163,10 +163,12 @@ bool cut_regions(Tree &ust, int k_param, int root, } /* - Rcout << "Testing this " << region_to_split + ".R2" << " \n"; + Rcout << "Testing this " << region_id_to_split + ".R2" << " \n"; Rcout << "We have Final d =" << new_d_val[idx] << " and " << num_final_districts - new_d_val[idx] << "\n"; */ + + // find index of node to cut at std::vector *siblings = &ust[parent[cut_at]]; int length = siblings->size(); @@ -190,22 +192,28 @@ bool cut_regions(Tree &ust, int k_param, int root, std::string new_region_label1; std::string new_region_label2; + std::string region_to_split = plan.region_str_labels.at(region_id_to_split); + // Set label and count depending on if district or multi district if(new_region1_d == 1){ plan.num_districts++; + // if district then string label just adds district number new_region_label1 = region_to_split + "." + std::to_string(plan.num_districts); }else{ - new_region_label1 = region_to_split + ".R1"; plan.num_multidistricts++; + // if region then just add current region number + new_region_label1 = region_to_split + ".R" + std::to_string(region_id_to_split); } // Now do it for second region if(new_region2_d == 1){ plan.num_districts++; + // if district then string label just adds district number new_region_label2 = region_to_split + "." + std::to_string(plan.num_districts); }else{ - new_region_label2 = region_to_split + ".R2"; plan.num_multidistricts++; + // if region then just add current region number + new_region_label2 = region_to_split + ".R" + std::to_string(plan.num_regions - 1); } // Check whether the new regions are districts or multidistricts @@ -241,40 +249,40 @@ bool cut_regions(Tree &ust, int k_param, int root, // update the function parameter with names of new regions - if(new_region_labels.size() != 2){ - Rcout << "For some reason the new_region_labels vector in cut_regions is not size 2!\n"; + if(new_region_ids.size() != 2){ + Rcout << "For some reason the new_region_ids vector in cut_regions is not size 2!\n"; } - new_region_labels[0] = new_region_label1; - new_region_labels[1] = new_region_label2; // Get the regions current integer id - int old_region_num_id = plan.str_label_to_num_id_map[region_to_split]; + int old_region_num_id = region_id_to_split; // make the first new region have the same integer id int new_region_num_id1 = old_region_num_id; // Second new region has id of the new number of regions minus 1 int new_region_num_id2 = plan.num_regions - 1; + new_region_ids[0] = new_region_num_id1; + new_region_ids[1] = new_region_num_id2; + + // Now update the two cut portions - assign_region(ust, plan, tree_vertex1, new_region_label1, new_region_num_id1, new_region1_pop, new_region1_d); - assign_region(ust, plan, tree_vertex2, new_region_label2, new_region_num_id2, new_region2_pop, new_region2_d); + assign_region(ust, plan, tree_vertex1, new_region_num_id1); + assign_region(ust, plan, tree_vertex2, new_region_num_id2); - // Now update the map objects in the plan - plan.r_to_d_map.erase(region_to_split); - plan.r_to_pop_map.erase(region_to_split); - plan.str_label_to_num_id_map.erase(region_to_split); - plan.num_id_to_str_label_map.erase(old_region_num_id); + // Now update the region level information // Add the new region 1 - plan.r_to_d_map[new_region_label1] = new_region1_d; - plan.r_to_pop_map[new_region_label1] = new_region1_pop; - plan.str_label_to_num_id_map[new_region_label1] = new_region_num_id1; - plan.num_id_to_str_label_map[new_region_num_id1] = new_region_label1; + + // New region 1 has the same id number as old region so update that + plan.region_dvals.at(new_region_num_id1) = new_region1_d; + plan.region_str_labels.at(new_region_num_id1) = new_region_label1; + plan.region_pops.at(new_region_num_id1) = new_region1_pop; // Add the new region 2 - plan.r_to_d_map[new_region_label2] = new_region2_d; - plan.r_to_pop_map[new_region_label2] = new_region2_pop; - plan.str_label_to_num_id_map[new_region_label2] = new_region_num_id2; - plan.num_id_to_str_label_map[new_region_num_id2] = new_region_label2; + // New region 2's id is the highest id number so push back + plan.region_dvals.push_back(new_region2_d); + plan.region_str_labels.push_back(new_region_label2); + plan.region_pops.push_back(new_region2_pop); + return true; @@ -289,7 +297,7 @@ bool cut_regions(Tree &ust, int k_param, int root, //' regions where both regions have valid population bounds. Does this by //' drawing a spanning tree uniformly at random then calling `cut_regions` on //' that. If the split it successful it returns true and modifies `plan` and -//' `new_region_labels` accordingly. This is based on the `split_map` function +//' `new_region_ids` accordingly. This is based on the `split_map` function //' in smc.cpp //' //' @@ -301,8 +309,8 @@ bool cut_regions(Tree &ust, int k_param, int root, //' @param counties Vector of county labels of each vertex in `g` //' @param cg multigraph object (not sure why this is needed) //' @param plan A plan object -//' @param region_to_split The label of the region in the plan object we're attempting to split -//' @param new_region_labels A vector that will be updated by reference to contain the names of +//' @param region_id_to_split The label of the region in the plan object we're attempting to split +//' @param new_region_ids A vector that will be updated by reference to contain the names of //' the two new split regions if function is successful. //' @param lower Acceptable lower bounds on a valid district's population //' @param upper Acceptable upper bounds on a valid district's population @@ -313,14 +321,14 @@ bool cut_regions(Tree &ust, int k_param, int root, //' //' @details Modifications //' - If two new valid regions are split then the plan object is updated accordingly -//' - If two new valid regions are split then the new_region_labels is updated so the +//' - If two new valid regions are split then the new_region_ids is updated so the //' first entry is the first new region and the second entry is the second new region //' //' @return True if two valid regions were split off false otherwise //' bool attempt_region_split(const Graph &g, Tree &ust, const uvec &counties, Multigraph &cg, - Plan &plan, const std::string region_to_split, - std::vector &new_region_labels, + Plan &plan, const int region_id_to_split, + std::vector &new_region_ids, std::vector &visited, std::vector &ignore, const uvec &pop, double &lower, double upper, double target, int k_param) { @@ -328,7 +336,7 @@ bool attempt_region_split(const Graph &g, Tree &ust, const uvec &counties, Multi // Mark it as ignore if its not in the region to split for (int i = 0; i < V; i++){ - ignore[i] = plan.region_labels[i] != region_to_split; + ignore[i] = plan.region_num_ids.at(i) != region_id_to_split; } // Get a uniform spanning tree drawn on that region @@ -341,9 +349,9 @@ bool attempt_region_split(const Graph &g, Tree &ust, const uvec &counties, Multi // Now try to cut the tree and return that result return cut_regions(ust, k_param, root, pop, - plan, region_to_split, + plan, region_id_to_split, lower, upper, target, - new_region_labels); + new_region_ids); } @@ -433,7 +441,7 @@ bool attempt_region_split(const Graph &g, Tree &ust, const uvec &counties, Multi //' original ancestors of the new plans //' - The `parent_vec` is updated to contain the indices of the parents of the //' new plans -//' - If two new valid regions are split then the new_region_labels is updated so the +//' - If two new valid regions are split then the new_region_ids is updated so the //' first entry is the first new region and the second entry is the second new region //' - The `new_log_incremental_weights` is updated to contain the incremental //' weights of the new plans NOTE: In the future this will be moved to its @@ -531,8 +539,8 @@ void generalized_split_maps( int reject_ct = 0; bool ok = false; int idx; - std::string region_to_split; - std::vector new_region_labels(2, "INIT"); + int region_id_to_split; + std::vector new_region_ids(2, -1); Tree ust = init_tree(V); std::vector visited(V); @@ -546,12 +554,12 @@ void generalized_split_maps( // pick a region to try to split choose_multidistrict_to_split( - old_plans_vec[idx], region_to_split); + old_plans_vec[idx], region_id_to_split); // Now try to split that region ok = attempt_region_split(g, ust, counties, cg, - proposed_new_plan, region_to_split, - new_region_labels, + proposed_new_plan, region_id_to_split, + new_region_ids, visited, ignore, pop, lower, upper, target, k_param); @@ -747,15 +755,22 @@ List gsmc_plans( plan_region_ids_mat.resize(N-1, std::vector>( M, std::vector(V, -1) )); - // For integers make default -1 for error tracking - // This is N-1 by M by V where for each n=1,...,N-1 and m=1,...M it maps vertices to region d val - plan_d_vals_mat.resize(N-1, std::vector>( - M, std::vector(V, -1) - )); + + // reserve space for N-1 elements + plan_d_vals_mat.reserve(N-1); + + // This is N-2 by M by 1,2,...N where for each n=1,...,N-1, m=1,...,M it maps the region + // id to the region's d value. So for a given n it is n by M by n+1 + // It stops at N-2 because for N-1 its all 1 + for(int n = 1; n < N-1; n++){ + plan_d_vals_mat.push_back( + std::vector>(M, std::vector(n+1, -1)) + ); + } // M by V where for each m=1,...M it maps vertices to region labels in a plan final_plan_region_labels.resize( - M, std::vector (V, "MISSING") + M, std::vector(N, "MISSING") ); }else{ // else only track for final round @@ -764,18 +779,11 @@ List gsmc_plans( plan_region_ids_mat.resize(1, std::vector>( M, std::vector(V, -1) )); - - // For integers make default -1 for error tracking - // This is M by V where for each m=1,...M it maps vertices to d value for plan - plan_d_vals_mat.resize(1, std::vector>( - M, std::vector(V, -1) - )); } - // Start off all the unnormalized weights at 1 std::vector unnormalized_sampling_weights(M, 1.0); @@ -862,14 +870,12 @@ List gsmc_plans( if(diagnostic_mode && n == N-2){ // record if in diagnostic mode and final step plan_region_ids_mat.at(n).at(j) = plans_vec[j].region_num_ids; - plan_d_vals_mat.at(n).at(j) = plans_vec[j].region_dval; - final_plan_region_labels.at(j) = plans_vec[j].region_labels; + // final_plan_region_labels.at(j) = plans_vec[j].region_labels; }else if(diagnostic_mode){ // record if in diagnostic mode but not final step plan_region_ids_mat.at(n).at(j) = plans_vec[j].region_num_ids; - plan_d_vals_mat.at(n).at(j) = plans_vec[j].region_dval; + plan_d_vals_mat.at(n).at(j) = plans_vec[j].region_dvals; }else if(n == N-2){ // else if not only record final step plan_region_ids_mat.at(0).at(j) = plans_vec[j].region_num_ids; - plan_d_vals_mat.at(0).at(j) = plans_vec[j].region_dval; } } diff --git a/src/gsmc.h b/src/gsmc.h index 6feda37ad..7f8b5a037 100644 --- a/src/gsmc.h +++ b/src/gsmc.h @@ -59,8 +59,8 @@ List gsmc_plans( bool attempt_region_split(const Graph &g, Tree &ust, const uvec &counties, Multigraph &cg, - Plan &plan, const std::string region_to_split, - std::vector &new_region_labels, + Plan &plan, const int region_id_to_split, + std::vector &new_region_ids, std::vector &visited, std::vector &ignore, const uvec &pop, double &lower, double upper, double target, int k_param); diff --git a/src/gsmc_helpers.cpp b/src/gsmc_helpers.cpp index 88684f575..4343b86c2 100644 --- a/src/gsmc_helpers.cpp +++ b/src/gsmc_helpers.cpp @@ -48,16 +48,16 @@ double compute_n_eff(const std::vector &log_wgt) { //' //' @param g A graph (adjacency list) passed by reference //' @param plan A plan object -//' @param region1_label The label of the first region -//' @param region2_label The label of the second region +//' @param region1_id The id of the first region +//' @param region2_id The id of the second region //' //' @details No modifications to inputs made //' //' @return the log of the boundary count //' double region_log_boundary(const Graph &g, const Plan &plan, - std::string const®ion1_label, - std::string const®ion2_label + int const®ion1_id, + int const®ion2_id ) { int V = g.size(); // get number of vertices double count = 0; // count of number of edges across the two regions @@ -69,17 +69,17 @@ double compute_n_eff(const std::vector &log_wgt) { counting we will only count those where first edge is in region 1 */ - if (plan.region_labels.at(i) != region1_label) continue; + if (plan.region_num_ids.at(i) != region1_id) continue; // Get vertice's neighbors std::vector nbors = g[i]; // Since edges show up twice to avoid double counting we will only count - // edges where first one is region1_label and second is region2_label + // edges where first one is region1_id and second is region2_id // Now check if neighbors are in second region for (int nbor : nbors) { - if (plan.region_labels.at(nbor) != region2_label) + if (plan.region_num_ids.at(nbor) != region2_id) continue; // if they are increase count by one count += 1.0; @@ -103,15 +103,15 @@ double compute_n_eff(const std::vector &log_wgt) { //' @title Choose multidistrict to split //' //' @param plan A plan object -//' @param region_to_split a string that will be updated by reference with the -//' name of the region selected to split +//' @param region_to_split an integer that will be updated by reference with the +//' id number of the region selected to split //' //' @details No modifications to inputs made //' //' @return the region level graph //' double choose_multidistrict_to_split( - Plan const&plan, std::string ®ion_to_split){ + Plan const&plan, int ®ion_id_to_split){ if(plan.num_multidistricts < 1){ Rprintf("ERROR: Trying to find multidistrict to split when there are none!\n"); @@ -122,18 +122,20 @@ double choose_multidistrict_to_split( // make vectors with cumulative d value and region label for later std::vector multi_d_vals; - std::vector region_labels; + std::vector region_ids; // Iterate over all regions - for (const auto &[key, value]: plan.r_to_d_map ) { + for(int region_id = 0; region_id < plan.num_regions; region_id++) { + + int d_val = plan.region_dvals.at(region_id); // collect info if multidistrict - if(value > 1){ + if(d_val > 1){ // Add that regions d value to the total - total_multi_ds += value; + total_multi_ds += d_val; // add the count and label to vector - multi_d_vals.push_back(value); - region_labels.push_back(key); + multi_d_vals.push_back(d_val); + region_ids.push_back(region_id); } } @@ -145,7 +147,7 @@ double choose_multidistrict_to_split( int idx = d(gen); - region_to_split = region_labels[idx]; + region_id_to_split = region_ids[idx]; double log_prob = std::log( static_cast(multi_d_vals[idx]) ) - std::log( @@ -229,8 +231,8 @@ Graph get_region_graph(const Graph &g, const Plan &plan) { //' @title Get Retroactive Split Selection Probability //' //' @param plan A plan object -//' @param region1_label The label of the first region to union -//' @param region2_label The label of the second region to union +//' @param region1_id The id of the first region to union +//' @param region2_id The id of the second region to union //' //' @details No modifications to inputs made //' @@ -239,7 +241,7 @@ Graph get_region_graph(const Graph &g, const Plan &plan) { //' double get_log_retroactive_splitting_prob( const Plan &plan, - const std::string region1_label, const std::string region2_label + const int region1_id, const int region2_id ){ // count total dvals of all the multidistricts @@ -247,16 +249,18 @@ double get_log_retroactive_splitting_prob( // Iterate over all regions - for (const auto &[key, value]: plan.r_to_d_map ) { + for(int region_id = 0; region_id < plan.num_regions; region_id++) { + int d_val = plan.region_dvals.at(region_id); + // collect info if multidistrict and not the two we started with - if(value > 1 && key != region1_label && key != region2_label){ + if(d_val > 1 && region_id != region1_id && region_id != region2_id){ // Add that regions d value to the total - total_multi_ds += value; + total_multi_ds += d_val; } } // Now get the sum of dnk values of two regions aka the unioned old region - int unioned_region_dnk = plan.r_to_d_map.at(region1_label) + plan.r_to_d_map.at(region2_label); + int unioned_region_dnk = plan.region_dvals.at(region1_id) + plan.region_dvals.at(region2_id); // update the total number of multi district dvals with the value the union region would have been total_multi_ds += unioned_region_dnk; @@ -324,13 +328,10 @@ double compute_log_incremental_weight(const Graph &g, const Plan &plan){ // Now iterate over all adjacent pairs for (const auto& edge : adj_region_pairs) { - // convert to region string label representation - std::string region1_label = plan.num_id_to_str_label_map.at(edge.first); - std::string region2_label = plan.num_id_to_str_label_map.at(edge.second); // get log of boundary length between regions - double log_boundary = region_log_boundary(g, plan, region1_label, region2_label); + double log_boundary = region_log_boundary(g, plan, edge.first, edge.second); // get prob of selecting union of adj regions - double log_splitting_prob = get_log_retroactive_splitting_prob(plan, region1_label, region2_label); + double log_splitting_prob = get_log_retroactive_splitting_prob(plan, edge.first, edge.second); // NO e^J TERM YET but can be added // multiply the boundary length and selection probability by adding the logs // now exponentiate and add to the sum diff --git a/src/gsmc_helpers.h b/src/gsmc_helpers.h index f83bc6842..adaa810a7 100644 --- a/src/gsmc_helpers.h +++ b/src/gsmc_helpers.h @@ -18,7 +18,7 @@ double compute_n_eff(const std::vector &log_wgt); double choose_multidistrict_to_split( - Plan const&plan, std::string ®ion_to_split); + Plan const&plan, int ®ion_id_to_split); double compute_log_incremental_weight(const Graph &g, const Plan &plan); diff --git a/src/redist_types.cpp b/src/redist_types.cpp index d65b12e25..5861bd930 100644 --- a/src/redist_types.cpp +++ b/src/redist_types.cpp @@ -11,16 +11,6 @@ // Define the constructor template outside the class // THIS ONLY CONSTRUCTS A ONE REGION MAP. ANYTHING ELSE MUST BE UPDATED Plan::Plan(int V, int N, double total_map_pop){ - // Check number of regions and districts make sense - /* - if(num_regions < 1){ - RcppThread::Rcerr << "ERROR: Invalid number of regions!\n"; - } - if(num_districts > num_regions){ - RcppThread::Rcout << "ERROR: Invalid number of districts!\n"; - } - */ - // set number of regions, districts, multidistricts, map pop, and V num_regions = 1; num_districts = 0; @@ -30,22 +20,20 @@ Plan::Plan(int V, int N, double total_map_pop){ this->N = N; + // Set array which will map region id to d_nk, pop values, and str_label if tracked + region_dvals.reserve(N); // Reserve N spots in memory + region_dvals.push_back(N); // Make entry 0 the map population + region_str_labels.reserve(N); // Reserve N spots in memory + region_str_labels.push_back("R0"); // Make entry 0 region 1 - // Set label to dnk and pop value map - r_to_d_map = std::map {{"R1", N}}; - r_to_pop_map = std::map {{"R1", map_pop}}; + region_pops.reserve(N); + region_pops.push_back(total_map_pop); - // Create region labels, pop, and dnk - // THIS ONLY WORKS FOR A BLANK REGION RIGHT NOW - region_labels = std::vector(V, "R1"); + // Create array which maps vertices to their region id region_num_ids = std::vector(V, 0); - region_dval = std::vector(V, r_to_d_map["R1"]); - region_pop = std::vector(V, r_to_pop_map["R1"]); - // Set maps allowing going between integer and string region ids - str_label_to_num_id_map = std::map {{"R1", 0}};; // Maps region label values to integer id number - num_id_to_str_label_map = std::map {{0, "R1"}};; // Maps integer id number to region label values + } @@ -57,9 +45,9 @@ void Plan::Rprint() const{ RcppThread::Rcout << "Region Level Values:"; - for (const auto &[key, value]: r_to_d_map ) { - RcppThread::Rcout << "(" << str_label_to_num_id_map.at(key) << " aka " << key << " also " << - num_id_to_str_label_map.at(str_label_to_num_id_map.at(key)) << ", " << value << ", " << r_to_pop_map.at(key) <<" ), "; + for(int region_id = 0; region_id < num_regions; region_id++){ + RcppThread::Rcout << "(" << region_str_labels.at(region_id) << " aka " << region_id << " also " << + ", " << region_dvals.at(region_id) << ", " << region_pops.at(region_id) <<" ), "; } RcppThread::Rcout << "\n"; // diff --git a/src/redist_types.h b/src/redist_types.h index d6f801858..df2b39c11 100644 --- a/src/redist_types.h +++ b/src/redist_types.h @@ -35,20 +35,17 @@ class Plan int num_multidistricts; // Number of multidistricts, always `num_regions` - `num_districts` double map_pop; // The population of the entire map - std::vector region_labels; // Representation of regions in string form (easy to trace lineage) - // Regions have R prefix whereas districts are just an integer (in string form). This is a vector length V - // which should have num_regions district values (I DO NOT CHECK THIS RIGHT NOW) + // vectors with length V std::vector region_num_ids; // Representation of regions in integer form (not as easy to trace // lineage). This is a length V vector where ith value maps it the integer id of its region - std::vector region_dval; //Vector of length V mapping vertex to the d value of its region - std::vector region_pop; //Vector of length V mapping vertex to the population of ITS REGION - std::map r_to_d_map; // Map of region label values to the d_n,k value (number of districts - std::map r_to_pop_map; // Map of region label values to The population of that region - - std::map str_label_to_num_id_map; //Maps region label values to integer id number - std::map num_id_to_str_label_map; //Maps region label values to integer id number + // vectors with length num_regions + std::vector region_dvals; //Vector of length num_regions mapping region ids to their d values + std::vector region_str_labels; // Vector of length num_regions mapping region id to string label (if tracked) + // Regions have R prefix whereas districts end in an integer (in string form). + std::vector region_pops; // Vector of length num_regions mapping region ids + // to the regions population // methods void Rprint() const; diff --git a/src/tree_op.cpp b/src/tree_op.cpp index 6547f2b65..572107e95 100644 --- a/src/tree_op.cpp +++ b/src/tree_op.cpp @@ -181,15 +181,11 @@ void assign_district(const Tree &ust, subview_col &districts, // TESTED void assign_region(const Tree &ust, Plan &plan, int root, - std::string new_region, int new_region_num_id, - double new_region_pop, int new_region_d) { - plan.region_labels.at(root) = new_region; + int new_region_num_id) { plan.region_num_ids.at(root) = new_region_num_id; - plan.region_pop.at(root) = new_region_pop; - plan.region_dval.at(root) = new_region_d; int n_desc = ust.at(root).size(); for (int i = 0; i < n_desc; i++) { - assign_region(ust, plan, ust.at(root).at(i), new_region, new_region_num_id, new_region_pop, new_region_d); + assign_region(ust, plan, ust.at(root).at(i), new_region_num_id); } } diff --git a/src/tree_op.h b/src/tree_op.h index 2589518a3..c2389cecb 100644 --- a/src/tree_op.h +++ b/src/tree_op.h @@ -71,8 +71,7 @@ void assign_district(const Tree &ust, subview_col &districts, // TESTED void assign_region(const Tree &ust, Plan &plan, int root, - std::string new_region, int new_region_num_id, - double new_region_pop, int new_region_d); + int new_region_num_id); /* * Find the root of a subtree. From eb23a5b23577094909f2e5897fa04a6d449b73da Mon Sep 17 00:00:00 2001 From: "Philip W. O'Sullivan" Date: Fri, 6 Sep 2024 21:31:27 -0400 Subject: [PATCH 009/324] updated some function doc pages --- man/gsmc_plans.Rd | 3 ++- man/redist_gsmc.Rd | 3 ++- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/man/gsmc_plans.Rd b/man/gsmc_plans.Rd index 4a84da43d..fb8ad7e48 100644 --- a/man/gsmc_plans.Rd +++ b/man/gsmc_plans.Rd @@ -16,7 +16,8 @@ gsmc_plans( k_param, control, ncores = -1L, - verbosity = 3L + verbosity = 3L, + diagnostic_mode = FALSE ) } \arguments{ diff --git a/man/redist_gsmc.Rd b/man/redist_gsmc.Rd index a637bb898..81387a63b 100644 --- a/man/redist_gsmc.Rd +++ b/man/redist_gsmc.Rd @@ -13,7 +13,8 @@ redist_gsmc( runs = 1L, ncores = 0L, verbose = FALSE, - silent = FALSE + silent = FALSE, + diagnostic_mode = FALSE ) } \value{ From 2be4d4fce259b27654ae10cd05fbc9474ea19585 Mon Sep 17 00:00:00 2001 From: "Philip W. O'Sullivan" Date: Wed, 11 Sep 2024 14:22:04 -0400 Subject: [PATCH 010/324] Weights now calculated in seperate function and parent tries are (maybe incorrectly) tracked --- R/redist_gsmc.R | 9 +++- src/gsmc.cpp | 125 ++++++++++++++++++++++++++++++++++-------------- 2 files changed, 98 insertions(+), 36 deletions(-) diff --git a/R/redist_gsmc.R b/R/redist_gsmc.R index 2573237bb..28e1eb876 100644 --- a/R/redist_gsmc.R +++ b/R/redist_gsmc.R @@ -162,6 +162,12 @@ redist_gsmc <- function(state_map, M, counties = NULL, k_param_val = 6, ncol = length(algout$draw_tries_mat), byrow = FALSE) + # make parent tries into a matrix + algout$parent_tries_mat <- matrix( + unlist(algout$parent_tries_mat), + ncol = length(algout$parent_tries_mat), + byrow = FALSE) + # make the log incremental weights into a matrix algout$log_incremental_weights_mat <- matrix( unlist(algout$log_incremental_weights_mat), @@ -261,7 +267,8 @@ redist_gsmc <- function(state_map, M, counties = NULL, k_param_val = 6, region_dvals_mat_list = algout$region_dvals_mat_list, log_incremental_weights_mat = algout$log_incremental_weights_mat, region_ids_mat_list = algout$region_ids_mat_list, - draw_tries_mat = algout$draw_tries_mat + draw_tries_mat = algout$draw_tries_mat, + parent_tries_mat = algout$parent_tries_mat ) algout diff --git a/src/gsmc.cpp b/src/gsmc.cpp index 695a2fb40..691674f70 100644 --- a/src/gsmc.cpp +++ b/src/gsmc.cpp @@ -396,9 +396,6 @@ bool attempt_region_split(const Graph &g, Tree &ust, const uvec &counties, Multi //' @param prev_ancestor_vec A vector used to track the index of the original //' ancestor of the previous plans. The value of `prev_ancestor_vec[i]` is the //' index of the original ancestor of `old_plans_vec[i]` -//' @param new_log_incremental_weights A vector of the new log incremental weights -//' computed for the new plans. The value of `new_log_incremental_weights[i]` is -//' the log incremental weight for `new_plans_vec[i]` //' @param unnormalized_sampling_weights A vector of weights used to sample indices //' of the `old_plans_vec`. The value of `unnormalized_sampling_weights[i]` is //' the unnormalized probability that index i is selected @@ -410,6 +407,11 @@ bool attempt_region_split(const Graph &g, Tree &ust, const uvec &counties, Multi //' many split attempts were made for the i-th new plan (including the successful //' split). For example, `draw_tries_vec[i] = 1` means that the first split //' attempt was successful. +//' @param parent_tries_vec A vector used to keep track of how many times the +//' previous rounds plans were sampled and unsuccessfully split. The value +//' `parent_tries_vec[i]` represents how many times `old_plans_vec[i]` was sampled +//' and then unsuccessfully split while creating all `M` of the new plans. +//' THIS MAY NOT BE THREAD SAFE //' @param accept_rate The number of accepted splits over the total number of //' attempted splits. This is equal to `sum(draw_tries_vec)/M` //' @param n_unique_parent_indices The number of unique parent indices, ie the @@ -443,15 +445,14 @@ bool attempt_region_split(const Graph &g, Tree &ust, const uvec &counties, Multi //' new plans //' - If two new valid regions are split then the new_region_ids is updated so the //' first entry is the first new region and the second entry is the second new region -//' - The `new_log_incremental_weights` is updated to contain the incremental -//' weights of the new plans NOTE: In the future this will be moved to its -//' own function //' - The `normalized_weights_to_fill_in` is updated to contain the normalized //' probabilities the index sampler used. This is only collected for diagnostics //' at this point and should just be equal to `unnormalized_sampling_weights` //' divided by `sum(unnormalized_sampling_weights)` //' - The `draw_tries_vec` is updated to contain the number of tries for each //' of the new plans +//' - The `parent_tries_vec` is updated to contain the number of unsuccessful +//' samples of the old plans //' - The `accept_rate` is updated to contain the average acceptance rate for //' this iteration //' - `n_unique_parent_indices` and `n_unique_original_ancestors` are updated @@ -468,10 +469,10 @@ void generalized_split_maps( std::vector &original_ancestor_vec, std::vector &parent_vec, const std::vector &prev_ancestor_vec, - std::vector &new_log_incremental_weights, const std::vector &unnormalized_sampling_weights, std::vector &normalized_weights_to_fill_in, std::vector &draw_tries_vec, + std::vector &parent_tries_vec, double &accept_rate, int &n_unique_parent_indices, int &n_unique_original_ancestors, @@ -565,6 +566,8 @@ void generalized_split_maps( // bad sample; try again if (!ok) { + // THIS MAY NOT BE THREAD SAFE + parent_tries_vec[idx]++; // update unsuccessful try RcppThread::checkUserInterrupt(++reject_ct % reject_check_int == 0); continue; } @@ -574,8 +577,6 @@ void generalized_split_maps( } - // compute the log incremental weight for the new plan - new_log_incremental_weights[i] = compute_log_incremental_weight(g, new_plans_vec[i]); // Record how many tries needed to create i-th new plan draw_tries_vec[i] = static_cast(iters[i]); // Make the new plans original ancestor the same as its parent @@ -623,14 +624,6 @@ void generalized_split_maps( 100.0 * accept_rate, (int) n_unique_parent_indices , (int) n_unique_original_ancestors); } - if(print_weights){ - Rprintf("Log Incremental weights are: "); - for (auto w : new_log_incremental_weights){ - Rprintf("%.4f, ", w); - } - Rprintf("\n"); - } - // ORIGINAL SMC CODE I DONT KNOW WHAT IT DOES ancestors = ancestors_new; @@ -638,6 +631,55 @@ void generalized_split_maps( +//' Computes log unnormalized weights for vector of plans +//' +//' Using the procedure outlined in this function computes the log +//' incremental weights and the unnormalized weights for a vector of plans (which +//' may or may not be the same depending on the parameters). +//' +//' @title Compute Log Unnormalized Weights +//' +//' @param pool A threadpool for multithreading +//' @param g A graph (adjacency list) passed by reference +//' @param plans_vec A vector of plans to compute the log unnormalized weights +//' of +//' @param log_incremental_weights A vector of the log incremental weights +//' computed for the plans. The value of `log_incremental_weights[i]` is +//' the log incremental weight for `plans_vec[i]` +//' @param unnormalized_sampling_weights A vector of the unnormalized sampling +//' weights to be used with sampling the `plans_vec` in the next iteration of the +//' algorithm. Depending on the other hyperparameters this may or may not be the +//' same as `exp(log_incremental_weights)` +//' @param pop_temper
+//' +//' @details Modifications +//' - The `log_incremental_weights` is updated to contain the incremental +//' weights of the plans +//' - The `unnormalized_sampling_weights` is updated to contain the unnormalized +//' sampling weights of the plans for the next round +void get_log_gsmc_weights( + RcppThread::ThreadPool &pool, + const Graph &g, std::vector &plans_vec, + std::vector &log_incremental_weights, + std::vector &unnormalized_sampling_weights, + double pop_temper +){ + int M = (int) plans_vec.size(); + + // Parallel thread pool where all objects in memory shared by default + pool.parallelFor(0, M, [&] (int i) { + double log_incr_weight = compute_log_incremental_weight(g, plans_vec.at(i)); + log_incremental_weights[i] = log_incr_weight; + unnormalized_sampling_weights[i] = std::exp(log_incr_weight); + }); + + // Wait for all the threads to finish + pool.wait(); + + return; +} + + //' Uses gsmc method to generate a sample of `M` plans in `c++` //' //' Using the procedure outlined in this function uses Sequential @@ -675,6 +717,9 @@ List gsmc_plans( // lags thing (copied from original smc code, don't understand what its doing) std::vector lags = as>(control["lags"]); + + double pop_temper = .8; + umat ancestors(M, lags.size(), fill::zeros); // Create map level graph and county level multigraph @@ -717,6 +762,11 @@ List gsmc_plans( // Inclusive of the final step. ie if succeeds in one try it would be 1 std::vector> draw_tries_mat(N-1, std::vector (M, -1)); + // This is N-1 by M where [i][j] is the number of times particle j from the + // previous round was sampled and unsuccessfully split on iteration i so this + // does not count successful sample then split + std::vector> parent_tries_mat(N-1, std::vector (M, 0)); + // This is N-1 by M where [i][j] is the log incremental weight of particle j on step i std::vector> log_incremental_weights_mat(N-1, std::vector (M, -1.0)); @@ -813,10 +863,10 @@ List gsmc_plans( original_ancestor_mat[n], parent_index_mat[n], dummy_prev_ancestors, - log_incremental_weights_mat[n], unnormalized_sampling_weights, normalized_weights_mat[n], draw_tries_mat[n], + parent_tries_mat.at(n), acceptance_rates[n], nunique_parents_vec[n], nunique_original_ancestors_vec[n], @@ -838,10 +888,10 @@ List gsmc_plans( original_ancestor_mat[n], parent_index_mat[n], original_ancestor_mat[n-1], - log_incremental_weights_mat[n], unnormalized_sampling_weights, normalized_weights_mat[n], draw_tries_mat[n], + parent_tries_mat.at(n), acceptance_rates[n], nunique_parents_vec[n], nunique_original_ancestors_vec[n], @@ -859,32 +909,36 @@ List gsmc_plans( Rcpp::checkUserInterrupt(); + // compute log incremental weights and sampling weights for next round + get_log_gsmc_weights( + pool, + g, + new_plans_vec, + log_incremental_weights_mat.at(n), + unnormalized_sampling_weights, + pop_temper + ); - // Now update the weights, region labels, dval column of the matrix - for(int j=0; j Date: Wed, 11 Sep 2024 14:48:58 -0400 Subject: [PATCH 011/324] renamed parent tries mat to parent unsuccessful tries mat --- R/redist_gsmc.R | 20 ++++++++++++++------ src/gsmc.cpp | 18 +++++++++--------- 2 files changed, 23 insertions(+), 15 deletions(-) diff --git a/R/redist_gsmc.R b/R/redist_gsmc.R index 28e1eb876..5252c4d12 100644 --- a/R/redist_gsmc.R +++ b/R/redist_gsmc.R @@ -151,10 +151,11 @@ redist_gsmc <- function(state_map, M, counties = NULL, k_param_val = 6, ) # make parent mat into matrix + # add 1 for R indexing algout$parent_index <- matrix( unlist(algout$parent_index), ncol = length(algout$parent_index), - byrow = FALSE) + byrow = FALSE) + 1 # make draws tries into a matrix algout$draw_tries_mat <- matrix( @@ -162,12 +163,18 @@ redist_gsmc <- function(state_map, M, counties = NULL, k_param_val = 6, ncol = length(algout$draw_tries_mat), byrow = FALSE) - # make parent tries into a matrix - algout$parent_tries_mat <- matrix( - unlist(algout$parent_tries_mat), - ncol = length(algout$parent_tries_mat), + # make parent unsuccessful tries into a matrix + algout$parent_unsuccessful_tries_mat <- matrix( + unlist(algout$parent_unsuccessful_tries_mat), + ncol = length(algout$parent_unsuccessful_tries_mat), byrow = FALSE) + # make parent succesful tries matrix counting the number of + # times a parent index was successfully sampled + parent_successful_tries_mat <- apply( + algout$parent_index, 2, tabulate, nbins = M + ) + # make the log incremental weights into a matrix algout$log_incremental_weights_mat <- matrix( unlist(algout$log_incremental_weights_mat), @@ -268,7 +275,8 @@ redist_gsmc <- function(state_map, M, counties = NULL, k_param_val = 6, log_incremental_weights_mat = algout$log_incremental_weights_mat, region_ids_mat_list = algout$region_ids_mat_list, draw_tries_mat = algout$draw_tries_mat, - parent_tries_mat = algout$parent_tries_mat + parent_unsuccessful_tries_mat = algout$parent_unsuccessful_tries_mat, + parent_successful_tries_mat = parent_successful_tries_mat ) algout diff --git a/src/gsmc.cpp b/src/gsmc.cpp index 691674f70..12438be8a 100644 --- a/src/gsmc.cpp +++ b/src/gsmc.cpp @@ -407,9 +407,9 @@ bool attempt_region_split(const Graph &g, Tree &ust, const uvec &counties, Multi //' many split attempts were made for the i-th new plan (including the successful //' split). For example, `draw_tries_vec[i] = 1` means that the first split //' attempt was successful. -//' @param parent_tries_vec A vector used to keep track of how many times the +//' @param parent_unsuccessful_tries_vec A vector used to keep track of how many times the //' previous rounds plans were sampled and unsuccessfully split. The value -//' `parent_tries_vec[i]` represents how many times `old_plans_vec[i]` was sampled +//' `parent_unsuccessful_tries_vec[i]` represents how many times `old_plans_vec[i]` was sampled //' and then unsuccessfully split while creating all `M` of the new plans. //' THIS MAY NOT BE THREAD SAFE //' @param accept_rate The number of accepted splits over the total number of @@ -451,7 +451,7 @@ bool attempt_region_split(const Graph &g, Tree &ust, const uvec &counties, Multi //' divided by `sum(unnormalized_sampling_weights)` //' - The `draw_tries_vec` is updated to contain the number of tries for each //' of the new plans -//' - The `parent_tries_vec` is updated to contain the number of unsuccessful +//' - The `parent_unsuccessful_tries_vec` is updated to contain the number of unsuccessful //' samples of the old plans //' - The `accept_rate` is updated to contain the average acceptance rate for //' this iteration @@ -472,7 +472,7 @@ void generalized_split_maps( const std::vector &unnormalized_sampling_weights, std::vector &normalized_weights_to_fill_in, std::vector &draw_tries_vec, - std::vector &parent_tries_vec, + std::vector &parent_unsuccessful_tries_vec, double &accept_rate, int &n_unique_parent_indices, int &n_unique_original_ancestors, @@ -567,7 +567,7 @@ void generalized_split_maps( // bad sample; try again if (!ok) { // THIS MAY NOT BE THREAD SAFE - parent_tries_vec[idx]++; // update unsuccessful try + parent_unsuccessful_tries_vec[idx]++; // update unsuccessful try RcppThread::checkUserInterrupt(++reject_ct % reject_check_int == 0); continue; } @@ -765,7 +765,7 @@ List gsmc_plans( // This is N-1 by M where [i][j] is the number of times particle j from the // previous round was sampled and unsuccessfully split on iteration i so this // does not count successful sample then split - std::vector> parent_tries_mat(N-1, std::vector (M, 0)); + std::vector> parent_unsuccessful_tries_mat(N-1, std::vector (M, 0)); // This is N-1 by M where [i][j] is the log incremental weight of particle j on step i std::vector> log_incremental_weights_mat(N-1, std::vector (M, -1.0)); @@ -866,7 +866,7 @@ List gsmc_plans( unnormalized_sampling_weights, normalized_weights_mat[n], draw_tries_mat[n], - parent_tries_mat.at(n), + parent_unsuccessful_tries_mat.at(n), acceptance_rates[n], nunique_parents_vec[n], nunique_original_ancestors_vec[n], @@ -891,7 +891,7 @@ List gsmc_plans( unnormalized_sampling_weights, normalized_weights_mat[n], draw_tries_mat[n], - parent_tries_mat.at(n), + parent_unsuccessful_tries_mat.at(n), acceptance_rates[n], nunique_parents_vec[n], nunique_original_ancestors_vec[n], @@ -961,7 +961,7 @@ List gsmc_plans( _["log_incremental_weights_mat"] = log_incremental_weights_mat, _["normalized_weights_mat"] = normalized_weights_mat, _["draw_tries_mat"] = draw_tries_mat, - _["parent_tries_mat"] = parent_tries_mat, + _["parent_unsuccessful_tries_mat"] = parent_unsuccessful_tries_mat, _["acceptance_rates"] = acceptance_rates, _["nunique_parent_indices"] = nunique_parents_vec, _["nunique_original_ancestors"] = nunique_original_ancestors_vec, From 466fd953569d2a01791d9d67504152852c6baa9f Mon Sep 17 00:00:00 2001 From: "Philip W. O'Sullivan" Date: Wed, 11 Sep 2024 17:38:01 -0400 Subject: [PATCH 012/324] added population tempering --- R/RcppExports.R | 19 +++++++++++++ R/diagnostics.R | 3 ++- R/redist_gsmc.R | 8 +++--- src/gsmc.cpp | 10 ++++--- src/gsmc_helpers.cpp | 63 ++++++++++++++++++++++++++++++++++++++++++-- src/gsmc_helpers.h | 21 ++++++++++++++- 6 files changed, 114 insertions(+), 10 deletions(-) diff --git a/R/RcppExports.R b/R/RcppExports.R index 1cf65eeba..56c216832 100644 --- a/R/RcppExports.R +++ b/R/RcppExports.R @@ -80,6 +80,25 @@ gsmc_plans <- function(N, adj_list, counties, pop, target, lower, upper, M, k_pa .Call(`_redist_gsmc_plans`, N, adj_list, counties, pop, target, lower, upper, M, k_param, control, ncores, verbosity, diagnostic_mode) } +#' Compute the log incremental weight of a plan +#' +#' Given a plan object this computes the minimum variance weights as derived in +#' . This is equivalent to the inverse of a sum over all +#' adjacent regions in a plan. +#' +#' @title Compute Incremental Weight of a plan +#' +#' @param plan A plan object +#' @param g The underlying map graph +#' @param target The target population for a single district +#' @param pop_temper The population tempering parameter +#' +#' @details No modifications to inputs made +#' +#' @return the log of the incremental weight of the plan +#' +NULL + log_st_map <- function(g, districts, counties, n_distr) { .Call(`_redist_log_st_map`, g, districts, counties, n_distr) } diff --git a/R/diagnostics.R b/R/diagnostics.R index 52ae47e2d..2f6c5f6f3 100644 --- a/R/diagnostics.R +++ b/R/diagnostics.R @@ -216,7 +216,8 @@ summary.redist_plans <- function(object, district = 1L, all_runs = TRUE, vi_max cli_text("{.strong gSMC:} {fmt_comma(n_samp)} sampled plans of {n_distr} districts on {fmt_comma(nrow(plans_m))} units with a population between {fmt_comma(pop_lb)} and {fmt_comma(pop_ub)}") - cli_text("{.arg k}={all_diagn[[1]]$est_k[1]} ") + cli_text("{.arg k}={all_diagn[[1]]$est_k[1]}") + cli_text("{.arg pop_temper}={format(all_diagn[[1]]$pop_temper, digits=3)}") cat("\n") cli_text("Plan diversity 80% range: {div_rg[1]} to {div_rg[2]}") diff --git a/R/redist_gsmc.R b/R/redist_gsmc.R index 5252c4d12..18da600dd 100644 --- a/R/redist_gsmc.R +++ b/R/redist_gsmc.R @@ -14,7 +14,7 @@ #' #' @export redist_gsmc <- function(state_map, M, counties = NULL, k_param_val = 6, - resample = TRUE, runs = 1L, ncores = 0L, + resample = TRUE, runs = 1L, ncores = 0L, pop_temper = 0, verbose = FALSE, silent = FALSE, diagnostic_mode = FALSE){ N <- attr(state_map, "ndists") # no constraints @@ -23,7 +23,9 @@ redist_gsmc <- function(state_map, M, counties = NULL, k_param_val = 6, # make controls intput lags <- 1 + unique(round((N - 1)^0.8*seq(0, 0.7, length.out = 4)^0.9)) - control = list(lags=lags) + control = list( + lags=lags, + pop_temper = pop_temper) # verbosity stuff verbosity <- 1 @@ -266,7 +268,7 @@ redist_gsmc <- function(state_map, M, counties = NULL, k_param_val = 6, unique_survive = c(algout$nunique_parent_indices, n_unique), ancestors = algout$ancestors, seq_alpha = .99, - pop_temper = 0, + pop_temper = pop_temper, runtime = as.numeric(t2_run - t1_run, units = "secs"), district_str_labels = algout$final_region_labs, nunique_original_ancestors = algout$nunique_original_ancestors, diff --git a/src/gsmc.cpp b/src/gsmc.cpp index 12438be8a..66ebc345b 100644 --- a/src/gsmc.cpp +++ b/src/gsmc.cpp @@ -650,6 +650,7 @@ void generalized_split_maps( //' weights to be used with sampling the `plans_vec` in the next iteration of the //' algorithm. Depending on the other hyperparameters this may or may not be the //' same as `exp(log_incremental_weights)` +//' @param target Target population of a single district //' @param pop_temper
//' //' @details Modifications @@ -662,13 +663,14 @@ void get_log_gsmc_weights( const Graph &g, std::vector &plans_vec, std::vector &log_incremental_weights, std::vector &unnormalized_sampling_weights, - double pop_temper + double target, double pop_temper ){ int M = (int) plans_vec.size(); // Parallel thread pool where all objects in memory shared by default pool.parallelFor(0, M, [&] (int i) { - double log_incr_weight = compute_log_incremental_weight(g, plans_vec.at(i)); + double log_incr_weight = compute_log_incremental_weight( + g, plans_vec.at(i), target, pop_temper); log_incremental_weights[i] = log_incr_weight; unnormalized_sampling_weights[i] = std::exp(log_incr_weight); }); @@ -718,7 +720,8 @@ List gsmc_plans( // lags thing (copied from original smc code, don't understand what its doing) std::vector lags = as>(control["lags"]); - double pop_temper = .8; + double pop_temper = as(control["pop_temper"]); + umat ancestors(M, lags.size(), fill::zeros); @@ -916,6 +919,7 @@ List gsmc_plans( new_plans_vec, log_incremental_weights_mat.at(n), unnormalized_sampling_weights, + target, pop_temper ); diff --git a/src/gsmc_helpers.cpp b/src/gsmc_helpers.cpp index 4343b86c2..da0377a54 100644 --- a/src/gsmc_helpers.cpp +++ b/src/gsmc_helpers.cpp @@ -278,6 +278,42 @@ double get_log_retroactive_splitting_prob( } +double compute_log_pop_temper( + const Plan &plan, + const int region1_id, const int region2_id, + double target, double pop_temper +){ + int N = plan.N; + // Get pop and dval of two regions and their union + double region1_pop = plan.region_pops[region1_id]; + double region2_pop = plan.region_pops[region2_id]; + double old_region_pop = region1_pop + region2_pop; + + int region1_dval = plan.region_dvals[region1_id]; + int region2_dval = plan.region_dvals[region2_id]; + int old_region_dval = region1_dval + region2_dval; + + // now compute the devations for each of them + double dev1 = std::fabs( + region1_pop/static_cast(region1_dval) - target + )/target; + double dev2 = std::fabs( + region2_pop/static_cast(region2_dval) - target + )/target; + double old_dev = std::fabs( + old_region_pop/static_cast(old_region_dval) - target + )/target; + + // now compute population penalties + double pop_pen1 = std::sqrt(static_cast(N) - 2) * std::log(1e-12 + dev1); + double pop_pen2 = std::sqrt(static_cast(N) - 2) * std::log(1e-12 + dev2); + double old_pop_pen = std::sqrt(static_cast(N) - 2) * std::log(1e-12 + old_dev); + + // now return the values for the old region minus the two new ones + return old_pop_pen * pop_temper - (pop_pen1 + pop_pen2) * pop_temper; +} + + //' Compute the log incremental weight of a plan //' //' Given a plan object this computes the minimum variance weights as derived in @@ -288,12 +324,16 @@ double get_log_retroactive_splitting_prob( //' //' @param plan A plan object //' @param g The underlying map graph +//' @param target The target population for a single district +//' @param pop_temper The population tempering parameter //' //' @details No modifications to inputs made //' //' @return the log of the incremental weight of the plan //' -double compute_log_incremental_weight(const Graph &g, const Plan &plan){ +double compute_log_incremental_weight( + const Graph &g, const Plan &plan, + const double target, const double pop_temper){ // get a region level graph Graph rg = get_region_graph(g, plan); @@ -325,6 +365,8 @@ double compute_log_incremental_weight(const Graph &g, const Plan &plan){ double incremental_weight = 0.0; + bool do_pop_temper = (plan.num_regions < plan.N) && pop_temper > 0; + // Now iterate over all adjacent pairs for (const auto& edge : adj_region_pairs) { @@ -333,9 +375,26 @@ double compute_log_incremental_weight(const Graph &g, const Plan &plan){ // get prob of selecting union of adj regions double log_splitting_prob = get_log_retroactive_splitting_prob(plan, edge.first, edge.second); // NO e^J TERM YET but can be added + + // Do population tempering term if not final + double log_temper; + if(do_pop_temper){ + log_temper = compute_log_pop_temper( + plan, + edge.first, edge.second, + target, pop_temper + ); + }else{ + log_temper = 0; + } + + + // multiply the boundary length and selection probability by adding the logs // now exponentiate and add to the sum - incremental_weight += std::exp(log_boundary + log_splitting_prob); + incremental_weight += std::exp(log_boundary + + log_splitting_prob + + log_temper); } diff --git a/src/gsmc_helpers.h b/src/gsmc_helpers.h index adaa810a7..e0ab4bfae 100644 --- a/src/gsmc_helpers.h +++ b/src/gsmc_helpers.h @@ -20,7 +20,26 @@ double compute_n_eff(const std::vector &log_wgt); double choose_multidistrict_to_split( Plan const&plan, int ®ion_id_to_split); -double compute_log_incremental_weight(const Graph &g, const Plan &plan); +//' Compute the log incremental weight of a plan +//' +//' Given a plan object this computes the minimum variance weights as derived in +//' . This is equivalent to the inverse of a sum over all +//' adjacent regions in a plan. +//' +//' @title Compute Incremental Weight of a plan +//' +//' @param plan A plan object +//' @param g The underlying map graph +//' @param target The target population for a single district +//' @param pop_temper The population tempering parameter +//' +//' @details No modifications to inputs made +//' +//' @return the log of the incremental weight of the plan +//' +double compute_log_incremental_weight( + const Graph &g, const Plan &plan, + const double target, const double pop_temper); Graph get_region_graph(const Graph &g, const Plan &plan); From a053c700ca2a906629ecdc3a6d883ecc576512bf Mon Sep 17 00:00:00 2001 From: "Philip W. O'Sullivan" Date: Sun, 15 Sep 2024 14:01:10 -0400 Subject: [PATCH 013/324] can now pass vector of k values in instead of one for entire run --- R/RcppExports.R | 4 ++-- R/diagnostics.R | 1 - R/redist_gsmc.R | 39 ++++++++++++++++++++++++++++++++++----- src/RcppExports.cpp | 9 ++++----- src/gsmc.cpp | 15 ++++++++------- src/gsmc.h | 2 +- 6 files changed, 49 insertions(+), 21 deletions(-) diff --git a/R/RcppExports.R b/R/RcppExports.R index 56c216832..0427de63a 100644 --- a/R/RcppExports.R +++ b/R/RcppExports.R @@ -76,8 +76,8 @@ dist_dist_diff <- function(p, i_dist, j_dist, x_center, y_center, x, y) { #' @param verbosity What level of detail to print out while the algorithm is #' running #' @export -gsmc_plans <- function(N, adj_list, counties, pop, target, lower, upper, M, k_param, control, ncores = -1L, verbosity = 3L, diagnostic_mode = FALSE) { - .Call(`_redist_gsmc_plans`, N, adj_list, counties, pop, target, lower, upper, M, k_param, control, ncores, verbosity, diagnostic_mode) +gsmc_plans <- function(N, adj_list, counties, pop, target, lower, upper, M, control, ncores = -1L, verbosity = 3L, diagnostic_mode = FALSE) { + .Call(`_redist_gsmc_plans`, N, adj_list, counties, pop, target, lower, upper, M, control, ncores, verbosity, diagnostic_mode) } #' Compute the log incremental weight of a plan diff --git a/R/diagnostics.R b/R/diagnostics.R index 2f6c5f6f3..1a8b4e585 100644 --- a/R/diagnostics.R +++ b/R/diagnostics.R @@ -216,7 +216,6 @@ summary.redist_plans <- function(object, district = 1L, all_runs = TRUE, vi_max cli_text("{.strong gSMC:} {fmt_comma(n_samp)} sampled plans of {n_distr} districts on {fmt_comma(nrow(plans_m))} units with a population between {fmt_comma(pop_lb)} and {fmt_comma(pop_ub)}") - cli_text("{.arg k}={all_diagn[[1]]$est_k[1]}") cli_text("{.arg pop_temper}={format(all_diagn[[1]]$pop_temper, digits=3)}") cat("\n") diff --git a/R/redist_gsmc.R b/R/redist_gsmc.R index 18da600dd..57689dfc7 100644 --- a/R/redist_gsmc.R +++ b/R/redist_gsmc.R @@ -8,12 +8,15 @@ #' gSMC Redistricting Sampler #' +#' @param k_params Either a single value to use as the splitting parameter for +#' every round or a vector of length N-1 where each value is the one to use for +#' a split. #' #' @return `redist_smc` returns a [redist_plans] object containing the simulated #' plans. #' #' @export -redist_gsmc <- function(state_map, M, counties = NULL, k_param_val = 6, +redist_gsmc <- function(state_map, M, counties = NULL, k_params = 6, resample = TRUE, runs = 1L, ncores = 0L, pop_temper = 0, verbose = FALSE, silent = FALSE, diagnostic_mode = FALSE){ N <- attr(state_map, "ndists") @@ -23,9 +26,27 @@ redist_gsmc <- function(state_map, M, counties = NULL, k_param_val = 6, # make controls intput lags <- 1 + unique(round((N - 1)^0.8*seq(0, 0.7, length.out = 4)^0.9)) + + # check k param imput + if(any(k_params < 1)){ + cli_abort("K parameter values must be all at least 1.") + } + + # if just a single number then repeat it + if(length(k_params) == 1 && floor(k_params) == k_params){ + k_params <- rep(k_params, N-1) + }else if(length(k_params) != N-1){ + cli_abort("K parameter input must be either 1 value or N-1!") + }else if(any(floor(k_params) != k_params)){ + # if either the length is not N-1 or its not all integers then throw + # error + cli_abort("K parameter values must be all integers") + } + control = list( lags=lags, - pop_temper = pop_temper) + pop_temper = pop_temper, + k_params = k_params) # verbosity stuff verbosity <- 1 @@ -62,6 +83,7 @@ redist_gsmc <- function(state_map, M, counties = NULL, k_param_val = 6, + # get population stuff pop_bounds <- attr(map, "pop_bounds") pop <- map[[attr(map, "pop_col")]] @@ -127,7 +149,6 @@ redist_gsmc <- function(state_map, M, counties = NULL, k_param_val = 6, lower=pop_bounds[1], upper=pop_bounds[3], M=M, - k_param = k_param_val, control = control, ncores = as.integer(ncores_per), verbosity=run_verbosity, @@ -152,6 +173,13 @@ redist_gsmc <- function(state_map, M, counties = NULL, k_param_val = 6, function(x) matrix(unlist(x), ncol = length(x), byrow = FALSE) ) + # make original ancestor matrix + # add 1 for R indexing + algout$original_ancestors_mat <- matrix( + unlist(algout$original_ancestors), + ncol = length(algout$original_ancestors), + byrow = FALSE) + 1 + # make parent mat into matrix # add 1 for R indexing algout$parent_index <- matrix( @@ -194,7 +222,7 @@ redist_gsmc <- function(state_map, M, counties = NULL, k_param_val = 6, # N-2 are previous results algout$plans <- algout$region_ids_mat_list[[N-1]] - algout$final_region_labs <- algout$final_region_labs <- matrix( + algout$final_region_labs <- matrix( unlist(algout$final_region_labs), ncol = length(algout$final_region_labs), byrow = FALSE) @@ -259,7 +287,7 @@ redist_gsmc <- function(state_map, M, counties = NULL, k_param_val = 6, n_eff = n_eff, step_n_eff = algout$step_n_eff, adapt_k_thresh = .99, # adapt_k_thresh, NEED TO DEAL WITH - est_k = rep(k_param_val, N-1), # algout$est_k, + est_k = k_params, # algout$est_k, accept_rate = algout$acceptance_rates, sd_lp = c( apply(algout$log_incremental_weights_mat, 2, sd), sd(lr) @@ -273,6 +301,7 @@ redist_gsmc <- function(state_map, M, counties = NULL, k_param_val = 6, district_str_labels = algout$final_region_labs, nunique_original_ancestors = algout$nunique_original_ancestors, parent_index_mat = algout$parent_index, + original_ancestors_mat = algout$original_ancestors_mat, region_dvals_mat_list = algout$region_dvals_mat_list, log_incremental_weights_mat = algout$log_incremental_weights_mat, region_ids_mat_list = algout$region_ids_mat_list, diff --git a/src/RcppExports.cpp b/src/RcppExports.cpp index 2374bcbe8..35fefdd15 100644 --- a/src/RcppExports.cpp +++ b/src/RcppExports.cpp @@ -192,8 +192,8 @@ BEGIN_RCPP END_RCPP } // gsmc_plans -List gsmc_plans(int N, List adj_list, const arma::uvec& counties, const arma::uvec& pop, double target, double lower, double upper, int M, int k_param, List control, int ncores, int verbosity, bool diagnostic_mode); -RcppExport SEXP _redist_gsmc_plans(SEXP NSEXP, SEXP adj_listSEXP, SEXP countiesSEXP, SEXP popSEXP, SEXP targetSEXP, SEXP lowerSEXP, SEXP upperSEXP, SEXP MSEXP, SEXP k_paramSEXP, SEXP controlSEXP, SEXP ncoresSEXP, SEXP verbositySEXP, SEXP diagnostic_modeSEXP) { +List gsmc_plans(int N, List adj_list, const arma::uvec& counties, const arma::uvec& pop, double target, double lower, double upper, int M, List control, int ncores, int verbosity, bool diagnostic_mode); +RcppExport SEXP _redist_gsmc_plans(SEXP NSEXP, SEXP adj_listSEXP, SEXP countiesSEXP, SEXP popSEXP, SEXP targetSEXP, SEXP lowerSEXP, SEXP upperSEXP, SEXP MSEXP, SEXP controlSEXP, SEXP ncoresSEXP, SEXP verbositySEXP, SEXP diagnostic_modeSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; @@ -205,12 +205,11 @@ BEGIN_RCPP Rcpp::traits::input_parameter< double >::type lower(lowerSEXP); Rcpp::traits::input_parameter< double >::type upper(upperSEXP); Rcpp::traits::input_parameter< int >::type M(MSEXP); - Rcpp::traits::input_parameter< int >::type k_param(k_paramSEXP); Rcpp::traits::input_parameter< List >::type control(controlSEXP); Rcpp::traits::input_parameter< int >::type ncores(ncoresSEXP); Rcpp::traits::input_parameter< int >::type verbosity(verbositySEXP); Rcpp::traits::input_parameter< bool >::type diagnostic_mode(diagnostic_modeSEXP); - rcpp_result_gen = Rcpp::wrap(gsmc_plans(N, adj_list, counties, pop, target, lower, upper, M, k_param, control, ncores, verbosity, diagnostic_mode)); + rcpp_result_gen = Rcpp::wrap(gsmc_plans(N, adj_list, counties, pop, target, lower, upper, M, control, ncores, verbosity, diagnostic_mode)); return rcpp_result_gen; END_RCPP } @@ -769,7 +768,7 @@ static const R_CallMethodDef CallEntries[] = { {"_redist_update_conncomp", (DL_FUNC) &_redist_update_conncomp, 3}, {"_redist_crsg", (DL_FUNC) &_redist_crsg, 9}, {"_redist_dist_dist_diff", (DL_FUNC) &_redist_dist_dist_diff, 7}, - {"_redist_gsmc_plans", (DL_FUNC) &_redist_gsmc_plans, 13}, + {"_redist_gsmc_plans", (DL_FUNC) &_redist_gsmc_plans, 12}, {"_redist_log_st_map", (DL_FUNC) &_redist_log_st_map, 4}, {"_redist_n_removed", (DL_FUNC) &_redist_n_removed, 3}, {"_redist_countpartitions", (DL_FUNC) &_redist_countpartitions, 1}, diff --git a/src/gsmc.cpp b/src/gsmc.cpp index 66ebc345b..95125343d 100644 --- a/src/gsmc.cpp +++ b/src/gsmc.cpp @@ -699,7 +699,6 @@ void get_log_gsmc_weights( //' @param lower Acceptable lower bounds on a valid district's population //' @param upper Acceptable upper bounds on a valid district's population //' @param M The number of plans (samples) to draw -//' @param k_param The k parameter from the SMC algorithm, you choose among the top k_param edges //' @param control Named list of additional parameters. //' @param num_threads The number of threads the threadpool should use //' @param verbosity What level of detail to print out while the algorithm is @@ -709,8 +708,8 @@ List gsmc_plans( int N, List adj_list, const arma::uvec &counties, const arma::uvec &pop, double target, double lower, double upper, - int M, int k_param, // M is Number of particles aka number of different plans - List control, + int M, // M is Number of particles aka number of different plans + List control, // control has pop temper, and k parameter value int num_threads, int verbosity, bool diagnostic_mode){ // set number of threads @@ -719,6 +718,8 @@ List gsmc_plans( // lags thing (copied from original smc code, don't understand what its doing) std::vector lags = as>(control["lags"]); + // k param values to use + std::vector k_params = as>(control["k_params"]); double pop_temper = as(control["pop_temper"]); @@ -821,7 +822,7 @@ List gsmc_plans( ); } - // M by V where for each m=1,...M it maps vertices to region labels in a plan + // M by N-1 where for each m=1,...M it maps region ids to region labels in a plan final_plan_region_labels.resize( M, std::vector(N, "MISSING") ); @@ -875,7 +876,7 @@ List gsmc_plans( nunique_original_ancestors_vec[n], ancestors, lags, lower, upper, target, - k_param, + k_params[n], pool, verbosity ); @@ -900,7 +901,7 @@ List gsmc_plans( nunique_original_ancestors_vec[n], ancestors, lags, lower, upper, target, - k_param, + k_params[n], pool, verbosity ); @@ -930,7 +931,7 @@ List gsmc_plans( if(diagnostic_mode && n == N-2){ // record if in diagnostic mode and final step for(int j=0; j Date: Sun, 15 Sep 2024 20:55:10 -0400 Subject: [PATCH 014/324] added basic version of original smc with optimal weights --- R/redist_basic_smc.R | 354 +++++++++++++++ man/basic_smc_plans.Rd | 56 +++ man/redist_basic_smc.Rd | 32 ++ src/basic_smc.cpp | 963 ++++++++++++++++++++++++++++++++++++++++ src/basic_smc.h | 74 +++ 5 files changed, 1479 insertions(+) create mode 100644 R/redist_basic_smc.R create mode 100644 man/basic_smc_plans.Rd create mode 100644 man/redist_basic_smc.Rd create mode 100644 src/basic_smc.cpp create mode 100644 src/basic_smc.h diff --git a/R/redist_basic_smc.R b/R/redist_basic_smc.R new file mode 100644 index 000000000..e206695cb --- /dev/null +++ b/R/redist_basic_smc.R @@ -0,0 +1,354 @@ +##################################################### +# Author: Philip O'Sullivan +# Institution: Harvard University +# Date Created: 2024/08/18 +# Purpose: tidy R wrapper to run gSMC redistricting code +#################################################### + + +#' Basic SMC Redistricting Sampler +#' +#' RedistSMC with optimal weights but not arbitrary region splits +#' +#' @param k_params Either a single value to use as the splitting parameter for +#' every round or a vector of length N-1 where each value is the one to use for +#' a split. +#' +#' @return `redist_smc` returns a [redist_plans] object containing the simulated +#' plans. +#' +#' @export +redist_basic_smc <- function(state_map, M, counties = NULL, k_params = 6, + resample = TRUE, runs = 1L, ncores = 0L, pop_temper = 0, + verbose = FALSE, silent = FALSE, diagnostic_mode = FALSE){ + N <- attr(state_map, "ndists") + # no constraints + constraints = list() + + + # make controls intput + lags <- 1 + unique(round((N - 1)^0.8*seq(0, 0.7, length.out = 4)^0.9)) + + # check k param imput + if(any(k_params < 1)){ + cli_abort("K parameter values must be all at least 1.") + } + + # if just a single number then repeat it + if(length(k_params) == 1 && floor(k_params) == k_params){ + k_params <- rep(k_params, N-1) + }else if(length(k_params) != N-1){ + cli_abort("K parameter input must be either 1 value or N-1!") + }else if(any(floor(k_params) != k_params)){ + # if either the length is not N-1 or its not all integers then throw + # error + cli_abort("K parameter values must be all integers") + } + + control = list( + lags=lags, + pop_temper = pop_temper, + k_params = k_params) + + # verbosity stuff + verbosity <- 1 + if (verbose) verbosity <- 3 + if (silent) verbosity <- 0 + + + # get the map in adjacency form + map <- validate_redist_map(state_map) + V <- nrow(state_map) + adj_list <- get_adj(state_map) + + + + + counties <- rlang::eval_tidy(rlang::enquo(counties), map) + if (is.null(counties)) { + counties <- rep(1, V) + } else { + if (any(is.na(counties))) + cli_abort("County vector must not contain missing values.") + + # handle discontinuous counties + component <- contiguity(adj_list, vctrs::vec_group_id(counties)) + counties <- dplyr::if_else(component > 1, + paste0(as.character(counties), "-", component), + as.character(counties)) %>% + as.factor() %>% + as.integer() + if (any(component > 1)) { + cli_warn("Counties were not contiguous; expect additional splits.") + } + } + + + + + # get population stuff + pop_bounds <- attr(map, "pop_bounds") + pop <- map[[attr(map, "pop_col")]] + if (any(pop >= pop_bounds[3])) { + too_big <- as.character(which(pop >= pop_bounds[3])) + cli_abort(c("Unit{?s} {too_big} ha{?ve/s/ve} + population larger than the district target.", + "x" = "Redistricting impossible.")) + } + + # compute lags thing + lags <- 1 + unique(round((N - 1)^0.8*seq(0, 0.7, length.out = 4)^0.9)) + + + # set up parallel + ncores_max <- parallel::detectCores() + ncores_runs <- min(ncores_max, runs) + ncores_per <- as.integer(ncores) + if (ncores_per == 0) { + if (M/100*length(adj_list)/200 < 20) { + ncores_per <- 1L + } else { + ncores_per <- floor(ncores_max/ncores_runs) + } + } + + + if (ncores_runs > 1) { + `%oper%` <- `%dorng%` + of <- if (Sys.info()[["sysname"]] == "Windows") { + tempfile(pattern = paste0("smc_", substr(Sys.time(), 1, 10)), fileext = ".txt") + } else { + "" + } + + if (!silent) + cl <- makeCluster(ncores_runs, outfile = of, methods = FALSE, + useXDR = .Platform$endian != "little") + else + cl <- makeCluster(ncores_runs, methods = FALSE, + useXDR = .Platform$endian != "little") + doParallel::registerDoParallel(cl, cores = ncores_runs) + on.exit(stopCluster(cl)) + } else { + `%oper%` <- `%do%` + } + + + + t1 <- Sys.time() + all_out <- foreach(chain = seq_len(runs), .inorder = FALSE, .packages="redist") %oper% { + + + run_verbosity <- if (chain == 1) verbosity else 0 + t1_run <- Sys.time() + + algout <- redist::basic_smc_plans( + N=N, + adj_list=adj_list, + counties=counties, + pop=pop, + target=pop_bounds[2], + lower=pop_bounds[1], + upper=pop_bounds[3], + M=M, + control = control, + ncores = as.integer(ncores_per), + verbosity=run_verbosity, + diagnostic_mode=diagnostic_mode) + + + if (length(algout) == 0) { + cli::cli_process_done() + cli::cli_process_done() + } + + + # make each element of region_ids_mat_list a V by M matrix + algout$region_ids_mat_list <- lapply( + algout$region_ids_mat_list, + function(x) matrix(unlist(x), ncol = length(x), byrow = FALSE) + 1 + ) + + # make each element of region_dvals_mat_list a V by M matrix + algout$region_dvals_mat_list <- lapply( + algout$region_dvals_mat_list, + function(x) matrix(unlist(x), ncol = length(x), byrow = FALSE) + ) + + # make original ancestor matrix + # add 1 for R indexing + algout$original_ancestors_mat <- matrix( + unlist(algout$original_ancestors), + ncol = length(algout$original_ancestors), + byrow = FALSE) + 1 + + # make parent mat into matrix + # add 1 for R indexing + algout$parent_index <- matrix( + unlist(algout$parent_index), + ncol = length(algout$parent_index), + byrow = FALSE) + 1 + + # make draws tries into a matrix + algout$draw_tries_mat <- matrix( + unlist(algout$draw_tries_mat), + ncol = length(algout$draw_tries_mat), + byrow = FALSE) + + # make parent unsuccessful tries into a matrix + algout$parent_unsuccessful_tries_mat <- matrix( + unlist(algout$parent_unsuccessful_tries_mat), + ncol = length(algout$parent_unsuccessful_tries_mat), + byrow = FALSE) + + # make parent succesful tries matrix counting the number of + # times a parent index was successfully sampled + parent_successful_tries_mat <- apply( + algout$parent_index, 2, tabulate, nbins = M + ) + + # make the log incremental weights into a matrix + algout$log_incremental_weights_mat <- matrix( + unlist(algout$log_incremental_weights_mat), + ncol = length(algout$log_incremental_weights_mat), + byrow = FALSE) + + # pull out the log weights + lr <- algout$log_incremental_weights_mat[,N-1] + + wgt <- exp(lr - mean(lr)) + n_eff <- length(wgt)*mean(wgt)^2/mean(wgt^2) + + if(diagnostic_mode){ + # add a plans matrix as the final output because first + # N-2 are previous results + algout$plans <- algout$region_ids_mat_list[[N-1]] + + algout$final_region_labs <- matrix( + unlist(algout$final_region_labs), + ncol = length(algout$final_region_labs), + byrow = FALSE) + + }else{ + # Just add first element since not diagnostic mode the first N-2 + # steps were not tracked + algout$plans <- algout$region_ids_mat_list[[1]] + + # make the region_ids_mat_list input just null since there's nothing else + algout$region_ids_mat_list <- NULL + algout$region_dvals_mat_list <- NULL + algout$final_region_labs <- NULL + } + + if (any(is.na(lr))) { + cli_abort(c("Sampling probabilities have been corrupted.", + "*" = "Check that none of your constraint weights are too large. + The output of constraint functions multiplied by the weight + should generally fall in the -5 to 5 range.", + "*" = "If you are using custom constraints, make sure that your + constraint function handles all edge cases and never returns + {.val {NA}} or {.val {Inf}}", + "*" = "If you are not using any constraints, please call + {.code rlang::trace_back()} and file an issue at + {.url https://github.com/alarm-redist/redist/issues/new}")) + } + + + + if (resample) { + normalized_wgts <- wgt/sum(wgt) + n_eff <- 1/sum(normalized_wgts^2) + + rs_idx <- resample_lowvar(normalized_wgts) + n_unique <- dplyr::n_distinct(rs_idx) + algout$plans <- algout$plans[, rs_idx, drop = FALSE] + + algout$ancestors <- algout$ancestors[rs_idx, , drop = FALSE] + storage.mode(algout$ancestors) <- "integer" + } + + storage.mode(algout$plans) <- "integer" + t2_run <- Sys.time() + + + if (!is.nan(n_eff) && n_eff/M <= 0.05) + cli_warn(c("Less than 5% resampling efficiency.", + "*" = "Increase the number of samples.", + "*" = "Consider weakening or removing constraints.", + "i" = "If sampling efficiency drops precipitously in the final + iterations, population balance is likely causing a bottleneck. + Try increasing {.arg pop_temper} by 0.01.", + "i" = "If sampling efficiency declines steadily across iterations, + adjusting {.arg seq_alpha} upward may help a bit.")) + + # add the numerically stable weights back + algout$wgt <- wgt + + # add diagnostic stuff + algout$l_diag <- list( + n_eff = n_eff, + step_n_eff = algout$step_n_eff, + adapt_k_thresh = .99, # adapt_k_thresh, NEED TO DEAL WITH + est_k = k_params, # algout$est_k, + accept_rate = algout$acceptance_rates, + sd_lp = c( + apply(algout$log_incremental_weights_mat, 2, sd), sd(lr) + ), + sd_temper = rep(NA, N-1), # algout$sd_temper, + unique_survive = c(algout$nunique_parent_indices, n_unique), + ancestors = algout$ancestors, + seq_alpha = .99, + pop_temper = pop_temper, + runtime = as.numeric(t2_run - t1_run, units = "secs"), + district_str_labels = algout$final_region_labs, + nunique_original_ancestors = algout$nunique_original_ancestors, + parent_index_mat = algout$parent_index, + original_ancestors_mat = algout$original_ancestors_mat, + region_dvals_mat_list = algout$region_dvals_mat_list, + log_incremental_weights_mat = algout$log_incremental_weights_mat, + region_ids_mat_list = algout$region_ids_mat_list, + draw_tries_mat = algout$draw_tries_mat, + parent_unsuccessful_tries_mat = algout$parent_unsuccessful_tries_mat, + parent_successful_tries_mat = parent_successful_tries_mat + ) + + algout + + } + + if (verbosity >= 2) { + t2 <- Sys.time() + cli_text("{format(M*runs, big.mark=',')} plans sampled in + {format(t2-t1, digits=2)}") + } + + + plans <- do.call(cbind, lapply(all_out, function(x) x$plans)) + wgt <- do.call(c, lapply(all_out, function(x) x$wgt)) + l_diag <- lapply(all_out, function(x) x$l_diag) + n_dist_act <- dplyr::n_distinct(plans[, 1]) # actual number (for partial plans) + + + out <- new_redist_plans(plans, map, "basic_smc", wgt, resample, + ndists = N, + n_eff = all_out[[1]]$n_eff, + compactness = 1, + constraints = constraints, + version = packageVersion("redist"), + diagnostics = l_diag, + pop_bounds = pop_bounds) + + + if (runs > 1) { + out <- mutate(out, chain = rep(seq_len(runs), each = n_dist_act*M)) %>% + dplyr::relocate('chain', .after = "draw") + } + + exist_name <- attr(map, "existing_col") + if (!is.null(exist_name) && !isFALSE(ref_name) && ndists == final_dists) { + ref_name <- if (!is.null(ref_name)) ref_name else exist_name + out <- add_reference(out, map[[exist_name]], ref_name) + } + + out +} diff --git a/man/basic_smc_plans.Rd b/man/basic_smc_plans.Rd new file mode 100644 index 000000000..742ca5f4e --- /dev/null +++ b/man/basic_smc_plans.Rd @@ -0,0 +1,56 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/RcppExports.R +\name{basic_smc_plans} +\alias{basic_smc_plans} +\title{Run redist gsmc} +\usage{ +basic_smc_plans( + N, + adj_list, + counties, + pop, + target, + lower, + upper, + M, + control, + ncores = -1L, + verbosity = 3L, + diagnostic_mode = FALSE +) +} +\arguments{ +\item{N}{The number of districts the final plans will have} + +\item{adj_list}{A 0-indexed adjacency list representing the undirected graph +which represents the underlying map the plans are to be drawn on} + +\item{counties}{Vector of county labels of each vertex in \code{g}} + +\item{pop}{A vector of the population associated with each vertex in \code{g}} + +\item{target}{Ideal population of a valid district. This is what deviance is calculated +relative to} + +\item{lower}{Acceptable lower bounds on a valid district's population} + +\item{upper}{Acceptable upper bounds on a valid district's population} + +\item{M}{The number of plans (samples) to draw} + +\item{control}{Named list of additional parameters.} + +\item{verbosity}{What level of detail to print out while the algorithm is +running \if{html}{\out{}}} + +\item{k_param}{The k parameter from the SMC algorithm, you choose among the top k_param edges} + +\item{num_threads}{The number of threads the threadpool should use} +} +\description{ +Uses gsmc method to generate a sample of \code{M} plans in \verb{c++} +} +\details{ +Using the procedure outlined in \if{html}{\out{}} this function uses Sequential +Monte Carlo (SMC) methods to generate a sample of \code{M} plans +} diff --git a/man/redist_basic_smc.Rd b/man/redist_basic_smc.Rd new file mode 100644 index 000000000..7dfc59740 --- /dev/null +++ b/man/redist_basic_smc.Rd @@ -0,0 +1,32 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/redist_basic_smc.R +\name{redist_basic_smc} +\alias{redist_basic_smc} +\title{Basic SMC Redistricting Sampler} +\usage{ +redist_basic_smc( + state_map, + M, + counties = NULL, + k_params = 6, + resample = TRUE, + runs = 1L, + ncores = 0L, + pop_temper = 0, + verbose = FALSE, + silent = FALSE, + diagnostic_mode = FALSE +) +} +\arguments{ +\item{k_params}{Either a single value to use as the splitting parameter for +every round or a vector of length N-1 where each value is the one to use for +a split.} +} +\value{ +\code{redist_smc} returns a \link{redist_plans} object containing the simulated +plans. +} +\description{ +RedistSMC with optimal weights but not arbitrary region splits +} diff --git a/src/basic_smc.cpp b/src/basic_smc.cpp new file mode 100644 index 000000000..2165aa672 --- /dev/null +++ b/src/basic_smc.cpp @@ -0,0 +1,963 @@ +#include "basic_smc.h" + + +//' Attempts to cut one district and remainder from spanning tree +//' +//' Takes a spanning tree `ust` drawn on a specific region and attempts to cut +//' it to produce two new regions using the generalized splitting procedure +//' outlined . This function is based on `cut_districts` in `smc.cpp` +//' +//' @title Attempt One District split +//' +//' @param ust A directed spanning tree passed by reference +//' @param k_param The k parameter from the SMC algorithm, you choose among the top k_param edges +//' @param root The root vertex of the spanning tree +//' @param pop A vector of the population associated with each vertex in `g` +//' @param plan A plan object +//' @param region_id_to_split The id of the region in the plan object we're attempting to split +//' @param lower Acceptable lower bounds on a valid district's population +//' @param upper Acceptable upper bounds on a valid district's population +//' @param target Ideal population of a valid district. This is what deviance is calculated +//' relative to +//' @param new_region_ids A vector that will be updated by reference to contain the names of +//' the two new split regions if function is successful. +//' +//' @details Modifications +//' - If two new valid regions are split then the plan object is updated accordingly +//' - If two new valid regions are split then the new_region_ids is updated so the +//' first entry is the first new region and the second entry is the second new region +//' +//' @return True if two valid regions were split off false otherwise +//' +bool basic_cut_district(Tree &ust, int k_param, int root, + const uvec &pop, + Plan &plan, const int region_id_to_split, + double lower, double upper, double target, + std::vector &new_region_ids){ + // Get population of region being split + double total_pop = plan.region_pops.at(region_id_to_split); + // Get the number of final districts in region being split + int remainder_dsize = plan.region_dvals.at(region_id_to_split); + + if(remainder_dsize <= 1){ + Rprintf("BIG ERROR THE REGION TO SPLIT IS NOT MULTI DIST\n"); + } + + // Rcout << "For " << region_id_to_split << " Total pop is " << total_pop << " and d_nk is " << remainder_dsize << "\n"; + + // create list that points to parents & computes population below each vtx + std::vector pop_below(plan.V, 0); + std::vector parent(plan.V); + parent[root] = -1; + tree_pop(ust, root, pop, pop_below, parent); + + // compile a list of: things for each edge in tree + std::vector candidates; // candidate edges to cut, + std::vector deviances; // how far from target pop. + std::vector is_ok; // whether they meet constraints + std::vector new_d_val; // the new d_n,k value + + // Reserve at least as much space for top k_param of them + candidates.reserve(k_param); + deviances.reserve(k_param); + is_ok.reserve(k_param); + new_d_val.reserve(k_param); + + if(plan.region_num_ids.at(root) != region_id_to_split){ + Rcout << "Root vertex is not in region to split!"; + } + + // Now loop over all valid edges to cut + for (int i = 1; i <= plan.V; i++) { // 1-indexing here + // Ignore any vertex not in this region or the root vertex as we wont be cutting those + if (plan.region_num_ids.at(i-1) != region_id_to_split || i - 1 == root) continue; + + // Get the population of one side of the partition removing that edge would cause + double below = pop_below.at(i - 1); + // Get the population of the other side + double above = total_pop - below; + + // vectors to keep track of value for each d_{n,k} + double dev; + bool dev2_bigger; + bool pop_in_bounds; + + // Find which cut induces something closer to district + double dev1 = std::fabs(below - target); + double dev2 = std::fabs(above - target); + + // If dev1 is smaller then we assign district to below + if (dev1 < dev2) { + dev = dev1; + dev2_bigger= true; + // check in bounds + pop_in_bounds = lower <= below + && below <= upper + && lower * (remainder_dsize - 1) <= above + && above <= upper * (remainder_dsize - 1); + } else { // Else if dev2 is smaller we assign d_nk to above + dev = dev2; + dev2_bigger = false; + pop_in_bounds = lower <= above + && above <= upper + && lower * (remainder_dsize - 1) <= below + && below <= upper * (remainder_dsize - 1); + } + + + + /* + Rcout << "min element has value " << *result << " and index [" + << best_potential_d << "]\n"; + */ + + if(dev2_bigger){ + candidates.push_back(i); + } else{ + candidates.push_back(-i); + } + + deviances.push_back(dev); + is_ok.push_back(pop_in_bounds); + // the new d value is always 1 + new_d_val.push_back(1); + + } + + + // if less than k_param candidates immediately reject + if((int) candidates.size() < k_param){ + return false; + } + + int idx = r_int(k_param); + idx = select_k(deviances, idx + 1); + int cut_at = std::fabs(candidates[idx]) - 1; + + + // reject sample if not ok + if (!is_ok[idx]){ + return false; + } + + + + + // find index of node to cut at + std::vector *siblings = &ust[parent[cut_at]]; + int length = siblings->size(); + int j; + for (j = 0; j < length; j++) { + if ((*siblings)[j] == cut_at) break; + } + + siblings->erase(siblings->begin()+j); // remove edge + parent[cut_at] = -1; + + + // update plan with new regions + plan.num_regions++; // increase region count by 1 + plan.num_multidistricts--; // Decrease by one to avoid double counting later + + // Create info for two new districts + int new_region1_d = new_d_val[idx]; + int new_region2_d = remainder_dsize - new_region1_d; + + std::string new_region_label1; + std::string new_region_label2; + + std::string region_to_split = plan.region_str_labels.at(region_id_to_split); + + // Set label and count depending on if district or multi district + if(new_region1_d == 1){ + plan.num_districts++; + // if district then string label just adds district number + new_region_label1 = region_to_split + "." + std::to_string(plan.num_districts); + }else{ + plan.num_multidistricts++; + // if region then just add current region number + new_region_label1 = region_to_split + ".R" + std::to_string(region_id_to_split); + } + + // Now do it for second region + if(new_region2_d == 1){ + plan.num_districts++; + // if district then string label just adds district number + new_region_label2 = region_to_split + "." + std::to_string(plan.num_districts); + }else{ + plan.num_multidistricts++; + // if region then just add current region number + new_region_label2 = region_to_split + ".R" + std::to_string(plan.num_regions - 1); + } + + // Check whether the new regions are districts or multidistricts + + + // Vertex to start traversing tree for updating later + int tree_vertex1; + int tree_vertex2; + + // population and d_nk of new regions + double new_region1_pop; + double new_region2_pop; + + + if (candidates[idx] > 0) { // Means cut below so first vertex is cut_at + tree_vertex1 = cut_at; + tree_vertex2 = root; + + // Set the new populations + new_region1_pop = pop_below.at(cut_at); + new_region2_pop = total_pop - new_region1_pop; + + // return pop_below.at(cut_at); + } else { // Means cut above so first vertex is root + tree_vertex1 = root; + tree_vertex2 = cut_at; + + // Set the new populations + new_region2_pop = pop_below.at(cut_at); + new_region1_pop = total_pop - new_region2_pop; + + } + + + // update the function parameter with names of new regions + if(new_region_ids.size() != 2){ + Rcout << "For some reason the new_region_ids vector in cut_regions is not size 2!\n"; + } + + // Get the regions current integer id + int old_region_num_id = region_id_to_split; + // make the first new region have the same integer id + int new_region_num_id1 = old_region_num_id; + // Second new region has id of the new number of regions minus 1 + int new_region_num_id2 = plan.num_regions - 1; + + new_region_ids[0] = new_region_num_id1; + new_region_ids[1] = new_region_num_id2; + + + // Now update the two cut portions + assign_region(ust, plan, tree_vertex1, new_region_num_id1); + assign_region(ust, plan, tree_vertex2, new_region_num_id2); + + // Now update the region level information + + // Add the new region 1 + + // New region 1 has the same id number as old region so update that + plan.region_dvals.at(new_region_num_id1) = new_region1_d; + plan.region_str_labels.at(new_region_num_id1) = new_region_label1; + plan.region_pops.at(new_region_num_id1) = new_region1_pop; + + // Add the new region 2 + // New region 2's id is the highest id number so push back + plan.region_dvals.push_back(new_region2_d); + plan.region_str_labels.push_back(new_region_label2); + plan.region_pops.push_back(new_region2_pop); + + + return true; + +}; + + + +//' Attempts to split a remainder region within a plan into a district and a +//' new remainder region with valid population bounds for both +//' +//' Given a plan with a remainder region this attempts to split a district off +//' from it where both new district and new remainder have valid population bounds. +//' Does this by drawing a spanning tree uniformly at random then calling +//' `basic_cut_district` on that. If the split it successful it returns true +//' and modifies `plan` and `new_region_ids` accordingly. This is based on the +//' `split_map` function in smc.cpp +//' +//' +//' @title Attempt to split a district from a remainder region in a plan +//' +//' @param g A graph (adjacency list) passed by reference +//' @param ust A directed tree object (this will be cleared in the function so +//' whatever it was before doesn't matter) +//' @param counties Vector of county labels of each vertex in `g` +//' @param cg multigraph object (not sure why this is needed) +//' @param plan A plan object +//' @param region_id_to_split The label of the region in the plan object we're attempting to split +//' @param new_region_ids A vector that will be updated by reference to contain the names of +//' the two new split regions if function is successful. +//' @param lower Acceptable lower bounds on a valid district's population +//' @param upper Acceptable upper bounds on a valid district's population +//' @param target Ideal population of a valid district. This is what deviance is calculated +//' relative to +//' Target population (probably Total population of map/Num districts) +//' @param k_param The k parameter from the SMC algorithm, you choose among the top k_param edges +//' +//' @details Modifications +//' - If two new valid regions are split then the plan object is updated accordingly +//' - If two new valid regions are split then the new_region_ids is updated so the +//' first entry is the first new region and the second entry is the second new region +//' +//' @return True if two valid regions were split off false otherwise +//' +bool attempt_district_split(const Graph &g, Tree &ust, const uvec &counties, Multigraph &cg, + Plan &plan, const int region_id_to_split, + std::vector &new_region_ids, + std::vector &visited, std::vector &ignore, const uvec &pop, + double &lower, double upper, double target, int k_param) { + + int V = g.size(); + + // Mark it as ignore if its not in the region to split + for (int i = 0; i < V; i++){ + ignore[i] = plan.region_num_ids.at(i) != region_id_to_split; + } + + // Get a uniform spanning tree drawn on that region + int root; + clear_tree(ust); + // Get a tree + int result = sample_sub_ust(g, ust, V, root, visited, ignore, pop, lower, upper, counties, cg); + // Return unsuccessful if tree not drawn + if (result != 0) return false; + + // Now try to cut the tree and return that result + return basic_cut_district(ust, k_param, root, pop, + plan, region_id_to_split, + lower, upper, target, + new_region_ids); + +} + + + + + +/* + * Split off a piece from each map in `districts`, + * keeping deviation between `lower` and `upper` + */ + +// This should just update ancestor, lag, and give log prob reason was picked. +// Everything else can happen outside. +// Actually we compute incremental weight in the function. + + +//' Splits a multidistrict in all of the plans +//' +//' Using the procedure outlined in this function attempts to split +//' a multidistrict in a previous steps plan until M successful splits have been made. This +//' is based on the `split_maps` function in smc.cpp +//' +//' @title Split all the maps +//' +//' @param g A graph (adjacency list) passed by reference +//' @param counties Vector of county labels of each vertex in `g` +//' @param cg County level multigraph +//' @param pop A vector of the population associated with each vertex in `g` +//' @param old_plans_vec A vector of plans from the previous step +//' @param new_plans_vec A vector which will be filled with plans that had a +//' multidistrict split to make them +//' @param original_ancestor_vec A vector used to track which original ancestor +//' the new plans descended from. The value of `original_ancestor_vec[i]` +//' is the index of the original ancestor the new plan `new_plans_vec[i]` is +//' descended from. +//' @param parent_vec A vector used to track the index of the previous plan +//' sampled that was successfully split. The value of `parent_vec[i]` is the +//' index of the old plan from which the new plan `new_plans_vec[i]` was +//' successfully split from. In other words `new_plans_vec[i]` is equal to +//' `attempt_district_split(old_plans_vec[parent_vec[i]], ...)` +//' @param prev_ancestor_vec A vector used to track the index of the original +//' ancestor of the previous plans. The value of `prev_ancestor_vec[i]` is the +//' index of the original ancestor of `old_plans_vec[i]` +//' @param unnormalized_sampling_weights A vector of weights used to sample indices +//' of the `old_plans_vec`. The value of `unnormalized_sampling_weights[i]` is +//' the unnormalized probability that index i is selected +//' @param normalized_weights_to_fill_in A vector which will be filled with the +//' normalized weights the index sampler uses. The value of +//' `normalized_weights_to_fill_in[i]` is the probability that index i is selected +//' @param draw_tries_vec A vector used to keep track of how many plan split +//' attempts were made for index i. The value `draw_tries_vec[i]` represents how +//' many split attempts were made for the i-th new plan (including the successful +//' split). For example, `draw_tries_vec[i] = 1` means that the first split +//' attempt was successful. +//' @param parent_unsuccessful_tries_vec A vector used to keep track of how many times the +//' previous rounds plans were sampled and unsuccessfully split. The value +//' `parent_unsuccessful_tries_vec[i]` represents how many times `old_plans_vec[i]` was sampled +//' and then unsuccessfully split while creating all `M` of the new plans. +//' THIS MAY NOT BE THREAD SAFE +//' @param accept_rate The number of accepted splits over the total number of +//' attempted splits. This is equal to `sum(draw_tries_vec)/M` +//' @param n_unique_parent_indices The number of unique parent indices, ie the +//' number of previous plans that had at least one descendant amongst the new +//' plans. This is equal to `unique(parent_vec)` +//' @param n_unique_original_ancestors The number of unique original ancestors, +//' in the new plans. This is equal to `unique(original_ancestor_vec)` +//' @param ancestors Parameter from older `smc.cpp` code. I DON'T UNDERSTAND +//' WHAT IT IS DOING +//' @param lags Parameter from older `smc.cpp` code. I DON'T UNDERSTAND +//' WHAT IT IS DOING +//' @param lower Acceptable lower bounds on a valid district's population +//' @param upper Acceptable upper bounds on a valid district's population +//' @param target Ideal population of a valid district. This is what deviance is calculated +//' relative to +//' @param k_param The top edges to pick parameter for the region splitting +//' algorithm +//' @param pool A threadpool for multithreading +//' @param verbosity A parameter controlling the amount of detail printed out +//' during the algorithms running +//' +//' @details Modifications +//' - The `new_plans_vec` is updated with all the newly split plans +//' - The `old_plans_vec` is updated with all the newly split plans as well. +//' Note that the reason both this and `new_plans_vec` are updated is because +//' of the nature of the code you need both vectors and so both are passed by +//' reference to save memory. +//' - The `original_ancestor_vec` is updated to contain the indices of the +//' original ancestors of the new plans +//' - The `parent_vec` is updated to contain the indices of the parents of the + //' new plans +//' - If two new valid regions are split then the new_region_ids is updated so the +//' first entry is the first new region and the second entry is the second new region +//' - The `normalized_weights_to_fill_in` is updated to contain the normalized +//' probabilities the index sampler used. This is only collected for diagnostics +//' at this point and should just be equal to `unnormalized_sampling_weights` +//' divided by `sum(unnormalized_sampling_weights)` +//' - The `draw_tries_vec` is updated to contain the number of tries for each +//' of the new plans +//' - The `parent_unsuccessful_tries_vec` is updated to contain the number of unsuccessful +//' samples of the old plans +//' - The `accept_rate` is updated to contain the average acceptance rate for +//' this iteration +//' - `n_unique_parent_indices` and `n_unique_original_ancestors` are updated +//' with the unique number of parents and original ancestors for all the new +//' plans respectively +//' - `ancestors` is updated to something. THIS IS FROM ORIGINAL SMC CODE, +//' I DO NOT KNOW WHAT IT MEANS +//' +//' @return nothing +//' +void basic_split_maps( + const Graph &g, const uvec &counties, Multigraph &cg, const uvec &pop, + std::vector &old_plans_vec, std::vector &new_plans_vec, + std::vector &original_ancestor_vec, + std::vector &parent_vec, + const std::vector &prev_ancestor_vec, + const std::vector &unnormalized_sampling_weights, + std::vector &normalized_weights_to_fill_in, + std::vector &draw_tries_vec, + std::vector &parent_unsuccessful_tries_vec, + double &accept_rate, + int &n_unique_parent_indices, + int &n_unique_original_ancestors, + umat &ancestors, const std::vector &lags, + double lower, double upper, double target, + int k_param, + RcppThread::ThreadPool &pool, + int verbosity + ) { + // important constants + const int V = g.size(); + const int M = old_plans_vec.size(); + + + uvec iters(M, fill::zeros); // how many actual iterations, (used to compute acceptance rate) + uvec original_ancestor_uniques(M); // used to compute unique original ancestors + uvec parent_index_uniques(M); // used to compute unique parent indicies + + // PREVIOUS SMC CODE I DONT KNOW WHAT IT DOES + const int dist_ctr = old_plans_vec.at(0).num_regions; + const int n_lags = lags.size(); + umat ancestors_new(M, n_lags); // lags/ancestor thing + + + + // Create the obj which will sample from the index with probability + // proportional to the weights + std::random_device rd; + std::mt19937 gen(rd()); + std::discrete_distribution<> index_sampler( + unnormalized_sampling_weights.begin(), + unnormalized_sampling_weights.end() + ); + + // extract and record the normalized weights the sampler is using + std::vector p = index_sampler.probabilities(); + int nw_index = 0; + bool print_weights = M < 12 && verbosity > 1; + if(print_weights){ + Rprintf("Unnormalized weights are: "); + for (auto w : unnormalized_sampling_weights){ + Rprintf("%.4f, ", w); + } + + Rprintf("\n"); + Rprintf("Normalized weights are: "); + } + for (auto prob : p){ + if(print_weights) Rprintf("%.4f, ", prob); + normalized_weights_to_fill_in.at(nw_index) = prob; + nw_index++; + } + if(print_weights) Rprintf("\n"); + + // Because of multithreading we have to add specific checks for if the user + // wants to quit the program + const int reject_check_int = 200; // check for interrupts every _ rejections + const int check_int = 50; // check for interrupts every _ iterations + + + // create a progress bar + RcppThread::ProgressBar bar(M, 1); + // Parallel thread pool where all objects in memory shared by default + pool.parallelFor(0, M, [&] (int i) { + int reject_ct = 0; + bool ok = false; + int idx; + // the id of the remainder is always the biggest region id + // which is dist_ctr - 1 + int region_id_to_split = dist_ctr - 1; + std::vector new_region_ids(2, -1); + + Tree ust = init_tree(V); + std::vector visited(V); + std::vector ignore(V); + while (!ok) { + // increase the iters count by one + iters[i]++; + // use weights to sample previous plan + idx = index_sampler(gen); + Plan proposed_new_plan = old_plans_vec[idx]; + + // Now try to split that region + ok = attempt_district_split(g, ust, counties, cg, + proposed_new_plan, region_id_to_split, + new_region_ids, + visited, ignore, pop, + lower, upper, target, k_param); + + // bad sample; try again + if (!ok) { + // THIS MAY NOT BE THREAD SAFE + parent_unsuccessful_tries_vec[idx]++; // update unsuccessful try + RcppThread::checkUserInterrupt(++reject_ct % reject_check_int == 0); + continue; + } + + // else update the new plan and leave the while loop + new_plans_vec[i] = proposed_new_plan; + + } + + // Record how many tries needed to create i-th new plan + draw_tries_vec[i] = static_cast(iters[i]); + // Make the new plans original ancestor the same as its parent + original_ancestor_uniques[i] = prev_ancestor_vec[idx]; + // record index of new plan's parent + parent_index_uniques[i] = idx; + // clear the spanning tree + clear_tree(ust); + + // ORIGINAL SMC CODE I DONT KNOW WHAT THIS DOES + // save ancestors/lags + for (int j = 0; j < n_lags; j++) { + if (dist_ctr <= lags[j]) { + ancestors_new(i, j) = i; + } else { + ancestors_new(i, j) = ancestors(idx, j); + } + } + + + // update this particles ancestor to be the ancestor of its previous one + parent_vec[i] = idx; + original_ancestor_vec[i] = prev_ancestor_vec[idx]; + + RcppThread::checkUserInterrupt(i % check_int == 0); + }); + + // Wait for all the threads to finish + pool.wait(); + + + + // now replace the old plans with the new ones + for(int i=0; i < M; i++){ + old_plans_vec[i] = new_plans_vec[i]; + } + + + // now compute acceptance rate and unique parents and original ancestors + accept_rate = M / (1.0 * sum(iters)); + n_unique_original_ancestors = ((uvec) find_unique(original_ancestor_uniques)).n_elem; + n_unique_parent_indices = ((uvec) find_unique(parent_index_uniques)).n_elem; + if (verbosity >= 3) { + Rprintf("%.2f acceptance rate, %d unique parent indices sampled, and %d unique original ancestors!\n", + 100.0 * accept_rate, (int) n_unique_parent_indices , (int) n_unique_original_ancestors); + } + + // ORIGINAL SMC CODE I DONT KNOW WHAT IT DOES + ancestors = ancestors_new; + +} + + + +//' Computes log unnormalized weights for vector of plans +//' +//' Using the procedure outlined in this function computes the log +//' incremental weights and the unnormalized weights for a vector of plans (which +//' may or may not be the same depending on the parameters). +//' +//' @title Compute Log Unnormalized Weights +//' +//' @param pool A threadpool for multithreading +//' @param g A graph (adjacency list) passed by reference +//' @param plans_vec A vector of plans to compute the log unnormalized weights +//' of +//' @param log_incremental_weights A vector of the log incremental weights +//' computed for the plans. The value of `log_incremental_weights[i]` is +//' the log incremental weight for `plans_vec[i]` +//' @param unnormalized_sampling_weights A vector of the unnormalized sampling +//' weights to be used with sampling the `plans_vec` in the next iteration of the +//' algorithm. Depending on the other hyperparameters this may or may not be the +//' same as `exp(log_incremental_weights)` +//' @param target Target population of a single district +//' @param pop_temper
+//' +//' @details Modifications +//' - The `log_incremental_weights` is updated to contain the incremental +//' weights of the plans +//' - The `unnormalized_sampling_weights` is updated to contain the unnormalized +//' sampling weights of the plans for the next round +void get_log_basic_smc_weights( + RcppThread::ThreadPool &pool, + const Graph &g, std::vector &plans_vec, + std::vector &log_incremental_weights, + std::vector &unnormalized_sampling_weights, + double target, double pop_temper +){ + int M = (int) plans_vec.size(); + + + int n = plans_vec.at(0).num_regions; + int N = plans_vec.at(0).N; + + // do basic smc weights unless N regions + if(n < N){ + // Parallel thread pool where all objects in memory shared by default + pool.parallelFor(0, M, [&] (int i) { + double log_incr_weight = compute_basic_smc_log_incremental_weight( + g, plans_vec.at(i), target, pop_temper); + log_incremental_weights[i] = log_incr_weight; + unnormalized_sampling_weights[i] = std::exp(log_incr_weight); + }); + }else{ + pool.parallelFor(0, M, [&] (int i) { + double log_incr_weight = compute_log_incremental_weight( + g, plans_vec.at(i), target, pop_temper); + log_incremental_weights[i] = log_incr_weight; + unnormalized_sampling_weights[i] = std::exp(log_incr_weight); + }); + } + + // Wait for all the threads to finish + pool.wait(); + + return; +} + + +//' Uses gsmc method to generate a sample of `M` plans in `c++` +//' +//' Using the procedure outlined in this function uses Sequential +//' Monte Carlo (SMC) methods to generate a sample of `M` plans +//' +//' @title Run redist gsmc +//' +//' @param N The number of districts the final plans will have +//' @param adj_list A 0-indexed adjacency list representing the undirected graph +//' which represents the underlying map the plans are to be drawn on +//' @param counties Vector of county labels of each vertex in `g` +//' @param pop A vector of the population associated with each vertex in `g` +//' @param target Ideal population of a valid district. This is what deviance is calculated +//' relative to +//' @param lower Acceptable lower bounds on a valid district's population +//' @param upper Acceptable upper bounds on a valid district's population +//' @param M The number of plans (samples) to draw +//' @param control Named list of additional parameters. +//' @param num_threads The number of threads the threadpool should use +//' @param verbosity What level of detail to print out while the algorithm is +//' running +//' @export +List basic_smc_plans( + int N, List adj_list, + const arma::uvec &counties, const arma::uvec &pop, + double target, double lower, double upper, + int M, // M is Number of particles aka number of different plans + List control, // control has pop temper, and k parameter value + int num_threads, int verbosity, bool diagnostic_mode){ + + // set number of threads + if (num_threads <= 0) num_threads = std::thread::hardware_concurrency(); + if (num_threads == 1) num_threads = 0; + + // lags thing (copied from original smc code, don't understand what its doing) + std::vector lags = as>(control["lags"]); + // k param values to use + std::vector k_params = as>(control["k_params"]); + + double pop_temper = as(control["pop_temper"]); + + + umat ancestors(M, lags.size(), fill::zeros); + + // Create map level graph and county level multigraph + Graph g = list_to_graph(adj_list); + Multigraph cg = county_graph(g, counties); + + int V = g.size(); + double total_pop = sum(pop); + + // Loading Info + if (verbosity >= 1) { + Rcout.imbue(std::locale("")); + Rcout << std::fixed << std::setprecision(0); + Rcout << "GENERALIZED SEQUENTIAL MONTE CARLO\n"; + Rcout << "Sampling " << M << " " << V << "-unit "; + Rcout << "maps with " << N << " districts and population between " + << lower << " and " << upper << " using " << num_threads << " threads.\n"; + if (cg.size() > 1){ + Rcout << "Ensuring no more than " << N - 1 << " splits of the " + << cg.size() << " administrative units.\n"; + } + } + + + + std::vector plans_vec(M, Plan(V, N, total_pop)); + std::vector new_plans_vec(M, Plan(V, N, total_pop)); // New plans + + + // Define output variables that must always be created + + // This is N-1 by M where [i][j] is the index of the parent of particle j on step i + // ie the index of the previous plan that was sampled and used to create particle j on step i + std::vector> parent_index_mat(N-1, std::vector (M, -1)); + + // This is N-1 by M where [i][j] is the index of the original (first) ancestor of particle j on step i + std::vector> original_ancestor_mat(N-1, std::vector (M, -1)); + + // This is N-1 by M where [i][j] is the number of tries it took to form particle j on iteration i + // Inclusive of the final step. ie if succeeds in one try it would be 1 + std::vector> draw_tries_mat(N-1, std::vector (M, -1)); + + // This is N-1 by M where [i][j] is the number of times particle j from the + // previous round was sampled and unsuccessfully split on iteration i so this + // does not count successful sample then split + std::vector> parent_unsuccessful_tries_mat(N-1, std::vector (M, 0)); + + // This is N-1 by M where [i][j] is the log incremental weight of particle j on step i + std::vector> log_incremental_weights_mat(N-1, std::vector (M, -1.0)); + + // This is N-1 by M where [i][j] is the normalized weight of particle j on step i + std::vector> normalized_weights_mat(N-1, std::vector (M, -1.0)); + + + + + // Tracks the acceptance rate - total number of tries over M - for each round + std::vector acceptance_rates(N-1, -1.0); + + // Tracks the effective sample size for the weights of each round + std::vector n_eff(N-1, -1.0); + + // Tracks the number of unique parent vectors sampled to create the next round + std::vector nunique_parents_vec(N-1, -1); + + // Tracks the number of unique ancestors left at each step + std::vector nunique_original_ancestors_vec(N-1, -1); + + + // Declare variables whose size will depend on whether or not we're in + // diagnostic mode or not + std::vector>> plan_region_ids_mat; + std::vector>> plan_d_vals_mat; + std::vector> final_plan_region_labels; + + + + + // If diagnostic mode track stuff from every round + if(diagnostic_mode){ + // Create info tracking we will pass out at the end + // This is N-1 by M by V where for each n=1,...,N-1 and m=1,...M it maps vertices to integer id + plan_region_ids_mat.resize(N-1, std::vector>( + M, std::vector(V, -1) + )); + + // reserve space for N-1 elements + plan_d_vals_mat.reserve(N-1); + + // This is N-2 by M by 1,2,...N where for each n=1,...,N-1, m=1,...,M it maps the region + // id to the region's d value. So for a given n it is n by M by n+1 + // It stops at N-2 because for N-1 its all 1 + for(int n = 1; n < N-1; n++){ + plan_d_vals_mat.push_back( + std::vector>(M, std::vector(n+1, -1)) + ); + } + + // M by N-1 where for each m=1,...M it maps region ids to region labels in a plan + final_plan_region_labels.resize( + M, std::vector(N, "MISSING") + ); + + }else{ // else only track for final round + // Create info tracking we will pass out at the end + // This is M by V where for each m=1,...M it maps vertices to integer id for plan + plan_region_ids_mat.resize(1, std::vector>( + M, std::vector(V, -1) + )); + } + + + // Start off all the unnormalized weights at 1 + std::vector unnormalized_sampling_weights(M, 1.0); + + + // Create a threadpool + + RcppThread::ThreadPool pool(num_threads); + + std::string bar_fmt = "Split [{cli::pb_current}/{cli::pb_total}] {cli::pb_bar} | ETA{cli::pb_eta}"; + RObject bar = cli_progress_bar(N-1, cli_config(false, bar_fmt.c_str())); + + // Now for each run through split the map + try { + for(int n=0; n 1){ + Rprintf("Iteration %d \n", n+1); + } + + + // For the first iteration we need to pass a special previous ancestor thing + if(n == 0){ + std::vector dummy_prev_ancestors(M, 1); + // split the map + basic_split_maps( + g, counties, cg, pop, + plans_vec, new_plans_vec, + original_ancestor_mat[n], + parent_index_mat[n], + dummy_prev_ancestors, + unnormalized_sampling_weights, + normalized_weights_mat[n], + draw_tries_mat[n], + parent_unsuccessful_tries_mat.at(n), + acceptance_rates[n], + nunique_parents_vec[n], + nunique_original_ancestors_vec[n], + ancestors, lags, + lower, upper, target, + k_params[n], + pool, + verbosity + ); + + // For the first ancestor one make every ancestor themselves + std::iota (parent_index_mat[0].begin(), parent_index_mat[0].end(), 0); + std::iota (original_ancestor_mat[0].begin(), original_ancestor_mat[0].end(), 0); + }else{ + // split the map and we can use the previous original ancestor matrix row + basic_split_maps( + g, counties, cg, pop, + plans_vec, new_plans_vec, + original_ancestor_mat[n], + parent_index_mat[n], + original_ancestor_mat[n-1], + unnormalized_sampling_weights, + normalized_weights_mat[n], + draw_tries_mat[n], + parent_unsuccessful_tries_mat.at(n), + acceptance_rates[n], + nunique_parents_vec[n], + nunique_original_ancestors_vec[n], + ancestors, lags, + lower, upper, target, + k_params[n], + pool, + verbosity + ); + } + + if (verbosity == 1 && CLI_SHOULD_TICK){ + cli_progress_set(bar, n); + } + Rcpp::checkUserInterrupt(); + + + // compute log incremental weights and sampling weights for next round + get_log_basic_smc_weights( + pool, + g, + new_plans_vec, + log_incremental_weights_mat.at(n), + unnormalized_sampling_weights, + target, + pop_temper + ); + + // compute effective sample size + n_eff.at(n) = compute_n_eff(log_incremental_weights_mat[n]); + + // Now update the diagnostic info if needed, region labels, dval column of the matrix + if(diagnostic_mode && n == N-2){ // record if in diagnostic mode and final step + for(int j=0; j +#include +#include +#include +#include +#include + +#include +#include "wilson.h" +#include "tree_op.h" +#include "map_calc.h" +#include "redist_types.h" +#include "gsmc_helpers.h" + + + + +//' Uses gsmc method to generate a sample of `M` plans in `c++` +//' +//' Using the procedure outlined in this function uses Sequential +//' Monte Carlo (SMC) methods to generate a sample of `M` plans +//' +//' @title Run redist gsmc +//' +//' @param N The number of districts the final plans will have +//' @param adj_list A 0-indexed adjacency list representing the undirected graph +//' which represents the underlying map the plans are to be drawn on +//' @param counties Vector of county labels of each vertex in `g` +//' @param pop A vector of the population associated with each vertex in `g` +//' @param target Ideal population of a valid district. This is what deviance is calculated +//' relative to +//' @param lower Acceptable lower bounds on a valid district's population +//' @param upper Acceptable upper bounds on a valid district's population +//' @param M The number of plans (samples) to draw +//' @param k_param The k parameter from the SMC algorithm, you choose among the top k_param edges +//' @param control Named list of additional parameters. +//' @param num_threads The number of threads the threadpool should use +//' @param verbosity What level of detail to print out while the algorithm is +//' running +//' @export +// [[Rcpp::export]] +List basic_smc_plans( + int N, List adj_list, + const arma::uvec &counties, const arma::uvec &pop, + double target, double lower, double upper, + int M, // Number of particles aka number of different plans + List control, + int ncores = -1, int verbosity = 3, bool diagnostic_mode = false); + + + + +bool attempt_district_split(const Graph &g, Tree &ust, const uvec &counties, Multigraph &cg, + Plan &plan, const int region_id_to_split, + std::vector &new_region_ids, + std::vector &visited, std::vector &ignore, const uvec &pop, + double &lower, double upper, double target, int k_param); + + +bool basic_cut_district(Tree &ust, int k_param, int root, + const uvec &pop, + Plan &plan, const int region_id_to_split, + double lower, double upper, double target, + std::vector &new_region_ids); + +#endif From 37b81c7137313e4e3e79be48c3610fa91d47f243 Mon Sep 17 00:00:00 2001 From: "Philip W. O'Sullivan" Date: Sun, 15 Sep 2024 21:18:37 -0400 Subject: [PATCH 015/324] added basic version of original smc with optimal weights --- .Rbuildignore | 22 ----------- NAMESPACE | 2 + R/RcppExports.R | 35 +++++++++++++++++ R/confint.R | 4 +- R/diagnostics.R | 4 +- man/gsmc_plans.Rd | 5 +-- man/redist_gsmc.Rd | 8 +++- src/RcppExports.cpp | 61 +++++++++++++++++++++++++++++ src/gsmc_helpers.cpp | 91 ++++++++++++++++++++++++++++++++++++++++++++ src/gsmc_helpers.h | 5 +++ 10 files changed, 208 insertions(+), 29 deletions(-) diff --git a/.Rbuildignore b/.Rbuildignore index 67e5005bc..91114bf2f 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -1,24 +1,2 @@ -README.Rmd -\.git -\.gitignore -\.travis\.yml -\.DS_Store -\.\.Rcheck -builder.sh -^.*\.o$ -^doc$ -^Meta$ -^_pkgdown\.yml$ -^docs$ -^pkgdown$ ^.*\.Rproj$ ^\.Rproj\.user$ -^cran-comments\.md$ -^CRAN-RELEASE$ -^R/dev_helpers\.R$ -^inst/enumpart/enumpart\.exe$ -^data-raw$ -^explore$ -^\.github$ -^LICENSE\.md$ -^CRAN-SUBMISSION$ diff --git a/NAMESPACE b/NAMESPACE index f8fbf4640..f8a4e6228 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -76,6 +76,7 @@ export(add_constr_total_splits) export(add_reference) export(as_redist_map) export(avg_by_prec) +export(basic_smc_plans) export(classify_plans) export(combine_scorers) export(compare_plans) @@ -169,6 +170,7 @@ export(redist.splits) export(redist.subset) export(redist.uncoarsen) export(redist.wted.adj) +export(redist_basic_smc) export(redist_ci) export(redist_constr) export(redist_flip) diff --git a/R/RcppExports.R b/R/RcppExports.R index 0427de63a..dc46fed3b 100644 --- a/R/RcppExports.R +++ b/R/RcppExports.R @@ -9,6 +9,33 @@ collapse_adj <- function(graph, idxs) { .Call(`_redist_collapse_adj`, graph, idxs) } +#' Uses gsmc method to generate a sample of `M` plans in `c++` +#' +#' Using the procedure outlined in this function uses Sequential +#' Monte Carlo (SMC) methods to generate a sample of `M` plans +#' +#' @title Run redist gsmc +#' +#' @param N The number of districts the final plans will have +#' @param adj_list A 0-indexed adjacency list representing the undirected graph +#' which represents the underlying map the plans are to be drawn on +#' @param counties Vector of county labels of each vertex in `g` +#' @param pop A vector of the population associated with each vertex in `g` +#' @param target Ideal population of a valid district. This is what deviance is calculated +#' relative to +#' @param lower Acceptable lower bounds on a valid district's population +#' @param upper Acceptable upper bounds on a valid district's population +#' @param M The number of plans (samples) to draw +#' @param k_param The k parameter from the SMC algorithm, you choose among the top k_param edges +#' @param control Named list of additional parameters. +#' @param num_threads The number of threads the threadpool should use +#' @param verbosity What level of detail to print out while the algorithm is +#' running +#' @export +basic_smc_plans <- function(N, adj_list, counties, pop, target, lower, upper, M, control, ncores = -1L, verbosity = 3L, diagnostic_mode = FALSE) { + .Call(`_redist_basic_smc_plans`, N, adj_list, counties, pop, target, lower, upper, M, control, ncores, verbosity, diagnostic_mode) +} + coarsen_adjacency <- function(adj, groups) { .Call(`_redist_coarsen_adjacency`, adj, groups) } @@ -239,6 +266,14 @@ swMH <- function(aList, cdvec, popvec, nsims, constraints, eprob, pct_dist_parit .Call(`_redist_swMH`, aList, cdvec, popvec, nsims, constraints, eprob, pct_dist_parity, beta_sequence, beta_weights, lambda, beta, adapt_beta, adjswap, exact_mh, adapt_eprob, adapt_lambda, num_hot_steps, num_annealing_steps, num_cold_steps, verbose) } +split_entire_map_once_basic_smc <- function(N, adj_list, counties, pop, target, lower, upper, verbose) { + .Call(`_redist_split_entire_map_once_basic_smc`, N, adj_list, counties, pop, target, lower, upper, verbose) +} + +basic_smc_split_all_the_way <- function(N, adj_list, counties, pop, target, lower, upper, verbose) { + .Call(`_redist_basic_smc_split_all_the_way`, N, adj_list, counties, pop, target, lower, upper, verbose) +} + tree_pop <- function(ust, vtx, pop, pop_below, parent) { .Call(`_redist_tree_pop`, ust, vtx, pop, pop_below, parent) } diff --git a/R/confint.R b/R/confint.R index e90fd1e09..e2d9d2a81 100644 --- a/R/confint.R +++ b/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", "gsmc", "mergesplit", "flip") + algos_ok = c("smc", "gsmc", "basic_smc", "mergesplit", "flip") x = enquo(x) @@ -59,6 +59,8 @@ redist_ci <- function(plans, x, district = 1L, conf = 0.9, by_chain = FALSE) { redist_smc_ci(plans, !!x, district, conf, by_chain) } else if (algo == "gsmc") { redist_smc_ci(plans, !!x, district, conf, by_chain) + } else if (algo == "basic_smc") { + redist_smc_ci(plans, !!x, district, conf, by_chain) } else { # MCMC redist_mcmc_ci(plans,!!x, district, conf, by_chain) } diff --git a/R/diagnostics.R b/R/diagnostics.R index 1a8b4e585..11ff49857 100644 --- a/R/diagnostics.R +++ b/R/diagnostics.R @@ -210,11 +210,11 @@ summary.redist_plans <- function(object, district = 1L, all_runs = TRUE, vi_max code <- str_glue("plot(, rowMeans(as.matrix({name}) == ))") cli::cat_line(" ", cli::code_highlight(code, "Material")) } - } else if(algo == "gsmc") { + } else if(algo %in% c("gsmc", 'basic_smc')) { pop_lb <- attr(object, "pop_bounds")[1] pop_ub <- attr(object, "pop_bounds")[3] - cli_text("{.strong gSMC:} {fmt_comma(n_samp)} sampled plans of {n_distr} + cli_text("{.strong {algo}:} {fmt_comma(n_samp)} sampled plans of {n_distr} districts on {fmt_comma(nrow(plans_m))} units with a population between {fmt_comma(pop_lb)} and {fmt_comma(pop_ub)}") cli_text("{.arg pop_temper}={format(all_diagn[[1]]$pop_temper, digits=3)}") cat("\n") diff --git a/man/gsmc_plans.Rd b/man/gsmc_plans.Rd index fb8ad7e48..a14634e01 100644 --- a/man/gsmc_plans.Rd +++ b/man/gsmc_plans.Rd @@ -13,7 +13,6 @@ gsmc_plans( lower, upper, M, - k_param, control, ncores = -1L, verbosity = 3L, @@ -39,13 +38,13 @@ relative to} \item{M}{The number of plans (samples) to draw} -\item{k_param}{The k parameter from the SMC algorithm, you choose among the top k_param edges} - \item{control}{Named list of additional parameters.} \item{verbosity}{What level of detail to print out while the algorithm is running \if{html}{\out{}}} +\item{k_param}{The k parameter from the SMC algorithm, you choose among the top k_param edges} + \item{num_threads}{The number of threads the threadpool should use} } \description{ diff --git a/man/redist_gsmc.Rd b/man/redist_gsmc.Rd index 81387a63b..cd8d0d1d1 100644 --- a/man/redist_gsmc.Rd +++ b/man/redist_gsmc.Rd @@ -8,15 +8,21 @@ redist_gsmc( state_map, M, counties = NULL, - k_param_val = 6, + k_params = 6, resample = TRUE, runs = 1L, ncores = 0L, + pop_temper = 0, verbose = FALSE, silent = FALSE, diagnostic_mode = FALSE ) } +\arguments{ +\item{k_params}{Either a single value to use as the splitting parameter for +every round or a vector of length N-1 where each value is the one to use for +a split.} +} \value{ \code{redist_smc} returns a \link{redist_plans} object containing the simulated plans. diff --git a/src/RcppExports.cpp b/src/RcppExports.cpp index 35fefdd15..46f875533 100644 --- a/src/RcppExports.cpp +++ b/src/RcppExports.cpp @@ -38,6 +38,28 @@ BEGIN_RCPP return rcpp_result_gen; END_RCPP } +// basic_smc_plans +List basic_smc_plans(int N, List adj_list, const arma::uvec& counties, const arma::uvec& pop, double target, double lower, double upper, int M, List control, int ncores, int verbosity, bool diagnostic_mode); +RcppExport SEXP _redist_basic_smc_plans(SEXP NSEXP, SEXP adj_listSEXP, SEXP countiesSEXP, SEXP popSEXP, SEXP targetSEXP, SEXP lowerSEXP, SEXP upperSEXP, SEXP MSEXP, SEXP controlSEXP, SEXP ncoresSEXP, SEXP verbositySEXP, SEXP diagnostic_modeSEXP) { +BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< int >::type N(NSEXP); + Rcpp::traits::input_parameter< List >::type adj_list(adj_listSEXP); + Rcpp::traits::input_parameter< const arma::uvec& >::type counties(countiesSEXP); + Rcpp::traits::input_parameter< const arma::uvec& >::type pop(popSEXP); + Rcpp::traits::input_parameter< double >::type target(targetSEXP); + Rcpp::traits::input_parameter< double >::type lower(lowerSEXP); + Rcpp::traits::input_parameter< double >::type upper(upperSEXP); + Rcpp::traits::input_parameter< int >::type M(MSEXP); + Rcpp::traits::input_parameter< List >::type control(controlSEXP); + Rcpp::traits::input_parameter< int >::type ncores(ncoresSEXP); + Rcpp::traits::input_parameter< int >::type verbosity(verbositySEXP); + Rcpp::traits::input_parameter< bool >::type diagnostic_mode(diagnostic_modeSEXP); + rcpp_result_gen = Rcpp::wrap(basic_smc_plans(N, adj_list, counties, pop, target, lower, upper, M, control, ncores, verbosity, diagnostic_mode)); + return rcpp_result_gen; +END_RCPP +} // coarsen_adjacency List coarsen_adjacency(List adj, IntegerVector groups); RcppExport SEXP _redist_coarsen_adjacency(SEXP adjSEXP, SEXP groupsSEXP) { @@ -709,6 +731,42 @@ BEGIN_RCPP return rcpp_result_gen; END_RCPP } +// split_entire_map_once_basic_smc +List split_entire_map_once_basic_smc(int N, List adj_list, const arma::uvec& counties, const arma::uvec& pop, double target, double lower, double upper, bool verbose); +RcppExport SEXP _redist_split_entire_map_once_basic_smc(SEXP NSEXP, SEXP adj_listSEXP, SEXP countiesSEXP, SEXP popSEXP, SEXP targetSEXP, SEXP lowerSEXP, SEXP upperSEXP, SEXP verboseSEXP) { +BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< int >::type N(NSEXP); + Rcpp::traits::input_parameter< List >::type adj_list(adj_listSEXP); + Rcpp::traits::input_parameter< const arma::uvec& >::type counties(countiesSEXP); + Rcpp::traits::input_parameter< const arma::uvec& >::type pop(popSEXP); + Rcpp::traits::input_parameter< double >::type target(targetSEXP); + Rcpp::traits::input_parameter< double >::type lower(lowerSEXP); + Rcpp::traits::input_parameter< double >::type upper(upperSEXP); + Rcpp::traits::input_parameter< bool >::type verbose(verboseSEXP); + rcpp_result_gen = Rcpp::wrap(split_entire_map_once_basic_smc(N, adj_list, counties, pop, target, lower, upper, verbose)); + return rcpp_result_gen; +END_RCPP +} +// basic_smc_split_all_the_way +List basic_smc_split_all_the_way(int N, List adj_list, const arma::uvec& counties, const arma::uvec& pop, double target, double lower, double upper, bool verbose); +RcppExport SEXP _redist_basic_smc_split_all_the_way(SEXP NSEXP, SEXP adj_listSEXP, SEXP countiesSEXP, SEXP popSEXP, SEXP targetSEXP, SEXP lowerSEXP, SEXP upperSEXP, SEXP verboseSEXP) { +BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< int >::type N(NSEXP); + Rcpp::traits::input_parameter< List >::type adj_list(adj_listSEXP); + Rcpp::traits::input_parameter< const arma::uvec& >::type counties(countiesSEXP); + Rcpp::traits::input_parameter< const arma::uvec& >::type pop(popSEXP); + Rcpp::traits::input_parameter< double >::type target(targetSEXP); + Rcpp::traits::input_parameter< double >::type lower(lowerSEXP); + Rcpp::traits::input_parameter< double >::type upper(upperSEXP); + Rcpp::traits::input_parameter< bool >::type verbose(verboseSEXP); + rcpp_result_gen = Rcpp::wrap(basic_smc_split_all_the_way(N, adj_list, counties, pop, target, lower, upper, verbose)); + return rcpp_result_gen; +END_RCPP +} // tree_pop int tree_pop(Tree& ust, int vtx, const arma::uvec& pop, std::vector& pop_below, std::vector& parent); RcppExport SEXP _redist_tree_pop(SEXP ustSEXP, SEXP vtxSEXP, SEXP popSEXP, SEXP pop_belowSEXP, SEXP parentSEXP) { @@ -757,6 +815,7 @@ END_RCPP static const R_CallMethodDef CallEntries[] = { {"_redist_reduce_adj", (DL_FUNC) &_redist_reduce_adj, 3}, {"_redist_collapse_adj", (DL_FUNC) &_redist_collapse_adj, 2}, + {"_redist_basic_smc_plans", (DL_FUNC) &_redist_basic_smc_plans, 12}, {"_redist_coarsen_adjacency", (DL_FUNC) &_redist_coarsen_adjacency, 2}, {"_redist_get_plan_graph", (DL_FUNC) &_redist_get_plan_graph, 4}, {"_redist_color_graph", (DL_FUNC) &_redist_color_graph, 2}, @@ -804,6 +863,8 @@ static const R_CallMethodDef CallEntries[] = { {"_redist_splits", (DL_FUNC) &_redist_splits, 4}, {"_redist_dist_cty_splits", (DL_FUNC) &_redist_dist_cty_splits, 3}, {"_redist_swMH", (DL_FUNC) &_redist_swMH, 20}, + {"_redist_split_entire_map_once_basic_smc", (DL_FUNC) &_redist_split_entire_map_once_basic_smc, 8}, + {"_redist_basic_smc_split_all_the_way", (DL_FUNC) &_redist_basic_smc_split_all_the_way, 8}, {"_redist_tree_pop", (DL_FUNC) &_redist_tree_pop, 5}, {"_redist_var_info_vec", (DL_FUNC) &_redist_var_info_vec, 3}, {"_redist_sample_ust", (DL_FUNC) &_redist_sample_ust, 6}, diff --git a/src/gsmc_helpers.cpp b/src/gsmc_helpers.cpp index da0377a54..85fd73896 100644 --- a/src/gsmc_helpers.cpp +++ b/src/gsmc_helpers.cpp @@ -408,3 +408,94 @@ double compute_log_incremental_weight( return -std::log(incremental_weight); } + + + + +//' Compute the log incremental weight of a plan under basic smc scheme +//' +//' Given a plan object this computes the minimum variance weights as derived in +//' . This is equivalent to the inverse of a sum over all +//' adjacent regions in a plan. +//' +//' @title Compute Incremental Weight of a plan +//' +//' @param plan A plan object +//' @param g The underlying map graph +//' @param target The target population for a single district +//' @param pop_temper The population tempering parameter +//' +//' @details No modifications to inputs made +//' +//' @return the log of the incremental weight of the plan +//' +double compute_basic_smc_log_incremental_weight( + const Graph &g, const Plan &plan, + const double target, const double pop_temper){ + // get a region level graph + Graph rg = get_region_graph(g, plan); + + + // sanity check: make sure the region level graph's number of vertices is + // the same as the number of regions in the plan + if((int)rg.size() != plan.num_regions){ + Rprintf("SOMETHING WENT WRONG IN COMPPUTE LOG INCREMENT WEIGHJT\n"); + } + + + // Now get all unique adjacent region pairs and store them such that + // the first vertex is always the smaller numbered of the edge + // We use a set because it doesn't keep duplicates + std::set> adj_region_pairs; + + int u = plan.num_regions - 1; + + // Iterate through the adjacency list of remainder region + // which is always the number of regions minus 1 + for(auto v: rg[u]){ + // store the edges such that smaller vertex is always first + if (u < v) { + adj_region_pairs.emplace(u, v); + } else { + adj_region_pairs.emplace(v, u); + } + } + + + double incremental_weight = 0.0; + bool do_pop_temper = (plan.num_regions < plan.N) && pop_temper > 0; + + // Now iterate over all adjacent pairs + for (const auto& edge : adj_region_pairs) { + // get log of boundary length between regions + double log_boundary = region_log_boundary(g, plan, edge.first, edge.second); + + // Do population tempering term if not final + double log_temper; + if(do_pop_temper){ + log_temper = compute_log_pop_temper( + plan, + edge.first, edge.second, + target, pop_temper + ); + }else{ + log_temper = 0; + } + + // multiply the boundary length and pop tempering by adding the logs + // now exponentiate and add to the sum + incremental_weight += std::exp(log_boundary + + log_temper); + } + + + // Check its not infinity + if(incremental_weight == -std::numeric_limits::infinity()){ + Rprintf("Error! weight is negative infinity for some reason \n"); + } + + + // now return the log of the inverse of the sum + return -std::log(incremental_weight); + +} diff --git a/src/gsmc_helpers.h b/src/gsmc_helpers.h index e0ab4bfae..72b839745 100644 --- a/src/gsmc_helpers.h +++ b/src/gsmc_helpers.h @@ -41,6 +41,11 @@ double compute_log_incremental_weight( const Graph &g, const Plan &plan, const double target, const double pop_temper); + +double compute_basic_smc_log_incremental_weight( + const Graph &g, const Plan &plan, + const double target, const double pop_temper); + Graph get_region_graph(const Graph &g, const Plan &plan); #endif From a002c5ba80e6908209c34810f161028c39efadb0 Mon Sep 17 00:00:00 2001 From: "Philip W. O'Sullivan" Date: Sun, 6 Oct 2024 20:34:16 -0400 Subject: [PATCH 016/324] added district counting functions --- NAMESPACE | 2 + R/diagnostics.R | 79 ++++++++++++++++++++++++++++++++--- R/redist_basic_smc.R | 5 +-- R/redist_smc.R | 28 ++++++++++++- R/region_counting.R | 83 +++++++++++++++++++++++++++++++++++++ man/get_k_step_ancestors.Rd | 24 +++++++++++ src/basic_smc.cpp | 27 ++++-------- src/gsmc_helpers.cpp | 49 +++++++++++++++------- src/smc.cpp | 51 +++++++++++++++++++++++ src/smc.h | 3 ++ 10 files changed, 305 insertions(+), 46 deletions(-) create mode 100644 R/region_counting.R create mode 100644 man/get_k_step_ancestors.Rd diff --git a/NAMESPACE b/NAMESPACE index f8a4e6228..be5e8f0de 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -86,7 +86,9 @@ export(distr_compactness) export(filter) export(freeze) export(get_adj) +export(get_district_count_df) export(get_existing) +export(get_k_step_ancestors) export(get_mh_acceptance_rate) export(get_plans_matrix) export(get_plans_weights) diff --git a/R/diagnostics.R b/R/diagnostics.R index 11ff49857..e045cbd38 100644 --- a/R/diagnostics.R +++ b/R/diagnostics.R @@ -147,7 +147,8 @@ summary.redist_plans <- function(object, district = 1L, all_runs = TRUE, vi_max accept_rate = c(diagn$accept_rate, NA), sd_log_wgt = diagn$sd_lp, max_unique = diagn$unique_survive, - est_k = c(diagn$est_k, NA)) + est_k = c(diagn$est_k, NA), + unique_original = c(diagn$nunique_original_ancestors, NA)) tbl_print <- as.data.frame(run_dfs[[i]]) min_n <- max(0.05*n_samp, min(0.4*n_samp, 100)) @@ -164,7 +165,7 @@ summary.redist_plans <- function(object, district = 1L, all_runs = TRUE, vi_max names(tbl_print) <- c("Eff. samples (%)", "Acc. rate", "Log wgt. sd", " Max. unique", - "Est. k", "") + "Est. k", "Unique Original Ancestors" , "") rownames(tbl_print) <- c(paste("Split", seq_len(nrow(tbl_print) - 1)), "Resample") if (i == 1 || isTRUE(all_runs)) { @@ -211,10 +212,15 @@ summary.redist_plans <- function(object, district = 1L, all_runs = TRUE, vi_max cli::cat_line(" ", cli::code_highlight(code, "Material")) } } else if(algo %in% c("gsmc", 'basic_smc')) { + if(algo == "gsmc"){ + algo_label <- "gSMC" + }else if(algo == "basic_smc"){ + algo_label <- "basicSMC" + } pop_lb <- attr(object, "pop_bounds")[1] pop_ub <- attr(object, "pop_bounds")[3] - cli_text("{.strong {algo}:} {fmt_comma(n_samp)} sampled plans of {n_distr} + cli_text("{.strong {algo_label}:} {fmt_comma(n_samp)} sampled plans of {n_distr} districts on {fmt_comma(nrow(plans_m))} units with a population between {fmt_comma(pop_lb)} and {fmt_comma(pop_ub)}") cli_text("{.arg pop_temper}={format(all_diagn[[1]]$pop_temper, digits=3)}") cat("\n") @@ -251,7 +257,7 @@ summary.redist_plans <- function(object, district = 1L, all_runs = TRUE, vi_max if (any(na.omit(rhats) >= 1.05)) { warn_converge <- TRUE - cli::cli_alert_danger("{.strong WARNING:} gSMC runs have not converged.") + cli::cli_alert_danger("{.strong WARNING:} {algo} runs have not converged.") } cat("\n") @@ -294,7 +300,7 @@ summary.redist_plans <- function(object, district = 1L, all_runs = TRUE, vi_max rownames(tbl_print) <- c(paste("Split", seq_len(nrow(tbl_print) - 1)), "Resample") if (i == 1 || isTRUE(all_runs)) { - cli_text("Sampling diagnostics for gSMC run {i} of {n_runs} ({fmt_comma(n_samp)} samples)") + cli_text("Sampling diagnostics for {algo_label} run {i} of {n_runs} ({fmt_comma(n_samp)} samples)") print(tbl_print, digits = 2) cat("\n") } @@ -318,7 +324,7 @@ summary.redist_plans <- function(object, district = 1L, all_runs = TRUE, vi_max {.arg pop_temper} by 0.01.") } if (warn_converge) { - cli::cli_li("{.strong gSMC convergence:} Increase the number of samples. + cli::cli_li("{.strong {algo_label} convergence:} Increase the number of samples. If you are experiencing low plan diversity or bottlenecks as well, address those issues first.") } @@ -446,3 +452,64 @@ diag_rhat <- function(x, grp, split = FALSE) { max(diag_calc_rhat(diag_ranknorm(x), grp), diag_calc_rhat(diag_ranknorm(diag_fold(x)), grp)) } + + + +#' Get k-step Ancestors of particles +#' +#' Tells you for a given index what its original ancestor was. +#' +#' @param parent_mat Ancestor matrix where entry [i,j] equals the index of the +#' parent of particle i after step j +#' @param steps_back How many steps back we should find the ancestors of (so +#' parents are 1 step ancestors). Defaults to going all the way back to the +#' original ancestors +#' @param start_col Which column to start at. Defaults to the last column +#' +#' @returns indices of k-step ancestors for particles at iteration `start_col` +#' @md +#' @export +get_k_step_ancestors <- function(parent_mat, steps_back = NULL, start_col = NULL){ + nparent_cols <- ncol(parent_mat) + + # if null then just start on final set of plans + if(is.null(start_col)){ + start_col <- nparent_cols + }else{ + # else assert starting column is between 1 and number of cols + assertthat::assert_that( + assertthat::is.scalar(start_col) && + start_col <= nparent_cols && + start_col > 1, + msg = sprintf("Error!\nInput start_col=`%s` is not valid. + Input must be a number between 1 and %d", + toString(start_col), nparent_cols) + ) + } + + # check steps back is between [1, nnparent_cols -1] + if(is.null(steps_back)){ + steps_back <- nparent_cols-2 + }else{ + assertthat::assert_that( + assertthat::is.scalar(steps_back) && + steps_back <= start_col-1 && + steps_back >= 1, + msg = sprintf( + "Error!\nInput steps_back=`%s` is not valid. +Input must be between 1 and the start_col value (you input %d)", + toString(steps_back), steps_back) + ) + } + + # vector where index i maps to the index of its ancestor + # initialize to this + ancestor <- 1:nrow(parent_mat) + + + # iterate through each step back we select the successive parent indices + for (j in start_col:(start_col - steps_back + 1)) { + ancestor <- parent_mat[ancestor, j] + } + return(ancestor) +} diff --git a/R/redist_basic_smc.R b/R/redist_basic_smc.R index e206695cb..4b5c0ea12 100644 --- a/R/redist_basic_smc.R +++ b/R/redist_basic_smc.R @@ -25,11 +25,10 @@ redist_basic_smc <- function(state_map, M, counties = NULL, k_params = 6, # no constraints constraints = list() - - # make controls intput + # make controls input lags <- 1 + unique(round((N - 1)^0.8*seq(0, 0.7, length.out = 4)^0.9)) - # check k param imput + # check k param input if(any(k_params < 1)){ cli_abort("K parameter values must be all at least 1.") } diff --git a/R/redist_smc.R b/R/redist_smc.R index 4d2b50caf..d8af272c3 100644 --- a/R/redist_smc.R +++ b/R/redist_smc.R @@ -273,6 +273,26 @@ redist_smc <- function(map, nsims, counties = NULL, compactness = 1, constraints cli::cli_process_done() } + + + # make original ancestor matrix + # add 1 for R indexing + algout$original_ancestors_mat <- matrix( + unlist(algout$original_ancestors), + ncol = length(algout$original_ancestors), + byrow = FALSE) + 1 + + + + # make parent mat into matrix + # add 1 for R indexing + algout$parent_index <- matrix( + unlist(algout$parent_index), + ncol = length(algout$parent_index), + byrow = FALSE) + 1 + + + lr <- -algout$lp wgt <- exp(lr - mean(lr)) n_eff <- length(wgt)*mean(wgt)^2/mean(wgt^2) @@ -325,6 +345,9 @@ redist_smc <- function(map, nsims, counties = NULL, compactness = 1, constraints algout$wgt <- wgt + nunique_original_ancestors <- algout$original_ancestors_mat |> + apply(2, function(x) length(unique(x))) + algout$l_diag <- list( n_eff = n_eff, step_n_eff = algout$step_n_eff, @@ -337,7 +360,10 @@ redist_smc <- function(map, nsims, counties = NULL, compactness = 1, constraints ancestors = algout$ancestors, seq_alpha = seq_alpha, pop_temper = pop_temper, - runtime = as.numeric(t2_run - t1_run, units = "secs") + runtime = as.numeric(t2_run - t1_run, units = "secs"), + parent_index_mat = algout$parent_index, + original_ancestors_mat = algout$original_ancestors_mat, + nunique_original_ancestors=nunique_original_ancestors ) algout diff --git a/R/region_counting.R b/R/region_counting.R new file mode 100644 index 000000000..e7f2822f4 --- /dev/null +++ b/R/region_counting.R @@ -0,0 +1,83 @@ +# Creates a hash map that counts the number of times a specific region appears +# in a matrix of plans or partial plans +get_region_counts <- function(plan_mat, N){ + # create hash map + region_count_map <- hash::hash() + + V <- nrow(plan_mat) + + # now iterate over each column + for (col_num in 1:ncol(plan_mat)) { + + # list mapping district number to precincts with district + district_list <- vector("list", length = N) + + # now check which district each vertex is in + for (vertex_num in 1:V) { + + district_id <- plan_mat[vertex_num, col_num] + # now add this vertex to the set of vertices associated with that + # district id + + # Check if + if(is.null(district_list[[district_id]])){ + district_list[[district_id]] <- c(vertex_num) + }else{ # else if already there just append + district_list[[district_id]] <- append( + district_list[[district_id]], vertex_num + ) + } + } + + # now add count of districts to hash map + for(district_vertices in district_list){ + # convert set of precincts to string + str_district_vertices <- toString(district_vertices) + # check if district already counted + if(hash::has.key(str_district_vertices, region_count_map)){ + region_count_map[[str_district_vertices]] <- region_count_map[[str_district_vertices]] + 1 + }else{ + region_count_map[[str_district_vertices]] <- 1 + } + } + } + + return(region_count_map) +} + + +get_region_count_df <- function(plan_mat, N){ + district_count_map <- get_region_counts(plan_mat, N) + + district_count_df <- data.frame( + district=names(hash::values(district_count_map, USE.NAMES=TRUE)), + d_count=hash::values(district_count_map, USE.NAMES=FALSE), + row.names=NULL + ) %>% + arrange(desc(d_count)) + + return(district_count_df) +} + +#' @export +get_district_count_df <- function(plans, chain_num){ + + district_count_map <- plans %>% + filter(chain == chain_num) %>% + as.matrix() %>% + get_region_counts(attr(plans, "ndist")) + + district_count_df <- data.frame( + district=names(hash::values(district_count_map, USE.NAMES=TRUE)), + d_count=hash::values(district_count_map, USE.NAMES=FALSE), + row.names=NULL + ) %>% + arrange(desc(d_count)) + + return(district_count_df) +} + + + + + diff --git a/man/get_k_step_ancestors.Rd b/man/get_k_step_ancestors.Rd new file mode 100644 index 000000000..1bd15c724 --- /dev/null +++ b/man/get_k_step_ancestors.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/diagnostics.R +\name{get_k_step_ancestors} +\alias{get_k_step_ancestors} +\title{Get k-step Ancestors of particles} +\usage{ +get_k_step_ancestors(parent_mat, steps_back = NULL, start_col = NULL) +} +\arguments{ +\item{parent_mat}{Ancestor matrix where entry \link{i,j} equals the index of the +parent of particle i after step j} + +\item{steps_back}{How many steps back we should find the ancestors of (so +parents are 1 step ancestors). Defaults to going all the way back to the +original ancestors} + +\item{start_col}{Which column to start at. Defaults to the last column} +} +\value{ +indices of k-step ancestors for particles at iteration \code{start_col} +} +\description{ +Tells you for a given index what its original ancestor was. +} diff --git a/src/basic_smc.cpp b/src/basic_smc.cpp index 2165aa672..269c17493 100644 --- a/src/basic_smc.cpp +++ b/src/basic_smc.cpp @@ -639,27 +639,14 @@ void get_log_basic_smc_weights( ){ int M = (int) plans_vec.size(); + // Parallel thread pool where all objects in memory shared by default + pool.parallelFor(0, M, [&] (int i) { + double log_incr_weight = compute_basic_smc_log_incremental_weight( + g, plans_vec.at(i), target, pop_temper); + log_incremental_weights[i] = log_incr_weight; + unnormalized_sampling_weights[i] = std::exp(log_incr_weight); + }); - int n = plans_vec.at(0).num_regions; - int N = plans_vec.at(0).N; - - // do basic smc weights unless N regions - if(n < N){ - // Parallel thread pool where all objects in memory shared by default - pool.parallelFor(0, M, [&] (int i) { - double log_incr_weight = compute_basic_smc_log_incremental_weight( - g, plans_vec.at(i), target, pop_temper); - log_incremental_weights[i] = log_incr_weight; - unnormalized_sampling_weights[i] = std::exp(log_incr_weight); - }); - }else{ - pool.parallelFor(0, M, [&] (int i) { - double log_incr_weight = compute_log_incremental_weight( - g, plans_vec.at(i), target, pop_temper); - log_incremental_weights[i] = log_incr_weight; - unnormalized_sampling_weights[i] = std::exp(log_incr_weight); - }); - } // Wait for all the threads to finish pool.wait(); diff --git a/src/gsmc_helpers.cpp b/src/gsmc_helpers.cpp index 85fd73896..775a03d12 100644 --- a/src/gsmc_helpers.cpp +++ b/src/gsmc_helpers.cpp @@ -442,26 +442,43 @@ double compute_basic_smc_log_incremental_weight( Rprintf("SOMETHING WENT WRONG IN COMPPUTE LOG INCREMENT WEIGHJT\n"); } + // We use a set to track edges because it doesn't keep duplicates + std::set> adj_region_pairs; - // Now get all unique adjacent region pairs and store them such that - // the first vertex is always the smaller numbered of the edge - // We use a set because it doesn't keep duplicates - std::set> adj_region_pairs; - - int u = plan.num_regions - 1; - - // Iterate through the adjacency list of remainder region - // which is always the number of regions minus 1 - for(auto v: rg[u]){ - // store the edges such that smaller vertex is always first - if (u < v) { - adj_region_pairs.emplace(u, v); - } else { - adj_region_pairs.emplace(v, u); - } + // If n < N just get adjacent to remainder + if(plan.num_regions < plan.N){ + // adjacent region always has id n-1 + int u = plan.num_regions - 1; + + // Iterate through the adjacency list of remainder region + // which is always the number of regions minus 1 + for(auto v: rg[u]){ + // store the edges such that smaller vertex is always first + if (u < v) { + adj_region_pairs.emplace(u, v); + } else { + adj_region_pairs.emplace(v, u); + } + } + }else{ // else get all adjacent districts + // Iterate through the adjacency list + // Now get all unique adjacent region pairs and store them such that + // the first vertex is always the smaller numbered of the edge + for (int u = 0; u < rg.size(); u++){ + // iterate over neighbors + for(auto v: rg[u]){ + // store the edges such that smaller vertex is always first + if (u < v) { + adj_region_pairs.emplace(u, v); + } else { + adj_region_pairs.emplace(v, u); + } + } + } } + double incremental_weight = 0.0; bool do_pop_temper = (plan.num_regions < plan.N) && pop_temper > 0; diff --git a/src/smc.cpp b/src/smc.cpp index 3e4876e76..fea6f41ed 100644 --- a/src/smc.cpp +++ b/src/smc.cpp @@ -100,13 +100,23 @@ List smc_plans(int N, List l, const uvec &counties, const uvec &pop, vec cum_wgt(N, fill::value(1.0 / N)); cum_wgt = cumsum(cum_wgt); + + // This is n_drawn by N where [i][j] is the index of the parent of particle j on step i + // ie the index of the previous plan that was sampled and used to create particle j on step i + std::vector> parent_index_mat(n_steps, std::vector (N, -1)); + + // This is n_drawn by N where [i][j] is the index of the original (first) ancestor of particle j on step i + std::vector> original_ancestor_mat(n_steps, std::vector (N, -1)); + RcppThread::ThreadPool pool(cores); std::string bar_fmt = "Split [{cli::pb_current}/{cli::pb_total}] {cli::pb_bar} | ETA{cli::pb_eta}"; RObject bar = cli_progress_bar(n_steps, cli_config(false, bar_fmt.c_str())); try { for (int ctr = n_drawn + 1; ctr <= n_drawn + n_steps; ctr++) { + int i_split = ctr - n_drawn - 1; + if (verbosity >= 3) { Rcout << "Making split " << ctr - n_drawn << " of " << n_steps; } @@ -126,12 +136,43 @@ List smc_plans(int N, List l, const uvec &counties, const uvec &pop, lower = target - (target - lower) * final_infl; upper = target + (upper - target) * final_infl; } + + + // For the first iteration we need to pass a special previous ancestor thing + if(i_split == 0){ + std::vector dummy_prev_ancestors(N, 1); + // split the map split_maps(g, counties, cg, pop, districts, cum_wgt, lp, pop_left, log_temper, pop_temper, accept_rate[i_split], n_distr, ctr, ancestors, lags, n_unique[i_split], + original_ancestor_mat.at(i_split), + parent_index_mat.at(i_split), + dummy_prev_ancestors, lower, upper, target, rho, cut_k[i_split], check_both, pool, verbosity); + + + // For the first ancestor one make every ancestor themselves + std::iota (parent_index_mat.at(0).begin(), parent_index_mat.at(0).end(), 0); + std::iota (original_ancestor_mat.at(0).begin(), original_ancestor_mat.at(0).end(), 0); + }else{ + // split the map and we can use the previous original ancestor matrix row + + split_maps(g, counties, cg, pop, districts, cum_wgt, lp, pop_left, + log_temper, pop_temper, accept_rate[i_split], + n_distr, ctr, ancestors, lags, n_unique[i_split], + original_ancestor_mat.at(i_split), + parent_index_mat.at(i_split), + original_ancestor_mat.at(i_split-1), + lower, upper, target, + rho, cut_k[i_split], check_both, pool, verbosity); + + + } + + + sd_lp[i_split] = stddev(lp); sd_temper[i_split] = stddev(log_temper); @@ -162,6 +203,8 @@ List smc_plans(int N, List l, const uvec &counties, const uvec &pop, } List out = List::create( + _["original_ancestors"] = original_ancestor_mat, + _["parent_index"] = parent_index_mat, _["plans"] = districts, _["lp"] = lp, _["ancestors"] = ancestors, @@ -339,6 +382,9 @@ void split_maps(const Graph &g, const uvec &counties, Multigraph &cg, vec &pop_left, vec &log_temper, double pop_temper, double &accept_rate, int n_distr, int dist_ctr, umat &ancestors, const std::vector &lags, int &n_unique, + std::vector &original_ancestor_vec, + std::vector &parent_vec, + const std::vector &prev_ancestor_vec, double lower, double upper, double target, double rho, int k, bool check_both, RcppThread::ThreadPool &pool, int verbosity) { @@ -398,6 +444,11 @@ void split_maps(const Graph &g, const uvec &counties, Multigraph &cg, ok = true; } + // update this particles ancestor to be the ancestor of its previous one + parent_vec[i] = idx; + original_ancestor_vec[i] = prev_ancestor_vec[idx]; + + uniques[i] = idx; clear_tree(ust); diff --git a/src/smc.h b/src/smc.h index 1757b6caf..1b5cb2391 100644 --- a/src/smc.h +++ b/src/smc.h @@ -40,6 +40,9 @@ void split_maps(const Graph &g, const uvec &counties, Multigraph &cg, vec &pop_left, vec &log_temper, double pop_temper, double &accept_rate, int n_distr, int dist_ctr, umat &ancestors, const std::vector &lags, int &n_unique, + std::vector &original_ancestor_vec, + std::vector &parent_vec, + const std::vector &prev_ancestor_vec, double lower, double upper, double target, double rho, int k, bool check_both, RcppThread::ThreadPool &pool, int verbosity); From d652bb2e736271740813392f28135277bb7f423f Mon Sep 17 00:00:00 2001 From: "Philip W. O'Sullivan" Date: Sat, 12 Oct 2024 16:08:36 -0400 Subject: [PATCH 017/324] basic smc no longer stores useless info --- R/redist_basic_smc.R | 13 ------------- R/region_counting.R | 6 +++--- src/basic_smc.cpp | 23 +---------------------- 3 files changed, 4 insertions(+), 38 deletions(-) diff --git a/R/redist_basic_smc.R b/R/redist_basic_smc.R index 4b5c0ea12..b0fed0095 100644 --- a/R/redist_basic_smc.R +++ b/R/redist_basic_smc.R @@ -168,11 +168,6 @@ redist_basic_smc <- function(state_map, M, counties = NULL, k_params = 6, function(x) matrix(unlist(x), ncol = length(x), byrow = FALSE) + 1 ) - # make each element of region_dvals_mat_list a V by M matrix - algout$region_dvals_mat_list <- lapply( - algout$region_dvals_mat_list, - function(x) matrix(unlist(x), ncol = length(x), byrow = FALSE) - ) # make original ancestor matrix # add 1 for R indexing @@ -223,10 +218,6 @@ redist_basic_smc <- function(state_map, M, counties = NULL, k_params = 6, # N-2 are previous results algout$plans <- algout$region_ids_mat_list[[N-1]] - algout$final_region_labs <- matrix( - unlist(algout$final_region_labs), - ncol = length(algout$final_region_labs), - byrow = FALSE) }else{ # Just add first element since not diagnostic mode the first N-2 @@ -235,8 +226,6 @@ redist_basic_smc <- function(state_map, M, counties = NULL, k_params = 6, # make the region_ids_mat_list input just null since there's nothing else algout$region_ids_mat_list <- NULL - algout$region_dvals_mat_list <- NULL - algout$final_region_labs <- NULL } if (any(is.na(lr))) { @@ -299,11 +288,9 @@ redist_basic_smc <- function(state_map, M, counties = NULL, k_params = 6, seq_alpha = .99, pop_temper = pop_temper, runtime = as.numeric(t2_run - t1_run, units = "secs"), - district_str_labels = algout$final_region_labs, nunique_original_ancestors = algout$nunique_original_ancestors, parent_index_mat = algout$parent_index, original_ancestors_mat = algout$original_ancestors_mat, - region_dvals_mat_list = algout$region_dvals_mat_list, log_incremental_weights_mat = algout$log_incremental_weights_mat, region_ids_mat_list = algout$region_ids_mat_list, draw_tries_mat = algout$draw_tries_mat, diff --git a/R/region_counting.R b/R/region_counting.R index e7f2822f4..4058d7d3d 100644 --- a/R/region_counting.R +++ b/R/region_counting.R @@ -1,6 +1,6 @@ # Creates a hash map that counts the number of times a specific region appears # in a matrix of plans or partial plans -get_region_counts <- function(plan_mat, N){ +get_region_count_map <- function(plan_mat, N){ # create hash map region_count_map <- hash::hash() @@ -47,7 +47,7 @@ get_region_counts <- function(plan_mat, N){ get_region_count_df <- function(plan_mat, N){ - district_count_map <- get_region_counts(plan_mat, N) + district_count_map <- get_region_count_map(plan_mat, N) district_count_df <- data.frame( district=names(hash::values(district_count_map, USE.NAMES=TRUE)), @@ -65,7 +65,7 @@ get_district_count_df <- function(plans, chain_num){ district_count_map <- plans %>% filter(chain == chain_num) %>% as.matrix() %>% - get_region_counts(attr(plans, "ndist")) + get_region_count_map(attr(plans, "ndist")) district_count_df <- data.frame( district=names(hash::values(district_count_map, USE.NAMES=TRUE)), diff --git a/src/basic_smc.cpp b/src/basic_smc.cpp index 269c17493..70e360154 100644 --- a/src/basic_smc.cpp +++ b/src/basic_smc.cpp @@ -769,8 +769,6 @@ List basic_smc_plans( // Declare variables whose size will depend on whether or not we're in // diagnostic mode or not std::vector>> plan_region_ids_mat; - std::vector>> plan_d_vals_mat; - std::vector> final_plan_region_labels; @@ -783,22 +781,7 @@ List basic_smc_plans( M, std::vector(V, -1) )); - // reserve space for N-1 elements - plan_d_vals_mat.reserve(N-1); - // This is N-2 by M by 1,2,...N where for each n=1,...,N-1, m=1,...,M it maps the region - // id to the region's d value. So for a given n it is n by M by n+1 - // It stops at N-2 because for N-1 its all 1 - for(int n = 1; n < N-1; n++){ - plan_d_vals_mat.push_back( - std::vector>(M, std::vector(n+1, -1)) - ); - } - - // M by N-1 where for each m=1,...M it maps region ids to region labels in a plan - final_plan_region_labels.resize( - M, std::vector(N, "MISSING") - ); }else{ // else only track for final round // Create info tracking we will pass out at the end @@ -898,16 +881,14 @@ List basic_smc_plans( // compute effective sample size n_eff.at(n) = compute_n_eff(log_incremental_weights_mat[n]); - // Now update the diagnostic info if needed, region labels, dval column of the matrix + // Now update the diagnostic info if needed if(diagnostic_mode && n == N-2){ // record if in diagnostic mode and final step for(int j=0; j Date: Mon, 14 Oct 2024 18:23:45 -0400 Subject: [PATCH 018/324] takes into account index changes for final resampling for ancestor related matrices --- R/redist_basic_smc.R | 33 ++++++++++++++++++++++++++++----- R/redist_gsmc.R | 40 +++++++++++++++++++++++++++++++++++----- 2 files changed, 63 insertions(+), 10 deletions(-) diff --git a/R/redist_basic_smc.R b/R/redist_basic_smc.R index b0fed0095..3ccea50bb 100644 --- a/R/redist_basic_smc.R +++ b/R/redist_basic_smc.R @@ -19,7 +19,9 @@ #' #' @export redist_basic_smc <- function(state_map, M, counties = NULL, k_params = 6, - resample = TRUE, runs = 1L, ncores = 0L, pop_temper = 0, + resample = TRUE, runs = 1L, + ncores = 0L, multiprocess=TRUE, + pop_temper = 0, verbose = FALSE, silent = FALSE, diagnostic_mode = FALSE){ N <- attr(state_map, "ndists") # no constraints @@ -111,8 +113,18 @@ redist_basic_smc <- function(state_map, M, counties = NULL, k_params = 6, } } + # if sequentially + if(!multiprocess){ + # either max cores if + if(ncores == 0){ + ncores_per = ncores_max + }else{ + ncores_per = ncores + } + } + - if (ncores_runs > 1) { + if (ncores_runs > 1 && multiprocess) { `%oper%` <- `%dorng%` of <- if (Sys.info()[["sysname"]] == "Windows") { tempfile(pattern = paste0("smc_", substr(Sys.time(), 1, 10)), fileext = ".txt") @@ -138,7 +150,7 @@ redist_basic_smc <- function(state_map, M, counties = NULL, k_params = 6, all_out <- foreach(chain = seq_len(runs), .inorder = FALSE, .packages="redist") %oper% { - run_verbosity <- if (chain == 1) verbosity else 0 + run_verbosity <- if (chain == 1 || !multiprocess) verbosity else 0 t1_run <- Sys.time() algout <- redist::basic_smc_plans( @@ -175,6 +187,7 @@ redist_basic_smc <- function(state_map, M, counties = NULL, k_params = 6, unlist(algout$original_ancestors), ncol = length(algout$original_ancestors), byrow = FALSE) + 1 + algout$original_ancestors <- NULL # make parent mat into matrix # add 1 for R indexing @@ -249,9 +262,18 @@ redist_basic_smc <- function(state_map, M, counties = NULL, k_params = 6, rs_idx <- resample_lowvar(normalized_wgts) n_unique <- dplyr::n_distinct(rs_idx) + # makes algout$plans[i] now equal to algout$plans[rs_idx[i]] algout$plans <- algout$plans[, rs_idx, drop = FALSE] - + # now adjust for the resampling algout$ancestors <- algout$ancestors[rs_idx, , drop = FALSE] + + # adjust for the resampling + # NOTE: IN FUTURE THIS SHOULD BE SEPERATED INTO FINAL SAMPLE INFO + algout$original_ancestors_mat <- algout$original_ancestors_mat[rs_idx, , drop = FALSE] + algout$parent_index <- algout$original_ancestors_mat[rs_idx, , drop = FALSE] + + + #TODO probably need to adjust the rest of these as well storage.mode(algout$ancestors) <- "integer" } @@ -295,7 +317,8 @@ redist_basic_smc <- function(state_map, M, counties = NULL, k_params = 6, region_ids_mat_list = algout$region_ids_mat_list, draw_tries_mat = algout$draw_tries_mat, parent_unsuccessful_tries_mat = algout$parent_unsuccessful_tries_mat, - parent_successful_tries_mat = parent_successful_tries_mat + parent_successful_tries_mat = parent_successful_tries_mat, + rs_idx = rs_idx ) algout diff --git a/R/redist_gsmc.R b/R/redist_gsmc.R index 57689dfc7..0762c7b26 100644 --- a/R/redist_gsmc.R +++ b/R/redist_gsmc.R @@ -11,13 +11,17 @@ #' @param k_params Either a single value to use as the splitting parameter for #' every round or a vector of length N-1 where each value is the one to use for #' a split. +#' @param multiprocess Whether or not to launch multiple processes (sometimes +#' better to disable to avoid using too much memory.) #' #' @return `redist_smc` returns a [redist_plans] object containing the simulated #' plans. #' #' @export redist_gsmc <- function(state_map, M, counties = NULL, k_params = 6, - resample = TRUE, runs = 1L, ncores = 0L, pop_temper = 0, + resample = TRUE, runs = 1L, + ncores = 0L, multiprocess=TRUE, + pop_temper = 0, verbose = FALSE, silent = FALSE, diagnostic_mode = FALSE){ N <- attr(state_map, "ndists") # no constraints @@ -110,8 +114,18 @@ redist_gsmc <- function(state_map, M, counties = NULL, k_params = 6, } } + # if sequentially + if(!multiprocess){ + # either max cores if + if(ncores == 0){ + ncores_per = ncores_max + }else{ + ncores_per = ncores + } + } + - if (ncores_runs > 1) { + if (ncores_runs > 1 && multiprocess) { `%oper%` <- `%dorng%` of <- if (Sys.info()[["sysname"]] == "Windows") { tempfile(pattern = paste0("smc_", substr(Sys.time(), 1, 10)), fileext = ".txt") @@ -137,7 +151,7 @@ redist_gsmc <- function(state_map, M, counties = NULL, k_params = 6, all_out <- foreach(chain = seq_len(runs), .inorder = FALSE, .packages="redist") %oper% { - run_verbosity <- if (chain == 1) verbosity else 0 + run_verbosity <- if (chain == 1 || !multiprocess) verbosity else 0 t1_run <- Sys.time() algout <- redist::gsmc_plans( @@ -179,6 +193,7 @@ redist_gsmc <- function(state_map, M, counties = NULL, k_params = 6, unlist(algout$original_ancestors), ncol = length(algout$original_ancestors), byrow = FALSE) + 1 + algout$original_ancestors <- NULL # make parent mat into matrix # add 1 for R indexing @@ -259,9 +274,23 @@ redist_gsmc <- function(state_map, M, counties = NULL, k_params = 6, rs_idx <- resample_lowvar(normalized_wgts) n_unique <- dplyr::n_distinct(rs_idx) + # makes algout$plans[i] now equal to algout$plans[rs_idx[i]] algout$plans <- algout$plans[, rs_idx, drop = FALSE] - + # now adjust for the resampling algout$ancestors <- algout$ancestors[rs_idx, , drop = FALSE] + + # adjust for the resampling + # NOTE: IN FUTURE THIS SHOULD BE SEPERATED INTO FINAL SAMPLE INFO + algout$original_ancestors_mat <- algout$original_ancestors_mat[rs_idx, , drop = FALSE] + algout$parent_index <- algout$original_ancestors_mat[rs_idx, , drop = FALSE] + + if(diagnostic_mode){ + # makes algout$final_region_labs[i] now equal to algout$final_region_labs[rs_idx[i]] + # to account for resampling + algout$final_region_labs[,rs_idx, drop = FALSE] + } + + #TODO probably need to adjust the rest of these as well storage.mode(algout$ancestors) <- "integer" } @@ -307,7 +336,8 @@ redist_gsmc <- function(state_map, M, counties = NULL, k_params = 6, region_ids_mat_list = algout$region_ids_mat_list, draw_tries_mat = algout$draw_tries_mat, parent_unsuccessful_tries_mat = algout$parent_unsuccessful_tries_mat, - parent_successful_tries_mat = parent_successful_tries_mat + parent_successful_tries_mat = parent_successful_tries_mat, + rs_idx = rs_idx ) algout From 26fba06e9cabac6c8ddade41ca788d4372e2128a Mon Sep 17 00:00:00 2001 From: "Philip W. O'Sullivan" Date: Tue, 15 Oct 2024 00:45:31 -0400 Subject: [PATCH 019/324] added task tracker document --- task_tracker.md | 47 +++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 47 insertions(+) create mode 100644 task_tracker.md diff --git a/task_tracker.md b/task_tracker.md new file mode 100644 index 000000000..c49adf46a --- /dev/null +++ b/task_tracker.md @@ -0,0 +1,47 @@ +# GENERAL INFORMATION + +The hope of this document is manage the list of tasks to do and also keep a record of what was done. + +# ---- IMPORTANT TO KEEP IN MIND ----- +Note all of the diagnostic information is accurately updated to account for a resampling. When the weights are really low variance it doesn't really matter but just take that with a grain of salt for everything. + + +# ----- ACTIVE TASKS ----- + +**Create More Internal Visualization/Examination Stuff** +Already created a new file, `splitting_inspection.cpp` to help with this but general idea is create code that allows someone in R to pass in a graph in adjacency list form (and potentially other stuff) and see things like the cut tree output by the splitting procedure or an internal region level graph. This will be helpful for making figures for the paper and also for deep level debugging/diagnostic things. + +**Deal with final sample vs diagnostics** +Need to more cleanly seperate diagnostic information from stuff in the final sample. This is because the resampling step if done changes things slightly and just re-indexing based on the final re-sample might destroy diagnostic information. + +**Try storing output as arma matrix instead of c++** +Instead of making vectors of vectors or vector of vectors of vectors try just making `arma::Matrix` instead. This should help with +optionally setting the storage size + +**Compress dval storage in `plan` object:** +- We don't actually need to store an `V` length vector of the dvals associated with each vertex. Instead all you need to do is keep a vector mapping region id values to the dvalue +- Change the attribute in `Plan` linking region id to d value from a `map` to just an array since the regions are already 0 indexed we don't need to bother with a map +- In the final output then the dval vectors don't need to be length `V` but instead just the number of regions + + +**For Previous tries track previous index not the current new particle** +- `draw_tries_vec` is the one. Make one that tracks the previous sampled index + + + +**Add optimal weights to current smc** +- `get_wgts` + +# ----- GENERAL THOUGHTS ----- + +- For trying to predict if something can never be split + - Sort population in order and see if gap is too large. This doesn't check every case but removes some + - Partition split problem + +# ----- COMPLETED TASKS ----- + +**Add population tempering - DONE 9/11/2024 ** +- Its the `log_temper` stuff right now. + - It can be added to every term except subtract from the final one + - Just create a seperate weights computation function and have it done in there + - Remember the value must be calculated for each of the three regions From 3dd1bc7f123c0aca769b96610194a0ecd25e3d17 Mon Sep 17 00:00:00 2001 From: "Philip W. O'Sullivan" Date: Tue, 15 Oct 2024 00:52:55 -0400 Subject: [PATCH 020/324] added new file for smc_withMCMC steps code --- R/RcppExports.R | 4 + src/RcppExports.cpp | 20 ++++ src/smc_and_mcmc.cpp | 242 +++++++++++++++++++++++++++++++++++++++++++ src/smc_and_mcmc.h | 32 ++++++ task_tracker.md | 1 + 5 files changed, 299 insertions(+) create mode 100644 src/smc_and_mcmc.cpp create mode 100644 src/smc_and_mcmc.h diff --git a/R/RcppExports.R b/R/RcppExports.R index dc46fed3b..ad63e73c6 100644 --- a/R/RcppExports.R +++ b/R/RcppExports.R @@ -266,6 +266,10 @@ swMH <- function(aList, cdvec, popvec, nsims, constraints, eprob, pct_dist_parit .Call(`_redist_swMH`, aList, cdvec, popvec, nsims, constraints, eprob, pct_dist_parity, beta_sequence, beta_weights, lambda, beta, adapt_beta, adjswap, exact_mh, adapt_eprob, adapt_lambda, num_hot_steps, num_annealing_steps, num_cold_steps, verbose) } +split_entire_map_once_new_cut_func <- function(N, adj_list, counties, pop, target, lower, upper, split_district_only, verbose) { + .Call(`_redist_split_entire_map_once_new_cut_func`, N, adj_list, counties, pop, target, lower, upper, split_district_only, verbose) +} + split_entire_map_once_basic_smc <- function(N, adj_list, counties, pop, target, lower, upper, verbose) { .Call(`_redist_split_entire_map_once_basic_smc`, N, adj_list, counties, pop, target, lower, upper, verbose) } diff --git a/src/RcppExports.cpp b/src/RcppExports.cpp index 46f875533..074f5d914 100644 --- a/src/RcppExports.cpp +++ b/src/RcppExports.cpp @@ -731,6 +731,25 @@ BEGIN_RCPP return rcpp_result_gen; END_RCPP } +// split_entire_map_once_new_cut_func +List split_entire_map_once_new_cut_func(int N, List adj_list, const arma::uvec& counties, const arma::uvec& pop, double target, double lower, double upper, bool split_district_only, bool verbose); +RcppExport SEXP _redist_split_entire_map_once_new_cut_func(SEXP NSEXP, SEXP adj_listSEXP, SEXP countiesSEXP, SEXP popSEXP, SEXP targetSEXP, SEXP lowerSEXP, SEXP upperSEXP, SEXP split_district_onlySEXP, SEXP verboseSEXP) { +BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< int >::type N(NSEXP); + Rcpp::traits::input_parameter< List >::type adj_list(adj_listSEXP); + Rcpp::traits::input_parameter< const arma::uvec& >::type counties(countiesSEXP); + Rcpp::traits::input_parameter< const arma::uvec& >::type pop(popSEXP); + Rcpp::traits::input_parameter< double >::type target(targetSEXP); + Rcpp::traits::input_parameter< double >::type lower(lowerSEXP); + Rcpp::traits::input_parameter< double >::type upper(upperSEXP); + Rcpp::traits::input_parameter< bool >::type split_district_only(split_district_onlySEXP); + Rcpp::traits::input_parameter< bool >::type verbose(verboseSEXP); + rcpp_result_gen = Rcpp::wrap(split_entire_map_once_new_cut_func(N, adj_list, counties, pop, target, lower, upper, split_district_only, verbose)); + return rcpp_result_gen; +END_RCPP +} // split_entire_map_once_basic_smc List split_entire_map_once_basic_smc(int N, List adj_list, const arma::uvec& counties, const arma::uvec& pop, double target, double lower, double upper, bool verbose); RcppExport SEXP _redist_split_entire_map_once_basic_smc(SEXP NSEXP, SEXP adj_listSEXP, SEXP countiesSEXP, SEXP popSEXP, SEXP targetSEXP, SEXP lowerSEXP, SEXP upperSEXP, SEXP verboseSEXP) { @@ -863,6 +882,7 @@ static const R_CallMethodDef CallEntries[] = { {"_redist_splits", (DL_FUNC) &_redist_splits, 4}, {"_redist_dist_cty_splits", (DL_FUNC) &_redist_dist_cty_splits, 3}, {"_redist_swMH", (DL_FUNC) &_redist_swMH, 20}, + {"_redist_split_entire_map_once_new_cut_func", (DL_FUNC) &_redist_split_entire_map_once_new_cut_func, 9}, {"_redist_split_entire_map_once_basic_smc", (DL_FUNC) &_redist_split_entire_map_once_basic_smc, 8}, {"_redist_basic_smc_split_all_the_way", (DL_FUNC) &_redist_basic_smc_split_all_the_way, 8}, {"_redist_tree_pop", (DL_FUNC) &_redist_tree_pop, 5}, diff --git a/src/smc_and_mcmc.cpp b/src/smc_and_mcmc.cpp new file mode 100644 index 000000000..20818a0fd --- /dev/null +++ b/src/smc_and_mcmc.cpp @@ -0,0 +1,242 @@ +/******************************************************** +* Author: Philip O'Sullivan' +* Institution: Harvard University +* Date Created: 2024/10 +* Purpose: Run SMC with MCMC merge-split steps mixed in +********************************************************/ + +#include "smc_and_mcmc.h" + + +//' Attempts to cut one region into two from a spanning tree and if successful +//' returns information on what the two new regions would be. Does not actually +//' update the plan +//' +//' Takes a spanning tree `ust` drawn on a specific region and attempts to cut +//' it to produce two new regions using the generalized splitting procedure +//' outlined . This function is based on `cut_districts` in `smc.cpp` +//' however the crucial difference is even if a cut is successful it does not +//' update the plan. Instead it just returns the information on the two new +//' regions if successful and the vertices to use to update the plans. +//' +//' Depending on the value of split_district_only will only attempt to split off +//' a single district or allows for more general splits. +//' +//' By convention the first new region (`new_region1`) will always be the region +//' with the smaller d-value (although they can be equal). +//' +//' @title Attempt to Cut Region Tree into Two New Regions +//' +//' @param ust A directed spanning tree passed by reference +//' @param root The root vertex of the spanning tree +//' @param k_param The k parameter from the SMC algorithm, you choose among the top k_param edges +//' @param split_district_only If true then only tries to split a district, if false allows for +//' arbitrary region splits +//' @param pop A vector of the population associated with each vertex in `g` +//' @param plan A plan object +//' @param region_id_to_split The id of the region in the plan object we're attempting to split +//' @param lower Acceptable lower bounds on a valid district's population +//' @param upper Acceptable upper bounds on a valid district's population +//' @param target Ideal population of a valid district. This is what deviance is calculated +//' relative to +//' @param new_region1_tree_root The index of the root of tree associated with +//' the first new region (if the tree cut was successful) +//' @param new_region1_dval The d-value of the first new region (if the tree cut +//' was successful) +//' @param new_region1_pop The population of the first new region (if the tree cut +//' was successful) +//' @param new_region2_tree_root The index of the root of tree associated with +//' the second new region (if the tree cut was successful) +//' @param new_region2_dval The d-value of the second new region (if the tree cut +//' was successful) +//' @param new_region2_pop The population of the second new region (if the tree cut +//' was successful) +//' +//' @details Modifications +//' - If two new valid regions are split then the tree `ust` is cut into two +//' distjoint pieces +//' - If two new valid regions are split then the 6 `new_region` inputs are all +//' updated by reference with the values associated with the new regions +//' +//' @return True if two valid regions were successfully split, false otherwise +//' +//' +//' +bool get_edge_to_cut(Tree &ust, int root, + int k_param, bool split_district_only, + const uvec &pop, const Plan &plan, const int region_id_to_split, + const double lower, const double upper, const double target, + int &new_region1_tree_root, int &new_region1_dval, double &new_region1_pop, + int &new_region2_tree_root, int &new_region2_dval, double &new_region2_pop + ){ + // Get population of region being split + double total_pop = plan.region_pops.at(region_id_to_split); + + // Get the number of final districts in region being split + int num_final_districts = plan.region_dvals.at(region_id_to_split); + + // Get the largest possible d value we can try + int max_potential_d; + + if(split_district_only){ + // if only splitting districts its just 1 bc then it will only try + // a potential d of 1 later on + max_potential_d = 1; + }else{ + // if arbitrary splits then d value of region minus 1 + max_potential_d = num_final_districts - 1; + } + + // Rcout << "For " << region_id_to_split << " Total pop is " << total_pop << " and d_nk is " << num_final_districts << "\n"; + + // create list that points to parents & computes population below each vtx + std::vector pop_below(plan.V, 0); + std::vector parent(plan.V); + parent[root] = -1; + tree_pop(ust, root, pop, pop_below, parent); + + // compile a list of: things for each edge in tree + std::vector candidates; // candidate edges to cut, + std::vector deviances; // how far from target pop. + std::vector is_ok; // whether they meet constraints + std::vector new_d_val; // the new d_n,k value + + // Reserve at least as much space for top k_param of them + candidates.reserve(k_param); + deviances.reserve(k_param); + is_ok.reserve(k_param); + new_d_val.reserve(k_param); + + if(plan.region_num_ids.at(root) != region_id_to_split){ + Rcout << "Root vertex is not in region to split!"; + } + + // Now loop over all valid edges to cut + for (int i = 1; i <= plan.V; i++) { // 1-indexing here + // Ignore any vertex not in this region or the root vertex as we wont be cutting those + if (plan.region_num_ids.at(i-1) != region_id_to_split || i - 1 == root) continue; + + // Get the population of one side of the partition removing that edge would cause + double below = pop_below.at(i - 1); + // Get the population of the other side + double above = total_pop - below; + + // vectors to keep track of value for each d_{n,k} + std::vector devs(max_potential_d); + std::vector dev2_bigger(max_potential_d); + std::vector are_ok(max_potential_d); + + + // Now try each potential d_nk value from 1 up to d_n-1,k -1 + // remember to correct for 0 indexing + for(int potential_d = 1; potential_d <= max_potential_d; potential_d++){ + + double dev1 = std::fabs(below - target * potential_d); + double dev2 = std::fabs(above - target * potential_d); + + // If dev1 is smaller then we assign d_nk to below + if (dev1 < dev2) { + devs[potential_d-1] = dev1; + dev2_bigger[potential_d-1] = true; + // check in bounds + are_ok[potential_d-1] = lower * potential_d <= below + && below <= upper * potential_d + && lower * (num_final_districts - potential_d) <= above + && above <= upper * (num_final_districts - potential_d); + } else { // Else if dev2 is smaller we assign d_nk to above + devs[potential_d-1] = dev2; + dev2_bigger[potential_d-1] = false; + are_ok[potential_d-1] = lower * potential_d <= above + && above <= upper * potential_d + && lower * (num_final_districts - potential_d) <= below + && below <= upper * (num_final_districts - potential_d); + } + + } + + // Now find the value of d_{n,k} that has the smallest deviation + std::vector::iterator result = std::min_element(devs.begin(), devs.end()); + int best_potential_d = std::distance(devs.begin(), result); + + /* + Rcout << "min element has value " << *result << " and index [" + << best_potential_d << "]\n"; + */ + + if(dev2_bigger[best_potential_d]){ + candidates.push_back(i); + } else{ + candidates.push_back(-i); + } + + deviances.push_back(devs[best_potential_d]); + is_ok.push_back(are_ok[best_potential_d]); + new_d_val.push_back(best_potential_d+1); + + } + + + // if less than k_param candidates immediately reject + if((int) candidates.size() < k_param){ + return false; + } + + int idx = r_int(k_param); + idx = select_k(deviances, idx + 1); + int cut_at = std::fabs(candidates[idx]) - 1; + + + // reject sample if not ok + if (!is_ok[idx]){ + return false; + } + + + // find index of node to cut at + std::vector *siblings = &ust[parent[cut_at]]; + int length = siblings->size(); + int j; + for (j = 0; j < length; j++) { + if ((*siblings)[j] == cut_at) break; + } + + // remove edge from tree + siblings->erase(siblings->begin()+j); + parent[cut_at] = -1; + + // Get dval for two new regions + new_region1_dval = new_d_val[idx]; + new_region2_dval = num_final_districts - new_region1_dval; + + + + if (candidates[idx] > 0) { // Means cut below so first vertex is cut_at + new_region1_tree_root = cut_at; + new_region2_tree_root = root; + + // Set the new populations + new_region1_pop = pop_below.at(cut_at); + new_region2_pop = total_pop - new_region1_pop; + + // return pop_below.at(cut_at); + } else { // Means cut above so first vertex is root + new_region1_tree_root = root; + new_region2_tree_root = cut_at; + + // Set the new populations + new_region2_pop = pop_below.at(cut_at); + new_region1_pop = total_pop - new_region2_pop; + + } + + // Now make it so that the first region is always the smallest + // So if the dval of region 1 is bigger swap the two + if(new_region1_dval > new_region2_dval){ + std::swap(new_region1_dval, new_region2_dval); + std::swap(new_region1_pop, new_region2_pop); + std::swap(new_region1_tree_root, new_region2_tree_root); + } + + return true; + +}; diff --git a/src/smc_and_mcmc.h b/src/smc_and_mcmc.h new file mode 100644 index 000000000..82cbf3546 --- /dev/null +++ b/src/smc_and_mcmc.h @@ -0,0 +1,32 @@ +#pragma once +#ifndef SMC_AND_MCMC_H +#define SMC_AND_MCMC_H + +// [[Rcpp::depends(redistmetrics)]] + +#include "smc_base.h" + +#include +#include +#include +#include +#include +#include + +#include +#include "wilson.h" +#include "tree_op.h" +#include "map_calc.h" +#include "redist_types.h" +#include "gsmc_helpers.h" + +bool get_edge_to_cut(Tree &ust, int root, + int k_param, bool split_district_only, + const uvec &pop, const Plan &plan, const int region_id_to_split, + const double lower, const double upper, const double target, + int &new_region1_tree_root, int &new_region1_dval, double &new_region1_pop, + int &new_region2_tree_root, int &new_region2_dval, double &new_region2_pop +); + + +#endif diff --git a/task_tracker.md b/task_tracker.md index c49adf46a..40a461d64 100644 --- a/task_tracker.md +++ b/task_tracker.md @@ -8,6 +8,7 @@ Note all of the diagnostic information is accurately updated to account for a re # ----- ACTIVE TASKS ----- + **Create More Internal Visualization/Examination Stuff** Already created a new file, `splitting_inspection.cpp` to help with this but general idea is create code that allows someone in R to pass in a graph in adjacency list form (and potentially other stuff) and see things like the cut tree output by the splitting procedure or an internal region level graph. This will be helpful for making figures for the paper and also for deep level debugging/diagnostic things. From 0d2c678b5252ae09928e78f348bbaca1d9c44627 Mon Sep 17 00:00:00 2001 From: "Philip W. O'Sullivan" Date: Tue, 15 Oct 2024 01:05:50 -0400 Subject: [PATCH 021/324] updated task tracking doc --- task_tracker.md | 24 ++++++++++++++---------- 1 file changed, 14 insertions(+), 10 deletions(-) diff --git a/task_tracker.md b/task_tracker.md index 40a461d64..65ee47a4c 100644 --- a/task_tracker.md +++ b/task_tracker.md @@ -8,6 +8,14 @@ Note all of the diagnostic information is accurately updated to account for a re # ----- ACTIVE TASKS ----- +**Create Separate Updating Function** +Create a function which takes a cut tree and information on the new regions and updates them. Previously this was in the `cut_regions` function but it has now been seperated out since sometimes for the MCMC step we want to know what a cut region would look like but don't neccesarily always want to actually change it. + +**Create Diagnostics Object for cpp code** +To avoid needing to pass so many different parameters in the function header consider creating a new diagnostic class in cpp which serves as a wrapper for all the diagnostic things that are collected in the `split_maps` function. + +**Rewrite gsmc and basic_smc ** +Use the code from the new `smc_and_mcmc.cpp` file to rewrite the gsmc and basic_smc stuff. It should be possible to make one version of most of the functions and just have a single input control whether or not it just splits districts. This should cut down on the code and eliminate the big redundancy problem. **Create More Internal Visualization/Examination Stuff** Already created a new file, `splitting_inspection.cpp` to help with this but general idea is create code that allows someone in R to pass in a graph in adjacency list form (and potentially other stuff) and see things like the cut tree output by the splitting procedure or an internal region level graph. This will be helpful for making figures for the paper and also for deep level debugging/diagnostic things. @@ -15,14 +23,7 @@ Already created a new file, `splitting_inspection.cpp` to help with this but gen **Deal with final sample vs diagnostics** Need to more cleanly seperate diagnostic information from stuff in the final sample. This is because the resampling step if done changes things slightly and just re-indexing based on the final re-sample might destroy diagnostic information. -**Try storing output as arma matrix instead of c++** -Instead of making vectors of vectors or vector of vectors of vectors try just making `arma::Matrix` instead. This should help with -optionally setting the storage size -**Compress dval storage in `plan` object:** -- We don't actually need to store an `V` length vector of the dvals associated with each vertex. Instead all you need to do is keep a vector mapping region id values to the dvalue -- Change the attribute in `Plan` linking region id to d value from a `map` to just an array since the regions are already 0 indexed we don't need to bother with a map -- In the final output then the dval vectors don't need to be length `V` but instead just the number of regions **For Previous tries track previous index not the current new particle** @@ -30,9 +31,6 @@ optionally setting the storage size -**Add optimal weights to current smc** -- `get_wgts` - # ----- GENERAL THOUGHTS ----- - For trying to predict if something can never be split @@ -41,6 +39,12 @@ optionally setting the storage size # ----- COMPLETED TASKS ----- +**Compress dval storage in `plan` object - DONE FORGOT TO RECORD DATE** +- We don't actually need to store an `V` length vector of the dvals associated with each vertex. Instead all you need to do is keep a vector mapping region id values to the dvalue +- Change the attribute in `Plan` linking region id to d value from a `map` to just an array since the regions are already 0 indexed we don't need to bother with a map +- In the final output then the dval vectors don't need to be length `V` but instead just the number of regions + + **Add population tempering - DONE 9/11/2024 ** - Its the `log_temper` stuff right now. - It can be added to every term except subtract from the final one From a30e4ecc43315092cdfc3e16d969a50cdee77851 Mon Sep 17 00:00:00 2001 From: "Philip W. O'Sullivan" Date: Tue, 15 Oct 2024 20:46:13 -0400 Subject: [PATCH 022/324] created and tested seperate plan update function and added code to expose splitting actions to R --- R/RcppExports.R | 4 + src/RcppExports.cpp | 27 ++++ src/redist_types.cpp | 7 +- src/smc_and_mcmc.cpp | 74 +++++++++++ src/smc_and_mcmc.h | 8 ++ src/splitting_inspection.cpp | 245 +++++++++++++++++++++++++++++++++++ src/splitting_inspection.h | 34 +++++ 7 files changed, 396 insertions(+), 3 deletions(-) create mode 100644 src/splitting_inspection.cpp create mode 100644 src/splitting_inspection.h diff --git a/R/RcppExports.R b/R/RcppExports.R index ad63e73c6..10e9c3d76 100644 --- a/R/RcppExports.R +++ b/R/RcppExports.R @@ -262,6 +262,10 @@ dist_cty_splits <- function(dm, community, nd) { .Call(`_redist_dist_cty_splits`, dm, community, nd) } +perform_a_valid_region_split <- function(adj_list, counties, pop, k_param, region_id_to_split, target, lower, upper, N, num_regions, num_districts, region_ids, region_dvals, region_pops, split_district_only, verbose) { + .Call(`_redist_perform_a_valid_region_split`, adj_list, counties, pop, k_param, region_id_to_split, target, lower, upper, N, num_regions, num_districts, region_ids, region_dvals, region_pops, split_district_only, verbose) +} + swMH <- function(aList, cdvec, popvec, nsims, constraints, eprob, pct_dist_parity, beta_sequence, beta_weights, lambda = 0L, beta = 0.0, adapt_beta = "none", adjswap = 1L, exact_mh = 0L, adapt_eprob = 0L, adapt_lambda = 0L, num_hot_steps = 0L, num_annealing_steps = 0L, num_cold_steps = 0L, verbose = TRUE) { .Call(`_redist_swMH`, aList, cdvec, popvec, nsims, constraints, eprob, pct_dist_parity, beta_sequence, beta_weights, lambda, beta, adapt_beta, adjswap, exact_mh, adapt_eprob, adapt_lambda, num_hot_steps, num_annealing_steps, num_cold_steps, verbose) } diff --git a/src/RcppExports.cpp b/src/RcppExports.cpp index 074f5d914..9b40a98ee 100644 --- a/src/RcppExports.cpp +++ b/src/RcppExports.cpp @@ -701,6 +701,32 @@ BEGIN_RCPP return rcpp_result_gen; END_RCPP } +// perform_a_valid_region_split +List perform_a_valid_region_split(List adj_list, const arma::uvec& counties, const arma::uvec& pop, int k_param, int region_id_to_split, double target, double lower, double upper, int N, int num_regions, int num_districts, std::vector region_ids, std::vector region_dvals, std::vector region_pops, bool split_district_only, bool verbose); +RcppExport SEXP _redist_perform_a_valid_region_split(SEXP adj_listSEXP, SEXP countiesSEXP, SEXP popSEXP, SEXP k_paramSEXP, SEXP region_id_to_splitSEXP, SEXP targetSEXP, SEXP lowerSEXP, SEXP upperSEXP, SEXP NSEXP, SEXP num_regionsSEXP, SEXP num_districtsSEXP, SEXP region_idsSEXP, SEXP region_dvalsSEXP, SEXP region_popsSEXP, SEXP split_district_onlySEXP, SEXP verboseSEXP) { +BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< List >::type adj_list(adj_listSEXP); + Rcpp::traits::input_parameter< const arma::uvec& >::type counties(countiesSEXP); + Rcpp::traits::input_parameter< const arma::uvec& >::type pop(popSEXP); + Rcpp::traits::input_parameter< int >::type k_param(k_paramSEXP); + Rcpp::traits::input_parameter< int >::type region_id_to_split(region_id_to_splitSEXP); + Rcpp::traits::input_parameter< double >::type target(targetSEXP); + Rcpp::traits::input_parameter< double >::type lower(lowerSEXP); + Rcpp::traits::input_parameter< double >::type upper(upperSEXP); + Rcpp::traits::input_parameter< int >::type N(NSEXP); + Rcpp::traits::input_parameter< int >::type num_regions(num_regionsSEXP); + Rcpp::traits::input_parameter< int >::type num_districts(num_districtsSEXP); + Rcpp::traits::input_parameter< std::vector >::type region_ids(region_idsSEXP); + Rcpp::traits::input_parameter< std::vector >::type region_dvals(region_dvalsSEXP); + Rcpp::traits::input_parameter< std::vector >::type region_pops(region_popsSEXP); + Rcpp::traits::input_parameter< bool >::type split_district_only(split_district_onlySEXP); + Rcpp::traits::input_parameter< bool >::type verbose(verboseSEXP); + rcpp_result_gen = Rcpp::wrap(perform_a_valid_region_split(adj_list, counties, pop, k_param, region_id_to_split, target, lower, upper, N, num_regions, num_districts, region_ids, region_dvals, region_pops, split_district_only, verbose)); + return rcpp_result_gen; +END_RCPP +} // swMH List swMH(List aList, NumericVector cdvec, NumericVector popvec, int nsims, List constraints, double eprob, double pct_dist_parity, NumericVector beta_sequence, NumericVector beta_weights, int lambda, double beta, std::string adapt_beta, int adjswap, int exact_mh, int adapt_eprob, int adapt_lambda, int num_hot_steps, int num_annealing_steps, int num_cold_steps, bool verbose); RcppExport SEXP _redist_swMH(SEXP aListSEXP, SEXP cdvecSEXP, SEXP popvecSEXP, SEXP nsimsSEXP, SEXP constraintsSEXP, SEXP eprobSEXP, SEXP pct_dist_paritySEXP, SEXP beta_sequenceSEXP, SEXP beta_weightsSEXP, SEXP lambdaSEXP, SEXP betaSEXP, SEXP adapt_betaSEXP, SEXP adjswapSEXP, SEXP exact_mhSEXP, SEXP adapt_eprobSEXP, SEXP adapt_lambdaSEXP, SEXP num_hot_stepsSEXP, SEXP num_annealing_stepsSEXP, SEXP num_cold_stepsSEXP, SEXP verboseSEXP) { @@ -881,6 +907,7 @@ static const R_CallMethodDef CallEntries[] = { {"_redist_smc_plans", (DL_FUNC) &_redist_smc_plans, 15}, {"_redist_splits", (DL_FUNC) &_redist_splits, 4}, {"_redist_dist_cty_splits", (DL_FUNC) &_redist_dist_cty_splits, 3}, + {"_redist_perform_a_valid_region_split", (DL_FUNC) &_redist_perform_a_valid_region_split, 16}, {"_redist_swMH", (DL_FUNC) &_redist_swMH, 20}, {"_redist_split_entire_map_once_new_cut_func", (DL_FUNC) &_redist_split_entire_map_once_new_cut_func, 9}, {"_redist_split_entire_map_once_basic_smc", (DL_FUNC) &_redist_split_entire_map_once_basic_smc, 8}, diff --git a/src/redist_types.cpp b/src/redist_types.cpp index 5861bd930..d7df73fe9 100644 --- a/src/redist_types.cpp +++ b/src/redist_types.cpp @@ -41,13 +41,14 @@ Plan::Plan(int V, int N, double total_map_pop){ // Prints our object using Rcout. Should be used in Rcpp call void Plan::Rprint() const{ RcppThread::Rcout << "Plan with " << num_regions << " regions, " << num_districts - << " districts and "<< V << " Vertices.\n["; + << " districts, " << num_multidistricts << " multidistricts and " + << V << " Vertices.\n["; RcppThread::Rcout << "Region Level Values:"; for(int region_id = 0; region_id < num_regions; region_id++){ - RcppThread::Rcout << "(" << region_str_labels.at(region_id) << " aka " << region_id << " also " << - ", " << region_dvals.at(region_id) << ", " << region_pops.at(region_id) <<" ), "; + RcppThread::Rcout << "(" << region_str_labels.at(region_id) << " aka " << region_id << + ", dval=" << region_dvals.at(region_id) << ", " << region_pops.at(region_id) <<" ), "; } RcppThread::Rcout << "\n"; // diff --git a/src/smc_and_mcmc.cpp b/src/smc_and_mcmc.cpp index 20818a0fd..271b1d860 100644 --- a/src/smc_and_mcmc.cpp +++ b/src/smc_and_mcmc.cpp @@ -240,3 +240,77 @@ bool get_edge_to_cut(Tree &ust, int root, return true; }; + + + + +void update_plan_from_cut( + Tree &ust, Plan &plan, + const int old_region_id, + const int new_region1_tree_root, const int new_region1_dval, const double new_region1_pop, + const int new_region2_tree_root, const int new_region2_dval, const double new_region2_pop, + int &new_region1_id, int &new_region2_id +){ + + // update plan with new regions + plan.num_regions++; // increase region count by 1 + plan.num_multidistricts--; // Decrease by one to avoid double counting later + + // Create info for two new districts + std::string new_region_label1; + std::string new_region_label2; + + std::string region_to_split = plan.region_str_labels.at(old_region_id); + + // Set label and count depending on if district or multi district + if(new_region1_dval == 1){ + plan.num_districts++; + // if district then string label just adds district number + new_region_label1 = region_to_split + "." + std::to_string(plan.num_districts); + }else{ + plan.num_multidistricts++; + // if region then just add current region number + new_region_label1 = region_to_split + ".R" + std::to_string(old_region_id); + } + + // Now do it for second region + if(new_region2_dval == 1){ + plan.num_districts++; + // if district then string label just adds district number + new_region_label2 = region_to_split + "." + std::to_string(plan.num_districts); + }else{ + plan.num_multidistricts++; + // if region then just add current region number + new_region_label2 = region_to_split + ".R" + std::to_string(plan.num_regions - 1); + } + + // TODO: Figure out how to do this to preserve the order districts were added + + // make the first new region have the same integer id + new_region1_id = old_region_id; + // Second new region has id of the new number of regions minus 1 + new_region2_id = plan.num_regions - 1; + + + // Now update the two cut portions + assign_region(ust, plan, new_region1_tree_root, new_region1_id); + assign_region(ust, plan, new_region2_tree_root, new_region2_id); + + // Now update the region level information + + // Add the new region 1 + // New region 1 has the same id number as old region so update that + plan.region_dvals.at(new_region1_id) = new_region1_dval; + plan.region_str_labels.at(new_region1_id) = new_region_label1; + plan.region_pops.at(new_region1_id) = new_region1_pop; + + // Add the new region 2 + // New region 2's id is the highest id number so push back + plan.region_dvals.push_back(new_region2_dval); + plan.region_str_labels.push_back(new_region_label2); + plan.region_pops.push_back(new_region2_pop); + + // done + return; + +}; diff --git a/src/smc_and_mcmc.h b/src/smc_and_mcmc.h index 82cbf3546..bd32e919d 100644 --- a/src/smc_and_mcmc.h +++ b/src/smc_and_mcmc.h @@ -29,4 +29,12 @@ bool get_edge_to_cut(Tree &ust, int root, ); +void update_plan_from_cut( + Tree &ust, Plan &plan, + const int old_region_id, + const int new_region1_tree_root, const int new_region1_dval, const double new_region1_pop, + const int new_region2_tree_root, const int new_region2_dval, const double new_region2_pop, + int &new_region1_id, int &new_region2_id +); + #endif diff --git a/src/splitting_inspection.cpp b/src/splitting_inspection.cpp new file mode 100644 index 000000000..574c9589c --- /dev/null +++ b/src/splitting_inspection.cpp @@ -0,0 +1,245 @@ +/******************************************************** +* Author: Philip O'Sullivan' +* Institution: Harvard University +* Date Created: 2024/10 +* Purpose: Exposes various aspects of the splitting procedure +* to R to allow for inspection for diagnostic purposes. +********************************************************/ + +#include "splitting_inspection.h" + + + +List perform_a_valid_region_split( + List adj_list, const arma::uvec &counties, const arma::uvec &pop, + int k_param, int region_id_to_split, + double target, double lower, double upper, + int N, int num_regions, int num_districts, + std::vector region_ids, std::vector region_dvals, + std::vector region_pops, + bool split_district_only, bool verbose +){ + // unpack control params + Graph g = list_to_graph(adj_list); + Multigraph cg = county_graph(g, counties); + int V = g.size(); + double total_pop = sum(pop); + + // Create a plan object + Plan plan = Plan(V, N, total_pop); + + // fill in the plan + plan.num_regions = num_regions; + plan.num_districts = num_districts; + plan.num_multidistricts = plan.num_regions - plan.num_districts; + plan.region_num_ids = region_ids; + plan.region_dvals = region_dvals; + plan.region_pops = region_pops; + // Need to fix string labels + plan.region_str_labels = std::vector(plan.num_regions, "IGNORE"); + + if(verbose){ + plan.Rprint(); + } + + // Create tree related stuff + int root; + Tree ust = init_tree(V); + Tree pre_split_ust = init_tree(V); + std::vector visited(V); + std::vector ignore(V, false); + + + // Mark it as ignore if its not in the region to split + for (int i = 0; i < V; i++){ + ignore[i] = plan.region_num_ids.at(i) != region_id_to_split; + } + + + + // Counts the number of split attempts + bool successful_split_made = false; + int try_counter {0}; + + + // splitting related params + int new_region1_tree_root, new_region2_tree_root; + int new_region1_dval, new_region2_dval; + double new_region1_pop, new_region2_pop; + + // Keep running until done + while(!successful_split_made){ + clear_tree(ust); + // Get a tree + int result = sample_sub_ust(g, ust, V, root, visited, ignore, pop, lower, upper, counties, cg); + // Return unsuccessful if tree not drawn + if (result != 0){ + try_counter++; + continue; + } + + // copy uncut tree + pre_split_ust = ust; + + // Try to make a cut + successful_split_made = get_edge_to_cut(ust, root, + k_param, split_district_only, pop, + plan, region_id_to_split, + lower, upper, target, + new_region1_tree_root, new_region1_dval, new_region1_pop, + new_region2_tree_root, new_region2_dval, new_region2_pop); + try_counter++; + // increase the counter by 1 + if(verbose && false){ + Rcout << "Attempt " << try_counter << "\n"; + } + + } + + + if(verbose){ + plan.Rprint(); + } + + // update + // TODO: make this optional + int new_region1_id, new_region2_id; + + update_plan_from_cut( + ust, plan, + region_id_to_split, + new_region1_tree_root, new_region1_dval, new_region1_pop, + new_region2_tree_root, new_region2_dval, new_region2_pop, + new_region1_id, new_region2_id + ); + + if(verbose){ + plan.Rprint(); + } + + List out = List::create( + _["num_attempts"] = try_counter, + _["region_id_that_was_split"] = region_id_to_split, + _["region_dvals"] = plan.region_dvals, + _["plan_vertex_ids"] = plan.region_num_ids, + _["pops"] = plan.region_pops, + _["num_regions"] = plan.num_regions, + _["num_districts"] = plan.num_districts, + _["tree"] = ust, + _["uncut_tree"] = pre_split_ust, + _["new_region1_id"] = new_region1_id, + _["new_region1_tree_root"] = new_region1_tree_root, + _["new_region1_dval"] = new_region1_dval, + _["new_region1_pop"] = new_region1_pop, + _["new_region2_id"] = new_region2_id, + _["new_region2_tree_root"] = new_region2_tree_root, + _["new_region2_dval"] = new_region2_dval, + _["new_region2_pop"] = new_region2_pop + ); + + return out; +} + + +/* + * New splitter test function. Performs cut tree function on the entire map + */ +List get_successful_proposed_cut(int N, List adj_list, const arma::uvec &counties, const arma::uvec &pop, + double target, double lower, double upper, + bool split_district_only, bool verbose +) { + + + // unpack control params + Graph g = list_to_graph(adj_list); + Multigraph cg = county_graph(g, counties); + int V = g.size(); + double total_pop = sum(pop); + + // Create a plan object + Plan plan = Plan(V, N, total_pop); + + + // Create tree related stuff + Tree ust = init_tree(V); + Tree pre_split_ust = init_tree(V); + std::vector visited(V); + std::vector ignore(V, false); + + auto region_id_to_split = 0; + + // Get a uniform spanning tree drawn on that region + int root; + + + + + // set k param for splitter + auto k_param {6}; + + // split the only region + int region_to_split = 0; + + + bool successful_split_made = false; + int try_counter {0}; + + + + int new_region1_tree_root, new_region2_tree_root; + int new_region1_dval, new_region2_dval; + double new_region1_pop, new_region2_pop; + + // Keep running until done + while(!successful_split_made){ + clear_tree(ust); + // Get a tree + int result = sample_sub_ust(g, ust, V, root, visited, ignore, pop, lower, upper, counties, cg); + // Return unsuccessful if tree not drawn + if (result != 0){ + try_counter++; + continue; + } + + // copy uncut tree + pre_split_ust = ust; + + // Try to make a cut + successful_split_made = get_edge_to_cut(ust, root, + k_param, split_district_only, pop, + plan, region_id_to_split, + lower, upper, target, + new_region1_tree_root, new_region1_dval, new_region1_pop, + new_region2_tree_root, new_region2_dval, new_region2_pop); + try_counter++; + // increase the counter by 1 + if(verbose){ + Rcout << "Attempt " << try_counter << "\n"; + } + + } + + + if(verbose){ + plan.Rprint(); + } + + + + List out = List::create( + _["num_attempts"] = try_counter, + _["region_dvals"] = plan.region_dvals, + _["plan"] = plan.region_num_ids, + _["tree"] = ust, + _["uncut_tree"] = pre_split_ust, + _["pops"] = plan.region_pops, + _["new_region1_tree_root"] = new_region1_tree_root, + _["new_region1_dval"] = new_region1_dval, + _["new_region1_pop"] = new_region1_pop, + _["new_region2_tree_root"] = new_region2_tree_root, + _["new_region2_dval"] = new_region2_dval, + _["new_region2_pop"] = new_region2_pop + ); + + return out; +} diff --git a/src/splitting_inspection.h b/src/splitting_inspection.h new file mode 100644 index 000000000..ebc41a597 --- /dev/null +++ b/src/splitting_inspection.h @@ -0,0 +1,34 @@ +#pragma once +#ifndef SPLITTING_INSPECTION_H +#define SPLITTING_INSPECTION_H + +// [[Rcpp::depends(redistmetrics)]] + +#include "smc_base.h" + +#include +#include +#include +#include +#include + +#include +#include "wilson.h" +#include "tree_op.h" +#include "map_calc.h" +#include "active_dev.h" +#include "smc_and_mcmc.h" + + +// [[Rcpp::export]] +List perform_a_valid_region_split( + List adj_list, const arma::uvec &counties, const arma::uvec &pop, + int k_param, int region_id_to_split, + double target, double lower, double upper, + int N, int num_regions, int num_districts, + std::vector region_ids, std::vector region_dvals, + std::vector region_pops, + bool split_district_only, bool verbose +); + +#endif From b24e1153b3f1b20454ebef25bc5ac12bd559a06e Mon Sep 17 00:00:00 2001 From: "Philip W. O'Sullivan" Date: Thu, 31 Oct 2024 22:14:03 -0400 Subject: [PATCH 023/324] put splitting functions in their own file --- src/smc_and_mcmc.cpp | 305 -------------------------------- src/smc_and_mcmc.h | 15 -- src/splitting.cpp | 348 +++++++++++++++++++++++++++++++++++++ src/splitting.h | 40 +++++ src/splitting_inspection.h | 2 +- 5 files changed, 389 insertions(+), 321 deletions(-) create mode 100644 src/splitting.cpp create mode 100644 src/splitting.h diff --git a/src/smc_and_mcmc.cpp b/src/smc_and_mcmc.cpp index 271b1d860..b7c168cb1 100644 --- a/src/smc_and_mcmc.cpp +++ b/src/smc_and_mcmc.cpp @@ -8,309 +8,4 @@ #include "smc_and_mcmc.h" -//' Attempts to cut one region into two from a spanning tree and if successful -//' returns information on what the two new regions would be. Does not actually -//' update the plan -//' -//' Takes a spanning tree `ust` drawn on a specific region and attempts to cut -//' it to produce two new regions using the generalized splitting procedure -//' outlined . This function is based on `cut_districts` in `smc.cpp` -//' however the crucial difference is even if a cut is successful it does not -//' update the plan. Instead it just returns the information on the two new -//' regions if successful and the vertices to use to update the plans. -//' -//' Depending on the value of split_district_only will only attempt to split off -//' a single district or allows for more general splits. -//' -//' By convention the first new region (`new_region1`) will always be the region -//' with the smaller d-value (although they can be equal). -//' -//' @title Attempt to Cut Region Tree into Two New Regions -//' -//' @param ust A directed spanning tree passed by reference -//' @param root The root vertex of the spanning tree -//' @param k_param The k parameter from the SMC algorithm, you choose among the top k_param edges -//' @param split_district_only If true then only tries to split a district, if false allows for -//' arbitrary region splits -//' @param pop A vector of the population associated with each vertex in `g` -//' @param plan A plan object -//' @param region_id_to_split The id of the region in the plan object we're attempting to split -//' @param lower Acceptable lower bounds on a valid district's population -//' @param upper Acceptable upper bounds on a valid district's population -//' @param target Ideal population of a valid district. This is what deviance is calculated -//' relative to -//' @param new_region1_tree_root The index of the root of tree associated with -//' the first new region (if the tree cut was successful) -//' @param new_region1_dval The d-value of the first new region (if the tree cut -//' was successful) -//' @param new_region1_pop The population of the first new region (if the tree cut -//' was successful) -//' @param new_region2_tree_root The index of the root of tree associated with -//' the second new region (if the tree cut was successful) -//' @param new_region2_dval The d-value of the second new region (if the tree cut -//' was successful) -//' @param new_region2_pop The population of the second new region (if the tree cut -//' was successful) -//' -//' @details Modifications -//' - If two new valid regions are split then the tree `ust` is cut into two -//' distjoint pieces -//' - If two new valid regions are split then the 6 `new_region` inputs are all -//' updated by reference with the values associated with the new regions -//' -//' @return True if two valid regions were successfully split, false otherwise -//' -//' -//' -bool get_edge_to_cut(Tree &ust, int root, - int k_param, bool split_district_only, - const uvec &pop, const Plan &plan, const int region_id_to_split, - const double lower, const double upper, const double target, - int &new_region1_tree_root, int &new_region1_dval, double &new_region1_pop, - int &new_region2_tree_root, int &new_region2_dval, double &new_region2_pop - ){ - // Get population of region being split - double total_pop = plan.region_pops.at(region_id_to_split); - // Get the number of final districts in region being split - int num_final_districts = plan.region_dvals.at(region_id_to_split); - - // Get the largest possible d value we can try - int max_potential_d; - - if(split_district_only){ - // if only splitting districts its just 1 bc then it will only try - // a potential d of 1 later on - max_potential_d = 1; - }else{ - // if arbitrary splits then d value of region minus 1 - max_potential_d = num_final_districts - 1; - } - - // Rcout << "For " << region_id_to_split << " Total pop is " << total_pop << " and d_nk is " << num_final_districts << "\n"; - - // create list that points to parents & computes population below each vtx - std::vector pop_below(plan.V, 0); - std::vector parent(plan.V); - parent[root] = -1; - tree_pop(ust, root, pop, pop_below, parent); - - // compile a list of: things for each edge in tree - std::vector candidates; // candidate edges to cut, - std::vector deviances; // how far from target pop. - std::vector is_ok; // whether they meet constraints - std::vector new_d_val; // the new d_n,k value - - // Reserve at least as much space for top k_param of them - candidates.reserve(k_param); - deviances.reserve(k_param); - is_ok.reserve(k_param); - new_d_val.reserve(k_param); - - if(plan.region_num_ids.at(root) != region_id_to_split){ - Rcout << "Root vertex is not in region to split!"; - } - - // Now loop over all valid edges to cut - for (int i = 1; i <= plan.V; i++) { // 1-indexing here - // Ignore any vertex not in this region or the root vertex as we wont be cutting those - if (plan.region_num_ids.at(i-1) != region_id_to_split || i - 1 == root) continue; - - // Get the population of one side of the partition removing that edge would cause - double below = pop_below.at(i - 1); - // Get the population of the other side - double above = total_pop - below; - - // vectors to keep track of value for each d_{n,k} - std::vector devs(max_potential_d); - std::vector dev2_bigger(max_potential_d); - std::vector are_ok(max_potential_d); - - - // Now try each potential d_nk value from 1 up to d_n-1,k -1 - // remember to correct for 0 indexing - for(int potential_d = 1; potential_d <= max_potential_d; potential_d++){ - - double dev1 = std::fabs(below - target * potential_d); - double dev2 = std::fabs(above - target * potential_d); - - // If dev1 is smaller then we assign d_nk to below - if (dev1 < dev2) { - devs[potential_d-1] = dev1; - dev2_bigger[potential_d-1] = true; - // check in bounds - are_ok[potential_d-1] = lower * potential_d <= below - && below <= upper * potential_d - && lower * (num_final_districts - potential_d) <= above - && above <= upper * (num_final_districts - potential_d); - } else { // Else if dev2 is smaller we assign d_nk to above - devs[potential_d-1] = dev2; - dev2_bigger[potential_d-1] = false; - are_ok[potential_d-1] = lower * potential_d <= above - && above <= upper * potential_d - && lower * (num_final_districts - potential_d) <= below - && below <= upper * (num_final_districts - potential_d); - } - - } - - // Now find the value of d_{n,k} that has the smallest deviation - std::vector::iterator result = std::min_element(devs.begin(), devs.end()); - int best_potential_d = std::distance(devs.begin(), result); - - /* - Rcout << "min element has value " << *result << " and index [" - << best_potential_d << "]\n"; - */ - - if(dev2_bigger[best_potential_d]){ - candidates.push_back(i); - } else{ - candidates.push_back(-i); - } - - deviances.push_back(devs[best_potential_d]); - is_ok.push_back(are_ok[best_potential_d]); - new_d_val.push_back(best_potential_d+1); - - } - - - // if less than k_param candidates immediately reject - if((int) candidates.size() < k_param){ - return false; - } - - int idx = r_int(k_param); - idx = select_k(deviances, idx + 1); - int cut_at = std::fabs(candidates[idx]) - 1; - - - // reject sample if not ok - if (!is_ok[idx]){ - return false; - } - - - // find index of node to cut at - std::vector *siblings = &ust[parent[cut_at]]; - int length = siblings->size(); - int j; - for (j = 0; j < length; j++) { - if ((*siblings)[j] == cut_at) break; - } - - // remove edge from tree - siblings->erase(siblings->begin()+j); - parent[cut_at] = -1; - - // Get dval for two new regions - new_region1_dval = new_d_val[idx]; - new_region2_dval = num_final_districts - new_region1_dval; - - - - if (candidates[idx] > 0) { // Means cut below so first vertex is cut_at - new_region1_tree_root = cut_at; - new_region2_tree_root = root; - - // Set the new populations - new_region1_pop = pop_below.at(cut_at); - new_region2_pop = total_pop - new_region1_pop; - - // return pop_below.at(cut_at); - } else { // Means cut above so first vertex is root - new_region1_tree_root = root; - new_region2_tree_root = cut_at; - - // Set the new populations - new_region2_pop = pop_below.at(cut_at); - new_region1_pop = total_pop - new_region2_pop; - - } - - // Now make it so that the first region is always the smallest - // So if the dval of region 1 is bigger swap the two - if(new_region1_dval > new_region2_dval){ - std::swap(new_region1_dval, new_region2_dval); - std::swap(new_region1_pop, new_region2_pop); - std::swap(new_region1_tree_root, new_region2_tree_root); - } - - return true; - -}; - - - - -void update_plan_from_cut( - Tree &ust, Plan &plan, - const int old_region_id, - const int new_region1_tree_root, const int new_region1_dval, const double new_region1_pop, - const int new_region2_tree_root, const int new_region2_dval, const double new_region2_pop, - int &new_region1_id, int &new_region2_id -){ - - // update plan with new regions - plan.num_regions++; // increase region count by 1 - plan.num_multidistricts--; // Decrease by one to avoid double counting later - - // Create info for two new districts - std::string new_region_label1; - std::string new_region_label2; - - std::string region_to_split = plan.region_str_labels.at(old_region_id); - - // Set label and count depending on if district or multi district - if(new_region1_dval == 1){ - plan.num_districts++; - // if district then string label just adds district number - new_region_label1 = region_to_split + "." + std::to_string(plan.num_districts); - }else{ - plan.num_multidistricts++; - // if region then just add current region number - new_region_label1 = region_to_split + ".R" + std::to_string(old_region_id); - } - - // Now do it for second region - if(new_region2_dval == 1){ - plan.num_districts++; - // if district then string label just adds district number - new_region_label2 = region_to_split + "." + std::to_string(plan.num_districts); - }else{ - plan.num_multidistricts++; - // if region then just add current region number - new_region_label2 = region_to_split + ".R" + std::to_string(plan.num_regions - 1); - } - - // TODO: Figure out how to do this to preserve the order districts were added - - // make the first new region have the same integer id - new_region1_id = old_region_id; - // Second new region has id of the new number of regions minus 1 - new_region2_id = plan.num_regions - 1; - - - // Now update the two cut portions - assign_region(ust, plan, new_region1_tree_root, new_region1_id); - assign_region(ust, plan, new_region2_tree_root, new_region2_id); - - // Now update the region level information - - // Add the new region 1 - // New region 1 has the same id number as old region so update that - plan.region_dvals.at(new_region1_id) = new_region1_dval; - plan.region_str_labels.at(new_region1_id) = new_region_label1; - plan.region_pops.at(new_region1_id) = new_region1_pop; - - // Add the new region 2 - // New region 2's id is the highest id number so push back - plan.region_dvals.push_back(new_region2_dval); - plan.region_str_labels.push_back(new_region_label2); - plan.region_pops.push_back(new_region2_pop); - - // done - return; - -}; diff --git a/src/smc_and_mcmc.h b/src/smc_and_mcmc.h index bd32e919d..2e995b18f 100644 --- a/src/smc_and_mcmc.h +++ b/src/smc_and_mcmc.h @@ -20,21 +20,6 @@ #include "redist_types.h" #include "gsmc_helpers.h" -bool get_edge_to_cut(Tree &ust, int root, - int k_param, bool split_district_only, - const uvec &pop, const Plan &plan, const int region_id_to_split, - const double lower, const double upper, const double target, - int &new_region1_tree_root, int &new_region1_dval, double &new_region1_pop, - int &new_region2_tree_root, int &new_region2_dval, double &new_region2_pop -); -void update_plan_from_cut( - Tree &ust, Plan &plan, - const int old_region_id, - const int new_region1_tree_root, const int new_region1_dval, const double new_region1_pop, - const int new_region2_tree_root, const int new_region2_dval, const double new_region2_pop, - int &new_region1_id, int &new_region2_id -); - #endif diff --git a/src/splitting.cpp b/src/splitting.cpp new file mode 100644 index 000000000..1ed1afe9a --- /dev/null +++ b/src/splitting.cpp @@ -0,0 +1,348 @@ +/******************************************************** +* Author: Philip O'Sullivan' +* Institution: Harvard University +* Date Created: 2024/11 +* Purpose: Helper Functions for Splitting Trees and Plans +********************************************************/ + +#include "splitting.h" + +//' Attempts to cut one region into two from a spanning tree and if successful +//' returns information on what the two new regions would be. Does not actually +//' update the plan +//' +//' Takes a spanning tree `ust` drawn on a specific region and attempts to cut +//' it to produce two new regions using the generalized splitting procedure +//' outlined . This function is based on `cut_districts` in `smc.cpp` +//' however the crucial difference is even if a cut is successful it does not +//' update the plan. Instead it just returns the information on the two new +//' regions if successful and the vertices to use to update the plans. +//' +//' Depending on the value of split_district_only will only attempt to split off +//' a single district or allows for more general splits. +//' +//' By convention the first new region (`new_region1`) will always be the region +//' with the smaller d-value (although they can be equal). +//' +//' @title Attempt to Cut Region Tree into Two New Regions +//' +//' @param ust A directed spanning tree passed by reference +//' @param root The root vertex of the spanning tree +//' @param k_param The k parameter from the SMC algorithm, you choose among the top k_param edges +//' @param split_district_only If true then only tries to split a district, if false allows for +//' arbitrary region splits +//' @param pop A vector of the population associated with each vertex in `g` +//' @param plan A plan object +//' @param region_id_to_split The id of the region in the plan object we're attempting to split +//' @param lower Acceptable lower bounds on a valid district's population +//' @param upper Acceptable upper bounds on a valid district's population +//' @param target Ideal population of a valid district. This is what deviance is calculated +//' relative to +//' @param new_region1_tree_root The index of the root of tree associated with +//' the first new region (if the tree cut was successful) +//' @param new_region1_dval The d-value of the first new region (if the tree cut +//' was successful) +//' @param new_region1_pop The population of the first new region (if the tree cut +//' was successful) +//' @param new_region2_tree_root The index of the root of tree associated with +//' the second new region (if the tree cut was successful) +//' @param new_region2_dval The d-value of the second new region (if the tree cut +//' was successful) +//' @param new_region2_pop The population of the second new region (if the tree cut +//' was successful) +//' +//' @details Modifications +//' - If two new valid regions are split then the tree `ust` is cut into two +//' distjoint pieces +//' - If two new valid regions are split then the 6 `new_region` inputs are all +//' updated by reference with the values associated with the new regions +//' +//' @return True if two valid regions were successfully split, false otherwise +//' +//' +//' +bool get_edge_to_cut(Tree &ust, int root, + int k_param, bool split_district_only, + const uvec &pop, const Plan &plan, const int region_id_to_split, + const double lower, const double upper, const double target, + int &new_region1_tree_root, int &new_region1_dval, double &new_region1_pop, + int &new_region2_tree_root, int &new_region2_dval, double &new_region2_pop + ){ + // Get population of region being split + double total_pop = plan.region_pops.at(region_id_to_split); + + // Get the number of final districts in region being split + int num_final_districts = plan.region_dvals.at(region_id_to_split); + + // Get the largest possible d value we can try + int max_potential_d; + + if(split_district_only){ + // if only splitting districts its just 1 bc then it will only try + // a potential d of 1 later on + max_potential_d = 1; + }else{ + // if arbitrary splits then d value of region minus 1 + max_potential_d = num_final_districts - 1; + } + + // Rcout << "For " << region_id_to_split << " Total pop is " << total_pop << " and d_nk is " << num_final_districts << "\n"; + + // create list that points to parents & computes population below each vtx + std::vector pop_below(plan.V, 0); + std::vector parent(plan.V); + parent[root] = -1; + tree_pop(ust, root, pop, pop_below, parent); + + // compile a list of: things for each edge in tree + std::vector candidates; // candidate edges to cut, + std::vector deviances; // how far from target pop. + std::vector is_ok; // whether they meet constraints + std::vector new_d_val; // the new d_n,k value + + // Reserve at least as much space for top k_param of them + candidates.reserve(k_param); + deviances.reserve(k_param); + is_ok.reserve(k_param); + new_d_val.reserve(k_param); + + if(plan.region_num_ids.at(root) != region_id_to_split){ + Rcout << "Root vertex is not in region to split!"; + } + + // Now loop over all valid edges to cut + for (int i = 1; i <= plan.V; i++) { // 1-indexing here + // Ignore any vertex not in this region or the root vertex as we wont be cutting those + if (plan.region_num_ids.at(i-1) != region_id_to_split || i - 1 == root) continue; + + // Get the population of one side of the partition removing that edge would cause + double below = pop_below.at(i - 1); + // Get the population of the other side + double above = total_pop - below; + + // vectors to keep track of value for each d_{n,k} + std::vector devs(max_potential_d); + std::vector dev2_bigger(max_potential_d); + std::vector are_ok(max_potential_d); + + + // Now try each potential d_nk value from 1 up to d_n-1,k -1 + // remember to correct for 0 indexing + for(int potential_d = 1; potential_d <= max_potential_d; potential_d++){ + + double dev1 = std::fabs(below - target * potential_d); + double dev2 = std::fabs(above - target * potential_d); + + // If dev1 is smaller then we assign d_nk to below + if (dev1 < dev2) { + devs[potential_d-1] = dev1; + dev2_bigger[potential_d-1] = true; + // check in bounds + are_ok[potential_d-1] = lower * potential_d <= below + && below <= upper * potential_d + && lower * (num_final_districts - potential_d) <= above + && above <= upper * (num_final_districts - potential_d); + } else { // Else if dev2 is smaller we assign d_nk to above + devs[potential_d-1] = dev2; + dev2_bigger[potential_d-1] = false; + are_ok[potential_d-1] = lower * potential_d <= above + && above <= upper * potential_d + && lower * (num_final_districts - potential_d) <= below + && below <= upper * (num_final_districts - potential_d); + } + + } + + // Now find the value of d_{n,k} that has the smallest deviation + std::vector::iterator result = std::min_element(devs.begin(), devs.end()); + int best_potential_d = std::distance(devs.begin(), result); + + /* + Rcout << "min element has value " << *result << " and index [" + << best_potential_d << "]\n"; + */ + + if(dev2_bigger[best_potential_d]){ + candidates.push_back(i); + } else{ + candidates.push_back(-i); + } + + deviances.push_back(devs[best_potential_d]); + is_ok.push_back(are_ok[best_potential_d]); + new_d_val.push_back(best_potential_d+1); + + } + + + // if less than k_param candidates immediately reject + if((int) candidates.size() < k_param){ + return false; + } + + int idx = r_int(k_param); + idx = select_k(deviances, idx + 1); + int cut_at = std::fabs(candidates[idx]) - 1; + + + // reject sample if not ok + if (!is_ok[idx]){ + return false; + } + + + // find index of node to cut at + std::vector *siblings = &ust[parent[cut_at]]; + int length = siblings->size(); + int j; + for (j = 0; j < length; j++) { + if ((*siblings)[j] == cut_at) break; + } + + // remove edge from tree + siblings->erase(siblings->begin()+j); + parent[cut_at] = -1; + + // Get dval for two new regions + new_region1_dval = new_d_val[idx]; + new_region2_dval = num_final_districts - new_region1_dval; + + + + if (candidates[idx] > 0) { // Means cut below so first vertex is cut_at + new_region1_tree_root = cut_at; + new_region2_tree_root = root; + + // Set the new populations + new_region1_pop = pop_below.at(cut_at); + new_region2_pop = total_pop - new_region1_pop; + + // return pop_below.at(cut_at); + } else { // Means cut above so first vertex is root + new_region1_tree_root = root; + new_region2_tree_root = cut_at; + + // Set the new populations + new_region2_pop = pop_below.at(cut_at); + new_region1_pop = total_pop - new_region2_pop; + + } + + // Now make it so that the first region is always the smallest + // So if the dval of region 1 is bigger swap the two + if(new_region1_dval > new_region2_dval){ + std::swap(new_region1_dval, new_region2_dval); + std::swap(new_region1_pop, new_region2_pop); + std::swap(new_region1_tree_root, new_region2_tree_root); + } + + return true; + +}; + + + + + + +//' Updates a `Plan` object using a cut tree +//' +//' Takes a cut spanning tree `ust` and variables on the two new regions +//' induced by the cuts and updates `plan` to add those two new regions. +//' +//' +//' @title Update plan regions from cut tree +//' +//' @param ust A cut (ie has two partition pieces) directed spanning tree +//' passed by reference +//' @param plan A plan object +//' @param old_region_id The id of old (split) region +//' @param new_region1_tree_root The vertex of the root of one piece of the cut +//' tree. This always corresponds to the region with the smaller dval (allowing +//' for the possiblity the dvals are equal). +//' @param new_region1_dval The dval associated with the new region 1 +//' @param new_region1_pop The population associated with the new region 1 +//' @param new_region2_tree_root The vertex of the root of other piece of the cut +//' tree. This always corresponds to the region with the bigger dval (allowing +//' for the possiblity the dvals are equal). +//' @param new_region2_dval The dval associated with the new region 2 +//' @param new_region2_pop The population associated with the new region 2 +//' @param new_region1_id The id the new region 1 was assigned in the plan +//' @param new_region2_id The id the new region 2 was assigned in the plan +//' +//' @details Modifications +//' - `plan` is updated in place with the two new regions and the old region +//' is removed +//' - `new_region1_id` and `new_region2_id` are updated by reference to what +//' the values of the two new region ids were set to +//' +void update_plan_from_cut( + Tree &ust, Plan &plan, + const int old_region_id, + const int new_region1_tree_root, const int new_region1_dval, const double new_region1_pop, + const int new_region2_tree_root, const int new_region2_dval, const double new_region2_pop, + int &new_region1_id, int &new_region2_id +){ + + // update plan with new regions + plan.num_regions++; // increase region count by 1 + plan.num_multidistricts--; // Decrease by one to avoid double counting later + + // Create info for two new districts + std::string new_region_label1; + std::string new_region_label2; + + std::string region_to_split = plan.region_str_labels.at(old_region_id); + + // Set label and count depending on if district or multi district + if(new_region1_dval == 1){ + plan.num_districts++; + // if district then string label just adds district number + new_region_label1 = region_to_split + "." + std::to_string(plan.num_districts); + }else{ + plan.num_multidistricts++; + // if region then just add current region number + new_region_label1 = region_to_split + ".R" + std::to_string(old_region_id); + } + + // Now do it for second region + if(new_region2_dval == 1){ + plan.num_districts++; + // if district then string label just adds district number + new_region_label2 = region_to_split + "." + std::to_string(plan.num_districts); + }else{ + plan.num_multidistricts++; + // if region then just add current region number + new_region_label2 = region_to_split + ".R" + std::to_string(plan.num_regions - 1); + } + + // TODO: Figure out how to do this to preserve the order districts were added + + // make the first new region have the same integer id + new_region1_id = old_region_id; + // Second new region has id of the new number of regions minus 1 + new_region2_id = plan.num_regions - 1; + + + // Now update the two cut portions + assign_region(ust, plan, new_region1_tree_root, new_region1_id); + assign_region(ust, plan, new_region2_tree_root, new_region2_id); + + // Now update the region level information + + // Add the new region 1 + // New region 1 has the same id number as old region so update that + plan.region_dvals.at(new_region1_id) = new_region1_dval; + plan.region_str_labels.at(new_region1_id) = new_region_label1; + plan.region_pops.at(new_region1_id) = new_region1_pop; + + // Add the new region 2 + // New region 2's id is the highest id number so push back + plan.region_dvals.push_back(new_region2_dval); + plan.region_str_labels.push_back(new_region_label2); + plan.region_pops.push_back(new_region2_pop); + + // done + return; + +}; diff --git a/src/splitting.h b/src/splitting.h new file mode 100644 index 000000000..a7ca6459f --- /dev/null +++ b/src/splitting.h @@ -0,0 +1,40 @@ +#pragma once +#ifndef SPLITTING_H +#define SPLITTING_H + +// [[Rcpp::depends(redistmetrics)]] + +#include "smc_base.h" + +#include +#include +#include +#include +#include +#include + +#include +#include "wilson.h" +#include "tree_op.h" +#include "map_calc.h" +#include "redist_types.h" +#include "gsmc_helpers.h" + +bool get_edge_to_cut(Tree &ust, int root, + int k_param, bool split_district_only, + const uvec &pop, const Plan &plan, const int region_id_to_split, + const double lower, const double upper, const double target, + int &new_region1_tree_root, int &new_region1_dval, double &new_region1_pop, + int &new_region2_tree_root, int &new_region2_dval, double &new_region2_pop +); + + +void update_plan_from_cut( + Tree &ust, Plan &plan, + const int old_region_id, + const int new_region1_tree_root, const int new_region1_dval, const double new_region1_pop, + const int new_region2_tree_root, const int new_region2_dval, const double new_region2_pop, + int &new_region1_id, int &new_region2_id +); + +#endif diff --git a/src/splitting_inspection.h b/src/splitting_inspection.h index ebc41a597..ec2a58007 100644 --- a/src/splitting_inspection.h +++ b/src/splitting_inspection.h @@ -17,7 +17,7 @@ #include "tree_op.h" #include "map_calc.h" #include "active_dev.h" -#include "smc_and_mcmc.h" +#include "splitting.h" // [[Rcpp::export]] From 369afb2f545b042a63585295ed1e60d4d2e62a49 Mon Sep 17 00:00:00 2001 From: "Philip W. O'Sullivan" Date: Fri, 1 Nov 2024 00:01:50 -0400 Subject: [PATCH 024/324] reorganized file structure. Added seperate files for weight computations and added more stuff to splitting file --- R/RcppExports.R | 260 +++++++++++++-- src/basic_smc.h | 3 +- src/gsmc.cpp | 14 +- src/gsmc.h | 6 +- src/gsmc_helpers.h | 51 --- src/smc_and_mcmc.h | 2 +- src/splitting.cpp | 452 +++++++++++++++++++++++++- src/splitting.h | 230 ++++++++++++- src/tree_op.cpp | 60 ++++ src/tree_op.h | 19 ++ src/{gsmc_helpers.cpp => weights.cpp} | 141 +------- src/weights.h | 47 +++ 12 files changed, 1068 insertions(+), 217 deletions(-) delete mode 100644 src/gsmc_helpers.h rename src/{gsmc_helpers.cpp => weights.cpp} (76%) create mode 100644 src/weights.h diff --git a/R/RcppExports.R b/R/RcppExports.R index 10e9c3d76..aeef7d962 100644 --- a/R/RcppExports.R +++ b/R/RcppExports.R @@ -107,25 +107,6 @@ gsmc_plans <- function(N, adj_list, counties, pop, target, lower, upper, M, cont .Call(`_redist_gsmc_plans`, N, adj_list, counties, pop, target, lower, upper, M, control, ncores, verbosity, diagnostic_mode) } -#' Compute the log incremental weight of a plan -#' -#' Given a plan object this computes the minimum variance weights as derived in -#' . This is equivalent to the inverse of a sum over all -#' adjacent regions in a plan. -#' -#' @title Compute Incremental Weight of a plan -#' -#' @param plan A plan object -#' @param g The underlying map graph -#' @param target The target population for a single district -#' @param pop_temper The population tempering parameter -#' -#' @details No modifications to inputs made -#' -#' @return the log of the incremental weight of the plan -#' -NULL - log_st_map <- function(g, districts, counties, n_distr) { .Call(`_redist_log_st_map`, g, districts, counties, n_distr) } @@ -262,6 +243,214 @@ dist_cty_splits <- function(dm, community, nd) { .Call(`_redist_dist_cty_splits`, dm, community, nd) } +#' Selects a multidistrict with probability proportional to its d_nk value and +#' returns the log probability of the selected region +#' +#' Given a plan object with at least one multidistrict this function randomly +#' selects a multidistrict with probability proporitional to its d_nk value +#' (relative to all multidistricts) and returns the log of the probability that +#' region was chosen. +#' +#' +#' @title Choose multidistrict to split +#' +#' @param plan A plan object +#' @param region_to_split an integer that will be updated by reference with the +#' id number of the region selected to split +#' +#' @details No modifications to inputs made +#' +#' @return the region level graph +#' +NULL + +#' Attempts to cut one region into two from a spanning tree and if successful +#' returns information on what the two new regions would be. Does not actually +#' update the plan +#' +#' Takes a spanning tree `ust` drawn on a specific region and attempts to cut +#' it to produce two new regions using the generalized splitting procedure +#' outlined . This function is based on `cut_districts` in `smc.cpp` +#' however the crucial difference is even if a cut is successful it does not +#' update the plan. Instead it just returns the information on the two new +#' regions if successful and the vertices to use to update the plans. +#' +#' Depending on the value of split_district_only will only attempt to split off +#' a single district or allows for more general splits. +#' +#' By convention the first new region (`new_region1`) will always be the region +#' with the smaller d-value (although they can be equal). +#' +#' @title Attempt to Cut Region Tree into Two New Regions +#' +#' @param ust A directed spanning tree passed by reference +#' @param root The root vertex of the spanning tree +#' @param k_param The k parameter from the SMC algorithm, you choose among the top k_param edges +#' @param split_district_only If true then only tries to split a district, if false allows for +#' arbitrary region splits +#' @param pop A vector of the population associated with each vertex in `g` +#' @param plan A plan object +#' @param region_id_to_split The id of the region in the plan object we're attempting to split +#' @param lower Acceptable lower bounds on a valid district's population +#' @param upper Acceptable upper bounds on a valid district's population +#' @param target Ideal population of a valid district. This is what deviance is calculated +#' relative to +#' @param new_region1_tree_root The index of the root of tree associated with +#' the first new region (if the tree cut was successful) +#' @param new_region1_dval The d-value of the first new region (if the tree cut +#' was successful) +#' @param new_region1_pop The population of the first new region (if the tree cut +#' was successful) +#' @param new_region2_tree_root The index of the root of tree associated with +#' the second new region (if the tree cut was successful) +#' @param new_region2_dval The d-value of the second new region (if the tree cut +#' was successful) +#' @param new_region2_pop The population of the second new region (if the tree cut +#' was successful) +#' +#' @details Modifications +#' - If two new valid regions are split then the tree `ust` is cut into two +#' distjoint pieces +#' - If two new valid regions are split then the 6 `new_region` inputs are all +#' updated by reference with the values associated with the new regions +#' +#' @return True if two valid regions were successfully split, false otherwise +#' +NULL + +#' Updates a `Plan` object using a cut tree +#' +#' Takes a cut spanning tree `ust` and variables on the two new regions +#' induced by the cuts and updates `plan` to add those two new regions. +#' +#' +#' @title Update plan regions from cut tree +#' +#' @param ust A cut (ie has two partition pieces) directed spanning tree +#' passed by reference +#' @param plan A plan object +#' @param old_region_id The id of old (split) region +#' @param new_region1_tree_root The vertex of the root of one piece of the cut +#' tree. This always corresponds to the region with the smaller dval (allowing +#' for the possiblity the dvals are equal). +#' @param new_region1_dval The dval associated with the new region 1 +#' @param new_region1_pop The population associated with the new region 1 +#' @param new_region2_tree_root The vertex of the root of other piece of the cut +#' tree. This always corresponds to the region with the bigger dval (allowing +#' for the possiblity the dvals are equal). +#' @param new_region2_dval The dval associated with the new region 2 +#' @param new_region2_pop The population associated with the new region 2 +#' @param new_region1_id The id the new region 1 was assigned in the plan +#' @param new_region2_id The id the new region 2 was assigned in the plan +#' +#' @details Modifications +#' - `plan` is updated in place with the two new regions and the old region +#' is removed +#' - `new_region1_id` and `new_region2_id` are updated by reference to what +#' the values of the two new region ids were set to +#' +NULL + +#' Splits a multidistrict in all of the plans +#' +#' Using the procedure outlined in this function attempts to split +#' a multidistrict in a previous steps plan until M successful splits have been made. This +#' is based on the `split_maps` function in smc.cpp +#' +#' @title Split all the maps +#' +#' @param g A graph (adjacency list) passed by reference +#' @param counties Vector of county labels of each vertex in `g` +#' @param cg County level multigraph +#' @param pop A vector of the population associated with each vertex in `g` +#' @param old_plans_vec A vector of plans from the previous step +#' @param new_plans_vec A vector which will be filled with plans that had a +#' multidistrict split to make them +#' @param original_ancestor_vec A vector used to track which original ancestor +#' the new plans descended from. The value of `original_ancestor_vec[i]` +#' is the index of the original ancestor the new plan `new_plans_vec[i]` is +#' descended from. +#' @param parent_vec A vector used to track the index of the previous plan +#' sampled that was successfully split. The value of `parent_vec[i]` is the +#' index of the old plan from which the new plan `new_plans_vec[i]` was +#' successfully split from. In other words `new_plans_vec[i]` is equal to +#' `attempt_region_split(old_plans_vec[parent_vec[i]], ...)` +#' @param prev_ancestor_vec A vector used to track the index of the original +#' ancestor of the previous plans. The value of `prev_ancestor_vec[i]` is the +#' index of the original ancestor of `old_plans_vec[i]` +#' @param unnormalized_sampling_weights A vector of weights used to sample indices +#' of the `old_plans_vec`. The value of `unnormalized_sampling_weights[i]` is +#' the unnormalized probability that index i is selected +#' @param normalized_weights_to_fill_in A vector which will be filled with the +#' normalized weights the index sampler uses. The value of +#' `normalized_weights_to_fill_in[i]` is the probability that index i is selected +#' @param draw_tries_vec A vector used to keep track of how many plan split +#' attempts were made for index i. The value `draw_tries_vec[i]` represents how +#' many split attempts were made for the i-th new plan (including the successful +#' split). For example, `draw_tries_vec[i] = 1` means that the first split +#' attempt was successful. +#' @param parent_unsuccessful_tries_vec A vector used to keep track of how many times the +#' previous rounds plans were sampled and unsuccessfully split. The value +#' `parent_unsuccessful_tries_vec[i]` represents how many times `old_plans_vec[i]` was sampled +#' and then unsuccessfully split while creating all `M` of the new plans. +#' THIS MAY NOT BE THREAD SAFE +#' @param accept_rate The number of accepted splits over the total number of +#' attempted splits. This is equal to `sum(draw_tries_vec)/M` +#' @param n_unique_parent_indices The number of unique parent indices, ie the +#' number of previous plans that had at least one descendant amongst the new +#' plans. This is equal to `unique(parent_vec)` +#' @param n_unique_original_ancestors The number of unique original ancestors, +#' in the new plans. This is equal to `unique(original_ancestor_vec)` +#' @param ancestors Parameter from older `smc.cpp` code. I DON'T UNDERSTAND +#' WHAT IT IS DOING +#' @param lags Parameter from older `smc.cpp` code. I DON'T UNDERSTAND +#' WHAT IT IS DOING +#' @param lower Acceptable lower bounds on a valid district's population +#' @param upper Acceptable upper bounds on a valid district's population +#' @param target Ideal population of a valid district. This is what deviance is calculated +#' relative to +#' @param k_param The top edges to pick parameter for the region splitting +#' algorithm +#' @param split_district_only Whether or not to only allow for single district +#' splits. If set to `true` will only attempt to split off one district at a +#' time +#' @param pool A threadpool for multithreading +#' @param verbosity A parameter controlling the amount of detail printed out +#' during the algorithms running +#' +#' @details Modifications +#' - The `new_plans_vec` is updated with all the newly split plans +#' - The `old_plans_vec` is updated with all the newly split plans as well. +#' Note that the reason both this and `new_plans_vec` are updated is because +#' of the nature of the code you need both vectors and so both are passed by +#' reference to save memory. +#' - The `original_ancestor_vec` is updated to contain the indices of the +#' original ancestors of the new plans +#' - The `parent_vec` is updated to contain the indices of the parents of the +NULL + +#' - If two new valid regions are split then the new_region_ids is updated so the +#' first entry is the first new region and the second entry is the second new region +#' - The `normalized_weights_to_fill_in` is updated to contain the normalized +#' probabilities the index sampler used. This is only collected for diagnostics +#' at this point and should just be equal to `unnormalized_sampling_weights` +#' divided by `sum(unnormalized_sampling_weights)` +#' - The `draw_tries_vec` is updated to contain the number of tries for each +#' of the new plans +#' - The `parent_unsuccessful_tries_vec` is updated to contain the number of unsuccessful +#' samples of the old plans +#' - The `accept_rate` is updated to contain the average acceptance rate for +#' this iteration +#' - `n_unique_parent_indices` and `n_unique_original_ancestors` are updated +#' with the unique number of parents and original ancestors for all the new +#' plans respectively +#' - `ancestors` is updated to something. THIS IS FROM ORIGINAL SMC CODE, +#' I DO NOT KNOW WHAT IT MEANS +#' +#' @return nothing +#' +NULL + perform_a_valid_region_split <- function(adj_list, counties, pop, k_param, region_id_to_split, target, lower, upper, N, num_regions, num_districts, region_ids, region_dvals, region_pops, split_district_only, verbose) { .Call(`_redist_perform_a_valid_region_split`, adj_list, counties, pop, k_param, region_id_to_split, target, lower, upper, N, num_regions, num_districts, region_ids, region_dvals, region_pops, split_district_only, verbose) } @@ -282,6 +471,22 @@ basic_smc_split_all_the_way <- function(N, adj_list, counties, pop, target, lowe .Call(`_redist_basic_smc_split_all_the_way`, N, adj_list, counties, pop, target, lower, upper, verbose) } +#' Creates the region level graph of a plan +#' +#' Given a plan object this returns a graph of the regions in the plan using +#' the region ids as indices +#' +#' @title Get Region-Level Graph +#' +#' @param g The graph of the entire map +#' @param plan A plan object +#' +#' @details No modifications to inputs made +#' +#' @return the log of the probability the specific value of `region_to_split` was chosen +#' +NULL + tree_pop <- function(ust, vtx, pop, pop_below, parent) { .Call(`_redist_tree_pop`, ust, vtx, pop, pop_below, parent) } @@ -290,6 +495,23 @@ var_info_vec <- function(m, ref, pop) { .Call(`_redist_var_info_vec`, m, ref, pop) } +#' Computes the effective sample size from log incremental weights +#' +#' Takes a vector of log incremental weights and computes the effective sample +#' size which is the sum of the weights squared divided by the sum of squared +#' weights +#' +#' +#' @title Compute Effective Sample Size +#' +#' @param log_wgt vector of log incremental weights +#' +#' @details No modifications to inputs made +#' +#' @return sum of weights squared over sum of squared weights (sum(wgt)^2 / sum(wgt^2)) +#' +NULL + sample_ust <- function(l, pop, lower, upper, counties, ignore) { .Call(`_redist_sample_ust`, l, pop, lower, upper, counties, ignore) } diff --git a/src/basic_smc.h b/src/basic_smc.h index 7c06af074..fbedeb1d8 100644 --- a/src/basic_smc.h +++ b/src/basic_smc.h @@ -18,7 +18,8 @@ #include "tree_op.h" #include "map_calc.h" #include "redist_types.h" -#include "gsmc_helpers.h" +#include "weights.h" +#include "splitting.h" diff --git a/src/gsmc.cpp b/src/gsmc.cpp index 95125343d..98568606f 100644 --- a/src/gsmc.cpp +++ b/src/gsmc.cpp @@ -326,7 +326,7 @@ bool cut_regions(Tree &ust, int k_param, int root, //' //' @return True if two valid regions were split off false otherwise //' -bool attempt_region_split(const Graph &g, Tree &ust, const uvec &counties, Multigraph &cg, +bool OLD_attempt_region_split(const Graph &g, Tree &ust, const uvec &counties, Multigraph &cg, Plan &plan, const int region_id_to_split, std::vector &new_region_ids, std::vector &visited, std::vector &ignore, const uvec &pop, @@ -463,7 +463,7 @@ bool attempt_region_split(const Graph &g, Tree &ust, const uvec &counties, Multi //' //' @return nothing //' -void generalized_split_maps( +void OLD_generalized_split_maps( const Graph &g, const uvec &counties, Multigraph &cg, const uvec &pop, std::vector &old_plans_vec, std::vector &new_plans_vec, std::vector &original_ancestor_vec, @@ -558,7 +558,7 @@ void generalized_split_maps( old_plans_vec[idx], region_id_to_split); // Now try to split that region - ok = attempt_region_split(g, ust, counties, cg, + ok = OLD_attempt_region_split(g, ust, counties, cg, proposed_new_plan, region_id_to_split, new_region_ids, visited, ignore, pop, @@ -658,7 +658,7 @@ void generalized_split_maps( //' weights of the plans //' - The `unnormalized_sampling_weights` is updated to contain the unnormalized //' sampling weights of the plans for the next round -void get_log_gsmc_weights( +void OLD_get_log_gsmc_weights( RcppThread::ThreadPool &pool, const Graph &g, std::vector &plans_vec, std::vector &log_incremental_weights, @@ -861,7 +861,7 @@ List gsmc_plans( if(n == 0){ std::vector dummy_prev_ancestors(M, 1); // split the map - generalized_split_maps( + OLD_generalized_split_maps( g, counties, cg, pop, plans_vec, new_plans_vec, original_ancestor_mat[n], @@ -886,7 +886,7 @@ List gsmc_plans( std::iota (original_ancestor_mat[0].begin(), original_ancestor_mat[0].end(), 0); }else{ // split the map and we can use the previous original ancestor matrix row - generalized_split_maps( + OLD_generalized_split_maps( g, counties, cg, pop, plans_vec, new_plans_vec, original_ancestor_mat[n], @@ -914,7 +914,7 @@ List gsmc_plans( // compute log incremental weights and sampling weights for next round - get_log_gsmc_weights( + OLD_get_log_gsmc_weights( pool, g, new_plans_vec, diff --git a/src/gsmc.h b/src/gsmc.h index 424718796..6cce1b813 100644 --- a/src/gsmc.h +++ b/src/gsmc.h @@ -18,8 +18,8 @@ #include "tree_op.h" #include "map_calc.h" #include "redist_types.h" -#include "gsmc_helpers.h" - +#include "weights.h" +#include "splitting.h" @@ -58,7 +58,7 @@ List gsmc_plans( -bool attempt_region_split(const Graph &g, Tree &ust, const uvec &counties, Multigraph &cg, +bool OLD_attempt_region_split(const Graph &g, Tree &ust, const uvec &counties, Multigraph &cg, Plan &plan, const int region_id_to_split, std::vector &new_region_ids, std::vector &visited, std::vector &ignore, const uvec &pop, diff --git a/src/gsmc_helpers.h b/src/gsmc_helpers.h deleted file mode 100644 index 72b839745..000000000 --- a/src/gsmc_helpers.h +++ /dev/null @@ -1,51 +0,0 @@ -#pragma once -#ifndef GENERALIZED_SMC_HELPERS_H -#define GENERALIZED_SMC_HELPERS_H - -// [[Rcpp::depends(redistmetrics)]] - -#include "smc_base.h" - - -#include -#include -#include -#include -#include // for std::pair -#include -#include "redist_types.h" - -double compute_n_eff(const std::vector &log_wgt); - -double choose_multidistrict_to_split( - Plan const&plan, int ®ion_id_to_split); - -//' Compute the log incremental weight of a plan -//' -//' Given a plan object this computes the minimum variance weights as derived in -//' . This is equivalent to the inverse of a sum over all -//' adjacent regions in a plan. -//' -//' @title Compute Incremental Weight of a plan -//' -//' @param plan A plan object -//' @param g The underlying map graph -//' @param target The target population for a single district -//' @param pop_temper The population tempering parameter -//' -//' @details No modifications to inputs made -//' -//' @return the log of the incremental weight of the plan -//' -double compute_log_incremental_weight( - const Graph &g, const Plan &plan, - const double target, const double pop_temper); - - -double compute_basic_smc_log_incremental_weight( - const Graph &g, const Plan &plan, - const double target, const double pop_temper); - -Graph get_region_graph(const Graph &g, const Plan &plan); - -#endif diff --git a/src/smc_and_mcmc.h b/src/smc_and_mcmc.h index 2e995b18f..2ba588055 100644 --- a/src/smc_and_mcmc.h +++ b/src/smc_and_mcmc.h @@ -18,7 +18,7 @@ #include "tree_op.h" #include "map_calc.h" #include "redist_types.h" -#include "gsmc_helpers.h" + diff --git a/src/splitting.cpp b/src/splitting.cpp index 1ed1afe9a..fbfe69a16 100644 --- a/src/splitting.cpp +++ b/src/splitting.cpp @@ -2,11 +2,86 @@ * Author: Philip O'Sullivan' * Institution: Harvard University * Date Created: 2024/11 -* Purpose: Helper Functions for Splitting Trees and Plans +* Purpose: Functions for Splitting Trees and Plans ********************************************************/ #include "splitting.h" + +//' Selects a multidistrict with probability proportional to its d_nk value and +//' returns the log probability of the selected region +//' +//' Given a plan object with at least one multidistrict this function randomly +//' selects a multidistrict with probability proporitional to its d_nk value +//' (relative to all multidistricts) and returns the log of the probability that +//' region was chosen. +//' +//' +//' @title Choose multidistrict to split +//' +//' @param plan A plan object +//' @param region_to_split an integer that will be updated by reference with the +//' id number of the region selected to split +//' +//' @details No modifications to inputs made +//' +//' @return the region level graph +//' +double choose_multidistrict_to_split( + Plan const&plan, int ®ion_id_to_split){ + + if(plan.num_multidistricts < 1){ + Rprintf("ERROR: Trying to find multidistrict to split when there are none!\n"); + } + + // count total + int total_multi_ds = 0; + + // make vectors with cumulative d value and region label for later + std::vector multi_d_vals; + std::vector region_ids; + + // Iterate over all regions + for(int region_id = 0; region_id < plan.num_regions; region_id++) { + + int d_val = plan.region_dvals.at(region_id); + + // collect info if multidistrict + if(d_val > 1){ + // Add that regions d value to the total + total_multi_ds += d_val; + // add the count and label to vector + multi_d_vals.push_back(d_val); + region_ids.push_back(region_id); + } + } + + // If only one then return that + if(multi_d_vals.size() == 1){ + region_id_to_split = multi_d_vals.at(0); + // probability of picking is 1 and log(1) = 0 + return 0; + } + + + // Now pick an index proportational to d_nk value + std::random_device rd; + std::mt19937 gen(rd()); + std::discrete_distribution<> d(multi_d_vals.begin(), multi_d_vals.end()); + + int idx = d(gen); + + region_id_to_split = region_ids[idx]; + double log_prob = std::log( + static_cast(multi_d_vals[idx]) + ) - std::log( + static_cast(total_multi_ds) + ); + + return log_prob; +} + + //' Attempts to cut one region into two from a spanning tree and if successful //' returns information on what the two new regions would be. Does not actually //' update the plan @@ -59,8 +134,6 @@ //' //' @return True if two valid regions were successfully split, false otherwise //' -//' -//' bool get_edge_to_cut(Tree &ust, int root, int k_param, bool split_district_only, const uvec &pop, const Plan &plan, const int region_id_to_split, @@ -346,3 +419,376 @@ void update_plan_from_cut( return; }; + + + + + + +//' Attempts to split a multi-district within a plan into two new regions with +//' valid population bounds (has option for one district splits only) +//' +//' Given a plan this attempts to split a multi-district in it into two new +//' regions where both regions have valid population bounds. (If +//' `split_district_only` is true it will only attempt to split off a district +//' and a remainder). It does this by drawing a spanning tree uniformly at random +//' then calling `get_edge_to_cut` on that. If the a valid cut is found it +//' then calls `update_plan_from_cut` to update the plan accordingly. If not +//' successful returns false and does nothing. +//' +//' This is based on the `split_map` function in `smc.cpp` +//' +//' +//' @title Attempt Generalized Region split of a multi-district within a plan +//' +//' @param g A graph (adjacency list) passed by reference +//' @param ust A directed tree object (this will be cleared in the function so +//' whatever it was before doesn't matter) +//' @param counties Vector of county labels of each vertex in `g` +//' @param cg multigraph object (not sure why this is needed) +//' @param plan A plan object +//' @param region_id_to_split The label of the region in the plan object we're attempting to split +//' @param new_region_ids A vector that will be updated by reference to contain the names of +//' the two new split regions if function is successful. +//' @param lower Acceptable lower bounds on a valid district's population +//' @param upper Acceptable upper bounds on a valid district's population +//' @param target Ideal population of a valid district. This is what deviance is calculated +//' relative to +//' Target population (probably Total population of map/Num districts) +//' @param k_param The k parameter from the SMC algorithm, you choose among the top k_param edges +//' @param split_district_only Whether or not to only allow for one district +//' split. If `true` then only splits off districts. +//' +//' @details Modifications +//' - If two new valid regions are split then the plan object is updated accordingly +//' - If two new valid regions are split then the new_region_ids is updated so the +//' first entry is the first new region and the second entry is the second new region +//' +//' @return True if two valid regions were split off false otherwise +//' +bool attempt_region_split(const Graph &g, Tree &ust, const uvec &counties, Multigraph &cg, + Plan &plan, const int region_id_to_split, + std::vector &new_region_ids, + std::vector &visited, std::vector &ignore, const uvec &pop, + double &lower, double upper, double target, + int k_param, bool split_district_only) { + + int V = g.size(); + + // Mark it as ignore if its not in the region to split + for (int i = 0; i < V; i++){ + ignore[i] = plan.region_num_ids.at(i) != region_id_to_split; + } + + // Get a uniform spanning tree drawn on that region + int root; + clear_tree(ust); + // Get a tree + int result = sample_sub_ust(g, ust, V, root, visited, ignore, pop, lower, upper, counties, cg); + // Return unsuccessful if tree not drawn + if (result != 0) return false; + + + // splitting related params + int new_region1_tree_root, new_region2_tree_root; + int new_region1_dval, new_region2_dval; + double new_region1_pop, new_region2_pop; + + + bool successful_edge_found; + + // try to get an edge to cut + successful_edge_found = get_edge_to_cut(ust, root, + k_param, split_district_only, pop, + plan, region_id_to_split, + lower, upper, target, + new_region1_tree_root, new_region1_dval, new_region1_pop, + new_region2_tree_root, new_region2_dval, new_region2_pop); + + int new_region1_id, new_region2_id; + + if(successful_edge_found){ + // if successful then update the plan + update_plan_from_cut( + ust, plan, + region_id_to_split, + new_region1_tree_root, new_region1_dval, new_region1_pop, + new_region2_tree_root, new_region2_dval, new_region2_pop, + new_region1_id, new_region2_id + ); + return true; + }else{ + return false; + } + +} + + + + + + + +//' Splits a multidistrict in all of the plans +//' +//' Using the procedure outlined in this function attempts to split +//' a multidistrict in a previous steps plan until M successful splits have been made. This +//' is based on the `split_maps` function in smc.cpp +//' +//' @title Split all the maps +//' +//' @param g A graph (adjacency list) passed by reference +//' @param counties Vector of county labels of each vertex in `g` +//' @param cg County level multigraph +//' @param pop A vector of the population associated with each vertex in `g` +//' @param old_plans_vec A vector of plans from the previous step +//' @param new_plans_vec A vector which will be filled with plans that had a +//' multidistrict split to make them +//' @param original_ancestor_vec A vector used to track which original ancestor +//' the new plans descended from. The value of `original_ancestor_vec[i]` +//' is the index of the original ancestor the new plan `new_plans_vec[i]` is +//' descended from. +//' @param parent_vec A vector used to track the index of the previous plan +//' sampled that was successfully split. The value of `parent_vec[i]` is the +//' index of the old plan from which the new plan `new_plans_vec[i]` was +//' successfully split from. In other words `new_plans_vec[i]` is equal to +//' `attempt_region_split(old_plans_vec[parent_vec[i]], ...)` +//' @param prev_ancestor_vec A vector used to track the index of the original +//' ancestor of the previous plans. The value of `prev_ancestor_vec[i]` is the +//' index of the original ancestor of `old_plans_vec[i]` +//' @param unnormalized_sampling_weights A vector of weights used to sample indices +//' of the `old_plans_vec`. The value of `unnormalized_sampling_weights[i]` is +//' the unnormalized probability that index i is selected +//' @param normalized_weights_to_fill_in A vector which will be filled with the +//' normalized weights the index sampler uses. The value of +//' `normalized_weights_to_fill_in[i]` is the probability that index i is selected +//' @param draw_tries_vec A vector used to keep track of how many plan split +//' attempts were made for index i. The value `draw_tries_vec[i]` represents how +//' many split attempts were made for the i-th new plan (including the successful +//' split). For example, `draw_tries_vec[i] = 1` means that the first split +//' attempt was successful. +//' @param parent_unsuccessful_tries_vec A vector used to keep track of how many times the +//' previous rounds plans were sampled and unsuccessfully split. The value +//' `parent_unsuccessful_tries_vec[i]` represents how many times `old_plans_vec[i]` was sampled +//' and then unsuccessfully split while creating all `M` of the new plans. +//' THIS MAY NOT BE THREAD SAFE +//' @param accept_rate The number of accepted splits over the total number of +//' attempted splits. This is equal to `sum(draw_tries_vec)/M` +//' @param n_unique_parent_indices The number of unique parent indices, ie the +//' number of previous plans that had at least one descendant amongst the new +//' plans. This is equal to `unique(parent_vec)` +//' @param n_unique_original_ancestors The number of unique original ancestors, +//' in the new plans. This is equal to `unique(original_ancestor_vec)` +//' @param ancestors Parameter from older `smc.cpp` code. I DON'T UNDERSTAND +//' WHAT IT IS DOING +//' @param lags Parameter from older `smc.cpp` code. I DON'T UNDERSTAND +//' WHAT IT IS DOING +//' @param lower Acceptable lower bounds on a valid district's population +//' @param upper Acceptable upper bounds on a valid district's population +//' @param target Ideal population of a valid district. This is what deviance is calculated +//' relative to +//' @param k_param The top edges to pick parameter for the region splitting +//' algorithm +//' @param split_district_only Whether or not to only allow for single district +//' splits. If set to `true` will only attempt to split off one district at a +//' time +//' @param pool A threadpool for multithreading +//' @param verbosity A parameter controlling the amount of detail printed out +//' during the algorithms running +//' +//' @details Modifications +//' - The `new_plans_vec` is updated with all the newly split plans +//' - The `old_plans_vec` is updated with all the newly split plans as well. +//' Note that the reason both this and `new_plans_vec` are updated is because +//' of the nature of the code you need both vectors and so both are passed by +//' reference to save memory. +//' - The `original_ancestor_vec` is updated to contain the indices of the +//' original ancestors of the new plans +//' - The `parent_vec` is updated to contain the indices of the parents of the + //' new plans +//' - If two new valid regions are split then the new_region_ids is updated so the +//' first entry is the first new region and the second entry is the second new region +//' - The `normalized_weights_to_fill_in` is updated to contain the normalized +//' probabilities the index sampler used. This is only collected for diagnostics +//' at this point and should just be equal to `unnormalized_sampling_weights` +//' divided by `sum(unnormalized_sampling_weights)` +//' - The `draw_tries_vec` is updated to contain the number of tries for each +//' of the new plans +//' - The `parent_unsuccessful_tries_vec` is updated to contain the number of unsuccessful +//' samples of the old plans +//' - The `accept_rate` is updated to contain the average acceptance rate for +//' this iteration +//' - `n_unique_parent_indices` and `n_unique_original_ancestors` are updated +//' with the unique number of parents and original ancestors for all the new +//' plans respectively +//' - `ancestors` is updated to something. THIS IS FROM ORIGINAL SMC CODE, +//' I DO NOT KNOW WHAT IT MEANS +//' +//' @return nothing +//' +void generalized_split_maps( + const Graph &g, const uvec &counties, Multigraph &cg, const uvec &pop, + std::vector &old_plans_vec, std::vector &new_plans_vec, + std::vector &original_ancestor_vec, + std::vector &parent_vec, + const std::vector &prev_ancestor_vec, + const std::vector &unnormalized_sampling_weights, + std::vector &normalized_weights_to_fill_in, + std::vector &draw_tries_vec, + std::vector &parent_unsuccessful_tries_vec, + double &accept_rate, + int &n_unique_parent_indices, + int &n_unique_original_ancestors, + umat &ancestors, const std::vector &lags, + double lower, double upper, double target, + int k_param, bool split_district_only, + RcppThread::ThreadPool &pool, + int verbosity + ) { + // important constants + const int V = g.size(); + const int M = old_plans_vec.size(); + + + uvec iters(M, fill::zeros); // how many actual iterations, (used to compute acceptance rate) + uvec original_ancestor_uniques(M); // used to compute unique original ancestors + uvec parent_index_uniques(M); // used to compute unique parent indicies + + // PREVIOUS SMC CODE I DONT KNOW WHAT IT DOES + const int dist_ctr = old_plans_vec.at(0).num_regions; + const int n_lags = lags.size(); + umat ancestors_new(M, n_lags); // lags/ancestor thing + + + + // Create the obj which will sample from the index with probability + // proportional to the weights + std::random_device rd; + std::mt19937 gen(rd()); + std::discrete_distribution<> index_sampler( + unnormalized_sampling_weights.begin(), + unnormalized_sampling_weights.end() + ); + + // extract and record the normalized weights the sampler is using + std::vector p = index_sampler.probabilities(); + int nw_index = 0; + bool print_weights = M < 12 && verbosity > 1; + if(print_weights){ + Rprintf("Unnormalized weights are: "); + for (auto w : unnormalized_sampling_weights){ + Rprintf("%.4f, ", w); + } + + Rprintf("\n"); + Rprintf("Normalized weights are: "); + } + for (auto prob : p){ + if(print_weights) Rprintf("%.4f, ", prob); + normalized_weights_to_fill_in.at(nw_index) = prob; + nw_index++; + } + if(print_weights) Rprintf("\n"); + + // Because of multithreading we have to add specific checks for if the user + // wants to quit the program + const int reject_check_int = 200; // check for interrupts every _ rejections + const int check_int = 50; // check for interrupts every _ iterations + + + // create a progress bar + RcppThread::ProgressBar bar(M, 1); + // Parallel thread pool where all objects in memory shared by default + pool.parallelFor(0, M, [&] (int i) { + int reject_ct = 0; + bool ok = false; + int idx; + int region_id_to_split; + std::vector new_region_ids(2, -1); + + Tree ust = init_tree(V); + std::vector visited(V); + std::vector ignore(V); + while (!ok) { + // increase the iters count by one + iters[i]++; + // use weights to sample previous plan + idx = index_sampler(gen); + Plan proposed_new_plan = old_plans_vec[idx]; + + // pick a region to try to split + choose_multidistrict_to_split( + old_plans_vec[idx], region_id_to_split); + + // Now try to split that region + ok = attempt_region_split(g, ust, counties, cg, + proposed_new_plan, region_id_to_split, + new_region_ids, + visited, ignore, pop, + lower, upper, target, + k_param, split_district_only); + + // bad sample; try again + if (!ok) { + // THIS MAY NOT BE THREAD SAFE + parent_unsuccessful_tries_vec[idx]++; // update unsuccessful try + RcppThread::checkUserInterrupt(++reject_ct % reject_check_int == 0); + continue; + } + + // else update the new plan and leave the while loop + new_plans_vec[i] = proposed_new_plan; + + } + + // Record how many tries needed to create i-th new plan + draw_tries_vec[i] = static_cast(iters[i]); + // Make the new plans original ancestor the same as its parent + original_ancestor_uniques[i] = prev_ancestor_vec[idx]; + // record index of new plan's parent + parent_index_uniques[i] = idx; + // clear the spanning tree + clear_tree(ust); + + // ORIGINAL SMC CODE I DONT KNOW WHAT THIS DOES + // save ancestors/lags + for (int j = 0; j < n_lags; j++) { + if (dist_ctr <= lags[j]) { + ancestors_new(i, j) = i; + } else { + ancestors_new(i, j) = ancestors(idx, j); + } + } + + + // update this particles ancestor to be the ancestor of its previous one + parent_vec[i] = idx; + original_ancestor_vec[i] = prev_ancestor_vec[idx]; + + RcppThread::checkUserInterrupt(i % check_int == 0); + }); + + // Wait for all the threads to finish + pool.wait(); + + + + // now replace the old plans with the new ones + for(int i=0; i < M; i++){ + old_plans_vec[i] = new_plans_vec[i]; + } + + + // now compute acceptance rate and unique parents and original ancestors + accept_rate = M / (1.0 * sum(iters)); + n_unique_original_ancestors = ((uvec) find_unique(original_ancestor_uniques)).n_elem; + n_unique_parent_indices = ((uvec) find_unique(parent_index_uniques)).n_elem; + if (verbosity >= 3) { + Rprintf("%.2f acceptance rate, %d unique parent indices sampled, and %d unique original ancestors!\n", + 100.0 * accept_rate, (int) n_unique_parent_indices , (int) n_unique_original_ancestors); + } + + // ORIGINAL SMC CODE I DONT KNOW WHAT IT DOES + ancestors = ancestors_new; + +} diff --git a/src/splitting.h b/src/splitting.h index a7ca6459f..38f1e8784 100644 --- a/src/splitting.h +++ b/src/splitting.h @@ -18,8 +18,84 @@ #include "tree_op.h" #include "map_calc.h" #include "redist_types.h" -#include "gsmc_helpers.h" + +//' Selects a multidistrict with probability proportional to its d_nk value and +//' returns the log probability of the selected region +//' +//' Given a plan object with at least one multidistrict this function randomly +//' selects a multidistrict with probability proporitional to its d_nk value +//' (relative to all multidistricts) and returns the log of the probability that +//' region was chosen. +//' +//' +//' @title Choose multidistrict to split +//' +//' @param plan A plan object +//' @param region_to_split an integer that will be updated by reference with the +//' id number of the region selected to split +//' +//' @details No modifications to inputs made +//' +//' @return the region level graph +//' +double choose_multidistrict_to_split( + Plan const&plan, int ®ion_id_to_split); + + + +//' Attempts to cut one region into two from a spanning tree and if successful +//' returns information on what the two new regions would be. Does not actually +//' update the plan +//' +//' Takes a spanning tree `ust` drawn on a specific region and attempts to cut +//' it to produce two new regions using the generalized splitting procedure +//' outlined . This function is based on `cut_districts` in `smc.cpp` +//' however the crucial difference is even if a cut is successful it does not +//' update the plan. Instead it just returns the information on the two new +//' regions if successful and the vertices to use to update the plans. +//' +//' Depending on the value of split_district_only will only attempt to split off +//' a single district or allows for more general splits. +//' +//' By convention the first new region (`new_region1`) will always be the region +//' with the smaller d-value (although they can be equal). +//' +//' @title Attempt to Cut Region Tree into Two New Regions +//' +//' @param ust A directed spanning tree passed by reference +//' @param root The root vertex of the spanning tree +//' @param k_param The k parameter from the SMC algorithm, you choose among the top k_param edges +//' @param split_district_only If true then only tries to split a district, if false allows for +//' arbitrary region splits +//' @param pop A vector of the population associated with each vertex in `g` +//' @param plan A plan object +//' @param region_id_to_split The id of the region in the plan object we're attempting to split +//' @param lower Acceptable lower bounds on a valid district's population +//' @param upper Acceptable upper bounds on a valid district's population +//' @param target Ideal population of a valid district. This is what deviance is calculated +//' relative to +//' @param new_region1_tree_root The index of the root of tree associated with +//' the first new region (if the tree cut was successful) +//' @param new_region1_dval The d-value of the first new region (if the tree cut +//' was successful) +//' @param new_region1_pop The population of the first new region (if the tree cut +//' was successful) +//' @param new_region2_tree_root The index of the root of tree associated with +//' the second new region (if the tree cut was successful) +//' @param new_region2_dval The d-value of the second new region (if the tree cut +//' was successful) +//' @param new_region2_pop The population of the second new region (if the tree cut +//' was successful) +//' +//' @details Modifications +//' - If two new valid regions are split then the tree `ust` is cut into two +//' distjoint pieces +//' - If two new valid regions are split then the 6 `new_region` inputs are all +//' updated by reference with the values associated with the new regions +//' +//' @return True if two valid regions were successfully split, false otherwise +//' bool get_edge_to_cut(Tree &ust, int root, int k_param, bool split_district_only, const uvec &pop, const Plan &plan, const int region_id_to_split, @@ -29,6 +105,38 @@ bool get_edge_to_cut(Tree &ust, int root, ); + +//' Updates a `Plan` object using a cut tree +//' +//' Takes a cut spanning tree `ust` and variables on the two new regions +//' induced by the cuts and updates `plan` to add those two new regions. +//' +//' +//' @title Update plan regions from cut tree +//' +//' @param ust A cut (ie has two partition pieces) directed spanning tree +//' passed by reference +//' @param plan A plan object +//' @param old_region_id The id of old (split) region +//' @param new_region1_tree_root The vertex of the root of one piece of the cut +//' tree. This always corresponds to the region with the smaller dval (allowing +//' for the possiblity the dvals are equal). +//' @param new_region1_dval The dval associated with the new region 1 +//' @param new_region1_pop The population associated with the new region 1 +//' @param new_region2_tree_root The vertex of the root of other piece of the cut +//' tree. This always corresponds to the region with the bigger dval (allowing +//' for the possiblity the dvals are equal). +//' @param new_region2_dval The dval associated with the new region 2 +//' @param new_region2_pop The population associated with the new region 2 +//' @param new_region1_id The id the new region 1 was assigned in the plan +//' @param new_region2_id The id the new region 2 was assigned in the plan +//' +//' @details Modifications +//' - `plan` is updated in place with the two new regions and the old region +//' is removed +//' - `new_region1_id` and `new_region2_id` are updated by reference to what +//' the values of the two new region ids were set to +//' void update_plan_from_cut( Tree &ust, Plan &plan, const int old_region_id, @@ -37,4 +145,124 @@ void update_plan_from_cut( int &new_region1_id, int &new_region2_id ); + + +//' Splits a multidistrict in all of the plans +//' +//' Using the procedure outlined in this function attempts to split +//' a multidistrict in a previous steps plan until M successful splits have been made. This +//' is based on the `split_maps` function in smc.cpp +//' +//' @title Split all the maps +//' +//' @param g A graph (adjacency list) passed by reference +//' @param counties Vector of county labels of each vertex in `g` +//' @param cg County level multigraph +//' @param pop A vector of the population associated with each vertex in `g` +//' @param old_plans_vec A vector of plans from the previous step +//' @param new_plans_vec A vector which will be filled with plans that had a +//' multidistrict split to make them +//' @param original_ancestor_vec A vector used to track which original ancestor +//' the new plans descended from. The value of `original_ancestor_vec[i]` +//' is the index of the original ancestor the new plan `new_plans_vec[i]` is +//' descended from. +//' @param parent_vec A vector used to track the index of the previous plan +//' sampled that was successfully split. The value of `parent_vec[i]` is the +//' index of the old plan from which the new plan `new_plans_vec[i]` was +//' successfully split from. In other words `new_plans_vec[i]` is equal to +//' `attempt_region_split(old_plans_vec[parent_vec[i]], ...)` +//' @param prev_ancestor_vec A vector used to track the index of the original +//' ancestor of the previous plans. The value of `prev_ancestor_vec[i]` is the +//' index of the original ancestor of `old_plans_vec[i]` +//' @param unnormalized_sampling_weights A vector of weights used to sample indices +//' of the `old_plans_vec`. The value of `unnormalized_sampling_weights[i]` is +//' the unnormalized probability that index i is selected +//' @param normalized_weights_to_fill_in A vector which will be filled with the +//' normalized weights the index sampler uses. The value of +//' `normalized_weights_to_fill_in[i]` is the probability that index i is selected +//' @param draw_tries_vec A vector used to keep track of how many plan split +//' attempts were made for index i. The value `draw_tries_vec[i]` represents how +//' many split attempts were made for the i-th new plan (including the successful +//' split). For example, `draw_tries_vec[i] = 1` means that the first split +//' attempt was successful. +//' @param parent_unsuccessful_tries_vec A vector used to keep track of how many times the +//' previous rounds plans were sampled and unsuccessfully split. The value +//' `parent_unsuccessful_tries_vec[i]` represents how many times `old_plans_vec[i]` was sampled +//' and then unsuccessfully split while creating all `M` of the new plans. +//' THIS MAY NOT BE THREAD SAFE +//' @param accept_rate The number of accepted splits over the total number of +//' attempted splits. This is equal to `sum(draw_tries_vec)/M` +//' @param n_unique_parent_indices The number of unique parent indices, ie the +//' number of previous plans that had at least one descendant amongst the new +//' plans. This is equal to `unique(parent_vec)` +//' @param n_unique_original_ancestors The number of unique original ancestors, +//' in the new plans. This is equal to `unique(original_ancestor_vec)` +//' @param ancestors Parameter from older `smc.cpp` code. I DON'T UNDERSTAND +//' WHAT IT IS DOING +//' @param lags Parameter from older `smc.cpp` code. I DON'T UNDERSTAND +//' WHAT IT IS DOING +//' @param lower Acceptable lower bounds on a valid district's population +//' @param upper Acceptable upper bounds on a valid district's population +//' @param target Ideal population of a valid district. This is what deviance is calculated +//' relative to +//' @param k_param The top edges to pick parameter for the region splitting +//' algorithm +//' @param split_district_only Whether or not to only allow for single district +//' splits. If set to `true` will only attempt to split off one district at a +//' time +//' @param pool A threadpool for multithreading +//' @param verbosity A parameter controlling the amount of detail printed out +//' during the algorithms running +//' +//' @details Modifications +//' - The `new_plans_vec` is updated with all the newly split plans +//' - The `old_plans_vec` is updated with all the newly split plans as well. +//' Note that the reason both this and `new_plans_vec` are updated is because +//' of the nature of the code you need both vectors and so both are passed by +//' reference to save memory. +//' - The `original_ancestor_vec` is updated to contain the indices of the +//' original ancestors of the new plans +//' - The `parent_vec` is updated to contain the indices of the parents of the + //' new plans +//' - If two new valid regions are split then the new_region_ids is updated so the +//' first entry is the first new region and the second entry is the second new region +//' - The `normalized_weights_to_fill_in` is updated to contain the normalized +//' probabilities the index sampler used. This is only collected for diagnostics +//' at this point and should just be equal to `unnormalized_sampling_weights` +//' divided by `sum(unnormalized_sampling_weights)` +//' - The `draw_tries_vec` is updated to contain the number of tries for each +//' of the new plans +//' - The `parent_unsuccessful_tries_vec` is updated to contain the number of unsuccessful +//' samples of the old plans +//' - The `accept_rate` is updated to contain the average acceptance rate for +//' this iteration +//' - `n_unique_parent_indices` and `n_unique_original_ancestors` are updated +//' with the unique number of parents and original ancestors for all the new +//' plans respectively +//' - `ancestors` is updated to something. THIS IS FROM ORIGINAL SMC CODE, +//' I DO NOT KNOW WHAT IT MEANS +//' +//' @return nothing +//' +void generalized_split_maps( + const Graph &g, const uvec &counties, Multigraph &cg, const uvec &pop, + std::vector &old_plans_vec, std::vector &new_plans_vec, + std::vector &original_ancestor_vec, + std::vector &parent_vec, + const std::vector &prev_ancestor_vec, + const std::vector &unnormalized_sampling_weights, + std::vector &normalized_weights_to_fill_in, + std::vector &draw_tries_vec, + std::vector &parent_unsuccessful_tries_vec, + double &accept_rate, + int &n_unique_parent_indices, + int &n_unique_original_ancestors, + umat &ancestors, const std::vector &lags, + double lower, double upper, double target, + int k_param, bool split_district_only, + RcppThread::ThreadPool &pool, + int verbosity +); + + #endif diff --git a/src/tree_op.cpp b/src/tree_op.cpp index 572107e95..02e896069 100644 --- a/src/tree_op.cpp +++ b/src/tree_op.cpp @@ -93,6 +93,66 @@ Graph district_graph(const Graph &g, const uvec &plan, int nd, bool zero) { } + +// NOT FULLY TESTED but taken from district_graph function which was tested +//' Creates the region level graph of a plan +//' +//' Given a plan object this returns a graph of the regions in the plan using +//' the region ids as indices +//' +//' @title Get Region-Level Graph +//' +//' @param g The graph of the entire map +//' @param plan A plan object +//' +//' @details No modifications to inputs made +//' +//' @return the log of the probability the specific value of `region_to_split` was chosen +//' +Graph get_region_graph(const Graph &g, const Plan &plan) { + int V = g.size(); + Graph out; + + // make a matrix where entry i,j represents if region i and j are adjacent + std::vector> gr_bool( + plan.num_regions, std::vector(plan.num_regions, false) + ); + + // iterate over all vertices in g + for (int i = 0; i < V; i++) { + std::vector nbors = g[i]; + // Find out which region this vertex corresponds to + int region_num_i = plan.region_num_ids[i]; + + // now iterate over its neighbors + for (int nbor : nbors) { + // find which region neighbor corresponds to + int region_num_j = plan.region_num_ids[nbor]; + // if they are different regions mark matrix true since region i + // and region j are adjacent as they share an edge across + if (region_num_i != region_num_j) { + gr_bool.at(region_num_i).at(region_num_j) = true; + } + } + } + + + // Now build the region level graph + for (int i = 0; i < plan.num_regions; i++) { + // create vector of i's neighbors + std::vector tmp; + for (int j = 0; j < plan.num_regions; j++) { + // check if i and j are adjacent, if so add j + if (gr_bool.at(i).at(j)) { + tmp.push_back(j); + } + } + out.push_back(tmp); + } + + return out; +} + /* * Initialize empty multigraph structure on graph with `V` vertices */ diff --git a/src/tree_op.h b/src/tree_op.h index c2389cecb..5128a0215 100644 --- a/src/tree_op.h +++ b/src/tree_op.h @@ -29,6 +29,25 @@ Multigraph county_graph(const Graph &g, const uvec &counties); // TESTED Graph district_graph(const Graph &g, const uvec &plan, int nd, bool zero=false); + +// NOT FULLY TESTED but taken from district_graph function which was tested +//' Creates the region level graph of a plan +//' +//' Given a plan object this returns a graph of the regions in the plan using +//' the region ids as indices +//' +//' @title Get Region-Level Graph +//' +//' @param g The graph of the entire map +//' @param plan A plan object +//' +//' @details No modifications to inputs made +//' +//' @return the log of the probability the specific value of `region_to_split` was chosen +//' +Graph get_region_graph(const Graph &g, const Plan &plan); + + /* * Initialize empty multigraph structure on graph with `V` vertices */ diff --git a/src/gsmc_helpers.cpp b/src/weights.cpp similarity index 76% rename from src/gsmc_helpers.cpp rename to src/weights.cpp index 775a03d12..de2ba6c26 100644 --- a/src/gsmc_helpers.cpp +++ b/src/weights.cpp @@ -1,5 +1,11 @@ -#include "gsmc_helpers.h" +/******************************************************** +* Author: Philip O'Sullivan +* Institution: Harvard University +* Date Created: 2024/11 +* Purpose: SMC weight calculation related functions +********************************************************/ +#include "weights.h" //' Computes the effective sample size from log incremental weights //' @@ -35,6 +41,8 @@ double compute_n_eff(const std::vector &log_wgt) { + + //' Returns the log of the count of the number of edges across two regions in //' the underlying graph. //' @@ -58,7 +66,7 @@ double compute_n_eff(const std::vector &log_wgt) { double region_log_boundary(const Graph &g, const Plan &plan, int const®ion1_id, int const®ion2_id - ) { +) { int V = g.size(); // get number of vertices double count = 0; // count of number of edges across the two regions @@ -87,74 +95,6 @@ double compute_n_eff(const std::vector &log_wgt) { } return std::log(count); - } - - - -//' Selects a multidistrict with probability proportional to its d_nk value and -//' returns the log probability of the selected region -//' -//' Given a plan object with at least one multidistrict this function randomly -//' selects a multidistrict with probability proporitional to its d_nk value -//' (relative to all multidistricts) and returns the log of the probability that -//' region was chosen. -//' -//' -//' @title Choose multidistrict to split -//' -//' @param plan A plan object -//' @param region_to_split an integer that will be updated by reference with the -//' id number of the region selected to split -//' -//' @details No modifications to inputs made -//' -//' @return the region level graph -//' -double choose_multidistrict_to_split( - Plan const&plan, int ®ion_id_to_split){ - - if(plan.num_multidistricts < 1){ - Rprintf("ERROR: Trying to find multidistrict to split when there are none!\n"); - } - - // count total - int total_multi_ds = 0; - - // make vectors with cumulative d value and region label for later - std::vector multi_d_vals; - std::vector region_ids; - - // Iterate over all regions - for(int region_id = 0; region_id < plan.num_regions; region_id++) { - - int d_val = plan.region_dvals.at(region_id); - - // collect info if multidistrict - if(d_val > 1){ - // Add that regions d value to the total - total_multi_ds += d_val; - // add the count and label to vector - multi_d_vals.push_back(d_val); - region_ids.push_back(region_id); - } - } - - - // Now pick an index proportational to d_nk value - std::random_device rd; - std::mt19937 gen(rd()); - std::discrete_distribution<> d(multi_d_vals.begin(), multi_d_vals.end()); - - int idx = d(gen); - - region_id_to_split = region_ids[idx]; - double log_prob = std::log( - static_cast(multi_d_vals[idx]) - ) - std::log( - static_cast(total_multi_ds) - ); - - return log_prob; } @@ -162,67 +102,6 @@ double choose_multidistrict_to_split( -// NOT FULLY TESTED but taken from district_graph function which was tested - -//' Creates the region level graph of a plan -//' -//' Given a plan object this returns a graph of the regions in the plan using -//' the region ids as indices -//' -//' @title Get Region-Level Graph -//' -//' @param g The graph of the entire map -//' @param plan A plan object -//' -//' @details No modifications to inputs made -//' -//' @return the log of the probability the specific value of `region_to_split` was chosen -//' -Graph get_region_graph(const Graph &g, const Plan &plan) { - int V = g.size(); - Graph out; - - // make a matrix where entry i,j represents if region i and j are adjacent - std::vector> gr_bool( - plan.num_regions, std::vector(plan.num_regions, false) - ); - - // iterate over all vertices in g - for (int i = 0; i < V; i++) { - std::vector nbors = g[i]; - // Find out which region this vertex corresponds to - int region_num_i = plan.region_num_ids[i]; - - // now iterate over its neighbors - for (int nbor : nbors) { - // find which region neighbor corresponds to - int region_num_j = plan.region_num_ids[nbor]; - // if they are different regions mark matrix true since region i - // and region j are adjacent as they share an edge across - if (region_num_i != region_num_j) { - gr_bool.at(region_num_i).at(region_num_j) = true; - } - } - } - - - // Now build the region level graph - for (int i = 0; i < plan.num_regions; i++) { - // create vector of i's neighbors - std::vector tmp; - for (int j = 0; j < plan.num_regions; j++) { - // check if i and j are adjacent, if so add j - if (gr_bool.at(i).at(j)) { - tmp.push_back(j); - } - } - out.push_back(tmp); - } - - return out; -} - - //' Get the probability the union of two regions was chosen to split //' //' Given a plan object and two regions in the plan this returns the probability diff --git a/src/weights.h b/src/weights.h new file mode 100644 index 000000000..e9a9eed3a --- /dev/null +++ b/src/weights.h @@ -0,0 +1,47 @@ +#pragma once +#ifndef WEIGHTS_H +#define WEIGHTS_H + +// [[Rcpp::depends(redistmetrics)]] + +#include "smc_base.h" + + +#include +#include +#include +#include +#include // for std::pair +#include +#include "redist_types.h" +#include "tree_op.h" + + +//' Computes the effective sample size from log incremental weights +//' +//' Takes a vector of log incremental weights and computes the effective sample +//' size which is the sum of the weights squared divided by the sum of squared +//' weights +//' +//' +//' @title Compute Effective Sample Size +//' +//' @param log_wgt vector of log incremental weights +//' +//' @details No modifications to inputs made +//' +//' @return sum of weights squared over sum of squared weights (sum(wgt)^2 / sum(wgt^2)) +//' +double compute_n_eff(const std::vector &log_wgt); + + +double compute_log_incremental_weight( + const Graph &g, const Plan &plan, + const double target, const double pop_temper); + +double compute_basic_smc_log_incremental_weight( + const Graph &g, const Plan &plan, + const double target, const double pop_temper); + + +#endif From e4c7b57f60876921a0a52de1391169e2b5b18dd6 Mon Sep 17 00:00:00 2001 From: "Philip W. O'Sullivan" Date: Fri, 1 Nov 2024 02:13:00 -0400 Subject: [PATCH 025/324] created all purpose code to handle smc and gsmc with optimal weights --- NAMESPACE | 2 + R/RcppExports.R | 67 +++++++ R/redist_optimal_gsmc.R | 392 +++++++++++++++++++++++++++++++++++++ man/optimal_gsmc_plans.Rd | 56 ++++++ man/redist_basic_smc.Rd | 1 + man/redist_gsmc.Rd | 4 + man/redist_optimal_gsmc.Rd | 37 ++++ src/RcppExports.cpp | 23 +++ src/optimal_gsmc.cpp | 322 ++++++++++++++++++++++++++++++ src/optimal_gsmc.h | 58 ++++++ src/splitting.cpp | 15 +- src/splitting.h | 8 + src/weights.cpp | 90 ++++++++- src/weights.h | 40 ++++ 14 files changed, 1099 insertions(+), 16 deletions(-) create mode 100644 R/redist_optimal_gsmc.R create mode 100644 man/optimal_gsmc_plans.Rd create mode 100644 man/redist_optimal_gsmc.Rd create mode 100644 src/optimal_gsmc.cpp create mode 100644 src/optimal_gsmc.h diff --git a/NAMESPACE b/NAMESPACE index be5e8f0de..da2d27c5f 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -106,6 +106,7 @@ export(merge_by) export(min_move_parity) export(muni_splits) export(number_by) +export(optimal_gsmc_plans) export(partisan_metrics) export(pl) export(plan_distances) @@ -182,6 +183,7 @@ export(redist_map) export(redist_mcmc_ci) export(redist_mergesplit) export(redist_mergesplit_parallel) +export(redist_optimal_gsmc) export(redist_plans) export(redist_quantile_trunc) export(redist_shortburst) diff --git a/R/RcppExports.R b/R/RcppExports.R index aeef7d962..7a99e8d78 100644 --- a/R/RcppExports.R +++ b/R/RcppExports.R @@ -159,6 +159,33 @@ ms_plans <- function(N, l, init, counties, pop, n_distr, target, lower, upper, r .Call(`_redist_ms_plans`, N, l, init, counties, pop, n_distr, target, lower, upper, rho, constraints, control, k, thin, verbosity) } +#' Uses gsmc method with optimal weights to generate a sample of `M` plans in `c++` +#' +#' Using the procedure outlined in this function uses Sequential +#' Monte Carlo (SMC) methods to generate a sample of `M` plans +#' +#' @title Run Optimalgsmc +#' +#' @param N The number of districts the final plans will have +#' @param adj_list A 0-indexed adjacency list representing the undirected graph +#' which represents the underlying map the plans are to be drawn on +#' @param counties Vector of county labels of each vertex in `g` +#' @param pop A vector of the population associated with each vertex in `g` +#' @param target Ideal population of a valid district. This is what deviance is calculated +#' relative to +#' @param lower Acceptable lower bounds on a valid district's population +#' @param upper Acceptable upper bounds on a valid district's population +#' @param M The number of plans (samples) to draw +#' @param k_param The k parameter from the SMC algorithm, you choose among the top k_param edges +#' @param control Named list of additional parameters. +#' @param num_threads The number of threads the threadpool should use +#' @param verbosity What level of detail to print out while the algorithm is +#' running +#' @export +optimal_gsmc_plans <- function(N, adj_list, counties, pop, target, lower, upper, M, control, ncores = -1L, verbosity = 3L, diagnostic_mode = FALSE) { + .Call(`_redist_optimal_gsmc_plans`, N, adj_list, counties, pop, target, lower, upper, M, control, ncores, verbosity, diagnostic_mode) +} + pareto_dominated <- function(x) { .Call(`_redist_pareto_dominated`, x) } @@ -262,6 +289,8 @@ dist_cty_splits <- function(dm, community, nd) { #' #' @return the region level graph #' +#' @noRd +#' @keywords internal NULL #' Attempts to cut one region into two from a spanning tree and if successful @@ -316,6 +345,8 @@ NULL #' #' @return True if two valid regions were successfully split, false otherwise #' +#' @noRd +#' @keywords internal NULL #' Updates a `Plan` object using a cut tree @@ -349,6 +380,8 @@ NULL #' - `new_region1_id` and `new_region2_id` are updated by reference to what #' the values of the two new region ids were set to #' +#' @noRd +#' @keywords internal NULL #' Splits a multidistrict in all of the plans @@ -449,6 +482,8 @@ NULL #' #' @return nothing #' +#' @noRd +#' @keywords internal NULL perform_a_valid_region_split <- function(adj_list, counties, pop, k_param, region_id_to_split, target, lower, upper, N, num_regions, num_districts, region_ids, region_dvals, region_pops, split_district_only, verbose) { @@ -512,6 +547,38 @@ var_info_vec <- function(m, ref, pop) { #' NULL +#' Computes log unnormalized weights for vector of plans +#' +#' Using the procedure outlined in this function computes the log +#' incremental weights and the unnormalized weights for a vector of plans (which +#' may or may not be the same depending on the parameters). +#' +#' @title Compute Log Unnormalized Weights +#' +#' @param pool A threadpool for multithreading +#' @param g A graph (adjacency list) passed by reference +#' @param plans_vec A vector of plans to compute the log unnormalized weights +#' of +#' @param split_district_only whether or not to compute the weights under +#' the district only split scheme or not. If `split_district_only` is true +#' then uses optimal weights from one-district split scheme. +#' @param log_incremental_weights A vector of the log incremental weights +#' computed for the plans. The value of `log_incremental_weights[i]` is +#' the log incremental weight for `plans_vec[i]` +#' @param unnormalized_sampling_weights A vector of the unnormalized sampling +#' weights to be used with sampling the `plans_vec` in the next iteration of the +#' algorithm. Depending on the other hyperparameters this may or may not be the +#' same as `exp(log_incremental_weights)` +#' @param target Target population of a single district +#' @param pop_temper
+#' +#' @details Modifications +#' - The `log_incremental_weights` is updated to contain the incremental +#' weights of the plans +#' - The `unnormalized_sampling_weights` is updated to contain the unnormalized +#' sampling weights of the plans for the next round +NULL + sample_ust <- function(l, pop, lower, upper, counties, ignore) { .Call(`_redist_sample_ust`, l, pop, lower, upper, counties, ignore) } diff --git a/R/redist_optimal_gsmc.R b/R/redist_optimal_gsmc.R new file mode 100644 index 000000000..79b283618 --- /dev/null +++ b/R/redist_optimal_gsmc.R @@ -0,0 +1,392 @@ +##################################################### +# Author: Philip O'Sullivan +# Institution: Harvard University +# Date Created: 2024/08/18 +# Purpose: tidy R wrapper to run gSMC redistricting code +#################################################### + + +#' OptimalgSMC Redistricting Sampler +#' +#' @param k_params Either a single value to use as the splitting parameter for +#' every round or a vector of length N-1 where each value is the one to use for +#' a split. +#' @param multiprocess Whether or not to launch multiple processes (sometimes +#' better to disable to avoid using too much memory.) +#' +#' @return `redist_smc` returns a [redist_plans] object containing the simulated +#' plans. +#' +#' @export +redist_optimal_gsmc <- function(state_map, M, counties = NULL, + k_params = 6, split_district_only = FALSE, + resample = TRUE, runs = 1L, + ncores = 0L, multiprocess=TRUE, + pop_temper = 0, + verbose = FALSE, silent = FALSE, diagnostic_mode = FALSE){ + N <- attr(state_map, "ndists") + + # figure out the alg type + if(split_district_only){ + alg_type <- "basic_smc" + }else{ + alg_type <- "gsmc" + } + + # no constraints + constraints <- list() + + + # make controls intput + lags <- 1 + unique(round((N - 1)^0.8*seq(0, 0.7, length.out = 4)^0.9)) + + # check k param imput + if(any(k_params < 1)) { + cli_abort("K parameter values must be all at least 1.") + } + + # if just a single number then repeat it + if(length(k_params) == 1 && floor(k_params) == k_params){ + k_params <- rep(k_params, N-1) + }else if(length(k_params) != N-1){ + cli_abort("K parameter input must be either 1 value or N-1!") + }else if(any(floor(k_params) != k_params)){ + # if either the length is not N-1 or its not all integers then throw + # error + cli_abort("K parameter values must be all integers") + } + + control <- list( + lags=lags, + pop_temper = pop_temper, + k_params = k_params, + split_district_only = split_district_only) + + # verbosity stuff + verbosity <- 1 + if (verbose) verbosity <- 3 + if (silent) verbosity <- 0 + + + # get the map in adjacency form + map <- validate_redist_map(state_map) + V <- nrow(state_map) + adj_list <- get_adj(state_map) + + + + + counties <- rlang::eval_tidy(rlang::enquo(counties), map) + if (is.null(counties)) { + counties <- rep(1, V) + } else { + if (any(is.na(counties))) + cli_abort("County vector must not contain missing values.") + + # handle discontinuous counties + component <- contiguity(adj_list, vctrs::vec_group_id(counties)) + counties <- dplyr::if_else(component > 1, + paste0(as.character(counties), "-", component), + as.character(counties)) %>% + as.factor() %>% + as.integer() + if (any(component > 1)) { + cli_warn("Counties were not contiguous; expect additional splits.") + } + } + + + + + # get population stuff + pop_bounds <- attr(map, "pop_bounds") + pop <- map[[attr(map, "pop_col")]] + if (any(pop >= pop_bounds[3])) { + too_big <- as.character(which(pop >= pop_bounds[3])) + cli_abort(c("Unit{?s} {too_big} ha{?ve/s/ve} + population larger than the district target.", + "x" = "Redistricting impossible.")) + } + + # compute lags thing + lags <- 1 + unique(round((N - 1)^0.8*seq(0, 0.7, length.out = 4)^0.9)) + + + # set up parallel + ncores_max <- parallel::detectCores() + ncores_runs <- min(ncores_max, runs) + ncores_per <- as.integer(ncores) + if (ncores_per == 0) { + if (M/100*length(adj_list)/200 < 20) { + ncores_per <- 1L + } else { + ncores_per <- floor(ncores_max/ncores_runs) + } + } + + # if sequentially + if(!multiprocess){ + # either max cores if + if(ncores == 0){ + ncores_per = ncores_max + }else{ + ncores_per = ncores + } + } + + + if (ncores_runs > 1 && multiprocess) { + `%oper%` <- `%dorng%` + of <- if (Sys.info()[["sysname"]] == "Windows") { + tempfile(pattern = paste0("smc_", substr(Sys.time(), 1, 10)), fileext = ".txt") + } else { + "" + } + + if (!silent) + cl <- makeCluster(ncores_runs, outfile = of, methods = FALSE, + useXDR = .Platform$endian != "little") + else + cl <- makeCluster(ncores_runs, methods = FALSE, + useXDR = .Platform$endian != "little") + doParallel::registerDoParallel(cl, cores = ncores_runs) + on.exit(stopCluster(cl)) + } else { + `%oper%` <- `%do%` + } + + + + t1 <- Sys.time() + all_out <- foreach(chain = seq_len(runs), .inorder = FALSE, .packages="redist") %oper% { + + + run_verbosity <- if (chain == 1 || !multiprocess) verbosity else 0 + t1_run <- Sys.time() + + algout <- redist::optimal_gsmc_plans( + N=N, + adj_list=adj_list, + counties=counties, + pop=pop, + target=pop_bounds[2], + lower=pop_bounds[1], + upper=pop_bounds[3], + M=M, + control = control, + ncores = as.integer(ncores_per), + verbosity=run_verbosity, + diagnostic_mode=diagnostic_mode) + + + if (length(algout) == 0) { + cli::cli_process_done() + cli::cli_process_done() + } + + + # make each element of region_ids_mat_list a V by M matrix + algout$region_ids_mat_list <- lapply( + algout$region_ids_mat_list, + function(x) matrix(unlist(x), ncol = length(x), byrow = FALSE) + 1 + ) + + # make each element of region_dvals_mat_list a V by M matrix + algout$region_dvals_mat_list <- lapply( + algout$region_dvals_mat_list, + function(x) matrix(unlist(x), ncol = length(x), byrow = FALSE) + ) + + # make original ancestor matrix + # add 1 for R indexing + algout$original_ancestors_mat <- matrix( + unlist(algout$original_ancestors), + ncol = length(algout$original_ancestors), + byrow = FALSE) + 1 + algout$original_ancestors <- NULL + + # make parent mat into matrix + # add 1 for R indexing + algout$parent_index <- matrix( + unlist(algout$parent_index), + ncol = length(algout$parent_index), + byrow = FALSE) + 1 + + # make draws tries into a matrix + algout$draw_tries_mat <- matrix( + unlist(algout$draw_tries_mat), + ncol = length(algout$draw_tries_mat), + byrow = FALSE) + + # make parent unsuccessful tries into a matrix + algout$parent_unsuccessful_tries_mat <- matrix( + unlist(algout$parent_unsuccessful_tries_mat), + ncol = length(algout$parent_unsuccessful_tries_mat), + byrow = FALSE) + + # make parent succesful tries matrix counting the number of + # times a parent index was successfully sampled + parent_successful_tries_mat <- apply( + algout$parent_index, 2, tabulate, nbins = M + ) + + # make the log incremental weights into a matrix + algout$log_incremental_weights_mat <- matrix( + unlist(algout$log_incremental_weights_mat), + ncol = length(algout$log_incremental_weights_mat), + byrow = FALSE) + + # pull out the log weights + lr <- algout$log_incremental_weights_mat[,N-1] + + wgt <- exp(lr - mean(lr)) + n_eff <- length(wgt)*mean(wgt)^2/mean(wgt^2) + + if(diagnostic_mode){ + # add a plans matrix as the final output because first + # N-2 are previous results + algout$plans <- algout$region_ids_mat_list[[N-1]] + + algout$final_region_labs <- matrix( + unlist(algout$final_region_labs), + ncol = length(algout$final_region_labs), + byrow = FALSE) + + }else{ + # Just add first element since not diagnostic mode the first N-2 + # steps were not tracked + algout$plans <- algout$region_ids_mat_list[[1]] + + # make the region_ids_mat_list input just null since there's nothing else + algout$region_ids_mat_list <- NULL + algout$region_dvals_mat_list <- NULL + algout$final_region_labs <- NULL + } + + if (any(is.na(lr))) { + cli_abort(c("Sampling probabilities have been corrupted.", + "*" = "Check that none of your constraint weights are too large. + The output of constraint functions multiplied by the weight + should generally fall in the -5 to 5 range.", + "*" = "If you are using custom constraints, make sure that your + constraint function handles all edge cases and never returns + {.val {NA}} or {.val {Inf}}", + "*" = "If you are not using any constraints, please call + {.code rlang::trace_back()} and file an issue at + {.url https://github.com/alarm-redist/redist/issues/new}")) + } + + + + if (resample) { + normalized_wgts <- wgt/sum(wgt) + n_eff <- 1/sum(normalized_wgts^2) + + rs_idx <- resample_lowvar(normalized_wgts) + n_unique <- dplyr::n_distinct(rs_idx) + # makes algout$plans[i] now equal to algout$plans[rs_idx[i]] + algout$plans <- algout$plans[, rs_idx, drop = FALSE] + # now adjust for the resampling + algout$ancestors <- algout$ancestors[rs_idx, , drop = FALSE] + + # adjust for the resampling + # NOTE: IN FUTURE THIS SHOULD BE SEPERATED INTO FINAL SAMPLE INFO + algout$original_ancestors_mat <- algout$original_ancestors_mat[rs_idx, , drop = FALSE] + algout$parent_index <- algout$original_ancestors_mat[rs_idx, , drop = FALSE] + + if(diagnostic_mode){ + # makes algout$final_region_labs[i] now equal to algout$final_region_labs[rs_idx[i]] + # to account for resampling + algout$final_region_labs[,rs_idx, drop = FALSE] + } + + #TODO probably need to adjust the rest of these as well + storage.mode(algout$ancestors) <- "integer" + } + + storage.mode(algout$plans) <- "integer" + t2_run <- Sys.time() + + + if (!is.nan(n_eff) && n_eff/M <= 0.05) + cli_warn(c("Less than 5% resampling efficiency.", + "*" = "Increase the number of samples.", + "*" = "Consider weakening or removing constraints.", + "i" = "If sampling efficiency drops precipitously in the final + iterations, population balance is likely causing a bottleneck. + Try increasing {.arg pop_temper} by 0.01.", + "i" = "If sampling efficiency declines steadily across iterations, + adjusting {.arg seq_alpha} upward may help a bit.")) + + # add the numerically stable weights back + algout$wgt <- wgt + + # add diagnostic stuff + algout$l_diag <- list( + n_eff = n_eff, + step_n_eff = algout$step_n_eff, + adapt_k_thresh = .99, # adapt_k_thresh, NEED TO DEAL WITH + est_k = k_params, # algout$est_k, + accept_rate = algout$acceptance_rates, + sd_lp = c( + apply(algout$log_incremental_weights_mat, 2, sd), sd(lr) + ), + sd_temper = rep(NA, N-1), # algout$sd_temper, + unique_survive = c(algout$nunique_parent_indices, n_unique), + ancestors = algout$ancestors, + seq_alpha = .99, + pop_temper = pop_temper, + runtime = as.numeric(t2_run - t1_run, units = "secs"), + district_str_labels = algout$final_region_labs, + nunique_original_ancestors = algout$nunique_original_ancestors, + parent_index_mat = algout$parent_index, + original_ancestors_mat = algout$original_ancestors_mat, + region_dvals_mat_list = algout$region_dvals_mat_list, + log_incremental_weights_mat = algout$log_incremental_weights_mat, + region_ids_mat_list = algout$region_ids_mat_list, + draw_tries_mat = algout$draw_tries_mat, + parent_unsuccessful_tries_mat = algout$parent_unsuccessful_tries_mat, + parent_successful_tries_mat = parent_successful_tries_mat, + rs_idx = rs_idx + ) + + algout + + } + + if (verbosity >= 2) { + t2 <- Sys.time() + cli_text("{format(M*runs, big.mark=',')} plans sampled in + {format(t2-t1, digits=2)}") + } + + + plans <- do.call(cbind, lapply(all_out, function(x) x$plans)) + wgt <- do.call(c, lapply(all_out, function(x) x$wgt)) + l_diag <- lapply(all_out, function(x) x$l_diag) + n_dist_act <- dplyr::n_distinct(plans[, 1]) # actual number (for partial plans) + + + out <- new_redist_plans(plans, map, alg_type, wgt, resample, + ndists = N, + n_eff = all_out[[1]]$n_eff, + compactness = 1, + constraints = constraints, + version = packageVersion("redist"), + diagnostics = l_diag, + pop_bounds = pop_bounds) + + + if (runs > 1) { + out <- mutate(out, chain = rep(seq_len(runs), each = n_dist_act*M)) %>% + dplyr::relocate('chain', .after = "draw") + } + + exist_name <- attr(map, "existing_col") + if (!is.null(exist_name) && !isFALSE(ref_name) && N == final_dists) { + ref_name <- if (!is.null(ref_name)) ref_name else exist_name + out <- add_reference(out, map[[exist_name]], ref_name) + } + + out +} diff --git a/man/optimal_gsmc_plans.Rd b/man/optimal_gsmc_plans.Rd new file mode 100644 index 000000000..42c866d45 --- /dev/null +++ b/man/optimal_gsmc_plans.Rd @@ -0,0 +1,56 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/RcppExports.R +\name{optimal_gsmc_plans} +\alias{optimal_gsmc_plans} +\title{Run Optimalgsmc} +\usage{ +optimal_gsmc_plans( + N, + adj_list, + counties, + pop, + target, + lower, + upper, + M, + control, + ncores = -1L, + verbosity = 3L, + diagnostic_mode = FALSE +) +} +\arguments{ +\item{N}{The number of districts the final plans will have} + +\item{adj_list}{A 0-indexed adjacency list representing the undirected graph +which represents the underlying map the plans are to be drawn on} + +\item{counties}{Vector of county labels of each vertex in \code{g}} + +\item{pop}{A vector of the population associated with each vertex in \code{g}} + +\item{target}{Ideal population of a valid district. This is what deviance is calculated +relative to} + +\item{lower}{Acceptable lower bounds on a valid district's population} + +\item{upper}{Acceptable upper bounds on a valid district's population} + +\item{M}{The number of plans (samples) to draw} + +\item{control}{Named list of additional parameters.} + +\item{verbosity}{What level of detail to print out while the algorithm is +running \if{html}{\out{}}} + +\item{k_param}{The k parameter from the SMC algorithm, you choose among the top k_param edges} + +\item{num_threads}{The number of threads the threadpool should use} +} +\description{ +Uses gsmc method with optimal weights to generate a sample of \code{M} plans in \verb{c++} +} +\details{ +Using the procedure outlined in \if{html}{\out{}} this function uses Sequential +Monte Carlo (SMC) methods to generate a sample of \code{M} plans +} diff --git a/man/redist_basic_smc.Rd b/man/redist_basic_smc.Rd index 7dfc59740..1901ff89c 100644 --- a/man/redist_basic_smc.Rd +++ b/man/redist_basic_smc.Rd @@ -12,6 +12,7 @@ redist_basic_smc( resample = TRUE, runs = 1L, ncores = 0L, + multiprocess = TRUE, pop_temper = 0, verbose = FALSE, silent = FALSE, diff --git a/man/redist_gsmc.Rd b/man/redist_gsmc.Rd index cd8d0d1d1..e350a0374 100644 --- a/man/redist_gsmc.Rd +++ b/man/redist_gsmc.Rd @@ -12,6 +12,7 @@ redist_gsmc( resample = TRUE, runs = 1L, ncores = 0L, + multiprocess = TRUE, pop_temper = 0, verbose = FALSE, silent = FALSE, @@ -22,6 +23,9 @@ redist_gsmc( \item{k_params}{Either a single value to use as the splitting parameter for every round or a vector of length N-1 where each value is the one to use for a split.} + +\item{multiprocess}{Whether or not to launch multiple processes (sometimes +better to disable to avoid using too much memory.)} } \value{ \code{redist_smc} returns a \link{redist_plans} object containing the simulated diff --git a/man/redist_optimal_gsmc.Rd b/man/redist_optimal_gsmc.Rd new file mode 100644 index 000000000..d1427c9e4 --- /dev/null +++ b/man/redist_optimal_gsmc.Rd @@ -0,0 +1,37 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/redist_optimal_gsmc.R +\name{redist_optimal_gsmc} +\alias{redist_optimal_gsmc} +\title{OptimalgSMC Redistricting Sampler} +\usage{ +redist_optimal_gsmc( + state_map, + M, + counties = NULL, + k_params = 6, + split_district_only = FALSE, + resample = TRUE, + runs = 1L, + ncores = 0L, + multiprocess = TRUE, + pop_temper = 0, + verbose = FALSE, + silent = FALSE, + diagnostic_mode = FALSE +) +} +\arguments{ +\item{k_params}{Either a single value to use as the splitting parameter for +every round or a vector of length N-1 where each value is the one to use for +a split.} + +\item{multiprocess}{Whether or not to launch multiple processes (sometimes +better to disable to avoid using too much memory.)} +} +\value{ +\code{redist_smc} returns a \link{redist_plans} object containing the simulated +plans. +} +\description{ +OptimalgSMC Redistricting Sampler +} diff --git a/src/RcppExports.cpp b/src/RcppExports.cpp index 9b40a98ee..4faa43652 100644 --- a/src/RcppExports.cpp +++ b/src/RcppExports.cpp @@ -413,6 +413,28 @@ BEGIN_RCPP return rcpp_result_gen; END_RCPP } +// optimal_gsmc_plans +List optimal_gsmc_plans(int N, List adj_list, const arma::uvec& counties, const arma::uvec& pop, double target, double lower, double upper, int M, List control, int ncores, int verbosity, bool diagnostic_mode); +RcppExport SEXP _redist_optimal_gsmc_plans(SEXP NSEXP, SEXP adj_listSEXP, SEXP countiesSEXP, SEXP popSEXP, SEXP targetSEXP, SEXP lowerSEXP, SEXP upperSEXP, SEXP MSEXP, SEXP controlSEXP, SEXP ncoresSEXP, SEXP verbositySEXP, SEXP diagnostic_modeSEXP) { +BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< int >::type N(NSEXP); + Rcpp::traits::input_parameter< List >::type adj_list(adj_listSEXP); + Rcpp::traits::input_parameter< const arma::uvec& >::type counties(countiesSEXP); + Rcpp::traits::input_parameter< const arma::uvec& >::type pop(popSEXP); + Rcpp::traits::input_parameter< double >::type target(targetSEXP); + Rcpp::traits::input_parameter< double >::type lower(lowerSEXP); + Rcpp::traits::input_parameter< double >::type upper(upperSEXP); + Rcpp::traits::input_parameter< int >::type M(MSEXP); + Rcpp::traits::input_parameter< List >::type control(controlSEXP); + Rcpp::traits::input_parameter< int >::type ncores(ncoresSEXP); + Rcpp::traits::input_parameter< int >::type verbosity(verbositySEXP); + Rcpp::traits::input_parameter< bool >::type diagnostic_mode(diagnostic_modeSEXP); + rcpp_result_gen = Rcpp::wrap(optimal_gsmc_plans(N, adj_list, counties, pop, target, lower, upper, M, control, ncores, verbosity, diagnostic_mode)); + return rcpp_result_gen; +END_RCPP +} // pareto_dominated LogicalVector pareto_dominated(arma::mat x); RcppExport SEXP _redist_pareto_dominated(SEXP xSEXP) { @@ -886,6 +908,7 @@ static const R_CallMethodDef CallEntries[] = { {"_redist_pop_tally", (DL_FUNC) &_redist_pop_tally, 3}, {"_redist_max_dev", (DL_FUNC) &_redist_max_dev, 3}, {"_redist_ms_plans", (DL_FUNC) &_redist_ms_plans, 15}, + {"_redist_optimal_gsmc_plans", (DL_FUNC) &_redist_optimal_gsmc_plans, 12}, {"_redist_pareto_dominated", (DL_FUNC) &_redist_pareto_dominated, 1}, {"_redist_testing_sample_forest", (DL_FUNC) &_redist_testing_sample_forest, 6}, {"_redist_plan_class_testing", (DL_FUNC) &_redist_plan_class_testing, 3}, diff --git a/src/optimal_gsmc.cpp b/src/optimal_gsmc.cpp new file mode 100644 index 000000000..c613ebee5 --- /dev/null +++ b/src/optimal_gsmc.cpp @@ -0,0 +1,322 @@ +/******************************************************** +* Author: Philip O'Sullivan +* Institution: Harvard University +* Date Created: 2024/10 +* Purpose: Sequential Monte Carlo redistricting sampler with +* optimal weights +********************************************************/ + +#include "optimal_gsmc.h" + + + +//' Uses gsmc method to generate a sample of `M` plans in `c++` +//' +//' Using the procedure outlined in this function uses Sequential +//' Monte Carlo (SMC) methods to generate a sample of `M` plans +//' +//' @title Run redist gsmc +//' +//' @param N The number of districts the final plans will have +//' @param adj_list A 0-indexed adjacency list representing the undirected graph +//' which represents the underlying map the plans are to be drawn on +//' @param counties Vector of county labels of each vertex in `g` +//' @param pop A vector of the population associated with each vertex in `g` +//' @param target Ideal population of a valid district. This is what deviance is calculated +//' relative to +//' @param lower Acceptable lower bounds on a valid district's population +//' @param upper Acceptable upper bounds on a valid district's population +//' @param M The number of plans (samples) to draw +//' @param control Named list of additional parameters. +//' @param num_threads The number of threads the threadpool should use +//' @param verbosity What level of detail to print out while the algorithm is +//' running +//' @export +List optimal_gsmc_plans( + int N, List adj_list, + const arma::uvec &counties, const arma::uvec &pop, + double target, double lower, double upper, + int M, // M is Number of particles aka number of different plans + List control, // control has pop temper, and k parameter value, and whether only district splits are allowed + int num_threads, int verbosity, bool diagnostic_mode){ + + // set number of threads + if (num_threads <= 0) num_threads = std::thread::hardware_concurrency(); + if (num_threads == 1) num_threads = 0; + + // lags thing (copied from original smc code, don't understand what its doing) + std::vector lags = as>(control["lags"]); + // k param values to use + std::vector k_params = as>(control["k_params"]); + // Whether or not to only do district splits + bool split_district_only = as(control["split_district_only"]); + + double pop_temper = as(control["pop_temper"]); + + + umat ancestors(M, lags.size(), fill::zeros); + + // Create map level graph and county level multigraph + Graph g = list_to_graph(adj_list); + Multigraph cg = county_graph(g, counties); + + int V = g.size(); + double total_pop = sum(pop); + + // Loading Info + if (verbosity >= 1) { + Rcout.imbue(std::locale("")); + Rcout << std::fixed << std::setprecision(0); + if(!split_district_only){ + Rcout << "GENERALIZED SEQUENTIAL MONTE CARLO\n"; + }else{ + Rcout << "SEQUENTIAL MONTE CARLO\n"; + } + Rcout << "Sampling " << M << " " << V << "-unit "; + Rcout << "maps with " << N << " districts and population between " + << lower << " and " << upper << " using " << num_threads << " threads "; + if(!split_district_only){ + Rcout << "and generalized region splits.\n"; + }else{ + Rcout << "and only performing 1-district splits.\n"; + } + if (cg.size() > 1){ + Rcout << "Ensuring no more than " << N - 1 << " splits of the " + << cg.size() << " administrative units.\n"; + } + } + + + std::vector plans_vec(M, Plan(V, N, total_pop)); + std::vector new_plans_vec(M, Plan(V, N, total_pop)); // New plans + + + // Define output variables that must always be created + + // This is N-1 by M where [i][j] is the index of the parent of particle j on step i + // ie the index of the previous plan that was sampled and used to create particle j on step i + std::vector> parent_index_mat(N-1, std::vector (M, -1)); + + // This is N-1 by M where [i][j] is the index of the original (first) ancestor of particle j on step i + std::vector> original_ancestor_mat(N-1, std::vector (M, -1)); + + // This is N-1 by M where [i][j] is the number of tries it took to form particle j on iteration i + // Inclusive of the final step. ie if succeeds in one try it would be 1 + std::vector> draw_tries_mat(N-1, std::vector (M, -1)); + + // This is N-1 by M where [i][j] is the number of times particle j from the + // previous round was sampled and unsuccessfully split on iteration i so this + // does not count successful sample then split + std::vector> parent_unsuccessful_tries_mat(N-1, std::vector (M, 0)); + + // This is N-1 by M where [i][j] is the log incremental weight of particle j on step i + std::vector> log_incremental_weights_mat(N-1, std::vector (M, -1.0)); + + // This is N-1 by M where [i][j] is the normalized weight of particle j on step i + std::vector> normalized_weights_mat(N-1, std::vector (M, -1.0)); + + + // Tracks the acceptance rate - total number of tries over M - for each round + std::vector acceptance_rates(N-1, -1.0); + + // Tracks the effective sample size for the weights of each round + std::vector n_eff(N-1, -1.0); + + // Tracks the number of unique parent vectors sampled to create the next round + std::vector nunique_parents_vec(N-1, -1); + + // Tracks the number of unique ancestors left at each step + std::vector nunique_original_ancestors_vec(N-1, -1); + + + // Declare variables whose size will depend on whether or not we're in + // diagnostic mode or not + std::vector>> plan_region_ids_mat; + std::vector>> plan_d_vals_mat; + std::vector> final_plan_region_labels; + + + + + // If diagnostic mode track stuff from every round + if(diagnostic_mode){ + // Create info tracking we will pass out at the end + // This is N-1 by M by V where for each n=1,...,N-1 and m=1,...M it maps vertices to integer id + plan_region_ids_mat.resize(N-1, std::vector>( + M, std::vector(V, -1) + )); + + // reserve space for N-1 elements + plan_d_vals_mat.reserve(N-1); + + // This is N-2 by M by 1,2,...N where for each n=1,...,N-1, m=1,...,M it maps the region + // id to the region's d value. So for a given n it is n by M by n+1 + // It stops at N-2 because for N-1 its all 1 + for(int n = 1; n < N-1; n++){ + plan_d_vals_mat.push_back( + std::vector>(M, std::vector(n+1, -1)) + ); + } + + // M by N-1 where for each m=1,...M it maps region ids to region labels in a plan + final_plan_region_labels.resize( + M, std::vector(N, "MISSING") + ); + + }else{ // else only track for final round + // Create info tracking we will pass out at the end + // This is M by V where for each m=1,...M it maps vertices to integer id for plan + plan_region_ids_mat.resize(1, std::vector>( + M, std::vector(V, -1) + )); + } + + + + + // Start off all the unnormalized weights at 1 + std::vector unnormalized_sampling_weights(M, 1.0); + + + // Create a threadpool + + RcppThread::ThreadPool pool(num_threads); + + std::string bar_fmt = "Split [{cli::pb_current}/{cli::pb_total}] {cli::pb_bar} | ETA{cli::pb_eta}"; + RObject bar = cli_progress_bar(N-1, cli_config(false, bar_fmt.c_str())); + + // Now for each run through split the map + try { + for(int n=0; n 1){ + Rprintf("Iteration %d \n", n+1); + } + + + // For the first iteration we need to pass a special previous ancestor thing + if(n == 0){ + std::vector dummy_prev_ancestors(M, 1); + // split the map + generalized_split_maps( + g, counties, cg, pop, + plans_vec, new_plans_vec, + original_ancestor_mat[n], + parent_index_mat[n], + dummy_prev_ancestors, + unnormalized_sampling_weights, + normalized_weights_mat[n], + draw_tries_mat[n], + parent_unsuccessful_tries_mat.at(n), + acceptance_rates[n], + nunique_parents_vec[n], + nunique_original_ancestors_vec[n], + ancestors, lags, + lower, upper, target, + k_params[n], split_district_only, + pool, + verbosity + ); + + // For the first ancestor one make every ancestor themselves + std::iota (parent_index_mat[0].begin(), parent_index_mat[0].end(), 0); + std::iota (original_ancestor_mat[0].begin(), original_ancestor_mat[0].end(), 0); + }else{ + // split the map and we can use the previous original ancestor matrix row + generalized_split_maps( + g, counties, cg, pop, + plans_vec, new_plans_vec, + original_ancestor_mat[n], + parent_index_mat[n], + original_ancestor_mat[n-1], + unnormalized_sampling_weights, + normalized_weights_mat[n], + draw_tries_mat[n], + parent_unsuccessful_tries_mat.at(n), + acceptance_rates[n], + nunique_parents_vec[n], + nunique_original_ancestors_vec[n], + ancestors, lags, + lower, upper, target, + k_params[n], split_district_only, + pool, + verbosity + ); + } + + if (verbosity == 1 && CLI_SHOULD_TICK){ + cli_progress_set(bar, n); + } + Rcpp::checkUserInterrupt(); + + + // compute log incremental weights and sampling weights for next round + get_all_plans_log_gsmc_weights( + pool, + g, + new_plans_vec, + split_district_only, + log_incremental_weights_mat.at(n), + unnormalized_sampling_weights, + target, + pop_temper + ); + + + // compute effective sample size + n_eff.at(n) = compute_n_eff(log_incremental_weights_mat[n]); + + // Now update the diagnostic info if needed, region labels, dval column of the matrix + if(diagnostic_mode && n == N-2){ // record if in diagnostic mode and final step + for(int j=0; j +#include +#include +#include +#include +#include + + +#include "wilson.h" +#include "tree_op.h" +#include "map_calc.h" +#include "redist_types.h" +#include "splitting.h" +#include "weights.h" + + +//' Uses gsmc method with optimal weights to generate a sample of `M` plans in `c++` +//' +//' Using the procedure outlined in this function uses Sequential +//' Monte Carlo (SMC) methods to generate a sample of `M` plans +//' +//' @title Run Optimalgsmc +//' +//' @param N The number of districts the final plans will have +//' @param adj_list A 0-indexed adjacency list representing the undirected graph +//' which represents the underlying map the plans are to be drawn on +//' @param counties Vector of county labels of each vertex in `g` +//' @param pop A vector of the population associated with each vertex in `g` +//' @param target Ideal population of a valid district. This is what deviance is calculated +//' relative to +//' @param lower Acceptable lower bounds on a valid district's population +//' @param upper Acceptable upper bounds on a valid district's population +//' @param M The number of plans (samples) to draw +//' @param k_param The k parameter from the SMC algorithm, you choose among the top k_param edges +//' @param control Named list of additional parameters. +//' @param num_threads The number of threads the threadpool should use +//' @param verbosity What level of detail to print out while the algorithm is +//' running +//' @export +// [[Rcpp::export]] +List optimal_gsmc_plans( + int N, List adj_list, + const arma::uvec &counties, const arma::uvec &pop, + double target, double lower, double upper, + int M, // M is Number of particles aka number of different plans + List control, // control has pop temper, and k parameter value, and whether only district splits are allowed + int ncores = -1, int verbosity = 3, bool diagnostic_mode = false +); + +#endif diff --git a/src/splitting.cpp b/src/splitting.cpp index fbfe69a16..913a8a310 100644 --- a/src/splitting.cpp +++ b/src/splitting.cpp @@ -56,9 +56,10 @@ double choose_multidistrict_to_split( } } - // If only one then return that - if(multi_d_vals.size() == 1){ - region_id_to_split = multi_d_vals.at(0); + // https://stackoverflow.com/questions/14599057/how-compare-vector-size-with-an-integer + size_t intendedSize = 1; + if(region_ids.size() == intendedSize){ + region_id_to_split = region_ids.at(0); // probability of picking is 1 and log(1) = 0 return 0; } @@ -505,7 +506,6 @@ bool attempt_region_split(const Graph &g, Tree &ust, const uvec &counties, Multi new_region1_tree_root, new_region1_dval, new_region1_pop, new_region2_tree_root, new_region2_dval, new_region2_pop); - int new_region1_id, new_region2_id; if(successful_edge_found){ // if successful then update the plan @@ -514,7 +514,7 @@ bool attempt_region_split(const Graph &g, Tree &ust, const uvec &counties, Multi region_id_to_split, new_region1_tree_root, new_region1_dval, new_region1_pop, new_region2_tree_root, new_region2_dval, new_region2_pop, - new_region1_id, new_region2_id + new_region_ids[1], new_region_ids[2] ); return true; }else{ @@ -624,8 +624,7 @@ bool attempt_region_split(const Graph &g, Tree &ust, const uvec &counties, Multi //' - `ancestors` is updated to something. THIS IS FROM ORIGINAL SMC CODE, //' I DO NOT KNOW WHAT IT MEANS //' -//' @return nothing -//' +//' @keywords internal void generalized_split_maps( const Graph &g, const uvec &counties, Multigraph &cg, const uvec &pop, std::vector &old_plans_vec, std::vector &new_plans_vec, @@ -720,6 +719,7 @@ void generalized_split_maps( choose_multidistrict_to_split( old_plans_vec[idx], region_id_to_split); + // Now try to split that region ok = attempt_region_split(g, ust, counties, cg, proposed_new_plan, region_id_to_split, @@ -728,6 +728,7 @@ void generalized_split_maps( lower, upper, target, k_param, split_district_only); + // bad sample; try again if (!ok) { // THIS MAY NOT BE THREAD SAFE diff --git a/src/splitting.h b/src/splitting.h index 38f1e8784..0031cfa8d 100644 --- a/src/splitting.h +++ b/src/splitting.h @@ -39,6 +39,8 @@ //' //' @return the region level graph //' +//' @noRd +//' @keywords internal double choose_multidistrict_to_split( Plan const&plan, int ®ion_id_to_split); @@ -96,6 +98,8 @@ double choose_multidistrict_to_split( //' //' @return True if two valid regions were successfully split, false otherwise //' +//' @noRd +//' @keywords internal bool get_edge_to_cut(Tree &ust, int root, int k_param, bool split_district_only, const uvec &pop, const Plan &plan, const int region_id_to_split, @@ -137,6 +141,8 @@ bool get_edge_to_cut(Tree &ust, int root, //' - `new_region1_id` and `new_region2_id` are updated by reference to what //' the values of the two new region ids were set to //' +//' @noRd +//' @keywords internal void update_plan_from_cut( Tree &ust, Plan &plan, const int old_region_id, @@ -244,6 +250,8 @@ void update_plan_from_cut( //' //' @return nothing //' +//' @noRd +//' @keywords internal void generalized_split_maps( const Graph &g, const uvec &counties, Multigraph &cg, const uvec &pop, std::vector &old_plans_vec, std::vector &new_plans_vec, diff --git a/src/weights.cpp b/src/weights.cpp index de2ba6c26..f4cb063ef 100644 --- a/src/weights.cpp +++ b/src/weights.cpp @@ -55,7 +55,8 @@ double compute_n_eff(const std::vector &log_wgt) { //' @title Log Region boundary count //' //' @param g A graph (adjacency list) passed by reference -//' @param plan A plan object +//' @param vertex_region_ids A vector mapping vertex id to the region its in +//' so `vertex_region_ids[i] = r` means vertex i is in region r //' @param region1_id The id of the first region //' @param region2_id The id of the second region //' @@ -63,7 +64,8 @@ double compute_n_eff(const std::vector &log_wgt) { //' //' @return the log of the boundary count //' - double region_log_boundary(const Graph &g, const Plan &plan, + double region_log_boundary(const Graph &g, + const std::vector &vertex_region_ids, int const®ion1_id, int const®ion2_id ) { @@ -77,7 +79,7 @@ double compute_n_eff(const std::vector &log_wgt) { counting we will only count those where first edge is in region 1 */ - if (plan.region_num_ids.at(i) != region1_id) continue; + if (vertex_region_ids.at(i) != region1_id) continue; // Get vertice's neighbors std::vector nbors = g[i]; @@ -87,7 +89,7 @@ double compute_n_eff(const std::vector &log_wgt) { // Now check if neighbors are in second region for (int nbor : nbors) { - if (plan.region_num_ids.at(nbor) != region2_id) + if (vertex_region_ids.at(nbor) != region2_id) continue; // if they are increase count by one count += 1.0; @@ -100,8 +102,6 @@ double compute_n_eff(const std::vector &log_wgt) { - - //' Get the probability the union of two regions was chosen to split //' //' Given a plan object and two regions in the plan this returns the probability @@ -156,7 +156,8 @@ double get_log_retroactive_splitting_prob( } - +// TODO: DOCUMENTATION NEEDED +// Computes log population tempering term double compute_log_pop_temper( const Plan &plan, const int region1_id, const int region2_id, @@ -250,7 +251,7 @@ double compute_log_incremental_weight( // Now iterate over all adjacent pairs for (const auto& edge : adj_region_pairs) { // get log of boundary length between regions - double log_boundary = region_log_boundary(g, plan, edge.first, edge.second); + double log_boundary = region_log_boundary(g, plan.region_num_ids, edge.first, edge.second); // get prob of selecting union of adj regions double log_splitting_prob = get_log_retroactive_splitting_prob(plan, edge.first, edge.second); // NO e^J TERM YET but can be added @@ -364,7 +365,7 @@ double compute_basic_smc_log_incremental_weight( // Now iterate over all adjacent pairs for (const auto& edge : adj_region_pairs) { // get log of boundary length between regions - double log_boundary = region_log_boundary(g, plan, edge.first, edge.second); + double log_boundary = region_log_boundary(g, plan.region_num_ids, edge.first, edge.second); // Do population tempering term if not final double log_temper; @@ -395,3 +396,74 @@ double compute_basic_smc_log_incremental_weight( return -std::log(incremental_weight); } + + + + +//' Computes log unnormalized weights for vector of plans +//' +//' Using the procedure outlined in this function computes the log +//' incremental weights and the unnormalized weights for a vector of plans (which +//' may or may not be the same depending on the parameters). +//' +//' @title Compute Log Unnormalized Weights +//' +//' @param pool A threadpool for multithreading +//' @param g A graph (adjacency list) passed by reference +//' @param plans_vec A vector of plans to compute the log unnormalized weights +//' of +//' @param split_district_only whether or not to compute the weights under +//' the district only split scheme or not. If `split_district_only` is true +//' then uses optimal weights from one-district split scheme. +//' @param log_incremental_weights A vector of the log incremental weights +//' computed for the plans. The value of `log_incremental_weights[i]` is +//' the log incremental weight for `plans_vec[i]` +//' @param unnormalized_sampling_weights A vector of the unnormalized sampling +//' weights to be used with sampling the `plans_vec` in the next iteration of the +//' algorithm. Depending on the other hyperparameters this may or may not be the +//' same as `exp(log_incremental_weights)` +//' @param target Target population of a single district +//' @param pop_temper
+//' +//' @details Modifications +//' - The `log_incremental_weights` is updated to contain the incremental +//' weights of the plans +//' - The `unnormalized_sampling_weights` is updated to contain the unnormalized +//' sampling weights of the plans for the next round +void get_all_plans_log_gsmc_weights( + RcppThread::ThreadPool &pool, + const Graph &g, std::vector &plans_vec, + bool split_district_only, + std::vector &log_incremental_weights, + std::vector &unnormalized_sampling_weights, + double target, double pop_temper +){ + int M = (int) plans_vec.size(); + + // check which scheme to compute weights under + if(split_district_only){ + // Parallel thread pool where all objects in memory shared by default + pool.parallelFor(0, M, [&] (int i) { + double log_incr_weight = compute_basic_smc_log_incremental_weight( + g, plans_vec.at(i), target, pop_temper); + log_incremental_weights[i] = log_incr_weight; + unnormalized_sampling_weights[i] = std::exp(log_incr_weight); + }); + + // Wait for all the threads to finish + pool.wait(); + }else{ + // Parallel thread pool where all objects in memory shared by default + pool.parallelFor(0, M, [&] (int i) { + double log_incr_weight = compute_log_incremental_weight( + g, plans_vec.at(i), target, pop_temper); + log_incremental_weights[i] = log_incr_weight; + unnormalized_sampling_weights[i] = std::exp(log_incr_weight); + }); + + // Wait for all the threads to finish + pool.wait(); + } + + return; +} \ No newline at end of file diff --git a/src/weights.h b/src/weights.h index e9a9eed3a..079559aef 100644 --- a/src/weights.h +++ b/src/weights.h @@ -44,4 +44,44 @@ double compute_basic_smc_log_incremental_weight( const double target, const double pop_temper); +//' Computes log unnormalized weights for vector of plans +//' +//' Using the procedure outlined in this function computes the log +//' incremental weights and the unnormalized weights for a vector of plans (which +//' may or may not be the same depending on the parameters). +//' +//' @title Compute Log Unnormalized Weights +//' +//' @param pool A threadpool for multithreading +//' @param g A graph (adjacency list) passed by reference +//' @param plans_vec A vector of plans to compute the log unnormalized weights +//' of +//' @param split_district_only whether or not to compute the weights under +//' the district only split scheme or not. If `split_district_only` is true +//' then uses optimal weights from one-district split scheme. +//' @param log_incremental_weights A vector of the log incremental weights +//' computed for the plans. The value of `log_incremental_weights[i]` is +//' the log incremental weight for `plans_vec[i]` +//' @param unnormalized_sampling_weights A vector of the unnormalized sampling +//' weights to be used with sampling the `plans_vec` in the next iteration of the +//' algorithm. Depending on the other hyperparameters this may or may not be the +//' same as `exp(log_incremental_weights)` +//' @param target Target population of a single district +//' @param pop_temper
+//' +//' @details Modifications +//' - The `log_incremental_weights` is updated to contain the incremental +//' weights of the plans +//' - The `unnormalized_sampling_weights` is updated to contain the unnormalized +//' sampling weights of the plans for the next round +void get_all_plans_log_gsmc_weights( + RcppThread::ThreadPool &pool, + const Graph &g, std::vector &plans_vec, + bool split_district_only, + std::vector &log_incremental_weights, + std::vector &unnormalized_sampling_weights, + double target, double pop_temper +); + + #endif From 3c8c4a981a07a136a81ffe5e572a36a657b4aa7c Mon Sep 17 00:00:00 2001 From: "Philip W. O'Sullivan" Date: Fri, 1 Nov 2024 03:00:29 -0400 Subject: [PATCH 026/324] removed old gsmc and basic_smc files, now replaced by new consolidated redist_optimal_gsmc --- NAMESPACE | 4 - R/RcppExports.R | 62 --- R/redist_basic_smc.R | 363 --------------- R/redist_gsmc.R | 382 ---------------- man/basic_smc_plans.Rd | 56 --- man/gsmc_plans.Rd | 56 --- man/redist_basic_smc.Rd | 33 -- man/redist_gsmc.Rd | 36 -- src/RcppExports.cpp | 84 ---- src/basic_smc.cpp | 929 -------------------------------------- src/basic_smc.h | 75 --- src/gsmc.cpp | 979 ---------------------------------------- src/gsmc.h | 67 --- src/weights.cpp | 2 +- 14 files changed, 1 insertion(+), 3127 deletions(-) delete mode 100644 R/redist_basic_smc.R delete mode 100644 R/redist_gsmc.R delete mode 100644 man/basic_smc_plans.Rd delete mode 100644 man/gsmc_plans.Rd delete mode 100644 man/redist_basic_smc.Rd delete mode 100644 man/redist_gsmc.Rd delete mode 100644 src/basic_smc.cpp delete mode 100644 src/basic_smc.h delete mode 100644 src/gsmc.cpp delete mode 100644 src/gsmc.h diff --git a/NAMESPACE b/NAMESPACE index da2d27c5f..6492c81d1 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -76,7 +76,6 @@ export(add_constr_total_splits) export(add_reference) export(as_redist_map) export(avg_by_prec) -export(basic_smc_plans) export(classify_plans) export(combine_scorers) export(compare_plans) @@ -96,7 +95,6 @@ export(get_pop_tol) export(get_sampling_info) export(get_target) export(group_frac) -export(gsmc_plans) export(is_contiguous) export(is_county_split) export(last_plan) @@ -173,12 +171,10 @@ export(redist.splits) export(redist.subset) export(redist.uncoarsen) export(redist.wted.adj) -export(redist_basic_smc) export(redist_ci) export(redist_constr) export(redist_flip) export(redist_flip_anneal) -export(redist_gsmc) export(redist_map) export(redist_mcmc_ci) export(redist_mergesplit) diff --git a/R/RcppExports.R b/R/RcppExports.R index 7a99e8d78..3ec795644 100644 --- a/R/RcppExports.R +++ b/R/RcppExports.R @@ -9,33 +9,6 @@ collapse_adj <- function(graph, idxs) { .Call(`_redist_collapse_adj`, graph, idxs) } -#' Uses gsmc method to generate a sample of `M` plans in `c++` -#' -#' Using the procedure outlined in this function uses Sequential -#' Monte Carlo (SMC) methods to generate a sample of `M` plans -#' -#' @title Run redist gsmc -#' -#' @param N The number of districts the final plans will have -#' @param adj_list A 0-indexed adjacency list representing the undirected graph -#' which represents the underlying map the plans are to be drawn on -#' @param counties Vector of county labels of each vertex in `g` -#' @param pop A vector of the population associated with each vertex in `g` -#' @param target Ideal population of a valid district. This is what deviance is calculated -#' relative to -#' @param lower Acceptable lower bounds on a valid district's population -#' @param upper Acceptable upper bounds on a valid district's population -#' @param M The number of plans (samples) to draw -#' @param k_param The k parameter from the SMC algorithm, you choose among the top k_param edges -#' @param control Named list of additional parameters. -#' @param num_threads The number of threads the threadpool should use -#' @param verbosity What level of detail to print out while the algorithm is -#' running -#' @export -basic_smc_plans <- function(N, adj_list, counties, pop, target, lower, upper, M, control, ncores = -1L, verbosity = 3L, diagnostic_mode = FALSE) { - .Call(`_redist_basic_smc_plans`, N, adj_list, counties, pop, target, lower, upper, M, control, ncores, verbosity, diagnostic_mode) -} - coarsen_adjacency <- function(adj, groups) { .Call(`_redist_coarsen_adjacency`, adj, groups) } @@ -80,33 +53,6 @@ dist_dist_diff <- function(p, i_dist, j_dist, x_center, y_center, x, y) { .Call(`_redist_dist_dist_diff`, p, i_dist, j_dist, x_center, y_center, x, y) } -#' Uses gsmc method to generate a sample of `M` plans in `c++` -#' -#' Using the procedure outlined in this function uses Sequential -#' Monte Carlo (SMC) methods to generate a sample of `M` plans -#' -#' @title Run redist gsmc -#' -#' @param N The number of districts the final plans will have -#' @param adj_list A 0-indexed adjacency list representing the undirected graph -#' which represents the underlying map the plans are to be drawn on -#' @param counties Vector of county labels of each vertex in `g` -#' @param pop A vector of the population associated with each vertex in `g` -#' @param target Ideal population of a valid district. This is what deviance is calculated -#' relative to -#' @param lower Acceptable lower bounds on a valid district's population -#' @param upper Acceptable upper bounds on a valid district's population -#' @param M The number of plans (samples) to draw -#' @param k_param The k parameter from the SMC algorithm, you choose among the top k_param edges -#' @param control Named list of additional parameters. -#' @param num_threads The number of threads the threadpool should use -#' @param verbosity What level of detail to print out while the algorithm is -#' running -#' @export -gsmc_plans <- function(N, adj_list, counties, pop, target, lower, upper, M, control, ncores = -1L, verbosity = 3L, diagnostic_mode = FALSE) { - .Call(`_redist_gsmc_plans`, N, adj_list, counties, pop, target, lower, upper, M, control, ncores, verbosity, diagnostic_mode) -} - log_st_map <- function(g, districts, counties, n_distr) { .Call(`_redist_log_st_map`, g, districts, counties, n_distr) } @@ -498,14 +444,6 @@ split_entire_map_once_new_cut_func <- function(N, adj_list, counties, pop, targe .Call(`_redist_split_entire_map_once_new_cut_func`, N, adj_list, counties, pop, target, lower, upper, split_district_only, verbose) } -split_entire_map_once_basic_smc <- function(N, adj_list, counties, pop, target, lower, upper, verbose) { - .Call(`_redist_split_entire_map_once_basic_smc`, N, adj_list, counties, pop, target, lower, upper, verbose) -} - -basic_smc_split_all_the_way <- function(N, adj_list, counties, pop, target, lower, upper, verbose) { - .Call(`_redist_basic_smc_split_all_the_way`, N, adj_list, counties, pop, target, lower, upper, verbose) -} - #' Creates the region level graph of a plan #' #' Given a plan object this returns a graph of the regions in the plan using diff --git a/R/redist_basic_smc.R b/R/redist_basic_smc.R deleted file mode 100644 index 3ccea50bb..000000000 --- a/R/redist_basic_smc.R +++ /dev/null @@ -1,363 +0,0 @@ -##################################################### -# Author: Philip O'Sullivan -# Institution: Harvard University -# Date Created: 2024/08/18 -# Purpose: tidy R wrapper to run gSMC redistricting code -#################################################### - - -#' Basic SMC Redistricting Sampler -#' -#' RedistSMC with optimal weights but not arbitrary region splits -#' -#' @param k_params Either a single value to use as the splitting parameter for -#' every round or a vector of length N-1 where each value is the one to use for -#' a split. -#' -#' @return `redist_smc` returns a [redist_plans] object containing the simulated -#' plans. -#' -#' @export -redist_basic_smc <- function(state_map, M, counties = NULL, k_params = 6, - resample = TRUE, runs = 1L, - ncores = 0L, multiprocess=TRUE, - pop_temper = 0, - verbose = FALSE, silent = FALSE, diagnostic_mode = FALSE){ - N <- attr(state_map, "ndists") - # no constraints - constraints = list() - - # make controls input - lags <- 1 + unique(round((N - 1)^0.8*seq(0, 0.7, length.out = 4)^0.9)) - - # check k param input - if(any(k_params < 1)){ - cli_abort("K parameter values must be all at least 1.") - } - - # if just a single number then repeat it - if(length(k_params) == 1 && floor(k_params) == k_params){ - k_params <- rep(k_params, N-1) - }else if(length(k_params) != N-1){ - cli_abort("K parameter input must be either 1 value or N-1!") - }else if(any(floor(k_params) != k_params)){ - # if either the length is not N-1 or its not all integers then throw - # error - cli_abort("K parameter values must be all integers") - } - - control = list( - lags=lags, - pop_temper = pop_temper, - k_params = k_params) - - # verbosity stuff - verbosity <- 1 - if (verbose) verbosity <- 3 - if (silent) verbosity <- 0 - - - # get the map in adjacency form - map <- validate_redist_map(state_map) - V <- nrow(state_map) - adj_list <- get_adj(state_map) - - - - - counties <- rlang::eval_tidy(rlang::enquo(counties), map) - if (is.null(counties)) { - counties <- rep(1, V) - } else { - if (any(is.na(counties))) - cli_abort("County vector must not contain missing values.") - - # handle discontinuous counties - component <- contiguity(adj_list, vctrs::vec_group_id(counties)) - counties <- dplyr::if_else(component > 1, - paste0(as.character(counties), "-", component), - as.character(counties)) %>% - as.factor() %>% - as.integer() - if (any(component > 1)) { - cli_warn("Counties were not contiguous; expect additional splits.") - } - } - - - - - # get population stuff - pop_bounds <- attr(map, "pop_bounds") - pop <- map[[attr(map, "pop_col")]] - if (any(pop >= pop_bounds[3])) { - too_big <- as.character(which(pop >= pop_bounds[3])) - cli_abort(c("Unit{?s} {too_big} ha{?ve/s/ve} - population larger than the district target.", - "x" = "Redistricting impossible.")) - } - - # compute lags thing - lags <- 1 + unique(round((N - 1)^0.8*seq(0, 0.7, length.out = 4)^0.9)) - - - # set up parallel - ncores_max <- parallel::detectCores() - ncores_runs <- min(ncores_max, runs) - ncores_per <- as.integer(ncores) - if (ncores_per == 0) { - if (M/100*length(adj_list)/200 < 20) { - ncores_per <- 1L - } else { - ncores_per <- floor(ncores_max/ncores_runs) - } - } - - # if sequentially - if(!multiprocess){ - # either max cores if - if(ncores == 0){ - ncores_per = ncores_max - }else{ - ncores_per = ncores - } - } - - - if (ncores_runs > 1 && multiprocess) { - `%oper%` <- `%dorng%` - of <- if (Sys.info()[["sysname"]] == "Windows") { - tempfile(pattern = paste0("smc_", substr(Sys.time(), 1, 10)), fileext = ".txt") - } else { - "" - } - - if (!silent) - cl <- makeCluster(ncores_runs, outfile = of, methods = FALSE, - useXDR = .Platform$endian != "little") - else - cl <- makeCluster(ncores_runs, methods = FALSE, - useXDR = .Platform$endian != "little") - doParallel::registerDoParallel(cl, cores = ncores_runs) - on.exit(stopCluster(cl)) - } else { - `%oper%` <- `%do%` - } - - - - t1 <- Sys.time() - all_out <- foreach(chain = seq_len(runs), .inorder = FALSE, .packages="redist") %oper% { - - - run_verbosity <- if (chain == 1 || !multiprocess) verbosity else 0 - t1_run <- Sys.time() - - algout <- redist::basic_smc_plans( - N=N, - adj_list=adj_list, - counties=counties, - pop=pop, - target=pop_bounds[2], - lower=pop_bounds[1], - upper=pop_bounds[3], - M=M, - control = control, - ncores = as.integer(ncores_per), - verbosity=run_verbosity, - diagnostic_mode=diagnostic_mode) - - - if (length(algout) == 0) { - cli::cli_process_done() - cli::cli_process_done() - } - - - # make each element of region_ids_mat_list a V by M matrix - algout$region_ids_mat_list <- lapply( - algout$region_ids_mat_list, - function(x) matrix(unlist(x), ncol = length(x), byrow = FALSE) + 1 - ) - - - # make original ancestor matrix - # add 1 for R indexing - algout$original_ancestors_mat <- matrix( - unlist(algout$original_ancestors), - ncol = length(algout$original_ancestors), - byrow = FALSE) + 1 - algout$original_ancestors <- NULL - - # make parent mat into matrix - # add 1 for R indexing - algout$parent_index <- matrix( - unlist(algout$parent_index), - ncol = length(algout$parent_index), - byrow = FALSE) + 1 - - # make draws tries into a matrix - algout$draw_tries_mat <- matrix( - unlist(algout$draw_tries_mat), - ncol = length(algout$draw_tries_mat), - byrow = FALSE) - - # make parent unsuccessful tries into a matrix - algout$parent_unsuccessful_tries_mat <- matrix( - unlist(algout$parent_unsuccessful_tries_mat), - ncol = length(algout$parent_unsuccessful_tries_mat), - byrow = FALSE) - - # make parent succesful tries matrix counting the number of - # times a parent index was successfully sampled - parent_successful_tries_mat <- apply( - algout$parent_index, 2, tabulate, nbins = M - ) - - # make the log incremental weights into a matrix - algout$log_incremental_weights_mat <- matrix( - unlist(algout$log_incremental_weights_mat), - ncol = length(algout$log_incremental_weights_mat), - byrow = FALSE) - - # pull out the log weights - lr <- algout$log_incremental_weights_mat[,N-1] - - wgt <- exp(lr - mean(lr)) - n_eff <- length(wgt)*mean(wgt)^2/mean(wgt^2) - - if(diagnostic_mode){ - # add a plans matrix as the final output because first - # N-2 are previous results - algout$plans <- algout$region_ids_mat_list[[N-1]] - - - }else{ - # Just add first element since not diagnostic mode the first N-2 - # steps were not tracked - algout$plans <- algout$region_ids_mat_list[[1]] - - # make the region_ids_mat_list input just null since there's nothing else - algout$region_ids_mat_list <- NULL - } - - if (any(is.na(lr))) { - cli_abort(c("Sampling probabilities have been corrupted.", - "*" = "Check that none of your constraint weights are too large. - The output of constraint functions multiplied by the weight - should generally fall in the -5 to 5 range.", - "*" = "If you are using custom constraints, make sure that your - constraint function handles all edge cases and never returns - {.val {NA}} or {.val {Inf}}", - "*" = "If you are not using any constraints, please call - {.code rlang::trace_back()} and file an issue at - {.url https://github.com/alarm-redist/redist/issues/new}")) - } - - - - if (resample) { - normalized_wgts <- wgt/sum(wgt) - n_eff <- 1/sum(normalized_wgts^2) - - rs_idx <- resample_lowvar(normalized_wgts) - n_unique <- dplyr::n_distinct(rs_idx) - # makes algout$plans[i] now equal to algout$plans[rs_idx[i]] - algout$plans <- algout$plans[, rs_idx, drop = FALSE] - # now adjust for the resampling - algout$ancestors <- algout$ancestors[rs_idx, , drop = FALSE] - - # adjust for the resampling - # NOTE: IN FUTURE THIS SHOULD BE SEPERATED INTO FINAL SAMPLE INFO - algout$original_ancestors_mat <- algout$original_ancestors_mat[rs_idx, , drop = FALSE] - algout$parent_index <- algout$original_ancestors_mat[rs_idx, , drop = FALSE] - - - #TODO probably need to adjust the rest of these as well - storage.mode(algout$ancestors) <- "integer" - } - - storage.mode(algout$plans) <- "integer" - t2_run <- Sys.time() - - - if (!is.nan(n_eff) && n_eff/M <= 0.05) - cli_warn(c("Less than 5% resampling efficiency.", - "*" = "Increase the number of samples.", - "*" = "Consider weakening or removing constraints.", - "i" = "If sampling efficiency drops precipitously in the final - iterations, population balance is likely causing a bottleneck. - Try increasing {.arg pop_temper} by 0.01.", - "i" = "If sampling efficiency declines steadily across iterations, - adjusting {.arg seq_alpha} upward may help a bit.")) - - # add the numerically stable weights back - algout$wgt <- wgt - - # add diagnostic stuff - algout$l_diag <- list( - n_eff = n_eff, - step_n_eff = algout$step_n_eff, - adapt_k_thresh = .99, # adapt_k_thresh, NEED TO DEAL WITH - est_k = k_params, # algout$est_k, - accept_rate = algout$acceptance_rates, - sd_lp = c( - apply(algout$log_incremental_weights_mat, 2, sd), sd(lr) - ), - sd_temper = rep(NA, N-1), # algout$sd_temper, - unique_survive = c(algout$nunique_parent_indices, n_unique), - ancestors = algout$ancestors, - seq_alpha = .99, - pop_temper = pop_temper, - runtime = as.numeric(t2_run - t1_run, units = "secs"), - nunique_original_ancestors = algout$nunique_original_ancestors, - parent_index_mat = algout$parent_index, - original_ancestors_mat = algout$original_ancestors_mat, - log_incremental_weights_mat = algout$log_incremental_weights_mat, - region_ids_mat_list = algout$region_ids_mat_list, - draw_tries_mat = algout$draw_tries_mat, - parent_unsuccessful_tries_mat = algout$parent_unsuccessful_tries_mat, - parent_successful_tries_mat = parent_successful_tries_mat, - rs_idx = rs_idx - ) - - algout - - } - - if (verbosity >= 2) { - t2 <- Sys.time() - cli_text("{format(M*runs, big.mark=',')} plans sampled in - {format(t2-t1, digits=2)}") - } - - - plans <- do.call(cbind, lapply(all_out, function(x) x$plans)) - wgt <- do.call(c, lapply(all_out, function(x) x$wgt)) - l_diag <- lapply(all_out, function(x) x$l_diag) - n_dist_act <- dplyr::n_distinct(plans[, 1]) # actual number (for partial plans) - - - out <- new_redist_plans(plans, map, "basic_smc", wgt, resample, - ndists = N, - n_eff = all_out[[1]]$n_eff, - compactness = 1, - constraints = constraints, - version = packageVersion("redist"), - diagnostics = l_diag, - pop_bounds = pop_bounds) - - - if (runs > 1) { - out <- mutate(out, chain = rep(seq_len(runs), each = n_dist_act*M)) %>% - dplyr::relocate('chain', .after = "draw") - } - - exist_name <- attr(map, "existing_col") - if (!is.null(exist_name) && !isFALSE(ref_name) && ndists == final_dists) { - ref_name <- if (!is.null(ref_name)) ref_name else exist_name - out <- add_reference(out, map[[exist_name]], ref_name) - } - - out -} diff --git a/R/redist_gsmc.R b/R/redist_gsmc.R deleted file mode 100644 index 0762c7b26..000000000 --- a/R/redist_gsmc.R +++ /dev/null @@ -1,382 +0,0 @@ -##################################################### -# Author: Philip O'Sullivan -# Institution: Harvard University -# Date Created: 2024/08/18 -# Purpose: tidy R wrapper to run gSMC redistricting code -#################################################### - - -#' gSMC Redistricting Sampler -#' -#' @param k_params Either a single value to use as the splitting parameter for -#' every round or a vector of length N-1 where each value is the one to use for -#' a split. -#' @param multiprocess Whether or not to launch multiple processes (sometimes -#' better to disable to avoid using too much memory.) -#' -#' @return `redist_smc` returns a [redist_plans] object containing the simulated -#' plans. -#' -#' @export -redist_gsmc <- function(state_map, M, counties = NULL, k_params = 6, - resample = TRUE, runs = 1L, - ncores = 0L, multiprocess=TRUE, - pop_temper = 0, - verbose = FALSE, silent = FALSE, diagnostic_mode = FALSE){ - N <- attr(state_map, "ndists") - # no constraints - constraints = list() - - - # make controls intput - lags <- 1 + unique(round((N - 1)^0.8*seq(0, 0.7, length.out = 4)^0.9)) - - # check k param imput - if(any(k_params < 1)){ - cli_abort("K parameter values must be all at least 1.") - } - - # if just a single number then repeat it - if(length(k_params) == 1 && floor(k_params) == k_params){ - k_params <- rep(k_params, N-1) - }else if(length(k_params) != N-1){ - cli_abort("K parameter input must be either 1 value or N-1!") - }else if(any(floor(k_params) != k_params)){ - # if either the length is not N-1 or its not all integers then throw - # error - cli_abort("K parameter values must be all integers") - } - - control = list( - lags=lags, - pop_temper = pop_temper, - k_params = k_params) - - # verbosity stuff - verbosity <- 1 - if (verbose) verbosity <- 3 - if (silent) verbosity <- 0 - - - # get the map in adjacency form - map <- validate_redist_map(state_map) - V <- nrow(state_map) - adj_list <- get_adj(state_map) - - - - - counties <- rlang::eval_tidy(rlang::enquo(counties), map) - if (is.null(counties)) { - counties <- rep(1, V) - } else { - if (any(is.na(counties))) - cli_abort("County vector must not contain missing values.") - - # handle discontinuous counties - component <- contiguity(adj_list, vctrs::vec_group_id(counties)) - counties <- dplyr::if_else(component > 1, - paste0(as.character(counties), "-", component), - as.character(counties)) %>% - as.factor() %>% - as.integer() - if (any(component > 1)) { - cli_warn("Counties were not contiguous; expect additional splits.") - } - } - - - - - # get population stuff - pop_bounds <- attr(map, "pop_bounds") - pop <- map[[attr(map, "pop_col")]] - if (any(pop >= pop_bounds[3])) { - too_big <- as.character(which(pop >= pop_bounds[3])) - cli_abort(c("Unit{?s} {too_big} ha{?ve/s/ve} - population larger than the district target.", - "x" = "Redistricting impossible.")) - } - - # compute lags thing - lags <- 1 + unique(round((N - 1)^0.8*seq(0, 0.7, length.out = 4)^0.9)) - - - # set up parallel - ncores_max <- parallel::detectCores() - ncores_runs <- min(ncores_max, runs) - ncores_per <- as.integer(ncores) - if (ncores_per == 0) { - if (M/100*length(adj_list)/200 < 20) { - ncores_per <- 1L - } else { - ncores_per <- floor(ncores_max/ncores_runs) - } - } - - # if sequentially - if(!multiprocess){ - # either max cores if - if(ncores == 0){ - ncores_per = ncores_max - }else{ - ncores_per = ncores - } - } - - - if (ncores_runs > 1 && multiprocess) { - `%oper%` <- `%dorng%` - of <- if (Sys.info()[["sysname"]] == "Windows") { - tempfile(pattern = paste0("smc_", substr(Sys.time(), 1, 10)), fileext = ".txt") - } else { - "" - } - - if (!silent) - cl <- makeCluster(ncores_runs, outfile = of, methods = FALSE, - useXDR = .Platform$endian != "little") - else - cl <- makeCluster(ncores_runs, methods = FALSE, - useXDR = .Platform$endian != "little") - doParallel::registerDoParallel(cl, cores = ncores_runs) - on.exit(stopCluster(cl)) - } else { - `%oper%` <- `%do%` - } - - - - t1 <- Sys.time() - all_out <- foreach(chain = seq_len(runs), .inorder = FALSE, .packages="redist") %oper% { - - - run_verbosity <- if (chain == 1 || !multiprocess) verbosity else 0 - t1_run <- Sys.time() - - algout <- redist::gsmc_plans( - N=N, - adj_list=adj_list, - counties=counties, - pop=pop, - target=pop_bounds[2], - lower=pop_bounds[1], - upper=pop_bounds[3], - M=M, - control = control, - ncores = as.integer(ncores_per), - verbosity=run_verbosity, - diagnostic_mode=diagnostic_mode) - - - if (length(algout) == 0) { - cli::cli_process_done() - cli::cli_process_done() - } - - - # make each element of region_ids_mat_list a V by M matrix - algout$region_ids_mat_list <- lapply( - algout$region_ids_mat_list, - function(x) matrix(unlist(x), ncol = length(x), byrow = FALSE) + 1 - ) - - # make each element of region_dvals_mat_list a V by M matrix - algout$region_dvals_mat_list <- lapply( - algout$region_dvals_mat_list, - function(x) matrix(unlist(x), ncol = length(x), byrow = FALSE) - ) - - # make original ancestor matrix - # add 1 for R indexing - algout$original_ancestors_mat <- matrix( - unlist(algout$original_ancestors), - ncol = length(algout$original_ancestors), - byrow = FALSE) + 1 - algout$original_ancestors <- NULL - - # make parent mat into matrix - # add 1 for R indexing - algout$parent_index <- matrix( - unlist(algout$parent_index), - ncol = length(algout$parent_index), - byrow = FALSE) + 1 - - # make draws tries into a matrix - algout$draw_tries_mat <- matrix( - unlist(algout$draw_tries_mat), - ncol = length(algout$draw_tries_mat), - byrow = FALSE) - - # make parent unsuccessful tries into a matrix - algout$parent_unsuccessful_tries_mat <- matrix( - unlist(algout$parent_unsuccessful_tries_mat), - ncol = length(algout$parent_unsuccessful_tries_mat), - byrow = FALSE) - - # make parent succesful tries matrix counting the number of - # times a parent index was successfully sampled - parent_successful_tries_mat <- apply( - algout$parent_index, 2, tabulate, nbins = M - ) - - # make the log incremental weights into a matrix - algout$log_incremental_weights_mat <- matrix( - unlist(algout$log_incremental_weights_mat), - ncol = length(algout$log_incremental_weights_mat), - byrow = FALSE) - - # pull out the log weights - lr <- algout$log_incremental_weights_mat[,N-1] - - wgt <- exp(lr - mean(lr)) - n_eff <- length(wgt)*mean(wgt)^2/mean(wgt^2) - - if(diagnostic_mode){ - # add a plans matrix as the final output because first - # N-2 are previous results - algout$plans <- algout$region_ids_mat_list[[N-1]] - - algout$final_region_labs <- matrix( - unlist(algout$final_region_labs), - ncol = length(algout$final_region_labs), - byrow = FALSE) - - }else{ - # Just add first element since not diagnostic mode the first N-2 - # steps were not tracked - algout$plans <- algout$region_ids_mat_list[[1]] - - # make the region_ids_mat_list input just null since there's nothing else - algout$region_ids_mat_list <- NULL - algout$region_dvals_mat_list <- NULL - algout$final_region_labs <- NULL - } - - if (any(is.na(lr))) { - cli_abort(c("Sampling probabilities have been corrupted.", - "*" = "Check that none of your constraint weights are too large. - The output of constraint functions multiplied by the weight - should generally fall in the -5 to 5 range.", - "*" = "If you are using custom constraints, make sure that your - constraint function handles all edge cases and never returns - {.val {NA}} or {.val {Inf}}", - "*" = "If you are not using any constraints, please call - {.code rlang::trace_back()} and file an issue at - {.url https://github.com/alarm-redist/redist/issues/new}")) - } - - - - if (resample) { - normalized_wgts <- wgt/sum(wgt) - n_eff <- 1/sum(normalized_wgts^2) - - rs_idx <- resample_lowvar(normalized_wgts) - n_unique <- dplyr::n_distinct(rs_idx) - # makes algout$plans[i] now equal to algout$plans[rs_idx[i]] - algout$plans <- algout$plans[, rs_idx, drop = FALSE] - # now adjust for the resampling - algout$ancestors <- algout$ancestors[rs_idx, , drop = FALSE] - - # adjust for the resampling - # NOTE: IN FUTURE THIS SHOULD BE SEPERATED INTO FINAL SAMPLE INFO - algout$original_ancestors_mat <- algout$original_ancestors_mat[rs_idx, , drop = FALSE] - algout$parent_index <- algout$original_ancestors_mat[rs_idx, , drop = FALSE] - - if(diagnostic_mode){ - # makes algout$final_region_labs[i] now equal to algout$final_region_labs[rs_idx[i]] - # to account for resampling - algout$final_region_labs[,rs_idx, drop = FALSE] - } - - #TODO probably need to adjust the rest of these as well - storage.mode(algout$ancestors) <- "integer" - } - - storage.mode(algout$plans) <- "integer" - t2_run <- Sys.time() - - - if (!is.nan(n_eff) && n_eff/M <= 0.05) - cli_warn(c("Less than 5% resampling efficiency.", - "*" = "Increase the number of samples.", - "*" = "Consider weakening or removing constraints.", - "i" = "If sampling efficiency drops precipitously in the final - iterations, population balance is likely causing a bottleneck. - Try increasing {.arg pop_temper} by 0.01.", - "i" = "If sampling efficiency declines steadily across iterations, - adjusting {.arg seq_alpha} upward may help a bit.")) - - # add the numerically stable weights back - algout$wgt <- wgt - - # add diagnostic stuff - algout$l_diag <- list( - n_eff = n_eff, - step_n_eff = algout$step_n_eff, - adapt_k_thresh = .99, # adapt_k_thresh, NEED TO DEAL WITH - est_k = k_params, # algout$est_k, - accept_rate = algout$acceptance_rates, - sd_lp = c( - apply(algout$log_incremental_weights_mat, 2, sd), sd(lr) - ), - sd_temper = rep(NA, N-1), # algout$sd_temper, - unique_survive = c(algout$nunique_parent_indices, n_unique), - ancestors = algout$ancestors, - seq_alpha = .99, - pop_temper = pop_temper, - runtime = as.numeric(t2_run - t1_run, units = "secs"), - district_str_labels = algout$final_region_labs, - nunique_original_ancestors = algout$nunique_original_ancestors, - parent_index_mat = algout$parent_index, - original_ancestors_mat = algout$original_ancestors_mat, - region_dvals_mat_list = algout$region_dvals_mat_list, - log_incremental_weights_mat = algout$log_incremental_weights_mat, - region_ids_mat_list = algout$region_ids_mat_list, - draw_tries_mat = algout$draw_tries_mat, - parent_unsuccessful_tries_mat = algout$parent_unsuccessful_tries_mat, - parent_successful_tries_mat = parent_successful_tries_mat, - rs_idx = rs_idx - ) - - algout - - } - - if (verbosity >= 2) { - t2 <- Sys.time() - cli_text("{format(M*runs, big.mark=',')} plans sampled in - {format(t2-t1, digits=2)}") - } - - - plans <- do.call(cbind, lapply(all_out, function(x) x$plans)) - wgt <- do.call(c, lapply(all_out, function(x) x$wgt)) - l_diag <- lapply(all_out, function(x) x$l_diag) - n_dist_act <- dplyr::n_distinct(plans[, 1]) # actual number (for partial plans) - - - out <- new_redist_plans(plans, map, "gsmc", wgt, resample, - ndists = N, - n_eff = all_out[[1]]$n_eff, - compactness = 1, - constraints = constraints, - version = packageVersion("redist"), - diagnostics = l_diag, - pop_bounds = pop_bounds) - - - if (runs > 1) { - out <- mutate(out, chain = rep(seq_len(runs), each = n_dist_act*M)) %>% - dplyr::relocate('chain', .after = "draw") - } - - exist_name <- attr(map, "existing_col") - if (!is.null(exist_name) && !isFALSE(ref_name) && ndists == final_dists) { - ref_name <- if (!is.null(ref_name)) ref_name else exist_name - out <- add_reference(out, map[[exist_name]], ref_name) - } - - out -} diff --git a/man/basic_smc_plans.Rd b/man/basic_smc_plans.Rd deleted file mode 100644 index 742ca5f4e..000000000 --- a/man/basic_smc_plans.Rd +++ /dev/null @@ -1,56 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/RcppExports.R -\name{basic_smc_plans} -\alias{basic_smc_plans} -\title{Run redist gsmc} -\usage{ -basic_smc_plans( - N, - adj_list, - counties, - pop, - target, - lower, - upper, - M, - control, - ncores = -1L, - verbosity = 3L, - diagnostic_mode = FALSE -) -} -\arguments{ -\item{N}{The number of districts the final plans will have} - -\item{adj_list}{A 0-indexed adjacency list representing the undirected graph -which represents the underlying map the plans are to be drawn on} - -\item{counties}{Vector of county labels of each vertex in \code{g}} - -\item{pop}{A vector of the population associated with each vertex in \code{g}} - -\item{target}{Ideal population of a valid district. This is what deviance is calculated -relative to} - -\item{lower}{Acceptable lower bounds on a valid district's population} - -\item{upper}{Acceptable upper bounds on a valid district's population} - -\item{M}{The number of plans (samples) to draw} - -\item{control}{Named list of additional parameters.} - -\item{verbosity}{What level of detail to print out while the algorithm is -running \if{html}{\out{}}} - -\item{k_param}{The k parameter from the SMC algorithm, you choose among the top k_param edges} - -\item{num_threads}{The number of threads the threadpool should use} -} -\description{ -Uses gsmc method to generate a sample of \code{M} plans in \verb{c++} -} -\details{ -Using the procedure outlined in \if{html}{\out{}} this function uses Sequential -Monte Carlo (SMC) methods to generate a sample of \code{M} plans -} diff --git a/man/gsmc_plans.Rd b/man/gsmc_plans.Rd deleted file mode 100644 index a14634e01..000000000 --- a/man/gsmc_plans.Rd +++ /dev/null @@ -1,56 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/RcppExports.R -\name{gsmc_plans} -\alias{gsmc_plans} -\title{Run redist gsmc} -\usage{ -gsmc_plans( - N, - adj_list, - counties, - pop, - target, - lower, - upper, - M, - control, - ncores = -1L, - verbosity = 3L, - diagnostic_mode = FALSE -) -} -\arguments{ -\item{N}{The number of districts the final plans will have} - -\item{adj_list}{A 0-indexed adjacency list representing the undirected graph -which represents the underlying map the plans are to be drawn on} - -\item{counties}{Vector of county labels of each vertex in \code{g}} - -\item{pop}{A vector of the population associated with each vertex in \code{g}} - -\item{target}{Ideal population of a valid district. This is what deviance is calculated -relative to} - -\item{lower}{Acceptable lower bounds on a valid district's population} - -\item{upper}{Acceptable upper bounds on a valid district's population} - -\item{M}{The number of plans (samples) to draw} - -\item{control}{Named list of additional parameters.} - -\item{verbosity}{What level of detail to print out while the algorithm is -running \if{html}{\out{}}} - -\item{k_param}{The k parameter from the SMC algorithm, you choose among the top k_param edges} - -\item{num_threads}{The number of threads the threadpool should use} -} -\description{ -Uses gsmc method to generate a sample of \code{M} plans in \verb{c++} -} -\details{ -Using the procedure outlined in \if{html}{\out{}} this function uses Sequential -Monte Carlo (SMC) methods to generate a sample of \code{M} plans -} diff --git a/man/redist_basic_smc.Rd b/man/redist_basic_smc.Rd deleted file mode 100644 index 1901ff89c..000000000 --- a/man/redist_basic_smc.Rd +++ /dev/null @@ -1,33 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/redist_basic_smc.R -\name{redist_basic_smc} -\alias{redist_basic_smc} -\title{Basic SMC Redistricting Sampler} -\usage{ -redist_basic_smc( - state_map, - M, - counties = NULL, - k_params = 6, - resample = TRUE, - runs = 1L, - ncores = 0L, - multiprocess = TRUE, - pop_temper = 0, - verbose = FALSE, - silent = FALSE, - diagnostic_mode = FALSE -) -} -\arguments{ -\item{k_params}{Either a single value to use as the splitting parameter for -every round or a vector of length N-1 where each value is the one to use for -a split.} -} -\value{ -\code{redist_smc} returns a \link{redist_plans} object containing the simulated -plans. -} -\description{ -RedistSMC with optimal weights but not arbitrary region splits -} diff --git a/man/redist_gsmc.Rd b/man/redist_gsmc.Rd deleted file mode 100644 index e350a0374..000000000 --- a/man/redist_gsmc.Rd +++ /dev/null @@ -1,36 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/redist_gsmc.R -\name{redist_gsmc} -\alias{redist_gsmc} -\title{gSMC Redistricting Sampler} -\usage{ -redist_gsmc( - state_map, - M, - counties = NULL, - k_params = 6, - resample = TRUE, - runs = 1L, - ncores = 0L, - multiprocess = TRUE, - pop_temper = 0, - verbose = FALSE, - silent = FALSE, - diagnostic_mode = FALSE -) -} -\arguments{ -\item{k_params}{Either a single value to use as the splitting parameter for -every round or a vector of length N-1 where each value is the one to use for -a split.} - -\item{multiprocess}{Whether or not to launch multiple processes (sometimes -better to disable to avoid using too much memory.)} -} -\value{ -\code{redist_smc} returns a \link{redist_plans} object containing the simulated -plans. -} -\description{ -gSMC Redistricting Sampler -} diff --git a/src/RcppExports.cpp b/src/RcppExports.cpp index 4faa43652..23421ae4a 100644 --- a/src/RcppExports.cpp +++ b/src/RcppExports.cpp @@ -38,28 +38,6 @@ BEGIN_RCPP return rcpp_result_gen; END_RCPP } -// basic_smc_plans -List basic_smc_plans(int N, List adj_list, const arma::uvec& counties, const arma::uvec& pop, double target, double lower, double upper, int M, List control, int ncores, int verbosity, bool diagnostic_mode); -RcppExport SEXP _redist_basic_smc_plans(SEXP NSEXP, SEXP adj_listSEXP, SEXP countiesSEXP, SEXP popSEXP, SEXP targetSEXP, SEXP lowerSEXP, SEXP upperSEXP, SEXP MSEXP, SEXP controlSEXP, SEXP ncoresSEXP, SEXP verbositySEXP, SEXP diagnostic_modeSEXP) { -BEGIN_RCPP - Rcpp::RObject rcpp_result_gen; - Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< int >::type N(NSEXP); - Rcpp::traits::input_parameter< List >::type adj_list(adj_listSEXP); - Rcpp::traits::input_parameter< const arma::uvec& >::type counties(countiesSEXP); - Rcpp::traits::input_parameter< const arma::uvec& >::type pop(popSEXP); - Rcpp::traits::input_parameter< double >::type target(targetSEXP); - Rcpp::traits::input_parameter< double >::type lower(lowerSEXP); - Rcpp::traits::input_parameter< double >::type upper(upperSEXP); - Rcpp::traits::input_parameter< int >::type M(MSEXP); - Rcpp::traits::input_parameter< List >::type control(controlSEXP); - Rcpp::traits::input_parameter< int >::type ncores(ncoresSEXP); - Rcpp::traits::input_parameter< int >::type verbosity(verbositySEXP); - Rcpp::traits::input_parameter< bool >::type diagnostic_mode(diagnostic_modeSEXP); - rcpp_result_gen = Rcpp::wrap(basic_smc_plans(N, adj_list, counties, pop, target, lower, upper, M, control, ncores, verbosity, diagnostic_mode)); - return rcpp_result_gen; -END_RCPP -} // coarsen_adjacency List coarsen_adjacency(List adj, IntegerVector groups); RcppExport SEXP _redist_coarsen_adjacency(SEXP adjSEXP, SEXP groupsSEXP) { @@ -213,28 +191,6 @@ BEGIN_RCPP return rcpp_result_gen; END_RCPP } -// gsmc_plans -List gsmc_plans(int N, List adj_list, const arma::uvec& counties, const arma::uvec& pop, double target, double lower, double upper, int M, List control, int ncores, int verbosity, bool diagnostic_mode); -RcppExport SEXP _redist_gsmc_plans(SEXP NSEXP, SEXP adj_listSEXP, SEXP countiesSEXP, SEXP popSEXP, SEXP targetSEXP, SEXP lowerSEXP, SEXP upperSEXP, SEXP MSEXP, SEXP controlSEXP, SEXP ncoresSEXP, SEXP verbositySEXP, SEXP diagnostic_modeSEXP) { -BEGIN_RCPP - Rcpp::RObject rcpp_result_gen; - Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< int >::type N(NSEXP); - Rcpp::traits::input_parameter< List >::type adj_list(adj_listSEXP); - Rcpp::traits::input_parameter< const arma::uvec& >::type counties(countiesSEXP); - Rcpp::traits::input_parameter< const arma::uvec& >::type pop(popSEXP); - Rcpp::traits::input_parameter< double >::type target(targetSEXP); - Rcpp::traits::input_parameter< double >::type lower(lowerSEXP); - Rcpp::traits::input_parameter< double >::type upper(upperSEXP); - Rcpp::traits::input_parameter< int >::type M(MSEXP); - Rcpp::traits::input_parameter< List >::type control(controlSEXP); - Rcpp::traits::input_parameter< int >::type ncores(ncoresSEXP); - Rcpp::traits::input_parameter< int >::type verbosity(verbositySEXP); - Rcpp::traits::input_parameter< bool >::type diagnostic_mode(diagnostic_modeSEXP); - rcpp_result_gen = Rcpp::wrap(gsmc_plans(N, adj_list, counties, pop, target, lower, upper, M, control, ncores, verbosity, diagnostic_mode)); - return rcpp_result_gen; -END_RCPP -} // log_st_map NumericVector log_st_map(const Graph& g, const arma::umat& districts, const arma::uvec& counties, int n_distr); RcppExport SEXP _redist_log_st_map(SEXP gSEXP, SEXP districtsSEXP, SEXP countiesSEXP, SEXP n_distrSEXP) { @@ -798,42 +754,6 @@ BEGIN_RCPP return rcpp_result_gen; END_RCPP } -// split_entire_map_once_basic_smc -List split_entire_map_once_basic_smc(int N, List adj_list, const arma::uvec& counties, const arma::uvec& pop, double target, double lower, double upper, bool verbose); -RcppExport SEXP _redist_split_entire_map_once_basic_smc(SEXP NSEXP, SEXP adj_listSEXP, SEXP countiesSEXP, SEXP popSEXP, SEXP targetSEXP, SEXP lowerSEXP, SEXP upperSEXP, SEXP verboseSEXP) { -BEGIN_RCPP - Rcpp::RObject rcpp_result_gen; - Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< int >::type N(NSEXP); - Rcpp::traits::input_parameter< List >::type adj_list(adj_listSEXP); - Rcpp::traits::input_parameter< const arma::uvec& >::type counties(countiesSEXP); - Rcpp::traits::input_parameter< const arma::uvec& >::type pop(popSEXP); - Rcpp::traits::input_parameter< double >::type target(targetSEXP); - Rcpp::traits::input_parameter< double >::type lower(lowerSEXP); - Rcpp::traits::input_parameter< double >::type upper(upperSEXP); - Rcpp::traits::input_parameter< bool >::type verbose(verboseSEXP); - rcpp_result_gen = Rcpp::wrap(split_entire_map_once_basic_smc(N, adj_list, counties, pop, target, lower, upper, verbose)); - return rcpp_result_gen; -END_RCPP -} -// basic_smc_split_all_the_way -List basic_smc_split_all_the_way(int N, List adj_list, const arma::uvec& counties, const arma::uvec& pop, double target, double lower, double upper, bool verbose); -RcppExport SEXP _redist_basic_smc_split_all_the_way(SEXP NSEXP, SEXP adj_listSEXP, SEXP countiesSEXP, SEXP popSEXP, SEXP targetSEXP, SEXP lowerSEXP, SEXP upperSEXP, SEXP verboseSEXP) { -BEGIN_RCPP - Rcpp::RObject rcpp_result_gen; - Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< int >::type N(NSEXP); - Rcpp::traits::input_parameter< List >::type adj_list(adj_listSEXP); - Rcpp::traits::input_parameter< const arma::uvec& >::type counties(countiesSEXP); - Rcpp::traits::input_parameter< const arma::uvec& >::type pop(popSEXP); - Rcpp::traits::input_parameter< double >::type target(targetSEXP); - Rcpp::traits::input_parameter< double >::type lower(lowerSEXP); - Rcpp::traits::input_parameter< double >::type upper(upperSEXP); - Rcpp::traits::input_parameter< bool >::type verbose(verboseSEXP); - rcpp_result_gen = Rcpp::wrap(basic_smc_split_all_the_way(N, adj_list, counties, pop, target, lower, upper, verbose)); - return rcpp_result_gen; -END_RCPP -} // tree_pop int tree_pop(Tree& ust, int vtx, const arma::uvec& pop, std::vector& pop_below, std::vector& parent); RcppExport SEXP _redist_tree_pop(SEXP ustSEXP, SEXP vtxSEXP, SEXP popSEXP, SEXP pop_belowSEXP, SEXP parentSEXP) { @@ -882,7 +802,6 @@ END_RCPP static const R_CallMethodDef CallEntries[] = { {"_redist_reduce_adj", (DL_FUNC) &_redist_reduce_adj, 3}, {"_redist_collapse_adj", (DL_FUNC) &_redist_collapse_adj, 2}, - {"_redist_basic_smc_plans", (DL_FUNC) &_redist_basic_smc_plans, 12}, {"_redist_coarsen_adjacency", (DL_FUNC) &_redist_coarsen_adjacency, 2}, {"_redist_get_plan_graph", (DL_FUNC) &_redist_get_plan_graph, 4}, {"_redist_color_graph", (DL_FUNC) &_redist_color_graph, 2}, @@ -894,7 +813,6 @@ static const R_CallMethodDef CallEntries[] = { {"_redist_update_conncomp", (DL_FUNC) &_redist_update_conncomp, 3}, {"_redist_crsg", (DL_FUNC) &_redist_crsg, 9}, {"_redist_dist_dist_diff", (DL_FUNC) &_redist_dist_dist_diff, 7}, - {"_redist_gsmc_plans", (DL_FUNC) &_redist_gsmc_plans, 12}, {"_redist_log_st_map", (DL_FUNC) &_redist_log_st_map, 4}, {"_redist_n_removed", (DL_FUNC) &_redist_n_removed, 3}, {"_redist_countpartitions", (DL_FUNC) &_redist_countpartitions, 1}, @@ -933,8 +851,6 @@ static const R_CallMethodDef CallEntries[] = { {"_redist_perform_a_valid_region_split", (DL_FUNC) &_redist_perform_a_valid_region_split, 16}, {"_redist_swMH", (DL_FUNC) &_redist_swMH, 20}, {"_redist_split_entire_map_once_new_cut_func", (DL_FUNC) &_redist_split_entire_map_once_new_cut_func, 9}, - {"_redist_split_entire_map_once_basic_smc", (DL_FUNC) &_redist_split_entire_map_once_basic_smc, 8}, - {"_redist_basic_smc_split_all_the_way", (DL_FUNC) &_redist_basic_smc_split_all_the_way, 8}, {"_redist_tree_pop", (DL_FUNC) &_redist_tree_pop, 5}, {"_redist_var_info_vec", (DL_FUNC) &_redist_var_info_vec, 3}, {"_redist_sample_ust", (DL_FUNC) &_redist_sample_ust, 6}, diff --git a/src/basic_smc.cpp b/src/basic_smc.cpp deleted file mode 100644 index 70e360154..000000000 --- a/src/basic_smc.cpp +++ /dev/null @@ -1,929 +0,0 @@ -#include "basic_smc.h" - - -//' Attempts to cut one district and remainder from spanning tree -//' -//' Takes a spanning tree `ust` drawn on a specific region and attempts to cut -//' it to produce two new regions using the generalized splitting procedure -//' outlined . This function is based on `cut_districts` in `smc.cpp` -//' -//' @title Attempt One District split -//' -//' @param ust A directed spanning tree passed by reference -//' @param k_param The k parameter from the SMC algorithm, you choose among the top k_param edges -//' @param root The root vertex of the spanning tree -//' @param pop A vector of the population associated with each vertex in `g` -//' @param plan A plan object -//' @param region_id_to_split The id of the region in the plan object we're attempting to split -//' @param lower Acceptable lower bounds on a valid district's population -//' @param upper Acceptable upper bounds on a valid district's population -//' @param target Ideal population of a valid district. This is what deviance is calculated -//' relative to -//' @param new_region_ids A vector that will be updated by reference to contain the names of -//' the two new split regions if function is successful. -//' -//' @details Modifications -//' - If two new valid regions are split then the plan object is updated accordingly -//' - If two new valid regions are split then the new_region_ids is updated so the -//' first entry is the first new region and the second entry is the second new region -//' -//' @return True if two valid regions were split off false otherwise -//' -bool basic_cut_district(Tree &ust, int k_param, int root, - const uvec &pop, - Plan &plan, const int region_id_to_split, - double lower, double upper, double target, - std::vector &new_region_ids){ - // Get population of region being split - double total_pop = plan.region_pops.at(region_id_to_split); - // Get the number of final districts in region being split - int remainder_dsize = plan.region_dvals.at(region_id_to_split); - - if(remainder_dsize <= 1){ - Rprintf("BIG ERROR THE REGION TO SPLIT IS NOT MULTI DIST\n"); - } - - // Rcout << "For " << region_id_to_split << " Total pop is " << total_pop << " and d_nk is " << remainder_dsize << "\n"; - - // create list that points to parents & computes population below each vtx - std::vector pop_below(plan.V, 0); - std::vector parent(plan.V); - parent[root] = -1; - tree_pop(ust, root, pop, pop_below, parent); - - // compile a list of: things for each edge in tree - std::vector candidates; // candidate edges to cut, - std::vector deviances; // how far from target pop. - std::vector is_ok; // whether they meet constraints - std::vector new_d_val; // the new d_n,k value - - // Reserve at least as much space for top k_param of them - candidates.reserve(k_param); - deviances.reserve(k_param); - is_ok.reserve(k_param); - new_d_val.reserve(k_param); - - if(plan.region_num_ids.at(root) != region_id_to_split){ - Rcout << "Root vertex is not in region to split!"; - } - - // Now loop over all valid edges to cut - for (int i = 1; i <= plan.V; i++) { // 1-indexing here - // Ignore any vertex not in this region or the root vertex as we wont be cutting those - if (plan.region_num_ids.at(i-1) != region_id_to_split || i - 1 == root) continue; - - // Get the population of one side of the partition removing that edge would cause - double below = pop_below.at(i - 1); - // Get the population of the other side - double above = total_pop - below; - - // vectors to keep track of value for each d_{n,k} - double dev; - bool dev2_bigger; - bool pop_in_bounds; - - // Find which cut induces something closer to district - double dev1 = std::fabs(below - target); - double dev2 = std::fabs(above - target); - - // If dev1 is smaller then we assign district to below - if (dev1 < dev2) { - dev = dev1; - dev2_bigger= true; - // check in bounds - pop_in_bounds = lower <= below - && below <= upper - && lower * (remainder_dsize - 1) <= above - && above <= upper * (remainder_dsize - 1); - } else { // Else if dev2 is smaller we assign d_nk to above - dev = dev2; - dev2_bigger = false; - pop_in_bounds = lower <= above - && above <= upper - && lower * (remainder_dsize - 1) <= below - && below <= upper * (remainder_dsize - 1); - } - - - - /* - Rcout << "min element has value " << *result << " and index [" - << best_potential_d << "]\n"; - */ - - if(dev2_bigger){ - candidates.push_back(i); - } else{ - candidates.push_back(-i); - } - - deviances.push_back(dev); - is_ok.push_back(pop_in_bounds); - // the new d value is always 1 - new_d_val.push_back(1); - - } - - - // if less than k_param candidates immediately reject - if((int) candidates.size() < k_param){ - return false; - } - - int idx = r_int(k_param); - idx = select_k(deviances, idx + 1); - int cut_at = std::fabs(candidates[idx]) - 1; - - - // reject sample if not ok - if (!is_ok[idx]){ - return false; - } - - - - - // find index of node to cut at - std::vector *siblings = &ust[parent[cut_at]]; - int length = siblings->size(); - int j; - for (j = 0; j < length; j++) { - if ((*siblings)[j] == cut_at) break; - } - - siblings->erase(siblings->begin()+j); // remove edge - parent[cut_at] = -1; - - - // update plan with new regions - plan.num_regions++; // increase region count by 1 - plan.num_multidistricts--; // Decrease by one to avoid double counting later - - // Create info for two new districts - int new_region1_d = new_d_val[idx]; - int new_region2_d = remainder_dsize - new_region1_d; - - std::string new_region_label1; - std::string new_region_label2; - - std::string region_to_split = plan.region_str_labels.at(region_id_to_split); - - // Set label and count depending on if district or multi district - if(new_region1_d == 1){ - plan.num_districts++; - // if district then string label just adds district number - new_region_label1 = region_to_split + "." + std::to_string(plan.num_districts); - }else{ - plan.num_multidistricts++; - // if region then just add current region number - new_region_label1 = region_to_split + ".R" + std::to_string(region_id_to_split); - } - - // Now do it for second region - if(new_region2_d == 1){ - plan.num_districts++; - // if district then string label just adds district number - new_region_label2 = region_to_split + "." + std::to_string(plan.num_districts); - }else{ - plan.num_multidistricts++; - // if region then just add current region number - new_region_label2 = region_to_split + ".R" + std::to_string(plan.num_regions - 1); - } - - // Check whether the new regions are districts or multidistricts - - - // Vertex to start traversing tree for updating later - int tree_vertex1; - int tree_vertex2; - - // population and d_nk of new regions - double new_region1_pop; - double new_region2_pop; - - - if (candidates[idx] > 0) { // Means cut below so first vertex is cut_at - tree_vertex1 = cut_at; - tree_vertex2 = root; - - // Set the new populations - new_region1_pop = pop_below.at(cut_at); - new_region2_pop = total_pop - new_region1_pop; - - // return pop_below.at(cut_at); - } else { // Means cut above so first vertex is root - tree_vertex1 = root; - tree_vertex2 = cut_at; - - // Set the new populations - new_region2_pop = pop_below.at(cut_at); - new_region1_pop = total_pop - new_region2_pop; - - } - - - // update the function parameter with names of new regions - if(new_region_ids.size() != 2){ - Rcout << "For some reason the new_region_ids vector in cut_regions is not size 2!\n"; - } - - // Get the regions current integer id - int old_region_num_id = region_id_to_split; - // make the first new region have the same integer id - int new_region_num_id1 = old_region_num_id; - // Second new region has id of the new number of regions minus 1 - int new_region_num_id2 = plan.num_regions - 1; - - new_region_ids[0] = new_region_num_id1; - new_region_ids[1] = new_region_num_id2; - - - // Now update the two cut portions - assign_region(ust, plan, tree_vertex1, new_region_num_id1); - assign_region(ust, plan, tree_vertex2, new_region_num_id2); - - // Now update the region level information - - // Add the new region 1 - - // New region 1 has the same id number as old region so update that - plan.region_dvals.at(new_region_num_id1) = new_region1_d; - plan.region_str_labels.at(new_region_num_id1) = new_region_label1; - plan.region_pops.at(new_region_num_id1) = new_region1_pop; - - // Add the new region 2 - // New region 2's id is the highest id number so push back - plan.region_dvals.push_back(new_region2_d); - plan.region_str_labels.push_back(new_region_label2); - plan.region_pops.push_back(new_region2_pop); - - - return true; - -}; - - - -//' Attempts to split a remainder region within a plan into a district and a -//' new remainder region with valid population bounds for both -//' -//' Given a plan with a remainder region this attempts to split a district off -//' from it where both new district and new remainder have valid population bounds. -//' Does this by drawing a spanning tree uniformly at random then calling -//' `basic_cut_district` on that. If the split it successful it returns true -//' and modifies `plan` and `new_region_ids` accordingly. This is based on the -//' `split_map` function in smc.cpp -//' -//' -//' @title Attempt to split a district from a remainder region in a plan -//' -//' @param g A graph (adjacency list) passed by reference -//' @param ust A directed tree object (this will be cleared in the function so -//' whatever it was before doesn't matter) -//' @param counties Vector of county labels of each vertex in `g` -//' @param cg multigraph object (not sure why this is needed) -//' @param plan A plan object -//' @param region_id_to_split The label of the region in the plan object we're attempting to split -//' @param new_region_ids A vector that will be updated by reference to contain the names of -//' the two new split regions if function is successful. -//' @param lower Acceptable lower bounds on a valid district's population -//' @param upper Acceptable upper bounds on a valid district's population -//' @param target Ideal population of a valid district. This is what deviance is calculated -//' relative to -//' Target population (probably Total population of map/Num districts) -//' @param k_param The k parameter from the SMC algorithm, you choose among the top k_param edges -//' -//' @details Modifications -//' - If two new valid regions are split then the plan object is updated accordingly -//' - If two new valid regions are split then the new_region_ids is updated so the -//' first entry is the first new region and the second entry is the second new region -//' -//' @return True if two valid regions were split off false otherwise -//' -bool attempt_district_split(const Graph &g, Tree &ust, const uvec &counties, Multigraph &cg, - Plan &plan, const int region_id_to_split, - std::vector &new_region_ids, - std::vector &visited, std::vector &ignore, const uvec &pop, - double &lower, double upper, double target, int k_param) { - - int V = g.size(); - - // Mark it as ignore if its not in the region to split - for (int i = 0; i < V; i++){ - ignore[i] = plan.region_num_ids.at(i) != region_id_to_split; - } - - // Get a uniform spanning tree drawn on that region - int root; - clear_tree(ust); - // Get a tree - int result = sample_sub_ust(g, ust, V, root, visited, ignore, pop, lower, upper, counties, cg); - // Return unsuccessful if tree not drawn - if (result != 0) return false; - - // Now try to cut the tree and return that result - return basic_cut_district(ust, k_param, root, pop, - plan, region_id_to_split, - lower, upper, target, - new_region_ids); - -} - - - - - -/* - * Split off a piece from each map in `districts`, - * keeping deviation between `lower` and `upper` - */ - -// This should just update ancestor, lag, and give log prob reason was picked. -// Everything else can happen outside. -// Actually we compute incremental weight in the function. - - -//' Splits a multidistrict in all of the plans -//' -//' Using the procedure outlined in this function attempts to split -//' a multidistrict in a previous steps plan until M successful splits have been made. This -//' is based on the `split_maps` function in smc.cpp -//' -//' @title Split all the maps -//' -//' @param g A graph (adjacency list) passed by reference -//' @param counties Vector of county labels of each vertex in `g` -//' @param cg County level multigraph -//' @param pop A vector of the population associated with each vertex in `g` -//' @param old_plans_vec A vector of plans from the previous step -//' @param new_plans_vec A vector which will be filled with plans that had a -//' multidistrict split to make them -//' @param original_ancestor_vec A vector used to track which original ancestor -//' the new plans descended from. The value of `original_ancestor_vec[i]` -//' is the index of the original ancestor the new plan `new_plans_vec[i]` is -//' descended from. -//' @param parent_vec A vector used to track the index of the previous plan -//' sampled that was successfully split. The value of `parent_vec[i]` is the -//' index of the old plan from which the new plan `new_plans_vec[i]` was -//' successfully split from. In other words `new_plans_vec[i]` is equal to -//' `attempt_district_split(old_plans_vec[parent_vec[i]], ...)` -//' @param prev_ancestor_vec A vector used to track the index of the original -//' ancestor of the previous plans. The value of `prev_ancestor_vec[i]` is the -//' index of the original ancestor of `old_plans_vec[i]` -//' @param unnormalized_sampling_weights A vector of weights used to sample indices -//' of the `old_plans_vec`. The value of `unnormalized_sampling_weights[i]` is -//' the unnormalized probability that index i is selected -//' @param normalized_weights_to_fill_in A vector which will be filled with the -//' normalized weights the index sampler uses. The value of -//' `normalized_weights_to_fill_in[i]` is the probability that index i is selected -//' @param draw_tries_vec A vector used to keep track of how many plan split -//' attempts were made for index i. The value `draw_tries_vec[i]` represents how -//' many split attempts were made for the i-th new plan (including the successful -//' split). For example, `draw_tries_vec[i] = 1` means that the first split -//' attempt was successful. -//' @param parent_unsuccessful_tries_vec A vector used to keep track of how many times the -//' previous rounds plans were sampled and unsuccessfully split. The value -//' `parent_unsuccessful_tries_vec[i]` represents how many times `old_plans_vec[i]` was sampled -//' and then unsuccessfully split while creating all `M` of the new plans. -//' THIS MAY NOT BE THREAD SAFE -//' @param accept_rate The number of accepted splits over the total number of -//' attempted splits. This is equal to `sum(draw_tries_vec)/M` -//' @param n_unique_parent_indices The number of unique parent indices, ie the -//' number of previous plans that had at least one descendant amongst the new -//' plans. This is equal to `unique(parent_vec)` -//' @param n_unique_original_ancestors The number of unique original ancestors, -//' in the new plans. This is equal to `unique(original_ancestor_vec)` -//' @param ancestors Parameter from older `smc.cpp` code. I DON'T UNDERSTAND -//' WHAT IT IS DOING -//' @param lags Parameter from older `smc.cpp` code. I DON'T UNDERSTAND -//' WHAT IT IS DOING -//' @param lower Acceptable lower bounds on a valid district's population -//' @param upper Acceptable upper bounds on a valid district's population -//' @param target Ideal population of a valid district. This is what deviance is calculated -//' relative to -//' @param k_param The top edges to pick parameter for the region splitting -//' algorithm -//' @param pool A threadpool for multithreading -//' @param verbosity A parameter controlling the amount of detail printed out -//' during the algorithms running -//' -//' @details Modifications -//' - The `new_plans_vec` is updated with all the newly split plans -//' - The `old_plans_vec` is updated with all the newly split plans as well. -//' Note that the reason both this and `new_plans_vec` are updated is because -//' of the nature of the code you need both vectors and so both are passed by -//' reference to save memory. -//' - The `original_ancestor_vec` is updated to contain the indices of the -//' original ancestors of the new plans -//' - The `parent_vec` is updated to contain the indices of the parents of the - //' new plans -//' - If two new valid regions are split then the new_region_ids is updated so the -//' first entry is the first new region and the second entry is the second new region -//' - The `normalized_weights_to_fill_in` is updated to contain the normalized -//' probabilities the index sampler used. This is only collected for diagnostics -//' at this point and should just be equal to `unnormalized_sampling_weights` -//' divided by `sum(unnormalized_sampling_weights)` -//' - The `draw_tries_vec` is updated to contain the number of tries for each -//' of the new plans -//' - The `parent_unsuccessful_tries_vec` is updated to contain the number of unsuccessful -//' samples of the old plans -//' - The `accept_rate` is updated to contain the average acceptance rate for -//' this iteration -//' - `n_unique_parent_indices` and `n_unique_original_ancestors` are updated -//' with the unique number of parents and original ancestors for all the new -//' plans respectively -//' - `ancestors` is updated to something. THIS IS FROM ORIGINAL SMC CODE, -//' I DO NOT KNOW WHAT IT MEANS -//' -//' @return nothing -//' -void basic_split_maps( - const Graph &g, const uvec &counties, Multigraph &cg, const uvec &pop, - std::vector &old_plans_vec, std::vector &new_plans_vec, - std::vector &original_ancestor_vec, - std::vector &parent_vec, - const std::vector &prev_ancestor_vec, - const std::vector &unnormalized_sampling_weights, - std::vector &normalized_weights_to_fill_in, - std::vector &draw_tries_vec, - std::vector &parent_unsuccessful_tries_vec, - double &accept_rate, - int &n_unique_parent_indices, - int &n_unique_original_ancestors, - umat &ancestors, const std::vector &lags, - double lower, double upper, double target, - int k_param, - RcppThread::ThreadPool &pool, - int verbosity - ) { - // important constants - const int V = g.size(); - const int M = old_plans_vec.size(); - - - uvec iters(M, fill::zeros); // how many actual iterations, (used to compute acceptance rate) - uvec original_ancestor_uniques(M); // used to compute unique original ancestors - uvec parent_index_uniques(M); // used to compute unique parent indicies - - // PREVIOUS SMC CODE I DONT KNOW WHAT IT DOES - const int dist_ctr = old_plans_vec.at(0).num_regions; - const int n_lags = lags.size(); - umat ancestors_new(M, n_lags); // lags/ancestor thing - - - - // Create the obj which will sample from the index with probability - // proportional to the weights - std::random_device rd; - std::mt19937 gen(rd()); - std::discrete_distribution<> index_sampler( - unnormalized_sampling_weights.begin(), - unnormalized_sampling_weights.end() - ); - - // extract and record the normalized weights the sampler is using - std::vector p = index_sampler.probabilities(); - int nw_index = 0; - bool print_weights = M < 12 && verbosity > 1; - if(print_weights){ - Rprintf("Unnormalized weights are: "); - for (auto w : unnormalized_sampling_weights){ - Rprintf("%.4f, ", w); - } - - Rprintf("\n"); - Rprintf("Normalized weights are: "); - } - for (auto prob : p){ - if(print_weights) Rprintf("%.4f, ", prob); - normalized_weights_to_fill_in.at(nw_index) = prob; - nw_index++; - } - if(print_weights) Rprintf("\n"); - - // Because of multithreading we have to add specific checks for if the user - // wants to quit the program - const int reject_check_int = 200; // check for interrupts every _ rejections - const int check_int = 50; // check for interrupts every _ iterations - - - // create a progress bar - RcppThread::ProgressBar bar(M, 1); - // Parallel thread pool where all objects in memory shared by default - pool.parallelFor(0, M, [&] (int i) { - int reject_ct = 0; - bool ok = false; - int idx; - // the id of the remainder is always the biggest region id - // which is dist_ctr - 1 - int region_id_to_split = dist_ctr - 1; - std::vector new_region_ids(2, -1); - - Tree ust = init_tree(V); - std::vector visited(V); - std::vector ignore(V); - while (!ok) { - // increase the iters count by one - iters[i]++; - // use weights to sample previous plan - idx = index_sampler(gen); - Plan proposed_new_plan = old_plans_vec[idx]; - - // Now try to split that region - ok = attempt_district_split(g, ust, counties, cg, - proposed_new_plan, region_id_to_split, - new_region_ids, - visited, ignore, pop, - lower, upper, target, k_param); - - // bad sample; try again - if (!ok) { - // THIS MAY NOT BE THREAD SAFE - parent_unsuccessful_tries_vec[idx]++; // update unsuccessful try - RcppThread::checkUserInterrupt(++reject_ct % reject_check_int == 0); - continue; - } - - // else update the new plan and leave the while loop - new_plans_vec[i] = proposed_new_plan; - - } - - // Record how many tries needed to create i-th new plan - draw_tries_vec[i] = static_cast(iters[i]); - // Make the new plans original ancestor the same as its parent - original_ancestor_uniques[i] = prev_ancestor_vec[idx]; - // record index of new plan's parent - parent_index_uniques[i] = idx; - // clear the spanning tree - clear_tree(ust); - - // ORIGINAL SMC CODE I DONT KNOW WHAT THIS DOES - // save ancestors/lags - for (int j = 0; j < n_lags; j++) { - if (dist_ctr <= lags[j]) { - ancestors_new(i, j) = i; - } else { - ancestors_new(i, j) = ancestors(idx, j); - } - } - - - // update this particles ancestor to be the ancestor of its previous one - parent_vec[i] = idx; - original_ancestor_vec[i] = prev_ancestor_vec[idx]; - - RcppThread::checkUserInterrupt(i % check_int == 0); - }); - - // Wait for all the threads to finish - pool.wait(); - - - - // now replace the old plans with the new ones - for(int i=0; i < M; i++){ - old_plans_vec[i] = new_plans_vec[i]; - } - - - // now compute acceptance rate and unique parents and original ancestors - accept_rate = M / (1.0 * sum(iters)); - n_unique_original_ancestors = ((uvec) find_unique(original_ancestor_uniques)).n_elem; - n_unique_parent_indices = ((uvec) find_unique(parent_index_uniques)).n_elem; - if (verbosity >= 3) { - Rprintf("%.2f acceptance rate, %d unique parent indices sampled, and %d unique original ancestors!\n", - 100.0 * accept_rate, (int) n_unique_parent_indices , (int) n_unique_original_ancestors); - } - - // ORIGINAL SMC CODE I DONT KNOW WHAT IT DOES - ancestors = ancestors_new; - -} - - - -//' Computes log unnormalized weights for vector of plans -//' -//' Using the procedure outlined in this function computes the log -//' incremental weights and the unnormalized weights for a vector of plans (which -//' may or may not be the same depending on the parameters). -//' -//' @title Compute Log Unnormalized Weights -//' -//' @param pool A threadpool for multithreading -//' @param g A graph (adjacency list) passed by reference -//' @param plans_vec A vector of plans to compute the log unnormalized weights -//' of -//' @param log_incremental_weights A vector of the log incremental weights -//' computed for the plans. The value of `log_incremental_weights[i]` is -//' the log incremental weight for `plans_vec[i]` -//' @param unnormalized_sampling_weights A vector of the unnormalized sampling -//' weights to be used with sampling the `plans_vec` in the next iteration of the -//' algorithm. Depending on the other hyperparameters this may or may not be the -//' same as `exp(log_incremental_weights)` -//' @param target Target population of a single district -//' @param pop_temper
-//' -//' @details Modifications -//' - The `log_incremental_weights` is updated to contain the incremental -//' weights of the plans -//' - The `unnormalized_sampling_weights` is updated to contain the unnormalized -//' sampling weights of the plans for the next round -void get_log_basic_smc_weights( - RcppThread::ThreadPool &pool, - const Graph &g, std::vector &plans_vec, - std::vector &log_incremental_weights, - std::vector &unnormalized_sampling_weights, - double target, double pop_temper -){ - int M = (int) plans_vec.size(); - - // Parallel thread pool where all objects in memory shared by default - pool.parallelFor(0, M, [&] (int i) { - double log_incr_weight = compute_basic_smc_log_incremental_weight( - g, plans_vec.at(i), target, pop_temper); - log_incremental_weights[i] = log_incr_weight; - unnormalized_sampling_weights[i] = std::exp(log_incr_weight); - }); - - - // Wait for all the threads to finish - pool.wait(); - - return; -} - - -//' Uses gsmc method to generate a sample of `M` plans in `c++` -//' -//' Using the procedure outlined in this function uses Sequential -//' Monte Carlo (SMC) methods to generate a sample of `M` plans -//' -//' @title Run redist gsmc -//' -//' @param N The number of districts the final plans will have -//' @param adj_list A 0-indexed adjacency list representing the undirected graph -//' which represents the underlying map the plans are to be drawn on -//' @param counties Vector of county labels of each vertex in `g` -//' @param pop A vector of the population associated with each vertex in `g` -//' @param target Ideal population of a valid district. This is what deviance is calculated -//' relative to -//' @param lower Acceptable lower bounds on a valid district's population -//' @param upper Acceptable upper bounds on a valid district's population -//' @param M The number of plans (samples) to draw -//' @param control Named list of additional parameters. -//' @param num_threads The number of threads the threadpool should use -//' @param verbosity What level of detail to print out while the algorithm is -//' running -//' @export -List basic_smc_plans( - int N, List adj_list, - const arma::uvec &counties, const arma::uvec &pop, - double target, double lower, double upper, - int M, // M is Number of particles aka number of different plans - List control, // control has pop temper, and k parameter value - int num_threads, int verbosity, bool diagnostic_mode){ - - // set number of threads - if (num_threads <= 0) num_threads = std::thread::hardware_concurrency(); - if (num_threads == 1) num_threads = 0; - - // lags thing (copied from original smc code, don't understand what its doing) - std::vector lags = as>(control["lags"]); - // k param values to use - std::vector k_params = as>(control["k_params"]); - - double pop_temper = as(control["pop_temper"]); - - - umat ancestors(M, lags.size(), fill::zeros); - - // Create map level graph and county level multigraph - Graph g = list_to_graph(adj_list); - Multigraph cg = county_graph(g, counties); - - int V = g.size(); - double total_pop = sum(pop); - - // Loading Info - if (verbosity >= 1) { - Rcout.imbue(std::locale("")); - Rcout << std::fixed << std::setprecision(0); - Rcout << "GENERALIZED SEQUENTIAL MONTE CARLO\n"; - Rcout << "Sampling " << M << " " << V << "-unit "; - Rcout << "maps with " << N << " districts and population between " - << lower << " and " << upper << " using " << num_threads << " threads.\n"; - if (cg.size() > 1){ - Rcout << "Ensuring no more than " << N - 1 << " splits of the " - << cg.size() << " administrative units.\n"; - } - } - - - - std::vector plans_vec(M, Plan(V, N, total_pop)); - std::vector new_plans_vec(M, Plan(V, N, total_pop)); // New plans - - - // Define output variables that must always be created - - // This is N-1 by M where [i][j] is the index of the parent of particle j on step i - // ie the index of the previous plan that was sampled and used to create particle j on step i - std::vector> parent_index_mat(N-1, std::vector (M, -1)); - - // This is N-1 by M where [i][j] is the index of the original (first) ancestor of particle j on step i - std::vector> original_ancestor_mat(N-1, std::vector (M, -1)); - - // This is N-1 by M where [i][j] is the number of tries it took to form particle j on iteration i - // Inclusive of the final step. ie if succeeds in one try it would be 1 - std::vector> draw_tries_mat(N-1, std::vector (M, -1)); - - // This is N-1 by M where [i][j] is the number of times particle j from the - // previous round was sampled and unsuccessfully split on iteration i so this - // does not count successful sample then split - std::vector> parent_unsuccessful_tries_mat(N-1, std::vector (M, 0)); - - // This is N-1 by M where [i][j] is the log incremental weight of particle j on step i - std::vector> log_incremental_weights_mat(N-1, std::vector (M, -1.0)); - - // This is N-1 by M where [i][j] is the normalized weight of particle j on step i - std::vector> normalized_weights_mat(N-1, std::vector (M, -1.0)); - - - - - // Tracks the acceptance rate - total number of tries over M - for each round - std::vector acceptance_rates(N-1, -1.0); - - // Tracks the effective sample size for the weights of each round - std::vector n_eff(N-1, -1.0); - - // Tracks the number of unique parent vectors sampled to create the next round - std::vector nunique_parents_vec(N-1, -1); - - // Tracks the number of unique ancestors left at each step - std::vector nunique_original_ancestors_vec(N-1, -1); - - - // Declare variables whose size will depend on whether or not we're in - // diagnostic mode or not - std::vector>> plan_region_ids_mat; - - - - - // If diagnostic mode track stuff from every round - if(diagnostic_mode){ - // Create info tracking we will pass out at the end - // This is N-1 by M by V where for each n=1,...,N-1 and m=1,...M it maps vertices to integer id - plan_region_ids_mat.resize(N-1, std::vector>( - M, std::vector(V, -1) - )); - - - - }else{ // else only track for final round - // Create info tracking we will pass out at the end - // This is M by V where for each m=1,...M it maps vertices to integer id for plan - plan_region_ids_mat.resize(1, std::vector>( - M, std::vector(V, -1) - )); - } - - - // Start off all the unnormalized weights at 1 - std::vector unnormalized_sampling_weights(M, 1.0); - - - // Create a threadpool - - RcppThread::ThreadPool pool(num_threads); - - std::string bar_fmt = "Split [{cli::pb_current}/{cli::pb_total}] {cli::pb_bar} | ETA{cli::pb_eta}"; - RObject bar = cli_progress_bar(N-1, cli_config(false, bar_fmt.c_str())); - - // Now for each run through split the map - try { - for(int n=0; n 1){ - Rprintf("Iteration %d \n", n+1); - } - - - // For the first iteration we need to pass a special previous ancestor thing - if(n == 0){ - std::vector dummy_prev_ancestors(M, 1); - // split the map - basic_split_maps( - g, counties, cg, pop, - plans_vec, new_plans_vec, - original_ancestor_mat[n], - parent_index_mat[n], - dummy_prev_ancestors, - unnormalized_sampling_weights, - normalized_weights_mat[n], - draw_tries_mat[n], - parent_unsuccessful_tries_mat.at(n), - acceptance_rates[n], - nunique_parents_vec[n], - nunique_original_ancestors_vec[n], - ancestors, lags, - lower, upper, target, - k_params[n], - pool, - verbosity - ); - - // For the first ancestor one make every ancestor themselves - std::iota (parent_index_mat[0].begin(), parent_index_mat[0].end(), 0); - std::iota (original_ancestor_mat[0].begin(), original_ancestor_mat[0].end(), 0); - }else{ - // split the map and we can use the previous original ancestor matrix row - basic_split_maps( - g, counties, cg, pop, - plans_vec, new_plans_vec, - original_ancestor_mat[n], - parent_index_mat[n], - original_ancestor_mat[n-1], - unnormalized_sampling_weights, - normalized_weights_mat[n], - draw_tries_mat[n], - parent_unsuccessful_tries_mat.at(n), - acceptance_rates[n], - nunique_parents_vec[n], - nunique_original_ancestors_vec[n], - ancestors, lags, - lower, upper, target, - k_params[n], - pool, - verbosity - ); - } - - if (verbosity == 1 && CLI_SHOULD_TICK){ - cli_progress_set(bar, n); - } - Rcpp::checkUserInterrupt(); - - - // compute log incremental weights and sampling weights for next round - get_log_basic_smc_weights( - pool, - g, - new_plans_vec, - log_incremental_weights_mat.at(n), - unnormalized_sampling_weights, - target, - pop_temper - ); - - // compute effective sample size - n_eff.at(n) = compute_n_eff(log_incremental_weights_mat[n]); - - // Now update the diagnostic info if needed - if(diagnostic_mode && n == N-2){ // record if in diagnostic mode and final step - for(int j=0; j -#include -#include -#include -#include -#include - -#include -#include "wilson.h" -#include "tree_op.h" -#include "map_calc.h" -#include "redist_types.h" -#include "weights.h" -#include "splitting.h" - - - - -//' Uses gsmc method to generate a sample of `M` plans in `c++` -//' -//' Using the procedure outlined in this function uses Sequential -//' Monte Carlo (SMC) methods to generate a sample of `M` plans -//' -//' @title Run redist gsmc -//' -//' @param N The number of districts the final plans will have -//' @param adj_list A 0-indexed adjacency list representing the undirected graph -//' which represents the underlying map the plans are to be drawn on -//' @param counties Vector of county labels of each vertex in `g` -//' @param pop A vector of the population associated with each vertex in `g` -//' @param target Ideal population of a valid district. This is what deviance is calculated -//' relative to -//' @param lower Acceptable lower bounds on a valid district's population -//' @param upper Acceptable upper bounds on a valid district's population -//' @param M The number of plans (samples) to draw -//' @param k_param The k parameter from the SMC algorithm, you choose among the top k_param edges -//' @param control Named list of additional parameters. -//' @param num_threads The number of threads the threadpool should use -//' @param verbosity What level of detail to print out while the algorithm is -//' running -//' @export -// [[Rcpp::export]] -List basic_smc_plans( - int N, List adj_list, - const arma::uvec &counties, const arma::uvec &pop, - double target, double lower, double upper, - int M, // Number of particles aka number of different plans - List control, - int ncores = -1, int verbosity = 3, bool diagnostic_mode = false); - - - - -bool attempt_district_split(const Graph &g, Tree &ust, const uvec &counties, Multigraph &cg, - Plan &plan, const int region_id_to_split, - std::vector &new_region_ids, - std::vector &visited, std::vector &ignore, const uvec &pop, - double &lower, double upper, double target, int k_param); - - -bool basic_cut_district(Tree &ust, int k_param, int root, - const uvec &pop, - Plan &plan, const int region_id_to_split, - double lower, double upper, double target, - std::vector &new_region_ids); - -#endif diff --git a/src/gsmc.cpp b/src/gsmc.cpp deleted file mode 100644 index 98568606f..000000000 --- a/src/gsmc.cpp +++ /dev/null @@ -1,979 +0,0 @@ -#include "gsmc.h" - - -//' Attempts to cut one region into two from spanning tree -//' -//' Takes a spanning tree `ust` drawn on a specific region and attempts to cut -//' it to produce two new regions using the generalized splitting procedure -//' outlined . This function is based on `cut_districts` in `smc.cpp` -//' -//' @title Attempt Generalized Region split -//' -//' @param ust A directed spanning tree passed by reference -//' @param k_param The k parameter from the SMC algorithm, you choose among the top k_param edges -//' @param root The root vertex of the spanning tree -//' @param pop A vector of the population associated with each vertex in `g` -//' @param plan A plan object -//' @param region_id_to_split The id of the region in the plan object we're attempting to split -//' @param lower Acceptable lower bounds on a valid district's population -//' @param upper Acceptable upper bounds on a valid district's population -//' @param target Ideal population of a valid district. This is what deviance is calculated -//' relative to -//' @param new_region_ids A vector that will be updated by reference to contain the names of -//' the two new split regions if function is successful. -//' -//' @details Modifications -//' - If two new valid regions are split then the plan object is updated accordingly -//' - If two new valid regions are split then the new_region_ids is updated so the -//' first entry is the first new region and the second entry is the second new region -//' -//' @return True if two valid regions were split off false otherwise -//' -bool cut_regions(Tree &ust, int k_param, int root, - const uvec &pop, - Plan &plan, const int region_id_to_split, - double lower, double upper, double target, - std::vector &new_region_ids){ - // Get population of region being split - double total_pop = plan.region_pops.at(region_id_to_split); - // Get the number of final districts in region being split - int num_final_districts = plan.region_dvals.at(region_id_to_split); - - // Rcout << "For " << region_id_to_split << " Total pop is " << total_pop << " and d_nk is " << num_final_districts << "\n"; - - // create list that points to parents & computes population below each vtx - std::vector pop_below(plan.V, 0); - std::vector parent(plan.V); - parent[root] = -1; - tree_pop(ust, root, pop, pop_below, parent); - - // compile a list of: things for each edge in tree - std::vector candidates; // candidate edges to cut, - std::vector deviances; // how far from target pop. - std::vector is_ok; // whether they meet constraints - std::vector new_d_val; // the new d_n,k value - - // Reserve at least as much space for top k_param of them - candidates.reserve(k_param); - deviances.reserve(k_param); - is_ok.reserve(k_param); - new_d_val.reserve(k_param); - - if(plan.region_num_ids.at(root) != region_id_to_split){ - Rcout << "Root vertex is not in region to split!"; - } - - // Now loop over all valid edges to cut - for (int i = 1; i <= plan.V; i++) { // 1-indexing here - // Ignore any vertex not in this region or the root vertex as we wont be cutting those - if (plan.region_num_ids.at(i-1) != region_id_to_split || i - 1 == root) continue; - - // Get the population of one side of the partition removing that edge would cause - double below = pop_below.at(i - 1); - // Get the population of the other side - double above = total_pop - below; - - // vectors to keep track of value for each d_{n,k} - std::vector devs(num_final_districts-1); - std::vector dev2_bigger(num_final_districts-1); - std::vector are_ok(num_final_districts-1); - - - // Now try each potential d_nk value from 1 up to d_n-1,k -1 - // remember to correct for 0 indexing - for(int potential_d = 1; potential_d < num_final_districts; potential_d++){ - - double dev1 = std::fabs(below - target * potential_d); - double dev2 = std::fabs(above - target * potential_d); - - /* - Rcout << "\nit is " << dev1 << " and " << dev2 << " for " << potential_d << "\n"; - Rcout << std::printf( - "We are on d = %d and upper is %f while lower is %f \n", - potential_d, above, below); - */ - - // If dev1 is smaller then we assign d_nk to below - if (dev1 < dev2) { - devs[potential_d-1] = dev1; - dev2_bigger[potential_d-1] = true; - // check in bounds - are_ok[potential_d-1] = lower * potential_d <= below - && below <= upper * potential_d - && lower * (num_final_districts - potential_d) <= above - && above <= upper * (num_final_districts - potential_d); - } else { // Else if dev2 is smaller we assign d_nk to above - devs[potential_d-1] = dev2; - dev2_bigger[potential_d-1] = false; - are_ok[potential_d-1] = lower * potential_d <= above - && above <= upper * potential_d - && lower * (num_final_districts - potential_d) <= below - && below <= upper * (num_final_districts - potential_d); - } - - } - - /* - Rcout << "The full vector is "; - for (auto i: devs) - Rcout << i << ' '; - Rcout << "\n"; - */ - - // Now find the value of d_{n,k} that has the smallest deviation - std::vector::iterator result = std::min_element(devs.begin(), devs.end()); - int best_potential_d = std::distance(devs.begin(), result); - - /* - Rcout << "min element has value " << *result << " and index [" - << best_potential_d << "]\n"; - */ - - if(dev2_bigger[best_potential_d]){ - candidates.push_back(i); - } else{ - candidates.push_back(-i); - } - - deviances.push_back(devs[best_potential_d]); - is_ok.push_back(are_ok[best_potential_d]); - new_d_val.push_back(best_potential_d+1); - - } - - - // if less than k_param candidates immediately reject - if((int) candidates.size() < k_param){ - return false; - } - - int idx = r_int(k_param); - idx = select_k(deviances, idx + 1); - int cut_at = std::fabs(candidates[idx]) - 1; - - - // Rcout << deviances[idx] << "\n"; - // Rcout << is_ok[idx] << " howdy \n"; - // Rcout << "top k element has value " << deviances[idx] << "\n"; - - - // reject sample if not ok - if (!is_ok[idx]){ - return false; - } - - /* - Rcout << "Testing this " << region_id_to_split + ".R2" << " \n"; - Rcout << "We have Final d =" << new_d_val[idx] << " and " << num_final_districts - new_d_val[idx] << "\n"; - */ - - - - // find index of node to cut at - std::vector *siblings = &ust[parent[cut_at]]; - int length = siblings->size(); - int j; - for (j = 0; j < length; j++) { - if ((*siblings)[j] == cut_at) break; - } - - siblings->erase(siblings->begin()+j); // remove edge - parent[cut_at] = -1; - - - // update plan with new regions - plan.num_regions++; // increase region count by 1 - plan.num_multidistricts--; // Decrease by one to avoid double counting later - - // Create info for two new districts - int new_region1_d = new_d_val[idx]; - int new_region2_d = num_final_districts - new_region1_d; - - std::string new_region_label1; - std::string new_region_label2; - - std::string region_to_split = plan.region_str_labels.at(region_id_to_split); - - // Set label and count depending on if district or multi district - if(new_region1_d == 1){ - plan.num_districts++; - // if district then string label just adds district number - new_region_label1 = region_to_split + "." + std::to_string(plan.num_districts); - }else{ - plan.num_multidistricts++; - // if region then just add current region number - new_region_label1 = region_to_split + ".R" + std::to_string(region_id_to_split); - } - - // Now do it for second region - if(new_region2_d == 1){ - plan.num_districts++; - // if district then string label just adds district number - new_region_label2 = region_to_split + "." + std::to_string(plan.num_districts); - }else{ - plan.num_multidistricts++; - // if region then just add current region number - new_region_label2 = region_to_split + ".R" + std::to_string(plan.num_regions - 1); - } - - // Check whether the new regions are districts or multidistricts - - - // Vertex to start traversing tree for updating later - int tree_vertex1; - int tree_vertex2; - - // population and d_nk of new regions - double new_region1_pop; - double new_region2_pop; - - - if (candidates[idx] > 0) { // Means cut below so first vertex is cut_at - tree_vertex1 = cut_at; - tree_vertex2 = root; - - // Set the new populations - new_region1_pop = pop_below.at(cut_at); - new_region2_pop = total_pop - new_region1_pop; - - // return pop_below.at(cut_at); - } else { // Means cut above so first vertex is root - tree_vertex1 = root; - tree_vertex2 = cut_at; - - // Set the new populations - new_region2_pop = pop_below.at(cut_at); - new_region1_pop = total_pop - new_region2_pop; - - } - - - // update the function parameter with names of new regions - if(new_region_ids.size() != 2){ - Rcout << "For some reason the new_region_ids vector in cut_regions is not size 2!\n"; - } - - // Get the regions current integer id - int old_region_num_id = region_id_to_split; - // make the first new region have the same integer id - int new_region_num_id1 = old_region_num_id; - // Second new region has id of the new number of regions minus 1 - int new_region_num_id2 = plan.num_regions - 1; - - new_region_ids[0] = new_region_num_id1; - new_region_ids[1] = new_region_num_id2; - - - // Now update the two cut portions - assign_region(ust, plan, tree_vertex1, new_region_num_id1); - assign_region(ust, plan, tree_vertex2, new_region_num_id2); - - // Now update the region level information - - // Add the new region 1 - - // New region 1 has the same id number as old region so update that - plan.region_dvals.at(new_region_num_id1) = new_region1_d; - plan.region_str_labels.at(new_region_num_id1) = new_region_label1; - plan.region_pops.at(new_region_num_id1) = new_region1_pop; - - // Add the new region 2 - // New region 2's id is the highest id number so push back - plan.region_dvals.push_back(new_region2_d); - plan.region_str_labels.push_back(new_region_label2); - plan.region_pops.push_back(new_region2_pop); - - - return true; - -}; - - - -//' Attempts to split a multi-district within a plan into two new regions with -//' valid population bounds -//' -//' Given a plan this attempts to split a multi-district in it into two new -//' regions where both regions have valid population bounds. Does this by -//' drawing a spanning tree uniformly at random then calling `cut_regions` on -//' that. If the split it successful it returns true and modifies `plan` and -//' `new_region_ids` accordingly. This is based on the `split_map` function -//' in smc.cpp -//' -//' -//' @title Attempt Generalized Region split of a multi-district within a plan -//' -//' @param g A graph (adjacency list) passed by reference -//' @param ust A directed tree object (this will be cleared in the function so -//' whatever it was before doesn't matter) -//' @param counties Vector of county labels of each vertex in `g` -//' @param cg multigraph object (not sure why this is needed) -//' @param plan A plan object -//' @param region_id_to_split The label of the region in the plan object we're attempting to split -//' @param new_region_ids A vector that will be updated by reference to contain the names of -//' the two new split regions if function is successful. -//' @param lower Acceptable lower bounds on a valid district's population -//' @param upper Acceptable upper bounds on a valid district's population -//' @param target Ideal population of a valid district. This is what deviance is calculated -//' relative to -//' Target population (probably Total population of map/Num districts) -//' @param k_param The k parameter from the SMC algorithm, you choose among the top k_param edges -//' -//' @details Modifications -//' - If two new valid regions are split then the plan object is updated accordingly -//' - If two new valid regions are split then the new_region_ids is updated so the -//' first entry is the first new region and the second entry is the second new region -//' -//' @return True if two valid regions were split off false otherwise -//' -bool OLD_attempt_region_split(const Graph &g, Tree &ust, const uvec &counties, Multigraph &cg, - Plan &plan, const int region_id_to_split, - std::vector &new_region_ids, - std::vector &visited, std::vector &ignore, const uvec &pop, - double &lower, double upper, double target, int k_param) { - - int V = g.size(); - - // Mark it as ignore if its not in the region to split - for (int i = 0; i < V; i++){ - ignore[i] = plan.region_num_ids.at(i) != region_id_to_split; - } - - // Get a uniform spanning tree drawn on that region - int root; - clear_tree(ust); - // Get a tree - int result = sample_sub_ust(g, ust, V, root, visited, ignore, pop, lower, upper, counties, cg); - // Return unsuccessful if tree not drawn - if (result != 0) return false; - - // Now try to cut the tree and return that result - return cut_regions(ust, k_param, root, pop, - plan, region_id_to_split, - lower, upper, target, - new_region_ids); - -} - - - - - -/* - * Split off a piece from each map in `districts`, - * keeping deviation between `lower` and `upper` - */ - -// This should just update ancestor, lag, and give log prob reason was picked. -// Everything else can happen outside. -// Actually we compute incremental weight in the function. - - -//' Splits a multidistrict in all of the plans -//' -//' Using the procedure outlined in this function attempts to split -//' a multidistrict in a previous steps plan until M successful splits have been made. This -//' is based on the `split_maps` function in smc.cpp -//' -//' @title Split all the maps -//' -//' @param g A graph (adjacency list) passed by reference -//' @param counties Vector of county labels of each vertex in `g` -//' @param cg County level multigraph -//' @param pop A vector of the population associated with each vertex in `g` -//' @param old_plans_vec A vector of plans from the previous step -//' @param new_plans_vec A vector which will be filled with plans that had a -//' multidistrict split to make them -//' @param original_ancestor_vec A vector used to track which original ancestor -//' the new plans descended from. The value of `original_ancestor_vec[i]` -//' is the index of the original ancestor the new plan `new_plans_vec[i]` is -//' descended from. -//' @param parent_vec A vector used to track the index of the previous plan -//' sampled that was successfully split. The value of `parent_vec[i]` is the -//' index of the old plan from which the new plan `new_plans_vec[i]` was -//' successfully split from. In other words `new_plans_vec[i]` is equal to -//' `attempt_region_split(old_plans_vec[parent_vec[i]], ...)` -//' @param prev_ancestor_vec A vector used to track the index of the original -//' ancestor of the previous plans. The value of `prev_ancestor_vec[i]` is the -//' index of the original ancestor of `old_plans_vec[i]` -//' @param unnormalized_sampling_weights A vector of weights used to sample indices -//' of the `old_plans_vec`. The value of `unnormalized_sampling_weights[i]` is -//' the unnormalized probability that index i is selected -//' @param normalized_weights_to_fill_in A vector which will be filled with the -//' normalized weights the index sampler uses. The value of -//' `normalized_weights_to_fill_in[i]` is the probability that index i is selected -//' @param draw_tries_vec A vector used to keep track of how many plan split -//' attempts were made for index i. The value `draw_tries_vec[i]` represents how -//' many split attempts were made for the i-th new plan (including the successful -//' split). For example, `draw_tries_vec[i] = 1` means that the first split -//' attempt was successful. -//' @param parent_unsuccessful_tries_vec A vector used to keep track of how many times the -//' previous rounds plans were sampled and unsuccessfully split. The value -//' `parent_unsuccessful_tries_vec[i]` represents how many times `old_plans_vec[i]` was sampled -//' and then unsuccessfully split while creating all `M` of the new plans. -//' THIS MAY NOT BE THREAD SAFE -//' @param accept_rate The number of accepted splits over the total number of -//' attempted splits. This is equal to `sum(draw_tries_vec)/M` -//' @param n_unique_parent_indices The number of unique parent indices, ie the -//' number of previous plans that had at least one descendant amongst the new -//' plans. This is equal to `unique(parent_vec)` -//' @param n_unique_original_ancestors The number of unique original ancestors, -//' in the new plans. This is equal to `unique(original_ancestor_vec)` -//' @param ancestors Parameter from older `smc.cpp` code. I DON'T UNDERSTAND -//' WHAT IT IS DOING -//' @param lags Parameter from older `smc.cpp` code. I DON'T UNDERSTAND -//' WHAT IT IS DOING -//' @param lower Acceptable lower bounds on a valid district's population -//' @param upper Acceptable upper bounds on a valid district's population -//' @param target Ideal population of a valid district. This is what deviance is calculated -//' relative to -//' @param k_param The top edges to pick parameter for the region splitting -//' algorithm -//' @param pool A threadpool for multithreading -//' @param verbosity A parameter controlling the amount of detail printed out -//' during the algorithms running -//' -//' @details Modifications -//' - The `new_plans_vec` is updated with all the newly split plans -//' - The `old_plans_vec` is updated with all the newly split plans as well. -//' Note that the reason both this and `new_plans_vec` are updated is because -//' of the nature of the code you need both vectors and so both are passed by -//' reference to save memory. -//' - The `original_ancestor_vec` is updated to contain the indices of the -//' original ancestors of the new plans -//' - The `parent_vec` is updated to contain the indices of the parents of the - //' new plans -//' - If two new valid regions are split then the new_region_ids is updated so the -//' first entry is the first new region and the second entry is the second new region -//' - The `normalized_weights_to_fill_in` is updated to contain the normalized -//' probabilities the index sampler used. This is only collected for diagnostics -//' at this point and should just be equal to `unnormalized_sampling_weights` -//' divided by `sum(unnormalized_sampling_weights)` -//' - The `draw_tries_vec` is updated to contain the number of tries for each -//' of the new plans -//' - The `parent_unsuccessful_tries_vec` is updated to contain the number of unsuccessful -//' samples of the old plans -//' - The `accept_rate` is updated to contain the average acceptance rate for -//' this iteration -//' - `n_unique_parent_indices` and `n_unique_original_ancestors` are updated -//' with the unique number of parents and original ancestors for all the new -//' plans respectively -//' - `ancestors` is updated to something. THIS IS FROM ORIGINAL SMC CODE, -//' I DO NOT KNOW WHAT IT MEANS -//' -//' @return nothing -//' -void OLD_generalized_split_maps( - const Graph &g, const uvec &counties, Multigraph &cg, const uvec &pop, - std::vector &old_plans_vec, std::vector &new_plans_vec, - std::vector &original_ancestor_vec, - std::vector &parent_vec, - const std::vector &prev_ancestor_vec, - const std::vector &unnormalized_sampling_weights, - std::vector &normalized_weights_to_fill_in, - std::vector &draw_tries_vec, - std::vector &parent_unsuccessful_tries_vec, - double &accept_rate, - int &n_unique_parent_indices, - int &n_unique_original_ancestors, - umat &ancestors, const std::vector &lags, - double lower, double upper, double target, - int k_param, - RcppThread::ThreadPool &pool, - int verbosity - ) { - // important constants - const int V = g.size(); - const int M = old_plans_vec.size(); - - - uvec iters(M, fill::zeros); // how many actual iterations, (used to compute acceptance rate) - uvec original_ancestor_uniques(M); // used to compute unique original ancestors - uvec parent_index_uniques(M); // used to compute unique parent indicies - - // PREVIOUS SMC CODE I DONT KNOW WHAT IT DOES - const int dist_ctr = old_plans_vec.at(0).num_regions; - const int n_lags = lags.size(); - umat ancestors_new(M, n_lags); // lags/ancestor thing - - - - // Create the obj which will sample from the index with probability - // proportional to the weights - std::random_device rd; - std::mt19937 gen(rd()); - std::discrete_distribution<> index_sampler( - unnormalized_sampling_weights.begin(), - unnormalized_sampling_weights.end() - ); - - // extract and record the normalized weights the sampler is using - std::vector p = index_sampler.probabilities(); - int nw_index = 0; - bool print_weights = M < 12 && verbosity > 1; - if(print_weights){ - Rprintf("Unnormalized weights are: "); - for (auto w : unnormalized_sampling_weights){ - Rprintf("%.4f, ", w); - } - - Rprintf("\n"); - Rprintf("Normalized weights are: "); - } - for (auto prob : p){ - if(print_weights) Rprintf("%.4f, ", prob); - normalized_weights_to_fill_in.at(nw_index) = prob; - nw_index++; - } - if(print_weights) Rprintf("\n"); - - // Because of multithreading we have to add specific checks for if the user - // wants to quit the program - const int reject_check_int = 200; // check for interrupts every _ rejections - const int check_int = 50; // check for interrupts every _ iterations - - - // create a progress bar - RcppThread::ProgressBar bar(M, 1); - // Parallel thread pool where all objects in memory shared by default - pool.parallelFor(0, M, [&] (int i) { - int reject_ct = 0; - bool ok = false; - int idx; - int region_id_to_split; - std::vector new_region_ids(2, -1); - - Tree ust = init_tree(V); - std::vector visited(V); - std::vector ignore(V); - while (!ok) { - // increase the iters count by one - iters[i]++; - // use weights to sample previous plan - idx = index_sampler(gen); - Plan proposed_new_plan = old_plans_vec[idx]; - - // pick a region to try to split - choose_multidistrict_to_split( - old_plans_vec[idx], region_id_to_split); - - // Now try to split that region - ok = OLD_attempt_region_split(g, ust, counties, cg, - proposed_new_plan, region_id_to_split, - new_region_ids, - visited, ignore, pop, - lower, upper, target, k_param); - - // bad sample; try again - if (!ok) { - // THIS MAY NOT BE THREAD SAFE - parent_unsuccessful_tries_vec[idx]++; // update unsuccessful try - RcppThread::checkUserInterrupt(++reject_ct % reject_check_int == 0); - continue; - } - - // else update the new plan and leave the while loop - new_plans_vec[i] = proposed_new_plan; - - } - - // Record how many tries needed to create i-th new plan - draw_tries_vec[i] = static_cast(iters[i]); - // Make the new plans original ancestor the same as its parent - original_ancestor_uniques[i] = prev_ancestor_vec[idx]; - // record index of new plan's parent - parent_index_uniques[i] = idx; - // clear the spanning tree - clear_tree(ust); - - // ORIGINAL SMC CODE I DONT KNOW WHAT THIS DOES - // save ancestors/lags - for (int j = 0; j < n_lags; j++) { - if (dist_ctr <= lags[j]) { - ancestors_new(i, j) = i; - } else { - ancestors_new(i, j) = ancestors(idx, j); - } - } - - - // update this particles ancestor to be the ancestor of its previous one - parent_vec[i] = idx; - original_ancestor_vec[i] = prev_ancestor_vec[idx]; - - RcppThread::checkUserInterrupt(i % check_int == 0); - }); - - // Wait for all the threads to finish - pool.wait(); - - - - // now replace the old plans with the new ones - for(int i=0; i < M; i++){ - old_plans_vec[i] = new_plans_vec[i]; - } - - - // now compute acceptance rate and unique parents and original ancestors - accept_rate = M / (1.0 * sum(iters)); - n_unique_original_ancestors = ((uvec) find_unique(original_ancestor_uniques)).n_elem; - n_unique_parent_indices = ((uvec) find_unique(parent_index_uniques)).n_elem; - if (verbosity >= 3) { - Rprintf("%.2f acceptance rate, %d unique parent indices sampled, and %d unique original ancestors!\n", - 100.0 * accept_rate, (int) n_unique_parent_indices , (int) n_unique_original_ancestors); - } - - // ORIGINAL SMC CODE I DONT KNOW WHAT IT DOES - ancestors = ancestors_new; - -} - - - -//' Computes log unnormalized weights for vector of plans -//' -//' Using the procedure outlined in this function computes the log -//' incremental weights and the unnormalized weights for a vector of plans (which -//' may or may not be the same depending on the parameters). -//' -//' @title Compute Log Unnormalized Weights -//' -//' @param pool A threadpool for multithreading -//' @param g A graph (adjacency list) passed by reference -//' @param plans_vec A vector of plans to compute the log unnormalized weights -//' of -//' @param log_incremental_weights A vector of the log incremental weights -//' computed for the plans. The value of `log_incremental_weights[i]` is -//' the log incremental weight for `plans_vec[i]` -//' @param unnormalized_sampling_weights A vector of the unnormalized sampling -//' weights to be used with sampling the `plans_vec` in the next iteration of the -//' algorithm. Depending on the other hyperparameters this may or may not be the -//' same as `exp(log_incremental_weights)` -//' @param target Target population of a single district -//' @param pop_temper
-//' -//' @details Modifications -//' - The `log_incremental_weights` is updated to contain the incremental -//' weights of the plans -//' - The `unnormalized_sampling_weights` is updated to contain the unnormalized -//' sampling weights of the plans for the next round -void OLD_get_log_gsmc_weights( - RcppThread::ThreadPool &pool, - const Graph &g, std::vector &plans_vec, - std::vector &log_incremental_weights, - std::vector &unnormalized_sampling_weights, - double target, double pop_temper -){ - int M = (int) plans_vec.size(); - - // Parallel thread pool where all objects in memory shared by default - pool.parallelFor(0, M, [&] (int i) { - double log_incr_weight = compute_log_incremental_weight( - g, plans_vec.at(i), target, pop_temper); - log_incremental_weights[i] = log_incr_weight; - unnormalized_sampling_weights[i] = std::exp(log_incr_weight); - }); - - // Wait for all the threads to finish - pool.wait(); - - return; -} - - -//' Uses gsmc method to generate a sample of `M` plans in `c++` -//' -//' Using the procedure outlined in this function uses Sequential -//' Monte Carlo (SMC) methods to generate a sample of `M` plans -//' -//' @title Run redist gsmc -//' -//' @param N The number of districts the final plans will have -//' @param adj_list A 0-indexed adjacency list representing the undirected graph -//' which represents the underlying map the plans are to be drawn on -//' @param counties Vector of county labels of each vertex in `g` -//' @param pop A vector of the population associated with each vertex in `g` -//' @param target Ideal population of a valid district. This is what deviance is calculated -//' relative to -//' @param lower Acceptable lower bounds on a valid district's population -//' @param upper Acceptable upper bounds on a valid district's population -//' @param M The number of plans (samples) to draw -//' @param control Named list of additional parameters. -//' @param num_threads The number of threads the threadpool should use -//' @param verbosity What level of detail to print out while the algorithm is -//' running -//' @export -List gsmc_plans( - int N, List adj_list, - const arma::uvec &counties, const arma::uvec &pop, - double target, double lower, double upper, - int M, // M is Number of particles aka number of different plans - List control, // control has pop temper, and k parameter value - int num_threads, int verbosity, bool diagnostic_mode){ - - // set number of threads - if (num_threads <= 0) num_threads = std::thread::hardware_concurrency(); - if (num_threads == 1) num_threads = 0; - - // lags thing (copied from original smc code, don't understand what its doing) - std::vector lags = as>(control["lags"]); - // k param values to use - std::vector k_params = as>(control["k_params"]); - - double pop_temper = as(control["pop_temper"]); - - - umat ancestors(M, lags.size(), fill::zeros); - - // Create map level graph and county level multigraph - Graph g = list_to_graph(adj_list); - Multigraph cg = county_graph(g, counties); - - int V = g.size(); - double total_pop = sum(pop); - - // Loading Info - if (verbosity >= 1) { - Rcout.imbue(std::locale("")); - Rcout << std::fixed << std::setprecision(0); - Rcout << "GENERALIZED SEQUENTIAL MONTE CARLO\n"; - Rcout << "Sampling " << M << " " << V << "-unit "; - Rcout << "maps with " << N << " districts and population between " - << lower << " and " << upper << " using " << num_threads << " threads.\n"; - if (cg.size() > 1){ - Rcout << "Ensuring no more than " << N - 1 << " splits of the " - << cg.size() << " administrative units.\n"; - } - } - - - - std::vector plans_vec(M, Plan(V, N, total_pop)); - std::vector new_plans_vec(M, Plan(V, N, total_pop)); // New plans - - - // Define output variables that must always be created - - // This is N-1 by M where [i][j] is the index of the parent of particle j on step i - // ie the index of the previous plan that was sampled and used to create particle j on step i - std::vector> parent_index_mat(N-1, std::vector (M, -1)); - - // This is N-1 by M where [i][j] is the index of the original (first) ancestor of particle j on step i - std::vector> original_ancestor_mat(N-1, std::vector (M, -1)); - - // This is N-1 by M where [i][j] is the number of tries it took to form particle j on iteration i - // Inclusive of the final step. ie if succeeds in one try it would be 1 - std::vector> draw_tries_mat(N-1, std::vector (M, -1)); - - // This is N-1 by M where [i][j] is the number of times particle j from the - // previous round was sampled and unsuccessfully split on iteration i so this - // does not count successful sample then split - std::vector> parent_unsuccessful_tries_mat(N-1, std::vector (M, 0)); - - // This is N-1 by M where [i][j] is the log incremental weight of particle j on step i - std::vector> log_incremental_weights_mat(N-1, std::vector (M, -1.0)); - - // This is N-1 by M where [i][j] is the normalized weight of particle j on step i - std::vector> normalized_weights_mat(N-1, std::vector (M, -1.0)); - - - - - // Tracks the acceptance rate - total number of tries over M - for each round - std::vector acceptance_rates(N-1, -1.0); - - // Tracks the effective sample size for the weights of each round - std::vector n_eff(N-1, -1.0); - - // Tracks the number of unique parent vectors sampled to create the next round - std::vector nunique_parents_vec(N-1, -1); - - // Tracks the number of unique ancestors left at each step - std::vector nunique_original_ancestors_vec(N-1, -1); - - - // Declare variables whose size will depend on whether or not we're in - // diagnostic mode or not - std::vector>> plan_region_ids_mat; - std::vector>> plan_d_vals_mat; - std::vector> final_plan_region_labels; - - - - - // If diagnostic mode track stuff from every round - if(diagnostic_mode){ - // Create info tracking we will pass out at the end - // This is N-1 by M by V where for each n=1,...,N-1 and m=1,...M it maps vertices to integer id - plan_region_ids_mat.resize(N-1, std::vector>( - M, std::vector(V, -1) - )); - - // reserve space for N-1 elements - plan_d_vals_mat.reserve(N-1); - - // This is N-2 by M by 1,2,...N where for each n=1,...,N-1, m=1,...,M it maps the region - // id to the region's d value. So for a given n it is n by M by n+1 - // It stops at N-2 because for N-1 its all 1 - for(int n = 1; n < N-1; n++){ - plan_d_vals_mat.push_back( - std::vector>(M, std::vector(n+1, -1)) - ); - } - - // M by N-1 where for each m=1,...M it maps region ids to region labels in a plan - final_plan_region_labels.resize( - M, std::vector(N, "MISSING") - ); - - }else{ // else only track for final round - // Create info tracking we will pass out at the end - // This is M by V where for each m=1,...M it maps vertices to integer id for plan - plan_region_ids_mat.resize(1, std::vector>( - M, std::vector(V, -1) - )); - } - - - - - // Start off all the unnormalized weights at 1 - std::vector unnormalized_sampling_weights(M, 1.0); - - - // Create a threadpool - - RcppThread::ThreadPool pool(num_threads); - - std::string bar_fmt = "Split [{cli::pb_current}/{cli::pb_total}] {cli::pb_bar} | ETA{cli::pb_eta}"; - RObject bar = cli_progress_bar(N-1, cli_config(false, bar_fmt.c_str())); - - // Now for each run through split the map - try { - for(int n=0; n 1){ - Rprintf("Iteration %d \n", n+1); - } - - - // For the first iteration we need to pass a special previous ancestor thing - if(n == 0){ - std::vector dummy_prev_ancestors(M, 1); - // split the map - OLD_generalized_split_maps( - g, counties, cg, pop, - plans_vec, new_plans_vec, - original_ancestor_mat[n], - parent_index_mat[n], - dummy_prev_ancestors, - unnormalized_sampling_weights, - normalized_weights_mat[n], - draw_tries_mat[n], - parent_unsuccessful_tries_mat.at(n), - acceptance_rates[n], - nunique_parents_vec[n], - nunique_original_ancestors_vec[n], - ancestors, lags, - lower, upper, target, - k_params[n], - pool, - verbosity - ); - - // For the first ancestor one make every ancestor themselves - std::iota (parent_index_mat[0].begin(), parent_index_mat[0].end(), 0); - std::iota (original_ancestor_mat[0].begin(), original_ancestor_mat[0].end(), 0); - }else{ - // split the map and we can use the previous original ancestor matrix row - OLD_generalized_split_maps( - g, counties, cg, pop, - plans_vec, new_plans_vec, - original_ancestor_mat[n], - parent_index_mat[n], - original_ancestor_mat[n-1], - unnormalized_sampling_weights, - normalized_weights_mat[n], - draw_tries_mat[n], - parent_unsuccessful_tries_mat.at(n), - acceptance_rates[n], - nunique_parents_vec[n], - nunique_original_ancestors_vec[n], - ancestors, lags, - lower, upper, target, - k_params[n], - pool, - verbosity - ); - } - - if (verbosity == 1 && CLI_SHOULD_TICK){ - cli_progress_set(bar, n); - } - Rcpp::checkUserInterrupt(); - - - // compute log incremental weights and sampling weights for next round - OLD_get_log_gsmc_weights( - pool, - g, - new_plans_vec, - log_incremental_weights_mat.at(n), - unnormalized_sampling_weights, - target, - pop_temper - ); - - // compute effective sample size - n_eff.at(n) = compute_n_eff(log_incremental_weights_mat[n]); - - // Now update the diagnostic info if needed, region labels, dval column of the matrix - if(diagnostic_mode && n == N-2){ // record if in diagnostic mode and final step - for(int j=0; j -#include -#include -#include -#include -#include - -#include -#include "wilson.h" -#include "tree_op.h" -#include "map_calc.h" -#include "redist_types.h" -#include "weights.h" -#include "splitting.h" - - - -//' Uses gsmc method to generate a sample of `M` plans in `c++` -//' -//' Using the procedure outlined in this function uses Sequential -//' Monte Carlo (SMC) methods to generate a sample of `M` plans -//' -//' @title Run redist gsmc -//' -//' @param N The number of districts the final plans will have -//' @param adj_list A 0-indexed adjacency list representing the undirected graph -//' which represents the underlying map the plans are to be drawn on -//' @param counties Vector of county labels of each vertex in `g` -//' @param pop A vector of the population associated with each vertex in `g` -//' @param target Ideal population of a valid district. This is what deviance is calculated -//' relative to -//' @param lower Acceptable lower bounds on a valid district's population -//' @param upper Acceptable upper bounds on a valid district's population -//' @param M The number of plans (samples) to draw -//' @param k_param The k parameter from the SMC algorithm, you choose among the top k_param edges -//' @param control Named list of additional parameters. -//' @param num_threads The number of threads the threadpool should use -//' @param verbosity What level of detail to print out while the algorithm is -//' running -//' @export -// [[Rcpp::export]] -List gsmc_plans( - int N, List adj_list, - const arma::uvec &counties, const arma::uvec &pop, - double target, double lower, double upper, - int M, // Number of particles aka number of different plans - List control, - int ncores = -1, int verbosity = 3, bool diagnostic_mode = false); - - - - -bool OLD_attempt_region_split(const Graph &g, Tree &ust, const uvec &counties, Multigraph &cg, - Plan &plan, const int region_id_to_split, - std::vector &new_region_ids, - std::vector &visited, std::vector &ignore, const uvec &pop, - double &lower, double upper, double target, int k_param); - -#endif diff --git a/src/weights.cpp b/src/weights.cpp index f4cb063ef..f9094eb61 100644 --- a/src/weights.cpp +++ b/src/weights.cpp @@ -319,7 +319,7 @@ double compute_basic_smc_log_incremental_weight( // sanity check: make sure the region level graph's number of vertices is // the same as the number of regions in the plan if((int)rg.size() != plan.num_regions){ - Rprintf("SOMETHING WENT WRONG IN COMPPUTE LOG INCREMENT WEIGHJT\n"); + Rprintf("SOMETHING WENT WRONG IN COMPUTE LOG INCREMENT WEIGHJT\n"); } // We use a set to track edges because it doesn't keep duplicates From 8143211fb267d3a4f49f9f004f63506d0e744222 Mon Sep 17 00:00:00 2001 From: "Philip W. O'Sullivan" Date: Fri, 1 Nov 2024 19:16:34 -0400 Subject: [PATCH 027/324] refactored code so R output now orders region ids by when they were split --- R/RcppExports.R | 4 + R/redist_optimal_gsmc.R | 146 +++++++++++++++++++----- R/redist_plans.R | 4 + src/optimal_gsmc.cpp | 90 +++++++++------ src/redist_types.cpp | 18 ++- src/redist_types.h | 13 ++- src/splitting.cpp | 54 +++++---- src/splitting.h | 8 +- src/splitting_inspection.cpp | 13 +-- src/tree_op.cpp | 6 +- src/weights.cpp | 212 ++++++++++------------------------- src/weights.h | 6 - task_tracker.md | 26 ++++- 13 files changed, 337 insertions(+), 263 deletions(-) diff --git a/R/RcppExports.R b/R/RcppExports.R index 3ec795644..3a97f5598 100644 --- a/R/RcppExports.R +++ b/R/RcppExports.R @@ -299,6 +299,7 @@ NULL #' #' Takes a cut spanning tree `ust` and variables on the two new regions #' induced by the cuts and updates `plan` to add those two new regions. +#' It also sets `plan.remainder_region` equal to `new_region2_id`. #' #' #' @title Update plan regions from cut tree @@ -306,6 +307,8 @@ NULL #' @param ust A cut (ie has two partition pieces) directed spanning tree #' passed by reference #' @param plan A plan object +#' @param split_district_only Whether or not this was split according to a +#' one district split scheme (as in does the remainder need to be updated) #' @param old_region_id The id of old (split) region #' @param new_region1_tree_root The vertex of the root of one piece of the cut #' tree. This always corresponds to the region with the smaller dval (allowing @@ -326,6 +329,7 @@ NULL #' - `new_region1_id` and `new_region2_id` are updated by reference to what #' the values of the two new region ids were set to #' +#' #' @noRd #' @keywords internal NULL diff --git a/R/redist_optimal_gsmc.R b/R/redist_optimal_gsmc.R index 79b283618..34db42889 100644 --- a/R/redist_optimal_gsmc.R +++ b/R/redist_optimal_gsmc.R @@ -19,12 +19,13 @@ #' #' @export redist_optimal_gsmc <- function(state_map, M, counties = NULL, - k_params = 6, split_district_only = FALSE, + k_params = 6, split_district_only = FALSE, resample = TRUE, runs = 1L, ncores = 0L, multiprocess=TRUE, pop_temper = 0, verbose = FALSE, silent = FALSE, diagnostic_mode = FALSE){ N <- attr(state_map, "ndists") + ndists <- attr(state_map, "ndists") # figure out the alg type if(split_district_only){ @@ -164,6 +165,7 @@ redist_optimal_gsmc <- function(state_map, M, counties = NULL, run_verbosity <- if (chain == 1 || !multiprocess) verbosity else 0 t1_run <- Sys.time() + algout <- redist::optimal_gsmc_plans( N=N, adj_list=adj_list, @@ -179,11 +181,27 @@ redist_optimal_gsmc <- function(state_map, M, counties = NULL, diagnostic_mode=diagnostic_mode) + + if (length(algout) == 0) { cli::cli_process_done() cli::cli_process_done() } + # convert the order added results into an actual list of arrays where + # for each list entry n and column entry i that is a vector of length n + # mapping the region id to its sorted order. The way to interpret is + # the index where algout$region_order_added_list[[test_n]][,test_i] == r + # is the new index region id r was mapped to. + # In other words which(algout$region_order_added_list[[n]][,i] == r) is + # the new ordered value r should be set to + algout$region_order_added_list <- lapply( + algout$region_order_added_list, + function(x) matrix(unlist(x), ncol = length(x), byrow = FALSE) + ) |> lapply( + function(a_l) apply(a_l, 2, order)) + + # make each element of region_ids_mat_list a V by M matrix algout$region_ids_mat_list <- lapply( @@ -191,12 +209,106 @@ redist_optimal_gsmc <- function(state_map, M, counties = NULL, function(x) matrix(unlist(x), ncol = length(x), byrow = FALSE) + 1 ) - # make each element of region_dvals_mat_list a V by M matrix + # make each element of region_dvals_mat_list a n by M matrix algout$region_dvals_mat_list <- lapply( algout$region_dvals_mat_list, function(x) matrix(unlist(x), ncol = length(x), byrow = FALSE) ) + if(diagnostic_mode && !split_district_only){ + # update the labels to reflect the order regions were added for each step + for (n in 1:(N-2)) { + for (i in 1:M) { + # reorder d values. Recall + # algout$region_order_added_list[[n]][,i] permutes the original + # region label vector to its new ordered form so its ok here + algout$region_dvals_mat_list[[n]][,i] <- algout$region_dvals_mat_list[[n]][,i][ + algout$region_order_added_list[[n]][,i] + ] + # reorder the labels themselves + # the reason for the order call again is it ensures that if + # r is the original region id and r_new is the new ordered one + # then + # order(algout$region_order_added_list[[1]][,i])[r] = r_new + algout$region_ids_mat_list[[n]][,i] <- order( + algout$region_order_added_list[[n]][,i] + )[ + algout$region_ids_mat_list[[n]][,i] + ] + + } + } + # do final step + for (i in 1:M) { + # reorder the labels themselves + # the reason for the order call again is it ensures that if + # r is the original region id and r_new is the new ordered one + # then + # order(algout$region_order_added_list[[1]][,i])[r] = r_new + algout$region_ids_mat_list[[N-1]][,i] <- order( + algout$region_order_added_list[[N-1]][,i] + )[ + algout$region_ids_mat_list[[N-1]][,i] + ] + + } + + # add a plans matrix as the final output because first + # N-2 are previous results + algout$plans <- algout$region_ids_mat_list[[N-1]] + }else if(diagnostic_mode){ + # if diagnostic but only one district splits we only care about + # labels + # update the labels to reflect the order regions were added for each step + for (n in 1:(N-1)) { + for (i in 1:M) { + # reorder the labels themselves + # the reason for the order call again is it ensures that if + # r is the original region id and r_new is the new ordered one + # then + # order(algout$region_order_added_list[[1]][,i])[r] = r_new + algout$region_ids_mat_list[[n]][,i] <- order( + algout$region_order_added_list[[n]][,i] + )[ + algout$region_ids_mat_list[[n]][,i] + ] + + } + } + + # add a plans matrix as the final output because first + # N-2 are previous results + algout$plans <- algout$region_ids_mat_list[[N-1]] + }else{ + # relabel the region ids so they are all in order + for (i in 1:M) { + # reorder the labels themselves + # the reason for the order call again is it ensures that if + # r is the original region id and r_new is the new ordered one + # then + # order(algout$region_order_added_list[[1]][,i])[r] = r_new + algout$region_ids_mat_list[[1]][,i] <- order( + algout$region_order_added_list[[1]][,i] + )[ + algout$region_ids_mat_list[[1]][,i] + ] + + } + + # Just add first element since not diagnostic mode the first N-2 + # steps were not tracked + algout$plans <- algout$region_ids_mat_list[[1]] + + # make the region_ids_mat_list input just null since there's nothing else + algout$region_ids_mat_list <- NULL + algout$region_dvals_mat_list <- NULL + } + + # now we can remove the relabelling info + algout$region_order_added_list <- NULL + gc() + + # make original ancestor matrix # add 1 for R indexing algout$original_ancestors_mat <- matrix( @@ -242,26 +354,6 @@ redist_optimal_gsmc <- function(state_map, M, counties = NULL, wgt <- exp(lr - mean(lr)) n_eff <- length(wgt)*mean(wgt)^2/mean(wgt^2) - if(diagnostic_mode){ - # add a plans matrix as the final output because first - # N-2 are previous results - algout$plans <- algout$region_ids_mat_list[[N-1]] - - algout$final_region_labs <- matrix( - unlist(algout$final_region_labs), - ncol = length(algout$final_region_labs), - byrow = FALSE) - - }else{ - # Just add first element since not diagnostic mode the first N-2 - # steps were not tracked - algout$plans <- algout$region_ids_mat_list[[1]] - - # make the region_ids_mat_list input just null since there's nothing else - algout$region_ids_mat_list <- NULL - algout$region_dvals_mat_list <- NULL - algout$final_region_labs <- NULL - } if (any(is.na(lr))) { cli_abort(c("Sampling probabilities have been corrupted.", @@ -277,7 +369,6 @@ redist_optimal_gsmc <- function(state_map, M, counties = NULL, } - if (resample) { normalized_wgts <- wgt/sum(wgt) n_eff <- 1/sum(normalized_wgts^2) @@ -297,7 +388,7 @@ redist_optimal_gsmc <- function(state_map, M, counties = NULL, if(diagnostic_mode){ # makes algout$final_region_labs[i] now equal to algout$final_region_labs[rs_idx[i]] # to account for resampling - algout$final_region_labs[,rs_idx, drop = FALSE] + # algout$final_region_labs[,rs_idx, drop = FALSE] } #TODO probably need to adjust the rest of these as well @@ -337,7 +428,6 @@ redist_optimal_gsmc <- function(state_map, M, counties = NULL, seq_alpha = .99, pop_temper = pop_temper, runtime = as.numeric(t2_run - t1_run, units = "secs"), - district_str_labels = algout$final_region_labs, nunique_original_ancestors = algout$nunique_original_ancestors, parent_index_mat = algout$parent_index, original_ancestors_mat = algout$original_ancestors_mat, @@ -350,6 +440,7 @@ redist_optimal_gsmc <- function(state_map, M, counties = NULL, rs_idx = rs_idx ) + algout } @@ -367,6 +458,8 @@ redist_optimal_gsmc <- function(state_map, M, counties = NULL, n_dist_act <- dplyr::n_distinct(plans[, 1]) # actual number (for partial plans) + + out <- new_redist_plans(plans, map, alg_type, wgt, resample, ndists = N, n_eff = all_out[[1]]$n_eff, @@ -377,11 +470,14 @@ redist_optimal_gsmc <- function(state_map, M, counties = NULL, pop_bounds = pop_bounds) + if (runs > 1) { out <- mutate(out, chain = rep(seq_len(runs), each = n_dist_act*M)) %>% dplyr::relocate('chain', .after = "draw") } + + exist_name <- attr(map, "existing_col") if (!is.null(exist_name) && !isFALSE(ref_name) && N == final_dists) { ref_name <- if (!is.null(ref_name)) ref_name else exist_name diff --git a/R/redist_plans.R b/R/redist_plans.R index 49de964a4..e2299ed75 100644 --- a/R/redist_plans.R +++ b/R/redist_plans.R @@ -22,6 +22,7 @@ new_redist_plans <- function(plans, map, algorithm, wgt, resampled = TRUE, ndist map_dists <- attr(map, "ndists") partial <- ndists < map_dists + prec_pop <- map[[attr(map, "pop_col")]] if (!partial) { distr_range <- 1:ndists @@ -33,6 +34,7 @@ new_redist_plans <- function(plans, map, algorithm, wgt, resampled = TRUE, ndist distr_pop <- pop_tally(pl_tmp, prec_pop, ndists) } + attr_names <- c("redist_attr", "plans", "ndists", "algorithm", "wgt", "resampled", "ndists", "merge_idx", "prec_pop", names(list(...))) @@ -47,6 +49,8 @@ new_redist_plans <- function(plans, map, algorithm, wgt, resampled = TRUE, ndist draw_fac = factor(draw_fac, levels=draw_fac) } + + structure(tibble(draw = rep(draw_fac, each = ndists), district = rep(distr_range, n_sims), total_pop = as.numeric(distr_pop)), diff --git a/src/optimal_gsmc.cpp b/src/optimal_gsmc.cpp index c613ebee5..c7128e678 100644 --- a/src/optimal_gsmc.cpp +++ b/src/optimal_gsmc.cpp @@ -87,8 +87,8 @@ List optimal_gsmc_plans( } - std::vector plans_vec(M, Plan(V, N, total_pop)); - std::vector new_plans_vec(M, Plan(V, N, total_pop)); // New plans + std::vector plans_vec(M, Plan(V, N, total_pop, split_district_only)); + std::vector new_plans_vec(M, Plan(V, N, total_pop, split_district_only)); // New plans // Define output variables that must always be created @@ -133,7 +133,7 @@ List optimal_gsmc_plans( // diagnostic mode or not std::vector>> plan_region_ids_mat; std::vector>> plan_d_vals_mat; - std::vector> final_plan_region_labels; + std::vector>> plan_region_order_added_mat; @@ -146,22 +146,37 @@ List optimal_gsmc_plans( M, std::vector(V, -1) )); + // reserve space for N-2 elements if doing generalized region splits + if(!split_district_only){ + plan_d_vals_mat.reserve(N-2); + } + // reserve space for N-1 elements - plan_d_vals_mat.reserve(N-1); + plan_region_order_added_mat.reserve(N-1); // This is N-2 by M by 1,2,...N where for each n=1,...,N-1, m=1,...,M it maps the region // id to the region's d value. So for a given n it is n by M by n+1 // It stops at N-2 because for N-1 its all 1 for(int n = 1; n < N-1; n++){ - plan_d_vals_mat.push_back( + if(!split_district_only){ + plan_d_vals_mat.push_back( + std::vector>(M, std::vector(n+1, -1)) + ); + } + + plan_region_order_added_mat.push_back( std::vector>(M, std::vector(n+1, -1)) ); } + // We care about order added for every split so also do final one + plan_region_order_added_mat.push_back( + std::vector>(M, std::vector(N, -1)) + ); // M by N-1 where for each m=1,...M it maps region ids to region labels in a plan - final_plan_region_labels.resize( - M, std::vector(N, "MISSING") - ); + // final_plan_region_labels.resize( + // M, std::vector(N, "MISSING") + // ); }else{ // else only track for final round // Create info tracking we will pass out at the end @@ -169,6 +184,9 @@ List optimal_gsmc_plans( plan_region_ids_mat.resize(1, std::vector>( M, std::vector(V, -1) )); + plan_region_order_added_mat.resize(1, std::vector>( + M, std::vector(N, -1) + )); } @@ -192,6 +210,7 @@ List optimal_gsmc_plans( Rprintf("Iteration %d \n", n+1); } + // For the first iteration we need to pass a special previous ancestor thing if(n == 0){ @@ -200,19 +219,19 @@ List optimal_gsmc_plans( generalized_split_maps( g, counties, cg, pop, plans_vec, new_plans_vec, - original_ancestor_mat[n], - parent_index_mat[n], + original_ancestor_mat.at(n), + parent_index_mat.at(n), dummy_prev_ancestors, unnormalized_sampling_weights, - normalized_weights_mat[n], - draw_tries_mat[n], + normalized_weights_mat.at(n), + draw_tries_mat.at(n), parent_unsuccessful_tries_mat.at(n), - acceptance_rates[n], - nunique_parents_vec[n], - nunique_original_ancestors_vec[n], + acceptance_rates.at(n), + nunique_parents_vec.at(n), + nunique_original_ancestors_vec.at(n), ancestors, lags, lower, upper, target, - k_params[n], split_district_only, + k_params.at(n), split_district_only, pool, verbosity ); @@ -225,19 +244,19 @@ List optimal_gsmc_plans( generalized_split_maps( g, counties, cg, pop, plans_vec, new_plans_vec, - original_ancestor_mat[n], - parent_index_mat[n], + original_ancestor_mat.at(n), + parent_index_mat.at(n), original_ancestor_mat[n-1], unnormalized_sampling_weights, - normalized_weights_mat[n], - draw_tries_mat[n], + normalized_weights_mat.at(n), + draw_tries_mat.at(n), parent_unsuccessful_tries_mat.at(n), - acceptance_rates[n], - nunique_parents_vec[n], - nunique_original_ancestors_vec[n], + acceptance_rates.at(n), + nunique_parents_vec.at(n), + nunique_original_ancestors_vec.at(n), ancestors, lags, lower, upper, target, - k_params[n], split_district_only, + k_params.at(n), split_district_only, pool, verbosity ); @@ -263,22 +282,25 @@ List optimal_gsmc_plans( // compute effective sample size - n_eff.at(n) = compute_n_eff(log_incremental_weights_mat[n]); + n_eff.at(n) = compute_n_eff(log_incremental_weights_mat.at(n)); // Now update the diagnostic info if needed, region labels, dval column of the matrix - if(diagnostic_mode && n == N-2){ // record if in diagnostic mode and final step + if(diagnostic_mode && n < N-2 && !split_district_only){ // record if in diagnostic mode and generalized splits for(int j=0; j(V, 0); + region_ids = std::vector(V, 0); + if(split_district_only){ + remainder_region = 0; + }else{ + remainder_region = -1; + } + } @@ -47,7 +55,7 @@ void Plan::Rprint() const{ RcppThread::Rcout << "Region Level Values:"; for(int region_id = 0; region_id < num_regions; region_id++){ - RcppThread::Rcout << "(" << region_str_labels.at(region_id) << " aka " << region_id << + RcppThread::Rcout << "( Region " << region_id << ", dval=" << region_dvals.at(region_id) << ", " << region_pops.at(region_id) <<" ), "; } RcppThread::Rcout << "\n"; diff --git a/src/redist_types.h b/src/redist_types.h index df2b39c11..27693be92 100644 --- a/src/redist_types.h +++ b/src/redist_types.h @@ -26,7 +26,7 @@ typedef std::vector>> Multigraph; class Plan { public: - Plan(int V, int N, double total_map_pop); // constructor for 1 region plan + Plan(int V, int N, double total_map_pop, bool split_district_only=false); // constructor for 1 region plan // attributes int N; // Number all d_nk must sum to int V; // Number of nodes in graph @@ -34,19 +34,26 @@ class Plan int num_districts; // Number of districts in the plan int num_multidistricts; // Number of multidistricts, always `num_regions` - `num_districts` double map_pop; // The population of the entire map + int remainder_region; // ID of the remainder region of the plan (if it has one) // vectors with length V - std::vector region_num_ids; // Representation of regions in integer form (not as easy to trace + std::vector region_ids; // Representation of regions in integer form (not as easy to trace // lineage). This is a length V vector where ith value maps it the integer id of its region // vectors with length num_regions std::vector region_dvals; //Vector of length num_regions mapping region ids to their d values - std::vector region_str_labels; // Vector of length num_regions mapping region id to string label (if tracked) // Regions have R prefix whereas districts end in an integer (in string form). std::vector region_pops; // Vector of length num_regions mapping region ids // to the regions population + std::vector region_added_order; // Vector of length num_regions that + // tracks the relative order that regions were added. As in if we have + // region_added_order[i] > region_added_order[j] then that means region i + // was added after region j + + int region_order_max; // value of current largest region order number + // methods void Rprint() const; diff --git a/src/splitting.cpp b/src/splitting.cpp index 913a8a310..78ec6ef05 100644 --- a/src/splitting.cpp +++ b/src/splitting.cpp @@ -180,14 +180,14 @@ bool get_edge_to_cut(Tree &ust, int root, is_ok.reserve(k_param); new_d_val.reserve(k_param); - if(plan.region_num_ids.at(root) != region_id_to_split){ + if(plan.region_ids.at(root) != region_id_to_split){ Rcout << "Root vertex is not in region to split!"; } // Now loop over all valid edges to cut for (int i = 1; i <= plan.V; i++) { // 1-indexing here // Ignore any vertex not in this region or the root vertex as we wont be cutting those - if (plan.region_num_ids.at(i-1) != region_id_to_split || i - 1 == root) continue; + if (plan.region_ids.at(i-1) != region_id_to_split || i - 1 == root) continue; // Get the population of one side of the partition removing that edge would cause double below = pop_below.at(i - 1); @@ -323,6 +323,7 @@ bool get_edge_to_cut(Tree &ust, int root, //' //' Takes a cut spanning tree `ust` and variables on the two new regions //' induced by the cuts and updates `plan` to add those two new regions. +//' It also sets `plan.remainder_region` equal to `new_region2_id`. //' //' //' @title Update plan regions from cut tree @@ -330,6 +331,8 @@ bool get_edge_to_cut(Tree &ust, int root, //' @param ust A cut (ie has two partition pieces) directed spanning tree //' passed by reference //' @param plan A plan object +//' @param split_district_only Whether or not this was split according to a +//' one district split scheme (as in does the remainder need to be updated) //' @param old_region_id The id of old (split) region //' @param new_region1_tree_root The vertex of the root of one piece of the cut //' tree. This always corresponds to the region with the smaller dval (allowing @@ -351,7 +354,7 @@ bool get_edge_to_cut(Tree &ust, int root, //' the values of the two new region ids were set to //' void update_plan_from_cut( - Tree &ust, Plan &plan, + Tree &ust, Plan &plan, bool split_district_only, const int old_region_id, const int new_region1_tree_root, const int new_region1_dval, const double new_region1_pop, const int new_region2_tree_root, const int new_region2_dval, const double new_region2_pop, @@ -363,31 +366,19 @@ void update_plan_from_cut( plan.num_multidistricts--; // Decrease by one to avoid double counting later // Create info for two new districts - std::string new_region_label1; - std::string new_region_label2; - - std::string region_to_split = plan.region_str_labels.at(old_region_id); // Set label and count depending on if district or multi district if(new_region1_dval == 1){ plan.num_districts++; - // if district then string label just adds district number - new_region_label1 = region_to_split + "." + std::to_string(plan.num_districts); }else{ plan.num_multidistricts++; - // if region then just add current region number - new_region_label1 = region_to_split + ".R" + std::to_string(old_region_id); } // Now do it for second region if(new_region2_dval == 1){ plan.num_districts++; - // if district then string label just adds district number - new_region_label2 = region_to_split + "." + std::to_string(plan.num_districts); }else{ plan.num_multidistricts++; - // if region then just add current region number - new_region_label2 = region_to_split + ".R" + std::to_string(plan.num_regions - 1); } // TODO: Figure out how to do this to preserve the order districts were added @@ -397,6 +388,14 @@ void update_plan_from_cut( // Second new region has id of the new number of regions minus 1 new_region2_id = plan.num_regions - 1; + // make the first new region get max plus one + plan.region_order_max++; + int new_region1_order_added_num = plan.region_order_max; + + // Now make the second new region max plus one again + plan.region_order_max++; + int new_region2_order_added_num = plan.region_order_max; + // Now update the two cut portions assign_region(ust, plan, new_region1_tree_root, new_region1_id); @@ -407,15 +406,20 @@ void update_plan_from_cut( // Add the new region 1 // New region 1 has the same id number as old region so update that plan.region_dvals.at(new_region1_id) = new_region1_dval; - plan.region_str_labels.at(new_region1_id) = new_region_label1; + plan.region_added_order.at(new_region1_id) = new_region1_order_added_num; plan.region_pops.at(new_region1_id) = new_region1_pop; // Add the new region 2 // New region 2's id is the highest id number so push back plan.region_dvals.push_back(new_region2_dval); - plan.region_str_labels.push_back(new_region_label2); + plan.region_added_order.push_back(new_region2_order_added_num); plan.region_pops.push_back(new_region2_pop); + if(split_district_only){ + // update the remainder region value if needed + plan.remainder_region = new_region2_id; + } + // done return; @@ -478,7 +482,7 @@ bool attempt_region_split(const Graph &g, Tree &ust, const uvec &counties, Multi // Mark it as ignore if its not in the region to split for (int i = 0; i < V; i++){ - ignore[i] = plan.region_num_ids.at(i) != region_id_to_split; + ignore[i] = plan.region_ids.at(i) != region_id_to_split; } // Get a uniform spanning tree drawn on that region @@ -510,7 +514,7 @@ bool attempt_region_split(const Graph &g, Tree &ust, const uvec &counties, Multi if(successful_edge_found){ // if successful then update the plan update_plan_from_cut( - ust, plan, + ust, plan, split_district_only, region_id_to_split, new_region1_tree_root, new_region1_dval, new_region1_pop, new_region2_tree_root, new_region2_dval, new_region2_pop, @@ -715,10 +719,14 @@ void generalized_split_maps( idx = index_sampler(gen); Plan proposed_new_plan = old_plans_vec[idx]; - // pick a region to try to split - choose_multidistrict_to_split( - old_plans_vec[idx], region_id_to_split); - + if(split_district_only){ + // if just doing district splits just use remainder region + region_id_to_split = proposed_new_plan.remainder_region; + }else{ + // if generalized split pick a region to try to split + choose_multidistrict_to_split( + old_plans_vec[idx], region_id_to_split); + } // Now try to split that region ok = attempt_region_split(g, ust, counties, cg, diff --git a/src/splitting.h b/src/splitting.h index 0031cfa8d..377aae111 100644 --- a/src/splitting.h +++ b/src/splitting.h @@ -114,6 +114,7 @@ bool get_edge_to_cut(Tree &ust, int root, //' //' Takes a cut spanning tree `ust` and variables on the two new regions //' induced by the cuts and updates `plan` to add those two new regions. +//' It also sets `plan.remainder_region` equal to `new_region2_id`. //' //' //' @title Update plan regions from cut tree @@ -121,6 +122,8 @@ bool get_edge_to_cut(Tree &ust, int root, //' @param ust A cut (ie has two partition pieces) directed spanning tree //' passed by reference //' @param plan A plan object +//' @param split_district_only Whether or not this was split according to a +//' one district split scheme (as in does the remainder need to be updated) //' @param old_region_id The id of old (split) region //' @param new_region1_tree_root The vertex of the root of one piece of the cut //' tree. This always corresponds to the region with the smaller dval (allowing @@ -141,11 +144,12 @@ bool get_edge_to_cut(Tree &ust, int root, //' - `new_region1_id` and `new_region2_id` are updated by reference to what //' the values of the two new region ids were set to //' +//' //' @noRd //' @keywords internal void update_plan_from_cut( - Tree &ust, Plan &plan, - const int old_region_id, + Tree &ust, Plan &plan, bool split_district_only, + const int old_region_id, const int new_region1_tree_root, const int new_region1_dval, const double new_region1_pop, const int new_region2_tree_root, const int new_region2_dval, const double new_region2_pop, int &new_region1_id, int &new_region2_id diff --git a/src/splitting_inspection.cpp b/src/splitting_inspection.cpp index 574c9589c..834901e38 100644 --- a/src/splitting_inspection.cpp +++ b/src/splitting_inspection.cpp @@ -32,11 +32,10 @@ List perform_a_valid_region_split( plan.num_regions = num_regions; plan.num_districts = num_districts; plan.num_multidistricts = plan.num_regions - plan.num_districts; - plan.region_num_ids = region_ids; + plan.region_ids = region_ids; plan.region_dvals = region_dvals; plan.region_pops = region_pops; - // Need to fix string labels - plan.region_str_labels = std::vector(plan.num_regions, "IGNORE"); + if(verbose){ plan.Rprint(); @@ -52,7 +51,7 @@ List perform_a_valid_region_split( // Mark it as ignore if its not in the region to split for (int i = 0; i < V; i++){ - ignore[i] = plan.region_num_ids.at(i) != region_id_to_split; + ignore[i] = plan.region_ids.at(i) != region_id_to_split; } @@ -106,7 +105,7 @@ List perform_a_valid_region_split( int new_region1_id, new_region2_id; update_plan_from_cut( - ust, plan, + ust, plan, split_district_only, region_id_to_split, new_region1_tree_root, new_region1_dval, new_region1_pop, new_region2_tree_root, new_region2_dval, new_region2_pop, @@ -121,7 +120,7 @@ List perform_a_valid_region_split( _["num_attempts"] = try_counter, _["region_id_that_was_split"] = region_id_to_split, _["region_dvals"] = plan.region_dvals, - _["plan_vertex_ids"] = plan.region_num_ids, + _["plan_vertex_ids"] = plan.region_ids, _["pops"] = plan.region_pops, _["num_regions"] = plan.num_regions, _["num_districts"] = plan.num_districts, @@ -229,7 +228,7 @@ List get_successful_proposed_cut(int N, List adj_list, const arma::uvec &countie List out = List::create( _["num_attempts"] = try_counter, _["region_dvals"] = plan.region_dvals, - _["plan"] = plan.region_num_ids, + _["plan"] = plan.region_ids, _["tree"] = ust, _["uncut_tree"] = pre_split_ust, _["pops"] = plan.region_pops, diff --git a/src/tree_op.cpp b/src/tree_op.cpp index 02e896069..4d5d5a203 100644 --- a/src/tree_op.cpp +++ b/src/tree_op.cpp @@ -122,12 +122,12 @@ Graph get_region_graph(const Graph &g, const Plan &plan) { for (int i = 0; i < V; i++) { std::vector nbors = g[i]; // Find out which region this vertex corresponds to - int region_num_i = plan.region_num_ids[i]; + int region_num_i = plan.region_ids[i]; // now iterate over its neighbors for (int nbor : nbors) { // find which region neighbor corresponds to - int region_num_j = plan.region_num_ids[nbor]; + int region_num_j = plan.region_ids[nbor]; // if they are different regions mark matrix true since region i // and region j are adjacent as they share an edge across if (region_num_i != region_num_j) { @@ -242,7 +242,7 @@ void assign_district(const Tree &ust, subview_col &districts, void assign_region(const Tree &ust, Plan &plan, int root, int new_region_num_id) { - plan.region_num_ids.at(root) = new_region_num_id; + plan.region_ids.at(root) = new_region_num_id; int n_desc = ust.at(root).size(); for (int i = 0; i < n_desc; i++) { assign_region(ust, plan, ust.at(root).at(i), new_region_num_id); diff --git a/src/weights.cpp b/src/weights.cpp index f9094eb61..de9f0f3cd 100644 --- a/src/weights.cpp +++ b/src/weights.cpp @@ -194,16 +194,22 @@ double compute_log_pop_temper( } -//' Compute the log incremental weight of a plan + + +//' Compute the optimal log incremental weight of a plan //' //' Given a plan object this computes the minimum variance weights as derived in -//' . This is equivalent to the inverse of a sum over all -//' adjacent regions in a plan. +//' . This is equal to the inverse of a sum over all +//' adjacent regions in a plan if using generalized region split and +//' sum over all districts adajacent to the remainder if using one district +//' split approach. //' -//' @title Compute Incremental Weight of a plan +//' @title Compute Optimal Incremental Weight of a plan //' -//' @param plan A plan object //' @param g The underlying map graph +//' @param plan A plan object +//' @param split_district_only whether or not to compute the weights under +//' the district only split scheme or not. //' @param target The target population for a single district //' @param pop_temper The population tempering parameter //' @@ -211,13 +217,13 @@ double compute_log_pop_temper( //' //' @return the log of the incremental weight of the plan //' -double compute_log_incremental_weight( +double compute_optimal_log_incremental_weight( const Graph &g, const Plan &plan, + bool split_district_only, const double target, const double pop_temper){ // get a region level graph Graph rg = get_region_graph(g, plan); - // sanity check: make sure the region level graph's number of vertices is // the same as the number of regions in the plan if((int)rg.size() != plan.num_regions){ @@ -228,10 +234,15 @@ double compute_log_incremental_weight( // the first vertex is always the smaller numbered of the edge // We use a set because it doesn't keep duplicates std::set> adj_region_pairs; - // Iterate through the adjacency list - for (int u = 0; u < rg.size(); u++){ - // iterate over neighbors - for(auto v: rg[u]){ + + + // If n < N and split_district_only true then just get adjacent to remainder + if(plan.num_regions < plan.N && split_district_only){ + // get remainder region id + int u = plan.remainder_region; + + // Iterate through the adjacency list of remainder region + for(auto v: rg.at(u)){ // store the edges such that smaller vertex is always first if (u < v) { adj_region_pairs.emplace(u, v); @@ -239,10 +250,24 @@ double compute_log_incremental_weight( adj_region_pairs.emplace(v, u); } } + }else{ // else get all adjacent districts + // Iterate through the adjacency list + // Now get all unique adjacent region pairs and store them such that + // the first vertex is always the smaller numbered of the edge + for (int u = 0; u < rg.size(); u++){ + // iterate over neighbors + for(auto v: rg.at(u)){ + // store the edges such that smaller vertex is always first + if (u < v) { + adj_region_pairs.emplace(u, v); + } else { + adj_region_pairs.emplace(v, u); + } + } + } } - double incremental_weight = 0.0; bool do_pop_temper = (plan.num_regions < plan.N) && pop_temper > 0; @@ -251,10 +276,19 @@ double compute_log_incremental_weight( // Now iterate over all adjacent pairs for (const auto& edge : adj_region_pairs) { // get log of boundary length between regions - double log_boundary = region_log_boundary(g, plan.region_num_ids, edge.first, edge.second); + double log_boundary = region_log_boundary(g, plan.region_ids, edge.first, edge.second); // get prob of selecting union of adj regions - double log_splitting_prob = get_log_retroactive_splitting_prob(plan, edge.first, edge.second); - // NO e^J TERM YET but can be added + double log_splitting_prob; + + // for one district split the probability that region was chosen to be split is always 1 + if(split_district_only){ + log_splitting_prob = 0; + }else{ + // in generalized region split find probability you would have + // picked to split the union of the the two regions + log_splitting_prob = get_log_retroactive_splitting_prob(plan, edge.first, edge.second); + } + // Do population tempering term if not final double log_temper; @@ -268,8 +302,6 @@ double compute_log_incremental_weight( log_temper = 0; } - - // multiply the boundary length and selection probability by adding the logs // now exponentiate and add to the sum incremental_weight += std::exp(log_boundary @@ -290,116 +322,6 @@ double compute_log_incremental_weight( } - - -//' Compute the log incremental weight of a plan under basic smc scheme -//' -//' Given a plan object this computes the minimum variance weights as derived in -//' . This is equivalent to the inverse of a sum over all -//' adjacent regions in a plan. -//' -//' @title Compute Incremental Weight of a plan -//' -//' @param plan A plan object -//' @param g The underlying map graph -//' @param target The target population for a single district -//' @param pop_temper The population tempering parameter -//' -//' @details No modifications to inputs made -//' -//' @return the log of the incremental weight of the plan -//' -double compute_basic_smc_log_incremental_weight( - const Graph &g, const Plan &plan, - const double target, const double pop_temper){ - // get a region level graph - Graph rg = get_region_graph(g, plan); - - - // sanity check: make sure the region level graph's number of vertices is - // the same as the number of regions in the plan - if((int)rg.size() != plan.num_regions){ - Rprintf("SOMETHING WENT WRONG IN COMPUTE LOG INCREMENT WEIGHJT\n"); - } - - // We use a set to track edges because it doesn't keep duplicates - std::set> adj_region_pairs; - - // If n < N just get adjacent to remainder - if(plan.num_regions < plan.N){ - // adjacent region always has id n-1 - int u = plan.num_regions - 1; - - // Iterate through the adjacency list of remainder region - // which is always the number of regions minus 1 - for(auto v: rg[u]){ - // store the edges such that smaller vertex is always first - if (u < v) { - adj_region_pairs.emplace(u, v); - } else { - adj_region_pairs.emplace(v, u); - } - } - }else{ // else get all adjacent districts - // Iterate through the adjacency list - // Now get all unique adjacent region pairs and store them such that - // the first vertex is always the smaller numbered of the edge - for (int u = 0; u < rg.size(); u++){ - // iterate over neighbors - for(auto v: rg[u]){ - // store the edges such that smaller vertex is always first - if (u < v) { - adj_region_pairs.emplace(u, v); - } else { - adj_region_pairs.emplace(v, u); - } - } - } - } - - - - double incremental_weight = 0.0; - bool do_pop_temper = (plan.num_regions < plan.N) && pop_temper > 0; - - // Now iterate over all adjacent pairs - for (const auto& edge : adj_region_pairs) { - // get log of boundary length between regions - double log_boundary = region_log_boundary(g, plan.region_num_ids, edge.first, edge.second); - - // Do population tempering term if not final - double log_temper; - if(do_pop_temper){ - log_temper = compute_log_pop_temper( - plan, - edge.first, edge.second, - target, pop_temper - ); - }else{ - log_temper = 0; - } - - // multiply the boundary length and pop tempering by adding the logs - // now exponentiate and add to the sum - incremental_weight += std::exp(log_boundary - + log_temper); - } - - - // Check its not infinity - if(incremental_weight == -std::numeric_limits::infinity()){ - Rprintf("Error! weight is negative infinity for some reason \n"); - } - - - // now return the log of the inverse of the sum - return -std::log(incremental_weight); - -} - - - - //' Computes log unnormalized weights for vector of plans //' //' Using the procedure outlined in this function computes the log @@ -440,30 +362,18 @@ void get_all_plans_log_gsmc_weights( ){ int M = (int) plans_vec.size(); - // check which scheme to compute weights under - if(split_district_only){ - // Parallel thread pool where all objects in memory shared by default - pool.parallelFor(0, M, [&] (int i) { - double log_incr_weight = compute_basic_smc_log_incremental_weight( - g, plans_vec.at(i), target, pop_temper); - log_incremental_weights[i] = log_incr_weight; - unnormalized_sampling_weights[i] = std::exp(log_incr_weight); - }); - - // Wait for all the threads to finish - pool.wait(); - }else{ - // Parallel thread pool where all objects in memory shared by default - pool.parallelFor(0, M, [&] (int i) { - double log_incr_weight = compute_log_incremental_weight( - g, plans_vec.at(i), target, pop_temper); - log_incremental_weights[i] = log_incr_weight; - unnormalized_sampling_weights[i] = std::exp(log_incr_weight); - }); - - // Wait for all the threads to finish - pool.wait(); - } + // Parallel thread pool where all objects in memory shared by default + pool.parallelFor(0, M, [&] (int i) { + double log_incr_weight = compute_optimal_log_incremental_weight( + g, plans_vec.at(i), split_district_only, + target, pop_temper); + log_incremental_weights[i] = log_incr_weight; + unnormalized_sampling_weights[i] = std::exp(log_incr_weight); + }); + + // Wait for all the threads to finish + pool.wait(); + return; } \ No newline at end of file diff --git a/src/weights.h b/src/weights.h index 079559aef..5eec7f3b6 100644 --- a/src/weights.h +++ b/src/weights.h @@ -35,13 +35,7 @@ double compute_n_eff(const std::vector &log_wgt); -double compute_log_incremental_weight( - const Graph &g, const Plan &plan, - const double target, const double pop_temper); -double compute_basic_smc_log_incremental_weight( - const Graph &g, const Plan &plan, - const double target, const double pop_temper); //' Computes log unnormalized weights for vector of plans diff --git a/task_tracker.md b/task_tracker.md index 65ee47a4c..d21d269a9 100644 --- a/task_tracker.md +++ b/task_tracker.md @@ -8,14 +8,13 @@ Note all of the diagnostic information is accurately updated to account for a re # ----- ACTIVE TASKS ----- -**Create Separate Updating Function** -Create a function which takes a cut tree and information on the new regions and updates them. Previously this was in the `cut_regions` function but it has now been seperated out since sometimes for the MCMC step we want to know what a cut region would look like but don't neccesarily always want to actually change it. +**Seperate New Region ID Creation from Update Edges** +To make code more resuable for merge split stuff make it so that creating IDs/resizing attributes in the plan is done outside the `update_plan_from_cut` function and instead that function only handles updating the plan. **Create Diagnostics Object for cpp code** To avoid needing to pass so many different parameters in the function header consider creating a new diagnostic class in cpp which serves as a wrapper for all the diagnostic things that are collected in the `split_maps` function. -**Rewrite gsmc and basic_smc ** -Use the code from the new `smc_and_mcmc.cpp` file to rewrite the gsmc and basic_smc stuff. It should be possible to make one version of most of the functions and just have a single input control whether or not it just splits districts. This should cut down on the code and eliminate the big redundancy problem. + **Create More Internal Visualization/Examination Stuff** Already created a new file, `splitting_inspection.cpp` to help with this but general idea is create code that allows someone in R to pass in a graph in adjacency list form (and potentially other stuff) and see things like the cut tree output by the splitting procedure or an internal region level graph. This will be helpful for making figures for the paper and also for deep level debugging/diagnostic things. @@ -39,6 +38,25 @@ Need to more cleanly seperate diagnostic information from stuff in the final sam # ----- COMPLETED TASKS ----- +**Remove Plan String Label and Replace with Split Order Number - DONE 11/1/2024** +Task: Remove the string label attribute from plan objects and instead just have a vector which tracks the relative order regions were added. This will be a vector mapping region id to a number where the order of the number relative to the others indicates the order it was added. Will also need to add a region_order_max attribute so each time a new region is added it is set to that plus one. At the end you can use this to recover the order districts were created but it can also be used to inspect intermediate results as well. + +Comments after completion: Successfully redesigned cpp and R code so it is now possible to track the relative order regions were added and the R function now automatically makes it so that region ID is numbered oldest to most recent added. + +**Track Remainder Better - DONE 11/12024** +Task: Right now the remainder region in a plan is blindly set to region2_id but this will be a problem for the merge split because the remainder might get changed. + +Comments after completion: Added a new option to the `Plan` constructor for specifying whether the plan is for district only splits or not. If its district only splits remainder is initialized to 0 and if not set to -1. That should mean if any future code tries to use remainder region when it shouldn't that will throw an error. + +**Rewrite gsmc and basic_smc into one function - DONE 11/1/2024** +Task: Use the code from the new `smc_and_mcmc.cpp` file to rewrite the gsmc and basic_smc stuff. It should be possible to make one version of most of the functions and just have a single input control whether or not it just splits districts. This should cut down on the code and eliminate the big redundancy problem. + +Comments after completion: The functionality previously in `gsmc.cpp` and `basic_smc.cpp` has now been moved to `optimal_gsmc.cpp` and some of the functions in there (namely the splitting and weight ones) have been moved to their own files. There is now a general purpose function that handles this with a new flag to control whether or not its doing generalized splits or one-district splits only. I also deleted the `redist_gsmc.R` and `redist_basic_smc.R` and consolidated things to the `redist_optimal_gmsc.R` which also now has a flag for generalized vs one district splits. + +**Create Separate Updating Function - DONE 11/1/2024** +Create a function which takes a cut tree and information on the new regions and updates them. Previously this was in the `cut_regions` function but it has now been seperated out since sometimes for the MCMC step we want to know what a cut region would look like but don't neccesarily always want to actually change it. + + **Compress dval storage in `plan` object - DONE FORGOT TO RECORD DATE** - We don't actually need to store an `V` length vector of the dvals associated with each vertex. Instead all you need to do is keep a vector mapping region id values to the dvalue - Change the attribute in `Plan` linking region id to d value from a `map` to just an array since the regions are already 0 indexed we don't need to bother with a map From 4d1e88f00c417437ad2776784c85d5b1a83b0636 Mon Sep 17 00:00:00 2001 From: "Philip W. O'Sullivan" Date: Fri, 1 Nov 2024 20:22:27 -0400 Subject: [PATCH 028/324] tweaked find edge to cut function to better integrate with merge split --- R/RcppExports.R | 25 ++--- src/splitting.cpp | 186 +++++++++++++++++------------------ src/splitting.h | 33 ++++--- src/splitting_inspection.cpp | 77 ++++++++++++--- task_tracker.md | 10 +- 5 files changed, 195 insertions(+), 136 deletions(-) diff --git a/R/RcppExports.R b/R/RcppExports.R index 3a97f5598..cfc4a68a5 100644 --- a/R/RcppExports.R +++ b/R/RcppExports.R @@ -250,7 +250,7 @@ NULL #' update the plan. Instead it just returns the information on the two new #' regions if successful and the vertices to use to update the plans. #' -#' Depending on the value of split_district_only will only attempt to split off +#' Depending on the value of max_potential_d will only attempt to split off #' a single district or allows for more general splits. #' #' By convention the first new region (`new_region1`) will always be the region @@ -261,11 +261,13 @@ NULL #' @param ust A directed spanning tree passed by reference #' @param root The root vertex of the spanning tree #' @param k_param The k parameter from the SMC algorithm, you choose among the top k_param edges -#' @param split_district_only If true then only tries to split a district, if false allows for -#' arbitrary region splits +#' @param max_potential_d The largest potential d value it will try for a cut. Setting this to +#' 1 will result in only 1 district splits. #' @param pop A vector of the population associated with each vertex in `g` -#' @param plan A plan object +#' @param region_ids A vector mapping 0 indexed vertices to their region id number #' @param region_id_to_split The id of the region in the plan object we're attempting to split +#' @param total_region_pop The total population of the region being split +#' @param total_region_dval The dval of the region being split #' @param lower Acceptable lower bounds on a valid district's population #' @param upper Acceptable upper bounds on a valid district's population #' @param target Ideal population of a valid district. This is what deviance is calculated @@ -298,8 +300,12 @@ NULL #' Updates a `Plan` object using a cut tree #' #' Takes a cut spanning tree `ust` and variables on the two new regions -#' induced by the cuts and updates `plan` to add those two new regions. -#' It also sets `plan.remainder_region` equal to `new_region2_id`. +#' induced by the cuts and updates `plan` with information on those two +#' new regions. Assumes that the plan attributes already have the correct +#' size and accessing either of the region ids won't create issues. +#' +#' It also sets `plan.remainder_region` equal to `new_region2_id` if +#' split_district_only is true. #' #' #' @title Update plan regions from cut tree @@ -309,7 +315,6 @@ NULL #' @param plan A plan object #' @param split_district_only Whether or not this was split according to a #' one district split scheme (as in does the remainder need to be updated) -#' @param old_region_id The id of old (split) region #' @param new_region1_tree_root The vertex of the root of one piece of the cut #' tree. This always corresponds to the region with the smaller dval (allowing #' for the possiblity the dvals are equal). @@ -324,11 +329,7 @@ NULL #' @param new_region2_id The id the new region 2 was assigned in the plan #' #' @details Modifications -#' - `plan` is updated in place with the two new regions and the old region -#' is removed -#' - `new_region1_id` and `new_region2_id` are updated by reference to what -#' the values of the two new region ids were set to -#' +#' - `plan` is updated in place with the two new regions #' #' @noRd #' @keywords internal diff --git a/src/splitting.cpp b/src/splitting.cpp index 78ec6ef05..f9707bb79 100644 --- a/src/splitting.cpp +++ b/src/splitting.cpp @@ -94,7 +94,7 @@ double choose_multidistrict_to_split( //' update the plan. Instead it just returns the information on the two new //' regions if successful and the vertices to use to update the plans. //' -//' Depending on the value of split_district_only will only attempt to split off +//' Depending on the value of max_potential_d will only attempt to split off //' a single district or allows for more general splits. //' //' By convention the first new region (`new_region1`) will always be the region @@ -105,11 +105,13 @@ double choose_multidistrict_to_split( //' @param ust A directed spanning tree passed by reference //' @param root The root vertex of the spanning tree //' @param k_param The k parameter from the SMC algorithm, you choose among the top k_param edges -//' @param split_district_only If true then only tries to split a district, if false allows for -//' arbitrary region splits +//' @param max_potential_d The largest potential d value it will try for a cut. Setting this to +//' 1 will result in only 1 district splits. //' @param pop A vector of the population associated with each vertex in `g` -//' @param plan A plan object +//' @param region_ids A vector mapping 0 indexed vertices to their region id number //' @param region_id_to_split The id of the region in the plan object we're attempting to split +//' @param total_region_pop The total population of the region being split +//' @param total_region_dval The dval of the region being split //' @param lower Acceptable lower bounds on a valid district's population //' @param upper Acceptable upper bounds on a valid district's population //' @param target Ideal population of a valid district. This is what deviance is calculated @@ -136,35 +138,23 @@ double choose_multidistrict_to_split( //' @return True if two valid regions were successfully split, false otherwise //' bool get_edge_to_cut(Tree &ust, int root, - int k_param, bool split_district_only, - const uvec &pop, const Plan &plan, const int region_id_to_split, + int k_param, int max_potential_d, + const uvec &pop, const std::vector ®ion_ids, + const int region_id_to_split, double total_region_pop, int total_region_dval, const double lower, const double upper, const double target, int &new_region1_tree_root, int &new_region1_dval, double &new_region1_pop, int &new_region2_tree_root, int &new_region2_dval, double &new_region2_pop ){ - // Get population of region being split - double total_pop = plan.region_pops.at(region_id_to_split); - // Get the number of final districts in region being split - int num_final_districts = plan.region_dvals.at(region_id_to_split); + // total_region_dval - // Get the largest possible d value we can try - int max_potential_d; - - if(split_district_only){ - // if only splitting districts its just 1 bc then it will only try - // a potential d of 1 later on - max_potential_d = 1; - }else{ - // if arbitrary splits then d value of region minus 1 - max_potential_d = num_final_districts - 1; - } + int V = static_cast(region_ids.size()); // Rcout << "For " << region_id_to_split << " Total pop is " << total_pop << " and d_nk is " << num_final_districts << "\n"; // create list that points to parents & computes population below each vtx - std::vector pop_below(plan.V, 0); - std::vector parent(plan.V); + std::vector pop_below(V, 0); + std::vector parent(V); parent[root] = -1; tree_pop(ust, root, pop, pop_below, parent); @@ -180,19 +170,19 @@ bool get_edge_to_cut(Tree &ust, int root, is_ok.reserve(k_param); new_d_val.reserve(k_param); - if(plan.region_ids.at(root) != region_id_to_split){ + if(region_ids.at(root) != region_id_to_split){ Rcout << "Root vertex is not in region to split!"; } // Now loop over all valid edges to cut - for (int i = 1; i <= plan.V; i++) { // 1-indexing here + for (int i = 1; i <= V; i++) { // 1-indexing here // Ignore any vertex not in this region or the root vertex as we wont be cutting those - if (plan.region_ids.at(i-1) != region_id_to_split || i - 1 == root) continue; + if (region_ids.at(i-1) != region_id_to_split || i - 1 == root) continue; // Get the population of one side of the partition removing that edge would cause double below = pop_below.at(i - 1); // Get the population of the other side - double above = total_pop - below; + double above = total_region_pop - below; // vectors to keep track of value for each d_{n,k} std::vector devs(max_potential_d); @@ -214,15 +204,15 @@ bool get_edge_to_cut(Tree &ust, int root, // check in bounds are_ok[potential_d-1] = lower * potential_d <= below && below <= upper * potential_d - && lower * (num_final_districts - potential_d) <= above - && above <= upper * (num_final_districts - potential_d); + && lower * (total_region_dval - potential_d) <= above + && above <= upper * (total_region_dval - potential_d); } else { // Else if dev2 is smaller we assign d_nk to above devs[potential_d-1] = dev2; dev2_bigger[potential_d-1] = false; are_ok[potential_d-1] = lower * potential_d <= above && above <= upper * potential_d - && lower * (num_final_districts - potential_d) <= below - && below <= upper * (num_final_districts - potential_d); + && lower * (total_region_dval - potential_d) <= below + && below <= upper * (total_region_dval - potential_d); } } @@ -231,10 +221,6 @@ bool get_edge_to_cut(Tree &ust, int root, std::vector::iterator result = std::min_element(devs.begin(), devs.end()); int best_potential_d = std::distance(devs.begin(), result); - /* - Rcout << "min element has value " << *result << " and index [" - << best_potential_d << "]\n"; - */ if(dev2_bigger[best_potential_d]){ candidates.push_back(i); @@ -279,8 +265,7 @@ bool get_edge_to_cut(Tree &ust, int root, // Get dval for two new regions new_region1_dval = new_d_val[idx]; - new_region2_dval = num_final_districts - new_region1_dval; - + new_region2_dval = total_region_dval - new_region1_dval; if (candidates[idx] > 0) { // Means cut below so first vertex is cut_at @@ -289,7 +274,7 @@ bool get_edge_to_cut(Tree &ust, int root, // Set the new populations new_region1_pop = pop_below.at(cut_at); - new_region2_pop = total_pop - new_region1_pop; + new_region2_pop = total_region_pop - new_region1_pop; // return pop_below.at(cut_at); } else { // Means cut above so first vertex is root @@ -298,7 +283,7 @@ bool get_edge_to_cut(Tree &ust, int root, // Set the new populations new_region2_pop = pop_below.at(cut_at); - new_region1_pop = total_pop - new_region2_pop; + new_region1_pop = total_region_pop - new_region2_pop; } @@ -322,8 +307,12 @@ bool get_edge_to_cut(Tree &ust, int root, //' Updates a `Plan` object using a cut tree //' //' Takes a cut spanning tree `ust` and variables on the two new regions -//' induced by the cuts and updates `plan` to add those two new regions. -//' It also sets `plan.remainder_region` equal to `new_region2_id`. +//' induced by the cuts and updates `plan` with information on those two +//' new regions. Assumes that the plan attributes already have the correct +//' size and accessing either of the region ids won't create issues. +//' +//' It also sets `plan.remainder_region` equal to `new_region2_id` if +//' split_district_only is true. //' //' //' @title Update plan regions from cut tree @@ -333,7 +322,6 @@ bool get_edge_to_cut(Tree &ust, int root, //' @param plan A plan object //' @param split_district_only Whether or not this was split according to a //' one district split scheme (as in does the remainder need to be updated) -//' @param old_region_id The id of old (split) region //' @param new_region1_tree_root The vertex of the root of one piece of the cut //' tree. This always corresponds to the region with the smaller dval (allowing //' for the possiblity the dvals are equal). @@ -348,46 +336,15 @@ bool get_edge_to_cut(Tree &ust, int root, //' @param new_region2_id The id the new region 2 was assigned in the plan //' //' @details Modifications -//' - `plan` is updated in place with the two new regions and the old region -//' is removed -//' - `new_region1_id` and `new_region2_id` are updated by reference to what -//' the values of the two new region ids were set to +//' - `plan` is updated in place with the two new regions //' void update_plan_from_cut( Tree &ust, Plan &plan, bool split_district_only, - const int old_region_id, const int new_region1_tree_root, const int new_region1_dval, const double new_region1_pop, const int new_region2_tree_root, const int new_region2_dval, const double new_region2_pop, - int &new_region1_id, int &new_region2_id + const int new_region1_id, const int new_region2_id ){ - // update plan with new regions - plan.num_regions++; // increase region count by 1 - plan.num_multidistricts--; // Decrease by one to avoid double counting later - - // Create info for two new districts - - // Set label and count depending on if district or multi district - if(new_region1_dval == 1){ - plan.num_districts++; - }else{ - plan.num_multidistricts++; - } - - // Now do it for second region - if(new_region2_dval == 1){ - plan.num_districts++; - }else{ - plan.num_multidistricts++; - } - - // TODO: Figure out how to do this to preserve the order districts were added - - // make the first new region have the same integer id - new_region1_id = old_region_id; - // Second new region has id of the new number of regions minus 1 - new_region2_id = plan.num_regions - 1; - // make the first new region get max plus one plan.region_order_max++; int new_region1_order_added_num = plan.region_order_max; @@ -403,18 +360,18 @@ void update_plan_from_cut( // Now update the region level information - // Add the new region 1 - // New region 1 has the same id number as old region so update that + // updates the new region 1 plan.region_dvals.at(new_region1_id) = new_region1_dval; plan.region_added_order.at(new_region1_id) = new_region1_order_added_num; plan.region_pops.at(new_region1_id) = new_region1_pop; - // Add the new region 2 + // updates the new region 2 // New region 2's id is the highest id number so push back - plan.region_dvals.push_back(new_region2_dval); - plan.region_added_order.push_back(new_region2_order_added_num); - plan.region_pops.push_back(new_region2_pop); + plan.region_dvals.at(new_region2_id) = new_region2_dval; + plan.region_added_order.at(new_region2_id) = new_region2_order_added_num; + plan.region_pops.at(new_region2_id) = new_region2_pop; + // If district split only then set the remainder region as well if(split_district_only){ // update the remainder region value if needed plan.remainder_region = new_region2_id; @@ -502,29 +459,70 @@ bool attempt_region_split(const Graph &g, Tree &ust, const uvec &counties, Multi bool successful_edge_found; + int max_potential_d; + + if(split_district_only){ + max_potential_d = 1; + }else{ + max_potential_d = plan.region_dvals.at(region_id_to_split) - 1; + } + // try to get an edge to cut successful_edge_found = get_edge_to_cut(ust, root, - k_param, split_district_only, pop, - plan, region_id_to_split, + k_param, max_potential_d, + pop, plan.region_ids, + region_id_to_split, plan.region_pops.at(region_id_to_split), + plan.region_dvals.at(region_id_to_split), lower, upper, target, new_region1_tree_root, new_region1_dval, new_region1_pop, new_region2_tree_root, new_region2_dval, new_region2_pop); - if(successful_edge_found){ - // if successful then update the plan - update_plan_from_cut( - ust, plan, split_district_only, - region_id_to_split, - new_region1_tree_root, new_region1_dval, new_region1_pop, - new_region2_tree_root, new_region2_dval, new_region2_pop, - new_region_ids[1], new_region_ids[2] - ); - return true; - }else{ + if(!successful_edge_found){ return false; } + // if successful then update the plan + // update plan with new regions + plan.num_regions++; // increase region count by 1 + plan.num_multidistricts--; // Decrease by one to avoid double counting later + + // Create info for two new districts + + // Set label and count depending on if district or multi district + if(new_region1_dval == 1){ + plan.num_districts++; + }else{ + plan.num_multidistricts++; + } + + // Now do it for second region + if(new_region2_dval == 1){ + plan.num_districts++; + }else{ + plan.num_multidistricts++; + } + + // make the first new region have the same integer id as the split region + new_region_ids[1] = region_id_to_split; + // Second new region has id of the new number of regions minus 1 + new_region_ids[2] = plan.num_regions - 1; + + // Now resize the region level attributes + plan.region_dvals.resize(plan.num_regions, -1); + plan.region_added_order.resize(plan.num_regions, -1); + plan.region_pops.resize(plan.num_regions, -1.0); + + // now update things with the new region ids + update_plan_from_cut( + ust, plan, split_district_only, + new_region1_tree_root, new_region1_dval, new_region1_pop, + new_region2_tree_root, new_region2_dval, new_region2_pop, + new_region_ids[1], new_region_ids[2] + ); + + return true; + } diff --git a/src/splitting.h b/src/splitting.h index 377aae111..c3ce7eee2 100644 --- a/src/splitting.h +++ b/src/splitting.h @@ -57,7 +57,7 @@ double choose_multidistrict_to_split( //' update the plan. Instead it just returns the information on the two new //' regions if successful and the vertices to use to update the plans. //' -//' Depending on the value of split_district_only will only attempt to split off +//' Depending on the value of max_potential_d will only attempt to split off //' a single district or allows for more general splits. //' //' By convention the first new region (`new_region1`) will always be the region @@ -68,11 +68,13 @@ double choose_multidistrict_to_split( //' @param ust A directed spanning tree passed by reference //' @param root The root vertex of the spanning tree //' @param k_param The k parameter from the SMC algorithm, you choose among the top k_param edges -//' @param split_district_only If true then only tries to split a district, if false allows for -//' arbitrary region splits +//' @param max_potential_d The largest potential d value it will try for a cut. Setting this to +//' 1 will result in only 1 district splits. //' @param pop A vector of the population associated with each vertex in `g` -//' @param plan A plan object +//' @param region_ids A vector mapping 0 indexed vertices to their region id number //' @param region_id_to_split The id of the region in the plan object we're attempting to split +//' @param total_region_pop The total population of the region being split +//' @param total_region_dval The dval of the region being split //' @param lower Acceptable lower bounds on a valid district's population //' @param upper Acceptable upper bounds on a valid district's population //' @param target Ideal population of a valid district. This is what deviance is calculated @@ -101,8 +103,9 @@ double choose_multidistrict_to_split( //' @noRd //' @keywords internal bool get_edge_to_cut(Tree &ust, int root, - int k_param, bool split_district_only, - const uvec &pop, const Plan &plan, const int region_id_to_split, + int k_param, int max_potential_d, + const uvec &pop, const std::vector ®ion_ids, + const int region_id_to_split, double total_region_pop, int total_region_dval, const double lower, const double upper, const double target, int &new_region1_tree_root, int &new_region1_dval, double &new_region1_pop, int &new_region2_tree_root, int &new_region2_dval, double &new_region2_pop @@ -113,8 +116,12 @@ bool get_edge_to_cut(Tree &ust, int root, //' Updates a `Plan` object using a cut tree //' //' Takes a cut spanning tree `ust` and variables on the two new regions -//' induced by the cuts and updates `plan` to add those two new regions. -//' It also sets `plan.remainder_region` equal to `new_region2_id`. +//' induced by the cuts and updates `plan` with information on those two +//' new regions. Assumes that the plan attributes already have the correct +//' size and accessing either of the region ids won't create issues. +//' +//' It also sets `plan.remainder_region` equal to `new_region2_id` if +//' split_district_only is true. //' //' //' @title Update plan regions from cut tree @@ -124,7 +131,6 @@ bool get_edge_to_cut(Tree &ust, int root, //' @param plan A plan object //' @param split_district_only Whether or not this was split according to a //' one district split scheme (as in does the remainder need to be updated) -//' @param old_region_id The id of old (split) region //' @param new_region1_tree_root The vertex of the root of one piece of the cut //' tree. This always corresponds to the region with the smaller dval (allowing //' for the possiblity the dvals are equal). @@ -139,20 +145,15 @@ bool get_edge_to_cut(Tree &ust, int root, //' @param new_region2_id The id the new region 2 was assigned in the plan //' //' @details Modifications -//' - `plan` is updated in place with the two new regions and the old region -//' is removed -//' - `new_region1_id` and `new_region2_id` are updated by reference to what -//' the values of the two new region ids were set to -//' +//' - `plan` is updated in place with the two new regions //' //' @noRd //' @keywords internal void update_plan_from_cut( Tree &ust, Plan &plan, bool split_district_only, - const int old_region_id, const int new_region1_tree_root, const int new_region1_dval, const double new_region1_pop, const int new_region2_tree_root, const int new_region2_dval, const double new_region2_pop, - int &new_region1_id, int &new_region2_id + const int new_region1_id, const int new_region2_id ); diff --git a/src/splitting_inspection.cpp b/src/splitting_inspection.cpp index 834901e38..338658ac7 100644 --- a/src/splitting_inspection.cpp +++ b/src/splitting_inspection.cpp @@ -81,12 +81,23 @@ List perform_a_valid_region_split( pre_split_ust = ust; // Try to make a cut + int max_potential_d; + if(split_district_only){ + max_potential_d = 1; + }else{ + max_potential_d = plan.region_dvals.at(region_id_to_split) - 1; + } + + // try to get an edge to cut successful_split_made = get_edge_to_cut(ust, root, - k_param, split_district_only, pop, - plan, region_id_to_split, - lower, upper, target, - new_region1_tree_root, new_region1_dval, new_region1_pop, - new_region2_tree_root, new_region2_dval, new_region2_pop); + k_param, max_potential_d, + pop, plan.region_ids, + region_id_to_split, plan.region_pops.at(region_id_to_split), + plan.region_dvals.at(region_id_to_split), + lower, upper, target, + new_region1_tree_root, new_region1_dval, new_region1_pop, + new_region2_tree_root, new_region2_dval, new_region2_pop); + try_counter++; // increase the counter by 1 if(verbose && false){ @@ -104,14 +115,46 @@ List perform_a_valid_region_split( // TODO: make this optional int new_region1_id, new_region2_id; + // if successful then update the plan + // update plan with new regions + plan.num_regions++; // increase region count by 1 + plan.num_multidistricts--; // Decrease by one to avoid double counting later + + // Create info for two new districts + + // Set label and count depending on if district or multi district + if(new_region1_dval == 1){ + plan.num_districts++; + }else{ + plan.num_multidistricts++; + } + + // Now do it for second region + if(new_region2_dval == 1){ + plan.num_districts++; + }else{ + plan.num_multidistricts++; + } + + // make the first new region have the same integer id as the split region + new_region1_id = region_id_to_split; + // Second new region has id of the new number of regions minus 1 + new_region2_id = plan.num_regions - 1; + + // Now resize the region level attributes + plan.region_dvals.resize(plan.num_regions, -1); + plan.region_added_order.resize(plan.num_regions, -1); + plan.region_pops.resize(plan.num_regions, -1.0); + + // now update things with the new region ids update_plan_from_cut( ust, plan, split_district_only, - region_id_to_split, new_region1_tree_root, new_region1_dval, new_region1_pop, new_region2_tree_root, new_region2_dval, new_region2_pop, new_region1_id, new_region2_id ); + if(verbose){ plan.Rprint(); } @@ -203,13 +246,23 @@ List get_successful_proposed_cut(int N, List adj_list, const arma::uvec &countie // copy uncut tree pre_split_ust = ust; - // Try to make a cut + int max_potential_d; + if(split_district_only){ + max_potential_d = 1; + }else{ + max_potential_d = plan.region_dvals.at(region_id_to_split) - 1; + } + + // try to get an edge to cut successful_split_made = get_edge_to_cut(ust, root, - k_param, split_district_only, pop, - plan, region_id_to_split, - lower, upper, target, - new_region1_tree_root, new_region1_dval, new_region1_pop, - new_region2_tree_root, new_region2_dval, new_region2_pop); + k_param, max_potential_d, + pop, plan.region_ids, + region_id_to_split, plan.region_pops.at(region_id_to_split), + plan.region_dvals.at(region_id_to_split), + lower, upper, target, + new_region1_tree_root, new_region1_dval, new_region1_pop, + new_region2_tree_root, new_region2_dval, new_region2_pop); + try_counter++; // increase the counter by 1 if(verbose){ diff --git a/task_tracker.md b/task_tracker.md index d21d269a9..a6e3a3c9a 100644 --- a/task_tracker.md +++ b/task_tracker.md @@ -8,8 +8,8 @@ Note all of the diagnostic information is accurately updated to account for a re # ----- ACTIVE TASKS ----- -**Seperate New Region ID Creation from Update Edges** -To make code more resuable for merge split stuff make it so that creating IDs/resizing attributes in the plan is done outside the `update_plan_from_cut` function and instead that function only handles updating the plan. +**Make get_edge_to_cut only need vertex region id vector** +Change `get_edge_to_cut` to only take in a vector of vertex region ids and a max dval to try instead of taking in a plan. This will make merge split easier by allowing you to just pass in a vertex region id vector with two regions merged without having to bother editing the actual plan. **Create Diagnostics Object for cpp code** To avoid needing to pass so many different parameters in the function header consider creating a new diagnostic class in cpp which serves as a wrapper for all the diagnostic things that are collected in the `split_maps` function. @@ -38,6 +38,12 @@ Need to more cleanly seperate diagnostic information from stuff in the final sam # ----- COMPLETED TASKS ----- + +**Seperate New Region ID Creation from Update Edges - DONE 11/1/2024** +Task: To make code more resuable for merge split stuff make it so that creating IDs/resizing attributes in the plan is done outside the `update_plan_from_cut` function and instead that function only handles updating the plan. + +Comments after completion: Changed `update_plan_from_cut` so it just does updating. Resizing plan attributes and coming up with region ids now happen outside the function so it should be fully usable for merge split stuff later on. + **Remove Plan String Label and Replace with Split Order Number - DONE 11/1/2024** Task: Remove the string label attribute from plan objects and instead just have a vector which tracks the relative order regions were added. This will be a vector mapping region id to a number where the order of the number relative to the others indicates the order it was added. Will also need to add a region_order_max attribute so each time a new region is added it is set to that plus one. At the end you can use this to recover the order districts were created but it can also be used to inspect intermediate results as well. From 490698255323ebd724cd4572229ee7cd0c36a320 Mon Sep 17 00:00:00 2001 From: "Philip W. O'Sullivan" Date: Fri, 1 Nov 2024 22:09:17 -0400 Subject: [PATCH 029/324] more tweaks to the updating functions from a cut tree --- R/RcppExports.R | 49 ++++++++++++++ src/RcppExports.cpp | 21 ++++++ src/splitting.cpp | 122 ++++++++++++++++++++++++++--------- src/splitting.h | 51 +++++++++++++++ src/splitting_inspection.cpp | 54 ++++++---------- 5 files changed, 232 insertions(+), 65 deletions(-) diff --git a/R/RcppExports.R b/R/RcppExports.R index cfc4a68a5..4b635d3a6 100644 --- a/R/RcppExports.R +++ b/R/RcppExports.R @@ -140,6 +140,10 @@ testing_sample_forest <- function(l, pop, lower, upper, counties, ignore) { .Call(`_redist_testing_sample_forest`, l, pop, lower, upper, counties, ignore) } +one_cut_then_merge_split <- function(N, adj_list, counties, pop, target, lower, upper, split_district_only, num_merge_split_steps, verbose) { + .Call(`_redist_one_cut_then_merge_split`, N, adj_list, counties, pop, target, lower, upper, split_district_only, num_merge_split_steps, verbose) +} + plan_class_testing <- function(V, num_regions, num_districts) { .Call(`_redist_plan_class_testing`, V, num_regions, num_districts) } @@ -335,6 +339,51 @@ NULL #' @keywords internal NULL +#' Creates new regions and updates the `Plan` object using a cut tree +#' +#' Takes a cut spanning tree `ust` and variables on the two new regions +#' induced by the cuts and creates space/updates the information on those +#' two new regions in the `plan` object. This function increases the number +#' of regions aspect by 1 and updates the region level information and all +#' other variables changed by adding a new region. +#' +#' It also sets `plan.remainder_region` equal to `new_region2_id` if +#' split_district_only is true. +#' +#' +#' @title Create and update new plan regions from cut tree +#' +#' @param ust A cut (ie has two partition pieces) directed spanning tree +#' passed by reference +#' @param plan A plan object +#' @param split_district_only Whether or not this was split according to a +#' one district split scheme (as in does the remainder need to be updated) +#' @param old_split_region_id The id of the region that was split into the two +#' new ones +#' @param new_region1_tree_root The vertex of the root of one piece of the cut +#' tree. This always corresponds to the region with the smaller dval (allowing +#' for the possiblity the dvals are equal). +#' @param new_region1_dval The dval associated with the new region 1 +#' @param new_region1_pop The population associated with the new region 1 +#' @param new_region2_tree_root The vertex of the root of other piece of the cut +#' tree. This always corresponds to the region with the bigger dval (allowing +#' for the possiblity the dvals are equal). +#' @param new_region2_dval The dval associated with the new region 2 +#' @param new_region2_pop The population associated with the new region 2 +#' @param new_region1_id The id the new region 1 was assigned in the plan +#' @param new_region2_id The id the new region 2 was assigned in the plan +#' +#' @details Modifications +#' - `plan` is updated in place with the two new regions +#' - `new_region1_id` is set to the id new region1 was assigned +#' which is just the `old_split_region_id` +#' - `new_region2_id` is set to the id new region2 was assigned +#' which is just `plan.num_regions-1` +#' +#' @noRd +#' @keywords internal +NULL + #' Splits a multidistrict in all of the plans #' #' Using the procedure outlined in this function attempts to split diff --git a/src/RcppExports.cpp b/src/RcppExports.cpp index 23421ae4a..d37be2a7d 100644 --- a/src/RcppExports.cpp +++ b/src/RcppExports.cpp @@ -418,6 +418,26 @@ BEGIN_RCPP return rcpp_result_gen; END_RCPP } +// one_cut_then_merge_split +List one_cut_then_merge_split(int N, List adj_list, const arma::uvec& counties, const arma::uvec& pop, double target, double lower, double upper, bool split_district_only, int num_merge_split_steps, bool verbose); +RcppExport SEXP _redist_one_cut_then_merge_split(SEXP NSEXP, SEXP adj_listSEXP, SEXP countiesSEXP, SEXP popSEXP, SEXP targetSEXP, SEXP lowerSEXP, SEXP upperSEXP, SEXP split_district_onlySEXP, SEXP num_merge_split_stepsSEXP, SEXP verboseSEXP) { +BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< int >::type N(NSEXP); + Rcpp::traits::input_parameter< List >::type adj_list(adj_listSEXP); + Rcpp::traits::input_parameter< const arma::uvec& >::type counties(countiesSEXP); + Rcpp::traits::input_parameter< const arma::uvec& >::type pop(popSEXP); + Rcpp::traits::input_parameter< double >::type target(targetSEXP); + Rcpp::traits::input_parameter< double >::type lower(lowerSEXP); + Rcpp::traits::input_parameter< double >::type upper(upperSEXP); + Rcpp::traits::input_parameter< bool >::type split_district_only(split_district_onlySEXP); + Rcpp::traits::input_parameter< int >::type num_merge_split_steps(num_merge_split_stepsSEXP); + Rcpp::traits::input_parameter< bool >::type verbose(verboseSEXP); + rcpp_result_gen = Rcpp::wrap(one_cut_then_merge_split(N, adj_list, counties, pop, target, lower, upper, split_district_only, num_merge_split_steps, verbose)); + return rcpp_result_gen; +END_RCPP +} // plan_class_testing List plan_class_testing(int V, int num_regions, int num_districts); RcppExport SEXP _redist_plan_class_testing(SEXP VSEXP, SEXP num_regionsSEXP, SEXP num_districtsSEXP) { @@ -829,6 +849,7 @@ static const R_CallMethodDef CallEntries[] = { {"_redist_optimal_gsmc_plans", (DL_FUNC) &_redist_optimal_gsmc_plans, 12}, {"_redist_pareto_dominated", (DL_FUNC) &_redist_pareto_dominated, 1}, {"_redist_testing_sample_forest", (DL_FUNC) &_redist_testing_sample_forest, 6}, + {"_redist_one_cut_then_merge_split", (DL_FUNC) &_redist_one_cut_then_merge_split, 10}, {"_redist_plan_class_testing", (DL_FUNC) &_redist_plan_class_testing, 3}, {"_redist_split_entire_map", (DL_FUNC) &_redist_split_entire_map, 8}, {"_redist_split_all_the_way", (DL_FUNC) &_redist_split_all_the_way, 8}, diff --git a/src/splitting.cpp b/src/splitting.cpp index f9707bb79..406ba3404 100644 --- a/src/splitting.cpp +++ b/src/splitting.cpp @@ -383,7 +383,94 @@ void update_plan_from_cut( }; +//' Creates new regions and updates the `Plan` object using a cut tree +//' +//' Takes a cut spanning tree `ust` and variables on the two new regions +//' induced by the cuts and creates space/updates the information on those +//' two new regions in the `plan` object. This function increases the number +//' of regions aspect by 1 and updates the region level information and all +//' other variables changed by adding a new region. +//' +//' It also sets `plan.remainder_region` equal to `new_region2_id` if +//' split_district_only is true. +//' +//' +//' @title Create and update new plan regions from cut tree +//' +//' @param ust A cut (ie has two partition pieces) directed spanning tree +//' passed by reference +//' @param plan A plan object +//' @param split_district_only Whether or not this was split according to a +//' one district split scheme (as in does the remainder need to be updated) +//' @param old_split_region_id The id of the region that was split into the two +//' new ones +//' @param new_region1_tree_root The vertex of the root of one piece of the cut +//' tree. This always corresponds to the region with the smaller dval (allowing +//' for the possiblity the dvals are equal). +//' @param new_region1_dval The dval associated with the new region 1 +//' @param new_region1_pop The population associated with the new region 1 +//' @param new_region2_tree_root The vertex of the root of other piece of the cut +//' tree. This always corresponds to the region with the bigger dval (allowing +//' for the possiblity the dvals are equal). +//' @param new_region2_dval The dval associated with the new region 2 +//' @param new_region2_pop The population associated with the new region 2 +//' @param new_region1_id The id the new region 1 was assigned in the plan +//' @param new_region2_id The id the new region 2 was assigned in the plan +//' +//' @details Modifications +//' - `plan` is updated in place with the two new regions +//' - `new_region1_id` is set to the id new region1 was assigned +//' which is just the `old_split_region_id` +//' - `new_region2_id` is set to the id new region2 was assigned +//' which is just `plan.num_regions-1` +//' +void add_new_regions_to_plan_from_cut( + Tree &ust, Plan &plan, bool split_district_only, + const int old_split_region_id, + const int new_region1_tree_root, const int new_region1_dval, const double new_region1_pop, + const int new_region2_tree_root, const int new_region2_dval, const double new_region2_pop, + int &new_region1_id, int &new_region2_id +){ + // if successful then update the plan + // update plan with new regions + plan.num_regions++; // increase region count by 1 + plan.num_multidistricts--; // Decrease by one to avoid double counting later + + // Create info for two new districts + + // Set label and count depending on if district or multi district + if(new_region1_dval == 1){ + plan.num_districts++; + }else{ + plan.num_multidistricts++; + } + + // Now do it for second region + if(new_region2_dval == 1){ + plan.num_districts++; + }else{ + plan.num_multidistricts++; + } + + // make the first new region have the same integer id as the split region + new_region1_id = old_split_region_id; + // Second new region has id of the new number of regions minus 1 + new_region2_id = plan.num_regions - 1; + + // Now resize the region level attributes + plan.region_dvals.resize(plan.num_regions, -1); + plan.region_added_order.resize(plan.num_regions, -1); + plan.region_pops.resize(plan.num_regions, -1.0); + + // now update using tree + update_plan_from_cut( + ust, plan, split_district_only, + new_region1_tree_root, new_region1_dval, new_region1_pop, + new_region2_tree_root, new_region2_dval, new_region2_pop, + new_region1_id, new_region2_id + ); +} @@ -482,40 +569,11 @@ bool attempt_region_split(const Graph &g, Tree &ust, const uvec &counties, Multi return false; } - // if successful then update the plan - // update plan with new regions - plan.num_regions++; // increase region count by 1 - plan.num_multidistricts--; // Decrease by one to avoid double counting later - - // Create info for two new districts - // Set label and count depending on if district or multi district - if(new_region1_dval == 1){ - plan.num_districts++; - }else{ - plan.num_multidistricts++; - } - - // Now do it for second region - if(new_region2_dval == 1){ - plan.num_districts++; - }else{ - plan.num_multidistricts++; - } - - // make the first new region have the same integer id as the split region - new_region_ids[1] = region_id_to_split; - // Second new region has id of the new number of regions minus 1 - new_region_ids[2] = plan.num_regions - 1; - - // Now resize the region level attributes - plan.region_dvals.resize(plan.num_regions, -1); - plan.region_added_order.resize(plan.num_regions, -1); - plan.region_pops.resize(plan.num_regions, -1.0); - - // now update things with the new region ids - update_plan_from_cut( + // now update the plan with the two new cut regions + add_new_regions_to_plan_from_cut( ust, plan, split_district_only, + region_id_to_split, new_region1_tree_root, new_region1_dval, new_region1_pop, new_region2_tree_root, new_region2_dval, new_region2_pop, new_region_ids[1], new_region_ids[2] diff --git a/src/splitting.h b/src/splitting.h index c3ce7eee2..a70bfed90 100644 --- a/src/splitting.h +++ b/src/splitting.h @@ -158,6 +158,57 @@ void update_plan_from_cut( +//' Creates new regions and updates the `Plan` object using a cut tree +//' +//' Takes a cut spanning tree `ust` and variables on the two new regions +//' induced by the cuts and creates space/updates the information on those +//' two new regions in the `plan` object. This function increases the number +//' of regions aspect by 1 and updates the region level information and all +//' other variables changed by adding a new region. +//' +//' It also sets `plan.remainder_region` equal to `new_region2_id` if +//' split_district_only is true. +//' +//' +//' @title Create and update new plan regions from cut tree +//' +//' @param ust A cut (ie has two partition pieces) directed spanning tree +//' passed by reference +//' @param plan A plan object +//' @param split_district_only Whether or not this was split according to a +//' one district split scheme (as in does the remainder need to be updated) +//' @param old_split_region_id The id of the region that was split into the two +//' new ones +//' @param new_region1_tree_root The vertex of the root of one piece of the cut +//' tree. This always corresponds to the region with the smaller dval (allowing +//' for the possiblity the dvals are equal). +//' @param new_region1_dval The dval associated with the new region 1 +//' @param new_region1_pop The population associated with the new region 1 +//' @param new_region2_tree_root The vertex of the root of other piece of the cut +//' tree. This always corresponds to the region with the bigger dval (allowing +//' for the possiblity the dvals are equal). +//' @param new_region2_dval The dval associated with the new region 2 +//' @param new_region2_pop The population associated with the new region 2 +//' @param new_region1_id The id the new region 1 was assigned in the plan +//' @param new_region2_id The id the new region 2 was assigned in the plan +//' +//' @details Modifications +//' - `plan` is updated in place with the two new regions +//' - `new_region1_id` is set to the id new region1 was assigned +//' which is just the `old_split_region_id` +//' - `new_region2_id` is set to the id new region2 was assigned +//' which is just `plan.num_regions-1` +//' +//' @noRd +//' @keywords internal +void add_new_regions_to_plan_from_cut( + Tree &ust, Plan &plan, bool split_district_only, + const int old_split_region_id, + const int new_region1_tree_root, const int new_region1_dval, const double new_region1_pop, + const int new_region2_tree_root, const int new_region2_dval, const double new_region2_pop, + int &new_region1_id, int &new_region2_id +); + //' Splits a multidistrict in all of the plans //' //' Using the procedure outlined in this function attempts to split diff --git a/src/splitting_inspection.cpp b/src/splitting_inspection.cpp index 338658ac7..f8eeee45e 100644 --- a/src/splitting_inspection.cpp +++ b/src/splitting_inspection.cpp @@ -115,46 +115,17 @@ List perform_a_valid_region_split( // TODO: make this optional int new_region1_id, new_region2_id; - // if successful then update the plan - // update plan with new regions - plan.num_regions++; // increase region count by 1 - plan.num_multidistricts--; // Decrease by one to avoid double counting later - - // Create info for two new districts - - // Set label and count depending on if district or multi district - if(new_region1_dval == 1){ - plan.num_districts++; - }else{ - plan.num_multidistricts++; - } - - // Now do it for second region - if(new_region2_dval == 1){ - plan.num_districts++; - }else{ - plan.num_multidistricts++; - } - - // make the first new region have the same integer id as the split region - new_region1_id = region_id_to_split; - // Second new region has id of the new number of regions minus 1 - new_region2_id = plan.num_regions - 1; - - // Now resize the region level attributes - plan.region_dvals.resize(plan.num_regions, -1); - plan.region_added_order.resize(plan.num_regions, -1); - plan.region_pops.resize(plan.num_regions, -1.0); - // now update things with the new region ids - update_plan_from_cut( + add_new_regions_to_plan_from_cut( ust, plan, split_district_only, + region_id_to_split, new_region1_tree_root, new_region1_dval, new_region1_pop, new_region2_tree_root, new_region2_dval, new_region2_pop, new_region1_id, new_region2_id ); + if(verbose){ plan.Rprint(); } @@ -262,7 +233,7 @@ List get_successful_proposed_cut(int N, List adj_list, const arma::uvec &countie lower, upper, target, new_region1_tree_root, new_region1_dval, new_region1_pop, new_region2_tree_root, new_region2_dval, new_region2_pop); - + try_counter++; // increase the counter by 1 if(verbose){ @@ -271,6 +242,17 @@ List get_successful_proposed_cut(int N, List adj_list, const arma::uvec &countie } + // if successful then update the plan + // update plan with new regions + int new_region1_id, new_region2_id; + // now update things with the new region ids + add_new_regions_to_plan_from_cut( + ust, plan, split_district_only, + region_id_to_split, + new_region1_tree_root, new_region1_dval, new_region1_pop, + new_region2_tree_root, new_region2_dval, new_region2_pop, + new_region1_id, new_region2_id + ); if(verbose){ plan.Rprint(); @@ -295,3 +277,9 @@ List get_successful_proposed_cut(int N, List adj_list, const arma::uvec &countie return out; } + + + + + + From 8feac8bb2b317dd982786d734ed57ab720e49968 Mon Sep 17 00:00:00 2001 From: "Philip W. O'Sullivan" Date: Sat, 2 Nov 2024 01:47:27 -0400 Subject: [PATCH 030/324] started working on merge split stuff --- R/RcppExports.R | 8 + src/RcppExports.cpp | 55 ++++++ src/merging.cpp | 167 ++++++++++++++++++ src/merging.h | 34 ++++ src/smc_and_mcmc.cpp | 330 +++++++++++++++++++++++++++++++++++ src/smc_and_mcmc.h | 8 +- src/splitting.cpp | 7 +- src/splitting_inspection.cpp | 68 ++++++++ src/splitting_inspection.h | 13 ++ task_tracker.md | 15 +- 10 files changed, 698 insertions(+), 7 deletions(-) create mode 100644 src/merging.cpp create mode 100644 src/merging.h diff --git a/R/RcppExports.R b/R/RcppExports.R index 4b635d3a6..003be5e62 100644 --- a/R/RcppExports.R +++ b/R/RcppExports.R @@ -140,6 +140,10 @@ testing_sample_forest <- function(l, pop, lower, upper, counties, ignore) { .Call(`_redist_testing_sample_forest`, l, pop, lower, upper, counties, ignore) } +perform_a_valid_region_split_then_merge_split <- function(adj_list, counties, pop, k_param, region_id_to_split, target, lower, upper, N, num_regions, num_districts, region_ids, region_dvals, region_pops, split_district_only, num_merge_split_steps, verbose) { + .Call(`_redist_perform_a_valid_region_split_then_merge_split`, adj_list, counties, pop, k_param, region_id_to_split, target, lower, upper, N, num_regions, num_districts, region_ids, region_dvals, region_pops, split_district_only, num_merge_split_steps, verbose) +} + one_cut_then_merge_split <- function(N, adj_list, counties, pop, target, lower, upper, split_district_only, num_merge_split_steps, verbose) { .Call(`_redist_one_cut_then_merge_split`, N, adj_list, counties, pop, target, lower, upper, split_district_only, num_merge_split_steps, verbose) } @@ -490,6 +494,10 @@ perform_a_valid_region_split <- function(adj_list, counties, pop, k_param, regio .Call(`_redist_perform_a_valid_region_split`, adj_list, counties, pop, k_param, region_id_to_split, target, lower, upper, N, num_regions, num_districts, region_ids, region_dvals, region_pops, split_district_only, verbose) } +perform_merge_split_steps <- function(adj_list, counties, pop, k_param, target, lower, upper, N, num_regions, num_districts, region_ids, region_dvals, region_pops, split_district_only, num_merge_split_steps, verbose) { + .Call(`_redist_perform_merge_split_steps`, adj_list, counties, pop, k_param, target, lower, upper, N, num_regions, num_districts, region_ids, region_dvals, region_pops, split_district_only, num_merge_split_steps, verbose) +} + swMH <- function(aList, cdvec, popvec, nsims, constraints, eprob, pct_dist_parity, beta_sequence, beta_weights, lambda = 0L, beta = 0.0, adapt_beta = "none", adjswap = 1L, exact_mh = 0L, adapt_eprob = 0L, adapt_lambda = 0L, num_hot_steps = 0L, num_annealing_steps = 0L, num_cold_steps = 0L, verbose = TRUE) { .Call(`_redist_swMH`, aList, cdvec, popvec, nsims, constraints, eprob, pct_dist_parity, beta_sequence, beta_weights, lambda, beta, adapt_beta, adjswap, exact_mh, adapt_eprob, adapt_lambda, num_hot_steps, num_annealing_steps, num_cold_steps, verbose) } diff --git a/src/RcppExports.cpp b/src/RcppExports.cpp index d37be2a7d..be6480ff3 100644 --- a/src/RcppExports.cpp +++ b/src/RcppExports.cpp @@ -418,6 +418,33 @@ BEGIN_RCPP return rcpp_result_gen; END_RCPP } +// perform_a_valid_region_split_then_merge_split +List perform_a_valid_region_split_then_merge_split(List adj_list, const arma::uvec& counties, const arma::uvec& pop, int k_param, int region_id_to_split, double target, double lower, double upper, int N, int num_regions, int num_districts, std::vector region_ids, std::vector region_dvals, std::vector region_pops, bool split_district_only, int num_merge_split_steps, bool verbose); +RcppExport SEXP _redist_perform_a_valid_region_split_then_merge_split(SEXP adj_listSEXP, SEXP countiesSEXP, SEXP popSEXP, SEXP k_paramSEXP, SEXP region_id_to_splitSEXP, SEXP targetSEXP, SEXP lowerSEXP, SEXP upperSEXP, SEXP NSEXP, SEXP num_regionsSEXP, SEXP num_districtsSEXP, SEXP region_idsSEXP, SEXP region_dvalsSEXP, SEXP region_popsSEXP, SEXP split_district_onlySEXP, SEXP num_merge_split_stepsSEXP, SEXP verboseSEXP) { +BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< List >::type adj_list(adj_listSEXP); + Rcpp::traits::input_parameter< const arma::uvec& >::type counties(countiesSEXP); + Rcpp::traits::input_parameter< const arma::uvec& >::type pop(popSEXP); + Rcpp::traits::input_parameter< int >::type k_param(k_paramSEXP); + Rcpp::traits::input_parameter< int >::type region_id_to_split(region_id_to_splitSEXP); + Rcpp::traits::input_parameter< double >::type target(targetSEXP); + Rcpp::traits::input_parameter< double >::type lower(lowerSEXP); + Rcpp::traits::input_parameter< double >::type upper(upperSEXP); + Rcpp::traits::input_parameter< int >::type N(NSEXP); + Rcpp::traits::input_parameter< int >::type num_regions(num_regionsSEXP); + Rcpp::traits::input_parameter< int >::type num_districts(num_districtsSEXP); + Rcpp::traits::input_parameter< std::vector >::type region_ids(region_idsSEXP); + Rcpp::traits::input_parameter< std::vector >::type region_dvals(region_dvalsSEXP); + Rcpp::traits::input_parameter< std::vector >::type region_pops(region_popsSEXP); + Rcpp::traits::input_parameter< bool >::type split_district_only(split_district_onlySEXP); + Rcpp::traits::input_parameter< int >::type num_merge_split_steps(num_merge_split_stepsSEXP); + Rcpp::traits::input_parameter< bool >::type verbose(verboseSEXP); + rcpp_result_gen = Rcpp::wrap(perform_a_valid_region_split_then_merge_split(adj_list, counties, pop, k_param, region_id_to_split, target, lower, upper, N, num_regions, num_districts, region_ids, region_dvals, region_pops, split_district_only, num_merge_split_steps, verbose)); + return rcpp_result_gen; +END_RCPP +} // one_cut_then_merge_split List one_cut_then_merge_split(int N, List adj_list, const arma::uvec& counties, const arma::uvec& pop, double target, double lower, double upper, bool split_district_only, int num_merge_split_steps, bool verbose); RcppExport SEXP _redist_one_cut_then_merge_split(SEXP NSEXP, SEXP adj_listSEXP, SEXP countiesSEXP, SEXP popSEXP, SEXP targetSEXP, SEXP lowerSEXP, SEXP upperSEXP, SEXP split_district_onlySEXP, SEXP num_merge_split_stepsSEXP, SEXP verboseSEXP) { @@ -725,6 +752,32 @@ BEGIN_RCPP return rcpp_result_gen; END_RCPP } +// perform_merge_split_steps +List perform_merge_split_steps(List adj_list, const arma::uvec& counties, const arma::uvec& pop, int k_param, double target, double lower, double upper, int N, int num_regions, int num_districts, std::vector region_ids, std::vector region_dvals, std::vector region_pops, bool split_district_only, int num_merge_split_steps, bool verbose); +RcppExport SEXP _redist_perform_merge_split_steps(SEXP adj_listSEXP, SEXP countiesSEXP, SEXP popSEXP, SEXP k_paramSEXP, SEXP targetSEXP, SEXP lowerSEXP, SEXP upperSEXP, SEXP NSEXP, SEXP num_regionsSEXP, SEXP num_districtsSEXP, SEXP region_idsSEXP, SEXP region_dvalsSEXP, SEXP region_popsSEXP, SEXP split_district_onlySEXP, SEXP num_merge_split_stepsSEXP, SEXP verboseSEXP) { +BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< List >::type adj_list(adj_listSEXP); + Rcpp::traits::input_parameter< const arma::uvec& >::type counties(countiesSEXP); + Rcpp::traits::input_parameter< const arma::uvec& >::type pop(popSEXP); + Rcpp::traits::input_parameter< int >::type k_param(k_paramSEXP); + Rcpp::traits::input_parameter< double >::type target(targetSEXP); + Rcpp::traits::input_parameter< double >::type lower(lowerSEXP); + Rcpp::traits::input_parameter< double >::type upper(upperSEXP); + Rcpp::traits::input_parameter< int >::type N(NSEXP); + Rcpp::traits::input_parameter< int >::type num_regions(num_regionsSEXP); + Rcpp::traits::input_parameter< int >::type num_districts(num_districtsSEXP); + Rcpp::traits::input_parameter< std::vector >::type region_ids(region_idsSEXP); + Rcpp::traits::input_parameter< std::vector >::type region_dvals(region_dvalsSEXP); + Rcpp::traits::input_parameter< std::vector >::type region_pops(region_popsSEXP); + Rcpp::traits::input_parameter< bool >::type split_district_only(split_district_onlySEXP); + Rcpp::traits::input_parameter< int >::type num_merge_split_steps(num_merge_split_stepsSEXP); + Rcpp::traits::input_parameter< bool >::type verbose(verboseSEXP); + rcpp_result_gen = Rcpp::wrap(perform_merge_split_steps(adj_list, counties, pop, k_param, target, lower, upper, N, num_regions, num_districts, region_ids, region_dvals, region_pops, split_district_only, num_merge_split_steps, verbose)); + return rcpp_result_gen; +END_RCPP +} // swMH List swMH(List aList, NumericVector cdvec, NumericVector popvec, int nsims, List constraints, double eprob, double pct_dist_parity, NumericVector beta_sequence, NumericVector beta_weights, int lambda, double beta, std::string adapt_beta, int adjswap, int exact_mh, int adapt_eprob, int adapt_lambda, int num_hot_steps, int num_annealing_steps, int num_cold_steps, bool verbose); RcppExport SEXP _redist_swMH(SEXP aListSEXP, SEXP cdvecSEXP, SEXP popvecSEXP, SEXP nsimsSEXP, SEXP constraintsSEXP, SEXP eprobSEXP, SEXP pct_dist_paritySEXP, SEXP beta_sequenceSEXP, SEXP beta_weightsSEXP, SEXP lambdaSEXP, SEXP betaSEXP, SEXP adapt_betaSEXP, SEXP adjswapSEXP, SEXP exact_mhSEXP, SEXP adapt_eprobSEXP, SEXP adapt_lambdaSEXP, SEXP num_hot_stepsSEXP, SEXP num_annealing_stepsSEXP, SEXP num_cold_stepsSEXP, SEXP verboseSEXP) { @@ -849,6 +902,7 @@ static const R_CallMethodDef CallEntries[] = { {"_redist_optimal_gsmc_plans", (DL_FUNC) &_redist_optimal_gsmc_plans, 12}, {"_redist_pareto_dominated", (DL_FUNC) &_redist_pareto_dominated, 1}, {"_redist_testing_sample_forest", (DL_FUNC) &_redist_testing_sample_forest, 6}, + {"_redist_perform_a_valid_region_split_then_merge_split", (DL_FUNC) &_redist_perform_a_valid_region_split_then_merge_split, 17}, {"_redist_one_cut_then_merge_split", (DL_FUNC) &_redist_one_cut_then_merge_split, 10}, {"_redist_plan_class_testing", (DL_FUNC) &_redist_plan_class_testing, 3}, {"_redist_split_entire_map", (DL_FUNC) &_redist_split_entire_map, 8}, @@ -870,6 +924,7 @@ static const R_CallMethodDef CallEntries[] = { {"_redist_splits", (DL_FUNC) &_redist_splits, 4}, {"_redist_dist_cty_splits", (DL_FUNC) &_redist_dist_cty_splits, 3}, {"_redist_perform_a_valid_region_split", (DL_FUNC) &_redist_perform_a_valid_region_split, 16}, + {"_redist_perform_merge_split_steps", (DL_FUNC) &_redist_perform_merge_split_steps, 16}, {"_redist_swMH", (DL_FUNC) &_redist_swMH, 20}, {"_redist_split_entire_map_once_new_cut_func", (DL_FUNC) &_redist_split_entire_map_once_new_cut_func, 9}, {"_redist_tree_pop", (DL_FUNC) &_redist_tree_pop, 5}, diff --git a/src/merging.cpp b/src/merging.cpp new file mode 100644 index 000000000..c539729aa --- /dev/null +++ b/src/merging.cpp @@ -0,0 +1,167 @@ +/******************************************************** +* Author: Philip O'Sullivan' +* Institution: Harvard University +* Date Created: 2024/11 +* Purpose: Functions for Merging Plans +********************************************************/ + +#include "merging.h" + +double pick_adj_regions_to_merge( + std::vector> const &adj_pairs_vec, + std::pair &adj_pair +){ + + // Return 1 over the log of the size + return 3.4; +} + + +int run_merge_split_step( + Graph const &g, const uvec &counties, Multigraph &cg, const uvec &pop, + bool split_district_only, + Tree &ust, int k_param, + Plan &plan, int nsteps_to_run, + double &lower, double upper, double target, + std::vector &visited, std::vector &ignore +){ + // initialize number of successes to zero + int num_successes = 0; + + // tracks + bool changed_plan = true; + + // initialize a region level graph + Graph rg; + + // get all pairs of adjacent regions + std::set> adj_region_pairs_set; + std::vector> adj_pairs_vec; + // stores the pair of adjacent regions to merge + std::pair adj_pair; + + // Seed the random generator with the current time + std::random_device rd; + std::mt19937 gen(rd()); + std::uniform_int_distribution distrib; + + + for (int j = 0; j < nsteps_to_run; j++){ + // Rprintf("Iter %d!\n", j); + // If plan change from previous step then recreate the region graph and + // adjacent pairslist and update tree stuff + if(changed_plan){ + rg = get_region_graph(g, plan); + adj_region_pairs_set.clear(); + for (int u = 0; u < rg.size(); u++){ + // iterate over neighbors + for(auto v: rg.at(u)){ + // store the edges such that smaller vertex is always first + if (u < v) { + adj_region_pairs_set.emplace(u, v); + } else { + adj_region_pairs_set.emplace(v, u); + } + } + } + // Now convert to vec + adj_pairs_vec.assign(adj_region_pairs_set.begin(), adj_region_pairs_set.end()); + // Define the range for random index + distrib = std::uniform_int_distribution(0, adj_pairs_vec.size() - 1); + } + + // Pick two regions to merge + // pick_regions_to_merge(adj_region_pairs) + auto adj_pair = adj_pairs_vec.at(distrib(gen)); + // + int region1_id = adj_pair.first; + int region2_id = adj_pair.second; + + // just make the first id the merged id + int merged_id = region1_id; + // create vector of vertex ids + std::vector region_ids = plan.region_ids; + // Replace all occurance of region 2 with region 1 + for (int v = 0; v < plan.V; v++) + { + if(region_ids[v] == region2_id){ + region_ids[v] = region1_id; + } + } + + // now create the merged dval and population + int merged_dval = plan.region_dvals.at(region1_id) + plan.region_dvals.at(region2_id); + double merged_pop = plan.region_pops.at(region1_id) + plan.region_pops.at(region2_id); + + + // Prepare to draw uniform spanning tree + for (int i = 0; i < plan.V; i++){ + ignore[i] = region_ids.at(i) != merged_id; + } + int root; + clear_tree(ust); + + // Get a uniform spanning tree drawn on that region + int result = sample_sub_ust(g, ust, plan.V, root, visited, ignore, pop, lower, upper, counties, cg); + // Return unsuccessful if tree not drawn + if (result != 0){ + REprintf("SPANNING TREE NOT DRAWN SOMETHING WENT REALLY WRONG!!\n"); + changed_plan = false; + continue; + } + + // splitting related params + int new_region1_tree_root, new_region2_tree_root; + int new_region1_dval, new_region2_dval; + double new_region1_pop, new_region2_pop; + + bool successful_edge_found; + + int max_potential_d; + + if(split_district_only){ + max_potential_d = 1; + }else{ + max_potential_d = merged_dval - 1; + } + + // try to get an edge to cut + successful_edge_found = get_edge_to_cut(ust, root, + k_param, max_potential_d, + pop, region_ids, + merged_id, merged_pop, + merged_dval, + lower, upper, target, + new_region1_tree_root, new_region1_dval, new_region1_pop, + new_region2_tree_root, new_region2_dval, new_region2_pop); + + if(successful_edge_found){ + Rprintf( + "Yippeee! Succesfully merged region %d and %d to make " + "a new region with %d dval and %.1f population. It was " + "then split into (R%d, %d, %.1f) and (R%d, %d, %.1f) \n", + region1_id, region2_id,merged_dval,merged_pop, + region1_id, new_region1_dval, new_region1_pop, + region2_id, new_region2_dval, new_region2_pop + ); + num_successes++; + // now update it using the old ids + update_plan_from_cut( + ust, plan, split_district_only, + new_region1_tree_root, new_region1_dval, new_region1_pop, + new_region2_tree_root, new_region2_dval, new_region2_pop, + region1_id, region2_id + ); + Rprintf("out of cut update!\n"); + // changed plan successfully + changed_plan = true; + }else{ + // plan didn't change + changed_plan = false; + } + + } + + + return num_successes; +} diff --git a/src/merging.h b/src/merging.h new file mode 100644 index 000000000..10cb8fe53 --- /dev/null +++ b/src/merging.h @@ -0,0 +1,34 @@ +#pragma once +#ifndef MERGING_H +#define MERGING_H + +// [[Rcpp::depends(redistmetrics)]] + +#include "smc_base.h" + +#include +#include +#include +#include +#include +#include +#include + +#include +#include "wilson.h" +#include "tree_op.h" +#include "map_calc.h" +#include "redist_types.h" +#include "splitting.h" + + +int run_merge_split_step( + Graph const &g, const uvec &counties, Multigraph &cg, const uvec &pop, + bool split_district_only, + Tree &ust, int k_param, + Plan &plan, int nsteps_to_run, + double &lower, double upper, double target, + std::vector &visited, std::vector &ignore +); + +#endif \ No newline at end of file diff --git a/src/smc_and_mcmc.cpp b/src/smc_and_mcmc.cpp index b7c168cb1..0d8bb010a 100644 --- a/src/smc_and_mcmc.cpp +++ b/src/smc_and_mcmc.cpp @@ -8,4 +8,334 @@ #include "smc_and_mcmc.h" +//' Uses gsmc method to generate a sample of `M` plans in `c++` +//' +//' Using the procedure outlined in this function uses Sequential +//' Monte Carlo (SMC) methods to generate a sample of `M` plans +//' +//' @title Run redist gsmc +//' +//' @param N The number of districts the final plans will have +//' @param adj_list A 0-indexed adjacency list representing the undirected graph +//' which represents the underlying map the plans are to be drawn on +//' @param counties Vector of county labels of each vertex in `g` +//' @param pop A vector of the population associated with each vertex in `g` +//' @param target Ideal population of a valid district. This is what deviance is calculated +//' relative to +//' @param lower Acceptable lower bounds on a valid district's population +//' @param upper Acceptable upper bounds on a valid district's population +//' @param M The number of plans (samples) to draw +//' @param control Named list of additional parameters. +//' @param num_threads The number of threads the threadpool should use +//' @param verbosity What level of detail to print out while the algorithm is +//' running +//' @export +List optimal_gsmc_with_merge_split_plans( + int N, List adj_list, + const arma::uvec &counties, const arma::uvec &pop, + double target, double lower, double upper, + int M, // M is Number of particles aka number of different plans + List control, // control has pop temper, and k parameter value, and whether only district splits are allowed + int num_threads, int verbosity, bool diagnostic_mode){ + // set number of threads + if (num_threads <= 0) num_threads = std::thread::hardware_concurrency(); + if (num_threads == 1) num_threads = 0; + + // lags thing (copied from original smc code, don't understand what its doing) + std::vector lags = as>(control["lags"]); + // k param values to use + std::vector k_params = as>(control["k_params"]); + // Whether or not to only do district splits + bool split_district_only = as(control["split_district_only"]); + + double pop_temper = as(control["pop_temper"]); + + // there are N-1 splits so for now just do it + int ms_freq = 7; + int total_ms_steps = (N-1)/ms_freq; + + umat ancestors(M, lags.size(), fill::zeros); + + // Create map level graph and county level multigraph + Graph g = list_to_graph(adj_list); + Multigraph cg = county_graph(g, counties); + + int V = g.size(); + double total_pop = sum(pop); + + // Loading Info + if (verbosity >= 1) { + Rcout.imbue(std::locale("")); + Rcout << std::fixed << std::setprecision(0); + if(!split_district_only){ + Rcout << "GENERALIZED SEQUENTIAL MONTE CARLO\n"; + }else{ + Rcout << "SEQUENTIAL MONTE CARLO\n"; + } + Rcout << "Sampling " << M << " " << V << "-unit "; + Rcout << "maps with " << N << " districts and population between " + << lower << " and " << upper << " using " << num_threads << " threads "; + if(!split_district_only){ + Rcout << "and generalized region splits.\n"; + }else{ + Rcout << "and only performing 1-district splits.\n"; + } + if (cg.size() > 1){ + Rcout << "Ensuring no more than " << N - 1 << " splits of the " + << cg.size() << " administrative units.\n"; + } + } + + + std::vector plans_vec(M, Plan(V, N, total_pop, split_district_only)); + std::vector new_plans_vec(M, Plan(V, N, total_pop, split_district_only)); // New plans + + + // Define output variables that must always be created + + // This is N-1 by M where [i][j] is the index of the parent of particle j on step i + // ie the index of the previous plan that was sampled and used to create particle j on step i + std::vector> parent_index_mat(N-1, std::vector (M, -1)); + + // This is N-1 by M where [i][j] is the index of the original (first) ancestor of particle j on step i + std::vector> original_ancestor_mat(N-1, std::vector (M, -1)); + + // This is N-1 by M where [i][j] is the number of tries it took to form particle j on iteration i + // Inclusive of the final step. ie if succeeds in one try it would be 1 + std::vector> draw_tries_mat(N-1, std::vector (M, -1)); + + // This is N-1 by M where [i][j] is the number of times particle j from the + // previous round was sampled and unsuccessfully split on iteration i so this + // does not count successful sample then split + std::vector> parent_unsuccessful_tries_mat(N-1, std::vector (M, 0)); + + // This is N-1 by M where [i][j] is the log incremental weight of particle j on step i + std::vector> log_incremental_weights_mat(N-1, std::vector (M, -1.0)); + + // This is N-1 by M where [i][j] is the normalized weight of particle j on step i + std::vector> normalized_weights_mat(N-1, std::vector (M, -1.0)); + + + // Tracks the acceptance rate - total number of tries over M - for each round + std::vector acceptance_rates(N-1, -1.0); + + // Tracks the effective sample size for the weights of each round + std::vector n_eff(N-1, -1.0); + + // Tracks the number of unique parent vectors sampled to create the next round + std::vector nunique_parents_vec(N-1, -1); + + // Tracks the number of unique ancestors left at each step + std::vector nunique_original_ancestors_vec(N-1, -1); + + + // Declare variables whose size will depend on whether or not we're in + // diagnostic mode or not + std::vector>> plan_region_ids_mat; + std::vector>> plan_d_vals_mat; + std::vector>> plan_region_order_added_mat; + + + + + // If diagnostic mode track stuff from every round + if(diagnostic_mode){ + // Create info tracking we will pass out at the end + // This is N-1 by M by V where for each n=1,...,N-1 and m=1,...M it maps vertices to integer id + plan_region_ids_mat.resize(N-1, std::vector>( + M, std::vector(V, -1) + )); + + // reserve space for N-2 elements if doing generalized region splits + if(!split_district_only){ + plan_d_vals_mat.reserve(N-2); + } + + // reserve space for N-1 elements + plan_region_order_added_mat.reserve(N-1); + + // This is N-2 by M by 1,2,...N where for each n=1,...,N-1, m=1,...,M it maps the region + // id to the region's d value. So for a given n it is n by M by n+1 + // It stops at N-2 because for N-1 its all 1 + for(int n = 1; n < N-1; n++){ + if(!split_district_only){ + plan_d_vals_mat.push_back( + std::vector>(M, std::vector(n+1, -1)) + ); + } + + plan_region_order_added_mat.push_back( + std::vector>(M, std::vector(n+1, -1)) + ); + } + // We care about order added for every split so also do final one + plan_region_order_added_mat.push_back( + std::vector>(M, std::vector(N, -1)) + ); + + // M by N-1 where for each m=1,...M it maps region ids to region labels in a plan + // final_plan_region_labels.resize( + // M, std::vector(N, "MISSING") + // ); + + }else{ // else only track for final round + // Create info tracking we will pass out at the end + // This is M by V where for each m=1,...M it maps vertices to integer id for plan + plan_region_ids_mat.resize(1, std::vector>( + M, std::vector(V, -1) + )); + plan_region_order_added_mat.resize(1, std::vector>( + M, std::vector(N, -1) + )); + } + + + + + // Start off all the unnormalized weights at 1 + std::vector unnormalized_sampling_weights(M, 1.0); + + + // Create a threadpool + + RcppThread::ThreadPool pool(num_threads); + + std::string bar_fmt = "Split [{cli::pb_current}/{cli::pb_total}] {cli::pb_bar} | ETA{cli::pb_eta}"; + RObject bar = cli_progress_bar(N-1, cli_config(false, bar_fmt.c_str())); + + // Now for each run through split the map + try { + for(int n=0; n 1){ + Rprintf("Iteration %d \n", n+1); + } + + + + // For the first iteration we need to pass a special previous ancestor thing + if(n == 0){ + std::vector dummy_prev_ancestors(M, 1); + // split the map + generalized_split_maps( + g, counties, cg, pop, + plans_vec, new_plans_vec, + original_ancestor_mat.at(n), + parent_index_mat.at(n), + dummy_prev_ancestors, + unnormalized_sampling_weights, + normalized_weights_mat.at(n), + draw_tries_mat.at(n), + parent_unsuccessful_tries_mat.at(n), + acceptance_rates.at(n), + nunique_parents_vec.at(n), + nunique_original_ancestors_vec.at(n), + ancestors, lags, + lower, upper, target, + k_params.at(n), split_district_only, + pool, + verbosity + ); + + // For the first ancestor one make every ancestor themselves + std::iota (parent_index_mat[0].begin(), parent_index_mat[0].end(), 0); + std::iota (original_ancestor_mat[0].begin(), original_ancestor_mat[0].end(), 0); + }else{ + // split the map and we can use the previous original ancestor matrix row + generalized_split_maps( + g, counties, cg, pop, + plans_vec, new_plans_vec, + original_ancestor_mat.at(n), + parent_index_mat.at(n), + original_ancestor_mat[n-1], + unnormalized_sampling_weights, + normalized_weights_mat.at(n), + draw_tries_mat.at(n), + parent_unsuccessful_tries_mat.at(n), + acceptance_rates.at(n), + nunique_parents_vec.at(n), + nunique_original_ancestors_vec.at(n), + ancestors, lags, + lower, upper, target, + k_params.at(n), split_district_only, + pool, + verbosity + ); + } + + if (verbosity == 1 && CLI_SHOULD_TICK){ + cli_progress_set(bar, n); + } + Rcpp::checkUserInterrupt(); + + + // compute log incremental weights and sampling weights for next round + get_all_plans_log_gsmc_weights( + pool, + g, + new_plans_vec, + split_district_only, + log_incremental_weights_mat.at(n), + unnormalized_sampling_weights, + target, + pop_temper + ); + + + // compute effective sample size + n_eff.at(n) = compute_n_eff(log_incremental_weights_mat.at(n)); + + // Now update the diagnostic info if needed, region labels, dval column of the matrix + if(diagnostic_mode && n < N-2 && !split_district_only){ // record if in diagnostic mode and generalized splits + for(int j=0; j #include -#include -#include "wilson.h" -#include "tree_op.h" -#include "map_calc.h" + #include "redist_types.h" +#include "splitting.h" +#include "merging.h" +#include "weights.h" diff --git a/src/splitting.cpp b/src/splitting.cpp index 406ba3404..2901abbc7 100644 --- a/src/splitting.cpp +++ b/src/splitting.cpp @@ -150,6 +150,8 @@ bool get_edge_to_cut(Tree &ust, int root, int V = static_cast(region_ids.size()); + + // Rcout << "For " << region_id_to_split << " Total pop is " << total_pop << " and d_nk is " << num_final_districts << "\n"; // create list that points to parents & computes population below each vtx @@ -174,6 +176,7 @@ bool get_edge_to_cut(Tree &ust, int root, Rcout << "Root vertex is not in region to split!"; } + // Now loop over all valid edges to cut for (int i = 1; i <= V; i++) { // 1-indexing here // Ignore any vertex not in this region or the root vertex as we wont be cutting those @@ -234,7 +237,6 @@ bool get_edge_to_cut(Tree &ust, int root, } - // if less than k_param candidates immediately reject if((int) candidates.size() < k_param){ return false; @@ -259,6 +261,7 @@ bool get_edge_to_cut(Tree &ust, int root, if ((*siblings)[j] == cut_at) break; } + // remove edge from tree siblings->erase(siblings->begin()+j); parent[cut_at] = -1; @@ -360,6 +363,7 @@ void update_plan_from_cut( // Now update the region level information + // updates the new region 1 plan.region_dvals.at(new_region1_id) = new_region1_dval; plan.region_added_order.at(new_region1_id) = new_region1_order_added_num; @@ -371,6 +375,7 @@ void update_plan_from_cut( plan.region_added_order.at(new_region2_id) = new_region2_order_added_num; plan.region_pops.at(new_region2_id) = new_region2_pop; + // If district split only then set the remainder region as well if(split_district_only){ // update the remainder region value if needed diff --git a/src/splitting_inspection.cpp b/src/splitting_inspection.cpp index f8eeee45e..9680afa86 100644 --- a/src/splitting_inspection.cpp +++ b/src/splitting_inspection.cpp @@ -154,6 +154,74 @@ List perform_a_valid_region_split( } +// Does a preset number of merge split steps +List perform_merge_split_steps( + List adj_list, const arma::uvec &counties, const arma::uvec &pop, + int k_param, + double target, double lower, double upper, + int N, int num_regions, int num_districts, + std::vector region_ids, std::vector region_dvals, + std::vector region_pops, + bool split_district_only, int num_merge_split_steps, + bool verbose +){ + // unpack control params + Graph g = list_to_graph(adj_list); + Multigraph cg = county_graph(g, counties); + int V = g.size(); + double total_pop = sum(pop); + + // Create a plan object + Plan plan = Plan(V, N, total_pop); + + // fill in the plan + plan.num_regions = num_regions; + plan.num_districts = num_districts; + plan.num_multidistricts = plan.num_regions - plan.num_districts; + plan.region_ids = region_ids; + plan.region_dvals = region_dvals; + plan.region_pops = region_pops; + + // TODO FIX THIS but need to create this + plan.region_added_order.resize(plan.num_regions, -1); + std::iota(plan.region_added_order.begin(), plan.region_added_order.end(), 1); + + + if(verbose){ + plan.Rprint(); + } + + // Create tree related stuff + int root; + Tree ust = init_tree(V); + Tree pre_split_ust = init_tree(V); + std::vector visited(V); + std::vector ignore(V, false); + + + // now do merge split + int num_successes = run_merge_split_step( + g, counties, cg, pop, + split_district_only, + ust, k_param, + plan, num_merge_split_steps, + lower, upper, target, + visited, ignore + ); + + List out = List::create( + _["region_dvals"] = plan.region_dvals, + _["plan_vertex_ids"] = plan.region_ids, + _["pops"] = plan.region_pops, + _["num_regions"] = plan.num_regions, + _["num_districts"] = plan.num_districts, + _["num_success"] = num_successes + ); + + return out; +} + + /* * New splitter test function. Performs cut tree function on the entire map */ diff --git a/src/splitting_inspection.h b/src/splitting_inspection.h index ec2a58007..afc4f65e0 100644 --- a/src/splitting_inspection.h +++ b/src/splitting_inspection.h @@ -18,6 +18,7 @@ #include "map_calc.h" #include "active_dev.h" #include "splitting.h" +#include "merging.h" // [[Rcpp::export]] @@ -31,4 +32,16 @@ List perform_a_valid_region_split( bool split_district_only, bool verbose ); +// [[Rcpp::export]] +List perform_merge_split_steps( + List adj_list, const arma::uvec &counties, const arma::uvec &pop, + int k_param, + double target, double lower, double upper, + int N, int num_regions, int num_districts, + std::vector region_ids, std::vector region_dvals, + std::vector region_pops, + bool split_district_only, int num_merge_split_steps, + bool verbose +); + #endif diff --git a/task_tracker.md b/task_tracker.md index a6e3a3c9a..66b10cec3 100644 --- a/task_tracker.md +++ b/task_tracker.md @@ -8,8 +8,15 @@ Note all of the diagnostic information is accurately updated to account for a re # ----- ACTIVE TASKS ----- -**Make get_edge_to_cut only need vertex region id vector** -Change `get_edge_to_cut` to only take in a vector of vertex region ids and a max dval to try instead of taking in a plan. This will make merge split easier by allowing you to just pass in a vertex region id vector with two regions merged without having to bother editing the actual plan. +**Create MH Ratio Calculator** +Create a function (along with helpers as needed) that computes the MH ratio for valid new proposed plans. + +**Create Full Pass through** +In the `smc_and_mcmc.cpp` file make a function analagous to `optimal_gsmc_plans` that runs it for the whole thing. For now just stick with doing MCMC moves with a set frequency with the amount set to 1/acceptance rate. Need to think about what kind of diagnostics to keep + +**Create Function for Diagnostics** +Since both the smc and smc with merge split share some diagnostics its probably better to write a function to create the vectors shared between them to avoid duplicate code. + **Create Diagnostics Object for cpp code** To avoid needing to pass so many different parameters in the function header consider creating a new diagnostic class in cpp which serves as a wrapper for all the diagnostic things that are collected in the `split_maps` function. @@ -38,6 +45,10 @@ Need to more cleanly seperate diagnostic information from stuff in the final sam # ----- COMPLETED TASKS ----- +**Make get_edge_to_cut only need vertex region id vector* - DONE 11/2/2024** +Task: Change `get_edge_to_cut` to only take in a vector of vertex region ids and a max dval to try instead of taking in a plan. This will make merge split easier by allowing you to just pass in a vertex region id vector with two regions merged without having to bother editing the actual plan. + +Comments after completion: Successfully changed that for merge split stuff. **Seperate New Region ID Creation from Update Edges - DONE 11/1/2024** Task: To make code more resuable for merge split stuff make it so that creating IDs/resizing attributes in the plan is done outside the `update_plan_from_cut` function and instead that function only handles updating the plan. From 76147e6ce77d5c38f33fcdfaa3ceb90513d45348 Mon Sep 17 00:00:00 2001 From: "Philip W. O'Sullivan" Date: Sat, 2 Nov 2024 16:44:28 -0400 Subject: [PATCH 031/324] built out skeleton for adding merge split steps --- NAMESPACE | 1 + R/RcppExports.R | 27 +++++ src/RcppExports.cpp | 23 +++++ src/optimal_gsmc.cpp | 1 + src/smc_and_mcmc.cpp | 233 +++++++++++++++++++++++++++---------------- src/smc_and_mcmc.h | 34 +++++++ task_tracker.md | 4 +- 7 files changed, 238 insertions(+), 85 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 6492c81d1..e1a2bd7ee 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -105,6 +105,7 @@ export(min_move_parity) export(muni_splits) export(number_by) export(optimal_gsmc_plans) +export(optimal_gsmc_with_merge_split_plans) export(partisan_metrics) export(pl) export(plan_distances) diff --git a/R/RcppExports.R b/R/RcppExports.R index 003be5e62..569db8cec 100644 --- a/R/RcppExports.R +++ b/R/RcppExports.R @@ -216,6 +216,33 @@ smc_plans <- function(N, l, counties, pop, n_distr, target, lower, upper, rho, d .Call(`_redist_smc_plans`, N, l, counties, pop, n_distr, target, lower, upper, rho, districts, n_drawn, n_steps, constraints, control, verbosity) } +#' Uses gsmc method with optimal weights and merge split steps to generate a sample of `M` plans in `c++` +#' +#' Using the procedure outlined in this function uses Sequential +#' Monte Carlo (SMC) methods to generate a sample of `M` plans +#' +#' @title Run Optimalgsmc with Merge Split +#' +#' @param N The number of districts the final plans will have +#' @param adj_list A 0-indexed adjacency list representing the undirected graph +#' which represents the underlying map the plans are to be drawn on +#' @param counties Vector of county labels of each vertex in `g` +#' @param pop A vector of the population associated with each vertex in `g` +#' @param target Ideal population of a valid district. This is what deviance is calculated +#' relative to +#' @param lower Acceptable lower bounds on a valid district's population +#' @param upper Acceptable upper bounds on a valid district's population +#' @param M The number of plans (samples) to draw +#' @param k_param The k parameter from the SMC algorithm, you choose among the top k_param edges +#' @param control Named list of additional parameters. +#' @param num_threads The number of threads the threadpool should use +#' @param verbosity What level of detail to print out while the algorithm is +#' running +#' @export +optimal_gsmc_with_merge_split_plans <- function(N, adj_list, counties, pop, target, lower, upper, M, control, ncores = -1L, verbosity = 3L, diagnostic_mode = FALSE) { + .Call(`_redist_optimal_gsmc_with_merge_split_plans`, N, adj_list, counties, pop, target, lower, upper, M, control, ncores, verbosity, diagnostic_mode) +} + splits <- function(dm, community, nd, max_split) { .Call(`_redist_splits`, dm, community, nd, max_split) } diff --git a/src/RcppExports.cpp b/src/RcppExports.cpp index be6480ff3..c40a27bc2 100644 --- a/src/RcppExports.cpp +++ b/src/RcppExports.cpp @@ -699,6 +699,28 @@ BEGIN_RCPP return rcpp_result_gen; END_RCPP } +// optimal_gsmc_with_merge_split_plans +List optimal_gsmc_with_merge_split_plans(int N, List adj_list, const arma::uvec& counties, const arma::uvec& pop, double target, double lower, double upper, int M, List control, int ncores, int verbosity, bool diagnostic_mode); +RcppExport SEXP _redist_optimal_gsmc_with_merge_split_plans(SEXP NSEXP, SEXP adj_listSEXP, SEXP countiesSEXP, SEXP popSEXP, SEXP targetSEXP, SEXP lowerSEXP, SEXP upperSEXP, SEXP MSEXP, SEXP controlSEXP, SEXP ncoresSEXP, SEXP verbositySEXP, SEXP diagnostic_modeSEXP) { +BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< int >::type N(NSEXP); + Rcpp::traits::input_parameter< List >::type adj_list(adj_listSEXP); + Rcpp::traits::input_parameter< const arma::uvec& >::type counties(countiesSEXP); + Rcpp::traits::input_parameter< const arma::uvec& >::type pop(popSEXP); + Rcpp::traits::input_parameter< double >::type target(targetSEXP); + Rcpp::traits::input_parameter< double >::type lower(lowerSEXP); + Rcpp::traits::input_parameter< double >::type upper(upperSEXP); + Rcpp::traits::input_parameter< int >::type M(MSEXP); + Rcpp::traits::input_parameter< List >::type control(controlSEXP); + Rcpp::traits::input_parameter< int >::type ncores(ncoresSEXP); + Rcpp::traits::input_parameter< int >::type verbosity(verbositySEXP); + Rcpp::traits::input_parameter< bool >::type diagnostic_mode(diagnostic_modeSEXP); + rcpp_result_gen = Rcpp::wrap(optimal_gsmc_with_merge_split_plans(N, adj_list, counties, pop, target, lower, upper, M, control, ncores, verbosity, diagnostic_mode)); + return rcpp_result_gen; +END_RCPP +} // splits IntegerVector splits(IntegerMatrix dm, IntegerVector community, int nd, int max_split); RcppExport SEXP _redist_splits(SEXP dmSEXP, SEXP communitySEXP, SEXP ndSEXP, SEXP max_splitSEXP) { @@ -921,6 +943,7 @@ static const R_CallMethodDef CallEntries[] = { {"_redist_k_smallest", (DL_FUNC) &_redist_k_smallest, 2}, {"_redist_k_biggest", (DL_FUNC) &_redist_k_biggest, 2}, {"_redist_smc_plans", (DL_FUNC) &_redist_smc_plans, 15}, + {"_redist_optimal_gsmc_with_merge_split_plans", (DL_FUNC) &_redist_optimal_gsmc_with_merge_split_plans, 12}, {"_redist_splits", (DL_FUNC) &_redist_splits, 4}, {"_redist_dist_cty_splits", (DL_FUNC) &_redist_dist_cty_splits, 3}, {"_redist_perform_a_valid_region_split", (DL_FUNC) &_redist_perform_a_valid_region_split, 16}, diff --git a/src/optimal_gsmc.cpp b/src/optimal_gsmc.cpp index c7128e678..116298974 100644 --- a/src/optimal_gsmc.cpp +++ b/src/optimal_gsmc.cpp @@ -10,6 +10,7 @@ + //' Uses gsmc method to generate a sample of `M` plans in `c++` //' //' Using the procedure outlined in this function uses Sequential diff --git a/src/smc_and_mcmc.cpp b/src/smc_and_mcmc.cpp index 0d8bb010a..6739c6c40 100644 --- a/src/smc_and_mcmc.cpp +++ b/src/smc_and_mcmc.cpp @@ -55,6 +55,37 @@ List optimal_gsmc_with_merge_split_plans( int ms_freq = 7; int total_ms_steps = (N-1)/ms_freq; + // TODO: In future the merge_split_step_vec should just be passed in as a parameter + + // total number of steps to run + int total_steps = N-1 + total_ms_steps; + + + // This is an N-1 + total_ms_steps length vector where [i] being true means that + // step should be a merge split step and false means normal SMC + std::vector merge_split_step_vec(total_steps, false); + + // For now just set every `ms_freq` value to merge split + for (int i = 1; i <= total_ms_steps; i++) + { + merge_split_step_vec.at(i*ms_freq - 1) = true; + } + + int cnnt = std::count(merge_split_step_vec.begin(), merge_split_step_vec.end(), true); + + Rprintf("Expected %d and real count was %d\n!", total_ms_steps, cnnt); + + // return List::create( + // _["merge_split_steps"] = merge_split_step_vec, + // _["count"] = cnnt + // ); + + if(merge_split_step_vec.at(0)){ + REprintf("BIG PROBLEM SAYS FIRST STEP SHOULD BE MCMC!!!\n"); + }; + + + umat ancestors(M, lags.size(), fill::zeros); // Create map level graph and county level multigraph @@ -94,40 +125,46 @@ List optimal_gsmc_with_merge_split_plans( // Define output variables that must always be created + + // TODO: All of these are actually total_steps instead of N-1 even though right now the + // merge split steps don't record anything + // This is N-1 by M where [i][j] is the index of the parent of particle j on step i // ie the index of the previous plan that was sampled and used to create particle j on step i - std::vector> parent_index_mat(N-1, std::vector (M, -1)); + std::vector> parent_index_mat(total_steps, std::vector (M, -1)); // This is N-1 by M where [i][j] is the index of the original (first) ancestor of particle j on step i - std::vector> original_ancestor_mat(N-1, std::vector (M, -1)); + std::vector> original_ancestor_mat(total_steps, std::vector (M, -1)); // This is N-1 by M where [i][j] is the number of tries it took to form particle j on iteration i // Inclusive of the final step. ie if succeeds in one try it would be 1 - std::vector> draw_tries_mat(N-1, std::vector (M, -1)); + std::vector> draw_tries_mat(total_steps, std::vector (M, -1)); // This is N-1 by M where [i][j] is the number of times particle j from the // previous round was sampled and unsuccessfully split on iteration i so this // does not count successful sample then split - std::vector> parent_unsuccessful_tries_mat(N-1, std::vector (M, 0)); + std::vector> parent_unsuccessful_tries_mat(total_steps, std::vector (M, 0)); + + // Tracks the number of unique parent vectors sampled to create the next round + std::vector nunique_parents_vec(total_steps, -1); + + // Tracks the number of unique ancestors left at each step + std::vector nunique_original_ancestors_vec(total_steps, -1); + // This is N-1 by M where [i][j] is the log incremental weight of particle j on step i - std::vector> log_incremental_weights_mat(N-1, std::vector (M, -1.0)); + std::vector> log_incremental_weights_mat(total_steps, std::vector (M, -1.0)); // This is N-1 by M where [i][j] is the normalized weight of particle j on step i - std::vector> normalized_weights_mat(N-1, std::vector (M, -1.0)); + std::vector> normalized_weights_mat(total_steps, std::vector (M, -1.0)); // Tracks the acceptance rate - total number of tries over M - for each round - std::vector acceptance_rates(N-1, -1.0); + std::vector acceptance_rates(total_steps, -1.0); // Tracks the effective sample size for the weights of each round - std::vector n_eff(N-1, -1.0); - - // Tracks the number of unique parent vectors sampled to create the next round - std::vector nunique_parents_vec(N-1, -1); + std::vector n_eff(total_steps, -1.0); - // Tracks the number of unique ancestors left at each step - std::vector nunique_original_ancestors_vec(N-1, -1); // Declare variables whose size will depend on whether or not we're in @@ -143,42 +180,41 @@ List optimal_gsmc_with_merge_split_plans( if(diagnostic_mode){ // Create info tracking we will pass out at the end // This is N-1 by M by V where for each n=1,...,N-1 and m=1,...M it maps vertices to integer id - plan_region_ids_mat.resize(N-1, std::vector>( + plan_region_ids_mat.resize(total_steps, std::vector>( M, std::vector(V, -1) )); - // reserve space for N-2 elements if doing generalized region splits + // reserve space for total_steps-1 elements if doing generalized region splits if(!split_district_only){ - plan_d_vals_mat.reserve(N-2); + plan_d_vals_mat.reserve(total_steps-1); } - // reserve space for N-1 elements - plan_region_order_added_mat.reserve(N-1); - - // This is N-2 by M by 1,2,...N where for each n=1,...,N-1, m=1,...,M it maps the region - // id to the region's d value. So for a given n it is n by M by n+1 - // It stops at N-2 because for N-1 its all 1 - for(int n = 1; n < N-1; n++){ - if(!split_district_only){ + // reserve space for total_steps number of elements + plan_region_order_added_mat.reserve(total_steps); + + + int num_regions = 2; + for (size_t i = 0; i < total_steps; i++){ + // Rprintf("Iteration %zu and Number of Regions is %d\n", i, num_regions); + // If doing generalized splits then make num regions by M vector to + // track dvals whenever its less than N regions + if(!split_district_only && num_regions < N){ plan_d_vals_mat.push_back( - std::vector>(M, std::vector(n+1, -1)) + std::vector>(M, std::vector(num_regions, -1)) ); } plan_region_order_added_mat.push_back( - std::vector>(M, std::vector(n+1, -1)) + std::vector>(M, std::vector(num_regions, -1)) ); - } - // We care about order added for every split so also do final one - plan_region_order_added_mat.push_back( - std::vector>(M, std::vector(N, -1)) - ); - // M by N-1 where for each m=1,...M it maps region ids to region labels in a plan - // final_plan_region_labels.resize( - // M, std::vector(N, "MISSING") - // ); + // if its not an MCMC step increase the number of regions + if(!merge_split_step_vec.at(i)){ + num_regions++; + } + } + }else{ // else only track for final round // Create info tracking we will pass out at the end // This is M by V where for each m=1,...M it maps vertices to integer id for plan @@ -190,8 +226,13 @@ List optimal_gsmc_with_merge_split_plans( )); } - - + // return List::create( + // _["merge_split_steps"] = merge_split_step_vec, + // _["count"] = cnnt, + // _["region_dvals_mat_list"] = plan_d_vals_mat, + // _["region_order_added_list"] = plan_region_order_added_mat, + // _["region_ids_mat_list"] = plan_region_ids_mat + // ); // Start off all the unnormalized weights at 1 std::vector unnormalized_sampling_weights(M, 1.0); @@ -202,37 +243,45 @@ List optimal_gsmc_with_merge_split_plans( RcppThread::ThreadPool pool(num_threads); std::string bar_fmt = "Split [{cli::pb_current}/{cli::pb_total}] {cli::pb_bar} | ETA{cli::pb_eta}"; - RObject bar = cli_progress_bar(N-1, cli_config(false, bar_fmt.c_str())); + RObject bar = cli_progress_bar(total_steps, cli_config(false, bar_fmt.c_str())); + + // For record tracking + Rprintf("There should be %d Merge split steps!\n", total_ms_steps); + + // counts the number of smc steps + int smc_step_num = 0; // Now for each run through split the map try { - for(int n=0; n 1){ - Rprintf("Iteration %d \n", n+1); + if(merge_split_step_vec[step_num]){ + Rprintf("Iteration %d: Merge Split Step %d \n", step_num+1, step_num - smc_step_num + 1); + }else{ + Rprintf("Iteration %d: SMC Step %d \n", step_num+1, smc_step_num + 1); + } } - - // For the first iteration we need to pass a special previous ancestor thing - if(n == 0){ + if(step_num == 0){ std::vector dummy_prev_ancestors(M, 1); // split the map generalized_split_maps( g, counties, cg, pop, plans_vec, new_plans_vec, - original_ancestor_mat.at(n), - parent_index_mat.at(n), + original_ancestor_mat.at(step_num), + parent_index_mat.at(step_num), dummy_prev_ancestors, unnormalized_sampling_weights, - normalized_weights_mat.at(n), - draw_tries_mat.at(n), - parent_unsuccessful_tries_mat.at(n), - acceptance_rates.at(n), - nunique_parents_vec.at(n), - nunique_original_ancestors_vec.at(n), + normalized_weights_mat.at(step_num), + draw_tries_mat.at(step_num), + parent_unsuccessful_tries_mat.at(step_num), + acceptance_rates.at(step_num), + nunique_parents_vec.at(step_num), + nunique_original_ancestors_vec.at(step_num), ancestors, lags, lower, upper, target, - k_params.at(n), split_district_only, + k_params.at(smc_step_num), split_district_only, pool, verbosity ); @@ -240,31 +289,46 @@ List optimal_gsmc_with_merge_split_plans( // For the first ancestor one make every ancestor themselves std::iota (parent_index_mat[0].begin(), parent_index_mat[0].end(), 0); std::iota (original_ancestor_mat[0].begin(), original_ancestor_mat[0].end(), 0); - }else{ + smc_step_num++; + }else if(merge_split_step_vec[step_num]){ // check if its a merge split step + // Rprintf("%d!\n", step_num); + + // Copy results from previous step + original_ancestor_mat.at(step_num) = original_ancestor_mat.at(step_num-1); + parent_index_mat.at(step_num) = parent_index_mat.at(step_num-1); + draw_tries_mat.at(step_num) = draw_tries_mat.at(step_num-1); + parent_unsuccessful_tries_mat.at(step_num) = parent_unsuccessful_tries_mat.at(step_num-1); + acceptance_rates.at(step_num) = acceptance_rates.at(step_num-1); + nunique_parents_vec.at(step_num) = nunique_parents_vec.at(step_num-1); + nunique_original_ancestors_vec.at(step_num) = nunique_original_ancestors_vec.at(step_num-1); + + + }else{ // else just run a normal smc step // split the map and we can use the previous original ancestor matrix row - generalized_split_maps( - g, counties, cg, pop, - plans_vec, new_plans_vec, - original_ancestor_mat.at(n), - parent_index_mat.at(n), - original_ancestor_mat[n-1], - unnormalized_sampling_weights, - normalized_weights_mat.at(n), - draw_tries_mat.at(n), - parent_unsuccessful_tries_mat.at(n), - acceptance_rates.at(n), - nunique_parents_vec.at(n), - nunique_original_ancestors_vec.at(n), - ancestors, lags, - lower, upper, target, - k_params.at(n), split_district_only, - pool, - verbosity - ); + generalized_split_maps( + g, counties, cg, pop, + plans_vec, new_plans_vec, + original_ancestor_mat.at(step_num), + parent_index_mat.at(step_num), + original_ancestor_mat.at(step_num-1), + unnormalized_sampling_weights, + normalized_weights_mat.at(step_num), + draw_tries_mat.at(step_num), + parent_unsuccessful_tries_mat.at(step_num), + acceptance_rates.at(step_num), + nunique_parents_vec.at(step_num), + nunique_original_ancestors_vec.at(step_num), + ancestors, lags, + lower, upper, target, + k_params.at(smc_step_num), split_district_only, + pool, + verbosity + ); + smc_step_num++; } if (verbosity == 1 && CLI_SHOULD_TICK){ - cli_progress_set(bar, n); + cli_progress_set(bar, step_num); } Rcpp::checkUserInterrupt(); @@ -275,7 +339,7 @@ List optimal_gsmc_with_merge_split_plans( g, new_plans_vec, split_district_only, - log_incremental_weights_mat.at(n), + log_incremental_weights_mat.at(step_num), unnormalized_sampling_weights, target, pop_temper @@ -283,24 +347,24 @@ List optimal_gsmc_with_merge_split_plans( // compute effective sample size - n_eff.at(n) = compute_n_eff(log_incremental_weights_mat.at(n)); + n_eff.at(step_num) = compute_n_eff(log_incremental_weights_mat.at(step_num)); // Now update the diagnostic info if needed, region labels, dval column of the matrix - if(diagnostic_mode && n < N-2 && !split_district_only){ // record if in diagnostic mode and generalized splits + if(diagnostic_mode && step_num < total_steps -1 && !split_district_only){ // record if in diagnostic mode and generalized splits for(int j=0; j this function uses Sequential +//' Monte Carlo (SMC) methods to generate a sample of `M` plans +//' +//' @title Run Optimalgsmc with Merge Split +//' +//' @param N The number of districts the final plans will have +//' @param adj_list A 0-indexed adjacency list representing the undirected graph +//' which represents the underlying map the plans are to be drawn on +//' @param counties Vector of county labels of each vertex in `g` +//' @param pop A vector of the population associated with each vertex in `g` +//' @param target Ideal population of a valid district. This is what deviance is calculated +//' relative to +//' @param lower Acceptable lower bounds on a valid district's population +//' @param upper Acceptable upper bounds on a valid district's population +//' @param M The number of plans (samples) to draw +//' @param k_param The k parameter from the SMC algorithm, you choose among the top k_param edges +//' @param control Named list of additional parameters. +//' @param num_threads The number of threads the threadpool should use +//' @param verbosity What level of detail to print out while the algorithm is +//' running +//' @export +// [[Rcpp::export]] +List optimal_gsmc_with_merge_split_plans( + int N, List adj_list, + const arma::uvec &counties, const arma::uvec &pop, + double target, double lower, double upper, + int M, // M is Number of particles aka number of different plans + List control, // control has pop temper, and k parameter value, and whether only district splits are allowed + int ncores = -1, int verbosity = 3, bool diagnostic_mode = false +); + + #endif diff --git a/task_tracker.md b/task_tracker.md index 66b10cec3..c22524a1f 100644 --- a/task_tracker.md +++ b/task_tracker.md @@ -8,11 +8,13 @@ Note all of the diagnostic information is accurately updated to account for a re # ----- ACTIVE TASKS ----- + + **Create MH Ratio Calculator** Create a function (along with helpers as needed) that computes the MH ratio for valid new proposed plans. **Create Full Pass through** -In the `smc_and_mcmc.cpp` file make a function analagous to `optimal_gsmc_plans` that runs it for the whole thing. For now just stick with doing MCMC moves with a set frequency with the amount set to 1/acceptance rate. Need to think about what kind of diagnostics to keep +In the `smc_and_mcmc.cpp` file make a function analagous to `optimal_gsmc_plans` that runs it for the whole thing. For now just stick with doing MCMC moves with a set frequency with the amount set to 1/acceptance rate. Need to think about what kind of diagnostics to keep. Right now I think it should just be the number of attempts made and how many were successful along with storing the plans and weights at the end **Create Function for Diagnostics** Since both the smc and smc with merge split share some diagnostics its probably better to write a function to create the vectors shared between them to avoid duplicate code. From 9e16744b135922e66a481d8f77786faa8364dd4a Mon Sep 17 00:00:00 2001 From: "Philip W. O'Sullivan" Date: Sun, 3 Nov 2024 01:59:41 -0400 Subject: [PATCH 032/324] almost done merge split. Just need to add MH ratio rejection step --- R/diagnostics.R | 137 ++++++ R/redist_optimal_gsmc_ms.R | 538 +++++++++++++++++++++ R/redist_plans.R | 2 +- man/optimal_gsmc_with_merge_split_plans.Rd | 56 +++ src/merging.cpp | 151 ++++-- src/merging.h | 22 +- src/smc_and_mcmc.cpp | 82 ++-- src/splitting.cpp | 4 +- src/splitting_inspection.cpp | 7 +- src/weights.cpp | 44 ++ src/weights.h | 6 +- 11 files changed, 969 insertions(+), 80 deletions(-) create mode 100644 R/redist_optimal_gsmc_ms.R create mode 100644 man/optimal_gsmc_with_merge_split_plans.Rd diff --git a/R/diagnostics.R b/R/diagnostics.R index e045cbd38..3e9abcc16 100644 --- a/R/diagnostics.R +++ b/R/diagnostics.R @@ -217,6 +217,7 @@ summary.redist_plans <- function(object, district = 1L, all_runs = TRUE, vi_max }else if(algo == "basic_smc"){ algo_label <- "basicSMC" } + pop_lb <- attr(object, "pop_bounds")[1] pop_ub <- attr(object, "pop_bounds")[3] @@ -342,6 +343,142 @@ summary.redist_plans <- function(object, district = 1L, all_runs = TRUE, vi_max code <- str_glue("plot(, rowMeans(as.matrix({name}) == ))") cli::cat_line(" ", cli::code_highlight(code, "Material")) } + } else if(algo %in% c("gsmc_ms", "smc_ms")) { + if(algo == "gsmc_ms"){ + algo_label <- "gSMC Merge Split" + }else if(algo == "smc_ms"){ + algo_label <- "SMC Merge Split" + } + + pop_lb <- attr(object, "pop_bounds")[1] + pop_ub <- attr(object, "pop_bounds")[3] + + cli_text("{.strong {algo_label}:} {fmt_comma(n_samp)} sampled plans of {n_distr} + districts on {fmt_comma(nrow(plans_m))} units with a population between {fmt_comma(pop_lb)} and {fmt_comma(pop_ub)} + with {diagn$num_ms_steps} merge split steps throughout.") + cli_text("{.arg pop_temper}={format(all_diagn[[1]]$pop_temper, digits=3)}") + cat("\n") + + cli_text("Plan diversity 80% range: {div_rg[1]} to {div_rg[2]}") + if (div_bad) cli::cli_alert_danger("{.strong WARNING:} Low plan diversity") + cat("\n") + + cols <- names(object) + addl_cols <- setdiff(cols, c("chain", "draw", "district", "total_pop")) + warn_converge <- FALSE + if ("chain" %in% cols && length(addl_cols) > 0) { + idx <- seq_len(n_samp) + if ("district" %in% cols) idx <- as.integer(district) + (idx - 1)*n_distr + + const_cols <- vapply(addl_cols, function(col) { + x <- object[[col]][idx] + all(is.na(x)) || all(x == x[1]) || + any(tapply(x, object[['chain']][idx], FUN = function(z) length(unique(z))) == 1) + }, numeric(1)) + addl_cols <- addl_cols[!const_cols] + + rhats <- vapply(addl_cols, function(col) { + x <- object[[col]][idx] + na_omit <- !is.na(x) + diag_rhat(x[na_omit], object$chain[idx][na_omit]) + }, numeric(1)) + names(rhats) <- addl_cols + cat("R-hat values for summary statistics:\n") + rhats_p <- vapply(rhats, function(x){ + ifelse(x < 1.05, sprintf('%.3f', x), paste0('\U274C', round(x, 3))) + }, FUN.VALUE = character(1)) + print(noquote(rhats_p)) + + if (any(na.omit(rhats) >= 1.05)) { + warn_converge <- TRUE + cli::cli_alert_danger("{.strong WARNING:} {algo} runs have not converged.") + } + cat("\n") + + } + + run_dfs <- list() + n_runs <- length(all_diagn) + warn_bottlenecks <- FALSE + + for (i in seq_len(n_runs)) { + diagn <- all_diagn[[i]] + n_samp <- nrow(diagn$ancestors) + + run_dfs[[i]] <- tibble(n_eff = c(diagn$step_n_eff, diagn$n_eff), + eff = c(diagn$step_n_eff, diagn$n_eff)/n_samp, + accept_rate = c(diagn$accept_rate, NA), + sd_log_wgt = diagn$sd_lp, + max_unique = diagn$unique_survive, + est_k = c(diagn$est_k, NA), + unique_original = c(diagn$nunique_original_ancestors, NA)) + + tbl_print <- as.data.frame(run_dfs[[i]]) + min_n <- max(0.05*n_samp, min(0.4*n_samp, 100)) + bottlenecks <- dplyr::coalesce(with(tbl_print, pmin(max_unique, n_eff) < min_n), FALSE) + warn_bottlenecks <- warn_bottlenecks || any(bottlenecks) + tbl_print$bottleneck <- ifelse(bottlenecks, " * ", "") + tbl_print$n_eff <- with(tbl_print, + str_glue("{fmt_comma(n_eff)} ({sprintf('%0.1f%%', 100*eff)})")) + tbl_print$eff <- NULL + tbl_print$accept_rate <- with(tbl_print, sprintf("%0.1f%%", 100*accept_rate)) + max_pct <- with(tbl_print, max_unique/(-n_samp * expm1(-1))) + tbl_print$max_unique <- with(tbl_print, + str_glue("{fmt_comma(max_unique)} ({sprintf('%3.0f%%', 100*max_pct)})")) + + # + + names(tbl_print) <- c("Eff. samples (%)", "Acc. rate", + "Log wgt. sd", " Max. unique", + "k", "Unique Original Ancestors", "") + rownames(tbl_print) <- c( + paste("Split", seq_len(nrow(tbl_print) - 1), diagn$step_split_types), + "Resample") + + if (i == 1 || isTRUE(all_runs)) { + cli_text("Sampling diagnostics for {algo_label} run {i} of {n_runs} ({fmt_comma(n_samp)} samples)") + print(tbl_print, digits = 2) + cat("\n") + } + } + out <- bind_rows(run_dfs) + + cli::cli_li(cli::col_grey(" + Watch out for low effective samples, very low acceptance rates (less than 1%), + large std. devs. of the log weights (more than 3 or so), + and low numbers of unique plans. + R-hat values for summary statistics should be between 1 and 1.05.")) + + if (div_bad) { + cli::cli_li("{.strong Low diversity:} Check for potential bottlenecks. + Increase the number of samples. + Examine the diversity plot with + `hist(plans_diversity({name}), breaks=24)`. + Consider weakening or removing constraints, or increasing + the population tolerance. If the acceptance rate drops + quickly in the final splits, try increasing + {.arg pop_temper} by 0.01.") + } + if (warn_converge) { + cli::cli_li("{.strong {algo_label} convergence:} Increase the number of samples. + If you are experiencing low plan diversity or bottlenecks as well, + address those issues first.") + } + if (warn_bottlenecks) { + cli::cli_li("(*) {.strong Bottlenecks found:} Consider weakening or removing + constraints, or increasing the population tolerance. + If the acceptance rate drops quickly in the final splits, + try increasing {.arg pop_temper} by 0.01. + If the weight variance (Log wgt. sd) increases steadily + or is particularly large for the \"Resample\" step, + consider increasing {.arg seq_alpha}. + To visualize what geographic areas may be causing problems, + try running the following code. Highlighted areas are + those that may be causing the bottleneck.\n\n") + code <- str_glue("plot(, rowMeans(as.matrix({name}) == ))") + cli::cat_line(" ", cli::code_highlight(code, "Material")) + + } } else if (algo %in% c("mergesplit", 'flip')) { if (algo == 'mergesplit') { diff --git a/R/redist_optimal_gsmc_ms.R b/R/redist_optimal_gsmc_ms.R new file mode 100644 index 000000000..9e3785274 --- /dev/null +++ b/R/redist_optimal_gsmc_ms.R @@ -0,0 +1,538 @@ +##################################################### +# Author: Philip O'Sullivan +# Institution: Harvard University +# Date Created: 2024/08/18 +# Purpose: tidy R wrapper to run gSMC with merge split steps +# redistricting code +#################################################### + + +#' OptimalgSMC with merge split Redistricting Sampler +#' +#' @param k_params Either a single value to use as the splitting parameter for +#' every round or a vector of length N-1 where each value is the one to use for +#' a split. +#' @param multiprocess Whether or not to launch multiple processes (sometimes +#' better to disable to avoid using too much memory.) +#' +#' @return `redist_smc` returns a [redist_plans] object containing the simulated +#' plans. +#' +#' @export +redist_optimal_gsmc_ms <- function(state_map, M, counties = NULL, + k_params = 6, split_district_only = FALSE, + ms_freq = 7, + resample = TRUE, runs = 1L, + ncores = 0L, multiprocess=TRUE, + pop_temper = 0, + verbose = FALSE, silent = FALSE, diagnostic_mode = FALSE){ + N <- attr(state_map, "ndists") + ndists <- attr(state_map, "ndists") + + # figure out the alg type + if(split_district_only){ + alg_type <- "smc_ms" + }else{ + alg_type <- "gsmc_ms" + } + + # no constraints + constraints <- list() + + + # make controls intput + lags <- 1 + unique(round((N - 1)^0.8*seq(0, 0.7, length.out = 4)^0.9)) + + # check k param imput + if(any(k_params < 1)) { + cli_abort("K parameter values must be all at least 1.") + } + + # if just a single number then repeat it + if(length(k_params) == 1 && floor(k_params) == k_params){ + k_params <- rep(k_params, N-1) + }else if(length(k_params) != N-1){ + cli_abort("K parameter input must be either 1 value or N-1!") + }else if(any(floor(k_params) != k_params)){ + # if either the length is not N-1 or its not all integers then throw + # error + cli_abort("K parameter values must be all integers") + } + + # create merge split parameter information + + # there are N-1 splits so for now just do it + total_smc_steps <- N-1 + total_ms_steps <- floor(total_smc_steps/ms_freq) + + # total number of steps to run + total_steps <- N - 1 + total_ms_steps + + # TODO: In future the merge_split_step_vec should just be passed in as a parameter + merge_split_step_vec <- rep(FALSE, total_steps) + + # For now just set every `ms_freq` value to merge split + for(i in 1:total_ms_steps){ + # remember 1 indexed + merge_split_step_vec[i*ms_freq] = TRUE + } + + + control <- list( + lags=lags, + pop_temper = pop_temper, + k_params = k_params, + split_district_only = split_district_only, + merge_split_step_vec = merge_split_step_vec + ) + + est_k_params <- k_params + for (index in which(merge_split_step_vec)) { + # Insert a duplicate by concatenating parts of the vector + est_k_params <- c(est_k_params[1:index], est_k_params[index], est_k_params[(index + 1):length(est_k_params)]) + } + + # verbosity stuff + verbosity <- 1 + if (verbose) verbosity <- 3 + if (silent) verbosity <- 0 + + + # get the map in adjacency form + map <- validate_redist_map(state_map) + V <- nrow(state_map) + adj_list <- get_adj(state_map) + + + + + counties <- rlang::eval_tidy(rlang::enquo(counties), map) + if (is.null(counties)) { + counties <- rep(1, V) + } else { + if (any(is.na(counties))) + cli_abort("County vector must not contain missing values.") + + # handle discontinuous counties + component <- contiguity(adj_list, vctrs::vec_group_id(counties)) + counties <- dplyr::if_else(component > 1, + paste0(as.character(counties), "-", component), + as.character(counties)) %>% + as.factor() %>% + as.integer() + if (any(component > 1)) { + cli_warn("Counties were not contiguous; expect additional splits.") + } + } + + + + + # get population stuff + pop_bounds <- attr(map, "pop_bounds") + pop <- map[[attr(map, "pop_col")]] + if (any(pop >= pop_bounds[3])) { + too_big <- as.character(which(pop >= pop_bounds[3])) + cli_abort(c("Unit{?s} {too_big} ha{?ve/s/ve} + population larger than the district target.", + "x" = "Redistricting impossible.")) + } + + # compute lags thing + lags <- 1 + unique(round((N - 1)^0.8*seq(0, 0.7, length.out = 4)^0.9)) + + + # set up parallel + ncores_max <- parallel::detectCores() + ncores_runs <- min(ncores_max, runs) + ncores_per <- as.integer(ncores) + if (ncores_per == 0) { + if (M/100*length(adj_list)/200 < 20) { + ncores_per <- 1L + } else { + ncores_per <- floor(ncores_max/ncores_runs) + } + } + + # if sequentially + if(!multiprocess){ + # either max cores if + if(ncores == 0){ + ncores_per = ncores_max + }else{ + ncores_per = ncores + } + } + + + if (ncores_runs > 1 && multiprocess) { + `%oper%` <- `%dorng%` + of <- if (Sys.info()[["sysname"]] == "Windows") { + tempfile(pattern = paste0("smc_", substr(Sys.time(), 1, 10)), fileext = ".txt") + } else { + "" + } + + if (!silent) + cl <- makeCluster(ncores_runs, outfile = of, methods = FALSE, + useXDR = .Platform$endian != "little") + else + cl <- makeCluster(ncores_runs, methods = FALSE, + useXDR = .Platform$endian != "little") + doParallel::registerDoParallel(cl, cores = ncores_runs) + on.exit(stopCluster(cl)) + } else { + `%oper%` <- `%do%` + } + + + + t1 <- Sys.time() + all_out <- foreach(chain = seq_len(runs), .inorder = FALSE, .packages="redist") %oper% { + + + run_verbosity <- if (chain == 1 || !multiprocess) verbosity else 0 + t1_run <- Sys.time() + + + algout <- redist::optimal_gsmc_with_merge_split_plans( + N=N, + adj_list=adj_list, + counties=counties, + pop=pop, + target=pop_bounds[2], + lower=pop_bounds[1], + upper=pop_bounds[3], + M=M, + control = control, + ncores = as.integer(ncores_per), + verbosity=run_verbosity, + diagnostic_mode=diagnostic_mode) + + + + if (length(algout) == 0) { + cli::cli_process_done() + cli::cli_process_done() + } + + # convert the order added results into an actual list of arrays where + # for each list entry n and column entry i that is a vector of length n + # mapping the region id to its sorted order. The way to interpret is + # the index where algout$region_order_added_list[[test_n]][,test_i] == r + # is the new index region id r was mapped to. + # In other words which(algout$region_order_added_list[[n]][,i] == r) is + # the new ordered value r should be set to + algout$region_order_added_list <- lapply( + algout$region_order_added_list, + function(x) matrix(unlist(x), ncol = length(x), byrow = FALSE) + ) |> lapply( + function(a_l) apply(a_l, 2, order)) + + + + # make each element of region_ids_mat_list a V by M matrix + algout$region_ids_mat_list <- lapply( + algout$region_ids_mat_list, + function(x) matrix(unlist(x), ncol = length(x), byrow = FALSE) + 1 + ) + + # make each element of region_dvals_mat_list a n by M matrix + algout$region_dvals_mat_list <- lapply( + algout$region_dvals_mat_list, + function(x) matrix(unlist(x), ncol = length(x), byrow = FALSE) + ) + + if(diagnostic_mode && !split_district_only){ + # update the labels to reflect the order regions were added for each step + for (n in 1:(total_steps-1)) { + for (i in 1:M) { + # reorder d values. Recall + # algout$region_order_added_list[[n]][,i] permutes the original + # region label vector to its new ordered form so its ok here + algout$region_dvals_mat_list[[n]][,i] <- algout$region_dvals_mat_list[[n]][,i][ + algout$region_order_added_list[[n]][,i] + ] + # reorder the labels themselves + # the reason for the order call again is it ensures that if + # r is the original region id and r_new is the new ordered one + # then + # order(algout$region_order_added_list[[1]][,i])[r] = r_new + algout$region_ids_mat_list[[n]][,i] <- order( + algout$region_order_added_list[[n]][,i] + )[ + algout$region_ids_mat_list[[n]][,i] + ] + + } + } + # do final step + for (i in 1:M) { + # reorder the labels themselves + # the reason for the order call again is it ensures that if + # r is the original region id and r_new is the new ordered one + # then + # order(algout$region_order_added_list[[1]][,i])[r] = r_new + algout$region_ids_mat_list[[total_steps]][,i] <- order( + algout$region_order_added_list[[total_steps]][,i] + )[ + algout$region_ids_mat_list[[total_steps]][,i] + ] + + } + + # add a plans matrix as the final output because first + # N-2 are previous results + algout$plans <- algout$region_ids_mat_list[[total_steps]] + }else if(diagnostic_mode){ + # if diagnostic but only one district splits we only care about + # labels + # update the labels to reflect the order regions were added for each step + for (n in 1:(total_steps)) { + for (i in 1:M) { + # reorder the labels themselves + # the reason for the order call again is it ensures that if + # r is the original region id and r_new is the new ordered one + # then + # order(algout$region_order_added_list[[1]][,i])[r] = r_new + algout$region_ids_mat_list[[n]][,i] <- order( + algout$region_order_added_list[[n]][,i] + )[ + algout$region_ids_mat_list[[n]][,i] + ] + + } + } + + # add a plans matrix as the final output because first + # N-2 are previous results + algout$plans <- algout$region_ids_mat_list[[total_steps]] + }else{ + # relabel the region ids so they are all in order + for (i in 1:M) { + # reorder the labels themselves + # the reason for the order call again is it ensures that if + # r is the original region id and r_new is the new ordered one + # then + # order(algout$region_order_added_list[[1]][,i])[r] = r_new + algout$region_ids_mat_list[[1]][,i] <- order( + algout$region_order_added_list[[1]][,i] + )[ + algout$region_ids_mat_list[[1]][,i] + ] + + } + + # Just add first element since not diagnostic mode the first N-2 + # steps were not tracked + algout$plans <- algout$region_ids_mat_list[[1]] + + # make the region_ids_mat_list input just null since there's nothing else + algout$region_ids_mat_list <- NULL + algout$region_dvals_mat_list <- NULL + } + + # now we can remove the relabelling info + algout$region_order_added_list <- NULL + gc() + + # make the M x num_ms_steps by + algout$merge_split_success_mat <- matrix( + unlist(algout$merge_split_success_counts), + ncol = length(algout$merge_split_success_counts), + byrow = FALSE + ) + algout$merge_split_success_counts <- NULL + + # turn it into a character vector + algout$step_split_types <- ifelse( + algout$merge_split_steps, "ms", "smc" + ) + + num_ms_steps <- sum( + algout$step_split_types == "ms" + ) + + # make original ancestor matrix + # add 1 for R indexing + algout$original_ancestors_mat <- matrix( + unlist(algout$original_ancestors), + ncol = length(algout$original_ancestors), + byrow = FALSE) + 1 + algout$original_ancestors <- NULL + + # make parent mat into matrix + # add 1 for R indexing + algout$parent_index <- matrix( + unlist(algout$parent_index), + ncol = length(algout$parent_index), + byrow = FALSE) + 1 + + # make draws tries into a matrix + algout$draw_tries_mat <- matrix( + unlist(algout$draw_tries_mat), + ncol = length(algout$draw_tries_mat), + byrow = FALSE) + + # make parent unsuccessful tries into a matrix + algout$parent_unsuccessful_tries_mat <- matrix( + unlist(algout$parent_unsuccessful_tries_mat), + ncol = length(algout$parent_unsuccessful_tries_mat), + byrow = FALSE) + + # make parent succesful tries matrix counting the number of + # times a parent index was successfully sampled + parent_successful_tries_mat <- apply( + algout$parent_index, 2, tabulate, nbins = M + ) + + # make the log incremental weights into a matrix + algout$log_incremental_weights_mat <- matrix( + unlist(algout$log_incremental_weights_mat), + ncol = length(algout$log_incremental_weights_mat), + byrow = FALSE) + + + # pull out the log weights + lr <- algout$log_incremental_weights_mat[,total_steps] + + wgt <- exp(lr - mean(lr)) + n_eff <- length(wgt)*mean(wgt)^2/mean(wgt^2) + + + if (any(is.na(lr))) { + cli_abort(c("Sampling probabilities have been corrupted.", + "*" = "Check that none of your constraint weights are too large. + The output of constraint functions multiplied by the weight + should generally fall in the -5 to 5 range.", + "*" = "If you are using custom constraints, make sure that your + constraint function handles all edge cases and never returns + {.val {NA}} or {.val {Inf}}", + "*" = "If you are not using any constraints, please call + {.code rlang::trace_back()} and file an issue at + {.url https://github.com/alarm-redist/redist/issues/new}")) + } + + + if (resample) { + normalized_wgts <- wgt/sum(wgt) + n_eff <- 1/sum(normalized_wgts^2) + + rs_idx <- resample_lowvar(normalized_wgts) + n_unique <- dplyr::n_distinct(rs_idx) + # makes algout$plans[i] now equal to algout$plans[rs_idx[i]] + algout$plans <- algout$plans[, rs_idx, drop = FALSE] + # now adjust for the resampling + algout$ancestors <- algout$ancestors[rs_idx, , drop = FALSE] + + # adjust for the resampling + # NOTE: IN FUTURE THIS SHOULD BE SEPERATED INTO FINAL SAMPLE INFO + algout$original_ancestors_mat <- algout$original_ancestors_mat[rs_idx, , drop = FALSE] + algout$parent_index <- algout$original_ancestors_mat[rs_idx, , drop = FALSE] + + if(diagnostic_mode){ + # makes algout$final_region_labs[i] now equal to algout$final_region_labs[rs_idx[i]] + # to account for resampling + # algout$final_region_labs[,rs_idx, drop = FALSE] + } + + #TODO probably need to adjust the rest of these as well + storage.mode(algout$ancestors) <- "integer" + } + + storage.mode(algout$plans) <- "integer" + t2_run <- Sys.time() + + + if (!is.nan(n_eff) && n_eff/M <= 0.05) + cli_warn(c("Less than 5% resampling efficiency.", + "*" = "Increase the number of samples.", + "*" = "Consider weakening or removing constraints.", + "i" = "If sampling efficiency drops precipitously in the final + iterations, population balance is likely causing a bottleneck. + Try increasing {.arg pop_temper} by 0.01.", + "i" = "If sampling efficiency declines steadily across iterations, + adjusting {.arg seq_alpha} upward may help a bit.")) + + # add the numerically stable weights back + algout$wgt <- wgt + + # add diagnostic stuff + algout$l_diag <- list( + n_eff = n_eff, + step_n_eff = algout$step_n_eff, + adapt_k_thresh = .99, # adapt_k_thresh, NEED TO DEAL WITH + est_k = est_k_params, # algout$est_k, + accept_rate = algout$acceptance_rates, + sd_lp = c( + apply(algout$log_incremental_weights_mat, 2, sd), sd(lr) + ), + sd_temper = rep(NA, total_steps), # algout$sd_temper, + unique_survive = c(algout$nunique_parent_indices, n_unique), + ancestors = algout$ancestors, + seq_alpha = .99, + pop_temper = pop_temper, + runtime = as.numeric(t2_run - t1_run, units = "secs"), + nunique_original_ancestors = algout$nunique_original_ancestors, + parent_index_mat = algout$parent_index, + original_ancestors_mat = algout$original_ancestors_mat, + region_dvals_mat_list = algout$region_dvals_mat_list, + log_incremental_weights_mat = algout$log_incremental_weights_mat, + region_ids_mat_list = algout$region_ids_mat_list, + draw_tries_mat = algout$draw_tries_mat, + parent_unsuccessful_tries_mat = algout$parent_unsuccessful_tries_mat, + parent_successful_tries_mat = parent_successful_tries_mat, + rs_idx = rs_idx, + merge_split_steps = algout$merge_split_steps, + step_split_types = algout$step_split_types, + merge_split_success_mat = algout$merge_split_success_mat, + merge_split_attempt_counts = algout$merge_split_attempt_counts, + num_ms_steps = num_ms_steps + ) + + + algout + + } + + if (verbosity >= 2) { + t2 <- Sys.time() + cli_text("{format(M*runs, big.mark=',')} plans sampled in + {format(t2-t1, digits=2)}") + } + + + plans <- do.call(cbind, lapply(all_out, function(x) x$plans)) + wgt <- do.call(c, lapply(all_out, function(x) x$wgt)) + l_diag <- lapply(all_out, function(x) x$l_diag) + n_dist_act <- dplyr::n_distinct(plans[, 1]) # actual number (for partial plans) + + + + + out <- new_redist_plans(plans, map, alg_type, wgt, resample, + ndists = N, + n_eff = all_out[[1]]$n_eff, + compactness = 1, + constraints = constraints, + version = packageVersion("redist"), + diagnostics = l_diag, + pop_bounds = pop_bounds) + + + + if (runs > 1) { + out <- mutate(out, chain = rep(seq_len(runs), each = n_dist_act*M)) %>% + dplyr::relocate('chain', .after = "draw") + } + + + + exist_name <- attr(map, "existing_col") + if (!is.null(exist_name) && !isFALSE(ref_name) && N == final_dists) { + ref_name <- if (!is.null(ref_name)) ref_name else exist_name + out <- add_reference(out, map[[exist_name]], ref_name) + } + + out +} diff --git a/R/redist_plans.R b/R/redist_plans.R index e2299ed75..678dc85f8 100644 --- a/R/redist_plans.R +++ b/R/redist_plans.R @@ -11,7 +11,7 @@ # plans has n_precinct columns and n_sims rows # map is a redist_map -# algorithm is one of "smc" or "mcmc" +# algorithm is one of "smc" or "mcmc" or "gsmc_ms # wgt is the weights before any resampling or truncation # ... will depend on the algorithm new_redist_plans <- function(plans, map, algorithm, wgt, resampled = TRUE, ndists = attr(map, "ndists"), ...) { diff --git a/man/optimal_gsmc_with_merge_split_plans.Rd b/man/optimal_gsmc_with_merge_split_plans.Rd new file mode 100644 index 000000000..bd586794f --- /dev/null +++ b/man/optimal_gsmc_with_merge_split_plans.Rd @@ -0,0 +1,56 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/RcppExports.R +\name{optimal_gsmc_with_merge_split_plans} +\alias{optimal_gsmc_with_merge_split_plans} +\title{Run Optimalgsmc with Merge Split} +\usage{ +optimal_gsmc_with_merge_split_plans( + N, + adj_list, + counties, + pop, + target, + lower, + upper, + M, + control, + ncores = -1L, + verbosity = 3L, + diagnostic_mode = FALSE +) +} +\arguments{ +\item{N}{The number of districts the final plans will have} + +\item{adj_list}{A 0-indexed adjacency list representing the undirected graph +which represents the underlying map the plans are to be drawn on} + +\item{counties}{Vector of county labels of each vertex in \code{g}} + +\item{pop}{A vector of the population associated with each vertex in \code{g}} + +\item{target}{Ideal population of a valid district. This is what deviance is calculated +relative to} + +\item{lower}{Acceptable lower bounds on a valid district's population} + +\item{upper}{Acceptable upper bounds on a valid district's population} + +\item{M}{The number of plans (samples) to draw} + +\item{control}{Named list of additional parameters.} + +\item{verbosity}{What level of detail to print out while the algorithm is +running \if{html}{\out{}}} + +\item{k_param}{The k parameter from the SMC algorithm, you choose among the top k_param edges} + +\item{num_threads}{The number of threads the threadpool should use} +} +\description{ +Uses gsmc method with optimal weights and merge split steps to generate a sample of \code{M} plans in \verb{c++} +} +\details{ +Using the procedure outlined in \if{html}{\out{}} this function uses Sequential +Monte Carlo (SMC) methods to generate a sample of \code{M} plans +} diff --git a/src/merging.cpp b/src/merging.cpp index c539729aa..bea6b575d 100644 --- a/src/merging.cpp +++ b/src/merging.cpp @@ -16,56 +16,59 @@ double pick_adj_regions_to_merge( return 3.4; } - -int run_merge_split_step( +int run_merge_split_step_on_a_plan( Graph const &g, const uvec &counties, Multigraph &cg, const uvec &pop, - bool split_district_only, - Tree &ust, int k_param, - Plan &plan, int nsteps_to_run, - double &lower, double upper, double target, - std::vector &visited, std::vector &ignore -){ + bool const split_district_only, + int const k_param, + Plan &plan, int const nsteps_to_run, + double const lower, double const upper, double const target) +{ + int V = plan.V; + Tree ust = init_tree(V); + std::vector visited(V); + std::vector ignore(V); + // initialize number of successes to zero int num_successes = 0; // tracks bool changed_plan = true; - // initialize a region level graph - Graph rg; - // get all pairs of adjacent regions - std::set> adj_region_pairs_set; std::vector> adj_pairs_vec; - // stores the pair of adjacent regions to merge - std::pair adj_pair; // Seed the random generator with the current time std::random_device rd; std::mt19937 gen(rd()); std::uniform_int_distribution distrib; - + + // Create the Unif[0,1] value + std::random_device rd_u; // Seed for randomness + std::mt19937 gen_u(rd_u()); // Mersenne Twister generator + std::uniform_real_distribution<> unif_rv(0.0, 1.0); // Uniform distribution on [0, 1] + // get draw by doing unif_rv(rd_u); + for (int j = 0; j < nsteps_to_run; j++){ // Rprintf("Iter %d!\n", j); // If plan change from previous step then recreate the region graph and // adjacent pairslist and update tree stuff if(changed_plan){ - rg = get_region_graph(g, plan); - adj_region_pairs_set.clear(); - for (int u = 0; u < rg.size(); u++){ - // iterate over neighbors - for(auto v: rg.at(u)){ - // store the edges such that smaller vertex is always first - if (u < v) { - adj_region_pairs_set.emplace(u, v); - } else { - adj_region_pairs_set.emplace(v, u); - } - } + std::vector valid_regions; + if(split_district_only){ + valid_regions.resize(plan.num_regions, false); + valid_regions.at(plan.remainder_region) = true; + }else{ + valid_regions.resize(plan.num_regions, true); } + // Now convert to vec - adj_pairs_vec.assign(adj_region_pairs_set.begin(), adj_region_pairs_set.end()); + get_all_adj_pairs( + g, adj_pairs_vec, + plan.region_ids, + valid_regions + ); + // Define the range for random index distrib = std::uniform_int_distribution(0, adj_pairs_vec.size() - 1); } @@ -77,6 +80,9 @@ int run_merge_split_step( int region1_id = adj_pair.first; int region2_id = adj_pair.second; + int old_region1_dval = plan.region_dvals.at(region1_id); + int old_region2_dval = plan.region_dvals.at(region2_id); + // just make the first id the merged id int merged_id = region1_id; // create vector of vertex ids @@ -90,7 +96,7 @@ int run_merge_split_step( } // now create the merged dval and population - int merged_dval = plan.region_dvals.at(region1_id) + plan.region_dvals.at(region2_id); + int merged_dval = old_region1_dval + old_region2_dval; double merged_pop = plan.region_pops.at(region1_id) + plan.region_pops.at(region2_id); @@ -105,7 +111,7 @@ int run_merge_split_step( int result = sample_sub_ust(g, ust, plan.V, root, visited, ignore, pop, lower, upper, counties, cg); // Return unsuccessful if tree not drawn if (result != 0){ - REprintf("SPANNING TREE NOT DRAWN SOMETHING WENT REALLY WRONG!!\n"); + // REprintf("SPANNING TREE NOT DRAWN SOMETHING WENT REALLY WRONG!!\n"); changed_plan = false; continue; } @@ -115,7 +121,8 @@ int run_merge_split_step( int new_region1_dval, new_region2_dval; double new_region1_pop, new_region2_pop; - bool successful_edge_found; + bool successful_edge_found; + bool proposal_accepted = false; int max_potential_d; @@ -135,16 +142,45 @@ int run_merge_split_step( new_region1_tree_root, new_region1_dval, new_region1_pop, new_region2_tree_root, new_region2_dval, new_region2_pop); + // If successful then do uniform thing if(successful_edge_found){ - Rprintf( - "Yippeee! Succesfully merged region %d and %d to make " - "a new region with %d dval and %.1f population. It was " - "then split into (R%d, %d, %.1f) and (R%d, %d, %.1f) \n", - region1_id, region2_id,merged_dval,merged_pop, - region1_id, new_region1_dval, new_region1_pop, - region2_id, new_region2_dval, new_region2_pop - ); + double u_draw = unif_rv(rd_u); + double mh_ratio = .99; + proposal_accepted = u_draw <= mh_ratio; + } + + if(proposal_accepted){ + // Rprintf( + // "Yippeee! Succesfully merged region %d and %d to make " + // "a new region with %d dval and %.1f population. It was " + // "then split into (R%d, %d, %.1f) and (R%d, %d, %.1f) \n", + // region1_id, region2_id,merged_dval,merged_pop, + // region1_id, new_region1_dval, new_region1_pop, + // region2_id, new_region2_dval, new_region2_pop + // ); num_successes++; + // check if we need to change the number of districts or multidistricts + + // Check if region 1 changed from multidist to district + if(old_region1_dval > 1 && new_region1_dval == 1){ + plan.num_multidistricts--; + plan.num_districts++; + }else if(old_region1_dval == 1 && new_region1_dval > 1){ + // check if region 1 changed from district to multidistrict + plan.num_multidistricts++; + plan.num_districts--; + } + + // Check if region 2 changed from multidist to district + if(old_region2_dval > 1 && new_region2_dval == 1){ + plan.num_multidistricts--; + plan.num_districts++; + }else if(old_region2_dval == 1 && new_region2_dval > 1){ + // check if region 2 changed from district to multidistrict + plan.num_multidistricts++; + plan.num_districts--; + } + // now update it using the old ids update_plan_from_cut( ust, plan, split_district_only, @@ -152,7 +188,9 @@ int run_merge_split_step( new_region2_tree_root, new_region2_dval, new_region2_pop, region1_id, region2_id ); - Rprintf("out of cut update!\n"); + + + // changed plan successfully changed_plan = true; }else{ @@ -165,3 +203,36 @@ int run_merge_split_step( return num_successes; } + +void run_merge_split_step_on_all_plans( + RcppThread::ThreadPool &pool, + Graph const &g, const uvec &counties, Multigraph &cg, const uvec &pop, + std::vector &plans_vec, + bool const split_district_only, int const k_param, + int const nsteps_to_run, + double const lower, double const upper, double const target, + std::vector &success_count_vec +){ + int M = (int) plans_vec.size(); + + // Parallel thread pool where all objects in memory shared by default + pool.parallelFor(0, M, [&] (int i) { + // Create variables needed for each + + // store the number of succesful runs + success_count_vec.at(i) = run_merge_split_step_on_a_plan( + g, counties, cg, pop, + split_district_only, + k_param, + plans_vec.at(i), nsteps_to_run, + lower, upper, target + ); + + }); + + // Wait for all the threads to finish + pool.wait(); + + return; +} + diff --git a/src/merging.h b/src/merging.h index 10cb8fe53..6b4428fb3 100644 --- a/src/merging.h +++ b/src/merging.h @@ -20,15 +20,25 @@ #include "map_calc.h" #include "redist_types.h" #include "splitting.h" +#include "weights.h" -int run_merge_split_step( +int run_merge_split_step_on_a_plan( Graph const &g, const uvec &counties, Multigraph &cg, const uvec &pop, - bool split_district_only, - Tree &ust, int k_param, - Plan &plan, int nsteps_to_run, - double &lower, double upper, double target, - std::vector &visited, std::vector &ignore + bool const split_district_only, + int const k_param, + Plan &plan, int const nsteps_to_run, + double const lower, double const upper, double const target +); + +void run_merge_split_step_on_all_plans( + RcppThread::ThreadPool &pool, + Graph const &g, const uvec &counties, Multigraph &cg, const uvec &pop, + std::vector &plans_vec, + bool const split_district_only, int const k_param, + int const nsteps_to_run, + double const lower, double const upper, double const target, + std::vector &success_count_vec ); #endif \ No newline at end of file diff --git a/src/smc_and_mcmc.cpp b/src/smc_and_mcmc.cpp index 6739c6c40..02e0c3a45 100644 --- a/src/smc_and_mcmc.cpp +++ b/src/smc_and_mcmc.cpp @@ -48,44 +48,45 @@ List optimal_gsmc_with_merge_split_plans( std::vector k_params = as>(control["k_params"]); // Whether or not to only do district splits bool split_district_only = as(control["split_district_only"]); + // This is a total_ms_steps by M vector where [s][i] is the number of + // successful merge splits performed for plan i on merge split round s + std::vector merge_split_step_vec = as>(control["merge_split_step_vec"]); + double pop_temper = as(control["pop_temper"]); // there are N-1 splits so for now just do it - int ms_freq = 7; - int total_ms_steps = (N-1)/ms_freq; - - // TODO: In future the merge_split_step_vec should just be passed in as a parameter - + int total_smc_steps = N-1; + int total_ms_steps = std::count(merge_split_step_vec.begin(), merge_split_step_vec.end(), true); + // total number of steps to run - int total_steps = N-1 + total_ms_steps; + int total_steps = total_smc_steps + total_ms_steps; + // Merge split related diagnostics - // This is an N-1 + total_ms_steps length vector where [i] being true means that - // step should be a merge split step and false means normal SMC - std::vector merge_split_step_vec(total_steps, false); + // For each merge split step this counts the number of attempts that were made + std::vector num_merge_split_attempts_vec(total_ms_steps, -1); - // For now just set every `ms_freq` value to merge split - for (int i = 1; i <= total_ms_steps; i++) - { - merge_split_step_vec.at(i*ms_freq - 1) = true; - } + // This is a total_ms_steps by M vector where [s][i] is the number of + // successful merge splits performed for plan i on merge split round s + std::vector> merge_split_successes_mat(total_ms_steps, + std::vector (M, -1) + ); - int cnnt = std::count(merge_split_step_vec.begin(), merge_split_step_vec.end(), true); - Rprintf("Expected %d and real count was %d\n!", total_ms_steps, cnnt); + + Rprintf("Running %d merge split steps!\n!", total_ms_steps); // return List::create( // _["merge_split_steps"] = merge_split_step_vec, // _["count"] = cnnt // ); + // Make sure first merge split argument isn't true if(merge_split_step_vec.at(0)){ - REprintf("BIG PROBLEM SAYS FIRST STEP SHOULD BE MCMC!!!\n"); + throw std::invalid_argument("The first entry of merge_split_step_vec cannot be true."); }; - - umat ancestors(M, lags.size(), fill::zeros); // Create map level graph and county level multigraph @@ -166,7 +167,6 @@ List optimal_gsmc_with_merge_split_plans( std::vector n_eff(total_steps, -1.0); - // Declare variables whose size will depend on whether or not we're in // diagnostic mode or not std::vector>> plan_region_ids_mat; @@ -174,8 +174,6 @@ List optimal_gsmc_with_merge_split_plans( std::vector>> plan_region_order_added_mat; - - // If diagnostic mode track stuff from every round if(diagnostic_mode){ // Create info tracking we will pass out at the end @@ -250,6 +248,7 @@ List optimal_gsmc_with_merge_split_plans( // counts the number of smc steps int smc_step_num = 0; + int merge_split_step_num = 0; // Now for each run through split the map try { @@ -292,17 +291,44 @@ List optimal_gsmc_with_merge_split_plans( smc_step_num++; }else if(merge_split_step_vec[step_num]){ // check if its a merge split step // Rprintf("%d!\n", step_num); + // run merge split + // Set the number of steps to run at 1 over previous stage acceptance rate + int nsteps_to_run = std::ceil(1/acceptance_rates.at(step_num-1)) * std::max(merge_split_step_num,1); + num_merge_split_attempts_vec.at(merge_split_step_num) = nsteps_to_run; + + run_merge_split_step_on_all_plans( + pool, + g, counties, cg, pop, + new_plans_vec, + split_district_only, k_params.at(smc_step_num), + nsteps_to_run, + lower, upper, target, + merge_split_successes_mat.at(merge_split_step_num) + ); + + // set the acceptance rate + int total_ms_successes = std::accumulate( + merge_split_successes_mat.at(merge_split_step_num).begin(), + merge_split_successes_mat.at(merge_split_step_num).end(), + 0); + + int total_ms_attempts = M * nsteps_to_run; + + acceptance_rates.at(step_num) = total_ms_successes / static_cast(total_ms_attempts); + + Rprintf("Ran %d Merge Split Attempts: %d Successes out of %d attempts. Acceptance Rate: %.2f\n", + nsteps_to_run, + total_ms_successes,total_ms_attempts, 100.0*acceptance_rates.at(step_num)); + // Copy results from previous step original_ancestor_mat.at(step_num) = original_ancestor_mat.at(step_num-1); parent_index_mat.at(step_num) = parent_index_mat.at(step_num-1); - draw_tries_mat.at(step_num) = draw_tries_mat.at(step_num-1); + draw_tries_mat.at(step_num) = std::vector(M, nsteps_to_run); parent_unsuccessful_tries_mat.at(step_num) = parent_unsuccessful_tries_mat.at(step_num-1); - acceptance_rates.at(step_num) = acceptance_rates.at(step_num-1); nunique_parents_vec.at(step_num) = nunique_parents_vec.at(step_num-1); nunique_original_ancestors_vec.at(step_num) = nunique_original_ancestors_vec.at(step_num-1); - - + merge_split_step_num++; }else{ // else just run a normal smc step // split the map and we can use the previous original ancestor matrix row generalized_split_maps( @@ -398,7 +424,9 @@ List optimal_gsmc_with_merge_split_plans( _["nunique_original_ancestors"] = nunique_original_ancestors_vec, _["ancestors"] = ancestors, _["step_n_eff"] = n_eff, - _["merge_split_steps"] = merge_split_step_vec + _["merge_split_steps"] = merge_split_step_vec, + _["merge_split_attempt_counts"] = num_merge_split_attempts_vec, + _["merge_split_success_counts"] = merge_split_successes_mat ); return out; diff --git a/src/splitting.cpp b/src/splitting.cpp index 2901abbc7..129cb4ba4 100644 --- a/src/splitting.cpp +++ b/src/splitting.cpp @@ -31,7 +31,9 @@ double choose_multidistrict_to_split( Plan const&plan, int ®ion_id_to_split){ if(plan.num_multidistricts < 1){ - Rprintf("ERROR: Trying to find multidistrict to split when there are none!\n"); + REprintf("ERROR: Trying to find multidistrict to split when there are none!\n"); + region_id_to_split = -1; + return -42; } // count total diff --git a/src/splitting_inspection.cpp b/src/splitting_inspection.cpp index 9680afa86..654104be2 100644 --- a/src/splitting_inspection.cpp +++ b/src/splitting_inspection.cpp @@ -200,13 +200,12 @@ List perform_merge_split_steps( // now do merge split - int num_successes = run_merge_split_step( + int num_successes = run_merge_split_step_on_a_plan( g, counties, cg, pop, split_district_only, - ust, k_param, + k_param, plan, num_merge_split_steps, - lower, upper, target, - visited, ignore + lower, upper, target ); List out = List::create( diff --git a/src/weights.cpp b/src/weights.cpp index de9f0f3cd..37cde5a84 100644 --- a/src/weights.cpp +++ b/src/weights.cpp @@ -39,8 +39,52 @@ double compute_n_eff(const std::vector &log_wgt) { ); } +// only gets regions adjacent to indices where valid_regions is true +void get_all_adj_pairs( + Graph const &g, std::vector> &adj_pairs_vec, + std::vector const &vertex_region_ids, + std::vector const valid_regions +){ + int V = g.size(); + + // Set to put adjacent pairs in + std::set> adj_region_pairs; + // iterate over all vertices in g + for (int i = 0; i < V; i++) { + // Find out which region this vertex corresponds to + int region_num_i = vertex_region_ids.at(i); + + // check if its a valid region and if not continue + if(!valid_regions.at(region_num_i)){ + continue; + } + std::vector nbors = g.at(i); + + // now iterate over its neighbors + for (int nbor : nbors) { + // find which region neighbor corresponds to + int region_num_j = vertex_region_ids.at(nbor); + + // if they are different regions mark matrix true since region i + // and region j are adjacent as they share an edge across + if (region_num_i != region_num_j) { + if (region_num_i < region_num_j) { + adj_region_pairs.emplace(region_num_i, region_num_j); + } else { + adj_region_pairs.emplace(region_num_j, region_num_i); + } + } + } + } + + // Now convert to vec + adj_pairs_vec.assign(adj_region_pairs.begin(), adj_region_pairs.end()); + + return; + +} //' Returns the log of the count of the number of edges across two regions in diff --git a/src/weights.h b/src/weights.h index 5eec7f3b6..40c26d33f 100644 --- a/src/weights.h +++ b/src/weights.h @@ -35,7 +35,11 @@ double compute_n_eff(const std::vector &log_wgt); - +void get_all_adj_pairs( + Graph const &g, std::vector> &adj_pairs_vec, + std::vector const &vertex_region_ids, + std::vector const valid_regions +); //' Computes log unnormalized weights for vector of plans From 083b3b90ed9e0006763ebd5e80f3357e5864b186 Mon Sep 17 00:00:00 2001 From: "Philip W. O'Sullivan" Date: Sun, 3 Nov 2024 02:48:32 -0500 Subject: [PATCH 033/324] mh rejection step now added for generalized split still need to test district only --- src/merging.cpp | 121 ++++++++++++++++++++++++++++++++++--------- src/smc_and_mcmc.cpp | 2 +- src/tree_op.cpp | 13 +++++ src/tree_op.h | 6 +++ src/weights.cpp | 34 ++++++++++++ src/weights.h | 8 +++ task_tracker.md | 1 + 7 files changed, 159 insertions(+), 26 deletions(-) diff --git a/src/merging.cpp b/src/merging.cpp index bea6b575d..ce86e557b 100644 --- a/src/merging.cpp +++ b/src/merging.cpp @@ -37,6 +37,27 @@ int run_merge_split_step_on_a_plan( // get all pairs of adjacent regions std::vector> adj_pairs_vec; + + std::vector> proposal_adj_pairs_vec; + + + // For the first run fill in the adjacency thing + std::vector valid_regions; + if(split_district_only){ + // if splitting district only then only find adjacent to remainder + valid_regions.resize(plan.num_regions, false); + valid_regions.at(plan.remainder_region) = true; + }else{ + valid_regions.resize(plan.num_regions, true); + } + + // Now fill in proposal_adj_pairs_vec + get_all_adj_pairs( + g, proposal_adj_pairs_vec, + plan.region_ids, + valid_regions + ); + // Seed the random generator with the current time std::random_device rd; std::mt19937 gen(rd()); @@ -54,20 +75,8 @@ int run_merge_split_step_on_a_plan( // If plan change from previous step then recreate the region graph and // adjacent pairslist and update tree stuff if(changed_plan){ - std::vector valid_regions; - if(split_district_only){ - valid_regions.resize(plan.num_regions, false); - valid_regions.at(plan.remainder_region) = true; - }else{ - valid_regions.resize(plan.num_regions, true); - } - - // Now convert to vec - get_all_adj_pairs( - g, adj_pairs_vec, - plan.region_ids, - valid_regions - ); + // if plan changed then the proposal becomes the current one + adj_pairs_vec = proposal_adj_pairs_vec; // Define the range for random index distrib = std::uniform_int_distribution(0, adj_pairs_vec.size() - 1); @@ -83,15 +92,36 @@ int run_merge_split_step_on_a_plan( int old_region1_dval = plan.region_dvals.at(region1_id); int old_region2_dval = plan.region_dvals.at(region2_id); - // just make the first id the merged id - int merged_id = region1_id; + // make the merged region the one associated with the larger dval + int merged_id; + + if (old_region1_dval > old_region2_dval) + { + merged_id = region1_id; + }else{ + merged_id = region2_id; + } + + + if(split_district_only) + { + if(merged_id != plan.remainder_region){ + REprintf("ERROROROROR merged id is %d but remainder is %d", + merged_id, plan.remainder_region); + } + } + + + // create vector of vertex ids - std::vector region_ids = plan.region_ids; + std::vector proposal_region_ids = plan.region_ids; // Replace all occurance of region 2 with region 1 for (int v = 0; v < plan.V; v++) { - if(region_ids[v] == region2_id){ - region_ids[v] = region1_id; + if(proposal_region_ids[v] == region2_id){ + proposal_region_ids[v] = merged_id; + } else if(proposal_region_ids[v] == region1_id){ + proposal_region_ids[v] = merged_id; } } @@ -102,7 +132,7 @@ int run_merge_split_step_on_a_plan( // Prepare to draw uniform spanning tree for (int i = 0; i < plan.V; i++){ - ignore[i] = region_ids.at(i) != merged_id; + ignore[i] = proposal_region_ids.at(i) != merged_id; } int root; clear_tree(ust); @@ -116,7 +146,7 @@ int run_merge_split_step_on_a_plan( continue; } - // splitting related params + // splitting related params int new_region1_tree_root, new_region2_tree_root; int new_region1_dval, new_region2_dval; double new_region1_pop, new_region2_pop; @@ -135,7 +165,7 @@ int run_merge_split_step_on_a_plan( // try to get an edge to cut successful_edge_found = get_edge_to_cut(ust, root, k_param, max_potential_d, - pop, region_ids, + pop, proposal_region_ids, merged_id, merged_pop, merged_dval, lower, upper, target, @@ -144,9 +174,49 @@ int run_merge_split_step_on_a_plan( // If successful then do uniform thing if(successful_edge_found){ + + // update just the vector from the tree + // Can just make regions arbitrary I guess + // CODE HERE + + // Now update the two cut portions + // its arbitrary so we made region2_id always the bigger one because we + // gave it the second root + assign_region_just_vertex_vec(ust, proposal_region_ids, new_region1_tree_root, region1_id); + assign_region_just_vertex_vec(ust, proposal_region_ids, new_region2_tree_root, region2_id); + + std::vector valid_regions; + if(split_district_only){ + // if splitting district only then only find adjacent to remainder + // which is region 2 because its the bigger one + valid_regions.resize(plan.num_regions, false); + valid_regions.at(region2_id) = true; + }else{ + valid_regions.resize(plan.num_regions, true); + } + + // get adjacent region pairs under the proposal + get_all_adj_pairs( + g, proposal_adj_pairs_vec, + proposal_region_ids, + valid_regions + ); + double u_draw = unif_rv(rd_u); - double mh_ratio = .99; - proposal_accepted = u_draw <= mh_ratio; + double log_mh_ratio = get_log_mh_ratio( + g, + region1_id, region2_id, + plan.region_ids, + proposal_region_ids, + static_cast(adj_pairs_vec.size()), + static_cast(proposal_adj_pairs_vec.size()) + ); + // Rprintf("(%d and %d and %.3f)\n", + // static_cast(adj_pairs_vec.size()), + // static_cast(proposal_adj_pairs_vec.size()), + // std::exp(log_mh_ratio) + // ); + proposal_accepted = std::log(u_draw) <= log_mh_ratio; } if(proposal_accepted){ @@ -189,7 +259,6 @@ int run_merge_split_step_on_a_plan( region1_id, region2_id ); - // changed plan successfully changed_plan = true; @@ -215,6 +284,8 @@ void run_merge_split_step_on_all_plans( ){ int M = (int) plans_vec.size(); + // create a progress bar + RcppThread::ProgressBar bar(M, 1); // Parallel thread pool where all objects in memory shared by default pool.parallelFor(0, M, [&] (int i) { // Create variables needed for each diff --git a/src/smc_and_mcmc.cpp b/src/smc_and_mcmc.cpp index 02e0c3a45..d5858f7eb 100644 --- a/src/smc_and_mcmc.cpp +++ b/src/smc_and_mcmc.cpp @@ -75,7 +75,7 @@ List optimal_gsmc_with_merge_split_plans( - Rprintf("Running %d merge split steps!\n!", total_ms_steps); + Rprintf("Running %d merge split steps!\n", total_ms_steps); // return List::create( // _["merge_split_steps"] = merge_split_step_vec, diff --git a/src/tree_op.cpp b/src/tree_op.cpp index 4d5d5a203..fec13f9b4 100644 --- a/src/tree_op.cpp +++ b/src/tree_op.cpp @@ -249,6 +249,19 @@ void assign_region(const Tree &ust, Plan &plan, } } + +void assign_region_just_vertex_vec(const Tree &ust, + std::vector ®ion_ids, + int root, + int new_region_num_id) { + region_ids.at(root) = new_region_num_id; + int n_desc = ust.at(root).size(); + for (int i = 0; i < n_desc; i++) { + assign_region_just_vertex_vec(ust, region_ids, ust.at(root).at(i), new_region_num_id); + } +} + + /* * Find the root of a subtree. */ diff --git a/src/tree_op.h b/src/tree_op.h index 5128a0215..ae89bf64b 100644 --- a/src/tree_op.h +++ b/src/tree_op.h @@ -92,6 +92,12 @@ void assign_region(const Tree &ust, Plan &plan, int root, int new_region_num_id); +// TEMP REMOVE LATER +void assign_region_just_vertex_vec(const Tree &ust, + std::vector ®ion_ids, + int root, + int new_region_num_id); + /* * Find the root of a subtree. */ diff --git a/src/weights.cpp b/src/weights.cpp index 37cde5a84..88767d35f 100644 --- a/src/weights.cpp +++ b/src/weights.cpp @@ -143,7 +143,41 @@ void get_all_adj_pairs( return std::log(count); } +// computes log metropolis hastings ratio +double get_log_mh_ratio( + const Graph &g, + const int region1_id, const int region2_id, + const std::vector &old_vertex_region_ids, + const std::vector &new_vertex_region_ids, + const int num_old_adj_regions, const int num_new_adj_regions +){ + // get the log boundary lengths + double old_log_boundary_length = region_log_boundary( + g, old_vertex_region_ids, + region1_id, region2_id + ); + + double new_log_boundary_length = region_log_boundary( + g, new_vertex_region_ids, + region1_id, region2_id + ); + + // Get the merge probability which for now is uniform + double log_old_merge_prob = std::log(1) - std::log( + static_cast(num_old_adj_regions) + ); + double log_new_merge_prob = std::log(1) - std::log( + static_cast(num_new_adj_regions) + ); + + double log_mh_ratio_numerator = old_log_boundary_length + log_old_merge_prob; + double log_mh_ratio_denominator = new_log_boundary_length + log_new_merge_prob; + + double log_mh_ratio = log_mh_ratio_numerator - log_mh_ratio_denominator; + + return log_mh_ratio; +} //' Get the probability the union of two regions was chosen to split diff --git a/src/weights.h b/src/weights.h index 40c26d33f..5c64e217b 100644 --- a/src/weights.h +++ b/src/weights.h @@ -42,6 +42,14 @@ void get_all_adj_pairs( ); +double get_log_mh_ratio( + const Graph &g, + const int region1_id, const int region2_id, + const std::vector &old_vertex_region_ids, + const std::vector &new_vertex_region_ids, + const int num_old_adj_regions, const int num_new_adj_regions +); + //' Computes log unnormalized weights for vector of plans //' //' Using the procedure outlined in this function computes the log diff --git a/task_tracker.md b/task_tracker.md index c22524a1f..8defc78af 100644 --- a/task_tracker.md +++ b/task_tracker.md @@ -12,6 +12,7 @@ Note all of the diagnostic information is accurately updated to account for a re **Create MH Ratio Calculator** Create a function (along with helpers as needed) that computes the MH ratio for valid new proposed plans. +- NOTE: Not sure if there needs to be an extra term in the raito for probability of picking that region to split, don't think so but still **Create Full Pass through** In the `smc_and_mcmc.cpp` file make a function analagous to `optimal_gsmc_plans` that runs it for the whole thing. For now just stick with doing MCMC moves with a set frequency with the amount set to 1/acceptance rate. Need to think about what kind of diagnostics to keep. Right now I think it should just be the number of attempts made and how many were successful along with storing the plans and weights at the end From 45a5be56d971274285f449e9e9bcaff1caefa05e Mon Sep 17 00:00:00 2001 From: "Philip W. O'Sullivan" Date: Sun, 3 Nov 2024 04:28:14 -0500 Subject: [PATCH 034/324] merge split now works for one district split as well --- R/diagnostics.R | 2 +- src/smc_and_mcmc.cpp | 17 ++++++++--------- 2 files changed, 9 insertions(+), 10 deletions(-) diff --git a/R/diagnostics.R b/R/diagnostics.R index 3e9abcc16..193a1db19 100644 --- a/R/diagnostics.R +++ b/R/diagnostics.R @@ -355,7 +355,7 @@ summary.redist_plans <- function(object, district = 1L, all_runs = TRUE, vi_max cli_text("{.strong {algo_label}:} {fmt_comma(n_samp)} sampled plans of {n_distr} districts on {fmt_comma(nrow(plans_m))} units with a population between {fmt_comma(pop_lb)} and {fmt_comma(pop_ub)} - with {diagn$num_ms_steps} merge split steps throughout.") + with {all_diagn[[1]]$num_ms_steps} merge split steps throughout.") cli_text("{.arg pop_temper}={format(all_diagn[[1]]$pop_temper, digits=3)}") cat("\n") diff --git a/src/smc_and_mcmc.cpp b/src/smc_and_mcmc.cpp index d5858f7eb..b2e01c288 100644 --- a/src/smc_and_mcmc.cpp +++ b/src/smc_and_mcmc.cpp @@ -74,9 +74,6 @@ List optimal_gsmc_with_merge_split_plans( ); - - Rprintf("Running %d merge split steps!\n", total_ms_steps); - // return List::create( // _["merge_split_steps"] = merge_split_step_vec, // _["count"] = cnnt @@ -299,7 +296,7 @@ List optimal_gsmc_with_merge_split_plans( run_merge_split_step_on_all_plans( pool, g, counties, cg, pop, - new_plans_vec, + plans_vec, split_district_only, k_params.at(smc_step_num), nsteps_to_run, lower, upper, target, @@ -316,9 +313,12 @@ List optimal_gsmc_with_merge_split_plans( acceptance_rates.at(step_num) = total_ms_successes / static_cast(total_ms_attempts); - Rprintf("Ran %d Merge Split Attempts: %d Successes out of %d attempts. Acceptance Rate: %.2f\n", - nsteps_to_run, - total_ms_successes,total_ms_attempts, 100.0*acceptance_rates.at(step_num)); + if (verbosity >= 3){ + Rprintf("Ran %d Merge Split Attempts: %d Successes out of %d attempts. Acceptance Rate: %.2f\n", + nsteps_to_run, + total_ms_successes,total_ms_attempts, 100.0*acceptance_rates.at(step_num)); + } + // Copy results from previous step @@ -363,7 +363,7 @@ List optimal_gsmc_with_merge_split_plans( get_all_plans_log_gsmc_weights( pool, g, - new_plans_vec, + plans_vec, split_district_only, log_incremental_weights_mat.at(step_num), unnormalized_sampling_weights, @@ -395,7 +395,6 @@ List optimal_gsmc_with_merge_split_plans( } } - } } catch (Rcpp::internal::InterruptedException e) { cli_progress_done(bar); From d04f1230ef744729dc969be80a0d12f6772c22b8 Mon Sep 17 00:00:00 2001 From: "Philip W. O'Sullivan" Date: Thu, 7 Nov 2024 02:38:19 -0500 Subject: [PATCH 035/324] fixed issue with not correctly spacing out merge split steps --- R/RcppExports.R | 8 +++--- R/confint.R | 8 ++---- R/redist_optimal_gsmc.R | 2 +- R/redist_optimal_gsmc_ms.R | 58 +++++++++++++++++++++++++++----------- src/RcppExports.cpp | 16 +++++------ src/optimal_gsmc.cpp | 2 +- src/optimal_gsmc.h | 2 +- src/smc.cpp | 1 + src/smc_and_mcmc.cpp | 13 +++++---- src/smc_and_mcmc.h | 2 +- 10 files changed, 68 insertions(+), 44 deletions(-) diff --git a/R/RcppExports.R b/R/RcppExports.R index 569db8cec..5c4bb9d85 100644 --- a/R/RcppExports.R +++ b/R/RcppExports.R @@ -128,8 +128,8 @@ ms_plans <- function(N, l, init, counties, pop, n_distr, target, lower, upper, r #' @param verbosity What level of detail to print out while the algorithm is #' running #' @export -optimal_gsmc_plans <- function(N, adj_list, counties, pop, target, lower, upper, M, control, ncores = -1L, verbosity = 3L, diagnostic_mode = FALSE) { - .Call(`_redist_optimal_gsmc_plans`, N, adj_list, counties, pop, target, lower, upper, M, control, ncores, verbosity, diagnostic_mode) +optimal_gsmc_plans <- function(N, adj_list, counties, pop, target, lower, upper, M, control, num_threads = -1L, verbosity = 3L, diagnostic_mode = FALSE) { + .Call(`_redist_optimal_gsmc_plans`, N, adj_list, counties, pop, target, lower, upper, M, control, num_threads, verbosity, diagnostic_mode) } pareto_dominated <- function(x) { @@ -239,8 +239,8 @@ smc_plans <- function(N, l, counties, pop, n_distr, target, lower, upper, rho, d #' @param verbosity What level of detail to print out while the algorithm is #' running #' @export -optimal_gsmc_with_merge_split_plans <- function(N, adj_list, counties, pop, target, lower, upper, M, control, ncores = -1L, verbosity = 3L, diagnostic_mode = FALSE) { - .Call(`_redist_optimal_gsmc_with_merge_split_plans`, N, adj_list, counties, pop, target, lower, upper, M, control, ncores, verbosity, diagnostic_mode) +optimal_gsmc_with_merge_split_plans <- function(N, adj_list, counties, pop, target, lower, upper, M, control, num_threads = -1L, verbosity = 3L, diagnostic_mode = FALSE) { + .Call(`_redist_optimal_gsmc_with_merge_split_plans`, N, adj_list, counties, pop, target, lower, upper, M, control, num_threads, verbosity, diagnostic_mode) } splits <- function(dm, community, nd, max_split) { diff --git a/R/confint.R b/R/confint.R index e2d9d2a81..85128ea9f 100644 --- a/R/confint.R +++ b/R/confint.R @@ -48,18 +48,14 @@ #' @export redist_ci <- function(plans, x, district = 1L, conf = 0.9, by_chain = FALSE) { algo = attr(plans, "algorithm") - algos_ok = c("smc", "gsmc", "basic_smc", "mergesplit", "flip") + algos_ok = c("smc", "gsmc", "basic_smc", "gsmc_ms", "smc_ms", "mergesplit", "flip") x = enquo(x) if (is.null(algo) || !algo %in% algos_ok) { cli_abort("{.field algorithm} attribute missing from {.arg plans}. Call {.fn redist_smc_ci} or {.fn redist_mcmc_ci} directly.") - } else if (algo == "smc") { - redist_smc_ci(plans, !!x, district, conf, by_chain) - } else if (algo == "gsmc") { - redist_smc_ci(plans, !!x, district, conf, by_chain) - } else if (algo == "basic_smc") { + } else if (algo %in% c("smc", "gsmc", "basic_smc", "gsmc_ms", "smc_ms")) { redist_smc_ci(plans, !!x, district, conf, by_chain) } else { # MCMC redist_mcmc_ci(plans,!!x, district, conf, by_chain) diff --git a/R/redist_optimal_gsmc.R b/R/redist_optimal_gsmc.R index 34db42889..1b39437af 100644 --- a/R/redist_optimal_gsmc.R +++ b/R/redist_optimal_gsmc.R @@ -176,7 +176,7 @@ redist_optimal_gsmc <- function(state_map, M, counties = NULL, upper=pop_bounds[3], M=M, control = control, - ncores = as.integer(ncores_per), + num_threads = as.integer(ncores_per), verbosity=run_verbosity, diagnostic_mode=diagnostic_mode) diff --git a/R/redist_optimal_gsmc_ms.R b/R/redist_optimal_gsmc_ms.R index 9e3785274..a70d3b2a2 100644 --- a/R/redist_optimal_gsmc_ms.R +++ b/R/redist_optimal_gsmc_ms.R @@ -63,20 +63,39 @@ redist_optimal_gsmc_ms <- function(state_map, M, counties = NULL, # there are N-1 splits so for now just do it total_smc_steps <- N-1 - total_ms_steps <- floor(total_smc_steps/ms_freq) - # total number of steps to run - total_steps <- N - 1 + total_ms_steps + # check if there will be any merge split steps + any_ms_steps_ran <- ms_freq <= total_smc_steps + + merge_split_step_vec <- rep(FALSE, N-1) + + if(any_ms_steps_ran){ + # Now add merge split every `ms_freq` steps + - # TODO: In future the merge_split_step_vec should just be passed in as a parameter - merge_split_step_vec <- rep(FALSE, total_steps) + # insertion trick + # https://stackoverflow.com/questions/1493969/insert-elements-into-a-vector-at-given-indexes + ind <- seq(from = ms_freq, to = N-1, by = ms_freq) + val <- c( merge_split_step_vec, rep(TRUE,length(ind)) ) + id <- c( seq_along(merge_split_step_vec), ind+0.5 ) - # For now just set every `ms_freq` value to merge split - for(i in 1:total_ms_steps){ - # remember 1 indexed - merge_split_step_vec[i*ms_freq] = TRUE + # number of merge split is sum of trues + merge_split_step_vec <- val[order(id)] + + # if the last step is merge split then make it one earlier + if(merge_split_step_vec[length(merge_split_step_vec)]){ + merge_split_step_vec[length(merge_split_step_vec)] <- FALSE + merge_split_step_vec[length(merge_split_step_vec)-1] <- TRUE + } } + assertthat::assert_that(sum(!merge_split_step_vec) == total_smc_steps) + + total_ms_steps <- sum(merge_split_step_vec) + + # total number of steps to run + total_steps <- total_smc_steps + total_ms_steps + control <- list( lags=lags, @@ -205,12 +224,13 @@ redist_optimal_gsmc_ms <- function(state_map, M, counties = NULL, upper=pop_bounds[3], M=M, control = control, - ncores = as.integer(ncores_per), + num_threads = as.integer(ncores_per), verbosity=run_verbosity, diagnostic_mode=diagnostic_mode) + if (length(algout) == 0) { cli::cli_process_done() cli::cli_process_done() @@ -336,13 +356,19 @@ redist_optimal_gsmc_ms <- function(state_map, M, counties = NULL, algout$region_order_added_list <- NULL gc() - # make the M x num_ms_steps by - algout$merge_split_success_mat <- matrix( - unlist(algout$merge_split_success_counts), - ncol = length(algout$merge_split_success_counts), - byrow = FALSE + # refor + if(any_ms_steps_ran){ + # make the M x num_ms_steps by + algout$merge_split_success_mat <- matrix( + unlist(algout$merge_split_success_counts), + ncol = length(algout$merge_split_success_counts), + byrow = FALSE ) - algout$merge_split_success_counts <- NULL + algout$merge_split_success_counts <- NULL + }else{ + algout$merge_split_success_counts <- NULL + } + # turn it into a character vector algout$step_split_types <- ifelse( diff --git a/src/RcppExports.cpp b/src/RcppExports.cpp index c40a27bc2..8bd0ee9e8 100644 --- a/src/RcppExports.cpp +++ b/src/RcppExports.cpp @@ -370,8 +370,8 @@ BEGIN_RCPP END_RCPP } // optimal_gsmc_plans -List optimal_gsmc_plans(int N, List adj_list, const arma::uvec& counties, const arma::uvec& pop, double target, double lower, double upper, int M, List control, int ncores, int verbosity, bool diagnostic_mode); -RcppExport SEXP _redist_optimal_gsmc_plans(SEXP NSEXP, SEXP adj_listSEXP, SEXP countiesSEXP, SEXP popSEXP, SEXP targetSEXP, SEXP lowerSEXP, SEXP upperSEXP, SEXP MSEXP, SEXP controlSEXP, SEXP ncoresSEXP, SEXP verbositySEXP, SEXP diagnostic_modeSEXP) { +List optimal_gsmc_plans(int N, List adj_list, const arma::uvec& counties, const arma::uvec& pop, double target, double lower, double upper, int M, List control, int num_threads, int verbosity, bool diagnostic_mode); +RcppExport SEXP _redist_optimal_gsmc_plans(SEXP NSEXP, SEXP adj_listSEXP, SEXP countiesSEXP, SEXP popSEXP, SEXP targetSEXP, SEXP lowerSEXP, SEXP upperSEXP, SEXP MSEXP, SEXP controlSEXP, SEXP num_threadsSEXP, SEXP verbositySEXP, SEXP diagnostic_modeSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; @@ -384,10 +384,10 @@ BEGIN_RCPP Rcpp::traits::input_parameter< double >::type upper(upperSEXP); Rcpp::traits::input_parameter< int >::type M(MSEXP); Rcpp::traits::input_parameter< List >::type control(controlSEXP); - Rcpp::traits::input_parameter< int >::type ncores(ncoresSEXP); + Rcpp::traits::input_parameter< int >::type num_threads(num_threadsSEXP); Rcpp::traits::input_parameter< int >::type verbosity(verbositySEXP); Rcpp::traits::input_parameter< bool >::type diagnostic_mode(diagnostic_modeSEXP); - rcpp_result_gen = Rcpp::wrap(optimal_gsmc_plans(N, adj_list, counties, pop, target, lower, upper, M, control, ncores, verbosity, diagnostic_mode)); + rcpp_result_gen = Rcpp::wrap(optimal_gsmc_plans(N, adj_list, counties, pop, target, lower, upper, M, control, num_threads, verbosity, diagnostic_mode)); return rcpp_result_gen; END_RCPP } @@ -700,8 +700,8 @@ BEGIN_RCPP END_RCPP } // optimal_gsmc_with_merge_split_plans -List optimal_gsmc_with_merge_split_plans(int N, List adj_list, const arma::uvec& counties, const arma::uvec& pop, double target, double lower, double upper, int M, List control, int ncores, int verbosity, bool diagnostic_mode); -RcppExport SEXP _redist_optimal_gsmc_with_merge_split_plans(SEXP NSEXP, SEXP adj_listSEXP, SEXP countiesSEXP, SEXP popSEXP, SEXP targetSEXP, SEXP lowerSEXP, SEXP upperSEXP, SEXP MSEXP, SEXP controlSEXP, SEXP ncoresSEXP, SEXP verbositySEXP, SEXP diagnostic_modeSEXP) { +List optimal_gsmc_with_merge_split_plans(int N, List adj_list, const arma::uvec& counties, const arma::uvec& pop, double target, double lower, double upper, int M, List control, int num_threads, int verbosity, bool diagnostic_mode); +RcppExport SEXP _redist_optimal_gsmc_with_merge_split_plans(SEXP NSEXP, SEXP adj_listSEXP, SEXP countiesSEXP, SEXP popSEXP, SEXP targetSEXP, SEXP lowerSEXP, SEXP upperSEXP, SEXP MSEXP, SEXP controlSEXP, SEXP num_threadsSEXP, SEXP verbositySEXP, SEXP diagnostic_modeSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; @@ -714,10 +714,10 @@ BEGIN_RCPP Rcpp::traits::input_parameter< double >::type upper(upperSEXP); Rcpp::traits::input_parameter< int >::type M(MSEXP); Rcpp::traits::input_parameter< List >::type control(controlSEXP); - Rcpp::traits::input_parameter< int >::type ncores(ncoresSEXP); + Rcpp::traits::input_parameter< int >::type num_threads(num_threadsSEXP); Rcpp::traits::input_parameter< int >::type verbosity(verbositySEXP); Rcpp::traits::input_parameter< bool >::type diagnostic_mode(diagnostic_modeSEXP); - rcpp_result_gen = Rcpp::wrap(optimal_gsmc_with_merge_split_plans(N, adj_list, counties, pop, target, lower, upper, M, control, ncores, verbosity, diagnostic_mode)); + rcpp_result_gen = Rcpp::wrap(optimal_gsmc_with_merge_split_plans(N, adj_list, counties, pop, target, lower, upper, M, control, num_threads, verbosity, diagnostic_mode)); return rcpp_result_gen; END_RCPP } diff --git a/src/optimal_gsmc.cpp b/src/optimal_gsmc.cpp index 116298974..12b6d81d3 100644 --- a/src/optimal_gsmc.cpp +++ b/src/optimal_gsmc.cpp @@ -67,7 +67,7 @@ List optimal_gsmc_plans( // Loading Info if (verbosity >= 1) { Rcout.imbue(std::locale("")); - Rcout << std::fixed << std::setprecision(0); + Rcout << std::fixed << std::setprecision(4); if(!split_district_only){ Rcout << "GENERALIZED SEQUENTIAL MONTE CARLO\n"; }else{ diff --git a/src/optimal_gsmc.h b/src/optimal_gsmc.h index e385b8643..755fc9ddf 100644 --- a/src/optimal_gsmc.h +++ b/src/optimal_gsmc.h @@ -52,7 +52,7 @@ List optimal_gsmc_plans( double target, double lower, double upper, int M, // M is Number of particles aka number of different plans List control, // control has pop temper, and k parameter value, and whether only district splits are allowed - int ncores = -1, int verbosity = 3, bool diagnostic_mode = false + int num_threads = -1, int verbosity = 3, bool diagnostic_mode = false ); #endif diff --git a/src/smc.cpp b/src/smc.cpp index fea6f41ed..1b4ff445d 100644 --- a/src/smc.cpp +++ b/src/smc.cpp @@ -108,6 +108,7 @@ List smc_plans(int N, List l, const uvec &counties, const uvec &pop, // This is n_drawn by N where [i][j] is the index of the original (first) ancestor of particle j on step i std::vector> original_ancestor_mat(n_steps, std::vector (N, -1)); + RcppThread::ThreadPool pool(cores); std::string bar_fmt = "Split [{cli::pb_current}/{cli::pb_total}] {cli::pb_bar} | ETA{cli::pb_eta}"; diff --git a/src/smc_and_mcmc.cpp b/src/smc_and_mcmc.cpp index b2e01c288..547adc55a 100644 --- a/src/smc_and_mcmc.cpp +++ b/src/smc_and_mcmc.cpp @@ -53,6 +53,7 @@ List optimal_gsmc_with_merge_split_plans( std::vector merge_split_step_vec = as>(control["merge_split_step_vec"]); + double pop_temper = as(control["pop_temper"]); // there are N-1 splits so for now just do it @@ -96,15 +97,17 @@ List optimal_gsmc_with_merge_split_plans( // Loading Info if (verbosity >= 1) { Rcout.imbue(std::locale("")); - Rcout << std::fixed << std::setprecision(0); + Rcout << std::fixed << std::setprecision(4); if(!split_district_only){ - Rcout << "GENERALIZED SEQUENTIAL MONTE CARLO\n"; + Rcout << "GENERALIZED SEQUENTIAL MONTE CARLO"; }else{ - Rcout << "SEQUENTIAL MONTE CARLO\n"; + Rcout << "SEQUENTIAL MONTE CARLO"; } + Rcout << " WITH MERGE SPLIT\n"; Rcout << "Sampling " << M << " " << V << "-unit "; Rcout << "maps with " << N << " districts and population between " - << lower << " and " << upper << " using " << num_threads << " threads "; + << lower << " and " << upper << " using " << num_threads << " threads, " + << total_ms_steps << " merge split steps, "; if(!split_district_only){ Rcout << "and generalized region splits.\n"; }else{ @@ -240,8 +243,6 @@ List optimal_gsmc_with_merge_split_plans( std::string bar_fmt = "Split [{cli::pb_current}/{cli::pb_total}] {cli::pb_bar} | ETA{cli::pb_eta}"; RObject bar = cli_progress_bar(total_steps, cli_config(false, bar_fmt.c_str())); - // For record tracking - Rprintf("There should be %d Merge split steps!\n", total_ms_steps); // counts the number of smc steps int smc_step_num = 0; diff --git a/src/smc_and_mcmc.h b/src/smc_and_mcmc.h index 847771381..4f6693a20 100644 --- a/src/smc_and_mcmc.h +++ b/src/smc_and_mcmc.h @@ -51,7 +51,7 @@ List optimal_gsmc_with_merge_split_plans( double target, double lower, double upper, int M, // M is Number of particles aka number of different plans List control, // control has pop temper, and k parameter value, and whether only district splits are allowed - int ncores = -1, int verbosity = 3, bool diagnostic_mode = false + int num_threads = -1, int verbosity = 3, bool diagnostic_mode = false ); From 8639bafb83f12a31d3e218f3815ad99db7611abc Mon Sep 17 00:00:00 2001 From: "Philip W. O'Sullivan" Date: Thu, 7 Nov 2024 16:23:59 -0500 Subject: [PATCH 036/324] fixed issue with bad mcmc weights. Now just leaves them unchanged --- src/smc_and_mcmc.cpp | 5 +++++ src/weights.cpp | 7 +++++-- 2 files changed, 10 insertions(+), 2 deletions(-) diff --git a/src/smc_and_mcmc.cpp b/src/smc_and_mcmc.cpp index 547adc55a..af1560555 100644 --- a/src/smc_and_mcmc.cpp +++ b/src/smc_and_mcmc.cpp @@ -361,6 +361,7 @@ List optimal_gsmc_with_merge_split_plans( // compute log incremental weights and sampling weights for next round + if(!merge_split_step_vec[step_num]){ get_all_plans_log_gsmc_weights( pool, g, @@ -371,6 +372,10 @@ List optimal_gsmc_with_merge_split_plans( target, pop_temper ); + }else{ + log_incremental_weights_mat.at(step_num) = log_incremental_weights_mat.at(step_num-1); + } + // compute effective sample size diff --git a/src/weights.cpp b/src/weights.cpp index 88767d35f..876d04722 100644 --- a/src/weights.cpp +++ b/src/weights.cpp @@ -171,8 +171,11 @@ double get_log_mh_ratio( static_cast(num_new_adj_regions) ); - double log_mh_ratio_numerator = old_log_boundary_length + log_old_merge_prob; - double log_mh_ratio_denominator = new_log_boundary_length + log_new_merge_prob; + // double log_mh_ratio_numerator = old_log_boundary_length + log_old_merge_prob; + // double log_mh_ratio_denominator = new_log_boundary_length + log_new_merge_prob; + + double log_mh_ratio_numerator = old_log_boundary_length + log_new_merge_prob; + double log_mh_ratio_denominator = new_log_boundary_length + log_old_merge_prob; double log_mh_ratio = log_mh_ratio_numerator - log_mh_ratio_denominator; From b19d03c5187404037913d022dd7e5a44312c1654 Mon Sep 17 00:00:00 2001 From: "Philip W. O'Sullivan" Date: Fri, 8 Nov 2024 01:42:28 -0500 Subject: [PATCH 037/324] added support for counting specific region ids within a plan instead of all of them --- R/redist_optimal_gsmc_ms.R | 17 +++++++- R/region_counting.R | 83 ++++++++++++++++++++++++++++---------- src/smc_and_mcmc.cpp | 4 +- task_tracker.md | 3 +- 4 files changed, 80 insertions(+), 27 deletions(-) diff --git a/R/redist_optimal_gsmc_ms.R b/R/redist_optimal_gsmc_ms.R index a70d3b2a2..dd241c85a 100644 --- a/R/redist_optimal_gsmc_ms.R +++ b/R/redist_optimal_gsmc_ms.R @@ -84,8 +84,21 @@ redist_optimal_gsmc_ms <- function(state_map, M, counties = NULL, # if the last step is merge split then make it one earlier if(merge_split_step_vec[length(merge_split_step_vec)]){ - merge_split_step_vec[length(merge_split_step_vec)] <- FALSE - merge_split_step_vec[length(merge_split_step_vec)-1] <- TRUE + merge_split_vec_len <- length(merge_split_step_vec) + + merge_split_step_vec[merge_split_vec_len] <- FALSE + merge_split_step_vec[merge_split_vec_len-1] <- TRUE + + # now check if the last two are both merge split (should only + # happen when frequency is 1) then remove one + if( + merge_split_step_vec[merge_split_vec_len-1] && + merge_split_step_vec[merge_split_vec_len-2] ){ + merge_split_step_vec <- c( + merge_split_step_vec[1:(merge_split_vec_len-2)], + merge_split_step_vec[merge_split_vec_len] + ) + } } } diff --git a/R/region_counting.R b/R/region_counting.R index 4058d7d3d..060e5da16 100644 --- a/R/region_counting.R +++ b/R/region_counting.R @@ -1,43 +1,77 @@ # Creates a hash map that counts the number of times a specific region appears # in a matrix of plans or partial plans -get_region_count_map <- function(plan_mat, N){ +# +# Only counts regions in district_nums. If null counts them all +get_region_count_map <- function(plan_mat, num_regions, region_ids_to_count = NULL){ + # check region ids only go from 1:num_regions + assertthat::assert_that( + assertthat::are_equal( + 1:num_regions, + sort(unique(plan_mat[,1])) + ) + ) + + region_ids_to_count <- unique(region_ids_to_count) + + # check not counting an invalid region id + assertthat::assert_that( + all(region_ids_to_count %in% 1:num_regions) + ) + + region_to_count_vec <- rep(FALSE, num_regions) + + if(is.null(region_ids_to_count)){ + checking_region_ids <- FALSE + }else{ + checking_region_ids <- TRUE + region_to_count_vec[region_ids_to_count] <- TRUE + } + # create hash map region_count_map <- hash::hash() V <- nrow(plan_mat) - # now iterate over each column + # now iterate over each plan for (col_num in 1:ncol(plan_mat)) { # list mapping district number to precincts with district - district_list <- vector("list", length = N) + region_list <- vector("list", length = num_regions) # now check which district each vertex is in for (vertex_num in 1:V) { - district_id <- plan_mat[vertex_num, col_num] + region_id <- plan_mat[vertex_num, col_num] # now add this vertex to the set of vertices associated with that # district id + # skip if its not one to count + if(checking_region_ids && !region_to_count_vec[region_id]){ + next + } + + # Check if - if(is.null(district_list[[district_id]])){ - district_list[[district_id]] <- c(vertex_num) + if(is.null(region_list[[region_id]])){ + region_list[[region_id]] <- c(vertex_num) }else{ # else if already there just append - district_list[[district_id]] <- append( - district_list[[district_id]], vertex_num + region_list[[region_id]] <- append( + region_list[[region_id]], vertex_num ) } } + region_list <- region_list[!sapply(region_list, is.null)] + # now add count of districts to hash map - for(district_vertices in district_list){ + for(region_vertices in region_list){ # convert set of precincts to string - str_district_vertices <- toString(district_vertices) + str_region_vertices <- toString(region_vertices) # check if district already counted - if(hash::has.key(str_district_vertices, region_count_map)){ - region_count_map[[str_district_vertices]] <- region_count_map[[str_district_vertices]] + 1 + if(hash::has.key(str_region_vertices, region_count_map)){ + region_count_map[[str_region_vertices]] <- region_count_map[[str_region_vertices]] + 1 }else{ - region_count_map[[str_district_vertices]] <- 1 + region_count_map[[str_region_vertices]] <- 1 } } } @@ -47,25 +81,28 @@ get_region_count_map <- function(plan_mat, N){ get_region_count_df <- function(plan_mat, N){ - district_count_map <- get_region_count_map(plan_mat, N) + region_count_map <- get_region_count_map(plan_mat, N) - district_count_df <- data.frame( - district=names(hash::values(district_count_map, USE.NAMES=TRUE)), - d_count=hash::values(district_count_map, USE.NAMES=FALSE), + region_count_df <- data.frame( + district=names(hash::values(region_count_map, USE.NAMES=TRUE)), + d_count=hash::values(region_count_map, USE.NAMES=FALSE), row.names=NULL ) %>% arrange(desc(d_count)) - return(district_count_df) + return(region_count_df) } #' @export -get_district_count_df <- function(plans, chain_num){ +get_district_count_df <- function(plans, chain_nums, district_ids_to_count = NULL){ + # if not specific districts specified then just do all district_count_map <- plans %>% - filter(chain == chain_num) %>% - as.matrix() %>% - get_region_count_map(attr(plans, "ndist")) + filter(chain %in% chain_nums) %>% + as.matrix() %>% + get_region_count_map(attr(plans, "ndist"), district_ids_to_count) + + district_count_df <- data.frame( district=names(hash::values(district_count_map, USE.NAMES=TRUE)), @@ -81,3 +118,5 @@ get_district_count_df <- function(plans, chain_num){ + + diff --git a/src/smc_and_mcmc.cpp b/src/smc_and_mcmc.cpp index af1560555..6093ff394 100644 --- a/src/smc_and_mcmc.cpp +++ b/src/smc_and_mcmc.cpp @@ -291,7 +291,7 @@ List optimal_gsmc_with_merge_split_plans( // Rprintf("%d!\n", step_num); // run merge split // Set the number of steps to run at 1 over previous stage acceptance rate - int nsteps_to_run = std::ceil(1/acceptance_rates.at(step_num-1)) * std::max(merge_split_step_num,1); + int nsteps_to_run = std::ceil(1/acceptance_rates.at(step_num-1)); // * std::max(merge_split_step_num,1); num_merge_split_attempts_vec.at(merge_split_step_num) = nsteps_to_run; run_merge_split_step_on_all_plans( @@ -322,7 +322,7 @@ List optimal_gsmc_with_merge_split_plans( - // Copy results from previous step + // Copy results from previous step original_ancestor_mat.at(step_num) = original_ancestor_mat.at(step_num-1); parent_index_mat.at(step_num) = parent_index_mat.at(step_num-1); draw_tries_mat.at(step_num) = std::vector(M, nsteps_to_run); diff --git a/task_tracker.md b/task_tracker.md index 8defc78af..45605f4d3 100644 --- a/task_tracker.md +++ b/task_tracker.md @@ -8,7 +8,8 @@ Note all of the diagnostic information is accurately updated to account for a re # ----- ACTIVE TASKS ----- - +**Shrink Incremental Weight Mat Size** +For the MH step the weights don't actually change so we don't need to store the output for every step, just every smc step. **Create MH Ratio Calculator** Create a function (along with helpers as needed) that computes the MH ratio for valid new proposed plans. From cb3b8c254261c70eac88d784432a1f0d4a64c53e Mon Sep 17 00:00:00 2001 From: "Philip W. O'Sullivan" Date: Sat, 9 Nov 2024 22:12:12 -0500 Subject: [PATCH 038/324] tweaked merge split to just do 1/acceptance rate again, will make it variable parameter in future --- R/diagnostics.R | 55 +++++++++++++++++++------------------- R/redist_optimal_gsmc.R | 1 + R/redist_optimal_gsmc_ms.R | 17 +++++++++--- src/smc_and_mcmc.cpp | 1 + task_tracker.md | 34 ++++++++++++++++++----- 5 files changed, 71 insertions(+), 37 deletions(-) diff --git a/R/diagnostics.R b/R/diagnostics.R index 193a1db19..892c61add 100644 --- a/R/diagnostics.R +++ b/R/diagnostics.R @@ -367,33 +367,34 @@ summary.redist_plans <- function(object, district = 1L, all_runs = TRUE, vi_max addl_cols <- setdiff(cols, c("chain", "draw", "district", "total_pop")) warn_converge <- FALSE if ("chain" %in% cols && length(addl_cols) > 0) { - idx <- seq_len(n_samp) - if ("district" %in% cols) idx <- as.integer(district) + (idx - 1)*n_distr - - const_cols <- vapply(addl_cols, function(col) { - x <- object[[col]][idx] - all(is.na(x)) || all(x == x[1]) || - any(tapply(x, object[['chain']][idx], FUN = function(z) length(unique(z))) == 1) - }, numeric(1)) - addl_cols <- addl_cols[!const_cols] - - rhats <- vapply(addl_cols, function(col) { - x <- object[[col]][idx] - na_omit <- !is.na(x) - diag_rhat(x[na_omit], object$chain[idx][na_omit]) - }, numeric(1)) - names(rhats) <- addl_cols - cat("R-hat values for summary statistics:\n") - rhats_p <- vapply(rhats, function(x){ - ifelse(x < 1.05, sprintf('%.3f', x), paste0('\U274C', round(x, 3))) - }, FUN.VALUE = character(1)) - print(noquote(rhats_p)) - - if (any(na.omit(rhats) >= 1.05)) { - warn_converge <- TRUE - cli::cli_alert_danger("{.strong WARNING:} {algo} runs have not converged.") - } - cat("\n") + print("Rhats Still under Dev for Merge Split") + # idx <- seq_len(n_samp) + # if ("district" %in% cols) idx <- as.integer(district) + (idx - 1)*n_distr + # + # const_cols <- vapply(addl_cols, function(col) { + # x <- object[[col]][idx] + # all(is.na(x)) || all(x == x[1]) || + # any(tapply(x, object[['chain']][idx], FUN = function(z) length(unique(z))) == 1) + # }, numeric(1)) + # addl_cols <- addl_cols[!const_cols] + # + # rhats <- vapply(addl_cols, function(col) { + # x <- object[[col]][idx] + # na_omit <- !is.na(x) + # diag_rhat(x[na_omit], object$chain[idx][na_omit]) + # }, numeric(1)) + # names(rhats) <- addl_cols + # cat("R-hat values for summary statistics:\n") + # rhats_p <- vapply(rhats, function(x){ + # ifelse(x < 1.05, sprintf('%.3f', x), paste0('\U274C', round(x, 3))) + # }, FUN.VALUE = character(1)) + # print(noquote(rhats_p)) + # + # if (any(na.omit(rhats) >= 1.05)) { + # warn_converge <- TRUE + # cli::cli_alert_danger("{.strong WARNING:} {algo} runs have not converged.") + # } + # cat("\n") } diff --git a/R/redist_optimal_gsmc.R b/R/redist_optimal_gsmc.R index 1b39437af..d702b2d7a 100644 --- a/R/redist_optimal_gsmc.R +++ b/R/redist_optimal_gsmc.R @@ -428,6 +428,7 @@ redist_optimal_gsmc <- function(state_map, M, counties = NULL, seq_alpha = .99, pop_temper = pop_temper, runtime = as.numeric(t2_run - t1_run, units = "secs"), + num_threads = ncores_per, nunique_original_ancestors = algout$nunique_original_ancestors, parent_index_mat = algout$parent_index, original_ancestors_mat = algout$original_ancestors_mat, diff --git a/R/redist_optimal_gsmc_ms.R b/R/redist_optimal_gsmc_ms.R index dd241c85a..810e5c2d0 100644 --- a/R/redist_optimal_gsmc_ms.R +++ b/R/redist_optimal_gsmc_ms.R @@ -118,12 +118,22 @@ redist_optimal_gsmc_ms <- function(state_map, M, counties = NULL, merge_split_step_vec = merge_split_step_vec ) + # TODO fix this later est_k_params <- k_params - for (index in which(merge_split_step_vec)) { - # Insert a duplicate by concatenating parts of the vector - est_k_params <- c(est_k_params[1:index], est_k_params[index], est_k_params[(index + 1):length(est_k_params)]) + est_k_params <- rep(-1, total_steps) + est_k_params[!merge_split_step_vec] <- k_params + + for (i in 1:total_steps) { + if(est_k_params[i] <= 0){ + est_k_params[i] <- est_k_params[i-1] + } } + assertthat::assert_that( + all(est_k_params > 0), + msg = "Something went wrong with est_k_params, fix it!" + ) + # verbosity stuff verbosity <- 1 if (verbose) verbosity <- 3 @@ -512,6 +522,7 @@ redist_optimal_gsmc_ms <- function(state_map, M, counties = NULL, seq_alpha = .99, pop_temper = pop_temper, runtime = as.numeric(t2_run - t1_run, units = "secs"), + num_threads = ncores_per, nunique_original_ancestors = algout$nunique_original_ancestors, parent_index_mat = algout$parent_index, original_ancestors_mat = algout$original_ancestors_mat, diff --git a/src/smc_and_mcmc.cpp b/src/smc_and_mcmc.cpp index 6093ff394..26f01977f 100644 --- a/src/smc_and_mcmc.cpp +++ b/src/smc_and_mcmc.cpp @@ -291,6 +291,7 @@ List optimal_gsmc_with_merge_split_plans( // Rprintf("%d!\n", step_num); // run merge split // Set the number of steps to run at 1 over previous stage acceptance rate + // int nsteps_to_run = std::ceil(1/std::pow(acceptance_rates.at(step_num-1),1.5)); // * std::max(merge_split_step_num,1); int nsteps_to_run = std::ceil(1/acceptance_rates.at(step_num-1)); // * std::max(merge_split_step_num,1); num_merge_split_attempts_vec.at(merge_split_step_num) = nsteps_to_run; diff --git a/task_tracker.md b/task_tracker.md index 45605f4d3..a653d1194 100644 --- a/task_tracker.md +++ b/task_tracker.md @@ -8,15 +8,24 @@ Note all of the diagnostic information is accurately updated to account for a re # ----- ACTIVE TASKS ----- -**Shrink Incremental Weight Mat Size** -For the MH step the weights don't actually change so we don't need to store the output for every step, just every smc step. +**Change diagnostics.R to be better** +Make the display for the new algorithm types better, also figure out a better way to calculate Rhats. For the ones that are by district it should compute for all districts and display the maximum. It also needs to have some way to store these results maybe . + +**Change redist_plans storage scheme** +Right now I lump everything into diagnostics but there is probably a smarter way to do this. There should be another things called like internal diagnostics or something that only contains things saved during diagnostic mode. + +**Consolidate Redist gsmc R files and c++ code** +Right now the redist_gsmc and redist_gsmc with merge split are in seperate c++ and R files but this seems unneccesary. It should be possible to combine them and just add a flag for whether or not merge split steps need to be run. + +**Shrink Incremental Weight Mat Size and other related variables** +For the MH step the weights don't actually change so we don't need to store the output for every step, just every smc step. That means we also don't need to track the effective sample size. + +**Remove unneccesary variables when not in diagnostics** +In order to save memory make it so that some things like the log incremental weights matrix are not created or are not big when its not diagnostic mode. This will be really important for saving memory. + +Also need to decide if things like the original ancestors matrix should be created when its not diagnostic mode. Probably not but we will see. -**Create MH Ratio Calculator** -Create a function (along with helpers as needed) that computes the MH ratio for valid new proposed plans. -- NOTE: Not sure if there needs to be an extra term in the raito for probability of picking that region to split, don't think so but still -**Create Full Pass through** -In the `smc_and_mcmc.cpp` file make a function analagous to `optimal_gsmc_plans` that runs it for the whole thing. For now just stick with doing MCMC moves with a set frequency with the amount set to 1/acceptance rate. Need to think about what kind of diagnostics to keep. Right now I think it should just be the number of attempts made and how many were successful along with storing the plans and weights at the end **Create Function for Diagnostics** Since both the smc and smc with merge split share some diagnostics its probably better to write a function to create the vectors shared between them to avoid duplicate code. @@ -49,6 +58,17 @@ Need to more cleanly seperate diagnostic information from stuff in the final sam # ----- COMPLETED TASKS ----- +**Create MH Ratio Calculator - DONE 11/6/2024** +Task: Create a function (along with helpers as needed) that computes the MH ratio for valid new proposed plans. + +Comments after completion: Initially got the probability of merging pairs flipped in the ratio but fixed it. + +**Create Full Pass through - DONE 11/2/2024** +Task: In the `smc_and_mcmc.cpp` file make a function analagous to `optimal_gsmc_plans` that runs it for the whole thing. For now just stick with doing MCMC moves with a set frequency with the amount set to 1/acceptance rate. Need to think about what kind of diagnostics to keep. Right now I think it should just be the number of attempts made and how many were successful along with storing the plans and weights at the end + +Comments after completion: None + + **Make get_edge_to_cut only need vertex region id vector* - DONE 11/2/2024** Task: Change `get_edge_to_cut` to only take in a vector of vertex region ids and a max dval to try instead of taking in a plan. This will make merge split easier by allowing you to just pass in a vertex region id vector with two regions merged without having to bother editing the actual plan. From 9da590638986c9c40330d86f277fc67a9a9d6117 Mon Sep 17 00:00:00 2001 From: "Philip W. O'Sullivan" Date: Sat, 9 Nov 2024 22:21:20 -0500 Subject: [PATCH 039/324] removed reference to file not on github --- src/splitting_inspection.h | 1 - 1 file changed, 1 deletion(-) diff --git a/src/splitting_inspection.h b/src/splitting_inspection.h index afc4f65e0..2b412205d 100644 --- a/src/splitting_inspection.h +++ b/src/splitting_inspection.h @@ -16,7 +16,6 @@ #include "wilson.h" #include "tree_op.h" #include "map_calc.h" -#include "active_dev.h" #include "splitting.h" #include "merging.h" From ee74cb7139a970f56f66bcddc4115d414b2d06c4 Mon Sep 17 00:00:00 2001 From: "Philip W. O'Sullivan" Date: Sun, 10 Nov 2024 00:53:08 -0500 Subject: [PATCH 040/324] made original smc support not multiprocessing --- R/redist_smc.R | 21 +++++++++++++++++---- 1 file changed, 17 insertions(+), 4 deletions(-) diff --git a/R/redist_smc.R b/R/redist_smc.R index d8af272c3..16a716309 100644 --- a/R/redist_smc.R +++ b/R/redist_smc.R @@ -135,7 +135,7 @@ redist_smc <- function(map, nsims, counties = NULL, compactness = 1, constraints resample = TRUE, runs = 1L, ncores = 0L, init_particles = NULL, n_steps = NULL, adapt_k_thresh = 0.99, seq_alpha = 0.5, truncate = (compactness != 1), trunc_fn = redist_quantile_trunc, - pop_temper = 0, final_infl = 1, + pop_temper = 0, final_infl = 1, multiprocess = FALSE, ref_name = NULL, verbose = FALSE, silent = FALSE) { map <- validate_redist_map(map) V <- nrow(map) @@ -229,6 +229,16 @@ redist_smc <- function(map, nsims, counties = NULL, compactness = 1, constraints } } + # if sequentially + if(!multiprocess){ + # either max cores if + if(ncores == 0){ + ncores_per = ncores_max + }else{ + ncores_per = ncores + } + } + lags <- 1 + unique(round((ndists - 1)^0.8*seq(0, 0.7, length.out = 4)^0.9)) control <- list(adapt_k_thresh = adapt_k_thresh, seq_alpha = seq_alpha, @@ -238,7 +248,9 @@ redist_smc <- function(map, nsims, counties = NULL, compactness = 1, constraints cores = as.integer(ncores_per)) - if (ncores_runs > 1) { + + + if (ncores_runs > 1 && multiprocess) { `%oper%` <- `%dorng%` of <- if (Sys.info()[["sysname"]] == "Windows") { tempfile(pattern = paste0("smc_", substr(Sys.time(), 1, 10)), fileext = ".txt") @@ -248,10 +260,10 @@ redist_smc <- function(map, nsims, counties = NULL, compactness = 1, constraints if (!silent) cl <- makeCluster(ncores_runs, outfile = of, methods = FALSE, - useXDR = .Platform$endian != "little") + useXDR = .Platform$endian != "little") else cl <- makeCluster(ncores_runs, methods = FALSE, - useXDR = .Platform$endian != "little") + useXDR = .Platform$endian != "little") doParallel::registerDoParallel(cl, cores = ncores_runs) on.exit(stopCluster(cl)) } else { @@ -361,6 +373,7 @@ redist_smc <- function(map, nsims, counties = NULL, compactness = 1, constraints seq_alpha = seq_alpha, pop_temper = pop_temper, runtime = as.numeric(t2_run - t1_run, units = "secs"), + num_threads = ncores_per, parent_index_mat = algout$parent_index, original_ancestors_mat = algout$original_ancestors_mat, nunique_original_ancestors=nunique_original_ancestors From 9dacb0fa581d47a460a9703ae6358e768e5009ba Mon Sep 17 00:00:00 2001 From: "Philip W. O'Sullivan" Date: Tue, 12 Nov 2024 16:01:16 -0500 Subject: [PATCH 041/324] makes it so when not doing multiprocess the output from each run is printed --- R/redist_smc.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/redist_smc.R b/R/redist_smc.R index 16a716309..66b1fc1e2 100644 --- a/R/redist_smc.R +++ b/R/redist_smc.R @@ -272,7 +272,7 @@ redist_smc <- function(map, nsims, counties = NULL, compactness = 1, constraints t1 <- Sys.time() all_out <- foreach(chain = seq_len(runs), .inorder = FALSE, .packages="redist") %oper% { - run_verbosity <- if (chain == 1) verbosity else 0 + run_verbosity <- if (chain == 1 || !multiprocess) verbosity else 0 t1_run <- Sys.time() algout <- smc_plans(nsims, adj, counties, pop, ndists, From 6d0b07746b9516e3907c6c0a5a65f27e008fc2fa Mon Sep 17 00:00:00 2001 From: "Philip W. O'Sullivan" Date: Wed, 13 Nov 2024 17:16:30 -0500 Subject: [PATCH 042/324] made it possible to do a final merge split step at the end --- NAMESPACE | 1 + R/redist_optimal_gsmc_ms.R | 20 ++---------- man/optimal_gsmc_plans.Rd | 6 ++-- man/optimal_gsmc_with_merge_split_plans.Rd | 6 ++-- man/redist_optimal_gsmc_ms.Rd | 38 ++++++++++++++++++++++ man/redist_smc.Rd | 1 + src/smc_and_mcmc.cpp | 7 ---- 7 files changed, 48 insertions(+), 31 deletions(-) create mode 100644 man/redist_optimal_gsmc_ms.Rd diff --git a/NAMESPACE b/NAMESPACE index e1a2bd7ee..f519576e6 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -181,6 +181,7 @@ export(redist_mcmc_ci) export(redist_mergesplit) export(redist_mergesplit_parallel) export(redist_optimal_gsmc) +export(redist_optimal_gsmc_ms) export(redist_plans) export(redist_quantile_trunc) export(redist_shortburst) diff --git a/R/redist_optimal_gsmc_ms.R b/R/redist_optimal_gsmc_ms.R index 810e5c2d0..f2e3d9284 100644 --- a/R/redist_optimal_gsmc_ms.R +++ b/R/redist_optimal_gsmc_ms.R @@ -82,27 +82,11 @@ redist_optimal_gsmc_ms <- function(state_map, M, counties = NULL, # number of merge split is sum of trues merge_split_step_vec <- val[order(id)] - # if the last step is merge split then make it one earlier - if(merge_split_step_vec[length(merge_split_step_vec)]){ - merge_split_vec_len <- length(merge_split_step_vec) - - merge_split_step_vec[merge_split_vec_len] <- FALSE - merge_split_step_vec[merge_split_vec_len-1] <- TRUE - - # now check if the last two are both merge split (should only - # happen when frequency is 1) then remove one - if( - merge_split_step_vec[merge_split_vec_len-1] && - merge_split_step_vec[merge_split_vec_len-2] ){ - merge_split_step_vec <- c( - merge_split_step_vec[1:(merge_split_vec_len-2)], - merge_split_step_vec[merge_split_vec_len] - ) - } - } } assertthat::assert_that(sum(!merge_split_step_vec) == total_smc_steps) + # assert first step is not smc + assertthat::assert_that(!merge_split_step_vec[1]) total_ms_steps <- sum(merge_split_step_vec) diff --git a/man/optimal_gsmc_plans.Rd b/man/optimal_gsmc_plans.Rd index 42c866d45..4eeca2f2f 100644 --- a/man/optimal_gsmc_plans.Rd +++ b/man/optimal_gsmc_plans.Rd @@ -14,7 +14,7 @@ optimal_gsmc_plans( upper, M, control, - ncores = -1L, + num_threads = -1L, verbosity = 3L, diagnostic_mode = FALSE ) @@ -40,12 +40,12 @@ relative to} \item{control}{Named list of additional parameters.} +\item{num_threads}{The number of threads the threadpool should use} + \item{verbosity}{What level of detail to print out while the algorithm is running \if{html}{\out{}}} \item{k_param}{The k parameter from the SMC algorithm, you choose among the top k_param edges} - -\item{num_threads}{The number of threads the threadpool should use} } \description{ Uses gsmc method with optimal weights to generate a sample of \code{M} plans in \verb{c++} diff --git a/man/optimal_gsmc_with_merge_split_plans.Rd b/man/optimal_gsmc_with_merge_split_plans.Rd index bd586794f..2f68701de 100644 --- a/man/optimal_gsmc_with_merge_split_plans.Rd +++ b/man/optimal_gsmc_with_merge_split_plans.Rd @@ -14,7 +14,7 @@ optimal_gsmc_with_merge_split_plans( upper, M, control, - ncores = -1L, + num_threads = -1L, verbosity = 3L, diagnostic_mode = FALSE ) @@ -40,12 +40,12 @@ relative to} \item{control}{Named list of additional parameters.} +\item{num_threads}{The number of threads the threadpool should use} + \item{verbosity}{What level of detail to print out while the algorithm is running \if{html}{\out{}}} \item{k_param}{The k parameter from the SMC algorithm, you choose among the top k_param edges} - -\item{num_threads}{The number of threads the threadpool should use} } \description{ Uses gsmc method with optimal weights and merge split steps to generate a sample of \code{M} plans in \verb{c++} diff --git a/man/redist_optimal_gsmc_ms.Rd b/man/redist_optimal_gsmc_ms.Rd new file mode 100644 index 000000000..6eb3062d3 --- /dev/null +++ b/man/redist_optimal_gsmc_ms.Rd @@ -0,0 +1,38 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/redist_optimal_gsmc_ms.R +\name{redist_optimal_gsmc_ms} +\alias{redist_optimal_gsmc_ms} +\title{OptimalgSMC with merge split Redistricting Sampler} +\usage{ +redist_optimal_gsmc_ms( + state_map, + M, + counties = NULL, + k_params = 6, + split_district_only = FALSE, + ms_freq = 7, + resample = TRUE, + runs = 1L, + ncores = 0L, + multiprocess = TRUE, + pop_temper = 0, + verbose = FALSE, + silent = FALSE, + diagnostic_mode = FALSE +) +} +\arguments{ +\item{k_params}{Either a single value to use as the splitting parameter for +every round or a vector of length N-1 where each value is the one to use for +a split.} + +\item{multiprocess}{Whether or not to launch multiple processes (sometimes +better to disable to avoid using too much memory.)} +} +\value{ +\code{redist_smc} returns a \link{redist_plans} object containing the simulated +plans. +} +\description{ +OptimalgSMC with merge split Redistricting Sampler +} diff --git a/man/redist_smc.Rd b/man/redist_smc.Rd index 6390687ab..81cf7e09b 100644 --- a/man/redist_smc.Rd +++ b/man/redist_smc.Rd @@ -21,6 +21,7 @@ redist_smc( trunc_fn = redist_quantile_trunc, pop_temper = 0, final_infl = 1, + multiprocess = FALSE, ref_name = NULL, verbose = FALSE, silent = FALSE diff --git a/src/smc_and_mcmc.cpp b/src/smc_and_mcmc.cpp index 26f01977f..d361c3e82 100644 --- a/src/smc_and_mcmc.cpp +++ b/src/smc_and_mcmc.cpp @@ -53,7 +53,6 @@ List optimal_gsmc_with_merge_split_plans( std::vector merge_split_step_vec = as>(control["merge_split_step_vec"]); - double pop_temper = as(control["pop_temper"]); // there are N-1 splits so for now just do it @@ -74,12 +73,6 @@ List optimal_gsmc_with_merge_split_plans( std::vector (M, -1) ); - - // return List::create( - // _["merge_split_steps"] = merge_split_step_vec, - // _["count"] = cnnt - // ); - // Make sure first merge split argument isn't true if(merge_split_step_vec.at(0)){ throw std::invalid_argument("The first entry of merge_split_step_vec cannot be true."); From 3e5eb3b9deba4f22581d55c8d2825f7e87cfe423 Mon Sep 17 00:00:00 2001 From: "Philip W. O'Sullivan" Date: Wed, 13 Nov 2024 20:48:21 -0500 Subject: [PATCH 043/324] changed so its now possible to run merge split after the final smc step --- R/redist_optimal_gsmc_ms.R | 1 - src/smc_and_mcmc.cpp | 13 +++++++++++-- task_tracker.md | 3 +++ 3 files changed, 14 insertions(+), 3 deletions(-) diff --git a/R/redist_optimal_gsmc_ms.R b/R/redist_optimal_gsmc_ms.R index f2e3d9284..40da8a225 100644 --- a/R/redist_optimal_gsmc_ms.R +++ b/R/redist_optimal_gsmc_ms.R @@ -237,7 +237,6 @@ redist_optimal_gsmc_ms <- function(state_map, M, counties = NULL, - if (length(algout) == 0) { cli::cli_process_done() cli::cli_process_done() diff --git a/src/smc_and_mcmc.cpp b/src/smc_and_mcmc.cpp index d361c3e82..91fde16ad 100644 --- a/src/smc_and_mcmc.cpp +++ b/src/smc_and_mcmc.cpp @@ -243,7 +243,7 @@ List optimal_gsmc_with_merge_split_plans( // Now for each run through split the map try { - for(int step_num=0; step_num< total_steps; step_num++){ + for(int step_num=0; step_num < total_steps; step_num++){ if(verbosity > 1){ if(merge_split_step_vec[step_num]){ Rprintf("Iteration %d: Merge Split Step %d \n", step_num+1, step_num - smc_step_num + 1); @@ -323,6 +323,7 @@ List optimal_gsmc_with_merge_split_plans( parent_unsuccessful_tries_mat.at(step_num) = parent_unsuccessful_tries_mat.at(step_num-1); nunique_parents_vec.at(step_num) = nunique_parents_vec.at(step_num-1); nunique_original_ancestors_vec.at(step_num) = nunique_original_ancestors_vec.at(step_num-1); + merge_split_step_num++; }else{ // else just run a normal smc step // split the map and we can use the previous original ancestor matrix row @@ -345,7 +346,12 @@ List optimal_gsmc_with_merge_split_plans( pool, verbosity ); - smc_step_num++; + // only increase if we have smc steps left else it will cause index issues + // with merge split + if(smc_step_num < total_smc_steps-1){ + smc_step_num++; + } + } if (verbosity == 1 && CLI_SHOULD_TICK){ @@ -372,6 +378,7 @@ List optimal_gsmc_with_merge_split_plans( + // compute effective sample size n_eff.at(step_num) = compute_n_eff(log_incremental_weights_mat.at(step_num)); @@ -401,6 +408,8 @@ List optimal_gsmc_with_merge_split_plans( return R_NilValue; } + + cli_progress_done(bar); diff --git a/task_tracker.md b/task_tracker.md index a653d1194..f45720950 100644 --- a/task_tracker.md +++ b/task_tracker.md @@ -8,6 +8,9 @@ Note all of the diagnostic information is accurately updated to account for a re # ----- ACTIVE TASKS ----- +**Fix merge split on district only splits** +Right now I think there's a bug where if you do merge split after the final smc step (so N districts) the district split only version still uses the remainder meaning it only merges regions adjacent to the remainder. Since this is unlabeled in that case it should just pick an arbitrary pair + **Change diagnostics.R to be better** Make the display for the new algorithm types better, also figure out a better way to calculate Rhats. For the ones that are by district it should compute for all districts and display the maximum. It also needs to have some way to store these results maybe . From 8a2ec6c0905d5d8543e769176c736b7a2546217f Mon Sep 17 00:00:00 2001 From: "Philip W. O'Sullivan" Date: Tue, 19 Nov 2024 21:52:09 -0500 Subject: [PATCH 044/324] can now specify multple of expected mcmc steps --- R/redist_optimal_gsmc_ms.R | 15 ++++++++++++--- src/smc_and_mcmc.cpp | 14 ++++---------- task_tracker.md | 3 +++ 3 files changed, 19 insertions(+), 13 deletions(-) diff --git a/R/redist_optimal_gsmc_ms.R b/R/redist_optimal_gsmc_ms.R index 40da8a225..b56199110 100644 --- a/R/redist_optimal_gsmc_ms.R +++ b/R/redist_optimal_gsmc_ms.R @@ -21,7 +21,7 @@ #' @export redist_optimal_gsmc_ms <- function(state_map, M, counties = NULL, k_params = 6, split_district_only = FALSE, - ms_freq = 7, + ms_freq = 7, ms_steps_multiplier = 1L, resample = TRUE, runs = 1L, ncores = 0L, multiprocess=TRUE, pop_temper = 0, @@ -61,6 +61,13 @@ redist_optimal_gsmc_ms <- function(state_map, M, counties = NULL, # create merge split parameter information + # check that ms_steps_multiplier is an integer + assertthat::assert_that( + floor(ms_steps_multiplier) == ms_steps_multiplier && + ms_steps_multiplier > 0, + msg = "`ms_steps_multiplier` must be a positive integer!" + ) + # there are N-1 splits so for now just do it total_smc_steps <- N-1 @@ -99,7 +106,8 @@ redist_optimal_gsmc_ms <- function(state_map, M, counties = NULL, pop_temper = pop_temper, k_params = k_params, split_district_only = split_district_only, - merge_split_step_vec = merge_split_step_vec + merge_split_step_vec = merge_split_step_vec, + ms_steps_multiplier = ms_steps_multiplier ) # TODO fix this later @@ -520,7 +528,8 @@ redist_optimal_gsmc_ms <- function(state_map, M, counties = NULL, step_split_types = algout$step_split_types, merge_split_success_mat = algout$merge_split_success_mat, merge_split_attempt_counts = algout$merge_split_attempt_counts, - num_ms_steps = num_ms_steps + num_ms_steps = num_ms_steps, + ms_steps_multiplier = ms_steps_multiplier ) diff --git a/src/smc_and_mcmc.cpp b/src/smc_and_mcmc.cpp index 91fde16ad..174de82b6 100644 --- a/src/smc_and_mcmc.cpp +++ b/src/smc_and_mcmc.cpp @@ -55,6 +55,8 @@ List optimal_gsmc_with_merge_split_plans( double pop_temper = as(control["pop_temper"]); + int ms_steps_multiplier = as(control["ms_steps_multiplier"]); + // there are N-1 splits so for now just do it int total_smc_steps = N-1; int total_ms_steps = std::count(merge_split_step_vec.begin(), merge_split_step_vec.end(), true); @@ -217,14 +219,6 @@ List optimal_gsmc_with_merge_split_plans( )); } - // return List::create( - // _["merge_split_steps"] = merge_split_step_vec, - // _["count"] = cnnt, - // _["region_dvals_mat_list"] = plan_d_vals_mat, - // _["region_order_added_list"] = plan_region_order_added_mat, - // _["region_ids_mat_list"] = plan_region_ids_mat - // ); - // Start off all the unnormalized weights at 1 std::vector unnormalized_sampling_weights(M, 1.0); @@ -285,10 +279,10 @@ List optimal_gsmc_with_merge_split_plans( // run merge split // Set the number of steps to run at 1 over previous stage acceptance rate // int nsteps_to_run = std::ceil(1/std::pow(acceptance_rates.at(step_num-1),1.5)); // * std::max(merge_split_step_num,1); - int nsteps_to_run = std::ceil(1/acceptance_rates.at(step_num-1)); // * std::max(merge_split_step_num,1); + int nsteps_to_run = ms_steps_multiplier * std::ceil(1/acceptance_rates.at(step_num-1)); // * std::max(merge_split_step_num,1); num_merge_split_attempts_vec.at(merge_split_step_num) = nsteps_to_run; - run_merge_split_step_on_all_plans( + run_merge_split_step_on_all_plans( pool, g, counties, cg, pop, plans_vec, diff --git a/task_tracker.md b/task_tracker.md index f45720950..e2762cd9a 100644 --- a/task_tracker.md +++ b/task_tracker.md @@ -8,6 +8,9 @@ Note all of the diagnostic information is accurately updated to account for a re # ----- ACTIVE TASKS ----- +**Pass results back in arma data types** +To make things more memory efficient change it so all results are passed back as arma vectors, matrices, or cubes for things that are multiple matrices. + **Fix merge split on district only splits** Right now I think there's a bug where if you do merge split after the final smc step (so N districts) the district split only version still uses the remainder meaning it only merges regions adjacent to the remainder. Since this is unlabeled in that case it should just pick an arbitrary pair From 8f0500d9dd367209ea9ce04bb49f14de4b1ed37a Mon Sep 17 00:00:00 2001 From: "Philip W. O'Sullivan" Date: Wed, 27 Nov 2024 22:28:06 -0500 Subject: [PATCH 045/324] Cory redist merge split now works --- R/redist_ms.R | 39 +++++---------- R/redist_ms_parallel.R | 105 +++++++++++++++++------------------------ src/mcmc_gibbs.cpp | 2 +- src/mcmc_gibbs.h | 2 +- src/merge_split.cpp | 41 +++++++--------- src/merge_split.h | 2 +- src/smc_and_mcmc.cpp | 35 ++++++++++++++ task_tracker.md | 3 +- 8 files changed, 112 insertions(+), 117 deletions(-) diff --git a/R/redist_ms.R b/R/redist_ms.R index 87c525a04..220f2a760 100644 --- a/R/redist_ms.R +++ b/R/redist_ms.R @@ -63,7 +63,6 @@ #' @param init_name a name for the initial plan, or \code{FALSE} to not include #' the initial plan in the output. Defaults to the column name of the #' existing plan, or "\code{}" if the initial plan is sampled. -#' @param silly_adj_fix Heuristic for fixing weird inputs. #' @param verbose Whether to print out intermediate information while sampling. #' Recommended. #' @param silent Whether to suppress all diagnostic information. @@ -104,7 +103,6 @@ redist_mergesplit <- function(map, nsims, thin = 1L, init_plan = NULL, counties = NULL, compactness = 1, constraints = list(), constraint_fn = function(m) rep(0, ncol(m)), adapt_k_thresh = 0.99, k = NULL, init_name = NULL, - silly_adj_fix = FALSE, verbose = FALSE, silent = FALSE) { if (!missing(constraint_fn)) cli_warn("{.arg constraint_fn} is deprecated.") @@ -128,10 +126,8 @@ redist_mergesplit <- function(map, nsims, exist_name <- attr(map, "existing_col") counties <- rlang::eval_tidy(rlang::enquo(counties), map) - orig_lookup = seq_len(ndists) if (is.null(init_plan) && !is.null(exist_name)) { init_plan <- vctrs::vec_group_id(get_existing(map)) - orig_lookup = unique(get_existing(map)) if (is.null(init_name)) init_name <- exist_name } else if (!is.null(init_plan) && is.null(init_name)) { init_name <- "" @@ -157,26 +153,12 @@ redist_mergesplit <- function(map, nsims, cli_abort("County vector must not contain missing values.") # handle discontinuous counties - if (silly_adj_fix) { - for (j in seq_len(ndists)) { - idx_distr = which(init_plan == j) - adj_distr = redist.reduce.adjacency(adj, idx_distr) - component <- contiguity(adj_distr, vctrs::vec_group_id(counties[idx_distr])) - counties[idx_distr] <- paste0( - j, ":", - dplyr::if_else(component > 1, - paste0(as.character(counties[idx_distr]), "-", component), - as.character(counties[idx_distr])) - ) - } - counties = vctrs::vec_group_id(counties) - } else { - component <- contiguity(adj, counties) - counties <- dplyr::if_else(component > 1, - paste0(as.character(counties), "-", component), - as.character(counties)) |> - vctrs::vec_group_id() - } + component <- contiguity(adj, vctrs::vec_group_id(counties)) + counties <- dplyr::if_else(component > 1, + paste0(as.character(counties), "-", component), + as.character(counties)) %>% + as.factor() %>% + as.integer() } # Other constraints @@ -223,10 +205,10 @@ redist_mergesplit <- function(map, nsims, warmup_idx <- c(seq_len(1 + warmup %/% thin), ncol(algout$plans)) l_diag <- list( - runtime = as.numeric(t2_run - t1_run, units = "secs") + runtime = as.numeric(t2_run - t1_run, units = "secs"), + prethinned_steps = nsims, + warmup = warmup ) - - out <- new_redist_plans(algout$plans[, -warmup_idx, drop = FALSE], map, "mergesplit", NULL, FALSE, ndists = ndists, @@ -240,9 +222,10 @@ redist_mergesplit <- function(map, nsims, warmup_idx <- c(seq_len(warmup %/% thin), length(acceptances)) out <- out %>% mutate(mcmc_accept = rep(acceptances[-warmup_idx], each = ndists)) + if (!is.null(init_name) && !isFALSE(init_name)) { out <- add_reference(out, init_plan, init_name) } out -} +} \ No newline at end of file diff --git a/R/redist_ms_parallel.R b/R/redist_ms_parallel.R index a6a750ede..984c45fed 100644 --- a/R/redist_ms_parallel.R +++ b/R/redist_ms_parallel.R @@ -49,7 +49,6 @@ redist_mergesplit_parallel <- function(map, nsims, chains = 1, constraints = list(), constraint_fn = function(m) rep(0, ncol(m)), adapt_k_thresh = 0.99, k = NULL, ncores = NULL, cl_type = "PSOCK", return_all = TRUE, init_name = NULL, - silly_adj_fix = FALSE, verbose = FALSE, silent = FALSE) { if (!missing(constraint_fn)) cli_warn("{.arg constraint_fn} is deprecated.") @@ -125,29 +124,13 @@ redist_mergesplit_parallel <- function(map, nsims, chains = 1, if (any(is.na(counties))) cli_abort("{.arg counties} must not contain missing values.") - if (silly_adj_fix) { - for (j in seq_len(ndists)) { - idx_distr <- which(init_plans[, 1] == j) - adj_distr <- redist.reduce.adjacency(adj, idx_distr) - component <- contiguity(adj_distr, vctrs::vec_group_id(counties[idx_distr])) - counties[idx_distr] <- paste0( - j, ":", - dplyr::if_else(component > 1, - paste0(as.character(counties[idx_distr]), "-", component), - as.character(counties[idx_distr])) - ) - } - counties <- vctrs::vec_group_id(counties) - } else { - counties = vctrs::vec_group_id(counties) - # handle discontinuous counties - component <- contiguity(adj, vctrs::vec_group_id(counties)) - counties <- dplyr::if_else(component > 1, - paste0(as.character(counties), "-", component), - as.character(counties)) %>% - as.factor() %>% - as.integer() - } + # handle discontinuous counties + component <- contiguity(adj, vctrs::vec_group_id(counties)) + counties <- dplyr::if_else(component > 1, + paste0(as.character(counties), "-", component), + as.character(counties)) %>% + as.factor() %>% + as.integer() } # Other constraints @@ -183,11 +166,19 @@ redist_mergesplit_parallel <- function(map, nsims, chains = 1, } control = list(adapt_k_thresh=adapt_k_thresh, do_mh=TRUE) - x <- ms_plans(1, adj, init_plans[, 1], counties, pop, ndists, pop_bounds[2], - pop_bounds[1], pop_bounds[3], compactness, - list(), control, 0L, 1L, verbosity = 0) - k <- x$est_k + # kind of hacky -- extract k=... from outupt + if (!requireNamespace("utils", quietly = TRUE)) stop() + out <- utils::capture.output({ + x <- ms_plans(1, adj, init_plans[, 1], counties, pop, ndists, pop_bounds[2], + pop_bounds[1], pop_bounds[3], compactness, list(), control, + 0L, 1L, verbosity = 3) + }, type = "output") rm(x) + k <- as.integer(stats::na.omit(stringr::str_match(out, "Using k = (\\d+)")[, 2])) + if (length(k) == 0) + cli_abort(c("Adaptive {.var k} not found. This error should not happen.", + ">" = "Please file an issue at + {.url https://github.com/alarm-redist/redist/issues/new}")) # set up parallel if (is.null(ncores)) ncores <- parallel::detectCores() @@ -195,18 +186,16 @@ redist_mergesplit_parallel <- function(map, nsims, chains = 1, of <- ifelse(Sys.info()[['sysname']] == 'Windows', tempfile(pattern = paste0('ms_', substr(Sys.time(), 1, 10)), fileext = '.txt'), '') - if (!silent) { - cl <- parallel::makeCluster(ncores, outfile = of, methods = FALSE, - useXDR = .Platform$endian != "little") - } else { - cl <- parallel::makeCluster(ncores, methods = FALSE, - useXDR = .Platform$endian != "little") - } - + if (!silent) + cl <- makeCluster(ncores, outfile = of, methods = FALSE, + useXDR = .Platform$endian != "little") + else + cl <- makeCluster(ncores, methods = FALSE, + useXDR = .Platform$endian != "little") doParallel::registerDoParallel(cl) - on.exit(parallel::stopCluster(cl)) + on.exit(stopCluster(cl)) - out_par <- foreach::foreach(chain = seq_len(chains), .inorder = FALSE, .packages="redist") %dorng% { + out_par <- foreach(chain = seq_len(chains), .inorder = FALSE, .packages="redist") %dorng% { if (!silent) cat("Starting chain ", chain, "\n", sep = "") run_verbosity <- if (chain == 1 || verbosity == 3) verbosity else 0 t1_run <- Sys.time() @@ -216,44 +205,38 @@ redist_mergesplit_parallel <- function(map, nsims, chains = 1, t2_run <- Sys.time() algout$l_diag <- list( - runtime = as.numeric(t2_run - t1_run, units = "secs") + runtime = as.numeric(t2_run - t1_run, units = "secs"), + prethinned_steps = nsims, + warmup = warmup ) - algout$mh <- mean(as.logical(algout$mhdecisions)) - - warmup_idx <- c(seq_len(1 + warmup %/% thin), nsims %/% thin + 2L) - if (return_all) { - algout$plans <- algout$plans[, -warmup_idx, drop = FALSE] - } else { - algout$plans <- algout$plans[, nsims + 1L, drop = FALSE] - } - storage.mode(algout$plans) <- "integer" - - warmup_idx <- c(seq_len(warmup %/% thin), nsims %/% thin + 1L) - if (!return_all) { - algout$mhdecisions <- as.logical(algout$mhdecisions[nsims]) - } else { - algout$mhdecisions <- as.logical(algout$mhdecisions[-warmup_idx]) - } - algout } - + warmup_idx <- c(seq_len(1 + warmup %/% thin), nsims %/% thin + 2L) plans <- lapply(out_par, function(algout) { - algout$plans + if (return_all) { + algout$plans[, -warmup_idx, drop = FALSE] + } else { + algout$plans[, nsims + 1L, drop = FALSE] + } }) each_len <- ncol(plans[[1]]) plans <- do.call(cbind, plans) storage.mode(plans) <- "integer" mh <- sapply(out_par, function(algout) { - algout$mh + mean(as.logical(algout$mhdecisions)) }) l_diag <- lapply(out_par, function(algout) algout$l_diag) + warmup_idx <- c(seq_len(warmup %/% thin), nsims %/% thin + 1L) acceptances <- sapply(out_par, function(algout) { - algout$mhdecisions + if (!return_all) { + as.logical(algout$mhdecisions[nsims]) + } else { + as.logical(algout$mhdecisions[-warmup_idx]) + } }) @@ -283,4 +266,4 @@ redist_mergesplit_parallel <- function(map, nsims, chains = 1, dplyr::relocate(out, chain, .after = "draw") } -utils::globalVariables("chain") +utils::globalVariables("chain") \ No newline at end of file diff --git a/src/mcmc_gibbs.cpp b/src/mcmc_gibbs.cpp index bcf0197b1..3a8a4e08d 100644 --- a/src/mcmc_gibbs.cpp +++ b/src/mcmc_gibbs.cpp @@ -140,4 +140,4 @@ double calc_gibbs_tgt(const subview_col &plan, int n_distr, int V, return log_tgt; -} +} \ No newline at end of file diff --git a/src/mcmc_gibbs.h b/src/mcmc_gibbs.h index 324b6a750..d7e375879 100644 --- a/src/mcmc_gibbs.h +++ b/src/mcmc_gibbs.h @@ -14,4 +14,4 @@ double calc_gibbs_tgt(const subview_col &plan, int n_distr, int V, std::vector districts, NumericVector &psi_vec, const uvec &pop, double parity, const Graph &g, List constraints); -#endif +#endif \ No newline at end of file diff --git a/src/merge_split.cpp b/src/merge_split.cpp index dddace1d9..3ab448e2d 100644 --- a/src/merge_split.cpp +++ b/src/merge_split.cpp @@ -82,18 +82,20 @@ Rcpp::List ms_plans(int N, List l, const uvec init, const uvec &counties, const for (int i = 1; i <= N; i++) { // make the proposal double prop_lp = 0.0; - reject_ct = 0; - do { - // copy old map to 'working' memory in `idx+1` - districts.col(idx+1) = districts.col(idx); + mh_decisions(idx - 1) = 0; + // copy old map to 'working' memory in `idx+1` + districts.col(idx+1) = districts.col(idx); + + select_pair(n_distr, dist_g, distr_1, distr_2); + prop_lp = split_map_ms(g, ust, counties, cg, districts.col(idx+1), + distr_1, distr_2, visited, ignore, + pop, lower, upper, target, k); - select_pair(n_distr, dist_g, distr_1, distr_2); - prop_lp = split_map_ms(g, ust, counties, cg, districts.col(idx+1), - distr_1, distr_2, visited, ignore, - pop, lower, upper, target, k); - if (reject_ct % 200 == 0) Rcpp::checkUserInterrupt(); - reject_ct++; - } while (!std::isfinite(prop_lp)); + if (!std::isfinite(prop_lp)) { + districts.col(idx+1) = districts.col(idx); + if (i % thin == 0) idx++; + continue; // reject + } // tau calculations if (rho != 1) { @@ -131,22 +133,13 @@ Rcpp::List ms_plans(int N, List l, const uvec init, const uvec &counties, const 1.0/new_dist_g[distr_1 - 1].size() + 1.0/new_dist_g[distr_2 - 1].size() ); - if (do_mh) { - double alpha = std::exp(prop_lp); - if (alpha >= 1 || r_unif() <= alpha) { // ACCEPT + if (!do_mh || prop_lp >= 0 || std::log(r_unif()) <= prop_lp) { // ACCEPT n_accept++; districts.col(idx) = districts.col(idx+1); // copy over new map dist_g = new_dist_g; mh_decisions(idx - 1) = 1; - } else { // REJECT - districts.col(idx+1) = districts.col(idx); // copy over old map - mh_decisions(idx - 1) = 0; - } - } else { - n_accept++; - districts.col(idx) = districts.col(idx+1); // copy over new map - dist_g = new_dist_g; - mh_decisions(idx - 1) = 1; + } else { // reject + districts.col(idx+1) = districts.col(idx); } if (i % thin == 0) idx++; @@ -369,4 +362,4 @@ void select_pair(int n_distr, const Graph &dist_g, int &i, int &j) { std::vector nbors = dist_g[i]; j = nbors[r_int(nbors.size())] + 1; i++; -} +} \ No newline at end of file diff --git a/src/merge_split.h b/src/merge_split.h index 92a354c5e..fdf503611 100644 --- a/src/merge_split.h +++ b/src/merge_split.h @@ -57,4 +57,4 @@ void adapt_ms_parameters(const Graph &g, int n_distr, int &k, double thresh, */ void select_pair(int n_distr, const Graph &dist_g, int &i, int &j); -#endif +#endif \ No newline at end of file diff --git a/src/smc_and_mcmc.cpp b/src/smc_and_mcmc.cpp index 174de82b6..1e97b94b2 100644 --- a/src/smc_and_mcmc.cpp +++ b/src/smc_and_mcmc.cpp @@ -8,6 +8,41 @@ #include "smc_and_mcmc.h" +// #include +// #include +// #include +// #include // std::iota +// #include + +// std::vector getRelativeOrder(const std::vector& rel_order) { +// // Create a vector of indices [0, 1, 2, ..., rel_order.size()-1] +// std::vector indices(rel_order.size()); +// for (size_t i = 0; i < indices.size(); ++i) { +// indices[i] = i; +// } + +// // Sort the indices based on the values in rel_order +// std::sort(indices.begin(), indices.end(), [&rel_order](int a, int b) { +// return rel_order[a] < rel_order[b]; +// }); + +// std::cout<<"Intermediate ["; +// for(size_t i = 0; i < indices.size(); i++){ +// std::cout << " " << indices[i]; +// } +// std::cout<<" ]\n"; + +// // Create a mapping vector to store the result +// std::vector result(rel_order.size()); +// for (size_t i = 0; i < indices.size(); ++i) { +// result[indices[i]] = i; +// } + +// return result; +// } + + + //' Uses gsmc method to generate a sample of `M` plans in `c++` //' //' Using the procedure outlined in this function uses Sequential diff --git a/task_tracker.md b/task_tracker.md index e2762cd9a..146a51aed 100644 --- a/task_tracker.md +++ b/task_tracker.md @@ -54,7 +54,8 @@ Need to more cleanly seperate diagnostic information from stuff in the final sam **For Previous tries track previous index not the current new particle** - `draw_tries_vec` is the one. Make one that tracks the previous sampled index - +**Ask why log compactness takes district matrix despite only using column** +The compute log tau term here: https://github.com/alarm-redist/redistmetrics/blob/5f7b36d8a7f9c7bc3c9098a7b6c6aa561d9074c7/inst/include/kirchhoff_inline.h#L16 takes a matrix of district values but only actually uses a single column. That can probably be changed. # ----- GENERAL THOUGHTS ----- From 732ecbc0f1fc1033992291ca22dadb4c5fbdfd5a Mon Sep 17 00:00:00 2001 From: "Philip W. O'Sullivan" Date: Fri, 6 Dec 2024 21:15:02 -0500 Subject: [PATCH 046/324] attempting to rename package to gredist --- .gitignore | 2 +- DESCRIPTION | 6 +- NAMESPACE | 112 ++++---- NEWS.md | 36 +-- R/RcppExports.R | 116 ++++---- R/adjacency.R | 22 +- R/classify_compare.R | 2 +- R/confint.R | 2 +- R/cores.R | 10 +- R/counties.R | 10 +- R/crsg.R | 14 +- R/data.R | 8 +- R/deprecations.R | 62 ++-- R/distances.R | 10 +- R/enumpart.R | 64 ++--- R/findtarget.R | 6 +- R/flip_helpers.R | 22 +- R/freeze.R | 10 +- R/map_helpers.R | 4 +- R/parity.R | 2 +- R/plans_helpers.R | 8 +- R/plot_cores.R | 4 +- R/plot_diagnostics.R | 20 +- R/plot_majmin.R | 4 +- R/plot_map.R | 16 +- R/plot_penalty.R | 2 +- R/plot_plans.R | 44 +-- R/plot_varinfo.R | 6 +- R/plot_weighted_adj.R | 12 +- R/pop_overlap.R | 16 +- R/proj.R | 8 +- R/random_subgraph.R | 4 +- R/redist-package.R | 22 -- R/redist-preproc.R | 14 +- R/redistMPI.R | 56 ++-- R/redist_constr.R | 6 +- R/redist_findparams.R | 14 +- R/redist_flip.R | 16 +- R/redist_map.R | 22 +- R/redist_ms.R | 5 +- R/redist_ms_parallel.R | 9 +- R/redist_optimal_gsmc.R | 8 +- R/redist_optimal_gsmc_ms.R | 8 +- R/redist_plans.R | 4 +- R/redist_shortburst.R | 4 +- R/redist_smc.R | 6 +- R/reindex.R | 6 +- R/rsg.R | 16 +- R/tidy_deprecations.R | 28 +- README.Rmd | 28 +- README.md | 28 +- _pkgdown.yml | 8 +- cran-comments.md | 2 +- docs/404.html | 12 +- docs/LICENSE.html | 10 +- docs/articles/common_args.html | 30 +- docs/articles/flip.html | 318 ++++++++++++++++----- docs/articles/glossary.html | 30 +- docs/articles/index.html | 14 +- docs/articles/map-preproc.html | 56 ++-- docs/articles/mcmc.html | 74 ++--- docs/articles/mpi-slurm.html | 60 ++-- docs/articles/redist.html | 76 ++--- docs/authors.html | 22 +- docs/index.html | 54 ++-- docs/news/index.html | 48 ++-- docs/pkgdown.yml | 2 +- docs/reference/EPSG.html | 18 +- docs/reference/add_reference.html | 14 +- docs/reference/avg_by_prec.html | 14 +- docs/reference/classify_plans.html | 16 +- docs/reference/compare_plans.html | 14 +- docs/reference/constraints.html | 16 +- docs/reference/fl25.html | 16 +- docs/reference/fl250.html | 12 +- docs/reference/fl25_adj.html | 16 +- docs/reference/fl25_enum.html | 16 +- docs/reference/fl70.html | 12 +- docs/reference/get_adj.html | 12 +- docs/reference/get_existing.html | 12 +- docs/reference/get_mh_acceptance_rate.html | 12 +- docs/reference/get_plans_matrix.html | 12 +- docs/reference/get_plans_weights.html | 12 +- docs/reference/get_pop_tol.html | 12 +- docs/reference/get_sampling_info.html | 12 +- docs/reference/get_target.html | 12 +- docs/reference/index.html | 126 ++++---- docs/reference/iowa.html | 14 +- docs/reference/is_contiguous.html | 12 +- docs/reference/is_county_split.html | 12 +- docs/reference/last_plan.html | 12 +- docs/reference/match_numbers.html | 14 +- docs/reference/merge_by.html | 14 +- docs/reference/min_move_parity.html | 14 +- docs/reference/number_by.html | 14 +- docs/reference/persily.html | 16 +- docs/reference/pick_a_plan.html | 12 +- docs/reference/pl.html | 12 +- docs/reference/plans_diversity.html | 14 +- docs/reference/plot.redist_classified.html | 12 +- docs/reference/plot.redist_constr.html | 14 +- docs/reference/plot.redist_map.html | 8 +- man/redist_mergesplit.Rd | 3 - man/redist_mergesplit_parallel.Rd | 3 - man/redist_optimal_gsmc_ms.Rd | 1 + redist.Rproj | 21 -- src/RcppExports.cpp | 235 ++++++++------- src/make_swaps_helper.cpp | 1 - src/merge_split.cpp | 11 +- src/merge_split.h | 1 + src/merging.cpp | 3 + task_tracker.md | 5 +- 112 files changed, 1386 insertions(+), 1258 deletions(-) delete mode 100644 R/redist-package.R delete mode 100644 redist.Rproj diff --git a/.gitignore b/.gitignore index 186295902..9de20d162 100644 --- a/.gitignore +++ b/.gitignore @@ -19,4 +19,4 @@ docs/articles/*_cache/* vignettes/*_cache/* src-i386/ inst/enumpart/enumpart.exe -redist/tests/testthat/_snaps +gredist/tests/testthat/_snaps diff --git a/DESCRIPTION b/DESCRIPTION index f5a42a957..763a2d221 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,4 +1,4 @@ -Package: redist +Package: gredist Version: 4.2.0.9000 Date: 2024-01-11 Title: Simulation Methods for Legislative Redistricting @@ -61,8 +61,8 @@ LinkingTo: Rcpp, RcppArmadillo, RcppThread, cli, redistmetrics License: GPL (>= 2) SystemRequirements: C++17, python NeedsCompilation: yes -BugReports: https://github.com/alarm-redist/redist/issues -URL: https://alarm-redist.org/redist/ +BugReports: https://github.com/alarm-gredist/gredist/issues +URL: https://alarm-gredist.org/gredist/ Roxygen: list(markdown = TRUE) RoxygenNote: 7.3.2 VignetteBuilder: knitr diff --git a/NAMESPACE b/NAMESPACE index f519576e6..0ae9fa441 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -117,61 +117,61 @@ export(proj_avg) export(proj_contr) export(proj_distr) export(pullback) -export(redist.adjacency) -export(redist.calc.frontier.size) -export(redist.coarsen.adjacency) -export(redist.combine.mpi) -export(redist.compactness) -export(redist.competitiveness) -export(redist.constraint.helper) -export(redist.county.id) -export(redist.county.relabel) -export(redist.crsg) -export(redist.diagplot) -export(redist.dist.pop.overlap) -export(redist.distances) -export(redist.district.splits) -export(redist.enumpart) -export(redist.find.target) -export(redist.findparams) -export(redist.freeze) -export(redist.group.percent) -export(redist.identify.cores) -export(redist.init.enumpart) -export(redist.ipw) -export(redist.mcmc.mpi) -export(redist.metrics) -export(redist.multisplits) -export(redist.muni.splits) -export(redist.parity) -export(redist.plot.adj) -export(redist.plot.contr_pfdr) -export(redist.plot.cores) -export(redist.plot.distr_qtys) -export(redist.plot.hist) -export(redist.plot.majmin) -export(redist.plot.map) -export(redist.plot.penalty) -export(redist.plot.plans) -export(redist.plot.scatter) -export(redist.plot.trace) -export(redist.plot.varinfo) -export(redist.plot.wted.adj) -export(redist.prec.pop.overlap) -export(redist.prep.enumpart) -export(redist.random.subgraph) -export(redist.read.enumpart) -export(redist.reduce.adjacency) -export(redist.reorder) -export(redist.rsg) -export(redist.run.enumpart) -export(redist.segcalc) -export(redist.sink.plan) -export(redist.smc_is_ci) -export(redist.splits) -export(redist.subset) -export(redist.uncoarsen) -export(redist.wted.adj) +export(gredist.adjacency) +export(gredist.calc.frontier.size) +export(gredist.coarsen.adjacency) +export(gredist.combine.mpi) +export(gredist.compactness) +export(gredist.competitiveness) +export(gredist.constraint.helper) +export(gredist.county.id) +export(gredist.county.relabel) +export(gredist.crsg) +export(gredist.diagplot) +export(gredist.dist.pop.overlap) +export(gredist.distances) +export(gredist.district.splits) +export(gredist.enumpart) +export(gredist.find.target) +export(gredist.findparams) +export(gredist.freeze) +export(gredist.group.percent) +export(gredist.identify.cores) +export(gredist.init.enumpart) +export(gredist.ipw) +export(gredist.mcmc.mpi) +export(gredist.metrics) +export(gredist.multisplits) +export(gredist.muni.splits) +export(gredist.parity) +export(gredist.plot.adj) +export(gredist.plot.contr_pfdr) +export(gredist.plot.cores) +export(gredist.plot.distr_qtys) +export(gredist.plot.hist) +export(gredist.plot.majmin) +export(gredist.plot.map) +export(gredist.plot.penalty) +export(gredist.plot.plans) +export(gredist.plot.scatter) +export(gredist.plot.trace) +export(gredist.plot.varinfo) +export(gredist.plot.wted.adj) +export(gredist.prec.pop.overlap) +export(gredist.prep.enumpart) +export(gredist.random.subgraph) +export(gredist.read.enumpart) +export(gredist.reduce.adjacency) +export(gredist.reorder) +export(gredist.rsg) +export(gredist.run.enumpart) +export(gredist.segcalc) +export(gredist.sink.plan) +export(gredist.smc_is_ci) +export(gredist.splits) +export(gredist.subset) +export(gredist.uncoarsen) +export(gredist.wted.adj) export(redist_ci) export(redist_constr) export(redist_flip) @@ -317,4 +317,4 @@ importFrom(utils,head) importFrom(utils,packageVersion) importFrom(utils,str) importFrom(utils,tail) -useDynLib(redist, .registration = TRUE) +useDynLib(gredist, .registration = TRUE) diff --git a/NEWS.md b/NEWS.md index 9534facce..2dc94c3be 100644 --- a/NEWS.md +++ b/NEWS.md @@ -14,21 +14,21 @@ With multiple scorers, the algorithm will stochastically explore to try to find the largest Pareto frontier for the scores. The frontier can be accessed with `attr(, "pareto_score")`. -* Removes the MPI vignette which relied on older implementations of `redist.mcmc()`, which was replaced by `redist.flip()` a few years ago, and finally `redist_flip()`. +* Removes the MPI vignette which relied on older implementations of `gredist.mcmc()`, which was replaced by `gredist.flip()` a few years ago, and finally `redist_flip()`. -# redist 4.1.1 +# gredist 4.1.1 * Resolves a sanitizer error for CRAN -# redist 4.1.0 +# gredist 4.1.0 * Improved diagnostic output * New `redist_ci` interface for confidence interval calculation -* Improved plotting options with `redist.plot.distr_qtys()` for custom geometry types. +* Improved plotting options with `gredist.plot.distr_qtys()` for custom geometry types. * Improved resampling efficiency at the final SMC stage * Faster implementation of loop-erased random walk in C++ * Faster random number generation in C++ * Updated citation information -# redist 4.0.0 +# gredist 4.0.0 * A new constraint interface that is more flexible, user friendly, and consistent across algorithms (see `redist_constr()` and `?constraints`). For the first time, user-defined custom constraints are supported and integrated within all three @@ -51,24 +51,24 @@ warnings throughout the package of ways to sequentially label districts. This factor should not have an effect on substantive conclusions and summary statistics. * Remove deprecated functions -* Many bug fixes (see https://github.com/alarm-redist/redist/issues) +* Many bug fixes (see https://github.com/alarm-gredist/gredist/issues) -# redist 3.1.6 +# gredist 3.1.6 * Utilities for using municipalities as well as counties in split calculations -# redist 3.1.5 +# gredist 3.1.5 * skip SMC test on Linux -# redist 3.1.4 +# gredist 3.1.4 * skip SMC test on Solaris -# redist 3.1.2 -* Fixes crash caused by `redist.splits()` +# gredist 3.1.2 +* Fixes crash caused by `gredist.splits()` -# redist 3.1.1 +# gredist 3.1.1 * Fixes printing bug in `color_graph()` -# redist 3.1.0 +# gredist 3.1.0 * Removes prior deprecated functions and arguments * Fix bugs (#78, #81, #86) * Introduces `redist_mergesplit_parallel()` @@ -76,11 +76,11 @@ on substantive conclusions and summary statistics. * Improves sampling speed for SMC and Merge-split with county constraint * Adds county split measures. * Adds population overlap measures for plan comparisons. -* Deprecates `redist.smc()` in favor of `redist_smc()` and `redist.mergesplit()` in favor of `redist_mergesplit()`. -# redist 3.0.2 +* Deprecates `gredist.smc()` in favor of `redist_smc()` and `gredist.mergesplit()` in favor of `redist_mergesplit()`. +# gredist 3.0.2 * Fix bugs (#60, #61, #62, #70, #71, #72), including s2 compatibility, Solaris fixes, and improved dplyr verb robustness. -# redist 3.0.1 +# gredist 3.0.1 * New tidy interface, including new `redist_map` and `redist_plans` objects * Merge-split MCMC now available in `redist_mergesplit()` @@ -100,7 +100,7 @@ on substantive conclusions and summary statistics. * Various bug fixes -# redist 2.0.4 +# gredist 2.0.4 -* New `redist.subset` allows for easy subsetting of an adjacency graph +* New `gredist.subset` allows for easy subsetting of an adjacency graph * Added a `NEWS.md` file to track changes to the package diff --git a/R/RcppExports.R b/R/RcppExports.R index 5c4bb9d85..c9600ba28 100644 --- a/R/RcppExports.R +++ b/R/RcppExports.R @@ -2,107 +2,107 @@ # Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 reduce_adj <- function(adj_list, prec_map, n_keep) { - .Call(`_redist_reduce_adj`, adj_list, prec_map, n_keep) + .Call(`_gredist_reduce_adj`, adj_list, prec_map, n_keep) } collapse_adj <- function(graph, idxs) { - .Call(`_redist_collapse_adj`, graph, idxs) + .Call(`_gredist_collapse_adj`, graph, idxs) } coarsen_adjacency <- function(adj, groups) { - .Call(`_redist_coarsen_adjacency`, adj, groups) + .Call(`_gredist_coarsen_adjacency`, adj, groups) } get_plan_graph <- function(l, V, plan, n_distr) { - .Call(`_redist_get_plan_graph`, l, V, plan, n_distr) + .Call(`_gredist_get_plan_graph`, l, V, plan, n_distr) } color_graph <- function(l, plan) { - .Call(`_redist_color_graph`, l, plan) + .Call(`_gredist_color_graph`, l, plan) } polsbypopper <- function(from, to, area, perimeter, dm, nd) { - .Call(`_redist_polsbypopper`, from, to, area, perimeter, dm, nd) + .Call(`_gredist_polsbypopper`, from, to, area, perimeter, dm, nd) } genAlConn <- function(aList, cds) { - .Call(`_redist_genAlConn`, aList, cds) + .Call(`_gredist_genAlConn`, aList, cds) } findBoundary <- function(fullList, conList) { - .Call(`_redist_findBoundary`, fullList, conList) + .Call(`_gredist_findBoundary`, fullList, conList) } contiguity <- function(adj, group) { - .Call(`_redist_contiguity`, adj, group) + .Call(`_gredist_contiguity`, adj, group) } cores <- function(adj, dm, k, cd_within_k) { - .Call(`_redist_cores`, adj, dm, k, cd_within_k) + .Call(`_gredist_cores`, adj, dm, k, cd_within_k) } update_conncomp <- function(dm, kvec, adj) { - .Call(`_redist_update_conncomp`, dm, kvec, adj) + .Call(`_gredist_update_conncomp`, dm, kvec, adj) } crsg <- function(adj_list, population, area, x_center, y_center, Ndistrict, target_pop, thresh, maxiter) { - .Call(`_redist_crsg`, adj_list, population, area, x_center, y_center, Ndistrict, target_pop, thresh, maxiter) + .Call(`_gredist_crsg`, adj_list, population, area, x_center, y_center, Ndistrict, target_pop, thresh, maxiter) } dist_dist_diff <- function(p, i_dist, j_dist, x_center, y_center, x, y) { - .Call(`_redist_dist_dist_diff`, p, i_dist, j_dist, x_center, y_center, x, y) + .Call(`_gredist_dist_dist_diff`, p, i_dist, j_dist, x_center, y_center, x, y) } log_st_map <- function(g, districts, counties, n_distr) { - .Call(`_redist_log_st_map`, g, districts, counties, n_distr) + .Call(`_gredist_log_st_map`, g, districts, counties, n_distr) } n_removed <- function(g, districts, n_distr) { - .Call(`_redist_n_removed`, g, districts, n_distr) + .Call(`_gredist_n_removed`, g, districts, n_distr) } countpartitions <- function(aList) { - .Call(`_redist_countpartitions`, aList) + .Call(`_gredist_countpartitions`, aList) } calcPWDh <- function(x) { - .Call(`_redist_calcPWDh`, x) + .Call(`_gredist_calcPWDh`, x) } group_pct_top_k <- function(m, group_pop, total_pop, k, n_distr) { - .Call(`_redist_group_pct_top_k`, m, group_pop, total_pop, k, n_distr) + .Call(`_gredist_group_pct_top_k`, m, group_pop, total_pop, k, n_distr) } proj_distr_m <- function(districts, x, draw_idx, n_distr) { - .Call(`_redist_proj_distr_m`, districts, x, draw_idx, n_distr) + .Call(`_gredist_proj_distr_m`, districts, x, draw_idx, n_distr) } colmax <- function(x) { - .Call(`_redist_colmax`, x) + .Call(`_gredist_colmax`, x) } colmin <- function(x) { - .Call(`_redist_colmin`, x) + .Call(`_gredist_colmin`, x) } prec_cooccur <- function(m, idxs, ncores = 0L) { - .Call(`_redist_prec_cooccur`, m, idxs, ncores) + .Call(`_gredist_prec_cooccur`, m, idxs, ncores) } group_pct <- function(m, group_pop, total_pop, n_distr) { - .Call(`_redist_group_pct`, m, group_pop, total_pop, n_distr) + .Call(`_gredist_group_pct`, m, group_pop, total_pop, n_distr) } pop_tally <- function(districts, pop, n_distr) { - .Call(`_redist_pop_tally`, districts, pop, n_distr) + .Call(`_gredist_pop_tally`, districts, pop, n_distr) } max_dev <- function(districts, pop, n_distr) { - .Call(`_redist_max_dev`, districts, pop, n_distr) + .Call(`_gredist_max_dev`, districts, pop, n_distr) } ms_plans <- function(N, l, init, counties, pop, n_distr, target, lower, upper, rho, constraints, control, k, thin, verbosity) { - .Call(`_redist_ms_plans`, N, l, init, counties, pop, n_distr, target, lower, upper, rho, constraints, control, k, thin, verbosity) + .Call(`_gredist_ms_plans`, N, l, init, counties, pop, n_distr, target, lower, upper, rho, constraints, control, k, thin, verbosity) } #' Uses gsmc method with optimal weights to generate a sample of `M` plans in `c++` @@ -129,91 +129,91 @@ ms_plans <- function(N, l, init, counties, pop, n_distr, target, lower, upper, r #' running #' @export optimal_gsmc_plans <- function(N, adj_list, counties, pop, target, lower, upper, M, control, num_threads = -1L, verbosity = 3L, diagnostic_mode = FALSE) { - .Call(`_redist_optimal_gsmc_plans`, N, adj_list, counties, pop, target, lower, upper, M, control, num_threads, verbosity, diagnostic_mode) + .Call(`_gredist_optimal_gsmc_plans`, N, adj_list, counties, pop, target, lower, upper, M, control, num_threads, verbosity, diagnostic_mode) } pareto_dominated <- function(x) { - .Call(`_redist_pareto_dominated`, x) + .Call(`_gredist_pareto_dominated`, x) } testing_sample_forest <- function(l, pop, lower, upper, counties, ignore) { - .Call(`_redist_testing_sample_forest`, l, pop, lower, upper, counties, ignore) + .Call(`_gredist_testing_sample_forest`, l, pop, lower, upper, counties, ignore) } perform_a_valid_region_split_then_merge_split <- function(adj_list, counties, pop, k_param, region_id_to_split, target, lower, upper, N, num_regions, num_districts, region_ids, region_dvals, region_pops, split_district_only, num_merge_split_steps, verbose) { - .Call(`_redist_perform_a_valid_region_split_then_merge_split`, adj_list, counties, pop, k_param, region_id_to_split, target, lower, upper, N, num_regions, num_districts, region_ids, region_dvals, region_pops, split_district_only, num_merge_split_steps, verbose) + .Call(`_gredist_perform_a_valid_region_split_then_merge_split`, adj_list, counties, pop, k_param, region_id_to_split, target, lower, upper, N, num_regions, num_districts, region_ids, region_dvals, region_pops, split_district_only, num_merge_split_steps, verbose) } one_cut_then_merge_split <- function(N, adj_list, counties, pop, target, lower, upper, split_district_only, num_merge_split_steps, verbose) { - .Call(`_redist_one_cut_then_merge_split`, N, adj_list, counties, pop, target, lower, upper, split_district_only, num_merge_split_steps, verbose) + .Call(`_gredist_one_cut_then_merge_split`, N, adj_list, counties, pop, target, lower, upper, split_district_only, num_merge_split_steps, verbose) } plan_class_testing <- function(V, num_regions, num_districts) { - .Call(`_redist_plan_class_testing`, V, num_regions, num_districts) + .Call(`_gredist_plan_class_testing`, V, num_regions, num_districts) } split_entire_map <- function(N, adj_list, counties, pop, target, lower, upper, verbose = FALSE) { - .Call(`_redist_split_entire_map`, N, adj_list, counties, pop, target, lower, upper, verbose) + .Call(`_gredist_split_entire_map`, N, adj_list, counties, pop, target, lower, upper, verbose) } split_all_the_way <- function(N, adj_list, counties, pop, target, lower, upper, verbose) { - .Call(`_redist_split_all_the_way`, N, adj_list, counties, pop, target, lower, upper, verbose) + .Call(`_gredist_split_all_the_way`, N, adj_list, counties, pop, target, lower, upper, verbose) } copy_semantics_tester_outer <- function() { - invisible(.Call(`_redist_copy_semantics_tester_outer`)) + invisible(.Call(`_gredist_copy_semantics_tester_outer`)) } test_cpp_discrete_distribution <- function() { - invisible(.Call(`_redist_test_cpp_discrete_distribution`)) + invisible(.Call(`_gredist_test_cpp_discrete_distribution`)) } test_region_lev_graph_stuff <- function(N, adj_list, counties, pop, target, lower, upper, verbose) { - .Call(`_redist_test_region_lev_graph_stuff`, N, adj_list, counties, pop, target, lower, upper, verbose) + .Call(`_gredist_test_region_lev_graph_stuff`, N, adj_list, counties, pop, target, lower, upper, verbose) } closest_adj_pop <- function(adj, i_dist, g_prop) { - .Call(`_redist_closest_adj_pop`, adj, i_dist, g_prop) + .Call(`_gredist_closest_adj_pop`, adj, i_dist, g_prop) } rint1 <- function(n, max) { - .Call(`_redist_rint1`, n, max) + .Call(`_gredist_rint1`, n, max) } runif1 <- function(n, max) { - .Call(`_redist_runif1`, n, max) + .Call(`_gredist_runif1`, n, max) } resample_lowvar <- function(wgts) { - .Call(`_redist_resample_lowvar`, wgts) + .Call(`_gredist_resample_lowvar`, wgts) } plan_joint <- function(m1, m2, pop) { - .Call(`_redist_plan_joint`, m1, m2, pop) + .Call(`_gredist_plan_joint`, m1, m2, pop) } renumber_matrix <- function(plans, renumb) { - .Call(`_redist_renumber_matrix`, plans, renumb) + .Call(`_gredist_renumber_matrix`, plans, renumb) } solve_hungarian <- function(costMatrix) { - .Call(`_redist_solve_hungarian`, costMatrix) + .Call(`_gredist_solve_hungarian`, costMatrix) } rsg <- function(adj_list, population, Ndistrict, target_pop, thresh, maxiter) { - .Call(`_redist_rsg`, adj_list, population, Ndistrict, target_pop, thresh, maxiter) + .Call(`_gredist_rsg`, adj_list, population, Ndistrict, target_pop, thresh, maxiter) } k_smallest <- function(x, k = 1L) { - .Call(`_redist_k_smallest`, x, k) + .Call(`_gredist_k_smallest`, x, k) } k_biggest <- function(x, k = 1L) { - .Call(`_redist_k_biggest`, x, k) + .Call(`_gredist_k_biggest`, x, k) } smc_plans <- function(N, l, counties, pop, n_distr, target, lower, upper, rho, districts, n_drawn, n_steps, constraints, control, verbosity = 1L) { - .Call(`_redist_smc_plans`, N, l, counties, pop, n_distr, target, lower, upper, rho, districts, n_drawn, n_steps, constraints, control, verbosity) + .Call(`_gredist_smc_plans`, N, l, counties, pop, n_distr, target, lower, upper, rho, districts, n_drawn, n_steps, constraints, control, verbosity) } #' Uses gsmc method with optimal weights and merge split steps to generate a sample of `M` plans in `c++` @@ -240,15 +240,15 @@ smc_plans <- function(N, l, counties, pop, n_distr, target, lower, upper, rho, d #' running #' @export optimal_gsmc_with_merge_split_plans <- function(N, adj_list, counties, pop, target, lower, upper, M, control, num_threads = -1L, verbosity = 3L, diagnostic_mode = FALSE) { - .Call(`_redist_optimal_gsmc_with_merge_split_plans`, N, adj_list, counties, pop, target, lower, upper, M, control, num_threads, verbosity, diagnostic_mode) + .Call(`_gredist_optimal_gsmc_with_merge_split_plans`, N, adj_list, counties, pop, target, lower, upper, M, control, num_threads, verbosity, diagnostic_mode) } splits <- function(dm, community, nd, max_split) { - .Call(`_redist_splits`, dm, community, nd, max_split) + .Call(`_gredist_splits`, dm, community, nd, max_split) } dist_cty_splits <- function(dm, community, nd) { - .Call(`_redist_dist_cty_splits`, dm, community, nd) + .Call(`_gredist_dist_cty_splits`, dm, community, nd) } #' Selects a multidistrict with probability proportional to its d_nk value and @@ -518,19 +518,19 @@ NULL NULL perform_a_valid_region_split <- function(adj_list, counties, pop, k_param, region_id_to_split, target, lower, upper, N, num_regions, num_districts, region_ids, region_dvals, region_pops, split_district_only, verbose) { - .Call(`_redist_perform_a_valid_region_split`, adj_list, counties, pop, k_param, region_id_to_split, target, lower, upper, N, num_regions, num_districts, region_ids, region_dvals, region_pops, split_district_only, verbose) + .Call(`_gredist_perform_a_valid_region_split`, adj_list, counties, pop, k_param, region_id_to_split, target, lower, upper, N, num_regions, num_districts, region_ids, region_dvals, region_pops, split_district_only, verbose) } perform_merge_split_steps <- function(adj_list, counties, pop, k_param, target, lower, upper, N, num_regions, num_districts, region_ids, region_dvals, region_pops, split_district_only, num_merge_split_steps, verbose) { - .Call(`_redist_perform_merge_split_steps`, adj_list, counties, pop, k_param, target, lower, upper, N, num_regions, num_districts, region_ids, region_dvals, region_pops, split_district_only, num_merge_split_steps, verbose) + .Call(`_gredist_perform_merge_split_steps`, adj_list, counties, pop, k_param, target, lower, upper, N, num_regions, num_districts, region_ids, region_dvals, region_pops, split_district_only, num_merge_split_steps, verbose) } swMH <- function(aList, cdvec, popvec, nsims, constraints, eprob, pct_dist_parity, beta_sequence, beta_weights, lambda = 0L, beta = 0.0, adapt_beta = "none", adjswap = 1L, exact_mh = 0L, adapt_eprob = 0L, adapt_lambda = 0L, num_hot_steps = 0L, num_annealing_steps = 0L, num_cold_steps = 0L, verbose = TRUE) { - .Call(`_redist_swMH`, aList, cdvec, popvec, nsims, constraints, eprob, pct_dist_parity, beta_sequence, beta_weights, lambda, beta, adapt_beta, adjswap, exact_mh, adapt_eprob, adapt_lambda, num_hot_steps, num_annealing_steps, num_cold_steps, verbose) + .Call(`_gredist_swMH`, aList, cdvec, popvec, nsims, constraints, eprob, pct_dist_parity, beta_sequence, beta_weights, lambda, beta, adapt_beta, adjswap, exact_mh, adapt_eprob, adapt_lambda, num_hot_steps, num_annealing_steps, num_cold_steps, verbose) } split_entire_map_once_new_cut_func <- function(N, adj_list, counties, pop, target, lower, upper, split_district_only, verbose) { - .Call(`_redist_split_entire_map_once_new_cut_func`, N, adj_list, counties, pop, target, lower, upper, split_district_only, verbose) + .Call(`_gredist_split_entire_map_once_new_cut_func`, N, adj_list, counties, pop, target, lower, upper, split_district_only, verbose) } #' Creates the region level graph of a plan @@ -550,11 +550,11 @@ split_entire_map_once_new_cut_func <- function(N, adj_list, counties, pop, targe NULL tree_pop <- function(ust, vtx, pop, pop_below, parent) { - .Call(`_redist_tree_pop`, ust, vtx, pop, pop_below, parent) + .Call(`_gredist_tree_pop`, ust, vtx, pop, pop_below, parent) } var_info_vec <- function(m, ref, pop) { - .Call(`_redist_var_info_vec`, m, ref, pop) + .Call(`_gredist_var_info_vec`, m, ref, pop) } #' Computes the effective sample size from log incremental weights @@ -607,6 +607,6 @@ NULL NULL sample_ust <- function(l, pop, lower, upper, counties, ignore) { - .Call(`_redist_sample_ust`, l, pop, lower, upper, counties, ignore) + .Call(`_gredist_sample_ust`, l, pop, lower, upper, counties, ignore) } diff --git a/R/adjacency.R b/R/adjacency.R index d97546191..f6a4a5b14 100644 --- a/R/adjacency.R +++ b/R/adjacency.R @@ -1,4 +1,4 @@ -#' Adjacency List functionality for redist +#' Adjacency List functionality for gredist #' #' @param shp A SpatialPolygonsDataFrame or sf object. Required. #' @param plan A numeric vector (if only one map) or matrix with one row @@ -9,7 +9,7 @@ #' #' @importFrom sf st_relate #' @export -redist.adjacency <- function(shp, plan) { +gredist.adjacency <- function(shp, plan) { # Check input if (!any(c("sf", "SpatialPolygonsDataFrame") %in% class(shp))) { cli_abort("{.arg shp} must be a {.cls sf} or {.cls sp} object") @@ -67,9 +67,9 @@ redist.adjacency <- function(shp, plan) { #' #' @examples #' data(fl25_adj) -#' redist.reduce.adjacency(fl25_adj, c(2, 3, 4, 6, 21)) +#' gredist.reduce.adjacency(fl25_adj, c(2, 3, 4, 6, 21)) #' -redist.reduce.adjacency <- function(adj, keep_rows) { +gredist.reduce.adjacency <- function(adj, keep_rows) { # Check inputs: if (!(class(keep_rows) %in% c("numeric", "integer"))) { cli_warn("{.arg keep_rows} must be a numeric or integer vector.") @@ -98,7 +98,7 @@ redist.reduce.adjacency <- function(adj, keep_rows) { #' #' @concept prepare #' @export -redist.coarsen.adjacency <- function(adj, groups) { +gredist.coarsen.adjacency <- function(adj, groups) { if (min(unlist(adj)) != 0) { cli_abort("{.arg adj} must be a 0-indexed list.") } @@ -125,7 +125,7 @@ redist.coarsen.adjacency <- function(adj, groups) { #' #' @param shp An sf object #' @param adj A zero-indexed adjacency list. Created with -#' \code{redist.adjacency} if not supplied. +#' \code{gredist.adjacency} if not supplied. #' @param keep_rows row numbers of precincts to keep. Random submap selected if not supplied. #' @param total_pop numeric vector with one entry for the population of each precinct. #' @param ndists integer, number of districts in whole map @@ -141,23 +141,23 @@ redist.coarsen.adjacency <- function(adj, groups) { #' #' @concept prepare #' @export -redist.subset <- function(shp, adj, keep_rows, total_pop, ndists, +gredist.subset <- function(shp, adj, keep_rows, total_pop, ndists, pop_tol, sub_ndists) { if (missing(shp)) { cli_abort(c("{.arg shp} is required.", - "i" = "Use {.fn redist.reduce.adjacency} to subset adjacency lists.")) + "i" = "Use {.fn gredist.reduce.adjacency} to subset adjacency lists.")) } if (!inherits(shp, "sf")) { cli_abort("{.arg shp} must be an {.cls sf} object.") } if (missing(adj)) { - adj <- redist.adjacency(shp) + adj <- gredist.adjacency(shp) } if (missing(keep_rows)) { n <- sample(1:nrow(shp), 1) - keep_rows <- redist.random.subgraph(shp, n, adj)$keep_rows + keep_rows <- gredist.random.subgraph(shp, n, adj)$keep_rows } if (!missing(total_pop) & @@ -176,7 +176,7 @@ redist.subset <- function(shp, adj, keep_rows, total_pop, ndists, rlist <- list( shp = shp %>% dplyr::slice(keep_rows), - adj = redist.reduce.adjacency(adj, keep_rows = keep_rows), + adj = gredist.reduce.adjacency(adj, keep_rows = keep_rows), keep_rows = keep_rows, sub_ndists = sub_ndists, sub_pop_tol = sub_pop_tol diff --git a/R/classify_compare.R b/R/classify_compare.R index d6790a429..06e2f86d6 100644 --- a/R/classify_compare.R +++ b/R/classify_compare.R @@ -168,7 +168,7 @@ compare_plans <- function(plans, set1, set2, shp = NULL, plot = "fill", thresh = p1 + p2 + patchwork::plot_annotation(title = "Eigenvectors") } else if (plot == "adj") { if (!inherits(shp, "redist_map")) { - adj <- redist.adjacency(shp) + adj <- gredist.adjacency(shp) } else { adj <- get_adj(shp) } diff --git a/R/confint.R b/R/confint.R index 85128ea9f..442ac8834 100644 --- a/R/confint.R +++ b/R/confint.R @@ -169,7 +169,7 @@ redist_mcmc_ci <- function(plans, x, district = 1L, conf = 0.9, by_chain = FALSE #' #' @concept post #' @export -redist.smc_is_ci <- function(x, wgt, conf = 0.99) { +gredist.smc_is_ci <- function(x, wgt, conf = 0.99) { .Deprecated("redist_smc_ci") wgt <- wgt/sum(wgt) mu <- sum(x*wgt) diff --git a/R/cores.R b/R/cores.R index ec13fdab8..19b649405 100644 --- a/R/cores.R +++ b/R/cores.R @@ -29,7 +29,7 @@ #' #' @importFrom dplyr row_number cur_group_id #' -#' @seealso [redist.plot.cores()] for a plotting function +#' @seealso [gredist.plot.cores()] for a plotting function #' @concept prepare #' @export #' @@ -37,10 +37,10 @@ #' data(fl250) #' fl250_map <- redist_map(fl250, ndists = 4, pop_tol = 0.01) #' plan <- as.matrix(redist_smc(fl250_map, 20, silent = TRUE)) -#' core <- redist.identify.cores(adj = fl250_map$adj, plan = plan) -#' redist.plot.cores(shp = fl250, plan = plan, core = core) +#' core <- gredist.identify.cores(adj = fl250_map$adj, plan = plan) +#' gredist.plot.cores(shp = fl250, plan = plan, core = core) #' -redist.identify.cores <- function(adj, plan, boundary = 1, focus = NULL, +gredist.identify.cores <- function(adj, plan, boundary = 1, focus = NULL, simplify = TRUE) { if (!is.list(adj)) cli_abort("{.arg adj} must be a list.") if (is.matrix(plan)) { @@ -94,7 +94,7 @@ redist.identify.cores <- function(adj, plan, boundary = 1, focus = NULL, #' #' @concept post #' @export -redist.uncoarsen <- function(plans, group_index) { +gredist.uncoarsen <- function(plans, group_index) { uncoarse <- matrix(nrow = length(group_index), ncol = ncol(plans)) diff --git a/R/counties.R b/R/counties.R index 88c6d1dec..094864f8d 100644 --- a/R/counties.R +++ b/R/counties.R @@ -16,9 +16,9 @@ #' data(fl25) #' data(fl25_adj) #' counties <- sample(c(rep("a", 20), rep("b", 5))) -#' redist.county.relabel(fl25_adj, counties) +#' gredist.county.relabel(fl25_adj, counties) #' -redist.county.relabel <- function(adj, counties, simplify = TRUE) { +gredist.county.relabel <- function(adj, counties, simplify = TRUE) { if (length(adj) != length(counties)) { cli_abort("{.arg adj} and {.arg counties} must have the same length.") } @@ -38,7 +38,7 @@ redist.county.relabel <- function(adj, counties, simplify = TRUE) { mutate(countiescomp = ifelse(.data$comps > 1, paste0(counties, "-", .data$comp), counties)) %>% ungroup() if (simplify) { - redist.county.id(component$countiescomp) + gredist.county.id(component$countiescomp) } else { component$countiescomp } @@ -56,9 +56,9 @@ redist.county.relabel <- function(adj, counties, simplify = TRUE) { #' @examples #' set.seed(2) #' counties <- sample(c(rep("a", 20), rep("b", 5))) -#' redist.county.id(counties) +#' gredist.county.id(counties) #' -redist.county.id <- function(counties) { +gredist.county.id <- function(counties) { if (class(counties) %in% c("character", "numeric", "integer")) { uc <- unique(sort(counties)) county_id <- rep(0, length(counties)) diff --git a/R/crsg.R b/R/crsg.R index f61867b5c..07dfd19d9 100644 --- a/R/crsg.R +++ b/R/crsg.R @@ -1,6 +1,6 @@ #' Redistricting via Compact Random Seed and Grow Algorithm #' -#' \code{redist.crsg} generates redistricting plans using a random seed a grow +#' \code{gredist.crsg} generates redistricting plans using a random seed a grow #' algorithm. This is the compact districting algorithm described in Chen and #' Rodden (2013). #' @@ -22,7 +22,7 @@ #' @param maxiter integer, indicating maximum number of iterations to attempt #' before convergence to population constraint fails. If it fails once, it will #' use a different set of start values and try again. If it fails again, -#' redist.rsg() returns an object of all NAs, indicating that use of more +#' gredist.rsg() returns an object of all NAs, indicating that use of more #' iterations may be advised. Default is 5000. #' #' @return list, containing three objects containing the completed redistricting @@ -42,12 +42,12 @@ #' #' @examples #' data("fl25") -#' adj <- redist.adjacency(fl25) -#' redist.crsg(adj = adj, total_pop = fl25$pop, shp = fl25, ndists = 2, pop_tol = .1) +#' adj <- gredist.adjacency(fl25) +#' gredist.crsg(adj = adj, total_pop = fl25$pop, shp = fl25, ndists = 2, pop_tol = .1) #' #' @concept simulate #' @export -redist.crsg <- function(adj, total_pop, shp, ndists, pop_tol, verbose = TRUE, +gredist.crsg <- function(adj, total_pop, shp, ndists, pop_tol, verbose = TRUE, maxiter = 5000) { if (missing(shp)) { stop("An argument to shp is now required.") @@ -64,7 +64,7 @@ redist.crsg <- function(adj, total_pop, shp, ndists, pop_tol, verbose = TRUE, cat("\n") cat(divider) - cat("redist.crsg(): Automated Redistricting Starts\n\n") + cat("gredist.crsg(): Automated Redistricting Starts\n\n") } target.pop <- sum(total_pop)/ndists @@ -97,7 +97,7 @@ redist.crsg <- function(adj, total_pop, shp, ndists, pop_tol, verbose = TRUE, if (is.na(ret$plan[1])) { - warning("redist.crsg() failed to return a valid partition. Try increasing maxiter") + warning("gredist.crsg() failed to return a valid partition. Try increasing maxiter") } else { ret$plan <- ret$plan + 1 diff --git a/R/data.R b/R/data.R index 068edbe63..050e86499 100644 --- a/R/data.R +++ b/R/data.R @@ -19,7 +19,7 @@ #' @references Fifield, Benjamin, Michael Higgins, Kosuke Imai and Alexander Tarr. #' (2016) "A New Automated Redistricting Simulator Using Markov Chain Monte Carlo." #' Working Paper. Available at -#' \url{http://imai.princeton.edu/research/files/redist.pdf}. +#' \url{http://imai.princeton.edu/research/files/gredist.pdf}. #' #' Massey, Douglas and Nancy Denton. (1987) "The Dimensions of Social Segregation". #' Social Forces. @@ -61,7 +61,7 @@ NULL #' @references Fifield, Benjamin, Michael Higgins, Kosuke Imai and Alexander Tarr. #' (2016) "A New Automated Redistricting Simulator Using Markov Chain Monte Carlo." #' Working Paper. Available at -#' \url{http://imai.princeton.edu/research/files/redist.pdf}. +#' \url{http://imai.princeton.edu/research/files/gredist.pdf}. #' @concept data #' @examples #' data(fl25) @@ -81,7 +81,7 @@ NULL #' @references Fifield, Benjamin, Michael Higgins, Kosuke Imai and Alexander Tarr. #' (2016) "A New Automated Redistricting Simulator Using Markov Chain Monte Carlo." #' Working Paper. Available at -#' \url{http://imai.princeton.edu/research/files/redist.pdf}. +#' \url{http://imai.princeton.edu/research/files/gredist.pdf}. #' @concept data #' @examples #' data(fl25_adj) @@ -197,7 +197,7 @@ NULL #' EPSG Table #' #' This data contains NAD83 (HARN) EPSG codes for every U.S. state. -#' Since `redist` uses projected geometries, it is often a good idea to use +#' Since `gredist` uses projected geometries, it is often a good idea to use #' projections tailored to a particular state, rather than, for example, a #' Mercator projection. Use these codes along with [sf::st_transform()] to #' project your shapefiles nicely. diff --git a/R/deprecations.R b/R/deprecations.R index aeb77604e..bb32ff336 100644 --- a/R/deprecations.R +++ b/R/deprecations.R @@ -1,22 +1,22 @@ #' Segregation index calculation for MCMC redistricting. #' -#' \code{redist.segcalc} calculates the dissimilarity index of segregation (see +#' \code{gredist.segcalc} calculates the dissimilarity index of segregation (see #' Massey & Denton 1987 for more details) for a specified subgroup under any #' redistricting plan. #' #' @param plans A matrix of congressional district assignments or a -#' redist object. +#' gredist object. #' @param group_pop A vector of populations for some subgroup of interest. #' @param total_pop A vector containing the populations of each geographic unit. #' -#' @return \code{redist.segcalc} returns a vector where each entry is the +#' @return \code{gredist.segcalc} returns a vector where each entry is the #' dissimilarity index of segregation (Massey & Denton 1987) for each #' redistricting plan in \code{algout}. #' #' @references Fifield, Benjamin, Michael Higgins, Kosuke Imai and Alexander #' Tarr. (2016) "A New Automated Redistricting Simulator Using Markov Chain #' Monte Carlo." Working Paper. Available at -#' \url{http://imai.princeton.edu/research/files/redist.pdf}. +#' \url{http://imai.princeton.edu/research/files/gredist.pdf}. #' #' Massey, Douglas and Nancy Denton. (1987) "The Dimensions of Social #' Segregation". Social Forces. @@ -37,17 +37,17 @@ #' #' #' ## Get Republican Dissimilarity Index from simulations -#' # old: rep_dmi_253 <- redist.segcalc(alg_253, fl25$mccain, fl25$pop) +#' # old: rep_dmi_253 <- gredist.segcalc(alg_253, fl25$mccain, fl25$pop) #' rep_dmi_253 <- seg_dissim(alg_253, fl25, mccain, pop) |> #' redistmetrics::by_plan(ndists = 3) #' } #' @concept analyze #' @export -redist.segcalc <- function(plans, group_pop, total_pop) { +gredist.segcalc <- function(plans, group_pop, total_pop) { .Deprecated("seg_dissim") - ## If redist object, get the partitions entry - if (all(class(plans) == "redist")) { + ## If gredist object, get the partitions entry + if (all(class(plans) == "gredist")) { plans <- plans$plans } @@ -85,10 +85,10 @@ redist.segcalc <- function(plans, group_pop, total_pop) { #' data(fl25_enum) #' #' plans_05 <- fl25_enum$plans[, fl25_enum$pop_dev <= 0.05] -#' # old: comp <- redist.competitiveness(plans_05, fl25$mccain, fl25$obama) +#' # old: comp <- gredist.competitiveness(plans_05, fl25$mccain, fl25$obama) #' comp <- compet_talisman(plans_05, fl25, mccain, obama) #' -redist.competitiveness <- function(plans, rvote, dvote, alpha = 1, beta = 1) { +gredist.competitiveness <- function(plans, rvote, dvote, alpha = 1, beta = 1) { .Deprecated("compet_talisman") nd <- length(unique(plans[, 1])) redistmetrics::compet_talisman(plans = plans, shp = data.frame(), @@ -106,7 +106,7 @@ redist.competitiveness <- function(plans, rvote, dvote, alpha = 1, beta = 1) { #' Calculate compactness measures for a set of plans #' -#' \code{redist.compactness} is used to compute different compactness statistics for a +#' \code{gredist.compactness} is used to compute different compactness statistics for a #' shapefile. It currently computes the Polsby-Popper, Schwartzberg score, Length-Width Ratio, #' Convex Hull score, Reock score, Boyce Clark Index, Fryer Holden score, Edges Removed number, #' and the log of the Spanning Trees. @@ -122,7 +122,7 @@ redist.competitiveness <- function(plans, rvote, dvote, alpha = 1, beta = 1) { #' @param total_pop A numeric vector with the population for every observation. Is #' only necessary when "FryerHolden" is used for measure. Defaults to NULL. #' @param adj A zero-indexed adjacency list. Only used for "PolsbyPopper", -#' EdgesRemoved" and "logSpanningTree". Created with \code{redist.adjacency} if not +#' EdgesRemoved" and "logSpanningTree". Created with \code{gredist.adjacency} if not #' supplied and needed. Default is NULL. #' @param draw A numeric to specify draw number. Defaults to 1 if only one map provided #' and the column number if multiple maps given. Can also take a factor input, which will become the @@ -236,14 +236,14 @@ redist.competitiveness <- function(plans, rvote, dvote, alpha = 1, beta = 1) { #' #' plans_05 <- fl25_enum$plans[, fl25_enum$pop_dev <= 0.05] #' -#' # old redist.compactness( +#' # old gredist.compactness( #' # shp = fl25, plans = plans_05[, 1:3], #' # measure = c("PolsbyPopper", "EdgesRemoved") #' # ) #' comp_polsby(plans_05[, 1:3], fl25) #' comp_edges_rem(plans_05[, 1:3], fl25, fl25$adj) -#' @export redist.compactness -redist.compactness <- function(shp = NULL, +#' @export gredist.compactness +gredist.compactness <- function(shp = NULL, plans, measure = c("PolsbyPopper"), total_pop = NULL, adj = NULL, draw = 1, @@ -448,7 +448,7 @@ redist.compactness <- function(shp = NULL, if (any(measure %in% c("EdgesRemoved", "logSpanningTree", "FracKept")) & is.null(adj)) { - adj <- redist.adjacency(shp) + adj <- gredist.adjacency(shp) } if ("logSpanningTree" %in% measure) { @@ -473,7 +473,7 @@ redist.compactness <- function(shp = NULL, #' Calculate Group Proportion by District #' -#' \code{redist.group.percent} computes the proportion that a group makes up in +#' \code{gredist.group.percent} computes the proportion that a group makes up in #' each district across a matrix of maps. #' #' @param plans A matrix with one row @@ -496,7 +496,7 @@ redist.compactness <- function(shp = NULL, #' fl25_plans = redist_plans(cd, fl25_map, algorithm="enumpart") #' #' group_frac(fl25_map, BlackPop, TotPop, fl25_plans) -redist.group.percent <- function(plans, group_pop, total_pop, ncores = 1) { +gredist.group.percent <- function(plans, group_pop, total_pop, ncores = 1) { .Deprecated("group_frac()") if (!is.numeric(group_pop) || !is.numeric(total_pop)) cli_abort("{.arg group_pop} and {.arg total_pop} must be numeric vectors.") @@ -525,7 +525,7 @@ redist.group.percent <- function(plans, group_pop, total_pop, ncores = 1) { #' Calculate gerrymandering metrics for a set of plans #' -#' \code{redist.metrics} is used to compute different gerrymandering metrics for a +#' \code{gredist.metrics} is used to compute different gerrymandering metrics for a #' set of maps. #' #' @param plans A numeric vector (if only one map) or matrix with one row @@ -574,7 +574,7 @@ redist.group.percent <- function(plans, group_pop, total_pop, ncores = 1) { #' data(fl25) #' data(fl25_enum) #' plans_05 <- fl25_enum$plans[, fl25_enum$pop_dev <= 0.05] -#' # old: redist.metrics(plans_05, measure = "DSeats", rvote = fl25$mccain, dvote = fl25$obama) +#' # old: gredist.metrics(plans_05, measure = "DSeats", rvote = fl25$mccain, dvote = fl25$obama) #' part_dseats(plans_05, fl25, mccain, obama) #' #' @references @@ -595,7 +595,7 @@ redist.group.percent <- function(plans, group_pop, total_pop, ncores = 1) { #' @md #' @concept analyze #' @export -redist.metrics <- function(plans, measure = "DSeats", rvote, dvote, +gredist.metrics <- function(plans, measure = "DSeats", rvote, dvote, tau = 1, biasV = 0.5, respV = 0.5, bandwidth = 0.01, draw = 1) { repl = c( @@ -766,7 +766,7 @@ redist.metrics <- function(plans, measure = "DSeats", rvote, dvote, #' #' @concept analyze #' @export -redist.splits <- function(plans, counties) { +gredist.splits <- function(plans, counties) { .Deprecated("splits_admin") if (missing(plans)) { cli_abort("Please provide an argument to {.arg plans}.") @@ -778,7 +778,7 @@ redist.splits <- function(plans, counties) { plans <- matrix(plans, ncol = 1) } if (any(class(plans) %in% c("numeric", "matrix"))) { - plans <- redist.reorder(plans) + plans <- gredist.reorder(plans) } if (missing(counties)) { @@ -809,9 +809,9 @@ redist.splits <- function(plans, counties) { #' data(iowa) #' ia <- redist_map(iowa, existing_plan = cd_2010, total_pop = pop, pop_tol = 0.01) #' plans <- redist_smc(ia, 50, silent = TRUE) -#' #old redist.district.splits(plans, ia$region) +#' #old gredist.district.splits(plans, ia$region) #' splits_count(plans, ia, region) -redist.district.splits <- function(plans, counties) { +gredist.district.splits <- function(plans, counties) { .Deprecated("splits_count") if (missing(plans)) { stop("Please provide an argument to plans.") @@ -830,7 +830,7 @@ redist.district.splits <- function(plans, counties) { stop("Please provide an argument to counties.") } if (class(counties) %in% c("character", "numeric", "integer")) { - county_id <- redist.county.id(counties) + county_id <- gredist.county.id(counties) } else { stop('Please provide "counties" as a character, numeric, or integer vector.') } @@ -857,9 +857,9 @@ redist.district.splits <- function(plans, counties) { #' data(iowa) #' ia <- redist_map(iowa, existing_plan = cd_2010, total_pop = pop, pop_tol = 0.01) #' plans <- redist_smc(ia, 50, silent = TRUE) -#' #old redist.multisplits(plans, ia$region) +#' #old gredist.multisplits(plans, ia$region) #' splits_multi(plans, ia, region) -redist.multisplits <- function(plans, counties) { +gredist.multisplits <- function(plans, counties) { .Deprecated("splits_multi") if (missing(plans)) { cli_abort("Please provide an argument to {.arg plans}.") @@ -871,7 +871,7 @@ redist.multisplits <- function(plans, counties) { plans <- matrix(plans, ncol = 1) } if (any(class(plans) %in% c("numeric", "matrix"))) { - plans <- redist.reorder(plans) + plans <- gredist.reorder(plans) } if (missing(counties)) { @@ -903,9 +903,9 @@ redist.multisplits <- function(plans, counties) { #' ia <- redist_map(iowa, existing_plan = cd_2010, total_pop = pop, pop_tol = 0.01) #' plans <- redist_smc(ia, 50, silent = TRUE) #' ia$region[1:10] <- NA -#' #old redist.muni.splits(plans, ia$region) +#' #old gredist.muni.splits(plans, ia$region) #' splits_sub_admin(plans, ia, region) -redist.muni.splits <- function(plans, munis) { +gredist.muni.splits <- function(plans, munis) { .Deprecated("splits_sub_admin") redistmetrics::splits_sub_admin(plans = plans, shp = data.frame(), sub_admin = munis) diff --git a/R/distances.R b/R/distances.R index a59817d02..1e8e3cc82 100644 --- a/R/distances.R +++ b/R/distances.R @@ -43,12 +43,12 @@ #' data(fl25_enum) #' #' plans_05 <- fl25_enum$plans[, fl25_enum$pop_dev <= 0.05] -#' distances <- redist.distances(plans_05) +#' distances <- gredist.distances(plans_05) #' distances$Hamming[1:5, 1:5] #' #' @concept analyze #' @export -redist.distances <- function(plans, measure = "Hamming", +gredist.distances <- function(plans, measure = "Hamming", ncores = 1, total_pop = NULL) { supported <- c("all", "Hamming", "Manhattan", "Euclidean", "variation of information") @@ -111,7 +111,7 @@ redist.distances <- function(plans, measure = "Hamming", distances } -#' @rdname redist.distances +#' @rdname gredist.distances #' @order 1 #' #' @param plans a \code{\link{redist_plans}} object. @@ -127,7 +127,7 @@ plan_distances <- function(plans, measure = "variation of information", ncores = if (is.null(pop)) stop("Precinct population must be stored in `prec_pop` attribute of `plans` object") - redist.distances(get_plans_matrix(plans), measure, ncores = ncores, total_pop = pop)[[1]] + gredist.distances(get_plans_matrix(plans), measure, ncores = ncores, total_pop = pop)[[1]] } #' Calculate the diversity of a set of plans @@ -192,7 +192,7 @@ plans_diversity <- function(plans, chains = 1, n_max = 100, if (is.null(total_pop)) cli_abort("Must provide {.arg total_pop} for this {.cls redist_plans} object.") - dists <- redist.distances(m[, idx], "variation of information", + dists <- gredist.distances(m[, idx], "variation of information", ncores = ncores, total_pop = total_pop)$VI 0.5*dists[upper.tri(dists)] } diff --git a/R/enumpart.R b/R/enumpart.R index 80e958096..bb8c83803 100644 --- a/R/enumpart.R +++ b/R/enumpart.R @@ -1,7 +1,7 @@ #' Initialize enumpart #' #' This ensures that the enumerate partitions programs is prepared to run. -#' This must be run once per install of the redist package. +#' This must be run once per install of the gredist package. #' #' @return 0 on success #' @export @@ -12,17 +12,17 @@ #' #' @concept enumerate #' @examples \dontrun{ -#' redist.init.enumpart() +#' gredist.init.enumpart() #' } -redist.init.enumpart <- function() { +gredist.init.enumpart <- function() { # Update makefile to direct to library only if Windows if (Sys.info()[["sysname"]] == "Windows") { - makecontent <- readLines(system.file("enumpart/Makefile", package = "redist")) + makecontent <- readLines(system.file("enumpart/Makefile", package = "gredist")) makecontent[7] <- "\tg++ enumpart.cpp SAPPOROBDD/bddc.o SAPPOROBDD/BDD.o SAPPOROBDD/ZBDD.o -o enumpart -I$(TDZDD_DIR) -std=c++11 -O3 -DB_64 -DNDEBUG -lpsapi" - writeLines(text = makecontent, con = system.file("enumpart/Makefile", package = "redist")) + writeLines(text = makecontent, con = system.file("enumpart/Makefile", package = "gredist")) } - servr::make(dir = system.file("enumpart", package = "redist"), verbose = FALSE) + servr::make(dir = system.file("enumpart", package = "gredist"), verbose = FALSE) if (Sys.info()[["sysname"]] == "Windows") { sys::exec_wait("python", args = c("-m", "pip", "install", "networkx", "--user")) @@ -33,9 +33,9 @@ redist.init.enumpart <- function() { # Necessary to avoid bad CRAN submissions: if (Sys.info()[["sysname"]] == "Windows") { - makecontent <- readLines(system.file("enumpart/Makefile", package = "redist")) + makecontent <- readLines(system.file("enumpart/Makefile", package = "gredist")) makecontent[7] <- "\tg++ enumpart.cpp SAPPOROBDD/bddc.o SAPPOROBDD/BDD.o SAPPOROBDD/ZBDD.o -o enumpart -I$(TDZDD_DIR) -std=c++11 -O3 -DB_64 -DNDEBUG" - writeLines(text = makecontent, con = system.file("enumpart/Makefile", package = "redist")) + writeLines(text = makecontent, con = system.file("enumpart/Makefile", package = "gredist")) } 0 @@ -64,11 +64,11 @@ redist.init.enumpart <- function() { #' @examples \dontrun{ #' temp <- tempdir() #' data(fl25) -#' adj <- redist.adjacency(fl25) -#' redist.prep.enumpart(adj = adj, unordered_path = paste0(temp, "/unordered"), +#' adj <- gredist.adjacency(fl25) +#' gredist.prep.enumpart(adj = adj, unordered_path = paste0(temp, "/unordered"), #' ordered_path = paste0(temp, "/ordered")) #' } -redist.prep.enumpart <- function(adj, unordered_path, ordered_path, +gredist.prep.enumpart <- function(adj, unordered_path, ordered_path, weight_path = NULL, total_pop = NULL) { if (is.null(weight_path) + is.null(total_pop) == 1L) { @@ -100,12 +100,12 @@ redist.prep.enumpart <- function(adj, unordered_path, ordered_path, if (Sys.info()[["sysname"]] == "Windows") { res <- sys::exec_wait("python", - args = system.file("python/ndscut.py", package = "redist"), + args = system.file("python/ndscut.py", package = "gredist"), std_in = paste0(unordered_path, ".dat"), std_out = paste0(ordered_path, ".dat")) } else { res <- sys::exec_wait("python3", - args = system.file("python/ndscut.py", package = "redist"), + args = system.file("python/ndscut.py", package = "gredist"), std_in = paste0(unordered_path, ".dat"), std_out = paste0(ordered_path, ".dat")) } @@ -120,7 +120,7 @@ redist.prep.enumpart <- function(adj, unordered_path, ordered_path, #' Runs the enumpart algorithm #' -#' @param ordered_path Path used in redist.prep.enumpart (not including ".dat") +#' @param ordered_path Path used in gredist.prep.enumpart (not including ".dat") #' @param out_path Valid path to output the enumerated districts #' @param ndists number of districts to enumerate #' @param all boolean. TRUE outputs all districts. FALSE samples n districts. @@ -143,10 +143,10 @@ redist.prep.enumpart <- function(adj, unordered_path, ordered_path, #' #' @examples \dontrun{ #' temp <- tempdir() -#' redist.run.enumpart(ordered_path = paste0(temp, "/ordered"), +#' gredist.run.enumpart(ordered_path = paste0(temp, "/ordered"), #' out_path = paste0(temp, "/enumerated")) #' } -redist.run.enumpart <- function(ordered_path, out_path, ndists = 2, +gredist.run.enumpart <- function(ordered_path, out_path, ndists = 2, all = TRUE, n = NULL, weight_path = NULL, lower = NULL, upper = NULL, options = NULL) { ndists <- as.integer(ndists) @@ -178,7 +178,7 @@ redist.run.enumpart <- function(ordered_path, out_path, ndists = 2, } ## Run enumpart - res <- sys::exec_wait(paste0(system.file("enumpart", package = "redist"), "/enumpart"), + res <- sys::exec_wait(paste0(system.file("enumpart", package = "gredist"), "/enumpart"), args = options, std_out = paste0(out_path, ".dat"), std_err = TRUE) @@ -190,7 +190,7 @@ redist.run.enumpart <- function(ordered_path, out_path, ndists = 2, #' Read Results from enumpart #' -#' @param out_path out_path specified in redist.run.enumpart +#' @param out_path out_path specified in gredist.run.enumpart #' @param skip number of lines to skip #' @param n_max max number of lines to read #' @@ -204,9 +204,9 @@ redist.run.enumpart <- function(ordered_path, out_path, ndists = 2, #' @concept enumerate #' @examples \dontrun{ #' temp <- tempdir() -#' cds <- redist.read.enumpart(out_path = paste0(temp, "/enumerated")) +#' cds <- gredist.read.enumpart(out_path = paste0(temp, "/enumerated")) #' } -redist.read.enumpart <- function(out_path, skip = 0, n_max = -1L) { +gredist.read.enumpart <- function(out_path, skip = 0, n_max = -1L) { sols <- readLines(paste0(out_path, ".dat"), n = n_max) if (skip > 0) sols <- sols[-seq_len(skip)] sols <- apply(do.call("cbind", strsplit(sols, " ")), 2, as.numeric) @@ -237,7 +237,7 @@ is_last <- function(i, v, edges) { #' Calculate Frontier Size #' -#' @param ordered_path path to ordered path created by redist.prep.enumpart +#' @param ordered_path path to ordered path created by gredist.prep.enumpart #' #' @return List, four objects #' @@ -252,11 +252,11 @@ is_last <- function(i, v, edges) { #' @importFrom stringr str_split #' @examples \dontrun{ #' data(fl25) -#' adj <- redist.adjacency(fl25) -#' redist.prep.enumpart(adj, "unordered", "ordered") -#' redist.calc.frontier.size("ordered") +#' adj <- gredist.adjacency(fl25) +#' gredist.prep.enumpart(adj, "unordered", "ordered") +#' gredist.calc.frontier.size("ordered") #' } -redist.calc.frontier.size <- function(ordered_path) { +gredist.calc.frontier.size <- function(ordered_path) { lines_in <- readLines(paste0(ordered_path, ".dat")) n <- length(lines_in) @@ -310,7 +310,7 @@ redist.calc.frontier.size <- function(ordered_path) { #' vertex weights, to be used along with \code{lower} and \code{upper}. #' @param lower A lower bound on each partition's total weight, implemented by rejection sampling. #' @param upper An upper bound on each partition's total weight. -#' @param init Runs redist.init.enumpart. Defaults to false. Should be run on first use. +#' @param init Runs gredist.init.enumpart. Defaults to false. Should be run on first use. #' @param read boolean. Defaults to TRUE. reads #' @param total_pop the vector of precinct populations #' @@ -323,21 +323,21 @@ redist.calc.frontier.size <- function(ordered_path) { #' #' @concept enumerate #' @export -redist.enumpart <- function(adj, unordered_path, ordered_path, +gredist.enumpart <- function(adj, unordered_path, ordered_path, out_path, ndists = 2, all = TRUE, n = NULL, weight_path = NULL, lower = NULL, upper = NULL, init = FALSE, read = TRUE, total_pop = NULL) { if (init) { - redist.init.enumpart() + gredist.init.enumpart() } - prep <- redist.prep.enumpart(adj = adj, + prep <- gredist.prep.enumpart(adj = adj, unordered_path = unordered_path, ordered_path = ordered_path, weight_path = weight_path, total_pop = total_pop) if (!prep) { - run <- redist.run.enumpart(ordered_path = ordered_path, + run <- gredist.run.enumpart(ordered_path = ordered_path, out_path = out_path, ndists = ndists, all = all, @@ -348,9 +348,9 @@ redist.enumpart <- function(adj, unordered_path, ordered_path, } if (read) { - cds <- redist.read.enumpart(out_path = out_path) + cds <- gredist.read.enumpart(out_path = out_path) if (!is.null(total_pop)) { - par <- redist.parity(plans = cds, total_pop = total_pop) + par <- gredist.parity(plans = cds, total_pop = total_pop) } else { par <- rep(NA_real_, ncol(cds)) } diff --git a/R/findtarget.R b/R/findtarget.R index 1e11fb034..79327531c 100644 --- a/R/findtarget.R +++ b/R/findtarget.R @@ -14,7 +14,7 @@ #' #' @concept prepare #' @export -redist.find.target <- function(tgt_min, group_pop, total_pop, ndists, nmmd) { +gredist.find.target <- function(tgt_min, group_pop, total_pop, ndists, nmmd) { totpop <- sum(total_pop) targetpop <- totpop/ndists tmm <- nmmd*tgt_min*targetpop @@ -39,7 +39,7 @@ redist.find.target <- function(tgt_min, group_pop, total_pop, ndists, nmmd) { #' #' @concept prepare #' @export -redist.constraint.helper <- function(constraints = "vra", tgt_min = 0.55, +gredist.constraint.helper <- function(constraints = "vra", tgt_min = 0.55, group_pop, total_pop, ndists, nmmd, strength_vra = 2500, pow_vra = 1.5) { .Deprecated("redist_constr") @@ -47,7 +47,7 @@ redist.constraint.helper <- function(constraints = "vra", tgt_min = 0.55, ret <- list() if ("vra" %in% constraints) { - tgt_other <- redist.find.target(tgt_min, group_pop, total_pop, ndists, nmmd) + tgt_other <- gredist.find.target(tgt_min, group_pop, total_pop, ndists, nmmd) ret[["vra"]] <- list(strength = strength_vra, min_pop = group_pop, diff --git a/R/flip_helpers.R b/R/flip_helpers.R index e417fa87d..20027713c 100644 --- a/R/flip_helpers.R +++ b/R/flip_helpers.R @@ -8,9 +8,9 @@ #' Inverse probability reweighting for MCMC Redistricting #' -#' \code{redist.ipw} properly weights and resamples simulated redistricting plans +#' \code{gredist.ipw} properly weights and resamples simulated redistricting plans #' so that the set of simulated plans resemble a random sample from the -#' underlying distribution. \code{redist.ipw} is used to correct the sample when +#' underlying distribution. \code{gredist.ipw} is used to correct the sample when #' population parity, geographic compactness, or other constraints are #' implemented. #' @@ -29,8 +29,8 @@ #' techniques reweights and resamples redistricting plans so that the resulting #' sample is representative of a random sample from the uniform distribution. #' -#' @return \code{redist.ipw} returns an object of class "redist". The object -#' \code{redist} is a list that contains the following components (the +#' @return \code{gredist.ipw} returns an object of class "gredist". The object +#' \code{gredist} is a list that contains the following components (the #' inclusion of some components is dependent on whether tempering #' techniques are used): #' \item{plans}{Matrix of congressional district assignments generated by the @@ -74,7 +74,7 @@ #' @references Fifield, Benjamin, Michael Higgins, Kosuke Imai and Alexander #' Tarr. (2016) "A New Automated Redistricting Simulator Using Markov Chain #' Monte Carlo." Working Paper. -#' Available at \url{http://imai.princeton.edu/research/files/redist.pdf}. +#' Available at \url{http://imai.princeton.edu/research/files/gredist.pdf}. #' #' Rubin, Donald. (1987) "Comment: A Noniterative Sampling/Importance Resampling #' Alternative to the Data Augmentation Algorithm for Creating a Few Imputations @@ -89,7 +89,7 @@ #' cons <- add_constr_pop_dev(cons, strength = 5.4) #' alg <- redist_flip(map_ia, nsims = 500, constraints = cons) #' -#' alg_ipw <- redist.ipw(plans = alg, +#' alg_ipw <- gredist.ipw(plans = alg, #' resampleconstraint = "pop_dev", #' targetbeta = 1, #' targetpop = 0.05) @@ -97,7 +97,7 @@ #' #' @concept post #' @export -redist.ipw <- function(plans, +gredist.ipw <- function(plans, resampleconstraint = c("pop_dev", "edges_removed", "segregation", "status_quo"), targetbeta, @@ -151,7 +151,7 @@ redist.ipw <- function(plans, plans %>% slice(indx) } -redist.warmup.chain <- function(algout, warmup = 1) { +gredist.warmup.chain <- function(algout, warmup = 1) { if (warmup <= 0) { return(algout) } @@ -172,12 +172,12 @@ redist.warmup.chain <- function(algout, warmup = 1) { } names(algout_new) <- names(algout) - class(algout_new) <- "redist" + class(algout_new) <- "gredist" algout_new } -redist.thin.chain <- function(algout, thin = 100) { +gredist.thin.chain <- function(algout, thin = 100) { if (thin <= 1) { return(algout) } @@ -199,6 +199,6 @@ redist.thin.chain <- function(algout, thin = 100) { } names(algout_new) <- names(algout) - class(algout_new) <- "redist" + class(algout_new) <- "gredist" algout_new } diff --git a/R/freeze.R b/R/freeze.R index 63c691590..a7493145d 100644 --- a/R/freeze.R +++ b/R/freeze.R @@ -12,20 +12,20 @@ #' @export #' @concept prepare #' @examples -#' library(redist) +#' library(gredist) #' library(dplyr) #' data(fl25) #' data(fl25_enum) #' data(fl25_adj) #' plan <- fl25_enum$plans[, 5118] -#' freeze_id <- redist.freeze(adj = fl25_adj, freeze_row = (plan == 2), +#' freeze_id <- gredist.freeze(adj = fl25_adj, freeze_row = (plan == 2), #' plan = plan) #' #' data(iowa) #' map <- redist_map(iowa, existing_plan = cd_2010, pop_tol = 0.02) #' map <- map %>% merge_by(freeze(cd_2010 == 1, .data = .)) #' -redist.freeze <- function(adj, freeze_row, plan = rep(1, length(adj))) { +gredist.freeze <- function(adj, freeze_row, plan = rep(1, length(adj))) { if (missing(adj)) { cli_abort("Please provide an object to {.arg adj}.") } @@ -66,7 +66,7 @@ redist.freeze <- function(adj, freeze_row, plan = rep(1, length(adj))) { tb$gid } -#' @rdname redist.freeze +#' @rdname gredist.freeze #' @order 1 #' #' @param .data a \code{\link{redist_map}} object @@ -93,7 +93,7 @@ freeze <- function(freeze_row, plan, .data = cur_map()) { else freeze_row <- as.numeric(freeze_row) - redist.freeze(adj = adj, freeze_row = freeze_row, plan = plan) + gredist.freeze(adj = adj, freeze_row = freeze_row, plan = plan) } globalVariables("rn") diff --git a/R/map_helpers.R b/R/map_helpers.R index 37a7cb59e..43e62ab84 100644 --- a/R/map_helpers.R +++ b/R/map_helpers.R @@ -80,7 +80,7 @@ merge_by <- function(.data, ..., by_existing = TRUE, drop_geom = TRUE, collapse_ } } -#' @rdname redist.identify.cores +#' @rdname gredist.identify.cores #' @order 1 #' #' @param .data a \code{\link{redist_map}} object @@ -99,7 +99,7 @@ make_cores <- function(.data = cur_map(), boundary = 1, focus = NULL) { cli_abort(c("No existing plan found from which to compute cores.", ">" = "Add one using the {.arg existing_plan} argument to {.fun redist_map}")) - redist.identify.cores(adj = get_adj(.data), + gredist.identify.cores(adj = get_adj(.data), plan = vctrs::vec_group_id(existing), boundary = boundary, focus = focus, simplify = TRUE) } diff --git a/R/parity.R b/R/parity.R index e83353b58..83e6e79b8 100644 --- a/R/parity.R +++ b/R/parity.R @@ -20,7 +20,7 @@ #' #' @concept analyze #' @export -redist.parity <- function(plans, total_pop) { +gredist.parity <- function(plans, total_pop) { if (!is.numeric(total_pop)) { cli_abort("{.arg total_pop} must be a numeric vector") } diff --git a/R/plans_helpers.R b/R/plans_helpers.R index 5d7a8995b..05c83974c 100644 --- a/R/plans_helpers.R +++ b/R/plans_helpers.R @@ -2,7 +2,7 @@ #' #' Merging map units through \code{\link{merge_by}} or \code{\link{summarize}} #' changes the indexing of each unit. Use this function to take a set of -#' redistricting plans from a \code{redist} algorithm and re-index them to +#' redistricting plans from a \code{gredist} algorithm and re-index them to #' be compatible with the original set of units. #' #' @param plans a \code{redist_plans} object @@ -64,7 +64,7 @@ tally_var <- function(map, x, .data = pl()) { as.numeric(pop_tally(get_plans_matrix(.data), x, attr(.data, "ndists"))) } -#' @rdname redist.group.percent +#' @rdname gredist.group.percent #' @order 1 #' #' @param map a \code{\link{redist_map}} object @@ -117,11 +117,11 @@ avg_by_prec <- function(plans, x, draws = NA) { } -#' @rdname redist.parity +#' @rdname gredist.parity #' #' @param map a \code{\link{redist_map}} object #' @param .data a \code{\link{redist_plans}} object -#' @param ... passed on to \code{redist.parity} +#' @param ... passed on to \code{gredist.parity} #' #' @concept analyze #' @export diff --git a/R/plot_cores.R b/R/plot_cores.R index 8fa74d388..be2c11310 100644 --- a/R/plot_cores.R +++ b/R/plot_cores.R @@ -3,7 +3,7 @@ #' @param shp A SpatialPolygonsDataFrame or sf object. Required. #' @param plan A numeric vector with one entry for each precinct in shp. #' Used to color the districts. Required. -#' @param core Required. integer vector produced by \code{redist.identify.cores()}. +#' @param core Required. integer vector produced by \code{gredist.identify.cores()}. #' @param lwd Line width. Defaults to 2. #' #' @importFrom dplyr if_else @@ -11,7 +11,7 @@ #' @return ggplot #' @export #' @concept plot -redist.plot.cores <- function(shp, plan = NULL, core = NULL, lwd = 2) { +gredist.plot.cores <- function(shp, plan = NULL, core = NULL, lwd = 2) { plan <- eval_tidy(enquo(plan), shp) if (is.null(plan)) { if (inherits(shp, "redist_map")) { diff --git a/R/plot_diagnostics.R b/R/plot_diagnostics.R index 0a83343c4..429db7406 100644 --- a/R/plot_diagnostics.R +++ b/R/plot_diagnostics.R @@ -1,8 +1,8 @@ #' Diagnostic plotting functionality for MCMC redistricting. #' -#' \code{redist.diagplot} generates several common MCMC diagnostic plots. +#' \code{gredist.diagplot} generates several common MCMC diagnostic plots. #' -#' @usage redist.diagplot(sumstat, +#' @usage gredist.diagplot(sumstat, #' plot = c("trace", "autocorr", "densplot", "mean", "gelmanrubin"), #' logit = FALSE, savename = NULL) #' @@ -26,7 +26,7 @@ #' @references Fifield, Benjamin, Michael Higgins, Kosuke Imai and Alexander #' Tarr. (2016) "A New Automated Redistricting Simulator Using Markov Chain Monte #' Carlo." Working Paper. Available at -#' \url{http://imai.princeton.edu/research/files/redist.pdf}. +#' \url{http://imai.princeton.edu/research/files/gredist.pdf}. #' #' Gelman, Andrew and Donald Rubin. (1992) "Inference from iterative simulations #' using multiple sequences (with discussion)." Statistical Science. @@ -53,10 +53,10 @@ #' redistmetrics::by_plan(ndists = 3) #' #' ## Generate diagnostic plots -#' redist.diagplot(rep_dmi_253, plot = "trace") -#' redist.diagplot(rep_dmi_253, plot = "autocorr") -#' redist.diagplot(rep_dmi_253, plot = "densplot") -#' redist.diagplot(rep_dmi_253, plot = "mean") +#' gredist.diagplot(rep_dmi_253, plot = "trace") +#' gredist.diagplot(rep_dmi_253, plot = "autocorr") +#' gredist.diagplot(rep_dmi_253, plot = "densplot") +#' gredist.diagplot(rep_dmi_253, plot = "mean") #' #' ## Gelman Rubin needs two chains, so we run a second #' alg_253_2 <- redist_flip(fl_map, nsims = 10000) @@ -68,16 +68,16 @@ #' rep_dmi_253_list <- list(rep_dmi_253, rep_dmi_253_2) #' #' ## Generate Gelman Rubin diagnostic plot -#' redist.diagplot(sumstat = rep_dmi_253_list, plot = "gelmanrubin") +#' gredist.diagplot(sumstat = rep_dmi_253_list, plot = "gelmanrubin") #' #' } #' @concept plot #' @export -redist.diagplot <- function(sumstat, plot = c("trace", "autocorr", "densplot", +gredist.diagplot <- function(sumstat, plot = c("trace", "autocorr", "densplot", "mean", "gelmanrubin"), logit = FALSE, savename = NULL) { if (!requireNamespace("coda", quietly = TRUE)) - cli_abort(c("{.fn redist.diagplot} requires the {.pkg coda} package.", + cli_abort(c("{.fn gredist.diagplot} requires the {.pkg coda} package.", ">" = 'Install it with {.code install.packages("coda")}')) ############## diff --git a/R/plot_majmin.R b/R/plot_majmin.R index 535ac1e36..df87fc18c 100644 --- a/R/plot_majmin.R +++ b/R/plot_majmin.R @@ -1,6 +1,6 @@ #' Majority Minority Plots #' -#' @param grouppercent output from redist.group.percent +#' @param grouppercent output from gredist.group.percent #' @param type string in 'hist', 'toptwo', or 'box' #' @param title ggplot title #' @@ -10,7 +10,7 @@ #' @return ggplot #' @concept plot #' @export -redist.plot.majmin <- function(grouppercent, type = "hist", title = "") { +gredist.plot.majmin <- function(grouppercent, type = "hist", title = "") { if (type == "hist") { mm <- colSums(grouppercent > 0.5) diff --git a/R/plot_map.R b/R/plot_map.R index 40f86c45e..37a3bc9af 100644 --- a/R/plot_map.R +++ b/R/plot_map.R @@ -13,7 +13,7 @@ #' plan is used as the color and fill as the alpha parameter. #' #' @param shp A SpatialPolygonsDataFrame, sf object, or redist_map. Required. -#' @param adj A zero-indexed adjacency list. Created with redist.adjacency +#' @param adj A zero-indexed adjacency list. Created with gredist.adjacency #' if not supplied and needed for coloring. Default is NULL. #' @param plan \code{\link[dplyr:dplyr_data_masking]{}} A numeric #' vector with one entry for each precinct in shp. Used to color the @@ -34,14 +34,14 @@ #' #' @examples #' data(iowa) -#' redist.plot.map(shp = iowa, plan = iowa$cd_2010) +#' gredist.plot.map(shp = iowa, plan = iowa$cd_2010) #' #' iowa_map <- redist_map(iowa, existing_plan = cd_2010) -#' redist.plot.map(iowa_map, fill = dem_08/tot_08, zoom_to = (cd_2010 == 1)) +#' gredist.plot.map(iowa_map, fill = dem_08/tot_08, zoom_to = (cd_2010 == 1)) #' #' @concept plot #' @export -redist.plot.map <- function(shp, adj, plan = NULL, fill = NULL, fill_label = "", +gredist.plot.map <- function(shp, adj, plan = NULL, fill = NULL, fill_label = "", zoom_to = NULL, boundaries = is.null(fill), title = "") { # Check inputs if (inherits(shp, "SpatialPolygonsDataFrame")) { @@ -177,7 +177,7 @@ redist.plot.map <- function(shp, adj, plan = NULL, fill = NULL, fill_label = "", #' Creates a Graph Overlay #' #' @param shp A SpatialPolygonsDataFrame or sf object. Required. -#' @param adj A zero-indexed adjacency list. Created with redist.adjacency +#' @param adj A zero-indexed adjacency list. Created with gredist.adjacency #' if not supplied. Default is NULL. #' @param plan A numeric vector with one entry for each precinct in shp. #' Used to remove edges that cross boundaries. Default is \code{NULL}. Optional. @@ -198,11 +198,11 @@ redist.plot.map <- function(shp, adj, plan = NULL, fill = NULL, fill_label = "", #' #' @examples #' data(iowa) -#' redist.plot.adj(shp = iowa, plan = iowa$cd_2010) +#' gredist.plot.adj(shp = iowa, plan = iowa$cd_2010) #' #' @concept plot #' @export -redist.plot.adj <- function(shp, adj = NULL, plan = NULL, centroids = TRUE, +gredist.plot.adj <- function(shp, adj = NULL, plan = NULL, centroids = TRUE, drop = FALSE, plot_shp = TRUE, zoom_to = NULL, title = "") { if (inherits(shp, "SpatialPolygonsDataFrame")) { shp <- shp %>% st_as_sf() @@ -226,7 +226,7 @@ redist.plot.adj <- function(shp, adj = NULL, plan = NULL, centroids = TRUE, adj <- get_adj(shp) } } else if (missing(adj)) { - adj <- redist.adjacency(shp) + adj <- gredist.adjacency(shp) } diff --git a/R/plot_penalty.R b/R/plot_penalty.R index 717d207fa..f06db1b7d 100644 --- a/R/plot_penalty.R +++ b/R/plot_penalty.R @@ -21,7 +21,7 @@ #' @export #' #' @importFrom ggplot2 lims labs geom_path -redist.plot.penalty <- function(tgt_min = 0.55, tgt_other = 0.25, +gredist.plot.penalty <- function(tgt_min = 0.55, tgt_other = 0.25, strength_vra = 2500, pow_vra = 1.5, limits = TRUE) { .Deprecated("plot.redist_constr") diff --git a/R/plot_plans.R b/R/plot_plans.R index 6b6c73229..1f89ac70a 100644 --- a/R/plot_plans.R +++ b/R/plot_plans.R @@ -2,7 +2,7 @@ ## Author: Cory McCartan ## Institution: Harvard University ## Date Created: 2021/01/28 -## Purpose: redist functions for a tidy workflow +## Purpose: gredist functions for a tidy workflow ############################################## @@ -20,8 +20,8 @@ is_const_num <- function(x, grps) { #' @param x the \code{redist_plans} object. #' @param ... passed on to the underlying function #' @param type the name of the plotting function to use. Will have -#' \code{redist.plot.}, prepended to it; e.g., use \code{type="plans"} to call -#' \code{\link{redist.plot.plans}}. +#' \code{gredist.plot.}, prepended to it; e.g., use \code{type="plans"} to call +#' \code{\link{gredist.plot.plans}}. #' #' @concept plot #' @export @@ -29,7 +29,7 @@ plot.redist_plans <- function(x, ..., type = "distr_qtys") { if (rlang::dots_n(...) == 0) { wgts <- get_plans_weights(subset_sampled(x, matrix = FALSE)) if (is.null(wgts)) - return(redist.plot.distr_qtys(x, total_pop, size = 0.1)) + return(gredist.plot.distr_qtys(x, total_pop, size = 0.1)) n <- length(wgts) iqr <- IQR(wgts) bins <- min(max(round(diff(range(wgts))/(2*iqr/n^(1/3))), 3), 100) @@ -40,7 +40,7 @@ plot.redist_plans <- function(x, ..., type = "distr_qtys") { ggplot2::scale_x_continuous(name = "Weights", trans = "log10") + ggplot2::labs(y = NULL, title = "Plan weights") } else { - get(paste0("redist.plot.", type))(x, ...) + get(paste0("gredist.plot.", type))(x, ...) } } @@ -64,11 +64,11 @@ plot.redist_plans <- function(x, ..., type = "distr_qtys") { #' plans <- redist_smc(iowa, nsims = 100, silent = TRUE) #' group_by(plans, draw) %>% #' summarize(pop_dev = max(abs(total_pop/mean(total_pop) - 1))) %>% -#' redist.plot.hist(pop_dev) +#' gredist.plot.hist(pop_dev) #' #' @concept plot #' @export -redist.plot.hist <- function(plans, qty, bins = NULL, ...) { +gredist.plot.hist <- function(plans, qty, bins = NULL, ...) { if (!inherits(plans, "redist_plans")) cli_abort("{.arg plans} must be a {.cls redist_plans}") if (missing(qty)) cli_abort("Must provide a {.arg qty} to make the histogram from.") @@ -102,14 +102,14 @@ redist.plot.hist <- function(plans, qty, bins = NULL, ...) { p } -#' @rdname redist.plot.hist +#' @rdname gredist.plot.hist #' @param x \code{\link[dplyr:dplyr_data_masking]{}} the statistic. #' @export hist.redist_plans <- function(x, qty, ...) { if (missing(qty)) cli_abort("Must provide a {.arg qty} to make the histogram from.") qty <- rlang::enquo(qty) - redist.plot.hist(x, !!qty, ...) + gredist.plot.hist(x, !!qty, ...) } #' Scatter plot of plan summary statistics @@ -137,11 +137,11 @@ hist.redist_plans <- function(x, qty, ...) { #' group_by(draw) %>% #' summarize(pop_dev = max(abs(total_pop/mean(total_pop) - 1)), #' comp = comp[1]) %>% -#' redist.plot.scatter(pop_dev, comp) +#' gredist.plot.scatter(pop_dev, comp) #' #' @concept plot #' @export -redist.plot.scatter <- function(plans, x, y, ..., bigger = TRUE) { +gredist.plot.scatter <- function(plans, x, y, ..., bigger = TRUE) { if (!inherits(plans, "redist_plans")) cli_abort("{.arg plans} must be a {.cls redist_plans}") p <- ggplot(subset_sampled(plans, matrix = FALSE), aes(x = {{ x }}, y = {{ y }})) + @@ -212,13 +212,13 @@ redist.plot.scatter <- function(plans, x, y, ..., bigger = TRUE) { #' iowa <- redist_map(iowa, existing_plan = cd_2010, pop_tol = 0.05, total_pop = pop) #' plans <- redist_smc(iowa, nsims = 100, silent = TRUE) #' plans <- plans %>% mutate(pct_dem = group_frac(iowa, dem_08, tot_08)) -#' redist.plot.distr_qtys(plans, pct_dem) +#' gredist.plot.distr_qtys(plans, pct_dem) #' #' # It also takes custom functions: -#' redist.plot.distr_qtys(plans, pct_dem, geom = ggplot2::geom_violin) +#' gredist.plot.distr_qtys(plans, pct_dem, geom = ggplot2::geom_violin) #' #' # With the raincloud example, if you have `ggdist`, you can run: -#' # redist.plot.distr_qtys(plans, pct_dem, geom = raincloud) +#' # gredist.plot.distr_qtys(plans, pct_dem, geom = raincloud) #' #' # The reference geom can also be changed via `reg_geom` #' r_geom <- function(...) ggplot2::geom_segment(ggplot2::aes(as.integer(.data$.distr_no) - 0.5, @@ -230,12 +230,12 @@ redist.plot.scatter <- function(plans, x, y, ..., bigger = TRUE) { #' #' #' # Finally, the `ref_label` argument can also be swapped for a function, like so: -#' redist.plot.distr_qtys(plans, pct_dem, geom = ggplot2::geom_violin, ref_geom = r_geom, +#' gredist.plot.distr_qtys(plans, pct_dem, geom = ggplot2::geom_violin, ref_geom = r_geom, #' ref_label = function() ggplot2::labs(color = 'Ref.')) #' #' @concept plot #' @export -redist.plot.distr_qtys <- function(plans, qty, sort = "asc", geom = "jitter", +gredist.plot.distr_qtys <- function(plans, qty, sort = "asc", geom = "jitter", color_thresh = NULL, size = 0.1, ref_geom, ref_label, ...) { if (!inherits(plans, "redist_plans")) cli_abort("{.arg plans} must be a {.cls redist_plans}") @@ -357,11 +357,11 @@ redist.plot.distr_qtys <- function(plans, qty, sort = "asc", geom = "jitter", #' #' iowa <- redist_map(iowa, existing_plan = cd_2010, pop_tol = 0.05, total_pop = pop) #' plans <- redist_smc(iowa, nsims = 100, silent = TRUE) -#' redist.plot.plans(plans, c(1, 2, 3, 4), iowa) +#' gredist.plot.plans(plans, c(1, 2, 3, 4), iowa) #' #' @concept plot #' @export -redist.plot.plans <- function(plans, draws, shp, qty = NULL, interactive = FALSE, ..., geom = NULL) { +gredist.plot.plans <- function(plans, draws, shp, qty = NULL, interactive = FALSE, ..., geom = NULL) { if (!missing(geom)) { .Deprecated("shp", old = "geom") if (missing(shp)) shp <- geom @@ -372,7 +372,7 @@ redist.plot.plans <- function(plans, draws, shp, qty = NULL, interactive = FALSE cli_abort("{.arg plans} and {.arg shp} must have the same number of precincts.") if (interactive) { - .Deprecated("interactive", msg = "Interactive editing is no longer supported within redist.") + .Deprecated("interactive", msg = "Interactive editing is no longer supported within gredist.") } plot_single <- function(draw) { @@ -387,7 +387,7 @@ redist.plot.plans <- function(plans, draws, shp, qty = NULL, interactive = FALSE qty <- qty[m[, draw_idx]] } - redist.plot.map(shp, fill = qty, fill_label = lab, ...) + + gredist.plot.map(shp, fill = qty, fill_label = lab, ...) + ggplot2::labs(title = title) } @@ -421,11 +421,11 @@ redist.plot.plans <- function(plans, draws, shp, qty = NULL, interactive = FALSE #' plans <- redist_mergesplit_parallel(iowa_map, nsims = 200, chains = 2, silent = TRUE) %>% #' mutate(dem = group_frac(iowa_map, dem_08, dem_08 + rep_08)) %>% #' number_by(dem) -#' redist.plot.trace(plans, dem, district = 1) +#' gredist.plot.trace(plans, dem, district = 1) #' #' @concept plot #' @export -redist.plot.trace <- function(plans, qty, district = 1L, ...) { +gredist.plot.trace <- function(plans, qty, district = 1L, ...) { if (!"chain" %in% names(plans)) plans$chain <- 1 plans <- as.data.frame(plans) %>% filter(!is.na(.data$chain)) %>% diff --git a/R/plot_varinfo.R b/R/plot_varinfo.R index 01cb34d91..e844cda22 100644 --- a/R/plot_varinfo.R +++ b/R/plot_varinfo.R @@ -14,11 +14,11 @@ #' @return patchworked ggplot #' @concept plot #' @export -redist.plot.varinfo <- function(plans, group_pop, total_pop, shp) { +gredist.plot.varinfo <- function(plans, group_pop, total_pop, shp) { centers <- 5 - gp <- redist.group.percent(plans = plans, group_pop = group_pop, total_pop = total_pop) + gp <- gredist.group.percent(plans = plans, group_pop = group_pop, total_pop = total_pop) pct_min <- colmin(gp) - dists <- redist.distances(plans, "info", total_pop = total_pop)$VI + dists <- gredist.distances(plans, "info", total_pop = total_pop)$VI mds <- cmdscale(dists) tb <- tibble(mds1 = mds[, 1], mds2 = mds[, 2], pct_min = pct_min, id = 1:ncol(plans)) diff --git a/R/plot_weighted_adj.R b/R/plot_weighted_adj.R index c4a092420..7fdc20615 100644 --- a/R/plot_weighted_adj.R +++ b/R/plot_weighted_adj.R @@ -10,7 +10,7 @@ #' edges which cross this boundary if supplied. #' @param ref Plot reference map? Defaults to TRUE which gets the existing plan from #' @param adj A zero-indexed adjacency list. Extracted from `shp` if `shp` is a `redist_map`. -#' Otherwise created with redist.adjacency if not supplied. Default is NULL. +#' Otherwise created with gredist.adjacency if not supplied. Default is NULL. #' @param plot_shp Should the shapes be plotted? Default is TRUE. #' #' @return ggplot @@ -20,8 +20,8 @@ #' data(iowa) #' shp <- redist_map(iowa, existing_plan = cd_2010, pop_tol = 0.01) #' plans <- redist_smc(shp, 100) -#' redist.plot.wted.adj(shp, plans = plans, counties = region) -redist.plot.wted.adj <- function(shp, plans, counties = NULL, +#' gredist.plot.wted.adj(shp, plans = plans, counties = region) +gredist.plot.wted.adj <- function(shp, plans, counties = NULL, ref = TRUE, adj = NULL, plot_shp = TRUE) { # Check inputs ---- if ("SpatialPolygonsDataFrame" %in% class(shp)) { @@ -38,7 +38,7 @@ redist.plot.wted.adj <- function(shp, plans, counties = NULL, adj <- get_adj(shp) } } else if (missing(adj)) { - adj <- redist.adjacency(shp) + adj <- gredist.adjacency(shp) } counties <- rlang::eval_tidy(rlang::enquo(counties), shp) @@ -118,8 +118,8 @@ redist.plot.wted.adj <- function(shp, plans, counties = NULL, #' data(iowa) #' shp <- redist_map(iowa, existing_plan = cd_2010, pop_tol = 0.01) #' plans <- redist_smc(shp, 100) -#' redist.wted.adj(shp, plans = plans) -redist.wted.adj <- function(map = NULL, plans = NULL) { +#' gredist.wted.adj(shp, plans = plans) +gredist.wted.adj <- function(map = NULL, plans = NULL) { plans <- plans %>% subset_sampled() %>% get_plans_matrix() diff --git a/R/pop_overlap.R b/R/pop_overlap.R index 1ff0eb5f6..28cda6def 100644 --- a/R/pop_overlap.R +++ b/R/pop_overlap.R @@ -26,22 +26,22 @@ #' iowa_map <- redist_map(iowa, total_pop = pop, pop_tol = 0.01, ndists = 4) #' plans <- redist_smc(iowa_map, 2) #' plans_mat <- get_plans_matrix(plans) -#' ov <- redist.dist.pop.overlap(plans_mat[, 1], plans_mat[, 2], iowa_map) +#' ov <- gredist.dist.pop.overlap(plans_mat[, 1], plans_mat[, 2], iowa_map) #' round(ov, 2) #' -#' ov_col <- redist.dist.pop.overlap(plans_mat[, 1], plans_mat[, 2], iowa_map, normalize_rows = FALSE) +#' ov_col <- gredist.dist.pop.overlap(plans_mat[, 1], plans_mat[, 2], iowa_map, normalize_rows = FALSE) #' round(ov_col, 2) #' -#' ov_un_norm <- redist.dist.pop.overlap(plans_mat[, 1], plans_mat[, 2], +#' ov_un_norm <- gredist.dist.pop.overlap(plans_mat[, 1], plans_mat[, 2], #' iowa_map, normalize_rows = NULL) #' round(ov_un_norm, 2) #' #' iowa_map_5 <- iowa_map <- redist_map(iowa, total_pop = pop, pop_tol = 0.01, ndists = 5) #' plan_5 <- get_plans_matrix(redist_smc(iowa_map_5, 1)) -#' ov4_5 <- redist.dist.pop.overlap(plans_mat[, 1], plan_5, iowa_map) +#' ov4_5 <- gredist.dist.pop.overlap(plans_mat[, 1], plan_5, iowa_map) #' round(ov4_5, 2) #' -redist.dist.pop.overlap <- function(plan_old, plan_new, total_pop, normalize_rows = TRUE) { +gredist.dist.pop.overlap <- function(plan_old, plan_new, total_pop, normalize_rows = TRUE) { if (missing(plan_old)) { stop("Please pass an argument to `plan_old`.") } @@ -105,11 +105,11 @@ redist.dist.pop.overlap <- function(plan_old, plan_new, total_pop, normalize_row #' iowa_map <- redist_map(iowa, total_pop = pop, pop_tol = 0.01, ndists = 4) #' plans <- redist_smc(iowa_map, 2, silent = TRUE) #' plans_mat <- get_plans_matrix(plans) -#' ov_vec <- redist.prec.pop.overlap(plans_mat[, 1], plans_mat[, 2], iowa_map) -#' redist.prec.pop.overlap(plans_mat[, 1], plans_mat[, 2], iowa_map, weighting = "s", +#' ov_vec <- gredist.prec.pop.overlap(plans_mat[, 1], plans_mat[, 2], iowa_map) +#' gredist.prec.pop.overlap(plans_mat[, 1], plans_mat[, 2], iowa_map, weighting = "s", #' normalize = FALSE, index_only = TRUE) #' -redist.prec.pop.overlap <- function(plan_old, plan_new, total_pop, weighting = "s", +gredist.prec.pop.overlap <- function(plan_old, plan_new, total_pop, weighting = "s", normalize = TRUE, index_only = FALSE, return_mat = FALSE) { weighting <- match.arg(weighting, choices = c("s", "m", "g", "n")) diff --git a/R/proj.R b/R/proj.R index 7c7590748..47ff7e19e 100644 --- a/R/proj.R +++ b/R/proj.R @@ -13,7 +13,7 @@ #' distribution when looking at projective contrasts. The `pfdr` argument to #' `proj_contr()` will calculate q-values for each precinct that can be used to #' control the positive false discovery rate (pFDR) to avoid being misled by -#' this variation. See [redist.plot.contr_pfdr()] for a way to automatically +#' this variation. See [gredist.plot.contr_pfdr()] for a way to automatically #' plot projective contrasts with this false discovery rate control. #' #' @param plans A [redist_plans] object. @@ -217,14 +217,14 @@ qvalues <- function(ests, p) { #' plans$dem <- group_frac(map, dem_08, tot_08, plans) #' #' pc = proj_contr(plans, dem, pfdr=TRUE) -#' redist.plot.contr_pfdr(map, pc, level=0.4) # high `level` just to demonstrate +#' gredist.plot.contr_pfdr(map, pc, level=0.4) # high `level` just to demonstrate #' #' #' @concept plot #' @export -redist.plot.contr_pfdr <- function(map, contr, level=0.05, density=0.2, spacing=0.015) { +gredist.plot.contr_pfdr <- function(map, contr, level=0.05, density=0.2, spacing=0.015) { if (is.null(attr(contr, "q"))) { - cli_abort("Must provide {.arg pfdr=TRUE} to {.fn proj_contr} to use {.fn redist.plot.contr_pfdr}.") + cli_abort("Must provide {.arg pfdr=TRUE} to {.fn proj_contr} to use {.fn gredist.plot.contr_pfdr}.") } p = plot(map, contr) diff --git a/R/random_subgraph.R b/R/random_subgraph.R index 28154013a..0ad2fc7a3 100644 --- a/R/random_subgraph.R +++ b/R/random_subgraph.R @@ -35,7 +35,7 @@ preproc.shp <- function(shp) { #' @noRd preproc.adj <- function(shp, adj) { if (is.null(adj)) { - adj <- redist.adjacency(shp) + adj <- gredist.adjacency(shp) } else if (nrow(shp) != length(adj)) { stop("Dimension of shp and adj do not match.") } @@ -59,7 +59,7 @@ preproc.adj <- function(shp, adj) { #' @importFrom dplyr union setdiff slice %>% #' #' -redist.random.subgraph <- function(shp, n, adj = NULL) { +gredist.random.subgraph <- function(shp, n, adj = NULL) { # Check input: shp <- preproc.shp(shp) adj <- preproc.adj(shp, adj) diff --git a/R/redist-package.R b/R/redist-package.R deleted file mode 100644 index f33e2ccad..000000000 --- a/R/redist-package.R +++ /dev/null @@ -1,22 +0,0 @@ -#' @keywords internal -#' @aliases redist-package redist -"_PACKAGE" - -#' @useDynLib redist, .registration = TRUE -#' -#' @import redistmetrics -#' @importFrom Rcpp evalCpp -#' @importFrom parallel makeCluster stopCluster -#' @importFrom foreach foreach %do% %dopar% -#' @importFrom doRNG %dorng% -#' @importFrom grDevices dev.off pdf -#' @importFrom stats sd var na.omit median runif quantile qnorm IQR optim splinefun qt -#' @importFrom utils str head tail packageVersion -#' @importFrom dplyr n dplyr_row_slice dplyr_col_modify dplyr_reconstruct .data -#' @importFrom cli cli_text cli_abort cli_warn cli_inform -#' @importFrom rlang := -#' @importFrom stringr str_c str_glue -NULL - -# for dplyr -utils::globalVariables(c("where", ".")) diff --git a/R/redist-preproc.R b/R/redist-preproc.R index 8c0155cb7..932e63419 100644 --- a/R/redist-preproc.R +++ b/R/redist-preproc.R @@ -1,4 +1,4 @@ -redist.preproc <- function(adj, total_pop, init_plan = NULL, ndists = NULL, +gredist.preproc <- function(adj, total_pop, init_plan = NULL, ndists = NULL, pop_tol = NULL, temper = NULL, betaseq = NULL, betaseqlength = NULL, @@ -87,7 +87,7 @@ redist.preproc <- function(adj, total_pop, init_plan = NULL, ndists = NULL, } else if (inherits(adj, "SpatialPolygonsDataFrame")) { ## shp object ## Convert shp object to adjacency list - adjlist <- redist.adjacency(st_as_sf(adj)) + adjlist <- gredist.adjacency(st_as_sf(adj)) } else { ## If neither list, matrix, or shp, throw error @@ -96,7 +96,7 @@ redist.preproc <- function(adj, total_pop, init_plan = NULL, ndists = NULL, } } else if ("sf" %in% class(adj)) { - adjlist <- redist.adjacency(adj) + adjlist <- gredist.adjacency(adj) } else { ## Rename adjacency object as list @@ -146,10 +146,10 @@ redist.preproc <- function(adj, total_pop, init_plan = NULL, ndists = NULL, if (verbose) { cat("\n", append = TRUE) cat(divider, append = TRUE) - cat("Using redist.rsg() to generate starting values.\n\n", append = TRUE) + cat("Using gredist.rsg() to generate starting values.\n\n", append = TRUE) } ## Run the algorithm - initout <- redist.rsg(adj = adjlist, + initout <- gredist.rsg(adj = adjlist, total_pop = total_pop, ndists = ndists, pop_tol = pop_tol_rsg, @@ -198,7 +198,7 @@ redist.preproc <- function(adj, total_pop, init_plan = NULL, ndists = NULL, init_plan <- vctrs::vec_group_id(init_plan) - 1 } if (length(unique(init_plan)) != (max(init_plan) + 1)) { - stop("The district numbers in init_plan must be consecutive. The input to `init_plan` could not be transformed using `redist.sink.plan()`.") + stop("The district numbers in init_plan must be consecutive. The input to `init_plan` could not be transformed using `gredist.sink.plan()`.") } #################################################### @@ -268,6 +268,6 @@ redist.preproc <- function(adj, total_pop, init_plan = NULL, ndists = NULL, ) ) - class(preprocout) <- "redist" + class(preprocout) <- "gredist" preprocout } diff --git a/R/redistMPI.R b/R/redistMPI.R index 787a5c130..01b1e3129 100755 --- a/R/redistMPI.R +++ b/R/redistMPI.R @@ -8,8 +8,8 @@ ############################################## ecutsMPI <- function(procID = procID, params = params, adj = adj, total_pop = total_pop, init_plan = init_plan, swaps = swaps) { - ## Load redist library - library(redist) + ## Load gredist library + library(gredist) if (is.na(params$savename)) { fname <- paste0("log", procID) @@ -24,7 +24,7 @@ ecutsMPI <- function(procID = procID, params = params, adj = adj, total_pop = to cat("\n", append = TRUE) cat(divider, append = TRUE) - cat("redist.mcmc.mpi(): Automated Redistricting Simulation Using + cat("gredist.mcmc.mpi(): Automated Redistricting Simulation Using Markov Chain Monte Carlo w/ Parallel Tempering \n\n", append = TRUE) } @@ -135,8 +135,8 @@ ecutsMPI <- function(procID = procID, params = params, adj = adj, total_pop = to nthin <- params$nthin - ## Run redist preprocessing function - preprocout <- redist.preproc(adj = adj, total_pop = total_pop, + ## Run gredist preprocessing function + preprocout <- gredist.preproc(adj = adj, total_pop = total_pop, init_plan = init_plan, ndists = ndists, pop_tol = pop_tol, temper = FALSE, @@ -392,7 +392,7 @@ ecutsMPI <- function(procID = procID, params = params, adj = adj, total_pop = to ## End loop over j } - class(algout) <- "redist" + class(algout) <- "gredist" ## Save random number state if setting the seed if (!is.null(rngseed)) { @@ -424,7 +424,7 @@ ecutsMPI <- function(procID = procID, params = params, adj = adj, total_pop = to ############################### if (nloop > 1) { if (procID == tempadj[1]) { - redist.combine.mpi(savename = savename, nloop = nloop, + gredist.combine.mpi(savename = savename, nloop = nloop, nthin = nthin, tempadj = tempadj) } } else if (!is.null(savename)) { @@ -437,31 +437,31 @@ ecutsMPI <- function(procID = procID, params = params, adj = adj, total_pop = to cat("\n", append = TRUE) cat(divider, append = TRUE) - cat("redist.mcmc.mpi() simulations finished.\n", append = TRUE) + cat("gredist.mcmc.mpi() simulations finished.\n", append = TRUE) sink() } ## End function } -#' Combine successive runs of \code{redist.mcmc.mpi} +#' Combine successive runs of \code{gredist.mcmc.mpi} #' -#' \code{redist.combine.mpi} is used to combine successive runs of -#' \code{redist.mcmc.mpi} into a single data object +#' \code{gredist.combine.mpi} is used to combine successive runs of +#' \code{gredist.mcmc.mpi} into a single data object #' -#' @usage redist.combine.mpi(savename, nloop, nthin, tempadj) +#' @usage gredist.combine.mpi(savename, nloop, nthin, tempadj) #' #' @param savename The name (without the loop or \code{.RData} suffix) #' of the saved simulations. #' @param nloop The number of loops being combined. #' @param nthin How much to thin the simulations being combined. #' @param tempadj The temperature adjacency object saved by -#' \code{redist.mcmc.mpi}. +#' \code{gredist.mcmc.mpi}. #' #' @details This function allows users to combine multiple successive runs of -#' \code{redist.mcmc.mpi} into a single \code{redist} object for analysis. +#' \code{gredist.mcmc.mpi} into a single \code{gredist} object for analysis. #' -#' @return \code{redist.combine.mpi} returns an object of class "redist". -#' The object \code{redist} is a list that contains the following components (the +#' @return \code{gredist.combine.mpi} returns an object of class "gredist". +#' The object \code{gredist} is a list that contains the following components (the #' inclusion of some components is dependent on whether tempering #' techniques are used): #' \item{plans}{Matrix of congressional district assignments generated by the @@ -497,7 +497,7 @@ ecutsMPI <- function(procID = procID, params = params, adj = adj, total_pop = to #' @references Fifield, Benjamin, Michael Higgins, Kosuke Imai and Alexander Tarr. #' (2016) "A New Automated Redistricting Simulator Using Markov Chain Monte #' Carlo." Working Paper. Available at -#' \url{http://imai.princeton.edu/research/files/redist.pdf}. +#' \url{http://imai.princeton.edu/research/files/gredist.pdf}. #' #' @examples #' \dontrun{ @@ -513,14 +513,14 @@ ecutsMPI <- function(procID = procID, params = params, adj = adj, total_pop = to #' init_plan <- fl25_enum$plans[, 5118] #' #' ## Run the algorithm -#' redist.mcmc.mpi(adj = fl25_adj, total_pop = fl25$pop, +#' gredist.mcmc.mpi(adj = fl25_adj, total_pop = fl25$pop, #' init_plan = init_plan, nsims = 10000, nloops = 2, savename = "test") -#' out <- redist.combine.mpi(savename = "test", nloop = 2, +#' out <- gredist.combine.mpi(savename = "test", nloop = 2, #' nthin = 10, tempadj = tempAdjMat) #' } #' @concept post #' @export -redist.combine.mpi <- function(savename, nloop, nthin, tempadj) { +gredist.combine.mpi <- function(savename, nloop, nthin, tempadj) { ############################## ## Set up container objects ## @@ -580,7 +580,7 @@ redist.combine.mpi <- function(savename, nloop, nthin, tempadj) { ######################### ## Set class of object ## ######################### - class(algout) <- "redist" + class(algout) <- "gredist" ################# ## Save object ## @@ -608,7 +608,7 @@ ecutsAppend <- function(algout, ndata) { #' MCMC Redistricting Simulator using MPI #' -#' \code{redist.mcmc.mpi} is used to simulate Congressional redistricting +#' \code{gredist.mcmc.mpi} is used to simulate Congressional redistricting #' plans using Markov Chain Monte Carlo methods. #' #' @@ -622,7 +622,7 @@ ecutsAppend <- function(algout, ndata) { #' @param init_plan A vector containing the congressional district labels #' of each geographic unit. The default is \code{NULL}. If not provided, random #' and contiguous congressional district assignments will be generated using -#' \code{redist.rsg}. +#' \code{gredist.rsg}. #' @param loopscompleted Number of save points reached by the #' algorithm. The default is \code{0}. #' @param nloop The total number of save points for the algorithm. The @@ -684,8 +684,8 @@ ecutsAppend <- function(algout, ndata) { #' parallel tempering functionality in MPI to improve the mixing of the Markov #' Chain. #' -#' @return \code{redist.mcmc.mpi} returns an object of class "redist". The object -#' \code{redist} is a list that contains the following components (the +#' @return \code{gredist.mcmc.mpi} returns an object of class "gredist". The object +#' \code{gredist} is a list that contains the following components (the #' inclusion of some components is dependent on whether tempering #' techniques are used): #' \item{partitions}{Matrix of congressional district assignments generated by the @@ -719,7 +719,7 @@ ecutsAppend <- function(algout, ndata) { #' @references Fifield, Benjamin, Michael Higgins, Kosuke Imai and Alexander #' Tarr. (2016) "A New Automated Redistricting Simulator Using Markov Chain Monte #' Carlo." Working Paper. Available at -#' \url{http://imai.princeton.edu/research/files/redist.pdf}. +#' \url{http://imai.princeton.edu/research/files/gredist.pdf}. #' #' @concept simulate #' @examples @@ -736,11 +736,11 @@ ecutsAppend <- function(algout, ndata) { #' init_plan <- fl25_enum$plans[, 5118] #' #' ## Run the algorithm -#' redist.mcmc.mpi(adj = fl25_adj, total_pop = fl25$pop, +#' gredist.mcmc.mpi(adj = fl25_adj, total_pop = fl25$pop, #' init_plan = init_plan, nsims = 10000, savename = "test") #' } #' @export -redist.mcmc.mpi <- function(adj, total_pop, nsims, ndists = NA, +gredist.mcmc.mpi <- function(adj, total_pop, nsims, ndists = NA, init_plan = NULL, loopscompleted = 0, nloop = 1, nthin = 1, eprob = 0.05, lambda = 0, diff --git a/R/redist_constr.R b/R/redist_constr.R index 7bd945afc..487c67fad 100644 --- a/R/redist_constr.R +++ b/R/redist_constr.R @@ -2,7 +2,7 @@ ## Author: Cory McCartan ## Institution: Harvard University ## Date Created: 2021/11/07 -## Purpose: redist constraints for a tidy workflow +## Purpose: gredist constraints for a tidy workflow ############################################## @@ -48,7 +48,7 @@ validate_redist_constr <- function(constr) { #' You can view the exact structure of this list by calling [str()]. #' Constraints may be added by using one of the following functions: #' -#' `r paste0("* [", setdiff(ls("package:redist")[grep("add_constr_", ls("package:redist"))], "add_constr_qps"), "()]", collapse="\n")` +#' `r paste0("* [", setdiff(ls("package:gredist")[grep("add_constr_", ls("package:gredist"))], "add_constr_qps"), "()]", collapse="\n")` #' #' More information about each constraint can be found on the relevant constraint page. #' @@ -635,7 +635,7 @@ add_constr_custom <- function(constr, strength, fn) { if (!is.null(found) && !identical(found, rlang::base_env()) && !identical(found, constr_env) && - !identical(found, rlang::pkg_env("redist"))) { + !identical(found, rlang::pkg_env("gredist"))) { constr_env[[nm]] = get(nm, envir=found) } } diff --git a/R/redist_findparams.R b/R/redist_findparams.R index 55233ed3c..9e0966039 100644 --- a/R/redist_findparams.R +++ b/R/redist_findparams.R @@ -228,14 +228,14 @@ run_sims <- function(i, params, map, nsims, init_plan, #' Run parameter testing for \code{redist_flip} #' -#' \code{redist.findparams} is used to find optimal parameter values of +#' \code{gredist.findparams} is used to find optimal parameter values of #' \code{redist_flip} for a given map. #' #' @param map A \code{\link{redist_map}} object. #' @param nsims The number of simulations run before a save point. #' @param init_plan A vector containing the congressional district labels #' of each geographic unit. The default is \code{NULL}. If not provided, random -#' and contiguous congressional district assignments will be generated using \code{redist.rsg}. +#' and contiguous congressional district assignments will be generated using \code{gredist.rsg}. #' @param adapt_lambda Whether to adaptively tune the lambda parameter so that the Metropolis-Hastings #' acceptance probability falls between 20% and 40%. Default is FALSE. #' @param adapt_eprob Whether to adaptively tune the edgecut probability parameter so that the @@ -269,13 +269,13 @@ run_sims <- function(i, params, map, nsims, init_plan, #' @details This function allows users to test multiple parameter settings of #' \code{redist_flip} in preparation for a longer run for analysis. #' -#' @return \code{redist.findparams} returns a print-out of summary statistics +#' @return \code{gredist.findparams} returns a print-out of summary statistics #' about each parameter setting. #' #' @references Fifield, Benjamin, Michael Higgins, Kosuke Imai and Alexander #' Tarr. (2016) "A New Automated Redistricting Simulator Using Markov Chain Monte #' Carlo." Working Paper. Available at -#' \url{http://imai.princeton.edu/research/files/redist.pdf}. +#' \url{http://imai.princeton.edu/research/files/gredist.pdf}. #' #' @importFrom dplyr slice #' @@ -292,12 +292,12 @@ run_sims <- function(i, params, map, nsims, init_plan, #' # Make map #' map_fl <- redist_map(fl25, ndists = 3, pop_tol = 0.2) #' ## Run the algorithm -#' redist.findparams(map_fl, +#' gredist.findparams(map_fl, #' init_plan = init_plan, nsims = 10000, params = params) #' } #' @concept prepare #' @export -redist.findparams <- function(map, +gredist.findparams <- function(map, nsims, init_plan = NULL, adapt_lambda = FALSE, adapt_eprob = FALSE, @@ -313,7 +313,7 @@ redist.findparams <- function(map, ## Starting statement if (verbose) { cat(paste("## ------------------------------\n", - "## redist.findparams(): Parameter tuning for redist_flip()\n", + "## gredist.findparams(): Parameter tuning for redist_flip()\n", "## Searching over", trials, "parameter combinations\n", "## ------------------------------\n\n", sep = " ")) } diff --git a/R/redist_flip.R b/R/redist_flip.R index 50281868d..e3a85e015 100644 --- a/R/redist_flip.R +++ b/R/redist_flip.R @@ -98,7 +98,7 @@ #' @param init_plan A vector containing the congressional district labels #' of each geographic unit. The default is \code{NULL}. If not provided, #' a random initial plan will be generated using \code{redist_smc}. You can also -#' request to initialize using \code{redist.rsg} by supplying 'rsg', though this is +#' request to initialize using \code{gredist.rsg} by supplying 'rsg', though this is #' not recommended behavior. #' @param constraints A `redist_constr` object. #' @param thin The amount by which to thin the Markov Chain. The @@ -160,7 +160,7 @@ redist_flip <- function(map, nsims, warmup = 0, init_plan, if (!missing(nthin)) { thin <- nthin - .Deprecated(msg = 'Argument `nthin` is deprecated in favor of `thin` in redist 4.2.0 for consistency.') + .Deprecated(msg = 'Argument `nthin` is deprecated in favor of `thin` in gredist 4.2.0 for consistency.') } if (verbose) { ## Initialize ## @@ -231,7 +231,7 @@ redist_flip <- function(map, nsims, warmup = 0, init_plan, cli::cli_alert_info("Preprocessing data.") } - preprocout <- redist.preproc( + preprocout <- gredist.preproc( adj = adj, total_pop = total_pop, init_plan = init_plan, @@ -270,8 +270,8 @@ redist_flip <- function(map, nsims, warmup = 0, init_plan, verbose = as.logical(verbose) ) - algout <- redist.warmup.chain(algout, warmup = warmup) - algout <- redist.thin.chain(algout, thin = thin) + algout <- gredist.warmup.chain(algout, warmup = warmup) + algout <- gredist.thin.chain(algout, thin = thin) algout$plans <- algout$plans + 1L @@ -333,7 +333,7 @@ redist_flip <- function(map, nsims, warmup = 0, init_plan, #' @param init_plan A vector containing the congressional district labels #' of each geographic unit. The default is \code{NULL}. If not provided, #' a random initial plan will be generated using \code{redist_smc}. You can also -#' request to initialize using \code{redist.rsg} by supplying 'rsg', though this is +#' request to initialize using \code{gredist.rsg} by supplying 'rsg', though this is #' not recommended behavior. #' @param constraints A `redist_constr` object. #' @param num_hot_steps The number of steps to run the simulator at beta = 0. @@ -456,7 +456,7 @@ redist_flip_anneal <- function(map, if (verbose) { cat("Preprocessing data.\n\n") } - preprocout <- redist.preproc(adj = adj, total_pop = total_pop, + preprocout <- gredist.preproc(adj = adj, total_pop = total_pop, init_plan = init_plan, ndists = ndists, pop_tol = pop_tol, temper = FALSE, @@ -509,7 +509,7 @@ redist_flip_anneal <- function(map, warmup = warmup, nthin = thin, mh_acceptance = mean(algout$mhdecisions), - version = packageVersion("redist"), + version = packageVersion("gredist"), ) %>% mutate( distance_parity = rep(algout$distance_parity, each = ndists), mhdecisions = rep(algout$mhdecisions, each = ndists), diff --git a/R/redist_map.R b/R/redist_map.R index 66a8d1635..f0104a595 100644 --- a/R/redist_map.R +++ b/R/redist_map.R @@ -2,7 +2,7 @@ ## Author: Cory McCartan ## Institution: Harvard University ## Date Created: 2021/01/28 -## Purpose: redist functions for a tidy workflow +## Purpose: gredist functions for a tidy workflow ############################################## ####################### @@ -46,7 +46,7 @@ validate_redist_map <- function(data, check_contig = TRUE, call = parent.frame() components <- contiguity(get_adj(data), rep(1, nrow(data))) disconn <- which(components != which.max(table(components))) cli_abort(c("Adjacency graph not contiguous.", - ">" = "Try manually editing the output of {.fun redist.adjacency}.", + ">" = "Try manually editing the output of {.fun gredist.adjacency}.", "i" = "Disconnected precincts: c({paste0(disconn, collapse=', ')})"), call = call) } @@ -226,7 +226,7 @@ redist_map <- function(..., existing_plan = NULL, pop_tol = NULL, pop_tol <- eval_tidy(enquo(pop_tol), x) if (is.null(pop_tol) && is.null(pop_bounds)) { if (!is.null(existing_col)) { - pop_tol <- redist.parity(x[[existing_col]], x[[pop_col]]) + pop_tol <- gredist.parity(x[[existing_col]], x[[pop_col]]) if (pop_tol <= 0.001) cli_inform("{.arg pop_tol} calculated from existing plan is \u2264 0.1%") } else { @@ -250,7 +250,7 @@ redist_map <- function(..., existing_plan = NULL, pop_tol = NULL, cli_abort(c("Column {.field adj_col} already present in data. ", ">" = "Specify an alternate adj column.")) - adj <- redist.adjacency(x) + adj <- gredist.adjacency(x) } validate_redist_map( @@ -375,7 +375,7 @@ dplyr_row_slice.redist_map <- function(data, i, ...) { # reduce adj. graph y <- vctrs::vec_slice(data, i) gr_col <- attr(data, "adj_col") - y[[gr_col]] <- redist.reduce.adjacency(data[[gr_col]], keep_rows = i) + y[[gr_col]] <- gredist.reduce.adjacency(data[[gr_col]], keep_rows = i) # fix ndists if existing_col exists exist_col <- attr(data, "existing_col") @@ -546,8 +546,8 @@ print.redist_map <- function(x, ...) { #' district and indicate the \code{fill} variable by shading. #' @param adj if \code{TRUE}, force plotting the adjacency graph. Overrides #' \code{by_distr}. -#' @param ... passed on to \code{\link{redist.plot.map}} (or -#' \code{\link{redist.plot.adj}} if \code{adj=TRUE}). +#' @param ... passed on to \code{\link{gredist.plot.map}} (or +#' \code{\link{gredist.plot.adj}} if \code{adj=TRUE}). #' Useful parameters may include \code{zoom_to}, \code{boundaries}, and #' \code{title}. #' @@ -577,17 +577,17 @@ plot.redist_map <- function(x, fill = NULL, by_distr = FALSE, adj = FALSE, ...) existing <- get_existing(x) if (rlang::quo_is_null(fill)) { if (!is.null(existing) && isFALSE(adj)) { - redist.plot.map(shp = x, adj = get_adj(x), plan = existing, ...) + gredist.plot.map(shp = x, adj = get_adj(x), plan = existing, ...) } else { - redist.plot.adj(shp = x, adj = get_adj(x), ...) + gredist.plot.adj(shp = x, adj = get_adj(x), ...) } } else { fill_name <- rlang::quo_text(fill) if (!is.null(existing) && isTRUE(by_distr)) { - redist.plot.map(shp = x, adj = get_adj(x), plan = existing, + gredist.plot.map(shp = x, adj = get_adj(x), plan = existing, fill = !!fill, fill_label = fill_name, ...) } else { - redist.plot.map(shp = x, fill = !!fill, fill_label = fill_name, ...) + gredist.plot.map(shp = x, fill = !!fill, fill_label = fill_name, ...) } } } diff --git a/R/redist_ms.R b/R/redist_ms.R index 220f2a760..e82552a30 100644 --- a/R/redist_ms.R +++ b/R/redist_ms.R @@ -198,6 +198,7 @@ redist_mergesplit <- function(map, nsims, algout <- ms_plans(nsims, adj, init_plan, counties, pop, ndists, pop_bounds[2], pop_bounds[1], pop_bounds[3], compactness, constraints, control, k, thin, verbosity) + t2_run <- Sys.time() storage.mode(algout$plans) <- "integer" @@ -215,7 +216,7 @@ redist_mergesplit <- function(map, nsims, compactness = compactness, constraints = constraints, adapt_k_thresh = adapt_k_thresh, - version = packageVersion("redist"), + version = packageVersion("gredist"), diagnostics = l_diag, mh_acceptance = mean(acceptances)) @@ -228,4 +229,4 @@ redist_mergesplit <- function(map, nsims, } out -} \ No newline at end of file +} diff --git a/R/redist_ms_parallel.R b/R/redist_ms_parallel.R index 984c45fed..9fe6015ca 100644 --- a/R/redist_ms_parallel.R +++ b/R/redist_ms_parallel.R @@ -178,7 +178,7 @@ redist_mergesplit_parallel <- function(map, nsims, chains = 1, if (length(k) == 0) cli_abort(c("Adaptive {.var k} not found. This error should not happen.", ">" = "Please file an issue at - {.url https://github.com/alarm-redist/redist/issues/new}")) + {.url https://github.com/alarm-gredist/gredist/issues/new}")) # set up parallel if (is.null(ncores)) ncores <- parallel::detectCores() @@ -195,7 +195,7 @@ redist_mergesplit_parallel <- function(map, nsims, chains = 1, doParallel::registerDoParallel(cl) on.exit(stopCluster(cl)) - out_par <- foreach(chain = seq_len(chains), .inorder = FALSE, .packages="redist") %dorng% { + out_par <- foreach(chain = seq_len(chains), .inorder = FALSE, .packages="gredist") %dorng% { if (!silent) cat("Starting chain ", chain, "\n", sep = "") run_verbosity <- if (chain == 1 || verbosity == 3) verbosity else 0 t1_run <- Sys.time() @@ -210,6 +210,7 @@ redist_mergesplit_parallel <- function(map, nsims, chains = 1, warmup = warmup ) + algout } @@ -247,7 +248,7 @@ redist_mergesplit_parallel <- function(map, nsims, chains = 1, ndists = ndists, adapt_k_thresh = adapt_k_thresh, mh_acceptance = mh, - version = packageVersion("redist"), + version = packageVersion("gredist"), diagnostics = l_diag) %>% mutate(chain = rep(seq_len(chains), each = each_len*ndists), mcmc_accept = rep(acceptances, each = ndists)) @@ -266,4 +267,4 @@ redist_mergesplit_parallel <- function(map, nsims, chains = 1, dplyr::relocate(out, chain, .after = "draw") } -utils::globalVariables("chain") \ No newline at end of file +utils::globalVariables("chain") diff --git a/R/redist_optimal_gsmc.R b/R/redist_optimal_gsmc.R index d702b2d7a..f8bd2bc06 100644 --- a/R/redist_optimal_gsmc.R +++ b/R/redist_optimal_gsmc.R @@ -159,14 +159,14 @@ redist_optimal_gsmc <- function(state_map, M, counties = NULL, t1 <- Sys.time() - all_out <- foreach(chain = seq_len(runs), .inorder = FALSE, .packages="redist") %oper% { + all_out <- foreach(chain = seq_len(runs), .inorder = FALSE, .packages="gredist") %oper% { run_verbosity <- if (chain == 1 || !multiprocess) verbosity else 0 t1_run <- Sys.time() - algout <- redist::optimal_gsmc_plans( + algout <- gredist::optimal_gsmc_plans( N=N, adj_list=adj_list, counties=counties, @@ -365,7 +365,7 @@ redist_optimal_gsmc <- function(state_map, M, counties = NULL, {.val {NA}} or {.val {Inf}}", "*" = "If you are not using any constraints, please call {.code rlang::trace_back()} and file an issue at - {.url https://github.com/alarm-redist/redist/issues/new}")) + {.url https://github.com/alarm-gredist/gredist/issues/new}")) } @@ -466,7 +466,7 @@ redist_optimal_gsmc <- function(state_map, M, counties = NULL, n_eff = all_out[[1]]$n_eff, compactness = 1, constraints = constraints, - version = packageVersion("redist"), + version = packageVersion("gredist"), diagnostics = l_diag, pop_bounds = pop_bounds) diff --git a/R/redist_optimal_gsmc_ms.R b/R/redist_optimal_gsmc_ms.R index b56199110..c1e0b3d7e 100644 --- a/R/redist_optimal_gsmc_ms.R +++ b/R/redist_optimal_gsmc_ms.R @@ -222,14 +222,14 @@ redist_optimal_gsmc_ms <- function(state_map, M, counties = NULL, t1 <- Sys.time() - all_out <- foreach(chain = seq_len(runs), .inorder = FALSE, .packages="redist") %oper% { + all_out <- foreach(chain = seq_len(runs), .inorder = FALSE, .packages="gredist") %oper% { run_verbosity <- if (chain == 1 || !multiprocess) verbosity else 0 t1_run <- Sys.time() - algout <- redist::optimal_gsmc_with_merge_split_plans( + algout <- gredist::optimal_gsmc_with_merge_split_plans( N=N, adj_list=adj_list, counties=counties, @@ -450,7 +450,7 @@ redist_optimal_gsmc_ms <- function(state_map, M, counties = NULL, {.val {NA}} or {.val {Inf}}", "*" = "If you are not using any constraints, please call {.code rlang::trace_back()} and file an issue at - {.url https://github.com/alarm-redist/redist/issues/new}")) + {.url https://github.com/alarm-gredist/gredist/issues/new}")) } @@ -557,7 +557,7 @@ redist_optimal_gsmc_ms <- function(state_map, M, counties = NULL, n_eff = all_out[[1]]$n_eff, compactness = 1, constraints = constraints, - version = packageVersion("redist"), + version = packageVersion("gredist"), diagnostics = l_diag, pop_bounds = pop_bounds) diff --git a/R/redist_plans.R b/R/redist_plans.R index 678dc85f8..d86a0e85d 100644 --- a/R/redist_plans.R +++ b/R/redist_plans.R @@ -2,7 +2,7 @@ ## Author: Cory McCartan ## Institution: Harvard University ## Date Created: 2021/01/28 -## Purpose: redist functions for a tidy workflow +## Purpose: gredist functions for a tidy workflow ############################################## @@ -140,7 +140,7 @@ reconstruct.redist_plans <- function(data, old) { #' data(iowa) #' #' iowa <- redist_map(iowa, existing_plan = cd_2010, pop_tol = 0.05, total_pop = pop) -#' rsg_plan <- redist.rsg(iowa$adj, iowa$pop, ndists = 4, pop_tol = 0.05)$plan +#' rsg_plan <- gredist.rsg(iowa$adj, iowa$pop, ndists = 4, pop_tol = 0.05)$plan #' redist_plans(rsg_plan, iowa, "rsg") #' #' @md diff --git a/R/redist_shortburst.R b/R/redist_shortburst.R index 0cd1d9cbe..e9dd9e74a 100644 --- a/R/redist_shortburst.R +++ b/R/redist_shortburst.R @@ -324,7 +324,7 @@ redist_shortburst <- function(map, score_fn = NULL, stop_at = NULL, converged = converged, pareto_front = cur_best, pareto_scores = pareto_scores, - version = packageVersion("redist"), + version = packageVersion("gredist"), score_fn = deparse(substitute(score_fn))) score_mat = matrix(rep(scores[out_idx, ], each = ndists), ncol = dim_score) colnames(score_mat) = colnames(scores) @@ -340,7 +340,7 @@ redist_shortburst <- function(map, score_fn = NULL, stop_at = NULL, n_bursts = burst, backend = backend, converged = converged, - version = packageVersion("redist"), + version = packageVersion("gredist"), score_fn = deparse(substitute(score_fn))) score_mat = matrix(rep(t(cur_best_scores * rescale), each = ndists), ncol = dim_score) diff --git a/R/redist_smc.R b/R/redist_smc.R index 66b1fc1e2..3e66ef050 100644 --- a/R/redist_smc.R +++ b/R/redist_smc.R @@ -271,7 +271,7 @@ redist_smc <- function(map, nsims, counties = NULL, compactness = 1, constraints } t1 <- Sys.time() - all_out <- foreach(chain = seq_len(runs), .inorder = FALSE, .packages="redist") %oper% { + all_out <- foreach(chain = seq_len(runs), .inorder = FALSE, .packages="gredist") %oper% { run_verbosity <- if (chain == 1 || !multiprocess) verbosity else 0 t1_run <- Sys.time() @@ -318,7 +318,7 @@ redist_smc <- function(map, nsims, counties = NULL, compactness = 1, constraints {.val {NA}} or {.val {Inf}}", "*" = "If you are not using any constraints, please call {.code rlang::trace_back()} and file an issue at - {.url https://github.com/alarm-redist/redist/issues/new}")) + {.url https://github.com/alarm-gredist/gredist/issues/new}")) } n_unique <- NA @@ -405,7 +405,7 @@ redist_smc <- function(map, nsims, counties = NULL, compactness = 1, constraints n_eff = all_out[[1]]$n_eff, compactness = compactness, constraints = constraints, - version = packageVersion("redist"), + version = packageVersion("gredist"), diagnostics = l_diag) if (runs > 1) { out <- mutate(out, chain = rep(seq_len(runs), each = n_dist_act*nsims)) %>% diff --git a/R/reindex.R b/R/reindex.R index 3fd002760..90cbd3b1d 100644 --- a/R/reindex.R +++ b/R/reindex.R @@ -12,9 +12,9 @@ #' @examples #' cds <- matrix(c(rep(c(4L, 5L, 2L, 1L, 3L), 5), #' rep(c(5L, 4L, 3L, 2L, 1L), 2), rep(c(4L, 5L, 2L, 1L, 3L), 3)), nrow = 25) -#' redist.reorder(cds) +#' gredist.reorder(cds) #' -redist.reorder <- function(plans) { +gredist.reorder <- function(plans) { # Check inputs if (!is.matrix(plans)) { if (is.numeric(plans)) { @@ -47,7 +47,7 @@ redist.reorder <- function(plans) { #' # Now plan can be used with redist_flip() #' plan #' -redist.sink.plan <- function(plan) { +gredist.sink.plan <- function(plan) { .Deprecated("vctrs::vec_group_id") vctrs::vec_group_id(plan) } diff --git a/R/rsg.R b/R/rsg.R index 45abe9a90..47fd824fd 100755 --- a/R/rsg.R +++ b/R/rsg.R @@ -1,6 +1,6 @@ #' Redistricting via Random Seed and Grow Algorithm #' -#' \code{redist.rsg} generates redistricting plans using a random seed a grow +#' \code{gredist.rsg} generates redistricting plans using a random seed a grow #' algorithm. This is the non-compact districting algorithm described in Chen and #' Rodden (2013). The algorithm can provide start values for the other #' redistricting routines in this package. @@ -23,7 +23,7 @@ #' @param maxiter integer, indicating maximum number of iterations to attempt #' before convergence to population constraint fails. If it fails once, it will #' use a different set of start values and try again. If it fails again, -#' redist.rsg() returns an object of all NAs, indicating that use of more +#' gredist.rsg() returns an object of all NAs, indicating that use of more #' iterations may be advised. #' #' @return list, containing three objects containing the completed redistricting @@ -61,12 +61,12 @@ #' data(fl25) #' data(fl25_adj) #' -#' res <- redist.rsg(adj = fl25_adj, total_pop = fl25$pop, +#' res <- gredist.rsg(adj = fl25_adj, total_pop = fl25$pop, #' ndists = 3, pop_tol = 0.05) #' #' @concept simulate #' @export -redist.rsg <- function(adj, total_pop, ndists, pop_tol, +gredist.rsg <- function(adj, total_pop, ndists, pop_tol, verbose = TRUE, maxiter = 5000) { if (verbose) { @@ -74,7 +74,7 @@ redist.rsg <- function(adj, total_pop, ndists, pop_tol, cat("\n") cat(divider) - cat("redist.rsg(): Automated Redistricting Starts\n\n") + cat("gredist.rsg(): Automated Redistricting Starts\n\n") } target.pop <- sum(total_pop)/ndists @@ -83,7 +83,7 @@ redist.rsg <- function(adj, total_pop, ndists, pop_tol, ## If returning districts but not contiguous, repeat ## First attempt time <- system.time(ret <- .Call("_redist_rsg", - PACKAGE = "redist", + PACKAGE = "gredist", adj, total_pop, ndists, @@ -95,7 +95,7 @@ redist.rsg <- function(adj, total_pop, ndists, pop_tol, ## because maxiter might be too low if (is.na(ret$plan[1])) { time <- system.time(ret <- .Call("_redist_rsg", - PACKAGE = "redist", + PACKAGE = "gredist", adj, total_pop, ndists, @@ -107,7 +107,7 @@ redist.rsg <- function(adj, total_pop, ndists, pop_tol, if (is.na(ret$plan[1])) { - stop("redist.rsg() failed to return a valid partition. Try increasing maxiterrsg") + stop("gredist.rsg() failed to return a valid partition. Try increasing maxiterrsg") } else { ret$plan <- ret$plan + 1 diff --git a/R/tidy_deprecations.R b/R/tidy_deprecations.R index 72ea4dad6..2a6118230 100644 --- a/R/tidy_deprecations.R +++ b/R/tidy_deprecations.R @@ -1,10 +1,10 @@ -#' @rdname redist.compactness +#' @rdname gredist.compactness #' @order 1 #' #' @param map a \code{\link{redist_map}} object #' @param .data a \code{\link{redist_plans}} object -#' @param ... passed on to \code{redist.compactness} +#' @param ... passed on to \code{gredist.compactness} #' #' @concept analyze #' @export @@ -16,12 +16,12 @@ distr_compactness <- function(map, measure = "FracKept", .data = cur_plans(), .. if (length(unique(diff(as.integer(.data$district)))) > 2) cli_warn("Districts not sorted in ascending order; output may be incorrect.") - redist.compactness(shp = map, plans = get_plans_matrix(.data), + gredist.compactness(shp = map, plans = get_plans_matrix(.data), measure = measure, total_pop = map[[attr(map, "pop_col")]], adj = get_adj(map), ...)[[measure]] } -#' @rdname redist.segcalc +#' @rdname gredist.segcalc #' @order 1 #' #' @param map a \code{\link{redist_map}} object @@ -36,17 +36,17 @@ segregation_index <- function(map, group_pop, total_pop = map[[attr(map, "pop_co group_pop <- rlang::eval_tidy(rlang::enquo(group_pop), map) total_pop <- rlang::eval_tidy(rlang::enquo(total_pop), map) plan_m <- get_plans_matrix(.data) - rep(as.numeric(redist.segcalc(plans = plan_m, group_pop = group_pop, + rep(as.numeric(gredist.segcalc(plans = plan_m, group_pop = group_pop, total_pop = total_pop)), each = attr(map, "ndists")) } -#' @rdname redist.metrics +#' @rdname gredist.metrics #' @order 1 #' #' @param map a \code{\link{redist_map}} object #' @param .data a \code{\link{redist_plans}} object -#' @param ... passed on to \code{redist.metrics} +#' @param ... passed on to \code{gredist.metrics} #' #' @concept analyze #' @export @@ -60,11 +60,11 @@ partisan_metrics <- function(map, measure, rvote, dvote, ..., rvote <- rlang::eval_tidy(rlang::enquo(rvote), map) dvote <- rlang::eval_tidy(rlang::enquo(dvote), map) - as.numeric(redist.metrics(plans = get_plans_matrix(.data), + as.numeric(gredist.metrics(plans = get_plans_matrix(.data), measure = measure, rvote = rvote, dvote = dvote, ...)[[measure]]) } -#' @rdname redist.competitiveness +#' @rdname gredist.competitiveness #' @order 1 #' #' @param map a \code{\link{redist_map}} object @@ -77,11 +77,11 @@ competitiveness <- function(map, rvote, dvote, .data = cur_plans()) { check_tidy_types(map, .data) rvote <- rlang::eval_tidy(rlang::enquo(rvote), map) dvote <- rlang::eval_tidy(rlang::enquo(dvote), map) - redist.competitiveness(plans = get_plans_matrix(.data), + gredist.competitiveness(plans = get_plans_matrix(.data), rvote = rvote, dvote = dvote) } -#' @rdname redist.splits +#' @rdname gredist.splits #' @order 1 #' #' @param map a \code{\link{redist_map}} object @@ -93,11 +93,11 @@ county_splits <- function(map, counties, .data = cur_plans()) { .Deprecated("splits_admin") check_tidy_types(map, .data) counties <- rlang::eval_tidy(rlang::enquo(counties), map) - redist.splits(plans = get_plans_matrix(.data), counties = counties) + gredist.splits(plans = get_plans_matrix(.data), counties = counties) } -#' @rdname redist.muni.splits +#' @rdname gredist.muni.splits #' @order 1 #' #' @param map a \code{\link{redist_map}} object @@ -110,5 +110,5 @@ muni_splits <- function(map, munis, .data = cur_plans()) { check_tidy_types(map, .data) idxs <- unique(as.integer(.data$draw)) munis <- rlang::eval_tidy(rlang::enquo(munis), map) - redist.muni.splits(plans = get_plans_matrix(.data)[, idxs, drop = FALSE], munis = munis) + gredist.muni.splits(plans = get_plans_matrix(.data)[, idxs, drop = FALSE], munis = munis) } diff --git a/README.Rmd b/README.Rmd index 47200f3a8..fc8487196 100644 --- a/README.Rmd +++ b/README.Rmd @@ -7,12 +7,12 @@ editor_options: -# **redist**: Simulation Methods for Legislative Redistricting +# **gredist**: Simulation Methods for Legislative Redistricting -[![R-CMD-check](https://github.com/alarm-redist/redist/actions/workflows/check-standard.yaml/badge.svg)](https://github.com/alarm-redist/redist/actions/workflows/check-standard.yaml) -[![CRAN_Status_Badge](https://www.r-pkg.org/badges/version-last-release/redist)](https://cran.r-project.org/package=redist) -![CRAN downloads](http://cranlogs.r-pkg.org/badges/grand-total/redist) +[![R-CMD-check](https://github.com/alarm-gredist/gredist/actions/workflows/check-standard.yaml/badge.svg)](https://github.com/alarm-gredist/gredist/actions/workflows/check-standard.yaml) +[![CRAN_Status_Badge](https://www.r-pkg.org/badges/version-last-release/gredist)](https://cran.r-project.org/package=gredist) +![CRAN downloads](http://cranlogs.r-pkg.org/badges/grand-total/gredist) @@ -60,18 +60,18 @@ Papers: ## Installation Instructions -`redist` is available on CRAN and can be installed using: +`gredist` is available on CRAN and can be installed using: ```{r eval = FALSE} -install.packages("redist") +install.packages("gredist") ``` -You can also install the most recent development version of `redist` +You can also install the most recent development version of `gredist` (which is usually quite stable) using the `remotes` package. ```{r eval=FALSE} if (!require(remotes)) install.packages("remotes") -remotes::install_github("alarm-redist/redist@dev", dependencies=TRUE) +remotes::install_github("alarm-gredist/gredist@dev", dependencies=TRUE) ``` ## Getting started @@ -81,7 +81,7 @@ A basic analysis has two steps. First, you define a redistricting plan using `redist_smc`, `redist_flip`, and `redist_mergesplit`. ```{r message=FALSE} -library(redist) +library(gredist) library(dplyr) data(iowa) @@ -92,14 +92,14 @@ iowa_map = redist_map(iowa, existing_plan=cd_2010, pop_tol=0.001, total_pop = po iowa_plans = redist_smc(iowa_map, nsims=500) ``` -After generating plans, you can use `redist`'s plotting functions to study the +After generating plans, you can use `gredist`'s plotting functions to study the geographic and partisan characteristics of the simulated ensemble. ```{r readme-plot} library(ggplot2) library(patchwork) # for plotting -redist.plot.plans(iowa_plans, draws=c("cd_2010", "1", "2", "3"), shp=iowa_map) +gredist.plot.plans(iowa_plans, draws=c("cd_2010", "1", "2", "3"), shp=iowa_map) iowa_plans = iowa_plans %>% mutate(Compactness = comp_polsby(pl(), iowa_map), @@ -109,7 +109,7 @@ iowa_plans = iowa_plans %>% hist(iowa_plans, `Population deviation`) + hist(iowa_plans, Compactness) + plot_layout(guides="collect") + plot_annotation(title="Simulated plan characteristics") -redist.plot.scatter(iowa_plans, `Population deviation`, Compactness) + +gredist.plot.scatter(iowa_plans, `Population deviation`, Compactness) + labs(title="Population deviation and compactness by plan") plot(iowa_plans, `Democratic vote`, size=0.5, color_thresh=0.5) + @@ -118,8 +118,8 @@ plot(iowa_plans, `Democratic vote`, size=0.5, color_thresh=0.5) + ``` A more detailed introduction to redistricting methods and the package can be -found in the [Get Started](https://alarm-redist.org/redist/articles/redist.html) -page. The package [vignettes](https://alarm-redist.org/redist/articles/) +found in the [Get Started](https://alarm-gredist.org/gredist/articles/gredist.html) +page. The package [vignettes](https://alarm-gredist.org/gredist/articles/) contain more detailed information and guides to specific workflows. diff --git a/README.md b/README.md index dcbbedc10..76ffb22fc 100644 --- a/README.md +++ b/README.md @@ -1,13 +1,13 @@ -# **redist**: Simulation Methods for Legislative Redistricting +# **gredist**: Simulation Methods for Legislative Redistricting -[![R-CMD-check](https://github.com/alarm-redist/redist/actions/workflows/check-standard.yaml/badge.svg)](https://github.com/alarm-redist/redist/actions/workflows/check-standard.yaml) -[![CRAN_Status_Badge](https://www.r-pkg.org/badges/version-last-release/redist)](https://cran.r-project.org/package=redist) -![CRAN downloads](http://cranlogs.r-pkg.org/badges/grand-total/redist) +[![R-CMD-check](https://github.com/alarm-gredist/gredist/actions/workflows/check-standard.yaml/badge.svg)](https://github.com/alarm-gredist/gredist/actions/workflows/check-standard.yaml) +[![CRAN_Status_Badge](https://www.r-pkg.org/badges/version-last-release/gredist)](https://cran.r-project.org/package=gredist) +![CRAN downloads](http://cranlogs.r-pkg.org/badges/grand-total/gredist) @@ -56,18 +56,18 @@ Papers: ## Installation Instructions -`redist` is available on CRAN and can be installed using: +`gredist` is available on CRAN and can be installed using: ``` r -install.packages("redist") +install.packages("gredist") ``` -You can also install the most recent development version of `redist` +You can also install the most recent development version of `gredist` (which is usually quite stable) using the `remotes` package. ``` r if (!require(remotes)) install.packages("remotes") -remotes::install_github("alarm-redist/redist@dev", dependencies=TRUE) +remotes::install_github("alarm-gredist/gredist@dev", dependencies=TRUE) ``` ## Getting started @@ -77,7 +77,7 @@ using `redist_map`. Then you simulate plans using one of the algorithm functions: `redist_smc`, `redist_flip`, and `redist_mergesplit`. ``` r -library(redist) +library(gredist) library(dplyr) data(iowa) @@ -90,7 +90,7 @@ iowa_plans = redist_smc(iowa_map, nsims=500) #> Sampling 500 99-unit maps with 4 districts and population between 760,827 and 762,350. ``` -After generating plans, you can use `redist`’s plotting functions to +After generating plans, you can use `gredist`’s plotting functions to study the geographic and partisan characteristics of the simulated ensemble. @@ -98,7 +98,7 @@ ensemble. library(ggplot2) library(patchwork) # for plotting -redist.plot.plans(iowa_plans, draws=c("cd_2010", "1", "2", "3"), shp=iowa_map) +gredist.plot.plans(iowa_plans, draws=c("cd_2010", "1", "2", "3"), shp=iowa_map) ``` ![](man/figures/README-readme-plot-1.png) @@ -119,7 +119,7 @@ hist(iowa_plans, `Population deviation`) + hist(iowa_plans, Compactness) + ![](man/figures/README-readme-plot-2.png) ``` r -redist.plot.scatter(iowa_plans, `Population deviation`, Compactness) + +gredist.plot.scatter(iowa_plans, `Population deviation`, Compactness) + labs(title="Population deviation and compactness by plan") ``` @@ -136,6 +136,6 @@ plot(iowa_plans, `Democratic vote`, size=0.5, color_thresh=0.5) + A more detailed introduction to redistricting methods and the package can be found in the [Get -Started](https://alarm-redist.org/redist/articles/redist.html) page. The -package [vignettes](https://alarm-redist.org/redist/articles/) contain +Started](https://alarm-gredist.org/gredist/articles/gredist.html) page. The +package [vignettes](https://alarm-gredist.org/gredist/articles/) contain more detailed information and guides to specific workflows. diff --git a/_pkgdown.yml b/_pkgdown.yml index 3aeaec47e..dca88fb96 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -12,11 +12,11 @@ home: summary statistics and plotting functionality, are also included. links: - text: ALARM Project - href: https://alarm-redist.github.io/ + href: https://alarm-gredist.github.io/ news: releases: - - text: "redist 3.0" - href: https://alarm-redist.github.io/posts/2021-04-02-redist-300/ + - text: "gredist 3.0" + href: https://alarm-gredist.github.io/posts/2021-04-02-gredist-300/ cran_dates: false reference: - title: "Simulation Algorithm Implementations" @@ -68,5 +68,5 @@ reference: - title: "Miscellaneous" desc: "Other functions" - contents: - - redist-package + - gredist-package - lacks_concepts(c("prepare", "simulate", "analyze", "plot", "enumerate", "data", "post")) diff --git a/cran-comments.md b/cran-comments.md index e74c38035..bb81afc4f 100644 --- a/cran-comments.md +++ b/cran-comments.md @@ -18,5 +18,5 @@ There are no reverse dependencies to check. ## Additional Notes -* Fixes itemize braces Rd note for `redist.calc.frontier.size.Rd`, `redist.crsg.Rd`, and `redist.rsg.Rd`. +* Fixes itemize braces Rd note for `gredist.calc.frontier.size.Rd`, `gredist.crsg.Rd`, and `gredist.rsg.Rd`. * Fixes "memory not mapped" error in `persily` function, which was due to be removed from the package in this release. diff --git a/docs/404.html b/docs/404.html index cf3ea5f4b..5dab731c2 100644 --- a/docs/404.html +++ b/docs/404.html @@ -5,7 +5,7 @@ -Page not found (404) • redist +Page not found (404) • gredist @@ -38,7 +38,7 @@ - redist + gredist 4.2.0 @@ -46,7 +46,7 @@ @@ -48,7 +48,7 @@ @@ -214,10 +214,10 @@

Getting started

Links

 @@ -233,7 +233,7 @@

License

Citation

@@ -251,8 +251,8 @@

Developers

Dev status

    -
  • R-CMD-check
    • -
  • CRAN_Status_Badge
    • +
  • R-CMD-check
    • +
  • CRAN_Status_Badge
diff --git a/docs/news/index.html b/docs/news/index.html index bbd46121a..b70882762 100644 --- a/docs/news/index.html +++ b/docs/news/index.html @@ -16,14 +16,14 @@ - redist + gredist 4.2.0