Author SHA1 Message Date
jared 446843bc86 docs: refresh status board for #24
R-CMD-check / R CMD check (push) Successful in 4m11s
2026-08-24 00:24:01 -04:00
jared 04a5ee958b docs: record session
R-CMD-check / R CMD check (push) Successful in 5m11s
Journal entry for the roborev triage session and a regenerated status board.
Adds AGENTS.md and .roborev.toml to the packaging workstream so root-level
config commits attribute to a stream instead of landing unreferenced.
2026-08-24 00:15:09 -04:00
jared cd1af67a3a fix(packaging): exclude scoped chore and docs commits from roborev
The exclusion patterns are substring matches, so `chore:` never matched
`chore(packaging):`. Because the cadence rule in AGENTS.md mandates the
`type(ws):` scope, every chore and docs commit was being reviewed -- job 15
spent a thorough review on a config-only commit. Adds the `chore(` and `docs(`
forms.

Also names pm/compass.toml as authoritative for the review rules, so the
prose copy in AGENTS.md cannot silently drift from the generated
.roborev.toml. Raised by roborev job 15.
2026-08-24 00:13:23 -04:00
jared 496b9ed9ac docs: record session (#21, #22)
Journal entry for the compass init session and the first generated status
board, published as pinned issue #23.
2026-08-23 23:39:35 -04:00
jared 7cad98b434 chore(packaging): initialise compass project tracking
Adds pm/compass.toml with five workstreams (theme, logo, quarto, helpers,
packaging), the journal and decision-record scaffold, and a composed
.roborev.toml carrying nine project-specific review rules derived from the
package's actual conventions.

Also adds AGENTS.md as the cross-tool conventions file, wires project memory
into .agent/memory/ so it travels between machines, and untracks
tests/testthat/Rplots.pdf, which churned on every test run.
2026-08-23 23:33:48 -04:00
jared 2c7c9a6dbc Fix ggplot2 imports and polish utility functions for publication
R-CMD-check / R CMD check (push) Successful in 4m17s
Blocking issue #1: Replace all ggplot2::function() calls with bare
references in R/colors.R, R/logo.R, R/theme.R. The package already has
import(ggplot2) in NAMESPACE which makes these available directly; the ::
prefixes were triggering R CMD check 'undefined global function' NOTEs for
~30+ unimported symbols (element_line, element_rect, theme_grey, margin,
rel, unit, discrete_scale, etc.).

Suggestion #6: Replace class(x) == "character" with "character" %in% class(x)
in R/db.R (countCleanr and simpleCap). The == pattern breaks on S3 objects
with multiple class attributes.

Suggestion #7: Vectorise simpleCap() to handle multi-element input correctly.
Previously strsplit(x, ' ')[[1]] only processed the first element; now uses
unname(vapply()) to capitalise each vector element independently while
preserving the original scalar behaviour (no names attribute on output).

Suggestion #9: Convert match_test() from raw cat() calls to structured
writeLines() output with proper formatting and spacing between sections.
2026-08-09 14:35:09 -04:00
jared 6051e4bb5c Remove vendored headshots and add proportion CI tests
R-CMD-check / R CMD check (push) Successful in 4m37s
- Remove Knowles_Headshot_2019_good.jpg and Knowles_Headshot_2019_prisma.jpg
  from inst/img/ — personal headshot should not be distributed with the package
- Update plot_jpeg() roxygen example to use a generic placeholder instead of
  the removed headshot path; regenerate man/plot_jpeg.Rd accordingly
- Add comprehensive testthat coverage for clopper_pearson(), z_univariate(),
  waldInterval(), and agresti_coull_interval() in tests/testthat/test_propint.R

The propint module previously had zero tests. New tests cover: return types,
formula correctness (cross-validated against binom.test()), edge cases
(0/n and n/n), interval validity, confidence level behavior, and sign/direction
of z-scores.
2026-08-09 13:53:08 -04:00
jared 9dea017381 Merge pull request 'fix: resolve locked namespace binding in civilytics_load_fonts() and default theme to transparent background' (#19) from kodor/fix-18-fonts-and-theme into master
R-CMD-check / R CMD check (push) Successful in 4m25s
Reviewed-on: #19
2026-08-03 10:46:40 -04:00
kodor 967e7e1111 docs: regenerate roxygen documentation for paper_bg and force params (#19)
R-CMD-check / R CMD check (pull_request) Successful in 4m29s
2026-08-01 21:44:50 -04:00
kodor f32093c662 fix(test): update theme tests for paper_bg=FALSE default (#19)
R-CMD-check / R CMD check (pull_request) Failing after 5m47s
2026-08-01 21:29:44 -04:00
kodor e257180f15 fix: resolve locked namespace binding in civilytics_load_fonts() and default theme to transparent background
R-CMD-check / R CMD check (pull_request) Failing after 4m13s
- Replace .cv_fonts_loaded <<- TRUE with environment-based state
  (.cv_state) to avoid 'locked namespace binding' error (#18)
- Add force=FALSE argument for idempotent font loading with guard check
- Flip theme_civilytics() paper_bg default to FALSE (transparent) (#7)
- Update roxygen docs and examples for both changes
2026-08-01 02:07:09 -04:00
jared 0ef0f310e2 Merge pull request 'fix(brand): use real company name "Civilytics Consulting" in templates' (#17) from fix/brand-name-consulting into master
R-CMD-check / R CMD check (push) Successful in 4m28s
2026-07-09 16:42:18 -04:00
34 changed files with 2045 additions and 330 deletions
+2 -2
View File
@@ -3,10 +3,10 @@
^\.github$
^\.gitea$
^README\.Rmd$
^NEWS\.md$
^Makefile$
^Dockerfile$
^LICENSE\.md$
^\.claude$
^\.playwright-mcp$
^civilytics-site\.png$
^Rplots\.pdf$
^Rplots\.pdf$
View File
+11 -4
View File
@@ -1,4 +1,11 @@
.Rproj.user
.Rhistory
.RData
.Ruserdata
.Rproj.user
.Rhistory
.RData
.Ruserdata
.compass-cache/
# roborev snapshots
/.roborev/
# Test run debris
tests/testthat/Rplots.pdf
tests/testthat/_problems/
+64
View File
@@ -0,0 +1,64 @@
# roborev configuration, initialised by compass.
# Reviews are queued to a background daemon -- they never block a commit.
post_commit_review = 'commit'
# Scoped conventional commits (`chore(packaging):`) do not contain `chore:`,
# and this repo's cadence rule mandates the scope -- so both forms are listed.
excluded_commit_patterns = ['WIP', 'chore:', 'chore(', 'docs:', 'docs(', 'Merge ']
review_guidelines = '''
# --- compass:begin (generated -- edit the sources, not this) ---
- Prefer returning new values to mutating arguments in place. A function that edits
its caller's object is a bug waiting for a second caller.
- Validate at system boundaries -- user input, API responses, file contents, config.
Fail fast with a message naming the field and the file.
- Never swallow an error. Handle it or let it propagate; a bare catch that continues
is worse than a crash.
- No hardcoded secrets, tokens, or credentials, and no secrets in log output or error
messages.
- Parameterise every query. String-built SQL is a defect even when the input looks safe.
- Keep functions under roughly 50 lines and files under roughly 400. Flag nesting
deeper than four levels.
- No magic numbers or hardcoded paths -- name them as constants or read them from config.
- New behaviour needs a test. A bug fix needs a test that fails without the fix.
- Prose a person reads -- an issue title or body, a journal entry, a decision record,
the narrative on the status board -- names the action or the thing, not the shape of
the machinery. Flag "gate", "seam", "surface area", "load-bearing", "first-class",
"primitive", "blast radius". A project's own defined vocabulary is not the target.
- Use the native pipe `|>`, not magrittr `%>%`.
- snake_case for objects and functions; UPPER_SNAKE for constants. Never use `.` as a
word separator in a function name -- it collides with S3 dispatch.
- Validate arguments at the top of exported functions with `stopifnot()` or an explicit
check, and say which argument was wrong.
- Never `setDT()`, `set()`, or otherwise modify by reference a data.table the caller
still owns. `as.data.table()` copies; use it.
- Prefer `vapply()` to `sapply()` -- `sapply()` silently returns a list when the type
varies, which turns a type error into a downstream mystery.
- Use `seq_len(n)` / `seq_along(x)`, never `1:n`, which iterates backwards when n is 0.
- Compare strings with `==` only after checking for NA; use `identical()` for scalars
where NA would be wrong.
- Do not call `library()` inside package or module files; attach packages in scripts and
test helpers only.
- Namespace-qualify calls into other packages (`stats::sd`) in code that is sourced.
- Every exported function needs roxygen with `@param` for each argument (type, meaning,
and why the default is what it is) and `@return`. Add `@examples` for exported API.
- Declare dependencies in DESCRIPTION. Prefer base R or an existing dependency over
adding a new one; a package with zero hard deps is worth keeping that way.
- Signal errors with `stop()` carrying a condition class, so callers can catch the kind
rather than matching on message text.
- Keep internals internal. Export only what a user needs; an accidentally exported
helper becomes an API you have to keep.
- Tests use testthat edition 3. Each test is self-sufficient -- no reliance on state
left by an earlier test or on a fixture built elsewhere in the file.
- Prefer duplication in tests over a helper that hides what is being asserted.
- Brand colors come from `civilytics_colors`; never write a hex literal in theme, scale, logo, or table code. `R/flextable.R` still carries off-brand Bootstrap defaults (#2c3e50, #f0f0eb, #888888, #cccccc, #555555) -- do not add more.
- No tidyverse dependency. Imports is base R plus ggplot2, grid/gridExtra, png/jpeg, stringr, stringdist, showtext/sysfonts, jsonlite. Reject dplyr, purrr, magrittr, tibble, and data.table; use base R idioms.
- NAMESPACE is roxygen-generated. Declare imports with `@importFrom` in the roxygen block and re-run roxygen; never hand-edit NAMESPACE.
- Themes default to a transparent background (`paper_bg = FALSE`) so plots composite onto any Quarto, Reveal, or Typst background. Making an opaque background the default is a regression, not a preference.
- Theme functions thread `ink`/`paper`/`accent` into ggplot2 4.0's base-theme parameters rather than setting element colors ad hoc. ggplot2 >= 4.0 is a hard dependency, so use S7 `@` property access on plot and theme objects, not `$`.
- User-facing progress goes through `message()` so callers can suppress it. No `cat()` or `print()` in package code.
- Nothing personal or client-identifying is vendored into `inst/` -- brand assets only. Version 0.3.2 removed headshots for exactly this reason.
- The camelCase exports (`countCleanr`, `dbSafeNames`, `simpleCap`, `waldInterval`, `countDots`, `countNA`, `findDots`, `nvals`) are frozen public API; do not rename them. New functions are snake_case.
- `R/theme.R` and `R/logo.R` are long by design -- one file per surface, with dense roxygen. File length is not a finding in this package; flag a single function over roughly 80 lines instead.
# --- compass:end ---
'''
+93
View File
@@ -0,0 +1,93 @@
# AGENTS.md
`civilytics` is the house R package for Civilytics Consulting: a ggplot2 brand theme
system, curated palettes, logo composition, Quarto/Typst/Reveal templates, and
data-wrangling helpers for public-sector analysis. It is a library other projects
depend on, so a breaking change here breaks reports that are already published.
## Project tracking
This repo is managed with compass. `pm/compass.toml`
defines the workstreams; `pm/JOURNAL.md` records sessions; `pm/decisions/` holds
numbered, immutable decision records. Ask compass where things stand rather than
reading the config back.
Workstreams (the `ws/` label on every issue):
| `ws/` | covers |
|---|---|
| `theme` | `R/theme.R`, `R/colors.R`, `R/fonts.R` — themes, palettes, font loading |
| `logo` | `R/logo.R`, `R/flextable.R`, `inst/img/` — logo and branded output |
| `quarto` | `R/quarto.R`, `inst/quarto/` — HTML, PDF, Typst, Reveal templates |
| `helpers` | `R/utils.R`, `R/prop_conf.R`, `R/join_utilities.R`, `R/db.R`, `R/notifications.R` |
| `packaging` | `DESCRIPTION`, `NAMESPACE`, `Makefile`, `Dockerfile`, `.gitea/workflows/` |
## Commit cadence
One coherent unit per commit, subject line:
```
type(ws): subject (#N)
```
`type` is one of `feat`, `fix`, `refactor`, `docs`, `test`, `chore`, `perf`, `ci`.
`ws` is a workstream id from the table above. `#N` is the issue, when there is one.
## Conventions
`pm/compass.toml` is authoritative for these rules. Its `[roborev]
project_guidelines` are composed into `.roborev.toml`, so change them there and
re-run compass rather than editing `.roborev.toml` by hand. The prose below is the
same rules stated for a human reader; if the two ever disagree, `pm/compass.toml`
wins.
**Dependencies.** Base R plus ggplot2 (>= 4.0), grid/gridExtra, png/jpeg, stringr,
stringdist, showtext/sysfonts, jsonlite. No tidyverse: no dplyr, purrr, magrittr,
tibble, or data.table. Prefer an existing dependency or base R over adding one —
this package is installed into other people's environments.
**Brand colors** live in `civilytics_colors` and nowhere else. Never write a hex
literal in theme, scale, logo, or table code. (`R/flextable.R` still carries
off-brand Bootstrap defaults; that is known debt, not a pattern to copy.)
**Themes** default to a transparent background (`paper_bg = FALSE`) so plots
composite onto any Quarto, Reveal, or Typst background. Thread `ink`, `paper`, and
`accent` into ggplot2 4.0's base-theme parameters rather than setting element colors
one at a time. ggplot2 >= 4.0 is a hard dependency, so use S7 `@` property access on
plot and theme objects, not `$`.
**Naming.** New functions are snake_case. The camelCase exports (`countCleanr`,
`dbSafeNames`, `simpleCap`, `waldInterval`, `countDots`, `countNA`, `findDots`,
`nvals`) are frozen public API — do not rename them.
**Documentation.** Roxygen generates both `man/` and `NAMESPACE`. Declare imports
with `@importFrom` in the roxygen block; never hand-edit `NAMESPACE`. Every exported
function needs `@param` for each argument and `@return`; exported API needs
`@examples`. Re-run roxygen in the same commit as the code change — compass files
documentation debt when code moves and its `man/` pages do not.
**Output.** User-facing progress goes through `message()` so callers can suppress it.
No `cat()` or `print()` in package code.
**Assets.** Nothing personal or client-identifying is vendored into `inst/` — brand
assets only. Version 0.3.2 removed headshots for exactly this reason.
## Testing
testthat edition 3, one file per source file (`tests/testthat/test_theme.R` etc.).
Tests are self-sufficient: no reliance on state left by an earlier test. New
behaviour needs a test; a bug fix needs a test that fails without the fix.
```zsh
make check # R CMD check --no-manual against a built tarball
Rscript -e 'devtools::test()'
```
CI runs `R CMD check` on `rocker/r-ver:4.6` via `.gitea/workflows/check.yaml` for
every push and PR to `master`.
## Release
Bump `Version` in `DESCRIPTION` and add a `NEWS.md` entry under **New features**,
**Bug fixes**, or **Internal**. `NEWS.md` is the changelog; compass tracks the work
that led to it, not the release itself.
View File
+16
View File
@@ -0,0 +1,16 @@
# civilytics 0.3.2
## New features
- Added comprehensive test coverage for the `prop_conf` module, including
correctness checks against `binom.test()` for Clopper-Pearson intervals and
formula-based verification for Wald and Agresti-Coull intervals.
## Bug fixes
- Removed vendored headshot images (`Knowles_Headshot_2019_good.jpg`,
`Knowles_Headshot_2019_prisma.jpg`) from `inst/img/` to prevent personal
photos from being distributed with the package. The `plot_jpeg()` example
now references a generic placeholder path instead of a specific headshot.
## Internal
- Renamed `LICENSE.md` to `LICENSE` for R packaging convention compliance so
that the LGPL-3 license ships correctly with built tarballs.
+7 -7
View File
@@ -199,7 +199,7 @@ civilytics_palette <- function(name = "qual", n = NULL, reverse = FALSE) {
#' Civilytics palette function (closure)
#'
#' Returns a closure `function(n)` suitable for passing to
#' [ggplot2::discrete_scale()] or similar scale constructors.
#' [discrete_scale()] or similar scale constructors.
#'
#' @param name Character. Palette name. See `names(civilytics_palettes)`.
#' @param reverse Logical. Reverse the palette order. Default `FALSE`.
@@ -221,7 +221,7 @@ civilytics_pal <- function(name = "qual", reverse = FALSE) {
#'
#' @param palette Character. Palette name. Defaults to `"qual"`.
#' @param discrete Logical. `TRUE` (default) for categorical data; `FALSE`
#' for a continuous gradient via [ggplot2::scale_color_gradientn()].
#' for a continuous gradient via [scale_color_gradientn()].
#' @param reverse Logical. Reverse the palette order. Default `FALSE`.
#' @param ... Additional arguments passed to the ggplot2 scale function.
#'
@@ -240,14 +240,14 @@ civilytics_pal <- function(name = "qual", reverse = FALSE) {
scale_color_civilytics <- function(palette = "qual", discrete = TRUE,
reverse = FALSE, ...) {
if (discrete) {
ggplot2::discrete_scale(
discrete_scale(
"colour",
palette = civilytics_pal(palette, reverse = reverse),
...
)
} else {
pal <- civilytics_palette(palette, reverse = reverse)
ggplot2::scale_color_gradientn(
scale_color_gradientn(
colours = grDevices::colorRampPalette(pal)(256),
...
)
@@ -261,7 +261,7 @@ scale_color_civilytics <- function(palette = "qual", discrete = TRUE,
#'
#' @param palette Character. Palette name. Defaults to `"qual"`.
#' @param discrete Logical. `TRUE` (default) for categorical data; `FALSE`
#' for a continuous gradient via [ggplot2::scale_fill_gradientn()].
#' for a continuous gradient via [scale_fill_gradientn()].
#' @param reverse Logical. Reverse the palette order. Default `FALSE`.
#' @param ... Additional arguments passed to the ggplot2 scale function.
#'
@@ -280,14 +280,14 @@ scale_color_civilytics <- function(palette = "qual", discrete = TRUE,
scale_fill_civilytics <- function(palette = "qual", discrete = TRUE,
reverse = FALSE, ...) {
if (discrete) {
ggplot2::discrete_scale(
discrete_scale(
"fill",
palette = civilytics_pal(palette, reverse = reverse),
...
)
} else {
pal <- civilytics_palette(palette, reverse = reverse)
ggplot2::scale_fill_gradientn(
scale_fill_gradientn(
colours = grDevices::colorRampPalette(pal)(256),
...
)
+11 -5
View File
@@ -19,7 +19,7 @@
#' @return a numeric column of data
#' @export
countCleanr <- function(x){
if(class(x) == "character"){
if ("character" %in% class(x)) {
x[x == "None not reported"] <- "0"
x[x == "Not applicable"] <- NA
x <- as.numeric(x)
@@ -110,8 +110,14 @@ nvals <- function(x){
#' my_string <- c("Happy school", "Easy school", "cool School", "big school")
#' simpleCap(my_string)
simpleCap <- function(x) {
stopifnot(class(x) == "character")
s <- strsplit(x, " ")[[1]]
paste(toupper(substring(s, 1,1)), substring(s, 2),
sep = "", collapse = " ")
stopifnot("character" %in% class(x))
# Vectorised over elements of x — each element is capitalised independently.
# unname() strips names inherited from the input vector so the output
# matches the original scalar behaviour (no names attribute).
unname(vapply(x, function(word) {
s <- strsplit(word, " ")[[1]]
paste(toupper(substring(s, 1, 1)), substring(s, 2),
sep = "", collapse = " ")
}, character(1)))
}
+24 -11
View File
@@ -5,32 +5,45 @@ CV_FONT_SANS <- "Inter" # axis text, legends, UI elements
CV_FONT_SERIF <- "Source Serif 4" # body prose / editorial long-form
CV_FONT_MONO <- "JetBrains Mono" # code, data tables, numeric callouts
# Internal flag so civilytics_load_fonts() is idempotent within a session.
.cv_fonts_loaded <- FALSE
# Mutable package state held in an environment so the binding itself stays
# locked (R locks all namespace bindings at load time) while the contents
# 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
#'
#' Downloads Inter and Libre Franklin from Google Fonts via
#' [sysfonts::font_add_google()], then calls [showtext::showtext_auto()] so
#' that all graphics devices render text with those fonts. This is called
#' automatically when the package loads; use this function to retry if the
#' initial load failed (e.g., the machine was offline at load time).
#' Downloads Inter, Libre Franklin, Source Serif 4 and JetBrains Mono from
#' Google Fonts via [sysfonts::font_add_google()], then calls
#' [showtext::showtext_auto()] so that all graphics devices render text with
#' those fonts. This is called automatically when the package loads; use this
#' function to retry if the initial load failed (e.g., the machine was offline
#' at load time).
#'
#' @return Invisibly returns `NULL`.
#' Subsequent calls within the same session are no-ops unless `force = TRUE`.
#'
#' @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
#'
#' @examples
#' \dontrun{
#' civilytics_load_fonts()
#' }
civilytics_load_fonts <- function() {
civilytics_load_fonts <- function(force = FALSE) {
if (.cv_state$fonts_loaded && !force) return(invisible(FALSE))
sysfonts::font_add_google("Inter", family = "Inter")
sysfonts::font_add_google("Libre Franklin", family = "Libre Franklin")
sysfonts::font_add_google("Source Serif 4", family = "Source Serif 4")
sysfonts::font_add_google("JetBrains Mono", family = "JetBrains Mono")
showtext::showtext_auto()
.cv_fonts_loaded <<- TRUE
invisible(NULL)
.cv_state$fonts_loaded <- TRUE
invisible(TRUE)
}
.onLoad <- function(libname, pkgname) {
+52 -48
View File
@@ -1,48 +1,52 @@
# Join utilities
#' Test the join between two sets of identifiers
#'
#' @param x a vector of identifiers to check against y
#' @param y a vector of identifiers to check against x
#' @param distinct logical, should duplicate values of x and y be removed before testing
#'
#' @return nothing, print a summary of match statistics to the console
#' @export
#'
#' @examples
#' x <- LETTERS
#' y <- c(letters, LETTERS)
#' match_test(x, y)
match_test <- function(x, y, distinct = TRUE) {
if (distinct) {
x <- unique(x)
y <- unique(y)
cat("**** Distinct Matches ****")
cat("\n")
}
# TODO: DO not report 100% if there is even 1 mismatch
xiny <- sum(x %in% y)
total_x <- length(x)
yinx <- sum(y %in% x)
total_y <- length(y)
cat("**** Match Summary ****")
cat("\n")
cat("X in Y")
cat("\n")
cat(paste0("Of the ", total_x, " X values, ", xiny, " (",
100*round(xiny/total_x, 2), "%) were matched."))
cat("\n")
cat("********************************************")
cat("\n")
cat("Y in X")
cat("\n")
cat(paste0("Of the ", total_y, " Y values, ", yinx, " (",
100*round(yinx/total_y, 2), "%) were matched."))
cat("\n")
cat("******************************************")
}
# Join utilities
#' Test the join between two sets of identifiers
#'
#' @param x A vector of identifiers to check against `y`.
#' @param y A vector of identifiers to look for a match in.
#' @param distinct Logical. Should duplicate values of `x` and `y` be removed
#' before testing? Default is `TRUE`.
#'
#' @return Invisibly returns `NULL`; prints a formatted summary of match
#' statistics to the console via [writeLines()].
#' @export
#'
#' @examples
#' x <- LETTERS
#' y <- c(letters, LETTERS)
#' match_test(x, y)
match_test <- function(x, y, distinct = TRUE) {
if (distinct) {
x <- unique(x)
y <- unique(y)
}
# TODO: DO not report 100% if there is even 1 mismatch
xiny <- sum(x %in% y)
total_x <- length(x)
pct_x <- round(100 * xiny / total_x, 2)
yinx <- sum(y %in% x)
total_y <- length(y)
pct_y <- round(100 * yinx / total_y, 2)
header <- if (distinct) "Distinct Matches" else "All Values"
lines <- c(
paste0("**** ", header, " ****"),
"",
"X in Y",
sprintf("Of the %d X values, %d (%s%%) were matched.",
total_x, xiny, format(pct_x, nsmall = 2)),
strrep("*", 40),
"",
"Y in X",
sprintf("Of the %d Y values, %d (%s%%) were matched.",
total_y, yinx, format(pct_y, nsmall = 2)),
strrep("*", 38)
)
writeLines(lines)
invisible(NULL)
}
+100 -99
View File
@@ -10,7 +10,8 @@
#' @importFrom graphics rasterImage
#' @examples
#' \dontrun{
#' img <- system.file("img","Knowles_Headshot_2019_good.jpg",package="civilytics")
#' # Supply a path to your own JPEG file
#' img <- "my_photo.jpg"
#' plot_jpeg(img)
#' }
plot_jpeg <- function(path, add=FALSE, upscale = TRUE)
@@ -74,8 +75,8 @@ add_logo <- function(plot, logo, margin_param = NULL, font_scale = 1.1,
# element cascades to titles, axis labels, legends, captions, and strips.
if (!is.null(font_scale) && font_scale != 1) {
base_size <- plot$theme$text$size %||% 14
plot <- plot + ggplot2::theme(
text = ggplot2::element_text(size = base_size * font_scale)
plot <- plot + theme(
text = element_text(size = base_size * font_scale)
)
}
@@ -125,7 +126,7 @@ add_logo <- function(plot, logo, margin_param = NULL, font_scale = 1.1,
#' @export
#'
#' @examples
#' p1 <- ggplot2::ggplot(mtcars, ggplot2::aes(mpg, wt)) + ggplot2::geom_point()
#' p1 <- ggplot(mtcars, aes(mpg, wt)) + geom_point()
#' measure_caption(p1) # Should equal 1 since no caption is present
measure_caption <- function(gg) {
if (has_caption(gg)) {
@@ -145,7 +146,7 @@ measure_caption <- function(gg) {
#' @export
#'
#' @examples
#' p1 <- ggplot2::ggplot(mtcars, ggplot2::aes(mpg, wt)) + ggplot2::geom_point()
#' p1 <- ggplot(mtcars, aes(mpg, wt)) + geom_point()
#' has_caption(p1) # FALSE
has_caption <- function(gg) {
any(names(gg$labels) == "caption")
@@ -186,8 +187,8 @@ add_logo_ga <- function(plot_list, logo, nrow = 1, widths = NULL,
if (!is.null(font_scale) && font_scale != 1) {
plot_list <- lapply(plot_list, function(p) {
base_size <- p$theme$text$size %||% 14
p + ggplot2::theme(
text = ggplot2::element_text(size = base_size * font_scale)
p + theme(
text = element_text(size = base_size * font_scale)
)
})
}
@@ -275,9 +276,9 @@ make_logo_grob <- function(type = c("wordmark", "mark"),
xmax <- 1
}
ggplot2::ggplot() +
ggplot2::theme_void() +
ggplot2::annotation_custom(
ggplot() +
theme_void() +
annotation_custom(
get_png(system.file("img", img_file, package = "civilytics")),
xmin = xmin, xmax = xmax
)
@@ -361,92 +362,92 @@ civilytics_logo <- function(plot,
position = position)
}
#' Stamp the Civilytics logo onto a saved raster (PNG) image
#'
#' The raster analogue of [civilytics_logo()] for outputs that are already
#' rendered to a file rather than held as a ggplot/grob — e.g. a `flextable`
#' exported to PNG, or any `grDevices::png()` / `ragg::agg_png()` output.
#' Resolves the *same* brand asset that [make_logo_grob()] uses, so file-based
#' tables stay visually consistent with logo-branded plots, and composites it
#' into a corner of the image. Pure base-graphics + grid + png — no new
#' package dependencies.
#'
#' @param path Character. Path to the PNG to stamp. The file is overwritten
#' in place at its original pixel dimensions.
#' @param type Character. `"wordmark"` (default) or `"mark"`. As in
#' [make_logo_grob()].
#' @param variant Character. `"light"` (default, dark logo for light
#' backgrounds) or `"dark"` (reverse logo for dark backgrounds).
#' @param position Character. Corner placement: `"bottom-right"` (default),
#' `"bottom-left"`, `"top-right"`, or `"top-left"`.
#' @param width_frac Numeric. Logo width as a fraction of the image width
#' (default `0.15`). Height follows from the logo's aspect ratio.
#' @param margin_frac Numeric. Padding from the edges as a fraction of the
#' image width (default `0.02`).
#'
#' @return `path`, invisibly.
#' @export
#' @importFrom png readPNG
#' @importFrom grid grid.newpage grid.raster
#' @importFrom grDevices png dev.off
#' @examples
#' \dontrun{
#' # Brand a table exported to PNG so it matches civilytics_logo()-branded plots
#' ragg::agg_png("table.png", width = 8, height = 4, units = "in", res = 200)
#' plot(flextable::flextable(head(mtcars)))
#' dev.off()
#' stamp_logo_png("table.png") # wordmark, bottom-right
#' stamp_logo_png("table.png", type = "mark", position = "bottom-left")
#' }
stamp_logo_png <- function(path,
type = c("wordmark", "mark"),
variant = c("light", "dark"),
position = c("bottom-right", "bottom-left",
"top-right", "top-left"),
width_frac = 0.15,
margin_frac = 0.02) {
type <- match.arg(type)
variant <- match.arg(variant)
position <- match.arg(position)
stopifnot(file.exists(path))
# Same asset selection as make_logo_grob() so files match branded plots.
img_file <- switch(
paste(type, variant, sep = "_"),
wordmark_light = "civilytics-wordmark.png",
wordmark_dark = "civilytics-wordmark-reverse.png",
mark_light = "civilytics-mark.png",
mark_dark = "civilytics-mark-reverse.png"
)
logo_path <- system.file("img", img_file, package = "civilytics")
if (!nzchar(logo_path)) {
stop("Civilytics logo asset not found in the 'civilytics' package: ", img_file)
}
base_img <- png::readPNG(path) # height x width x channels, values in [0, 1]
logo_img <- png::readPNG(logo_path)
h <- dim(base_img)[1]
w <- dim(base_img)[2]
aspect <- dim(logo_img)[1] / dim(logo_img)[2] # logo height / width
# Sizes/margins are expressed relative to image WIDTH, then converted to the
# device's npc units (which scale with the viewport's own width and height).
lw <- width_frac
lh <- width_frac * aspect * (w / h)
mx <- margin_frac
my <- margin_frac * (w / h)
x <- if (grepl("right", position)) 1 - mx else mx
y <- if (grepl("top", position)) 1 - my else my
just <- c(if (grepl("right", position)) "right" else "left",
if (grepl("top", position)) "top" else "bottom")
grDevices::png(path, width = w, height = h, units = "px")
on.exit(grDevices::dev.off(), add = TRUE)
grid::grid.newpage()
grid::grid.raster(base_img, width = 1, height = 1, interpolate = FALSE)
grid::grid.raster(logo_img, x = x, y = y, width = lw, height = lh,
just = just, interpolate = TRUE)
invisible(path)
}
#' Stamp the Civilytics logo onto a saved raster (PNG) image
#'
#' The raster analogue of [civilytics_logo()] for outputs that are already
#' rendered to a file rather than held as a ggplot/grob — e.g. a `flextable`
#' exported to PNG, or any `grDevices::png()` / `ragg::agg_png()` output.
#' Resolves the *same* brand asset that [make_logo_grob()] uses, so file-based
#' tables stay visually consistent with logo-branded plots, and composites it
#' into a corner of the image. Pure base-graphics + grid + png — no new
#' package dependencies.
#'
#' @param path Character. Path to the PNG to stamp. The file is overwritten
#' in place at its original pixel dimensions.
#' @param type Character. `"wordmark"` (default) or `"mark"`. As in
#' [make_logo_grob()].
#' @param variant Character. `"light"` (default, dark logo for light
#' backgrounds) or `"dark"` (reverse logo for dark backgrounds).
#' @param position Character. Corner placement: `"bottom-right"` (default),
#' `"bottom-left"`, `"top-right"`, or `"top-left"`.
#' @param width_frac Numeric. Logo width as a fraction of the image width
#' (default `0.15`). Height follows from the logo's aspect ratio.
#' @param margin_frac Numeric. Padding from the edges as a fraction of the
#' image width (default `0.02`).
#'
#' @return `path`, invisibly.
#' @export
#' @importFrom png readPNG
#' @importFrom grid grid.newpage grid.raster
#' @importFrom grDevices png dev.off
#' @examples
#' \dontrun{
#' # Brand a table exported to PNG so it matches civilytics_logo()-branded plots
#' ragg::agg_png("table.png", width = 8, height = 4, units = "in", res = 200)
#' plot(flextable::flextable(head(mtcars)))
#' dev.off()
#' stamp_logo_png("table.png") # wordmark, bottom-right
#' stamp_logo_png("table.png", type = "mark", position = "bottom-left")
#' }
stamp_logo_png <- function(path,
type = c("wordmark", "mark"),
variant = c("light", "dark"),
position = c("bottom-right", "bottom-left",
"top-right", "top-left"),
width_frac = 0.15,
margin_frac = 0.02) {
type <- match.arg(type)
variant <- match.arg(variant)
position <- match.arg(position)
stopifnot(file.exists(path))
# Same asset selection as make_logo_grob() so files match branded plots.
img_file <- switch(
paste(type, variant, sep = "_"),
wordmark_light = "civilytics-wordmark.png",
wordmark_dark = "civilytics-wordmark-reverse.png",
mark_light = "civilytics-mark.png",
mark_dark = "civilytics-mark-reverse.png"
)
logo_path <- system.file("img", img_file, package = "civilytics")
if (!nzchar(logo_path)) {
stop("Civilytics logo asset not found in the 'civilytics' package: ", img_file)
}
base_img <- png::readPNG(path) # height x width x channels, values in [0, 1]
logo_img <- png::readPNG(logo_path)
h <- dim(base_img)[1]
w <- dim(base_img)[2]
aspect <- dim(logo_img)[1] / dim(logo_img)[2] # logo height / width
# Sizes/margins are expressed relative to image WIDTH, then converted to the
# device's npc units (which scale with the viewport's own width and height).
lw <- width_frac
lh <- width_frac * aspect * (w / h)
mx <- margin_frac
my <- margin_frac * (w / h)
x <- if (grepl("right", position)) 1 - mx else mx
y <- if (grepl("top", position)) 1 - my else my
just <- c(if (grepl("right", position)) "right" else "left",
if (grepl("top", position)) "top" else "bottom")
grDevices::png(path, width = w, height = h, units = "px")
on.exit(grDevices::dev.off(), add = TRUE)
grid::grid.newpage()
grid::grid.raster(base_img, width = 1, height = 1, interpolate = FALSE)
grid::grid.raster(logo_img, x = x, y = y, width = lw, height = lh,
just = just, interpolate = TRUE)
invisible(path)
}
+112 -110
View File
@@ -1,6 +1,6 @@
#' Civilytics ggplot2 theme
#'
#' A complete ggplot2 theme built on [ggplot2::theme_grey()] using the
#' A complete ggplot2 theme built on [theme_grey()] using the
#' Civilytics brand color palette and typography. Requires ggplot2 >= 4.0.0
#' for the `ink`, `paper`, and `accent` base-theme parameters.
#'
@@ -36,10 +36,12 @@
#' to [civilytics_colors]`["paper_2"]` (`#F2EDE4`).
#' @param grid Character. Which major gridlines to draw: `"y"` (default,
#' horizontal only), `"x"` (vertical only), `"both"`, or `"none"`.
#' @param paper_bg Logical. If `TRUE` (default), fill the plot and panel
#' backgrounds with the warm `paper` color. Set to `FALSE` for a
#' transparent background (useful for slides or overlay on colored
#' surfaces).
#' @param paper_bg Logical. If `TRUE`, fill the plot and panel backgrounds
#' with the warm `paper` color (Civilytics cream). Default is `FALSE`
#' (transparent) so that figures composite cleanly onto any background.
#' 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:
#' All text sizes are derived from `font_size` using relative scale factors.
@@ -61,14 +63,14 @@
#' logo below the plot, pass `font_scale` to compensate for viewport
#' shrinkage.
#'
#' @return A complete ggplot2 [ggplot2::theme()] object.
#' @return A complete ggplot2 [theme()] object.
#' @export
#'
#' @examples
#' \dontrun{
#' library(ggplot2)
#'
#' # Default editorial theme
#' # Default — transparent background for embedding
#' ggplot(mpg, aes(displ, hwy)) +
#' geom_point() +
#' theme_civilytics()
@@ -79,10 +81,10 @@
#' scale_color_civilytics() +
#' theme_civilytics(grid = "both")
#'
#' # Transparent background for embedding
#' # Branded cream background (opt-in)
#' ggplot(mpg, aes(displ, hwy)) +
#' geom_point() +
#' theme_civilytics(paper_bg = FALSE)
#' theme_civilytics(paper_bg = TRUE)
#'
#' # Larger text for poster or display
#' ggplot(mpg, aes(displ, hwy)) +
@@ -102,7 +104,7 @@ theme_civilytics <- function(
accent = unname(civilytics_colors["ember_600"]),
strip_color = unname(civilytics_colors["paper_2"]),
grid = c("y", "x", "both", "none"),
paper_bg = TRUE) {
paper_bg = FALSE) {
grid <- match.arg(grid)
half_line <- font_size / 2
@@ -113,30 +115,30 @@ theme_civilytics <- function(
bg_color <- if (isTRUE(paper_bg)) paper else NA
# Grid line elements
grid_line <- ggplot2::element_line(color = rule_color, linewidth = 0.35)
no_line <- ggplot2::element_blank()
grid_line <- element_line(color = rule_color, linewidth = 0.35)
no_line <- element_blank()
ggplot2::theme_grey(
theme_grey(
base_size = font_size,
base_family = font_family,
ink = ink,
paper = paper,
accent = accent
) %+replace%
ggplot2::theme(
line = ggplot2::element_line(
theme(
line = element_line(
color = ink,
linewidth = line_size,
linetype = 1,
lineend = "butt"
),
rect = ggplot2::element_rect(
rect = element_rect(
fill = NA,
color = NA,
linewidth = line_size,
linetype = 1
),
text = ggplot2::element_text(
text = element_text(
family = font_family,
face = "plain",
color = ink,
@@ -145,161 +147,161 @@ theme_civilytics <- function(
vjust = 0.5,
angle = 0,
lineheight = 0.9,
margin = ggplot2::margin(),
margin = margin(),
debug = FALSE
),
# -- Axes --
axis.line = ggplot2::element_blank(),
axis.line.x = ggplot2::element_line(
axis.line = element_blank(),
axis.line.x = element_line(
color = ink,
linewidth = 0.6,
lineend = "square"
),
axis.line.y = ggplot2::element_blank(),
axis.text = ggplot2::element_text(
axis.line.y = element_blank(),
axis.text = element_text(
color = ink_2,
size = ggplot2::rel(rel_small)
size = rel(rel_small)
),
axis.text.x = ggplot2::element_text(
margin = ggplot2::margin(t = small_size / 4),
axis.text.x = element_text(
margin = margin(t = small_size / 4),
vjust = 1
),
axis.text.x.top = ggplot2::element_text(
margin = ggplot2::margin(b = small_size / 4),
axis.text.x.top = element_text(
margin = margin(b = small_size / 4),
vjust = 0
),
axis.text.y = ggplot2::element_text(
margin = ggplot2::margin(r = small_size / 4),
axis.text.y = element_text(
margin = margin(r = small_size / 4),
hjust = 1
),
axis.text.y.right = ggplot2::element_text(
margin = ggplot2::margin(l = small_size / 4),
axis.text.y.right = element_text(
margin = margin(l = small_size / 4),
hjust = 0
),
axis.ticks = ggplot2::element_line(
axis.ticks = element_line(
color = ink_3,
linewidth = 0.4
),
axis.ticks.length = ggplot2::unit(4, "pt"),
axis.title.x = ggplot2::element_text(
size = ggplot2::rel(rel_small),
axis.ticks.length = unit(4, "pt"),
axis.title.x = element_text(
size = rel(rel_small),
color = ink_3,
margin = ggplot2::margin(t = 10),
margin = margin(t = 10),
vjust = 1
),
axis.title.x.top = ggplot2::element_text(
size = ggplot2::rel(rel_small),
axis.title.x.top = element_text(
size = rel(rel_small),
color = ink_3,
margin = ggplot2::margin(b = half_line / 2),
margin = margin(b = half_line / 2),
vjust = 0
),
axis.title.y = ggplot2::element_text(
size = ggplot2::rel(rel_small),
axis.title.y = element_text(
size = rel(rel_small),
color = ink_3,
angle = 90,
margin = ggplot2::margin(r = 10),
margin = margin(r = 10),
vjust = 1
),
axis.title.y.right = ggplot2::element_text(
size = ggplot2::rel(rel_small),
axis.title.y.right = element_text(
size = rel(rel_small),
color = ink_3,
angle = -90,
margin = ggplot2::margin(l = half_line / 2),
margin = margin(l = half_line / 2),
vjust = 0
),
# -- Legend --
legend.background = ggplot2::element_blank(),
legend.spacing = ggplot2::unit(font_size, "pt"),
legend.background = element_blank(),
legend.spacing = unit(font_size, "pt"),
legend.spacing.x = NULL,
legend.spacing.y = NULL,
legend.margin = ggplot2::margin(0, 0, 4, 0),
legend.key = ggplot2::element_blank(),
legend.key.size = ggplot2::unit(12, "pt"),
legend.margin = margin(0, 0, 4, 0),
legend.key = element_blank(),
legend.key.size = unit(12, "pt"),
legend.key.height = NULL,
legend.key.width = NULL,
legend.text = ggplot2::element_text(
size = ggplot2::rel(rel_small),
legend.text = element_text(
size = rel(rel_small),
color = ink_2
),
legend.title = ggplot2::element_text(
legend.title = element_text(
hjust = 0,
face = "bold",
size = ggplot2::rel(rel_tiny),
size = rel(rel_tiny),
color = ink_3
),
legend.position = "top",
legend.direction = NULL,
legend.justification = c("left", "center"),
legend.box = NULL,
legend.box.margin = ggplot2::margin(0, 0, 0, 0),
legend.box.background = ggplot2::element_blank(),
legend.box.spacing = ggplot2::unit(font_size, "pt"),
legend.box.margin = margin(0, 0, 0, 0),
legend.box.background = element_blank(),
legend.box.spacing = unit(font_size, "pt"),
# -- Panel --
panel.background = ggplot2::element_rect(fill = bg_color, color = NA),
panel.border = ggplot2::element_blank(),
panel.grid.minor = ggplot2::element_blank(),
panel.background = element_rect(fill = bg_color, color = NA),
panel.border = element_blank(),
panel.grid.minor = element_blank(),
panel.grid.major.x = if (grid %in% c("x", "both")) grid_line else no_line,
panel.grid.major.y = if (grid %in% c("y", "both")) grid_line else no_line,
panel.spacing = ggplot2::unit(16, "pt"),
panel.spacing = unit(16, "pt"),
panel.spacing.x = NULL,
panel.spacing.y = NULL,
panel.ontop = FALSE,
# -- Facet strips --
strip.background = ggplot2::element_rect(fill = strip_color, color = NA),
strip.text = ggplot2::element_text(
strip.background = element_rect(fill = strip_color, color = NA),
strip.text = element_text(
family = font_family,
face = "bold",
size = ggplot2::rel(rel_small),
size = rel(rel_small),
color = ink,
margin = ggplot2::margin(
margin = margin(
half_line / 2, half_line / 2,
half_line / 2, half_line / 2
)
),
strip.text.x = NULL,
strip.text.y = ggplot2::element_text(angle = -90),
strip.text.y = element_text(angle = -90),
strip.placement = "inside",
strip.placement.x = NULL,
strip.placement.y = NULL,
strip.switch.pad.grid = ggplot2::unit(half_line / 2, "pt"),
strip.switch.pad.wrap = ggplot2::unit(half_line / 2, "pt"),
strip.switch.pad.grid = unit(half_line / 2, "pt"),
strip.switch.pad.wrap = unit(half_line / 2, "pt"),
# -- Plot-level --
plot.background = ggplot2::element_rect(fill = bg_color, color = NA),
plot.title = ggplot2::element_text(
plot.background = element_rect(fill = bg_color, color = NA),
plot.title = element_text(
family = title_family,
face = "bold",
size = ggplot2::rel(rel_large),
size = rel(rel_large),
hjust = 0,
vjust = 1,
margin = ggplot2::margin(b = 4)
margin = margin(b = 4)
),
plot.title.position = "plot",
plot.subtitle = ggplot2::element_text(
size = ggplot2::rel(1),
plot.subtitle = element_text(
size = rel(1),
color = ink_2,
hjust = 0,
vjust = 1,
lineheight = 1.3,
margin = ggplot2::margin(b = 14)
margin = margin(b = 14)
),
plot.caption = ggplot2::element_text(
size = ggplot2::rel(rel_tiny),
plot.caption = element_text(
size = rel(rel_tiny),
color = ink_3,
hjust = 0,
vjust = 1,
lineheight = 1.3,
margin = ggplot2::margin(t = 14)
margin = margin(t = 14)
),
plot.caption.position = "plot",
plot.tag = ggplot2::element_text(
plot.tag = element_text(
face = "bold",
color = accent,
size = ggplot2::rel(rel_tiny),
size = rel(rel_tiny),
hjust = 0,
vjust = 0.7
),
plot.tag.position = c(0, 1),
plot.margin = ggplot2::margin(16, 18, 16, 16),
plot.margin = margin(16, 18, 16, 16),
complete = TRUE
)
}
@@ -315,7 +317,7 @@ theme_civilytics <- function(
#'
#' @inheritParams theme_civilytics
#'
#' @return A complete ggplot2 [ggplot2::theme()] object.
#' @return A complete ggplot2 [theme()] object.
#' @export
#'
#' @examples
@@ -359,20 +361,20 @@ theme_civilytics_dark <- function(
# The base theme hardcodes ink_2/ink_3 for subtitle/caption, which are
# dark colors meant for light backgrounds. Override with lighter values
# so text remains readable on the navy background.
ggplot2::theme(
plot.subtitle = ggplot2::element_text(
theme(
plot.subtitle = element_text(
color = unname(civilytics_colors["navy_200"])
),
plot.caption = ggplot2::element_text(
plot.caption = element_text(
color = unname(civilytics_colors["navy_300"])
),
axis.text = ggplot2::element_text(
axis.text = element_text(
color = unname(civilytics_colors["navy_200"])
),
axis.title.x = ggplot2::element_text(
axis.title.x = element_text(
color = unname(civilytics_colors["navy_300"])
),
axis.title.y = ggplot2::element_text(
axis.title.y = element_text(
color = unname(civilytics_colors["navy_300"])
)
)
@@ -387,7 +389,7 @@ theme_civilytics_dark <- function(
#'
#' @inheritParams theme_civilytics
#'
#' @return A complete ggplot2 [ggplot2::theme()] object.
#' @return A complete ggplot2 [theme()] object.
#' @export
#'
#' @examples
@@ -428,13 +430,13 @@ theme_civilytics_slide <- function(
grid = grid,
paper_bg = paper_bg
) +
ggplot2::theme(
axis.line.x = ggplot2::element_line(
theme(
axis.line.x = element_line(
color = ink,
linewidth = 0.8,
lineend = "square"
),
plot.margin = ggplot2::margin(24, 24, 24, 24)
plot.margin = margin(24, 24, 24, 24)
)
}
@@ -446,23 +448,23 @@ theme_civilytics_slide <- function(
#' Strips away axes, ticks, gridlines, and axis titles/labels — the elements
#' that are meaningless on a choropleth or spatial plot.
#'
#' @return A partial ggplot2 [ggplot2::theme()] object.
#' @return A partial ggplot2 [theme()] object.
#' @keywords internal
.map_theme_extras <- function() {
ggplot2::theme(
axis.line = ggplot2::element_blank(),
axis.line.x = ggplot2::element_blank(),
axis.line.y = ggplot2::element_blank(),
axis.text = ggplot2::element_blank(),
axis.text.x = ggplot2::element_blank(),
axis.text.y = ggplot2::element_blank(),
axis.ticks = ggplot2::element_blank(),
axis.ticks.length = ggplot2::unit(0, "pt"),
axis.title.x = ggplot2::element_blank(),
axis.title.y = ggplot2::element_blank(),
panel.grid.major.x = ggplot2::element_blank(),
panel.grid.major.y = ggplot2::element_blank(),
panel.grid.minor = ggplot2::element_blank()
theme(
axis.line = element_blank(),
axis.line.x = element_blank(),
axis.line.y = element_blank(),
axis.text = element_blank(),
axis.text.x = element_blank(),
axis.text.y = element_blank(),
axis.ticks = element_blank(),
axis.ticks.length = unit(0, "pt"),
axis.title.x = element_blank(),
axis.title.y = element_blank(),
panel.grid.major.x = element_blank(),
panel.grid.major.y = element_blank(),
panel.grid.minor = element_blank()
)
}
@@ -476,7 +478,7 @@ theme_civilytics_slide <- function(
#'
#' @inheritParams theme_civilytics
#'
#' @return A complete ggplot2 [ggplot2::theme()] object.
#' @return A complete ggplot2 [theme()] object.
#' @export
#'
#' @examples
@@ -528,7 +530,7 @@ theme_civilytics_map <- function(
#'
#' @inheritParams theme_civilytics_dark
#'
#' @return A complete ggplot2 [ggplot2::theme()] object.
#' @return A complete ggplot2 [theme()] object.
#' @export
#'
#' @examples
@@ -579,7 +581,7 @@ theme_civilytics_dark_map <- function(
#'
#' @inheritParams theme_civilytics_slide
#'
#' @return A complete ggplot2 [ggplot2::theme()] object.
#' @return A complete ggplot2 [theme()] object.
#' @export
#'
#' @examples
+866
View File
File diff suppressed because one or more lines are too long
Binary file not shown.

After

Width:  |  Height:  |  Size: 682 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 3.2 MiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 321 KiB

+15 -7
View File
@@ -4,17 +4,25 @@
\alias{civilytics_load_fonts}
\title{Load Civilytics brand fonts}
\usage{
civilytics_load_fonts()
civilytics_load_fonts(force = FALSE)
}
\arguments{
\item{force}{Logical. If \code{TRUE}, reload fonts even if they were already
loaded in this session. Default \code{FALSE}.}
}
\value{
Invisibly returns `NULL`.
Invisibly returns \code{TRUE} if fonts were loaded, \code{FALSE} if skipped
(already loaded and \code{force = FALSE}).
}
\description{
Downloads Inter and Libre Franklin from Google Fonts via
[sysfonts::font_add_google()], then calls [showtext::showtext_auto()] so
that all graphics devices render text with those fonts. This is called
automatically when the package loads; use this function to retry if the
initial load failed (e.g., the machine was offline at load time).
Downloads Inter, Libre Franklin, Source Serif 4 and JetBrains Mono from
Google Fonts via \code{sysfonts::font_add_google()}, then calls
\code{showtext::showtext_auto()} so that all graphics devices render text with
those fonts. This is called automatically when the package loads; use this
function to retry if the initial load failed (e.g., the machine was offline
at load time).
Subsequent calls within the same session are no-ops unless \code{force = TRUE}.
}
\examples{
\dontrun{
+2 -1
View File
@@ -22,7 +22,8 @@ Plot a jpeg image as a raster
}
\examples{
\dontrun{
img <- system.file("img","Knowles_Headshot_2019_good.jpg",package="civilytics")
# Supply a path to your own JPEG file
img <- "my_photo.jpg"
plot_jpeg(img)
}
}
+10 -8
View File
@@ -17,7 +17,7 @@ theme_civilytics(
accent = unname(civilytics_colors["ember_600"]),
strip_color = unname(civilytics_colors["paper_2"]),
grid = c("y", "x", "both", "none"),
paper_bg = TRUE
paper_bg = FALSE
)
}
\arguments{
@@ -56,10 +56,12 @@ to [civilytics_colors]`["paper_2"]` (`#F2EDE4`).}
\item{grid}{Character. Which major gridlines to draw: `"y"` (default,
horizontal only), `"x"` (vertical only), `"both"`, or `"none"`.}
\item{paper_bg}{Logical. If `TRUE` (default), fill the plot and panel
backgrounds with the warm `paper` color. Set to `FALSE` for a
transparent background (useful for slides or overlay on colored
surfaces).}
\item{paper_bg}{Logical. If `TRUE`, fill the plot and panel backgrounds
with the warm `paper` color (Civilytics cream). Default is `FALSE`
(transparent) so that figures composite cleanly onto any background.
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.}
}
\value{
A complete ggplot2 [ggplot2::theme()] object.
@@ -105,7 +107,7 @@ shrinkage.
\dontrun{
library(ggplot2)
# Default editorial theme
# Default — transparent background for embedding
ggplot(mpg, aes(displ, hwy)) +
geom_point() +
theme_civilytics()
@@ -116,10 +118,10 @@ ggplot(mpg, aes(displ, hwy, colour = class)) +
scale_color_civilytics() +
theme_civilytics(grid = "both")
# Transparent background for embedding
# Branded cream background (opt-in)
ggplot(mpg, aes(displ, hwy)) +
geom_point() +
theme_civilytics(paper_bg = FALSE)
theme_civilytics(paper_bg = TRUE)
# Larger text for poster or display
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,
horizontal only), `"x"` (vertical only), `"both"`, or `"none"`.}
\item{paper_bg}{Logical. If `TRUE` (default), fill the plot and panel
backgrounds with the warm `paper` color. Set to `FALSE` for a
transparent background (useful for slides or overlay on colored
surfaces).}
\item{paper_bg}{Logical. If `TRUE`, fill the plot and panel backgrounds
with the warm `paper` color (Civilytics cream). Default is `FALSE`
(transparent) so that figures composite cleanly onto any background.
Set to `TRUE` for the branded cream canvas.}
}
\value{
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
to [civilytics_colors]`["paper_2"]` (`#F2EDE4`).}
\item{paper_bg}{Logical. If `TRUE` (default), fill the plot and panel
backgrounds with the warm `paper` color. Set to `FALSE` for a
transparent background (useful for slides or overlay on colored
surfaces).}
\item{paper_bg}{Logical. If `TRUE`, fill the plot and panel backgrounds
with the warm `paper` color (Civilytics cream). Default is `FALSE`
(transparent) so that figures composite cleanly onto any background.
Set to `TRUE` for the branded cream canvas.}
}
\value{
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
to [civilytics_colors]`["paper_2"]` (`#F2EDE4`).}
\item{paper_bg}{Logical. If `TRUE` (default), fill the plot and panel
backgrounds with the warm `paper` color. Set to `FALSE` for a
transparent background (useful for slides or overlay on colored
surfaces).}
\item{paper_bg}{Logical. If `TRUE`, fill the plot and panel backgrounds
with the warm `paper` color (Civilytics cream). Default is `FALSE`
(transparent) so that figures composite cleanly onto any background.
Set to `TRUE` for the branded cream canvas.}
}
\value{
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,
horizontal only), `"x"` (vertical only), `"both"`, or `"none"`.}
\item{paper_bg}{Logical. If `TRUE` (default), fill the plot and panel
backgrounds with the warm `paper` color. Set to `FALSE` for a
transparent background (useful for slides or overlay on colored
surfaces).}
\item{paper_bg}{Logical. If `TRUE`, fill the plot and panel backgrounds
with the warm `paper` color (Civilytics cream). Default is `FALSE`
(transparent) so that figures composite cleanly onto any background.
Set to `TRUE` for the branded cream canvas.}
}
\value{
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
to [civilytics_colors]`["paper_2"]` (`#F2EDE4`).}
\item{paper_bg}{Logical. If `TRUE` (default), fill the plot and panel
backgrounds with the warm `paper` color. Set to `FALSE` for a
transparent background (useful for slides or overlay on colored
surfaces).}
\item{paper_bg}{Logical. If `TRUE`, fill the plot and panel backgrounds
with the warm `paper` color (Civilytics cream). Default is `FALSE`
(transparent) so that figures composite cleanly onto any background.
Set to `TRUE` for the branded cream canvas.}
}
\value{
A complete ggplot2 [ggplot2::theme()] object.
+34
View File
@@ -0,0 +1,34 @@
# Project journal
Append-only, newest first. **Entries are never edited** — the value of this file is
that it records what was believed at the time, including the parts that turned out
wrong. Where things stand *today* is in `STATUS.md`, which is generated.
Four lines per entry. The analysis belongs in the issue or the decision record; this
file carries the reasoning and the pointers.
- **Why** — the driver. The one line git cannot reconstruct later.
- **Obligates** — issues this change created elsewhere. Numbers, not prose.
- **Refs** — commits, issues, decision records.
---
## 2026-08-24 · packaging · roborev exclusion patterns fixed; init review triaged
**Why:** roborev reviewed the init commit because `excluded_commit_patterns` are
substring matches and `chore:` never matches the `chore(packaging):` form the
cadence rule mandates — the commit convention was silently defeating its own
review filter. Two low findings came back; one was half-right, one rested on a
generator it could not see.
**Obligates:** —
**Refs:** cd1af67, roborev job 15
## 2026-08-23 · packaging · compass initialised, five workstreams defined
**Why:** the package had no tracking at all — one open issue, a NEWS changelog, and
no record of why anything was decided. Workstream boundaries follow how the code
actually goes stale, not the directory listing: colors stay with theme because the
scales are consumed by the themes, and packaging is its own stream so CI and
dependency drift file against something.
**Obligates:** #21, #22
**Refs:** 7cad98b, #20
+66
View File
@@ -0,0 +1,66 @@
# Project status
> Between the compass markers is generated. Edit the sources, not this.
<!-- compass:begin -->
<!-- compass:board -->
## Where this stands
`civilytics` is the house R package behind every Civilytics chart, table, and report —
ggplot2 themes, brand palettes, logo composition, and Quarto templates, plus the
data-wrangling helpers the analysis work leans on. It is at version 0.3.1 and already
depended on by live projects, so changes here surface in reports that are published.
Project tracking went in on 23 August. Five workstreams divide the package by how it
actually goes stale rather than by directory: themes and palettes, logo and branded
output, Quarto templates, analysis helpers, and packaging. Documentation debt is caught
automatically — if code moves and its roxygen pages do not, an issue gets filed.
Automated review is running, with one sharp edge now documented. The exclusion patterns
that decide which commits get reviewed are matched against the whole commit message, not
just the subject, so a commit whose body merely mentions an excluded prefix is skipped
with no record anywhere. That is filed as #24. It is not urgent, but it is the kind of
silence that is expensive to diagnose cold.
Four things are open, none blocked. A logo defect (#20) drops patchwork panels and clips
captions, which is the one that bites users. The flextable styling helper (#21) ships
Bootstrap's palette as its default instead of the brand's, so tables built with the
defaults are quietly off-brand. The remaining two are housekeeping: duplicate `kodor/*`
labels at repo and org scope (#22), and the review-skip trap (#24).
CI passes on `04a5ee9`. The next substantive work is #20.
## Ready to work on next
- **#20** civilytics_logo(): drops patchwork panels, clips captions, and silently rescales fonts · `ws/logo` — nothing is blocking it; something is currently wrong
- **#21** style_flextable_civilytics() defaults to Bootstrap colors, not Civilytics brand · `ws/logo` — nothing is blocking it; owed work from an earlier change
- **#22** kodor/* labels are defined at both repo and org scope · `ws/packaging` — nothing is blocking it
- **#24** roborev exclusion patterns match the whole commit message, causing silent skips · `ws/packaging` — nothing is blocking it
## Workstreams
| Stream | Commits since | Open | Debt | Owes docs |
|---|---|---|---|---|
| Themes, palettes, and fonts | 0 | 0 | 0 | no |
| Logo and branded output composition | 0 | 2 | 1 | no |
| Quarto themes and publishing templates | 0 | 0 | 0 | no |
| Analysis and workflow helpers | 0 | 0 | 0 | no |
| Package infrastructure and release | 0 | 2 | 0 | no |
## CI
![R-CMD-check](https://gitea.civilytics.org/Civilytics/civilyticsR/actions/workflows/check.yaml/badge.svg?branch=master)
<details>
<summary>Dependency graph and detail</summary>
_Nothing blocks anything else, so there is no graph to draw._
- Marker: `04a5ee95` (2026-08-24)
- Commits since: 0
- Open issues: 4
</details>
<!-- compass:end -->
+107
View File
@@ -0,0 +1,107 @@
[project]
name = "civilytics"
forge = "Civilytics/civilyticsR"
[[workstream]]
id = "theme"
title = "Themes, palettes, and fonts"
paths = [
"R/theme.R",
"R/colors.R",
"R/fonts.R",
"tests/testthat/test_theme.R",
]
docs = [
"man/theme_civilytics*.Rd",
"man/scale_color_civilytics.Rd",
"man/scale_fill_civilytics.Rd",
"man/civilytics_pal*.Rd",
"man/civilytics_colors.Rd",
"man/civilytics_load_fonts.Rd",
"README.Rmd",
]
[[workstream]]
id = "logo"
title = "Logo and branded output composition"
paths = [
"R/logo.R",
"R/flextable.R",
"inst/img/**",
"tests/testthat/test_logo.R",
"tests/testthat/test_flextable.R",
]
docs = [
"man/*logo*.Rd",
"man/*flextable*.Rd",
"man/plot_jpeg.Rd",
"man/get_png.Rd",
"man/has_caption.Rd",
"man/measure_caption.Rd",
"README.Rmd",
]
[[workstream]]
id = "quarto"
title = "Quarto themes and publishing templates"
paths = [
"R/quarto.R",
"inst/quarto/**",
]
docs = [
"man/use_civilytics_*.Rd",
"man/quarto-helpers.Rd",
"inst/quarto/examples/*.qmd",
]
[[workstream]]
id = "helpers"
title = "Analysis and workflow helpers"
paths = [
"R/utils.R",
"R/prop_conf.R",
"R/join_utilities.R",
"R/db.R",
"R/notifications.R",
"tests/testthat/test_utils.R",
"tests/testthat/test_propint.R",
"tests/testthat/test_joins.R",
"tests/testthat/test_db.R",
"tests/testthat/test_notifications.R",
]
docs = [
"README.Rmd",
"NEWS.md",
]
[[workstream]]
id = "packaging"
title = "Package infrastructure and release"
paths = [
"DESCRIPTION",
"NAMESPACE",
"Makefile",
"Dockerfile",
".Rbuildignore",
".gitea/workflows/**",
"tests/testthat.R",
"AGENTS.md",
".roborev.toml",
]
docs = [
"NEWS.md",
"README.Rmd",
]
[roborev]
project_guidelines = [
"Brand colors come from `civilytics_colors`; never write a hex literal in theme, scale, logo, or table code. `R/flextable.R` still carries off-brand Bootstrap defaults (#2c3e50, #f0f0eb, #888888, #cccccc, #555555) -- do not add more.",
"No tidyverse dependency. Imports is base R plus ggplot2, grid/gridExtra, png/jpeg, stringr, stringdist, showtext/sysfonts, jsonlite. Reject dplyr, purrr, magrittr, tibble, and data.table; use base R idioms.",
"NAMESPACE is roxygen-generated. Declare imports with `@importFrom` in the roxygen block and re-run roxygen; never hand-edit NAMESPACE.",
"Themes default to a transparent background (`paper_bg = FALSE`) so plots composite onto any Quarto, Reveal, or Typst background. Making an opaque background the default is a regression, not a preference.",
"Theme functions thread `ink`/`paper`/`accent` into ggplot2 4.0's base-theme parameters rather than setting element colors ad hoc. ggplot2 >= 4.0 is a hard dependency, so use S7 `@` property access on plot and theme objects, not `$`.",
"User-facing progress goes through `message()` so callers can suppress it. No `cat()` or `print()` in package code.",
"Nothing personal or client-identifying is vendored into `inst/` -- brand assets only. Version 0.3.2 removed headshots for exactly this reason.",
"The camelCase exports (`countCleanr`, `dbSafeNames`, `simpleCap`, `waldInterval`, `countDots`, `countNA`, `findDots`, `nvals`) are frozen public API; do not rename them. New functions are snake_case.",
"`R/theme.R` and `R/logo.R` are long by design -- one file per surface, with dense roxygen. File length is not a finding in this package; flag a single function over roughly 80 lines instead.",
]
+12
View File
@@ -0,0 +1,12 @@
# Decisions
One file per decision, numbered and immutable. A decision that changes is superseded
by a new record, never edited in place — the old reasoning is the point.
The table below is **generated** by `compass:decide`. Do not hand-edit it.
<!-- compass:begin decisions -->
| # | Date | Decision | Status |
|---|---|---|---|
| — | — | *No decisions recorded yet.* | — |
<!-- compass:end decisions -->
+51
View File
@@ -0,0 +1,51 @@
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()
+4 -4
View File
@@ -1,4 +1,4 @@
library(testthat)
library(civilytics)
test_check("civilytics")
library(testthat)
library(civilytics)
test_check("civilytics")
+173 -2
View File
@@ -1,2 +1,173 @@
# test prop intervals
# Tests for proportion confidence interval functions
# --- 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"]))
})
+6 -1
View File
@@ -133,8 +133,13 @@ test_that("theme_civilytics uses brand ink color for text", {
expect_equal(th$text$colour, unname(civilytics_colors["ink"]))
})
test_that("theme_civilytics uses brand paper color for plot background", {
test_that("theme_civilytics has transparent background by default", {
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"]))
})
+187 -1
View File
@@ -65,7 +65,193 @@ test_that("na_sum quiet=TRUE suppresses the message", {
})
context("Test Utilities - Postcode Lookup")
# --- postcode_lookup -------------------------------------------------------
# Build a lookup that mirrors the internal implementation:
# state.name + "District of Columbia" + "Puerto Rico"
map_name <- c(state.name, "District of Columbia", "Puerto Rico")
map_abb <- c(state.abb, "DC", "PR")
lookup_ref <- function(x) {
map_abb[match(as.character(x), map_name)]
}
test_that("postcode_lookup returns correct abbreviations for known states", {
expect_equal(postcode_lookup("Montana"), lookup_ref("Montana"))
expect_equal(postcode_lookup("Texas"), lookup_ref("Texas"))
expect_equal(postcode_lookup("New York"), lookup_ref("New York"))
expect_equal(postcode_lookup("California"), lookup_ref("California"))
})
test_that("postcode_lookup handles DC and Puerto Rico", {
# These are not in state.name/state.abb but should still resolve.
expect_equal(postcode_lookup("District of Columbia"), "DC")
expect_equal(postcode_lookup("Puerto Rico"), "PR")
})
test_that("postcode_lookup is vectorized", {
states <- c("Montana", "Texas", "California", "Florida")
result <- postcode_lookup(states)
expected <- lookup_ref(states)
expect_equal(result, expected)
expect_length(result, length(states))
})
test_that("postcode_lookup returns NA for unknown state names", {
# match() returns NA when there is no match; the function propagates it.
result <- postcode_lookup("Atlantis")
expect_true(is.na(unname(result)))
})
test_that("postcode_lookup matches all built-in states", {
# Every entry in state.name should resolve to a valid abbreviation.
results <- postcode_lookup(state.name)
expected <- lookup_ref(state.name)
expect_equal(results, expected)
expect_false(any(is.na(results)))
})
context("Test Utilities - Race Short Names")
# --- race_short_names -------------------------------------------------------
# A reference implementation mirroring the function logic for cross-checking.
race_ref <- function(x) {
x <- as.character(x)
x[x %in% c("Black", "Black Or African American", "Black or African American",
"African American")] <- "black"
x[x %in% c("Hispanic", "Hispanic Or Latino", "Hispanic or Latino")] <- "hisp_lat"
x[x %in% c("White", "white", "White and Not Hispanic")] <- "white"
x[x %in% c("Asian", "Asian American")] <- "asian"
x[x %in% c("Two Or More Races", "Two or More Races")] <- "two_or_more"
x[x %in% c("Native Hawaiian Or Other Pacific Islander",
"Native Hawaiian or Other Pacific Islander",
"Native Hawaiian Pacific Islander")] <- "native_haw"
x[x %in% c("American Indian", "American Indian Or Alaska Native",
"American Indian or Alaska Native", "American Indian or Native Alaskan")] <- "amind"
x[x %in% c("Not Reported")] <- "other"
x
}
test_that("race_short_names returns character vector of same length", {
input <- c("Black", "Hispanic Or Latino", "White")
result <- race_short_names(input)
expect_type(result, "character")
expect_length(result, length(input))
})
test_that("race_short_names maps all known categories correctly", {
# One representative from each category group.
input <- c(
"Black Or African American",
"Hispanic or Latino",
"White and Not Hispanic",
"Asian American",
"Two or More Races",
"Native Hawaiian or Other Pacific Islander",
"American Indian or Alaska Native",
"Not Reported"
)
expected <- c(
"black", "hisp_lat", "white", "asian",
"two_or_more", "native_haw", "amind", "other"
)
result <- race_short_names(input)
expect_equal(result, expected)
})
test_that("race_short_names coerces factors to character", {
input_factor <- factor(c("Black", "White", "Asian"))
result <- race_short_names(input_factor)
expect_type(result, "character")
expect_equal(result, c("black", "white", "asian"))
})
test_that("race_short_names passes through unrecognized values unchanged", {
input <- c("Black", "Some Other Category", "White")
result <- race_short_names(input)
# Unrecognized category should be returned as-is (lowercased by as.character).
expect_equal(result[2], "Some Other Category")
})
test_that("race_short_names handles empty input", {
result <- race_short_names(character(0))
expect_length(result, 0)
expect_type(result, "character")
})
test_that("race_short_names matches reference implementation across all categories",
{
# Exhaustive check: feed every variant string the function handles.
all_variants <- c(
"Black", "Black Or African American", "Black or African American", "African American",
"Hispanic", "Hispanic Or Latino", "Hispanic or Latino",
"White", "white", "White and Not Hispanic",
"Asian", "Asian American",
"Two Or More Races", "Two or More Races",
"Native Hawaiian Or Other Pacific Islander",
"Native Hawaiian or Other Pacific Islander",
"Native Hawaiian Pacific Islander",
"American Indian", "American Indian Or Alaska Native",
"American Indian or Alaska Native", "American Indian or Native Alaskan",
"Not Reported"
)
expect_equal(race_short_names(all_variants), race_ref(all_variants))
})
context("Test Utilities - Get FIPS")
# --- get_fips ---------------------------------------------------------------
test_that("get_fips errors gracefully when tidycensus is not installed", {
# When tidycensus is absent, the function should stop with an informative message.
if (!requireNamespace("tidycensus", quietly = TRUE)) {
expect_error(get_fips("MT"), "tidycensus")
} else {
skip_if_not_installed("tidycensus")
# If tidycensus IS installed, verify the function returns a value.
result <- get_fips("MT")
expect_type(result, "character")
expect_gt(length(result), 0)
}
})
test_that("get_fips returns a FIPS code for a valid state abbreviation", {
skip_if_not_installed("tidycensus")
result <- get_fips("MT")
# Montana's FIPS state code is "30"
expect_equal(result, "30")
})
test_that("get_stabbr returns a valid abbreviation", {
skip_if_not_installed("tidycensus")
result <- get_fips("CA")
# California's FIPS state code is "06"
expect_equal(result, "06")
})
context("Test Utilities - Pretty Count")