Author SHA1 Message Date
kodor 4ea7333835 fix: address review round 3 for #7 2026-07-05 00:56:30 -04:00
kodor 0d523c83de fix: address review round 1 for #7 2026-07-04 23:36:46 -04:00
kodor fc9383555d feat: resolve #7 theme_civilytics(): default to a transparent background, opt-in for Civilytics cream 2026-07-04 23:03:42 -04:00
jared 761a72da18 Merge pull request 'feat(logo): add stamp_logo_png() for branding file-based (PNG) outputs' (#9) from feat/stamp-logo-png into master
R-CMD-check / R CMD check (push) Successful in 3m51s
Reviewed-on: #9
2026-06-22 16:59:52 -04:00
jared 5fc8155965 feat(logo): add stamp_logo_png() to brand file-based PNG outputs
R-CMD-check / R CMD check (pull_request) Successful in 3m53s
civilytics_logo()/make_logo_grob() brand ggplot/grobs, but flextables and
other outputs are rendered to PNG first and can't use them. stamp_logo_png()
is the raster analogue: it resolves the SAME brand asset that make_logo_grob()
uses (via the type/variant switch) and composites it into a corner of an
existing PNG in place, so file-based tables stay visually consistent with
logo-branded plots.

Dependency-free by design — uses only png + grid + grDevices (all already
imported), no magick. Configurable type/variant/position/width/margin;
preserves the image's pixel dimensions. Adds tests (21 assertions).
2026-06-22 16:33:08 -04:00
jared 41162597cf Merge pull request 'Fix issues #1, #3, #5: misc improvements' (#6) from fix/issues-1-3-5-misc-improvements into master
R-CMD-check / R CMD check (push) Successful in 4m25s
R-CMD-check / R CMD check (pull_request) Successful in 4m6s
Reviewed-on: #6
2026-06-04 14:04:44 -04:00
jared 2a74ec2bd3 test: add security regression test and beep(type='all') coverage
R-CMD-check / R CMD check (pull_request) Successful in 3m53s
- Add test verifying .send_webhook() and .send_desktop_notify() use
  system2() (not system()) to prevent command injection. This test
  reads the function body and asserts system2 is present and
  system("...") is absent, so the vulnerability cannot be
  reintroduced by accident.
- Add test for beep(type='all') exercising both beep and notify paths.
2026-06-04 13:48:21 +00:00
jared 366ac39fac fix: replace system() with system2() to prevent command injection in beep notifications
R-CMD-check / R CMD check (pull_request) Successful in 3m50s
Use system2() with separate args instead of shell-interpolated system()
calls in .send_desktop_notify() and .send_webhook(). This eliminates
command injection risk when msg, status, url, or payload contain shell
metacharacters.
2026-06-04 13:17:06 +00:00
jared fc8bf1866b Fix beep.Rd Rd syntax errors (remove invalid \char escape)
R-CMD-check / R CMD check (pull_request) Successful in 4m44s
2026-06-03 19:11:19 +00:00
jared 75b9a73165 Fix CI warnings: add jsonlite dep, flush.console import, Rd docs
R-CMD-check / R CMD check (pull_request) Failing after 1m13s
- Add jsonlite to Imports (used by beep() webhook)
- Add importFrom(utils, flush.console) to NAMESPACE
- Update na_sum.Rd to include quiet parameter
- Create beep.Rd documentation
2026-06-03 19:08:48 +00:00
jared 2f1cdcde52 Fix issues #1, #3, #5: misc improvements
R-CMD-check / R CMD check (pull_request) Failing after 4m43s
- #5: Unwrap _brand.yml for Quarto 1.9+ compatibility (remove top-level
  brand: wrapper so meta/logo/color/typography are at the top level)
- #1: Add quiet parameter to na_sum() to suppress warnings in loops/pipelines
- #3: Add beep() function for CLI beep, desktop notifications, and webhook
  alerts (supports type=beep|notify|webhook|all)
2026-06-03 19:01:30 +00:00
15 changed files with 571 additions and 80 deletions
+1
View File
@@ -19,6 +19,7 @@ Depends:
Imports: Imports:
ggplot2 (>= 4.0.0), ggplot2 (>= 4.0.0),
jpeg, jpeg,
jsonlite,
png, png,
stringr, stringr,
gridExtra, gridExtra,
+7
View File
@@ -1,5 +1,6 @@
# Generated by roxygen2: do not edit by hand # Generated by roxygen2: do not edit by hand
export(beep)
export(add_logo) export(add_logo)
export(add_logo_ga) export(add_logo_ga)
export(agresti_coull_interval) export(agresti_coull_interval)
@@ -41,6 +42,7 @@ export(safe_ratio)
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(theme_civilytics) export(theme_civilytics)
export(theme_civilytics_dark) export(theme_civilytics_dark)
@@ -60,8 +62,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)
@@ -71,3 +77,4 @@ importFrom(stats,qnorm)
importFrom(stats,runif) importFrom(stats,runif)
importFrom(stringdist,stringsim) importFrom(stringdist,stringsim)
importFrom(stringr,str_count) importFrom(stringr,str_count)
importFrom(utils,flush.console)
+3 -1
View File
@@ -111,7 +111,9 @@ nvals <- function(x){
#' simpleCap(my_string) #' simpleCap(my_string)
simpleCap <- function(x) { simpleCap <- function(x) {
stopifnot(class(x) == "character") stopifnot(class(x) == "character")
s <- strsplit(x, " ")[[1]] sapply(x, function(word) {
s <- strsplit(word, " ")[[1]]
paste(toupper(substring(s, 1, 1)), substring(s, 2), paste(toupper(substring(s, 1, 1)), substring(s, 2),
sep = "", collapse = " ") sep = "", collapse = " ")
})
} }
+89
View File
@@ -361,3 +361,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)
}
+153
View File
@@ -0,0 +1,153 @@
#' Send a CLI beep / desktop notification
#'
#' Plays an audible beep in the terminal and/or sends a desktop notification
#' when a long-running R script completes or reaches a milestone.
#'
#' @param msg Character. Optional message to include in the notification.
#' When `type = "notify"`, this becomes the notification body.
#' @param type Character. Notification method:
#' - `"beep"` (default): emit a terminal bell character (`\007`).
#' Works in any terminal that supports the bell.
#' - `"notify"`: send a desktop notification via `notify-send` (Linux) or
#' `osascript` (macOS). Falls back to `"beep"` if neither tool is found.
#' - `"webhook"`: POST a JSON payload to a URL. Requires `url` argument.
#' - `"all"`: play beep + send desktop notification (webhook only if `url`
#' is provided).
#' @param url Character. Webhook URL for `type = "webhook"` or `"all"`.
#' A JSON payload is POSTed with keys `message`, `status`, and `timestamp`.
#' @param status Character. Status label for the notification (default `"done"`).
#' Used in the notification title and webhook payload.
#' @param timeout Numeric. Seconds to wait for the webhook POST to complete
#' (default `5`). Ignored for non-webhook types.
#' @param quiet Logical. If `TRUE`, suppress the terminal beep even when
#' `type` includes `"beep"`. Useful for silent background runs.
#'
#' @return Invisible `NULL`.
#'
#' @section Requirements:
#' - `type = "notify"` requires `notify-send` (Linux) or `osascript` (macOS).
#' - `type = "webhook"` requires network access to the provided URL.
#'
#' @section Examples:
#' \preformatted{
#' # Simple terminal beep
#' beep()
#'
#' # Desktop notification with message
#' beep("Analysis complete!", type = "notify")
#'
#' # Send to a webhook (e.g., Slack, Discord, custom endpoint)
#' beep("Job finished", type = "webhook",
#' url = "https://hooks.slack.com/services/...")
#'
#' # Beep + desktop notification
#' beep("Processing done", type = "all")
#' }
#'
#' @export
#'
beep <- function(msg = "done",
type = c("beep", "notify", "webhook", "all"),
url = NULL,
status = "done",
timeout = 5,
quiet = FALSE) {
type <- match.arg(type)
# -- Terminal beep ----------------------------------------------------------
if (!quiet && grepl("beep", type)) {
cat("\007")
flush.console()
}
# -- Desktop notification ---------------------------------------------------
if (grepl("notify", type)) {
.send_desktop_notify(msg, status)
}
# -- Webhook ----------------------------------------------------------------
if (grepl("webhook", type) && !is.null(url)) {
.send_webhook(url, msg, status, timeout)
}
invisible(NULL)
}
# -- Internal helpers ---------------------------------------------------------
#' Send a desktop notification via notify-send or osascript
#'
#' @param msg Message body
#' @param status Status label for the title
#' @keywords internal
.send_desktop_notify <- function(msg, status) {
# Linux: notify-send
if (.has_command("notify-send")) {
system2("notify-send", args = c(status, msg),
stdout = TRUE, stderr = TRUE)
return(invisible(NULL))
}
# macOS: osascript
if (.has_command("osascript")) {
system2("osascript",
args = c("-e",
paste0("display notification \"", msg,
"\" with title \"", status, "\"")),
stdout = TRUE, stderr = TRUE)
return(invisible(NULL))
}
# Neither tool available — silently skip
invisible(NULL)
}
#' POST a JSON payload to a webhook URL
#'
#' @param url Webhook URL
#' @param msg Message body
#' @param status Status label
#' @param timeout Seconds to wait for the request
#' @keywords internal
.send_webhook <- function(url, msg, status, timeout) {
payload <- jsonlite::toJSON(list(
message = msg,
status = status,
timestamp = format(Sys.time(), "%Y-%m-%dT%H:%M:%S%z")
), auto_unbox = TRUE)
# Use curl via system2() for maximum compatibility (no extra R deps).
# system2() passes arguments directly to the executable without shell
# interpolation, avoiding command injection.
if (.has_command("curl")) {
system2("curl",
args = c("-s", "-X", "POST",
"-H", "Content-Type: application/json",
"-d", payload,
url,
"--max-time", as.character(timeout)),
stdout = TRUE, stderr = TRUE)
} else if (.has_command("wget")) {
system2("wget",
args = c("-q", "-O", "/dev/null",
paste0("--post-data=", payload),
paste0("--header=Content-Type: application/json"),
paste0("--timeout=", timeout),
url),
stdout = TRUE, stderr = TRUE)
}
invisible(NULL)
}
#' Check if a command exists on the system PATH
#'
#' @param cmd Command name
#' @return Logical
#' @keywords internal
.has_command <- function(cmd) {
Sys.which(cmd) != ""
}
+13 -11
View File
@@ -36,10 +36,9 @@
#' 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 `FALSE` (default), the plot and panel
#' backgrounds with the warm `paper` color. Set to `FALSE` for a #' backgrounds are transparent (`fill = NA`). Set to `TRUE` to fill them
#' transparent background (useful for slides or overlay on colored #' with the warm `paper` color (the Civilytics cream canvas).
#' surfaces).
#' #'
#' @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.
@@ -68,26 +67,29 @@
#' \dontrun{ #' \dontrun{
#' library(ggplot2) #' library(ggplot2)
#' #'
#' # Default editorial theme #' # Transparent background (default) — composites cleanly onto any surface
#' ggplot(mpg, aes(displ, hwy)) + #' ggplot(mpg, aes(displ, hwy)) +
#' geom_point() + #' geom_point() +
#' theme_civilytics() #' theme_civilytics()
#' #'
#' # Warm paper canvas (opt-in)
#' ggplot(mpg, aes(displ, hwy)) +
#' geom_point() +
#' theme_civilytics(paper_bg = TRUE)
#'
#' # With both gridlines and brand colors #' # With both gridlines and brand colors
#' ggplot(mpg, aes(displ, hwy, colour = class)) + #' ggplot(mpg, aes(displ, hwy, colour = class)) +
#' geom_point() + #' geom_point() +
#' scale_color_civilytics() + #' scale_color_civilytics() +
#' theme_civilytics(grid = "both") #' theme_civilytics(grid = "both")
#' #'
#' # Transparent background for embedding
#' ggplot(mpg, aes(displ, hwy)) +
#' geom_point() +
#' theme_civilytics(paper_bg = FALSE)
#'
#' # Larger text for poster or display #' # Larger text for poster or display
#' ggplot(mpg, aes(displ, hwy)) + #' ggplot(mpg, aes(displ, hwy)) +
#' geom_point() + #' geom_point() +
#' theme_civilytics(font_size = 18) #' theme_civilytics(font_size = 18)
#'
#' # Note: for fully-transparent PNGs, also set a transparent device
#' # background (e.g. `ggsave("plot.png", bg = NA)`).
#' } #' }
theme_civilytics <- function( theme_civilytics <- function(
font_size = 14, font_size = 14,
@@ -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
+10 -4
View File
@@ -31,7 +31,7 @@ safe_max <- function(x) {
#' pretty_per(0.2, ndigit = 1) #' pretty_per(0.2, ndigit = 1)
#' pretty_per(c(0.2, 0.332423, 0.4, 0.342342), ndigit = 2) #' pretty_per(c(0.2, 0.332423, 0.4, 0.342342), ndigit = 2)
pretty_per <- function(x, ndigit = 1) { pretty_per <- function(x, ndigit = 1) {
if (any(x >= 100) & !all(is.na(x))) { if (any(x >= 100) && !all(is.na(x))) {
message("Values over 100 found, did you mean to use proportions?") message("Values over 100 found, did you mean to use proportions?")
} }
x <- format(round(x, digits = ndigit + 2) * 100, nsmall = ndigit) x <- format(round(x, digits = ndigit + 2) * 100, nsmall = ndigit)
@@ -149,6 +149,9 @@ race_short_names <- function(x) {
#' Sum a numeric that contains missing values and ignore missing values #' Sum a numeric that contains missing values and ignore missing values
#' #'
#' @param x a numeric vector #' @param x a numeric vector
#' @param quiet Logical. If `TRUE` (default `FALSE`), suppress the warning
#' message. Useful when calling `na_sum()` inside a loop or `dplyr` pipeline
#' where the message would be emitted repeatedly.
#' #'
#' @return the sum, ignoring any missing values #' @return the sum, ignoring any missing values
#' @export #' @export
@@ -156,9 +159,12 @@ race_short_names <- function(x) {
#' @examples #' @examples
#' x <- c(2, NA, 4, 9) #' x <- c(2, NA, 4, 9)
#' na_sum(x) # 15 #' na_sum(x) # 15
na_sum <- function(x) { #' na_sum(x, quiet = TRUE) # 15 (no message)
na_sum <- function(x, quiet = FALSE) {
stopifnot(is.numeric(x)) stopifnot(is.numeric(x))
if (!quiet) {
message("Taking a sum with missing values equal to 0, be careful!") message("Taking a sum with missing values equal to 0, be careful!")
}
x <- na_zero(x) x <- na_zero(x)
return(sum(x)) return(sum(x))
} }
@@ -277,7 +283,7 @@ get_stabbr <- function(fips) {
fips_codes <- fips_codes[!duplicated(fips_codes),] fips_codes <- fips_codes[!duplicated(fips_codes),]
if (length(fips) != 1) { if (length(fips) != 1) {
out <- rep(NA, length(fips)) out <- rep(NA, length(fips))
for (i in length(fips)) { for (i in seq_along(fips)) {
out[i] <- fips_codes[fips_codes$state_code == fips, 1] out[i] <- fips_codes[fips_codes$state_code == fips, 1]
} }
@@ -369,7 +375,7 @@ random_round <- function(x) {
add = rep(as.integer(0),length(r)) add = rep(as.integer(0),length(r))
add[r>test] <- as.integer(1) add[r>test] <- as.integer(1)
value = v + add value = v + add
ifelse(is.na(value) | value<0, 0, value) value <- ifelse(is.na(value) | value < 0, 0, value)
return(value) return(value)
} }
-1
View File
@@ -2,7 +2,6 @@
# Optional but recommended — Quarto auto-applies these to HTML, PDF, and Revealjs. # Optional but recommended — Quarto auto-applies these to HTML, PDF, and Revealjs.
# https://quarto.org/docs/authoring/brand.html # https://quarto.org/docs/authoring/brand.html
brand:
meta: meta:
name: Civilytics Consulting name: Civilytics Consulting
description: Turning public data into clear, actionable analysis for public good. description: Turning public data into clear, actionable analysis for public good.
+71
View File
@@ -0,0 +1,71 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/notifications.R
\name{beep}
\alias{beep}
\title{Send a CLI beep / desktop notification}
\usage{
beep(
msg = "done",
type = c("beep", "notify", "webhook", "all"),
url = NULL,
status = "done",
timeout = 5,
quiet = FALSE
)
}
\arguments{
\item{msg}{Character. Optional message to include in the notification.
When \code{type = "notify"}, this becomes the notification body.}
\item{type}{Character. Notification method:
\itemize{
\item \code{"beep"} (default): emit a terminal bell character.
Works in any terminal that supports the bell.
\item \code{"notify"}: send a desktop notification via \code{notify-send} (Linux) or
\code{osascript} (macOS). Falls back to \code{"beep"} if neither tool is found.
\item \code{"webhook"}: POST a JSON payload to a URL. Requires \code{url} argument.
\item \code{"all"}: play beep + send desktop notification (webhook only if \code{url}
is provided).
}}
\item{url}{Character. Webhook URL for \code{type = "webhook"} or \code{"all"}.
A JSON payload is POSTed with keys \code{message}, \code{status}, and \code{timestamp}.}
\item{status}{Character. Status label for the notification (default \code{"done"}).
Used in the notification title and webhook payload.}
\item{timeout}{Numeric. Seconds to wait for the webhook POST to complete
(default \code{5}). Ignored for non-webhook types.}
\item{quiet}{Logical. If \code{TRUE}, suppress the terminal beep even when
\code{type} includes \code{"beep"}. Useful for silent background runs.}
}
\value{
Invisible \code{NULL}.
}
\description{
Plays an audible beep in the terminal and/or sends a desktop notification
when a long-running R script completes or reaches a milestone.
}
\section{Requirements}{
\itemize{
\item \code{type = "notify"} requires \code{notify-send} (Linux) or \code{osascript} (macOS).
\item \code{type = "webhook"} requires network access to the provided URL.
}
}
\section{Examples}{
\preformatted{
# Simple terminal beep
beep()
# Desktop notification with message
beep("Analysis complete!", type = "notify")
# Send to a webhook (e.g., Slack, Discord, custom endpoint)
beep("Job finished", type = "webhook",
url = "https://hooks.slack.com/services/...")
# Beep + desktop notification
beep("Processing done", type = "all")
}
}
+6 -1
View File
@@ -4,10 +4,14 @@
\alias{na_sum} \alias{na_sum}
\title{Sum a numeric that contains missing values and ignore missing values} \title{Sum a numeric that contains missing values and ignore missing values}
\usage{ \usage{
na_sum(x) na_sum(x, quiet = FALSE)
} }
\arguments{ \arguments{
\item{x}{a numeric vector} \item{x}{a numeric vector}
\item{quiet}{Logical. If \code{TRUE} (default \code{FALSE}), suppress the warning
message. Useful when calling \code{na_sum()} inside a loop or \code{dplyr} pipeline
where the message would be emitted repeatedly.}
} }
\value{ \value{
the sum, ignoring any missing values the sum, ignoring any missing values
@@ -18,4 +22,5 @@ Sum a numeric that contains missing values and ignore missing values
\examples{ \examples{
x <- c(2, NA, 4, 9) x <- c(2, NA, 4, 9)
na_sum(x) # 15 na_sum(x) # 15
na_sum(x, quiet = TRUE) # 15 (no message)
} }
+56
View File
@@ -0,0 +1,56 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/logo.R
\name{stamp_logo_png}
\alias{stamp_logo_png}
\title{Stamp the Civilytics logo onto a saved raster (PNG) image}
\usage{
stamp_logo_png(
path,
type = c("wordmark", "mark"),
variant = c("light", "dark"),
position = c("bottom-right", "bottom-left", "top-right", "top-left"),
width_frac = 0.15,
margin_frac = 0.02
)
}
\arguments{
\item{path}{Character. Path to the PNG to stamp. The file is overwritten
in place at its original pixel dimensions.}
\item{type}{Character. `"wordmark"` (default) or `"mark"`. As in
[make_logo_grob()].}
\item{variant}{Character. `"light"` (default, dark logo for light
backgrounds) or `"dark"` (reverse logo for dark backgrounds).}
\item{position}{Character. Corner placement: `"bottom-right"` (default),
`"bottom-left"`, `"top-right"`, or `"top-left"`.}
\item{width_frac}{Numeric. Logo width as a fraction of the image width
(default `0.15`). Height follows from the logo's aspect ratio.}
\item{margin_frac}{Numeric. Padding from the edges as a fraction of the
image width (default `0.02`).}
}
\value{
`path`, invisibly.
}
\description{
The raster analogue of [civilytics_logo()] for outputs that are already
rendered to a file rather than held as a ggplot/grob — e.g. a `flextable`
exported to PNG, or any `grDevices::png()` / `ragg::agg_png()` output.
Resolves the *same* brand asset that [make_logo_grob()] uses, so file-based
tables stay visually consistent with logo-branded plots, and composites it
into a corner of the image. Pure base-graphics + grid + png — no new
package dependencies.
}
\examples{
\dontrun{
# Brand a table exported to PNG so it matches civilytics_logo()-branded plots
ragg::agg_png("table.png", width = 8, height = 4, units = "in", res = 200)
plot(flextable::flextable(head(mtcars)))
dev.off()
stamp_logo_png("table.png") # wordmark, bottom-right
stamp_logo_png("table.png", type = "mark", position = "bottom-left")
}
}
+30
View File
@@ -0,0 +1,30 @@
test_that("stamp_logo_png preserves image dimensions and returns the path invisibly", {
p <- tempfile(fileext = ".png")
on.exit(unlink(p), add = TRUE)
grDevices::png(p, width = 600, height = 240); plot(1:5); grDevices::dev.off()
in_dim <- dim(png::readPNG(p))[1:2]
expect_invisible(out <- stamp_logo_png(p))
expect_identical(out, p)
expect_identical(dim(png::readPNG(p))[1:2], in_dim) # overwritten at same size
})
test_that("stamp_logo_png runs for every type/variant/position combination", {
p <- tempfile(fileext = ".png")
on.exit(unlink(p), add = TRUE)
grDevices::png(p, width = 500, height = 200); plot(1:5); grDevices::dev.off()
for (ty in c("wordmark", "mark")) {
for (va in c("light", "dark")) {
for (pos in c("bottom-right", "bottom-left", "top-right", "top-left")) {
expect_no_error(stamp_logo_png(p, type = ty, variant = va, position = pos))
}
}
}
})
test_that("stamp_logo_png validates its inputs", {
expect_error(stamp_logo_png(tempfile(fileext = ".png"))) # file does not exist
# invalid type is rejected by match.arg() before the file is touched
expect_error(stamp_logo_png(tempfile(fileext = ".png"), type = "banner"))
})
+56
View File
@@ -0,0 +1,56 @@
# Test beep / notification function
context("Test beep() function")
test_that("beep() returns invisibly", {
expect_invisible(beep())
expect_invisible(beep("test", type = "beep"))
expect_invisible(beep("test", type = "all"))
})
test_that("beep() with quiet=TRUE produces no output", {
expect_silent(beep("test", type = "beep", quiet = TRUE))
})
test_that("beep() with type=notify is silent when no tools available", {
# When notify-send and osascript are both absent, should be silent
expect_silent(beep("test", type = "notify"))
})
test_that("beep() with type=webhook and no URL is silent", {
expect_silent(beep("test", type = "webhook"))
})
test_that("beep(type='all') exercises both beep and notify paths", {
# type="all" should trigger the terminal beep (unless quiet) and
# attempt a desktop notification. We verify by checking that the
# function returns invisibly and does not error when notify-send
# is absent (which is the case in CI).
expect_invisible(beep("all-test", type = "all"))
expect_invisible(beep("all-test", type = "all", quiet = TRUE))
})
test_that("notification helpers use system2() to prevent command injection", {
# Security regression: .send_webhook and .send_desktop_notify must
# use system2() with separate args, never system() with shell
# interpolation. system2() passes arguments directly to the
# executable without going through a shell, so shell metacharacters
# in msg, status, url, or payload are treated as literal data.
webhook_body <- deparse(body(.send_webhook))
notify_body <- deparse(body(.send_desktop_notify))
# Must use system2
expect_true(any(grepl("system2", webhook_body)),
info = ".send_webhook() must use system2() to avoid shell injection")
expect_true(any(grepl("system2", notify_body)),
info = ".send_desktop_notify() must use system2() to avoid shell injection")
# Must NOT use system( with string interpolation (system("curl ..."))
# We look for system( followed by a string literal (the old pattern).
# system2 calls look like system2("curl", args = ...) which is fine.
expect_false(any(grepl('system\\(\\s*"', webhook_body)),
info = ".send_webhook() must not use system() with interpolated strings")
expect_false(any(grepl('system\\(\\s*"', notify_body)),
info = ".send_desktop_notify() must not use system() with interpolated strings")
})
+9 -1
View File
@@ -133,9 +133,17 @@ 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))
expect_true(is.na(th$panel.background$fill))
expect_null(th$legend.background$fill)
})
test_that("theme_civilytics paper_bg=TRUE opt-in fills with cream", {
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"]))
expect_equal(th$panel.background$fill, unname(civilytics_colors["paper"]))
}) })
test_that("theme_civilytics uses paper_2 for strip background by default", { test_that("theme_civilytics uses paper_2 for strip background by default", {
+6
View File
@@ -58,6 +58,12 @@ test_that("na_sum fails with non-numerics", {
expect_error(na_sum(as.factor(1:10))) expect_error(na_sum(as.factor(1:10)))
}) })
test_that("na_sum quiet=TRUE suppresses the message", {
expect_message(na_sum(c(1:10, NA)), "Taking a sum")
expect_silent(na_sum(c(1:10, NA), quiet = TRUE))
expect_equal(na_sum(c(1:10, NA), quiet = TRUE), 55)
})
context("Test Utilities - Pretty Count") context("Test Utilities - Pretty Count")