Fixes #304 add enum helper for ticklabels (#305)

* Fixes #304 add enum helper for ticklabels

* Fix typo in Pi label mapping

* Fix typo in example

* If ticklabels is of type expression, numeric or function use it as is

If expression or function isIncluded throw an error so the assertion is necessary before isIncluded

* style and document

Co-authored-by: Indrajeet Patil <patilindrajeet.science@gmail.com>

NAMESPACE

@@ -80,6 +80,7 @@ export(ThemeAestheticSelections)
 export(ThemeBackground)
 export(ThemeFont)
 export(ThemePlotConfigurations)
+export(TickLabelTransforms)
 export(TimeProfileDataMapping)
 export(TimeProfilePlotConfiguration)
 export(TornadoDataMapping)
@@ -100,6 +101,7 @@ export(exportPlot)
 export(exportPlotConfigurationCode)
 export(getBoxWhiskerMeasure)
 export(getDefaultCaptions)
+export(getGreekTickLabels)
 export(getGuestValues)
 export(getGuestValuesFromDataMapping)
 export(getLabelWithUnit)
@@ -109,6 +111,7 @@ export(getLinesFromFoldDistance)
 export(getLnTickLabels)
 export(getLogTickLabels)
 export(getPKRatioMeasure)
+export(getPiTickLabels)
 export(getSqrtTickLabels)
 export(initializePlot)
 export(loadThemeFromJson)

NEWS.md

