Label key figures

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: gghdx
 Title: HDX Theme, Scales, and Other Conveniences for 'ggplot2'
-Version: 0.1.2
+Version: 0.1.2.9000
 Authors@R: 
     person(
       given = "Seth",

NAMESPACE

@@ -18,6 +18,7 @@ export(hdx_pal_gray)
 export(hdx_pal_mint)
 export(hdx_pal_sapphire)
 export(hdx_pal_tomato)
+export(label_number_hdx)
 export(load_source_sans_3)
 export(scale_color_gradient2_hdx)
 export(scale_color_gradient_hdx)

NEWS.md

@@ -1,3 +1,8 @@
+# Development
+
+- Implement `label_number_hdx()` function to improve numeric scales labeling
+to match the data visualization guidelines.
+
 # gghdx 0.1.2
 
 * Use anonymous function format `function()` in `hdx_display_pal()`.

R/hdx_display_pal.R

@@ -64,7 +64,7 @@ hdx_display_pal <- function(
     ) +
     ggplot2::geom_tile(
       color = "white",
-      lwd = 1
+      linewidth = 1
     ) +
     theme_hdx(
       base_family = base_family

R/label_number_hdx.R

@@ -0,0 +1,100 @@
+#' Label numbers in HDX key figures style
+#'
+#' Formats numeric vector in the Centre style for key figures, which abbreviates
+#' numbers 1,000 and above to X.YK, 10,000 and above to XYK, 100,000 and above
+#' to XYZK, and the same for 1,000,000 and above, replacing the K with an M, and
+#' the same for B. Details of the data viz style can be found in the
+#' [visualization guidelines](https://data.humdata.org/dataviz-guide/dataviz-elements/#/data-visualization/text)
+#'
+#' Just for continuity, values are labeled with T for trillion, and that is the
+#' maximum formatting available, anything above the trillions will continue to be
+#' truncated to report in the trillions.
+#'
+#' Deals with negative values in case those ever need to be formatted in similar
+#' manners. Also ensures that rounding is performed so numbers look correct.
+#' Not to be used for percents, which should just use [scales::label_percent()].
+#'
+#' Designed like the `scales::` family of label functions, the return value of
+#' `label_number_hdx` is a function, based on the `additional_prefix`. So you
+#' should pass it in to `scales_...()` `labels` parameter in the same way as
+#' `scales_...()`
+#'
+#' @param additional_prefix Additional prefix to add to string, that will come
+#'     between `sign_prefix` and the number. For example, `"$"` could produce a
+#'     return value of `-$1.1K`.
+#'
+#' @returns Returns a "labelling" function, in the same way as `scales::label_...()`
+#'     functions work, i.e. a function that takes `x` and returns a labelled character
+#'     vector of `length(x)`.
+#'
+#' @examples
+#' library(ggplot2)
+#'
+#' # discrete scaling
+#' p <- ggplot(txhousing) +
+#'   geom_point(
+#'     aes(
+#'       x = median,
+#'       y = volume
+#'     )
+#'   )
+#'
+#' p
+#'
+#' p +
+#'   scale_x_continuous(
+#'     labels = label_number_hdx("$")
+#'   ) +
+#'   scale_y_continuous(
+#'     labels = label_number_hdx()
+#'   )
+#'
+#' @export
+label_number_hdx <- function(additional_prefix = "") {
+  if (!is.character(additional_prefix) || length(additional_prefix) > 1) {
+    stop(
+      "`additional_prefix` should be a character string of length 1, not a ",
+      class(additional_prefix)[1],
+      ".",
+      call. = FALSE
+    )
+  }
+
+  function(x) format_number_hdx(x = x, additional_prefix = additional_prefix)
+}
+
+#' Format numbers in HDX style
+#'
+#' Does the formatting found in `label_number_hdx`.
+#'
+#' @inherit label_number_hdx params description details
+#'
+#' @param x Numeric vector to format
+#'
+#' @returns Character vector of formatted strings
+format_number_hdx <- function(x, additional_prefix) {
+  if (!is.numeric(x)) {
+    stop(
+      "`x` must be numeric, not class ",
+      class(x)[1],
+      ".",
+      call. = FALSE
+    )
+  }
+
+  sign_x <- sign(x)
+  sign_prefix <- ifelse(sign_x == -1, "-", "")
+  abs_x <- abs(x)
+
+  dplyr::case_when(
+    abs_x < 1e3 ~ paste0(sign_prefix, additional_prefix, round(abs_x, digits = 0)),
+    abs_x < 1e4 ~ paste0(sign_prefix, additional_prefix, round(abs_x / 1e3, digits = 1), "K"),
+    abs_x < 1e6 ~ paste0(sign_prefix, additional_prefix, round(abs_x / 1e3, digits = 0), "K"),
+    abs_x < 1e7 ~ paste0(sign_prefix, additional_prefix, round(abs_x / 1e6, digits = 1), "M"),
+    abs_x < 1e9 ~ paste0(sign_prefix, additional_prefix, round(abs_x / 1e6, digits = 0), "M"),
+    abs_x < 1e10 ~ paste0(sign_prefix, additional_prefix, round(abs_x / 1e9, digits = 1), "B"),
+    abs_x < 1e12 ~ paste0(sign_prefix, additional_prefix, round(abs_x / 1e9, digits = 0), "B"),
+    abs_x < 1e13 ~ paste0(sign_prefix, additional_prefix, round(abs_x / 1e12, digits = 1), "T"),
+    abs_x >= 1e13 ~ paste0(sign_prefix, additional_prefix, round(abs_x / 1e12, digits = 0), "T")
+  )
+}

R/scale_hdx.R

@@ -53,9 +53,8 @@
 #' @export
 scale_color_hdx_discrete <- function(...) {
   ggplot2::discrete_scale(
-    "colour",
-    "hdx",
-    hdx_pal_discrete(),
+    aesthetics = "colour",
+    palette = hdx_pal_discrete(),
     na.value = hdx_hex("gray-light"),
     ...
   )
@@ -69,9 +68,8 @@ scale_colour_hdx_discrete <- scale_color_hdx_discrete
 #' @export
 scale_color_hdx_gray <- function(...) {
   ggplot2::discrete_scale(
-    "colour",
-    "hdx",
-    hdx_pal_gray(),
+    aesthetics = "colour",
+    palette = hdx_pal_gray(),
     na.value = hdx_hex("tomato-hdx"),
     ...
   )
@@ -93,9 +91,8 @@ scale_color_hdx_grey <- scale_color_hdx_gray
 #' @export
 scale_color_hdx_mint <- function(...) {
   ggplot2::discrete_scale(
-    "colour",
-    "hdx",
-    hdx_pal_mint(),
+    aesthetics = "colour",
+    palette = hdx_pal_mint(),
     na.value = hdx_hex("gray-light"),
     ...
   )
@@ -109,9 +106,8 @@ scale_colour_hdx_mint <- scale_color_hdx_mint
 #' @export
 scale_color_hdx_sapphire <- function(...) {
   ggplot2::discrete_scale(
-    "colour",
-    "hdx",
-    hdx_pal_sapphire(),
+    aesthetic = "colour",
+    palette = hdx_pal_sapphire(),
     na.value = hdx_hex("gray-light"),
     ...
   )
@@ -125,9 +121,8 @@ scale_colour_hdx_sapphire <- scale_color_hdx_sapphire
 #' @export
 scale_color_hdx_tomato <- function(...) {
   ggplot2::discrete_scale(
-    "colour",
-    "hdx",
-    hdx_pal_tomato(),
+    aesthetics = "colour",
+    palette = hdx_pal_tomato(),
     na.value = hdx_hex("gray-light"),
     ...
   )
@@ -141,9 +136,8 @@ scale_colour_hdx_tomato <- scale_color_hdx_tomato
 #' @export
 scale_fill_hdx_discrete <- function(...) {
   ggplot2::discrete_scale(
-    "fill",
-    "hdx",
-    hdx_pal_discrete(),
+    aesthetics = "fill",
+    palette = hdx_pal_discrete(),
     na.value = hdx_hex("gray-light"),
     ...
   )
@@ -153,9 +147,8 @@ scale_fill_hdx_discrete <- function(...) {
 #' @export
 scale_fill_hdx_gray <- function(...) {
   ggplot2::discrete_scale(
-    "fill",
-    "hdx",
-    hdx_pal_gray(),
+    aesthetics = "fill",
+    palette = hdx_pal_gray(),
     na.value = hdx_hex("tomato-hdx"),
     ...
   )
@@ -169,9 +162,8 @@ scale_fill_hdx_grey <- scale_fill_hdx_gray
 #' @export
 scale_fill_hdx_mint <- function(...) {
   ggplot2::discrete_scale(
-    "fill",
-    "hdx",
-    hdx_pal_mint(),
+    aesthetics = "fill",
+    palette = hdx_pal_mint(),
     na.value = hdx_hex("gray-light"),
     ...
   )
@@ -181,9 +173,8 @@ scale_fill_hdx_mint <- function(...) {
 #' @export
 scale_fill_hdx_sapphire <- function(...) {
   ggplot2::discrete_scale(
-    "fill",
-    "hdx",
-    hdx_pal_sapphire(),
+    aesthetics = "fill",
+    palette = hdx_pal_sapphire(),
     na.value = hdx_hex("gray-light"),
     ...
   )
@@ -193,9 +184,8 @@ scale_fill_hdx_sapphire <- function(...) {
 #' @export
 scale_fill_hdx_tomato <- function(...) {
   ggplot2::discrete_scale(
-    "fill",
-    "hdx",
-    hdx_pal_tomato(),
+    aesthetics = "fill",
+    palette = hdx_pal_tomato(),
     na.value = hdx_hex("gray-light"),
     ...
   )
@@ -206,7 +196,6 @@ scale_fill_hdx_tomato <- function(...) {
 scale_fill_gradient_hdx <- function(...) {
   ggplot2::continuous_scale(
     aesthetics = "fill",
-    scale_name = "hdx",
     palette = scales::seq_gradient_pal(
       low = hdx_hex("tomato-hdx"),
       high = hdx_hex("sapphire-hdx")
@@ -221,7 +210,6 @@ scale_fill_gradient_hdx <- function(...) {
 scale_fill_gradient_hdx_sapphire <- function(...) {
   ggplot2::continuous_scale(
     aesthetics = "fill",
-    scale_name = "hdx",
     palette = scales::seq_gradient_pal(
       low = "white",
       high = hdx_hex("sapphire-hdx")
@@ -236,7 +224,6 @@ scale_fill_gradient_hdx_sapphire <- function(...) {
 scale_fill_gradient_hdx_mint <- function(...) {
   ggplot2::continuous_scale(
     aesthetics = "fill",
-    scale_name = "hdx",
     palette = scales::seq_gradient_pal(
       low = "white",
       high = hdx_hex("mint-hdx")
@@ -251,7 +238,6 @@ scale_fill_gradient_hdx_mint <- function(...) {
 scale_fill_gradient_hdx_tomato <- function(...) {
   ggplot2::continuous_scale(
     aesthetics = "fill",
-    scale_name = "hdx",
     palette = scales::seq_gradient_pal(
       low = "white",
       high = hdx_hex("tomato-hdx")
@@ -266,7 +252,6 @@ scale_fill_gradient_hdx_tomato <- function(...) {
 scale_color_gradient_hdx <- function(...) {
   ggplot2::continuous_scale(
     aesthetics = "color",
-    scale_name = "hdx",
     palette = scales::seq_gradient_pal(
       low = hdx_hex("tomato-hdx"),
       high = hdx_hex("sapphire-hdx")
@@ -285,7 +270,6 @@ scale_colour_gradient_hdx <- scale_color_gradient_hdx
 scale_color_gradient_hdx_sapphire <- function(...) {
   ggplot2::continuous_scale(
     aesthetics = "color",
-    scale_name = "hdx",
     palette = scales::seq_gradient_pal(
       low = "white",
       high = hdx_hex("sapphire-hdx")
@@ -304,7 +288,6 @@ scale_colour_gradient_hdx_sapphire <- scale_color_gradient_hdx_sapphire
 scale_color_gradient_hdx_mint <- function(...) {
   ggplot2::continuous_scale(
     aesthetics = "color",
-    scale_name = "hdx",
     palette = scales::seq_gradient_pal(
       low = "white",
       high = hdx_hex("mint-hdx")
@@ -323,7 +306,6 @@ scale_colour_gradient_hdx_mint <- scale_color_gradient_hdx_mint
 scale_color_gradient_hdx_tomato <- function(...) {
   ggplot2::continuous_scale(
     aesthetics = "color",
-    scale_name = "hdx",
     palette = scales::seq_gradient_pal(
       low = "white",
       high = hdx_hex("tomato-hdx")
@@ -342,7 +324,6 @@ scale_colour_gradient_hdx_tomato <- scale_color_gradient_hdx_tomato
 scale_color_gradient2_hdx <- function(...) {
   ggplot2::continuous_scale(
     aesthetics = "color",
-    scale_name = "hdx",
     palette = scales::div_gradient_pal(
       low = hdx_hex("tomato-hdx"),
       mid = hdx_hex("gray-white"),
@@ -362,7 +343,6 @@ scale_colour_gradient2_hdx <- scale_color_gradient2_hdx
 scale_fill_gradient2_hdx <- function(...) {
   ggplot2::continuous_scale(
     aesthetics = "fill",
-    scale_name = "hdx",
     palette = scales::div_gradient_pal(
       low = hdx_hex("tomato-hdx"),
       mid = hdx_hex("gray-white"),

README.Rmd

@@ -41,6 +41,8 @@ starting from the y-axis.
 * `gghdx()` ensures plot for the session use HDX defaults for color and fill
 scales, uses `theme_hdx()` for all plots, and applies `scale_color_hdx_...()` and
 `scale_fill_hdx_...()`
+* `label_number_hdx()` supplements the `scales::label_...()` series of functions
+to create labels for numbers in the HDX style.
 
 ## Installation
 

README.md

@@ -31,6 +31,8 @@ features. The key functionalities are:
 - `gghdx()` ensures plot for the session use HDX defaults for color and
   fill scales, uses `theme_hdx()` for all plots, and applies
   `scale_color_hdx_...()` and `scale_fill_hdx_...()`
+- `label_number_hdx()` supplements the `scales::label_...()` series of
+  functions to create labels for numbers in the HDX style.
 
 ## Installation
 
@@ -187,7 +189,8 @@ the visual guide using the theme and color scales in the package.
 
 The inbuilt data `gghdx::df_covid` has aggregated COVID data we can use
 to mirror this plot. To make the data start at the y-axis, we can use
-`scale_y_continuous_hdx()` which sets `expand = c(0, 0)` by default.
+`scale_y_continuous_hdx()` which sets `expand = c(0, 0)` by default, and
+the `label_number_hdx()` function to create custom labels.
 
 ``` r
 p_blue <- ggplot(
@@ -203,11 +206,7 @@ p_blue <- ggplot(
     fill = hdx_hex("sapphire-hdx") # use sapphire for fill
   ) +
   scale_y_continuous_hdx(
-    labels = scales::label_number(
-      accuracy = 1,
-      scale = 1 / 1000000,
-      suffix = "M"
-    )
+    labels = label_number_hdx()
   ) +
   scale_x_date(
     date_breaks = "1 month",