Fix ggplot2 imports and polish utility functions for publication
R-CMD-check / R CMD check (push) Successful in 4m17s
R-CMD-check / R CMD check (push) Successful in 4m17s
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.
This commit is contained in:
+1
-1
@@ -3,9 +3,9 @@
|
||||
^\.github$
|
||||
^\.gitea$
|
||||
^README\.Rmd$
|
||||
^NEWS\.md$
|
||||
^Makefile$
|
||||
^Dockerfile$
|
||||
^LICENSE\.md$
|
||||
^\.claude$
|
||||
^\.playwright-mcp$
|
||||
^civilytics-site\.png$
|
||||
|
||||
@@ -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.
|
||||
+7
-7
@@ -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),
|
||||
...
|
||||
)
|
||||
|
||||
@@ -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)))
|
||||
}
|
||||
|
||||
+30
-26
@@ -1,11 +1,14 @@
|
||||
# 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
|
||||
#' @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 nothing, print a summary of match statistics to the console
|
||||
#' @return Invisibly returns `NULL`; prints a formatted summary of match
|
||||
#' statistics to the console via [writeLines()].
|
||||
#' @export
|
||||
#'
|
||||
#' @examples
|
||||
@@ -16,33 +19,34 @@ 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)
|
||||
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)
|
||||
yinx <- sum(y %in% x)
|
||||
total_y <- length(y)
|
||||
pct_y <- round(100 * yinx / total_y, 2)
|
||||
|
||||
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("******************************************")
|
||||
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)
|
||||
}
|
||||
|
||||
@@ -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
|
||||
)
|
||||
|
||||
@@ -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
|
||||
|
||||
+187
-1
@@ -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")
|
||||
|
||||
|
||||
|
||||
|
||||
Reference in New Issue
Block a user