Fixes #362 introduce qq plots (#370)

* Fixes #362 introduce qq plots

* Remove empty y check overkill

Co-authored-by: Indrajeet Patil <[email protected]>

DESCRIPTION

@@ -79,6 +79,7 @@ Collate:
     'plot-histogram.R'
     'plot-obs-vs-pred.R'
     'plot-pkratio.R'
+    'plot-qq.R'
     'plot-res-vs-pred.R'
     'plot-timeprofile.R'
     'plot-tornado.R'
@@ -88,6 +89,7 @@ Collate:
     'plotconfiguration-label.R'
     'plotconfiguration-legend.R'
     'plotconfiguration.R'
+    'qq-datamapping.R'
     'themes.R'
     'timeprofile-datamapping.R'
     'timeprofile-helper.R'

NAMESPACE

@@ -66,6 +66,8 @@ export(PKRatioPlotConfiguration)
 export(PlotAnnotationTextSize)
 export(PlotConfiguration)
 export(PlotGridConfiguration)
+export(QQDataMapping)
+export(QQPlotConfiguration)
 export(RangeDataMapping)
 export(ResVsPredDataMapping)
 export(ResVsPredPlotConfiguration)
@@ -111,6 +113,7 @@ export(getLinesFromFoldDistance)
 export(getLnTickLabels)
 export(getLogTickLabels)
 export(getPKRatioMeasure)
+export(getPercentileTickLabels)
 export(getPiTickLabels)
 export(getSameLimits)
 export(getSqrtTickLabels)
@@ -123,6 +126,7 @@ export(plotGrid)
 export(plotHistogram)
 export(plotObsVsPred)
 export(plotPKRatio)
+export(plotQQ)
 export(plotResVsPred)
 export(plotResVsTime)
 export(plotTimeProfile)

R/plot-qq.R

@@ -0,0 +1,108 @@
+#' @title plotQQ
+#' @description
+#' Producing Histograms
+#'
+#' @inheritParams addScatter
+#' @param dataMapping
+#' A `QQDataMapping` object mapping `y` and aesthetic groups to their variable names of `data`.
+#' @param plotConfiguration
+#' An optional `QQPlotConfiguration` object defining labels, grid, background and watermark.
+#' @return A `ggplot` object
+#'
+#' @export
+#' @family molecule plots
+#' @examples
+#' # Produce QQ plot of normally distributed data
+#' plotQQ(y = rnorm(100))
+#'
+#' # Produce QQ plot of normally distributed data split by group
+#' qqData <- data.frame(
+#'   residuals = c(rnorm(100), rnorm(100)),
+#'   groups = c(rep("Group A", 100), rep("Group B", 100))
+#' )
+#' plotQQ(
+#'   data = qqData,
+#'   dataMapping = QQDataMapping$new(y = "residuals", group = "groups")
+#' )
+#'
+plotQQ <- function(data = NULL,
+                   metaData = NULL,
+                   y = NULL,
+                   dataMapping = NULL,
+                   plotConfiguration = NULL,
+                   plotObject = NULL) {
+  #----- Validation and formatting of input arguments -----
+  if (is.null(data)) {
+    validateIsNumeric(y)
+    data <- data.frame(y = y)
+    dataMapping <- dataMapping %||% QQDataMapping$new(
+      y = "y",
+      data = data
+    )
+  }
+  validateIsNotEmpty(data)
+  validateIsOfType(data, "data.frame")
+  dataMapping <- .setDataMapping(dataMapping, QQDataMapping, data)
+
+  plotConfiguration <- .setPlotConfiguration(
+    plotConfiguration, QQPlotConfiguration,
+    data, metaData, dataMapping
+  )
+  plotObject <- .setPlotObject(plotObject, plotConfiguration)
+
+  mapData <- dataMapping$checkMapData(data)
+  mapLabels <- .getAesStringMapping(dataMapping)
+
+  #----- Build layers of molecule plot -----
+  # 1- Line layer
+  aestheticValues <- .getAestheticValuesFromConfiguration(
+    n = 1,
+    plotConfigurationProperty = plotObject$plotConfiguration$lines,
+    propertyNames = c("color", "size", "alpha", "linetype")
+  )
+
+  plotObject <- plotObject +
+    ggplot2::geom_qq_line(
+      data = mapData,
+      mapping = ggplot2::aes_string(
+        sample = mapLabels$y
+      ),
+      size = aestheticValues$size,
+      color = aestheticValues$color,
+      linetype = aestheticValues$linetype,
+      alpha = aestheticValues$alpha,
+      na.rm = TRUE
+    )
+
+  # 2- Scatter point layer
+  aestheticValues <- .getAestheticValuesFromConfiguration(
+    n = 1,
+    plotConfigurationProperty = plotObject$plotConfiguration$points,
+    propertyNames = c("size", "alpha")
+  )
+
+  plotObject <- plotObject +
+    ggplot2::geom_point(
+      data = mapData,
+      mapping = ggplot2::aes_string(
+        x = DefaultDataMappingValues$qqPlot,
+        y = mapLabels$y,
+        color = mapLabels$color,
+        shape = mapLabels$shape
+      ),
+      size = aestheticValues$size,
+      alpha = aestheticValues$alpha,
+      na.rm = TRUE
+    )
+
+  #----- Update properties using ggplot2::scale functions -----
+  plotObject <- .updateAesProperties(
+    plotObject,
+    plotConfigurationProperty = "points",
+    propertyNames = c("color", "shape"),
+    data = mapData,
+    mapLabels = mapLabels
+  )
+  plotObject <- .updateAxes(plotObject)
+  return(plotObject)
+}

