xaxl / yaxl args for formatting axis tick labels

NAMESPACE

@@ -70,6 +70,7 @@ importFrom(grDevices,xy.coords)
 importFrom(graphics,Axis)
 importFrom(graphics,abline)
 importFrom(graphics,arrows)
+importFrom(graphics,axTicks)
 importFrom(graphics,axis)
 importFrom(graphics,box)
 importFrom(graphics,boxplot)

NEWS.md

@@ -23,6 +23,10 @@ where the formatting is also better._
 - The palette argument now accepts a vector or list of manual colours, e.g.
   `tinyplot(..., palette = c("cyan4", "hotpink, "purple4"))`, or
   `tinytheme("clean", palette = c("cyan4", "hotpink, "purple4"))` (#325 @grantmcdermott)
+- The new top-level `xaxl` and `yaxl` arguments allow users to format the
+  appearance of their axis tick labels. Several convenience strings are
+  supported for common cases, e.g., `tinyplot(..., xaxl = "percent")` or
+  `tinyplot(..., yaxl = "dollar")`, etc. (#363 @grantmcdermott)
 
 ### Bugs fixes:
 

R/facet.R

@@ -181,29 +181,32 @@ draw_facet_window = function(grid, ...) {
       if (dynmar) {
         if (par("las") %in% 1:2) {
           # extra whitespace bump on the y axis
-          # yaxl = axTicks(2)
-          yaxl = axisTicks(usr = extendrange(ylim, f = 0.04), log = par("ylog"))
           ## overrides for ridge and some types that use integer spacing with (named) axis labels ## FXIME
           if (type == "ridge") {
-            yaxl = levels(y)
+            yaxlabs = levels(y)
           } else if (!is.null(ylabs)) {
-            yaxl = if (!is.null(names(ylabs))) names(ylabs) else ylabs 
+            yaxlabs = if (!is.null(names(ylabs))) names(ylabs) else ylabs 
           } else if (type == "boxplot" && isTRUE(flip) && !is.null(xlabs)) {
-            yaxl = if (!is.null(names(xlabs))) names(xlabs) else xlabs 
+            yaxlabs = if (!is.null(names(xlabs))) names(xlabs) else xlabs 
+          } else {
+            # yaxl = axTicks(2)
+            yaxlabs = axisTicks(usr = extendrange(ylim, f = 0.04), log = par("ylog"))
           }
+          if (!is.null(yaxl)) yaxlabs = tinylabel(yaxlabs, yaxl)
           # whtsbp = grconvertX(max(strwidth(yaxl, "figure")), from = "nfc", to = "lines") - 1
-          whtsbp = grconvertX(max(strwidth(yaxl, "figure")), from = "nfc", to = "lines") - grconvertX(0, from = "nfc", to = "lines") - 1
+          whtsbp = grconvertX(max(strwidth(yaxlabs, "figure")), from = "nfc", to = "lines") - grconvertX(0, from = "nfc", to = "lines") - 1
           if (whtsbp > 0) {
             omar = omar + c(0, whtsbp, 0, 0) * cex_fct_adj
             fmar[2] = fmar[2] + whtsbp * cex_fct_adj
           }
         }
         if (par("las") %in% 2:3) {
           # extra whitespace bump on the x axis
-          # xaxl = axTicks(1)
-          xaxl = axisTicks(usr = extendrange(xlim, f = 0.04), log = par("xlog"))
-          whtsbp = grconvertY(max(strwidth(xaxl, "figure")), from = "nfc", to = "lines") - 1
-          # whtsbp = grconvertY(max(strwidth(xaxl, "figure")), from = "nfc", to = "lines") - grconvertY(0, from = "nfc", to = "lines") - 1
+          # xaxlabs = axTicks(1)
+          xaxlabs = axisTicks(usr = extendrange(xlim, f = 0.04), log = par("xlog"))
+          if (!is.null(xaxl)) xaxlabs = tinylabel(xaxlabs, xaxl)
+          whtsbp = grconvertY(max(strwidth(xaxlabs, "figure")), from = "nfc", to = "lines") - 1
+          # whtsbp = grconvertY(max(strwidth(xaxlabs, "figure")), from = "nfc", to = "lines") - grconvertY(0, from = "nfc", to = "lines") - 1
           if (whtsbp > 0) {
             omar = omar + c(whtsbp, 0, 0, 0) * cex_fct_adj
             fmar[1] = fmar[1] + whtsbp * cex_fct_adj
@@ -247,28 +250,31 @@ draw_facet_window = function(grid, ...) {
       if (type == "spineplot") omar[4] = 2.1 # FIXME catch for spineplot RHS axis labs
       if (par("las") %in% 1:2) {
         # extra whitespace bump on the y axis
-        # yaxl = axTicks(2)
-        yaxl = axisTicks(usr = extendrange(ylim, f = 0.04), log = par("ylog"))
         ## overrides for ridge and some types that use integer spacing with (named) axis labels ## FXIME
         if (type == "ridge") {
-          yaxl = levels(y)
+          yaxlabs = levels(y)
         } else if (!is.null(ylabs)) {
-          yaxl = if (!is.null(names(ylabs))) names(ylabs) else ylabs 
+          yaxlabs = if (!is.null(names(ylabs))) names(ylabs) else ylabs 
         } else if (type == "boxplot" && isTRUE(flip) && !is.null(xlabs)) {
-          yaxl = if (!is.null(names(xlabs))) names(xlabs) else xlabs 
+          yaxlabs = if (!is.null(names(xlabs))) names(xlabs) else xlabs 
+        } else {
+          # yaxl = axTicks(2)
+          yaxlabs = axisTicks(usr = extendrange(ylim, f = 0.04), log = par("ylog"))
         }
-        # whtsbp = grconvertX(max(strwidth(yaxl, "figure")), from = "nfc", to = "lines") - 1
-        whtsbp = grconvertX(max(strwidth(yaxl, "figure")), from = "nfc", to = "lines") - grconvertX(0, from = "nfc", to = "lines") - 1
+        if (!is.null(yaxl)) yaxlabs = tinylabel(yaxlabs, yaxl)
+        # whtsbp = grconvertX(max(strwidth(yaxlabs, "figure")), from = "nfc", to = "lines") - 1
+        whtsbp = grconvertX(max(strwidth(yaxlabs, "figure")), from = "nfc", to = "lines") - grconvertX(0, from = "nfc", to = "lines") - 1
         if (whtsbp > 0) {
           omar[2] = omar[2] + whtsbp
         }
       }
       if (par("las") %in% 2:3) {
         # extra whitespace bump on the x axis
         # xaxl = axTicks(1)
-        xaxl = axisTicks(usr = extendrange(ylim, f = 0.04), log = par("xlog"))
-        whtsbp = grconvertY(max(strwidth(xaxl, "figure")), from = "nfc", to = "lines") - 1
-        # whtsbp = grconvertY(max(strwidth(xaxl, "figure")), from = "nfc", to = "lines") - grconvertY(0, from = "nfc", to = "lines") - 1
+        xaxlabs = axisTicks(usr = extendrange(ylim, f = 0.04), log = par("xlog"))
+        if (!is.null(xaxl)) xaxlabs = tinylabel(xaxlabs, xaxl)
+        whtsbp = grconvertY(max(strwidth(xaxlabs, "figure")), from = "nfc", to = "lines") - 1
+        # whtsbp = grconvertY(max(strwidth(xaxlabs, "figure")), from = "nfc", to = "lines") - grconvertY(0, from = "nfc", to = "lines") - 1
         if (whtsbp > 0) {
           omar[1] = omar[1] + whtsbp
         }
@@ -327,13 +333,15 @@ draw_facet_window = function(grid, ...) {
         args_x = list(x,
           side = xside,
           type = xaxt,
+          labeller = xaxl,
           cex = get_tpar(c("cex.xaxs", "cex.axis"), 0.8),
           lwd = get_tpar(c("lwd.xaxs", "lwd.axis"), 1),
           lty = get_tpar(c("lty.xaxs", "lty.axis"), 1)
         )
         args_y = list(y,
           side = yside,
           type = yaxt,
+          labeller = yaxl,
           cex = get_tpar(c("cex.yaxs", "cex.axis"), 0.8),
           lwd = get_tpar(c("lwd.yaxs", "lwd.axis"), 1),
           lty = get_tpar(c("lty.yaxs", "lty.axis"), 1)

R/tinyAxis.R

@@ -1,7 +1,7 @@
 #' auxiliary Axis() interface with different parameter combinations based on type
 #'
 #' @keywords internal
-tinyAxis = function(x = NULL, ..., type = "standard") {
+tinyAxis = function(x = NULL, ..., type = "standard", labeller = NULL) {
   type = match.arg(type, c("standard", "none", "labels", "ticks", "axis"))
   if (type == "none") {
     invisible(numeric(0L))
@@ -17,6 +17,14 @@ tinyAxis = function(x = NULL, ..., type = "standard") {
     } else {
       args$tick = TRUE
     }
+    if (!is.null(labeller)) {
+      if (!is.null(args$at)) {
+        args$labels = if (!is.null(args$labels)) tinylabel(args$labels, labeller) else tinylabel(args$at, labeller)
+      } else {
+        args$at = axTicks(args$side) # FIXME: log ?
+        args$labels = tinylabel(args$at, labeller)
+      }
+    }
     do.call("Axis", args)
   }
 }

R/tinylabel.R

@@ -0,0 +1,51 @@
+#' Format labels
+#' 
+#' @description Internal function for formatting label appearance, e.g. axis
+#' ticks labels. This is what the top-level `xaxl` and `yaxl` arguments
+#' ultimately get passed to.
+#' @param x a numeric or character vector
+#' @param labeller a formatting function to be applied to `x`, e.g. `abs`,
+#'   `topper`, etc. Can also be one of the following convenience strings, for
+#'   which common formatting transformations are provided: `"percent"`,
+#'   `"comma"`, `"dollar"`, `"euro"`, or `"sterling"`.
+#'
+#' @keywords internal
+tinylabel = function(x, labeller = NULL) {
+  if (is.null(labeller)) return(x)
+  if (is.character(labeller)) labeller = labeller_fun((labeller))
+  return(labeller(x))
+}
+
+
+labeller_fun = function(label = c("percent", "comma", "dollar", "euro", "sterling")) {
+  label = match.arg(label)
+
+  format_percent = function(x) {
+    sprintf("%.0f%%", x * 100)
+  }
+
+  format_comma = function(x) {
+    prettyNum(x, big.mark = ",", scientific = FALSE)
+  }
+
+  format_dollar = function(x) {
+    paste0("$", prettyNum(x, big.mark = ",", scientific = FALSE))
+  }
+
+  format_euro = function(x) {
+    paste0("\u20ac", prettyNum(x, big.mark = ",", scientific = FALSE))
+  }
+
+  format_sterling = function(x) {
+    paste0("\u00a3", prettyNum(x, big.mark = ",", scientific = FALSE))
+  }
+
+  switch(
+    label,
+    percent  = format_percent,
+    comma    = format_comma,
+    dollar   = format_dollar,
+    euro     = format_euro,
+    sterling = format_sterling
+  )
+}