Fixes #350 default obs vs pred plot use same axes limits

DESCRIPTION

@@ -64,6 +64,7 @@ Collate:
     'error-checks.R'
     'font.R'
     'global-vars.R'
+    'helpers.R'
     'histogram-datamapping.R'
     'label.R'
     'messages.R'

NAMESPACE

@@ -112,7 +112,9 @@ export(getLnTickLabels)
 export(getLogTickLabels)
 export(getPKRatioMeasure)
 export(getPiTickLabels)
+export(getSameLimits)
 export(getSqrtTickLabels)
+export(getSymmetricLimits)
 export(initializePlot)
 export(loadThemeFromJson)
 export(plotBoxWhisker)

R/aaa-utilities.R

@@ -92,6 +92,7 @@
 
 #' @title .updateAxes
 #' @description Updates the plot axes
+#' @param plotObject A `ggplot` object
 #' @return A `ggplot` object
 #' @keywords internal
 .updateAxes <- function(plotObject) {
@@ -100,3 +101,44 @@
   try(suppressMessages(plotObject <- setYAxis(plotObject)))
   return(plotObject)
 }
+
+#' @title .updateSameAxes
+#' @description Updates plot configuration axes to get same limits
+#' @param plotObject A `ggplot` object
+#' @param data A data.frame
+#' @param dataMapping A `DataMapping` object
+#' @return A `ggplot` object
+#' @keywords internal
+.updateSameAxes <- function(plotObject, data, dataMapping) {
+  if(!all(
+    plotObject$plotConfiguration$defaultSymmetricAxes,
+    isEmpty(plotObject$plotConfiguration$xAxis$limits),
+    isEmpty(plotObject$plotConfiguration$yAxis$limits)
+  )){
+    return(plotObject)
+  }
+  limits <- .getSameLimitsFromMapping(data, dataMapping)
+  plotObject$plotConfiguration$xAxis$limits <- limits
+  plotObject$plotConfiguration$yAxis$limits <- limits
+  return(plotObject)
+}
+
+#' @title .updateSymmetricAxes
+#' @description Updates plot configuration axes to get symmetric limits
+#' @param plotObject A `ggplot` object
+#' @param data A data.frame
+#' @param dataMapping A `DataMapping` object
+#' @return A `ggplot` object
+#' @keywords internal
+.updateSymmetricAxes <- function(plotObject, data, dataMapping) {
+  if(!all(
+    plotObject$plotConfiguration$defaultSymmetricAxes,
+    isEmpty(plotObject$plotConfiguration$yAxis$limits)
+  )){
+    return(plotObject)
+  }
+  limits <- getSymmetricLimits(data[, dataMapping$y])
+  plotObject$plotConfiguration$yAxis$limits <- limits
+  return(plotObject)
+}
+

R/helpers.R

@@ -0,0 +1,39 @@
+#' @title getSymmetricLimits
+#' @description Get symmetric limits from a set of values
+#' @param values numeric values
+#' @return An array of 2 symmetric values equally distant from 0
+#' @export
+#' @examples 
+#' getSymmetricLimits(seq(-3, 8))
+#' 
+getSymmetricLimits <- function(values){
+  validateIsNumeric(values, nullAllowed = TRUE)
+  # Remove Inf and NA values
+  values <- values[!is.infinite(values)]
+  values <- values[!is.na(values)]
+  if(isEmpty(values)){
+    return(NULL)
+  }
+  return(c(-max(abs(values)), max(abs(values))))
+}
+
+
+#' @title getSameLimits
+#' @description Get same limits from multiple sets of values
+#' @param ... numeric values
+#' @return An array of 2 values
+#' @export
+#' @examples 
+#' getSameLimits(seq(-3, 8), seq(-12, 4))
+#' 
+getSameLimits <- function(...){
+  values <- c(...)
+  validateIsNumeric(values, nullAllowed = TRUE)
+  # Remove Inf and NA values
+  values <- values[!is.infinite(values)]
+  values <- values[!is.na(values)]
+  if(isEmpty(values)){
+    return(NULL)
+  }
+  return(c(min(values), max(values)))
+}

