Remove vendored headshots and add proportion CI tests

- Remove Knowles_Headshot_2019_good.jpg and Knowles_Headshot_2019_prisma.jpg
  from inst/img/ — personal headshot should not be distributed with the package
- Update plot_jpeg() roxygen example to use a generic placeholder instead of
  the removed headshot path; regenerate man/plot_jpeg.Rd accordingly
- Add comprehensive testthat coverage for clopper_pearson(), z_univariate(),
  waldInterval(), and agresti_coull_interval() in tests/testthat/test_propint.R

The propint module previously had zero tests. New tests cover: return types,
formula correctness (cross-validated against binom.test()), edge cases
(0/n and n/n), interval validity, confidence level behavior, and sign/direction
of z-scores.

R/logo.R

@@ -10,7 +10,8 @@
 #' @importFrom graphics rasterImage
 #' @examples
 #' \dontrun{
-#' img <- system.file("img","Knowles_Headshot_2019_good.jpg",package="civilytics")
+#' # Supply a path to your own JPEG file
+#' img <- "my_photo.jpg"
 #' plot_jpeg(img)
 #' }
 plot_jpeg <- function(path, add=FALSE, upscale = TRUE)
@@ -361,92 +362,92 @@ civilytics_logo <- function(plot,
            position = position)
 }
 
