41 changed files with 371 additions and 2154 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$
+2 -5
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"))
@@ -31,10 +31,7 @@ Encoding: UTF-8
Suggests: Suggests:
testthat (>= 3.0.0), testthat (>= 3.0.0),
tidycensus, tidycensus,
quarto, quarto
flextable,
officer,
ragg
Config/testthat/edition: 3 Config/testthat/edition: 3
Config/roxygen2/version: 8.0.0 Config/roxygen2/version: 8.0.0
RoxygenNote: 7.3.3 RoxygenNote: 7.3.3
View File
-2
View File
@@ -39,13 +39,11 @@ export(rnh)
export(round_to_nearest_half) export(round_to_nearest_half)
export(safe_max) export(safe_max)
export(safe_ratio) export(safe_ratio)
export(save_branded_flextable_png)
export(scale_color_civilytics) export(scale_color_civilytics)
export(scale_fill_civilytics) export(scale_fill_civilytics)
export(simpleCap) export(simpleCap)
export(stamp_logo_png) export(stamp_logo_png)
export(star_subs) export(star_subs)
export(style_flextable_civilytics)
export(theme_civilytics) export(theme_civilytics)
export(theme_civilytics_dark) export(theme_civilytics_dark)
export(theme_civilytics_dark_map) export(theme_civilytics_dark_map)
-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 -8
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,10 @@ 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")
sapply(x, function(word) {
# 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]] s <- strsplit(word, " ")[[1]]
paste(toupper(substring(s, 1, 1)), substring(s, 2), paste(toupper(substring(s, 1, 1)), substring(s, 2),
sep = "", collapse = " ") sep = "", collapse = " ")
}, character(1))) })
} }
-175
View File
@@ -1,175 +0,0 @@
#' Apply the Civilytics brand styling to a flextable
#'
#' Applies *only* the visual Civilytics brand to an already-structured
#' [flextable::flextable()] — header fill and color, body font and size,
#' zebra striping, borders, footer styling, and a fixed table layout. The
#' caller remains responsible for table *structure*: labels
#' ([flextable::set_header_labels()]), header/title lines
#' ([flextable::add_header_lines()]), column widths ([flextable::width()]),
#' alignment ([flextable::align()]), and footer text
#' ([flextable::add_footer_lines()]). This separation keeps styling reusable
#' across projects while leaving content decisions where they belong.
#'
#' `flextable`, `officer`, and `ragg` are Suggested (not Imported) to keep the
#' base install light, so this function errors with an install hint if
#' `flextable` is unavailable.
#'
#' @param ft A [flextable::flextable()] object.
#' @param header_bg Character. Header background fill. Default `"#2c3e50"`.
#' @param header_color Character. Header text color. Default `"white"`.
#' @param title_fontsize Numeric. Font size for the first header line (the
#' title row, `i = 1`). Default `14`.
#' @param body_fontsize Numeric. Body font size. Default `11`.
#' @param font_name Character. Font family applied to all parts. Default
#' `"Arial"`.
#' @param zebra Logical. Apply alternating-row striping to even body rows.
#' Default `TRUE`. Safely skipped for tables with fewer than two body rows.
#' @param zebra_bg Character. Fill color for striped (even) body rows.
#' Default `"#f0f0eb"`.
#' @param outer_border_color Character. Outer border color. Default
#' `"#888888"`.
#' @param outer_border_width Numeric. Outer border width. Default `1`.
#' @param inner_border_color Character. Inner horizontal border color (body).
#' Default `"#cccccc"`.
#' @param inner_border_width Numeric. Inner horizontal border width. Default
#' `0.5`.
#' @param footer_fontsize Numeric. Footer font size (applied only if a footer
#' part exists). Default `9`.
#' @param footer_color Character. Footer text color. Default `"#555555"`.
#'
#' @return The styled [flextable::flextable()] object.
#' @export
#' @seealso [save_branded_flextable_png()] to export the styled table to a
#' logo-stamped PNG.
#' @examples
#' \dontrun{
#' library(flextable)
#' ft <- flextable(head(mtcars)) |>
#' add_header_lines("Motor Trend Cars") |>
#' add_footer_lines("Source: mtcars") |>
#' style_flextable_civilytics()
#' }
style_flextable_civilytics <- function(ft,
header_bg = "#2c3e50",
header_color = "white",
title_fontsize = 14,
body_fontsize = 11,
font_name = "Arial",
zebra = TRUE,
zebra_bg = "#f0f0eb",
outer_border_color = "#888888",
outer_border_width = 1,
inner_border_color = "#cccccc",
inner_border_width = 0.5,
footer_fontsize = 9,
footer_color = "#555555") {
if (!requireNamespace("flextable", quietly = TRUE)) {
stop("Install 'flextable' to use this function.", call. = FALSE)
}
if (!requireNamespace("officer", quietly = TRUE)) {
stop("Install 'officer' to use this function.", call. = FALSE)
}
# Header: navy fill, white bold text, larger title line.
ft <- flextable::bg(ft, bg = header_bg, part = "header")
ft <- flextable::color(ft, color = header_color, part = "header")
ft <- flextable::bold(ft, part = "header")
ft <- flextable::fontsize(ft, i = 1, size = title_fontsize, part = "header")
# Body: readable size, brand font across all parts.
ft <- flextable::fontsize(ft, size = body_fontsize, part = "body")
ft <- flextable::font(ft, fontname = font_name, part = "all")
# Zebra striping on even body rows, guarded for tables with < 2 rows.
nrow_body <- flextable::nrow_part(ft, part = "body")
if (zebra && nrow_body >= 2) {
ft <- flextable::bg(ft, i = seq(2, nrow_body, 2), bg = zebra_bg,
part = "body")
}
# Borders: outer frame on all parts, light horizontal rules in the body.
ft <- flextable::border_outer(
ft,
border = officer::fp_border(color = outer_border_color,
width = outer_border_width),
part = "all"
)
ft <- flextable::border_inner_h(
ft,
border = officer::fp_border(color = inner_border_color,
width = inner_border_width),
part = "body"
)
# Footer styling — only if the table actually has a footer part.
if (flextable::nrow_part(ft, part = "footer") > 0) {
ft <- flextable::fontsize(ft, size = footer_fontsize, part = "footer")
ft <- flextable::color(ft, color = footer_color, part = "footer")
}
flextable::set_table_properties(ft, layout = "fixed")
}
#' Save a branded flextable to a logo-stamped PNG
#'
#' Exports a styled [flextable::flextable()] to a PNG via
#' [ragg::agg_png()] (sized to the table's own dimensions plus a little
#' headroom for the logo), then optionally stamps the Civilytics logo onto the
#' file with [stamp_logo_png()] so file-based tables stay visually consistent
#' with [civilytics_logo()]-branded plots.
#'
#' `ragg` and `flextable` are Suggested (not Imported); this function errors
#' with an install hint if either is unavailable.
#'
#' @param ft A [flextable::flextable()] object, typically already styled with
#' [style_flextable_civilytics()].
#' @param path Character. Output PNG path. Returned invisibly.
#' @param logo Logical. Stamp the Civilytics logo onto the saved PNG via
#' [stamp_logo_png()]. Default `TRUE`.
#' @param res Numeric. Output resolution in PPI passed to [ragg::agg_png()].
#' Default `300`.
#' @param extra_height Numeric. Additional height in inches added to the
#' table's natural height to leave room for the stamped logo. Default `0.4`.
#' @param ... Additional arguments forwarded to [stamp_logo_png()] (e.g.
#' `type`, `variant`, `position`, `width_frac`, `margin_frac`).
#'
#' @return `path`, invisibly.
#' @export
#' @seealso [style_flextable_civilytics()] to apply the brand styling, and
#' [stamp_logo_png()] for the underlying logo compositing.
#' @examples
#' \dontrun{
#' library(flextable)
#' ft <- flextable(head(mtcars)) |>
#' add_footer_lines("Source: mtcars") |>
#' style_flextable_civilytics()
#' save_branded_flextable_png(ft, "table.png")
#' save_branded_flextable_png(ft, "table.png", position = "bottom-left")
#' knitr::include_graphics("table.png")
#' }
save_branded_flextable_png <- function(ft, path, logo = TRUE, res = 300,
extra_height = 0.4, ...) {
if (!requireNamespace("flextable", quietly = TRUE)) {
stop("Install 'flextable' to use this function.", call. = FALSE)
}
if (!requireNamespace("ragg", quietly = TRUE)) {
stop("Install 'ragg' to use this function.", call. = FALSE)
}
d <- flextable::flextable_dim(ft)
ragg::agg_png(path, width = d$width, height = d$height + extra_height,
units = "in", res = res)
on.exit(grDevices::dev.off(), add = TRUE)
plot(ft)
if (logo) {
# dev.off() must run before stamp_logo_png() re-reads the file. Flush the
# device now and clear the on.exit handler so it does not fire twice.
grDevices::dev.off()
on.exit()
stamp_logo_png(path, ...)
}
invisible(path)
}
+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) {
+26 -30
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)
+114 -114
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,9 @@
#' 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 `FALSE` (default), the plot and panel
#' with the warm `paper` color (Civilytics cream). Default is `FALSE` #' backgrounds are transparent (`fill = NA`). Set to `TRUE` to fill them
#' (transparent) so that figures composite cleanly onto any background. #' with the warm `paper` color (the Civilytics cream canvas).
#' Set to `TRUE` for the branded cream canvas. Note: a transparent device
#' 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,33 +60,36 @@
#' 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 #' # Transparent background (default) — composites cleanly onto any surface
#' ggplot(mpg, aes(displ, hwy)) + #' ggplot(mpg, aes(displ, hwy)) +
#' geom_point() + #' geom_point() +
#' theme_civilytics() #' theme_civilytics()
#' #'
#' # Warm paper canvas (opt-in)
#' ggplot(mpg, aes(displ, hwy)) +
#' geom_point() +
#' theme_civilytics(paper_bg = TRUE)
#'
#' # With both gridlines and brand colors #' # With both gridlines and brand colors
#' ggplot(mpg, aes(displ, hwy, colour = class)) + #' ggplot(mpg, aes(displ, hwy, colour = class)) +
#' geom_point() + #' geom_point() +
#' scale_color_civilytics() + #' scale_color_civilytics() +
#' theme_civilytics(grid = "both") #' theme_civilytics(grid = "both")
#' #'
#' # Branded cream background (opt-in)
#' ggplot(mpg, aes(displ, hwy)) +
#' geom_point() +
#' theme_civilytics(paper_bg = TRUE)
#'
#' # Larger text for poster or display #' # Larger text for poster or display
#' ggplot(mpg, aes(displ, hwy)) + #' ggplot(mpg, aes(displ, hwy)) +
#' geom_point() + #' geom_point() +
#' theme_civilytics(font_size = 18) #' theme_civilytics(font_size = 18)
#'
#' # Note: for fully-transparent PNGs, also set a transparent device
#' # background (e.g. `ggsave("plot.png", bg = NA)`).
#' } #' }
theme_civilytics <- function( theme_civilytics <- function(
font_size = 14, font_size = 14,
@@ -115,30 +115,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 +147,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 +317,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 +361,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 +389,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 +430,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 +448,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 +478,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 +530,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 +581,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
+3 -3
View File
@@ -31,7 +31,7 @@ safe_max <- function(x) {
#' pretty_per(0.2, ndigit = 1) #' pretty_per(0.2, ndigit = 1)
#' pretty_per(c(0.2, 0.332423, 0.4, 0.342342), ndigit = 2) #' pretty_per(c(0.2, 0.332423, 0.4, 0.342342), ndigit = 2)
pretty_per <- function(x, ndigit = 1) { pretty_per <- function(x, ndigit = 1) {
if (any(x >= 100) & !all(is.na(x))) { if (any(x >= 100) && !all(is.na(x))) {
message("Values over 100 found, did you mean to use proportions?") message("Values over 100 found, did you mean to use proportions?")
} }
x <- format(round(x, digits = ndigit + 2) * 100, nsmall = ndigit) x <- format(round(x, digits = ndigit + 2) * 100, nsmall = ndigit)
@@ -283,7 +283,7 @@ get_stabbr <- function(fips) {
fips_codes <- fips_codes[!duplicated(fips_codes),] fips_codes <- fips_codes[!duplicated(fips_codes),]
if (length(fips) != 1) { if (length(fips) != 1) {
out <- rep(NA, length(fips)) out <- rep(NA, length(fips))
for (i in length(fips)) { for (i in seq_along(fips)) {
out[i] <- fips_codes[fips_codes$state_code == fips, 1] out[i] <- fips_codes[fips_codes$state_code == fips, 1]
} }
@@ -375,7 +375,7 @@ random_round <- function(x) {
add = rep(as.integer(0),length(r)) add = rep(as.integer(0),length(r))
add[r>test] <- as.integer(1) add[r>test] <- as.integer(1)
value = v + add value = v + add
ifelse(is.na(value) | value<0, 0, value) value <- ifelse(is.na(value) | value < 0, 0, value)
return(value) return(value)
} }
-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)
} }
} }
-62
View File
@@ -1,62 +0,0 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/flextable.R
\name{save_branded_flextable_png}
\alias{save_branded_flextable_png}
\title{Save a branded flextable to a logo-stamped PNG}
\usage{
save_branded_flextable_png(
ft,
path,
logo = TRUE,
res = 300,
extra_height = 0.4,
...
)
}
\arguments{
\item{ft}{A [flextable::flextable()] object, typically already styled with
[style_flextable_civilytics()].}
\item{path}{Character. Output PNG path. Returned invisibly.}
\item{logo}{Logical. Stamp the Civilytics logo onto the saved PNG via
[stamp_logo_png()]. Default `TRUE`.}
\item{res}{Numeric. Output resolution in PPI passed to [ragg::agg_png()].
Default `300`.}
\item{extra_height}{Numeric. Additional height in inches added to the
table's natural height to leave room for the stamped logo. Default `0.4`.}
\item{...}{Additional arguments forwarded to [stamp_logo_png()] (e.g.
`type`, `variant`, `position`, `width_frac`, `margin_frac`).}
}
\value{
`path`, invisibly.
}
\description{
Exports a styled [flextable::flextable()] to a PNG via
[ragg::agg_png()] (sized to the table's own dimensions plus a little
headroom for the logo), then optionally stamps the Civilytics logo onto the
file with [stamp_logo_png()] so file-based tables stay visually consistent
with [civilytics_logo()]-branded plots.
}
\details{
`ragg` and `flextable` are Suggested (not Imported); this function errors
with an install hint if either is unavailable.
}
\examples{
\dontrun{
library(flextable)
ft <- flextable(head(mtcars)) |>
add_footer_lines("Source: mtcars") |>
style_flextable_civilytics()
save_branded_flextable_png(ft, "table.png")
save_branded_flextable_png(ft, "table.png", position = "bottom-left")
knitr::include_graphics("table.png")
}
}
\seealso{
[style_flextable_civilytics()] to apply the brand styling, and
[stamp_logo_png()] for the underlying logo compositing.
}
-92
View File
@@ -1,92 +0,0 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/flextable.R
\name{style_flextable_civilytics}
\alias{style_flextable_civilytics}
\title{Apply the Civilytics brand styling to a flextable}
\usage{
style_flextable_civilytics(
ft,
header_bg = "#2c3e50",
header_color = "white",
title_fontsize = 14,
body_fontsize = 11,
font_name = "Arial",
zebra = TRUE,
zebra_bg = "#f0f0eb",
outer_border_color = "#888888",
outer_border_width = 1,
inner_border_color = "#cccccc",
inner_border_width = 0.5,
footer_fontsize = 9,
footer_color = "#555555"
)
}
\arguments{
\item{ft}{A [flextable::flextable()] object.}
\item{header_bg}{Character. Header background fill. Default `"#2c3e50"`.}
\item{header_color}{Character. Header text color. Default `"white"`.}
\item{title_fontsize}{Numeric. Font size for the first header line (the
title row, `i = 1`). Default `14`.}
\item{body_fontsize}{Numeric. Body font size. Default `11`.}
\item{font_name}{Character. Font family applied to all parts. Default
`"Arial"`.}
\item{zebra}{Logical. Apply alternating-row striping to even body rows.
Default `TRUE`. Safely skipped for tables with fewer than two body rows.}
\item{zebra_bg}{Character. Fill color for striped (even) body rows.
Default `"#f0f0eb"`.}
\item{outer_border_color}{Character. Outer border color. Default
`"#888888"`.}
\item{outer_border_width}{Numeric. Outer border width. Default `1`.}
\item{inner_border_color}{Character. Inner horizontal border color (body).
Default `"#cccccc"`.}
\item{inner_border_width}{Numeric. Inner horizontal border width. Default
`0.5`.}
\item{footer_fontsize}{Numeric. Footer font size (applied only if a footer
part exists). Default `9`.}
\item{footer_color}{Character. Footer text color. Default `"#555555"`.}
}
\value{
The styled [flextable::flextable()] object.
}
\description{
Applies *only* the visual Civilytics brand to an already-structured
[flextable::flextable()] — header fill and color, body font and size,
zebra striping, borders, footer styling, and a fixed table layout. The
caller remains responsible for table *structure*: labels
([flextable::set_header_labels()]), header/title lines
([flextable::add_header_lines()]), column widths ([flextable::width()]),
alignment ([flextable::align()]), and footer text
([flextable::add_footer_lines()]). This separation keeps styling reusable
across projects while leaving content decisions where they belong.
}
\details{
`flextable`, `officer`, and `ragg` are Suggested (not Imported) to keep the
base install light, so this function errors with an install hint if
`flextable` is unavailable.
}
\examples{
\dontrun{
library(flextable)
ft <- flextable(head(mtcars)) |>
add_header_lines("Motor Trend Cars") |>
add_footer_lines("Source: mtcars") |>
style_flextable_civilytics()
}
}
\seealso{
[save_branded_flextable_png()] to export the styled table to a
logo-stamped PNG.
}
+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.
-89
View File
@@ -1,89 +0,0 @@
test_that("style_flextable_civilytics returns a styled flextable", {
skip_if_not_installed("flextable")
skip_if_not_installed("officer")
ft <- flextable::flextable(head(mtcars, 4))
ft <- flextable::add_footer_lines(ft, "Source: mtcars")
styled <- style_flextable_civilytics(ft)
expect_s3_class(styled, "flextable")
# Fixed layout is the documented end-state of the styling.
expect_identical(styled$properties$layout, "fixed")
})
test_that("style_flextable_civilytics is idempotent on a 1-row table (no zebra error)", {
skip_if_not_installed("flextable")
skip_if_not_installed("officer")
ft <- flextable::flextable(head(mtcars, 1))
expect_no_error(once <- style_flextable_civilytics(ft))
# Re-styling an already-styled table must not error either.
expect_no_error(twice <- style_flextable_civilytics(once))
expect_s3_class(twice, "flextable")
})
test_that("zebra = FALSE still returns a valid flextable", {
skip_if_not_installed("flextable")
skip_if_not_installed("officer")
ft <- flextable::flextable(head(mtcars, 6))
expect_s3_class(style_flextable_civilytics(ft, zebra = FALSE), "flextable")
})
test_that("save_branded_flextable_png writes a PNG with plausible dimensions", {
skip_if_not_installed("flextable")
skip_if_not_installed("officer")
skip_if_not_installed("ragg")
skip_if_not_installed("png")
ft <- flextable::flextable(head(mtcars, 4))
ft <- flextable::add_footer_lines(ft, "Source: mtcars")
ft <- style_flextable_civilytics(ft)
path <- tempfile(fileext = ".png")
on.exit(unlink(path), add = TRUE)
out <- save_branded_flextable_png(ft, path)
expect_identical(out, path)
expect_true(file.exists(path))
dims <- dim(png::readPNG(path))
# height x width x channels — a real table is at least a few hundred px each.
expect_gt(dims[1], 50)
expect_gt(dims[2], 50)
})
test_that("save_branded_flextable_png with logo = FALSE skips stamping but still writes", {
skip_if_not_installed("flextable")
skip_if_not_installed("officer")
skip_if_not_installed("ragg")
skip_if_not_installed("png")
ft <- style_flextable_civilytics(flextable::flextable(head(mtcars, 3)))
path <- tempfile(fileext = ".png")
on.exit(unlink(path), add = TRUE)
save_branded_flextable_png(ft, path, logo = FALSE)
expect_true(file.exists(path))
expect_gt(file.info(path)$size, 0)
})
test_that("extra_height increases the exported PNG height", {
skip_if_not_installed("flextable")
skip_if_not_installed("officer")
skip_if_not_installed("ragg")
skip_if_not_installed("png")
ft <- style_flextable_civilytics(flextable::flextable(head(mtcars, 4)))
path_small <- tempfile(fileext = ".png")
path_big <- tempfile(fileext = ".png")
on.exit(unlink(c(path_small, path_big)), add = TRUE)
save_branded_flextable_png(ft, path_small, logo = FALSE, extra_height = 0)
save_branded_flextable_png(ft, path_big, logo = FALSE, extra_height = 2)
expect_gt(dim(png::readPNG(path_big))[1], dim(png::readPNG(path_small))[1])
})
+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"]))
})
+4 -1
View File
@@ -136,11 +136,14 @@ test_that("theme_civilytics uses brand ink color for text", {
test_that("theme_civilytics has transparent background by default", { test_that("theme_civilytics has transparent background by default", {
th <- theme_civilytics() th <- theme_civilytics()
expect_true(is.na(th$plot.background$fill)) expect_true(is.na(th$plot.background$fill))
expect_true(is.na(th$panel.background$fill))
expect_null(th$legend.background$fill)
}) })
test_that("theme_civilytics uses brand paper color when paper_bg = TRUE", { test_that("theme_civilytics paper_bg=TRUE opt-in fills with cream", {
th <- theme_civilytics(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"]))
expect_equal(th$panel.background$fill, unname(civilytics_colors["paper"]))
}) })
test_that("theme_civilytics uses paper_2 for strip background by default", { test_that("theme_civilytics uses paper_2 for strip background by default", {
+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")