R/plot-obs-vs-pred.R

@@ -137,6 +137,8 @@ plotObsVsPred <- function(data,
     data = mapData,
     mapLabels = mapLabels
   )
+  # Update axes limits if option symmetric and user did not define specific limits
+  plotObject <- .updateSameAxes(plotObject, mapData, dataMapping)
   plotObject <- .updateAxes(plotObject)
   return(plotObject)
 }

R/plot-res-vs-pred.R

@@ -108,6 +108,7 @@ plotResVsPred <- function(data,
     data = mapData,
     mapLabels = mapLabels
   )
+  plotObject <- .updateSymmetricAxes(plotObject, mapData, dataMapping)
   plotObject <- .updateAxes(plotObject)
   return(plotObject)
 }

R/plotconfiguration.R

@@ -4,6 +4,7 @@
 #' @field defaultXScale Default xAxis scale value when creating a `PlotConfiguration` object
 #' @field defaultYScale Default yAxis scale value when creating a `PlotConfiguration` object
 #' @field defaultExpand Default expand value when creating a `PlotConfiguration` object
+#' @field defaultSymmetricAxes Default option setting symmetric xAxis and/or yAxis limits when creating a `PlotConfiguration` object
 #' @family PlotConfiguration classes
 #' @references For examples, see:
 #' <https://www.open-systems-pharmacology.org/TLF-Library/articles/plot-configuration.html>
@@ -17,6 +18,7 @@ PlotConfiguration <- R6::R6Class(
     defaultXScale = "lin",
     defaultYScale = "lin",
     defaultExpand = FALSE,
+    defaultSymmetricAxes = FALSE,
 
     #' @description Create a new `PlotConfiguration` object
     #' @param title character or `Label` object defining plot title
@@ -317,19 +319,27 @@ DDIRatioPlotConfiguration <- R6::R6Class(
 
 #' @title ObsVsPredPlotConfiguration
 #' @description R6 class defining the configuration of a `ggplot` object for Obs vs Pred plots
+#' @field defaultSymmetricAxes Default option setting symmetric xAxis and/or yAxis limits when creating a `ObsVsPredPlotConfiguration` object
 #' @export
 #' @family PlotConfiguration classes
 ObsVsPredPlotConfiguration <- R6::R6Class(
   "ObsVsPredPlotConfiguration",
-  inherit = PlotConfiguration
+  inherit = PlotConfiguration,
+  public = list(
+    defaultSymmetricAxes = TRUE
+  )
 )
 
 #' @title ResVsPredPlotConfiguration
 #' @description R6 class defining the configuration of a `ggplot` object for Res vs Pred/Time plots
+#' @field defaultSymmetricAxes Default option setting symmetric xAxis and/or yAxis limits when creating a `ResVsPredPlotConfiguration` object
 #' @export
 ResVsPredPlotConfiguration <- R6::R6Class(
   "ResVsPredPlotConfiguration",
-  inherit = PlotConfiguration
+  inherit = PlotConfiguration,
+  public = list(
+    defaultSymmetricAxes = TRUE
+  )
 )
 
 #' @title ResVsTimePlotConfiguration

R/utilities-mapping.R

@@ -375,3 +375,14 @@ getLinesFromFoldDistance <- function(foldDistance) {
 
   return(aggregatedData)
 }
+
+
+#' @title .getSameLimitsFromMapping
+#' @description Get same axes limits from mapped data
+#' @param data A data.frame with labels mapped to properties and obtained from a `DataMapping` object
+#' @param dataMapping A `ObsVsPredDataMapping` object
+#' @keywords internal
+.getSameLimitsFromMapping <- function(data, dataMapping){
+  getSameLimits(data[,dataMapping$x], data[,dataMapping$y], data[,dataMapping$xmin], data[,dataMapping$xmax])
+}
+