## ----include = FALSE---------------------------------------------------------- knitr::opts_chunk$set( collapse = TRUE, comment = "#>" ) ## ----setup-------------------------------------------------------------------- library(explodemap) library(sf) library(dplyr) ## ----nj-calibration, eval = FALSE--------------------------------------------- # nj <- explode_state( # state_fips = "34", crs = 32118, # region_map = list( # North = c("Bergen", "Essex", "Hudson", "Morris", # "Passaic", "Sussex", "Union", "Warren"), # Central = c("Hunterdon", "Mercer", "Middlesex", # "Monmouth", "Somerset"), # South = c("Atlantic", "Burlington", "Camden", "Cape May", # "Cumberland", "Gloucester", "Ocean", "Salem") # ), # label = "New Jersey" # ) # # summary(nj) ## ----pa-region-map------------------------------------------------------------ pa_region_map <- list( Southeast = c("Philadelphia", "Delaware", "Chester", "Montgomery", "Bucks"), Northeast = c("Pike", "Monroe", "Carbon", "Northampton", "Lehigh", "Luzerne", "Lackawanna", "Wayne", "Susquehanna", "Wyoming", "Sullivan", "Columbia", "Montour", "Schuylkill", "Berks", "Bradford"), Central = c("Centre", "Clinton", "Lycoming", "Tioga", "Potter", "Cameron", "Elk", "Clearfield", "Jefferson", "Indiana", "Blair", "Huntingdon", "Mifflin", "Snyder", "Union", "Northumberland", "Juniata", "Perry", "Dauphin", "Lebanon"), SouthCentral = c("York", "Adams", "Lancaster", "Cumberland", "Franklin", "Fulton", "Bedford", "Somerset", "Cambria"), Southwest = c("Allegheny", "Westmoreland", "Fayette", "Greene", "Washington", "Beaver", "Butler", "Armstrong", "Lawrence"), Northwest = c("Erie", "Crawford", "Mercer", "Venango", "Clarion", "Forest", "Warren", "McKean") ) ## ----pa-transfer, eval = FALSE------------------------------------------------ # pa <- explode_state( # state_fips = "42", crs = 26918, # region_map = pa_region_map, # label = "Pennsylvania" # ) # # summary(pa) ## ----pa-sensitivity, eval = FALSE--------------------------------------------- # alpha_l_canonical <- 12447 # alpha_r_canonical <- 20174 # # factors <- c(0.85, 0.90, 0.95, 1.00, 1.05, 1.10, 1.15) # labels <- c("-15%", "-10%", "-5%", "canonical", "+5%", "+10%", "+15%") # # rows <- list() # for (i in seq_along(factors)) { # run <- explode_state( # state_fips = "42", crs = 26918, # region_map = pa_region_map, # alpha_r = alpha_r_canonical, # alpha_l = round(alpha_l_canonical * factors[i]), # plot = FALSE, export = FALSE, # label = paste0("PA ", labels[i]) # ) # rows[[i]] <- calibration_row(run) # rows[[i]]$label <- labels[i] # rows[[i]]$factor <- factors[i] # } # # sensitivity_df <- bind_rows(rows) # print(sensitivity_df) ## ----calibration, eval = FALSE------------------------------------------------ # source(system.file("registries/state_registry.R", package = "explodemap")) # # calib_rows <- list() # for (key in names(state_registry)) { # reg <- state_registry[[key]] # # result <- tryCatch( # explode_state( # state_fips = reg$fips, crs = reg$crs, # region_map = reg$region_map, # allow_other = TRUE, plot = FALSE, # label = reg$name # ), # error = function(e) { # message("ERROR: ", e$message) # NULL # } # ) # # if (is.null(result)) next # calib_rows[[key]] <- calibration_row(result) # } # # calib_df <- bind_rows(calib_rows) # print(calib_df) ## ----ohio, eval = FALSE------------------------------------------------------- # oh <- explode_state( # state_fips = "39", crs = 32617, # region_map = list( # Northeast = c("Cuyahoga", "Summit", "Lorain", "Lake", "Medina", # "Portage", "Geauga", "Ashtabula", "Trumbull", "Mahoning", # "Columbiana", "Carroll", "Stark", "Wayne", "Holmes", # "Harrison", "Jefferson"), # Northwest = c("Lucas", "Wood", "Fulton", "Williams", "Defiance", # "Paulding", "Henry", "Putnam", "Hancock", "Sandusky", # "Erie", "Ottawa", "Seneca", "Wyandot", "Crawford", # "Huron", "Ashland", "Richland", "Morrow", "Knox", # "Marion", "Hardin", "Logan", "Union", "Delaware", # "Allen", "Van Wert", "Auglaize", "Shelby", "Mercer"), # Central = c("Franklin", "Licking", "Fairfield", "Pickaway", # "Madison", "Fayette", "Ross", "Clark", "Greene", # "Montgomery", "Preble", "Darke", "Miami", "Champaign"), # Southwest = c("Hamilton", "Butler", "Warren", "Clermont", "Clinton", # "Highland", "Brown", "Adams", "Scioto", "Lawrence", # "Gallia", "Jackson", "Pike"), # Southeast = c("Belmont", "Monroe", "Washington", "Meigs", "Morgan", # "Noble", "Guernsey", "Muskingum", "Perry", "Hocking", # "Athens", "Tuscarawas", "Coshocton", "Vinton") # ), # label = "Ohio" # ) # # summary(oh) # plot(oh, "both") ## ----canada-regions----------------------------------------------------------- province_regions <- data.frame( PRUID = c("10", "11", "12", "13", "24", "35", "46", "47", "48", "59", "60", "61", "62"), region = c(rep("Atlantic", 4), "Quebec", "Ontario", rep("Prairies", 3), "Pacific", rep("Territories", 3)), stringsAsFactors = FALSE ) ## ----canada-download, eval = FALSE-------------------------------------------- # cache_file <- file.path(path.expand("~"), "explode_map_cache", # "canada_csds_2021.rds") # # if (file.exists(cache_file)) { # sf_raw <- readRDS(cache_file) # } else { # url <- paste0( # "https://www12.statcan.gc.ca/census-recensement/2021/geo/sip-pis/", # "boundary-limites/files-fichiers/lcsd000b21a_e.zip" # ) # tmp <- tempfile(fileext = ".zip") # download.file(url, tmp, mode = "wb") # dir <- file.path(tempdir(), "canada_csds") # dir.create(dir, showWarnings = FALSE) # unzip(tmp, exdir = dir) # shp <- list.files(dir, "\\.shp$", recursive = TRUE, full.names = TRUE) # sf_raw <- st_read(shp[1], quiet = TRUE) # dir.create(dirname(cache_file), showWarnings = FALSE, recursive = TRUE) # saveRDS(sf_raw, cache_file) # } ## ----canada-explode, eval = FALSE--------------------------------------------- # sf_proj <- sf_raw |> # st_transform(3347) |> # left_join(province_regions, by = "PRUID") # # sf_proj$region[is.na(sf_proj$region)] <- "Other" # # sf_prov <- sf_proj |> # filter(region != "Territories") # # canada <- explode_sf( # sf_prov, # region_col = "region", # allow_other = TRUE, # label = "Canada (provinces)" # ) # # summary(canada) # plot(canada, "both") ## ----hhs-lookup--------------------------------------------------------------- hhs_lookup <- data.frame( STUSPS = c( "CT", "ME", "MA", "NH", "RI", "VT", "NJ", "NY", "PR", "VI", "DE", "DC", "MD", "PA", "VA", "WV", "AL", "FL", "GA", "KY", "MS", "NC", "SC", "TN", "IL", "IN", "MI", "MN", "OH", "WI", "AR", "LA", "NM", "OK", "TX", "IA", "KS", "MO", "NE", "CO", "MT", "ND", "SD", "UT", "WY", "AZ", "CA", "HI", "NV", "GU", "AS", "MP", "AK", "ID", "OR", "WA" ), hhs_region = c( rep("1", 6), rep("2", 4), rep("3", 6), rep("4", 8), rep("5", 6), rep("6", 5), rep("7", 4), rep("8", 6), rep("9", 7), rep("10", 4) ), stringsAsFactors = FALSE ) ## ----hhs-download, eval = FALSE----------------------------------------------- # cache_file <- file.path(path.expand("~"), "explode_map_cache", # "us_states.rds") # # if (file.exists(cache_file)) { # states_sf <- readRDS(cache_file) # } else { # url <- "https://www2.census.gov/geo/tiger/TIGER2024/STATE/tl_2024_us_state.zip" # tmp <- tempfile(fileext = ".zip") # download.file(url, tmp, mode = "wb", quiet = TRUE) # dir <- file.path(tempdir(), "us_states") # dir.create(dir, showWarnings = FALSE) # unzip(tmp, exdir = dir) # shp <- list.files(dir, "\\.shp$", recursive = TRUE, full.names = TRUE) # states_sf <- st_read(shp[1], quiet = TRUE) # dir.create(dirname(cache_file), showWarnings = FALSE, recursive = TRUE) # saveRDS(states_sf, cache_file) # } ## ----hhs-explode, eval = FALSE------------------------------------------------ # states_proj <- states_sf |> # st_transform(5070) |> # left_join(hhs_lookup, by = "STUSPS") # # states_proj$hhs_region[is.na(states_proj$hhs_region)] <- "Other" # # hhs <- explode_grouped( # states_proj, # region_col = "hhs_region", # mode = "auto_collision", # alpha_l = 120000, # p = 1.25, # kappa = 1.8, # padding = 80000, # delta = 20000, # lambda = 0.18, # eta = 0.18, # padding_sep = 30000, # max_iter = 60, # label = "US by HHS Region" # ) # # print(hhs) # plot(hhs, "all") ## ----session-info------------------------------------------------------------- sessionInfo()