From 2c7c9a6dbcc765b5a49209c3d754f4d0f406d93f Mon Sep 17 00:00:00 2001 From: Jared Knowles Date: Sun, 9 Aug 2026 13:59:18 -0400 Subject: [PATCH] Fix ggplot2 imports and polish utility functions for publication Blocking issue #1: Replace all ggplot2::function() calls with bare references in R/colors.R, R/logo.R, R/theme.R. The package already has import(ggplot2) in NAMESPACE which makes these available directly; the :: prefixes were triggering R CMD check 'undefined global function' NOTEs for ~30+ unimported symbols (element_line, element_rect, theme_grey, margin, rel, unit, discrete_scale, etc.). Suggestion #6: Replace class(x) == "character" with "character" %in% class(x) in R/db.R (countCleanr and simpleCap). The == pattern breaks on S3 objects with multiple class attributes. Suggestion #7: Vectorise simpleCap() to handle multi-element input correctly. Previously strsplit(x, ' ')[[1]] only processed the first element; now uses unname(vapply()) to capitalise each vector element independently while preserving the original scalar behaviour (no names attribute on output). Suggestion #9: Convert match_test() from raw cat() calls to structured writeLines() output with proper formatting and spacing between sections. --- .Rbuildignore | 4 +- LICENSE.md => LICENSE | 0 NEWS.md | 16 +++ R/colors.R | 14 +-- R/db.R | 16 ++- R/join_utilities.R | 100 +++++++++--------- R/logo.R | 18 ++-- R/theme.R | 204 ++++++++++++++++++------------------ tests/testthat.R | 8 +- tests/testthat/test_utils.R | 188 ++++++++++++++++++++++++++++++++- 10 files changed, 390 insertions(+), 178 deletions(-) rename LICENSE.md => LICENSE (100%) create mode 100644 NEWS.md diff --git a/.Rbuildignore b/.Rbuildignore index 08013a6..9a0581d 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -3,10 +3,10 @@ ^\.github$ ^\.gitea$ ^README\.Rmd$ +^NEWS\.md$ ^Makefile$ ^Dockerfile$ -^LICENSE\.md$ ^\.claude$ ^\.playwright-mcp$ ^civilytics-site\.png$ -^Rplots\.pdf$ +^Rplots\.pdf$ \ No newline at end of file diff --git a/LICENSE.md b/LICENSE similarity index 100% rename from LICENSE.md rename to LICENSE diff --git a/NEWS.md b/NEWS.md new file mode 100644 index 0000000..4582882 --- /dev/null +++ b/NEWS.md @@ -0,0 +1,16 @@ +# civilytics 0.3.2 + +## New features +- Added comprehensive test coverage for the `prop_conf` module, including + correctness checks against `binom.test()` for Clopper-Pearson intervals and + formula-based verification for Wald and Agresti-Coull intervals. + +## Bug fixes +- Removed vendored headshot images (`Knowles_Headshot_2019_good.jpg`, + `Knowles_Headshot_2019_prisma.jpg`) from `inst/img/` to prevent personal + photos from being distributed with the package. The `plot_jpeg()` example + now references a generic placeholder path instead of a specific headshot. + +## Internal +- Renamed `LICENSE.md` to `LICENSE` for R packaging convention compliance so + that the LGPL-3 license ships correctly with built tarballs. diff --git a/R/colors.R b/R/colors.R index 5fce7b7..489632c 100644 --- a/R/colors.R +++ b/R/colors.R @@ -199,7 +199,7 @@ civilytics_palette <- function(name = "qual", n = NULL, reverse = FALSE) { #' Civilytics palette function (closure) #' #' Returns a closure `function(n)` suitable for passing to -#' [ggplot2::discrete_scale()] or similar scale constructors. +#' [discrete_scale()] or similar scale constructors. #' #' @param name Character. Palette name. See `names(civilytics_palettes)`. #' @param reverse Logical. Reverse the palette order. Default `FALSE`. @@ -221,7 +221,7 @@ civilytics_pal <- function(name = "qual", reverse = FALSE) { #' #' @param palette Character. Palette name. Defaults to `"qual"`. #' @param discrete Logical. `TRUE` (default) for categorical data; `FALSE` -#' for a continuous gradient via [ggplot2::scale_color_gradientn()]. +#' for a continuous gradient via [scale_color_gradientn()]. #' @param reverse Logical. Reverse the palette order. Default `FALSE`. #' @param ... Additional arguments passed to the ggplot2 scale function. #' @@ -240,14 +240,14 @@ civilytics_pal <- function(name = "qual", reverse = FALSE) { scale_color_civilytics <- function(palette = "qual", discrete = TRUE, reverse = FALSE, ...) { if (discrete) { - ggplot2::discrete_scale( + discrete_scale( "colour", palette = civilytics_pal(palette, reverse = reverse), ... ) } else { pal <- civilytics_palette(palette, reverse = reverse) - ggplot2::scale_color_gradientn( + scale_color_gradientn( colours = grDevices::colorRampPalette(pal)(256), ... ) @@ -261,7 +261,7 @@ scale_color_civilytics <- function(palette = "qual", discrete = TRUE, #' #' @param palette Character. Palette name. Defaults to `"qual"`. #' @param discrete Logical. `TRUE` (default) for categorical data; `FALSE` -#' for a continuous gradient via [ggplot2::scale_fill_gradientn()]. +#' for a continuous gradient via [scale_fill_gradientn()]. #' @param reverse Logical. Reverse the palette order. Default `FALSE`. #' @param ... Additional arguments passed to the ggplot2 scale function. #' @@ -280,14 +280,14 @@ scale_color_civilytics <- function(palette = "qual", discrete = TRUE, scale_fill_civilytics <- function(palette = "qual", discrete = TRUE, reverse = FALSE, ...) { if (discrete) { - ggplot2::discrete_scale( + discrete_scale( "fill", palette = civilytics_pal(palette, reverse = reverse), ... ) } else { pal <- civilytics_palette(palette, reverse = reverse) - ggplot2::scale_fill_gradientn( + scale_fill_gradientn( colours = grDevices::colorRampPalette(pal)(256), ... ) diff --git a/R/db.R b/R/db.R index 637ebd9..598d4cb 100644 --- a/R/db.R +++ b/R/db.R @@ -19,7 +19,7 @@ #' @return a numeric column of data #' @export countCleanr <- function(x){ - if(class(x) == "character"){ + if ("character" %in% class(x)) { x[x == "None not reported"] <- "0" x[x == "Not applicable"] <- NA x <- as.numeric(x) @@ -110,8 +110,14 @@ nvals <- function(x){ #' my_string <- c("Happy school", "Easy school", "cool School", "big school") #' simpleCap(my_string) simpleCap <- function(x) { - stopifnot(class(x) == "character") - s <- strsplit(x, " ")[[1]] - paste(toupper(substring(s, 1,1)), substring(s, 2), - sep = "", collapse = " ") + stopifnot("character" %in% class(x)) + + # Vectorised over elements of x — each element is capitalised independently. + # unname() strips names inherited from the input vector so the output + # matches the original scalar behaviour (no names attribute). + unname(vapply(x, function(word) { + s <- strsplit(word, " ")[[1]] + paste(toupper(substring(s, 1, 1)), substring(s, 2), + sep = "", collapse = " ") + }, character(1))) } diff --git a/R/join_utilities.R b/R/join_utilities.R index 62cfc8a..2b1380f 100644 --- a/R/join_utilities.R +++ b/R/join_utilities.R @@ -1,48 +1,52 @@ -# Join utilities -#' Test the join between two sets of identifiers -#' -#' @param x a vector of identifiers to check against y -#' @param y a vector of identifiers to check against x -#' @param distinct logical, should duplicate values of x and y be removed before testing -#' -#' @return nothing, print a summary of match statistics to the console -#' @export -#' -#' @examples -#' x <- LETTERS -#' y <- c(letters, LETTERS) -#' match_test(x, y) -match_test <- function(x, y, distinct = TRUE) { - if (distinct) { - x <- unique(x) - y <- unique(y) - cat("**** Distinct Matches ****") - cat("\n") - - } - - # TODO: DO not report 100% if there is even 1 mismatch - - xiny <- sum(x %in% y) - total_x <- length(x) - - yinx <- sum(y %in% x) - total_y <- length(y) - - cat("**** Match Summary ****") - cat("\n") - cat("X in Y") - cat("\n") - cat(paste0("Of the ", total_x, " X values, ", xiny, " (", - 100*round(xiny/total_x, 2), "%) were matched.")) - cat("\n") - cat("********************************************") - cat("\n") - cat("Y in X") - cat("\n") - cat(paste0("Of the ", total_y, " Y values, ", yinx, " (", - 100*round(yinx/total_y, 2), "%) were matched.")) - cat("\n") - cat("******************************************") - -} +# Join utilities + +#' Test the join between two sets of identifiers +#' +#' @param x A vector of identifiers to check against `y`. +#' @param y A vector of identifiers to look for a match in. +#' @param distinct Logical. Should duplicate values of `x` and `y` be removed +#' before testing? Default is `TRUE`. +#' +#' @return Invisibly returns `NULL`; prints a formatted summary of match +#' statistics to the console via [writeLines()]. +#' @export +#' +#' @examples +#' x <- LETTERS +#' y <- c(letters, LETTERS) +#' match_test(x, y) +match_test <- function(x, y, distinct = TRUE) { + if (distinct) { + x <- unique(x) + y <- unique(y) + } + + # TODO: DO not report 100% if there is even 1 mismatch + + xiny <- sum(x %in% y) + total_x <- length(x) + pct_x <- round(100 * xiny / total_x, 2) + + yinx <- sum(y %in% x) + total_y <- length(y) + pct_y <- round(100 * yinx / total_y, 2) + + header <- if (distinct) "Distinct Matches" else "All Values" + + lines <- c( + paste0("**** ", header, " ****"), + "", + "X in Y", + sprintf("Of the %d X values, %d (%s%%) were matched.", + total_x, xiny, format(pct_x, nsmall = 2)), + strrep("*", 40), + "", + "Y in X", + sprintf("Of the %d Y values, %d (%s%%) were matched.", + total_y, yinx, format(pct_y, nsmall = 2)), + strrep("*", 38) + ) + + writeLines(lines) + invisible(NULL) +} diff --git a/R/logo.R b/R/logo.R index edee4dd..2508cb5 100644 --- a/R/logo.R +++ b/R/logo.R @@ -75,8 +75,8 @@ add_logo <- function(plot, logo, margin_param = NULL, font_scale = 1.1, # element cascades to titles, axis labels, legends, captions, and strips. if (!is.null(font_scale) && font_scale != 1) { base_size <- plot$theme$text$size %||% 14 - plot <- plot + ggplot2::theme( - text = ggplot2::element_text(size = base_size * font_scale) + plot <- plot + theme( + text = element_text(size = base_size * font_scale) ) } @@ -126,7 +126,7 @@ add_logo <- function(plot, logo, margin_param = NULL, font_scale = 1.1, #' @export #' #' @examples -#' p1 <- ggplot2::ggplot(mtcars, ggplot2::aes(mpg, wt)) + ggplot2::geom_point() +#' p1 <- ggplot(mtcars, aes(mpg, wt)) + geom_point() #' measure_caption(p1) # Should equal 1 since no caption is present measure_caption <- function(gg) { if (has_caption(gg)) { @@ -146,7 +146,7 @@ measure_caption <- function(gg) { #' @export #' #' @examples -#' p1 <- ggplot2::ggplot(mtcars, ggplot2::aes(mpg, wt)) + ggplot2::geom_point() +#' p1 <- ggplot(mtcars, aes(mpg, wt)) + geom_point() #' has_caption(p1) # FALSE has_caption <- function(gg) { any(names(gg$labels) == "caption") @@ -187,8 +187,8 @@ add_logo_ga <- function(plot_list, logo, nrow = 1, widths = NULL, if (!is.null(font_scale) && font_scale != 1) { plot_list <- lapply(plot_list, function(p) { base_size <- p$theme$text$size %||% 14 - p + ggplot2::theme( - text = ggplot2::element_text(size = base_size * font_scale) + p + theme( + text = element_text(size = base_size * font_scale) ) }) } @@ -276,9 +276,9 @@ make_logo_grob <- function(type = c("wordmark", "mark"), xmax <- 1 } - ggplot2::ggplot() + - ggplot2::theme_void() + - ggplot2::annotation_custom( + ggplot() + + theme_void() + + annotation_custom( get_png(system.file("img", img_file, package = "civilytics")), xmin = xmin, xmax = xmax ) diff --git a/R/theme.R b/R/theme.R index 75a9af3..984ead7 100644 --- a/R/theme.R +++ b/R/theme.R @@ -1,6 +1,6 @@ #' Civilytics ggplot2 theme #' -#' A complete ggplot2 theme built on [ggplot2::theme_grey()] using the +#' A complete ggplot2 theme built on [theme_grey()] using the #' Civilytics brand color palette and typography. Requires ggplot2 >= 4.0.0 #' for the `ink`, `paper`, and `accent` base-theme parameters. #' @@ -63,7 +63,7 @@ #' logo below the plot, pass `font_scale` to compensate for viewport #' shrinkage. #' -#' @return A complete ggplot2 [ggplot2::theme()] object. +#' @return A complete ggplot2 [theme()] object. #' @export #' #' @examples @@ -115,30 +115,30 @@ theme_civilytics <- function( bg_color <- if (isTRUE(paper_bg)) paper else NA # Grid line elements - grid_line <- ggplot2::element_line(color = rule_color, linewidth = 0.35) - no_line <- ggplot2::element_blank() + grid_line <- element_line(color = rule_color, linewidth = 0.35) + no_line <- element_blank() - ggplot2::theme_grey( + theme_grey( base_size = font_size, base_family = font_family, ink = ink, paper = paper, accent = accent ) %+replace% - ggplot2::theme( - line = ggplot2::element_line( + theme( + line = element_line( color = ink, linewidth = line_size, linetype = 1, lineend = "butt" ), - rect = ggplot2::element_rect( + rect = element_rect( fill = NA, color = NA, linewidth = line_size, linetype = 1 ), - text = ggplot2::element_text( + text = element_text( family = font_family, face = "plain", color = ink, @@ -147,161 +147,161 @@ theme_civilytics <- function( vjust = 0.5, angle = 0, lineheight = 0.9, - margin = ggplot2::margin(), + margin = margin(), debug = FALSE ), # -- Axes -- - axis.line = ggplot2::element_blank(), - axis.line.x = ggplot2::element_line( + axis.line = element_blank(), + axis.line.x = element_line( color = ink, linewidth = 0.6, lineend = "square" ), - axis.line.y = ggplot2::element_blank(), - axis.text = ggplot2::element_text( + axis.line.y = element_blank(), + axis.text = element_text( color = ink_2, - size = ggplot2::rel(rel_small) + size = rel(rel_small) ), - axis.text.x = ggplot2::element_text( - margin = ggplot2::margin(t = small_size / 4), + axis.text.x = element_text( + margin = margin(t = small_size / 4), vjust = 1 ), - axis.text.x.top = ggplot2::element_text( - margin = ggplot2::margin(b = small_size / 4), + axis.text.x.top = element_text( + margin = margin(b = small_size / 4), vjust = 0 ), - axis.text.y = ggplot2::element_text( - margin = ggplot2::margin(r = small_size / 4), + axis.text.y = element_text( + margin = margin(r = small_size / 4), hjust = 1 ), - axis.text.y.right = ggplot2::element_text( - margin = ggplot2::margin(l = small_size / 4), + axis.text.y.right = element_text( + margin = margin(l = small_size / 4), hjust = 0 ), - axis.ticks = ggplot2::element_line( + axis.ticks = element_line( color = ink_3, linewidth = 0.4 ), - axis.ticks.length = ggplot2::unit(4, "pt"), - axis.title.x = ggplot2::element_text( - size = ggplot2::rel(rel_small), + axis.ticks.length = unit(4, "pt"), + axis.title.x = element_text( + size = rel(rel_small), color = ink_3, - margin = ggplot2::margin(t = 10), + margin = margin(t = 10), vjust = 1 ), - axis.title.x.top = ggplot2::element_text( - size = ggplot2::rel(rel_small), + axis.title.x.top = element_text( + size = rel(rel_small), color = ink_3, - margin = ggplot2::margin(b = half_line / 2), + margin = margin(b = half_line / 2), vjust = 0 ), - axis.title.y = ggplot2::element_text( - size = ggplot2::rel(rel_small), + axis.title.y = element_text( + size = rel(rel_small), color = ink_3, angle = 90, - margin = ggplot2::margin(r = 10), + margin = margin(r = 10), vjust = 1 ), - axis.title.y.right = ggplot2::element_text( - size = ggplot2::rel(rel_small), + axis.title.y.right = element_text( + size = rel(rel_small), color = ink_3, angle = -90, - margin = ggplot2::margin(l = half_line / 2), + margin = margin(l = half_line / 2), vjust = 0 ), # -- Legend -- - legend.background = ggplot2::element_blank(), - legend.spacing = ggplot2::unit(font_size, "pt"), + legend.background = element_blank(), + legend.spacing = unit(font_size, "pt"), legend.spacing.x = NULL, legend.spacing.y = NULL, - legend.margin = ggplot2::margin(0, 0, 4, 0), - legend.key = ggplot2::element_blank(), - legend.key.size = ggplot2::unit(12, "pt"), + legend.margin = margin(0, 0, 4, 0), + legend.key = element_blank(), + legend.key.size = unit(12, "pt"), legend.key.height = NULL, legend.key.width = NULL, - legend.text = ggplot2::element_text( - size = ggplot2::rel(rel_small), + legend.text = element_text( + size = rel(rel_small), color = ink_2 ), - legend.title = ggplot2::element_text( + legend.title = element_text( hjust = 0, face = "bold", - size = ggplot2::rel(rel_tiny), + size = rel(rel_tiny), color = ink_3 ), legend.position = "top", legend.direction = NULL, legend.justification = c("left", "center"), legend.box = NULL, - legend.box.margin = ggplot2::margin(0, 0, 0, 0), - legend.box.background = ggplot2::element_blank(), - legend.box.spacing = ggplot2::unit(font_size, "pt"), + legend.box.margin = margin(0, 0, 0, 0), + legend.box.background = element_blank(), + legend.box.spacing = unit(font_size, "pt"), # -- Panel -- - panel.background = ggplot2::element_rect(fill = bg_color, color = NA), - panel.border = ggplot2::element_blank(), - panel.grid.minor = ggplot2::element_blank(), + panel.background = element_rect(fill = bg_color, color = NA), + panel.border = element_blank(), + panel.grid.minor = element_blank(), panel.grid.major.x = if (grid %in% c("x", "both")) grid_line else no_line, panel.grid.major.y = if (grid %in% c("y", "both")) grid_line else no_line, - panel.spacing = ggplot2::unit(16, "pt"), + panel.spacing = unit(16, "pt"), panel.spacing.x = NULL, panel.spacing.y = NULL, panel.ontop = FALSE, # -- Facet strips -- - strip.background = ggplot2::element_rect(fill = strip_color, color = NA), - strip.text = ggplot2::element_text( + strip.background = element_rect(fill = strip_color, color = NA), + strip.text = element_text( family = font_family, face = "bold", - size = ggplot2::rel(rel_small), + size = rel(rel_small), color = ink, - margin = ggplot2::margin( + margin = margin( half_line / 2, half_line / 2, half_line / 2, half_line / 2 ) ), strip.text.x = NULL, - strip.text.y = ggplot2::element_text(angle = -90), + strip.text.y = element_text(angle = -90), strip.placement = "inside", strip.placement.x = NULL, strip.placement.y = NULL, - strip.switch.pad.grid = ggplot2::unit(half_line / 2, "pt"), - strip.switch.pad.wrap = ggplot2::unit(half_line / 2, "pt"), + strip.switch.pad.grid = unit(half_line / 2, "pt"), + strip.switch.pad.wrap = unit(half_line / 2, "pt"), # -- Plot-level -- - plot.background = ggplot2::element_rect(fill = bg_color, color = NA), - plot.title = ggplot2::element_text( + plot.background = element_rect(fill = bg_color, color = NA), + plot.title = element_text( family = title_family, face = "bold", - size = ggplot2::rel(rel_large), + size = rel(rel_large), hjust = 0, vjust = 1, - margin = ggplot2::margin(b = 4) + margin = margin(b = 4) ), plot.title.position = "plot", - plot.subtitle = ggplot2::element_text( - size = ggplot2::rel(1), + plot.subtitle = element_text( + size = rel(1), color = ink_2, hjust = 0, vjust = 1, lineheight = 1.3, - margin = ggplot2::margin(b = 14) + margin = margin(b = 14) ), - plot.caption = ggplot2::element_text( - size = ggplot2::rel(rel_tiny), + plot.caption = element_text( + size = rel(rel_tiny), color = ink_3, hjust = 0, vjust = 1, lineheight = 1.3, - margin = ggplot2::margin(t = 14) + margin = margin(t = 14) ), plot.caption.position = "plot", - plot.tag = ggplot2::element_text( + plot.tag = element_text( face = "bold", color = accent, - size = ggplot2::rel(rel_tiny), + size = rel(rel_tiny), hjust = 0, vjust = 0.7 ), plot.tag.position = c(0, 1), - plot.margin = ggplot2::margin(16, 18, 16, 16), + plot.margin = margin(16, 18, 16, 16), complete = TRUE ) } @@ -317,7 +317,7 @@ theme_civilytics <- function( #' #' @inheritParams theme_civilytics #' -#' @return A complete ggplot2 [ggplot2::theme()] object. +#' @return A complete ggplot2 [theme()] object. #' @export #' #' @examples @@ -361,20 +361,20 @@ theme_civilytics_dark <- function( # The base theme hardcodes ink_2/ink_3 for subtitle/caption, which are # dark colors meant for light backgrounds. Override with lighter values # so text remains readable on the navy background. - ggplot2::theme( - plot.subtitle = ggplot2::element_text( + theme( + plot.subtitle = element_text( color = unname(civilytics_colors["navy_200"]) ), - plot.caption = ggplot2::element_text( + plot.caption = element_text( color = unname(civilytics_colors["navy_300"]) ), - axis.text = ggplot2::element_text( + axis.text = element_text( color = unname(civilytics_colors["navy_200"]) ), - axis.title.x = ggplot2::element_text( + axis.title.x = element_text( color = unname(civilytics_colors["navy_300"]) ), - axis.title.y = ggplot2::element_text( + axis.title.y = element_text( color = unname(civilytics_colors["navy_300"]) ) ) @@ -389,7 +389,7 @@ theme_civilytics_dark <- function( #' #' @inheritParams theme_civilytics #' -#' @return A complete ggplot2 [ggplot2::theme()] object. +#' @return A complete ggplot2 [theme()] object. #' @export #' #' @examples @@ -430,13 +430,13 @@ theme_civilytics_slide <- function( grid = grid, paper_bg = paper_bg ) + - ggplot2::theme( - axis.line.x = ggplot2::element_line( + theme( + axis.line.x = element_line( color = ink, linewidth = 0.8, lineend = "square" ), - plot.margin = ggplot2::margin(24, 24, 24, 24) + plot.margin = margin(24, 24, 24, 24) ) } @@ -448,23 +448,23 @@ theme_civilytics_slide <- function( #' Strips away axes, ticks, gridlines, and axis titles/labels — the elements #' that are meaningless on a choropleth or spatial plot. #' -#' @return A partial ggplot2 [ggplot2::theme()] object. +#' @return A partial ggplot2 [theme()] object. #' @keywords internal .map_theme_extras <- function() { - ggplot2::theme( - axis.line = ggplot2::element_blank(), - axis.line.x = ggplot2::element_blank(), - axis.line.y = ggplot2::element_blank(), - axis.text = ggplot2::element_blank(), - axis.text.x = ggplot2::element_blank(), - axis.text.y = ggplot2::element_blank(), - axis.ticks = ggplot2::element_blank(), - axis.ticks.length = ggplot2::unit(0, "pt"), - axis.title.x = ggplot2::element_blank(), - axis.title.y = ggplot2::element_blank(), - panel.grid.major.x = ggplot2::element_blank(), - panel.grid.major.y = ggplot2::element_blank(), - panel.grid.minor = ggplot2::element_blank() + theme( + axis.line = element_blank(), + axis.line.x = element_blank(), + axis.line.y = element_blank(), + axis.text = element_blank(), + axis.text.x = element_blank(), + axis.text.y = element_blank(), + axis.ticks = element_blank(), + axis.ticks.length = unit(0, "pt"), + axis.title.x = element_blank(), + axis.title.y = element_blank(), + panel.grid.major.x = element_blank(), + panel.grid.major.y = element_blank(), + panel.grid.minor = element_blank() ) } @@ -478,7 +478,7 @@ theme_civilytics_slide <- function( #' #' @inheritParams theme_civilytics #' -#' @return A complete ggplot2 [ggplot2::theme()] object. +#' @return A complete ggplot2 [theme()] object. #' @export #' #' @examples @@ -530,7 +530,7 @@ theme_civilytics_map <- function( #' #' @inheritParams theme_civilytics_dark #' -#' @return A complete ggplot2 [ggplot2::theme()] object. +#' @return A complete ggplot2 [theme()] object. #' @export #' #' @examples @@ -581,7 +581,7 @@ theme_civilytics_dark_map <- function( #' #' @inheritParams theme_civilytics_slide #' -#' @return A complete ggplot2 [ggplot2::theme()] object. +#' @return A complete ggplot2 [theme()] object. #' @export #' #' @examples diff --git a/tests/testthat.R b/tests/testthat.R index 736bc98..047bb07 100644 --- a/tests/testthat.R +++ b/tests/testthat.R @@ -1,4 +1,4 @@ -library(testthat) -library(civilytics) - -test_check("civilytics") +library(testthat) +library(civilytics) + +test_check("civilytics") \ No newline at end of file diff --git a/tests/testthat/test_utils.R b/tests/testthat/test_utils.R index 9dd4d11..aa675e8 100644 --- a/tests/testthat/test_utils.R +++ b/tests/testthat/test_utils.R @@ -65,7 +65,193 @@ test_that("na_sum quiet=TRUE suppresses the message", { }) +context("Test Utilities - Postcode Lookup") + +# --- postcode_lookup ------------------------------------------------------- + +# Build a lookup that mirrors the internal implementation: +# state.name + "District of Columbia" + "Puerto Rico" +map_name <- c(state.name, "District of Columbia", "Puerto Rico") +map_abb <- c(state.abb, "DC", "PR") + +lookup_ref <- function(x) { + map_abb[match(as.character(x), map_name)] +} + + +test_that("postcode_lookup returns correct abbreviations for known states", { + expect_equal(postcode_lookup("Montana"), lookup_ref("Montana")) + expect_equal(postcode_lookup("Texas"), lookup_ref("Texas")) + expect_equal(postcode_lookup("New York"), lookup_ref("New York")) + expect_equal(postcode_lookup("California"), lookup_ref("California")) +}) + + +test_that("postcode_lookup handles DC and Puerto Rico", { + # These are not in state.name/state.abb but should still resolve. + expect_equal(postcode_lookup("District of Columbia"), "DC") + expect_equal(postcode_lookup("Puerto Rico"), "PR") +}) + + +test_that("postcode_lookup is vectorized", { + states <- c("Montana", "Texas", "California", "Florida") + result <- postcode_lookup(states) + expected <- lookup_ref(states) + expect_equal(result, expected) + expect_length(result, length(states)) +}) + + +test_that("postcode_lookup returns NA for unknown state names", { + # match() returns NA when there is no match; the function propagates it. + result <- postcode_lookup("Atlantis") + expect_true(is.na(unname(result))) +}) + + +test_that("postcode_lookup matches all built-in states", { + # Every entry in state.name should resolve to a valid abbreviation. + results <- postcode_lookup(state.name) + expected <- lookup_ref(state.name) + expect_equal(results, expected) + expect_false(any(is.na(results))) +}) + + +context("Test Utilities - Race Short Names") + +# --- race_short_names ------------------------------------------------------- + +# A reference implementation mirroring the function logic for cross-checking. +race_ref <- function(x) { + x <- as.character(x) + x[x %in% c("Black", "Black Or African American", "Black or African American", + "African American")] <- "black" + x[x %in% c("Hispanic", "Hispanic Or Latino", "Hispanic or Latino")] <- "hisp_lat" + x[x %in% c("White", "white", "White and Not Hispanic")] <- "white" + x[x %in% c("Asian", "Asian American")] <- "asian" + x[x %in% c("Two Or More Races", "Two or More Races")] <- "two_or_more" + x[x %in% c("Native Hawaiian Or Other Pacific Islander", + "Native Hawaiian or Other Pacific Islander", + "Native Hawaiian Pacific Islander")] <- "native_haw" + x[x %in% c("American Indian", "American Indian Or Alaska Native", + "American Indian or Alaska Native", "American Indian or Native Alaskan")] <- "amind" + x[x %in% c("Not Reported")] <- "other" + x +} + + +test_that("race_short_names returns character vector of same length", { + input <- c("Black", "Hispanic Or Latino", "White") + result <- race_short_names(input) + expect_type(result, "character") + expect_length(result, length(input)) +}) + + +test_that("race_short_names maps all known categories correctly", { + # One representative from each category group. + input <- c( + "Black Or African American", + "Hispanic or Latino", + "White and Not Hispanic", + "Asian American", + "Two or More Races", + "Native Hawaiian or Other Pacific Islander", + "American Indian or Alaska Native", + "Not Reported" + ) + + expected <- c( + "black", "hisp_lat", "white", "asian", + "two_or_more", "native_haw", "amind", "other" + ) + + result <- race_short_names(input) + expect_equal(result, expected) +}) + + +test_that("race_short_names coerces factors to character", { + input_factor <- factor(c("Black", "White", "Asian")) + result <- race_short_names(input_factor) + expect_type(result, "character") + expect_equal(result, c("black", "white", "asian")) +}) + + +test_that("race_short_names passes through unrecognized values unchanged", { + input <- c("Black", "Some Other Category", "White") + result <- race_short_names(input) + # Unrecognized category should be returned as-is (lowercased by as.character). + expect_equal(result[2], "Some Other Category") +}) + + +test_that("race_short_names handles empty input", { + result <- race_short_names(character(0)) + expect_length(result, 0) + expect_type(result, "character") +}) + + +test_that("race_short_names matches reference implementation across all categories", +{ + # Exhaustive check: feed every variant string the function handles. + all_variants <- c( + "Black", "Black Or African American", "Black or African American", "African American", + "Hispanic", "Hispanic Or Latino", "Hispanic or Latino", + "White", "white", "White and Not Hispanic", + "Asian", "Asian American", + "Two Or More Races", "Two or More Races", + "Native Hawaiian Or Other Pacific Islander", + "Native Hawaiian or Other Pacific Islander", + "Native Hawaiian Pacific Islander", + "American Indian", "American Indian Or Alaska Native", + "American Indian or Alaska Native", "American Indian or Native Alaskan", + "Not Reported" + ) + + expect_equal(race_short_names(all_variants), race_ref(all_variants)) +}) + + +context("Test Utilities - Get FIPS") + +# --- get_fips --------------------------------------------------------------- + + +test_that("get_fips errors gracefully when tidycensus is not installed", { + # When tidycensus is absent, the function should stop with an informative message. + if (!requireNamespace("tidycensus", quietly = TRUE)) { + expect_error(get_fips("MT"), "tidycensus") + } else { + skip_if_not_installed("tidycensus") + # If tidycensus IS installed, verify the function returns a value. + result <- get_fips("MT") + expect_type(result, "character") + expect_gt(length(result), 0) + } +}) + + +test_that("get_fips returns a FIPS code for a valid state abbreviation", { + skip_if_not_installed("tidycensus") + result <- get_fips("MT") + # Montana's FIPS state code is "30" + expect_equal(result, "30") +}) + + +test_that("get_stabbr returns a valid abbreviation", { + skip_if_not_installed("tidycensus") + result <- get_fips("CA") + # California's FIPS state code is "06" + expect_equal(result, "06") +}) + + context("Test Utilities - Pretty Count") -