Fixes #333 set cap width of errorbars

NAMESPACE

@@ -142,6 +142,7 @@ export(setCaptionVisibility)
 export(setDefaultAggregationBins)
 export(setDefaultAggregationFunctions)
 export(setDefaultAggregationLabels)
+export(setDefaultErrorbarCapSize)
 export(setDefaultExportParameters)
 export(setDefaultLegendPosition)
 export(setDefaultLegendTitle)

R/aaa-utilities.R

@@ -149,7 +149,8 @@
 }
 
 #' @title .parseAddUncertaintyLayer
-#' @description Create an expression that adds errorbars if uncertainty is included in dataMapping
+#' @description Create an expression that adds errorbars
+#' `mapLabels` needs to be obtained from `DataMapping` objects
 #' @return An expression to `eval()`
 #' @keywords internal
 .parseAddUncertaintyLayer <- function(direction = "vertical") {
@@ -165,7 +166,8 @@
       "vertical" = "x = mapLabels$x, ymin = mapLabels$ymin, ymax = mapLabels$y,",
       "horizontal" = "y = mapLabels$y, xmin = mapLabels$xmin, xmax = mapLabels$x,"
     ),
-    "color = mapLabels$color",
+    "color = mapLabels$color,",
+    "group = mapLabels$color",
     "),",
     'size = .getAestheticValues(n = 1, selectionKey = plotConfiguration$errorbars$size, position = 0, aesthetic = "size"),',
     'linetype = .getAestheticValues(n = 1, selectionKey = plotConfiguration$errorbars$linetype, aesthetic = "linetype"),',
@@ -180,13 +182,48 @@
       "vertical" = "x = mapLabels$x, ymin = mapLabels$y, ymax = mapLabels$ymax,",
       "horizontal" = "y = mapLabels$y, xmin = mapLabels$x, xmax = mapLabels$xmax,"
     ),
-    "color = mapLabels$color",
+    "color = mapLabels$color,",
+    "group = 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",
+    ") + ",
+    # Add lower cap to error bar
+    "ggplot2::geom_point(",
+    "data = mapData,",
+    "mapping = aes_string(",
+    switch(direction,
+           "vertical" = "x = mapLabels$x, y = mapLabels$ymin,",
+           "horizontal" = "y = mapLabels$y, x = mapLabels$xmin,"
+    ),
+    "color = mapLabels$color,",
+    "group = mapLabels$color",
+    "),",
+    'size = tlfEnv$defaultErrorbarCapSize,',
+    'shape = ', switch(direction, "vertical" = '"_"', "horizontal" = '"|"'), ',',
+    'alpha = .getAestheticValues(n = 1, selectionKey = plotConfiguration$errorbars$alpha, aesthetic = "alpha"),',
+    "na.rm = TRUE,",
+    "show.legend = FALSE",
+    ") + ",
+    # Add upper cap to error bar
+    "ggplot2::geom_point(",
+    "data = mapData,",
+    "mapping = aes_string(",
+    switch(direction,
+           "vertical" = "x = mapLabels$x, y = mapLabels$ymax,",
+           "horizontal" = "y = mapLabels$y, x = mapLabels$xmax,"
+    ),
+    "color = mapLabels$color,",
+    "group = mapLabels$color",
+    "),",
+    'size = tlfEnv$defaultErrorbarCapSize,',
+    'shape = ', switch(direction, "vertical" = '"_"', "horizontal" = '"|"'), ',', 
+    'alpha = .getAestheticValues(n = 1, selectionKey = plotConfiguration$errorbars$alpha, aesthetic = "alpha"),',
+    "na.rm = TRUE,",
+    "show.legend = FALSE",
     ")"
   ))
 }

R/atom-plots.R

