jared
e43c4229c3
R-CMD-check / R CMD check (push) Failing after 4m35s
Blocking issue #1: Replace all ggplot2::function() calls with bare references in R/colors.R, R/logo.R, R/theme.R. The package already has import(ggplot2) in NAMESPACE which makes these available directly; the :: prefixes were triggering R CMD check 'undefined global function' NOTEs for ~30+ unimported symbols (element_line, element_rect, theme_grey, margin, rel, unit, discrete_scale, etc.). Suggestion #6: Replace class(x) == "character" with "character" %in% class(x) in R/db.R (countCleanr and simpleCap). The == pattern breaks on S3 objects with multiple class attributes. Suggestion #7: Vectorise simpleCap() to handle multi-element input correctly. Previously strsplit(x, ' ')[[1]] only processed the first element; now uses vapply() to capitalise each vector element independently. Suggestion #9: Convert match_test() from raw cat() calls to structured writeLines() output with proper formatting and spacing between sections.
454 lines
17 KiB
R
454 lines
17 KiB
R
#' Plot a jpeg image as a raster
|
|
#'
|
|
#' @param path a character representing the relative or absolute path to the image
|
|
#' @param add a logical, TRUE to add the image to an existing plot, FALSE creates a new plot
|
|
#' @param upscale a logical, TRUE upscales the resolution of the graphic by a factor of 3, FALSE
|
|
#' preserves the resolution
|
|
#' @return a rasterImage
|
|
#' @export
|
|
#' @importFrom jpeg readJPEG
|
|
#' @importFrom graphics rasterImage
|
|
#' @examples
|
|
#' \dontrun{
|
|
#' # Supply a path to your own JPEG file
|
|
#' img <- "my_photo.jpg"
|
|
#' plot_jpeg(img)
|
|
#' }
|
|
plot_jpeg <- function(path, add=FALSE, upscale = TRUE)
|
|
{
|
|
jpg = readJPEG(path, native = TRUE) # read the file
|
|
res = dim(jpg)[2:1] # get the resolution, [x, y]
|
|
if (upscale){
|
|
res <- res * 3
|
|
}
|
|
if (!add) # initialize an empty plot area if add==FALSE
|
|
plot(1,1,xlim=c(1,res[1]),ylim=c(1,res[2]),asp=1,type='n',xaxs='i',yaxs='i',
|
|
xaxt='n',yaxt='n',xlab='',ylab='',bty='n', oma=c(0,0,1,1), mar=c(0,0,1,1)
|
|
)
|
|
rasterImage(jpg,1,1,res[1],res[2],interpolate=TRUE)
|
|
}
|
|
|
|
|
|
#' Plot a PNG file as a rasterGrob for inclusion in ggplot2
|
|
#'
|
|
#' @param filename a character with file path to a png file
|
|
#'
|
|
#' @return a plotted rasteGrob of a png image
|
|
#' @export
|
|
#' @importFrom png readPNG
|
|
#' @importFrom grid rasterGrob
|
|
get_png <- function(filename) {
|
|
grid::rasterGrob(png::readPNG(filename), interpolate = TRUE)
|
|
}
|
|
|
|
|
|
#' Add a logo to a ggplot2 object
|
|
#'
|
|
#' @param plot a ggplot2 grob
|
|
#' @param logo a logo grob created by make_logo_grob()
|
|
#' @param margin_param a numeric specifying what margin to add or subtract to align the logo
|
|
#' @param font_scale Numeric. Multiplicative scaling factor applied to text
|
|
#' sizes before composing the plot with the logo. Default `1.1` inflates
|
|
#' text by ~10 \% to compensate for the viewport shrinkage caused by
|
|
#' [gridExtra::arrangeGrob()]. Set to `1` to disable.
|
|
#' @param position Character. Corner placement for the logo: `"bottom-right"`
|
|
#' (default), `"bottom-left"`, `"top-right"`, or `"top-left"`. Controls
|
|
#' whether the logo is placed above or below the plot.
|
|
#'
|
|
#' @return a grob with a logo attached to it ready to plot
|
|
#' @importFrom ggplot2 theme
|
|
#' @importFrom gridExtra arrangeGrob
|
|
#' @export
|
|
add_logo <- function(plot, logo, margin_param = NULL, font_scale = 1.1,
|
|
position = c("bottom-right", "bottom-left",
|
|
"top-right", "top-left")) {
|
|
position <- match.arg(position)
|
|
at_top <- grepl("top", position)
|
|
|
|
# Capture the plot's background color so we can fill the entire composed
|
|
# grob with it. The logo grob must stay transparent (theme_void) so that
|
|
# caption/axis text overlapping via negative margins remains visible.
|
|
bg_fill <- plot$theme$plot.background$fill
|
|
|
|
# Inflate text sizes to compensate for arrangeGrob viewport shrinkage.
|
|
# All theme text elements use rel() sizing, so scaling the root 'text'
|
|
# element cascades to titles, axis labels, legends, captions, and strips.
|
|
if (!is.null(font_scale) && font_scale != 1) {
|
|
base_size <- plot$theme$text$size %||% 14
|
|
plot <- plot + theme(
|
|
text = element_text(size = base_size * font_scale)
|
|
)
|
|
}
|
|
|
|
if (at_top) {
|
|
# For top placement, tighten the top margin of the plot
|
|
if (!is.null(margin_param)) {
|
|
plot <- plot + theme(plot.margin = unit(c(margin_param, 7, 7, 7), "pt"))
|
|
} else {
|
|
plot <- plot + theme(plot.margin = unit(c(-14, 7, 7, 7), "pt"))
|
|
}
|
|
composed <- arrangeGrob(logo, plot, heights = c(0.1, 0.93),
|
|
padding = unit(0.1, "line"))
|
|
} else {
|
|
# Bottom placement (original behaviour)
|
|
if(has_caption(plot)) {
|
|
cap_lines <- measure_caption(plot)
|
|
if (!is.null(margin_param)) {
|
|
plot <- plot + theme(plot.margin = unit(c(7, 7, margin_param, 7), "pt"))
|
|
} else {
|
|
plot <- plot + theme(plot.margin = unit(c(7, 7, cap_lines * -52, 7), "pt"))
|
|
}
|
|
} else {
|
|
plot <- plot + theme(plot.margin = unit(c(7, 7, -14, 7), "pt"))
|
|
}
|
|
composed <- arrangeGrob(plot, logo, heights = c(0.93, 0.1),
|
|
padding = unit(0.1, "line"))
|
|
}
|
|
|
|
# Wrap with a full-bleed background rect so any transparent areas (the
|
|
# logo strip, padding gaps) pick up the plot's background color instead
|
|
# of the device default (white).
|
|
if (!is.null(bg_fill) && !is.na(bg_fill)) {
|
|
bg_rect <- grid::rectGrob(gp = grid::gpar(fill = bg_fill, col = NA))
|
|
grid::grobTree(bg_rect, composed)
|
|
} else {
|
|
composed
|
|
}
|
|
}
|
|
|
|
#' Measure a ggplot2 object caption
|
|
#'
|
|
#' @param gg a ggplot object
|
|
#'
|
|
#' @return a numeric value stating the number of lines to be added or subtracted to align a logo with
|
|
#' the caption
|
|
#' @importFrom stringr str_count
|
|
#' @export
|
|
#'
|
|
#' @examples
|
|
#' p1 <- ggplot(mtcars, aes(mpg, wt)) + geom_point()
|
|
#' measure_caption(p1) # Should equal 1 since no caption is present
|
|
measure_caption <- function(gg) {
|
|
if (has_caption(gg)) {
|
|
stringr::str_count(gg$labels$caption, pattern = "\n") + 1
|
|
} else {
|
|
1
|
|
}
|
|
}
|
|
|
|
|
|
#' Test whether a ggplot2 object has a caption
|
|
#'
|
|
#' @param gg a gg object from ggplot2
|
|
#'
|
|
#' @return a logical, TRUE if a caption exists and FALSE if it does not
|
|
#' @import ggplot2
|
|
#' @export
|
|
#'
|
|
#' @examples
|
|
#' p1 <- ggplot(mtcars, aes(mpg, wt)) + geom_point()
|
|
#' has_caption(p1) # FALSE
|
|
has_caption <- function(gg) {
|
|
any(names(gg$labels) == "caption")
|
|
}
|
|
|
|
#' Add a logo to multiple ggplot2 objects
|
|
#'
|
|
#' @param plot_list a list containing ggplot2 objects
|
|
#' @param logo a grob containing the logo created with `make_logo_grob`
|
|
#' @param nrow an integer, default = 1, for the number of rows to align the plots in
|
|
#' @param widths an optional vector the same length as plot_list with the widths for each plot
|
|
#' @param margin_param a number giving the adjustment up or down to help manually align logo and captions
|
|
#' @param font_scale Numeric. Multiplicative scaling factor applied to text
|
|
#' sizes before composing. Default `1.1`. See [add_logo()] for details.
|
|
#'
|
|
#' @return a grid object
|
|
#' @note The resulting object needs to be drawn to the screen using grid.draw()
|
|
#' @importFrom gridExtra arrangeGrob
|
|
#' @importFrom ggplot2 theme
|
|
#' @importFrom grid grid.draw
|
|
#' @export
|
|
#'
|
|
#' @examples
|
|
#' \dontrun{
|
|
#' library(ggplot2); library(grid)
|
|
#' tmp_plot <- ggplot(mtcars) + aes(x = hp, y = disp) + geom_point() + theme_civilytics()
|
|
#' tmp_logo <- make_logo_grob()
|
|
#' plot_and_logo <- add_logo(tmp_plot, tmp_logo)
|
|
#' grid.draw(plot_and_logo)
|
|
#' dev.off()
|
|
#' }
|
|
add_logo_ga <- function(plot_list, logo, nrow = 1, widths = NULL,
|
|
margin_param = NULL, font_scale = 1.1) {
|
|
# Capture the background color from the first plot
|
|
bg_fill <- plot_list[[1]]$theme$plot.background$fill
|
|
|
|
# Inflate text sizes to compensate for viewport shrinkage
|
|
if (!is.null(font_scale) && font_scale != 1) {
|
|
plot_list <- lapply(plot_list, function(p) {
|
|
base_size <- p$theme$text$size %||% 14
|
|
p + theme(
|
|
text = element_text(size = base_size * font_scale)
|
|
)
|
|
})
|
|
}
|
|
|
|
# Change position of logo depending on if plot has a caption
|
|
if (!is.null(margin_param)) {
|
|
margin <- theme(plot.margin = unit(c(7, 7, margin_param, 7), "pt"))
|
|
} else if (any(unlist(lapply(plot_list, has_caption)))) {
|
|
cap_lines <- max(sapply(plot_list, measure_caption))
|
|
margin <- theme(plot.margin = unit(c(7, 7, -7 * sqrt(cap_lines), 7), "pt"))
|
|
} else {
|
|
margin <- theme(plot.margin = unit(c(7, 7, 7, 7), "pt"))
|
|
}
|
|
if (nrow > 1) {
|
|
len <- length(plot_list)
|
|
plot_list[[len]] <- plot_list[[len]] + margin
|
|
} else {
|
|
plot_list <- lapply(plot_list, "+", margin)
|
|
}
|
|
|
|
if (nrow != 1) {
|
|
if (!is.null(widths)) warning("`widths` is ignored when `nrow > 1`")
|
|
hold <- arrangeGrob(grobs = plot_list, nrow = nrow, ncol = 1)
|
|
} else {
|
|
hold <- arrangeGrob(grobs = plot_list, nrow = 1, ncol = length(plot_list), widths = widths)
|
|
}
|
|
|
|
composed <- arrangeGrob(hold, logo, heights = c(0.93, .07))
|
|
|
|
if (!is.null(bg_fill) && !is.na(bg_fill)) {
|
|
bg_rect <- grid::rectGrob(gp = grid::gpar(fill = bg_fill, col = NA))
|
|
grid::grobTree(bg_rect, composed)
|
|
} else {
|
|
composed
|
|
}
|
|
}
|
|
|
|
|
|
#' Get a Civilytics Logo grob
|
|
#'
|
|
#' Returns a ggplot object containing the Civilytics logo as a rasterGrob,
|
|
#' ready to compose with plots via [add_logo()], [add_logo_ga()], or the
|
|
#' pipe-friendly [civilytics_logo()].
|
|
#'
|
|
#' @param type Character. `"wordmark"` (default) uses the full wordmark.
|
|
#' `"mark"` uses the compact C-pulse icon only.
|
|
#' @param variant Character. `"light"` (default) uses the dark logo for light
|
|
#' backgrounds. `"dark"` uses the reverse (light) logo for dark backgrounds
|
|
#' (pairs with [theme_civilytics_dark()]).
|
|
#' @param position Character. Corner placement for the logo: `"bottom-right"`
|
|
#' (default), `"bottom-left"`, `"top-right"`, or `"top-left"`. Controls
|
|
#' horizontal alignment of the logo grob.
|
|
#'
|
|
#' @return A ggplot object (class `"gg"`) containing the logo grob.
|
|
#' @export
|
|
#' @importFrom ggplot2 ggplot theme_void annotation_custom
|
|
#' @examples
|
|
#' logo <- make_logo_grob() # wordmark, light
|
|
#' logo <- make_logo_grob("mark", "dark") # mark, dark
|
|
#' logo <- make_logo_grob(position = "bottom-left") # left-aligned
|
|
#' class(logo) # "gg" "ggplot"
|
|
make_logo_grob <- function(type = c("wordmark", "mark"),
|
|
variant = c("light", "dark"),
|
|
position = c("bottom-right", "bottom-left",
|
|
"top-right", "top-left")) {
|
|
type <- match.arg(type)
|
|
variant <- match.arg(variant)
|
|
position <- match.arg(position)
|
|
|
|
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"
|
|
)
|
|
|
|
align_left <- grepl("left", position)
|
|
|
|
if (align_left) {
|
|
xmin <- 0
|
|
xmax <- if (type == "mark") 0.07 else 0.35
|
|
} else {
|
|
xmin <- if (type == "mark") 0.93 else 0.65
|
|
xmax <- 1
|
|
}
|
|
|
|
ggplot() +
|
|
theme_void() +
|
|
annotation_custom(
|
|
get_png(system.file("img", img_file, package = "civilytics")),
|
|
xmin = xmin, xmax = xmax
|
|
)
|
|
}
|
|
|
|
#' Add a Civilytics logo to a ggplot (pipe-friendly)
|
|
#'
|
|
#' A convenience wrapper that creates the logo grob and attaches it to a
|
|
#' corner of the plot in one call. Designed for use with the base pipe `|>`.
|
|
#'
|
|
#' **Important:** R's `|>` has *higher* precedence than `+`, so you must
|
|
#' wrap the ggplot chain in parentheses before piping:
|
|
#'
|
|
#' ```
|
|
#' (ggplot(mpg, aes(displ, hwy)) +
|
|
#' geom_point() +
|
|
#' theme_civilytics()) |>
|
|
#' civilytics_logo()
|
|
#' ```
|
|
#'
|
|
#' @param plot A ggplot object.
|
|
#' @param type Character. `"wordmark"` (default) or `"mark"`. Passed to
|
|
#' [make_logo_grob()].
|
|
#' @param variant Character. `"light"` (default) or `"dark"`. Passed to
|
|
#' [make_logo_grob()].
|
|
#' @param position Character. Corner placement for the logo: `"bottom-right"`
|
|
#' (default), `"bottom-left"`, `"top-right"`, or `"top-left"`.
|
|
#' @param margin_param Numeric or `NULL`. Manual margin adjustment passed to
|
|
#' [add_logo()].
|
|
#' @param font_scale Numeric. Inflate text sizes by this factor to compensate
|
|
#' for viewport shrinkage when composing with [gridExtra::arrangeGrob()].
|
|
#' Default `1.1` (~10 \% inflation). Set to `1` to disable.
|
|
#'
|
|
#' @return A grob (from [gridExtra::arrangeGrob()]) ready to draw with
|
|
#' [grid::grid.draw()].
|
|
#' @export
|
|
#'
|
|
#' @examples
|
|
#' \dontrun{
|
|
#' library(ggplot2); library(grid)
|
|
#'
|
|
#' # Pipe usage — parentheses required around the ggplot chain
|
|
#' (ggplot(mpg, aes(displ, hwy)) +
|
|
#' geom_point() +
|
|
#' theme_civilytics()) |>
|
|
#' civilytics_logo() |>
|
|
#' grid.draw()
|
|
#'
|
|
#' # Top-right placement
|
|
#' (ggplot(mpg, aes(displ, hwy)) +
|
|
#' geom_point() +
|
|
#' theme_civilytics()) |>
|
|
#' civilytics_logo(position = "top-right") |>
|
|
#' grid.draw()
|
|
#'
|
|
#' # Bottom-left with mark
|
|
#' (ggplot(mpg, aes(displ, hwy)) +
|
|
#' geom_point() +
|
|
#' theme_civilytics()) |>
|
|
#' civilytics_logo(type = "mark", position = "bottom-left") |>
|
|
#' grid.draw()
|
|
#'
|
|
#' # Dark theme with mark in top-left
|
|
#' (ggplot(mpg, aes(displ, hwy)) +
|
|
#' geom_point() +
|
|
#' theme_civilytics_dark()) |>
|
|
#' civilytics_logo(variant = "dark", type = "mark",
|
|
#' position = "top-left") |>
|
|
#' grid.draw()
|
|
#' }
|
|
civilytics_logo <- function(plot,
|
|
type = c("wordmark", "mark"),
|
|
variant = c("light", "dark"),
|
|
position = c("bottom-right", "bottom-left",
|
|
"top-right", "top-left"),
|
|
margin_param = NULL,
|
|
font_scale = 1.1) {
|
|
position <- match.arg(position)
|
|
logo <- make_logo_grob(type = type, variant = variant, position = position)
|
|
add_logo(plot, logo, margin_param = margin_param, font_scale = font_scale,
|
|
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)
|
|
}
|