From a0fa26788a1ce13a04c716ced156cab4a588316e Mon Sep 17 00:00:00 2001 From: David Hugh-Jones Date: Tue, 14 Jun 2022 10:21:55 +0100 Subject: [PATCH] Add `label_itemized()`: display values like an itemized list. --- NAMESPACE | 1 + R/label-itemized.R | 87 ++++++++++++++++++++++++++++ man/label_itemized.Rd | 46 +++++++++++++++ tests/testthat/test-label-itemized.R | 22 +++++++ 4 files changed, 156 insertions(+) create mode 100644 R/label-itemized.R create mode 100644 man/label_itemized.Rd create mode 100644 tests/testthat/test-label-itemized.R diff --git a/NAMESPACE b/NAMESPACE index 2e821ea1..72789ca8 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -88,6 +88,7 @@ export(label_comma) export(label_date) export(label_date_short) export(label_dollar) +export(label_itemized) export(label_log) export(label_math) export(label_number) diff --git a/R/label-itemized.R b/R/label-itemized.R new file mode 100644 index 00000000..ddfc4621 --- /dev/null +++ b/R/label-itemized.R @@ -0,0 +1,87 @@ + + +#' Label categories like an itemized list +#' +#' `label_itemized` displays values using itemized list numbering +#' like `a, b, c` or `(1), (2), (3)`. +#' +#' @inherit label_number return +#' @param fmt A format string containing exactly one occurrence of either `"i"`, +#' `"I"`, `"a"`, `"A"` or `"1"`. +#' +#' @details +#' Values are converted to integers. +#' +#' * If `fmt` contains `"a"`, values are labelled `a, b, c, ...`. +#' * If `fmt` contains `"A"`, values are labelled `A, B, C, ...`. +#' * If `fmt` contains `"i"`, values are labelled by Roman numerals +#' `i, ii, iii, iv, ...`. +#' * If `fmt` contains `"I"`, values are labelled `I, II, III, IV, ...`. +#' * If `fmt` contains `"1"`, values are labelled `1, 2, 3,...`. +#' +#' Other characters in `fmt` are passed through as-is, so e.g. `fmt = "a)"` +#' becomes `a), b), c), ...`. +#' +#' @export +#' +#' @examples +#' demo_continuous(1:5) +#' demo_continuous(1:5, labels = label_itemized()) +#' demo_continuous(1:5, labels = label_itemized("(a)")) +#' demo_continuous(1:5, labels = label_itemized("i.")) +label_itemized <- function (fmt = "a") { + force_all(fmt) + match <- gregexpr("(a|A|i|I|1)", fmt)[[1]] + if (length(match) > 1 || match[1] == -1L) { + abort("`fmt` must contain exactly one a/A/i/I/1 character") + } + + key <- substr(fmt, match, match) + before <- substr(fmt, 1, match - 1) + after <- substr(fmt, match + 1, nchar(fmt)) + + switch(key, + "a" = itemized_alphabetic(before, after, caps = FALSE), + "A" = itemized_alphabetic(before, after, caps = TRUE), + "i" = itemized_roman(before, after, caps = FALSE), + "I" = itemized_roman(before, after, caps = TRUE), + "1" = itemized_numeral(before, after) + ) + +} + +itemized_alphabetic <- function (before, after, caps) { + alphabet <- if (caps) LETTERS else letters + function (x) { + if (max(x, na.rm = TRUE) > length(alphabet)) { + abort("Large elements in `x` cannot be represented by the alphabet") + } + out <- paste0(before, alphabet[as.integer(x)], after) + out[is.na(x)] <- NA + names(out) <- names(x) + + out + } +} + +itemized_roman <- function (before, after, caps) { + function (x) { + romans <- utils::as.roman(as.integer(x)) + if (! caps) romans <- tolower(romans) + out <- paste0(before, romans, after) + out[is.na(x)] <- NA + names(out) <- names(x) + + out + } +} + +itemized_numeral <- function (before, after) { + function (x) { + out <- paste0(before, as.integer(x), after) + out[is.na(x)] <- NA + names(out) <- names(x) + + out + } +} diff --git a/man/label_itemized.Rd b/man/label_itemized.Rd new file mode 100644 index 00000000..e1c7f5c1 --- /dev/null +++ b/man/label_itemized.Rd @@ -0,0 +1,46 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/label-itemized.R +\name{label_itemized} +\alias{label_itemized} +\title{Label categories like an itemized list} +\usage{ +label_itemized(fmt = "a") +} +\arguments{ +\item{fmt}{A format string containing exactly one occurrence of either \code{"i"}, +\code{"I"}, \code{"a"}, \code{"A"} or \code{"1"}.} +} +\value{ +All \code{label_()} functions return a "labelling" function, i.e. a function that +takes a vector \code{x} and returns a character vector of \code{length(x)} giving a +label for each input value. + +Labelling functions are designed to be used with the \code{labels} argument of +ggplot2 scales. The examples demonstrate their use with x scales, but +they work similarly for all scales, including those that generate legends +rather than axes. +} +\description{ +\code{label_itemized} displays values using itemized list numbering +like \verb{a, b, c} or \verb{(1), (2), (3)}. +} +\details{ +Values are converted to integers. +\itemize{ +\item If \code{fmt} contains \code{"a"}, values are labelled \verb{a, b, c, ...}. +\item If \code{fmt} contains \code{"A"}, values are labelled \verb{A, B, C, ...}. +\item If \code{fmt} contains \code{"i"}, values are labelled by Roman numerals +\verb{i, ii, iii, iv, ...}. +\item If \code{fmt} contains \code{"I"}, values are labelled \verb{I, II, III, IV, ...}. +\item If \code{fmt} contains \code{"1"}, values are labelled \verb{1, 2, 3,...}. +} + +Other characters in \code{fmt} are passed through as-is, so e.g. \code{fmt = "a)"} +becomes \verb{a), b), c), ...}. +} +\examples{ +demo_continuous(1:5) +demo_continuous(1:5, labels = label_itemized()) +demo_continuous(1:5, labels = label_itemized("(a)")) +demo_continuous(1:5, labels = label_itemized("i.")) +} diff --git a/tests/testthat/test-label-itemized.R b/tests/testthat/test-label-itemized.R new file mode 100644 index 00000000..7f4530fc --- /dev/null +++ b/tests/testthat/test-label-itemized.R @@ -0,0 +1,22 @@ +test_that("label_itemized works correctly", { + x <- 1:5 + x_na <- c(1, 2, NA, 4, 5) + + expect_equal(label_itemized("a")(x), c("a", "b", "c", "d", "e")) + expect_equal(label_itemized("A")(x), c("A", "B", "C", "D", "E")) + expect_equal(label_itemized("i")(x), c("i", "ii", "iii", "iv", "v")) + expect_equal(label_itemized("I")(x), c("I", "II", "III", "IV", "V")) + expect_equal(label_itemized("1")(x), c("1", "2", "3", "4", "5")) + + expect_equal(label_itemized("a)")(x), c("a)", "b)", "c)", "d)", "e)")) + expect_equal(label_itemized("A)")(x), c("A)", "B)", "C)", "D)", "E)")) + expect_equal(label_itemized("i)")(x), c("i)", "ii)", "iii)", "iv)", "v)")) + expect_equal(label_itemized("I)")(x), c("I)", "II)", "III)", "IV)", "V)")) + expect_equal(label_itemized("1)")(x), c("1)", "2)", "3)", "4)", "5)")) + + expect_equal(label_itemized("a")(x_na), c("a", "b", NA, "d", "e")) +}) + +test_that("label_itemized preserves names", { + expect_named(label_itemized("a")(c(a = 1)), "a") +})