Brand themes, color palettes, and utility functions for Civilytics Consulting. The package +provides a complete ggplot2 theme system drawn from the Civilytics +design system — warm paper backgrounds, civic-navy ink, and editorial +typography — along with 10 curated color palettes, logo composition +helpers, and data-wrangling utilities for public-sector analysis.
+Install from the Civilytics Gitea server:
+# install.packages("remotes")
+remotes::install_git("https://gitea.civilytics.org/Civilytics/civilyticsR.git")library(civilytics)
+library(ggplot2)
+
+ggplot(mpg, aes(displ, hwy, colour = class)) +
+ geom_point(size = 2.5) +
+ scale_color_civilytics() +
+ labs(
+ title = "Fuel economy by engine displacement",
+ subtitle = "Highway MPG vs. engine size for 234 vehicles",
+ caption = "Source: EPA fuel economy data (ggplot2::mpg)",
+ x = "Engine displacement (litres)",
+ y = "Highway MPG"
+ ) +
+ theme_civilytics()
+
+The package ships 53 named brand colors in
+civilytics_colors and 10 curated palettes in
+civilytics_palettes. Use civilytics_palette()
+to retrieve colors by name, or pass palettes directly to the ggplot2
+scales.
+
+# Discrete fill with the qualitative palette
+ggplot(mpg, aes(class, fill = class)) +
+ geom_bar(show.legend = FALSE) +
+ scale_fill_civilytics() +
+ labs(title = "Vehicle counts by class", x = NULL, y = NULL) +
+ theme_civilytics(grid = "y")
+
+
+# Continuous fill with a sequential palette
+ggplot(faithfuld, aes(waiting, eruptions, fill = density)) +
+ geom_tile() +
+ scale_fill_civilytics("seq_ember", discrete = FALSE) +
+ labs(title = "Old Faithful eruption density") +
+ theme_civilytics(grid = "none")
+
+Three theme variants cover the most common output contexts. All share
+the same typographic structure and accept grid and
+paper_bg parameters.
The default theme uses a warm paper background with horizontal +gridlines — an editorial, Pew-style layout.
+base_plot <- ggplot(mpg, aes(displ, hwy)) +
+ geom_point(aes(colour = factor(cyl)), size = 2) +
+ scale_color_civilytics() +
+ labs(
+ title = "Engine size vs. highway fuel economy",
+ subtitle = "Colored by number of cylinders",
+ caption = "Source: ggplot2::mpg",
+ colour = "Cylinders",
+ x = "Displacement (L)", y = "Highway MPG"
+ )
+
+base_plot + theme_civilytics()
+
+The grid parameter controls which major gridlines are
+drawn.
+
+Dark navy background with light text, suitable for presentations or +dashboards on dark surfaces.
+ +
+
+Transparent background and larger base font (18 pt), sized for +Reveal.js slides or PowerPoint exports.
+ +
+
+Facet strips use the paper_2 tint, with the title
+font.
ggplot(mpg, aes(displ, hwy)) +
+ geom_point(colour = civilytics_colors["navy_600"], size = 1.5) +
+ facet_wrap(~class, ncol = 4) +
+ labs(
+ title = "Highway MPG by vehicle class",
+ x = "Displacement (L)", y = "Highway MPG"
+ ) +
+ theme_civilytics(grid = "y")
+
+Add the Civilytics logo to any ggplot using the pipe-friendly
+civilytics_logo() or the lower-level
+add_logo() / make_logo_grob(). The logo is
+automatically right-aligned below the plot area. Wrap the ggplot chain
+in parentheses before piping — R’s |> binds tighter than
++.
p <- ggplot(mpg, aes(displ, hwy, colour = class)) +
+ geom_point(size = 2) +
+ scale_color_civilytics() +
+ labs(
+ title = "Fuel economy by engine displacement",
+ caption = "Source: EPA fuel economy data (ggplot2::mpg)",
+ x = "Displacement (L)", y = "Highway MPG"
+ ) +
+ theme_civilytics()
+
+grid::grid.draw(civilytics_logo(p))
+
+Use type = "mark" for the compact C-pulse icon instead
+of the full wordmark.
p2_logo <- ggplot(mpg, aes(displ, hwy, colour = factor(cyl))) +
+ geom_point(size = 2) +
+ scale_color_civilytics() +
+ labs(
+ title = "Engine size vs. highway fuel economy",
+ colour = "Cylinders",
+ x = "Displacement (L)", y = "Highway MPG"
+ ) +
+ theme_civilytics()
+
+grid::grid.draw(civilytics_logo(p2_logo, type = "mark"))
+
+Use add_logo_ga() to attach a single logo below a row of
+plots.
p1 <- ggplot(mpg, aes(class, fill = class)) +
+ geom_bar(show.legend = FALSE) +
+ scale_fill_civilytics() +
+ labs(title = "Vehicle counts", x = NULL, y = NULL) +
+ theme_civilytics(grid = "y")
+
+p2 <- ggplot(mpg, aes(displ, hwy)) +
+ geom_point(colour = civilytics_colors["navy_600"], size = 1.5) +
+ labs(title = "Displacement vs. MPG", x = "Displacement (L)", y = "Highway MPG") +
+ theme_civilytics(grid = "y")
+
+logo <- make_logo_grob()
+grid::grid.draw(add_logo_ga(list(p1, p2), logo))
+
+The package also includes helpers for public-sector data +analysis:
+| Function | +Purpose | +
|---|---|
pretty_count() /
+pretty_per() |
+Format numbers and percentages | +
grade_level_to_num() |
+Convert grade labels (KG, 01–12) to numeric | +
race_short_names() |
+Standardize NCES race/ethnicity categories | +
get_fips() /
+get_stabbr() |
+State FIPS code lookups | +
clopper_pearson() /
+agresti_coull_interval() |
+Proportion confidence intervals | +
match_test() /
+trunc_match() |
+Fuzzy join diagnostics | +
perturb_count() /
+random_round() |
+Privacy-preserving data perturbation | +
Logo and brand mark files live in inst/img/. The package
+ships both PNG (for ggplot2 raster composition) and SVG (for Quarto/HTML
+output) variants:
| File | +Format | +Used by | +
|---|---|---|
civilytics-wordmark.png /
+.svg |
+Full “Civilytics” lockup | +make_logo_grob("wordmark", "light"),
+Quarto templates |
+
civilytics-wordmark-reverse.png /
+.svg |
+Light-on-dark wordmark | +make_logo_grob("wordmark", "dark"), dark
+slides |
+
civilytics-mark.png /
+.svg |
+Compact C-pulse icon | +make_logo_grob("mark", "light") |
+
civilytics-mark-reverse.svg |
+Light-on-dark mark | +make_logo_grob("mark", "dark") |
+
civilytics-pulse.svg |
+Standalone waveform glyph | +Quarto slide footer chrome | +
To update the logos, replace the files in inst/img/ with
+new versions using the same filenames. The PNG files must be raster
+images (the ggplot2 logo functions read them via
+png::readPNG()). SVG files are passed through as-is by
+Quarto and HTML templates.
After replacing files, re-render the README gallery to update the +screenshots:
+ + + + diff --git a/civilytics-site.png b/civilytics-site.png new file mode 100644 index 0000000..ea46d70 Binary files /dev/null and b/civilytics-site.png differ diff --git a/inst/img/Knowles_Headshot_2019_good.jpg b/inst/img/Knowles_Headshot_2019_good.jpg deleted file mode 100644 index 9aaa710..0000000 Binary files a/inst/img/Knowles_Headshot_2019_good.jpg and /dev/null differ diff --git a/inst/img/Knowles_Headshot_2019_prisma.jpg b/inst/img/Knowles_Headshot_2019_prisma.jpg deleted file mode 100644 index 499e0fd..0000000 Binary files a/inst/img/Knowles_Headshot_2019_prisma.jpg and /dev/null differ diff --git a/man/plot_jpeg.Rd b/man/plot_jpeg.Rd index 2550ef4..ca2c01e 100644 --- a/man/plot_jpeg.Rd +++ b/man/plot_jpeg.Rd @@ -22,7 +22,8 @@ Plot a jpeg image as a raster } \examples{ \dontrun{ -img <- system.file("img","Knowles_Headshot_2019_good.jpg",package="civilytics") +# Supply a path to your own JPEG file +img <- "my_photo.jpg" plot_jpeg(img) } } diff --git a/reprex.r b/reprex.r new file mode 100644 index 0000000..63df066 --- /dev/null +++ b/reprex.r @@ -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() diff --git a/tests/testthat/Rplots.pdf b/tests/testthat/Rplots.pdf new file mode 100644 index 0000000..9fbe60d Binary files /dev/null and b/tests/testthat/Rplots.pdf differ diff --git a/tests/testthat/test_propint.R b/tests/testthat/test_propint.R index a684fac..c13a7d3 100644 --- a/tests/testthat/test_propint.R +++ b/tests/testthat/test_propint.R @@ -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"])) +})