Fixes Open-Systems-Pharmacology#245 allow transparency for lines and …

…points
pchelle · Apr 29, 2022 · 0afa615 · 0afa615
1 parent 7602df3
commit 0afa615
Show file tree

Hide file tree

Showing 3 changed files with 25 additions and 10 deletions.
diff --git a/R/atom-plots.R b/R/atom-plots.R
@@ -157,12 +157,14 @@ addScatter <- function(data = NULL,
     ggplot2::geom_point(
       data = mapData,
       mapping = ggplot2::aes_string(x = mapLabels$x, y = mapLabels$y, shape = "legendLabels", color = "legendLabels", size = "legendLabels"),
+      alpha = getAestheticValues(n = 1, selectionKey = plotConfiguration$points$alpha, aesthetic = "alpha"),
       show.legend = TRUE,
       na.rm = TRUE
     ) +
     ggplot2::geom_path(
       data = mapData,
       mapping = ggplot2::aes_string(x = mapLabels$x, y = mapLabels$y, linetype = "legendLabels", color = "legendLabels", size = "legendLabels"),
+      alpha = getAestheticValues(n = 1, selectionKey = plotConfiguration$points$alpha, aesthetic = "alpha"),
       show.legend = TRUE,
       na.rm = TRUE
     ) +
@@ -249,9 +251,8 @@ addLine <- function(data = NULL,
   validateIsOfType(plotConfiguration, PlotConfiguration, nullAllowed = TRUE)
 
   # If data is not input,  creates new data and its mapping from x and y input
-  if (isOfLength(data, 0)) {
+  if (isEmpty(data)) {
     data <- as.data.frame(cbind(x = x, y = y))
-
     dataMapping <- dataMapping %||% XYGDataMapping$new(x = ifNotNull(x, "x"), y = ifNotNull(y, "y"), data = data)
   }
 
@@ -269,7 +270,7 @@ addLine <- function(data = NULL,
   plotObject <- plotObject %||% initializePlot(plotConfiguration)
 
   # If no mapping, return plot
-  if (all(isOfLength(dataMapping$x, 0), isOfLength(dataMapping$y, 0))) {
+  if (all(isEmpty(dataMapping$x), isEmpty(dataMapping$y))) {
     warning("No mapping found for both x and y, line layer was not added")
     return(plotObject)
   }
@@ -286,11 +287,12 @@ addLine <- function(data = NULL,
   # y-intercept
   # geom_blank is used to fill the missing aes properties
   # This prevents messing up the legend
-  if (isOfLength(dataMapping$x, 0) && !isOfLength(dataMapping$y, 0)) {
+  if (isEmpty(dataMapping$x) && !isEmpty(dataMapping$y)) {
     plotObject <- plotObject +
       ggplot2::geom_hline(
         data = mapData,
         mapping = ggplot2::aes_string(yintercept = mapLabels$y, linetype = "legendLabels", color = "legendLabels", size = "legendLabels"),
+        alpha = getAestheticValues(n = 1, selectionKey = plotConfiguration$lines$alpha, aesthetic = "alpha"),
         show.legend = TRUE
       ) +
       ggplot2::geom_blank(
@@ -299,16 +301,17 @@ addLine <- function(data = NULL,
           shape = "legendLabels",
           fill = "legendLabels"
         ),
-        show.legend = TRUE
+        show.legend = NA
       )
   }
 
   # x-intercept
-  if (isOfLength(dataMapping$y, 0) && !isOfLength(dataMapping$x, 0)) {
+  if (isEmpty(dataMapping$y) && !isEmpty(dataMapping$x)) {
     plotObject <- plotObject +
       ggplot2::geom_vline(
         data = mapData,
         mapping = ggplot2::aes_string(xintercept = mapLabels$x, linetype = "legendLabels", color = "legendLabels", size = "legendLabels"),
+        alpha = getAestheticValues(n = 1, selectionKey = plotConfiguration$lines$alpha, aesthetic = "alpha"),
         show.legend = TRUE
       ) +
       ggplot2::geom_blank(
@@ -317,24 +320,26 @@ addLine <- function(data = NULL,
           shape = "legendLabels",
           fill = "legendLabels"
         ),
-        show.legend = TRUE
+        show.legend = NA
       )
   }
 
   # Case of a line defined by x and y
   # geom_path is used instead of geom_line,
   # consequently values are connected by their order of appearance and not according to x values
-  if (all(!isOfLength(dataMapping$x, 0), !isOfLength(dataMapping$y, 0))) {
+  if (all(!isEmpty(dataMapping$x), !isEmpty(dataMapping$y))) {
     plotObject <- plotObject +
       ggplot2::geom_point(
         data = mapData,
         mapping = ggplot2::aes_string(x = mapLabels$x, y = mapLabels$y, shape = "legendLabels", color = "legendLabels", size = "legendLabels"),
+        alpha = getAestheticValues(n = 1, selectionKey = plotConfiguration$lines$alpha, aesthetic = "alpha"),
         show.legend = TRUE,
         na.rm = TRUE
       ) +
       ggplot2::geom_path(
         data = mapData,
         mapping = ggplot2::aes_string(x = mapLabels$x, y = mapLabels$y, linetype = "legendLabels", color = "legendLabels", size = "legendLabels"),
+        alpha = getAestheticValues(n = 1, selectionKey = plotConfiguration$lines$alpha, aesthetic = "alpha"),
         show.legend = TRUE,
         na.rm = TRUE
       ) +
@@ -561,7 +566,7 @@ addErrorbar <- function(data = NULL,
   # validateIsIncluded(barLinetype, Linetypes, nullAllowed = TRUE)
 
   # If data is not input, creates data and its mapping from x, ymin and ymax input
-  if (isOfLength(data, 0)) {
+  if (isEmpty(data)) {
     data <- as.data.frame(cbind(x = x, ymin = ymin %||% 0, ymax = ymax %||% 0))
     dataMapping <- dataMapping %||% RangeDataMapping$new(x = "x", ymin = "ymin", ymax = "ymax", data = data)
   }
@@ -579,7 +584,7 @@ addErrorbar <- function(data = NULL,
   plotObject <- plotObject %||% initializePlot(plotConfiguration)
 
   # If no mapping, return plot
-  if (all(isOfLength(dataMapping$x, 0), isOfLength(dataMapping$ymin, 0), isOfLength(dataMapping$ymax, 0))) {
+  if (all(isEmpty(dataMapping$x), isEmpty(dataMapping$ymin), isEmpty(dataMapping$ymax))) {
     warning("No mapping found for x, ymin and ymax, error bar layer was not added")
     return(plotObject)
   }
@@ -609,6 +614,7 @@ addErrorbar <- function(data = NULL,
         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")
       )
   }
@@ -626,6 +632,7 @@ addErrorbar <- function(data = NULL,
         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")
       )
   }

diff --git a/R/plot-timeprofile.R b/R/plot-timeprofile.R
@@ -92,6 +92,7 @@ plotTimeProfile <- function(data = NULL,
             linetype = mapLabels$linetype
           ),
           size = getAestheticValues(n = 1, selectionKey = plotConfiguration$lines$size, position = 0, aesthetic = "size"),
+          alpha = getAestheticValues(n = 1, selectionKey = plotConfiguration$lines$alpha, position = 0, aesthetic = "alpha"),
           show.legend = TRUE
         )
     }
@@ -122,6 +123,7 @@ plotTimeProfile <- function(data = NULL,
         ),
         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_linerange(
@@ -134,6 +136,7 @@ plotTimeProfile <- function(data = NULL,
         ),
         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
       )
   }
@@ -147,6 +150,7 @@ plotTimeProfile <- function(data = NULL,
         shape = observedMapLabels$shape
       ),
       size = getAestheticValues(n = 1, selectionKey = plotConfiguration$points$size, position = 0, aesthetic = "size"),
+      alpha = getAestheticValues(n = 1, selectionKey = plotConfiguration$points$alpha, position = 0, aesthetic = "alpha"),
       show.legend = TRUE
     )
 

diff --git a/vignettes/atom-plots.Rmd b/vignettes/atom-plots.Rmd
@@ -281,6 +281,10 @@ addLine(
 )
 ```
 
+**Caution**: It is possible to define the transparency of the points and lines using `PlotConfiguration` objects using the field `alpha` in `lines` or `points`.
+Lines with transparency in legend may disappear when the plot is displayed within the viewport for older versions of RStudio (for more details, see https://github.com/tidyverse/ggplot2/issues/4351). However, this does not affect exported plots.
+
+
 ## `addRibbon`
 
 The function `addRibbon` returns a ribbon plot.