35 changed files with 361 additions and 1733 deletions
+1 -1
View File
@@ -3,9 +3,9 @@
^\.github$ ^\.github$
^\.gitea$ ^\.gitea$
^README\.Rmd$ ^README\.Rmd$
^NEWS\.md$
^Makefile$ ^Makefile$
^Dockerfile$ ^Dockerfile$
^LICENSE\.md$
^\.claude$ ^\.claude$
^\.playwright-mcp$ ^\.playwright-mcp$
^civilytics-site\.png$ ^civilytics-site\.png$
+1 -1
View File
@@ -1,7 +1,7 @@
Package: civilytics Package: civilytics
Type: Package Type: Package
Title: Brand Themes, Color Palettes, and Utility Functions for Civilytics Title: Brand Themes, Color Palettes, and Utility Functions for Civilytics
Version: 0.3.1 Version: 0.2.0
Authors@R: Authors@R:
person("Jared", "E. Knowles", email = "jared@civilytics.com", person("Jared", "E. Knowles", email = "jared@civilytics.com",
role = c("aut", "cre")) role = c("aut", "cre"))
View File
-16
View File
@@ -1,16 +0,0 @@
# 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
View File
@@ -199,7 +199,7 @@ civilytics_palette <- function(name = "qual", n = NULL, reverse = FALSE) {
#' Civilytics palette function (closure) #' Civilytics palette function (closure)
#' #'
#' Returns a closure `function(n)` suitable for passing to #' Returns a closure `function(n)` suitable for passing to
#' [discrete_scale()] or similar scale constructors. #' [ggplot2::discrete_scale()] or similar scale constructors.
#' #'
#' @param name Character. Palette name. See `names(civilytics_palettes)`. #' @param name Character. Palette name. See `names(civilytics_palettes)`.
#' @param reverse Logical. Reverse the palette order. Default `FALSE`. #' @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 palette Character. Palette name. Defaults to `"qual"`.
#' @param discrete Logical. `TRUE` (default) for categorical data; `FALSE` #' @param discrete Logical. `TRUE` (default) for categorical data; `FALSE`
#' for a continuous gradient via [scale_color_gradientn()]. #' for a continuous gradient via [ggplot2::scale_color_gradientn()].
#' @param reverse Logical. Reverse the palette order. Default `FALSE`. #' @param reverse Logical. Reverse the palette order. Default `FALSE`.
#' @param ... Additional arguments passed to the ggplot2 scale function. #' @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, scale_color_civilytics <- function(palette = "qual", discrete = TRUE,
reverse = FALSE, ...) { reverse = FALSE, ...) {
if (discrete) { if (discrete) {
discrete_scale( ggplot2::discrete_scale(
"colour", "colour",
palette = civilytics_pal(palette, reverse = reverse), palette = civilytics_pal(palette, reverse = reverse),
... ...
) )
} else { } else {
pal <- civilytics_palette(palette, reverse = reverse) pal <- civilytics_palette(palette, reverse = reverse)
scale_color_gradientn( ggplot2::scale_color_gradientn(
colours = grDevices::colorRampPalette(pal)(256), 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 palette Character. Palette name. Defaults to `"qual"`.
#' @param discrete Logical. `TRUE` (default) for categorical data; `FALSE` #' @param discrete Logical. `TRUE` (default) for categorical data; `FALSE`
#' for a continuous gradient via [scale_fill_gradientn()]. #' for a continuous gradient via [ggplot2::scale_fill_gradientn()].
#' @param reverse Logical. Reverse the palette order. Default `FALSE`. #' @param reverse Logical. Reverse the palette order. Default `FALSE`.
#' @param ... Additional arguments passed to the ggplot2 scale function. #' @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, scale_fill_civilytics <- function(palette = "qual", discrete = TRUE,
reverse = FALSE, ...) { reverse = FALSE, ...) {
if (discrete) { if (discrete) {
discrete_scale( ggplot2::discrete_scale(
"fill", "fill",
palette = civilytics_pal(palette, reverse = reverse), palette = civilytics_pal(palette, reverse = reverse),
... ...
) )
} else { } else {
pal <- civilytics_palette(palette, reverse = reverse) pal <- civilytics_palette(palette, reverse = reverse)
scale_fill_gradientn( ggplot2::scale_fill_gradientn(
colours = grDevices::colorRampPalette(pal)(256), colours = grDevices::colorRampPalette(pal)(256),
... ...
) )
+4 -10
View File
@@ -19,7 +19,7 @@
#' @return a numeric column of data #' @return a numeric column of data
#' @export #' @export
countCleanr <- function(x){ countCleanr <- function(x){
if ("character" %in% class(x)) { if(class(x) == "character"){
x[x == "None not reported"] <- "0" x[x == "None not reported"] <- "0"
x[x == "Not applicable"] <- NA x[x == "Not applicable"] <- NA
x <- as.numeric(x) x <- as.numeric(x)
@@ -110,14 +110,8 @@ nvals <- function(x){
#' my_string <- c("Happy school", "Easy school", "cool School", "big school") #' my_string <- c("Happy school", "Easy school", "cool School", "big school")
#' simpleCap(my_string) #' simpleCap(my_string)
simpleCap <- function(x) { simpleCap <- function(x) {
stopifnot("character" %in% class(x)) stopifnot(class(x) == "character")
s <- strsplit(x, " ")[[1]]
# Vectorised over elements of x — each element is capitalised independently. paste(toupper(substring(s, 1,1)), substring(s, 2),
# 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 = " ") sep = "", collapse = " ")
}, character(1)))
} }
+11 -24
View File
@@ -5,45 +5,32 @@ CV_FONT_SANS <- "Inter" # axis text, legends, UI elements
CV_FONT_SERIF <- "Source Serif 4" # body prose / editorial long-form CV_FONT_SERIF <- "Source Serif 4" # body prose / editorial long-form
CV_FONT_MONO <- "JetBrains Mono" # code, data tables, numeric callouts CV_FONT_MONO <- "JetBrains Mono" # code, data tables, numeric callouts
# Mutable package state held in an environment so the binding itself stays # Internal flag so civilytics_load_fonts() is idempotent within a session.
# locked (R locks all namespace bindings at load time) while the contents .cv_fonts_loaded <- FALSE
# remain writable. See https://adv-r.hadley.nz/environments.html#environments-as-containers
.cv_state <- new.env(parent = emptyenv())
.cv_state$fonts_loaded <- FALSE
#' Load Civilytics brand fonts #' Load Civilytics brand fonts
#' #'
#' Downloads Inter, Libre Franklin, Source Serif 4 and JetBrains Mono from #' Downloads Inter and Libre Franklin from Google Fonts via
#' Google Fonts via [sysfonts::font_add_google()], then calls #' [sysfonts::font_add_google()], then calls [showtext::showtext_auto()] so
#' [showtext::showtext_auto()] so that all graphics devices render text with #' that all graphics devices render text with those fonts. This is called
#' those fonts. This is called automatically when the package loads; use this #' automatically when the package loads; use this function to retry if the
#' function to retry if the initial load failed (e.g., the machine was offline #' initial load failed (e.g., the machine was offline at load time).
#' at load time).
#' #'
#' Subsequent calls within the same session are no-ops unless `force = TRUE`. #' @return Invisibly returns `NULL`.
#'
#' @param force Logical. If `TRUE`, reload fonts even if they were already
#' loaded in this session. Default `FALSE`.
#'
#' @return Invisibly returns `TRUE` if fonts were loaded, `FALSE` if skipped
#' (already loaded and `force = FALSE`).
#' @export #' @export
#' #'
#' @examples #' @examples
#' \dontrun{ #' \dontrun{
#' civilytics_load_fonts() #' civilytics_load_fonts()
#' } #' }
civilytics_load_fonts <- function(force = FALSE) { civilytics_load_fonts <- function() {
if (.cv_state$fonts_loaded && !force) return(invisible(FALSE))
sysfonts::font_add_google("Inter", family = "Inter") sysfonts::font_add_google("Inter", family = "Inter")
sysfonts::font_add_google("Libre Franklin", family = "Libre Franklin") sysfonts::font_add_google("Libre Franklin", family = "Libre Franklin")
sysfonts::font_add_google("Source Serif 4", family = "Source Serif 4") sysfonts::font_add_google("Source Serif 4", family = "Source Serif 4")
sysfonts::font_add_google("JetBrains Mono", family = "JetBrains Mono") sysfonts::font_add_google("JetBrains Mono", family = "JetBrains Mono")
showtext::showtext_auto() showtext::showtext_auto()
.cv_fonts_loaded <<- TRUE
.cv_state$fonts_loaded <- TRUE invisible(NULL)
invisible(TRUE)
} }
.onLoad <- function(libname, pkgname) { .onLoad <- function(libname, pkgname) {
+22 -26
View File
@@ -1,14 +1,11 @@
# Join utilities # Join utilities
#' Test the join between two sets of identifiers #' Test the join between two sets of identifiers
#' #'
#' @param x A vector of identifiers to check against `y`. #' @param x a vector of identifiers to check against y
#' @param y A vector of identifiers to look for a match in. #' @param y a vector of identifiers to check against x
#' @param distinct Logical. Should duplicate values of `x` and `y` be removed #' @param distinct logical, should duplicate values of x and y be removed before testing
#' before testing? Default is `TRUE`.
#' #'
#' @return Invisibly returns `NULL`; prints a formatted summary of match #' @return nothing, print a summary of match statistics to the console
#' statistics to the console via [writeLines()].
#' @export #' @export
#' #'
#' @examples #' @examples
@@ -19,34 +16,33 @@ match_test <- function(x, y, distinct = TRUE) {
if (distinct) { if (distinct) {
x <- unique(x) x <- unique(x)
y <- unique(y) y <- unique(y)
cat("**** Distinct Matches ****")
cat("\n")
} }
# TODO: DO not report 100% if there is even 1 mismatch # TODO: DO not report 100% if there is even 1 mismatch
xiny <- sum(x %in% y) xiny <- sum(x %in% y)
total_x <- length(x) total_x <- length(x)
pct_x <- round(100 * xiny / total_x, 2)
yinx <- sum(y %in% x) yinx <- sum(y %in% x)
total_y <- length(y) total_y <- length(y)
pct_y <- round(100 * yinx / total_y, 2)
header <- if (distinct) "Distinct Matches" else "All Values" 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("******************************************")
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)
} }
+10 -11
View File
@@ -10,8 +10,7 @@
#' @importFrom graphics rasterImage #' @importFrom graphics rasterImage
#' @examples #' @examples
#' \dontrun{ #' \dontrun{
#' # Supply a path to your own JPEG file #' img <- system.file("img","Knowles_Headshot_2019_good.jpg",package="civilytics")
#' img <- "my_photo.jpg"
#' plot_jpeg(img) #' plot_jpeg(img)
#' } #' }
plot_jpeg <- function(path, add=FALSE, upscale = TRUE) plot_jpeg <- function(path, add=FALSE, upscale = TRUE)
@@ -75,8 +74,8 @@ add_logo <- function(plot, logo, margin_param = NULL, font_scale = 1.1,
# element cascades to titles, axis labels, legends, captions, and strips. # element cascades to titles, axis labels, legends, captions, and strips.
if (!is.null(font_scale) && font_scale != 1) { if (!is.null(font_scale) && font_scale != 1) {
base_size <- plot$theme$text$size %||% 14 base_size <- plot$theme$text$size %||% 14
plot <- plot + theme( plot <- plot + ggplot2::theme(
text = element_text(size = base_size * font_scale) text = ggplot2::element_text(size = base_size * font_scale)
) )
} }
@@ -126,7 +125,7 @@ add_logo <- function(plot, logo, margin_param = NULL, font_scale = 1.1,
#' @export #' @export
#' #'
#' @examples #' @examples
#' p1 <- ggplot(mtcars, aes(mpg, wt)) + geom_point() #' p1 <- ggplot2::ggplot(mtcars, ggplot2::aes(mpg, wt)) + ggplot2::geom_point()
#' measure_caption(p1) # Should equal 1 since no caption is present #' measure_caption(p1) # Should equal 1 since no caption is present
measure_caption <- function(gg) { measure_caption <- function(gg) {
if (has_caption(gg)) { if (has_caption(gg)) {
@@ -146,7 +145,7 @@ measure_caption <- function(gg) {
#' @export #' @export
#' #'
#' @examples #' @examples
#' p1 <- ggplot(mtcars, aes(mpg, wt)) + geom_point() #' p1 <- ggplot2::ggplot(mtcars, ggplot2::aes(mpg, wt)) + ggplot2::geom_point()
#' has_caption(p1) # FALSE #' has_caption(p1) # FALSE
has_caption <- function(gg) { has_caption <- function(gg) {
any(names(gg$labels) == "caption") any(names(gg$labels) == "caption")
@@ -187,8 +186,8 @@ add_logo_ga <- function(plot_list, logo, nrow = 1, widths = NULL,
if (!is.null(font_scale) && font_scale != 1) { if (!is.null(font_scale) && font_scale != 1) {
plot_list <- lapply(plot_list, function(p) { plot_list <- lapply(plot_list, function(p) {
base_size <- p$theme$text$size %||% 14 base_size <- p$theme$text$size %||% 14
p + theme( p + ggplot2::theme(
text = element_text(size = base_size * font_scale) text = ggplot2::element_text(size = base_size * font_scale)
) )
}) })
} }
@@ -276,9 +275,9 @@ make_logo_grob <- function(type = c("wordmark", "mark"),
xmax <- 1 xmax <- 1
} }
ggplot() + ggplot2::ggplot() +
theme_void() + ggplot2::theme_void() +
annotation_custom( ggplot2::annotation_custom(
get_png(system.file("img", img_file, package = "civilytics")), get_png(system.file("img", img_file, package = "civilytics")),
xmin = xmin, xmax = xmax xmin = xmin, xmax = xmax
) )
+7 -9
View File
@@ -135,12 +135,12 @@ use_civilytics_theme <- function(path = ".", force = FALSE) {
.copy_pkg_file(file.path("quarto/latex", f), file.path("latex", f), path, force) .copy_pkg_file(file.path("quarto/latex", f), file.path("latex", f), path, force)
} }
# Typst — shipped as template-partials so Quarto keeps its Skylighting # Typst
# definitions and syntax-highlighted code blocks render (see issue #12) .copy_pkg_file(
typst_files <- c("typst-template.typ", "typst-show.typ") "quarto/typst/civilytics-typst.typ",
for (f in typst_files) { "typst/civilytics-typst.typ",
.copy_pkg_file(file.path("quarto/typst", f), file.path("typst", f), path, force) path, force
} )
# Logos — for _brand.yml (expects assets/logo/) # Logos — for _brand.yml (expects assets/logo/)
.copy_logos("assets/logo", path, force) .copy_logos("assets/logo", path, force)
@@ -158,9 +158,7 @@ use_civilytics_theme <- function(path = ".", force = FALSE) {
message(" include-in-header: latex/civilytics.tex") message(" include-in-header: latex/civilytics.tex")
message(" include-before-body: latex/civilytics-title.tex") message(" include-before-body: latex/civilytics-title.tex")
message(" typst:") message(" typst:")
message(" template-partials:") message(" template: typst/civilytics-typst.typ")
message(" - typst/typst-template.typ")
message(" - typst/typst-show.typ")
message("---") message("---")
message("\nSee examples/report.qmd for a complete example.") message("\nSee examples/report.qmd for a complete example.")
invisible(NULL) invisible(NULL)
+110 -112
View File
@@ -1,6 +1,6 @@
#' Civilytics ggplot2 theme #' Civilytics ggplot2 theme
#' #'
#' A complete ggplot2 theme built on [theme_grey()] using the #' A complete ggplot2 theme built on [ggplot2::theme_grey()] using the
#' Civilytics brand color palette and typography. Requires ggplot2 >= 4.0.0 #' Civilytics brand color palette and typography. Requires ggplot2 >= 4.0.0
#' for the `ink`, `paper`, and `accent` base-theme parameters. #' for the `ink`, `paper`, and `accent` base-theme parameters.
#' #'
@@ -36,12 +36,10 @@
#' to [civilytics_colors]`["paper_2"]` (`#F2EDE4`). #' to [civilytics_colors]`["paper_2"]` (`#F2EDE4`).
#' @param grid Character. Which major gridlines to draw: `"y"` (default, #' @param grid Character. Which major gridlines to draw: `"y"` (default,
#' horizontal only), `"x"` (vertical only), `"both"`, or `"none"`. #' horizontal only), `"x"` (vertical only), `"both"`, or `"none"`.
#' @param paper_bg Logical. If `TRUE`, fill the plot and panel backgrounds #' @param paper_bg Logical. If `TRUE` (default), fill the plot and panel
#' with the warm `paper` color (Civilytics cream). Default is `FALSE` #' backgrounds with the warm `paper` color. Set to `FALSE` for a
#' (transparent) so that figures composite cleanly onto any background. #' transparent background (useful for slides or overlay on colored
#' Set to `TRUE` for the branded cream canvas. Note: a transparent device #' surfaces).
#' background (e.g., `dev = "ragg_png"`, `dev.args = list(background =
#' "transparent")`) is also needed for fully-transparent PNG exports.
#' #'
#' @section Font size hierarchy: #' @section Font size hierarchy:
#' All text sizes are derived from `font_size` using relative scale factors. #' All text sizes are derived from `font_size` using relative scale factors.
@@ -63,14 +61,14 @@
#' logo below the plot, pass `font_scale` to compensate for viewport #' logo below the plot, pass `font_scale` to compensate for viewport
#' shrinkage. #' shrinkage.
#' #'
#' @return A complete ggplot2 [theme()] object. #' @return A complete ggplot2 [ggplot2::theme()] object.
#' @export #' @export
#' #'
#' @examples #' @examples
#' \dontrun{ #' \dontrun{
#' library(ggplot2) #' library(ggplot2)
#' #'
#' # Default — transparent background for embedding #' # Default editorial theme
#' ggplot(mpg, aes(displ, hwy)) + #' ggplot(mpg, aes(displ, hwy)) +
#' geom_point() + #' geom_point() +
#' theme_civilytics() #' theme_civilytics()
@@ -81,10 +79,10 @@
#' scale_color_civilytics() + #' scale_color_civilytics() +
#' theme_civilytics(grid = "both") #' theme_civilytics(grid = "both")
#' #'
#' # Branded cream background (opt-in) #' # Transparent background for embedding
#' ggplot(mpg, aes(displ, hwy)) + #' ggplot(mpg, aes(displ, hwy)) +
#' geom_point() + #' geom_point() +
#' theme_civilytics(paper_bg = TRUE) #' theme_civilytics(paper_bg = FALSE)
#' #'
#' # Larger text for poster or display #' # Larger text for poster or display
#' ggplot(mpg, aes(displ, hwy)) + #' ggplot(mpg, aes(displ, hwy)) +
@@ -104,7 +102,7 @@ theme_civilytics <- function(
accent = unname(civilytics_colors["ember_600"]), accent = unname(civilytics_colors["ember_600"]),
strip_color = unname(civilytics_colors["paper_2"]), strip_color = unname(civilytics_colors["paper_2"]),
grid = c("y", "x", "both", "none"), grid = c("y", "x", "both", "none"),
paper_bg = FALSE) { paper_bg = TRUE) {
grid <- match.arg(grid) grid <- match.arg(grid)
half_line <- font_size / 2 half_line <- font_size / 2
@@ -115,30 +113,30 @@ theme_civilytics <- function(
bg_color <- if (isTRUE(paper_bg)) paper else NA bg_color <- if (isTRUE(paper_bg)) paper else NA
# Grid line elements # Grid line elements
grid_line <- element_line(color = rule_color, linewidth = 0.35) grid_line <- ggplot2::element_line(color = rule_color, linewidth = 0.35)
no_line <- element_blank() no_line <- ggplot2::element_blank()
theme_grey( ggplot2::theme_grey(
base_size = font_size, base_size = font_size,
base_family = font_family, base_family = font_family,
ink = ink, ink = ink,
paper = paper, paper = paper,
accent = accent accent = accent
) %+replace% ) %+replace%
theme( ggplot2::theme(
line = element_line( line = ggplot2::element_line(
color = ink, color = ink,
linewidth = line_size, linewidth = line_size,
linetype = 1, linetype = 1,
lineend = "butt" lineend = "butt"
), ),
rect = element_rect( rect = ggplot2::element_rect(
fill = NA, fill = NA,
color = NA, color = NA,
linewidth = line_size, linewidth = line_size,
linetype = 1 linetype = 1
), ),
text = element_text( text = ggplot2::element_text(
family = font_family, family = font_family,
face = "plain", face = "plain",
color = ink, color = ink,
@@ -147,161 +145,161 @@ theme_civilytics <- function(
vjust = 0.5, vjust = 0.5,
angle = 0, angle = 0,
lineheight = 0.9, lineheight = 0.9,
margin = margin(), margin = ggplot2::margin(),
debug = FALSE debug = FALSE
), ),
# -- Axes -- # -- Axes --
axis.line = element_blank(), axis.line = ggplot2::element_blank(),
axis.line.x = element_line( axis.line.x = ggplot2::element_line(
color = ink, color = ink,
linewidth = 0.6, linewidth = 0.6,
lineend = "square" lineend = "square"
), ),
axis.line.y = element_blank(), axis.line.y = ggplot2::element_blank(),
axis.text = element_text( axis.text = ggplot2::element_text(
color = ink_2, color = ink_2,
size = rel(rel_small) size = ggplot2::rel(rel_small)
), ),
axis.text.x = element_text( axis.text.x = ggplot2::element_text(
margin = margin(t = small_size / 4), margin = ggplot2::margin(t = small_size / 4),
vjust = 1 vjust = 1
), ),
axis.text.x.top = element_text( axis.text.x.top = ggplot2::element_text(
margin = margin(b = small_size / 4), margin = ggplot2::margin(b = small_size / 4),
vjust = 0 vjust = 0
), ),
axis.text.y = element_text( axis.text.y = ggplot2::element_text(
margin = margin(r = small_size / 4), margin = ggplot2::margin(r = small_size / 4),
hjust = 1 hjust = 1
), ),
axis.text.y.right = element_text( axis.text.y.right = ggplot2::element_text(
margin = margin(l = small_size / 4), margin = ggplot2::margin(l = small_size / 4),
hjust = 0 hjust = 0
), ),
axis.ticks = element_line( axis.ticks = ggplot2::element_line(
color = ink_3, color = ink_3,
linewidth = 0.4 linewidth = 0.4
), ),
axis.ticks.length = unit(4, "pt"), axis.ticks.length = ggplot2::unit(4, "pt"),
axis.title.x = element_text( axis.title.x = ggplot2::element_text(
size = rel(rel_small), size = ggplot2::rel(rel_small),
color = ink_3, color = ink_3,
margin = margin(t = 10), margin = ggplot2::margin(t = 10),
vjust = 1 vjust = 1
), ),
axis.title.x.top = element_text( axis.title.x.top = ggplot2::element_text(
size = rel(rel_small), size = ggplot2::rel(rel_small),
color = ink_3, color = ink_3,
margin = margin(b = half_line / 2), margin = ggplot2::margin(b = half_line / 2),
vjust = 0 vjust = 0
), ),
axis.title.y = element_text( axis.title.y = ggplot2::element_text(
size = rel(rel_small), size = ggplot2::rel(rel_small),
color = ink_3, color = ink_3,
angle = 90, angle = 90,
margin = margin(r = 10), margin = ggplot2::margin(r = 10),
vjust = 1 vjust = 1
), ),
axis.title.y.right = element_text( axis.title.y.right = ggplot2::element_text(
size = rel(rel_small), size = ggplot2::rel(rel_small),
color = ink_3, color = ink_3,
angle = -90, angle = -90,
margin = margin(l = half_line / 2), margin = ggplot2::margin(l = half_line / 2),
vjust = 0 vjust = 0
), ),
# -- Legend -- # -- Legend --
legend.background = element_blank(), legend.background = ggplot2::element_blank(),
legend.spacing = unit(font_size, "pt"), legend.spacing = ggplot2::unit(font_size, "pt"),
legend.spacing.x = NULL, legend.spacing.x = NULL,
legend.spacing.y = NULL, legend.spacing.y = NULL,
legend.margin = margin(0, 0, 4, 0), legend.margin = ggplot2::margin(0, 0, 4, 0),
legend.key = element_blank(), legend.key = ggplot2::element_blank(),
legend.key.size = unit(12, "pt"), legend.key.size = ggplot2::unit(12, "pt"),
legend.key.height = NULL, legend.key.height = NULL,
legend.key.width = NULL, legend.key.width = NULL,
legend.text = element_text( legend.text = ggplot2::element_text(
size = rel(rel_small), size = ggplot2::rel(rel_small),
color = ink_2 color = ink_2
), ),
legend.title = element_text( legend.title = ggplot2::element_text(
hjust = 0, hjust = 0,
face = "bold", face = "bold",
size = rel(rel_tiny), size = ggplot2::rel(rel_tiny),
color = ink_3 color = ink_3
), ),
legend.position = "top", legend.position = "top",
legend.direction = NULL, legend.direction = NULL,
legend.justification = c("left", "center"), legend.justification = c("left", "center"),
legend.box = NULL, legend.box = NULL,
legend.box.margin = margin(0, 0, 0, 0), legend.box.margin = ggplot2::margin(0, 0, 0, 0),
legend.box.background = element_blank(), legend.box.background = ggplot2::element_blank(),
legend.box.spacing = unit(font_size, "pt"), legend.box.spacing = ggplot2::unit(font_size, "pt"),
# -- Panel -- # -- Panel --
panel.background = element_rect(fill = bg_color, color = NA), panel.background = ggplot2::element_rect(fill = bg_color, color = NA),
panel.border = element_blank(), panel.border = ggplot2::element_blank(),
panel.grid.minor = element_blank(), panel.grid.minor = ggplot2::element_blank(),
panel.grid.major.x = if (grid %in% c("x", "both")) grid_line else no_line, 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.grid.major.y = if (grid %in% c("y", "both")) grid_line else no_line,
panel.spacing = unit(16, "pt"), panel.spacing = ggplot2::unit(16, "pt"),
panel.spacing.x = NULL, panel.spacing.x = NULL,
panel.spacing.y = NULL, panel.spacing.y = NULL,
panel.ontop = FALSE, panel.ontop = FALSE,
# -- Facet strips -- # -- Facet strips --
strip.background = element_rect(fill = strip_color, color = NA), strip.background = ggplot2::element_rect(fill = strip_color, color = NA),
strip.text = element_text( strip.text = ggplot2::element_text(
family = font_family, family = font_family,
face = "bold", face = "bold",
size = rel(rel_small), size = ggplot2::rel(rel_small),
color = ink, color = ink,
margin = margin( margin = ggplot2::margin(
half_line / 2, half_line / 2, half_line / 2, half_line / 2,
half_line / 2, half_line / 2 half_line / 2, half_line / 2
) )
), ),
strip.text.x = NULL, strip.text.x = NULL,
strip.text.y = element_text(angle = -90), strip.text.y = ggplot2::element_text(angle = -90),
strip.placement = "inside", strip.placement = "inside",
strip.placement.x = NULL, strip.placement.x = NULL,
strip.placement.y = NULL, strip.placement.y = NULL,
strip.switch.pad.grid = unit(half_line / 2, "pt"), strip.switch.pad.grid = ggplot2::unit(half_line / 2, "pt"),
strip.switch.pad.wrap = unit(half_line / 2, "pt"), strip.switch.pad.wrap = ggplot2::unit(half_line / 2, "pt"),
# -- Plot-level -- # -- Plot-level --
plot.background = element_rect(fill = bg_color, color = NA), plot.background = ggplot2::element_rect(fill = bg_color, color = NA),
plot.title = element_text( plot.title = ggplot2::element_text(
family = title_family, family = title_family,
face = "bold", face = "bold",
size = rel(rel_large), size = ggplot2::rel(rel_large),
hjust = 0, hjust = 0,
vjust = 1, vjust = 1,
margin = margin(b = 4) margin = ggplot2::margin(b = 4)
), ),
plot.title.position = "plot", plot.title.position = "plot",
plot.subtitle = element_text( plot.subtitle = ggplot2::element_text(
size = rel(1), size = ggplot2::rel(1),
color = ink_2, color = ink_2,
hjust = 0, hjust = 0,
vjust = 1, vjust = 1,
lineheight = 1.3, lineheight = 1.3,
margin = margin(b = 14) margin = ggplot2::margin(b = 14)
), ),
plot.caption = element_text( plot.caption = ggplot2::element_text(
size = rel(rel_tiny), size = ggplot2::rel(rel_tiny),
color = ink_3, color = ink_3,
hjust = 0, hjust = 0,
vjust = 1, vjust = 1,
lineheight = 1.3, lineheight = 1.3,
margin = margin(t = 14) margin = ggplot2::margin(t = 14)
), ),
plot.caption.position = "plot", plot.caption.position = "plot",
plot.tag = element_text( plot.tag = ggplot2::element_text(
face = "bold", face = "bold",
color = accent, color = accent,
size = rel(rel_tiny), size = ggplot2::rel(rel_tiny),
hjust = 0, hjust = 0,
vjust = 0.7 vjust = 0.7
), ),
plot.tag.position = c(0, 1), plot.tag.position = c(0, 1),
plot.margin = margin(16, 18, 16, 16), plot.margin = ggplot2::margin(16, 18, 16, 16),
complete = TRUE complete = TRUE
) )
} }
@@ -317,7 +315,7 @@ theme_civilytics <- function(
#' #'
#' @inheritParams theme_civilytics #' @inheritParams theme_civilytics
#' #'
#' @return A complete ggplot2 [theme()] object. #' @return A complete ggplot2 [ggplot2::theme()] object.
#' @export #' @export
#' #'
#' @examples #' @examples
@@ -361,20 +359,20 @@ theme_civilytics_dark <- function(
# The base theme hardcodes ink_2/ink_3 for subtitle/caption, which are # The base theme hardcodes ink_2/ink_3 for subtitle/caption, which are
# dark colors meant for light backgrounds. Override with lighter values # dark colors meant for light backgrounds. Override with lighter values
# so text remains readable on the navy background. # so text remains readable on the navy background.
theme( ggplot2::theme(
plot.subtitle = element_text( plot.subtitle = ggplot2::element_text(
color = unname(civilytics_colors["navy_200"]) color = unname(civilytics_colors["navy_200"])
), ),
plot.caption = element_text( plot.caption = ggplot2::element_text(
color = unname(civilytics_colors["navy_300"]) color = unname(civilytics_colors["navy_300"])
), ),
axis.text = element_text( axis.text = ggplot2::element_text(
color = unname(civilytics_colors["navy_200"]) color = unname(civilytics_colors["navy_200"])
), ),
axis.title.x = element_text( axis.title.x = ggplot2::element_text(
color = unname(civilytics_colors["navy_300"]) color = unname(civilytics_colors["navy_300"])
), ),
axis.title.y = element_text( axis.title.y = ggplot2::element_text(
color = unname(civilytics_colors["navy_300"]) color = unname(civilytics_colors["navy_300"])
) )
) )
@@ -389,7 +387,7 @@ theme_civilytics_dark <- function(
#' #'
#' @inheritParams theme_civilytics #' @inheritParams theme_civilytics
#' #'
#' @return A complete ggplot2 [theme()] object. #' @return A complete ggplot2 [ggplot2::theme()] object.
#' @export #' @export
#' #'
#' @examples #' @examples
@@ -430,13 +428,13 @@ theme_civilytics_slide <- function(
grid = grid, grid = grid,
paper_bg = paper_bg paper_bg = paper_bg
) + ) +
theme( ggplot2::theme(
axis.line.x = element_line( axis.line.x = ggplot2::element_line(
color = ink, color = ink,
linewidth = 0.8, linewidth = 0.8,
lineend = "square" lineend = "square"
), ),
plot.margin = margin(24, 24, 24, 24) plot.margin = ggplot2::margin(24, 24, 24, 24)
) )
} }
@@ -448,23 +446,23 @@ theme_civilytics_slide <- function(
#' Strips away axes, ticks, gridlines, and axis titles/labels — the elements #' Strips away axes, ticks, gridlines, and axis titles/labels — the elements
#' that are meaningless on a choropleth or spatial plot. #' that are meaningless on a choropleth or spatial plot.
#' #'
#' @return A partial ggplot2 [theme()] object. #' @return A partial ggplot2 [ggplot2::theme()] object.
#' @keywords internal #' @keywords internal
.map_theme_extras <- function() { .map_theme_extras <- function() {
theme( ggplot2::theme(
axis.line = element_blank(), axis.line = ggplot2::element_blank(),
axis.line.x = element_blank(), axis.line.x = ggplot2::element_blank(),
axis.line.y = element_blank(), axis.line.y = ggplot2::element_blank(),
axis.text = element_blank(), axis.text = ggplot2::element_blank(),
axis.text.x = element_blank(), axis.text.x = ggplot2::element_blank(),
axis.text.y = element_blank(), axis.text.y = ggplot2::element_blank(),
axis.ticks = element_blank(), axis.ticks = ggplot2::element_blank(),
axis.ticks.length = unit(0, "pt"), axis.ticks.length = ggplot2::unit(0, "pt"),
axis.title.x = element_blank(), axis.title.x = ggplot2::element_blank(),
axis.title.y = element_blank(), axis.title.y = ggplot2::element_blank(),
panel.grid.major.x = element_blank(), panel.grid.major.x = ggplot2::element_blank(),
panel.grid.major.y = element_blank(), panel.grid.major.y = ggplot2::element_blank(),
panel.grid.minor = element_blank() panel.grid.minor = ggplot2::element_blank()
) )
} }
@@ -478,7 +476,7 @@ theme_civilytics_slide <- function(
#' #'
#' @inheritParams theme_civilytics #' @inheritParams theme_civilytics
#' #'
#' @return A complete ggplot2 [theme()] object. #' @return A complete ggplot2 [ggplot2::theme()] object.
#' @export #' @export
#' #'
#' @examples #' @examples
@@ -530,7 +528,7 @@ theme_civilytics_map <- function(
#' #'
#' @inheritParams theme_civilytics_dark #' @inheritParams theme_civilytics_dark
#' #'
#' @return A complete ggplot2 [theme()] object. #' @return A complete ggplot2 [ggplot2::theme()] object.
#' @export #' @export
#' #'
#' @examples #' @examples
@@ -581,7 +579,7 @@ theme_civilytics_dark_map <- function(
#' #'
#' @inheritParams theme_civilytics_slide #' @inheritParams theme_civilytics_slide
#' #'
#' @return A complete ggplot2 [theme()] object. #' @return A complete ggplot2 [ggplot2::theme()] object.
#' @export #' @export
#' #'
#' @examples #' @examples
-866
View File
File diff suppressed because one or more lines are too long
Binary file not shown.

Before

Width:  |  Height:  |  Size: 682 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 3.2 MiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 321 KiB

+2 -4
View File
@@ -2,7 +2,7 @@
title: "Who pays when rent outpaces wages?" title: "Who pays when rent outpaces wages?"
subtitle: "A 12-county analysis of cost-burdened renter households, 2019–2024." subtitle: "A 12-county analysis of cost-burdened renter households, 2019–2024."
author: author:
- name: "Jared Knowles" - name: "Civilytics Research"
affiliation: "Civilytics Consulting" affiliation: "Civilytics Consulting"
date: "2026-04-15" date: "2026-04-15"
abstract: | abstract: |
@@ -19,9 +19,7 @@ format:
toc: true toc: true
toc-location: right toc-location: right
typst: typst:
template-partials: template: ../typst/civilytics-typst.typ
- ../typst/typst-template.typ
- ../typst/typst-show.typ
pdf: pdf:
include-in-header: ../latex/civilytics.tex include-in-header: ../latex/civilytics.tex
include-before-body: ../latex/civilytics-title.tex include-before-body: ../latex/civilytics-title.tex
+2 -2
View File
@@ -55,11 +55,11 @@ Big idea goes here.
> Rent has outpaced wages in every county we studied. > Rent has outpaced wages in every county we studied.
Civilytics Consulting, 2026 Civilytics Research, 2026
## Thank you {.thank-you} ## Thank you {.thank-you}
Questions? Questions?
- jared@civilytics.com - jared@civilytics.com
- civilytics.com - civilytics.consulting
+3 -6
View File
@@ -2,16 +2,11 @@
% Replaces Quarto's default \maketitle. Uses values from YAML % Replaces Quarto's default \maketitle. Uses values from YAML
% (\thetitle, \theauthor, \thedate) plus an \ifabstract block. % (\thetitle, \theauthor, \thedate) plus an \ifabstract block.
% Guard: \thesubtitle is normally defined by civilytics.tex's subtitle
% capture; provide a fallback so this partial degrades gracefully if used
% without that preamble. See civilyticsR issue #13.
\providecommand{\thesubtitle}{}
\begin{titlepage} \begin{titlepage}
\pagecolor{paper} \pagecolor{paper}
\color{ink} \color{ink}
\vspace*{0.5in} \vspace*{0.5in}
{\sffamily\bfseries\scriptsize\color{ember}\MakeUppercase{— Civilytics Consulting}\par} {\sffamily\bfseries\scriptsize\color{ember}\MakeUppercase{— Civilytics Research}\par}
\vspace{12pt} \vspace{12pt}
{\displayfont\fontsize{32pt}{34pt}\selectfont\bfseries\color{ink}\thetitle\par} {\displayfont\fontsize{32pt}{34pt}\selectfont\bfseries\color{ink}\thetitle\par}
\vspace{8pt} \vspace{8pt}
@@ -38,6 +33,8 @@
% Pulse mark, in ember % Pulse mark, in ember
\begin{center} \begin{center}
\begin{tikzpicture}[overlay, remember picture]
\end{tikzpicture}
{\color{ember}\rule{40pt}{2pt}} {\color{ember}\rule{40pt}{2pt}}
\end{center} \end{center}
\end{titlepage} \end{titlepage}
+3 -26
View File
@@ -40,40 +40,17 @@
\color{ink} \color{ink}
% --- Fonts (require local install or fontspec lookup) --- % --- Fonts (require local install or fontspec lookup) ---
% Bold uses the family's native Bold weight (present in every Source Serif 4
% install). Do NOT hard-require a "SemiBold" face: the package installs no
% system fonts for the PDF path, and standard Source Serif 4 ships only
% Regular/Bold/Italic/BoldItalic. See civilyticsR issue #14.
\setmainfont{Source Serif 4}[ \setmainfont{Source Serif 4}[
UprightFont = *, UprightFont = *,
ItalicFont = * Italic, ItalicFont = * Italic,
BoldFont = * SemiBold,
BoldItalicFont = * SemiBold Italic,
Ligatures = TeX, Ligatures = TeX,
] ]
\setsansfont{Inter}[Ligatures = TeX] \setsansfont{Inter}[Ligatures = TeX]
\setmonofont{JetBrains Mono}[Scale = 0.92] \setmonofont{JetBrains Mono}[Scale = 0.92]
\newfontfamily\displayfont{Libre Franklin}[Ligatures = TeX] \newfontfamily\displayfont{Libre Franklin}[Ligatures = TeX]
% --- Subtitle capture ---
% Quarto/pandoc defines \subtitle (which appends to \@title) but never
% \thesubtitle, which the title page uses. This preamble is emitted before
% pandoc's \providecommand{\subtitle}, so our definition wins: capture the
% subtitle into \thesubtitle instead. See civilyticsR issue #13.
\makeatletter
\providecommand{\thesubtitle}{}
\def\subtitle#1{\renewcommand{\thesubtitle}{#1}}
\makeatother
% --- Use the Civilytics title page, not pandoc's default ---
% civilytics-title.tex (include-before-body) IS the title page. Quarto emits
% its default \maketitle + abstract *before* include-before-body, which would
% print a second, unstyled title. Neutralise both here, in the preamble
% (runs at \begin{document}, before the default title). The branded title page
% does not display the abstract. See civilyticsR issue #13.
\AtBeginDocument{%
\renewcommand{\maketitle}{}%
\renewenvironment{abstract}{\setbox0=\vbox\bgroup}{\egroup}%
}
% --- Hyperlinks --- % --- Hyperlinks ---
\hypersetup{ \hypersetup{
colorlinks = true, colorlinks = true,
@@ -100,7 +77,7 @@
\renewcommand{\footrulewidth}{0pt} \renewcommand{\footrulewidth}{0pt}
\fancyhead[L]{\sffamily\scriptsize\color{ink3}\MakeUppercase{Civilytics Consulting}} \fancyhead[L]{\sffamily\scriptsize\color{ink3}\MakeUppercase{Civilytics Consulting}}
\fancyhead[R]{\sffamily\scriptsize\color{ink3}\thetitle} \fancyhead[R]{\sffamily\scriptsize\color{ink3}\thetitle}
\fancyfoot[L]{\sffamily\scriptsize\color{ink3}civilytics.com} \fancyfoot[L]{\sffamily\scriptsize\color{ink3}civilytics.consulting}
\fancyfoot[C]{\sffamily\scriptsize\color{ink3}\thepage} \fancyfoot[C]{\sffamily\scriptsize\color{ink3}\thepage}
\fancyfoot[R]{\sffamily\scriptsize\color{ink3}\textcopyright\ 2026} \fancyfoot[R]{\sffamily\scriptsize\color{ink3}\textcopyright\ 2026}
@@ -1,15 +1,9 @@
// ============================================================= // =============================================================
// Civilytics — Typst template partial for Quarto PDF (typst-template.typ). // Civilytics — Typst template for Quarto PDF
// Shipped as a Quarto template-partial (paired with typst-show.typ) rather
// than a full `template:` so Quarto keeps its own `definitions` partial —
// which defines Skylighting/token functions needed for syntax-highlighted
// code blocks. See civilyticsR issue #12.
// Usage in YAML: // Usage in YAML:
// format: // format:
// typst: // typst:
// template-partials: // template: quarto/typst/civilytics-typst.typ
// - quarto/typst/typst-template.typ
// - quarto/typst/typst-show.typ
// ============================================================= // =============================================================
#let paper-bg = rgb("#FAF7F2") #let paper-bg = rgb("#FAF7F2")
@@ -60,7 +54,7 @@
grid( grid(
columns: (1fr, auto, 1fr), columns: (1fr, auto, 1fr),
align: (left, center, right), align: (left, center, right),
[civilytics.com], [civilytics.consulting],
counter(page).display("1 / 1", both: true), counter(page).display("1 / 1", both: true),
[© 2026] [© 2026]
) )
@@ -164,7 +158,7 @@
if title != none { if title != none {
block[ block[
#set text(font: sans-stack, size: 8pt, weight: 600, fill: ember, tracking: 0.1em) #set text(font: sans-stack, size: 8pt, weight: 600, fill: ember, tracking: 0.1em)
#upper[— Civilytics Consulting] #upper[— Civilytics Research]
] ]
v(8pt) v(8pt)
block[ block[
@@ -235,3 +229,16 @@
doc doc
} }
// Quarto entry point
#show: doc => civilytics(
title: $title$,
$if(subtitle)$subtitle: $subtitle$,$endif$
$if(by-author)$authors: ($for(by-author)$"$it.name.literal$",$endfor$),$endif$
$if(date)$date: $date$,$endif$
$if(abstract)$abstract: [$abstract$],$endif$
toc: $if(toc)$true$else$false$endif$,
doc
)
$body$
-17
View File
@@ -1,17 +0,0 @@
// Civilytics — Typst show/entry partial for Quarto (typst-show.typ).
// Pairs with typst-template.typ. Quarto appends the rendered document body
// after this partial, so this file intentionally ends with the show rule and
// no trailing body token. (Do not write that token in a comment here: Quarto
// interpolates its template variables even inside comments.)
// Title/subtitle/date are wrapped in [ ] so arbitrary text (including words
// that are Typst keywords like "for"/"in") is treated as content, not code.
// See civilyticsR issue #12.
#show: doc => civilytics(
title: [$title$],
$if(subtitle)$subtitle: [$subtitle$],$endif$
$if(by-author)$authors: ($for(by-author)$"$it.name.literal$",$endfor$),$endif$
$if(date)$date: [$date$],$endif$
$if(abstract)$abstract: [$abstract$],$endif$
toc: $if(toc)$true$else$false$endif$,
doc
)
+7 -15
View File
@@ -4,25 +4,17 @@
\alias{civilytics_load_fonts} \alias{civilytics_load_fonts}
\title{Load Civilytics brand fonts} \title{Load Civilytics brand fonts}
\usage{ \usage{
civilytics_load_fonts(force = FALSE) civilytics_load_fonts()
}
\arguments{
\item{force}{Logical. If \code{TRUE}, reload fonts even if they were already
loaded in this session. Default \code{FALSE}.}
} }
\value{ \value{
Invisibly returns \code{TRUE} if fonts were loaded, \code{FALSE} if skipped Invisibly returns `NULL`.
(already loaded and \code{force = FALSE}).
} }
\description{ \description{
Downloads Inter, Libre Franklin, Source Serif 4 and JetBrains Mono from Downloads Inter and Libre Franklin from Google Fonts via
Google Fonts via \code{sysfonts::font_add_google()}, then calls [sysfonts::font_add_google()], then calls [showtext::showtext_auto()] so
\code{showtext::showtext_auto()} so that all graphics devices render text with that all graphics devices render text with those fonts. This is called
those fonts. This is called automatically when the package loads; use this automatically when the package loads; use this function to retry if the
function to retry if the initial load failed (e.g., the machine was offline initial load failed (e.g., the machine was offline at load time).
at load time).
Subsequent calls within the same session are no-ops unless \code{force = TRUE}.
} }
\examples{ \examples{
\dontrun{ \dontrun{
+1 -2
View File
@@ -22,8 +22,7 @@ Plot a jpeg image as a raster
} }
\examples{ \examples{
\dontrun{ \dontrun{
# Supply a path to your own JPEG file img <- system.file("img","Knowles_Headshot_2019_good.jpg",package="civilytics")
img <- "my_photo.jpg"
plot_jpeg(img) plot_jpeg(img)
} }
} }
+8 -10
View File
@@ -17,7 +17,7 @@ theme_civilytics(
accent = unname(civilytics_colors["ember_600"]), accent = unname(civilytics_colors["ember_600"]),
strip_color = unname(civilytics_colors["paper_2"]), strip_color = unname(civilytics_colors["paper_2"]),
grid = c("y", "x", "both", "none"), grid = c("y", "x", "both", "none"),
paper_bg = FALSE paper_bg = TRUE
) )
} }
\arguments{ \arguments{
@@ -56,12 +56,10 @@ to [civilytics_colors]`["paper_2"]` (`#F2EDE4`).}
\item{grid}{Character. Which major gridlines to draw: `"y"` (default, \item{grid}{Character. Which major gridlines to draw: `"y"` (default,
horizontal only), `"x"` (vertical only), `"both"`, or `"none"`.} horizontal only), `"x"` (vertical only), `"both"`, or `"none"`.}
\item{paper_bg}{Logical. If `TRUE`, fill the plot and panel backgrounds \item{paper_bg}{Logical. If `TRUE` (default), fill the plot and panel
with the warm `paper` color (Civilytics cream). Default is `FALSE` backgrounds with the warm `paper` color. Set to `FALSE` for a
(transparent) so that figures composite cleanly onto any background. transparent background (useful for slides or overlay on colored
Set to `TRUE` for the branded cream canvas. Note: a transparent device surfaces).}
background (e.g., `dev = "ragg_png"`, `dev.args = list(background =
"transparent")`) is also needed for fully-transparent PNG exports.}
} }
\value{ \value{
A complete ggplot2 [ggplot2::theme()] object. A complete ggplot2 [ggplot2::theme()] object.
@@ -107,7 +105,7 @@ shrinkage.
\dontrun{ \dontrun{
library(ggplot2) library(ggplot2)
# Default — transparent background for embedding # Default editorial theme
ggplot(mpg, aes(displ, hwy)) + ggplot(mpg, aes(displ, hwy)) +
geom_point() + geom_point() +
theme_civilytics() theme_civilytics()
@@ -118,10 +116,10 @@ ggplot(mpg, aes(displ, hwy, colour = class)) +
scale_color_civilytics() + scale_color_civilytics() +
theme_civilytics(grid = "both") theme_civilytics(grid = "both")
# Branded cream background (opt-in) # Transparent background for embedding
ggplot(mpg, aes(displ, hwy)) + ggplot(mpg, aes(displ, hwy)) +
geom_point() + geom_point() +
theme_civilytics(paper_bg = TRUE) theme_civilytics(paper_bg = FALSE)
# Larger text for poster or display # Larger text for poster or display
ggplot(mpg, aes(displ, hwy)) + ggplot(mpg, aes(displ, hwy)) +
+4 -4
View File
@@ -56,10 +56,10 @@ to [civilytics_colors]`["paper_2"]` (`#F2EDE4`).}
\item{grid}{Character. Which major gridlines to draw: `"y"` (default, \item{grid}{Character. Which major gridlines to draw: `"y"` (default,
horizontal only), `"x"` (vertical only), `"both"`, or `"none"`.} horizontal only), `"x"` (vertical only), `"both"`, or `"none"`.}
\item{paper_bg}{Logical. If `TRUE`, fill the plot and panel backgrounds \item{paper_bg}{Logical. If `TRUE` (default), fill the plot and panel
with the warm `paper` color (Civilytics cream). Default is `FALSE` backgrounds with the warm `paper` color. Set to `FALSE` for a
(transparent) so that figures composite cleanly onto any background. transparent background (useful for slides or overlay on colored
Set to `TRUE` for the branded cream canvas.} surfaces).}
} }
\value{ \value{
A complete ggplot2 [ggplot2::theme()] object. A complete ggplot2 [ggplot2::theme()] object.
+4 -4
View File
@@ -52,10 +52,10 @@ design system.}
\item{strip_color}{Character. Hex code for facet strip background. Defaults \item{strip_color}{Character. Hex code for facet strip background. Defaults
to [civilytics_colors]`["paper_2"]` (`#F2EDE4`).} to [civilytics_colors]`["paper_2"]` (`#F2EDE4`).}
\item{paper_bg}{Logical. If `TRUE`, fill the plot and panel backgrounds \item{paper_bg}{Logical. If `TRUE` (default), fill the plot and panel
with the warm `paper` color (Civilytics cream). Default is `FALSE` backgrounds with the warm `paper` color. Set to `FALSE` for a
(transparent) so that figures composite cleanly onto any background. transparent background (useful for slides or overlay on colored
Set to `TRUE` for the branded cream canvas.} surfaces).}
} }
\value{ \value{
A complete ggplot2 [ggplot2::theme()] object. A complete ggplot2 [ggplot2::theme()] object.
+4 -4
View File
@@ -52,10 +52,10 @@ design system.}
\item{strip_color}{Character. Hex code for facet strip background. Defaults \item{strip_color}{Character. Hex code for facet strip background. Defaults
to [civilytics_colors]`["paper_2"]` (`#F2EDE4`).} to [civilytics_colors]`["paper_2"]` (`#F2EDE4`).}
\item{paper_bg}{Logical. If `TRUE`, fill the plot and panel backgrounds \item{paper_bg}{Logical. If `TRUE` (default), fill the plot and panel
with the warm `paper` color (Civilytics cream). Default is `FALSE` backgrounds with the warm `paper` color. Set to `FALSE` for a
(transparent) so that figures composite cleanly onto any background. transparent background (useful for slides or overlay on colored
Set to `TRUE` for the branded cream canvas.} surfaces).}
} }
\value{ \value{
A complete ggplot2 [ggplot2::theme()] object. A complete ggplot2 [ggplot2::theme()] object.
+4 -4
View File
@@ -56,10 +56,10 @@ to [civilytics_colors]`["paper_2"]` (`#F2EDE4`).}
\item{grid}{Character. Which major gridlines to draw: `"y"` (default, \item{grid}{Character. Which major gridlines to draw: `"y"` (default,
horizontal only), `"x"` (vertical only), `"both"`, or `"none"`.} horizontal only), `"x"` (vertical only), `"both"`, or `"none"`.}
\item{paper_bg}{Logical. If `TRUE`, fill the plot and panel backgrounds \item{paper_bg}{Logical. If `TRUE` (default), fill the plot and panel
with the warm `paper` color (Civilytics cream). Default is `FALSE` backgrounds with the warm `paper` color. Set to `FALSE` for a
(transparent) so that figures composite cleanly onto any background. transparent background (useful for slides or overlay on colored
Set to `TRUE` for the branded cream canvas.} surfaces).}
} }
\value{ \value{
A complete ggplot2 [ggplot2::theme()] object. A complete ggplot2 [ggplot2::theme()] object.
+4 -4
View File
@@ -52,10 +52,10 @@ design system.}
\item{strip_color}{Character. Hex code for facet strip background. Defaults \item{strip_color}{Character. Hex code for facet strip background. Defaults
to [civilytics_colors]`["paper_2"]` (`#F2EDE4`).} to [civilytics_colors]`["paper_2"]` (`#F2EDE4`).}
\item{paper_bg}{Logical. If `TRUE`, fill the plot and panel backgrounds \item{paper_bg}{Logical. If `TRUE` (default), fill the plot and panel
with the warm `paper` color (Civilytics cream). Default is `FALSE` backgrounds with the warm `paper` color. Set to `FALSE` for a
(transparent) so that figures composite cleanly onto any background. transparent background (useful for slides or overlay on colored
Set to `TRUE` for the branded cream canvas.} surfaces).}
} }
\value{ \value{
A complete ggplot2 [ggplot2::theme()] object. A complete ggplot2 [ggplot2::theme()] object.
-51
View File
@@ -1,51 +0,0 @@
library(civilytics)
library(ggplot2)
library(grid)
data(mtcars)
ggplot(mtcars, aes(x = hp, y = mpg)) +
geom_point() +
labs(title = "This is the title", subtitle = "More context.",
caption = "JEK made this for you.") +
theme_civilytics_dark(font_size = 16)
(ggplot(mtcars, aes(x = hp, y = mpg)) +
geom_point() +
labs(title = "This is the title", subtitle = "More context.",
caption = "JEK made this for you.") +
theme_civilytics_dark(font_size = 16)) |>
civilytics_logo(variant = "dark") |>
grid::grid.draw()
dev.off()
(ggplot(mtcars, aes(x = hp, y = mpg)) +
geom_point() +
labs(title = "This is the title", subtitle = "More context.",
caption = "JEK made this for you.") +
theme_civilytics_dark()) |>
civilytics_logo(variant = "dark") |>
grid::grid.draw()
dev.off()
(ggplot(mtcars, aes(x = hp, y = mpg)) +
geom_point() +
labs(title = "This is the title", subtitle = "More context.",
caption = "JEK made this for you.") +
theme_civilytics_dark(font_size = 14)) |>
civilytics_logo(variant = "dark") |>
grid::grid.draw()
dev.off()
(ggplot(mtcars, aes(x = hp, y = mpg)) +
geom_point() +
labs(title = "This is the title", subtitle = "More context.",
caption = "JEK made this for you.") +
theme_civilytics_dark(font_size = 16)) |>
civilytics_logo(variant = "dark", position = "top-right") |>
grid::grid.draw()
Binary file not shown.
+1 -172
View File
@@ -1,173 +1,2 @@
# Tests for proportion confidence interval functions # test prop intervals
# --- clopper_pearson ---------------------------------------------------------
test_that("clopper_pearson returns a named numeric vector of length 3", {
result <- clopper_pearson(20, 40)
expect_type(result, "double")
expect_length(result, 3)
expect_named(result, c("low", "observed", "high"))
})
test_that("clopper_pearson observed matches num/den", {
result <- clopper_pearson(20, 40)
expect_equal(unname(result["observed"]), 20 / 40)
})
test_that("clopper_pearson matches binom.test in base R", {
# The implementation is documented as producing the same results as
# binom.test(), which uses the Clopper-Pearson method.
for (num in c(0, 1, 5, 20, 39, 40)) {
result <- clopper_pearson(num, 40)
bt <- binom.test(num, 40)$conf.int
expect_equal(unname(result["low"]), bt[1], tolerance = 1e-10)
expect_equal(unname(result["high"]), bt[2], tolerance = 1e-10)
}
})
test_that("clopper_pearson interval is valid (low <= observed <= high)", {
result <- clopper_pearson(5, 10)
expect_lte(result["low"], result["observed"])
expect_gte(result["high"], result["observed"])
})
test_that("clopper_pearson handles edge cases", {
# num = 0: lower bound should be exactly 0
zero_result <- clopper_pearson(0, 10)
expect_equal(unname(zero_result["low"]), 0, tolerance = 1e-15)
expect_gt(unname(zero_result["high"]), 0)
# Upper bound should match binom.test exactly
bt_zero <- binom.test(0, 10)$conf.int[2]
expect_equal(unname(zero_result["high"]), unname(bt_zero), tolerance = 1e-10)
# num = den: upper bound should be exactly 1 (observed is at the boundary)
full_result <- clopper_pearson(10, 10)
expect_equal(unname(full_result["high"]), 1, tolerance = 1e-15)
# Lower bound for all-successes case is well below observed (asymmetric interval)
bt_full <- binom.test(10, 10)$conf.int
expect_equal(unname(full_result["low"]), unname(bt_full[1]), tolerance = 1e-10)
})
test_that("clopper_pearson respects conf.level", {
wide <- clopper_pearson(20, 40, conf.level = 0.99)
narrow <- clopper_pearson(20, 40, conf.level = 0.80)
# Higher confidence level produces a wider interval
expect_gt(unname(wide["high"]) - unname(wide["low"]),
unname(narrow["high"]) - unname(narrow["low"]))
})
# --- z_univariate ------------------------------------------------------------
test_that("z_univariate returns a single numeric value", {
result <- z_univariate(0.13, 0.11, 2500)
expect_type(result, "double")
expect_length(result, 1)
})
test_that("z_univariate equals the formula by hand calculation", {
# z = (p_hat - p_0) / sqrt(p_0 * (1 - p_0) / n)
unit_prop <- 0.13
global_prop <- 0.11
unit_denom <- 2500
expected <- (unit_prop - global_prop) /
sqrt((global_prop * (1 - global_prop)) / unit_denom)
result <- z_univariate(unit_prop, global_prop, unit_denom)
expect_equal(result, expected, tolerance = 1e-12)
})
test_that("z_univariate is zero when proportions are equal", {
expect_equal(z_univariate(0.5, 0.5, 100), 0, tolerance = 1e-15)
})
test_that("z_univariate sign follows the direction of deviation", {
# When unit_prop > global_prop, z should be positive
expect_gt(z_univariate(0.2, 0.1, 100), 0)
# When unit_prop < global_prop, z should be negative
expect_lt(z_univariate(0.1, 0.2, 100), 0)
})
# --- waldInterval ------------------------------------------------------------
test_that("waldInterval returns a named numeric vector of length 2", {
result <- waldInterval(x = 20, n = 40)
expect_type(result, "double")
expect_length(result, 2)
expect_named(result, c("lwr", "upr"))
})
test_that("waldInterval matches documented example values", {
# The roxygen @examples comment says: waldInterval(x = 20, n = 40)
# returns approximately 0.345 and 0.655
result <- waldInterval(20, 40)
p_hat <- 20 / 40 # 0.5
se <- sqrt(p_hat * (1 - p_hat) / 40) # ~0.0791
z_crit <- qnorm(0.975) # ~1.96
expect_equal(unname(result["lwr"]), p_hat - z_crit * se, tolerance = 1e-12)
expect_equal(unname(result["upr"]), p_hat + z_crit * se, tolerance = 1e-12)
})
test_that("waldInterval interval is centered on the sample proportion", {
result <- waldInterval(30, 50)
midpoint <- (unname(result["lwr"]) + unname(result["upr"])) / 2
expect_equal(midpoint, 30 / 50, tolerance = 1e-12)
})
test_that("waldInterval respects conf.level", {
wide <- waldInterval(20, 40, conf.level = 0.99)
narrow <- waldInterval(20, 40, conf.level = 0.80)
expect_gt(unname(wide["upr"]) - unname(wide["lwr"]),
unname(narrow["upr"]) - unname(narrow["lwr"]))
})
# --- agresti_coull_interval --------------------------------------------------
test_that("agresti_coull_interval returns a named numeric vector of length 3", {
result <- agresti_coull_interval(20, 40)
expect_type(result, "double")
expect_length(result, 3)
expect_named(result, c("low", "observed", "high"))
})
test_that("agresti_coull_interval observed matches num/den", {
result <- agresti_coull_interval(20, 40)
expect_equal(unname(result["observed"]), 20 / 40)
})
test_that("agresti_coull_interval interval is valid (low <= observed <= high)", {
result <- agresti_coull_interval(15, 30)
expect_lte(result["low"], result["observed"])
expect_gte(result["high"], result["observed"])
})
test_that("agresti_coull_interval matches manual formula calculation", {
num <- 20
den <- 40
conf_level <- 0.95
z <- qnorm(1 - (1 - conf_level) / 2)
n_tilde <- den + z^2
p_tilde <- (num + z^2 / 2) / n_tilde
margin <- z * sqrt(p_tilde * (1 - p_tilde) / n_tilde)
result <- agresti_coull_interval(num, den, conf.level = conf_level)
expect_equal(unname(result["low"]), p_tilde - margin, tolerance = 1e-12)
expect_equal(unname(result["high"]), p_tilde + margin, tolerance = 1e-12)
})
test_that("agresti_coull_interval respects conf.level", {
wide <- agresti_coull_interval(20, 40, conf.level = 0.99)
narrow <- agresti_coull_interval(20, 40, conf.level = 0.80)
expect_gt(unname(wide["high"]) - unname(wide["low"]),
unname(narrow["high"]) - unname(narrow["low"]))
})
+1 -6
View File
@@ -133,13 +133,8 @@ test_that("theme_civilytics uses brand ink color for text", {
expect_equal(th$text$colour, unname(civilytics_colors["ink"])) expect_equal(th$text$colour, unname(civilytics_colors["ink"]))
}) })
test_that("theme_civilytics has transparent background by default", { test_that("theme_civilytics uses brand paper color for plot background", {
th <- theme_civilytics() th <- theme_civilytics()
expect_true(is.na(th$plot.background$fill))
})
test_that("theme_civilytics uses brand paper color when paper_bg = TRUE", {
th <- theme_civilytics(paper_bg = TRUE)
expect_equal(th$plot.background$fill, unname(civilytics_colors["paper"])) expect_equal(th$plot.background$fill, unname(civilytics_colors["paper"]))
}) })
+1 -187
View File
@@ -65,193 +65,7 @@ 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") context("Test Utilities - Pretty Count")