Fixes #199 Fixes #154 use log ticks and log labels (#201)

* Fixes #199 Fixes #154 use log ticks and log labels * Generalize the ticklabel method to natural log and sqrt scales Axis configurations now include 3 new public methods: * ggplotScale that provides the actual ggplot scale name * prettyTicks that will get user defined or tlf default ticks * prettyTickLabels that will get user defined or tlf default ticklabels * Remove now unnecessary helper in runPlotMaker
Open-Systems-Pharmacology · Nov 23, 2021 · 46cee6a · 46cee6a
1 parent 4384bc5
commit 46cee6a
Show file tree

Hide file tree

Showing 19 changed files with 499 additions and 48 deletions.
diff --git a/NAMESPACE b/NAMESPACE
@@ -93,7 +93,10 @@ export(getGuestValues)
 export(getGuestValuesFromDataMapping)
 export(getLabelWithUnit)
 export(getLegendCaption)
+export(getLnTickLabels)
+export(getLogTickLabels)
 export(getPKRatioMeasure)
+export(getSqrtTickLabels)
 export(initializePlot)
 export(loadThemeFromJson)
 export(metaDataHelper)
@@ -125,6 +128,7 @@ export(setDefaultAggregationLabels)
 export(setDefaultExportName)
 export(setDefaultExportParameters)
 export(setDefaultLegendPosition)
+export(setDefaultLogTicks)
 export(setDefaultWatermark)
 export(setGrid)
 export(setLegend)

diff --git a/R/plotconfiguration-axis.R b/R/plotconfiguration-axis.R
@@ -1,26 +1,15 @@
-#' @title Scaling
-#' @include enum.R
-#' @export
-#' @description
-#'  Pre-defined transformation of axes
-#'  Not that built-in transformations from `ggplot2` includes more transformations
-#' @keywords internal
-Scaling <- enum(c("lin", "log", "discrete",
-                  "reverse", "sqrt", "time", "date"))
-
 #' @title createPlotScale
-#' @description Translate scale into a value directly usable by `ggplot2`
-#' to give more flexibility in the next functions
+#' @description Translate scale into one of the values available in the enum `Scaling`.
 #' @param scale character defining the name of the scale
