224 time profile mapping (#229)

* Fixes #224 plotTimeProfile and its mapping are more versatile

Now simulated and observed data can be plotted both independently or synchronized (as illustrated by vignette) with correct legend for both
I also removed lloq from ObservedDataMapping that was making things complicated

* Remove ggplot2 messages when aesthetic scales are updated

* Export function to update time profile plot legend easily

* Prevent time profile errors

This code was a fix committed in PR #228 that may lead to a merge conflict

NAMESPACE

@@ -146,6 +146,7 @@ export(setXGrid)
 export(setYAxis)
 export(setYGrid)
 export(tlfStatFunctions)
+export(updateTimeProfileLegend)
 export(useDarkTheme)
 export(useExcelTheme)
 export(useHighChartTheme)

R/aaa-utilities.R

@@ -87,10 +87,10 @@ parseUpdateAestheticProperty <- function(aestheticProperty, plotConfigurationPro
     parse(text = paste0(aestheticProperty, "Length <- length(unique(mapData[, ", aestheticProperty, "Variable]))")),
     # Update the property using ggplot `scale` functions
     parse(text = paste0(
-      "plotObject <- plotObject + ggplot2::scale_", aestheticProperty, "_manual(",
+      "suppressMessages(plotObject <- plotObject + ggplot2::scale_", aestheticProperty, "_manual(",
       "values=getAestheticValues(n=", aestheticProperty, "Length,",
       "selectionKey=plotConfiguration$", plotConfigurationProperty, "$", aestheticProperty,
-      ',aesthetic = "', aestheticProperty, '"))'
+      ',aesthetic = "', aestheticProperty, '")))'
     )),
     # remove the legend of aesthetic if default unmapped aesthetic
     parse(text = paste0("if(isIncluded(", aestheticProperty, 'Variable, "legendLabels")){plotObject <- plotObject + ggplot2::guides(', aestheticProperty, " = 'none')}"))

R/datamapping-range.R

@@ -21,6 +21,7 @@ RangeDataMapping <- R6::R6Class(
     #' @param linetype R6 class `Grouping` object or its input
     #' @param shape R6 class `Grouping` object or its input
     #' @param size R6 class `Grouping` object or its input
+    #' @param group R6 class `Grouping` object or its input
     #' @param data data.frame to map used by `smartMapping`
     #' @return A new `RangeDataMapping` object
     initialize = function(x = NULL,
@@ -32,14 +33,15 @@ RangeDataMapping <- R6::R6Class(
                           linetype = NULL,
                           shape = NULL,
                           size = NULL,
+                          group = NULL,
                           data = NULL) {
 
       # smartMapping is available in utilities-mapping.R
       smartMap <- smartMapping(data)
       super$initialize(x %||% smartMap$x,
         y = NULL,
         groupMapping = groupMapping, color = color, fill = fill,
-        linetype = linetype, shape = shape, size = size
+        linetype = linetype, shape = shape, size = size, group = group
       )
 
       self$ymin <- ymin %||% smartMap$ymin

R/datamapping-xygroup.R

@@ -18,6 +18,7 @@ XYGDataMapping <- R6::R6Class(
     #' @param linetype R6 class `Grouping` object or its input
     #' @param shape R6 class `Grouping` object or its input
     #' @param size R6 class `Grouping` object or its input
+    #' @param group R6 class `Grouping` object or its input
     #' @param data data.frame to map used by `smartMapping`
     #' @return A new `XYGDataMapping` object
     initialize = function(x = NULL,
@@ -28,6 +29,7 @@ XYGDataMapping <- R6::R6Class(
                           linetype = NULL,
                           shape = NULL,
                           size = NULL,
+                          group = NULL,
                           data = NULL) {
 
       # smartMapping is available in utilities-mapping.R
@@ -39,15 +41,16 @@ XYGDataMapping <- R6::R6Class(
         "fill" = fill,
         "linetype" = linetype,
         "shape" = shape,
-        "size" = size
+        "size" = size,
+        "group" = group
       ))
       # To simplify the process workflow, groupMapping inputs color, fill... can be used directly instead of groupMapping
       self$groupMapping <- groupMapping %||% GroupMapping$new(
-        color %||% smartMap$color,
-        fill %||% smartMap$fill,
-        linetype %||% smartMap$linetype,
-        shape %||% smartMap$shape,
-        size %||% smartMap$size
+        color %||% group %||% smartMap$color,
+        fill %||% group %||% smartMap$fill,
+        linetype %||% group %||% smartMap$linetype,
+        shape %||% group %||% smartMap$shape,
+        size %||% group %||% smartMap$size
       )
     },
 

R/observed-data-mapping.R

@@ -6,8 +6,6 @@ ObservedDataMapping <- R6::R6Class(
   "ObservedDataMapping",
   inherit = XYGDataMapping,
   public = list(
-    #' @field lloq mapping lower limit of quantitation variable
-    lloq = NULL,
     #' @field error mapping error bars around scatter points
     error = NULL,
     #' @field mdv mapping missing dependent variable
@@ -21,8 +19,9 @@ ObservedDataMapping <- R6::R6Class(
     #' @param x Name of x variable to map
     #' @param y Name of y variable to map
     #' @param group R6 class `Grouping` object or its input
+    #' @param color R6 class `Grouping` object or its input
+    #' @param shape R6 class `Grouping` object or its input
     #' @param data data.frame to map used by `smartMapping`
-    #' @param lloq mapping lower limit of quantitation variable
     #' @param uncertainty mapping error bars around scatter points.
     #' Deprecated parameter replaced by `error`.
     #' @param error mapping error bars around scatter points
@@ -36,19 +35,18 @@ ObservedDataMapping <- R6::R6Class(
                           error = NULL,
                           ymin = NULL,
                           ymax = NULL,
-                          lloq = NULL,
                           mdv = NULL,
+                          color = NULL,
+                          shape = NULL,
                           group = NULL,
                           data = NULL){
-      validateIsString(lloq, nullAllowed = TRUE)
       validateIsString(uncertainty, nullAllowed = TRUE)
       validateIsString(error, nullAllowed = TRUE)
       validateIsString(ymin, nullAllowed = TRUE)
       validateIsString(ymax, nullAllowed = TRUE)
       validateIsString(mdv, nullAllowed = TRUE)
-      super$initialize(x = x, y = y, color = group, data = data)
+      super$initialize(x = x, y = y, color = color, shape = shape, group = group, data = data)
 
-      self$lloq <- lloq
       # If defined, ymin and ymax are used as is
       # If not, error/uncertainty are used and 
       # creates ymin and ymax as y +/- error
@@ -66,19 +64,14 @@ ObservedDataMapping <- R6::R6Class(
     checkMapData = function(data, metaData = NULL) {
       validateIsOfType(data, "data.frame")
       validateIsIncluded(self$error, names(data), nullAllowed = TRUE)
-      validateIsIncluded(self$lloq, names(data), nullAllowed = TRUE)
       validateIsIncluded(self$mdv, names(data), nullAllowed = TRUE)
 
       # Using super method, fetches x, y and groups
       mapData <- super$checkMapData(data, metaData)
-      # Add lloq data
-      if (!isOfLength(self$lloq, 0)) {
-        mapData[, self$lloq] <- data[, self$lloq]
-        mapData$lloq <- data[, self$lloq]
-      }
+
       # ymin and ymax for error bars
       # This section may change depending on how we want to include options
-      if (!isOfLength(self$error, 0)) {
+      if (!isEmpty(self$error)) {
         mapData[, self$error] <- data[, self$error]
         # Symetric error bars
         mapData[, self$ymax] <- data[, self$y] + data[, self$error]
@@ -92,7 +85,7 @@ ObservedDataMapping <- R6::R6Class(
         mapData[, self$ymin] <- data[,self$ymin]
       }
       # MDV is a Nonmem notation in which values with MDV==1 are removed
-      if (!isOfLength(self$mdv, 0)) {
+      if (!isEmpty(self$mdv)) {
         mapData[, self$mdv] <- as.logical(data[,self$mdv])
         mapData <- mapData[!mapData[, self$mdv], ]
       }