@@ -505,7 +505,9 @@ addRibbon <- function(data = NULL,
 #'
 #' @inheritParams addRibbon
 #' @inheritParams addScatter
-#' @param includeCap Logical defining if errorbars include caps at their ends.
+#' @param capSize Numeric extent of the error bars caps
+#' Caution the value corresponds to the ratio of the mean spacing between plotted error bars.
+#' For instance, an `extent` of `1` will fill the caps until the next error bar
 #' @return A `ggplot` object
 #' @references For examples, see:
 #' <https://www.open-systems-pharmacology.org/TLF-Library/articles/atom-plots.html>
@@ -536,12 +538,12 @@ addRibbon <- function(data = NULL,
 #' addErrorbar(data = errorbarData, caption = "My errorbar plot")
 #'
 #' # Add a errorbar with specific properties
-#' addErrorbar(data = errorbarData, color = "blue", size = 0.5, includeCap = TRUE, caption = "My data")
+#' addErrorbar(data = errorbarData, color = "blue", size = 0.5, caption = "My data")
 #'
 #' # Add a errorbar with specific properties
 #' p <- addErrorbar(
 #'   data = errorbarData,
-#'   color = "blue", size = 0.5, includeCap = TRUE, caption = "My data"
+#'   color = "blue", size = 0.5, caption = "My data"
 #' )
 #' addScatter(
 #'   x = time, y = cos(time),
@@ -558,15 +560,13 @@ addErrorbar <- function(data = NULL,
                         color = NULL,
                         size = NULL,
                         linetype = NULL,
-                        includeCap = FALSE,
+                        capSize = NULL,
                         dataMapping = NULL,
                         plotConfiguration = NULL,
                         plotObject = NULL) {
   validateIsOfType(dataMapping, c("RangeDataMapping", "ObservedDataMapping"), nullAllowed = TRUE)
   validateIsOfType(plotConfiguration, PlotConfiguration, nullAllowed = TRUE)
-  validateIsLogical(includeCap)
-  # validateIsIncluded(barLinetype, Linetypes, nullAllowed = TRUE)
-
+
   # If data is not input, creates data and its mapping from x, ymin and ymax input
   if (isEmpty(data)) {
     data <- as.data.frame(cbind(x = x, ymin = ymin %||% 0, ymax = ymax %||% 0))
@@ -600,44 +600,57 @@ addErrorbar <- function(data = NULL,
   }
   mapData$legendLabels <- caption %||% mapData$legendLabels
   legendLength <- length(unique(mapData$legendLabels))
-
-  # Option caps allows to add an horizontal bar at the edges of the error bars
-  if (includeCap) {
-    plotObject <- plotObject +
-      ggplot2::geom_errorbar(
-        data = mapData,
-        mapping = ggplot2::aes_string(
-          x = mapLabels$x,
-          ymin = mapLabels$ymin,
-          ymax = mapLabels$ymax,
-          group = "legendLabels"
-        ),
-        na.rm = TRUE,
-        show.legend = FALSE,
-        size = size %||% .getAestheticValues(n = 1, selectionKey = plotConfiguration$errorbars$size, aesthetic = "size"),
-        linetype = linetype %||% .getAestheticValues(n = 1, selectionKey = plotConfiguration$errorbars$linetype, aesthetic = "linetype"),
-        alpha = .getAestheticValues(n = 1, selectionKey = plotConfiguration$errorbars$alpha, aesthetic = "alpha"),
-        color = color %||% .getAestheticValues(n = 1, selectionKey = plotConfiguration$errorbars$color, aesthetic = "color")
-      )
-  }
-  if (!includeCap) {
-    plotObject <- plotObject +
-      ggplot2::geom_linerange(
-        data = mapData,
-        mapping = ggplot2::aes_string(
-          x = mapLabels$x,
-          ymin = mapLabels$ymin,
-          ymax = mapLabels$ymax,
-          group = "legendLabels"
+
+  eval(.parseVariableToObject("plotObject$plotConfiguration$errorbars", c("color", "size", "linetype"), keepIfNull = TRUE))
+
+  plotObject <- plotObject +
+    ggplot2::geom_linerange(
+      data = mapData,
+      mapping = aes_string(
+        x = mapLabels$x, 
+        ymin = mapLabels$ymin, 
+        ymax = mapLabels$ymax,
+        color = mapLabels$color,
+        group = mapLabels$color
         ),
-        na.rm = TRUE,
-        show.legend = FALSE,
-        size = size %||% .getAestheticValues(n = 1, selectionKey = plotConfiguration$errorbars$size, aesthetic = "size"),
-        linetype = linetype %||% .getAestheticValues(n = 1, selectionKey = plotConfiguration$errorbars$linetype, aesthetic = "linetype"),
-        alpha = .getAestheticValues(n = 1, selectionKey = plotConfiguration$errorbars$alpha, aesthetic = "alpha"),
-        color = color %||% .getAestheticValues(n = 1, selectionKey = plotConfiguration$errorbars$color, aesthetic = "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"),
+      color = .getAestheticValues(n = 1, selectionKey = plotConfiguration$errorbars$color, aesthetic = "color"),
+      na.rm = TRUE,
+      show.legend = FALSE
+      ) + 
+    ggplot2::geom_point(
+      data = mapData,
+      mapping = aes_string(
+        x = mapLabels$x, 
+        y = mapLabels$ymin, 
+        color = mapLabels$color,
+        group = mapLabels$color
+      ),
+      size = capSize %||% tlfEnv$defaultErrorbarCapSize,
+      shape = "_",
+      alpha = .getAestheticValues(n = 1, selectionKey = plotConfiguration$errorbars$alpha, aesthetic = "alpha"),
+      color = .getAestheticValues(n = 1, selectionKey = plotConfiguration$errorbars$color, aesthetic = "color"),
+      na.rm = TRUE,
+      show.legend = FALSE
+    ) + 
+    ggplot2::geom_point(
+      data = mapData,
+      mapping = aes_string(
+        x = mapLabels$x, 
+        y = mapLabels$ymax,
+        color = mapLabels$color,
+        group = mapLabels$color
+      ),
+      size = capSize %||% tlfEnv$defaultErrorbarCapSize,
+      shape = "_",
+      alpha = .getAestheticValues(n = 1, selectionKey = plotConfiguration$errorbars$alpha, aesthetic = "alpha"),
+      color = .getAestheticValues(n = 1, selectionKey = plotConfiguration$errorbars$color, aesthetic = "color"),
+      na.rm = TRUE,
+      show.legend = FALSE
+    )
+
   # Try is used to prevent crashes in the final plot due to ggplot2 peculiarities regarding scale functions
   eval(.parseUpdateAxes())
   return(plotObject)

R/plot-timeprofile.R

@@ -150,7 +150,8 @@ plotTimeProfile <- function(data = NULL,
           x = observedMapLabels$x,
           ymin = observedMapLabels$ymin,
           ymax = observedMapLabels$y,
-          color = observedMapLabels$color
+          color = observedMapLabels$color,
+          group = observedMapLabels$color
         ),
         size = .getAestheticValues(n = 1, selectionKey = plotConfiguration$errorbars$size, position = 0, aesthetic = "size"),
         linetype = .getAestheticValues(n = 1, selectionKey = plotConfiguration$errorbars$linetype, position = 0, aesthetic = "linetype"),
@@ -163,12 +164,39 @@ plotTimeProfile <- function(data = NULL,
           x = observedMapLabels$x,
           ymin = observedMapLabels$y,
           ymax = observedMapLabels$ymax,
-          color = observedMapLabels$color
+          color = observedMapLabels$color,
+          group = observedMapLabels$color
         ),
         size = .getAestheticValues(n = 1, selectionKey = plotConfiguration$errorbars$size, position = 0, aesthetic = "size"),
         linetype = .getAestheticValues(n = 1, selectionKey = plotConfiguration$errorbars$linetype, position = 0, aesthetic = "linetype"),
         alpha = .getAestheticValues(n = 1, selectionKey = plotConfiguration$errorbars$alpha, position = 0, aesthetic = "alpha"),
         show.legend = FALSE
+      ) + 
+      ggplot2::geom_point(
+        data = mapObservedData,
+        mapping = ggplot2::aes_string(
+          x = observedMapLabels$x,
+          y = observedMapLabels$ymin,
+          color = observedMapLabels$color,
+          group = observedMapLabels$color
+        ),
+        size = tlfEnv$defaultErrorbarCapSize,
+        shape = "_",
+        alpha = .getAestheticValues(n = 1, selectionKey = plotConfiguration$errorbars$alpha, position = 0, aesthetic = "alpha"),
+        show.legend = FALSE
+      ) +
+      ggplot2::geom_point(
+        data = mapObservedData,
+        mapping = ggplot2::aes_string(
+          x = observedMapLabels$x,
+          y = observedMapLabels$ymax,
+          color = observedMapLabels$color,
+          group = observedMapLabels$color
+        ),
+        size = tlfEnv$defaultErrorbarCapSize,
+        shape = "_",
+        alpha = .getAestheticValues(n = 1, selectionKey = plotConfiguration$errorbars$alpha, position = 0, aesthetic = "alpha"),
+        show.legend = FALSE
       )
   }
   plotObject <- plotObject +

R/tlf-env.R

@@ -177,3 +177,16 @@ setDefaultLogTicks <- function(ticks) {
   tlfEnv$logTicks <- ticks
   return(invisible())
 }
+
+# No cap displayed in the default settings
+tlfEnv$defaultErrorbarCapSize <- 0
+
+#' @title setDefaultErrorbarCapSize
+#' @description Set default cap size of error bars
+#' @param size A numeric defining the size of the error bar caps in pts
+#' @export
+setDefaultErrorbarCapSize <- function(size) {
+  validateIsNumeric(size)
+  tlfEnv$defaultErrorbarCapSize <- size
+  return(invisible())
+}

vignettes/atom-plots.Rmd

@@ -344,7 +344,7 @@ addErrorbar(
 )
 ```
 
-Among its optional inputs, `addErrorbar` proposes `includeCap` a logical that defines if caps are included at the extremities of the error bars.
+Among its optional inputs, `addErrorbar` proposes `capSize` a numeric that defines the size of the extremities of the error bars (caps).
 
 ```{r addErrorbar optional inputs}
 addErrorbar(
@@ -353,7 +353,7 @@ addErrorbar(
   ymax = cosData$cos,
   color = "firebrick",
   linetype = Linetypes$solid,
-  includeCap = TRUE,
+  capSize = 5,
   size = 0.5,
   caption = "error bar plot"
 )