-#' @return name of the `ggplot2` scale
+#' @return A value available in enum `Scaling`
 #' @keywords internal
 createPlotScale <- function(scale) {
   validateIsString(scale)
   if (isIncluded(tolower(scale), c("identity", "lin", "linear", "default", "normal"))) {
     return("identity")
   }
   if (isIncluded(tolower(scale), c("log", "logarithmic", "log10"))) {
-    return("log10")
+    return(Scaling$log)
   }
   validateIsIncluded(tolower(scale), Scaling)
   return(tolower(scale))
@@ -42,7 +31,7 @@ createPlotTicks <- function(ticks) {
   if (isIncluded(ticks, c("none"))) {
     return(NULL)
   }
-  if (isOfType(ticks, c("numeric", "character", "function"))) {
+  if (isOfType(ticks, c("numeric", "character", "function", "expression"))) {
     return(ticks)
   }
 }
@@ -63,10 +52,10 @@ AxisConfiguration <- R6::R6Class(
     #' @param font `Font` object defining the font of ticklabels
     #' @return A new `AxisConfiguration` object
     initialize = function(limits = NULL,
-                          scale = Scaling$lin,
-                          ticks = NULL,
-                          ticklabels = NULL,
-                          font = NULL) {
+                              scale = Scaling$lin,
+                              ticks = NULL,
+                              ticklabels = NULL,
+                              font = NULL) {
       validateIsNumeric(limits, nullAllowed = TRUE)
       validateIsOfType(font, "Font", nullAllowed = TRUE)
       private$.limits <- limits
@@ -86,6 +75,53 @@ AxisConfiguration <- R6::R6Class(
         defaultFont <- currentTheme$fonts$yAxis
       }
       private$.font <- font %||% defaultFont
+    },
+
+    #' @description Get the `ggplot2` actual `trans` name of scale
+    #' @return A character included in `ggplot2` available `trans` names
+    ggplotScale = function() {
+      switch(
+        private$.scale,
+        "log" = "log10",
+        "ln" = "log",
+        private$.scale
+      )
+    },
+
+    #' @description Get tick values for pretty default log plots
+    #' @return User defined tick values or tlf default ticks
+    prettyTicks = function() {
+      # A waiver is a ggplot2 "flag" object, similar to NULL,
+      # that indicates the calling function should just use the default value
+      if (!isOfType(private$.ticks, "waiver")) {
+        return(private$.ticks)
+      }
+      # Default tick values as a function of scale
+      switch(
+        private$.scale,
+        "log" = tlfEnv$logTicks,
+        "ln" = tlfEnv$lnTicks,
+        private$.ticks
+      )
+    },
+
+    #' @description Get tick labels for pretty default log plots
+    #' @return User defined tick labels or tlf default ticklabels
+    prettyTickLabels = function() {
+      # A waiver is a ggplot2 "flag" object, similar to NULL,
+      # that indicates the calling function should just use the default value
+      if (!isOfType(private$.ticklabels, "waiver")) {
+        return(private$.ticklabels)
+      }
+      # Default tick labels as a function of scale
+      # ggplot2 accepts functions as input for labels
+      switch(
+        private$.scale,
+        "log" = getLogTickLabels,
+        "ln" = getLnTickLabels,
+        "sqrt" = getSqrtTickLabels,
+        private$.ticklabels
+      )
     }
   ),
   active = list(
@@ -177,7 +213,7 @@ XAxisConfiguration <- R6::R6Class(
       suppressMessages(
         plotObject <- plotObject + ggplot2::coord_cartesian(xlim = private$.limits, ylim = ylim)
       )
-      # Update scales and ticks
+      # Update ticks and their labels for discrete scale
       if (isIncluded(private$.scale, Scaling$discrete)) {
         suppressMessages(
           plotObject <- plotObject +
@@ -189,7 +225,16 @@ XAxisConfiguration <- R6::R6Class(
       # `try` should be added in cases of scale breaking because all the ggplot object elements are not yet in place
       suppressMessages(
         plotObject <- plotObject +
-          ggplot2::scale_x_continuous(trans = private$.scale, breaks = private$.ticks, labels = private$.ticklabels)
+          ggplot2::scale_x_continuous(trans = self$ggplotScale(), breaks = self$prettyTicks(), labels = self$prettyTickLabels())
+      )
+      # Add special tick lines for pretty log plots
+      suppressMessages(
+        plotObject <- switch(
+          private$.scale,
+          "log" = plotObject + ggplot2::annotation_logticks(sides = "b", color = private$.font$color),
+          "ln" = plotObject + ggplot2::annotation_logticks(base = exp(1), sides = "b", color = private$.font$color),
+          plotObject
+        )
       )
       return(plotObject)
     }
@@ -217,7 +262,7 @@ YAxisConfiguration <- R6::R6Class(
       suppressMessages(
         plotObject <- plotObject + ggplot2::coord_cartesian(xlim = xlim, ylim = private$.limits)
       )
-      # Update scales and ticks
+      # Update ticks and their labels for discrete scale
       if (isIncluded(private$.scale, Scaling$discrete)) {
         suppressMessages(
           plotObject <- plotObject +
@@ -229,7 +274,16 @@ YAxisConfiguration <- R6::R6Class(
       # `try` should be added in cases of scale breaking because all the ggplot object elements are not yet in place
       suppressMessages(
         plotObject <- plotObject +
-          ggplot2::scale_y_continuous(trans = private$.scale, breaks = private$.ticks, labels = private$.ticklabels)
+          ggplot2::scale_y_continuous(trans = self$ggplotScale(), breaks = self$prettyTicks(), labels = self$prettyTickLabels())
+      )
+      # Add special tick lines for pretty log plots
+      suppressMessages(
+        plotObject <- switch(
+          private$.scale,
+          "log" = plotObject + ggplot2::annotation_logticks(sides = "l", color = private$.font$color),
+          "ln" = plotObject + ggplot2::annotation_logticks(base = exp(1), sides = "l", color = private$.font$color),
+          plotObject
+        )
       )
       return(plotObject)
     }

diff --git a/R/tlf-env.R b/R/tlf-env.R
@@ -10,7 +10,6 @@ tlfEnv$packageName <- "tlf"
 #' @export
 #' @description
 #' List of all available legend positions
-#' @keywords internal
 LegendPositions <- enum(c(
   "none",
   "insideTop",
@@ -137,7 +136,6 @@ setDefaultAggregationBins <- function(bins = NULL) {
   tlfEnv$defaultAggregation$bins <- bins %||% tlfEnv$defaultAggregation$bins
 }
 
-
 #' @title setDefaultWatermark
 #' @description Set default watermark value for current theme
 #' @param watermark character or Label class object
@@ -153,3 +151,16 @@ setDefaultWatermark <- function(watermark = NULL) {
   }
   return(invisible())
 }
+
+tlfEnv$logTicks <- 10^seq(-6,6)
+tlfEnv$lnTicks <- exp(seq(-6,6))
+
+#' @title setDefaultLogTicks
+#' @description Set default values for log ticks
+#' @param ticks numeric values where ticks are placed.
+#' Ensure that the values are positive (they are meant for log scale)
+#' @export
+setDefaultLogTicks <- function(ticks) {
+  tlfEnv$logTicks <- ticks
+  return(invisible())
+}