Compare commits
22
Commits
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
76aebe2b49
|
||
|
|
446843bc86
|
||
|
|
04a5ee958b
|
||
|
|
cd1af67a3a
|
||
|
|
496b9ed9ac
|
||
|
|
7cad98b434
|
||
|
|
2c7c9a6dbc
|
||
|
|
6051e4bb5c
|
||
|
|
9dea017381 | ||
|
|
967e7e1111 | ||
|
|
f32093c662 | ||
|
|
e257180f15 | ||
|
|
0ef0f310e2 | ||
|
|
4fb5c488f8
|
||
|
|
96dc1c4c6b | ||
|
|
6ea9265236 | ||
|
|
b9d427eb76
|
||
|
|
a904d2313a
|
||
|
|
761a72da18 | ||
|
|
4f51a49903
|
||
|
|
5fc8155965
|
||
|
|
41162597cf |
+1
-1
@@ -3,9 +3,9 @@
|
|||||||
^\.github$
|
^\.github$
|
||||||
^\.gitea$
|
^\.gitea$
|
||||||
^README\.Rmd$
|
^README\.Rmd$
|
||||||
|
^NEWS\.md$
|
||||||
^Makefile$
|
^Makefile$
|
||||||
^Dockerfile$
|
^Dockerfile$
|
||||||
^LICENSE\.md$
|
|
||||||
^\.claude$
|
^\.claude$
|
||||||
^\.playwright-mcp$
|
^\.playwright-mcp$
|
||||||
^civilytics-site\.png$
|
^civilytics-site\.png$
|
||||||
|
|||||||
@@ -2,3 +2,10 @@
|
|||||||
.Rhistory
|
.Rhistory
|
||||||
.RData
|
.RData
|
||||||
.Ruserdata
|
.Ruserdata
|
||||||
|
.compass-cache/
|
||||||
|
# roborev snapshots
|
||||||
|
/.roborev/
|
||||||
|
|
||||||
|
# Test run debris
|
||||||
|
tests/testthat/Rplots.pdf
|
||||||
|
tests/testthat/_problems/
|
||||||
|
|||||||
@@ -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 ---
|
||||||
|
'''
|
||||||
@@ -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.
|
||||||
+5
-2
@@ -1,7 +1,7 @@
|
|||||||
Package: civilytics
|
Package: civilytics
|
||||||
Type: Package
|
Type: Package
|
||||||
Title: Brand Themes, Color Palettes, and Utility Functions for Civilytics
|
Title: Brand Themes, Color Palettes, and Utility Functions for Civilytics
|
||||||
Version: 0.2.0
|
Version: 0.3.1
|
||||||
Authors@R:
|
Authors@R:
|
||||||
person("Jared", "E. Knowles", email = "jared@civilytics.com",
|
person("Jared", "E. Knowles", email = "jared@civilytics.com",
|
||||||
role = c("aut", "cre"))
|
role = c("aut", "cre"))
|
||||||
@@ -31,7 +31,10 @@ Encoding: UTF-8
|
|||||||
Suggests:
|
Suggests:
|
||||||
testthat (>= 3.0.0),
|
testthat (>= 3.0.0),
|
||||||
tidycensus,
|
tidycensus,
|
||||||
quarto
|
quarto,
|
||||||
|
flextable,
|
||||||
|
officer,
|
||||||
|
ragg
|
||||||
Config/testthat/edition: 3
|
Config/testthat/edition: 3
|
||||||
Config/roxygen2/version: 8.0.0
|
Config/roxygen2/version: 8.0.0
|
||||||
RoxygenNote: 7.3.3
|
RoxygenNote: 7.3.3
|
||||||
|
|||||||
@@ -39,10 +39,13 @@ export(rnh)
|
|||||||
export(round_to_nearest_half)
|
export(round_to_nearest_half)
|
||||||
export(safe_max)
|
export(safe_max)
|
||||||
export(safe_ratio)
|
export(safe_ratio)
|
||||||
|
export(save_branded_flextable_png)
|
||||||
export(scale_color_civilytics)
|
export(scale_color_civilytics)
|
||||||
export(scale_fill_civilytics)
|
export(scale_fill_civilytics)
|
||||||
export(simpleCap)
|
export(simpleCap)
|
||||||
|
export(stamp_logo_png)
|
||||||
export(star_subs)
|
export(star_subs)
|
||||||
|
export(style_flextable_civilytics)
|
||||||
export(theme_civilytics)
|
export(theme_civilytics)
|
||||||
export(theme_civilytics_dark)
|
export(theme_civilytics_dark)
|
||||||
export(theme_civilytics_dark_map)
|
export(theme_civilytics_dark_map)
|
||||||
@@ -61,8 +64,12 @@ importFrom(ggplot2,annotation_custom)
|
|||||||
importFrom(ggplot2,ggplot)
|
importFrom(ggplot2,ggplot)
|
||||||
importFrom(ggplot2,theme)
|
importFrom(ggplot2,theme)
|
||||||
importFrom(ggplot2,theme_void)
|
importFrom(ggplot2,theme_void)
|
||||||
|
importFrom(grDevices,dev.off)
|
||||||
|
importFrom(grDevices,png)
|
||||||
importFrom(graphics,rasterImage)
|
importFrom(graphics,rasterImage)
|
||||||
importFrom(grid,grid.draw)
|
importFrom(grid,grid.draw)
|
||||||
|
importFrom(grid,grid.newpage)
|
||||||
|
importFrom(grid,grid.raster)
|
||||||
importFrom(grid,rasterGrob)
|
importFrom(grid,rasterGrob)
|
||||||
importFrom(gridExtra,arrangeGrob)
|
importFrom(gridExtra,arrangeGrob)
|
||||||
importFrom(jpeg,readJPEG)
|
importFrom(jpeg,readJPEG)
|
||||||
|
|||||||
@@ -0,0 +1,16 @@
|
|||||||
|
# civilytics 0.3.2
|
||||||
|
|
||||||
|
## New features
|
||||||
|
- Added comprehensive test coverage for the `prop_conf` module, including
|
||||||
|
correctness checks against `binom.test()` for Clopper-Pearson intervals and
|
||||||
|
formula-based verification for Wald and Agresti-Coull intervals.
|
||||||
|
|
||||||
|
## Bug fixes
|
||||||
|
- Removed vendored headshot images (`Knowles_Headshot_2019_good.jpg`,
|
||||||
|
`Knowles_Headshot_2019_prisma.jpg`) from `inst/img/` to prevent personal
|
||||||
|
photos from being distributed with the package. The `plot_jpeg()` example
|
||||||
|
now references a generic placeholder path instead of a specific headshot.
|
||||||
|
|
||||||
|
## Internal
|
||||||
|
- Renamed `LICENSE.md` to `LICENSE` for R packaging convention compliance so
|
||||||
|
that the LGPL-3 license ships correctly with built tarballs.
|
||||||
+7
-7
@@ -199,7 +199,7 @@ civilytics_palette <- function(name = "qual", n = NULL, reverse = FALSE) {
|
|||||||
#' Civilytics palette function (closure)
|
#' Civilytics palette function (closure)
|
||||||
#'
|
#'
|
||||||
#' Returns a closure `function(n)` suitable for passing to
|
#' 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 name Character. Palette name. See `names(civilytics_palettes)`.
|
||||||
#' @param reverse Logical. Reverse the palette order. Default `FALSE`.
|
#' @param reverse Logical. Reverse the palette order. Default `FALSE`.
|
||||||
@@ -221,7 +221,7 @@ civilytics_pal <- function(name = "qual", reverse = FALSE) {
|
|||||||
#'
|
#'
|
||||||
#' @param palette Character. Palette name. Defaults to `"qual"`.
|
#' @param palette Character. Palette name. Defaults to `"qual"`.
|
||||||
#' @param discrete Logical. `TRUE` (default) for categorical data; `FALSE`
|
#' @param discrete Logical. `TRUE` (default) for categorical data; `FALSE`
|
||||||
#' for a continuous gradient via [ggplot2::scale_color_gradientn()].
|
#' for a continuous gradient via [scale_color_gradientn()].
|
||||||
#' @param reverse Logical. Reverse the palette order. Default `FALSE`.
|
#' @param reverse Logical. Reverse the palette order. Default `FALSE`.
|
||||||
#' @param ... Additional arguments passed to the ggplot2 scale function.
|
#' @param ... Additional arguments passed to the ggplot2 scale function.
|
||||||
#'
|
#'
|
||||||
@@ -240,14 +240,14 @@ civilytics_pal <- function(name = "qual", reverse = FALSE) {
|
|||||||
scale_color_civilytics <- function(palette = "qual", discrete = TRUE,
|
scale_color_civilytics <- function(palette = "qual", discrete = TRUE,
|
||||||
reverse = FALSE, ...) {
|
reverse = FALSE, ...) {
|
||||||
if (discrete) {
|
if (discrete) {
|
||||||
ggplot2::discrete_scale(
|
discrete_scale(
|
||||||
"colour",
|
"colour",
|
||||||
palette = civilytics_pal(palette, reverse = reverse),
|
palette = civilytics_pal(palette, reverse = reverse),
|
||||||
...
|
...
|
||||||
)
|
)
|
||||||
} else {
|
} else {
|
||||||
pal <- civilytics_palette(palette, reverse = reverse)
|
pal <- civilytics_palette(palette, reverse = reverse)
|
||||||
ggplot2::scale_color_gradientn(
|
scale_color_gradientn(
|
||||||
colours = grDevices::colorRampPalette(pal)(256),
|
colours = grDevices::colorRampPalette(pal)(256),
|
||||||
...
|
...
|
||||||
)
|
)
|
||||||
@@ -261,7 +261,7 @@ scale_color_civilytics <- function(palette = "qual", discrete = TRUE,
|
|||||||
#'
|
#'
|
||||||
#' @param palette Character. Palette name. Defaults to `"qual"`.
|
#' @param palette Character. Palette name. Defaults to `"qual"`.
|
||||||
#' @param discrete Logical. `TRUE` (default) for categorical data; `FALSE`
|
#' @param discrete Logical. `TRUE` (default) for categorical data; `FALSE`
|
||||||
#' for a continuous gradient via [ggplot2::scale_fill_gradientn()].
|
#' for a continuous gradient via [scale_fill_gradientn()].
|
||||||
#' @param reverse Logical. Reverse the palette order. Default `FALSE`.
|
#' @param reverse Logical. Reverse the palette order. Default `FALSE`.
|
||||||
#' @param ... Additional arguments passed to the ggplot2 scale function.
|
#' @param ... Additional arguments passed to the ggplot2 scale function.
|
||||||
#'
|
#'
|
||||||
@@ -280,14 +280,14 @@ scale_color_civilytics <- function(palette = "qual", discrete = TRUE,
|
|||||||
scale_fill_civilytics <- function(palette = "qual", discrete = TRUE,
|
scale_fill_civilytics <- function(palette = "qual", discrete = TRUE,
|
||||||
reverse = FALSE, ...) {
|
reverse = FALSE, ...) {
|
||||||
if (discrete) {
|
if (discrete) {
|
||||||
ggplot2::discrete_scale(
|
discrete_scale(
|
||||||
"fill",
|
"fill",
|
||||||
palette = civilytics_pal(palette, reverse = reverse),
|
palette = civilytics_pal(palette, reverse = reverse),
|
||||||
...
|
...
|
||||||
)
|
)
|
||||||
} else {
|
} else {
|
||||||
pal <- civilytics_palette(palette, reverse = reverse)
|
pal <- civilytics_palette(palette, reverse = reverse)
|
||||||
ggplot2::scale_fill_gradientn(
|
scale_fill_gradientn(
|
||||||
colours = grDevices::colorRampPalette(pal)(256),
|
colours = grDevices::colorRampPalette(pal)(256),
|
||||||
...
|
...
|
||||||
)
|
)
|
||||||
|
|||||||
@@ -19,7 +19,7 @@
|
|||||||
#' @return a numeric column of data
|
#' @return a numeric column of data
|
||||||
#' @export
|
#' @export
|
||||||
countCleanr <- function(x){
|
countCleanr <- function(x){
|
||||||
if(class(x) == "character"){
|
if ("character" %in% class(x)) {
|
||||||
x[x == "None not reported"] <- "0"
|
x[x == "None not reported"] <- "0"
|
||||||
x[x == "Not applicable"] <- NA
|
x[x == "Not applicable"] <- NA
|
||||||
x <- as.numeric(x)
|
x <- as.numeric(x)
|
||||||
@@ -110,8 +110,14 @@ nvals <- function(x){
|
|||||||
#' my_string <- c("Happy school", "Easy school", "cool School", "big school")
|
#' my_string <- c("Happy school", "Easy school", "cool School", "big school")
|
||||||
#' simpleCap(my_string)
|
#' simpleCap(my_string)
|
||||||
simpleCap <- function(x) {
|
simpleCap <- function(x) {
|
||||||
stopifnot(class(x) == "character")
|
stopifnot("character" %in% class(x))
|
||||||
s <- strsplit(x, " ")[[1]]
|
|
||||||
paste(toupper(substring(s, 1,1)), substring(s, 2),
|
# Vectorised over elements of x — each element is capitalised independently.
|
||||||
sep = "", collapse = " ")
|
# 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
@@ -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)
|
||||||
|
}
|
||||||
@@ -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_SERIF <- "Source Serif 4" # body prose / editorial long-form
|
||||||
CV_FONT_MONO <- "JetBrains Mono" # code, data tables, numeric callouts
|
CV_FONT_MONO <- "JetBrains Mono" # code, data tables, numeric callouts
|
||||||
|
|
||||||
# Internal flag so civilytics_load_fonts() is idempotent within a session.
|
# Mutable package state held in an environment so the binding itself stays
|
||||||
.cv_fonts_loaded <- FALSE
|
# 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
|
#' Load Civilytics brand fonts
|
||||||
#'
|
#'
|
||||||
#' Downloads Inter and Libre Franklin from Google Fonts via
|
#' Downloads Inter, Libre Franklin, Source Serif 4 and JetBrains Mono from
|
||||||
#' [sysfonts::font_add_google()], then calls [showtext::showtext_auto()] so
|
#' Google Fonts via [sysfonts::font_add_google()], then calls
|
||||||
#' that all graphics devices render text with those fonts. This is called
|
#' [showtext::showtext_auto()] so that all graphics devices render text with
|
||||||
#' automatically when the package loads; use this function to retry if the
|
#' those fonts. This is called automatically when the package loads; use this
|
||||||
#' initial load failed (e.g., the machine was offline at load time).
|
#' 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
|
#' @export
|
||||||
#'
|
#'
|
||||||
#' @examples
|
#' @examples
|
||||||
#' \dontrun{
|
#' \dontrun{
|
||||||
#' civilytics_load_fonts()
|
#' 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("Inter", family = "Inter")
|
||||||
sysfonts::font_add_google("Libre Franklin", family = "Libre Franklin")
|
sysfonts::font_add_google("Libre Franklin", family = "Libre Franklin")
|
||||||
sysfonts::font_add_google("Source Serif 4", family = "Source Serif 4")
|
sysfonts::font_add_google("Source Serif 4", family = "Source Serif 4")
|
||||||
sysfonts::font_add_google("JetBrains Mono", family = "JetBrains Mono")
|
sysfonts::font_add_google("JetBrains Mono", family = "JetBrains Mono")
|
||||||
showtext::showtext_auto()
|
showtext::showtext_auto()
|
||||||
.cv_fonts_loaded <<- TRUE
|
|
||||||
invisible(NULL)
|
.cv_state$fonts_loaded <- TRUE
|
||||||
|
invisible(TRUE)
|
||||||
}
|
}
|
||||||
|
|
||||||
.onLoad <- function(libname, pkgname) {
|
.onLoad <- function(libname, pkgname) {
|
||||||
|
|||||||
+30
-26
@@ -1,11 +1,14 @@
|
|||||||
# Join utilities
|
# Join utilities
|
||||||
|
|
||||||
#' Test the join between two sets of identifiers
|
#' Test the join between two sets of identifiers
|
||||||
#'
|
#'
|
||||||
#' @param x a vector of identifiers to check against y
|
#' @param x A vector of identifiers to check against `y`.
|
||||||
#' @param y a vector of identifiers to check against x
|
#' @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
|
#' @param distinct Logical. Should duplicate values of `x` and `y` be removed
|
||||||
|
#' before testing? Default is `TRUE`.
|
||||||
#'
|
#'
|
||||||
#' @return nothing, print a summary of match statistics to the console
|
#' @return Invisibly returns `NULL`; prints a formatted summary of match
|
||||||
|
#' statistics to the console via [writeLines()].
|
||||||
#' @export
|
#' @export
|
||||||
#'
|
#'
|
||||||
#' @examples
|
#' @examples
|
||||||
@@ -16,33 +19,34 @@ match_test <- function(x, y, distinct = TRUE) {
|
|||||||
if (distinct) {
|
if (distinct) {
|
||||||
x <- unique(x)
|
x <- unique(x)
|
||||||
y <- unique(y)
|
y <- unique(y)
|
||||||
cat("**** Distinct Matches ****")
|
|
||||||
cat("\n")
|
|
||||||
|
|
||||||
}
|
}
|
||||||
|
|
||||||
# TODO: DO not report 100% if there is even 1 mismatch
|
# TODO: DO not report 100% if there is even 1 mismatch
|
||||||
|
|
||||||
xiny <- sum(x %in% y)
|
xiny <- sum(x %in% y)
|
||||||
total_x <- length(x)
|
total_x <- length(x)
|
||||||
|
pct_x <- round(100 * xiny / total_x, 2)
|
||||||
|
|
||||||
yinx <- sum(y %in% x)
|
yinx <- sum(y %in% x)
|
||||||
total_y <- length(y)
|
total_y <- length(y)
|
||||||
|
pct_y <- round(100 * yinx / total_y, 2)
|
||||||
|
|
||||||
cat("**** Match Summary ****")
|
header <- if (distinct) "Distinct Matches" else "All Values"
|
||||||
cat("\n")
|
|
||||||
cat("X in Y")
|
|
||||||
cat("\n")
|
|
||||||
cat(paste0("Of the ", total_x, " X values, ", xiny, " (",
|
|
||||||
100*round(xiny/total_x, 2), "%) were matched."))
|
|
||||||
cat("\n")
|
|
||||||
cat("********************************************")
|
|
||||||
cat("\n")
|
|
||||||
cat("Y in X")
|
|
||||||
cat("\n")
|
|
||||||
cat(paste0("Of the ", total_y, " Y values, ", yinx, " (",
|
|
||||||
100*round(yinx/total_y, 2), "%) were matched."))
|
|
||||||
cat("\n")
|
|
||||||
cat("******************************************")
|
|
||||||
|
|
||||||
|
lines <- c(
|
||||||
|
paste0("**** ", header, " ****"),
|
||||||
|
"",
|
||||||
|
"X in Y",
|
||||||
|
sprintf("Of the %d X values, %d (%s%%) were matched.",
|
||||||
|
total_x, xiny, format(pct_x, nsmall = 2)),
|
||||||
|
strrep("*", 40),
|
||||||
|
"",
|
||||||
|
"Y in X",
|
||||||
|
sprintf("Of the %d Y values, %d (%s%%) were matched.",
|
||||||
|
total_y, yinx, format(pct_y, nsmall = 2)),
|
||||||
|
strrep("*", 38)
|
||||||
|
)
|
||||||
|
|
||||||
|
writeLines(lines)
|
||||||
|
invisible(NULL)
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -10,7 +10,8 @@
|
|||||||
#' @importFrom graphics rasterImage
|
#' @importFrom graphics rasterImage
|
||||||
#' @examples
|
#' @examples
|
||||||
#' \dontrun{
|
#' \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(img)
|
||||||
#' }
|
#' }
|
||||||
plot_jpeg <- function(path, add=FALSE, upscale = TRUE)
|
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.
|
# element cascades to titles, axis labels, legends, captions, and strips.
|
||||||
if (!is.null(font_scale) && font_scale != 1) {
|
if (!is.null(font_scale) && font_scale != 1) {
|
||||||
base_size <- plot$theme$text$size %||% 14
|
base_size <- plot$theme$text$size %||% 14
|
||||||
plot <- plot + ggplot2::theme(
|
plot <- plot + theme(
|
||||||
text = ggplot2::element_text(size = base_size * font_scale)
|
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
|
#' @export
|
||||||
#'
|
#'
|
||||||
#' @examples
|
#' @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(p1) # Should equal 1 since no caption is present
|
||||||
measure_caption <- function(gg) {
|
measure_caption <- function(gg) {
|
||||||
if (has_caption(gg)) {
|
if (has_caption(gg)) {
|
||||||
@@ -145,7 +146,7 @@ measure_caption <- function(gg) {
|
|||||||
#' @export
|
#' @export
|
||||||
#'
|
#'
|
||||||
#' @examples
|
#' @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(p1) # FALSE
|
||||||
has_caption <- function(gg) {
|
has_caption <- function(gg) {
|
||||||
any(names(gg$labels) == "caption")
|
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) {
|
if (!is.null(font_scale) && font_scale != 1) {
|
||||||
plot_list <- lapply(plot_list, function(p) {
|
plot_list <- lapply(plot_list, function(p) {
|
||||||
base_size <- p$theme$text$size %||% 14
|
base_size <- p$theme$text$size %||% 14
|
||||||
p + ggplot2::theme(
|
p + theme(
|
||||||
text = ggplot2::element_text(size = base_size * font_scale)
|
text = element_text(size = base_size * font_scale)
|
||||||
)
|
)
|
||||||
})
|
})
|
||||||
}
|
}
|
||||||
@@ -275,9 +276,9 @@ make_logo_grob <- function(type = c("wordmark", "mark"),
|
|||||||
xmax <- 1
|
xmax <- 1
|
||||||
}
|
}
|
||||||
|
|
||||||
ggplot2::ggplot() +
|
ggplot() +
|
||||||
ggplot2::theme_void() +
|
theme_void() +
|
||||||
ggplot2::annotation_custom(
|
annotation_custom(
|
||||||
get_png(system.file("img", img_file, package = "civilytics")),
|
get_png(system.file("img", img_file, package = "civilytics")),
|
||||||
xmin = xmin, xmax = xmax
|
xmin = xmin, xmax = xmax
|
||||||
)
|
)
|
||||||
@@ -361,3 +362,92 @@ civilytics_logo <- function(plot,
|
|||||||
position = position)
|
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
@@ -135,12 +135,12 @@ use_civilytics_theme <- function(path = ".", force = FALSE) {
|
|||||||
.copy_pkg_file(file.path("quarto/latex", f), file.path("latex", f), path, force)
|
.copy_pkg_file(file.path("quarto/latex", f), file.path("latex", f), path, force)
|
||||||
}
|
}
|
||||||
|
|
||||||
# Typst
|
# Typst — shipped as template-partials so Quarto keeps its Skylighting
|
||||||
.copy_pkg_file(
|
# definitions and syntax-highlighted code blocks render (see issue #12)
|
||||||
"quarto/typst/civilytics-typst.typ",
|
typst_files <- c("typst-template.typ", "typst-show.typ")
|
||||||
"typst/civilytics-typst.typ",
|
for (f in typst_files) {
|
||||||
path, force
|
.copy_pkg_file(file.path("quarto/typst", f), file.path("typst", f), path, force)
|
||||||
)
|
}
|
||||||
|
|
||||||
# Logos — for _brand.yml (expects assets/logo/)
|
# Logos — for _brand.yml (expects assets/logo/)
|
||||||
.copy_logos("assets/logo", path, force)
|
.copy_logos("assets/logo", path, force)
|
||||||
@@ -158,7 +158,9 @@ use_civilytics_theme <- function(path = ".", force = FALSE) {
|
|||||||
message(" include-in-header: latex/civilytics.tex")
|
message(" include-in-header: latex/civilytics.tex")
|
||||||
message(" include-before-body: latex/civilytics-title.tex")
|
message(" include-before-body: latex/civilytics-title.tex")
|
||||||
message(" typst:")
|
message(" typst:")
|
||||||
message(" template: typst/civilytics-typst.typ")
|
message(" template-partials:")
|
||||||
|
message(" - typst/typst-template.typ")
|
||||||
|
message(" - typst/typst-show.typ")
|
||||||
message("---")
|
message("---")
|
||||||
message("\nSee examples/report.qmd for a complete example.")
|
message("\nSee examples/report.qmd for a complete example.")
|
||||||
invisible(NULL)
|
invisible(NULL)
|
||||||
|
|||||||
@@ -1,6 +1,6 @@
|
|||||||
#' Civilytics ggplot2 theme
|
#' 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
|
#' Civilytics brand color palette and typography. Requires ggplot2 >= 4.0.0
|
||||||
#' for the `ink`, `paper`, and `accent` base-theme parameters.
|
#' for the `ink`, `paper`, and `accent` base-theme parameters.
|
||||||
#'
|
#'
|
||||||
@@ -36,10 +36,12 @@
|
|||||||
#' to [civilytics_colors]`["paper_2"]` (`#F2EDE4`).
|
#' to [civilytics_colors]`["paper_2"]` (`#F2EDE4`).
|
||||||
#' @param grid Character. Which major gridlines to draw: `"y"` (default,
|
#' @param grid Character. Which major gridlines to draw: `"y"` (default,
|
||||||
#' horizontal only), `"x"` (vertical only), `"both"`, or `"none"`.
|
#' horizontal only), `"x"` (vertical only), `"both"`, or `"none"`.
|
||||||
#' @param paper_bg Logical. If `TRUE` (default), fill the plot and panel
|
#' @param paper_bg Logical. If `TRUE`, fill the plot and panel backgrounds
|
||||||
#' backgrounds with the warm `paper` color. Set to `FALSE` for a
|
#' with the warm `paper` color (Civilytics cream). Default is `FALSE`
|
||||||
#' transparent background (useful for slides or overlay on colored
|
#' (transparent) so that figures composite cleanly onto any background.
|
||||||
#' surfaces).
|
#' Set to `TRUE` for the branded cream canvas. Note: a transparent device
|
||||||
|
#' background (e.g., `dev = "ragg_png"`, `dev.args = list(background =
|
||||||
|
#' "transparent")`) is also needed for fully-transparent PNG exports.
|
||||||
#'
|
#'
|
||||||
#' @section Font size hierarchy:
|
#' @section Font size hierarchy:
|
||||||
#' All text sizes are derived from `font_size` using relative scale factors.
|
#' All text sizes are derived from `font_size` using relative scale factors.
|
||||||
@@ -61,14 +63,14 @@
|
|||||||
#' logo below the plot, pass `font_scale` to compensate for viewport
|
#' logo below the plot, pass `font_scale` to compensate for viewport
|
||||||
#' shrinkage.
|
#' shrinkage.
|
||||||
#'
|
#'
|
||||||
#' @return A complete ggplot2 [ggplot2::theme()] object.
|
#' @return A complete ggplot2 [theme()] object.
|
||||||
#' @export
|
#' @export
|
||||||
#'
|
#'
|
||||||
#' @examples
|
#' @examples
|
||||||
#' \dontrun{
|
#' \dontrun{
|
||||||
#' library(ggplot2)
|
#' library(ggplot2)
|
||||||
#'
|
#'
|
||||||
#' # Default editorial theme
|
#' # Default — transparent background for embedding
|
||||||
#' ggplot(mpg, aes(displ, hwy)) +
|
#' ggplot(mpg, aes(displ, hwy)) +
|
||||||
#' geom_point() +
|
#' geom_point() +
|
||||||
#' theme_civilytics()
|
#' theme_civilytics()
|
||||||
@@ -79,10 +81,10 @@
|
|||||||
#' scale_color_civilytics() +
|
#' scale_color_civilytics() +
|
||||||
#' theme_civilytics(grid = "both")
|
#' theme_civilytics(grid = "both")
|
||||||
#'
|
#'
|
||||||
#' # Transparent background for embedding
|
#' # Branded cream background (opt-in)
|
||||||
#' ggplot(mpg, aes(displ, hwy)) +
|
#' ggplot(mpg, aes(displ, hwy)) +
|
||||||
#' geom_point() +
|
#' geom_point() +
|
||||||
#' theme_civilytics(paper_bg = FALSE)
|
#' theme_civilytics(paper_bg = TRUE)
|
||||||
#'
|
#'
|
||||||
#' # Larger text for poster or display
|
#' # Larger text for poster or display
|
||||||
#' ggplot(mpg, aes(displ, hwy)) +
|
#' ggplot(mpg, aes(displ, hwy)) +
|
||||||
@@ -102,7 +104,7 @@ theme_civilytics <- function(
|
|||||||
accent = unname(civilytics_colors["ember_600"]),
|
accent = unname(civilytics_colors["ember_600"]),
|
||||||
strip_color = unname(civilytics_colors["paper_2"]),
|
strip_color = unname(civilytics_colors["paper_2"]),
|
||||||
grid = c("y", "x", "both", "none"),
|
grid = c("y", "x", "both", "none"),
|
||||||
paper_bg = TRUE) {
|
paper_bg = FALSE) {
|
||||||
|
|
||||||
grid <- match.arg(grid)
|
grid <- match.arg(grid)
|
||||||
half_line <- font_size / 2
|
half_line <- font_size / 2
|
||||||
@@ -113,30 +115,30 @@ theme_civilytics <- function(
|
|||||||
bg_color <- if (isTRUE(paper_bg)) paper else NA
|
bg_color <- if (isTRUE(paper_bg)) paper else NA
|
||||||
|
|
||||||
# Grid line elements
|
# Grid line elements
|
||||||
grid_line <- ggplot2::element_line(color = rule_color, linewidth = 0.35)
|
grid_line <- element_line(color = rule_color, linewidth = 0.35)
|
||||||
no_line <- ggplot2::element_blank()
|
no_line <- element_blank()
|
||||||
|
|
||||||
ggplot2::theme_grey(
|
theme_grey(
|
||||||
base_size = font_size,
|
base_size = font_size,
|
||||||
base_family = font_family,
|
base_family = font_family,
|
||||||
ink = ink,
|
ink = ink,
|
||||||
paper = paper,
|
paper = paper,
|
||||||
accent = accent
|
accent = accent
|
||||||
) %+replace%
|
) %+replace%
|
||||||
ggplot2::theme(
|
theme(
|
||||||
line = ggplot2::element_line(
|
line = element_line(
|
||||||
color = ink,
|
color = ink,
|
||||||
linewidth = line_size,
|
linewidth = line_size,
|
||||||
linetype = 1,
|
linetype = 1,
|
||||||
lineend = "butt"
|
lineend = "butt"
|
||||||
),
|
),
|
||||||
rect = ggplot2::element_rect(
|
rect = element_rect(
|
||||||
fill = NA,
|
fill = NA,
|
||||||
color = NA,
|
color = NA,
|
||||||
linewidth = line_size,
|
linewidth = line_size,
|
||||||
linetype = 1
|
linetype = 1
|
||||||
),
|
),
|
||||||
text = ggplot2::element_text(
|
text = element_text(
|
||||||
family = font_family,
|
family = font_family,
|
||||||
face = "plain",
|
face = "plain",
|
||||||
color = ink,
|
color = ink,
|
||||||
@@ -145,161 +147,161 @@ theme_civilytics <- function(
|
|||||||
vjust = 0.5,
|
vjust = 0.5,
|
||||||
angle = 0,
|
angle = 0,
|
||||||
lineheight = 0.9,
|
lineheight = 0.9,
|
||||||
margin = ggplot2::margin(),
|
margin = margin(),
|
||||||
debug = FALSE
|
debug = FALSE
|
||||||
),
|
),
|
||||||
# -- Axes --
|
# -- Axes --
|
||||||
axis.line = ggplot2::element_blank(),
|
axis.line = element_blank(),
|
||||||
axis.line.x = ggplot2::element_line(
|
axis.line.x = element_line(
|
||||||
color = ink,
|
color = ink,
|
||||||
linewidth = 0.6,
|
linewidth = 0.6,
|
||||||
lineend = "square"
|
lineend = "square"
|
||||||
),
|
),
|
||||||
axis.line.y = ggplot2::element_blank(),
|
axis.line.y = element_blank(),
|
||||||
axis.text = ggplot2::element_text(
|
axis.text = element_text(
|
||||||
color = ink_2,
|
color = ink_2,
|
||||||
size = ggplot2::rel(rel_small)
|
size = rel(rel_small)
|
||||||
),
|
),
|
||||||
axis.text.x = ggplot2::element_text(
|
axis.text.x = element_text(
|
||||||
margin = ggplot2::margin(t = small_size / 4),
|
margin = margin(t = small_size / 4),
|
||||||
vjust = 1
|
vjust = 1
|
||||||
),
|
),
|
||||||
axis.text.x.top = ggplot2::element_text(
|
axis.text.x.top = element_text(
|
||||||
margin = ggplot2::margin(b = small_size / 4),
|
margin = margin(b = small_size / 4),
|
||||||
vjust = 0
|
vjust = 0
|
||||||
),
|
),
|
||||||
axis.text.y = ggplot2::element_text(
|
axis.text.y = element_text(
|
||||||
margin = ggplot2::margin(r = small_size / 4),
|
margin = margin(r = small_size / 4),
|
||||||
hjust = 1
|
hjust = 1
|
||||||
),
|
),
|
||||||
axis.text.y.right = ggplot2::element_text(
|
axis.text.y.right = element_text(
|
||||||
margin = ggplot2::margin(l = small_size / 4),
|
margin = margin(l = small_size / 4),
|
||||||
hjust = 0
|
hjust = 0
|
||||||
),
|
),
|
||||||
axis.ticks = ggplot2::element_line(
|
axis.ticks = element_line(
|
||||||
color = ink_3,
|
color = ink_3,
|
||||||
linewidth = 0.4
|
linewidth = 0.4
|
||||||
),
|
),
|
||||||
axis.ticks.length = ggplot2::unit(4, "pt"),
|
axis.ticks.length = unit(4, "pt"),
|
||||||
axis.title.x = ggplot2::element_text(
|
axis.title.x = element_text(
|
||||||
size = ggplot2::rel(rel_small),
|
size = rel(rel_small),
|
||||||
color = ink_3,
|
color = ink_3,
|
||||||
margin = ggplot2::margin(t = 10),
|
margin = margin(t = 10),
|
||||||
vjust = 1
|
vjust = 1
|
||||||
),
|
),
|
||||||
axis.title.x.top = ggplot2::element_text(
|
axis.title.x.top = element_text(
|
||||||
size = ggplot2::rel(rel_small),
|
size = rel(rel_small),
|
||||||
color = ink_3,
|
color = ink_3,
|
||||||
margin = ggplot2::margin(b = half_line / 2),
|
margin = margin(b = half_line / 2),
|
||||||
vjust = 0
|
vjust = 0
|
||||||
),
|
),
|
||||||
axis.title.y = ggplot2::element_text(
|
axis.title.y = element_text(
|
||||||
size = ggplot2::rel(rel_small),
|
size = rel(rel_small),
|
||||||
color = ink_3,
|
color = ink_3,
|
||||||
angle = 90,
|
angle = 90,
|
||||||
margin = ggplot2::margin(r = 10),
|
margin = margin(r = 10),
|
||||||
vjust = 1
|
vjust = 1
|
||||||
),
|
),
|
||||||
axis.title.y.right = ggplot2::element_text(
|
axis.title.y.right = element_text(
|
||||||
size = ggplot2::rel(rel_small),
|
size = rel(rel_small),
|
||||||
color = ink_3,
|
color = ink_3,
|
||||||
angle = -90,
|
angle = -90,
|
||||||
margin = ggplot2::margin(l = half_line / 2),
|
margin = margin(l = half_line / 2),
|
||||||
vjust = 0
|
vjust = 0
|
||||||
),
|
),
|
||||||
# -- Legend --
|
# -- Legend --
|
||||||
legend.background = ggplot2::element_blank(),
|
legend.background = element_blank(),
|
||||||
legend.spacing = ggplot2::unit(font_size, "pt"),
|
legend.spacing = unit(font_size, "pt"),
|
||||||
legend.spacing.x = NULL,
|
legend.spacing.x = NULL,
|
||||||
legend.spacing.y = NULL,
|
legend.spacing.y = NULL,
|
||||||
legend.margin = ggplot2::margin(0, 0, 4, 0),
|
legend.margin = margin(0, 0, 4, 0),
|
||||||
legend.key = ggplot2::element_blank(),
|
legend.key = element_blank(),
|
||||||
legend.key.size = ggplot2::unit(12, "pt"),
|
legend.key.size = unit(12, "pt"),
|
||||||
legend.key.height = NULL,
|
legend.key.height = NULL,
|
||||||
legend.key.width = NULL,
|
legend.key.width = NULL,
|
||||||
legend.text = ggplot2::element_text(
|
legend.text = element_text(
|
||||||
size = ggplot2::rel(rel_small),
|
size = rel(rel_small),
|
||||||
color = ink_2
|
color = ink_2
|
||||||
),
|
),
|
||||||
legend.title = ggplot2::element_text(
|
legend.title = element_text(
|
||||||
hjust = 0,
|
hjust = 0,
|
||||||
face = "bold",
|
face = "bold",
|
||||||
size = ggplot2::rel(rel_tiny),
|
size = rel(rel_tiny),
|
||||||
color = ink_3
|
color = ink_3
|
||||||
),
|
),
|
||||||
legend.position = "top",
|
legend.position = "top",
|
||||||
legend.direction = NULL,
|
legend.direction = NULL,
|
||||||
legend.justification = c("left", "center"),
|
legend.justification = c("left", "center"),
|
||||||
legend.box = NULL,
|
legend.box = NULL,
|
||||||
legend.box.margin = ggplot2::margin(0, 0, 0, 0),
|
legend.box.margin = margin(0, 0, 0, 0),
|
||||||
legend.box.background = ggplot2::element_blank(),
|
legend.box.background = element_blank(),
|
||||||
legend.box.spacing = ggplot2::unit(font_size, "pt"),
|
legend.box.spacing = unit(font_size, "pt"),
|
||||||
# -- Panel --
|
# -- Panel --
|
||||||
panel.background = ggplot2::element_rect(fill = bg_color, color = NA),
|
panel.background = element_rect(fill = bg_color, color = NA),
|
||||||
panel.border = ggplot2::element_blank(),
|
panel.border = element_blank(),
|
||||||
panel.grid.minor = ggplot2::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.x = if (grid %in% c("x", "both")) grid_line else no_line,
|
||||||
panel.grid.major.y = if (grid %in% c("y", "both")) grid_line else no_line,
|
panel.grid.major.y = if (grid %in% c("y", "both")) grid_line else no_line,
|
||||||
panel.spacing = ggplot2::unit(16, "pt"),
|
panel.spacing = unit(16, "pt"),
|
||||||
panel.spacing.x = NULL,
|
panel.spacing.x = NULL,
|
||||||
panel.spacing.y = NULL,
|
panel.spacing.y = NULL,
|
||||||
panel.ontop = FALSE,
|
panel.ontop = FALSE,
|
||||||
# -- Facet strips --
|
# -- Facet strips --
|
||||||
strip.background = ggplot2::element_rect(fill = strip_color, color = NA),
|
strip.background = element_rect(fill = strip_color, color = NA),
|
||||||
strip.text = ggplot2::element_text(
|
strip.text = element_text(
|
||||||
family = font_family,
|
family = font_family,
|
||||||
face = "bold",
|
face = "bold",
|
||||||
size = ggplot2::rel(rel_small),
|
size = rel(rel_small),
|
||||||
color = ink,
|
color = ink,
|
||||||
margin = ggplot2::margin(
|
margin = margin(
|
||||||
half_line / 2, half_line / 2,
|
half_line / 2, half_line / 2,
|
||||||
half_line / 2, half_line / 2
|
half_line / 2, half_line / 2
|
||||||
)
|
)
|
||||||
),
|
),
|
||||||
strip.text.x = NULL,
|
strip.text.x = NULL,
|
||||||
strip.text.y = ggplot2::element_text(angle = -90),
|
strip.text.y = element_text(angle = -90),
|
||||||
strip.placement = "inside",
|
strip.placement = "inside",
|
||||||
strip.placement.x = NULL,
|
strip.placement.x = NULL,
|
||||||
strip.placement.y = NULL,
|
strip.placement.y = NULL,
|
||||||
strip.switch.pad.grid = ggplot2::unit(half_line / 2, "pt"),
|
strip.switch.pad.grid = unit(half_line / 2, "pt"),
|
||||||
strip.switch.pad.wrap = ggplot2::unit(half_line / 2, "pt"),
|
strip.switch.pad.wrap = unit(half_line / 2, "pt"),
|
||||||
# -- Plot-level --
|
# -- Plot-level --
|
||||||
plot.background = ggplot2::element_rect(fill = bg_color, color = NA),
|
plot.background = element_rect(fill = bg_color, color = NA),
|
||||||
plot.title = ggplot2::element_text(
|
plot.title = element_text(
|
||||||
family = title_family,
|
family = title_family,
|
||||||
face = "bold",
|
face = "bold",
|
||||||
size = ggplot2::rel(rel_large),
|
size = rel(rel_large),
|
||||||
hjust = 0,
|
hjust = 0,
|
||||||
vjust = 1,
|
vjust = 1,
|
||||||
margin = ggplot2::margin(b = 4)
|
margin = margin(b = 4)
|
||||||
),
|
),
|
||||||
plot.title.position = "plot",
|
plot.title.position = "plot",
|
||||||
plot.subtitle = ggplot2::element_text(
|
plot.subtitle = element_text(
|
||||||
size = ggplot2::rel(1),
|
size = rel(1),
|
||||||
color = ink_2,
|
color = ink_2,
|
||||||
hjust = 0,
|
hjust = 0,
|
||||||
vjust = 1,
|
vjust = 1,
|
||||||
lineheight = 1.3,
|
lineheight = 1.3,
|
||||||
margin = ggplot2::margin(b = 14)
|
margin = margin(b = 14)
|
||||||
),
|
),
|
||||||
plot.caption = ggplot2::element_text(
|
plot.caption = element_text(
|
||||||
size = ggplot2::rel(rel_tiny),
|
size = rel(rel_tiny),
|
||||||
color = ink_3,
|
color = ink_3,
|
||||||
hjust = 0,
|
hjust = 0,
|
||||||
vjust = 1,
|
vjust = 1,
|
||||||
lineheight = 1.3,
|
lineheight = 1.3,
|
||||||
margin = ggplot2::margin(t = 14)
|
margin = margin(t = 14)
|
||||||
),
|
),
|
||||||
plot.caption.position = "plot",
|
plot.caption.position = "plot",
|
||||||
plot.tag = ggplot2::element_text(
|
plot.tag = element_text(
|
||||||
face = "bold",
|
face = "bold",
|
||||||
color = accent,
|
color = accent,
|
||||||
size = ggplot2::rel(rel_tiny),
|
size = rel(rel_tiny),
|
||||||
hjust = 0,
|
hjust = 0,
|
||||||
vjust = 0.7
|
vjust = 0.7
|
||||||
),
|
),
|
||||||
plot.tag.position = c(0, 1),
|
plot.tag.position = c(0, 1),
|
||||||
plot.margin = ggplot2::margin(16, 18, 16, 16),
|
plot.margin = margin(16, 18, 16, 16),
|
||||||
complete = TRUE
|
complete = TRUE
|
||||||
)
|
)
|
||||||
}
|
}
|
||||||
@@ -315,7 +317,7 @@ theme_civilytics <- function(
|
|||||||
#'
|
#'
|
||||||
#' @inheritParams theme_civilytics
|
#' @inheritParams theme_civilytics
|
||||||
#'
|
#'
|
||||||
#' @return A complete ggplot2 [ggplot2::theme()] object.
|
#' @return A complete ggplot2 [theme()] object.
|
||||||
#' @export
|
#' @export
|
||||||
#'
|
#'
|
||||||
#' @examples
|
#' @examples
|
||||||
@@ -359,20 +361,20 @@ theme_civilytics_dark <- function(
|
|||||||
# The base theme hardcodes ink_2/ink_3 for subtitle/caption, which are
|
# The base theme hardcodes ink_2/ink_3 for subtitle/caption, which are
|
||||||
# dark colors meant for light backgrounds. Override with lighter values
|
# dark colors meant for light backgrounds. Override with lighter values
|
||||||
# so text remains readable on the navy background.
|
# so text remains readable on the navy background.
|
||||||
ggplot2::theme(
|
theme(
|
||||||
plot.subtitle = ggplot2::element_text(
|
plot.subtitle = element_text(
|
||||||
color = unname(civilytics_colors["navy_200"])
|
color = unname(civilytics_colors["navy_200"])
|
||||||
),
|
),
|
||||||
plot.caption = ggplot2::element_text(
|
plot.caption = element_text(
|
||||||
color = unname(civilytics_colors["navy_300"])
|
color = unname(civilytics_colors["navy_300"])
|
||||||
),
|
),
|
||||||
axis.text = ggplot2::element_text(
|
axis.text = element_text(
|
||||||
color = unname(civilytics_colors["navy_200"])
|
color = unname(civilytics_colors["navy_200"])
|
||||||
),
|
),
|
||||||
axis.title.x = ggplot2::element_text(
|
axis.title.x = element_text(
|
||||||
color = unname(civilytics_colors["navy_300"])
|
color = unname(civilytics_colors["navy_300"])
|
||||||
),
|
),
|
||||||
axis.title.y = ggplot2::element_text(
|
axis.title.y = element_text(
|
||||||
color = unname(civilytics_colors["navy_300"])
|
color = unname(civilytics_colors["navy_300"])
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
@@ -387,7 +389,7 @@ theme_civilytics_dark <- function(
|
|||||||
#'
|
#'
|
||||||
#' @inheritParams theme_civilytics
|
#' @inheritParams theme_civilytics
|
||||||
#'
|
#'
|
||||||
#' @return A complete ggplot2 [ggplot2::theme()] object.
|
#' @return A complete ggplot2 [theme()] object.
|
||||||
#' @export
|
#' @export
|
||||||
#'
|
#'
|
||||||
#' @examples
|
#' @examples
|
||||||
@@ -428,13 +430,13 @@ theme_civilytics_slide <- function(
|
|||||||
grid = grid,
|
grid = grid,
|
||||||
paper_bg = paper_bg
|
paper_bg = paper_bg
|
||||||
) +
|
) +
|
||||||
ggplot2::theme(
|
theme(
|
||||||
axis.line.x = ggplot2::element_line(
|
axis.line.x = element_line(
|
||||||
color = ink,
|
color = ink,
|
||||||
linewidth = 0.8,
|
linewidth = 0.8,
|
||||||
lineend = "square"
|
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
|
#' Strips away axes, ticks, gridlines, and axis titles/labels — the elements
|
||||||
#' that are meaningless on a choropleth or spatial plot.
|
#' that are meaningless on a choropleth or spatial plot.
|
||||||
#'
|
#'
|
||||||
#' @return A partial ggplot2 [ggplot2::theme()] object.
|
#' @return A partial ggplot2 [theme()] object.
|
||||||
#' @keywords internal
|
#' @keywords internal
|
||||||
.map_theme_extras <- function() {
|
.map_theme_extras <- function() {
|
||||||
ggplot2::theme(
|
theme(
|
||||||
axis.line = ggplot2::element_blank(),
|
axis.line = element_blank(),
|
||||||
axis.line.x = ggplot2::element_blank(),
|
axis.line.x = element_blank(),
|
||||||
axis.line.y = ggplot2::element_blank(),
|
axis.line.y = element_blank(),
|
||||||
axis.text = ggplot2::element_blank(),
|
axis.text = element_blank(),
|
||||||
axis.text.x = ggplot2::element_blank(),
|
axis.text.x = element_blank(),
|
||||||
axis.text.y = ggplot2::element_blank(),
|
axis.text.y = element_blank(),
|
||||||
axis.ticks = ggplot2::element_blank(),
|
axis.ticks = element_blank(),
|
||||||
axis.ticks.length = ggplot2::unit(0, "pt"),
|
axis.ticks.length = unit(0, "pt"),
|
||||||
axis.title.x = ggplot2::element_blank(),
|
axis.title.x = element_blank(),
|
||||||
axis.title.y = ggplot2::element_blank(),
|
axis.title.y = element_blank(),
|
||||||
panel.grid.major.x = ggplot2::element_blank(),
|
panel.grid.major.x = element_blank(),
|
||||||
panel.grid.major.y = ggplot2::element_blank(),
|
panel.grid.major.y = element_blank(),
|
||||||
panel.grid.minor = ggplot2::element_blank()
|
panel.grid.minor = element_blank()
|
||||||
)
|
)
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -476,7 +478,7 @@ theme_civilytics_slide <- function(
|
|||||||
#'
|
#'
|
||||||
#' @inheritParams theme_civilytics
|
#' @inheritParams theme_civilytics
|
||||||
#'
|
#'
|
||||||
#' @return A complete ggplot2 [ggplot2::theme()] object.
|
#' @return A complete ggplot2 [theme()] object.
|
||||||
#' @export
|
#' @export
|
||||||
#'
|
#'
|
||||||
#' @examples
|
#' @examples
|
||||||
@@ -528,7 +530,7 @@ theme_civilytics_map <- function(
|
|||||||
#'
|
#'
|
||||||
#' @inheritParams theme_civilytics_dark
|
#' @inheritParams theme_civilytics_dark
|
||||||
#'
|
#'
|
||||||
#' @return A complete ggplot2 [ggplot2::theme()] object.
|
#' @return A complete ggplot2 [theme()] object.
|
||||||
#' @export
|
#' @export
|
||||||
#'
|
#'
|
||||||
#' @examples
|
#' @examples
|
||||||
@@ -579,7 +581,7 @@ theme_civilytics_dark_map <- function(
|
|||||||
#'
|
#'
|
||||||
#' @inheritParams theme_civilytics_slide
|
#' @inheritParams theme_civilytics_slide
|
||||||
#'
|
#'
|
||||||
#' @return A complete ggplot2 [ggplot2::theme()] object.
|
#' @return A complete ggplot2 [theme()] object.
|
||||||
#' @export
|
#' @export
|
||||||
#'
|
#'
|
||||||
#' @examples
|
#' @examples
|
||||||
|
|||||||
+866
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 |
@@ -2,7 +2,7 @@
|
|||||||
title: "Who pays when rent outpaces wages?"
|
title: "Who pays when rent outpaces wages?"
|
||||||
subtitle: "A 12-county analysis of cost-burdened renter households, 2019–2024."
|
subtitle: "A 12-county analysis of cost-burdened renter households, 2019–2024."
|
||||||
author:
|
author:
|
||||||
- name: "Civilytics Research"
|
- name: "Jared Knowles"
|
||||||
affiliation: "Civilytics Consulting"
|
affiliation: "Civilytics Consulting"
|
||||||
date: "2026-04-15"
|
date: "2026-04-15"
|
||||||
abstract: |
|
abstract: |
|
||||||
@@ -19,7 +19,9 @@ format:
|
|||||||
toc: true
|
toc: true
|
||||||
toc-location: right
|
toc-location: right
|
||||||
typst:
|
typst:
|
||||||
template: ../typst/civilytics-typst.typ
|
template-partials:
|
||||||
|
- ../typst/typst-template.typ
|
||||||
|
- ../typst/typst-show.typ
|
||||||
pdf:
|
pdf:
|
||||||
include-in-header: ../latex/civilytics.tex
|
include-in-header: ../latex/civilytics.tex
|
||||||
include-before-body: ../latex/civilytics-title.tex
|
include-before-body: ../latex/civilytics-title.tex
|
||||||
|
|||||||
@@ -55,11 +55,11 @@ Big idea goes here.
|
|||||||
|
|
||||||
> Rent has outpaced wages in every county we studied.
|
> Rent has outpaced wages in every county we studied.
|
||||||
|
|
||||||
Civilytics Research, 2026
|
Civilytics Consulting, 2026
|
||||||
|
|
||||||
## Thank you {.thank-you}
|
## Thank you {.thank-you}
|
||||||
|
|
||||||
Questions?
|
Questions?
|
||||||
|
|
||||||
- jared@civilytics.com
|
- jared@civilytics.com
|
||||||
- civilytics.consulting
|
- civilytics.com
|
||||||
|
|||||||
@@ -2,11 +2,16 @@
|
|||||||
% Replaces Quarto's default \maketitle. Uses values from YAML
|
% Replaces Quarto's default \maketitle. Uses values from YAML
|
||||||
% (\thetitle, \theauthor, \thedate) plus an \ifabstract block.
|
% (\thetitle, \theauthor, \thedate) plus an \ifabstract block.
|
||||||
|
|
||||||
|
% Guard: \thesubtitle is normally defined by civilytics.tex's subtitle
|
||||||
|
% capture; provide a fallback so this partial degrades gracefully if used
|
||||||
|
% without that preamble. See civilyticsR issue #13.
|
||||||
|
\providecommand{\thesubtitle}{}
|
||||||
|
|
||||||
\begin{titlepage}
|
\begin{titlepage}
|
||||||
\pagecolor{paper}
|
\pagecolor{paper}
|
||||||
\color{ink}
|
\color{ink}
|
||||||
\vspace*{0.5in}
|
\vspace*{0.5in}
|
||||||
{\sffamily\bfseries\scriptsize\color{ember}\MakeUppercase{— Civilytics Research}\par}
|
{\sffamily\bfseries\scriptsize\color{ember}\MakeUppercase{— Civilytics Consulting}\par}
|
||||||
\vspace{12pt}
|
\vspace{12pt}
|
||||||
{\displayfont\fontsize{32pt}{34pt}\selectfont\bfseries\color{ink}\thetitle\par}
|
{\displayfont\fontsize{32pt}{34pt}\selectfont\bfseries\color{ink}\thetitle\par}
|
||||||
\vspace{8pt}
|
\vspace{8pt}
|
||||||
@@ -33,8 +38,6 @@
|
|||||||
|
|
||||||
% Pulse mark, in ember
|
% Pulse mark, in ember
|
||||||
\begin{center}
|
\begin{center}
|
||||||
\begin{tikzpicture}[overlay, remember picture]
|
|
||||||
\end{tikzpicture}
|
|
||||||
{\color{ember}\rule{40pt}{2pt}}
|
{\color{ember}\rule{40pt}{2pt}}
|
||||||
\end{center}
|
\end{center}
|
||||||
\end{titlepage}
|
\end{titlepage}
|
||||||
|
|||||||
@@ -40,17 +40,40 @@
|
|||||||
\color{ink}
|
\color{ink}
|
||||||
|
|
||||||
% --- Fonts (require local install or fontspec lookup) ---
|
% --- Fonts (require local install or fontspec lookup) ---
|
||||||
|
% Bold uses the family's native Bold weight (present in every Source Serif 4
|
||||||
|
% install). Do NOT hard-require a "SemiBold" face: the package installs no
|
||||||
|
% system fonts for the PDF path, and standard Source Serif 4 ships only
|
||||||
|
% Regular/Bold/Italic/BoldItalic. See civilyticsR issue #14.
|
||||||
\setmainfont{Source Serif 4}[
|
\setmainfont{Source Serif 4}[
|
||||||
UprightFont = *,
|
UprightFont = *,
|
||||||
ItalicFont = * Italic,
|
ItalicFont = * Italic,
|
||||||
BoldFont = * SemiBold,
|
|
||||||
BoldItalicFont = * SemiBold Italic,
|
|
||||||
Ligatures = TeX,
|
Ligatures = TeX,
|
||||||
]
|
]
|
||||||
\setsansfont{Inter}[Ligatures = TeX]
|
\setsansfont{Inter}[Ligatures = TeX]
|
||||||
\setmonofont{JetBrains Mono}[Scale = 0.92]
|
\setmonofont{JetBrains Mono}[Scale = 0.92]
|
||||||
\newfontfamily\displayfont{Libre Franklin}[Ligatures = TeX]
|
\newfontfamily\displayfont{Libre Franklin}[Ligatures = TeX]
|
||||||
|
|
||||||
|
% --- Subtitle capture ---
|
||||||
|
% Quarto/pandoc defines \subtitle (which appends to \@title) but never
|
||||||
|
% \thesubtitle, which the title page uses. This preamble is emitted before
|
||||||
|
% pandoc's \providecommand{\subtitle}, so our definition wins: capture the
|
||||||
|
% subtitle into \thesubtitle instead. See civilyticsR issue #13.
|
||||||
|
\makeatletter
|
||||||
|
\providecommand{\thesubtitle}{}
|
||||||
|
\def\subtitle#1{\renewcommand{\thesubtitle}{#1}}
|
||||||
|
\makeatother
|
||||||
|
|
||||||
|
% --- Use the Civilytics title page, not pandoc's default ---
|
||||||
|
% civilytics-title.tex (include-before-body) IS the title page. Quarto emits
|
||||||
|
% its default \maketitle + abstract *before* include-before-body, which would
|
||||||
|
% print a second, unstyled title. Neutralise both here, in the preamble
|
||||||
|
% (runs at \begin{document}, before the default title). The branded title page
|
||||||
|
% does not display the abstract. See civilyticsR issue #13.
|
||||||
|
\AtBeginDocument{%
|
||||||
|
\renewcommand{\maketitle}{}%
|
||||||
|
\renewenvironment{abstract}{\setbox0=\vbox\bgroup}{\egroup}%
|
||||||
|
}
|
||||||
|
|
||||||
% --- Hyperlinks ---
|
% --- Hyperlinks ---
|
||||||
\hypersetup{
|
\hypersetup{
|
||||||
colorlinks = true,
|
colorlinks = true,
|
||||||
@@ -77,7 +100,7 @@
|
|||||||
\renewcommand{\footrulewidth}{0pt}
|
\renewcommand{\footrulewidth}{0pt}
|
||||||
\fancyhead[L]{\sffamily\scriptsize\color{ink3}\MakeUppercase{Civilytics Consulting}}
|
\fancyhead[L]{\sffamily\scriptsize\color{ink3}\MakeUppercase{Civilytics Consulting}}
|
||||||
\fancyhead[R]{\sffamily\scriptsize\color{ink3}\thetitle}
|
\fancyhead[R]{\sffamily\scriptsize\color{ink3}\thetitle}
|
||||||
\fancyfoot[L]{\sffamily\scriptsize\color{ink3}civilytics.consulting}
|
\fancyfoot[L]{\sffamily\scriptsize\color{ink3}civilytics.com}
|
||||||
\fancyfoot[C]{\sffamily\scriptsize\color{ink3}\thepage}
|
\fancyfoot[C]{\sffamily\scriptsize\color{ink3}\thepage}
|
||||||
\fancyfoot[R]{\sffamily\scriptsize\color{ink3}\textcopyright\ 2026}
|
\fancyfoot[R]{\sffamily\scriptsize\color{ink3}\textcopyright\ 2026}
|
||||||
|
|
||||||
|
|||||||
@@ -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:
|
// Usage in YAML:
|
||||||
// format:
|
// format:
|
||||||
// typst:
|
// typst:
|
||||||
// template: quarto/typst/civilytics-typst.typ
|
// template-partials:
|
||||||
|
// - quarto/typst/typst-template.typ
|
||||||
|
// - quarto/typst/typst-show.typ
|
||||||
// =============================================================
|
// =============================================================
|
||||||
|
|
||||||
#let paper-bg = rgb("#FAF7F2")
|
#let paper-bg = rgb("#FAF7F2")
|
||||||
@@ -54,7 +60,7 @@
|
|||||||
grid(
|
grid(
|
||||||
columns: (1fr, auto, 1fr),
|
columns: (1fr, auto, 1fr),
|
||||||
align: (left, center, right),
|
align: (left, center, right),
|
||||||
[civilytics.consulting],
|
[civilytics.com],
|
||||||
counter(page).display("1 / 1", both: true),
|
counter(page).display("1 / 1", both: true),
|
||||||
[© 2026]
|
[© 2026]
|
||||||
)
|
)
|
||||||
@@ -158,7 +164,7 @@
|
|||||||
if title != none {
|
if title != none {
|
||||||
block[
|
block[
|
||||||
#set text(font: sans-stack, size: 8pt, weight: 600, fill: ember, tracking: 0.1em)
|
#set text(font: sans-stack, size: 8pt, weight: 600, fill: ember, tracking: 0.1em)
|
||||||
#upper[— Civilytics Research]
|
#upper[— Civilytics Consulting]
|
||||||
]
|
]
|
||||||
v(8pt)
|
v(8pt)
|
||||||
block[
|
block[
|
||||||
@@ -229,16 +235,3 @@
|
|||||||
|
|
||||||
doc
|
doc
|
||||||
}
|
}
|
||||||
|
|
||||||
// Quarto entry point
|
|
||||||
#show: doc => civilytics(
|
|
||||||
title: $title$,
|
|
||||||
$if(subtitle)$subtitle: $subtitle$,$endif$
|
|
||||||
$if(by-author)$authors: ($for(by-author)$"$it.name.literal$",$endfor$),$endif$
|
|
||||||
$if(date)$date: $date$,$endif$
|
|
||||||
$if(abstract)$abstract: [$abstract$],$endif$
|
|
||||||
toc: $if(toc)$true$else$false$endif$,
|
|
||||||
doc
|
|
||||||
)
|
|
||||||
|
|
||||||
$body$
|
|
||||||
@@ -4,17 +4,25 @@
|
|||||||
\alias{civilytics_load_fonts}
|
\alias{civilytics_load_fonts}
|
||||||
\title{Load Civilytics brand fonts}
|
\title{Load Civilytics brand fonts}
|
||||||
\usage{
|
\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{
|
\value{
|
||||||
Invisibly returns `NULL`.
|
Invisibly returns \code{TRUE} if fonts were loaded, \code{FALSE} if skipped
|
||||||
|
(already loaded and \code{force = FALSE}).
|
||||||
}
|
}
|
||||||
\description{
|
\description{
|
||||||
Downloads Inter and Libre Franklin from Google Fonts via
|
Downloads Inter, Libre Franklin, Source Serif 4 and JetBrains Mono from
|
||||||
[sysfonts::font_add_google()], then calls [showtext::showtext_auto()] so
|
Google Fonts via \code{sysfonts::font_add_google()}, then calls
|
||||||
that all graphics devices render text with those fonts. This is called
|
\code{showtext::showtext_auto()} so that all graphics devices render text with
|
||||||
automatically when the package loads; use this function to retry if the
|
those fonts. This is called automatically when the package loads; use this
|
||||||
initial load failed (e.g., the machine was offline at load time).
|
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{
|
\examples{
|
||||||
\dontrun{
|
\dontrun{
|
||||||
|
|||||||
+2
-1
@@ -22,7 +22,8 @@ Plot a jpeg image as a raster
|
|||||||
}
|
}
|
||||||
\examples{
|
\examples{
|
||||||
\dontrun{
|
\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(img)
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -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.
|
||||||
|
}
|
||||||
@@ -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")
|
||||||
|
}
|
||||||
|
}
|
||||||
@@ -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
@@ -17,7 +17,7 @@ theme_civilytics(
|
|||||||
accent = unname(civilytics_colors["ember_600"]),
|
accent = unname(civilytics_colors["ember_600"]),
|
||||||
strip_color = unname(civilytics_colors["paper_2"]),
|
strip_color = unname(civilytics_colors["paper_2"]),
|
||||||
grid = c("y", "x", "both", "none"),
|
grid = c("y", "x", "both", "none"),
|
||||||
paper_bg = TRUE
|
paper_bg = FALSE
|
||||||
)
|
)
|
||||||
}
|
}
|
||||||
\arguments{
|
\arguments{
|
||||||
@@ -56,10 +56,12 @@ to [civilytics_colors]`["paper_2"]` (`#F2EDE4`).}
|
|||||||
\item{grid}{Character. Which major gridlines to draw: `"y"` (default,
|
\item{grid}{Character. Which major gridlines to draw: `"y"` (default,
|
||||||
horizontal only), `"x"` (vertical only), `"both"`, or `"none"`.}
|
horizontal only), `"x"` (vertical only), `"both"`, or `"none"`.}
|
||||||
|
|
||||||
\item{paper_bg}{Logical. If `TRUE` (default), fill the plot and panel
|
\item{paper_bg}{Logical. If `TRUE`, fill the plot and panel backgrounds
|
||||||
backgrounds with the warm `paper` color. Set to `FALSE` for a
|
with the warm `paper` color (Civilytics cream). Default is `FALSE`
|
||||||
transparent background (useful for slides or overlay on colored
|
(transparent) so that figures composite cleanly onto any background.
|
||||||
surfaces).}
|
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{
|
\value{
|
||||||
A complete ggplot2 [ggplot2::theme()] object.
|
A complete ggplot2 [ggplot2::theme()] object.
|
||||||
@@ -105,7 +107,7 @@ shrinkage.
|
|||||||
\dontrun{
|
\dontrun{
|
||||||
library(ggplot2)
|
library(ggplot2)
|
||||||
|
|
||||||
# Default editorial theme
|
# Default — transparent background for embedding
|
||||||
ggplot(mpg, aes(displ, hwy)) +
|
ggplot(mpg, aes(displ, hwy)) +
|
||||||
geom_point() +
|
geom_point() +
|
||||||
theme_civilytics()
|
theme_civilytics()
|
||||||
@@ -116,10 +118,10 @@ ggplot(mpg, aes(displ, hwy, colour = class)) +
|
|||||||
scale_color_civilytics() +
|
scale_color_civilytics() +
|
||||||
theme_civilytics(grid = "both")
|
theme_civilytics(grid = "both")
|
||||||
|
|
||||||
# Transparent background for embedding
|
# Branded cream background (opt-in)
|
||||||
ggplot(mpg, aes(displ, hwy)) +
|
ggplot(mpg, aes(displ, hwy)) +
|
||||||
geom_point() +
|
geom_point() +
|
||||||
theme_civilytics(paper_bg = FALSE)
|
theme_civilytics(paper_bg = TRUE)
|
||||||
|
|
||||||
# Larger text for poster or display
|
# Larger text for poster or display
|
||||||
ggplot(mpg, aes(displ, hwy)) +
|
ggplot(mpg, aes(displ, hwy)) +
|
||||||
|
|||||||
@@ -56,10 +56,10 @@ to [civilytics_colors]`["paper_2"]` (`#F2EDE4`).}
|
|||||||
\item{grid}{Character. Which major gridlines to draw: `"y"` (default,
|
\item{grid}{Character. Which major gridlines to draw: `"y"` (default,
|
||||||
horizontal only), `"x"` (vertical only), `"both"`, or `"none"`.}
|
horizontal only), `"x"` (vertical only), `"both"`, or `"none"`.}
|
||||||
|
|
||||||
\item{paper_bg}{Logical. If `TRUE` (default), fill the plot and panel
|
\item{paper_bg}{Logical. If `TRUE`, fill the plot and panel backgrounds
|
||||||
backgrounds with the warm `paper` color. Set to `FALSE` for a
|
with the warm `paper` color (Civilytics cream). Default is `FALSE`
|
||||||
transparent background (useful for slides or overlay on colored
|
(transparent) so that figures composite cleanly onto any background.
|
||||||
surfaces).}
|
Set to `TRUE` for the branded cream canvas.}
|
||||||
}
|
}
|
||||||
\value{
|
\value{
|
||||||
A complete ggplot2 [ggplot2::theme()] object.
|
A complete ggplot2 [ggplot2::theme()] object.
|
||||||
|
|||||||
@@ -52,10 +52,10 @@ design system.}
|
|||||||
\item{strip_color}{Character. Hex code for facet strip background. Defaults
|
\item{strip_color}{Character. Hex code for facet strip background. Defaults
|
||||||
to [civilytics_colors]`["paper_2"]` (`#F2EDE4`).}
|
to [civilytics_colors]`["paper_2"]` (`#F2EDE4`).}
|
||||||
|
|
||||||
\item{paper_bg}{Logical. If `TRUE` (default), fill the plot and panel
|
\item{paper_bg}{Logical. If `TRUE`, fill the plot and panel backgrounds
|
||||||
backgrounds with the warm `paper` color. Set to `FALSE` for a
|
with the warm `paper` color (Civilytics cream). Default is `FALSE`
|
||||||
transparent background (useful for slides or overlay on colored
|
(transparent) so that figures composite cleanly onto any background.
|
||||||
surfaces).}
|
Set to `TRUE` for the branded cream canvas.}
|
||||||
}
|
}
|
||||||
\value{
|
\value{
|
||||||
A complete ggplot2 [ggplot2::theme()] object.
|
A complete ggplot2 [ggplot2::theme()] object.
|
||||||
|
|||||||
@@ -52,10 +52,10 @@ design system.}
|
|||||||
\item{strip_color}{Character. Hex code for facet strip background. Defaults
|
\item{strip_color}{Character. Hex code for facet strip background. Defaults
|
||||||
to [civilytics_colors]`["paper_2"]` (`#F2EDE4`).}
|
to [civilytics_colors]`["paper_2"]` (`#F2EDE4`).}
|
||||||
|
|
||||||
\item{paper_bg}{Logical. If `TRUE` (default), fill the plot and panel
|
\item{paper_bg}{Logical. If `TRUE`, fill the plot and panel backgrounds
|
||||||
backgrounds with the warm `paper` color. Set to `FALSE` for a
|
with the warm `paper` color (Civilytics cream). Default is `FALSE`
|
||||||
transparent background (useful for slides or overlay on colored
|
(transparent) so that figures composite cleanly onto any background.
|
||||||
surfaces).}
|
Set to `TRUE` for the branded cream canvas.}
|
||||||
}
|
}
|
||||||
\value{
|
\value{
|
||||||
A complete ggplot2 [ggplot2::theme()] object.
|
A complete ggplot2 [ggplot2::theme()] object.
|
||||||
|
|||||||
@@ -56,10 +56,10 @@ to [civilytics_colors]`["paper_2"]` (`#F2EDE4`).}
|
|||||||
\item{grid}{Character. Which major gridlines to draw: `"y"` (default,
|
\item{grid}{Character. Which major gridlines to draw: `"y"` (default,
|
||||||
horizontal only), `"x"` (vertical only), `"both"`, or `"none"`.}
|
horizontal only), `"x"` (vertical only), `"both"`, or `"none"`.}
|
||||||
|
|
||||||
\item{paper_bg}{Logical. If `TRUE` (default), fill the plot and panel
|
\item{paper_bg}{Logical. If `TRUE`, fill the plot and panel backgrounds
|
||||||
backgrounds with the warm `paper` color. Set to `FALSE` for a
|
with the warm `paper` color (Civilytics cream). Default is `FALSE`
|
||||||
transparent background (useful for slides or overlay on colored
|
(transparent) so that figures composite cleanly onto any background.
|
||||||
surfaces).}
|
Set to `TRUE` for the branded cream canvas.}
|
||||||
}
|
}
|
||||||
\value{
|
\value{
|
||||||
A complete ggplot2 [ggplot2::theme()] object.
|
A complete ggplot2 [ggplot2::theme()] object.
|
||||||
|
|||||||
@@ -52,10 +52,10 @@ design system.}
|
|||||||
\item{strip_color}{Character. Hex code for facet strip background. Defaults
|
\item{strip_color}{Character. Hex code for facet strip background. Defaults
|
||||||
to [civilytics_colors]`["paper_2"]` (`#F2EDE4`).}
|
to [civilytics_colors]`["paper_2"]` (`#F2EDE4`).}
|
||||||
|
|
||||||
\item{paper_bg}{Logical. If `TRUE` (default), fill the plot and panel
|
\item{paper_bg}{Logical. If `TRUE`, fill the plot and panel backgrounds
|
||||||
backgrounds with the warm `paper` color. Set to `FALSE` for a
|
with the warm `paper` color (Civilytics cream). Default is `FALSE`
|
||||||
transparent background (useful for slides or overlay on colored
|
(transparent) so that figures composite cleanly onto any background.
|
||||||
surfaces).}
|
Set to `TRUE` for the branded cream canvas.}
|
||||||
}
|
}
|
||||||
\value{
|
\value{
|
||||||
A complete ggplot2 [ggplot2::theme()] object.
|
A complete ggplot2 [ggplot2::theme()] object.
|
||||||
|
|||||||
@@ -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
|
||||||
@@ -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
|
||||||
|
|
||||||
|

|
||||||
|
|
||||||
|
<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
@@ -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.",
|
||||||
|
]
|
||||||
@@ -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 -->
|
||||||
@@ -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()
|
||||||
@@ -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])
|
||||||
|
})
|
||||||
@@ -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"))
|
||||||
|
})
|
||||||
@@ -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"]))
|
||||||
|
})
|
||||||
|
|||||||
@@ -133,8 +133,13 @@ test_that("theme_civilytics uses brand ink color for text", {
|
|||||||
expect_equal(th$text$colour, unname(civilytics_colors["ink"]))
|
expect_equal(th$text$colour, unname(civilytics_colors["ink"]))
|
||||||
})
|
})
|
||||||
|
|
||||||
test_that("theme_civilytics uses brand paper color for plot background", {
|
test_that("theme_civilytics has transparent background by default", {
|
||||||
th <- theme_civilytics()
|
th <- theme_civilytics()
|
||||||
|
expect_true(is.na(th$plot.background$fill))
|
||||||
|
})
|
||||||
|
|
||||||
|
test_that("theme_civilytics uses brand paper color when paper_bg = TRUE", {
|
||||||
|
th <- theme_civilytics(paper_bg = TRUE)
|
||||||
expect_equal(th$plot.background$fill, unname(civilytics_colors["paper"]))
|
expect_equal(th$plot.background$fill, unname(civilytics_colors["paper"]))
|
||||||
})
|
})
|
||||||
|
|
||||||
|
|||||||
+187
-1
@@ -65,7 +65,193 @@ test_that("na_sum quiet=TRUE suppresses the message", {
|
|||||||
})
|
})
|
||||||
|
|
||||||
|
|
||||||
|
context("Test Utilities - Postcode Lookup")
|
||||||
|
|
||||||
|
# --- postcode_lookup -------------------------------------------------------
|
||||||
|
|
||||||
|
# Build a lookup that mirrors the internal implementation:
|
||||||
|
# state.name + "District of Columbia" + "Puerto Rico"
|
||||||
|
map_name <- c(state.name, "District of Columbia", "Puerto Rico")
|
||||||
|
map_abb <- c(state.abb, "DC", "PR")
|
||||||
|
|
||||||
|
lookup_ref <- function(x) {
|
||||||
|
map_abb[match(as.character(x), map_name)]
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
test_that("postcode_lookup returns correct abbreviations for known states", {
|
||||||
|
expect_equal(postcode_lookup("Montana"), lookup_ref("Montana"))
|
||||||
|
expect_equal(postcode_lookup("Texas"), lookup_ref("Texas"))
|
||||||
|
expect_equal(postcode_lookup("New York"), lookup_ref("New York"))
|
||||||
|
expect_equal(postcode_lookup("California"), lookup_ref("California"))
|
||||||
|
})
|
||||||
|
|
||||||
|
|
||||||
|
test_that("postcode_lookup handles DC and Puerto Rico", {
|
||||||
|
# These are not in state.name/state.abb but should still resolve.
|
||||||
|
expect_equal(postcode_lookup("District of Columbia"), "DC")
|
||||||
|
expect_equal(postcode_lookup("Puerto Rico"), "PR")
|
||||||
|
})
|
||||||
|
|
||||||
|
|
||||||
|
test_that("postcode_lookup is vectorized", {
|
||||||
|
states <- c("Montana", "Texas", "California", "Florida")
|
||||||
|
result <- postcode_lookup(states)
|
||||||
|
expected <- lookup_ref(states)
|
||||||
|
expect_equal(result, expected)
|
||||||
|
expect_length(result, length(states))
|
||||||
|
})
|
||||||
|
|
||||||
|
|
||||||
|
test_that("postcode_lookup returns NA for unknown state names", {
|
||||||
|
# match() returns NA when there is no match; the function propagates it.
|
||||||
|
result <- postcode_lookup("Atlantis")
|
||||||
|
expect_true(is.na(unname(result)))
|
||||||
|
})
|
||||||
|
|
||||||
|
|
||||||
|
test_that("postcode_lookup matches all built-in states", {
|
||||||
|
# Every entry in state.name should resolve to a valid abbreviation.
|
||||||
|
results <- postcode_lookup(state.name)
|
||||||
|
expected <- lookup_ref(state.name)
|
||||||
|
expect_equal(results, expected)
|
||||||
|
expect_false(any(is.na(results)))
|
||||||
|
})
|
||||||
|
|
||||||
|
|
||||||
|
context("Test Utilities - Race Short Names")
|
||||||
|
|
||||||
|
# --- race_short_names -------------------------------------------------------
|
||||||
|
|
||||||
|
# A reference implementation mirroring the function logic for cross-checking.
|
||||||
|
race_ref <- function(x) {
|
||||||
|
x <- as.character(x)
|
||||||
|
x[x %in% c("Black", "Black Or African American", "Black or African American",
|
||||||
|
"African American")] <- "black"
|
||||||
|
x[x %in% c("Hispanic", "Hispanic Or Latino", "Hispanic or Latino")] <- "hisp_lat"
|
||||||
|
x[x %in% c("White", "white", "White and Not Hispanic")] <- "white"
|
||||||
|
x[x %in% c("Asian", "Asian American")] <- "asian"
|
||||||
|
x[x %in% c("Two Or More Races", "Two or More Races")] <- "two_or_more"
|
||||||
|
x[x %in% c("Native Hawaiian Or Other Pacific Islander",
|
||||||
|
"Native Hawaiian or Other Pacific Islander",
|
||||||
|
"Native Hawaiian Pacific Islander")] <- "native_haw"
|
||||||
|
x[x %in% c("American Indian", "American Indian Or Alaska Native",
|
||||||
|
"American Indian or Alaska Native", "American Indian or Native Alaskan")] <- "amind"
|
||||||
|
x[x %in% c("Not Reported")] <- "other"
|
||||||
|
x
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
test_that("race_short_names returns character vector of same length", {
|
||||||
|
input <- c("Black", "Hispanic Or Latino", "White")
|
||||||
|
result <- race_short_names(input)
|
||||||
|
expect_type(result, "character")
|
||||||
|
expect_length(result, length(input))
|
||||||
|
})
|
||||||
|
|
||||||
|
|
||||||
|
test_that("race_short_names maps all known categories correctly", {
|
||||||
|
# One representative from each category group.
|
||||||
|
input <- c(
|
||||||
|
"Black Or African American",
|
||||||
|
"Hispanic or Latino",
|
||||||
|
"White and Not Hispanic",
|
||||||
|
"Asian American",
|
||||||
|
"Two or More Races",
|
||||||
|
"Native Hawaiian or Other Pacific Islander",
|
||||||
|
"American Indian or Alaska Native",
|
||||||
|
"Not Reported"
|
||||||
|
)
|
||||||
|
|
||||||
|
expected <- c(
|
||||||
|
"black", "hisp_lat", "white", "asian",
|
||||||
|
"two_or_more", "native_haw", "amind", "other"
|
||||||
|
)
|
||||||
|
|
||||||
|
result <- race_short_names(input)
|
||||||
|
expect_equal(result, expected)
|
||||||
|
})
|
||||||
|
|
||||||
|
|
||||||
|
test_that("race_short_names coerces factors to character", {
|
||||||
|
input_factor <- factor(c("Black", "White", "Asian"))
|
||||||
|
result <- race_short_names(input_factor)
|
||||||
|
expect_type(result, "character")
|
||||||
|
expect_equal(result, c("black", "white", "asian"))
|
||||||
|
})
|
||||||
|
|
||||||
|
|
||||||
|
test_that("race_short_names passes through unrecognized values unchanged", {
|
||||||
|
input <- c("Black", "Some Other Category", "White")
|
||||||
|
result <- race_short_names(input)
|
||||||
|
# Unrecognized category should be returned as-is (lowercased by as.character).
|
||||||
|
expect_equal(result[2], "Some Other Category")
|
||||||
|
})
|
||||||
|
|
||||||
|
|
||||||
|
test_that("race_short_names handles empty input", {
|
||||||
|
result <- race_short_names(character(0))
|
||||||
|
expect_length(result, 0)
|
||||||
|
expect_type(result, "character")
|
||||||
|
})
|
||||||
|
|
||||||
|
|
||||||
|
test_that("race_short_names matches reference implementation across all categories",
|
||||||
|
{
|
||||||
|
# Exhaustive check: feed every variant string the function handles.
|
||||||
|
all_variants <- c(
|
||||||
|
"Black", "Black Or African American", "Black or African American", "African American",
|
||||||
|
"Hispanic", "Hispanic Or Latino", "Hispanic or Latino",
|
||||||
|
"White", "white", "White and Not Hispanic",
|
||||||
|
"Asian", "Asian American",
|
||||||
|
"Two Or More Races", "Two or More Races",
|
||||||
|
"Native Hawaiian Or Other Pacific Islander",
|
||||||
|
"Native Hawaiian or Other Pacific Islander",
|
||||||
|
"Native Hawaiian Pacific Islander",
|
||||||
|
"American Indian", "American Indian Or Alaska Native",
|
||||||
|
"American Indian or Alaska Native", "American Indian or Native Alaskan",
|
||||||
|
"Not Reported"
|
||||||
|
)
|
||||||
|
|
||||||
|
expect_equal(race_short_names(all_variants), race_ref(all_variants))
|
||||||
|
})
|
||||||
|
|
||||||
|
|
||||||
|
context("Test Utilities - Get FIPS")
|
||||||
|
|
||||||
|
# --- get_fips ---------------------------------------------------------------
|
||||||
|
|
||||||
|
|
||||||
|
test_that("get_fips errors gracefully when tidycensus is not installed", {
|
||||||
|
# When tidycensus is absent, the function should stop with an informative message.
|
||||||
|
if (!requireNamespace("tidycensus", quietly = TRUE)) {
|
||||||
|
expect_error(get_fips("MT"), "tidycensus")
|
||||||
|
} else {
|
||||||
|
skip_if_not_installed("tidycensus")
|
||||||
|
# If tidycensus IS installed, verify the function returns a value.
|
||||||
|
result <- get_fips("MT")
|
||||||
|
expect_type(result, "character")
|
||||||
|
expect_gt(length(result), 0)
|
||||||
|
}
|
||||||
|
})
|
||||||
|
|
||||||
|
|
||||||
|
test_that("get_fips returns a FIPS code for a valid state abbreviation", {
|
||||||
|
skip_if_not_installed("tidycensus")
|
||||||
|
result <- get_fips("MT")
|
||||||
|
# Montana's FIPS state code is "30"
|
||||||
|
expect_equal(result, "30")
|
||||||
|
})
|
||||||
|
|
||||||
|
|
||||||
|
test_that("get_stabbr returns a valid abbreviation", {
|
||||||
|
skip_if_not_installed("tidycensus")
|
||||||
|
result <- get_fips("CA")
|
||||||
|
# California's FIPS state code is "06"
|
||||||
|
expect_equal(result, "06")
|
||||||
|
})
|
||||||
|
|
||||||
|
|
||||||
context("Test Utilities - Pretty Count")
|
context("Test Utilities - Pretty Count")
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
Reference in New Issue
Block a user