@@ -13,6 +13,7 @@
    - `HorizontalJustification` (horizontal justifications for plot annotation text) (#293)
    - `VerticalJustification` (vertical justifications for plot annotation text) (#293)
    - `PlotAnnotationTextSize` (default text sizes for plot annotations) (#293)
+   - `TickLabelTransforms` (predefined tick labeling) (#304)
 
 ## Minor improvements and bug fixes
 

R/ddiratio-datamapping.R

@@ -31,7 +31,7 @@ DDIRatioDataMapping <- R6::R6Class(
       validateIsNumeric(minRange)
       validateIsOfLength(minRange, 2)
       validateIsLogical(residualsVsObserved)
-      
+
       self$lines <- lines
       self$minRange <- minRange
       self$deltaGuest <- deltaGuest

R/plot-ddiratio.R

@@ -24,14 +24,14 @@
 #' ddiData <- data.frame(x = c(1, 2, 1, 2, 3), y = c(5, 0.2, 2, 3, 4))
 #'
 #' plotDDIRatio(data = ddiData, dataMapping = DDIRatioDataMapping$new(x = "x", y = "y"))
-#' 
+#'
 #' # Produce DDI Ratio plot with user-defined horizontal lines
 #' plotDDIRatio(
-#' data = ddiData,
-#' dataMapping = DDIRatioDataMapping$new(x = "x", y = "y"), 
-#' foldDistance = c(1, 10),
-#' deltaGuest = 1.25,
-#' residualsVsObserved = TRUE
+#'   data = ddiData,
+#'   dataMapping = DDIRatioDataMapping$new(x = "x", y = "y"),
+#'   foldDistance = c(1, 10),
+#'   deltaGuest = 1.25,
+#'   residualsVsObserved = TRUE
 #' )
 #'
 plotDDIRatio <- function(data,
@@ -53,13 +53,13 @@ plotDDIRatio <- function(data,
 
   dataMapping$residualsVsObserved <- residualsVsObserved %||% dataMapping$residualsVsObserved
   dataMapping$deltaGuest <- deltaGuest %||% dataMapping$deltaGuest
-  
+
   lineOrientation <- "diagonal"
   if (dataMapping$residualsVsObserved) {
     lineOrientation <- "ddiHorizontal"
   }
   # Include diagonal or horizontal lines depending on the plot type
-  if(!isEmpty(foldDistance)){
+  if (!isEmpty(foldDistance)) {
     dataMapping$lines <- getLinesFromFoldDistance(foldDistance)
   }
   for (lineIndex in seq_along(dataMapping$lines)) {

R/plot-obs-vs-pred.R

@@ -33,14 +33,15 @@
 #'
 #' # Produce Obs vs Pred plot with user-defined fold distance lines
 #' plotObsVsPred(
-#' data = obsVsPredData,
-#' dataMapping = ObsVsPredDataMapping$new(x = "x", y = "y"), 
-#' plotConfiguration = ObsVsPredPlotConfiguration$new(
-#' xScale = Scaling$log, xLimits = c(0.05, 50),
-#' yScale = Scaling$log, yLimits = c(0.05, 50)),
-#' foldDistance = c(1, 10)
+#'   data = obsVsPredData,
+#'   dataMapping = ObsVsPredDataMapping$new(x = "x", y = "y"),
+#'   plotConfiguration = ObsVsPredPlotConfiguration$new(
+#'     xScale = Scaling$log, xLimits = c(0.05, 50),
+#'     yScale = Scaling$log, yLimits = c(0.05, 50)
+#'   ),
+#'   foldDistance = c(1, 10)
 #' )
-#' 
+#'
 plotObsVsPred <- function(data,
                           metaData = NULL,
                           dataMapping = NULL,
@@ -58,7 +59,7 @@ plotObsVsPred <- function(data,
   plotObject <- plotObject %||% initializePlot(plotConfiguration)
 
   # Add diagonal lines with offset defined in lines of dataMapping
-  if(!isEmpty(foldDistance)){
+  if (!isEmpty(foldDistance)) {
     dataMapping$lines <- getLinesFromFoldDistance(foldDistance)
   }
   for (lineIndex in seq_along(dataMapping$lines)) {

R/plot-pkratio.R

@@ -21,12 +21,12 @@
 #' pkData <- data.frame(x = c(1, 2, 1, 2, 3), y = c(5, 0.2, 2, 3, 4))
 #'
 #' plotPKRatio(data = pkData, dataMapping = PKRatioDataMapping$new(x = "x", y = "y"))
-#' 
+#'
 #' # Produce PK Ratio plot with user-defined horizontal lines
 #' plotPKRatio(
-#' data = pkData,
-#' dataMapping = PKRatioDataMapping$new(x = "x", y = "y"), 
-#' foldDistance = c(1, 10)
+#'   data = pkData,
+#'   dataMapping = PKRatioDataMapping$new(x = "x", y = "y"),
+#'   foldDistance = c(1, 10)
 #' )
 #'
 plotPKRatio <- function(data,
@@ -41,9 +41,9 @@ plotPKRatio <- function(data,
   mapLabels <- getAesStringMapping(dataMapping)
 
   plotObject <- plotObject %||% initializePlot(plotConfiguration)
-  
+
   # Include horizontal lines
-  if(!isEmpty(foldDistance)){
+  if (!isEmpty(foldDistance)) {
     dataMapping$lines <- getLinesFromFoldDistance(foldDistance)
   }
   for (lineIndex in seq_along(dataMapping$lines)) {

R/plot-res-vs-pred.R

@@ -3,9 +3,9 @@
 #' Producing residuals vs predicted plots
 #'
 #' @inheritParams plotObsVsPred
-#' @param dataMapping 
+#' @param dataMapping
 #' A `ResVsPredDataMapping` object mapping `x`, `y` and aesthetic groups to their variable names of `data`.
-#' @param plotConfiguration 
+#' @param plotConfiguration
 #' An optional `ResVsPredConfiguration` object defining labels, grid, background and watermark.
 #' @return A `ggplot` object
 #'
@@ -94,24 +94,24 @@ plotResVsPred <- function(data,
 #' Producing residuals vs time plots
 #'
 #' @inheritParams plotObsVsPred
-#' @param dataMapping 
+#' @param dataMapping
 #' A `ResVsTimeDataMapping` object mapping `x`, `y` and aesthetic groups to their variable names of `data`.
-#' @param plotConfiguration 
+#' @param plotConfiguration
 #' An optional `ResVsTimeConfiguration` object defining labels, grid, background and watermark.
 #' @return A `ggplot` object
 #'
 #' @export
 #' @family molecule plots
-#' @examples 
+#' @examples
 #' # Produce Obs vs Pred plot
 #' resVsTimeData <- data.frame(x = c(1, 2, 1, 2, 3), y = c(5, 0.2, 2, 3, 4))
-#' 
+#'
 #' plotResVsTime(data = resVsTimeData, dataMapping = ResVsTimeDataMapping$new(x = "x", y = "y"))
-#' 
+#'
 #' # Produce Res vs Time plot with linear regression
 #' plotResVsTime(
-#' data = resVsTimeData, 
-#' dataMapping = ResVsTimeDataMapping$new(x = "x", y = "y"),
-#' smoother = "lm"
+#'   data = resVsTimeData,
+#'   dataMapping = ResVsTimeDataMapping$new(x = "x", y = "y"),
+#'   smoother = "lm"
 #' )
 plotResVsTime <- plotResVsPred

R/plotconfiguration-axis.R

@@ -38,6 +38,35 @@ createPlotTicks <- function(ticks) {
   return(ticks)
 }
 
+#' @title createPlotTickLabels
+#' @description Translate ticks and ticklabels into a value directly usable by `ggplot2`
+#' to give more flexibilty in the next functions
+#' @param ticklabels character, numeric or function defining the ticks
+#' @return name of the `ggplot2` scale
+#' @keywords internal
+createPlotTickLabels <- function(ticklabels) {
+  if (isEmpty(ticklabels)) {
+    return(waiver())
+  }
+  if (isOfType(ticklabels, c("numeric", "function", "expression"))) {
+    return(ticklabels)
+  }
+  if (isIncluded(ticklabels, TickLabelTransforms)) {
+    transformedLabels <- switch(ticklabels,
+      "default" = waiver(),
+      "none" = NULL,
+      "identity" = identity,
+      "log" = getLogTickLabels,
+      "ln" = getLnTickLabels,
+      "sqrt" = getSqrtTickLabels,
+      "greek" = getGreekTickLabels,
+      "pi" = getPiTickLabels
+    )
+    return(transformedLabels)
+  }
+  return(ticklabels)
+}
+
 #' @title AxisConfiguration
 #' @description  R6 class defining the configuration of axis
 #' @export
@@ -69,7 +98,7 @@ AxisConfiguration <- R6::R6Class(
       scale <- scale %||% Scaling$lin
       private$.scale <- createPlotScale(scale)
       private$.ticks <- createPlotTicks(ticks)
-      private$.ticklabels <- createPlotTicks(ticklabels)
+      private$.ticklabels <- createPlotTickLabels(ticklabels)
       private$.expand <- expand
 
       # Default axis font will use theme
@@ -176,7 +205,7 @@ AxisConfiguration <- R6::R6Class(
       if (missing(value)) {
         return(private$.ticklabels)
       }
-      private$.ticklabels <- createPlotTicks(value)
+      private$.ticklabels <- createPlotTickLabels(value)
       return(invisible())
     },
     #' @field font `Font` object defining the font of the ticklabels

R/utilities-axis.R

@@ -142,3 +142,76 @@ getSqrtTickLabels <- function(ticks) {
   sqrtValues <- ticks^2
   return(parse(text = paste("sqrt(", sqrtValues, ")", sep = "")))
 }
+
+#' @title getGreekTickLabels
+#' @description Get ticklabels expressions for discrete scale plots with greek letters
+#' @param ticks numeric values of the ticks
+#' @return Expressions to use in `ticklabels` input parameter of `setXAxis` and `setYAxis` functions
+#' @examples
+#' ticks <- c(1, 5, 10, 50, 100, 500)
+#' getGreekTickLabels(ticks)
+#' @export
+getGreekTickLabels <- function(ticks) {
+  # alpha starts at converted integer 945
+  if (is.numeric(ticks)) {
+    return(sapply(ticks, function(tick) {
+      intToUtf8(tick + 944)
+    }))
+  }
+  tickLabels <- sapply(1:length(ticks), function(tick) {
+    intToUtf8(tick + 944)
+  })
+  return(tickLabels)
+}
+
+#' @title getPiTickLabels
+#' @description Get ticklabels expressions for plots with values as ratios of Pi
+#' @param ticks numeric values of the ticks
+#' @return Expressions to use in `ticklabels` input parameter of `setXAxis` and `setYAxis` functions
+#' @examples
+#' ticks <- seq(0, 2 * pi, pi / 2)
+#' getPiTickLabels(ticks)
+#' @export
+getPiTickLabels <- function(ticks) {
+  # Get fractions of pi from ticks
+  roundPi <- as.character(ticks %/% pi)
+  # Remove 1 and -1 from expression
+  roundPi[roundPi == "1"] <- ""
+  roundPi[roundPi == "-1"] <- "-"
+  # Flag when 0 to remove pi from label
+  roundPi[roundPi == "0"] <- "x"
+
+  roundPi <- paste(roundPi, "\u03C0", sep = "")
+  roundPi[grepl("x", roundPi)] <- ""
+
+  # Round to 3 digits to get fraction values
+  # If fraction is recognized, used fraction format
+  decPi <- round((ticks %% pi) / pi, 3)
+  decPi <- sapply(decPi, function(piFraction) {
+    if (piFraction == 0) {
+      return("")
+    }
+    if (piFraction == 0.167) {
+      return(" + \u03C0/6")
+    }
+    if (piFraction == 0.25) {
+      return(" + \u03C0/4")
+    }
+    if (piFraction == 0.333) {
+      return(" + \u03C0/3")
+    }
+    if (piFraction == 0.5) {
+      return(" + \u03C0/2")
+    }
+    if (piFraction == 0.667) {
+      return(" + 2\u03C0/3")
+    }
+    if (piFraction == 0.833) {
+      return(" + 5\u03C0/6")
+    }
+    return(paste0("+", piFraction, "\u03C0"))
+  })
+  piLabels <- paste(roundPi, decPi, sep = "")
+  piLabels[piLabels == ""] <- "0"
+  return(piLabels)
+}

R/utilities-enums.R

@@ -320,3 +320,11 @@ ExportUnits <- enum(c("cm", "in", "mm", "px"))
 #' List of all available formats to export a ggplot object
 #' @family enum helpers
 ExportFormats <- enum(c("png", "pdf", "eps", "ps", "tex", "jpeg", "tiff", "bmp", "svg", "wmf"))
+
+#' @title TickLabelTransforms
+#' @import ospsuite.utils
+#' @export
+#' @description
+#' List of all available tick label transformation names
+#' @family enum helpers
+TickLabelTransforms <- enum(c("none", "default", "identity", "log", "ln", "sqrt", "greek", "pi"))