From 1a1c884443efe13e0b198f1dbf2bd02db3c721b1 Mon Sep 17 00:00:00 2001 From: Unknown Date: Fri, 26 May 2023 08:05:31 -0400 Subject: [PATCH] Fixes #478 lloq dotted lines appear on plots --- R/utilities-goodness-of-fit.R | 15 +++- R/utilities-observed-data.R | 3 - R/utilities-plots.R | 126 ++++++++++++++++++++++++++++++++-- man/addLLOQLegend.Rd | 24 +++++++ man/getLegendAesOverride.Rd | 21 ++++++ 5 files changed, 180 insertions(+), 9 deletions(-) create mode 100644 man/addLLOQLegend.Rd create mode 100644 man/getLegendAesOverride.Rd diff --git a/R/utilities-goodness-of-fit.R b/R/utilities-goodness-of-fit.R index 97a98fdf..14a96986 100644 --- a/R/utilities-goodness-of-fit.R +++ b/R/utilities-goodness-of-fit.R @@ -555,6 +555,13 @@ plotMeanTimeProfile <- function(simulatedData, observedDataMapping = observedDataMapping, plotConfiguration = plotConfiguration ) + # Check if lloq needs to be added + lloqRows <- !is.na(observedData$lloq) + if(!any(lloqRows)){ + return(timeProfilePlot) + } + lloqCaptions <- unique(observedData[lloqRows, dataMapping$group]) + timeProfilePlot <- addLLOQLegend(timeProfilePlot, lloqCaptions) return(timeProfilePlot) } @@ -650,7 +657,13 @@ plotPopTimeProfile <- function(simulatedData, observedDataMapping = observedDataMapping, plotConfiguration = plotConfiguration ) - + # Check if lloq needs to be added + lloqRows <- !is.na(observedData$lloq) + if(!any(lloqRows)){ + return(timeProfilePlot) + } + lloqCaptions <- unique(observedData[lloqRows, dataMapping$group]) + timeProfilePlot <- addLLOQLegend(timeProfilePlot, lloqCaptions) return(timeProfilePlot) } diff --git a/R/utilities-observed-data.R b/R/utilities-observed-data.R index 9b2cc9ed..cd9ade78 100644 --- a/R/utilities-observed-data.R +++ b/R/utilities-observed-data.R @@ -435,9 +435,6 @@ getObservedDataFromOutput <- function(output, data, dataMapping, molWeight, stru } } outputData$lloq <- checkLLOQValues(lloqConcentration, structureSet) - # Update legend indicating dotted lines are lloq - outputData$Legend <- paste(outputData$Legend, "LLOQ represented as dotted line", sep = "\n") - metaData$legend <- paste(metaData$legend, "LLOQ represented as dotted line", sep = "\n") return(list(data = outputData, metaData = metaData)) } diff --git a/R/utilities-plots.R b/R/utilities-plots.R index cee66f24..97d5d2d7 100644 --- a/R/utilities-plots.R +++ b/R/utilities-plots.R @@ -862,20 +862,136 @@ updateAxesMargin <- function(axesProperties, sideMarginsEnabled = TRUE) { } #' @title getDefaultPropertyFromTheme -#' @description +#' @description #' Get default property value from current reEnv theme #' @param propertyName Name of the aesthetic property (eg `"color"`) #' @param propertyType One of `"points"`, `"lines`, `"ribbons"` or `"errorbars"` #' @param plotName Name of the plot in Theme (eg `"plotTimeProfile"`) #' @return Property value #' @keywords internal -getDefaultPropertiesFromTheme <- function(plotName, - propertyType = "points", - propertyNames = as.character(tlf::AestheticProperties)){ +getDefaultPropertiesFromTheme <- function(plotName, + propertyType = "points", + propertyNames = as.character(tlf::AestheticProperties)) { # The function to get values from a Theme/PlotConfiguration exists in tlf but it is not exported # For this reason, it needs to be called using ::: tlf:::.getAestheticValuesFromConfiguration( plotConfigurationProperty = reEnv$theme$plotConfigurations[[plotName]][[propertyType]], propertyNames = propertyNames ) -} \ No newline at end of file +} + +#' @title getLegendAesOverride +#' @description +#' In time profiles, legends are merged into one unique legend +#' The displayed legend is stored in the `plotObject` within the color guide field `override.aes`. +#' This function simply gets the list from that field for updating the current legend +#' TODO: create and export that function in `{tlf}` package +#' @param plotObject A ggplot object +#' @return A list of aesthetic values +#' @keywords internal +getLegendAesOverride <- function(plotObject) { + return(plotObject$guides$colour$override.aes) +} + +#' @title addLLOQLegend +#' @description +#' Add LLOQ displayed legend to the legend of a `plotObject` +#' TODO: create and export that function in `{tlf}` package +#' Fix coloring issues +#' @param plotObject A ggplot object +#' @param captions Current observed data captions for which lloq legend is needed +#' @param prefix Prefix for legend +#' @return A list of aesthetic values +#' @keywords internal +addLLOQLegend <- function(plotObject, captions, prefix = "LLOQ for") { + + # Since lloq legend should be positioned after the current legend + # Current legend needs to be reused by the color and shape guides + # to prevent losing the correct captions and keys + currentLegend <- getLegendAesOverride(plotObject) + lloqLegend <- prettyCaption( + captions = paste(prefix, captions), + plotObject = plotObject + ) + + # If both observed and simulated data are displayed + # tlf merge the legends using option override.aes from color guide + # while removing the legends from linetype and shape + shapeGuide <- "none" + if (isEmpty(currentLegend)) { + # ggplot2 auto-merge shape and color legends + # if only observed data are displayed + # thus both color and shape guides need to be consistent by using same order and title + shapeGuide <- ggplot2::guide_legend( + title = plotObject$plotConfiguration$legend$title$text, + title.theme = plotObject$plotConfiguration$legend$title$createPlotFont(), + order = 1, + label.theme = plotObject$plotConfiguration$legend$font$createPlotFont() + ) + } + colorGuide <- ggplot2::guide_legend( + title = plotObject$plotConfiguration$legend$title$text, + title.theme = plotObject$plotConfiguration$legend$title$createPlotFont(), + order = 1, + override.aes = currentLegend, + label.theme = plotObject$plotConfiguration$legend$font$createPlotFont() + ) + + # the linetype guide should display the caption for lloq legend + # corresponding to "LLOQ for " + # - order argument renders legend after current legend + # - title is null to allow pasting this additional legend right below the current + linetypeGuide <- ggplot2::guide_legend( + title = NULL, + order = 2, + override.aes = list( + shape = tlf::Shapes$blank, + linetype = tlf:::tlfEnv$defaultLLOQLinetype, + fill = NA + ), + label.theme = plotObject$plotConfiguration$legend$font$createPlotFont() + ) + + # Needs to add a dummy linetype aesthetic to get lloq legend displayed + plotObject <- plotObject + + ggplot2::geom_blank( + mapping = ggplot2::aes(linetype = lloqLegend), + inherit.aes = FALSE + ) + linetypeScale <- plotObject$scales$get_scales("linetype") + + # Suppress message stating scale was updated + suppressMessages({ + plotObject <- plotObject + + # Ensure only lloq legend entries are displayed + # and prevent current linetypes to be changed or removed + ggplot2::scale_linetype_manual( + breaks = head(c(linetypeScale$breaks, lloqLegend), length(lloqLegend)), + values = as.character(c( + linetypeScale$palette(1), + rep(tlf::Linetypes$blank, length(lloqLegend)) + )), + labels = lloqLegend + ) + + ggplot2::guides( + colour = colorGuide, + shape = shapeGuide, + linetype = linetypeGuide + ) + + # Ensures + # - gaps between legends are removed + # - legends are on top of each other (not side by side) + # - aligned on legend keys (prettier display) + ggplot2::theme( + legend.margin = ggplot2::margin( + t = -plotObject$plotConfiguration$legend$title$font$size / 2, + b = -plotObject$plotConfiguration$legend$title$font$size / 2, + unit = "pt" + ), + legend.box = "vertical", + legend.box.just = "left" + ) + }) + + return(plotObject) +} diff --git a/man/addLLOQLegend.Rd b/man/addLLOQLegend.Rd new file mode 100644 index 00000000..68aa906f --- /dev/null +++ b/man/addLLOQLegend.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utilities-plots.R +\name{addLLOQLegend} +\alias{addLLOQLegend} +\title{addLLOQLegend} +\usage{ +addLLOQLegend(plotObject, captions, prefix = "LLOQ for") +} +\arguments{ +\item{plotObject}{A ggplot object} + +\item{captions}{Current observed data captions for which lloq legend is needed} + +\item{prefix}{Prefix for legend} +} +\value{ +A list of aesthetic values +} +\description{ +Add LLOQ displayed legend to the legend of a `plotObject` +TODO: create and export that function in `{tlf}` package +Fix coloring issues +} +\keyword{internal} diff --git a/man/getLegendAesOverride.Rd b/man/getLegendAesOverride.Rd new file mode 100644 index 00000000..da82a304 --- /dev/null +++ b/man/getLegendAesOverride.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utilities-plots.R +\name{getLegendAesOverride} +\alias{getLegendAesOverride} +\title{getLegendAesOverride} +\usage{ +getLegendAesOverride(plotObject) +} +\arguments{ +\item{plotObject}{A ggplot object} +} +\value{ +A list of aesthetic values +} +\description{ +In time profiles, legends are merged into one unique legend +The displayed legend is stored in the `plotObject` within the color guide field `override.aes`. +This function simply gets the list from that field for updating the current legend +TODO: create and export that function in `{tlf}` package +} +\keyword{internal}