Fixes #327 horizontal bars for obs vs pred plots (#331)

- error is replaced in favor of ymin/ymax or xmin/xmax
- dataMapping initialize method needs to explicitly redefine `x` and `y` arguments because of R partial matching (if user inputs `x="a"`, partial matching would assign "a" to `xmin` instead of `x` because `xmin` was the only argument explicitly defined)

R/aaa-utilities.R

@@ -152,25 +152,43 @@
 #' @description Create an expression that adds errorbars if uncertainty is included in dataMapping
 #' @return An expression to `eval()`
 #' @keywords internal
-.parseAddUncertaintyLayer <- function() {
-  expression({
-    if (!isOfLength(dataMapping$uncertainty, 0)) {
-      plotObject <- plotObject +
-        ggplot2::geom_linerange(
-          data = mapData,
-          mapping = aes_string(
-            x = mapLabels$x,
-            ymin = "ymin",
-            ymax = "ymax",
-            color = mapLabels$color
-          ),
-          # Error bar size uses a ratio of 1/4 to match with point size
-          size = .getAestheticValues(n = 1, selectionKey = plotConfiguration$errorbars$size, position = 0, aesthetic = "size"),
-          linetype = .getAestheticValues(n = 1, selectionKey = plotConfiguration$errorbars$linetype, aesthetic = "linetype"),
-          alpha = .getAestheticValues(n = 1, selectionKey = plotConfiguration$errorbars$alpha, aesthetic = "alpha"),
-          na.rm = TRUE,
-          show.legend = TRUE
-        )
-    }
-  })
+.parseAddUncertaintyLayer <- function(direction = "vertical") {
+  parse(text = paste0(
+    "plotObject <- plotObject +",
+    # Plot error bars from xmin/ymin to x/y
+    # If lower value is negative and plot is log scaled,
+    # Upper bar will still be plotted
+    "ggplot2::geom_linerange(",
+    "data = mapData,",
+    "mapping = aes_string(",
+    switch(
+      direction,
+      "vertical" = "x = mapLabels$x, ymin = mapLabels$ymin, ymax = mapLabels$y,",
+      "horizontal" = "y = mapLabels$y, xmin = mapLabels$xmin, xmax = mapLabels$x,"
+      ),
+    "color = mapLabels$color",
+    "),",
+    'size = .getAestheticValues(n = 1, selectionKey = plotConfiguration$errorbars$size, position = 0, aesthetic = "size"),',
+    'linetype = .getAestheticValues(n = 1, selectionKey = plotConfiguration$errorbars$linetype, aesthetic = "linetype"),',
+    'alpha = .getAestheticValues(n = 1, selectionKey = plotConfiguration$errorbars$alpha, aesthetic = "alpha"),',
+    "na.rm = TRUE,",
+    "show.legend = FALSE",
+    ") + ",
+    "ggplot2::geom_linerange(",
+    "data = mapData,",
+    "mapping = aes_string(",
+    switch(
+      direction,
+      "vertical" = "x = mapLabels$x, ymin = mapLabels$y, ymax = mapLabels$ymax,",
+      "horizontal" = "y = mapLabels$y, xmin = mapLabels$x, xmax = mapLabels$xmax,"
+      ),
+    "color = mapLabels$color",
+    "),",
+    'size = .getAestheticValues(n = 1, selectionKey = plotConfiguration$errorbars$size, position = 0, aesthetic = "size"),',
+    'linetype = .getAestheticValues(n = 1, selectionKey = plotConfiguration$errorbars$linetype, aesthetic = "linetype"),',
+    'alpha = .getAestheticValues(n = 1, selectionKey = plotConfiguration$errorbars$alpha, aesthetic = "alpha"),',
+    "na.rm = TRUE,",
+    "show.legend = FALSE",
+    ")"
+  ))
 }

R/obs-vs-pred-datamapping.R

@@ -4,25 +4,59 @@
 #' @family DataMapping classes
 ObsVsPredDataMapping <- R6::R6Class(
   "ObsVsPredDataMapping",
-  inherit = PKRatioDataMapping,
+  inherit = XYGDataMapping,
   public = list(
+    #' @field lines list of ratio limits to plot as horizontal lines
+    lines = NULL,
+    #' @field xmin mapping of upper value of error bars around scatter points
+    xmin = NULL,
+    #' @field xmax mapping of lower value of error bars around scatter points
+    xmax = NULL,
     #' @field smoother regression function name
     smoother = NULL,
 
     #' @description Create a new `ObsVsPredDataMapping` object
+    #' @param x Name of x variable to map
+    #' @param y Name of y variable to map
+    #' @param xmin mapping of upper value of error bars around scatter points
+    #' @param xmax mapping of lower value of error bars around scatter points
     #' @param lines list of lines to plot
     #' @param smoother smoother function or parameter
     #' To map a loess smoother to the plot, use `smoother`="loess"
     #' @param ... parameters inherited from `XYGDataMapping`
     #' @return A new `ObsVsPredDataMapping` object
-    initialize = function(lines = DefaultDataMappingValues$obsVsPred,
+    initialize = function(x = NULL, 
+                          y = NULL,
+                          xmin = NULL,
+                          xmax = NULL,
+                          lines = DefaultDataMappingValues$obsVsPred,
                           smoother = NULL,
                           ...) {
       validateIsIncluded(smoother, c("lm", "loess"), nullAllowed = TRUE)
-
-      super$initialize(...)
+      validateIsString(xmin, nullAllowed = TRUE)
+      validateIsString(xmax, nullAllowed = TRUE)
+      super$initialize(x=x,y=y,...)
       self$lines <- lines
       self$smoother <- smoother
+      # If no xmin/xmax defined, map to x to get emtpy errorbars
+      self$xmin <- xmin %||% self$x
+      self$xmax <- xmax %||% self$x
+    },
+
+    #' @description Check that `data` variables include map variables
+    #' @param data data.frame to check
+    #' @param metaData list containing information on `data`
+    #' @return A data.frame with map and `defaultAes` variables.
+    #' Dummy variable `defaultAes` is necessary to allow further modification of plots.
+    checkMapData = function(data, metaData = NULL) {
+      validateIsOfType(data, "data.frame")
+      .validateMapping(self$xmin, data, nullAllowed = TRUE)
+      .validateMapping(self$xmax, data, nullAllowed = TRUE)
+      mapData <- super$checkMapData(data, metaData)
+      mapData[, self$xmin] <- data[, self$xmin]
+      mapData[, self$xmax] <- data[, self$xmax]
+      self$data <- mapData
+      return(mapData)
     }
   )
 )

R/pkratio-datamapping.R

@@ -8,25 +8,32 @@ PKRatioDataMapping <- R6::R6Class(
   public = list(
     #' @field lines list of ratio limits to plot as horizontal lines
     lines = NULL,
-    #' @field error mapping error bars around scatter points
-    error = NULL,
-
+    #' @field ymin mapping of upper value of error bars around scatter points
+    ymin = NULL,
+    #' @field ymax mapping of lower value of error bars around scatter points
+    ymax = NULL,
+
     #' @description Create a new `PKRatioDataMapping` object
+    #' @param x Name of x variable to map
+    #' @param y Name of y variable to map
+    #' @param ymin mapping of upper value of error bars around scatter points
+    #' @param ymax mapping of lower value of error bars around scatter points
     #' @param lines List of ratio limits to display as horizontal lines
-    #' @param uncertainty mapping error bars around scatter points.
-    #' Deprecated parameter replaced by `error`.
-    #' @param error mapping error bars around scatter points
     #' @param ... parameters inherited from `XYGDataMapping`
     #' @return A new `PKRatioDataMapping` object
-    initialize = function(lines = DefaultDataMappingValues$pkRatio,
-                          uncertainty = NULL,
-                          error = NULL,
+    initialize = function(x = NULL, 
+                          y = NULL, 
+                          ymin = NULL,
+                          ymax = NULL,
+                          lines = DefaultDataMappingValues$pkRatio,
                           ...) {
-      validateIsString(uncertainty, nullAllowed = TRUE)
-      super$initialize(...)
+      validateIsString(ymin, nullAllowed = TRUE)
+      validateIsString(ymax, nullAllowed = TRUE)
+      super$initialize(x=x,y=y,...)
       self$lines <- lines
-      # Keep uncertainty for compatibility
-      self$error <- error %||% uncertainty
+      # If no ymin/ymax defined, map to y to get emtpy errorbars
+      self$ymin <- ymin %||% self$y
+      self$ymax <- ymax %||% self$y
     },
 
     #' @description Check that `data` variables include map variables
@@ -36,13 +43,11 @@ PKRatioDataMapping <- R6::R6Class(
     #' Dummy variable `defaultAes` is necessary to allow further modification of plots.
     checkMapData = function(data, metaData = NULL) {
       validateIsOfType(data, "data.frame")
-      .validateMapping(self$error, data, nullAllowed = TRUE)
+      .validateMapping(self$ymin, data, nullAllowed = TRUE)
+      .validateMapping(self$ymax, data, nullAllowed = TRUE)
       mapData <- super$checkMapData(data, metaData)
-      # This may change depending of how we want to include options
-      if (!isOfLength(self$error, 0)) {
-        mapData$ymax <- data[, self$y] * (1 + data[, self$error])
-        mapData$ymin <- data[, self$y] * (1 - data[, self$error])
-      }
+      mapData[, self$ymin] <- data[, self$ymin]
+      mapData[, self$ymax] <- data[, self$ymax]
       self$data <- mapData
       return(mapData)
     }

R/plot-ddiratio.R

@@ -95,10 +95,8 @@ plotDDIRatio <- function(data,
       size = .getAestheticValues(n = 1, selectionKey = plotConfiguration$lines$size, position = lineIndex, aesthetic = "size")
     )
 
-  # If uncertainty is defined, add error bars
-  if (!isEmpty(dataMapping$error)) {
-    eval(.parseAddUncertaintyLayer())
-  }
+
+  eval(.parseAddUncertaintyLayer())
   eval(.parseAddScatterLayer())
   # Define shapes and colors based on plotConfiguration$points properties
   eval(.parseUpdateAestheticProperty(AestheticProperties$color, "points"))

R/plot-obs-vs-pred.R

@@ -104,10 +104,7 @@ plotObsVsPred <- function(data,
       )
   }
 
-  # If uncertainty is defined, add error bars
-  if (!isOfLength(dataMapping$uncertainty, 0)) {
-    eval(.parseAddUncertaintyLayer())
-  }
+  eval(.parseAddUncertaintyLayer(direction = "horizontal"))
   eval(.parseAddScatterLayer())
   # Define shapes and colors based on plotConfiguration$points properties
   eval(.parseUpdateAestheticProperty(AestheticProperties$color, "points"))

R/plot-pkratio.R

@@ -54,10 +54,7 @@ plotPKRatio <- function(data,
   }
 
   # If uncertainty is defined, add error bars
-  if (!isOfLength(dataMapping$uncertainty, 0)) {
-    eval(.parseAddUncertaintyLayer())
-  }
-
+  eval(.parseAddUncertaintyLayer())
   eval(.parseAddScatterLayer())
   # Define shapes and colors based on plotConfiguration$points properties
   eval(.parseUpdateAestheticProperty(AestheticProperties$color, "points"))

R/utilities-mapping.R

@@ -148,7 +148,7 @@ getDefaultCaptions <- function(data, metaData, variableList = colnames(data), se
 #' }
 .getAesStringMapping <- function(dataMapping) {
   # Define list of mappings to check
-  geomMappings <- c("x", "y", "ymin", "ymax", "lower", "middle", "upper")
+  geomMappings <- c("x", "y", "xmin", "xmax", "ymin", "ymax", "lower", "middle", "upper")
   groupMappings <- names(LegendTypes)
 
   # Initialize Labels