From 9c320cdbb6bee853193ac729e6710f37535e07bc Mon Sep 17 00:00:00 2001 From: CarwilB <54286746+CarwilB@users.noreply.github.com> Date: Tue, 23 Sep 2025 15:39:36 -0500 Subject: [PATCH 01/14] Added filename-tools for domains only. --- R/filename-tools-subset.R | 40 +++++++++++++++++++++ tests/testthat/test-filename-tools-subset.R | 26 ++++++++++++++ 2 files changed, 66 insertions(+) create mode 100644 R/filename-tools-subset.R create mode 100644 tests/testthat/test-filename-tools-subset.R diff --git a/R/filename-tools-subset.R b/R/filename-tools-subset.R new file mode 100644 index 0000000..1eb5506 --- /dev/null +++ b/R/filename-tools-subset.R @@ -0,0 +1,40 @@ +#' Generate protest domain filename +#' +#' @param protest_domain The protest domain name +#' @return The corresponding filename for the domain page, +#' relative to the root of the website. +#' @export +#' +#' @examples +#' domain_filename("Rural land") +domain_filename <- function(protest_domain){ + # No files for overlapping domains like "Rural land, Partisan politics" + name <- stringr::str_replace_all(protest_domain, "\\s+", "-") %>% + stringr::str_to_lower() %>% + stringi::stri_trans_general("Latin-ASCII") + filename <- str_glue("/domain/{name}.html") + return(if_else(stringr::str_detect(protest_domain, ","), + "", # No files for overlapping domains + filename + )) +} + +#' Generate Spanish domain filename +#' +#' @param protest_domain The protest domain name in Spanish +#' @return The corresponding filename for the Spanish domain page, +#' relative to the root of the website. +#' +#' @examples +#' domain_filename_es("Campesino") +domain_filename_es <- function(protest_domain){ + name <- stringr::str_replace_all(protest_domain, "\\s+", "-") %>% + stringr::str_to_lower() %>% + stringi::stri_trans_general("Latin-ASCII") + filename <- str_glue("/dominio/{name}.html") + + return(if_else(stringr::str_detect(protest_domain, ","), + "", # No files for overlapping domains + filename + )) +} diff --git a/tests/testthat/test-filename-tools-subset.R b/tests/testthat/test-filename-tools-subset.R new file mode 100644 index 0000000..17c6220 --- /dev/null +++ b/tests/testthat/test-filename-tools-subset.R @@ -0,0 +1,26 @@ +test_that("domain_filename works", { + domain_list <- c("Gas wars", "Economic policies", "Labor", "Education", "Mining", + "Coca", "Peasant", "Rural land", + "Ethno-ecological", "Urban land", "Drug trade", "Contraband", + "Municipal governance", "Local development", "National governance", + "Partisan politics", "Disabled", "Guerrilla", "Paramilitary", + "Unknown") + desired_links <- c("/domain/gas-wars.html", "/domain/economic-policies.html", + "/domain/labor.html", "/domain/education.html", "/domain/mining.html", + "/domain/coca.html", "/domain/peasant.html", "/domain/rural-land.html", + "/domain/ethno-ecological.html", "/domain/urban-land.html", + "/domain/drug-trade.html", "/domain/contraband.html", + "/domain/municipal-governance.html", + "/domain/local-development.html", "/domain/national-governance.html", + "/domain/partisan-politics.html", "/domain/disabled.html", + "/domain/guerrilla.html", + "/domain/paramilitary.html", "/domain/unknown.html") + expect_equal(domain_filename(domain_list), desired_links) +}) +test_that("domain_filename handles commas", { + expect_equal(domain_filename("Rural land, Partisan politics"), "") + expect_equal(domain_filename_es("Campesino, Politica partidaria"), "") +}) + + + From 5f193d9f8788661a142a477d9cc3dc8205635976 Mon Sep 17 00:00:00 2001 From: CarwilB <54286746+CarwilB@users.noreply.github.com> Date: Thu, 30 Oct 2025 09:50:34 -0500 Subject: [PATCH 02/14] Initial waffle-plot-functions, testcode, imports, etc. --- DESCRIPTION | 3 + NAMESPACE | 20 ++ R/consequencestools-package.R | 19 ++ R/waffle-plot-functions.R | 198 ++++++++++++++++ tests/testthat/test-waffle-plot-functions.R | 245 ++++++++++++++++++++ 5 files changed, 485 insertions(+) create mode 100644 R/waffle-plot-functions.R create mode 100644 tests/testthat/test-waffle-plot-functions.R diff --git a/DESCRIPTION b/DESCRIPTION index aa08b33..cb1f2a8 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -28,6 +28,7 @@ Imports: assertthat, dplyr, forcats, + ggplot2, grDevices, incase, lubridate, @@ -36,12 +37,14 @@ Imports: reactable, reactablefmtr, rlang, + scales, stringi, stringr, tidyr, tidyselect, transcats (>= 0.0.0.9002), utils, + waffle (>= 1.0.2), zoo Depends: R (>= 3.5) diff --git a/NAMESPACE b/NAMESPACE index d8d9695..b23a21e 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -34,6 +34,7 @@ export(count_ongoing_events) export(count_range_by) export(department_name_from_id) export(displayed_date_string) +export(domain_filename) export(estimated_date) export(estimated_date_string) export(event_counts_by) @@ -113,6 +114,22 @@ importFrom(forcats,fct_collapse) importFrom(forcats,fct_explicit_na) importFrom(forcats,fct_na_value_to_level) importFrom(forcats,fct_relevel) +importFrom(ggplot2,aes) +importFrom(ggplot2,coord_equal) +importFrom(ggplot2,element_blank) +importFrom(ggplot2,element_line) +importFrom(ggplot2,element_text) +importFrom(ggplot2,facet_wrap) +importFrom(ggplot2,geom_vline) +importFrom(ggplot2,ggplot) +importFrom(ggplot2,guide_legend) +importFrom(ggplot2,scale_fill_manual) +importFrom(ggplot2,scale_x_continuous) +importFrom(ggplot2,scale_x_discrete) +importFrom(ggplot2,scale_y_continuous) +importFrom(ggplot2,scale_y_discrete) +importFrom(ggplot2,theme) +importFrom(ggplot2,theme_minimal) importFrom(grDevices,col2rgb) importFrom(grDevices,colorRamp) importFrom(grDevices,rgb) @@ -124,7 +141,9 @@ importFrom(reactable,colDef) importFrom(reactablefmtr,nytimes) importFrom(rlang,"!!!") importFrom(rlang,.data) +importFrom(rlang,enquo) importFrom(rlang,list2) +importFrom(rlang,quo_name) importFrom(rlang,sym) importFrom(stringi,stri_trans_general) importFrom(stringr,str_c) @@ -141,4 +160,5 @@ importFrom(tidyselect,any_of) importFrom(tidyselect,last_col) importFrom(transcats,translated_join_vars) importFrom(utils,head) +importFrom(waffle,geom_waffle) importFrom(zoo,as.Date.yearmon) diff --git a/R/consequencestools-package.R b/R/consequencestools-package.R index 2e42bb0..d49642a 100644 --- a/R/consequencestools-package.R +++ b/R/consequencestools-package.R @@ -22,6 +22,22 @@ #' @importFrom forcats fct_explicit_na #' @importFrom forcats fct_na_value_to_level #' @importFrom forcats fct_relevel +#' @importFrom ggplot2 aes +#' @importFrom ggplot2 coord_equal +#' @importFrom ggplot2 element_blank +#' @importFrom ggplot2 element_line +#' @importFrom ggplot2 element_text +#' @importFrom ggplot2 facet_wrap +#' @importFrom ggplot2 geom_vline +#' @importFrom ggplot2 ggplot +#' @importFrom ggplot2 guide_legend +#' @importFrom ggplot2 scale_fill_manual +#' @importFrom ggplot2 scale_x_continuous +#' @importFrom ggplot2 scale_x_discrete +#' @importFrom ggplot2 scale_y_continuous +#' @importFrom ggplot2 scale_y_discrete +#' @importFrom ggplot2 theme +#' @importFrom ggplot2 theme_minimal #' @importFrom grDevices col2rgb #' @importFrom grDevices colorRamp #' @importFrom grDevices rgb @@ -31,7 +47,9 @@ #' @importFrom reactablefmtr nytimes #' @importFrom rlang !!! #' @importFrom rlang .data +#' @importFrom rlang enquo #' @importFrom rlang list2 +#' @importFrom rlang quo_name #' @importFrom rlang sym #' @importFrom stringi stri_trans_general #' @importFrom stringr str_c @@ -48,6 +66,7 @@ #' @importFrom tidyselect last_col #' @importFrom transcats translated_join_vars #' @importFrom utils head +#' @importFrom waffle geom_waffle #' @importFrom zoo as.Date.yearmon ## usethis namespace: end NULL diff --git a/R/waffle-plot-functions.R b/R/waffle-plot-functions.R new file mode 100644 index 0000000..43ef7e6 --- /dev/null +++ b/R/waffle-plot-functions.R @@ -0,0 +1,198 @@ +#' Helper function to create counts dataframe for waffle charts +#' +#' @param dataframe The input dataframe containing the data. +#' @param x_var The variable to facet the waffle chart by (e.g., year). +#' @param fill_var The variable to color the waffle chart blocks by (e.g., +#' state_responsibility). +#' @param fill_var_description A list containing the title, levels, and colors +#' for the fill variable. Can be taken from our level description list, lev. +#' +#' @return A dataframe with counts of occurrences for each combination of x_var +#' and fill_var. +#' +#' @export +#' @examples +#' waffle_counts(dataframe = assign_state_responsibility_levels(deaths_aug24, simplify = TRUE), +#' x_var = year, fill_var = state_responsibility, +#' fill_var_description = lev$state_responsibility) +waffle_counts <- function(dataframe, x_var, + fill_var, fill_var_description) { + # Ensure the fill variable is properly factored with the correct levels + dataframe <- dataframe %>% + mutate(across({{ fill_var }}, + ~factor(., levels = fill_var_description$levels))) + + # Create the counts dataframe + counts_df <- dataframe %>% + filter(!is.na(year)) %>% + filter(!is.na({{ x_var }})) %>% + filter({{ x_var }} != "Unknown") %>% + filter(!is.na({{ fill_var }})) %>% + dplyr::count({{ x_var }}, {{ fill_var }}) + + return(counts_df) +} + +# New helper function to add null/missing x values +complete_x_values <- function(counts_df, x_var, fill_var, + all_levels = NULL, .verbose = FALSE) { + x_var_name <- quo_name(enquo(x_var)) + existing_values <- unique(counts_df[[x_var_name]]) + + null_x_values <- c() + range_of_x_levels <- c() + + # Handle year variable + if (x_var_name == "year") { + min_val <- min(existing_values) + max_val <- max(existing_values) + range_of_x_levels <- min_val:max_val + null_x_values <- setdiff(range_of_x_levels, existing_values) + + if (.verbose) { + print(paste("Null values: ", paste(null_x_values, collapse = ", "))) + } + } + + # Handle pres_admin variable (requires all_levels) + if (x_var_name == "pres_admin") { + if (is.null(all_levels)) { + stop("all_levels must be provided for pres_admin variable") + } + + min_idx <- min(match(existing_values, all_levels)) + max_idx <- max(match(existing_values, all_levels)) + range_of_x_levels <- all_levels[min_idx:max_idx] + null_x_values <- setdiff(range_of_x_levels, existing_values) + } + + # Add null rows if any missing values found + if (length(null_x_values) > 0) { + null_rows <- tibble( + {{ x_var }} := null_x_values, + {{ fill_var }} := " ", + n = 1 + ) + counts_df <- bind_rows(counts_df, null_rows) + } + + # Re-factor x variable with complete range of levels + if (length(range_of_x_levels) > 0) { + counts_df <- counts_df %>% + mutate(across(1, ~factor(., levels = range_of_x_levels))) + } + + if (.verbose) { + print(str(counts_df)) + } + + return(counts_df) +} + +make_waffle_chart <- function(dataframe, x_var, fill_var, + fill_var_description, + n_columns = 5, + waffle_width = 10, + complete_x = FALSE, + .verbose = FALSE) { + # Get the color palette from the corresponding description variable + fill_colors <- fill_var_description$colors + fill_legend <- fill_colors + + x_var_name <- quo_name(enquo(x_var)) + range_of_x_levels <- NULL + + if (is.factor(dataframe[[x_var_name]])) { + all_levels <- levels(dataframe[[x_var_name]]) + range_of_x_levels <- all_levels + } + + counts_df <- waffle_counts(dataframe, {{x_var}}, {{fill_var}}, + {{fill_var_description}}) + + # Complete with null blocks if requested + if (complete_x) { + counts_df <- complete_x_values(counts_df, {{x_var}}, {{fill_var}}, + all_levels = range_of_x_levels, + .verbose = .verbose) + + # Add null to the color set but not to the legend + fill_colors <- c(fill_colors, ' ' = "white") + } + + # Create the plot + ggplot(counts_df, aes(fill = {{ fill_var }}, values = n)) + + geom_waffle(color = "white", size = .25, n_rows = waffle_width, + flip = TRUE, na.rm = TRUE) + + facet_wrap(vars({{ x_var }}), ncol = n_columns, + labeller = label_wrap_gen(20), + strip.position = "bottom") + + scale_x_discrete() + + scale_y_continuous(breaks = c(0.5, 5.5, 10.5), + labels = function(x) (x-0.5) * waffle_width, + expand = c(0,0)) + + coord_equal() + + scale_fill_manual(name = fill_var_description$title, + values = fill_colors, + limits = names(fill_colors), + breaks = names(fill_colors)) + + theme_minimal(base_family = "Roboto Condensed") + + theme(panel.grid = element_blank(), axis.ticks.y = element_line(), + legend.text = element_text(size = 12), + axis.text = element_text(size = 12), + strip.text.x = element_text(size = 12)) + + guides(fill = guide_legend(reverse = TRUE)) +} + +make_waffle_chart_tall <- function(dataframe, x_var, fill_var, fill_var_description, + n_columns = 5) { + counts_df <- waffle_counts(dataframe, {{x_var}}, {{fill_var}}, + {{fill_var_description}}) + + # Define waffle chart parameters + waffle_width <- 5 + + # Get the color palette from the corresponding description variable + fill_colors <- fill_var_description$colors + + legend_orientation <- "horizontal" + if ((nrow(counts_df) / n_columns) <= 1) { + legend_orientation <- "vertical" + } + + # Create the plot + ggplot(counts_df, aes(fill = {{ fill_var }}, values = n)) + + # Remove flip=TRUE to make bars build left to right + geom_waffle(color = "white", size = .25, n_rows = waffle_width, na.rm = TRUE) + + # Change strip.position to "left" and use nrow instead of ncol + facet_wrap(ggplot2::vars({{ x_var }}), nrow = n_columns, + labeller = label_wrap_gen(20), + strip.position = "left", + dir = "v") + + scale_x_continuous(breaks = c(0.5, 5.5, 10.5, 15.5, 20.5, 25.5), + labels = function(x) (x-0.5) * waffle_width, + expand = c(0,0)) + + # Use scale_y_discrete() instead of scale_x_discrete() + scale_y_discrete() + + coord_equal() + + scale_fill_manual(name = fill_var_description$title, + values = fill_colors, + breaks = names(fill_colors), + guide = guide_legend(reverse = FALSE)) + + theme_minimal(base_family = "Roboto Condensed") + + # Change axis.ticks.y to axis.ticks.x + theme(panel.grid = element_blank(), + axis.ticks.x = element_line(), + legend.text = element_text(size = 12), + axis.text = element_text(size = 12), + legend.position = "top", + legend.direction = legend_orientation, + # Change strip.text.x to strip.text.y + strip.text.y.left = element_text(size = 14, + angle = 0, hjust = 0), + strip.placement = "outside", + plot.margin = ggplot2::margin(5, 20, 5, 35)) + + # add a 1pt solid line at x=0.5 and 1pt grey line at x =20.5 + geom_vline(xintercept = 0.5, color = "black", linewidth = 0.5) + + geom_vline(xintercept = 20.5, color = "darkgrey", linewidth = 0.25) +} diff --git a/tests/testthat/test-waffle-plot-functions.R b/tests/testthat/test-waffle-plot-functions.R new file mode 100644 index 0000000..7703a26 --- /dev/null +++ b/tests/testthat/test-waffle-plot-functions.R @@ -0,0 +1,245 @@ +# Tests for waffle plot functions + +# Setup test data and descriptions +setup_test_data <- function() { + # Create sample fill variable description + fill_desc <- list( + title = "Test Category", + levels = c("Category A", "Category B", "Category C"), + colors = c("Category A" = "#FF0000", + "Category B" = "#00FF00", + "Category C" = "#0000FF") + ) + + # Create sample dataframe + test_df <- tibble::tibble( + year = c(2010, 2010, 2012, 2012, 2014, 2014), + pres_admin = factor(c("Admin1", "Admin1", "Admin2", "Admin2", "Admin3", "Admin3"), + levels = c("Admin1", "Admin2", "Admin3", "Admin4")), + category = factor(c("Category A", "Category B", "Category A", + "Category C", "Category B", "Category C"), + levels = c("Category A", "Category B", "Category C")), + value = c(5, 3, 4, 2, 6, 1) + ) + + list(df = test_df, fill_desc = fill_desc) +} + +test_that("waffle_counts filters and counts correctly", { + test_data <- setup_test_data() + + result <- waffle_counts(test_data$df, year, category, test_data$fill_desc) + + # Should have 6 rows (one for each year-category combination) + expect_equal(nrow(result), 6) + + # Should have 3 columns: year, category, n + expect_equal(ncol(result), 3) + + # Category should be properly factored + expect_true(is.factor(result$category)) + expect_equal(levels(result$category), test_data$fill_desc$levels) +}) + +test_that("waffle_counts filters out NA and Unknown values", { + test_data <- setup_test_data() + + # Add problematic rows + df_with_nas <- test_data$df %>% + dplyr::bind_rows( + tibble::tibble(year = NA, pres_admin = "Admin1", category = "Category A", value = 1), + tibble::tibble(year = 2015, pres_admin = "Unknown", category = "Category A", value = 1), + tibble::tibble(year = 2015, pres_admin = "Admin1", category = NA, value = 1) + ) + + result <- waffle_counts(df_with_nas, pres_admin, category, test_data$fill_desc) + + # Should only have the original 6 rows + expect_equal(nrow(result), 6) + + # Should not contain NA or "Unknown" + expect_false(any(is.na(result$pres_admin))) + expect_false(any(result$pres_admin == "Unknown")) + expect_false(any(is.na(result$category))) +}) + +test_that("waffle_counts works on standard dataset", { + deaths <- deaths_aug24 %>% + assign_state_responsibility_levels(simplify = TRUE) + result <- waffle_counts(deaths, year, state_responsibility, + lev$state_responsibility) + + # Should have more than 0 rows + expect_gt(nrow(result), 0) + + # Should have full range of values + expect_equal(sort(unique(result$year)), + sort(unique(na.omit(deaths$year)))) + expect_equal(sort(unique(result$state_responsibility)), + sort(unique(deaths$state_responsibility))) + + # Should have 3 columns: year, state_responsibility, n + expect_equal(names(result), c("year", "state_responsibility", "n")) + + # state_responsibility should be properly factored + expect_true(is.factor(result$state_responsibility)) + expect_equal(levels(result$state_responsibility), lev$state_responsibility$levels) +}) + +test_that("make_waffle_chart returns a ggplot object", { + test_data <- setup_test_data() + + result <- make_waffle_chart(test_data$df, year, category, + test_data$fill_desc, complete_x = FALSE) + + expect_s3_class(result, "gg") + expect_s3_class(result, "ggplot") +}) + +test_that("complete_x_values adds missing years", { + test_data <- setup_test_data() + + # Create data with gaps + df_with_gaps <- test_data$df %>% + dplyr::filter(year != 2012) # Remove 2012 + + counts_df <- waffle_counts(df_with_gaps, year, category, test_data$fill_desc) + + completed_counts <- complete_x_values(counts_df, year, category, + all_levels = NULL, .verbose = FALSE) + + # Check that 2012 was added + expect_true(2012 %in% completed_counts$year) +}) +complete_x_values() + +test_that("complete_x_values fixes missing years in standard data", { + deaths <- assign_levels(deaths_aug24, "standard", .simplify=TRUE) + + # Create data with gaps + df_with_gaps <- deaths %>% + dplyr::filter(year != 2012) # Remove 2012 + + waffle_counts_df <- waffle_counts(df_with_gaps, + x_var = year, + fill_var = protest_domain, + fill_var_description = lev$protest_domain) + + expect_equal(nrow(waffle_counts_df[waffle_counts_df$year == 2012, ]), 0) + + waffle_counts_df_completed <- complete_x_values(waffle_counts_df, + x_var = year, + fill_var = protest_domain, + all_levels = NULL, + .verbose = FALSE) + expect_true(2012 %in% waffle_counts_df_completed$year) + + result <- make_waffle_chart(df_with_gaps, + x_var = year, + fill_var = protest_domain, + lev$protest_domain, complete_x = FALSE) + + # Check that the plot data doesn't include 2012 + plot_data <- ggplot2::ggplot_build(result)$data[[1]] + expect_false(2012 %in% unique(df_with_gaps$year)) + + result_completed <- make_waffle_chart(df_with_gaps, + x_var = year, + fill_var = protest_domain, + lev$protest_domain, complete_x = TRUE) + # Check that the plot data includes 2012 + plot_data_completed <- ggplot2::ggplot_build(result_completed)$data[[1]] + expect_true(2012 %in% unique(plot_data_completed$x)) + + +}) + +test_that("make_waffle_chart with complete_x=TRUE fills year gaps", { +# test_data <- setup_test_data() + + # Create data with gaps in years + df_with_gaps <- deaths_aug24 %>% + assign_state_responsibility_levels(simplify = TRUE) %>% + dplyr::filter(year != 2012) # Remove 2012 + + # This should add a null block for 2012 + result <- make_waffle_chart(df_with_gaps, + x_var = year, + fill_var = state_responsibility, + lev$state_responsibility, complete_x = FALSE) + + expect_s3_class(result, "ggplot") + + # Check that white color was added for null blocks + fill_scale <- result$scales$get_scales("fill") + expect_true(" " %in% names(fill_scale$palette())) +}) + +# test_that("make_waffle_chart with complete_x=TRUE fills pres_admin gaps", { +# test_data <- setup_test_data() +# +# # Create data with gaps in pres_admin (missing Admin2) +# df_with_gaps <- test_data$df %>% +# dplyr::filter(pres_admin != "Admin2") +# +# # This should add a null block for Admin2 +# result <- make_waffle_chart(df_with_gaps, pres_admin, category, +# test_data$fill_desc, complete_x = TRUE) +# +# expect_s3_class(result, "ggplot") +# +# # Check that white color was added for null blocks +# fill_scale <- result$scales$get_scales("fill") +# expect_true(" " %in% names(fill_scale$palette())) +# }) + +# test_that("make_waffle_chart respects color palette from fill_var_description", { +# test_data <- setup_test_data() +# +# result <- make_waffle_chart(test_data$df, year, category, +# test_data$fill_desc, complete_x = FALSE) +# +# # Get the fill scale +# fill_scale <- result$scales$get_scales("fill") +# colors <- fill_scale$palette()(length(test_data$fill_desc$colors)) +# names(colors) <- test_data$fill_desc$levels +# +# # Colors should match (order may differ) +# expect_setequal(names(colors), names(test_data$fill_desc$colors)) +# }) + +test_that("make_waffle_chart_tall returns a ggplot object", { + test_data <- setup_test_data() + + result <- make_waffle_chart_tall(test_data$df, year, category, + test_data$fill_desc) + + expect_s3_class(result, "gg") + expect_s3_class(result, "ggplot") +}) + +test_that("make_waffle_chart handles different waffle_width values", { + test_data <- setup_test_data() + + result1 <- make_waffle_chart(test_data$df, year, category, + test_data$fill_desc, waffle_width = 5) + result2 <- make_waffle_chart(test_data$df, year, category, + test_data$fill_desc, waffle_width = 15) + + expect_s3_class(result1, "ggplot") + expect_s3_class(result2, "ggplot") +}) + +test_that("complete_x verbose mode produces output", { + test_data <- setup_test_data() + + df_with_gaps <- test_data$df %>% + dplyr::filter(year != 2012) + + # Should print verbose output + expect_output( + make_waffle_chart(df_with_gaps, year, category, + test_data$fill_desc, complete_x = TRUE, .verbose = TRUE), + "Null values" + ) +}) From 26133301c0d2b1aedcf79111f43e9db9c396b1c2 Mon Sep 17 00:00:00 2001 From: CarwilB <54286746+CarwilB@users.noreply.github.com> Date: Thu, 30 Oct 2025 09:53:06 -0500 Subject: [PATCH 03/14] commit a version without using the complete_x_values function. --- R/waffle-plot-functions.R | 81 +++++++++++++++++++++++++++++++-------- 1 file changed, 66 insertions(+), 15 deletions(-) diff --git a/R/waffle-plot-functions.R b/R/waffle-plot-functions.R index 43ef7e6..939bbc2 100644 --- a/R/waffle-plot-functions.R +++ b/R/waffle-plot-functions.R @@ -1,4 +1,4 @@ -#' Helper function to create counts dataframe for waffle charts +# Helper function to create counts dataframe for waffle charts #' #' @param dataframe The input dataframe containing the data. #' @param x_var The variable to facet the waffle chart by (e.g., year). @@ -100,9 +100,8 @@ make_waffle_chart <- function(dataframe, x_var, fill_var, fill_legend <- fill_colors x_var_name <- quo_name(enquo(x_var)) - range_of_x_levels <- NULL - - if (is.factor(dataframe[[x_var_name]])) { + range_of_x_levels <- list() + if(is.factor(dataframe[[x_var_name]])){ all_levels <- levels(dataframe[[x_var_name]]) range_of_x_levels <- all_levels } @@ -110,26 +109,78 @@ make_waffle_chart <- function(dataframe, x_var, fill_var, counts_df <- waffle_counts(dataframe, {{x_var}}, {{fill_var}}, {{fill_var_description}}) - # Complete with null blocks if requested + # complete with a single null block if (complete_x) { - counts_df <- complete_x_values(counts_df, {{x_var}}, {{fill_var}}, - all_levels = range_of_x_levels, - .verbose = .verbose) + null_x_values <- list() # if not recognized below, add nothing + + if (x_var_name == "year") { + null_x_values <- { + existing_values <- unique(counts_df[[x_var_name]]) + + # Find min and max indices of existing values in the levels vector + min_val <- min(existing_values) + max_val <- max(existing_values) + + # Get only the levels that are between min and max (inclusive) + range_of_x_levels <- min_val:max_val + + # Find which of these middle levels are missing from counts_df + setdiff(range_of_x_levels, existing_values) + } + if(.verbose){ + print(paste("Null values: ", null_x_values))} + } - # Add null to the color set but not to the legend - fill_colors <- c(fill_colors, ' ' = "white") + if (x_var_name =="pres_admin") { + null_x_values <- { + + existing_values <- unique(counts_df[[x_var_name]]) + + # Find min and max indices of existing values in the levels vector + min_idx <- min(match(existing_values, all_levels)) + max_idx <- max(match(existing_values, all_levels)) + + # Get only the levels that are between min and max (inclusive) + range_of_x_levels <- all_levels[min_idx:max_idx] + + # Find which of these middle levels are missing from counts_df + setdiff(range_of_x_levels, existing_values) + } + } + + + # Add a row for each null x value + if ( length(null_x_values) > 0){ + null_rows <- tibble( + {{ x_var }} := null_x_values, + {{ fill_var }} := " ", + n = 1) + counts_df <- bind_rows(counts_df, null_rows) + } + + if (length(range_of_x_levels) > 0){ + counts_df <- counts_df %>% + mutate(across(1, ~factor(., levels = range_of_x_levels))) + } + if(.verbose){ print(str(counts_df))} + + # add null to the color set but not to the legend + + fill_colors <- c(fill_colors, + ' ' = "white" + ) } # Create the plot ggplot(counts_df, aes(fill = {{ fill_var }}, values = n)) + - geom_waffle(color = "white", size = .25, n_rows = waffle_width, + waffle::geom_waffle(color = "white", size = .25, n_rows = waffle_width, flip = TRUE, na.rm = TRUE) + - facet_wrap(vars({{ x_var }}), ncol = n_columns, - labeller = label_wrap_gen(20), + facet_wrap(ggplot2::vars({{ x_var }}), ncol = n_columns, + labeller = ggplot2::label_wrap_gen(20), strip.position = "bottom") + scale_x_discrete() + scale_y_continuous(breaks = c(0.5, 5.5, 10.5), - labels = function(x) (x-0.5) * waffle_width, + labels = function(x) (x-0.5) * waffle_width, # make this multiplier the same as n_rows expand = c(0,0)) + coord_equal() + scale_fill_manual(name = fill_var_description$title, @@ -141,7 +192,7 @@ make_waffle_chart <- function(dataframe, x_var, fill_var, legend.text = element_text(size = 12), axis.text = element_text(size = 12), strip.text.x = element_text(size = 12)) + - guides(fill = guide_legend(reverse = TRUE)) + ggplot2::guides(fill = guide_legend(reverse = TRUE)) } make_waffle_chart_tall <- function(dataframe, x_var, fill_var, fill_var_description, From 298977642c0fb9a39aaa54113a3b841673228218 Mon Sep 17 00:00:00 2001 From: CarwilB <54286746+CarwilB@users.noreply.github.com> Date: Thu, 30 Oct 2025 09:56:42 -0500 Subject: [PATCH 04/14] incorporate complete_x_values() --- R/waffle-plot-functions.R | 66 ++++++--------------------------------- 1 file changed, 9 insertions(+), 57 deletions(-) diff --git a/R/waffle-plot-functions.R b/R/waffle-plot-functions.R index 939bbc2..cf2aabe 100644 --- a/R/waffle-plot-functions.R +++ b/R/waffle-plot-functions.R @@ -110,65 +110,17 @@ make_waffle_chart <- function(dataframe, x_var, fill_var, {{fill_var_description}}) # complete with a single null block + # Complete with null blocks if requested if (complete_x) { - null_x_values <- list() # if not recognized below, add nothing - - if (x_var_name == "year") { - null_x_values <- { - existing_values <- unique(counts_df[[x_var_name]]) - - # Find min and max indices of existing values in the levels vector - min_val <- min(existing_values) - max_val <- max(existing_values) - - # Get only the levels that are between min and max (inclusive) - range_of_x_levels <- min_val:max_val - - # Find which of these middle levels are missing from counts_df - setdiff(range_of_x_levels, existing_values) - } - if(.verbose){ - print(paste("Null values: ", null_x_values))} - } - - if (x_var_name =="pres_admin") { - null_x_values <- { - - existing_values <- unique(counts_df[[x_var_name]]) - - # Find min and max indices of existing values in the levels vector - min_idx <- min(match(existing_values, all_levels)) - max_idx <- max(match(existing_values, all_levels)) - - # Get only the levels that are between min and max (inclusive) - range_of_x_levels <- all_levels[min_idx:max_idx] - - # Find which of these middle levels are missing from counts_df - setdiff(range_of_x_levels, existing_values) - } + # code only implemented for these two variables for now + if (x_var_name %in% c("year", "pres_admin")){ + counts_df <- complete_x_values(counts_df, {{x_var}}, {{fill_var}}, + all_levels = range_of_x_levels, + .verbose = .verbose) + + # Add null to the color set but not to the legend + fill_colors <- c(fill_colors, ' ' = "white") } - - - # Add a row for each null x value - if ( length(null_x_values) > 0){ - null_rows <- tibble( - {{ x_var }} := null_x_values, - {{ fill_var }} := " ", - n = 1) - counts_df <- bind_rows(counts_df, null_rows) - } - - if (length(range_of_x_levels) > 0){ - counts_df <- counts_df %>% - mutate(across(1, ~factor(., levels = range_of_x_levels))) - } - if(.verbose){ print(str(counts_df))} - - # add null to the color set but not to the legend - - fill_colors <- c(fill_colors, - ' ' = "white" - ) } # Create the plot From 3b78f8cb370f0e7cbec2c9b4dec6ff47b4c8c85e Mon Sep 17 00:00:00 2001 From: CarwilB <54286746+CarwilB@users.noreply.github.com> Date: Thu, 30 Oct 2025 10:38:23 -0500 Subject: [PATCH 05/14] Waffle plot functions are tested and documented --- R/waffle-plot-functions.R | 52 +++++++++++++- tests/testthat/test-waffle-plot-functions.R | 75 ++++++--------------- 2 files changed, 71 insertions(+), 56 deletions(-) diff --git a/R/waffle-plot-functions.R b/R/waffle-plot-functions.R index cf2aabe..b0d2837 100644 --- a/R/waffle-plot-functions.R +++ b/R/waffle-plot-functions.R @@ -33,7 +33,29 @@ waffle_counts <- function(dataframe, x_var, return(counts_df) } -# New helper function to add null/missing x values +#' New helper function to add null/missing x values +#' +#' @param counts_df The counts dataframe from waffle_counts +#' @param x_var The variable to facet the waffle chart by (e.g., year). +#' @param fill_var The variable to color the waffle chart blocks by (e.g., +#' state_responsibility). +#' @param all_levels Optional: All possible levels for the x variable (needed +#' for pres_admin) +#' @param .verbose Logical indicating whether to print debug information +#' @return The counts dataframe with missing x values added +#' +#' @examples +#' deaths <- assign_levels(deaths_aug24, "standard", .simplify=TRUE) %>% +#' dplyr::filter(year != 2012) # Remove 2012 +#' waffle_counts_df <- waffle_counts(deaths, +#' x_var = year, +#' fill_var = protest_domain, +#' fill_var_description = lev$protest_domain) +#' waffle_counts_df_completed <- complete_x_values(waffle_counts_df, +#' x_var = year, +#' fill_var = protest_domain, +#' all_levels = NULL, +#' .verbose = FALSE) complete_x_values <- function(counts_df, x_var, fill_var, all_levels = NULL, .verbose = FALSE) { x_var_name <- quo_name(enquo(x_var)) @@ -89,6 +111,34 @@ complete_x_values <- function(counts_df, x_var, fill_var, return(counts_df) } +#' Create a waffle chart with facets +#' +#' Creates a waffle chart from an overall dataset, both calculating +#' the relevant counts and formatting the chart. +#' +#' @param dataframe The input dataframe containing the data. +#' @param x_var The variable to facet the waffle chart by (e.g., year +#' or pres_admin). This will name the facets. +#' @param fill_var The variable to color the waffle chart blocks by (e.g., +#' state_responsibility). +#' @param fill_var_description A list containing the title, levels, and colors +#' for the fill variable. Can be taken from our level description list, lev. +#' @param n_columns Number of columns for the facet wrap. +#' @param waffle_width Number of rows in each waffle chart (default 10). +#' @param complete_x Logical indicating whether to complete missing x values +#' with a single null block. Only implemented for year and pres_admin. +#' @param .verbose Logical indicating whether to print debug information. +#' +#' @return A ggplot object representing the waffle chart. +#' @export +#' +#' @examples +#' deaths <- assign_levels(deaths_aug24, "standard", .simplify = TRUE) +#' make_waffle_chart(deaths, +#' x_var = pres_admin, +#' fill_var = state_responsibility, +#' fill_var_description = state_resp, +#' complete_x = TRUE, n_columns = 7) make_waffle_chart <- function(dataframe, x_var, fill_var, fill_var_description, n_columns = 5, diff --git a/tests/testthat/test-waffle-plot-functions.R b/tests/testthat/test-waffle-plot-functions.R index 7703a26..e15ea23 100644 --- a/tests/testthat/test-waffle-plot-functions.R +++ b/tests/testthat/test-waffle-plot-functions.R @@ -111,7 +111,6 @@ test_that("complete_x_values adds missing years", { # Check that 2012 was added expect_true(2012 %in% completed_counts$year) }) -complete_x_values() test_that("complete_x_values fixes missing years in standard data", { deaths <- assign_levels(deaths_aug24, "standard", .simplify=TRUE) @@ -141,73 +140,39 @@ test_that("complete_x_values fixes missing years in standard data", { # Check that the plot data doesn't include 2012 plot_data <- ggplot2::ggplot_build(result)$data[[1]] - expect_false(2012 %in% unique(df_with_gaps$year)) + expect_false(2012 %in% plot_data$plot$data$year) result_completed <- make_waffle_chart(df_with_gaps, x_var = year, fill_var = protest_domain, lev$protest_domain, complete_x = TRUE) # Check that the plot data includes 2012 - plot_data_completed <- ggplot2::ggplot_build(result_completed)$data[[1]] - expect_true(2012 %in% unique(plot_data_completed$x)) - - + plot_data_completed <- ggplot2::ggplot_build(result_completed) + expect_true(2012 %in% plot_data_completed$plot$data$year) }) -test_that("make_waffle_chart with complete_x=TRUE fills year gaps", { -# test_data <- setup_test_data() - - # Create data with gaps in years - df_with_gaps <- deaths_aug24 %>% - assign_state_responsibility_levels(simplify = TRUE) %>% - dplyr::filter(year != 2012) # Remove 2012 +test_that("make_waffle_chart with complete_x=TRUE fills pres_admin gaps", { + deaths <- assign_levels(deaths_aug24, "standard", .simplify=TRUE) - # This should add a null block for 2012 - result <- make_waffle_chart(df_with_gaps, - x_var = year, - fill_var = state_responsibility, - lev$state_responsibility, complete_x = FALSE) + # verify that there are already missinng values + count(deaths, pres_admin, .drop=FALSE) %>% filter(n==0) %>% nrow() -> num_missing + expect_gt(num_missing, 0) + pres_admin_missing <- count(deaths, pres_admin, .drop=FALSE) %>% + filter(n==0) %>% pull(pres_admin) - expect_s3_class(result, "ggplot") + # Verify it's missing if not completed + result <- make_waffle_chart(deaths, pres_admin, protest_domain, + lev$protest_domain, complete_x = FALSE) + plot_data <- ggplot2::ggplot_build(result)$data[[1]] + expect_false(any(pres_admin_missing %in% plot_data$plot$data$pres_admin)) - # Check that white color was added for null blocks - fill_scale <- result$scales$get_scales("fill") - expect_true(" " %in% names(fill_scale$palette())) + # This should add a null block for our missing president(s) + result_completed <- make_waffle_chart(deaths, pres_admin, protest_domain, + lev$protest_domain, complete_x = TRUE) + plot_data_completed <- ggplot2::ggplot_build(result_completed) + expect_true(any(pres_admin_missing %in% plot_data_completed$plot$data$pres_admin)) }) -# test_that("make_waffle_chart with complete_x=TRUE fills pres_admin gaps", { -# test_data <- setup_test_data() -# -# # Create data with gaps in pres_admin (missing Admin2) -# df_with_gaps <- test_data$df %>% -# dplyr::filter(pres_admin != "Admin2") -# -# # This should add a null block for Admin2 -# result <- make_waffle_chart(df_with_gaps, pres_admin, category, -# test_data$fill_desc, complete_x = TRUE) -# -# expect_s3_class(result, "ggplot") -# -# # Check that white color was added for null blocks -# fill_scale <- result$scales$get_scales("fill") -# expect_true(" " %in% names(fill_scale$palette())) -# }) - -# test_that("make_waffle_chart respects color palette from fill_var_description", { -# test_data <- setup_test_data() -# -# result <- make_waffle_chart(test_data$df, year, category, -# test_data$fill_desc, complete_x = FALSE) -# -# # Get the fill scale -# fill_scale <- result$scales$get_scales("fill") -# colors <- fill_scale$palette()(length(test_data$fill_desc$colors)) -# names(colors) <- test_data$fill_desc$levels -# -# # Colors should match (order may differ) -# expect_setequal(names(colors), names(test_data$fill_desc$colors)) -# }) - test_that("make_waffle_chart_tall returns a ggplot object", { test_data <- setup_test_data() From 5561b3b01df8e2e8dc8446a2ba239c7bdd1af51e Mon Sep 17 00:00:00 2001 From: CarwilB <54286746+CarwilB@users.noreply.github.com> Date: Thu, 30 Oct 2025 10:40:06 -0500 Subject: [PATCH 06/14] incorporate complete_x functionality into make_waffle_chart_tall( --- R/waffle-plot-functions.R | 60 +++++++++++++++++++++++++++++++++++---- 1 file changed, 54 insertions(+), 6 deletions(-) diff --git a/R/waffle-plot-functions.R b/R/waffle-plot-functions.R index b0d2837..d9e3b4f 100644 --- a/R/waffle-plot-functions.R +++ b/R/waffle-plot-functions.R @@ -159,7 +159,6 @@ make_waffle_chart <- function(dataframe, x_var, fill_var, counts_df <- waffle_counts(dataframe, {{x_var}}, {{fill_var}}, {{fill_var_description}}) - # complete with a single null block # Complete with null blocks if requested if (complete_x) { # code only implemented for these two variables for now @@ -197,17 +196,66 @@ make_waffle_chart <- function(dataframe, x_var, fill_var, ggplot2::guides(fill = guide_legend(reverse = TRUE)) } +#' Create a tall waffle chart with facets +#' +#' Creates a tall-oriented waffle chart from an overall dataset, both calculating +#' the relevant counts and formatting the chart. Facets are arranged vertically. +#' +#' @param dataframe The input dataframe containing the data. +#' @param x_var The variable to facet the waffle chart by (e.g., year +#' or pres_admin). This will name the facets. +#' @param fill_var The variable to color the waffle chart blocks by (e.g., +#' state_responsibility). +#' @param fill_var_description A list containing the title, levels, and colors +#' for the fill variable. Can be taken from our level description list, lev. +#' @param n_columns Number of rows for the facet wrap (displayed vertically). +#' @param complete_x Logical indicating whether to complete missing x values +#' with a single null block. Only implemented for year and pres_admin. +#' @param .verbose Logical indicating whether to print debug information. +#' +#' @return A ggplot object representing the tall waffle chart. +#' @export +#' +#' @examples +#' deaths <- assign_levels(deaths_aug24, "standard", .simplify = TRUE) +#' make_waffle_chart_tall(deaths, +#' x_var = pres_admin, +#' fill_var = state_responsibility, +#' fill_var_description = state_resp, +#' complete_x = TRUE, n_columns = 7) make_waffle_chart_tall <- function(dataframe, x_var, fill_var, fill_var_description, - n_columns = 5) { + n_columns = 5, + complete_x = FALSE, + .verbose = FALSE) { + # Get the color palette from the corresponding description variable + fill_colors <- fill_var_description$colors + + x_var_name <- quo_name(enquo(x_var)) + range_of_x_levels <- list() + if(is.factor(dataframe[[x_var_name]])){ + all_levels <- levels(dataframe[[x_var_name]]) + range_of_x_levels <- all_levels + } + counts_df <- waffle_counts(dataframe, {{x_var}}, {{fill_var}}, {{fill_var_description}}) + # Complete with null blocks if requested + if (complete_x) { + # code only implemented for these two variables for now + if (x_var_name %in% c("year", "pres_admin")){ + counts_df <- complete_x_values(counts_df, {{x_var}}, {{fill_var}}, + all_levels = range_of_x_levels, + .verbose = .verbose) + + # Add null to the color set but not to the legend + fill_colors <- c(fill_colors, ' ' = "white") + } + } + # Define waffle chart parameters waffle_width <- 5 - # Get the color palette from the corresponding description variable - fill_colors <- fill_var_description$colors - legend_orientation <- "horizontal" if ((nrow(counts_df) / n_columns) <= 1) { legend_orientation <- "vertical" @@ -248,4 +296,4 @@ make_waffle_chart_tall <- function(dataframe, x_var, fill_var, fill_var_descript # add a 1pt solid line at x=0.5 and 1pt grey line at x =20.5 geom_vline(xintercept = 0.5, color = "black", linewidth = 0.5) + geom_vline(xintercept = 20.5, color = "darkgrey", linewidth = 0.25) -} +} \ No newline at end of file From bd10f366b548b7e75d7e5bda5a8e351bfd0bcff2 Mon Sep 17 00:00:00 2001 From: CarwilB <54286746+CarwilB@users.noreply.github.com> Date: Thu, 30 Oct 2025 10:47:16 -0500 Subject: [PATCH 07/14] Overwrite level variables to update state_resp colors --- data-raw/level-variables.R | 4 ++-- data/affiliations.rda | Bin 787 -> 789 bytes data/departments.rda | Bin 371 -> 380 bytes data/president.rda | Bin 569 -> 581 bytes data/protest_domains.rda | Bin 549 -> 562 bytes data/state_resp.rda | Bin 350 -> 355 bytes 6 files changed, 2 insertions(+), 2 deletions(-) diff --git a/data-raw/level-variables.R b/data-raw/level-variables.R index 828b0d4..ca1ff2c 100644 --- a/data-raw/level-variables.R +++ b/data-raw/level-variables.R @@ -51,7 +51,7 @@ state_resp$r_variable <- "state_responsibility" state_resp$levels <- c("Perpetrator", "Victim", "Involved", "Separate", "Unintentional", "Unknown") state_resp$colors <- c( Perpetrator = "forestgreen", - Victim = "#cd6600", # "darkorange3", + Victim = "#8B1A1A", # "firebrick4", Involved = "#90ee90", # "lightgreen", Separate = "#eeb422", # "goldenrod2", Unintentional = "darkgray", @@ -59,7 +59,7 @@ state_resp$colors <- c( state_resp$colors_es <- c( Perpetrador = "forestgreen", - Victima = "#cd6600", # "darkorange3", + Victima = "#8B1A1A", # "firebrick4", Involucrado = "#90ee90", # "lightgreen", Separado = "#eeb422", # "goldenrod2", "No Intencional" = "darkgray", diff --git a/data/affiliations.rda b/data/affiliations.rda index 64852dc8a8d5170ac360985679dd20de948350fa..1488f41c537a493bbc5cf33a76eb5f5b9530c512 100644 GIT binary patch delta 769 zcmV+c1OEJz29*X5LRx4!F+o`-Q&|;gArp}fB7bvaZLKKbD56i&dYBS=jRVxvO#lrs z8Z`AZ0B8UVKqUkOO--crF-N5J8hRjT8Usd+0iXjw145KEXvi`eWDNsAXfTWf&<25{ zAOIv%Oi|>9fuloB8X5oq000009-=Dui*65zBA_5k-^iyN0VE0|KP1EF3tv|3oIwO( zGJm}4As6=Fq> zK~h&WkV1Lpx*AnV1$`RjQ$DH#_ z1@vrpwHkw28C@E}v*0(klL%Xv8r^opr)*_}pLIH0$Y#M~mdB?SO&64|ws(>Hl?z?7 z6)I)4q+A+rT~cvJLh%VPIiXa#@hs@!MzF0oVeCRPUTk;M9$Q9q94FfN|Y9m-zp6R zq(h)I5zrMB%XY%h8QfZ7l{H2giLxrmCTWxfYN|4sY^Wy;LV$XNMKWT@tZFQx_!Uuu zPVVV?D7U7AOpO7w?N%TU(;R>uQBolkQHo@P$i3K6v=GLrByeQZ=0QZL$u}KRkSrlm z2*#@?%R*^BxmgoaC1nXWflto0LaKin<55WQSfmi|u$MJV0Q-uiuR)P^QvFkrs delta 767 zcmV1Or>TV&lLj0Kp@!zz;Xf=+@MO#0U`KGF@a5 z&wr4t_BPV+y=E@oyA{&I$1C&Nr zpm?EWVz81efRMl-WXJ(KI|xaAFbpavpm!=26%h+60;mNNLioUxXf&2pS?EkriA8ob zP#~t9>H|X1(QqsW@1N+rx0#Gk|UdJ$g~W8%cny-mr?kQoB0 z06`iUN}{|GzCaBLT(s0;v0*Ypcz@uqb(EnXtRIAG4ImNv1@i$Y;&9QbEYSlfB;s0f zU%7=a&mkeeRwh((B-n=v)pEe*1%D#LCz%dCIcrsb@`uS?Oq(5FsmPPEq(U*`>SH4Z z3P@3x5n!}kj=X7ab|f4;K;j{?BMHEC47th_8MqS&3hS1jegI&^M1bUf0Eh_kkwYMP z6c93E_MK*kJRmf0FIBn{S0!}KMM`NOp#6csk_ z6j4Q@lNKCI7MjRdJPptqJO+@c_&$m-ok`}nsRtN)M3+pcr~|8TF2)qYsbE2rWG5t; xkvVR8Y@$^zfi)7U!6;@#h_mVrD5gp!F~;^s@-}8J4I|_HUC9*TLP6~a@?=I8L45!K diff --git a/data/departments.rda b/data/departments.rda index eb912e8593506e30d80146fa8592c1713b69190b..a9b8fcdb496ae3cd9cde5e01e2b9a0c19b4d6aa9 100644 GIT binary patch literal 380 zcmV-?0fYWRT4*^jL0KkKSv#tRhyVdIf7JiDNB~Fzf8aj^-ax*8|Byfc00IaA00FQ8 zHMTI1R1-<2r|Np96VW!Iqf9j#WXX+9F*c?k(M(2$qd)^q00Yth00Tj_B-GPWX{6dF z0E|N>nJ@&xXl)8KLJkNCiEt8(5GMdIMDJ;jzcV?O2UM{Yt~!834ipIpAHzmJNYY)N z6}u=>d1J?hRIf;~$3ahG?31vBuAmbDRAiho5J1VyASM|JY-AKh2v`q-ya-d3w5rCD zjjYZP`ZPr-h1lMB+PiF8)}-co!x=~dwiPSAOw0&<8N z+&Uz0ep;zFrr}>E!+D~y8LRBvbDXGYQJg76np>D`JgFX(5|?=*`7z0O)JR`qj%D|e zCFWY=bMYo38fAUM%nBZ=1o5jS;!0ALRFJqmL{%-ulZhO4BO#+f(W=9uBNVTmJbcCh a=(Q4sNK!c+i{p-c#oUoj6eJGnp`rk^@}La> literal 371 zcmV-(0gV1aT4*^jL0KkKSs`}?$p8T_f7JiDNB~Fxf8aj^-ax*8|Byfc00IaA00FQ8 zHMTHqQ8bgurqw-7GgD7dpgl&1lzM||dYT(eAZVk}Pg692&<218AOHX~8&pk0)i#MUK&<_l%YX@flck`|#!q)j`Jlj%`xDp9W?6mFn6cY^rjS$dwLDW8Xu R@YDDFUC9*TLO_Mw7bG|crZNBk diff --git a/data/president.rda b/data/president.rda index 7732de9d62878f1da1e8d1312993e9b381e319fd..74f06073b513ee46858212859e87f7e953437ac0 100644 GIT binary patch literal 581 zcmV-L0=oS|T4*^jL0KkKSt>4B9smJ{f876jc__eQf8am%e^9>X-!NbRAOau&2mk;9 zKmt8OB7{b&Z9p0g2AXI921Wv800001DyH&DKUBoP1Zk$3G8iDhnKF7z)X9Ws!NW~3 zLm{S_88CoppbRFBGGGA%K&l}mPY}{PrZhDf20@?zWDiJW#L=O2)uii0Uzmc@#cClW z!;c3idcQT%2S57x%^)n^H~;~NkuGFl1joc2#_8ObLnf%sLou*nL1oxxb4^6+WX-jk z^qVVJp>354F3xQ?q=xz-69`89lu98A(t#Z*B@+nGtwbZkFpU>P%Dg_zZR%j_mo*;SFr7(_I~dAEIj=Ll&BsfLuyD3oOsytG>}k+WRaS1gSGMq)yy=QR zt%vZ&xmISwE3#dQ!L=K$J;tj+nM|qu-_$FP%N%6}&Quip@;o#0tu zH@LY}udNQG=$9Zy9C;P3NU0bwb@9 Thp^L$1mrH{ig2MIR9vz=u>}g= literal 569 zcmV-90>=G9T4*^jL0KkKS%7&~k^ljNf876jc__eOf8aj$c~HLR-!NbRAOau&2mk;9 zKmr=z01>L2L@i0j48NgFpZP<0efQh9;N@7!ynpf?{c=fD9nXNswgF15E$` z05kvq0062XAye@U6#SVq2x>e@;+kSTs(KUkPZDJG)Y>9}khsfP?`E+{Y@8 zwFQX-x8_Ldgc?Wy0OBQ!nHUMNhzGQ1JCka`tvu39Y&ez2k-V-t>L}W2mcEIywR;xe zP@?T;1BPM_WI`qgiE_~j){zK^@kuC{M!lLL7fd4i!e)Hfn+a^J+ALmBqB)l@B;|jr z&a_|uC!UnfhKYDVGE1>qWvNQUdVjnzu3Np1s=I9LRjJ0K;9Xzg?tB)s>U-a_xojt6 zUtM2>yYo=TN-p=&+|NW{?Q8DQlJU;u{Uhd~SBF9J+*bOJKF89&nzV$I~7dD>D zF`h|{n;A+)K3AHa*BiyDymhzR4K0Rc?5Vz;Dy;K7SGaMTe>BA(X7lQ0T&sz^(%mk| z=-`h-XU^MSaVe!g_8p^{c2wJc271v~e@zuJvr=kcS2Kl1d%n-Dj2w%VOA65PP6Fkg zbh!^h8}TO7{HVp4%FxpMoGdJFaq)z8a_{D5T1}5jb=w^mD}5;_*OgV7)X12!@{w6p zF}CAi>0MaRx~Wzvhl-r*vAs<0r;~Z3BXN<7BF51r#za-|A9OiZYG8fWpZL3yDZ+$= H1Io0JKhY3J diff --git a/data/protest_domains.rda b/data/protest_domains.rda index b76ba6ee1edbf81a209049957abcaee10f3ca6a9..b368a3004c8dc2a79f5c2297c2ffc51f03906376 100644 GIT binary patch literal 562 zcmV-20?qwGT4*^jL0KkKS?@aVQ~&|Le}Mn>?gB^#f8aldRzSY*-=F{izydu>EC3}% zPiZktrQGoQCPgB$fs038pAp0T>lUG-#2gjZKlDjXg)G0imF1XdZ#7bkibs_o|4qk~yt(yP-QJ#MMV|?Nl$Q zit{q5^rg*wm}ut{yu`5XxU~TsqDYJJj4}x^87+i`%sB!a2mvwEBn(8MS(Nh;1Bhz| zKx3h5pyix4tP%-pLR!(VGMY;tS+WaW+`_3UmGdG=AOjNvmlQ;nSF&asN* zXG)dbv6nGw=2S}Psj4kvjVlV5oRqzpp{Z9hq}7r)3=*qcb^pcOkxmpOJI=fn077v9 AO8@`> literal 549 zcmV+=0^0pTT4*^jL0KkKS%vE2=l}t`e}Mn>?gB^#f8aldQb4}%-=F{izydnu%mId} z>S8rCJrD+ghyZ$kG&BLA4OIP2Ces?4O#lD@00000878REdO!i7000000B99SG-#CA zk5utA$d6OhdYTyx88m62U^N*WBV?#Y)A%xB#MG{|W1A2=4g&HO{87a*? zgb^f+-njgA6ext=WD9^2(Bl~sTry}ugM6HbJlGQYi6~>IAvH!Ivst8}=a_9!QbJ6~ zl(DR183Kc|#G+Vg*U^FXbh+IM*&5$&jrZMJsMpHp~CSXk> zZpW6@MkizP!tP;y;xBZhlWTaHb5}}a)r(wD6&X5`#$NADmN*hORbyq03S&`w8AqQ3 zt#ajtHHt4-@Kr*NB}K@U77;g@8f=q)6L}&@H`0`&g@UA&w5FOQL<;TB3!g4DDrbHYn8UHe-xM$tdlQU&Y*!P81{|dbqj(rqA$? diff --git a/data/state_resp.rda b/data/state_resp.rda index 614a1c6468c31429e1dd5f2032c962b9b0e09c5c..accdd46fbb4f0282c25ff614f1872601a59640cc 100644 GIT binary patch literal 355 zcmV-p0i6CqT4*^jL0KkKS%oA6aR31J|A7DdOaMp%d|)*pUqHX_-=F{iumM<*2}){c z#ApBjXc{!~2mlQSFbRMY005W(34j2SA_Vm^CWF*HL5ZV405URSOwcSPf#ZC1GC)tW zajD`ypUu?-A5~;&$1}ko3zlf2$L-6q2 zyrEn%7KuR;)jZc+R&y4zbw=VOR#)l>Vi^9Un01kC!HDQoC*wDYHk>6Tx7QMK#hP3a zVU9s_laW;?7?t7VGQFM5m6alOxPfAU$G3CS literal 350 zcmV-k0ipgvT4*^jL0KkKS@<-MwEzI{|A7DdOaMp#RUiZ*TR^|>-=F{iumM=04M+n? zh!~A96V&w369O7z00000G#UWV4FHlNG&MGgo}U(4J<6vV9LEvGY>!yu;^1%tq%k!g^Zp-N<#RY-&mf)J7_nbAcWrb7UA({U42 z!myFyk=u4YH0ffr(B498#G{#}Ryr w$g5L~PT}S3pbiA07ytkO From cf9eca7e9ceaa5117dceeb5b6f6dd5f0c3eb12a8 Mon Sep 17 00:00:00 2001 From: CarwilB <54286746+CarwilB@users.noreply.github.com> Date: Thu, 30 Oct 2025 11:04:00 -0500 Subject: [PATCH 08/14] clean file --- R/waffle-plot-functions.R | 14 +++++++++----- 1 file changed, 9 insertions(+), 5 deletions(-) diff --git a/R/waffle-plot-functions.R b/R/waffle-plot-functions.R index d9e3b4f..f69df4f 100644 --- a/R/waffle-plot-functions.R +++ b/R/waffle-plot-functions.R @@ -221,22 +221,26 @@ make_waffle_chart <- function(dataframe, x_var, fill_var, #' make_waffle_chart_tall(deaths, #' x_var = pres_admin, #' fill_var = state_responsibility, -#' fill_var_description = state_resp, +#' fill_var_description = lev$state_responsibility, #' complete_x = TRUE, n_columns = 7) +#' make_waffle_chart_tall(deaths, +#' x_var = pres_admin, fill_var = state_responsibility, +#' fill_var_description = lev$state_responsibility, +#' complete_x = FALSE, n_columns = 6) make_waffle_chart_tall <- function(dataframe, x_var, fill_var, fill_var_description, n_columns = 5, complete_x = FALSE, .verbose = FALSE) { # Get the color palette from the corresponding description variable fill_colors <- fill_var_description$colors - + x_var_name <- quo_name(enquo(x_var)) range_of_x_levels <- list() if(is.factor(dataframe[[x_var_name]])){ all_levels <- levels(dataframe[[x_var_name]]) range_of_x_levels <- all_levels } - + counts_df <- waffle_counts(dataframe, {{x_var}}, {{fill_var}}, {{fill_var_description}}) @@ -267,7 +271,7 @@ make_waffle_chart_tall <- function(dataframe, x_var, fill_var, fill_var_descript geom_waffle(color = "white", size = .25, n_rows = waffle_width, na.rm = TRUE) + # Change strip.position to "left" and use nrow instead of ncol facet_wrap(ggplot2::vars({{ x_var }}), nrow = n_columns, - labeller = label_wrap_gen(20), + labeller = ggplot2::label_wrap_gen(20), strip.position = "left", dir = "v") + scale_x_continuous(breaks = c(0.5, 5.5, 10.5, 15.5, 20.5, 25.5), @@ -296,4 +300,4 @@ make_waffle_chart_tall <- function(dataframe, x_var, fill_var, fill_var_descript # add a 1pt solid line at x=0.5 and 1pt grey line at x =20.5 geom_vline(xintercept = 0.5, color = "black", linewidth = 0.5) + geom_vline(xintercept = 20.5, color = "darkgrey", linewidth = 0.25) -} \ No newline at end of file +} From 7b53bc5259c981e34446084d85d55ad2e5f31d6a Mon Sep 17 00:00:00 2001 From: CarwilB <54286746+CarwilB@users.noreply.github.com> Date: Thu, 30 Oct 2025 14:20:50 -0500 Subject: [PATCH 09/14] Update level variables to have Spanish names. --- data-raw/level-variables.R | 10 +++++++++- data/affiliations.rda | Bin 789 -> 805 bytes data/departments.rda | Bin 380 -> 391 bytes data/president.rda | Bin 581 -> 599 bytes data/protest_domains.rda | Bin 562 -> 571 bytes data/state_resp.rda | Bin 355 -> 384 bytes 6 files changed, 9 insertions(+), 1 deletion(-) diff --git a/data-raw/level-variables.R b/data-raw/level-variables.R index ca1ff2c..0ce8a39 100644 --- a/data-raw/level-variables.R +++ b/data-raw/level-variables.R @@ -3,6 +3,7 @@ lev <- list() president <- list() president$title <- "Presidential Administration" +president$title_es <- "Administración presidencial" president$r_variable <- "pres_admin" president$levels <- c( "Hernán Siles Zuazo", "Víctor Paz Estenssoro", "Jaime Paz Zamora", @@ -35,6 +36,7 @@ usethis::use_data(president, overwrite=TRUE) location_precision <- list() location_precision$title <- "Location Precision" +location_precision$title_es <- "Precisión de la ubicación" location_precision$r_variable <- "location_precision" location_precision$levels <- c( "address", "poi_small", "intersection", @@ -47,6 +49,7 @@ lev$location_precision <- location_precision state_resp <- list() state_resp$title <- "State Responsibility" +state_resp$title_es <- "Responsabilidad del Estado" state_resp$r_variable <- "state_responsibility" state_resp$levels <- c("Perpetrator", "Victim", "Involved", "Separate", "Unintentional", "Unknown") state_resp$colors <- c( @@ -124,11 +127,12 @@ assign_protest_domain.colors <- function() { protest_domains <- list() protest_domains$title <- "Protest Domain" +protest_domains$title_es <- "Dominio de protesta" protest_domains$r_variable <- "protest_domain" protest_domains$levels <- protest_domain.grouped protest_domains$colors <- assign_protest_domain.colors() -lev$protest_domain <- protest_domain +lev$protest_domain <- protest_domains usethis::use_data(protest_domains, overwrite=TRUE) # Affiliations @@ -244,6 +248,7 @@ assign_affiliation.colors <- function() { affiliations <- list() affiliations$title <- "Affiliation" +affiliations$title_es <- "Afiliación" affiliations$r_variable <- "affiliation" affiliations$levels <- affiliation.grouped affiliations$levels_es <- affiliation.grouped_es @@ -253,14 +258,17 @@ usethis::use_data(affiliations, overwrite = TRUE) lev$dec_affiliation <- affiliations lev$dec_affiliation$title <- "Deceased Affiliation" +lev$dec_affiliation$title_es <- "Afiliación del fallecido" lev$dec_affiliation$r_variable <- "dec_affiliation" lev$perp_affiliation <- affiliations lev$perp_affiliation$title <- "Perpetrator Affiliation" +lev$perp_affiliation$title_es <- "Afiliación del perpetrador" lev$perp_affiliation$r_variable <- "perp_affiliation" departments <- list() departments$title <- "Department" +departments$title_es <- "Departamento" departments$r_variable <- "department" departments$levels <- c("Beni", "Chuquisaca", "Cochabamba", "La Paz", "Oruro", "Pando", "Potosí", "Santa Cruz", "Tarija", "Unknown") diff --git a/data/affiliations.rda b/data/affiliations.rda index 1488f41c537a493bbc5cf33a76eb5f5b9530c512..b5f26178780e4d8de2e659f7df59c68520961ca1 100644 GIT binary patch delta 798 zcmV+(1L6FY2BiiOLRx4!F+o`-Q&}^ySN#A2Gm#M%e+Uo=0005N0{v{+7yt=H3V2O0 zlhkM)r>TelY3ZoZr>UR=KpFr5)i#)>Oq9vBJwreZ00*c6rhotd00%V0WMtDOfMhge zGGqV%42?203?YytNJfO1RQ)HEeyKlHdU;c50R~KiO#zXigwgsV(v*4T$A$`Q(?|ga zrw7o_e_X*(7@}PjN2+*BZnJElh$K!DtE~bx&4gks4Xr|bMlI298)XYTliZ>B78?W1 zSqvA=0Ln@M84-gf(qqJrtdhV`jCj8w)DOOJOs7$8X(VnykibE?geD*qq68sxG=Z=f z(-Mk+|gf0_tWOt*tRVWQQWM8%bP#}$}C>x~n7 z#v*A|7;zSn840CUT8q@zcMj>nS0@vJOp7`^-z~9KKu~a|vnQVMWr8gV-3c=) zkY3Qlre?d*TP`uzp~z-8?$;>ll&@bU;-PeS+`OeCjD_+7Qjx7h}1GWWt-iVaI zf2Rfh8{}Ang;0Ms=G6OVch2b1g|TcGy;}4eHfCeVDx>9PxR4Qzo8i`WGf^9n{?z!Z z2llMda=CenB%^`vr{tXmMF)IHJ9=zhWkaSmS{C4rb5Q0OP_!f&tZz&v?mD4A82zTh z^)y^ttUu!h5-k-no6ch~VNyhx@w_7{f2o^JP3K>obMY4!a~jNAupz8|1%k&>tb^mh zYice;5yfvG#Ud>Y=Bt>~`Il8*RK2VVh$eEXX;L6&Lq2bTu;e*#I+!iLUE;8rZH45r zC^7`CYw=d_%MN0+sr1vWK=*?gc~RDWLg0z2&^bt&k_MTpFGjRO_LD`ZKk%)Fh%)Ej)b6~z@*@E6!=Um;HAN{hdsfmJlB cWgvg(x&_|YTePCz|BJaIoG3^c1lX(ofEmYS4FCWD delta 781 zcmV+o1M>W(29*X8LRx4!F+o`-Q&|;gArk-sCy@~re*h2&0005N0`+rbZLKKbD56i& zdYBS=jRVxvO#lrs8Z`AZ0B8UVKqUkOO--crF-N5J8hRjT8Usd+0iXjw145KEXvi`e zWDNsAXfTWf&<25{AOIv%Oi|>9fuloB8X5oq000009-=Dui*65zBA_5k-^iyN0VE0| zKP1EFe+yq$?3_UaVKThxAs6=Fq>K~h&WkV1Lpx*AnV1$`Rje^W(T^%pZAeXOko3dDH#_1@vrpwHkw28C@E}v*0(klL%Xv8r^opr)*_}pLIH0$Y#M~mdB?S zO&64|ws(>Hl?z?76)I)4q+A+rT~cvJLh%VPIiXa#@hs@!MzF0oVeCRPUTk;M9$Q9 zq94FfN|Y9m-zp6Rq(h)I5zrMB%XY%h8QfZ7l{H2giLxrmCTWxfYN|4sY^Wy;b3%Z6 zgheu9$gC`)_!UuuPVVV?D7U7AOpO7w?N%TU(;R>uQBolkQHo@P$i3K6v=GLrByeQZ z=0QZL$u}KRkSrlm2*#@?%R*^BxmgoaC1nXWflto0LaKin<55WQSfmi|u$MJV0 LQ-uiuR)P^Q=gC25 diff --git a/data/departments.rda b/data/departments.rda index a9b8fcdb496ae3cd9cde5e01e2b9a0c19b4d6aa9..2eeb09a9a3a5ac4ceff503773abf51d837ab60c2 100644 GIT binary patch literal 391 zcmV;20eJpGT4*^jL0KkKS)-xq_5cAt|J48dNB~Fzf8aj^-ax*8|Byfc00IaA00FQ8 zR&8d6QkcqU8UPPS00*Q7gG~m2GC-%JM4D|TA%PeK^b<`oX@E@xR3y}CnrdWelSin? z8Z-a^Xvwt=MamH&0s|0HVu%F*LQH!%_f8v;JH|tqBJ138&;oVfa`IX%?0Yh9R>EmSy6?bHr~!fjR1z!!SwV~ zVM$AYyLmIo(8eMt+Ibkx$4ZNv`k0T!nE-9l_OGa5w||bB9W4fC&|x$Y&`NU);@NRZ z4yOS_V8bHzeY%at!3aXL99f)%`iT=THLry&*5%Ul@2OyT6CX$bqbh*xU|l3?f+vwv l%m{anX9botr}Mh8F64@Ep&>^@)$D*!sO$g$ literal 380 zcmV-?0fYWRT4*^jL0KkKSv#tRhyVdIf7JiDNB~Fzf8aj^-ax*8|Byfc00IaA00FQ8 zHMTI1R1-<2r|Np96VW!Iqf9j#WXX+9F*c?k(M(2$qd)^q00Yth00Tj_B-GPWX{6dF z0E|N>nJ@&xXl)8KLJkNCiEt8(5GMdIMDJ;jzcV?O2UM{Yt~!834ipIpAHzmJNYY)N z6}u=>d1J?hRIf;~$3ahG?31vBuAmbDRAiho5J1VyASM|JY-AKh2v`q-ya-d3w5rCD zjjYZP`ZPr-h1lMB+PiF8)}-co!x=~dwiPSAOw0&<8N z+&Uz0ep;zFrr}>E!+D~y8LRBvbDXGYQJg76np>D`JgFX(5|?=*`7z0O)JR`qj%D|e zCFWY=bMYo38fAUM%nBZ=1o5jS;!0ALRFJqmL{%-ulZhO4BO#+f(W=9uBNVTmJbcCh a=(Q4sNK!c+i{p-c#oUoj6eJGnp`rk^@}La> diff --git a/data/president.rda b/data/president.rda index 74f06073b513ee46858212859e87f7e953437ac0..89df7033e746a62c79769a2fc2a5b8c629a8e5da 100644 GIT binary patch literal 599 zcmV-d0;v5$T4*^jL0KkKS-~rezyJZ0|J?ukc`U$Uf8am%e^9>X-!NbRAOa`=2mk;9 zKmuBwS^$QipwI?Q4FCWd7=Ri8G|&J8m`wqoG-$#!7>zM9VrVdp10WeN5+zSm8fl;! z22B7xKm*hRAk)+U00OE6Q%n)0@@jsNCJCU#XlTiVX_G;q$n`Y3coG?Wl}3yDM2wakjXHMI^SVH=eV*fv3G*B^V6qV z&5JMGi4FP@#iIPHS5}AYzBqEeRfqV=Yni~R)h)7!Oge^Z&jCJm>qRvsC zP^}_Jc@--}+1|lUdnEQ zx%=M-LX?jy;^B3vZ0B_H96Ts)Ie>m+2Re)z3K$W)&srO}N=X0~RJK<41iz_5{LCbYb}Mwa+V0mf!Ip zGc`O-NJ);YulDUmYiU|&!s3u+M>MHM!Y!j^d5Dc8$dcwW6C+Kw)>~b3pLij^X6BxY zMO0VfkC~10H)>BY6iGU4-(e$q~T(zqMRjfTgNuqwdbW{eU+rM l1Hiz!fkQlrQGp4*&^zG4B9smJ{f876jc__eQf8am%e^9>X-!NbRAOau&2mk;9 zKmt8OB7{b&Z9p0g2AXI921Wv800001DyH&DKUBoP1Zk$3G8iDhnKF7z)X9Ws!NW~3 zLm{S_88CoppbRFBGGGA%K&l}mPY}{PrZhDf20@?zWDiJW#L=O2)uii0Uzmc@#cClW z!;c3idcQT%2S57x%^)n^H~;~NkuGFl1joc2#_8ObLnf%sLou*nL1oxxb4^6+WX-jk z^qVVJp>354F3xQ?q=xz-69`89lu98A(t#Z*B@+nGtwbZkFpU>P%Dg_zZR%j_mo*;SFr7(_I~dAEIj=Ll&BsfLuyD3oOsytG>}k+WRaS1gSGMq)yy=QR zt%vZ&xmISwE3#dQ!L=K$J;tj+nM|qu-_$FP%N%6}&Quip@;o#0tu zH@LY}udNQG=$9Zy9C;P3NU0bwb@9 Thp^L$1mrH{ig2MIR9vz=u>}g= diff --git a/data/protest_domains.rda b/data/protest_domains.rda index b368a3004c8dc2a79f5c2297c2ffc51f03906376..11d3ce61fc8a147a6114d7008e0edf4176ad4614 100644 GIT binary patch literal 571 zcmV-B0>u47T4*^jL0KkKS%XH0k^lkB|A7DX?gB^#f8aldRzSY*-=F{izydnu%K!;f z8jRE%Q$PR>002E8002c#CP%2#)b&Py0004?XaE2ZO;gejNC4ADAOWVD15E*;kZ2V| zK$3c8KUCQb6Gqf%0gwiUf#?X5IzU9F1w%k2fJ6mt-Q|r55E-ICXDs0a8jZY*7=SSM z5y7b`8{<;cYj|)yjg&Kr`>tfjmd5Cxg%1k!b10WvV(c5SLgJRLH{*_C5Z43~2!^SJ zB1l5Aq>zZ{k)lxIlqOKamDQabMnkaBD!}=Dfr0WAklC`hAYILlmhMu45+avS>_iEY zbriH9pLp1Y(kW?+VoK|-0i@$ti_#D>O>v=b!eUHGf`}9XgsxB^&B1jJG{rzhHUlUy zp?%0XL>ppw8wSXU(U7w_pyv@p_FNP=V-jmNkBbmYAR%1yaneLm$mHgGK9uEiD%r~D zRn-?AZ<4}g(!8mWRF!OY_b6?)GqSpwU&xGH=}WoaDqz>~RI0&y#T|>AkIOMM#rRR8 zH_~TQGiyPSer4=gi=GXqLk0^>>sK*a>{(jeT=1x1iCDCXwvoYVTf1yhN?WO!juuKK zHaHYj67k|xi(83~H){8C%bn$l;`=qX8PTRR>RzS=j2E;g6H$WpR`NXk)T@(#-ZVFp zm89d-6lAp;60O_R0hmwOp2LJ#7 literal 562 zcmV-20?qwGT4*^jL0KkKS?@aVQ~&|Le}Mn>?gB^#f8aldRzSY*-=F{izydu>EC3}% zPiZktrQGoQCPgB$fs038pAp0T>lUG-#2gjZKlDjXg)G0imF1XdZ#7bkibs_o|4qk~yt(yP-QJ#MMV|?Nl$Q zit{q5^rg*wm}ut{yu`5XxU~TsqDYJJj4}x^87+i`%sB!a2mvwEBn(8MS(Nh;1Bhz| zKx3h5pyix4tP%-pLR!(VGMY;tS+WaW+`_3UmGdG=AOjNvmlQ;nSF&asN* zXG)dbv6nGw=2S}Psj4kvjVlV5oRqzpp{Z9hq}7r)3=*qcb^pcOkxmpOJI=fn077v9 AO8@`> diff --git a/data/state_resp.rda b/data/state_resp.rda index accdd46fbb4f0282c25ff614f1872601a59640cc..fdcf2ee0d5ba84ff39889205b854c150d757cac8 100644 GIT binary patch literal 384 zcmV-`0e}8NT4*^jL0KkKS%Z>a>i_`+e}Mn{Ob|!{d|)>rUqHX_-=F{iumM(N0#Zoz z85#fp8UscF007W5r=-#uG{goYO&EX%ngC>C2_lKLF*0bF(KPgiO#lEi$Z3d`5H1r4 zU^J*B0Dxc3HHr-+e-m2d5OgvXvz;b_A_Ai3(tT5!PGj_wX;!mIEYyuex~W8jww2K1 zWRl8(41}_>92p2vJES1_>vV#&%H*?Em`I-s#0A0vuTlsG#Snvs4bgH_50J2%BU;iv zZb)D>ijr4tqt8zDpW@OWjV4(FQ@HFGpyR zY+Du|!nt$|v8s8?#OCph#49$df6R9%D+VKCG6ZHdf)W-{V8&ubPNBezjc9&=iulX= z*=TiOZo7QUpr0DNLwSU@S8-xasaj{jI}BtMgoJ8T;}gv7JFvmNe#nY5u`(dI5f@ZO ePOKyeQzlf2$L-6q2 zyrEn%7KuR;)jZc+R&y4zbw=VOR#)l>Vi^9Un01kC!HDQoC*wDYHk>6Tx7QMK#hP3a zVU9s_laW;?7?t7VGQFM5m6alOxPfAU$G3CS From 4b44eb1baafd257d85b1e3d7be158780a7448113 Mon Sep 17 00:00:00 2001 From: CarwilB <54286746+CarwilB@users.noreply.github.com> Date: Thu, 30 Oct 2025 14:21:15 -0500 Subject: [PATCH 10/14] Make waffle plot legends bilingual --- R/waffle-plot-functions.R | 17 +++++++++++++++++ 1 file changed, 17 insertions(+) diff --git a/R/waffle-plot-functions.R b/R/waffle-plot-functions.R index f69df4f..a0ffec6 100644 --- a/R/waffle-plot-functions.R +++ b/R/waffle-plot-functions.R @@ -144,10 +144,15 @@ make_waffle_chart <- function(dataframe, x_var, fill_var, n_columns = 5, waffle_width = 10, complete_x = FALSE, + lang = "en", .verbose = FALSE) { # Get the color palette from the corresponding description variable fill_colors <- fill_var_description$colors fill_legend <- fill_colors + if (lang=="es" & "colors_es" %in% names(fill_var_description)){ + fill_legend <- fill_var_description$colors_es + fill_var_description$title <- fill_var_description$title_es + } x_var_name <- quo_name(enquo(x_var)) range_of_x_levels <- list() @@ -187,6 +192,7 @@ make_waffle_chart <- function(dataframe, x_var, fill_var, scale_fill_manual(name = fill_var_description$title, values = fill_colors, limits = names(fill_colors), + labels = names(fill_legend), # Language specific breaks = names(fill_colors)) + theme_minimal(base_family = "Roboto Condensed") + theme(panel.grid = element_blank(), axis.ticks.y = element_line(), @@ -227,12 +233,22 @@ make_waffle_chart <- function(dataframe, x_var, fill_var, #' x_var = pres_admin, fill_var = state_responsibility, #' fill_var_description = lev$state_responsibility, #' complete_x = FALSE, n_columns = 6) +#' make_waffle_chart_tall(deaths, +#' x_var = pres_admin, fill_var = state_responsibility, +#' fill_var_description = lev$state_responsibility, +#' complete_x = FALSE, n_columns = 6, lang="es') make_waffle_chart_tall <- function(dataframe, x_var, fill_var, fill_var_description, n_columns = 5, complete_x = FALSE, + lang = "en", .verbose = FALSE) { # Get the color palette from the corresponding description variable fill_colors <- fill_var_description$colors + fill_legend <- fill_colors + if (lang=="es" & "colors_es" %in% names(fill_var_description)){ + fill_legend <- fill_var_description$colors_es + fill_var_description$title <- fill_var_description$title_es + } x_var_name <- quo_name(enquo(x_var)) range_of_x_levels <- list() @@ -283,6 +299,7 @@ make_waffle_chart_tall <- function(dataframe, x_var, fill_var, fill_var_descript scale_fill_manual(name = fill_var_description$title, values = fill_colors, breaks = names(fill_colors), + labels = names(fill_legend), # Language specific guide = guide_legend(reverse = FALSE)) + theme_minimal(base_family = "Roboto Condensed") + # Change axis.ticks.y to axis.ticks.x From 477793a7eacff3bda383911f54b1ef7e33f23e8b Mon Sep 17 00:00:00 2001 From: CarwilB <54286746+CarwilB@users.noreply.github.com> Date: Thu, 30 Oct 2025 14:46:45 -0500 Subject: [PATCH 11/14] documentation --- man/complete_x_values.Rd | 48 ++++++++++++++++++++++++++ man/domain_filename.Rd | 21 +++++++++++ man/domain_filename_es.Rd | 21 +++++++++++ man/make_waffle_chart.Rd | 60 ++++++++++++++++++++++++++++++++ man/make_waffle_chart_tall.Rd | 65 +++++++++++++++++++++++++++++++++++ man/waffle_counts.Rd | 31 +++++++++++++++++ 6 files changed, 246 insertions(+) create mode 100644 man/complete_x_values.Rd create mode 100644 man/domain_filename.Rd create mode 100644 man/domain_filename_es.Rd create mode 100644 man/make_waffle_chart.Rd create mode 100644 man/make_waffle_chart_tall.Rd create mode 100644 man/waffle_counts.Rd diff --git a/man/complete_x_values.Rd b/man/complete_x_values.Rd new file mode 100644 index 0000000..c41339a --- /dev/null +++ b/man/complete_x_values.Rd @@ -0,0 +1,48 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/waffle-plot-functions.R +\name{complete_x_values} +\alias{complete_x_values} +\title{New helper function to add null/missing x values} +\usage{ +complete_x_values( + counts_df, + x_var, + fill_var, + all_levels = NULL, + .verbose = FALSE +) +} +\arguments{ +\item{counts_df}{The counts dataframe from waffle_counts} + +\item{x_var}{The variable to facet the waffle chart by (e.g., year).} + +\item{fill_var}{The variable to color the waffle chart blocks by (e.g., +state_responsibility).} + +\item{all_levels}{Optional: All possible levels for the x variable (needed +for pres_admin)} + +\item{.verbose}{Logical indicating whether to print debug information} +} +\value{ +The counts dataframe with missing x values added +} +\description{ +New helper function to add null/missing x values +} +\examples{ +\donttest{ +deaths <- assign_levels(deaths_aug24, "standard", .simplify=TRUE) \%>\% + dplyr::filter(year != 2012) # Remove 2012 +waffle_counts_df <- waffle_counts(deaths, + x_var = year, + fill_var = protest_domain, + fill_var_description = lev$protest_domain) +waffle_counts_df_completed <- complete_x_values(waffle_counts_df, + x_var = year, + fill_var = protest_domain, + all_levels = NULL, + .verbose = FALSE) +} +} diff --git a/man/domain_filename.Rd b/man/domain_filename.Rd new file mode 100644 index 0000000..fb3c4d2 --- /dev/null +++ b/man/domain_filename.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/filename-tools-subset.R +\name{domain_filename} +\alias{domain_filename} +\title{Generate protest domain filename} +\usage{ +domain_filename(protest_domain) +} +\arguments{ +\item{protest_domain}{The protest domain name} +} +\value{ +The corresponding filename for the domain page, + relative to the root of the website. +} +\description{ +Generate protest domain filename +} +\examples{ +domain_filename("Rural land") +} diff --git a/man/domain_filename_es.Rd b/man/domain_filename_es.Rd new file mode 100644 index 0000000..1251f28 --- /dev/null +++ b/man/domain_filename_es.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/filename-tools-subset.R +\name{domain_filename_es} +\alias{domain_filename_es} +\title{Generate Spanish domain filename} +\usage{ +domain_filename_es(protest_domain) +} +\arguments{ +\item{protest_domain}{The protest domain name in Spanish} +} +\value{ +The corresponding filename for the Spanish domain page, + relative to the root of the website. +} +\description{ +Generate Spanish domain filename +} +\examples{ +domain_filename_es("Campesino") +} diff --git a/man/make_waffle_chart.Rd b/man/make_waffle_chart.Rd new file mode 100644 index 0000000..eb75ba5 --- /dev/null +++ b/man/make_waffle_chart.Rd @@ -0,0 +1,60 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/waffle-plot-functions.R +\name{make_waffle_chart} +\alias{make_waffle_chart} +\title{Create a waffle chart with facets} +\usage{ +make_waffle_chart( + dataframe, + x_var, + fill_var, + fill_var_description, + n_columns = 5, + waffle_width = 10, + complete_x = FALSE, + lang = "en", + .verbose = FALSE +) +} +\arguments{ +\item{dataframe}{The input dataframe containing the data.} + +\item{x_var}{The variable to facet the waffle chart by (e.g., year +or pres_admin). This will name the facets.} + +\item{fill_var}{The variable to color the waffle chart blocks by (e.g., +state_responsibility).} + +\item{fill_var_description}{A list containing the title, levels, and colors +for the fill variable. Can be taken from our level description list, lev.} + +\item{n_columns}{Number of columns for the facet wrap.} + +\item{waffle_width}{Number of rows in each waffle chart (default 10).} + +\item{complete_x}{Logical indicating whether to complete missing x values +with a single null block. Only implemented for year and pres_admin.} + +\item{lang}{Language for the legend labels ("en" or "es"). Default is "en". +Only affects the legend and not the x-axis label, which should be +handled before calling the function.} + +\item{.verbose}{Logical indicating whether to print debug information.} +} +\value{ +A ggplot object representing the waffle chart. +} +\description{ +Creates a waffle chart from an overall dataset, both calculating +the relevant counts and formatting the chart. +} +\examples{ +\dontrun{ +deaths <- assign_levels(deaths_aug24, "standard", .simplify = TRUE) +make_waffle_chart(deaths, + x_var = pres_admin, + fill_var = state_responsibility, + fill_var_description = state_resp, + complete_x = TRUE, n_columns = 7) +} +} diff --git a/man/make_waffle_chart_tall.Rd b/man/make_waffle_chart_tall.Rd new file mode 100644 index 0000000..d3560b2 --- /dev/null +++ b/man/make_waffle_chart_tall.Rd @@ -0,0 +1,65 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/waffle-plot-functions.R +\name{make_waffle_chart_tall} +\alias{make_waffle_chart_tall} +\title{Create a tall waffle chart with facets} +\usage{ +make_waffle_chart_tall( + dataframe, + x_var, + fill_var, + fill_var_description, + n_columns = 5, + complete_x = FALSE, + lang = "en", + .verbose = FALSE +) +} +\arguments{ +\item{dataframe}{The input dataframe containing the data.} + +\item{x_var}{The variable to facet the waffle chart by (e.g., year +or pres_admin). This will name the facets.} + +\item{fill_var}{The variable to color the waffle chart blocks by (e.g., +state_responsibility).} + +\item{fill_var_description}{A list containing the title, levels, and colors +for the fill variable. Can be taken from our level description list, lev.} + +\item{n_columns}{Number of rows for the facet wrap (displayed vertically).} + +\item{complete_x}{Logical indicating whether to complete missing x values +with a single null block. Only implemented for year and pres_admin.} + +\item{lang}{Language for the legend labels ("en" or "es"). Default is "en". +Only affects the legend and not the x-axis label, which should be +handled before calling the function.} + +\item{.verbose}{Logical indicating whether to print debug information.} +} +\value{ +A ggplot object representing the tall waffle chart. +} +\description{ +Creates a tall-oriented waffle chart from an overall dataset, both calculating +the relevant counts and formatting the chart. Facets are arranged vertically. +} +\examples{ +\dontrun{ +deaths <- assign_levels(deaths_aug24, "standard", .simplify = TRUE) +make_waffle_chart_tall(deaths, + x_var = pres_admin, + fill_var = state_responsibility, + fill_var_description = lev$state_responsibility, + complete_x = TRUE, n_columns = 7) + make_waffle_chart_tall(deaths, + x_var = pres_admin, fill_var = state_responsibility, + fill_var_description = lev$state_responsibility, + complete_x = FALSE, n_columns = 6) + make_waffle_chart_tall(deaths, + x_var = pres_admin, fill_var = state_responsibility, + fill_var_description = lev$state_responsibility, + complete_x = FALSE, n_columns = 6, lang="es") +} +} diff --git a/man/waffle_counts.Rd b/man/waffle_counts.Rd new file mode 100644 index 0000000..3f8a76f --- /dev/null +++ b/man/waffle_counts.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/waffle-plot-functions.R +\name{waffle_counts} +\alias{waffle_counts} +\title{Helper function to create counts dataframe for waffle charts} +\usage{ +waffle_counts(dataframe, x_var, fill_var, fill_var_description) +} +\arguments{ +\item{dataframe}{The input dataframe containing the data.} + +\item{x_var}{The variable to facet the waffle chart by (e.g., year).} + +\item{fill_var}{The variable to color the waffle chart blocks by (e.g., +state_responsibility).} + +\item{fill_var_description}{A list containing the title, levels, and colors +for the fill variable. Can be taken from our level description list, lev.} +} +\value{ +A dataframe with counts of occurrences for each combination of x_var + and fill_var. +} +\description{ +Helper function to create counts dataframe for waffle charts +} +\examples{ +waffle_counts(dataframe = assign_state_responsibility_levels(deaths_aug24, simplify = TRUE), + x_var = year, fill_var = state_responsibility, + fill_var_description = lev$state_responsibility) +} From b416b8cb6aea9071f05819930f285035d68fd973 Mon Sep 17 00:00:00 2001 From: CarwilB <54286746+CarwilB@users.noreply.github.com> Date: Thu, 30 Oct 2025 14:47:06 -0500 Subject: [PATCH 12/14] final checks on waffle-plot-functions --- DESCRIPTION | 3 +-- NAMESPACE | 5 +++++ R/filename-tools-subset.R | 2 ++ R/waffle-plot-functions.R | 22 +++++++++++++++++++--- vignettes/articles/event-heat-map.Rmd | 2 +- 5 files changed, 28 insertions(+), 6 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index cb1f2a8..6b79f11 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -2,7 +2,7 @@ Package: consequencestools Type: Package Title: Provides Support Tools for Data Analysis and Visualization from the Ultimate Consequences Database -Version: 0.0.0.9010 +Version: 0.0.0.9011 Authors@R: person( "Carwil", "Bjork-James", @@ -37,7 +37,6 @@ Imports: reactable, reactablefmtr, rlang, - scales, stringi, stringr, tidyr, diff --git a/NAMESPACE b/NAMESPACE index b23a21e..1c1e3db 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -29,12 +29,14 @@ export(clean_pt_variables) export(col2hex) export(combine_dates) export(combine_names) +export(complete_x_values) export(count_events_in_month) export(count_ongoing_events) export(count_range_by) export(department_name_from_id) export(displayed_date_string) export(domain_filename) +export(domain_filename_es) export(estimated_date) export(estimated_date_string) export(event_counts_by) @@ -55,6 +57,8 @@ export(id_for_event) export(id_for_municipality) export(id_for_municipality_2) export(id_for_president) +export(make_waffle_chart) +export(make_waffle_chart_tall) export(muni_counts_by) export(muni_list_with_counts_by) export(municipality_name_from_id) @@ -86,6 +90,7 @@ export(sv_pal) export(top_values_string) export(truncate_event_list) export(truncate_muni_list) +export(waffle_counts) export(wide_event_outcomes_reactable) export(wide_event_outcomes_table) import(dplyr) diff --git a/R/filename-tools-subset.R b/R/filename-tools-subset.R index 1eb5506..0963b81 100644 --- a/R/filename-tools-subset.R +++ b/R/filename-tools-subset.R @@ -25,6 +25,8 @@ domain_filename <- function(protest_domain){ #' @return The corresponding filename for the Spanish domain page, #' relative to the root of the website. #' +#' @export +#' #' @examples #' domain_filename_es("Campesino") domain_filename_es <- function(protest_domain){ diff --git a/R/waffle-plot-functions.R b/R/waffle-plot-functions.R index a0ffec6..a15ebcc 100644 --- a/R/waffle-plot-functions.R +++ b/R/waffle-plot-functions.R @@ -1,4 +1,4 @@ -# Helper function to create counts dataframe for waffle charts +#' Helper function to create counts dataframe for waffle charts #' #' @param dataframe The input dataframe containing the data. #' @param x_var The variable to facet the waffle chart by (e.g., year). @@ -44,7 +44,10 @@ waffle_counts <- function(dataframe, x_var, #' @param .verbose Logical indicating whether to print debug information #' @return The counts dataframe with missing x values added #' +#' @export +#' #' @examples +#' \donttest{ #' deaths <- assign_levels(deaths_aug24, "standard", .simplify=TRUE) %>% #' dplyr::filter(year != 2012) # Remove 2012 #' waffle_counts_df <- waffle_counts(deaths, @@ -56,6 +59,7 @@ waffle_counts <- function(dataframe, x_var, #' fill_var = protest_domain, #' all_levels = NULL, #' .verbose = FALSE) +#' } complete_x_values <- function(counts_df, x_var, fill_var, all_levels = NULL, .verbose = FALSE) { x_var_name <- quo_name(enquo(x_var)) @@ -105,7 +109,7 @@ complete_x_values <- function(counts_df, x_var, fill_var, } if (.verbose) { - print(str(counts_df)) + print(utils::str(counts_df)) } return(counts_df) @@ -127,18 +131,23 @@ complete_x_values <- function(counts_df, x_var, fill_var, #' @param waffle_width Number of rows in each waffle chart (default 10). #' @param complete_x Logical indicating whether to complete missing x values #' with a single null block. Only implemented for year and pres_admin. +#' @param lang Language for the legend labels ("en" or "es"). Default is "en". +#' Only affects the legend and not the x-axis label, which should be +#' handled before calling the function. #' @param .verbose Logical indicating whether to print debug information. #' #' @return A ggplot object representing the waffle chart. #' @export #' #' @examples +#' \dontrun{ #' deaths <- assign_levels(deaths_aug24, "standard", .simplify = TRUE) #' make_waffle_chart(deaths, #' x_var = pres_admin, #' fill_var = state_responsibility, #' fill_var_description = state_resp, #' complete_x = TRUE, n_columns = 7) +#' } make_waffle_chart <- function(dataframe, x_var, fill_var, fill_var_description, n_columns = 5, @@ -174,6 +183,7 @@ make_waffle_chart <- function(dataframe, x_var, fill_var, # Add null to the color set but not to the legend fill_colors <- c(fill_colors, ' ' = "white") + fill_legend <- c(fill_legend, ' ' = "white") } } @@ -217,12 +227,16 @@ make_waffle_chart <- function(dataframe, x_var, fill_var, #' @param n_columns Number of rows for the facet wrap (displayed vertically). #' @param complete_x Logical indicating whether to complete missing x values #' with a single null block. Only implemented for year and pres_admin. +#' @param lang Language for the legend labels ("en" or "es"). Default is "en". +#' Only affects the legend and not the x-axis label, which should be +#' handled before calling the function. #' @param .verbose Logical indicating whether to print debug information. #' #' @return A ggplot object representing the tall waffle chart. #' @export #' #' @examples +#' \dontrun{ #' deaths <- assign_levels(deaths_aug24, "standard", .simplify = TRUE) #' make_waffle_chart_tall(deaths, #' x_var = pres_admin, @@ -236,7 +250,8 @@ make_waffle_chart <- function(dataframe, x_var, fill_var, #' make_waffle_chart_tall(deaths, #' x_var = pres_admin, fill_var = state_responsibility, #' fill_var_description = lev$state_responsibility, -#' complete_x = FALSE, n_columns = 6, lang="es') +#' complete_x = FALSE, n_columns = 6, lang="es") +#' } make_waffle_chart_tall <- function(dataframe, x_var, fill_var, fill_var_description, n_columns = 5, complete_x = FALSE, @@ -270,6 +285,7 @@ make_waffle_chart_tall <- function(dataframe, x_var, fill_var, fill_var_descript # Add null to the color set but not to the legend fill_colors <- c(fill_colors, ' ' = "white") + fill_legend <- c(fill_legend, ' ' = "white") } } diff --git a/vignettes/articles/event-heat-map.Rmd b/vignettes/articles/event-heat-map.Rmd index 38ad4d5..2616259 100644 --- a/vignettes/articles/event-heat-map.Rmd +++ b/vignettes/articles/event-heat-map.Rmd @@ -85,7 +85,7 @@ create_calendar_heatmap <- function(year) { plot_month <- function(month_num) { month_data <- df %>% filter(month == month_num) - ggplot(month_data, aes(x = wday, y = week, fill = events)) + + ggplot2::ggplot(month_data, aes(x = wday, y = week, fill = events)) + geom_tile(color = "white") + scale_fill_gradient(low = "white", high = "red") + scale_x_continuous(breaks = 1:7, labels = c("S", "M", "T", "W", "T", "F", "S")) + From f55fa545b4c75c6364d9384eb6f7e193be30a02a Mon Sep 17 00:00:00 2001 From: CarwilB <54286746+CarwilB@users.noreply.github.com> Date: Thu, 30 Oct 2025 15:11:04 -0500 Subject: [PATCH 13/14] Add functions to sort variable descriptions --- NAMESPACE | 2 + R/relabel-pres-admin.R | 47 ++++ R/sort-var-description.R | 129 +++++++++++ man/relabel_pres_admin.Rd | 34 +++ man/sorted_by_most_frequent.Rd | 42 ++++ man/sorted_by_widest_appearance.Rd | 45 ++++ tests/testthat/_snaps/relabel-pres-admin.md | 52 +++++ tests/testthat/test-relabel-pres-admin.R | 14 ++ tests/testthat/test-sort-var-description.R | 224 ++++++++++++++++++++ 9 files changed, 589 insertions(+) create mode 100644 R/relabel-pres-admin.R create mode 100644 R/sort-var-description.R create mode 100644 man/relabel_pres_admin.Rd create mode 100644 man/sorted_by_most_frequent.Rd create mode 100644 man/sorted_by_widest_appearance.Rd create mode 100644 tests/testthat/_snaps/relabel-pres-admin.md create mode 100644 tests/testthat/test-relabel-pres-admin.R create mode 100644 tests/testthat/test-sort-var-description.R diff --git a/NAMESPACE b/NAMESPACE index 1c1e3db..7898734 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -82,6 +82,8 @@ export(repair_name_line_es) export(sep_pal) export(set_maximums) export(share_of_largest_n) +export(sorted_by_most_frequent) +export(sorted_by_widest_appearance) export(standard_filter) export(str_equivalent) export(str_equivalent_list) diff --git a/R/relabel-pres-admin.R b/R/relabel-pres-admin.R new file mode 100644 index 0000000..c923d97 --- /dev/null +++ b/R/relabel-pres-admin.R @@ -0,0 +1,47 @@ +#' Relabel presidential administration using presidency_name_table +#' +#' Replaces pres_admin values with corresponding values from a specified column +#' in presidency_name_table (e.g., presidency_year, presidency_short, etc.) +#' +#' @param dataframe The input dataframe containing a pres_admin column +#' @param output_column The column from presidency_name_table to use for new labels +#' (unquoted column name) +#' @param keep_original Logical indicating whether to keep the original pres_admin +#' column as pres_admin_original (default TRUE) +#' +#' @return The dataframe with pres_admin relabeled according to output_column +#' +#' @examples +#' def_labeled <- relabel_pres_admin(def, presidency_year) +#' def_labeled <- relabel_pres_admin(def, presidency_short) +#' def_labeled <- relabel_pres_admin(def, presidency_full, keep_original = FALSE) +relabel_pres_admin <- function(dataframe, output_column, .input_column="presidency", keep_original = TRUE) { + output_col_name <- rlang::ensym(output_column) + input_col_name <- rlang::ensym(.input_column) + + result <- dataframe %>% + left_join(select(presidency_name_table, {{input_col_name}}, {{output_column}}), + by = join_by(pres_admin == {{input_col_name}})) + + if (keep_original) { + result <- result %>% + rename(pres_admin_original = pres_admin) + } else { + result <- result %>% + select(-pres_admin) + } + + result <- result %>% + rename(pres_admin = {{output_column}}) + + if(length(unique(presidency_name_table[[rlang::as_name(output_col_name)]])) < nrow(presidency_name_table)) { + warning("Some new values are ambiguous. pres_admin not returned as a factor.") + } else { + result <- result %>% + # Make pres_admin a factor in the order specified in presidency_name_table + mutate(pres_admin = factor(pres_admin, + levels = presidency_name_table[[rlang::as_name(output_col_name)]])) + } + + return(result) +} diff --git a/R/sort-var-description.R b/R/sort-var-description.R new file mode 100644 index 0000000..ad326ad --- /dev/null +++ b/R/sort-var-description.R @@ -0,0 +1,129 @@ +#' Sort variable description by widest appearance across groups +#' +#' Reorders the levels and colors in a variable description list based on how +#' widely each level appears across a grouping variable. Levels that appear in +#' more groups are ranked higher. For example, sorting protest domains by how +#' many presidential administrations each domain appears in. +#' +#' @param var_description A list containing variable metadata with elements: +#' \itemize{ +#' \item \code{r_variable}: Name of the variable in the dataframe +#' \item \code{levels}: Character vector of level names +#' \item \code{colors}: Named vector of colors for each level +#' \item \code{levels_es}: (Optional) Spanish translations of levels +#' \item \code{colors_es}: (Optional) Spanish-named color vector +#' } +#' @param def The dataframe containing the data to analyze +#' @param grouping_var The variable to group by when calculating width of +#' appearance (e.g., pres_admin, year). Use unquoted variable name. +#' +#' @return A modified variable description list with levels and colors reordered +#' by widest appearance. Includes a new \code{$ranked} element with the +#' sorted levels. +#' +#' @export +#' @examples +#' \dontrun{ +#' # Sort protest domains by how many presidential administrations they appear in +#' deaths <- assign_protest_domain_levels(deaths_aug24) +#' pd_sorted <- sorted_by_widest_appearance( +#' var_description = lev$protest_domain, +#' def = deaths, +#' grouping_var = pres_admin +#' ) +#' } +sorted_by_widest_appearance <- function(var_description, def, grouping_var) { + var_name <- var_description$r_variable + var_description$ranked <- + count(def, {{grouping_var}}, !!sym(var_name)) %>% # 2-var frequency table + count(!!sym(var_name)) %>% # frequency table of number of + # values of the grouping variable, with deaths in each value of the variable + arrange(desc(n)) %>% # ranked downward + pull(!!sym(var_name)) # vector of the groups + new_var_description <- var_description + + # Get the new order based on ranked + new_order <- match(new_var_description$ranked, var_description$levels) + + # Reorder levels + new_var_description$levels <- var_description$ranked + + # Reorder levels_es if it exists + if (!is.null(var_description$levels_es)) { + new_var_description$levels_es <- var_description$levels_es[new_order] + } + + # Reorder colors + new_var_description$colors <- var_description$colors[new_order] + + # Reorder colors_es if it exists + if (!is.null(var_description$colors_es)) { + new_var_description$colors_es <- var_description$colors_es[new_order] + } + + new_var_description +} + + +#' Sort variable description by frequency +#' +#' Reorders the levels and colors in a variable description list based on +#' the frequency of each level in the data. More frequent levels are ranked +#' higher. +#' +#' @param var_description A list containing variable metadata with elements: +#' \itemize{ +#' \item \code{r_variable}: Name of the variable in the dataframe +#' \item \code{levels}: Character vector of level names +#' \item \code{colors}: Named vector of colors for each level +#' \item \code{levels_es}: (Optional) Spanish translations of levels +#' \item \code{colors_es}: (Optional) Spanish-named color vector +#' } +#' @param def The dataframe containing the data to analyze +#' @param grouping_var Optional grouping variable (not used, included for +#' consistency with \code{sorted_by_widest_appearance}) +#' +#' @return A modified variable description list with levels and colors reordered +#' by frequency. Includes a new \code{$ranked} element with the sorted levels. +#' +#' @export +#' @examples +#' \dontrun{ +#' deaths <- assign_protest_domain_levels(deaths_aug24) +#' # Sort protest domains by total frequency +#' pd_sorted <- sorted_by_most_frequent( +#' var_description = lev$protest_domain, +#' def = deaths +#' ) +#' } +sorted_by_most_frequent <- function(var_description, def, grouping_var = NULL) { + # Note: grouping_var parameter is not used but included for API consistency + + var_name <- var_description$r_variable + var_description$ranked <- + count(def, !!sym(var_name)) %>% # frequency table for the variable in question + arrange(desc(n)) %>% # ranked downward + pull(!!sym(var_name)) # vector of the groups + new_var_description <- var_description + + # Get the new order based on ranked + new_order <- match(new_var_description$ranked, var_description$levels) + + # Reorder levels + new_var_description$levels <- var_description$ranked + + # Reorder levels_es if it exists + if (!is.null(var_description$levels_es)) { + new_var_description$levels_es <- var_description$levels_es[new_order] + } + + # Reorder colors + new_var_description$colors <- var_description$colors[new_order] + + # Reorder colors_es if it exists + if (!is.null(var_description$colors_es)) { + new_var_description$colors_es <- var_description$colors_es[new_order] + } + + new_var_description +} diff --git a/man/relabel_pres_admin.Rd b/man/relabel_pres_admin.Rd new file mode 100644 index 0000000..bfe25ad --- /dev/null +++ b/man/relabel_pres_admin.Rd @@ -0,0 +1,34 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/relabel-pres-admin.R +\name{relabel_pres_admin} +\alias{relabel_pres_admin} +\title{Relabel presidential administration using presidency_name_table} +\usage{ +relabel_pres_admin( + dataframe, + output_column, + .input_column = "presidency", + keep_original = TRUE +) +} +\arguments{ +\item{dataframe}{The input dataframe containing a pres_admin column} + +\item{output_column}{The column from presidency_name_table to use for new labels +(unquoted column name)} + +\item{keep_original}{Logical indicating whether to keep the original pres_admin +column as pres_admin_original (default TRUE)} +} +\value{ +The dataframe with pres_admin relabeled according to output_column +} +\description{ +Replaces pres_admin values with corresponding values from a specified column +in presidency_name_table (e.g., presidency_year, presidency_short, etc.) +} +\examples{ +def_labeled <- relabel_pres_admin(def, presidency_year) +def_labeled <- relabel_pres_admin(def, presidency_short) +def_labeled <- relabel_pres_admin(def, presidency_full, keep_original = FALSE) +} diff --git a/man/sorted_by_most_frequent.Rd b/man/sorted_by_most_frequent.Rd new file mode 100644 index 0000000..2ea8097 --- /dev/null +++ b/man/sorted_by_most_frequent.Rd @@ -0,0 +1,42 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/sort-var-description.R +\name{sorted_by_most_frequent} +\alias{sorted_by_most_frequent} +\title{Sort variable description by frequency} +\usage{ +sorted_by_most_frequent(var_description, def, grouping_var = NULL) +} +\arguments{ +\item{var_description}{A list containing variable metadata with elements: +\itemize{ + \item \code{r_variable}: Name of the variable in the dataframe + \item \code{levels}: Character vector of level names + \item \code{colors}: Named vector of colors for each level + \item \code{levels_es}: (Optional) Spanish translations of levels + \item \code{colors_es}: (Optional) Spanish-named color vector +}} + +\item{def}{The dataframe containing the data to analyze} + +\item{grouping_var}{Optional grouping variable (not used, included for +consistency with \code{sorted_by_widest_appearance})} +} +\value{ +A modified variable description list with levels and colors reordered + by frequency. Includes a new \code{$ranked} element with the sorted levels. +} +\description{ +Reorders the levels and colors in a variable description list based on +the frequency of each level in the data. More frequent levels are ranked +higher. +} +\examples{ +\dontrun{ +deaths <- assign_protest_domain_levels(deaths_aug24) +# Sort protest domains by total frequency +pd_sorted <- sorted_by_most_frequent( + var_description = lev$protest_domain, + def = deaths +) +} +} diff --git a/man/sorted_by_widest_appearance.Rd b/man/sorted_by_widest_appearance.Rd new file mode 100644 index 0000000..4e72e46 --- /dev/null +++ b/man/sorted_by_widest_appearance.Rd @@ -0,0 +1,45 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/sort-var-description.R +\name{sorted_by_widest_appearance} +\alias{sorted_by_widest_appearance} +\title{Sort variable description by widest appearance across groups} +\usage{ +sorted_by_widest_appearance(var_description, def, grouping_var) +} +\arguments{ +\item{var_description}{A list containing variable metadata with elements: +\itemize{ + \item \code{r_variable}: Name of the variable in the dataframe + \item \code{levels}: Character vector of level names + \item \code{colors}: Named vector of colors for each level + \item \code{levels_es}: (Optional) Spanish translations of levels + \item \code{colors_es}: (Optional) Spanish-named color vector +}} + +\item{def}{The dataframe containing the data to analyze} + +\item{grouping_var}{The variable to group by when calculating width of +appearance (e.g., pres_admin, year). Use unquoted variable name.} +} +\value{ +A modified variable description list with levels and colors reordered + by widest appearance. Includes a new \code{$ranked} element with the + sorted levels. +} +\description{ +Reorders the levels and colors in a variable description list based on how +widely each level appears across a grouping variable. Levels that appear in +more groups are ranked higher. For example, sorting protest domains by how +many presidential administrations each domain appears in. +} +\examples{ +\dontrun{ +# Sort protest domains by how many presidential administrations they appear in +deaths <- assign_protest_domain_levels(deaths_aug24) +pd_sorted <- sorted_by_widest_appearance( + var_description = lev$protest_domain, + def = deaths, + grouping_var = pres_admin +) +} +} diff --git a/tests/testthat/_snaps/relabel-pres-admin.md b/tests/testthat/_snaps/relabel-pres-admin.md new file mode 100644 index 0000000..c5afbeb --- /dev/null +++ b/tests/testthat/_snaps/relabel-pres-admin.md @@ -0,0 +1,52 @@ +# relabel_pres_admin works + + Code + def_labeled + Output + # A tibble: 670 x 52 + event_title unconfirmed year month day later_year later_month later_day + + 1 Shooting at S~ NA 1984 10 26 NA NA NA + 2 Shooting at S~ NA 1984 10 26 NA NA NA + 3 Shooting at S~ NA 1984 10 26 NA NA NA + 4 Shooting at S~ NA 1984 10 26 NA NA NA + 5 Killing of ha~ NA 1984 10 28 NA NA NA + 6 Huayllani roa~ NA 1985 6 3 NA NA NA + 7 Huayllani roa~ NA 1985 6 3 NA NA NA + 8 Huayllani roa~ TRUE 1985 6 3 NA NA NA + 9 COB education~ NA 1986 4 8 NA NA NA + 10 COB education~ NA 1986 4 8 1986 4 10 + # i 660 more rows + # i 44 more variables: dec_firstname , dec_surnames , id_indiv , + # dec_age , dec_alt_age , dec_gender , dec_residence , + # dec_nationality , dec_affiliation , dec_spec_affiliation , + # dec_title , cause_death , munition , weapon , + # va_notes , perp_category , perp_group , + # perp_pol_stalemate , dec_pol_stalemate , ... + +--- + + Code + def_labeled2 + Output + # A tibble: 670 x 52 + event_title unconfirmed year month day later_year later_month later_day + + 1 Shooting at S~ NA 1984 10 26 NA NA NA + 2 Shooting at S~ NA 1984 10 26 NA NA NA + 3 Shooting at S~ NA 1984 10 26 NA NA NA + 4 Shooting at S~ NA 1984 10 26 NA NA NA + 5 Killing of ha~ NA 1984 10 28 NA NA NA + 6 Huayllani roa~ NA 1985 6 3 NA NA NA + 7 Huayllani roa~ NA 1985 6 3 NA NA NA + 8 Huayllani roa~ TRUE 1985 6 3 NA NA NA + 9 COB education~ NA 1986 4 8 NA NA NA + 10 COB education~ NA 1986 4 8 1986 4 10 + # i 660 more rows + # i 44 more variables: dec_firstname , dec_surnames , id_indiv , + # dec_age , dec_alt_age , dec_gender , dec_residence , + # dec_nationality , dec_affiliation , dec_spec_affiliation , + # dec_title , cause_death , munition , weapon , + # va_notes , perp_category , perp_group , + # perp_pol_stalemate , dec_pol_stalemate , ... + diff --git a/tests/testthat/test-relabel-pres-admin.R b/tests/testthat/test-relabel-pres-admin.R new file mode 100644 index 0000000..76a6e0a --- /dev/null +++ b/tests/testthat/test-relabel-pres-admin.R @@ -0,0 +1,14 @@ +test_that("relabel_pres_admin works", { + def <- deaths_aug24 + def_labeled <- relabel_pres_admin(def, presidency_year, keep_original = TRUE) + expect_equal(ncol(def_labeled), ncol(def) + 1) + expect_true("pres_admin_original" %in% colnames(def_labeled)) + expect_equal(def_labeled$pres_admin_original, def$pres_admin) + expect_snapshot(def_labeled) + + def_labeled2 <- relabel_pres_admin(def, presidency_initials) %>% suppressWarnings() + expect_equal(ncol(def_labeled2), ncol(def) + 1) + expect_true(all(unique(def_labeled2$pres_admin) %in% presidency_name_table$presidency_initials)) + + expect_snapshot(def_labeled2) +}) diff --git a/tests/testthat/test-sort-var-description.R b/tests/testthat/test-sort-var-description.R new file mode 100644 index 0000000..7abffa2 --- /dev/null +++ b/tests/testthat/test-sort-var-description.R @@ -0,0 +1,224 @@ +# tests/testthat/test-sort-var-description.R + +test_that("sorted_by_widest_appearance reorders levels correctly", { + # Create sample data + test_data <- tibble::tibble( + year = c(2010, 2010, 2011, 2011, 2012, 2013), + category = c("A", "B", "A", "C", "A", "B") + ) + + # Create sample var_description + test_desc <- list( + r_variable = "category", + levels = c("A", "B", "C"), + colors = c("A" = "#FF0000", "B" = "#00FF00", "C" = "#0000FF") + ) + + # Apply function + result <- sorted_by_widest_appearance(test_desc, test_data, year) + + # A appears in 3 years, B in 2 years, C in 1 year + expect_equal(as.character(result$ranked), c("A", "B", "C")) + expect_equal(result$levels, c("A", "B", "C")) + expect_equal(names(result$colors), c("A", "B", "C")) + expect_equal(as.character(result$colors), c("#FF0000", "#00FF00", "#0000FF")) +}) + +test_that("sorted_by_widest_appearance handles tied ranks", { + test_data <- tibble::tibble( + year = c(2010, 2010, 2011, 2011), + category = c("A", "B", "A", "B") + ) + + test_desc <- list( + r_variable = "category", + levels = c("A", "B"), + colors = c("A" = "#FF0000", "B" = "#00FF00") + ) + + result <- sorted_by_widest_appearance(test_desc, test_data, year) + + # Both A and B appear in 2 years + expect_equal(length(result$ranked), 2) + expect_true(all(c("A", "B") %in% as.character(result$ranked))) +}) + +test_that("sorted_by_widest_appearance preserves Spanish levels", { + test_data <- tibble::tibble( + year = c(2010, 2010, 2011, 2011, 2012), + category = c("A", "B", "A", "C", "A") + ) + + test_desc <- list( + r_variable = "category", + levels = c("A", "B", "C"), + levels_es = c("Categoría A", "Categoría B", "Categoría C"), + colors = c("A" = "#FF0000", "B" = "#00FF00", "C" = "#0000FF") + ) + + result <- sorted_by_widest_appearance(test_desc, test_data, year) + + # Check that Spanish levels are reordered to match English + expect_equal(result$levels, c("A", "B", "C")) + expect_equal(result$levels_es, c("Categoría A", "Categoría B", "Categoría C")) +}) + +test_that("sorted_by_widest_appearance preserves Spanish colors", { + test_data <- tibble::tibble( + year = c(2010, 2010, 2011, 2012), + category = c("B", "A", "B", "B") + ) + + test_desc <- list( + r_variable = "category", + levels = c("A", "B"), + levels_es = c("Categoría A", "Categoría B"), + colors = c("A" = "#FF0000", "B" = "#00FF00"), + colors_es = c("Categoría A" = "#FF0000", "Categoría B" = "#00FF00") + ) + + result <- sorted_by_widest_appearance(test_desc, test_data, year) + + # B appears in 3 years, A in 1 year + expect_equal(result$levels, c("B", "A")) + expect_equal(result$levels_es, c("Categoría B", "Categoría A")) + expect_equal(names(result$colors_es), c("Categoría B", "Categoría A")) + expect_equal(as.character(result$colors_es), c("#00FF00", "#FF0000")) +}) + +test_that("sorted_by_most_frequent reorders by frequency", { + test_data <- tibble::tibble( + category = c("A", "A", "A", "B", "B", "C") + ) + + test_desc <- list( + r_variable = "category", + levels = c("C", "B", "A"), + colors = c("C" = "#0000FF", "B" = "#00FF00", "A" = "#FF0000") + ) + + result <- sorted_by_most_frequent(test_desc, test_data) + + # A has 3, B has 2, C has 1 + expect_equal(as.character(result$ranked), c("A", "B", "C")) + expect_equal(result$levels, c("A", "B", "C")) + expect_equal(names(result$colors), c("A", "B", "C")) + expect_equal(as.character(result$colors), c("#FF0000", "#00FF00", "#0000FF")) +}) + +test_that("sorted_by_most_frequent ignores grouping_var parameter", { + test_data <- tibble::tibble( + year = c(2010, 2010, 2011), + category = c("A", "B", "A") + ) + + test_desc <- list( + r_variable = "category", + levels = c("A", "B"), + colors = c("A" = "#FF0000", "B" = "#00FF00") + ) + + result1 <- sorted_by_most_frequent(test_desc, test_data) + result2 <- sorted_by_most_frequent(test_desc, test_data, grouping_var = year) + + # Both should give same result (A appears 2x, B appears 1x) + expect_equal(result1$ranked, result2$ranked) + expect_equal(result1$levels, result2$levels) +}) + +test_that("sorted_by_most_frequent preserves Spanish translations", { + test_data <- tibble::tibble( + category = c("C", "C", "C", "A", "A", "B") + ) + + test_desc <- list( + r_variable = "category", + levels = c("A", "B", "C"), + levels_es = c("Categoría A", "Categoría B", "Categoría C"), + colors = c("A" = "#FF0000", "B" = "#00FF00", "C" = "#0000FF"), + colors_es = c("Categoría A" = "#FF0000", + "Categoría B" = "#00FF00", + "Categoría C" = "#0000FF") + ) + + result <- sorted_by_most_frequent(test_desc, test_data) + + # C has 3, A has 2, B has 1 + expect_equal(result$levels, c("C", "A", "B")) + expect_equal(result$levels_es, c("Categoría C", "Categoría A", "Categoría B")) + expect_equal(names(result$colors_es), + c("Categoría C", "Categoría A", "Categoría B")) +}) + +test_that("functions work with real package data", { + skip_if_not(exists("deaths_aug24"), "deaths_aug24 not available") + skip_if_not(exists("lev"), "lev not available") + skip_if_not(exists("assign_levels"), "assign_levels not available") + + deaths_filtered <- assign_levels(deaths_aug24, "standard", .simplify = TRUE) + + # Test sorted_by_widest_appearance with real data + if ("protest_domain" %in% names(lev)) { + result_wide <- sorted_by_widest_appearance( + lev$protest_domain, + deaths_filtered, + pres_admin + ) + + expect_true("ranked" %in% names(result_wide)) + expect_equal(length(result_wide$levels), length(result_wide$colors)) + if (!is.null(result_wide$levels_es)) { + expect_equal(length(result_wide$levels), length(result_wide$levels_es)) + } + } + + # Test sorted_by_most_frequent with real data + if ("protest_domain" %in% names(lev)) { + result_freq <- sorted_by_most_frequent( + lev$protest_domain, + deaths_filtered + ) + + expect_true("ranked" %in% names(result_freq)) + expect_equal(length(result_freq$levels), length(result_freq$colors)) + } +}) + +test_that("functions handle single-level variables", { + test_data <- tibble::tibble( + year = c(2010, 2011, 2012), + category = c("A", "A", "A") + ) + + test_desc <- list( + r_variable = "category", + levels = c("A"), + colors = c("A" = "#FF0000") + ) + + result_wide <- sorted_by_widest_appearance(test_desc, test_data, year) + result_freq <- sorted_by_most_frequent(test_desc, test_data) + + expect_equal(length(result_wide$levels), 1) + expect_equal(length(result_freq$levels), 1) + expect_equal(result_wide$levels, "A") + expect_equal(result_freq$levels, "A") +}) + +test_that("functions preserve all color values", { + test_data <- tibble::tibble( + category = c("B", "C", "A") + ) + + test_desc <- list( + r_variable = "category", + levels = c("A", "B", "C"), + colors = c("A" = "#FF0000", "B" = "#00FF00", "C" = "#0000FF") + ) + + result <- sorted_by_most_frequent(test_desc, test_data) + + # Check all colors are present (even if reordered) + expect_setequal(as.character(result$colors), + c("#FF0000", "#00FF00", "#0000FF")) +}) From bba8064780cac6f5129b5eb39f2e5fa2c89095d6 Mon Sep 17 00:00:00 2001 From: CarwilB <54286746+CarwilB@users.noreply.github.com> Date: Thu, 30 Oct 2025 15:21:59 -0500 Subject: [PATCH 14/14] checks complete --- NAMESPACE | 1 + R/relabel-pres-admin.R | 21 +++++++++++++-------- man/relabel_pres_admin.Rd | 10 +++++++--- 3 files changed, 21 insertions(+), 11 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 7898734..dd1e510 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -71,6 +71,7 @@ export(perp_pal) export(province_name_from_id) export(quasilogical_as_binary) export(red_pal) +export(relabel_pres_admin) export(rename_anexo_columns) export(render_age) export(render_age_es) diff --git a/R/relabel-pres-admin.R b/R/relabel-pres-admin.R index c923d97..98c4a86 100644 --- a/R/relabel-pres-admin.R +++ b/R/relabel-pres-admin.R @@ -1,28 +1,33 @@ #' Relabel presidential administration using presidency_name_table #' #' Replaces pres_admin values with corresponding values from a specified column -#' in presidency_name_table (e.g., presidency_year, presidency_short, etc.) +#' in presidency_name_table (e.g., presidency_year, presidency_initials, etc.) #' #' @param dataframe The input dataframe containing a pres_admin column #' @param output_column The column from presidency_name_table to use for new labels #' (unquoted column name) +#' @param .input_column The column from presidency_name_table to match against +#' pres_admin (default "presidency") #' @param keep_original Logical indicating whether to keep the original pres_admin #' column as pres_admin_original (default TRUE) #' #' @return The dataframe with pres_admin relabeled according to output_column #' +#' @export +#' #' @examples +#' def <- assign_presidency_levels(deaths_aug24) #' def_labeled <- relabel_pres_admin(def, presidency_year) -#' def_labeled <- relabel_pres_admin(def, presidency_short) -#' def_labeled <- relabel_pres_admin(def, presidency_full, keep_original = FALSE) +#' def_labeled <- relabel_pres_admin(def, presidency_initials) +#' def_labeled <- relabel_pres_admin(def, presidency_fullname_es, keep_original = TRUE) relabel_pres_admin <- function(dataframe, output_column, .input_column="presidency", keep_original = TRUE) { output_col_name <- rlang::ensym(output_column) input_col_name <- rlang::ensym(.input_column) - + result <- dataframe %>% left_join(select(presidency_name_table, {{input_col_name}}, {{output_column}}), by = join_by(pres_admin == {{input_col_name}})) - + if (keep_original) { result <- result %>% rename(pres_admin_original = pres_admin) @@ -30,10 +35,10 @@ relabel_pres_admin <- function(dataframe, output_column, .input_column="presiden result <- result %>% select(-pres_admin) } - + result <- result %>% rename(pres_admin = {{output_column}}) - + if(length(unique(presidency_name_table[[rlang::as_name(output_col_name)]])) < nrow(presidency_name_table)) { warning("Some new values are ambiguous. pres_admin not returned as a factor.") } else { @@ -42,6 +47,6 @@ relabel_pres_admin <- function(dataframe, output_column, .input_column="presiden mutate(pres_admin = factor(pres_admin, levels = presidency_name_table[[rlang::as_name(output_col_name)]])) } - + return(result) } diff --git a/man/relabel_pres_admin.Rd b/man/relabel_pres_admin.Rd index bfe25ad..448d0b6 100644 --- a/man/relabel_pres_admin.Rd +++ b/man/relabel_pres_admin.Rd @@ -17,6 +17,9 @@ relabel_pres_admin( \item{output_column}{The column from presidency_name_table to use for new labels (unquoted column name)} +\item{.input_column}{The column from presidency_name_table to match against +pres_admin (default "presidency")} + \item{keep_original}{Logical indicating whether to keep the original pres_admin column as pres_admin_original (default TRUE)} } @@ -25,10 +28,11 @@ The dataframe with pres_admin relabeled according to output_column } \description{ Replaces pres_admin values with corresponding values from a specified column -in presidency_name_table (e.g., presidency_year, presidency_short, etc.) +in presidency_name_table (e.g., presidency_year, presidency_initials, etc.) } \examples{ +def <- assign_presidency_levels(deaths_aug24) def_labeled <- relabel_pres_admin(def, presidency_year) -def_labeled <- relabel_pres_admin(def, presidency_short) -def_labeled <- relabel_pres_admin(def, presidency_full, keep_original = FALSE) +def_labeled <- relabel_pres_admin(def, presidency_initials) +def_labeled <- relabel_pres_admin(def, presidency_fullname_es, keep_original = TRUE) }