Author SHA1 Message Date
jared 76aebe2b49 chore: add CLAUDE.md that imports AGENTS.md
R-CMD-check / R CMD check (push) Successful in 4m46s
Claude Code loads a project's AGENTS.md only when the project has no CLAUDE.md, and then
also loads every AGENTS.md and .claude/AGENTS.md above it, including ~/AGENTS.md and
~/.claude/AGENTS.md. This one-line import keeps the project's instructions to its own
AGENTS.md, matching the other Civilytics repos.
2026-10-11 16:57:02 -04:00
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
jared 4fb5c488f8 fix(brand): use real company name "Civilytics Consulting" in templates
R-CMD-check / R CMD check (pull_request) Successful in 4m27s
The title-page kicker in the Typst and LaTeX templates was hardcoded to
"Civilytics Research", which is not a real entity — the company is
Civilytics Consulting. Fix the kicker in both templates, and update the
example report/slides that echoed the same non-real name. Bump to 0.3.1.
2026-07-09 16:41:55 -04:00
jared 96dc1c4c6b Merge pull request 'feat(flextable): reusable Civilytics flextable branding helpers' (#16) from feat/flextable-branding into master
R-CMD-check / R CMD check (push) Successful in 4m25s
2026-07-09 16:18:43 -04:00
jared 6ea9265236 Merge pull request 'fix(quarto): repair LaTeX + Typst branded templates (#11 #12 #13 #14)' (#15) from fix/quarto-template-bugs into master
R-CMD-check / R CMD check (push) Successful in 4m13s
2026-07-09 16:18:29 -04:00
jared b9d427eb76 fix(typst): ship template as partials so code blocks render (#12)
R-CMD-check / R CMD check (pull_request) Successful in 3m54s
The single-file `template: civilytics-typst.typ` discarded Quarto's
auto-generated `definitions` partial, so any Typst document containing a
code block failed with `unknown variable: Skylighting`.

Ship the template as Quarto template-partials instead, so Quarto keeps its
definitions (Skylighting + token functions) and syntax-highlighted code
blocks render while the Civilytics branding still applies:

- split civilytics-typst.typ into typst-template.typ (the styling function)
  and typst-show.typ (the show/entry point, keyword-safe [ ] wrapping kept);
  remove the single-file template
- use_civilytics_theme() now copies both partials and prints the
  template-partials usage
- example report.qmd uses template-partials

Verified: a report with an R code block renders with working syntax
highlighting and full branding.
2026-07-09 16:10:15 -04:00
jared a904d2313a fix(quarto): repair LaTeX + Typst branded templates
R-CMD-check / R CMD check (pull_request) Successful in 3m56s
- LaTeX: capture pandoc's \subtitle into \thesubtitle so subtitled PDFs
  compile; suppress the default \maketitle/abstract so only the branded
  title page renders (no double title); drop the unused tikz dependency
  from the title partial (#13)
- LaTeX: stop requiring a "Source Serif 4 SemiBold" face that the setup
  never installs; use the family's native Bold weight (#14)
- Typst: wrap title/subtitle/date in [ ] so text containing Typst keywords
  ("for"/"in") no longer breaks compilation (#12)
- Fix footer URL civilytics.consulting -> civilytics.com in the LaTeX and
  Typst templates and the slides example (#11)
- Bump version to 0.3.0
2026-07-09 15:57:47 -04:00
jared 761a72da18 Merge pull request 'feat(logo): add stamp_logo_png() for branding file-based (PNG) outputs' (#9) from feat/stamp-logo-png into master
R-CMD-check / R CMD check (push) Successful in 3m51s
Reviewed-on: #9
2026-06-22 16:59:52 -04:00
jared 4f51a49903 feat(flextable): add reusable Civilytics flextable branding helpers
R-CMD-check / R CMD check (pull_request) Successful in 4m20s
Generalize the flextable brand styling and "export to PNG + stamp logo"
pattern repeated across Civilytics projects into two small functions:

- style_flextable_civilytics(): applies only the visual brand (header
  fill/color, body font/size, zebra striping guarded for <2 rows,
  borders, footer styling, fixed layout) to an already-structured
  flextable. Every value is an overridable parameter; zebra toggles
  striping. Structure (labels, headers, widths, alignment, footer text)
  stays with the caller.
- save_branded_flextable_png(): exports a styled flextable to PNG via
  ragg::agg_png() sized to the table plus extra_height headroom, then
  optionally stamps the logo via stamp_logo_png() (... forwarded).

flextable, officer, and ragg are added to Suggests (not Imports) to keep
the base install light; both functions reference them fully qualified and
guard with requireNamespace() + an install hint. Real round-trip tests
cover styling, 1-row idempotence, PNG export, and extra_height.
2026-06-22 16:53:37 -04:00
jared 5fc8155965 feat(logo): add stamp_logo_png() to brand file-based PNG outputs
R-CMD-check / R CMD check (pull_request) Successful in 3m53s
civilytics_logo()/make_logo_grob() brand ggplot/grobs, but flextables and
other outputs are rendered to PNG first and can't use them. stamp_logo_png()
is the raster analogue: it resolves the SAME brand asset that make_logo_grob()
uses (via the type/variant switch) and composites it into a corner of an
existing PNG in place, so file-based tables stay visually consistent with
logo-branded plots.

Dependency-free by design — uses only png + grid + grDevices (all already
imported), no magick. Configurable type/variant/position/width/margin;
preserves the image's pixel dimensions. Adds tests (21 assertions).
2026-06-22 16:33:08 -04:00
50 changed files with 2636 additions and 277 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.
+1
View File
@@ -0,0 +1 @@
@AGENTS.md
+5 -2
View File
@@ -1,7 +1,7 @@
Package: civilytics
Type: Package
Title: Brand Themes, Color Palettes, and Utility Functions for Civilytics
Version: 0.2.0
Version: 0.3.1
Authors@R:
person("Jared", "E. Knowles", email = "jared@civilytics.com",
role = c("aut", "cre"))
@@ -31,7 +31,10 @@ Encoding: UTF-8
Suggests:
testthat (>= 3.0.0),
tidycensus,
quarto
quarto,
flextable,
officer,
ragg
Config/testthat/edition: 3
Config/roxygen2/version: 8.0.0
RoxygenNote: 7.3.3
View File
+7
View File
@@ -39,10 +39,13 @@ export(rnh)
export(round_to_nearest_half)
export(safe_max)
export(safe_ratio)
export(save_branded_flextable_png)
export(scale_color_civilytics)
export(scale_fill_civilytics)
export(simpleCap)
export(stamp_logo_png)
export(star_subs)
export(style_flextable_civilytics)
export(theme_civilytics)
export(theme_civilytics_dark)
export(theme_civilytics_dark_map)
@@ -61,8 +64,12 @@ importFrom(ggplot2,annotation_custom)
importFrom(ggplot2,ggplot)
importFrom(ggplot2,theme)
importFrom(ggplot2,theme_void)
importFrom(grDevices,dev.off)
importFrom(grDevices,png)
importFrom(graphics,rasterImage)
importFrom(grid,grid.draw)
importFrom(grid,grid.newpage)
importFrom(grid,grid.raster)
importFrom(grid,rasterGrob)
importFrom(gridExtra,arrangeGrob)
importFrom(jpeg,readJPEG)
+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)))
}
+175
View File
@@ -0,0 +1,175 @@
#' 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)
}
+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 -10
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,3 +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)
}
+9 -7
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)
}
# Typst
.copy_pkg_file(
"quarto/typst/civilytics-typst.typ",
"typst/civilytics-typst.typ",
path, force
)
# Typst — shipped as template-partials so Quarto keeps its Skylighting
# definitions and syntax-highlighted code blocks render (see issue #12)
typst_files <- c("typst-template.typ", "typst-show.typ")
for (f in typst_files) {
.copy_pkg_file(file.path("quarto/typst", f), file.path("typst", f), path, force)
}
# Logos — for _brand.yml (expects assets/logo/)
.copy_logos("assets/logo", path, force)
@@ -158,7 +158,9 @@ use_civilytics_theme <- function(path = ".", force = FALSE) {
message(" include-in-header: latex/civilytics.tex")
message(" include-before-body: latex/civilytics-title.tex")
message(" typst:")
message(" template: typst/civilytics-typst.typ")
message(" template-partials:")
message(" - typst/typst-template.typ")
message(" - typst/typst-show.typ")
message("---")
message("\nSee examples/report.qmd for a complete example.")
invisible(NULL)
+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

+4 -2
View File
@@ -2,7 +2,7 @@
title: "Who pays when rent outpaces wages?"
subtitle: "A 12-county analysis of cost-burdened renter households, 2019–2024."
author:
- name: "Civilytics Research"
- name: "Jared Knowles"
affiliation: "Civilytics Consulting"
date: "2026-04-15"
abstract: |
@@ -19,7 +19,9 @@ format:
toc: true
toc-location: right
typst:
template: ../typst/civilytics-typst.typ
template-partials:
- ../typst/typst-template.typ
- ../typst/typst-show.typ
pdf:
include-in-header: ../latex/civilytics.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.
Civilytics Research, 2026
Civilytics Consulting, 2026
## Thank you {.thank-you}
Questions?
- jared@civilytics.com
- civilytics.consulting
- civilytics.com
+6 -3
View File
@@ -2,11 +2,16 @@
% Replaces Quarto's default \maketitle. Uses values from YAML
% (\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}
\pagecolor{paper}
\color{ink}
\vspace*{0.5in}
{\sffamily\bfseries\scriptsize\color{ember}\MakeUppercase{— Civilytics Research}\par}
{\sffamily\bfseries\scriptsize\color{ember}\MakeUppercase{— Civilytics Consulting}\par}
\vspace{12pt}
{\displayfont\fontsize{32pt}{34pt}\selectfont\bfseries\color{ink}\thetitle\par}
\vspace{8pt}
@@ -33,8 +38,6 @@
% Pulse mark, in ember
\begin{center}
\begin{tikzpicture}[overlay, remember picture]
\end{tikzpicture}
{\color{ember}\rule{40pt}{2pt}}
\end{center}
\end{titlepage}
+26 -3
View File
@@ -40,17 +40,40 @@
\color{ink}
% --- 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}[
UprightFont = *,
ItalicFont = * Italic,
BoldFont = * SemiBold,
BoldItalicFont = * SemiBold Italic,
Ligatures = TeX,
]
\setsansfont{Inter}[Ligatures = TeX]
\setmonofont{JetBrains Mono}[Scale = 0.92]
\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 ---
\hypersetup{
colorlinks = true,
@@ -77,7 +100,7 @@
\renewcommand{\footrulewidth}{0pt}
\fancyhead[L]{\sffamily\scriptsize\color{ink3}\MakeUppercase{Civilytics Consulting}}
\fancyhead[R]{\sffamily\scriptsize\color{ink3}\thetitle}
\fancyfoot[L]{\sffamily\scriptsize\color{ink3}civilytics.consulting}
\fancyfoot[L]{\sffamily\scriptsize\color{ink3}civilytics.com}
\fancyfoot[C]{\sffamily\scriptsize\color{ink3}\thepage}
\fancyfoot[R]{\sffamily\scriptsize\color{ink3}\textcopyright\ 2026}
+17
View File
@@ -0,0 +1,17 @@
// 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
)
@@ -1,9 +1,15 @@
// =============================================================
// Civilytics — Typst template for Quarto PDF
// Civilytics — Typst template partial for Quarto PDF (typst-template.typ).
// 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:
// format:
// typst:
// template: quarto/typst/civilytics-typst.typ
// template-partials:
// - quarto/typst/typst-template.typ
// - quarto/typst/typst-show.typ
// =============================================================
#let paper-bg = rgb("#FAF7F2")
@@ -54,7 +60,7 @@
grid(
columns: (1fr, auto, 1fr),
align: (left, center, right),
[civilytics.consulting],
[civilytics.com],
counter(page).display("1 / 1", both: true),
[© 2026]
)
@@ -158,7 +164,7 @@
if title != none {
block[
#set text(font: sans-stack, size: 8pt, weight: 600, fill: ember, tracking: 0.1em)
#upper[— Civilytics Research]
#upper[— Civilytics Consulting]
]
v(8pt)
block[
@@ -229,16 +235,3 @@
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$
+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)
}
}
+62
View File
@@ -0,0 +1,62 @@
% 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.
}
+56
View File
@@ -0,0 +1,56 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/logo.R
\name{stamp_logo_png}
\alias{stamp_logo_png}
\title{Stamp the Civilytics logo onto a saved raster (PNG) image}
\usage{
stamp_logo_png(
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
)
}
\arguments{
\item{path}{Character. Path to the PNG to stamp. The file is overwritten
in place at its original pixel dimensions.}
\item{type}{Character. `"wordmark"` (default) or `"mark"`. As in
[make_logo_grob()].}
\item{variant}{Character. `"light"` (default, dark logo for light
backgrounds) or `"dark"` (reverse logo for dark backgrounds).}
\item{position}{Character. Corner placement: `"bottom-right"` (default),
`"bottom-left"`, `"top-right"`, or `"top-left"`.}
\item{width_frac}{Numeric. Logo width as a fraction of the image width
(default `0.15`). Height follows from the logo's aspect ratio.}
\item{margin_frac}{Numeric. Padding from the edges as a fraction of the
image width (default `0.02`).}
}
\value{
`path`, invisibly.
}
\description{
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.
}
\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")
}
}
+92
View File
@@ -0,0 +1,92 @@
% 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.
}
+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")
+89
View File
@@ -0,0 +1,89 @@
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])
})
+30
View File
@@ -0,0 +1,30 @@
test_that("stamp_logo_png preserves image dimensions and returns the path invisibly", {
p <- tempfile(fileext = ".png")
on.exit(unlink(p), add = TRUE)
grDevices::png(p, width = 600, height = 240); plot(1:5); grDevices::dev.off()
in_dim <- dim(png::readPNG(p))[1:2]
expect_invisible(out <- stamp_logo_png(p))
expect_identical(out, p)
expect_identical(dim(png::readPNG(p))[1:2], in_dim) # overwritten at same size
})
test_that("stamp_logo_png runs for every type/variant/position combination", {
p <- tempfile(fileext = ".png")
on.exit(unlink(p), add = TRUE)
grDevices::png(p, width = 500, height = 200); plot(1:5); grDevices::dev.off()
for (ty in c("wordmark", "mark")) {
for (va in c("light", "dark")) {
for (pos in c("bottom-right", "bottom-left", "top-right", "top-left")) {
expect_no_error(stamp_logo_png(p, type = ty, variant = va, position = pos))
}
}
}
})
test_that("stamp_logo_png validates its inputs", {
expect_error(stamp_logo_png(tempfile(fileext = ".png"))) # file does not exist
# invalid type is rejected by match.arg() before the file is touched
expect_error(stamp_logo_png(tempfile(fileext = ".png"), type = "banner"))
})
+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")