R/plotconfiguration-axis.R

@@ -180,6 +180,7 @@ AxisConfiguration <- R6::R6Class(
         "log" = getLogTickLabels,
         "ln" = getLnTickLabels,
         "sqrt" = getSqrtTickLabels,
+        "percentiles" = getPercentileTickLabels,
         private$.ticklabels
       )
     }

R/plotconfiguration.R

@@ -367,3 +367,22 @@ HistogramPlotConfiguration <- R6::R6Class(
     }
   )
 )
+
+#' @title QQPlotConfiguration
+#' @description R6 class defining the configuration of a `ggplot` object for Quantile-Quantile plots
+#' @export
+#' @family PlotConfiguration classes
+QQPlotConfiguration <- R6::R6Class(
+  "QQPlotConfiguration",
+  inherit = PlotConfiguration,
+  public = list(
+    #' @description Create a new `QQPlotConfiguration` object
+    #' @param xlabel QQ-plot default display is "Standard Normal Quantiles"
+    #' @param ... parameters inherited from `PlotConfiguration`
+    #' @return A new `QQPlotConfiguration` object
+    initialize = function(xlabel = "Standard Normal Quantiles",
+                          ...) {
+      super$initialize(xlabel = xlabel, ...)
+    }
+  )
+)

R/qq-datamapping.R

@@ -0,0 +1,26 @@
+#' @title QQDataMapping
+#' @description  R6 class for mapping `x`, `y` and `GroupMapping` variables to `data`
+#' @export
+#' @family DataMapping classes
+QQDataMapping <- R6::R6Class(
+  "QQDataMapping",
+  inherit = XYGDataMapping,
+  public = list(
+    #' @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")
+      mapData <- super$checkMapData(data, metaData)
+      if (isEmpty(self$x)) {
+        # Get theoritical quantiles for normal distribution
+        xQuantiles <- stats::qqnorm(data[, self$y], plot.it = FALSE)$x
+        mapData[, DefaultDataMappingValues$qqPlot] <- xQuantiles
+      }
+      self$data <- mapData
+      return(mapData)
+    }
+  )
+)

R/utilities-axis.R

@@ -219,6 +219,23 @@ getPiTickLabels <- function(ticks) {
   return(piLabels)
 }
 
+#' @title getPercentileTickLabels
+#' @description Get ticklabels expressions for percentiles of normal distribution scale plots
+#' @param ticks numeric values of the ticks
+#' @return Expressions to use in `ticklabels` input parameter of `setXAxis` and `setYAxis` functions
+#' @examples
+#' ticks <- rnorm(5)
+#' getPercentileTickLabels(ticks)
+#'
+#' # Get percentile of normal distribution
+#' ticks <- qnorm(seq(1, 9) / 10)
+#' getPercentileTickLabels(ticks)
+#'
+#' @export
+getPercentileTickLabels <- function(ticks) {
+  return(paste0(round(100 * stats::pnorm(ticks), 3), "%"))
+}
+
 #' @title .removeInfiniteValues
 #' @description Censor/remove any values outside of range
 #' Caution, removing infinite values can cause issues with ribbons

R/utilities-enums.R

@@ -329,4 +329,4 @@ ExportFormats <- enum(c("png", "pdf", "eps", "ps", "tex", "jpeg", "tiff", "bmp",
 #' @description
 #' List of all available tick label transformation names
 #' @family enum helpers
-TickLabelTransforms <- enum(c("none", "default", "identity", "log", "ln", "sqrt", "greek", "pi"))
+TickLabelTransforms <- enum(c("none", "default", "identity", "log", "ln", "sqrt", "greek", "pi", "percentiles"))

R/utilities-mapping.R

@@ -274,7 +274,8 @@ DefaultDataMappingValues <- list(
   ),
   resVsPred = 0,
   tornado = 0,
-  histogram = 0
+  histogram = 0,
+  qqPlot = "StandardNormalQuantiles"
 )
 
 #' @title getLinesFromFoldDistance