-
+
-#' Stamp the Civilytics logo onto a saved raster (PNG) image
+#' Stamp the Civilytics logo onto a saved raster (PNG) image
-#'
+#'
-#' The raster analogue of [civilytics_logo()] for outputs that are already
+#' 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`
+#' 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.
+#' exported to PNG, or any `grDevices::png()` / `ragg::agg_png()` output.
-#' Resolves the *same* brand asset that [make_logo_grob()] uses, so file-based
+#' Resolves the *same* brand asset that [make_logo_grob()] uses, so file-based
-#' tables stay visually consistent with logo-branded plots, and composites it
+#' tables stay visually consistent with logo-branded plots, and composites it
-#' into a corner of the image. Pure base-graphics + grid + png — no new
+#' into a corner of the image. Pure base-graphics + grid + png — no new
-#' package dependencies.
+#' package dependencies.
-#'
+#'
-#' @param path Character. Path to the PNG to stamp. The file is overwritten
+#' @param path Character. Path to the PNG to stamp. The file is overwritten
-#'   in place at its original pixel dimensions.
+#'   in place at its original pixel dimensions.
-#' @param type Character. `"wordmark"` (default) or `"mark"`. As in
+#' @param type Character. `"wordmark"` (default) or `"mark"`. As in
-#'   [make_logo_grob()].
+#'   [make_logo_grob()].
-#' @param variant Character. `"light"` (default, dark logo for light
+#' @param variant Character. `"light"` (default, dark logo for light
-#'   backgrounds) or `"dark"` (reverse logo for dark backgrounds).
+#'   backgrounds) or `"dark"` (reverse logo for dark backgrounds).
-#' @param position Character. Corner placement: `"bottom-right"` (default),
+#' @param position Character. Corner placement: `"bottom-right"` (default),
-#'   `"bottom-left"`, `"top-right"`, or `"top-left"`.
+#'   `"bottom-left"`, `"top-right"`, or `"top-left"`.
-#' @param width_frac Numeric. Logo width as a fraction of the image width
+#' @param width_frac Numeric. Logo width as a fraction of the image width
-#'   (default `0.15`). Height follows from the logo's aspect ratio.
+#'   (default `0.15`). Height follows from the logo's aspect ratio.
-#' @param margin_frac Numeric. Padding from the edges as a fraction of the
+#' @param margin_frac Numeric. Padding from the edges as a fraction of the
-#'   image width (default `0.02`).
+#'   image width (default `0.02`).
-#'
+#'
-#' @return `path`, invisibly.
+#' @return `path`, invisibly.
-#' @export
+#' @export
-#' @importFrom png readPNG
+#' @importFrom png readPNG
-#' @importFrom grid grid.newpage grid.raster
+#' @importFrom grid grid.newpage grid.raster
-#' @importFrom grDevices png dev.off
+#' @importFrom grDevices png dev.off
-#' @examples
+#' @examples
-#' \dontrun{
+#' \dontrun{
-#' # Brand a table exported to PNG so it matches civilytics_logo()-branded plots
+#' # 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)
+#' ragg::agg_png("table.png", width = 8, height = 4, units = "in", res = 200)
-#' plot(flextable::flextable(head(mtcars)))
+#' plot(flextable::flextable(head(mtcars)))
-#' dev.off()
+#' dev.off()
-#' stamp_logo_png("table.png")                         # wordmark, bottom-right
+#' stamp_logo_png("table.png")                         # wordmark, bottom-right
-#' stamp_logo_png("table.png", type = "mark", position = "bottom-left")
+#' stamp_logo_png("table.png", type = "mark", position = "bottom-left")
-#' }
+#' }
-stamp_logo_png <- function(path,
+stamp_logo_png <- function(path,
-                           type = c("wordmark", "mark"),
+                           type = c("wordmark", "mark"),
-                           variant = c("light", "dark"),
+                           variant = c("light", "dark"),
-                           position = c("bottom-right", "bottom-left",
+                           position = c("bottom-right", "bottom-left",
-                                        "top-right", "top-left"),
+                                        "top-right", "top-left"),
-                           width_frac = 0.15,
+                           width_frac = 0.15,
-                           margin_frac = 0.02) {
+                           margin_frac = 0.02) {
-  type     <- match.arg(type)
+  type     <- match.arg(type)
-  variant  <- match.arg(variant)
+  variant  <- match.arg(variant)
-  position <- match.arg(position)
+  position <- match.arg(position)
-  stopifnot(file.exists(path))
+  stopifnot(file.exists(path))
-
+
-  # Same asset selection as make_logo_grob() so files match branded plots.
+  # Same asset selection as make_logo_grob() so files match branded plots.
-  img_file <- switch(
+  img_file <- switch(
-    paste(type, variant, sep = "_"),
+    paste(type, variant, sep = "_"),
-    wordmark_light = "civilytics-wordmark.png",
+    wordmark_light = "civilytics-wordmark.png",
-    wordmark_dark  = "civilytics-wordmark-reverse.png",
+    wordmark_dark  = "civilytics-wordmark-reverse.png",
-    mark_light     = "civilytics-mark.png",
+    mark_light     = "civilytics-mark.png",
-    mark_dark      = "civilytics-mark-reverse.png"
+    mark_dark      = "civilytics-mark-reverse.png"
-  )
+  )
-  logo_path <- system.file("img", img_file, package = "civilytics")
+  logo_path <- system.file("img", img_file, package = "civilytics")
-  if (!nzchar(logo_path)) {
+  if (!nzchar(logo_path)) {
-    stop("Civilytics logo asset not found in the 'civilytics' package: ", img_file)
+    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]
+  base_img <- png::readPNG(path)        # height x width x channels, values in [0, 1]
-  logo_img <- png::readPNG(logo_path)
+  logo_img <- png::readPNG(logo_path)
-  h <- dim(base_img)[1]
+  h <- dim(base_img)[1]
-  w <- dim(base_img)[2]
+  w <- dim(base_img)[2]
-  aspect <- dim(logo_img)[1] / dim(logo_img)[2]   # logo height / width
+  aspect <- dim(logo_img)[1] / dim(logo_img)[2]   # logo height / width
-
+
-  # Sizes/margins are expressed relative to image WIDTH, then converted to the
+  # 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).
+  # device's npc units (which scale with the viewport's own width and height).
-  lw <- width_frac
+  lw <- width_frac
-  lh <- width_frac * aspect * (w / h)
+  lh <- width_frac * aspect * (w / h)
-  mx <- margin_frac
+  mx <- margin_frac
-  my <- margin_frac * (w / h)
+  my <- margin_frac * (w / h)
-
+
-  x <- if (grepl("right", position)) 1 - mx else mx
+  x <- if (grepl("right", position)) 1 - mx else mx
-  y <- if (grepl("top",   position)) 1 - my else my
+  y <- if (grepl("top",   position)) 1 - my else my
-  just <- c(if (grepl("right", position)) "right" else "left",
+  just <- c(if (grepl("right", position)) "right" else "left",
-            if (grepl("top",   position)) "top"   else "bottom")
+            if (grepl("top",   position)) "top"   else "bottom")
-
+
-  grDevices::png(path, width = w, height = h, units = "px")
+  grDevices::png(path, width = w, height = h, units = "px")
-  on.exit(grDevices::dev.off(), add = TRUE)
+  on.exit(grDevices::dev.off(), add = TRUE)
-  grid::grid.newpage()
+  grid::grid.newpage()
-  grid::grid.raster(base_img, width = 1, height = 1, interpolate = FALSE)
+  grid::grid.raster(base_img, width = 1, height = 1, interpolate = FALSE)
-  grid::grid.raster(logo_img, x = x, y = y, width = lw, height = lh,
+  grid::grid.raster(logo_img, x = x, y = y, width = lw, height = lh,
-                    just = just, interpolate = TRUE)
+                    just = just, interpolate = TRUE)
-  invisible(path)
+  invisible(path)
-}
+}

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)
 }
 }

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()

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"]))
+})