diff --git a/DESCRIPTION b/DESCRIPTION index c3f48ea2..8f8bfe7f 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: tlf Type: Package Title: TLF Library -Version: 1.1.0 +Version: 1.2.0 Authors@R: c(person(given = "Open-Systems-Pharmacology Community", role = "cph"), @@ -25,7 +25,8 @@ BugReports: https://github.com/open-systems-pharmacology/tlf-library/issues Imports: ggplot2 (>= 3.3.0), R6, - reshape2 + reshape2, + jsonlite Depends: R (>= 3.5) Encoding: UTF-8 @@ -46,9 +47,7 @@ Collate: 'atom-plots.R' 'boxwhisker-datamapping.R' 'boxwhisker-get-measure.R' - 'boxwhisker-plot.R' 'boxwhisker-plotconfiguration.R' - 'data-description.R' 'datamapping-grouping.R' 'datamapping-groupmapping.R' 'datamapping-range.R' @@ -57,7 +56,6 @@ Collate: 'ddiratio-datamapping.R' 'ddiratio-plotconfiguration.R' 'error-checks.R' - 'utils.R' 'font.R' 'histogram-datamapping.R' 'histogram-plotconfiguration.R' @@ -66,9 +64,11 @@ Collate: 'metadata-helper.R' 'obs-vs-pred-datamapping.R' 'obs-vs-pred-plotconfiguration.R' + 'observed-data-mapping.R' 'pkratio-datamapping.R' 'pkratio-get-measure.R' 'pkratio-plotconfiguration.R' + 'plot-boxwhisker.R' 'plot-ddiratio.R' 'plot-histogram.R' 'plot-obs-vs-pred.R' @@ -88,9 +88,11 @@ Collate: 'tlf-env.R' 'tornado-datamapping.R' 'tornado-plotconfiguration.R' + 'utilities-aesthetics.R' 'utilities-axis.R' 'utilities-background.R' 'utilities-export.R' 'utilities-label.R' 'utilities-legend.R' 'utilities-mapping.R' + 'utils.R' diff --git a/NAMESPACE b/NAMESPACE index 650dd90a..7a7d98c5 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -27,13 +27,16 @@ export("median+1.5IQR") export("median+IQR") export("median-1.5IQR") export("median-IQR") +export(AestheticSelectionKeys) export(AggregationInput) export(AggregationSummary) export(AxisConfiguration) export(BackgroundConfiguration) -export(BackgroundElementConfiguration) +export(BackgroundElement) export(BoxWhiskerDataMapping) export(BoxWhiskerPlotConfiguration) +export(ColorMaps) +export(DDIComparisonTypes) export(DDIRatioDataMapping) export(DDIRatioPlotConfiguration) export(ExportConfiguration) @@ -47,16 +50,23 @@ export(LabelConfiguration) export(LegendConfiguration) export(LegendPositions) export(LegendTypes) +export(LineElement) +export(Linetypes) export(ObsVsPredDataMapping) export(ObsVsPredPlotConfiguration) +export(ObservedDataMapping) export(PKRatioDataMapping) export(PKRatioPlotConfiguration) export(PlotConfiguration) export(RangeDataMapping) export(Scaling) +export(Shapes) export(Theme) -export(ThemeAesProperties) +export(ThemeAestheticMaps) +export(ThemeAestheticSelections) +export(ThemeBackground) export(ThemeFont) +export(ThemePlotConfigurations) export(TimeProfileDataMapping) export(TimeProfilePlotConfiguration) export(TornadoDataMapping) @@ -71,17 +81,16 @@ export(addRibbon) export(addScatter) export(addWatermark) export(asLabel) -export(bigTheme) -export(bwTheme) export(createWatermarkGrob) -export(defaultTheme) export(exportPlot) export(getBoxWhiskerMeasure) export(getDefaultCaptions) +export(getGuestValues) export(getLabelWithUnit) export(getLegendCaption) export(getPKRatioMeasure) export(initializePlot) +export(loadThemeFromJson) export(metaDataHelper) export(plotBoxWhisker) export(plotDDIRatio) @@ -90,7 +99,14 @@ export(plotObsVsPred) export(plotPKRatio) export(plotTimeProfile) export(plotTornado) +export(runDDIRatioPlot) +export(runObsVsPredPlot) +export(runPKRatioPlot) +export(runThemeMaker) +export(saveThemeToJson) export(setBackground) +export(setBackgroundPanelArea) +export(setBackgroundPlotArea) export(setCaptionColor) export(setCaptionFill) export(setCaptionLabels) @@ -106,10 +122,10 @@ export(setDefaultExportName) export(setDefaultExportParameters) export(setDefaultLegendPosition) export(setDefaultWatermark) -export(setFontProperties) export(setGrid) export(setLegend) export(setLegendCaption) +export(setLegendFont) export(setLegendPosition) export(setLegendTitle) export(setPlotExport) @@ -118,10 +134,12 @@ export(setPlotExportSize) export(setPlotLabels) export(setWatermark) export(setXAxis) +export(setXGrid) export(setYAxis) +export(setYGrid) export(tlfStatFunctions) -export(tlfTheme) export(updateLegendCaption) export(useTheme) import(ggplot2) +import(jsonlite) import(utils) diff --git a/R/atom-plots.R b/R/atom-plots.R index 1cdbb003..8385c483 100644 --- a/R/atom-plots.R +++ b/R/atom-plots.R @@ -2,7 +2,7 @@ #' @title initializePlot #' @param plotConfiguration -#' \code{PlotConfiguration} class or subclass defining labels, grid, background and watermark +#' \code{PlotConfiguration} objecct defining labels, grid, background and watermark #' This parameter is optional: the \code{tlf} library provides a default configuration according to the current theme #' @description #' Initialize a \code{ggplot} object and set the labels, grid, background and watermark @@ -12,10 +12,6 @@ #' # Initialize an empty plot #' p <- initializePlot() #' -#' # Use a predifined theme -#' useTheme(tlfTheme) -#' p <- initializePlot() -#' #' # Implement a customized configuration using PlotConfiguration #' config <- PlotConfiguration$new(title = "My Plot", xlabel = "x variable", ylabel = "y variable") #' p <- initializePlot(config) @@ -27,8 +23,10 @@ initializePlot <- function(plotConfiguration = NULL) { plotObject$plotConfiguration <- plotConfiguration plotObject <- setWatermark(plotObject) - plotObject <- setBackground(plotObject) - plotObject <- setGrid(plotObject) + plotObject <- setBackgroundPlotArea(plotObject) + plotObject <- setBackgroundPanelArea(plotObject) + plotObject <- setXGrid(plotObject) + plotObject <- setYGrid(plotObject) plotObject <- setPlotLabels(plotObject) return(plotObject) @@ -102,9 +100,8 @@ addScatter <- function(data = NULL, validateIsOfType(dataMapping, XYGDataMapping, nullAllowed = TRUE) validateIsOfType(plotConfiguration, PlotConfiguration, nullAllowed = TRUE) - # If data is not input - # Create new data and its mapping from x and y input - if (is.null(data)) { + # If data is not input, creates data from x and y inputs + if (isOfLength(data, 0)) { validateIsSameLength(x, y) data <- as.data.frame(cbind(x = x, y = y)) dataMapping <- dataMapping %||% XYGDataMapping$new(x = ifnotnull(x, "x"), y = ifnotnull(y, "y"), data = data) @@ -115,15 +112,21 @@ addScatter <- function(data = NULL, } dataMapping <- dataMapping %||% XYGDataMapping$new(x = x, y = y, data = data) - plotConfiguration <- plotConfiguration %||% PlotConfiguration$new(data = data, metaData = metaData, dataMapping = dataMapping) + # Update plotConfiguration if user defined aesthetics + aestheticInputs <- c("color", "shape", "linetype", "size") + aestheticInputsExpression <- parse(text = paste0( + "plotConfiguration$points$", aestheticInputs, + " <- ", aestheticInputs, " %||% plotConfiguration$points$", aestheticInputs + )) + eval(aestheticInputsExpression) # If no plot, initialize empty plot plotObject <- plotObject %||% initializePlot(plotConfiguration) # If no mapping, nor x or y, return plotObject - if (is.null(dataMapping$x) || is.null(dataMapping$y)) { - warning("No mapping found for x or y, scatter layer was not added") + if (any(isOfLength(dataMapping$x, 0), isOfLength(dataMapping$y, 0))) { + warning("No mapping found for x nor y, scatter layer was not added") return(plotObject) } @@ -143,7 +146,7 @@ addScatter <- function(data = NULL, mapping = ggplot2::aes_string(x = mapLabels$x, y = mapLabels$y, shape = "legendLabels", color = "legendLabels", size = "legendLabels"), show.legend = TRUE ) + - ggplot2::geom_line( + ggplot2::geom_path( data = mapData, mapping = ggplot2::aes_string(x = mapLabels$x, y = mapLabels$y, linetype = "legendLabels", color = "legendLabels", size = "legendLabels"), show.legend = TRUE @@ -151,26 +154,21 @@ addScatter <- function(data = NULL, ggplot2::geom_ribbon( data = mapData, mapping = ggplot2::aes_string(x = mapLabels$x, ymin = mapLabels$y, ymax = mapLabels$y, fill = "legendLabels"), + # alpha is 0 so that line can be seen in legend + alpha = 0, show.legend = TRUE ) # Prepare data for merging previous and current legend - # TO DO: base modulo of newLegendProperty on theme aesProperties lengths newLabels <- levels(factor(mapData$legendLabels)) - legendLength <- nrow(plotObject$plotConfiguration$legend$caption) %||% 0 - newLegendProperty <- seq(legendLength + 1, legendLength + length(newLabels)) - 1 %% 6 + 1 - - # Sample LegendType properties based tlfTheme if not input - plotObject <- mergeLegend(plotObject, + # Sample LegendType properties based Theme if not input + try(plotObject <- mergeLegend(plotObject, newLabels = newLabels, - color = color %||% tlfEnv$currentTheme$aesProperties$color[newLegendProperty], - shape = shape %||% tlfEnv$currentTheme$aesProperties$shape[newLegendProperty], - size = size %||% rep(1, length(newLabels)), - linetype = linetype %||% rep("blank", length(newLabels)), - fill = rep(NA, length(newLabels)) - ) - try(suppressMessages(plotObject <- plotObject$plotConfiguration$xAxis$setPlotAxis(plotObject))) - try(suppressMessages(plotObject <- plotObject$plotConfiguration$yAxis$setPlotAxis(plotObject))) + aestheticSelections = plotConfiguration$points + )) + # Try is used to prevent crashes in the final plot due to ggplot2 peculiarities regarding scale functions + try(suppressMessages(plotObject <- setXAxis(plotObject))) + try(suppressMessages(plotObject <- setYAxis(plotObject))) return(plotObject) } @@ -249,9 +247,8 @@ addLine <- function(data = NULL, validateIsOfType(dataMapping, XYGDataMapping, nullAllowed = TRUE) validateIsOfType(plotConfiguration, PlotConfiguration, nullAllowed = TRUE) - # If data is not input - # Create new data and its mapping from x and y input - if (is.null(data)) { + # If data is not input, creates new data and its mapping from x and y input + if (isOfLength(data, 0)) { data <- as.data.frame(cbind(x = x, y = y)) dataMapping <- dataMapping %||% XYGDataMapping$new(x = ifnotnull(x, "x"), y = ifnotnull(y, "y"), data = data) @@ -263,15 +260,22 @@ addLine <- function(data = NULL, } dataMapping <- dataMapping %||% XYGDataMapping$new(x = x, y = y, data = data) - plotConfiguration <- plotConfiguration %||% PlotConfiguration$new(data = data, metaData = metaData, dataMapping = dataMapping) + # Update plotConfiguration if user defined aesthetics + aestheticInputs <- c("color", "shape", "linetype", "size") + aestheticInputsExpression <- parse(text = paste0( + "plotConfiguration$lines$", aestheticInputs, + " <- ", aestheticInputs, " %||% plotConfiguration$lines$", aestheticInputs + )) + eval(aestheticInputsExpression) + # If no plot, initialize empty plot plotObject <- plotObject %||% initializePlot(plotConfiguration) # If no mapping, return plot - if (is.null(dataMapping$x) && is.null(dataMapping$y)) { - warning("No mapping found, line layer was not added") + if (all(isOfLength(dataMapping$x, 0), isOfLength(dataMapping$y, 0))) { + warning("No mapping found for both x and y, line layer was not added") return(plotObject) } @@ -288,67 +292,74 @@ addLine <- function(data = NULL, # y-intercept # geom_blank is used to fill the missing aes properties # This prevents messing up the legend - if (is.null(dataMapping$x) && !is.null(dataMapping$y)) { + if (isOfLength(dataMapping$x, 0) && !isOfLength(dataMapping$y, 0)) { plotObject <- plotObject + ggplot2::geom_hline( data = mapData, - mapping = aes_string(yintercept = mapLabels$y, linetype = "legendLabels", color = "legendLabels", size = "legendLabels"), + mapping = ggplot2::aes_string(yintercept = mapLabels$y, linetype = "legendLabels", color = "legendLabels", size = "legendLabels"), show.legend = TRUE ) + ggplot2::geom_blank( data = mapData, - mapping = aes_string(shape = "legendLabels", fill = "legendLabels") + mapping = ggplot2::aes_string( + shape = "legendLabels", + fill = "legendLabels" + ), + show.legend = TRUE ) } # x-intercept - if (is.null(dataMapping$y) && !is.null(dataMapping$x)) { + if (isOfLength(dataMapping$y, 0) && !isOfLength(dataMapping$x, 0)) { plotObject <- plotObject + ggplot2::geom_vline( data = mapData, - mapping = aes_string(xintercept = mapLabels$x, linetype = "legendLabels", color = "legendLabels", size = "legendLabels"), + mapping = ggplot2::aes_string(xintercept = mapLabels$x, linetype = "legendLabels", color = "legendLabels", size = "legendLabels"), show.legend = TRUE ) + ggplot2::geom_blank( data = mapData, - mapping = aes_string(shape = "legendLabels", fill = "legendLabels") + mapping = ggplot2::aes_string( + shape = "legendLabels", + fill = "legendLabels" + ), + show.legend = TRUE ) } - if (!is.null(dataMapping$x) && !is.null(dataMapping$y)) { + # 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))) { plotObject <- plotObject + ggplot2::geom_point( data = mapData, - mapping = aes_string(x = mapLabels$x, y = mapLabels$y, shape = "legendLabels", color = "legendLabels", size = "legendLabels"), + mapping = ggplot2::aes_string(x = mapLabels$x, y = mapLabels$y, shape = "legendLabels", color = "legendLabels", size = "legendLabels"), show.legend = TRUE ) + - ggplot2::geom_line( + ggplot2::geom_path( data = mapData, - mapping = aes_string(x = mapLabels$x, y = mapLabels$y, linetype = "legendLabels", color = "legendLabels", size = "legendLabels"), + mapping = ggplot2::aes_string(x = mapLabels$x, y = mapLabels$y, linetype = "legendLabels", color = "legendLabels", size = "legendLabels"), show.legend = TRUE ) + ggplot2::geom_ribbon( data = mapData, - mapping = aes_string(x = mapLabels$x, ymin = mapLabels$y, ymax = mapLabels$y, fill = "legendLabels"), + mapping = ggplot2::aes_string(x = mapLabels$x, ymin = mapLabels$y, ymax = mapLabels$y, fill = "legendLabels"), + # alpha is 0 so that line can be seen in legend + alpha = 0, show.legend = TRUE ) } + # Prepare data for merging previous and current legend newLabels <- levels(factor(mapData$legendLabels)) - legendLength <- nrow(plotObject$plotConfiguration$legend$caption) %||% 0 - newLegendProperty <- seq(legendLength + 1, legendLength + length(newLabels)) - 1 %% 6 + 1 - - # Sample LegendType properties based tlfTheme if not input - plotObject <- mergeLegend(plotObject, + # Sample LegendType properties based Theme if not input + try(plotObject <- mergeLegend(plotObject, newLabels = newLabels, - color = color %||% tlfEnv$currentTheme$aesProperties$color[newLegendProperty], - shape = shape %||% rep(-2, length(newLabels)), - size = size %||% rep(1, length(newLabels)), - linetype = linetype %||% tlfEnv$currentTheme$aesProperties$linetype[newLegendProperty], - fill = rep(NA, length(newLabels)) - ) - try(suppressMessages(plotObject <- plotObject$plotConfiguration$xAxis$setPlotAxis(plotObject))) - try(suppressMessages(plotObject <- plotObject$plotConfiguration$yAxis$setPlotAxis(plotObject))) + aestheticSelections = plotConfiguration$lines + )) + try(suppressMessages(plotObject <- setXAxis(plotObject))) + try(suppressMessages(plotObject <- setYAxis(plotObject))) return(plotObject) } @@ -438,13 +449,12 @@ addRibbon <- function(data = NULL, validateIsOfType(dataMapping, RangeDataMapping, nullAllowed = TRUE) validateIsOfType(plotConfiguration, PlotConfiguration, nullAllowed = TRUE) - # If data is not input - # Create new data and its mapping from x, ymin and ymax input - if (is.null(data)) { + # If data is not input, creates data and its mapping from x, ymin and ymax input + if (isOfLength(data, 0)) { data <- as.data.frame(cbind(x = x, ymin = ymin %||% 0, ymax = ymax %||% 0)) # y-intercept ribbon - if (is.null(x)) { + if (isOfLength(x, 0)) { # Redefine data.frame for y-intercept ribbon data <- rbind.data.frame(cbind.data.frame(x = -Inf, data), cbind.data.frame(x = Inf, data)) } @@ -456,15 +466,22 @@ addRibbon <- function(data = NULL, } dataMapping <- dataMapping %||% RangeDataMapping$new(x = x, ymin = ymin, ymax = ymax, data = data) - plotConfiguration <- plotConfiguration %||% PlotConfiguration$new(data = data, metaData = metaData, dataMapping = dataMapping) + # Update plotConfiguration if user defined aesthetics + aestheticInputs <- c("color", "fill", "linetype", "size", "alpha") + aestheticInputsExpression <- parse(text = paste0( + "plotConfiguration$ribbons$", aestheticInputs, + " <- ", aestheticInputs, " %||% plotConfiguration$ribbons$", aestheticInputs + )) + eval(aestheticInputsExpression) + # If no plot, initialize empty plot plotObject <- plotObject %||% initializePlot(plotConfiguration) # If no mapping, return plot - if (is.null(dataMapping$x) && is.null(dataMapping$ymin) && is.null(dataMapping$ymax)) { - warning("No mapping found, ribbon layer was not added") + if (all(isOfLength(dataMapping$x, 0), isOfLength(dataMapping$ymin, 0), isOfLength(dataMapping$ymax, 0))) { + warning("No mapping found for x, ymin and ymax, ribbon layer was not added") return(plotObject) } @@ -478,7 +495,6 @@ addRibbon <- function(data = NULL, } mapData$legendLabels <- caption %||% mapData$legendLabels - # Get mapping and convert labels into characters usable by aes_string mapData <- dataMapping$checkMapData(data) mapLabels <- getAesStringMapping(dataMapping) @@ -490,51 +506,30 @@ addRibbon <- function(data = NULL, mapData$legendLabels <- caption %||% mapData$legendLabels # y-intercept - if (max(is.infinite(mapData[, dataMapping$x])) == 1) { - plotObject <- plotObject + - ggplot2::geom_ribbon( - data = mapData, - mapping = ggplot2::aes_string(x = mapLabels$x, ymin = mapLabels$ymin, ymax = mapLabels$ymax, fill = "legendLabels", color = "legendLabels", size = "legendLabels", linetype = "legendLabels"), - alpha = alpha, - show.legend = TRUE - ) + - ggplot2::geom_blank( - data = mapData, - mapping = aes_string(shape = "legendLabels") - ) - } else { - plotObject <- plotObject + - ggplot2::geom_ribbon( - data = mapData, - mapping = ggplot2::aes_string(x = mapLabels$x, ymin = mapLabels$ymin, ymax = mapLabels$ymax, fill = "legendLabels", color = "legendLabels", size = "legendLabels", linetype = "legendLabels"), - alpha = alpha, - show.legend = TRUE - ) + - ggplot2::geom_blank( - data = mapData, - mapping = aes_string(shape = "legendLabels") - ) - } + plotObject <- plotObject + + ggplot2::geom_ribbon( + data = mapData, + mapping = ggplot2::aes_string(x = mapLabels$x, ymin = mapLabels$ymin, ymax = mapLabels$ymax, fill = "legendLabels"), + alpha = alpha, + show.legend = TRUE + ) + + ggplot2::geom_blank( + data = mapData, + mapping = aes_string(shape = "legendLabels", color = "legendLabels", size = "legendLabels", linetype = "legendLabels") + ) + # Prepare data for merging previous and current legend newLabels <- levels(factor(mapData$legendLabels)) - legendLength <- nrow(plotObject$plotConfiguration$legend$caption) %||% 0 - newLegendProperty <- seq(legendLength + 1, legendLength + length(newLabels)) - 1 %% 6 + 1 - - # Sample LegendType properties based tlfTheme if not input - plotObject <- mergeLegend(plotObject, + # Sample LegendType properties based Theme if not input + try(plotObject <- mergeLegend(plotObject, newLabels = newLabels, - color = color %||% tlfEnv$currentTheme$aesProperties$color[newLegendProperty], - shape = rep(-2, length(newLabels)), - size = size %||% rep(1, length(newLabels)), - linetype = linetype %||% rep("blank", length(newLabels)), - fill = fill %||% tlfEnv$currentTheme$aesProperties$fill[newLegendProperty] - ) - try(suppressMessages(plotObject <- plotObject$plotConfiguration$xAxis$setPlotAxis(plotObject))) - try(suppressMessages(plotObject <- plotObject$plotConfiguration$yAxis$setPlotAxis(plotObject))) + aestheticSelections = plotConfiguration$ribbons + )) + try(suppressMessages(plotObject <- setXAxis(plotObject))) + try(suppressMessages(plotObject <- setYAxis(plotObject))) return(plotObject) } - #' @title addErrorbar #' @param data data.frame containing the errorbar endpoints to be plotted #' @param metaData list of information on \code{data} such as \code{dimension} and \code{unit} of their variables @@ -581,15 +576,14 @@ addErrorbar <- function(data = NULL, dataMapping = NULL, plotConfiguration = NULL, plotObject = NULL) { - validateIsOfType(dataMapping, RangeDataMapping, nullAllowed = TRUE) + validateIsOfType(dataMapping, c("RangeDataMapping", "ObservedDataMapping"), nullAllowed = TRUE) validateIsOfType(plotConfiguration, PlotConfiguration, nullAllowed = TRUE) validateIsLogical(includeCap) + # validateIsIncluded(barLinetype, Linetypes, nullAllowed = TRUE) - # If data is not input - # Create new data and its mapping from x, ymin and ymax input - if (is.null(data)) { + # If data is not input, creates data and its mapping from x, ymin and ymax input + if (isOfLength(data, 0)) { 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) } # Enforce data to be a data.frame for dataMapping @@ -598,15 +592,22 @@ addErrorbar <- function(data = NULL, } dataMapping <- dataMapping %||% RangeDataMapping$new(x = x, ymin = ymin, ymax = ymax, data = data) - plotConfiguration <- plotConfiguration %||% PlotConfiguration$new(data = data, metaData = metaData, dataMapping = dataMapping) + # Update plotConfiguration if user defined aesthetics + aestheticInputs <- c("color", "linetype", "size") + aestheticInputsExpression <- parse(text = paste0( + "plotConfiguration$errorbars$", aestheticInputs, + " <- ", aestheticInputs, " %||% plotConfiguration$errorbars$", aestheticInputs + )) + eval(aestheticInputsExpression) + # If no plot, initialize empty plot plotObject <- plotObject %||% initializePlot(plotConfiguration) # If no mapping, return plot - if (is.null(dataMapping$x) || is.null(dataMapping$ymin) || is.null(dataMapping$ymax)) { - warning("No mapping found for x, ymin or ymax, errorbar layer was not added") + if (all(isOfLength(dataMapping$x, 0), isOfLength(dataMapping$ymin, 0), isOfLength(dataMapping$ymax, 0))) { + warning("No mapping found for x, ymin and ymax, error bar layer was not added") return(plotObject) } @@ -629,58 +630,74 @@ addErrorbar <- function(data = NULL, mapData$legendLabels <- getlegendLabelsCaption(plotObject) } mapData$legendLabels <- caption %||% mapData$legendLabels + legendLength <- length(unique(mapData$legendLabels)) + # Option caps allows to add an horizontal bar at the edges of the error bars if (includeCap) { plotObject <- plotObject + ggplot2::geom_errorbar( data = mapData, - mapping = aes_string( + mapping = ggplot2::aes_string( x = mapLabels$x, ymin = mapLabels$ymin, ymax = mapLabels$ymax, color = "legendLabels", - size = "legendLabels", - linetype = "legendLabels" ), - show.legend = TRUE + size = size %||% getAestheticValues(n = 1, selectionKey = plotConfiguration$errorbars$size, aesthetic = "size"), + linetype = linetype %||% getAestheticValues(n = 1, selectionKey = plotConfiguration$errorbars$linetype, aesthetic = "linetype") ) } if (!includeCap) { plotObject <- plotObject + ggplot2::geom_linerange( data = mapData, - mapping = aes_string( + mapping = ggplot2::aes_string( x = mapLabels$x, ymin = mapLabels$ymin, ymax = mapLabels$ymax, color = "legendLabels", - size = "legendLabels", - linetype = "legendLabels" ), - show.legend = TRUE + size = size %||% getAestheticValues(n = 1, selectionKey = plotConfiguration$errorbars$size, aesthetic = "size"), + linetype = linetype %||% getAestheticValues(n = 1, selectionKey = plotConfiguration$errorbars$linetype, aesthetic = "linetype") ) } + plotObject <- plotObject + + ggplot2::geom_ribbon( + data = mapData, + mapping = ggplot2::aes_string( + x = mapLabels$x, + ymin = mapLabels$ymin, + ymax = mapLabels$ymax, + fill = "legendLabels", + ), + alpha = 0, + show.legend = TRUE + ) + # Add blank lines, points and ribbon to the plot plotObject <- plotObject + ggplot2::geom_blank( data = mapData, - mapping = aes_string(shape = "legendLabels", fill = "legendLabels") + mapping = ggplot2::aes_string( + x = mapLabels$x, + y = mapLabels$ymax, + shape = "legendLabels", + color = "legendLabels", + fill = "legendLabels", + size = "legendLabels", + linetype = "legendLabels" + ) ) + # Prepare data for merging previous and current legend newLabels <- levels(factor(mapData$legendLabels)) - legendLength <- nrow(plotObject$plotConfiguration$legend$caption) %||% 0 - newLegendProperty <- seq(legendLength + 1, legendLength + length(newLabels)) - 1 %% 6 + 1 - - # Sample LegendType properties based tlfTheme if not input - plotObject <- mergeLegend(plotObject, + # Sample LegendType properties based Theme if not input + try(plotObject <- mergeLegend(plotObject, newLabels = newLabels, - color = color %||% tlfEnv$currentTheme$aesProperties$color[newLegendProperty], - shape = rep(-2, length(newLabels)), - size = size %||% rep(1, length(newLabels)), - linetype = linetype %||% tlfEnv$currentTheme$aesProperties$linetype[newLegendProperty], - fill = rep(NA, length(newLabels)) - ) - try(suppressMessages(plotObject <- plotObject$plotConfiguration$xAxis$setPlotAxis(plotObject))) - try(suppressMessages(plotObject <- plotObject$plotConfiguration$yAxis$setPlotAxis(plotObject))) + aestheticSelections = plotConfiguration$errorbars + )) + # Try is used to prevent crashes in the final plot due to ggplot2 peculiarities regarding scale functions + try(suppressMessages(plotObject <- setXAxis(plotObject))) + try(suppressMessages(plotObject <- setYAxis(plotObject))) return(plotObject) } diff --git a/R/boxwhisker-datamapping.R b/R/boxwhisker-datamapping.R index d73823e0..e2928f8a 100644 --- a/R/boxwhisker-datamapping.R +++ b/R/boxwhisker-datamapping.R @@ -43,8 +43,7 @@ BoxWhiskerDataMapping <- R6::R6Class( maxOutlierLimit = tlfStatFunctions$`Percentile75%+1.5IQR`, ...) { super$initialize(x = x, y = y, ...) - - super$groupMapping$color <- super$groupMapping$color %||% super$groupMapping$fill + self$groupMapping$color <- self$groupMapping$color %||% self$groupMapping$fill self$boxWhiskerLimits <- c(ymin, lower, middle, upper, ymax) self$outlierLimits <- c(minOutlierLimit, maxOutlierLimit) @@ -55,7 +54,7 @@ BoxWhiskerDataMapping <- R6::R6Class( #' @return A data.frame with `ymin`, `lower`, `middle`, `upper`, `ymax` variables. getBoxWhiskerLimits = function(data) { # Dummy silent variable if x is NULL - if (is.null(self$x)) { + if (isOfLength(self$x, 0)) { data$legendLabels <- factor("") } @@ -87,7 +86,7 @@ BoxWhiskerDataMapping <- R6::R6Class( getOutliers = function(data) { data <- self$checkMapData(data) # Dummy silent variable if x is NULL - if (is.null(self$x)) { + if (isOfLength(self$x, 0)) { data$legendLabels <- factor("") } diff --git a/R/boxwhisker-plot.R b/R/boxwhisker-plot.R deleted file mode 100644 index 70b61d8a..00000000 --- a/R/boxwhisker-plot.R +++ /dev/null @@ -1,44 +0,0 @@ -#' @title plotBoxWhisker -#' @param data data.frame (or list of data.frames? TO BE DISCUSSED) -#' containing the data to be used for the plot -#' @param metaData list of lists (structure TO BE DISCUSSED) -#' containing complementary information to data (e.g. unit) -#' @param dataMapping R6 class BoxWhiskerDataMapping -#' mapping of x, y axes + mapping of colorGrouping, sizeGrouping, shapeGrouping -#' @param plotConfiguration R6 class BoxWhiskerConfiguration -#' Plot Configuration defining title, subtitle, xlabel, ylabel watermark, and legend -#' @param plotObject -#' ggplot object, if null creates new plot, if not add time profile layers to ggplot -#' @description -#' plotBoxWhisker(data, metaData, dataMapping, plotConfiguration) -#' @return a ggplot graphical object -#' @export -plotBoxWhisker <- function(data, - metaData = NULL, - dataMapping = NULL, - plotConfiguration = NULL, - plotObject = NULL) { - dataMapping <- dataMapping %||% BoxWhiskerDataMapping$new() - plotConfiguration <- plotConfiguration %||% BoxWhiskerPlotConfiguration$new( - data = data, - metaData = metaData, - dataMapping = dataMapping - ) - - validateIsOfType(dataMapping, BoxWhiskerDataMapping) - validateIsOfType(plotConfiguration, BoxWhiskerPlotConfiguration) - validateIsOfType(plotObject, ggplot, nullAllowed = TRUE) - - plotObject <- plotObject %||% initializePlot(plotConfiguration) - - if(nrow(data)==0){ - warning("No data to plot in BoxWhiskers") - return(plotObject) - } - - # Add Plot Configuration layers and box whisker plots - plotObject <- plotConfiguration$addBoxWhisker(plotObject, data, metaData, dataMapping) - plotObject <- plotConfiguration$addOutliers(plotObject, data, metaData, dataMapping) - - return(plotObject) -} diff --git a/R/boxwhisker-plotconfiguration.R b/R/boxwhisker-plotconfiguration.R index 601c9d6c..7f8e4e37 100644 --- a/R/boxwhisker-plotconfiguration.R +++ b/R/boxwhisker-plotconfiguration.R @@ -4,108 +4,41 @@ BoxWhiskerPlotConfiguration <- R6::R6Class( "BoxWhiskerPlotConfiguration", inherit = PlotConfiguration, - public = list( - #' @description Create a new \code{BoxWhiskerPlotConfiguration} object + #' @description Create a new \code{PKRatioPlotConfiguration} object + #' @param ribbons `ThemeAestheticSelections` object defining properties for boxes of boxplot + #' @param points `ThemeAestheticSelections` object defining properties for outlier scatter points + #' @param outliers logical defining if outliers should be included in boxplot #' @param ... parameters inherited from \code{PlotConfiguration} - #' @return A new \code{BoxWhiskerPlotConfiguration} object - initialize = function(...) { + #' @return A new \code{PKRatioPlotConfiguration} object + initialize = function(outliers = TRUE, + ribbons = NULL, + points = NULL, + ...) { super$initialize(...) - }, - - #' @description Add a boxplot layer to a \code{ggplot} object - #' @param plotObject a \code{ggplot} object - #' @param data data.frame - #' @param metaData list of information on \code{data} - #' @param dataMapping R6 class \code{BoxWhiskerDataMapping} - #' @return A \code{ggplot} object - addBoxWhisker = function(plotObject, data, metaData, dataMapping) { - - # Get the box plot quantiles from dataMapping - mapBoxWhiskers <- dataMapping$getBoxWhiskerLimits(data) - - # Convert the mapping into characters usable by aes_string - mapLabels <- getAesStringMapping(dataMapping) - - plotObject <- plotObject + ggplot2::geom_boxplot( - data = mapBoxWhiskers, - mapping = aes_string( - x = mapLabels$x, - ymin = "ymin", - lower = "lower", - middle = "middle", - upper = "upper", - ymax = "ymax", - fill = mapLabels$fill, - color = mapLabels$color, - linetype = mapLabels$linetype, - size = mapLabels$size - ), - alpha = self$theme$aesProperties$alpha[1], - show.legend = TRUE, - stat = "identity" - ) - - plotObject <- plotObject + - ifEqual("legendLabels", mapLabels$fill, guides(fill = "none")) + - ifEqual("legendLabels", mapLabels$color, guides(color = "none")) + - ifEqual("legendLabels", mapLabels$linetype, guides(linetype = "none")) + - ifEqual("legendLabels", mapLabels$size, guides(size = "none")) - return(plotObject) - }, + validateIsOfType(ribbons, "ThemeAestheticSelections", nullAllowed = TRUE) + validateIsOfType(points, "ThemeAestheticSelections", nullAllowed = TRUE) + currentTheme <- tlfEnv$currentTheme$clone(deep = TRUE) + private$.ribbons <- ribbons %||% asThemeAestheticSelections(currentTheme$plotConfigurations$plotBoxWhisker$ribbons) + private$.points <- points %||% asThemeAestheticSelections(currentTheme$plotConfigurations$plotBoxWhisker$points) - #' @description Add a outlier points layer to a \code{ggplot} object - #' @param plotObject a \code{ggplot} object - #' @param data data.frame - #' @param metaData list of information on \code{data} - #' @param dataMapping R6 class \code{BoxWhiskerDataMapping} - #' @return A \code{ggplot} object - addOutliers = function(plotObject, data, metaData, dataMapping) { - mapOutliers <- dataMapping$getOutliers(data) - - # Convert the mapping into characters usable by aes_string - mapLabels <- getAesStringMapping(dataMapping) - - plotObject <- plotObject + - ggplot2::geom_point( - data = mapOutliers, - mapping = aes_string( - x = mapLabels$x, - y = "maxOutliers", - group = mapLabels$fill, - shape = mapLabels$shape, - color = mapLabels$color, - size = mapLabels$size - ), - show.legend = TRUE, - na.rm = TRUE, - position = position_dodge(width = 0.9) - ) + - ggplot2::geom_point( - data = mapOutliers, - mapping = aes_string( - x = mapLabels$x, - y = "minOutliers", - group = mapLabels$fill, - shape = mapLabels$shape, - color = mapLabels$color, - size = mapLabels$size - ), - show.legend = TRUE, - na.rm = TRUE, - position = position_dodge(width = 0.9) - ) - # position = position_dodge(width = 0.9) aligns points with centers of boxplots - # no matter the number of groups, the value of 0.9 will be always fix, - # otherwise, points won't be centered anymore - - plotObject <- plotObject + - ifEqual("legendLabels", mapLabels$shape, guides(shape = "none")) + - ifEqual("legendLabels", mapLabels$color, guides(color = "none")) + - ifEqual("legendLabels", mapLabels$size, guides(size = "none")) - - return(plotObject) + validateIsLogical(outliers) + private$.outliers <- outliers + } + ), + active = list( + #' @field outliers logical defining if outliers should be included in boxplot + outliers = function(value) { + if (missing(value)) { + return(private$.outliers) + } + validateIsLogical(value, nullAllowed = TRUE) + private$.outliers <- value %||% private$.outliers + return(invisible()) } + ), + private = list( + .outliers = NULL ) ) diff --git a/R/data-description.R b/R/data-description.R deleted file mode 100644 index 9cf54318..00000000 --- a/R/data-description.R +++ /dev/null @@ -1,46 +0,0 @@ -#' Test dataset of PK Ratios for 40 subjects. -#' -#' -#' @format A data frame with 40 rows and 11 variables: -#' \describe{ -#' \item{IndividualID}{} -#' \item{Population}{} -#' \item{Gender}{} -#' \item{Age}{} -#' \item{Compound}{} -#' \item{Dose}{} -#' \item{Organ}{} -#' \item{Compartment}{} -#' \item{Simulated}{} -#' \item{Observed}{} -#' \item{Ratio}{} -#' } -"pkRatioData" - -#' Test metaData for pkRatioData -#' -#' -#' @format A list of lists for the 11 variables of pkRatioData -#' Each variable includes: -#' \describe{ -#' \item{unit}{} -#' \item{dimension}{} -#' } -"pkRatioMetaData" - -#' Test dataset for time profiles with 3 subjects. -#' -#' @format A data frame with 12 rows and 10 variables: -#' \describe{ -#' \item{Time}{} -#' \item{IndividualID}{} -#' \item{Population}{} -#' \item{Gender}{} -#' \item{Age}{} -#' \item{Compound}{} -#' \item{Dose}{} -#' \item{Organ}{} -#' \item{Compartment}{} -#' \item{Simulated}{} -#' } -"timeProfileDataFrame" diff --git a/R/datamapping-range.R b/R/datamapping-range.R index 7e3de807..e70f0b82 100644 --- a/R/datamapping-range.R +++ b/R/datamapping-range.R @@ -48,8 +48,8 @@ RangeDataMapping <- R6::R6Class( #' @description Check that \code{data} variables include map variables #' @param data data.frame to check #' @param metaData list containing information on \code{data} - #' @return A data.frame with map and \code{defaultAes} variables. - #' Dummy variable \code{defaultAes} is necessary to allow further modification of plots. + #' @return A data.frame with map and \code{legendLabels} variables. + #' Dummy variable \code{legendLabels} is necessary to allow further modification of plots. checkMapData = function(data, metaData = NULL) { validateMapping(self$x, data, nullAllowed = TRUE) if (isOfType(self$ymin, "character")) { diff --git a/R/ddiratio-datamapping.R b/R/ddiratio-datamapping.R index 44495991..7d3bb737 100644 --- a/R/ddiratio-datamapping.R +++ b/R/ddiratio-datamapping.R @@ -3,28 +3,29 @@ #' @export DDIRatioDataMapping <- R6::R6Class( "DDIRatioDataMapping", - inherit = XYGDataMapping, - public = list( - #' @field ddiRatioLines numeric vector of ratio limits to plot - ddiRatioLines = NULL, - #' @field deltaGuest numeric value of Guest et al ratio limits - deltaGuest = NULL, - #' @field range 2 elements vector of x limits - range = NULL, + inherit = PKRatioDataMapping, + public = list( + #' @field comparisonType Options for comparison from enum `MappingComparisonTypes` + comparisonType = NULL, + #' @field minRange Mininmum range for guest and ratio lines + minRange = NULL, #' @description Create a new \code{DDIRatioDataMapping} object - #' @param ddiRatioValues list of values for ratio and guest limits to plot - #' @param range 2 elements vector of x limits - #' @param ... parameters inherited from \code{XYGDataMapping} + #' @param comparisonType Options for comparison from enum `DDIComparisonTypes` + #' @param minRange Mininmum range for guest and ratio lines + #' @param lines list of ratio and guest limits to plot as horizontal lines + #' @param ... parameters inherited from \code{PKRatioDataMapping} #' @return A new \code{DDIRatioDataMapping} object - initialize = function(ddiRatioValues = DefaultDataMappingValues$ddiRatio, - range = c(1e-2, 1e2), + initialize = function(comparisonType = DDIComparisonTypes$obsVsPred, + minRange = c(1e-2, 1e2), + lines = DefaultDataMappingValues$ddiRatio, ...) { + validateIsIncluded(comparisonType, MappingComparisonTypes) super$initialize(...) - self$ddiRatioLines <- c(ddiRatioValues$ddiRatio1, ddiRatioValues$ddiRatio2) - self$deltaGuest <- ddiRatioValues$guestLine - self$range <- range + self$lines <- lines + self$comparisonType <- comparisonType + self$minRange <- minRange }, #' @description Create a data.frame with DDI ratio limits @@ -37,7 +38,7 @@ DDIRatioDataMapping <- R6::R6Class( x <- 10^(seq(log10(xmin), log10(xmax), 0.01)) - y <- x * self$ddiRatioLines[1] + y <- x * self$lines$ddiRatioLines[1] ymax <- x * self$ddiRatioLines[2] ymin <- x * self$ddiRatioLines[3] diff --git a/R/ddiratio-plotconfiguration.R b/R/ddiratio-plotconfiguration.R index 3025c8d7..c4d66bf6 100644 --- a/R/ddiratio-plotconfiguration.R +++ b/R/ddiratio-plotconfiguration.R @@ -3,22 +3,5 @@ #' @export DDIRatioPlotConfiguration <- R6::R6Class( "DDIRatioPlotConfiguration", - inherit = PlotConfiguration, - public = list( - #' @field ddiRatioCaption list of properties for DDI ratio plot specific features - ddiRatioCaption = NULL, - - #' @description Create a new \code{DDIRatioPlotConfiguration} object - #' @param ddiRatioCaption list of properties for DDI ratio plot specific features - #' @param ... parameters inherited from \code{PlotConfiguration} - #' @return A new \code{DDIRatioPlotConfiguration} object - initialize = function(ddiRatioCaption = getDefaultCaptionFor("ddiRatio"), - ...) { - validateIsOfType(ddiRatioCaption, "data.frame") - validateIsIncluded(names(ddiRatioCaption), CaptionProperties) - super$initialize(...) - - self$ddiRatioCaption <- ddiRatioCaption - } - ) + inherit = PKRatioPlotConfiguration ) diff --git a/R/font.R b/R/font.R index 789e9139..dcbcb84f 100644 --- a/R/font.R +++ b/R/font.R @@ -1,54 +1,53 @@ #' @title Font -#' @description R6 class defining \code{size}, \code{color}, \code{fontFamily}, \code{fontFace} of font -#' @include utils.R +#' @description R6 class defining font properties +#' @field size numeric defining the size of font +#' @field color character defining the color of font +#' @field fontFamily character defining the family of font +#' @field fontFace character defining the face of font +#' @field angle numeric defining the angle of font #' @export Font <- R6::R6Class( "Font", public = list( - #' @field size numeric size of font size = 12, - #' @field color character color of font color = "black", - #' @field fontFamily character family of font fontFamily = "", - #' @field fontFace character face of font fontFace = "plain", + angle = 0, #' @description Create a new \code{Font} object. #' Default font properties are defined directly in the object field, #' so `NULL` input is allowed will lead to default properties. - #' @param size numeric size of font - #' @param color character color of font - #' @param fontFamily character family of font - #' @param fontFace character face of font + #' @param size numeric defining the size of font + #' @param color character defining the color of font + #' @param fontFamily character defining the family of font + #' @param fontFace character defining the face of font + #' @param angle numeric defining the angle of font #' @return A new \code{Font} object initialize = function(size = NULL, color = NULL, fontFamily = NULL, - fontFace = NULL) { - self$size <- size %||% self$size - self$color <- color %||% self$color - self$fontFamily <- fontFamily %||% self$fontFamily - self$fontFace <- fontFace %||% self$fontFace - }, + fontFace = NULL, + angle = NULL) { + validateIsString(c(color, fontFamily, fontFace), nullAllowed = TRUE) + validateIsNumeric(c(size, angle), nullAllowed = TRUE) - #' @description Print \code{Font} properties. - print = function() { - cat("size:", self$size, "\n", sep = " ") - cat("color:", self$color, "\n", sep = " ") - cat("fontFamily:", self$fontFamily, "\n", sep = " ") - cat("fontFace:", self$fontFace, "\n", sep = " ") - invisible(self) + fieldNames <- c("size", "color", "fontFace", "fontFamily", "angle") + setFontExpression <- parse(text = paste0("self$", fieldNames, " <- ", fieldNames, " %||% self$", fieldNames)) + eval(setFontExpression) }, - #' @description Create an `element_text` for ggplot with \code{Font} properties. - #' @return An `element_text` for ggplot with \code{Font} properties. - setFont = function() { - element_text( + #' @description Create a `ggplot2::element_text` directly convertible by `ggplot2::theme`. + #' @return An `element_text` object. + createPlotFont = function() { + ggplot2::element_text( colour = self$color, size = self$size, face = self$fontFace, - family = self$fontFamily + # TO DO: check why I get the following error messages + # "font family not found in Windows font database" + #family = self$fontFamily, + angle = self$angle ) } ) diff --git a/R/histogram-datamapping.R b/R/histogram-datamapping.R index 00dbd1d0..54b8f924 100644 --- a/R/histogram-datamapping.R +++ b/R/histogram-datamapping.R @@ -6,31 +6,41 @@ HistogramDataMapping <- R6::R6Class( "HistogramDataMapping", inherit = XYGDataMapping, public = list( - #' @field verticalLineGroupings R6 class \code{Grouping} variable - verticalLineGroupings = NULL, - #' @field verticalLineFunctionNames Vector of function name - #' to be indicated in captions of the histogram - verticalLineFunctionNames = NULL, - #' @field verticalLineFunctions List of functions calculated on \code{data} - #' to obtain vertical lines on the histogram - verticalLineFunctions = NULL, + #' @field stack logical defining if histogram bars should be stacked + stack = NULL, + #' @field bins number of bins or binning values/methods passed on `ggplot2::geom_histogram` + bins = NULL, + #' @field lines values or functions to define vertical lines + lines = NULL, + #' @field fitNormalDist logical defining if a normal distribution should be fitted + fitNormalDist = NULL, + #' @field fitDensity logical defining if a density distribution function should be fitted + fitDensity = NULL, #' @description Create a new \code{HistogramDataMapping} object - #' @param verticalLineGroupings R6 class \code{Grouping} variable - #' @param verticalLineFunctionNames Vector of function name to be indicated in captions of the histogram - #' Default value uses `mean` and `median`. - #' @param verticalLineFunctions List of functions calculated on \code{data} - #' Default value uses `mean` and `median`. + #' @param stack logical defining if histogram bars should be stacked + #' @param bins argument passed on `ggplot2::geom_histogram` + #' @param lines values or functions to define vertical lines + #' @param fitNormalDist logical defining if a normal distribution should be fitted + #' @param fitDensity logical defining if a density distribution should be fitted #' @param ... parameters inherited from \code{XYGDataMapping} #' @return A new \code{HistogramDataMapping} object - initialize = function(verticalLineGroupings = NULL, - verticalLineFunctionNames = c("mean", "median"), - verticalLineFunctions = c(mean, median), + initialize = function(stack = FALSE, + bins = NULL, + lines = DefaultDataMappingValues$histogram, + fitNormalDist = FALSE, + fitDensity = FALSE, ...) { super$initialize(...) - self$verticalLineGroupings <- verticalLineGroupings - self$verticalLineFunctionNames <- verticalLineFunctionNames - self$verticalLineFunctions <- verticalLineFunctions + validateIsLogical(stack) + validateIsLogical(fitNormalDist) + validateIsLogical(fitDensity) + self$stack <- stack + self$fitNormalDist <- fitNormalDist + self$fitDensity <- fitDensity + + self$bins <- bins + self$lines <- lines } ) ) diff --git a/R/histogram-plotconfiguration.R b/R/histogram-plotconfiguration.R index 1d2c4b91..c10ab84b 100644 --- a/R/histogram-plotconfiguration.R +++ b/R/histogram-plotconfiguration.R @@ -6,62 +6,24 @@ HistogramPlotConfiguration <- R6::R6Class( inherit = PlotConfiguration, public = list( - #' @field mapData data.frame after dataMapping - mapData = NULL, - #' @field bins numeric vector of bin edges - bins = NULL, - #' @field binWidth numeric value of bin width - binWidth = NULL, - - #' @description Create a new \code{TimeProfilePlotConfiguration} object - #' @param bins numeric vector of bin edges - #' @param binWidth numeric value of bin width + + #' @description Create a new \code{HistogramPlotConfiguration} object + #' @param lines `ThemeAestheticSelections` object defining properties for vertical lines + #' @param ribbons `ThemeAestheticSelections` object defining properties for histogram + #' @param ylabel Histograms default display is "Count" #' @param ... parameters inherited from \code{PlotConfiguration} #' @return A new \code{TimeProfilePlotConfiguration} object - initialize = function(binWidth = NULL, - bins = NULL, + initialize = function(lines = NULL, + ribbons = NULL, + ylabel = "Count", ...) { - super$initialize(...) - - self$binWidth <- binWidth - self$bins <- bins %||% tlfEnv$defaultAggregation$bins - }, + super$initialize(ylabel = ylabel, ...) - #' @description Add histogram as histogram layer to a \code{ggplot} object - #' @param plotObject \code{ggplot} object - #' @param data data.frame - #' @param metaData list of information on \code{data} - #' @param dataMapping R6 class \code{HistogramDataMapping} - #' @param bins numeric vector of bin edges - #' @param binWidth numeric value of bin width - #' @return A \code{ggplot} object with histogram - addHistograms = function(plotObject, - data, - metaData = NULL, - dataMapping, - binWidth = NULL, bins = NULL) { - binWidth <- binWidth %||% self$binWidth - bins <- bins %||% self$bins - - mapData <- dataMapping$checkMapData(data, metaData) - - # Convert the mapping into characters usable by aes_string - mapLabels <- getAesStringMapping(dataMapping) - - plotObject <- plotObject + ggplot2::geom_histogram( - data = mapData, - mapping = ggplot2::aes_string(x = mapLabels$x, fill = mapLabels$fill, color = mapLabels$fill), - show.legend = TRUE, - binwidth = binWidth, - bins = bins, - alpha = self$theme$aesProperties$alpha[1] - ) - - # If no mapping defined, remove dummy aesthetic label from the legend - plotObject <- plotObject + - ifEqual("legendLabels", mapLabels$fill, guides(fill = "none", color="none")) - - return(plotObject) + validateIsOfType(lines, "ThemeAestheticSelections", nullAllowed = TRUE) + validateIsOfType(ribbons, "ThemeAestheticSelections", nullAllowed = TRUE) + currentTheme <- tlfEnv$currentTheme$clone(deep = TRUE) + private$.lines <- lines %||% asThemeAestheticSelections(currentTheme$plotConfigurations$plotHistogram$lines) + private$.ribbons <- ribbons %||% asThemeAestheticSelections(currentTheme$plotConfigurations$plotHistogram$ribbons) }, #' @description Add statistics as line layer to a \code{ggplot} object diff --git a/R/label.R b/R/label.R index df656c10..cd5606b1 100644 --- a/R/label.R +++ b/R/label.R @@ -4,68 +4,69 @@ Label <- R6::R6Class( "Label", public = list( - #' @field text character text of label - text = NULL, - #' @field font R6 class \code{Font} object - font = NULL, - #' @description Create a new \code{Label} object. - #' @param text character text of label - #' @param font R6 class \code{Font} object - #' @param size numeric size of font - #' @param color character color of font - #' @param fontFamily character family of font - #' @param fontFace character face of font + #' @param text character text of the \code{Label} object + #' @param font \code{Font} object defining the font of the `Label` object + #' @param size numeric defining the size of the `Label` object + #' @param color character defining the color of the `Label` object + #' @param fontFamily character defining the font family of the `Label` object + #' @param fontFace character defining the font face of the `Label` object + #' @param angle numeric defining the angle of the `Label` object #' @return A new \code{Label} object initialize = function(text = "", font = NULL, color = NULL, size = NULL, fontFace = NULL, - fontFamily = NULL) { + fontFamily = NULL, + angle = NULL) { + validateIsNumeric(c(as.numeric(angle), as.numeric(size)), nullAllowed = TRUE) + validateIsString(c(color, fontFace, fontFamily), nullAllowed = TRUE) + validateIsOfType(font, "Font", nullAllowed = TRUE) + self$text <- text - validateEitherOrNullInput( - list("font" = font), - list( - "color" = color, - "size" = size, - "fontFace" = fontFace, - "fontFamily" = fontFamily - ) - ) + self$font <- font %||% Font$new() - self$font <- font %||% Font$new( - color = color, - size = size, - fontFace = fontFace, - fontFamily = fontFamily - ) - validateIsOfType(self$font, Font) + # If font properties are explicitely written, they will overwrite the properties of input Font + fieldNames <- c("size", "color", "fontFace", "fontFamily", "angle") + setFontExpression <- parse(text = paste0("self$font$", fieldNames, " <- ", fieldNames, " %||% self$font$", fieldNames)) + eval(setFontExpression) }, - #' @description Print \code{Label} properties. - print = function() { - cat("text:", self$text, "\n", sep = " ") - cat("font color:", self$font$color, "\n", sep = " ") - cat("font size:", self$font$size, "\n", sep = " ") - cat("font family:", self$font$fontFamily, "\n", sep = " ") - cat("font face:", self$font$fontFace, "\n", sep = " ") - invisible(self) + #' @description Create a `ggplot2::element_text` directly convertible by `ggplot2::theme`. + #' @return An `element_text` or `element_blank`object. + createPlotFont = function() { + if (isOfLength(self$text, 0)) { + return(ggplot2::element_blank()) + } + return(self$font$createPlotFont()) + } + ), + active = list( + #' @field text character text of the label + text = function(value) { + if (missing(value)) { + return(private$.text) + } + validateIsString(value, nullAllowed = TRUE) + private$.text <- value + return(invisible()) }, - - #' @description Set font properties of Label - #' @param size numeric size of font - #' @param color character color of font - #' @param fontFamily character family of font - #' @param fontFace character face of font - setFontProperties = function(color = self$font$color, - size = self$font$size, - fontFamily = self$font$fontFamily, - fontFace = self$font$fontFace) { - self$font$color <- color - self$font$size <- size - self$font$fontFamily <- fontFamily - self$font$fontFace <- fontFace + #' @field font \code{Font} object + font = function(value) { + if (missing(value)) { + return(private$.font) + } + validateIsOfType(value, "Font", nullAllowed = TRUE) + private$.font <- value %||% Font$new() + # Ensures that size and angle are numeric + private$.font$size <- as.numeric(private$.font$size) + private$.font$angle <- as.numeric(private$.font$angle) + return(invisible()) } + ), + private = list( + .text = NULL, + .font = NULL ) ) diff --git a/R/messages.R b/R/messages.R index a3327037..212807c3 100644 --- a/R/messages.R +++ b/R/messages.R @@ -51,5 +51,9 @@ messages <- list( "Conflicting inputs provided. Inputs '", paste0(eitherInput, collapse = ", "), "' and '", paste0(orInput, collapse = ", "), "' can't be provided at the same time." ) + }, + + errorNrowData = function(plotName) { + paste0("nrow(data)=0. ", plotName, " layer could not be added.") } ) diff --git a/R/obs-vs-pred-datamapping.R b/R/obs-vs-pred-datamapping.R index d8398f8a..4e8640d9 100644 --- a/R/obs-vs-pred-datamapping.R +++ b/R/obs-vs-pred-datamapping.R @@ -3,54 +3,32 @@ #' @export ObsVsPredDataMapping <- R6::R6Class( "ObsVsPredDataMapping", - inherit = XYGDataMapping, + inherit = ObservedDataMapping, public = list( - #' @field obsVsPredValues numeric vector of limits to plot - obsVsPredValues = NULL, - #' @field lloq numeric value of lower limit of quantification - lloq = NULL, + #' @field lines list of lines to plot + lines = NULL, + #' @field minRange Mininmum range for the lines + minRange = NULL, #' @field smoother regression function name smoother = NULL, - #' @field range 2 elements vector of x limits - range = NULL, #' @description Create a new \code{ObsVsPredDataMapping} object - #' @param obsVsPredValues list of values for obs vs pred plot - #' @param lloq numeric value of lower limit of quantification + #' @param minRange Mininmum range for guest and ratio lines + #' @param lines list of lines to plot #' @param smoother smoother function or parameter #' To map a loess smoother to the plot, use `smoother`="loess" - #' @param range 2 elements vector of x limits #' @param ... parameters inherited from \code{XYGDataMapping} #' @return A new \code{ObsVsPredDataMapping} object - initialize = function(obsVsPredValues = DefaultDataMappingValues$obsVsPred, - lloq = NULL, - range = NULL, + initialize = function(lines = DefaultDataMappingValues$obsVsPred, + minRange = NULL, smoother = NULL, ...) { + validateIsIncluded(smoother, c("lm", "loess"), nullAllowed = TRUE) + super$initialize(...) - self$obsVsPredValues <- obsVsPredValues - self$lloq <- lloq + self$lines <- lines self$smoother <- smoother - self$range <- range - }, - - #' @description Create a data.frame with of limits to plot - #' This data.frame is necessary in case if log-log plots as - #' \code{geom_abline} doesn't work properly in log scale - #' @param data data.frame of data - #' @return A data.frame - getObsVsPredLines = function(data) { - xmin <- ifnotnull(self$range, min(self$range), 0.8 * min(data[, self$x])) - xmax <- ifnotnull(self$range, max(self$range), 1.2 * max(data[, self$x])) - - x <- seq(xmin, xmax, 0.01) - if (xmin > 0) { - 10^(seq(log10(xmin), log10(xmax), 0.01)) - } - y <- x * self$obsVsPredValues$`y=x` - - obsVsPredLines <- data.frame(x = x, y = y) - return(obsVsPredLines) + self$minRange <- minRange } ) ) diff --git a/R/obs-vs-pred-plotconfiguration.R b/R/obs-vs-pred-plotconfiguration.R index d2f4e5fd..509b51f4 100644 --- a/R/obs-vs-pred-plotconfiguration.R +++ b/R/obs-vs-pred-plotconfiguration.R @@ -5,86 +5,25 @@ ObsVsPredPlotConfiguration <- R6::R6Class( "ObsVsPredPlotConfiguration", inherit = PlotConfiguration, public = list( - #' @field obsVsPredCaption list of properties for obs vs pred plot specific features - obsVsPredCaption = NULL, - #' @description Create a new \code{ObsVsPredPlotConfiguration} object - #' @param obsVsPredCaption list of properties for DDI ratio plot specific features + #' @param lines `ThemeAestheticSelections` object defining properties for lines + #' @param points `ThemeAestheticSelections` object defining properties for scatter points + #' @param errorbars `ThemeAestheticSelections` object defining properties for error bars #' @param ... parameters inherited from \code{PlotConfiguration} - #' @return A new \code{obsVsPredProperties} object - initialize = function(obsVsPredCaption = getDefaultCaptionFor("obsVsPred"), + #' @return A new \code{ObsVsPredPlotConfiguration} object + initialize = function(lines = NULL, + points = NULL, + errorbars = NULL, ...) { - validateIsOfType(obsVsPredCaption, "data.frame") - validateIsIncluded(names(obsVsPredCaption), CaptionProperties) super$initialize(...) - self$obsVsPredCaption <- obsVsPredCaption - }, - - #' @description Add smoother layer to a \code{ggplot} object - #' @param plotObject \code{ggplot} object - #' @param data data.frame - #' @param metaData list of information on \code{data} - #' @param dataMapping R6 class \code{ObsVsPredDataMapping} - #' @return A \code{ggplot} object with smoother - addSmoother = function(plotObject, data, metaData, dataMapping) { - # Check if mapping is included in the data - # Add the group mapping and aesthtics variables in the data.frame - mapData <- dataMapping$checkMapData(data, metaData) - - # Convert the mapping into characters usable by aes_string - mapLabels <- getAesStringMapping(dataMapping) - - plotObject <- plotObject + geom_smooth( - data = mapData, - mapping = aes_string( - x = mapLabels$x, - y = mapLabels$y, - color = mapLabels$color, - linetype = mapLabels$linetype, - size = mapLabels$size - ), - method = dataMapping$smoother, - se = FALSE, - show.legend = TRUE - ) - return(plotObject) - }, - - #' @description Add obs vs pred as scatter layer to a \code{ggplot} object - #' @param plotObject \code{ggplot} object - #' @param data data.frame - #' @param metaData list of information on \code{data} - #' @param dataMapping R6 class \code{ObsVsPredDataMapping} - #' @return A \code{ggplot} object - addObsVsPred = function(plotObject, data, metaData, dataMapping) { - - # Check if mapping is included in the data - # Add the group mapping and aesthtics variables in the data.frame - mapData <- dataMapping$checkMapData(data, metaData) - - # Convert the mapping into characters usable by aes_string - mapLabels <- getAesStringMapping(dataMapping) - - plotObject <- plotObject + geom_point( - data = mapData, - mapping = aes_string( - x = mapLabels$x, - y = mapLabels$y, - color = mapLabels$color, - shape = mapLabels$shape, - size = mapLabels$size - ), - show.legend = TRUE - ) - - # If no mapping defined, remove dummy aesthetic label from the legend - plotObject <- plotObject + - ifEqual("defaultAes", mapLabels$color, guides(color = "none")) + - ifEqual("defaultAes", mapLabels$shape, guides(shape = "none")) + - ifEqual("defaultAes", mapLabels$size, guides(size = "none")) - - return(plotObject) + validateIsOfType(lines, "ThemeAestheticSelections", nullAllowed = TRUE) + validateIsOfType(points, "ThemeAestheticSelections", nullAllowed = TRUE) + validateIsOfType(errorbars, "ThemeAestheticSelections", nullAllowed = TRUE) + currentTheme <- tlfEnv$currentTheme$clone(deep = TRUE) + private$.lines <- lines %||% asThemeAestheticSelections(currentTheme$plotConfigurations$plotObsVsPred$lines) + private$.points <- points %||% asThemeAestheticSelections(currentTheme$plotConfigurations$plotObsVsPred$points) + private$.errorbars <- errorbars %||% asThemeAestheticSelections(currentTheme$plotConfigurations$plotObsVsPred$errorbars) } ) ) diff --git a/R/observed-data-mapping.R b/R/observed-data-mapping.R new file mode 100644 index 00000000..3ba9a767 --- /dev/null +++ b/R/observed-data-mapping.R @@ -0,0 +1,69 @@ +#' @title ObservedDataMapping +#' @description R6 class for mapping \code{x}, \code{y}, of observed data for a time profile plot +#' @export +ObservedDataMapping <- R6::R6Class( + "ObservedDataMapping", + inherit = XYGDataMapping, + public = list( + #' @field lloq mapping lower limit of quantitation variable + lloq = NULL, + #' @field uncertainty mapping error bars around scatter points + uncertainty = NULL, + #' @field mdv mapping missing dependent variable + mdv = NULL, + #' @field ymin mapping error bars around scatter points + ymin = "ymin", + #' @field ymax mapping error bars around scatter points + ymax = "ymax", + + #' @description Create a new \code{PKRatioDataMapping} object + #' @param lloq mapping lower limit of quantitation variable + #' @param uncertainty mapping error bars around scatter points + #' @param mdv mapping missing dependent variable + #' @param ... parameters inherited from \code{XYGDataMapping} + #' @return A new \code{PKRatioDataMapping} object + initialize = function(lloq = NULL, + uncertainty = NULL, + mdv = NULL, + ...) { + validateIsString(lloq, nullAllowed = TRUE) + validateIsString(uncertainty, nullAllowed = TRUE) + validateIsString(mdv, nullAllowed = TRUE) + super$initialize(...) + self$lloq <- lloq + self$uncertainty <- uncertainty + self$mdv <- mdv + }, + + #' @description Check that \code{data} variables include map variables + #' @param data data.frame to check + #' @param metaData list containing information on \code{data} + #' @return A data.frame with map and \code{defaultAes} variables. + #' Dummy variable \code{defaultAes} is necessary to allow further modification of plots. + checkMapData = function(data, metaData = NULL) { + validateIsOfType(data, "data.frame") + validateIsIncluded(self$uncertainty, names(data), nullAllowed = TRUE) + validateIsIncluded(self$lloq, names(data), nullAllowed = TRUE) + validateIsIncluded(self$mdv, names(data), nullAllowed = TRUE) + + 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 uncertainty error bars + # This may change depending of how we want to include options + if (!isOfLength(self$uncertainty, 0)) { + mapData[, self$uncertainty] <- data[, self$uncertainty] + mapData$ymax <- data[, self$y] + data[, self$uncertainty] + mapData$ymin <- data[, self$y] - data[, self$uncertainty] + } + # MDV is a Nonmem notation in which values with MDV==1 are removed + if (!isOfLength(self$mdv, 0)) { + mapData <- mapData[!as.logical(data[, self$mdv]), ] + } + return(mapData) + } + ) +) diff --git a/R/pkratio-datamapping.R b/R/pkratio-datamapping.R index 6bf21ea6..0cab8d39 100644 --- a/R/pkratio-datamapping.R +++ b/R/pkratio-datamapping.R @@ -1,21 +1,45 @@ #' @title PKRatioDataMapping -#' @description R6 class for mapping \code{x}, \code{y}, \code{GroupMapping} and \code{pkRatioLines} variables to \code{data} +#' @description R6 class for mapping \code{x}, \code{y}, \code{GroupMapping} and pkRatio \code{lines} variables to \code{data} #' @export PKRatioDataMapping <- R6::R6Class( "PKRatioDataMapping", inherit = XYGDataMapping, public = list( - #' @field pkRatioValues numeric vector of ratio limits to plot - pkRatioValues = NULL, + #' @field lines list of ratio limits to plot as horizontal lines + lines = NULL, + #' @field uncertainty mapping error bars around scatter points + uncertainty = NULL, #' @description Create a new \code{PKRatioDataMapping} object - #' @param pkRatioValues numeric vector of ratio limits to plot + #' @param lines list of ratio limits to plot as horizontal lines + #' @param uncertainty mapping error bars around scatter points #' @param ... parameters inherited from \code{XYGDataMapping} #' @return A new \code{PKRatioDataMapping} object - initialize = function(pkRatioValues = DefaultDataMappingValues$pkRatio, + initialize = function(lines = DefaultDataMappingValues$pkRatio, + uncertainty = NULL, ...) { + validateIsString(uncertainty, nullAllowed = TRUE) super$initialize(...) - self$pkRatioValues <- pkRatioValues + self$lines <- lines + self$uncertainty <- uncertainty + }, + + #' @description Check that \code{data} variables include map variables + #' @param data data.frame to check + #' @param metaData list containing information on \code{data} + #' @return A data.frame with map and \code{defaultAes} variables. + #' Dummy variable \code{defaultAes} is necessary to allow further modification of plots. + checkMapData = function(data, metaData = NULL) { + validateIsOfType(data, "data.frame") + validateMapping(self$uncertainty, data, nullAllowed = TRUE) + mapData <- super$checkMapData(data, metaData) + # This may change depending of how we want to include options + if (!isOfLength(self$uncertainty, 0)) { + mapData$ymax <- data[, self$y] + data[, self$uncertainty] + mapData$ymin <- data[, self$y] - data[, self$uncertainty] + } + self$data <- mapData + return(mapData) } ) ) diff --git a/R/pkratio-plotconfiguration.R b/R/pkratio-plotconfiguration.R index 0f6a1e0b..66ee5eec 100644 --- a/R/pkratio-plotconfiguration.R +++ b/R/pkratio-plotconfiguration.R @@ -5,20 +5,26 @@ PKRatioPlotConfiguration <- R6::R6Class( "PKRatioPlotConfiguration", inherit = PlotConfiguration, public = list( - #' @field pkRatioCaption list of properties for PK ratio plot specific features - pkRatioCaption = NULL, #' @description Create a new \code{PKRatioPlotConfiguration} object - #' @param pkRatioCaption list of properties for PK ratio plot specific features + #' @param lines `ThemeAestheticSelections` object defining properties for PK ratio horizontal lines + #' @param points `ThemeAestheticSelections` object defining properties for PK ratio scatter points + #' @param errorbars `ThemeAestheticSelections` object defining properties for PK ratio error bars #' @param ... parameters inherited from \code{PlotConfiguration} #' @return A new \code{PKRatioPlotConfiguration} object - initialize = function(pkRatioCaption = getDefaultCaptionFor("pkRatio"), + initialize = function(lines = NULL, + points = NULL, + errorbars = NULL, ...) { - validateIsOfType(pkRatioCaption, "data.frame") - validateIsIncluded(names(pkRatioCaption), CaptionProperties) super$initialize(...) - self$pkRatioCaption <- pkRatioCaption + validateIsOfType(lines, "ThemeAestheticSelections", nullAllowed = TRUE) + validateIsOfType(points, "ThemeAestheticSelections", nullAllowed = TRUE) + validateIsOfType(errorbars, "ThemeAestheticSelections", nullAllowed = TRUE) + currentTheme <- tlfEnv$currentTheme$clone(deep = TRUE) + private$.lines <- lines %||% asThemeAestheticSelections(currentTheme$plotConfigurations$plotPKRatio$lines) + private$.points <- points %||% asThemeAestheticSelections(currentTheme$plotConfigurations$plotPKRatio$points) + private$.errorbars <- errorbars %||% asThemeAestheticSelections(currentTheme$plotConfigurations$plotPKRatio$errorbars) } ) ) diff --git a/R/plot-boxwhisker.R b/R/plot-boxwhisker.R new file mode 100644 index 00000000..4bf09e23 --- /dev/null +++ b/R/plot-boxwhisker.R @@ -0,0 +1,160 @@ +#' @title plotBoxWhisker +#' @param data data.frame (or list of data.frames? TO BE DISCUSSED) +#' containing the data to be used for the plot +#' @param metaData list of lists (structure TO BE DISCUSSED) +#' containing complementary information to data (e.g. unit) +#' @param outliers logical defining if outliers should be included in boxplot +#' @param dataMapping `BoxWhiskerDataMapping` object +#' mapping of x, y axes + mapping of colorGrouping, sizeGrouping, shapeGrouping +#' @param plotConfiguration `BoxWhiskerConfiguration` object +#' Plot Configuration defining title, subtitle, xlabel, ylabel watermark, and legend +#' @param plotObject +#' ggplot object, if null creates new plot, if not add time profile layers to ggplot +#' @description +#' plotBoxWhisker(data, metaData, dataMapping, plotConfiguration) +#' @return a ggplot graphical object +#' @export +plotBoxWhisker <- function(data, + metaData = NULL, + outliers = NULL, + dataMapping = NULL, + plotConfiguration = NULL, + plotObject = NULL) { + dataMapping <- dataMapping %||% BoxWhiskerDataMapping$new(data = data) + plotConfiguration <- plotConfiguration %||% BoxWhiskerPlotConfiguration$new( + data = data, + metaData = metaData, + dataMapping = dataMapping + ) + + validateIsOfType(dataMapping, "BoxWhiskerDataMapping") + validateIsOfType(plotConfiguration, "BoxWhiskerPlotConfiguration") + validateIsOfType(data, "data.frame") + validateIsOfType(plotObject, "ggplot", nullAllowed = TRUE) + + # Overwrites plotConfiguration$outliers if outliers is not null + validateIsLogical(outliers, nullAllowed = TRUE) + plotConfiguration$outliers <- outliers + + plotObject <- plotObject %||% initializePlot(plotConfiguration) + + if (nrow(data) == 0) { + warning(messages$errorNrowData("box whisker plot")) + return(plotObject) + } + + # Add Plot Configuration layers and box whisker plots + plotObject <- addBoxWhisker(data, metaData, dataMapping, plotConfiguration, plotObject) + if (plotConfiguration$outliers) { + plotObject <- addOutliers(data, metaData, dataMapping, plotConfiguration, plotObject) + } + return(plotObject) +} + +#' @title addBoxWhisker +#' @description Add layer of boxes and whiskers to a \code{ggplot} object +#' @param data data.frame +#' @param metaData list of information on \code{data} +#' @param dataMapping \code{BoxWhiskerDataMapping} object +#' @param plotConfiguration \code{BoxWhiskerPlotConfiguration} object +#' @param plotObject a \code{ggplot} object +#' @return A \code{ggplot} object +addBoxWhisker <- function(data, metaData, dataMapping, plotConfiguration, plotObject) { + + # Get the box plot quantiles from dataMapping + mapData <- dataMapping$getBoxWhiskerLimits(data) + # Convert the mapping into characters usable by aes_string + mapLabels <- getAesStringMapping(dataMapping) + + plotObject <- plotObject + + ggplot2::geom_boxplot( + data = mapData, + mapping = ggplot2::aes_string( + x = mapLabels$x, + ymin = "ymin", + lower = "lower", + middle = "middle", + upper = "upper", + ymax = "ymax", + fill = mapLabels$fill, + color = mapLabels$color + ), + alpha = getAestheticValues(n = 1, selectionKey = plotConfiguration$ribbons$alpha, position = 0, aesthetic = "alpha"), + size = getAestheticValues(n = 1, selectionKey = plotConfiguration$ribbons$size, position = 0, aesthetic = "size"), + linetype = getAestheticValues(n = 1, selectionKey = plotConfiguration$ribbons$linetype, position = 0, aesthetic = "linetype"), + show.legend = TRUE, + stat = "identity" + ) + + # Define linetype, color, f# Define shapes and colors based on plotConfiguration$points properties + fillVariable <- gsub("`", "", mapLabels$fill) + colorVariable <- gsub("`", "", mapLabels$color) + fillLength <- length(unique(mapData[, fillVariable])) + colorLength <- length(unique(mapData[, colorVariable])) + + plotObject <- plotObject + + ggplot2::scale_fill_manual(values = getAestheticValues(n = fillLength, selectionKey = plotConfiguration$ribbons$fill, aesthetic = "fill")) + + ggplot2::scale_color_manual(values = getAestheticValues(n = colorLength, selectionKey = plotConfiguration$ribbons$color, aesthetic = "color")) + + # If variable is legendLabel, remove it from legend + if (isIncluded(fillVariable, "legendLabels")) { + plotObject <- plotObject + ggplot2::guides(fill = FALSE) + } + if (isIncluded(colorVariable, "legendLabels")) { + plotObject <- plotObject + ggplot2::guides(color = FALSE) + } + return(plotObject) +} + +#' @title addOutliers +#' @description Add a outlier points layer to a \code{ggplot} object +#' @param data data.frame +#' @param metaData list of information on \code{data} +#' @param dataMapping \code{BoxWhiskerDataMapping} object +#' @param plotConfiguration \code{BoxWhiskerPlotConfiguration} object +#' @param plotObject a \code{ggplot} object +#' @return A \code{ggplot} object +addOutliers <- function(data, metaData, dataMapping, plotConfiguration, plotObject) { + mapData <- dataMapping$getOutliers(data) + # Convert the mapping into characters usable by aes_string + mapLabels <- getAesStringMapping(dataMapping) + + # addScatter cannot be used in this case, + # because position dodge is needed to align boxes and outlier points + # no matter the number of groups, the value of 0.9 will be always fix + # otherwise, points won't be centered anymore + # besides, mapData includes NA instead of non-outlying data, + # na.rm removes these points without sending warning + plotObject <- plotObject + + ggplot2::geom_point( + data = mapData, + mapping = ggplot2::aes_string( + x = mapLabels$x, + y = "maxOutliers", + group = mapLabels$fill, + color = mapLabels$color + ), + size = getAestheticValues(n = 1, selectionKey = plotConfiguration$points$size, position = 0, aesthetic = "size"), + shape = getAestheticValues(n = 1, selectionKey = plotConfiguration$points$shape, position = 0, aesthetic = "shape"), + color = getAestheticValues(n = 1, selectionKey = plotConfiguration$points$color, position = 0, aesthetic = "color"), + show.legend = TRUE, + na.rm = TRUE, + position = position_dodge(width = 0.9) + ) + + ggplot2::geom_point( + data = mapData, + mapping = ggplot2::aes_string( + x = mapLabels$x, + y = "minOutliers", + group = mapLabels$fill, + color = mapLabels$color + ), + size = getAestheticValues(n = 1, selectionKey = plotConfiguration$points$size, position = 0, aesthetic = "size"), + shape = getAestheticValues(n = 1, selectionKey = plotConfiguration$points$shape, position = 0, aesthetic = "shape"), + color = getAestheticValues(n = 1, selectionKey = plotConfiguration$points$color, position = 0, aesthetic = "color"), + show.legend = TRUE, + na.rm = TRUE, + position = position_dodge(width = 0.9) + ) + return(plotObject) +} diff --git a/R/plot-ddiratio.R b/R/plot-ddiratio.R index 44778dea..c25a6212 100644 --- a/R/plot-ddiratio.R +++ b/R/plot-ddiratio.R @@ -14,27 +14,188 @@ plotDDIRatio <- function(data, metaData = NULL, dataMapping = NULL, + comparisonType = NULL, plotConfiguration = NULL, plotObject = NULL) { + validateIsOfType(data, "data.frame") dataMapping <- dataMapping %||% DDIRatioDataMapping$new(data = data) plotConfiguration <- plotConfiguration %||% DDIRatioPlotConfiguration$new(data = data, metaData = metaData, dataMapping = dataMapping) - validateIsOfType(dataMapping, DDIRatioDataMapping) - validateIsOfType(plotConfiguration, DDIRatioPlotConfiguration) + validateIsOfType(dataMapping, "DDIRatioDataMapping") + validateIsOfType(plotConfiguration, "PKRatioPlotConfiguration") + validateIsOfType(plotObject, "ggplot", nullAllowed = TRUE) - ratioData <- dataMapping$getDDIRatioLines() - guestData <- dataMapping$getGuestLines() + if (nrow(data) == 0) { + warning(messages$errorNrowData("PK ratio plot")) + return(plotObject) + } + + # Get transformed data from mapping and convert labels into characters usable by aes_string + mapData <- dataMapping$checkMapData(data) + mapLabels <- getAesStringMapping(dataMapping) plotObject <- plotObject %||% initializePlot(plotConfiguration) - plotObject <- addLine(x = ratioData$x, y = ratioData$y, caption = "ddiRatioLine1", plotObject = plotObject) - plotObject <- addLine(x = ratioData$x, y = ratioData$ymin, caption = "ddiRatioLine2", plotObject = plotObject) - plotObject <- addLine(x = ratioData$x, y = ratioData$ymax, caption = "ddiRatioLine2", plotObject = plotObject) + plotObject <- addDDIRatioLines(data, + metaData, + dataMapping, + plotConfiguration = plotConfiguration, + plotObject = plotObject + ) + + # If uncertainty is defined, add error bars + if (!isOfLength(dataMapping$uncertainty, 0)) { + plotObject <- plotObject + + ggplot2::geom_linerange( + data = mapData, + mapping = aes_string( + x = mapLabels$x, + ymin = "ymin", + ymax = "ymax", + color = mapLabels$color + ), + # Error bar size uses a ratio of 1/4 to match with point size + size = getAestheticValues(n = 1, selectionKey = plotConfiguration$errorbars$size, position = 0, aesthetic = "size"), + linetype = getAestheticValues(n = 1, selectionKey = plotConfiguration$errorbars$linetype, aesthetic = "linetype"), + show.legend = TRUE + ) + } + plotObject <- plotObject + + ggplot2::geom_point( + data = mapData, + mapping = ggplot2::aes_string( + x = mapLabels$x, + y = mapLabels$y, + color = mapLabels$color, + shape = mapLabels$shape + ), + size = getAestheticValues(n = 1, selectionKey = plotConfiguration$points$size, position = 0, aesthetic = "size"), + show.legend = TRUE + ) + + # Define shapes and colors based on plotConfiguration$points properties + shapeVariable <- gsub("`", "", mapLabels$shape) + colorVariable <- gsub("`", "", mapLabels$color) + shapeLength <- length(unique(mapData[, shapeVariable])) + colorLength <- length(unique(mapData[, colorVariable])) + + plotObject <- plotObject + + ggplot2::scale_shape_manual(values = getAestheticValues(n = shapeLength, selectionKey = plotConfiguration$points$shape, aesthetic = "shape")) + + ggplot2::scale_color_manual(values = getAestheticValues(n = colorLength, selectionKey = plotConfiguration$points$color, aesthetic = "color")) + + # If variable is legendLabel, remove it from legend + if (isIncluded(shapeVariable, "legendLabels")) { + plotObject <- plotObject + ggplot2::guides(shape = FALSE) + } + if (isIncluded(colorVariable, "legendLabels")) { + plotObject <- plotObject + ggplot2::guides(color = FALSE) + } + # Try is used to prevent crashes in the final plot due to ggplot2 peculiarities regarding scale functions + try(suppressMessages(plotObject <- setXAxis(plotObject))) + try(suppressMessages(plotObject <- setYAxis(plotObject))) + return(plotObject) +} + +#' @title addDDIRatioLines +#' @param data data.frame (or list of data.frames? TO BE DISCUSSED) +#' containing the data to be used for the plot +#' @param metaData list of lists (structure TO BE DISCUSSED) +#' containing complementary information to data (e.g. unit) +#' @param dataMapping R6 class PKRatioDataMapping +#' mapping of x, y axes + mapping of colorGrouping, sizeGrouping, shapeGrouping +#' @param plotConfiguration R6 class PKRatioPlotConfiguration +#' Plot Configuration defining title, subtitle, xlabel, ylabel watermark, and legend +#' @description +#' addDDIRatioLines(data, metaData, dataMapping, plotConfiguration, plotObject) +#' @return a ggplot graphical object +addDDIRatioLines <- function(data, + metaData = NULL, + dataMapping = NULL, + comparisonType = NULL, + plotConfiguration = NULL, + plotObject = NULL) { + validateIsOfType(dataMapping, "DDIRatioDataMapping") + validateIsOfType(plotConfiguration, "PKRatioPlotConfiguration") + validateIsOfType(plotObject, "ggplot", nullAllowed = TRUE) + validateIsIncluded(comparisonType, DDIComparisonTypes, nullAllowed = TRUE) + + dataMapping$comparisonType <- comparisonType %||% dataMapping$comparisonType - plotObject <- addLine(x = ratioData$x, y = guestData$ymin, caption = "guestLine", plotObject = plotObject) - plotObject <- addLine(x = ratioData$x, y = guestData$ymax, caption = "guestLine", plotObject = plotObject) + # Get range of x values to plot + xmin <- min(dataMapping$minRange, data[, dataMapping$x]) + xmax <- max(dataMapping$minRange, data[, dataMapping$x]) + # Not sure yet if this should be handled this way or using an external option from the dataMapping + x <- 10^(seq(log10(xmin), log10(xmax), 1e-3)) - plotObject <- setLegendCaption(plotObject, plotConfiguration$ddiRatioCaption) - plotObject <- addScatter(data = data, dataMapping = dataMapping, plotObject = plotObject) + ratioData <- list() + + # If comparison type is obs vs pred: to be compared with line of identity + if (isIncluded(dataMapping$comparisonType, DDIComparisonTypes$obsVsPred)) { + ratioData$ddiRatio1 <- data.frame( + x = x, + y = dataMapping$lines$ddiRatio1 * x + ) + ratioData$ddiRatio2 <- data.frame( + x = x, + ymin = min(dataMapping$lines$ddiRatio2) * x, + ymax = max(dataMapping$lines$ddiRatio2) * x + ) + ratioData$guestRatio <- getGuestValues(x, delta = dataMapping$lines$guestRatio) + } + # If comparison type is residuals vs pred: to be compared with line of ratio = 1 + if (isIncluded(dataMapping$comparisonType, DDIComparisonTypes$resVsPred)) { + ratioData$ddiRatio1 <- data.frame( + x = x, + y = dataMapping$lines$ddiRatio1 + ) + ratioData$ddiRatio2 <- data.frame( + x = x, + ymin = min(dataMapping$lines$ddiRatio2), + ymax = max(dataMapping$lines$ddiRatio2) + ) + ratioData$guestRatio <- getGuestValues(x, delta = dataMapping$lines$guestRatio) + ratioData$guestRatio$ymin <- ratioData$guestRatio$ymin / ratioData$guestRatio$x + ratioData$guestRatio$ymax <- ratioData$guestRatio$ymax / ratioData$guestRatio$x + } + + # Use expressions to simplify code + # Goal is to draw ratio lines with specific aesthetic values + ratioLineNames <- c("ddiRatio1", "ddiRatio2", "ddiRatio2", "guestRatio", "guestRatio") + ratioLineVariables <- c("y", "ymin", "ymax", "ymin", "ymax") + ratioLinePositions <- c("0", "1", "1", "2", "2") + + addLineExpression <- parse(text = paste0("plotObject <- plotObject + + ggplot2::geom_path(data = ratioData$", ratioLineNames, ", + mapping = ggplot2::aes_string(x='x', y='", ratioLineVariables, "'), + color = getAestheticValues(n=1, selectionKey = plotConfiguration$lines$color, position = ", ratioLinePositions, ", aesthetic = 'color'), + linetype = getAestheticValues(n=1, selectionKey = plotConfiguration$lines$linetype, position = ", ratioLinePositions, ", aesthetic = 'linetype'), + size = getAestheticValues(n=1, selectionKey = plotConfiguration$lines$size, position = ", ratioLinePositions, ", aesthetic = 'size'))")) + eval(addLineExpression) return(plotObject) } + +#' @title getGuestValues +#' @description Get a data.frame with Guest et al. ratio limits +#' @param x input values of Guest function +#' @param delta parameter of Guest function +#' @return A data.frame with Guest et al. ratio limits as ymin and ymax +#' @export +getGuestValues <- function(x, delta = 1) { + xSym <- x + xSym[x < 1] <- 1 / x[x < 1] + limit <- (delta + 2 * (xSym - 1)) / xSym + ymin <- x / limit + ymax <- x * limit + + guestLines <- data.frame(x, ymin, ymax) + return(guestLines) +} + +#' @title runDDIRatioPlot +#' @description +#' Run shiny app to use `plotDDIRatio()` from user interface +#' @export +runDDIRatioPlot <- function() { + appPath <- system.file("ddi-ratio", package = "tlf") + shiny::runApp(appPath) +} diff --git a/R/plot-histogram.R b/R/plot-histogram.R index f0e75c6f..3f8fdc14 100644 --- a/R/plot-histogram.R +++ b/R/plot-histogram.R @@ -19,29 +19,104 @@ plotHistogram <- function(data, metaData = NULL, dataMapping = NULL, - plotConfiguration = NULL, - binWidth = NULL, bins = NULL, - verticalLineFunctions = NULL, - verticalLineFunctionNames = NULL, + stack = NULL, + fitNormalDist = NULL, + fitDensity = NULL, + plotConfiguration = NULL, plotObject = NULL) { - dataMapping <- dataMapping %||% HistogramDataMapping$new() + dataMapping <- dataMapping %||% HistogramDataMapping$new(data = data) plotConfiguration <- plotConfiguration %||% HistogramPlotConfiguration$new( - binWidth = binWidth, - bins = bins, - ylabel = "Count", data = data, metaData = metaData, - dataMapping = dataMapping) + dataMapping = dataMapping + ) + + validateIsOfType(dataMapping, "HistogramDataMapping") + validateIsOfType(plotConfiguration, "HistogramPlotConfiguration") + validateIsOfType(data, "data.frame") + validateIsOfType(plotObject, "ggplot", nullAllowed = TRUE) - validateIsOfType(dataMapping, HistogramDataMapping) - validateIsOfType(plotConfiguration, HistogramPlotConfiguration) - validateIsOfType(plotObject, ggplot, nullAllowed = TRUE) + # Overwrites plotConfiguration and dataMapping if some inputs are not null + validateIsLogical(stack, nullAllowed = TRUE) + validateIsLogical(fitNormalDist, nullAllowed = TRUE) + validateIsLogical(fitDensity, nullAllowed = TRUE) + dataMapping$stack <- stack %||% dataMapping$stack + dataMapping$fitNormalDist <- fitNormalDist %||% dataMapping$fitNormalDist + dataMapping$fitDensity <- fitDensity %||% dataMapping$fitDensity + dataMapping$bins <- bins %||% dataMapping$bins plotObject <- plotObject %||% initializePlot(plotConfiguration) - plotObject <- plotConfiguration$addHistograms(plotObject, data, metaData, dataMapping, bins, binWidth) - - #plotObject <- plotConfiguration$addVerticalLines(plotObject, data, metaData, dataMapping) + if (nrow(data) == 0) { + warning(messages$errorNrowData("Histogram")) + return(plotObject) + } + + # Get transformed data from mapping and convert labels into characters usable by aes_string + mapData <- dataMapping$checkMapData(data) + mapLabels <- getAesStringMapping(dataMapping) + + position <- ggplot2::position_nudge() + if (dataMapping$stack) { + position <- ggplot2::position_stack() + } + + plotObject <- plotObject + + ggplot2::geom_histogram( + data = mapData, + mapping = ggplot2::aes_string( + x = mapLabels$x, + fill = mapLabels$fill + ), + position = position, + bins = dataMapping$bins %||% tlfEnv$defaultAggregation$bins, + size = getAestheticValues(n = 1, selectionKey = plotConfiguration$ribbons$size, position = 0, aesthetic = "size"), + color = getAestheticValues(n = 1, selectionKey = plotConfiguration$ribbons$color, position = 0, aesthetic = "color"), + alpha = getAestheticValues(n = 1, selectionKey = plotConfiguration$ribbons$alpha, position = 0, aesthetic = "alpha") + ) + + # Vertical lines defined in dataMapping$lines + for (lineIndex in dataMapping$lines) { + plotObject <- plotObject + + ggplot2::geom_vline( + xintercept = dataMapping$lines[lineIndex], + size = getAestheticValues(n = 1, selectionKey = plotConfiguration$lines$size, position = lineIndex - 1, aesthetic = "size"), + color = getAestheticValues(n = 1, selectionKey = plotConfiguration$lines$color, position = lineIndex - 1, aesthetic = "color"), + linetype = getAestheticValues(n = 1, selectionKey = plotConfiguration$lines$linetype, position = lineIndex - 1, aesthetic = "linetype") + ) + } + # Lines fitting a normal distribution + if (dataMapping$fitNormalDist) { + histResult <- graphics::hist(data[, dataMapping$x], breaks = dataMapping$bins %||% tlfEnv$defaultAggregation$bins, plot = FALSE) + scalingFactor <- mean(histResult$counts[histResult$counts > 0] / histResult$density[histResult$counts > 0]) + xmean <- mean(data[, dataMapping$x]) + xsd <- stats::sd(data[, dataMapping$x], na.rm = TRUE) + xDensityData <- seq(xmean - 3 * xsd, xmean + 3 * xsd, 6 * xsd / 100) + yDensityData <- scalingFactor * stats::dnorm(xDensityData, mean = xmean, sd = xsd) + densityData <- data.frame(x = xDensityData, y = yDensityData) + + plotObject <- plotObject + + ggplot2::geom_path( + data = densityData, + mapping = ggplot2::aes_string(x = "x", y = "y"), + size = getAestheticValues(n = 1, selectionKey = plotConfiguration$lines$size, position = 0, aesthetic = "size"), + color = getAestheticValues(n = 1, selectionKey = plotConfiguration$lines$color, position = 0, aesthetic = "color"), + linetype = getAestheticValues(n = 1, selectionKey = plotConfiguration$lines$linetype, position = 0, aesthetic = "linetype") + ) + } + + # Define fill based on plotConfiguration$points properties + fillVariable <- gsub("`", "", mapLabels$fill) + fillLength <- length(unique(mapData[, fillVariable])) + + plotObject <- plotObject + + ggplot2::scale_fill_manual(values = getAestheticValues(n = fillLength, selectionKey = plotConfiguration$ribbons$fill, aesthetic = "fill")) + + # If variable is legendLabel, remove it from legend + if (isIncluded(fillVariable, "legendLabels")) { + plotObject <- plotObject + ggplot2::guides(fill = FALSE) + } + # dataMapping$smoother return(plotObject) } diff --git a/R/plot-obs-vs-pred.R b/R/plot-obs-vs-pred.R index 178eb475..36852b67 100644 --- a/R/plot-obs-vs-pred.R +++ b/R/plot-obs-vs-pred.R @@ -24,25 +24,115 @@ plotObsVsPred <- function(data, dataMapping = NULL, plotConfiguration = NULL, plotObject = NULL) { - - # If no data mapping or plot configuration is input, use default - # metaData <- metaData %||% metaDataHelper(data) + validateIsOfType(data, "data.frame") dataMapping <- dataMapping %||% ObsVsPredDataMapping$new(data = data) plotConfiguration <- plotConfiguration %||% ObsVsPredPlotConfiguration$new(data = data, metaData = metaData, dataMapping = dataMapping) - validateIsOfType(dataMapping, ObsVsPredDataMapping) - validateIsOfType(plotConfiguration, ObsVsPredPlotConfiguration) + validateIsOfType(dataMapping, "ObsVsPredDataMapping") + validateIsOfType(plotConfiguration, "ObsVsPredPlotConfiguration") + validateIsOfType(plotObject, "ggplot", nullAllowed = TRUE) + + if (nrow(data) == 0) { + warning(messages$errorNrowData("Obs vs Pred plot")) + return(plotObject) + } - identityData <- dataMapping$getObsVsPredLines(data) - lloq <- dataMapping$lloq + # Get error bars for uncertainty + if (!isOfLength(dataMapping$uncertainty, 0)) { + plotObject <- addErrorbar( + data = data, + dataMapping = dataMapping, + plotConfiguration = plotConfiguration, + plotObject = plotObject + ) + } + plotObject <- addScatter( + data = data, + dataMapping = dataMapping, + plotConfiguration = plotConfiguration, + plotObject = plotObject + ) - plotObject <- plotObject %||% initializePlot(plotConfiguration) + # Add line of identity depending and smoothing + plotObject <- addObsVsPredLines( + data = data, + metaData, + dataMapping, + plotConfiguration, + plotObject + ) + # LLOQ + if (!isOfLength(dataMapping$lloq, 0)) { + # Overwrite y mapping temporarily + yMapping <- dataMapping$y + dataMapping$y <- dataMapping$lloq - plotObject <- addLine(x = identityData$x, y = identityData$y, caption = "y=x", plotObject = plotObject) - plotObject <- ifnotnull(lloq, addLine(x = c(lloq, lloq), y = c(-Inf, Inf), caption = "lloq", plotObject = plotObject), plotObject) + plotObject <- addLine( + data = data, + dataMapping = dataMapping, + caption = dataMapping$lloq, + plotConfiguration = plotConfiguration, + plotObject = plotObject + ) + dataMapping$y <- yMapping + } + + try(suppressMessages(plotObject <- setXAxis(plotObject))) + try(suppressMessages(plotObject <- setYAxis(plotObject))) + return(plotObject) +} + +#' @title addObsVsPredLines +#' @param data data.frame containing the data to be used for the plot +#' @param metaData list of lists +#' @param dataMapping \code{ObsVsPredDataMapping} object +#' @param plotConfiguration \code{ObsVsPredConfiguration} object +#' @param plotObject \code{ggplot} graphical object +#' @description +#' Add layers of identity line and smoother +#' @return A \code{ggplot} graphical object +addObsVsPredLines <- function(data, + metaData = NULL, + dataMapping = NULL, + plotConfiguration = NULL, + plotObject = NULL) { - plotObject <- setLegendCaption(plotObject, plotConfiguration$obsVsPredCaption) - plotObject <- addScatter(data = data, dataMapping = dataMapping, plotObject = plotObject) + # Get range of x values to plot + xmin <- min(dataMapping$minRange, data[, dataMapping$x], data[, dataMapping$y]) + xmax <- max(dataMapping$minRange, data[, dataMapping$x], data[, dataMapping$y]) + obsVsPredLineData <- data.frame(x = c(xmin, xmax), y = c(xmin, xmax) * dataMapping$lines) + plotObject <- plotObject + + ggplot2::geom_path( + data = obsVsPredLineData, + mapping = ggplot2::aes_string(x = "x", y = "y"), + color = getAestheticValues(n = 1, selectionKey = plotConfiguration$lines$color, position = 0, aesthetic = "color"), + linetype = getAestheticValues(n = 1, selectionKey = plotConfiguration$lines$linetype, position = 0, aesthetic = "linetype"), + size = getAestheticValues(n = 1, selectionKey = plotConfiguration$lines$size, position = 0, aesthetic = "size") + ) + # Get mapping and convert labels into characters usable by aes_string + mapData <- dataMapping$checkMapData(data) + mapLabels <- getAesStringMapping(dataMapping) + if (!isOfLength(dataMapping$smoother, 0)) { + plotObject <- plotObject + + ggplot2::geom_smooth( + data = mapData, + mapping = ggplot2::aes_string(x = mapLabels$x, y = mapLabels$y), + method = dataMapping$smoother, + se = FALSE, + color = getAestheticValues(n = 1, selectionKey = plotConfiguration$lines$color, position = 1, aesthetic = "color"), + linetype = getAestheticValues(n = 1, selectionKey = plotConfiguration$lines$linetype, position = 1, aesthetic = "linetype"), + size = getAestheticValues(n = 1, selectionKey = plotConfiguration$lines$size, position = 1, aesthetic = "size") + ) + } return(plotObject) } + +#' @title runObsVsPredPlot +#' @description +#' Run shiny app to use `plotObsVsPred()` from user interface +#' @export +runObsVsPredPlot <- function() { + appPath <- system.file("obs-vs-pred", package = "tlf") + shiny::runApp(appPath) +} diff --git a/R/plot-pkratio.R b/R/plot-pkratio.R index 90fd9fc3..a83779ae 100644 --- a/R/plot-pkratio.R +++ b/R/plot-pkratio.R @@ -24,21 +24,94 @@ plotPKRatio <- function(data, dataMapping = NULL, plotConfiguration = NULL, plotObject = NULL) { + validateIsOfType(data, "data.frame") dataMapping <- dataMapping %||% PKRatioDataMapping$new(data = data) plotConfiguration <- plotConfiguration %||% PKRatioPlotConfiguration$new(data = data, metaData = metaData, dataMapping = dataMapping) - validateIsOfType(dataMapping, PKRatioDataMapping) - validateIsOfType(plotConfiguration, PKRatioPlotConfiguration) + validateIsOfType(dataMapping, "PKRatioDataMapping") + validateIsOfType(plotConfiguration, "PKRatioPlotConfiguration") + validateIsOfType(plotObject, "ggplot", nullAllowed = TRUE) + + if (nrow(data) == 0) { + warning(messages$errorNrowData("PK ratio plot")) + return(plotObject) + } + + # Get transformed data from mapping and convert labels into characters usable by aes_string + mapData <- dataMapping$checkMapData(data) + mapLabels <- getAesStringMapping(dataMapping) plotObject <- plotObject %||% initializePlot(plotConfiguration) - for (lineIndex in seq_along(dataMapping$pkRatioValues)) { - plotObject <- addLine( - y = dataMapping$pkRatioValues[[lineIndex]], - caption = paste0("pkRatioLine", lineIndex), - plotObject = plotObject + # Include horizontal lines + for (lineIndex in seq_along(dataMapping$lines)) { + # position correspond to the number of layer lines already added + plotObject <- plotObject + + ggplot2::geom_hline( + yintercept = dataMapping$lines[[lineIndex]], + color = getAestheticValues(n = 1, selectionKey = plotConfiguration$lines$color, position = lineIndex - 1, aesthetic = "color"), + linetype = getAestheticValues(n = 1, selectionKey = plotConfiguration$lines$linetype, position = lineIndex - 1, aesthetic = "linetype"), + size = getAestheticValues(n = 1, selectionKey = plotConfiguration$lines$size, position = lineIndex - 1, aesthetic = "size") + ) + } + + # If uncertainty is defined, add error bars + if (!isOfLength(dataMapping$uncertainty, 0)) { + plotObject <- plotObject + + ggplot2::geom_linerange( + data = mapData, + mapping = aes_string( + x = mapLabels$x, + ymin = "ymin", + ymax = "ymax", + color = mapLabels$color + ), + # Error bar size uses a ratio of 1/4 to match with point size + size = getAestheticValues(n = 1, selectionKey = plotConfiguration$errorbars$size, position = 0, aesthetic = "size"), + linetype = getAestheticValues(n = 1, selectionKey = plotConfiguration$errorbars$linetype, aesthetic = "linetype"), + show.legend = TRUE + ) + } + plotObject <- plotObject + + ggplot2::geom_point( + data = mapData, + mapping = ggplot2::aes_string( + x = mapLabels$x, + y = mapLabels$y, + color = mapLabels$color, + shape = mapLabels$shape + ), + size = getAestheticValues(n = 1, selectionKey = plotConfiguration$points$size, position = 0, aesthetic = "size"), + show.legend = TRUE ) + + # Define shapes and colors based on plotConfiguration$points properties + shapeVariable <- gsub("`", "", mapLabels$shape) + colorVariable <- gsub("`", "", mapLabels$color) + shapeLength <- length(unique(mapData[, shapeVariable])) + colorLength <- length(unique(mapData[, colorVariable])) + + plotObject <- plotObject + + ggplot2::scale_shape_manual(values = getAestheticValues(n = shapeLength, selectionKey = plotConfiguration$points$shape, aesthetic = "shape")) + + ggplot2::scale_color_manual(values = getAestheticValues(n = colorLength, selectionKey = plotConfiguration$points$color, aesthetic = "color")) + + # If variable is legendLabel, remove it from legend + if (isIncluded(shapeVariable, "legendLabels")) { + plotObject <- plotObject + ggplot2::guides(shape = FALSE) } - plotObject <- setLegendCaption(plotObject, plotConfiguration$pkRatioCaption) - plotObject <- addScatter(data = data, dataMapping = dataMapping, plotObject = plotObject) + if (isIncluded(colorVariable, "legendLabels")) { + plotObject <- plotObject + ggplot2::guides(color = FALSE) + } + # Try is used to prevent crashes in the final plot due to ggplot2 peculiarities regarding scale functions + try(suppressMessages(plotObject <- setXAxis(plotObject))) + try(suppressMessages(plotObject <- setYAxis(plotObject))) return(plotObject) } + +#' @title runPKRatioPlot +#' @description +#' Run shiny app to use `plotPKRatio()` from user interface +#' @export +runPKRatioPlot <- function() { + appPath <- system.file("pk-ratio", package = "tlf") + shiny::runApp(appPath) +} diff --git a/R/plot-timeprofile.R b/R/plot-timeprofile.R index f5a0ae25..19996ceb 100644 --- a/R/plot-timeprofile.R +++ b/R/plot-timeprofile.R @@ -9,48 +9,87 @@ #' plotTimeProfile(data, metaData = NULL, dataMapping = NULL, plotConfiguration = NULL, plotObject = NULL) #' @return a ggplot graphical object #' @export -plotTimeProfile <- function(data, +plotTimeProfile <- function(data = NULL, metaData = NULL, dataMapping = NULL, observedData = NULL, - dataMappingForObserved = NULL, + observedDataMapping = NULL, plotConfiguration = NULL, plotObject = NULL) { - dataMapping <- dataMapping %||% TimeProfileDataMapping$new(data = data) + validateIsOfType(data, "data.frame", nullAllowed = TRUE) + validateIsOfType(observedData, "data.frame", nullAllowed = TRUE) + if (all(isOfLength(data, 0), isOfLength(observedData, 0))) { + warning("data and observed data are of length 0. Time profile layer was not added.") + return(plotObject) + } + + if (!isOfLength(data, 0)) { + dataMapping <- dataMapping %||% TimeProfileDataMapping$new(data = data) + } + if (!isOfLength(observedData, 0)) { + observedDataMapping <- observedDataMapping %||% ObservedDataMapping$new(data = data) + } + plotConfiguration <- plotConfiguration %||% TimeProfilePlotConfiguration$new(data = data, metaData = metaData, dataMapping = dataMapping) - validateIsOfType(data, "data.frame") - validateIsOfType(dataMapping, TimeProfileDataMapping) + validateIsOfType(dataMapping, TimeProfileDataMapping, nullAllowed = TRUE) + validateIsOfType(observedDataMapping, ObservedDataMapping, nullAllowed = TRUE) validateIsOfType(plotConfiguration, TimeProfilePlotConfiguration) - validateIsOfType(observedData, "data.frame", nullAllowed = TRUE) - validateIsOfType(dataMappingForObserved, XYGDataMapping, nullAllowed = TRUE) - - lloq <- dataMapping$lloq - isRangeTimeProfile <- dataMapping$isRangeTimeProfile + # Initialize plot based on plotConfiguration plotObject <- plotObject %||% initializePlot(plotConfiguration) - if (!is.null(lloq)) { - plotObject <- addLine(y = lloq, caption = "lloq", plotObject = plotObject) - plotObject <- setLegendCaption(plotObject, plotConfiguration$timeProfileCaption) - } - if (isRangeTimeProfile) { - aggregatedData <- getAggregatedData(dataMapping$checkMapData(data), dataMapping$x, dataMapping$y) - rangeData <- aggregatedData - rangeData$Groups <- paste(tlfEnv$defaultAggregation$labels$range, aggregatedData$Groups) - rangeMapping <- RangeDataMapping$new(x = "x", ymin = "ymin", ymax = "ymax", color = "Groups") - plotObject <- addRibbon(data = rangeData, dataMapping = rangeMapping, plotObject = plotObject) - lineMapping <- XYGDataMapping$new(x = "x", y = "y", color = "Groups") - lineData <- aggregatedData - lineData$Groups <- paste(tlfEnv$defaultAggregation$labels$y, aggregatedData$Groups) - plotObject <- addLine(data = lineData, dataMapping = lineMapping, plotObject = plotObject) - } - if (!isRangeTimeProfile) { - plotObject <- addLine(data = data, dataMapping = dataMapping, plotObject) - } - if (!is.null(observedData)) { - dataMappingForObserved <- dataMappingForObserved %||% XYGDataMapping$new(data = observedData) - plotObject <- addScatter(data = observedData, dataMapping = dataMappingForObserved, plotObject = plotObject) + + # Get transformed data from mapping and convert labels into characters usable by aes_string + if (!isOfLength(data, 0)) { + mapData <- dataMapping$checkMapData(data) + if (!any(isOfLength(dataMapping$ymin, 0), isOfLength(dataMapping$ymax, 0))) { + plotObject <- addRibbon( + data = mapData, + dataMapping = dataMapping, + plotConfiguration = plotConfiguration, + plotObject = plotObject + ) + } + if (!isOfLength(dataMapping$y, 0)) { + plotObject <- addLine( + data = mapData, + dataMapping = dataMapping, + plotConfiguration = plotConfiguration, + plotObject = plotObject + ) + } } + if (!isOfLength(observedData, 0)) { + mapObservedData <- observedDataMapping$checkMapData(observedData) + if (!isOfLength(observedDataMapping$uncertainty, 0)) { + plotObject <- addErrorbar( + data = mapObservedData, + dataMapping = observedDataMapping, + plotConfiguration = plotConfiguration, + plotObject = plotObject + ) + } + plotObject <- addScatter( + data = mapObservedData, + dataMapping = observedDataMapping, + plotConfiguration = plotConfiguration, + plotObject = plotObject + ) + # LLOQ + if (!isOfLength(observedDataMapping$lloq, 0)) { + mapObservedData$legendLabels <- paste(mapObservedData$legendLabels, " LLOQ") + plotObject <- addLine( + data = mapObservedData, + dataMapping = XYGDataMapping$new( + x = observedDataMapping$x, + y = "lloq", + color = "legendLabels" + ), + plotConfiguration = plotConfiguration, + plotObject = plotObject + ) + } + } return(plotObject) } diff --git a/R/plot-tornado.R b/R/plot-tornado.R index 3ae32edb..93c66b89 100644 --- a/R/plot-tornado.R +++ b/R/plot-tornado.R @@ -92,11 +92,21 @@ plotTornado <- function(data = NULL, fill = mapLabels$fill, color = mapLabels$color ), - alpha = plotConfiguration$theme$aesProperties$alpha[1], - size = plotConfiguration$theme$aesProperties$size[1], - linetype = plotConfiguration$theme$aesProperties$linetype[1], + alpha = getAestheticValues(n = 1, selectionKey = plotConfiguration$ribbons$alpha, position = 0, aesthetic = "alpha"), + size = getAestheticValues(n = 1, selectionKey = plotConfiguration$ribbons$size, position = 0, aesthetic = "size"), + linetype = getAestheticValues(n = 1, selectionKey = plotConfiguration$ribbons$linetype, position = 0, aesthetic = "linetype"), position = ggplot2::position_dodge(width = plotConfiguration$dodge) ) + + # Define shapes and colors based on plotConfiguration$points properties + fillVariable <- gsub("`", "", mapLabels$fill) + colorVariable <- gsub("`", "", mapLabels$color) + fillLength <- length(unique(mapData[, fillVariable])) + colorLength <- length(unique(mapData[, colorVariable])) + + plotObject <- plotObject + + ggplot2::scale_fill_manual(values = getAestheticValues(n = fillLength, selectionKey = plotConfiguration$ribbons$fill, aesthetic = "fill")) + + ggplot2::scale_color_manual(values = getAestheticValues(n = colorLength, selectionKey = plotConfiguration$ribbons$color, aesthetic = "color")) } if (!plotConfiguration$bar) { # For tornado with points, their shape will be taken from the theme properties @@ -108,31 +118,42 @@ plotTornado <- function(data = NULL, color = mapLabels$color, shape = mapLabels$shape ), - size = plotConfiguration$theme$aesProperties$size[1], + size = getAestheticValues(n = 1, selectionKey = plotConfiguration$points$size, position = 0, aesthetic = "size"), position = ggplot2::position_dodge(width = plotConfiguration$dodge) - ) + - ggplot2::scale_shape_manual(values = tlfEnv$currentTheme$aesProperties$shape) + ) + + # Define shapes and colors based on plotConfiguration$points properties + shapeVariable <- gsub("`", "", mapLabels$shape) + colorVariable <- gsub("`", "", mapLabels$color) + shapeLength <- length(unique(mapData[, shapeVariable])) + colorLength <- length(unique(mapData[, colorVariable])) + + plotObject <- plotObject + + ggplot2::scale_shape_manual(values = getAestheticValues(n = shapeLength, selectionKey = plotConfiguration$points$shape, aesthetic = "shape")) + + ggplot2::scale_color_manual(values = getAestheticValues(n = colorLength, selectionKey = plotConfiguration$points$color, aesthetic = "color")) } # Final plot includes a vertical line in 0 # And optional color palette otherwise use colors from theme - plotObject <- plotObject + + if (!isOfLength(dataMapping$lines, 0)) { + plotObject <- plotObject + ggplot2::geom_vline( - xintercept = dataMapping$tornadoValues, - color = tlfEnv$currentTheme$aesProperties$color[1], - size = tlfEnv$currentTheme$aesProperties$size[1], - linetype = tlfEnv$currentTheme$aesProperties$linetype[1] + xintercept = dataMapping$lines, + color = getAestheticValues(n = length(dataMapping$lines), selectionKey = plotConfiguration$lines$color, position = 0, aesthetic = "color"), + size = getAestheticValues(n = length(dataMapping$lines), selectionKey = plotConfiguration$lines$size, position = 0, aesthetic = "size"), + linetype = getAestheticValues(n = length(dataMapping$lines), selectionKey = plotConfiguration$lines$linetype, position = 0, aesthetic = "linetype") ) - - if(!is.null(plotConfiguration$colorPalette)){ - plotObject <- plotObject + - ggplot2::scale_fill_brewer(palette = plotConfiguration$colorPalette, - aesthetics = c("color", "fill")) - return(plotObject) } - - plotObject <- plotObject + - ggplot2::scale_fill_manual(values = tlfEnv$currentTheme$aesProperties$fill) + - ggplot2::scale_color_manual(values = tlfEnv$currentTheme$aesProperties$color) + + if (!isOfLength(plotConfiguration$colorPalette, 0)) { + try(suppressMessages( + plotObject <- plotObject + + ggplot2::scale_fill_brewer( + palette = plotConfiguration$colorPalette, + aesthetics = c("color", "fill") + ) + )) + } + try(suppressMessages(plotObject <- setXAxis(plotObject))) return(plotObject) } diff --git a/R/plotconfiguration-axis.R b/R/plotconfiguration-axis.R index f12b7ab6..b81a8065 100644 --- a/R/plotconfiguration-axis.R +++ b/R/plotconfiguration-axis.R @@ -3,15 +3,49 @@ #' @export #' @description #' Pre-defined transformation of axes -#' Not that built-in transformations from ggplot2 includes more transformations +#' Not that built-in transformations from `ggplot2` includes more transformations Scaling <- enum(c( - "lin", - "log10", - "log", - "discrete", + "lin", "log", "discrete", "reverse", "sqrt", "time", "date" )) +#' @title createPlotScale +#' @description Translate scale into a value directly usable by `ggplot2` +#' to give more flexibilty in the next functions +#' @param scale character defining the name of the scale +#' @return name of the `ggplot2` scale +createPlotScale <- function(scale) { + validateIsString(scale) + if (isIncluded(tolower(scale), c("identity", "lin", "linear", "default", "normal"))) { + return("identity") + } + if (isIncluded(tolower(scale), c("log", "logarithmic", "log10"))) { + return("log10") + } + validateIsIncluded(tolower(scale), Scaling) + return(tolower(scale)) +} + +#' @title createPlotTicks +#' @description Translate ticks and ticklabels into a value directly usable by `ggplot2` +#' to give more flexibilty in the next functions +#' @param ticks character, numeric or function defining the ticks +#' @return name of the `ggplot2` scale +createPlotTicks <- function(ticks) { + if (isOfLength(ticks, 0)) { + return(waiver()) + } + if (isIncluded(ticks, c("default", "identity"))) { + return(waiver()) + } + if (isIncluded(ticks, c("none"))) { + return(NULL) + } + if (isOfType(ticks, c("numeric", "character", "function"))) { + return(ticks) + } +} + #' @title AxisConfiguration #' @description R6 class defining the configuration of axis @@ -19,66 +53,107 @@ Scaling <- enum(c( AxisConfiguration <- R6::R6Class( "AxisConfiguration", public = list( - #' @field limits numeric vector of axis limits - limits = NULL, - #' @field scale character defining axis scale - scale = NULL, - #' @field ticks numeric vector or function defining where to position axis ticks - ticks = NULL, - #' @field ticklabels character vector or function defining what to print on axis ticks - ticklabels = NULL, - #' @description Create a new \code{AxisConfiguration} object #' @param limits numeric vector of axis limits #' @param scale character defining axis scale #' Use enum `Scaling` to access predefined scales. #' @param ticks numeric vector or function defining where to position axis ticks #' @param ticklabels character vector or function defining what to print on axis ticks + #' @param font \code{Font} object defining the font of ticklabels #' @return A new \code{AxisConfiguration} object initialize = function(limits = NULL, scale = Scaling$lin, - ticks = "default", - ticklabels = "default") { - self$limits <- limits - self$scale <- scale - if (self$scale %in% "lin") { - self$scale <- "identity" - } + ticks = NULL, + ticklabels = NULL, + font = NULL) { + validateIsNumeric(limits, nullAllowed = TRUE) + validateIsOfType(font, "Font", nullAllowed = TRUE) + private$.limits <- limits + + scale <- scale %||% Scaling$lin + private$.scale <- createPlotScale(scale) + private$.ticks <- createPlotTicks(ticks) + private$.ticklabels <- createPlotTicks(ticklabels) - self$ticks <- ticks - if (!isOfLength(ticks, 0)) { - if (ticks[1] %in% "default") { - self$ticks <- waiver() - } + # Default axis font will use theme + defaultFont <- Font$new() + currentTheme <- tlfEnv$currentTheme$clone(deep = TRUE) + if (isOfType(self, "XAxisConfiguration")) { + defaultFont <- currentTheme$fonts$xAxis } - self$ticklabels <- ticklabels - if (!isOfLength(ticklabels, 0)) { - if (ticklabels[1] %in% "default") { - self$ticklabels <- waiver() - } + if (isOfType(self, "YAxisConfiguration")) { + defaultFont <- currentTheme$fonts$yAxis } + private$.font <- font %||% defaultFont + } + ), + active = list( + #' @field limits numeric vector of length 2 defining limits of axis. + #' A value of `NULL` is allowed and lead to default `ggplot2` behaviour + limits = function(value) { + if (missing(value)) { + return(private$.limits) + } + validateIsNumeric(value, nullAllowed = TRUE) + if (isOfLength(value, 0)) { + private$.limits <- NULL + return(invisible()) + } + validateIsOfLength(value, 2) + private$.limits <- value + return(invisible()) }, - - #' @description Print axis properties - #' @return Axis properties - print = function() { - axisProperties <- list( - scale = self$scale, - limits = self$limits, - ticks = self$ticks, - ticklabels = self$ticklabels - ) - if (axisProperties$scale %in% "identity") { - axisProperties$scale <- "linear" + #' @field scale name of axis scale from Enum `Scaling` + #' A value of `NULL` is allowed and will lead to a default linear scale + scale = function(value) { + if (missing(value)) { + return(private$.scale) } - if (length(axisProperties$ticks) == 0 & !is.null(axisProperties$ticks)) { - axisProperties$ticks <- "default" + value <- value %||% Scaling$lin + private$.scale <- createPlotScale(value) + return(invisible()) + }, + #' @field ticks function or values defining where axis ticks are placed + ticks = function(value) { + if (missing(value)) { + return(private$.ticks) } - if (length(axisProperties$ticklabels) == 0 & !is.null(axisProperties$ticklabels)) { - axisProperties$ticklabels <- "default" + private$.ticks <- createPlotTicks(value) + return(invisible()) + }, + #' @field ticklabels function or values defining the axis tick labels + ticklabels = function(value) { + if (missing(value)) { + return(private$.ticklabels) + } + private$.ticklabels <- createPlotTicks(value) + return(invisible()) + }, + #' @field font \code{Font} object defining the font of the ticklabels + font = function(value) { + if (missing(value)) { + return(private$.font) + } + validateIsOfType(value, "Font", nullAllowed = TRUE) + # Default axis font will use theme + defaultFont <- Font$new() + currentTheme <- tlfEnv$currentTheme$clone(deep = TRUE) + if (isOfType(self, "XAxisConfiguration")) { + defaultFont <- currentTheme$fonts$xAxis + } + if (isOfType(self, "YAxisConfiguration")) { + defaultFont <- currentTheme$fonts$yAxis } - return(axisProperties) + private$.font <- value %||% defaultFont + return(invisible()) } + ), + private = list( + .limits = NULL, + .scale = NULL, + .ticks = NULL, + .ticklabels = NULL, + .font = NULL ) ) @@ -89,20 +164,26 @@ XAxisConfiguration <- R6::R6Class( "XAxisConfiguration", inherit = AxisConfiguration, public = list( - #' @description Set axis configuration on a \code{ggplot} object + #' @description Update axis configuration on a \code{ggplot} object #' @param plotObject \code{ggplot} object #' @return A \code{ggplot} object with updated axis properties - setPlotAxis = function(plotObject) { - if (self$scale %in% "discrete") { + updatePlot = function(plotObject) { + validateIsOfType(plotObject, "ggplot") + # Update font properties + plotObject <- plotObject + ggplot2::theme(axis.text.x = private$.font$createPlotFont()) + # Update scales and ticks + if (isIncluded(private$.scale, Scaling$discrete)) { suppressMessages( plotObject <- plotObject + - scale_x_discrete(limits = self$limits, breaks = self$ticks, labels = self$ticklabels) + ggplot2::scale_x_discrete(limits = private$.limits, breaks = private$.ticks, labels = private$.ticklabels) ) return(plotObject) } + # Most of ggplot2 scales lead to unwanted warning messages + # `try` should be added in cases of scale breaking because all the ggplot object elements are not yet in place suppressMessages( plotObject <- plotObject + - scale_x_continuous(trans = self$scale, limits = self$limits, breaks = self$ticks, labels = self$ticklabels) + ggplot2::scale_x_continuous(trans = private$.scale, limits = private$.limits, breaks = private$.ticks, labels = private$.ticklabels) ) return(plotObject) } @@ -117,15 +198,28 @@ YAxisConfiguration <- R6::R6Class( inherit = AxisConfiguration, public = list( #' @field position character poistion of the Y-axis - position = NULL, # TO DO: initialize position, then scale position = "left" or "right" + position = NULL, # TO DO: find a way to include position in y axis, then scale position = "left" or "right" - #' @description Set axis configuration on a \code{ggplot} object + #' @description Update axis configuration on a \code{ggplot} object #' @param plotObject \code{ggplot} object #' @return A \code{ggplot} object with updated axis properties - setPlotAxis = function(plotObject) { + updatePlot = function(plotObject) { + validateIsOfType(plotObject, "ggplot") + # Update font properties + plotObject <- plotObject + ggplot2::theme(axis.text.y = private$.font$createPlotFont()) + # Update scales and ticks + if (isIncluded(private$.scale, Scaling$discrete)) { + suppressMessages( + plotObject <- plotObject + + ggplot2::scale_y_discrete(limits = private$.limits, breaks = private$.ticks, labels = private$.ticklabels) + ) + return(plotObject) + } + # Most of ggplot2 scales lead to unwanted warning messages + # `try` should be added in cases of scale breaking because all the ggplot object elements are not yet in place suppressMessages( plotObject <- plotObject + - scale_y_continuous(trans = self$scale, limits = self$limits, breaks = self$ticks, labels = self$ticklabels) + ggplot2::scale_y_continuous(trans = private$.scale, limits = private$.limits, breaks = private$.ticks, labels = private$.ticklabels) ) return(plotObject) } diff --git a/R/plotconfiguration-background.R b/R/plotconfiguration-background.R index 88edbb3f..35970760 100644 --- a/R/plotconfiguration-background.R +++ b/R/plotconfiguration-background.R @@ -4,131 +4,191 @@ BackgroundConfiguration <- R6::R6Class( "BackgroundConfiguration", public = list( - #' @field outerBackground R6 class \code{BackgroundElementConfiguration} object - outerBackground = NULL, - #' @field innerBackground R6 class \code{BackgroundElementConfiguration} object - innerBackground = NULL, - #' @field grid R6 class \code{BackgroundElementConfiguration} object - grid = NULL, - #' @field watermark R6 class \code{Label} object defining watermark background - watermark = NULL, - #' @description Create a new \code{BackgroundConfiguration} object - #' @param outerBackground R6 class \code{BackgroundElementConfiguration} object - #' @param innerBackground R6 class \code{BackgroundElementConfiguration} object - #' @param grid R6 class \code{BackgroundElementConfiguration} object - #' @param watermark R6 class \code{Label} object defining watermark background - #' @param watermarkFont R6 class \code{Font} object defining watermark font - #' @param theme R6 class \code{Theme} object + #' @param watermark \code{Label} object defining properties of watermark + #' @param plot \code{BackgroundElement} object defining oustide plot background properties + #' @param panel \code{BackgroundElement} object defining panel (inside of plot) background properties + #' @param xAxis \code{LineElement} object defining properties of x-axis + #' @param yAxis \code{LineElement} object defining properties of y-axis + #' @param xGrid \code{LineElement} object defining properties of x-grid + #' @param yGrid \code{LineElement} object defining properties of y-grid #' @return A new \code{BackgroundConfiguration} object - initialize = function(outerBackground = NULL, - innerBackground = NULL, - grid = NULL, - watermark = NULL, - watermarkFont = NULL, - theme = tlfEnv$currentTheme) { - self$outerBackground <- outerBackground %||% BackgroundElementConfiguration$new(theme = theme$background$outer) - self$innerBackground <- innerBackground %||% BackgroundElementConfiguration$new(theme = theme$background$inner) - self$grid <- grid %||% BackgroundElementConfiguration$new(theme = theme$background$grid) + initialize = function(watermark = NULL, + plot = NULL, + panel = NULL, + xAxis = NULL, + yAxis = NULL, + xGrid = NULL, + yGrid = NULL) { + validateIsOfType(watermark, c("character", "Label"), nullAllowed = TRUE) + currentTheme <- tlfEnv$currentTheme$clone(deep = TRUE) + watermark <- watermark %||% currentTheme$background$watermark + # Enforce watermark as Label with value + if (isOfType(watermark, "character")) { + watermark <- asLabel(text = watermark, font = currentTheme$fonts$watermark) + } + private$.watermark <- watermark - self$watermark <- asLabel(watermark %||% theme$background$watermark %||% "") - self$watermark$font <- watermarkFont %||% self$watermark$font - }, + areaFieldNames <- c("plot", "panel") + lineFieldNames <- c("xAxis", "yAxis", "xGrid", "yGrid") - #' @description Print background properties - #' @return Background properties - print = function() { - backgroundProperties <- list( - "outerBackground" = self$outerBackground$print(), - "innerBackground" = self$innerBackground$print(), - "grid" = self$grid$print(), - "watermark" = self$watermark$text - ) - return(backgroundProperties) + validateAreaExpression <- parse(text = paste0("validateIsOfType(", areaFieldNames, ", 'BackgroundElement', nullAllowed = TRUE)")) + validateLineExpression <- parse(text = paste0("validateIsOfType(", lineFieldNames, ", 'LineElement', nullAllowed = TRUE)")) + eval(validateAreaExpression) + eval(validateLineExpression) + + setAreaExpression <- parse(text = paste0("private$.", areaFieldNames, " <- ", areaFieldNames, " %||% currentTheme$background$", areaFieldNames)) + setLineExpression <- parse(text = paste0("private$.", lineFieldNames, " <- ", lineFieldNames, " %||% currentTheme$background$", lineFieldNames)) + eval(setAreaExpression) + eval(setLineExpression) }, - #' @description Set background properties of a \code{ggplot} object + #' @description Update background a \code{ggplot} object from `BackgroundConfiguration` properties #' @param plotObject a \code{ggplot} object #' @return A \code{ggplot} object - setBackground = function(plotObject) { - plotObject <- plotObject + theme( - plot.background = element_rect(fill = self$outerBackground$fill), - panel.background = element_rect( - fill = self$innerBackground$fill, - color = self$innerBackground$color, - size = self$innerBackground$size, - linetype = self$innerBackground$linetype, - ), - panel.grid = element_line( - color = self$grid$color, - size = self$grid$size, - linetype = self$grid$linetype - ) + updatePlot = function(plotObject) { + plotObject <- plotObject + ggplot2::theme( + plot.background = private$.plot$createPlotElement(), + panel.background = private$.panel$createPlotElement(), + axis.line.x = private$.xAxis$createPlotElement(), + axis.line.y = private$.yAxis$createPlotElement(), + panel.grid.major.x = private$.xGrid$createPlotElement(), + panel.grid.major.y = private$.yGrid$createPlotElement() ) - plotObject <- addWatermark(plotObject = plotObject, label = self$watermark) return(plotObject) } - ) + ), + active = list( + #' @field watermark `Label` object + watermark = function(value) { + if (missing(value)) { + return(private$.watermark) + } + validateIsOfType(value, c("character", "Label"), nullAllowed = TRUE) + value <- value %||% private$.watermark$text + # Enforce watermark as Label with value + if (isOfType(value, "character")) { + value <- asLabel(text = value, font = private$.watermark$font) + } + private$.watermark <- value + return(invisible()) + }, + #' @field plot `BackgroundElement` object + plot = function(value) { + requestOnElement(private$.plot, value) + }, + #' @field panel `BackgroundElement` object + panel = function(value) { + requestOnElement(private$.panel, value) + }, + #' @field xAxis `LineElement` object + xAxis = function(value) { + requestOnElement(private$.xAxis, value) + }, + #' @field yAxis `LineElement` object + yAxis = function(value) { + requestOnElement(private$.yAxis, value) + }, + #' @field xGrid `LineElement` object + xGrid = function(value) { + requestOnElement(private$.xGrid, value) + }, + #' @field yGrid `LineElement` object + yGrid = function(value) { + requestOnElement(private$.yGrid, value) + } + ), + private = list( + .watermark = NULL, + .plot = NULL, + .panel = NULL, + .xAxis = NULL, + .yAxis = NULL, + .xGrid = NULL, + .yGrid = NULL + ), ) -#' @title BackgroundElementConfiguration -#' @description R6 class defining the configuration of background elements +#' @title BackgroundElement +#' @description R6 class defining the properties of background elements +#' @field fill character defining the color filling of the background element +#' @field color character defining the color of the background element frame/line +#' @field size numeric defining the size of the background element frame/line +#' @field linetype character defining the size of the background element frame/line #' @export -BackgroundElementConfiguration <- R6::R6Class( - "BackgroundElementConfiguration", +BackgroundElement <- R6::R6Class( + "BackgroundElement", public = list( - #' @field fill character color filling of the background element fill = NULL, - #' @field color character color of the frame of the background element color = NULL, - #' @field size character size of the frame of the background element size = NULL, - #' @field linetype character linetype of the frame of the background element linetype = NULL, - #' @description Create a new \code{BackgroundElementConfiguration} object + #' @description Create a new \code{BackgroundElement} object #' @param fill character color filling of the background element #' @param color character color of the frame of the background element #' @param size character size of the frame of the background element #' @param linetype character linetype of the frame of the background element - #' @param theme R6 class \code{Theme} object - #' @return A new \code{BackgroundElementConfiguration} object + #' @return A new \code{BackgroundElement} object initialize = function(fill = NULL, color = NULL, size = NULL, - linetype = NULL, - theme = NULL) { - self$fill <- fill %||% theme$fill - self$color <- color %||% theme$color - self$size <- size %||% theme$size - self$linetype <- linetype %||% theme$linetype - }, + linetype = NULL) { + validateIsString(c(fill, color, linetype), nullAllowed = TRUE) + validateIsNumeric(size, nullAllowed = TRUE) - #' @description Print background element properties - #' @return Background element properties - print = function() { - backgroundProperties <- NULL + fieldNames <- c("fill", "color", "size", "linetype") + setPropertiesExpression <- parse(text = paste0("self$", fieldNames, " <- ", fieldNames)) + eval(setPropertiesExpression) + }, - # Get properties that are of character type - elementProperties <- unlist(eapply( - self, - function(x) { - isOfType(x, "character") - } - )) - elementNames <- names(elementProperties[as.logical(elementProperties)]) + #' @description Create a `ggplot2::element_rect` directly usable by `ggplot2::theme`. + #' @return An `element_rect` object. + createPlotElement = function() { + ggplot2::element_rect( + fill = self$fill, + colour = self$color, + size = as.numeric(self$size), + linetype = self$linetype + ) + } + ) +) - # Build data.frame of properties while removing NULL values - for (elementName in elementNames) { - backgroundProperties <- rbind.data.frame( - backgroundProperties, - data.frame( - Property = elementName, - Value = self[[elementName]] - ) - ) - } - return(backgroundProperties) +#' @title LineElement +#' @description R6 class defining the properties of background line elements +#' @export +LineElement <- R6::R6Class( + "LineElement", + inherit = BackgroundElement, + public = list( + #' @description Create a `ggplot2::element_line` directly usable by `ggplot2::theme`. + #' @return An `element_line` object. + createPlotElement = function() { + ggplot2::element_line( + colour = self$color, + size = as.numeric(self$size), + linetype = self$linetype + ) } ) ) + +requestOnElement <- function(field, value) { + if (missing(value)) { + return(field) + } + # Update the element partially in case of names list + if (isOfType(value, "list")) { + for (fieldName in c("color", "size", "linetype")) { + field[[fieldName]] <- value[[fieldName]] %||% field[[fieldName]] + } + if (isOfType(field, "BackgroundElement")) { + field[["fill"]] <- value[["fill"]] %||% field[["fill"]] + } + } + # Or update the whole element R6 object is used + if (isOfType(value, "BackgroundElement")) { + field <- value + } +} diff --git a/R/plotconfiguration-label.R b/R/plotconfiguration-label.R index c3188fbb..2387bd6e 100644 --- a/R/plotconfiguration-label.R +++ b/R/plotconfiguration-label.R @@ -4,89 +4,94 @@ LabelConfiguration <- R6::R6Class( "LabelConfiguration", public = list( - #' @field title R6 class \code{Label} object - title = NULL, - #' @field subtitle R6 class \code{Label} object - subtitle = NULL, - #' @field xlabel R6 class \code{Label} object - xlabel = NULL, - #' @field ylabel R6 class \code{Label} object - ylabel = NULL, - #' @description Create a new \code{LabelConfiguration} object - #' @param title R6 class \code{Label} object - #' @param subtitle R6 class \code{Label} object - #' @param xlabel R6 class \code{Label} object - #' @param ylabel R6 class \code{Label} object - #' @param theme R6 class \code{Theme} + #' @param title character or \code{Label} object defining title + #' @param subtitle character or \code{Label} object defining subtitle + #' @param xlabel character or \code{Label} object defining xlabel + #' @param ylabel character or \code{Label} object defining ylabel #' @return A new \code{LabelConfiguration} object initialize = function(title = NULL, subtitle = NULL, xlabel = NULL, - ylabel = NULL, - theme = tlfEnv$currentTheme) { + ylabel = NULL) { inputs <- c("title", "subtitle", "xlabel", "ylabel") validateExpressions <- parse(text = paste0("validateIsOfType(", inputs, ', c("Label", "character"), nullAllowed =TRUE)')) eval(validateExpressions) + currentTheme <- tlfEnv$currentTheme$clone(deep = TRUE) enforceLabelExpressions <- parse(text = paste0( - "if(isOfType(", inputs, ',"character")){', - inputs, "<- asLabel(text = ", inputs, ", font = theme$", inputs, "Font)}" + "if(!isOfType(", inputs, ',"Label")){', + inputs, "<- asLabel(text = ", inputs, ", font = currentTheme$fonts$", inputs, ")}" )) eval(enforceLabelExpressions) - associateExpressions <- parse(text = paste0("self$", inputs, " <- asLabel(", inputs, ")")) + associateExpressions <- parse(text = paste0("private$.", inputs, " <- asLabel(", inputs, ")")) eval(associateExpressions) }, - #' @description Set plot labels properties of a \code{ggplot} object + #' @description Update labels of a \code{ggplot} object and their properties #' @param plotObject a \code{ggplot} object #' @return A \code{ggplot} object - setPlotLabels = function(plotObject) { - - # Titles and axes labels + updatePlot = function(plotObject) { + validateIsOfType(plotObject, "ggplot") + # Update titles and axes labels plotObject <- plotObject + ggplot2::labs( - title = self$title$text, - subtitle = self$subtitle$text, - x = self$xlabel$text, - y = self$ylabel$text + title = private$.title$text, + subtitle = private$.subtitle$text, + x = private$.xlabel$text, + y = private$.ylabel$text ) - - plotObject <- setFontProperties( - plotObject, - titleFont = self$title$font, - subtitleFont = self$subtitle$font, - xAxisFont = self$xlabel$font, - yAxisFont = self$ylabel$font + plotObject <- plotObject + ggplot2::theme( + plot.title = private$.title$createPlotFont(), + plot.subtitle = private$.subtitle$createPlotFont(), + axis.title.x = private$.xlabel$createPlotFont(), + axis.title.y = private$.ylabel$createPlotFont() ) return(plotObject) + } + ), + active = list( + #' @field title \code{Label} object defining the title of the plot + title = function(value) { + if (missing(value)) { + return(private$.title) + } + validateIsOfType(value, c("character", "Label"), nullAllowed = TRUE) + private$.title <- asLabel(value) + return(invisible()) }, - - #' @description Print plot label properties - #' @return Plot label properties - print = function() { - labelProperties <- NULL - - # Get properties that are of Label type - elementProperties <- unlist(eapply( - self, - function(x) { - isOfType(x, "Label") - } - )) - elementNames <- names(elementProperties[as.logical(elementProperties)]) - - # Build data.frame of properties while removing NULL values - for (elementName in elementNames) { - labelProperties <- rbind.data.frame( - labelProperties, - data.frame( - Property = elementName, - Value = self[[elementName]]$text %||% "NULL" - ) - ) + #' @field subtitle \code{Label} object defining the subtitle of the plot + subtitle = function(value) { + if (missing(value)) { + return(private$.subtitle) + } + validateIsOfType(value, c("character", "Label"), nullAllowed = TRUE) + private$.subtitle <- asLabel(value) + return(invisible()) + }, + #' @field xlabel \code{Label} object defining the xlabel of the plot + xlabel = function(value) { + if (missing(value)) { + return(private$.xlabel) + } + validateIsOfType(value, c("character", "Label"), nullAllowed = TRUE) + private$.xlabel <- asLabel(value) + return(invisible()) + }, + #' @field ylabel \code{Label} object defining the ylabel of the plot + ylabel = function(value) { + if (missing(value)) { + return(private$.ylabel) } - return(labelProperties) + validateIsOfType(value, c("character", "Label"), nullAllowed = TRUE) + private$.ylabel <- asLabel(value) + return(invisible()) } + ), + private = list( + .title = NULL, + .subtitle = NULL, + .xlabel = NULL, + .ylabel = NULL ) ) diff --git a/R/plotconfiguration-legend.R b/R/plotconfiguration-legend.R index 44eb3907..c2237186 100644 --- a/R/plotconfiguration-legend.R +++ b/R/plotconfiguration-legend.R @@ -4,39 +4,129 @@ LegendConfiguration <- R6::R6Class( "LegendConfiguration", public = list( - #' @field position character position of the legend - position = NULL, - #' @field title character name of the legend - title = NULL, - #' @field caption data.frame with - caption = NULL, - #' @description Create a new \code{LegendConfiguration} object - #' @param position character position of the legend. - #' Use enum `LegendPositions` to assess available legend positions. - #' @param title character title of the legend caption. - #' Default `NULL` does not provide any legend title. - #' @param caption data.frame containing the legend caption properties + #' @param position position of the legend as defined by enum `LegendPositions` + #' @param caption data.frame containing the properties of the legend caption + #' @param title character title of the legend caption. A value of `NULL` removes the title. + #' @param titleFont \code{Font} object defining the font of the legend title + #' @param font \code{Font} object defining the font of the legend caption + #' @param background \code{BackgroundElement} object defining the background of the legend #' @return A new \code{LegendConfiguration} object - initialize = function(position = tlfEnv$defaultLegendPosition, + initialize = function(position = NULL, + caption = NULL, title = NULL, - caption = NULL) { - validateIsIncluded(position, LegendPositions) + titleFont = NULL, + font = NULL, + background = NULL) { + validateIsIncluded(position, LegendPositions, nullAllowed = TRUE) + validateIsString(title, nullAllowed = TRUE) + validateIsOfType(titleFont, "Font", nullAllowed = TRUE) + validateIsOfType(font, "Font", nullAllowed = TRUE) + validateIsOfType(background, "BackgroundElement", nullAllowed = TRUE) + + currentTheme <- tlfEnv$currentTheme$clone(deep = TRUE) + private$.position <- position %||% currentTheme$background$legendPosition + private$.font <- font %||% currentTheme$fonts$legend + private$.titleFont <- titleFont %||% currentTheme$fonts$legendTitle + private$.background <- background %||% currentTheme$background$legend - self$position <- position - self$title <- title - self$caption <- caption + private$.title <- title + private$.caption <- caption %||% data.frame() }, - #' @description Print legend properties - #' @return Legend properties - print = function() { - legendProperties <- list( - title = self$title, - position = self$position, - caption = self$caption + #' @description Update legend configuration on a \code{ggplot} object + #' @param plotObject \code{ggplot} object + #' @return A \code{ggplot} object with updated axis properties + updatePlot = function(plotObject) { + validateIsOfType(plotObject, "ggplot") + # Update legend background, font and title font + plotObject <- plotObject + + ggplot2::theme( + legend.background = private$.background$createPlotElement(), + legend.text = private$.font$createPlotFont(), + legend.title = private$.titleFont$createPlotFont() + ) + + # For legend title, if no title, element_blank should be used + if (isOfLength(private$.title, 0)) { + plotObject <- plotObject + ggplot2::theme(legend.title = ggplot2::element_blank()) + } + # Update legend position + legendPosition <- getLegendPosition(private$.position) + plotObject <- plotObject + ggplot2::theme( + legend.position = c(legendPosition$xPosition, legendPosition$yPosition), + legend.justification = c(legendPosition$xJustification, legendPosition$yJustification), + legend.direction = "vertical" ) - return(legendProperties) + # TO DO: update caption properties before returning plot + return(plotObject) + } + ), + active = list( + #' @field caption of legend defined as data.frame with caption properties + caption = function(value) { + if (missing(value)) { + return(private$.caption) + } + validateIsOfType(value, "data.frame") + private$.caption <- value + return(invisible()) + }, + #' @field position of legend as defined in Enum `LegendPositions` + position = function(value) { + if (missing(value)) { + return(private$.position) + } + validateIsIncluded(value, LegendPositions) + private$.position <- value + return(invisible()) + }, + #' @field font \code{Font} object defining the font of the legend + font = function(value) { + if (missing(value)) { + return(private$.font) + } + validateIsOfType(value, "Font", nullAllowed = TRUE) + currentTheme <- tlfEnv$currentTheme$clone(deep = TRUE) + private$.font <- value %||% currentTheme$fonts$legend + return(invisible()) + }, + #' @field titleFont \code{Font} object defining the font of the legend title + titleFont = function(value) { + if (missing(value)) { + return(private$.titleFont) + } + validateIsOfType(value, "Font", nullAllowed = TRUE) + currentTheme <- tlfEnv$currentTheme$clone(deep = TRUE) + private$.titleFont <- value %||% currentTheme$fonts$legendTitle + return(invisible()) + }, + #' @field background \code{Background} object defining the background of the legend + background = function(value) { + if (missing(value)) { + return(private$.background) + } + validateIsOfType(value, "BackgroundElement", nullAllowed = TRUE) + currentTheme <- tlfEnv$currentTheme$clone(deep = TRUE) + private$.background <- value %||% currentTheme$background$legend + return(invisible()) + }, + #' @field title character defining title of the legend + title = function(value) { + if (missing(value)) { + return(private$.title) + } + validateIsString(value, nullAllowed = TRUE) + private$.title <- value + return(invisible()) } + ), + private = list( + .position = NULL, + .title = NULL, + .titleFont = NULL, + .font = NULL, + .background = NULL, + .caption = NULL ) ) diff --git a/R/plotconfiguration.R b/R/plotconfiguration.R index 27ecc0cd..e45a9871 100644 --- a/R/plotconfiguration.R +++ b/R/plotconfiguration.R @@ -1,41 +1,33 @@ #' @title PlotConfiguration #' @description R6 class defining the configuration of a \code{ggplot} object +#' @field export R6 class \code{ExportConfiguration} defining export properties #' @export PlotConfiguration <- R6::R6Class( "PlotConfiguration", public = list( - #' @field labels R6 class \code{LabelConfiguration} defining labels properties - labels = NULL, - #' @field legend R6 class \code{LegendConfiguration} defining legend properties - legend = NULL, - #' @field xAxis R6 class \code{XAxisConfiguration} defining X-axis properties - xAxis = NULL, - #' @field yAxis R6 class \code{YAxisConfiguration} defining Y-axis properties - yAxis = NULL, - #' @field background R6 class \code{BackgroundConfiguration} defining background properties - background = NULL, - #' @field export R6 class \code{ExportConfiguration} defining export properties export = NULL, - #' @field theme \code{Theme} R6 class defining theme aesthetic properties - theme = NULL, #' @description Create a new \code{PlotConfiguration} object - #' @param title R6 class \code{Label} object - #' @param subtitle R6 class \code{Label} object - #' @param xlabel R6 class \code{Label} object - #' @param ylabel R6 class \code{Label} object - #' @param legend R6 class \code{LegendConfiguration} object defining legend properties - #' @param legendTitle character legend title - #' @param legendPosition character legend position. + #' @param title character or \code{Label} object defining plot title + #' @param subtitle character or \code{Label} object defining plot subtitle + #' @param xlabel character or \code{Label} object defining plot xlabel + #' @param ylabel character or \code{Label} object defining plot ylabel + #' @param legend \code{LegendConfiguration} object defining legend properties + #' @param legendTitle character defining legend title + #' @param legendPosition character defining legend position. #' Use Enum `LegendPositions` to get a list of available to legend positions. - #' @param xAxis R6 class \code{XAxisConfiguration} object defining X-axis properties - #' @param xScale character defining X-axis scale. Use enum `Scaling` to access predefined scales. - #' @param xLimits numeric vector of X-axis limits - #' @param yAxis R6 class \code{YAxisConfiguration} object defining X-axis properties - #' @param yScale character defining Y-axis scale. Use enum `Scaling` to access predefined scales. - #' @param yLimits numeric vector of Y-axis limits - #' @param background R6 class \code{BackgroundConfiguration} defining background properties - #' @param watermark R6 class \code{Label} object defining watermark background + #' @param xAxis \code{XAxisConfiguration} object defining x-axis properties + #' @param xScale name of X-axis scale. Use enum `Scaling` to access predefined scales. + #' @param xLimits numeric vector of length 2 defining x-axis limits + #' @param yAxis \code{YAxisConfiguration} object defining y-axis properties + #' @param yScale name of y-axis scale. Use enum `Scaling` to access predefined scales. + #' @param yLimits numeric vector of length 2 defining y-axis limits + #' @param background \code{BackgroundConfiguration} object defining background properties + #' @param plotArea \code{BackgroundElement} object defining properties of plot area + #' @param panelArea \code{BackgroundElement} object defining properties of panel area + #' @param xGrid \code{LineElement} object defining properties of x-grid background + #' @param yGrid \code{LineElement} object defining properties of y-grid background + #' @param watermark \code{Label} object defining watermark #' @param export R6 class \code{SaveConfiguration} defining saving properties #' @param format character defining the format of the file to be saved #' @param width numeric values defining the width in `units` of the plot dimensions after saving @@ -44,7 +36,6 @@ PlotConfiguration <- R6::R6Class( #' @param data data.frame used by \code{smartMapping} #' @param metaData list of information on \code{data} #' @param dataMapping R6 class or subclass \code{XYDataMapping} - #' @param theme R6 class \code{Theme} #' @return A new \code{PlotConfiguration} object initialize = function( # Label configuration title = NULL, @@ -65,6 +56,10 @@ PlotConfiguration <- R6::R6Class( yLimits = NULL, # Background configuration background = NULL, + plotArea = NULL, + panelArea = NULL, + xGrid = NULL, + yGrid = NULL, watermark = NULL, # Export configuration export = NULL, @@ -75,13 +70,13 @@ PlotConfiguration <- R6::R6Class( # Smart configuration using metaData data = NULL, metaData = NULL, - dataMapping = NULL, - # Theme - theme = tlfEnv$currentTheme) { - self$labels <- LabelConfiguration$new( + dataMapping = NULL) { + + # Label configuration + # validation of the input is done within the creation of the object + private$.labels <- LabelConfiguration$new( title = title, subtitle = subtitle, - xlabel = xlabel, ylabel = ylabel, - theme = theme + xlabel = xlabel, ylabel = ylabel ) # Smart configuration if xlabel and ylabel @@ -91,39 +86,57 @@ PlotConfiguration <- R6::R6Class( if (!is.null(data)) { dataMapping <- dataMapping %||% XYGDataMapping$new(data = data) } - self$labels$xlabel <- asLabel(xlabel %||% + private$.labels$xlabel <- asLabel(xlabel %||% dataMappingLabel(dataMapping$x, metaData) %||% dataMapping$x %||% - self$labels$xlabel) - self$labels$ylabel <- asLabel(ylabel %||% + private$.labels$xlabel$text, font = private$.labels$xlabel$font) + private$.labels$ylabel <- asLabel(ylabel %||% dataMappingLabel(dataMapping$y, metaData) %||% dataMapping$y %||% dataMappingLabel(dataMapping$ymax, metaData) %||% dataMapping$ymax %||% - self$labels$ylabel) + private$.labels$ylabel, font = private$.labels$ylabel$font) - # Smart configuration if legend is not defined, - self$legend <- legend %||% LegendConfiguration$new() - self$legend$title <- legendTitle %||% self$legend$title + # Legend Configuration, overwrite some properties only if they are defined + validateIsOfType(legend, "LegendConfiguration", nullAllowed = TRUE) + private$.legend <- legend %||% LegendConfiguration$new() + private$.legend$title <- legendTitle %||% private$.legend$title validateIsIncluded(legendPosition, LegendPositions, nullAllowed = TRUE) - self$legend$position <- legendPosition %||% self$legend$position - - # Define X-Axis configuration, overwrite properties only if they are defined - self$xAxis <- xAxis %||% XAxisConfiguration$new(scale = xAxisDefaultScale(self)) - self$xAxis$limits <- xLimits %||% self$xAxis$limits - self$xAxis$scale <- xScale %||% self$xAxis$scale - - # Define Y-Axis configuration, overwrite properties only if they are defined - self$yAxis <- yAxis %||% YAxisConfiguration$new(scale = yAxisDefaultScale(self)) - self$yAxis$limits <- yLimits %||% self$yAxis$limits - self$yAxis$scale <- yScale %||% self$yAxis$scale - - # Set background properties - self$background <- background %||% BackgroundConfiguration$new( - watermark = watermark, - theme = theme - ) - self$background$watermark <- watermark %||% self$background$watermark + private$.legend$position <- legendPosition %||% private$.legend$position + + # X-Axis Configuration, overwrite some properties only if they are defined + validateIsOfType(xAxis, "XAxisConfiguration", nullAllowed = TRUE) + private$.xAxis <- xAxis %||% XAxisConfiguration$new(scale = xAxisDefaultScale(self)) + private$.xAxis$limits <- xLimits %||% private$.xAxis$limits + private$.xAxis$scale <- xScale %||% private$.xAxis$scale + + # Y-Axis configuration, overwrite some properties only if they are defined + validateIsOfType(yAxis, "YAxisConfiguration", nullAllowed = TRUE) + private$.yAxis <- yAxis %||% YAxisConfiguration$new(scale = yAxisDefaultScale(self)) + private$.yAxis$limits <- yLimits %||% private$.yAxis$limits + private$.yAxis$scale <- yScale %||% private$.yAxis$scale + + # Background configuration, overwrite some properties only if they are defined + validateIsOfType(background, "BackgroundConfiguration", nullAllowed = TRUE) + validateIsOfType(plotArea, "BackgroundElement", nullAllowed = TRUE) + validateIsOfType(panelArea, "BackgroundElement", nullAllowed = TRUE) + validateIsOfType(xGrid, "LineElement", nullAllowed = TRUE) + validateIsOfType(yGrid, "LineElement", nullAllowed = TRUE) + validateIsOfType(watermark, c("character", "Label"), nullAllowed = TRUE) + + private$.background <- background %||% BackgroundConfiguration$new() + private$.background$plot <- plotArea %||% private$.background$plot + private$.background$panel <- panelArea %||% private$.background$panel + private$.background$xGrid <- xGrid %||% private$.background$xGrid + private$.background$yGrid <- yGrid %||% private$.background$yGrid + private$.background$watermark <- watermark %||% private$.background$watermark + + # Define atom behaviour from theme + currentTheme <- tlfEnv$currentTheme$clone(deep = TRUE) + private$.lines <- asThemeAestheticSelections(currentTheme$plotConfigurations$addLine) + private$.ribbons <- asThemeAestheticSelections(currentTheme$plotConfigurations$addRibbon) + private$.points <- asThemeAestheticSelections(currentTheme$plotConfigurations$addScatter) + private$.errorbars <- asThemeAestheticSelections(currentTheme$plotConfigurations$addErrorbar) # Define export configuration, overwrite properties only if they are defined self$export <- export %||% ExportConfiguration$new() @@ -131,23 +144,101 @@ PlotConfiguration <- R6::R6Class( self$export$width <- width %||% self$export$width self$export$height <- height %||% self$export$height self$export$units <- units %||% self$export$units - - self$theme <- theme + } + ), + active = list( + #' @field labels \code{LabelConfiguration} object defining properties of labels + labels = function(value) { + if (missing(value)) { + return(private$.labels) + } + validateIsOfType(value, "LabelConfiguration", nullAllowed = TRUE) + private$.labels <- value %||% private$.labels + return(invisible()) }, - - #' @description Print plot configuration - #' @return Plot configuration - print = function() { - plotProperties <- list( - labels = self$labels$print(), - legend = self$legend$print(), - xAxis = self$xAxis$print(), - yAxis = self$yAxis$print(), - background = self$background$print(), - saveConfiguration = self$saveConfiguration$print() - ) - return(plotProperties) + #' @field legend \code{LegendConfiguration} object defining properties of legend + legend = function(value) { + if (missing(value)) { + return(private$.legend) + } + validateIsOfType(value, "LegendConfiguration", nullAllowed = TRUE) + private$.legend <- value %||% private$.legend + return(invisible()) + }, + #' @field xAxis \code{XAxisConfiguration} object defining properties of x-axis + xAxis = function(value) { + if (missing(value)) { + return(private$.xAxis) + } + validateIsOfType(value, "XAxisConfiguration", nullAllowed = TRUE) + private$.xAxis <- value %||% private$.xAxis + return(invisible()) + }, + #' @field yAxis \code{YAxisConfiguration} object defining properties of x-axis + yAxis = function(value) { + if (missing(value)) { + return(private$.yAxis) + } + validateIsOfType(value, "YAxisConfiguration", nullAllowed = TRUE) + private$.yAxis <- value %||% private$.yAxis + return(invisible()) + }, + #' @field background \code{BackgroundConfiguration} object defining properties of x-axis + background = function(value) { + if (missing(value)) { + return(private$.background) + } + validateIsOfType(value, "BackgroundConfiguration", nullAllowed = TRUE) + private$.background <- value %||% private$.background + return(invisible()) + }, + #' @field lines `ThemeAestheticSelections` defining properties of lines + lines = function(value) { + if (missing(value)) { + return(private$.lines) + } + validateIsOfType(value, "ThemeAestheticSelections", nullAllowed = TRUE) + private$.lines <- value %||% private$.lines + return(invisible()) + }, + #' @field ribbons `ThemeAestheticSelections` defining properties of ribbons + ribbons = function(value) { + if (missing(value)) { + return(private$.ribbons) + } + validateIsOfType(value, "ThemeAestheticSelections", nullAllowed = TRUE) + private$.ribbons <- value %||% private$.ribbons + return(invisible()) + }, + #' @field points `ThemeAestheticSelections` defining properties of points + points = function(value) { + if (missing(value)) { + return(private$.points) + } + validateIsOfType(value, "ThemeAestheticSelections", nullAllowed = TRUE) + private$.points <- value %||% private$.points + return(invisible()) + }, + #' @field errorbars `ThemeAestheticSelections` defining properties of error bars + errorbars = function(value) { + if (missing(value)) { + return(private$.errorbars) + } + validateIsOfType(value, "ThemeAestheticSelections", nullAllowed = TRUE) + private$.errorbars <- value %||% private$.errorbars + return(invisible()) } + ), + private = list( + .labels = NULL, + .legend = NULL, + .xAxis = NULL, + .yAxis = NULL, + .background = NULL, + .lines = NULL, + .ribbons = NULL, + .points = NULL, + .errorbars = NULL ) ) diff --git a/R/sysdata.rda b/R/sysdata.rda deleted file mode 100644 index f36d9be0..00000000 Binary files a/R/sysdata.rda and /dev/null differ diff --git a/R/themes.R b/R/themes.R index 82c2d844..e959912f 100644 --- a/R/themes.R +++ b/R/themes.R @@ -1,168 +1,577 @@ # Theme Properties and theme object definitions -# -## ------------------------------------------------- -# Load theme properties from a Json file -load("data/tlfEnvThemesProperties.RData") -# jsonlite::fromJSON("../data/default-themes.json") if imported from a .json - #' @title ThemeFont -#' @description R6 class defining theme fonts -#' @include utils.R +#' @description R6 class defining theme font properties +#' @field title \code{Font} object for font properties title +#' @field subtitle \code{Font} object for font properties of subtitle +#' @field xlabel \code{Font} object for font properties of xlabel +#' @field ylabel \code{Font} object for font properties of ylabel +#' @field watermark \code{Font} object for font properties of watermark +#' @field legendTitle \code{Font} object for font properties of legend title +#' @field legend \code{Font} object for font properties of legend +#' @field xAxis \code{Font} object for font properties of xAxis +#' @field yAxis \code{Font} object for font properties of yAxis #' @export ThemeFont <- R6::R6Class( "ThemeFont", + public = list( - #' @field titleFont R6 class \code{Font} object - titleFont = NULL, - #' @field subtitleFont R6 class \code{Font} object - subtitleFont = NULL, - #' @field xlabelFont R6 class \code{Font} object - xlabelFont = NULL, - #' @field ylabelFont R6 class \code{Font} object - ylabelFont = NULL, - #' @field watermarkFont R6 class \code{Font} object - watermarkFont = NULL, + title = NULL, + subtitle = NULL, + xlabel = NULL, + ylabel = NULL, + watermark = NULL, + legendTitle = NULL, + legend = NULL, + xAxis = NULL, + yAxis = NULL, #' @description Create a new \code{ThemeFont} object - #' @param labelColors list of colors for each label - #' @param labelBaseSize numeric value for theme base size + #' @param title \code{Font} object or list for font properties title + #' @param subtitle \code{Font} object or list for font properties of subtitle + #' @param xlabel \code{Font} object or list for font properties of xlabel + #' @param ylabel \code{Font} object or list for font properties of ylabel + #' @param watermark \code{Font} object or list for font properties of watermark + #' @param legendTitle \code{Font} object or list for font properties of legend + #' @param legend \code{Font} object or list for font properties of legend + #' @param xAxis \code{Font} object or list for font properties of xAxis + #' @param yAxis \code{Font} object or list for font properties of yAxis + #' @param baseColor name of base color of undefined fonts. Default is black. + #' @param baseSize base size of undefined fonts. Default is 12. + #' @param baseFace name of base face of undefined fonts. Default is "plain". + #' @param baseFamily name of base family of undefined fonts. Default is "". + #' @param baseAngle base angle of undefined fonts. Default is 0 degree. #' @return A new \code{ThemeFont} object - initialize = function(labelColors = tlfEnvThemesProperties$default$labelColors, - labelBaseSize = 14) { - - # Set font properties of labels - self$titleFont <- Font$new(color = labelColors$title, size = labelBaseSize * 2, fontFace = "bold") - self$subtitleFont <- Font$new(color = labelColors$subtitle, size = labelBaseSize * 1.5, fontFace = "italic") - self$xlabelFont <- Font$new(color = labelColors$xlabel, size = labelBaseSize) - self$ylabelFont <- Font$new(color = labelColors$ylabel, size = labelBaseSize) - self$watermarkFont <- Font$new(color = labelColors$watermark, size = labelBaseSize) + initialize = function(title = NULL, + subtitle = NULL, + xlabel = NULL, + ylabel = NULL, + watermark = NULL, + legendTitle = NULL, + legend = NULL, + xAxis = NULL, + yAxis = NULL, + baseColor = "black", + baseSize = 12, + baseFace = "plain", + baseFamily = "", + baseAngle = 0) { + # Validate necessary input + validateIsString(baseColor) + validateIsString(baseFace) + validateIsString(baseFamily) + validateIsNumeric(baseSize) + validateIsNumeric(baseAngle) + + # Create all field properties by parsing and evaluating their expression + fieldNames <- c("title", "subtitle", "xlabel", "ylabel", "watermark", "legendTitle", "legend", "xAxis", "yAxis") + setFontExpression <- parse(text = paste0("self$", fieldNames, " <- Font$new( + color = ", fieldNames, "$color %||% baseColor, + size = ", fieldNames, "$size %||% baseSize, + fontFace = ", fieldNames, "$fontFace %||% baseFace, + fontFamily = ", fieldNames, "$fontFamily %||% baseFamily, + angle = ", fieldNames, "$angle %||% baseAngle)")) + eval(setFontExpression) + }, + + #' @description Translate object into a json list + #' @return A list that can be saved into a json file + toJson = function() { + jsonObject <- list() + fieldNames <- c("title", "subtitle", "xlabel", "ylabel", "watermark", "legendTitle", "legend", "xAxis", "yAxis") + setJsonExpression <- parse(text = paste0("jsonObject$", fieldNames, " <- list( + color = self$", fieldNames, "$color, + size = self$", fieldNames, "$size, + angle = self$", fieldNames, "$angle, + fontFace = self$", fieldNames, "$fontFace, + fontFamily = self$", fieldNames, "$fontFamily)")) + eval(setJsonExpression) + return(jsonObject) } ) ) -#' @title ThemeAesProperties -#' @description R6 class defining theme aesthetic properties plots -#' @include utils.R +#' @title ThemeBackground +#' @description R6 class defining theme background properties +#' @field watermark character defining content of watermark +#' @field legendPosition character defining where legend should usually be placed +#' @field plot \code{BackgroundElement} object for plot area properties (outside of panel) +#' @field panel \code{BackgroundElement} object for plot area properties (inside of panel) +#' @field xAxis \code{BackgroundElement} object for x axis properties +#' @field yAxis \code{BackgroundElement} object for y axis properties +#' @field xGrid \code{BackgroundElement} object for x grid properties +#' @field yGrid \code{BackgroundElement} object for y grid properties +#' @field legend \code{BackgroundElement} object for legend area properties #' @export -ThemeAesProperties <- R6::R6Class( - "ThemeAesProperties", +ThemeBackground <- R6::R6Class( + "ThemeBackground", + + public = list( + watermark = NULL, + legendPosition = NULL, + plot = NULL, + panel = NULL, + xAxis = NULL, + yAxis = NULL, + xGrid = NULL, + yGrid = NULL, + legend = NULL, + + #' @description Create a new \code{ThemeBackground} object + #' @param watermark character defining content of watermark + #' @param legendPosition character defining where legend should usually be placed + #' @param plot \code{BackgroundElement} object or list for plot area properties (outside of panel) + #' @param panel \code{BackgroundElement} object or list for plot area properties (inside of panel) + #' @param xAxis \code{BackgroundElement} object or list for x axis properties + #' @param yAxis \code{BackgroundElement} object or list for y axis properties + #' @param xGrid \code{BackgroundElement} object or list for x grid properties + #' @param yGrid \code{BackgroundElement} object or list for y grid properties + #' @param legend \code{BackgroundElement} object or list for legend area properties + #' @param baseFill name of base color fill of undefined background elements. Default is white. + #' @param baseColor name of base color of undefined background elements. Default is black. + #' @param baseSize name of base size of undefined background elements. Default is 0.5. + #' @param baseLinetype name of base size of undefined background elements. Default is "solid". + #' @return A new \code{ThemeFont} object + initialize = function(watermark = NULL, + legendPosition = NULL, + plot = NULL, + panel = NULL, + xAxis = NULL, + yAxis = NULL, + xGrid = NULL, + yGrid = NULL, + legend = NULL, + baseFill = "white", + baseColor = "black", + baseSize = 0.5, + baseLinetype = "solid") { + # Validate necessary input + validateIsString(baseFill) + validateIsString(baseColor) + validateIsString(baseLinetype) + validateIsNumeric(baseSize) + + self$watermark <- watermark %||% "" + self$legendPosition <- legendPosition %||% LegendPositions$outsideRight + + # Create all field properties by parsing and evaluating their expression + areaFieldNames <- c("plot", "panel", "legend") + lineFieldNames <- c("xAxis", "yAxis", "xGrid", "yGrid") + + setAreaExpression <- parse(text = paste0("self$", areaFieldNames, " <- BackgroundElement$new(fill = ", areaFieldNames, "$fill %||% baseFill, color = ", areaFieldNames, "$color %||% baseColor, size = ", areaFieldNames, "$size %||% baseSize, linetype = ", areaFieldNames, "$linetype %||% baseLinetype)")) + setLineExpression <- parse(text = paste0("self$", lineFieldNames, " <- LineElement$new(color = ", lineFieldNames, "$color %||% baseColor, size = ", lineFieldNames, "$size %||% baseSize, linetype = ", lineFieldNames, "$linetype %||% baseLinetype)")) + eval(setAreaExpression) + eval(setLineExpression) + }, + + #' @description Translate object into a json list + #' @return A list that can be saved into a json file + toJson = function() { + jsonObject <- list() + jsonObject$watermark <- self$watermark + jsonObject$legendPosition <- self$legendPosition + areaFieldNames <- c("plot", "panel", "legend") + lineFieldNames <- c("xAxis", "yAxis", "xGrid", "yGrid") + + setJsonAreaExpression <- parse(text = paste0("jsonObject$", areaFieldNames, " <- list( + fill = self$", areaFieldNames, "$fill, + color = self$", areaFieldNames, "$color, + size = self$", areaFieldNames, "$size, + linetype = self$", areaFieldNames, "$linetype)")) + setJsonLineExpression <- parse(text = paste0("jsonObject$", lineFieldNames, " <- list( + color = self$", lineFieldNames, "$color, + size = self$", lineFieldNames, "$size, + linetype = self$", lineFieldNames, "$linetype)")) + eval(setJsonAreaExpression) + eval(setJsonLineExpression) + return(jsonObject) + } + ) +) + +#' @title ThemeAestheticMaps +#' @description R6 class defining theme aesthetic maps +#' @field color color map as character or numeric vector +#' @field fill fill map as character or numeric vector +#' @field size size map as numeric vector +#' @field shape shape map as numeric vector +#' @field linetype linetype as character vector +#' @field alpha map as numeric vector +#' @export +ThemeAestheticMaps <- R6::R6Class( + "ThemeAestheticMaps", + public = list( - #' @field color character vector of color properties color = NULL, - #' @field shape character vector of shape properties + fill = NULL, shape = NULL, - #' @field size numeric vector of size properties size = NULL, - #' @field fill character vector of fill properties - fill = NULL, - #' @field linetype character vector of linetype properties linetype = NULL, - #' @field alpha numeric vector of alpha properties alpha = NULL, - #' @description Create a new \code{ThemeAesProperties} object - #' @param aesProperties list of aesthetic properties - #' @param color character vector of color properties - #' @param shape character vector of shape properties - #' @param size numeric vector of size properties - #' @param fill character vector of fill properties - #' @param linetype character vector of linetype properties - #' @param alpha numeric vector of alpha properties - #' @return A new \code{ThemeAesProperties} object - initialize = function(aesProperties = tlfEnvThemesProperties$default$aesProperties, - color = NULL, + #' @description Create a new \code{ThemeAestheticMaps} object + #' @param color color map as list, character or numeric vector + #' @param fill fill map as list, character or numeric vector + #' @param shape shape map as list, character or numeric vector + #' @param size size map as list, character or numeric vector + #' @param linetype linetype map as list, character or numeric vector + #' @param alpha alpha map as list, character or numeric vector + #' @return A new \code{ThemeAestheticMaps} object + initialize = function(color = NULL, + fill = NULL, shape = NULL, size = NULL, + linetype = NULL, + alpha = NULL) { + + # Validate necessary input + validateIsString(color, nullAllowed = TRUE) + validateIsString(fill, nullAllowed = TRUE) + validateIsString(linetype, nullAllowed = TRUE) + + validateIsOfType(shape, c("numeric", "character"), nullAllowed = TRUE) + + validateIsNumeric(size, nullAllowed = TRUE) + validateIsNumeric(alpha, nullAllowed = TRUE) + + # Default aesthetic maps + self$color <- color %||% ColorMaps$default + self$fill <- fill %||% ColorMaps$default + self$shape <- shape %||% as.numeric(Shapes) + self$linetype <- linetype %||% as.character(Linetypes) + self$size <- size %||% seq(1, 5) + self$alpha <- alpha %||% c(0.75, 0.5, 0.25) + + # Checks shapes and linetype according to ggplot2 standards + self$shape <- asPlotShape(self$shape) + validateIsIncluded(self$linetype, Linetypes) + }, + + #' @description Translate object into a json list + #' @return A list that can be saved into a json file + toJson = function() { + jsonObject <- list() + fieldNames <- names(AestheticProperties) + + setJsonExpression <- parse(text = paste0("jsonObject$", fieldNames, " <- self$", fieldNames)) + eval(setJsonExpression) + return(jsonObject) + } + ) +) + +#' @title ThemeAestheticSelections +#' @description R6 class defining how plot configurations will use aesthetic maps +#' @export +ThemeAestheticSelections <- R6::R6Class( + "ThemeAestheticSelections", + inherit = ThemeAestheticMaps, + public = list( + + #' @description Create a new \code{ThemeAestheticSelections} object + #' @param color selection key or values for choice of color + #' @param fill selection key or values for choice of fill + #' @param shape selection key or values for choice of shape + #' @param size selection key or values for choice of size + #' @param linetype selection key or values for choice of linetype + #' @param alpha selection key or values for choice of alpha + #' @return A new \code{ThemeAestheticSelections} object + initialize = function(color = NULL, fill = NULL, + shape = NULL, + size = NULL, linetype = NULL, alpha = NULL) { - self$color <- color %||% aesProperties$color - self$shape <- shape %||% aesProperties$shape - self$size <- size %||% aesProperties$size - self$fill <- fill %||% aesProperties$fill - self$linetype <- linetype %||% aesProperties$linetype - self$alpha <- alpha %||% aesProperties$alpha + + # Associate to each field its value + initializeExpression <- parse(text = paste0("self$", names(AestheticProperties), " <- ", names(AestheticProperties), " %||% 'first'")) + eval(initializeExpression) + }, + + #' @description Translate object into a json list + #' @return A list that can be saved into a json file + toJson = function() { + jsonObject <- list() + fieldNames <- names(AestheticProperties) + + setJsonExpression <- parse(text = paste0("jsonObject$", fieldNames, " <- self$", fieldNames)) + eval(setJsonExpression) + return(jsonObject) + } + ) +) + +#' @title ThemePlotConfigurations +#' @description R6 class defining theme of plot configuration objects +#' @field addScatter theme properties for `PlotConfiguration` objects as used in function `addScatter()` +#' @field addLine theme properties for `PlotConfiguration` objects as used in function `addLine()` +#' @field addRibbon theme properties for `PlotConfiguration` objects as used in function `addRibbon()` +#' @field addErrorbar theme properties for `PlotConfiguration` objects as used in function `addErrorbar()` +#' @field plotPKRatio theme properties for `PlotConfiguration` objects as used in function `plotPKRatio()` +#' @field plotDDIRatio theme properties for `PlotConfiguration` objects as used in function `plotDDIRatio()` +#' @field plotTimeProfile theme properties for `PlotConfiguration` objects as used in function `plotTimeProfile()` +#' @field plotObsVsPred theme properties for `PlotConfiguration` objects as used in function `plotObsVsPred()` +#' @field plotBoxWhisker theme properties for `PlotConfiguration` objects as used in function `plotBoxWhisker()` +#' @field plotTornado theme properties for `PlotConfiguration` objects as used in function `plotTornado()` +#' @field plotHistogram theme properties for `PlotConfiguration` objects as used in function `plotHistogram()` +#' @export +ThemePlotConfigurations <- R6::R6Class( + "ThemePlotConfigurations", + + public = list( + addScatter = NULL, + addLine = NULL, + addRibbon = NULL, + addErrorbar = NULL, + plotPKRatio = NULL, + plotDDIRatio = NULL, + plotTimeProfile = NULL, + plotObsVsPred = NULL, + plotBoxWhisker = NULL, + plotTornado = NULL, + plotHistogram = NULL, + + #' @description Create a new \code{ThemePlotConfigurations} object + #' @param addScatter theme properties for `PlotConfiguration` objects as used in function `addScatter()` + #' @param addLine theme properties for `PlotConfiguration` objects as used in function `addLine()` + #' @param addRibbon theme properties for `PlotConfiguration` objects as used in function `addRibbon()` + #' @param addErrorbar theme properties for `PlotConfiguration` objects as used in function `addErrorbar()` + #' @param plotPKRatio theme properties for `PlotConfiguration` objects as used in function `plotPKRatio()` + #' @param plotDDIRatio theme properties for `PlotConfiguration` objects as used in function `plotDDIRatio()` + #' @param plotTimeProfile theme properties for `PlotConfiguration` objects as used in function `plotTimeProfile()` + #' @param plotObsVsPred theme properties for `PlotConfiguration` objects as used in function `plotObsVsPred()` + #' @param plotBoxWhisker theme properties for `PlotConfiguration` objects as used in function `plotBoxWhisker()` + #' @param plotTornado theme properties for `PlotConfiguration` objects as used in function `plotTornado()` + #' @param plotHistogram theme properties for `PlotConfiguration` objects as used in function `plotHistogram()` + #' @return A new \code{ThemePlotConfigurations} object + initialize = function(addScatter = NULL, + addLine = NULL, + addRibbon = NULL, + addErrorbar = NULL, + plotPKRatio = NULL, + plotDDIRatio = NULL, + plotTimeProfile = NULL, + plotObsVsPred = NULL, + plotBoxWhisker = NULL, + plotTornado = NULL, + plotHistogram = NULL) { + + # Validate necessary input + atomPlotInputs <- c("addScatter", "addLine", "addRibbon", "addErrorbar") + moleculePlotInputs <- c("plotPKRatio", "plotDDIRatio", "plotTimeProfile", "plotObsVsPred", "plotBoxWhisker", "plotTornado", "plotHistogram") + + validateExpressions <- parse(text = paste0("validateIsOfType(", atomPlotInputs, ", 'ThemeAestheticSelections', nullAllowed = TRUE)")) + eval(validateExpressions) + validateExpressions <- parse(text = paste0("validateIsOfType(c(", moleculePlotInputs, "), 'ThemeAestheticSelections', nullAllowed = TRUE)")) + eval(validateExpressions) + + # Default aesthetic for atom plots + self$addScatter <- addScatter %||% ThemeAestheticSelections$new(color = "next", fill = NA, shape = "next", linetype = "blank", size = "first", alpha = 1) + self$addLine <- addLine %||% ThemeAestheticSelections$new(color = "next", fill = NA, shape = "blank", linetype = "reset", size = "first", alpha = 1) + self$addRibbon <- addRibbon %||% ThemeAestheticSelections$new(color = "next", fill = "next", shape = "blank", linetype = "first", size = "same", alpha = 1) + self$addErrorbar <- addErrorbar %||% ThemeAestheticSelections$new(color = "reset", fill = NA, shape = "blank", linetype = "first", size = "same", alpha = 1) + + # Default aesthetic for molecule plots + self$plotPKRatio <- plotPKRatio %||% list( + lines = ThemeAestheticSelections$new(color = c("#000000", "#0078D7", "#D83B01"), linetype = c("longdash", "longdash", "longdash"), size = 0.5, alpha = 1), + points = ThemeAestheticSelections$new(color = "reset", fill = NA, shape = "reset", linetype = "blank", size = 3), + errorbars = ThemeAestheticSelections$new(color = "reset", fill = NA, shape = "blank", linetype = "solid", size = 1) + ) + self$plotDDIRatio <- plotDDIRatio %||% list( + lines = ThemeAestheticSelections$new(color = c("#000000", "#0078D7", "#D83B01"), linetype = c("longdash", "longdash", "longdash"), size = 0.5, alpha = 1), + points = ThemeAestheticSelections$new(color = "reset", fill = NA, shape = "reset", linetype = "blank", size = 3), + errorbars = ThemeAestheticSelections$new(color = "reset", fill = NA, shape = "blank", linetype = "solid", size = 1) + ) + self$plotTimeProfile <- plotTimeProfile %||% list( + lines = ThemeAestheticSelections$new(color = "reset", fill = "reset", shape = "blank", linetype = "reset", size = 1), + ribbons = ThemeAestheticSelections$new(color = "reset", fill = "reset", shape = "blank", linetype = "blank", size = 1, alpha = "first"), + points = ThemeAestheticSelections$new(color = "reset", fill = NA, shape = "reset", linetype = "blank", size = 3), + errorbars = ThemeAestheticSelections$new(color = "reset", fill = NA, shape = "blank", linetype = "solid", size = 1) + ) + self$plotObsVsPred <- plotObsVsPred %||% list( + lines = ThemeAestheticSelections$new(color = "reset", fill = NA, shape = "blank", linetype = "reset", size = 1), + points = ThemeAestheticSelections$new(color = "reset", fill = NA, shape = "reset", linetype = "blank", size = 3), + errorbars = ThemeAestheticSelections$new(color = "reset", fill = NA, shape = "blank", linetype = "solid", size = 1) + ) + self$plotBoxWhisker <- plotBoxWhisker %||% list( + ribbons = ThemeAestheticSelections$new(color = "#000000", fill = "next", linetype = "solid", size = 1, alpha = "first"), + points = ThemeAestheticSelections$new(color = "#000000", shape = "first", linetype = "blank", size = 1) + ) + self$plotTornado <- plotTornado %||% list( + lines = ThemeAestheticSelections$new(color = "#000000", fill = NA, shape = "blank", linetype = "longdash", size = 1), + ribbons = ThemeAestheticSelections$new(color = "reset", fill = "reset", shape = "blank", linetype = "solid", size = 1, alpha = "first"), + points = ThemeAestheticSelections$new(color = "reset", fill = NA, shape = "reset", linetype = "blank", size = 3) + ) + self$plotHistogram <- plotHistogram %||% list( + lines = ThemeAestheticSelections$new(color = "reset", fill = NA, shape = "blank", linetype = "reset", size = 1), + ribbons = ThemeAestheticSelections$new(color = "#000000", fill = "reset", shape = "blank", linetype = "solid", size = 0.5, alpha = "first") + ) + }, + + #' @description Translate object into a json list + #' @return A list that can be saved into a json file + toJson = function() { + jsonObject <- list() + fieldNames <- c("addScatter", "addLine", "addRibbon", "addErrorbar") + + setJsonExpression <- parse(text = paste0("jsonObject$", fieldNames, " <- self$", fieldNames, "$toJson()")) + eval(setJsonExpression) + return(jsonObject) } ) ) #' @title Theme -#' @description R6 class defining theme -#' @include utils.R +#' @description R6 class defining theme properties #' @export Theme <- R6::R6Class( "Theme", - inherit = ThemeFont, public = list( - #' @field watermark list of font properties for watermark - watermark = NULL, - #' @field background list of aesthetic properties for background configuration - background = NULL, - #' @field aesProperties list of aesthetic properties for plots in general - aesProperties = NULL, - #' @field defaultCaption aesthetic properties for specific plots - defaultCaption = NULL, #' @description Create a new \code{Theme} object - #' @param themesProperties list of aesthetic properties - #' @param labelColors list of colors for each label - #' @param labelBaseSize numeric value for theme base size - #' @param background list of aesthetic properties for background configuration - #' @param watermark list of font properties for watermark - #' @param aesProperties list of aesthetic properties for plots in general - #' @param defaultCaption list of aesthetic properties for specific plot features + #' @param fonts `ThemeFont` object + #' @param background `ThemeBackground` object + #' @param aestheticMaps `ThemeAestheticMaps` object + #' @param plotConfigurations `ThemePlotConfiguration` object #' @return A new \code{Theme} object - initialize = function(themesProperties = tlfEnvThemesProperties$default, - labelColors = NULL, - labelBaseSize = 14, + initialize = function(fonts = NULL, background = NULL, - watermark = NULL, - aesProperties = NULL, - defaultCaption = NULL) { - super$initialize( - labelColors = labelColors %||% themesProperties$labelColors, - labelBaseSize = labelBaseSize - ) + aestheticMaps = NULL, + plotConfigurations = NULL) { + validateIsOfType(fonts, "ThemeFont", nullAllowed = TRUE) + validateIsOfType(background, "ThemeBackground", nullAllowed = TRUE) + validateIsOfType(aestheticMaps, "ThemeAestheticMaps", nullAllowed = TRUE) + validateIsOfType(plotConfigurations, "ThemePlotConfigurations", nullAllowed = TRUE) - self$background <- background %||% themesProperties$background - ifnotnull(watermark, self$background$watermark <- watermark) + private$.fonts <- fonts %||% ThemeFont$new() + private$.background <- background %||% ThemeBackground$new() + private$.aestheticMaps <- aestheticMaps %||% ThemeAestheticMaps$new() + private$.plotConfigurations <- plotConfigurations %||% ThemePlotConfigurations$new() + }, - # Set the color, shape, size maps - self$aesProperties <- aesProperties %||% ThemeAesProperties$new(aesProperties = themesProperties$aesProperties) - - # Set the properties of specific plots - self$defaultCaption <- defaultCaption %||% themesProperties$defaultCaption + #' @description Save `Theme` as a json file + #' @param jsonFile name of json file + save = function(jsonFile) { + validateIsString(jsonFile) + themeContent <- list( + font = private$.fonts$toJson(), + background = private$.background$toJson(), + aestheticMaps = private$.aestheticMaps$toJson(), + plotConfigurations = private$.plotConfigurations$toJson() + ) + # Options added in saved json are to help users reading the output + jsonContent <- jsonlite::toJSON(themeContent, auto_unbox = TRUE, pretty = TRUE) + write(jsonContent, file = jsonFile) + return(invisible()) + } + ), + active = list( + #' @field fonts `ThemeFont` object + fonts = function(value) { + if (missing(value)) { + return(private$.fonts) + } + validateIsOfType(value, "ThemeFont") + private$.fonts <- value + }, + #' @field background `ThemeBackground` object + background = function(value) { + if (missing(value)) { + return(private$.background) + } + validateIsOfType(value, "ThemeBackground") + private$.background <- value + }, + #' @field aestheticMaps `ThemeAestheticMaps` object + aestheticMaps = function(value) { + if (missing(value)) { + return(private$.aestheticMaps) + } + validateIsOfType(value, "ThemeAestheticMaps") + private$.aestheticMaps <- value + }, + #' @field plotConfigurations `ThemePlotConfiguration` object + plotConfigurations = function(value) { + if (missing(value)) { + return(private$.plotConfigurations) + } + validateIsOfType(value, "ThemePlotConfigurations") + private$.plotConfigurations <- value } + ), + private = list( + .fonts = NULL, + .background = NULL, + .aestheticMaps = NULL, + .plotConfigurations = NULL ) ) -## ------------------------------------------------- -# Definition of a few standard themes to be used - -#' @title defaultTheme -#' @description -#' Default theme for plot configuration +#' @title loadThemeFromJson +#' @description Load theme object from json file. +#' A template of a json theme is available at system.file(package= "tlf", "theme-maker","theme-template.json") +#' @param jsonFile path of json file +#' @return A \code{Theme} object #' @export -defaultTheme <- Theme$new() +#' @import jsonlite +loadThemeFromJson <- function(jsonFile) { + # Get the content of json file and define lists of its properties + themeContent <- jsonlite::fromJSON(jsonFile) + themeProperties <- names(themeContent) -#' @title tlfTheme -#' @description -#' tlf theme for plot configuration -#' @export -tlfTheme <- Theme$new(themesProperties = tlfEnvThemesProperties$tlf) + # Define default `Theme` properties, properties defined in json will overwrite those + fonts <- ThemeFont$new() + background <- ThemeBackground$new() + aestheticMaps <- ThemeAestheticMaps$new() + plotConfigurations <- ThemePlotConfigurations$new() -#' @title bwTheme -#' @description -#' Black and White theme for plot configuration -#' @export -bwTheme <- Theme$new(themesProperties = tlfEnvThemesProperties$bw) + for (themeProperty in themeProperties) { + if (!isIncluded(themeProperty, c("fonts", "background", "aestheticMaps", "plotConfigurations"))) { + next + } + propertyFields <- names(themeContent[[themeProperty]]) + for (propertyField in propertyFields) { + inputs <- names(themeContent[[themeProperty]][[propertyField]]) + if (isOfLength(inputs, 0)) { + next + } + # Expressions overwriting the properties: + # For each theme property (w.g. fonts, background ...), associate its values (e.g. size, color ...) + propertyExpression <- parse(text = paste0( + themeProperty, "$", propertyField, "$", inputs, + " <- themeContent$", themeProperty, "$", propertyField, "$", inputs + )) + eval(propertyExpression) + } + # Some specific cases are missing from the expressions + background$watermark <- themeContent$background$watermark + background$legendPosition <- themeContent$background$legendPosition + } + return(Theme$new( + fonts = fonts, + background = background, + aestheticMaps = aestheticMaps, + plotConfigurations = plotConfigurations + )) +} -#' @title bigTheme -#' @description -#' Big theme for plot configuration + +#' @title saveThemeToJson +#' @description Save theme object to a json file. +#' @param jsonFile path of json file +#' @param theme `Theme` object path of json file #' @export -bigTheme <- Theme$new(labelBaseSize = 20, watermark = "Big") +saveThemeToJson <- function(jsonFile, theme = NULL) { + # Check that theme is a Theme + validateIsOfType(theme, "Theme", nullAllowed = TRUE) + validateIsString(jsonFile) + + if (isOfLength(theme, 0)) { + theme <- tlfEnv$currentTheme + } + theme$save(jsonFile) + return(invisible()) +} ## ------------------------------------------------- #' @title useTheme @@ -173,5 +582,17 @@ bigTheme <- Theme$new(labelBaseSize = 20, watermark = "Big") #' @export #' useTheme <- function(theme) { + validateIsOfType(theme, "Theme") tlfEnv$currentTheme <- theme } + +## ------------------------------------------------- +#' @title runThemeMaker +#' @description +#' Run shiny app that allows easy setting of Theme objects. +#' Theme objects drive default properties of plots +#' @export +runThemeMaker <- function() { + appPath <- system.file("theme-maker", package = "tlf") + shiny::runApp(appPath) +} diff --git a/R/timeprofile-datamapping.R b/R/timeprofile-datamapping.R index 72c00959..b9d173ca 100644 --- a/R/timeprofile-datamapping.R +++ b/R/timeprofile-datamapping.R @@ -3,26 +3,61 @@ #' @export TimeProfileDataMapping <- R6::R6Class( "TimeProfileDataMapping", - inherit = XYGDataMapping, - + inherit = RangeDataMapping, public = list( - #' @field lloq numeric value of lower limit of quantification - lloq = NULL, - #' @field isRangeTimeProfile logical to set aggregation of data - isRangeTimeProfile = NULL, - #' @description Create a new \code{TimeProfileDataMapping} object - #' @param lloq numeric value of lower limit of quantification - #' @param isRangeTimeProfile Name of x variable to map - #' @param ... parameters inherited from \code{XYGDataMapping} - #' @return A new \code{TimeProfileDataMapping} object - initialize = function(lloq = NULL, - isRangeTimeProfile = FALSE, - ...) { - validateIsLogical(isRangeTimeProfile) - super$initialize(...) - self$lloq <- lloq - self$isRangeTimeProfile <- isRangeTimeProfile + #' @param x Name of x variable to map + #' @param y Name of y variable to map + #' @param ymin Name of ymin variable to map + #' @param ymax Name of ymax variable to map + #' @param groupMapping R6 class \code{GroupMapping} object + #' @param color R6 class \code{Grouping} object or its input + #' @param fill R6 class \code{Grouping} object or its input + #' @param linetype R6 class \code{Grouping} object or its input + #' @param shape R6 class \code{Grouping} object or its input + #' @param size R6 class \code{Grouping} object or its input + #' @param data data.frame to map used by \code{smartMapping} + #' @return A new \code{RangeDataMapping} object + initialize = function(x = NULL, + y = NULL, + ymin = NULL, + ymax = NULL, + groupMapping = NULL, + color = NULL, + fill = NULL, + linetype = NULL, + shape = NULL, + size = NULL, + data = NULL) { + + # smartMapping is available in utilities-mapping.R + smartMap <- smartMapping(data) + super$initialize( + x = x %||% smartMap$x, + ymin = ymin %||% smartMap$ymin, + ymax = ymax %||% smartMap$ymax, + groupMapping = groupMapping, color = color, fill = fill, + linetype = linetype, shape = shape, size = size + ) + # Since TimeProfileDataMapping inherits from RangeDataMapping + # super$initialize introduce a self$y which is NULL + self$y <- y %||% smartMap$y + }, + #' @description Check that \code{data} variables include map variables + #' @param data data.frame to check + #' @param metaData list containing information on \code{data} + #' @return A data.frame with map and \code{legendLabels} variables. + #' Dummy variable \code{legendLabels} is necessary to allow further modification of plots. + checkMapData = function(data, metaData = NULL) { + validateIsOfType(data, "data.frame") + validateMapping(self$y, data, nullAllowed = TRUE) + mapData <- super$checkMapData(data, metaData) + # This may change depending of how we want to include options + if (!isOfLength(self$y, 0)) { + mapData[, self$y] <- data[, self$y] + } + self$data <- mapData + return(mapData) } ) ) diff --git a/R/timeprofile-plotconfiguration.R b/R/timeprofile-plotconfiguration.R index a9be99a3..fd4e95a8 100644 --- a/R/timeprofile-plotconfiguration.R +++ b/R/timeprofile-plotconfiguration.R @@ -6,20 +6,28 @@ TimeProfilePlotConfiguration <- R6::R6Class( inherit = PlotConfiguration, public = list( - #' @field timeProfileCaption list of properties for time profile plot specific features - timeProfileCaption = NULL, - #' @description Create a new \code{TimeProfilePlotConfiguration} object - #' @param timeProfileCaption list of properties for PK ratio plot specific features + #' @param lines `ThemeAestheticSelections` defining properties of lines + #' @param ribbons `ThemeAestheticSelections` defining properties of ribbons + #' @param points `ThemeAestheticSelections` defining properties of points + #' @param errorbars `ThemeAestheticSelections` defining properties of error bars #' @param ... parameters inherited from \code{PlotConfiguration} #' @return A new \code{TimeProfilePlotConfiguration} object - initialize = function(timeProfileCaption = getDefaultCaptionFor("timeProfile"), + initialize = function(lines = NULL, + ribbons = NULL, + points = NULL, + errorbars = NULL, ...) { - validateIsOfType(timeProfileCaption, "data.frame") - validateIsIncluded(names(timeProfileCaption), CaptionProperties) super$initialize(...) - - self$timeProfileCaption <- timeProfileCaption + validateIsOfType(lines, "ThemeAestheticSelections", nullAllowed = TRUE) + validateIsOfType(ribbons, "ThemeAestheticSelections", nullAllowed = TRUE) + validateIsOfType(points, "ThemeAestheticSelections", nullAllowed = TRUE) + validateIsOfType(errorbars, "ThemeAestheticSelections", nullAllowed = TRUE) + currentTheme <- tlfEnv$currentTheme$clone(deep = TRUE) + private$.lines <- lines %||% asThemeAestheticSelections(currentTheme$plotConfigurations$plotTimeProfile$lines) + private$.ribbons <- ribbons %||% asThemeAestheticSelections(currentTheme$plotConfigurations$plotTimeProfile$ribbons) + private$.points <- points %||% asThemeAestheticSelections(currentTheme$plotConfigurations$plotTimeProfile$points) + private$.errorbars <- errorbars %||% asThemeAestheticSelections(currentTheme$plotConfigurations$plotTimeProfile$errorbars) } ) ) diff --git a/R/tlf-env.R b/R/tlf-env.R index 17e1d028..be5ad436 100644 --- a/R/tlf-env.R +++ b/R/tlf-env.R @@ -5,9 +5,6 @@ tlfEnv <- new.env(parent = emptyenv()) # name of the package. This will be used to retrieve information on the package at run time tlfEnv$packageName <- "tlf" -# Set the current theme of the tlf plot configurations -tlfEnv$currentTheme <- defaultTheme - #' @title LegendPositions #' @include enum.R #' @export @@ -42,7 +39,9 @@ tlfEnv$defaultLegendPosition <- LegendPositions$outsideRight #' @export setDefaultLegendPosition <- function(position) { validateIsIncluded(position, LegendPositions) + # TO DO: Line to be deprecated tlfEnv$defaultLegendPosition <- position + tlfEnv$currentTheme$background$legendPosition <- position } tlfEnv$defaultExportParameters <- list(format = "png", width = 16, height = 9, units = "cm") @@ -142,7 +141,14 @@ setDefaultAggregationBins <- function(bins = NULL) { #' @description Set default watermark value for current theme #' @param watermark character or Label class object #' @export -setDefaultWatermark <- function(watermark = NULL){ +setDefaultWatermark <- function(watermark = NULL) { validateIsOfType(watermark, c("Label", "character"), nullAllowed = TRUE) - tlfEnv$currentTheme$background$watermark <- asLabel(watermark) -} \ No newline at end of file + if(isOfType(watermark, "character")){ + tlfEnv$currentTheme$background$watermark <- watermark + } + if(isOfType(watermark, "Label")){ + tlfEnv$currentTheme$background$watermark <- watermark$text + tlfEnv$currentTheme$fonts$watermark <- watermark$font + } + return(invisible()) +} diff --git a/R/tornado-datamapping.R b/R/tornado-datamapping.R index 197d675d..c92cff9d 100644 --- a/R/tornado-datamapping.R +++ b/R/tornado-datamapping.R @@ -5,24 +5,24 @@ TornadoDataMapping <- R6::R6Class( "TornadoDataMapping", inherit = XYGDataMapping, public = list( - #' @field tornadoValues numeric vector of limits to plot - tornadoValues = NULL, + #' @field lines numeric vector of limits to plot + lines = NULL, #' @field sorted logical indicating if values should be sorted sorted = NULL, #' @description Create a new \code{TornadoDataMapping} object - #' @param tornadoValues numeric vector of ratio limits to plot + #' @param lines numeric vector of limits to plot #' @param sorted logical indicating if values should be sorted #' @param x Variable including the values of tornado plot #' @param y Variable including the labels of tornado plot #' @param ... parameters inherited from \code{XYGDataMapping} #' @return A new \code{TornadoDataMapping} object - initialize = function(tornadoValues = DefaultDataMappingValues$tornado, + initialize = function(lines = DefaultDataMappingValues$tornado, sorted = NULL, x = NULL, y = NULL, ...) { - validateIsNumeric(tornadoValues) + validateIsNumeric(lines, nullAllowed = TRUE) validateIsLogical(sorted, nullAllowed = TRUE) super$initialize(x = x, y = y, ...) @@ -44,7 +44,7 @@ TornadoDataMapping <- R6::R6Class( self$groupMapping$color ) - self$tornadoValues <- tornadoValues + self$lines <- lines self$sorted <- sorted %||% TRUE } ) diff --git a/R/tornado-plotconfiguration.R b/R/tornado-plotconfiguration.R index 8f3c331b..cbebdcec 100644 --- a/R/tornado-plotconfiguration.R +++ b/R/tornado-plotconfiguration.R @@ -5,8 +5,6 @@ TornadoPlotConfiguration <- R6::R6Class( "TornadoPlotConfiguration", inherit = PlotConfiguration, public = list( - #' @field tornadoCaption list of properties for tornado plot specific features - tornadoCaption = NULL, #' @field bar logical setting if tornado is uses a bar plot instead of regular points bar = NULL, #' @field colorPalette color palette property from `ggplot2` @@ -16,29 +14,38 @@ TornadoPlotConfiguration <- R6::R6Class( #' @description Create a new \code{TornadoPlotConfiguration} object - #' @param tornadoCaption list of properties for tornado plot specific features #' @param bar logical setting if tornado is uses a bar plot instead of regular points #' @param colorPalette color palette property from `ggplot2` #' @param dodge space between the bars/points + #' @param lines `ThemeAestheticSelections` object defining properties for Tornado vertical lines + #' @param points `ThemeAestheticSelections` object defining properties for scatter points + #' @param ribbons `ThemeAestheticSelections` object defining properties for bars #' @param ... parameters inherited from \code{PlotConfiguration} #' @return A new \code{TornadoPlotConfiguration} object - initialize = function(tornadoCaption = getDefaultCaptionFor("tornado"), - bar = TRUE, + initialize = function(bar = TRUE, colorPalette = NULL, dodge = 0.5, + lines = NULL, + points = NULL, + ribbons = NULL, ...) { - validateIsOfType(tornadoCaption, "data.frame") - #validateIsIncluded(names(tornadoCaption), CaptionProperties) - # Currently the properties from tornadoCaption are not defined in the theme snapshot validateIsLogical(bar) validateIsString(colorPalette, nullAllowed = TRUE) validateIsNumeric(dodge) + validateIsOfType(lines, "ThemeAestheticSelections", nullAllowed = TRUE) + validateIsOfType(points, "ThemeAestheticSelections", nullAllowed = TRUE) + validateIsOfType(ribbons, "ThemeAestheticSelections", nullAllowed = TRUE) super$initialize(...) + + currentTheme <- tlfEnv$currentTheme$clone(deep = TRUE) + private$.lines <- lines %||% asThemeAestheticSelections(currentTheme$plotConfigurations$plotTornado$lines) + private$.points <- points %||% asThemeAestheticSelections(currentTheme$plotConfigurations$plotTornado$points) + private$.ribbons <- ribbons %||% asThemeAestheticSelections(currentTheme$plotConfigurations$plotTornado$ribbons) + self$bar <- bar self$colorPalette <- colorPalette self$dodge <- dodge - self$tornadoCaption <- tornadoCaption } ) ) diff --git a/R/utilities-aesthetics.R b/R/utilities-aesthetics.R new file mode 100644 index 00000000..e05d9e4c --- /dev/null +++ b/R/utilities-aesthetics.R @@ -0,0 +1,172 @@ +#' @title AestheticProperties +#' @description Enum of aesthetic property names of `ggplot2` +AestheticProperties <- enum(c( + "color", + "fill", + "size", + "shape", + "linetype", + "alpha" +)) + +#' @title Linetypes +#' @description Enum of `ggplot2` linetypes +#' @export +Linetypes <- enum(c( + "solid", + "longdash", + "dotted", + "dashed", + "twodash", + "dotdash", + "blank" +)) + +#' @title Shapes +#' @description List of some `ggplot2` shapes +#' @export +Shapes <- list( + "square" = 15, + "dot" = 20, + "circle" = 19, + "diamond" = 18, + "star" = 8, + "plus" = 3, + "cross" = 4, + "triangle" = 17, + "blank" = -2 +) + +asPlotShape <- function(shapes) { + ggplotShapes <- NULL + for (shape in shapes) { + ggplotShape <- shape + if (isOfType(shape, "character")) { + validateIsIncluded(shape, names(Shapes)) + ggplotShape <- Shapes[[shape]] + } + ggplotShapes <- c(ggplotShapes, ggplotShape) + } + return(ggplotShapes) +} + +asThemeAestheticSelections <- function(themeSelectionObject) { + if (isOfType(themeSelectionObject, "ThemeAestheticSelections")) { + return(themeSelectionObject) + } + newThemeAestheticSelections <- ThemeAestheticSelections$new() + setNewThemeSelectionExpression <- parse(text = paste0( + "newThemeAestheticSelections$", names(themeSelectionObject), "<- themeSelectionObject$", names(themeSelectionObject) + )) + eval(setNewThemeSelectionExpression) + return(newThemeAestheticSelections) +} + +#' @title ColorMaps +#' @description List with some color maps for `Theme` object +#' @export +ColorMaps <- list( + default = c("#0078D7", "#D83B01", "#107C10", "#A80000", "#002050", "#B4009E"), + grays = paste("gray", seq(0, 100, 10), sep = ""), + prism = c("#FF0000", "#FF7F00", "#FFFF00", "#00FF00", "#0000FF", "#4B0082", "#8F00FF"), + blot = c("blue", "magenta", "cyan", "green", "yellow", "red"), + temperature = c("#262A76", "#234990", "#2F8AC3", "#26B0D2", "#FFC1CB", "#EB559", "#AE3535", "8E1F20") +) + +#' @title AestheticSelectionKeys +#' @description List of some `ggplot2` shapes +#' @export +AestheticSelectionKeys <- enum(c( + "next", + "same", + "first", + "reset" +)) + +#' @title getAestheticValues +#' @description Get aesthetic values (e.g color, shape, linetype) based on a selected strategy +#' @param n integer defining size of returned aesthetic vector +#' @param selectionKey value of aesthetic to be returned or key function from enum `AestheticSelectionKeys` +#' @return Vector of aesthetics +getAestheticValues <- function(n, selectionKey = NA, position = 0, aesthetic = "color") { + validateIsIncluded(aesthetic, AestheticProperties) + # Load aesthetics from current `Theme` object + map <- tlfEnv$currentTheme$aestheticMaps[[aesthetic]] + # next is necessary as `next` otherwise R crashes + if (isIncluded(selectionKey, AestheticSelectionKeys$`next`)) { + return(getNextAestheticValues(n, position, map)) + } + if (isIncluded(selectionKey, AestheticSelectionKeys$same)) { + return(getSameAestheticValues(n, position, map)) + } + if (isIncluded(selectionKey, AestheticSelectionKeys$first)) { + return(getFirstAestheticValues(n, map)) + } + if (isIncluded(selectionKey, AestheticSelectionKeys$reset)) { + return(getResetAestheticvalues(n, map)) + } + # TO DO: Add wrappers for validation + # which could translate some selection keys for ggplot 2 + if (isIncluded(aesthetic, AestheticProperties$shape)) { + return(asPlotShape(getNextAestheticValues(n, position = position, map = selectionKey))) + } + if (isIncluded(aesthetic, c(AestheticProperties$size, AestheticProperties$alpha))) { + return(as.numeric(getNextAestheticValues(n, position = position, map = selectionKey))) + } + # If selection key is a specific value/set of values, it becomes the map + return(getNextAestheticValues(n, position = position, map = selectionKey)) +} + +#' @title getNextAestheticValues +#' @description Get the next aesthetic values (e.g color, shape, linetype) from an aesthetic map defined in `Theme` +#' @param n integer defining size of returned aesthetic vector +#' @param position integer defining at which position to look for aesthetic vector +#' @param map Aesthetic (e.g. color, shape, linetype) map from `Theme` object. +#' @return Vector of aesthetics +getNextAestheticValues <- function(n, position = 0, map) { + # Get the map indices of aesthtic values to be output + aesPositions <- seq(position + 1, position + n) + + # In case the map is not long enough to get all the indices + # the indices have to go start back from 1 using modelu function + mapSize <- length(map) + aesPositions <- ((aesPositions - 1) %% mapSize) + 1 + return(map[aesPositions]) +} + +#' @title getSameAestheticValues +#' @description Get the same aesthetic values (e.g color, shape, linetype) from an aesthetic map defined in `Theme` +#' @param n integer defining size of returned aesthetic vector +#' @param position integer defining at which position to look for aesthetic vector +#' @param map Aesthetic (e.g. color, shape, linetype) map from `Theme` object. +#' @return Vector of aesthetics +getSameAestheticValues <- function(n, position = 0, map) { + # In case the map is not long enough to get the indices in position + # the indices have to go start back from 1 using modelu function + mapSize <- length(map) + aesPosition <- (position %% mapSize) + 1 + + # Get the map indices of aesthtic values to be output + aesPositions <- rep(aesPosition, n) + return(map[aesPositions]) +} + +#' @title getResetAestheticvalues +#' @description Get the aesthetic values (e.g color, shape, linetype) from an aesthetic map defined in `Theme`. +#' Reset the value every time it is used. +#' @param n integer defining size of returned aesthetic vector +#' @param map Aesthetic (e.g. color, shape, linetype) map from `Theme` object. +#' @return Vector of aesthetics +getResetAestheticvalues <- function(n, map) { + return(getNextAestheticValues(n, position = 0, map)) +} + +#' @title getFirstAestheticValues +#' @description Get the next aesthetic values (e.g color, shape, linetype) from an aesthetic map defined in `Theme` +#' @param n integer defining size of returned aesthetic vector +#' @param position integer defining at which position to look for aesthetic vector +#' @param map Aesthetic (e.g. color, shape, linetype) map from `Theme` object. +#' @return Vector of aesthetics +getFirstAestheticValues <- function(n, map) { + return(getSameAestheticValues(n, position = 0, map)) +} diff --git a/R/utilities-axis.R b/R/utilities-axis.R index 2fab9f5d..8e1f457b 100644 --- a/R/utilities-axis.R +++ b/R/utilities-axis.R @@ -5,47 +5,35 @@ #' @param limits X-axis limits #' @param ticks X-axis ticks #' @param ticklabels X-axis ticklabels +#' @param font `Font` object defining font of ticklabels #' @return ggplot object with updated X-axis #' @export setXAxis <- function(plotObject, scale = NULL, limits = NULL, ticks = NULL, - ticklabels = NULL) { + ticklabels = NULL, + font = NULL) { validateIsOfType(plotObject, "ggplot") validateIsIncluded(scale, Scaling, nullAllowed = TRUE) + validateIsNumeric(limits, nullAllowed = TRUE) + validateIsOfType(font, "Font", nullAllowed = TRUE) # Clone plotConfiguration into a new plot object # Prevents update of R6 class being spread to plotObject newPlotObject <- plotObject newPlotObject$plotConfiguration <- plotObject$plotConfiguration$clone(deep = TRUE) - # R6 class not cloned will spread modifications into newPlotObject$plotConfiguration$yAxis + # R6 class not cloned will spread modifications into newPlotObject$plotConfiguration$xAxis xAxis <- newPlotObject$plotConfiguration$xAxis - xAxis <- plotObject$plotConfiguration$xAxis$clone() xAxis$limits <- limits %||% xAxis$limits xAxis$scale <- scale %||% xAxis$scale xAxis$ticks <- ticks %||% xAxis$ticks xAxis$ticklabels <- ticklabels %||% xAxis$ticklabels + xAxis$font <- font %||% xAxis$font - if (xAxis$scale %in% "lin") { - xAxis$scale <- "identity" - } - if (!isOfLength(xAxis$ticks, 0)) { - if (xAxis$ticks[1] %in% "default") { - xAxis$ticks <- waiver() - } - } - - if (!isOfLength(xAxis$ticks, 0)) { - if (xAxis$ticklabels[1] %in% "default") { - xAxis$ticklabels <- waiver() - } - } - - newPlotObject <- xAxis$setPlotAxis(newPlotObject) - + newPlotObject <- xAxis$updatePlot(newPlotObject) return(newPlotObject) } @@ -56,15 +44,19 @@ setXAxis <- function(plotObject, #' @param limits Y-axis limits #' @param ticks Y-axis ticks #' @param ticklabels Y-axis ticklabels +#' @param font `Font` object defining font of ticklabels #' @return ggplot object with updated Y-axis #' @export setYAxis <- function(plotObject, scale = NULL, limits = NULL, ticks = NULL, - ticklabels = NULL) { + ticklabels = NULL, + font = NULL) { validateIsOfType(plotObject, "ggplot") validateIsIncluded(scale, Scaling, nullAllowed = TRUE) + validateIsNumeric(limits, nullAllowed = TRUE) + validateIsOfType(font, "Font", nullAllowed = TRUE) # Clone plotConfiguration into a new plot object # Prevents update of R6 class being spread to plotObject @@ -78,25 +70,9 @@ setYAxis <- function(plotObject, yAxis$scale <- scale %||% yAxis$scale yAxis$ticks <- ticks %||% yAxis$ticks yAxis$ticklabels <- ticklabels %||% yAxis$ticklabels + yAxis$font <- font %||% yAxis$font - if (yAxis$scale %in% "lin") { - yAxis$scale <- "identity" - } - - if (!isOfLength(yAxis$ticks, 0)) { - if (yAxis$ticks[1] %in% "default") { - yAxis$ticks <- waiver() - } - } - - if (!isOfLength(yAxis$ticks, 0)) { - if (yAxis$ticklabels[1] %in% "default") { - yAxis$ticklabels <- waiver() - } - } - - newPlotObject <- yAxis$setPlotAxis(newPlotObject) - + newPlotObject <- yAxis$updatePlot(newPlotObject) return(newPlotObject) } diff --git a/R/utilities-background.R b/R/utilities-background.R index 50300ed8..2f258ee9 100644 --- a/R/utilities-background.R +++ b/R/utilities-background.R @@ -1,40 +1,102 @@ #' @title setGrid -#' @description Set grid properties on a ggplot object +#' @description Set x and y grid properties on a ggplot object #' @param plotObject ggplot object to set #' @param color character color of the grid #' @param linetype character linetype of the grid. Use "blank" to remove grid. #' @param size numeric size of the grid lines -#' @return ggplot object with updated Y-axis +#' @return ggplot object #' @export setGrid <- function(plotObject, color = NULL, linetype = NULL, size = NULL) { validateIsOfType(plotObject, "ggplot") - validateIsOfType(color, "character", nullAllowed = TRUE) - validateIsOfType(linetype, "character", nullAllowed = TRUE) - validateIsOfType(size, "numeric", nullAllowed = TRUE) + validateIsString(color, nullAllowed = TRUE) + validateIsIncluded(linetype, Linetypes, nullAllowed = TRUE) + validateIsNumeric(size, nullAllowed = TRUE) # Clone plotConfiguration into a new plot object # Prevents update of R6 class being spread to plotObject newPlotObject <- plotObject newPlotObject$plotConfiguration <- plotObject$plotConfiguration$clone(deep = TRUE) - # R6 class not cloned will spread modifications into newPlotObject$plotConfiguration$grid - grid <- newPlotObject$plotConfiguration$background$grid + # R6 class not cloned will spread modifications into newPlotObject$plotConfiguration + background <- newPlotObject$plotConfiguration$background - grid$color <- color %||% grid$color - grid$linetype <- linetype %||% grid$linetype - grid$size <- size %||% grid$size + background$xGrid$color <- color %||% background$xGrid$color + background$yGrid$color <- color %||% background$yGrid$color + background$xGrid$linetype <- linetype %||% background$xGrid$linetype + background$yGrid$linetype <- linetype %||% background$yGrid$linetype + background$xGrid$size <- color %||% background$xGrid$size + background$yGrid$size <- color %||% background$yGrid$size - newPlotObject <- newPlotObject + theme( - panel.grid = element_line( - color = grid$color, - size = grid$size, - linetype = grid$linetype - ) - ) + newPlotObject <- background$updatePlot(newPlotObject) + return(newPlotObject) +} + +#' @title setXGrid +#' @description Set x-grid properties on a ggplot object +#' @param plotObject ggplot object to set +#' @param color character color of the grid +#' @param linetype character linetype of the grid. Use "blank" to remove grid. +#' @param size numeric size of the grid lines +#' @return ggplot object +#' @export +setXGrid <- function(plotObject, + color = NULL, + linetype = NULL, + size = NULL) { + validateIsOfType(plotObject, "ggplot") + validateIsString(color, nullAllowed = TRUE) + validateIsIncluded(linetype, Linetypes, nullAllowed = TRUE) + validateIsNumeric(size, nullAllowed = TRUE) + # Clone plotConfiguration into a new plot object + # Prevents update of R6 class being spread to plotObject + newPlotObject <- plotObject + newPlotObject$plotConfiguration <- plotObject$plotConfiguration$clone(deep = TRUE) + + # R6 class not cloned will spread modifications into newPlotObject$plotConfiguration + background <- newPlotObject$plotConfiguration$background + + background$xGrid$color <- color %||% background$xGrid$color + background$xGrid$linetype <- linetype %||% background$xGrid$linetype + background$xGrid$size <- color %||% background$xGrid$size + + newPlotObject <- background$updatePlot(newPlotObject) + return(newPlotObject) +} + +#' @title setYGrid +#' @description Set x and y grid properties on a ggplot object +#' @param plotObject ggplot object to set +#' @param color character color of the grid +#' @param linetype character linetype of the grid. Use "blank" to remove grid. +#' @param size numeric size of the grid lines +#' @return ggplot object +#' @export +setYGrid <- function(plotObject, + color = NULL, + linetype = NULL, + size = NULL) { + validateIsOfType(plotObject, "ggplot") + validateIsString(color, nullAllowed = TRUE) + validateIsIncluded(linetype, Linetypes, nullAllowed = TRUE) + validateIsNumeric(size, nullAllowed = TRUE) + + # Clone plotConfiguration into a new plot object + # Prevents update of R6 class being spread to plotObject + newPlotObject <- plotObject + newPlotObject$plotConfiguration <- plotObject$plotConfiguration$clone(deep = TRUE) + + # R6 class not cloned will spread modifications into newPlotObject$plotConfiguration + background <- newPlotObject$plotConfiguration$background + + background$yGrid$color <- color %||% background$yGrid$color + background$yGrid$linetype <- linetype %||% background$yGrid$linetype + background$yGrid$size <- color %||% background$yGrid$size + + newPlotObject <- background$updatePlot(newPlotObject) return(newPlotObject) } @@ -45,20 +107,18 @@ setGrid <- function(plotObject, #' @param color character color of the background frame #' @param linetype character linetype of the background frame #' @param size numeric size of the background frame -#' @param outerBackgroundFill character color fill of the outerBackground -#' @return ggplot object with updated Y-axis +#' @return ggplot object #' @export setBackground <- function(plotObject, fill = NULL, color = NULL, linetype = NULL, - size = NULL, - outerBackgroundFill = NULL) { + size = NULL) { validateIsOfType(plotObject, "ggplot") - validateIsOfType(size, "numeric", nullAllowed = TRUE) - inputs <- c("fill", "color", "linetype", "outerBackgroundFill") - validateExpressions <- parse(text = paste0("validateIsOfType(", inputs, ', "character", nullAllowed =TRUE)')) - eval(validateExpressions) + validateIsString(fill, nullAllowed = TRUE) + validateIsString(color, nullAllowed = TRUE) + validateIsIncluded(linetype, Linetypes, nullAllowed = TRUE) + validateIsNumeric(size, nullAllowed = TRUE) # Clone plotConfiguration into a new plot object # Prevents update of R6 class being spread to plotObject @@ -66,42 +126,109 @@ setBackground <- function(plotObject, newPlotObject$plotConfiguration <- plotObject$plotConfiguration$clone(deep = TRUE) # R6 class not cloned will spread modifications into newPlotObject$plotConfiguration - innerBackground <- newPlotObject$plotConfiguration$background$innerBackground - outerBackground <- newPlotObject$plotConfiguration$background$outerBackground - - innerBackground$fill <- fill %||% innerBackground$fill - innerBackground$color <- color %||% innerBackground$color - innerBackground$linetype <- linetype %||% innerBackground$linetype - innerBackground$size <- size %||% innerBackground$size - outerBackground$fill <- outerBackgroundFill %||% innerBackground$fill - - newPlotObject <- newPlotObject + theme( - plot.background = element_rect(fill = outerBackground$fill), - legend.background = element_rect(fill = outerBackground$fill), - panel.background = element_rect( - fill = innerBackground$fill, - color = innerBackground$color, - size = innerBackground$size, - linetype = innerBackground$linetype, - ) - ) + background <- newPlotObject$plotConfiguration$background + + background$plot$fill <- fill %||% background$plot$fill + background$plot$color <- color %||% background$plot$color + background$plot$linetype <- linetype %||% background$plot$linetype + background$plot$size <- size %||% background$plot$size + + background$panel$fill <- fill %||% background$panel$fill + background$panel$color <- color %||% background$panel$color + background$panel$linetype <- linetype %||% background$panel$linetype + background$panel$size <- size %||% background$panel$size + + newPlotObject <- background$updatePlot(newPlotObject) return(newPlotObject) } +#' @title setBackgroundPanelArea +#' @description Set background panel area properties on a ggplot object +#' @param plotObject ggplot object to set +#' @param fill character color fill of the background +#' @param color character color of the background frame +#' @param linetype character linetype of the background frame +#' @param size numeric size of the background frame +#' @return ggplot object +#' @export +setBackgroundPanelArea <- function(plotObject, + fill = NULL, + color = NULL, + linetype = NULL, + size = NULL) { + validateIsOfType(plotObject, "ggplot") + validateIsString(fill, nullAllowed = TRUE) + validateIsString(color, nullAllowed = TRUE) + validateIsIncluded(linetype, Linetypes, nullAllowed = TRUE) + validateIsNumeric(size, nullAllowed = TRUE) + + # Clone plotConfiguration into a new plot object + # Prevents update of R6 class being spread to plotObject + newPlotObject <- plotObject + newPlotObject$plotConfiguration <- plotObject$plotConfiguration$clone(deep = TRUE) + + # R6 class not cloned will spread modifications into newPlotObject$plotConfiguration + background <- newPlotObject$plotConfiguration$background + + background$panel$fill <- fill %||% background$panel$fill + background$panel$color <- color %||% background$panel$color + background$panel$linetype <- linetype %||% background$panel$linetype + background$panel$size <- size %||% background$panel$size + + newPlotObject <- background$updatePlot(newPlotObject) + return(newPlotObject) +} + +#' @title setBackgroundPlotArea +#' @description Set background plot area properties on a ggplot object +#' @param plotObject ggplot object to set +#' @param fill character color fill of the background +#' @param color character color of the background frame +#' @param linetype character linetype of the background frame +#' @param size numeric size of the background frame +#' @return ggplot object +#' @export +setBackgroundPlotArea <- function(plotObject, + fill = NULL, + color = NULL, + linetype = NULL, + size = NULL) { + validateIsOfType(plotObject, "ggplot") + validateIsString(fill, nullAllowed = TRUE) + validateIsString(color, nullAllowed = TRUE) + validateIsIncluded(linetype, Linetypes, nullAllowed = TRUE) + validateIsNumeric(size, nullAllowed = TRUE) + + # Clone plotConfiguration into a new plot object + # Prevents update of R6 class being spread to plotObject + newPlotObject <- plotObject + newPlotObject$plotConfiguration <- plotObject$plotConfiguration$clone(deep = TRUE) + + # R6 class not cloned will spread modifications into newPlotObject$plotConfiguration + background <- newPlotObject$plotConfiguration$background + + background$plot$fill <- fill %||% background$plot$fill + background$plot$color <- color %||% background$plot$color + background$plot$linetype <- linetype %||% background$plot$linetype + background$plot$size <- size %||% background$plot$size + + newPlotObject <- background$updatePlot(newPlotObject) + return(newPlotObject) +} #' @title addWatermark #' @param plotObject ggplot object to which the watermark is added -#' @param label Character or Label class object corresponding to the watermark text -#' (and its font properties if Label) -#' @param angle Angle in degree from horizontal of the watermark label. Default angle is 30 degrees. +#' @param watermark Character or `Label` object corresponding to the watermark text +#' (and its font properties if `Label`) +#' @param color Color of the watermark label. +#' @param size Size of the watermark label. +#' @param angle Angle of the watermark label (in degree). #' @param alpha Transparency of the watermark label. #' Alpha is a numeric between 0 and 1: 0 label is totally transparent, 1 label is totally opaque. -#' Default alpha is 0.4. #' @return \code{plotObject} ggplot object to which the watermark is added. #' @description #' addWatermark creates a ggplot grob based on the label text and its font properties. #' Then, adds the grob to the ggplot object input \code{plotObject} as a new layer using \code{ggplot2::annotation_custom}. -#' \code{angle} and \code{alpha} are optional input to customize the angle and transparency of the watermark text. #' @import ggplot2 #' @export #' @examples @@ -121,19 +248,37 @@ setBackground <- function(plotObject, #' # Create a sun as background #' for (angle in seq(0, 340, 20)) { #' p <- addWatermark(p, -#' label = Label$new(text = " >", color = "yellow"), -#' angle = angle, alpha = 1 +#' watermark = " >", +#' color = "yellow", angle = angle, alpha = 1 #' ) #' } addWatermark <- function(plotObject, - label, - angle = 30, - alpha = 0.4) { + watermark, + color = NULL, + size = NULL, + angle = NULL, + alpha = NULL) { validateIsOfType(plotObject, "ggplot") - # Ensure label is a Label class - label <- asLabel(label) + validateIsOfType(watermark, c("character", "Label")) + validateIsString(color, nullAllowed = TRUE) + validateIsNumeric(size, nullAllowed = TRUE) + validateIsNumeric(alpha, nullAllowed = TRUE) + validateIsNumeric(angle, nullAllowed = TRUE) + # Transparency from theme aesthetic map if left undefined + alpha <- alpha %||% getAestheticValues( + n = 1, + selectionKey = AestheticSelectionKeys$first, + aesthetic = "alpha" + ) + # Ensure watermark is a Label class + if (isOfType(watermark, "character")) { + watermark <- asLabel(watermark, font = tlfEnv$currentTheme$fonts$watermark) + } + watermark$font$color <- color %||% watermark$font$color + watermark$font$size <- size %||% watermark$font$size + watermark$font$angle <- angle %||% watermark$font$angle - watermark <- createWatermarkGrob(label = label, angle = angle, alpha = alpha) + watermark <- createWatermarkGrob(label = watermark, alpha = alpha) plotObject <- plotObject + ggplot2::annotation_custom(grob = watermark, xmin = -Inf, ymin = -Inf, xmax = Inf, ymax = Inf) @@ -142,22 +287,34 @@ addWatermark <- function(plotObject, #' @title setWatermark #' @param plotObject ggplot object to which the watermark is set -#' @param watermark character or Label class object -#' @param angle Angle in degree from horizontal of the watermark label. Default angle is 30 degrees. +#' @param watermark Character or `Label` object corresponding to the watermark text +#' (and its font properties if `Label`) +#' @param color Color of the watermark label. +#' @param size Size of the watermark label. +#' @param angle Angle of the watermark label (in degree). #' @param alpha Transparency of the watermark label. #' Alpha is a numeric between 0 and 1: 0 label is totally transparent, 1 label is totally opaque. -#' Default alpha is 0.6. #' @return ggplot object to which the watermark is added. -#' @import ggplot2 +#' @import ggplot2 #' @export setWatermark <- function(plotObject, watermark = NULL, - angle = 30, - alpha = 0.4) { + color = NULL, + size = NULL, + angle = NULL, + alpha = NULL) { validateIsOfType(plotObject, "ggplot") - # Angle and alpha can be added as a part of plot configuration later on: - # For this create Watermark R6 class inheriting from Label and which gets fields angle and alpha - validateIsOfType(watermark, c("Label", "character"), nullAllowed = TRUE) + validateIsOfType(watermark, c("character", "Label"), nullAllowed = TRUE) + validateIsString(color, nullAllowed = TRUE) + validateIsNumeric(size, nullAllowed = TRUE) + validateIsNumeric(alpha, nullAllowed = TRUE) + validateIsNumeric(angle, nullAllowed = TRUE) + + alpha <- alpha %||% getAestheticValues( + n = 1, + selectionKey = AestheticSelectionKeys$first, + aesthetic = "alpha" + ) # Clone plotConfiguration into a new plot object # Prevents update of R6 class being spread to plotObject @@ -167,19 +324,18 @@ setWatermark <- function(plotObject, # R6 class not cloned will spread modifications into newPlotObject$plotConfiguration$background$watermark watermarkConfiguration <- newPlotObject$plotConfiguration$background$watermark - if (!is.null(watermark)) { - if (isOfType(watermark, "character")) { - watermark <- asLabel(watermark, watermarkConfiguration$font) - } + if (isOfType(watermark, "character")) { + watermark <- asLabel(text = watermark, font = watermarkConfiguration$font) } - watermarkConfiguration <- watermark %||% watermarkConfiguration + watermarkConfiguration$font$color <- color %||% watermarkConfiguration$font$color + watermarkConfiguration$font$size <- size %||% watermarkConfiguration$font$size + watermarkConfiguration$font$angle <- angle %||% watermarkConfiguration$font$angle # If plot is initialized, addWatermark otherwise update watermark - if (length(plotObject$layers) == 0) { + if (isOfLength(plotObject$layers, 0)) { newPlotObject <- addWatermark(newPlotObject, - label = watermarkConfiguration, - angle = angle, + watermark = watermarkConfiguration, alpha = alpha ) return(newPlotObject) @@ -187,38 +343,41 @@ setWatermark <- function(plotObject, # Using initializePlot, watermark will always be as first layer dummyPlot <- addWatermark(ggplot2::ggplot(), - label = watermarkConfiguration, - angle = angle, + watermark = watermarkConfiguration, alpha = alpha ) - newPlotObject$layers[[1]] <- dummyPlot$layer[[1]] - return(newPlotObject) } #' @title createWatermarkGrob -#' @param label Character or Label class object corresponding to the watermark text +#' @param label Character or Label object corresponding to the watermark text #' (and its font properties if Label) -#' @param angle Angle in degree from horizontal of the watermark label. Default angle is 30 degrees. #' @param alpha Transparency of the watermark label. #' Alpha is a numeric between 0 and 1: 0 label is totally transparent, 1 label is totally opaque. -#' Default alpha is 0.6. +#' Default alpha is defined from theme aesthetic alpha map #' @return Watermark background as a ggplot grob object #' @description #' createWatermarkGrob creates a ggplot grob based on the label text and its font properties. #' @export -createWatermarkGrob <- function(label, angle = 30, alpha = 0.6) { +createWatermarkGrob <- function(label, alpha = NULL) { + validateIsNumeric(alpha, nullAllowed = TRUE) # Ensure label is a Label class label <- asLabel(label) + alpha <- alpha %||% getAestheticValues( + n = 1, + selectionKey = AestheticSelectionKeys$first, + aesthetic = "alpha" + ) + watermark <- ggplot2::ggplot() + ggplot2::theme_void() + ggplot2::annotate( geom = "text", x = 0, y = 0, - label = label$text, + label = label$text %||% "", color = label$font$color, fontface = label$font$fontFace, size = label$font$size, - angle = angle, alpha = alpha + angle = label$font$angle, alpha = alpha ) watermark <- ggplot2::ggplotGrob(watermark) diff --git a/R/utilities-label.R b/R/utilities-label.R index cec59efa..9da219eb 100644 --- a/R/utilities-label.R +++ b/R/utilities-label.R @@ -1,11 +1,11 @@ #' @title setPlotLabels #' @description Set labels properties on a ggplot object #' @param plotObject ggplot object to set -#' @param title character or Label class object -#' @param subtitle character or Label class object -#' @param xlabel character or Label class object -#' @param ylabel character or Label class object -#' @return ggplot object with updated labels +#' @param title character or `Label` object +#' @param subtitle character or `Label` object +#' @param xlabel character or `Label` object +#' @param ylabel character or `Label` object +#' @return ggplot object #' @export setPlotLabels <- function(plotObject, title = NULL, @@ -13,7 +13,6 @@ setPlotLabels <- function(plotObject, xlabel = NULL, ylabel = NULL) { validateIsOfType(plotObject, "ggplot") - # Inputs will undergo the same code, so parse/eval # parse/eval of inputs prevent copy paste of code inputs <- c("title", "subtitle", "xlabel", "ylabel") @@ -29,17 +28,15 @@ setPlotLabels <- function(plotObject, labels <- newPlotObject$plotConfiguration$labels char2LabExpressions <- parse(text = paste0( - "if(!is.null(", inputs, ")){", "if(isOfType(", inputs, ', "character")){', - inputs, " <- asLabel(", inputs, ", labels$", inputs, "$font)}}" + inputs, " <- asLabel(", inputs, ", font = labels$", inputs, "$font)}" )) eval(char2LabExpressions) updateLabelExpressions <- parse(text = paste0("labels$", inputs, " <- ", inputs, " %||% labels$", inputs)) eval(updateLabelExpressions) - newPlotObject <- labels$setPlotLabels(newPlotObject) - + newPlotObject <- labels$updatePlot(newPlotObject) return(newPlotObject) } @@ -69,44 +66,3 @@ asLabel <- function(text = "", font = NULL) { return(text) } - -#' @title setFontProperties -#' @param plotObject ggplot object -#' @param titleFont Font Class for title -#' @param subtitleFont Font Class for subtitle -#' @param xAxisFont Font Class for xaxis and ticks -#' @param yAxisFont Font Class for yaxis and ticks -#' @param legendFont Font Class for legend -#' @return plotObject ggplot object with updated fonts -#' @description -#' setFontProperties set Font Properties on a ggplot object -#' @include font.R -#' @export -#' @examples -#' p <- ggplot2::ggplot() + ggplot2::labs(title = "Title") -#' newFont <- Font$new(color = "blue", size = 20) -#' p <- setFontProperties(plotObject = p, titleFont = newFont) -setFontProperties <- function(plotObject, - titleFont = NULL, - subtitleFont = NULL, - xAxisFont = NULL, - yAxisFont = NULL, - legendFont = NULL) { - if (!is.null(titleFont)) { - plotObject <- plotObject + theme(plot.title = titleFont$setFont()) - } - if (!is.null(subtitleFont)) { - plotObject <- plotObject + theme(plot.subtitle = subtitleFont$setFont()) - } - if (!is.null(xAxisFont)) { - plotObject <- plotObject + theme(axis.title.x = xAxisFont$setFont(), axis.text.x = xAxisFont$setFont()) - } - if (!is.null(yAxisFont)) { - plotObject <- plotObject + theme(axis.title.y = yAxisFont$setFont(), axis.text.y = yAxisFont$setFont()) - } - if (!is.null(legendFont)) { - plotObject <- plotObject + theme(legend.text = legendFont$setFont()) - } - - return(plotObject) -} diff --git a/R/utilities-legend.R b/R/utilities-legend.R index 87606b00..a8f9bc31 100644 --- a/R/utilities-legend.R +++ b/R/utilities-legend.R @@ -2,26 +2,138 @@ #' @param plotObject Graphical object created from ggplot #' @param position legend position. #' Use enum `LegendPositions` to access the list of legend positions. -#' @param title title of legend +#' @param title character or `Label` object +#' @param font `Font` object defining legend font #' @param caption data.frame containing the caption properties of the legend -#' @return A \code{ggplot} graphical object +#' @return A \code{ggplot} object #' @description -#' Set legend position, title and/or caption +#' Set legend position, title, font and/or caption #' @export setLegend <- function(plotObject, - position, + position = NULL, title = NULL, + font = NULL, caption = NULL) { - validateIsIncluded(position, LegendPositions) validateIsOfType(plotObject, "ggplot") + validateIsIncluded(position, LegendPositions, nullAllowed = TRUE) + validateIsOfType(title, c("character", "Label"), nullAllowed = TRUE) + validateIsOfType(font, c("Font"), nullAllowed = TRUE) + validateIsOfType(caption, "data.frame", nullAllowed = TRUE) + + plotObject <- setLegendPosition(plotObject, position = position) + plotObject <- setLegendTitle(plotObject, title = title) + plotObject <- setLegendFont(plotObject, color = font$color, size = font$size, angle = font$angle, fontFace = font$fontFace) + plotObject <- setLegendCaption(plotObject, caption = caption) + return(plotObject) +} + +#' @title setLegendFont +#' @param plotObject ggplot object +#' @param color color of legend font +#' @param size size of legend font +#' @param fontFace color of legend font +#' @param color color of legend font +#' @return A ggplot object +#' @description Set legend font properties +#' @export +setLegendFont <- function(plotObject, + color = NULL, + size = NULL, + fontFace = NULL, + angle = NULL) { + validateIsOfType(plotObject, "ggplot") + validateIsNumeric(size, nullAllowed = TRUE) + validateIsNumeric(angle, nullAllowed = TRUE) + validateIsString(color, nullAllowed = TRUE) + validateIsString(fontFace, nullAllowed = TRUE) - plotObject <- setLegendPosition(plotObject, position) - plotObject <- setLegendTitle(plotObject, title) + # Clone plotConfiguration into a new plot object + # Prevents update of R6 class being spread to plotObject + newPlotObject <- plotObject + newPlotObject$plotConfiguration <- plotObject$plotConfiguration$clone(deep = TRUE) + + # R6 class not cloned will spread modifications into newPlotObject$plotConfiguration + legend <- newPlotObject$plotConfiguration$legend + legend$font$color <- color %||% legend$font$color + legend$font$size <- size %||% legend$font$size + legend$font$angle <- angle %||% legend$font$angle + legend$font$fontFace <- fontFace %||% legend$font$fontFace + + newPlotObject <- legend$updatePlot(newPlotObject) + return(newPlotObject) +} - if (!is.null(caption)) { - plotObject <- setLegendCaption(plotObject, caption) +#' @title setLegendTitle +#' @param plotObject ggplot object +#' @param title character or `Label` object +#' @param color color of legend font +#' @param size size of legend font +#' @param fontFace color of legend font +#' @param color color of legend font +#' @return A ggplot object +#' @description Set legend title +#' @export +setLegendTitle <- function(plotObject, + title = NULL, + color = NULL, + size = NULL, + fontFace = NULL, + angle = NULL) { + validateIsOfType(plotObject, "ggplot") + validateIsOfType(title, c("character", "Label"), nullAllowed = TRUE) + validateIsNumeric(size, nullAllowed = TRUE) + validateIsNumeric(angle, nullAllowed = TRUE) + validateIsString(color, nullAllowed = TRUE) + validateIsString(fontFace, nullAllowed = TRUE) + + # Clone plotConfiguration into a new plot object + # Prevents update of R6 class being spread to plotObject + newPlotObject <- plotObject + newPlotObject$plotConfiguration <- plotObject$plotConfiguration$clone(deep = TRUE) + + # If title is`Label`, reconcile its properties with other inputs + if (isOfType(title, "Label")) { + color <- color %||% title$font$color + size <- size %||% title$font$size + angle <- angle %||% title$font$angle + fontFace <- fontFace %||% title$font$fontFace + title <- title$text } - return(plotObject) + + # R6 class not cloned will spread modifications into newPlotObject$plotConfiguration + legend <- newPlotObject$plotConfiguration$legend + legend$titleFont$color <- color %||% legend$titleFont$color + legend$titleFont$size <- size %||% legend$titleFont$size + legend$titleFont$angle <- angle %||% legend$titleFont$angle + legend$titleFont$fontFace <- fontFace %||% legend$titleFont$fontFace + legend$title <- title %||% legend$title + + newPlotObject <- legend$updatePlot(newPlotObject) + return(newPlotObject) +} + +#' @title setLegendPosition +#' @param plotObject \code{ggplot} graphical object +#' @param position legend position. +#' Use enum `LegendPositions` to access the list of legend positions. +#' @return A \code{ggplot} graphical object +#' @description +#' Set the legend position +#' @export +#' @import ggplot2 +setLegendPosition <- function(plotObject, + position = NULL) { + validateIsOfType(plotObject, "ggplot") + validateIsIncluded(position, LegendPositions, nullAllowed = TRUE) + + newPlotObject <- plotObject + newPlotObject$plotConfiguration <- plotObject$plotConfiguration$clone(deep = TRUE) + + legend <- newPlotObject$plotConfiguration$legend + legend$position <- position %||% legend$position + + newPlotObject <- legend$updatePlot(newPlotObject) + return(newPlotObject) } #' @title setLegendCaption @@ -33,9 +145,15 @@ setLegend <- function(plotObject, #' @export #' @import ggplot2 #' @import utils -setLegendCaption <- function(plotObject, caption) { +setLegendCaption <- function(plotObject, caption = NULL) { validateIsOfType(plotObject, "ggplot") - validateIsOfType(caption, "data.frame") + validateIsOfType(caption, "data.frame", nullAllowed = TRUE) + + # Empty or null captions + if (isOfLength(caption, 0)) { + return(plotObject) + } + validateIsIncluded(names(caption), CaptionProperties) newPlotObject <- plotObject @@ -92,9 +210,7 @@ getLegendCaption <- function(plotObject) { newPlotObject <- plotObject newPlotObject$plotConfiguration <- plotObject$plotConfiguration$clone(deep = TRUE) - caption <- newPlotObject$plotConfiguration$legend$caption - - return(caption) + return(newPlotObject$plotConfiguration$legend$caption) } #' @title setCaptionLabel @@ -265,78 +381,6 @@ setCaptionFill <- function(plotObject, fill, name = NULL) { return(newPlotObject) } -#' @title setLegendTitle -#' @param plotObject \code{ggplot} graphical object -#' @param title title of legend -#' @return A \code{ggplot} graphical object -#' @description -#' Set the legend title -#' @export -#' @import ggplot2 -setLegendTitle <- function(plotObject, title) { - validateIsOfType(plotObject, "ggplot") - - newPlotObject <- plotObject - newPlotObject$plotConfiguration <- plotObject$plotConfiguration$clone(deep = TRUE) - - legend <- newPlotObject$plotConfiguration$legend - legend$title <- title - - # Re-order based on order variable - orderedName <- legend$caption$name[legend$caption$order] - orderedLabel <- legend$caption$label[legend$caption$order] - orderedVisibility <- legend$caption$visibility[legend$caption$order] - - # The next lines need to be looped on every element of LegendTypes - # Otherwise, there can be a title per LegendTypes - for (aestype in LegendTypes) { - # scale_discrete_manual sends warning every time it overwrite something - # besides the function need value input to be filled otherwise crash - # so this line need to be silent - suppressMessages( - newPlotObject <- newPlotObject + - ggplot2::scale_discrete_manual( - aesthetics = aestype, - name = legend$title, - breaks = orderedName[orderedVisibility], - labels = orderedLabel[orderedVisibility], - values = legend$caption[order(legend$caption$name), aestype] - ) - ) - } - return(newPlotObject) -} - -#' @title setLegendTitle -#' @param plotObject \code{ggplot} graphical object -#' @param position legend position. -#' Use enum `LegendPositions` to access the list of legend positions. -#' @return A \code{ggplot} graphical object -#' @description -#' Set the legend position -#' @export -#' @import ggplot2 -setLegendPosition <- function(plotObject, position) { - validateIsOfType(plotObject, "ggplot") - validateIsIncluded(position, LegendPositions) - - newPlotObject <- plotObject - newPlotObject$plotConfiguration <- plotObject$plotConfiguration$clone(deep = TRUE) - - legend <- newPlotObject$plotConfiguration$legend - legend$position <- position - - legendPosition <- getLegendPosition(legend$position) - - newPlotObject <- newPlotObject + theme( - legend.position = c(legendPosition$xPosition, legendPosition$yPosition), - legend.justification = c(legendPosition$xJustification, legendPosition$yJustification), - legend.direction = "vertical" - ) - - return(newPlotObject) -} - # LegendPositions needed to be defined before to tlfEnv$defaultLegendPosition # It was consequently moved from utilities-legend to tlf-env @@ -392,23 +436,54 @@ getLegendPosition <- function(position) { return(legendPosition) } -mergeLegend <- function(plotObject, newLabels, color, shape, size, linetype, fill) { +#' @title mergeLegend +#' @description merge legend caption with existing legend caption +#' @param plotObject ggplot object +#' @param newLabels labels of caption to merge +#' @param aestheticSelections `ThemeAestheticSelections` object +mergeLegend <- function(plotObject, newLabels, aestheticSelections) { validateIsOfType(plotObject, "ggplot") + validateIsOfType(aestheticSelections, "ThemeAestheticSelections") oldCaption <- plotObject$plotConfiguration$legend$caption - legendLength <- nrow(plotObject$plotConfiguration$legend$caption) %||% 0 + oldCaptionLength <- nrow(oldCaption) + newCaptionLength <- length(newLabels) + + # Associate new values of aesthetics based on theme aesthetic selections + newCaptionExpression <- parse(text = paste0( + names(AestheticProperties), " <- getAestheticValues(n = newCaptionLength, + selectionKey = aestheticSelections$", names(AestheticProperties), ", + position = oldCaptionLength, + aesthetic = '", names(AestheticProperties), "')" + )) + eval(newCaptionExpression) + + # Create the new caption newCaption <- data.frame( name = newLabels, label = newLabels, - visibility = rep(TRUE, length(newLabels)), - order = seq(legendLength + 1, legendLength + length(newLabels)), + visibility = rep(TRUE, newCaptionLength), + order = seq(oldCaptionLength + 1, oldCaptionLength + newCaptionLength), color = color, shape = shape, size = size, linetype = linetype, fill = fill, stringsAsFactors = FALSE ) - mergeCaption <- rbind.data.frame(oldCaption, newCaption) - plotObject <- setLegendCaption(plotObject, mergeCaption) - plotObject <- setLegendPosition(plotObject, plotObject$plotConfiguration$legend$position) + if (oldCaptionLength == 0) { + plotObject <- setLegend(plotObject, caption = newCaption) + return(plotObject) + } + # Resolve conflicts between old and new legend caption for merging + # Fill must remain as defined by old (prevent overwriting addRibbon) + for (oldCaptionName in oldCaption$name) { + oldSelectedCaptions <- oldCaption$name %in% oldCaptionName + newSelectedCaptions <- newCaption$name %in% oldCaptionName + newCaption$fill[newSelectedCaptions] <- oldCaption$fill[oldSelectedCaptions] + newCaption$order[newSelectedCaptions] <- oldCaption$order[oldSelectedCaptions] + } + # Remove duplicate old captions for merging + oldCaption <- oldCaption[!(oldCaption$name %in% newCaption$name), ] + mergeCaption <- rbind.data.frame(oldCaption, newCaption, stringsAsFactors = FALSE) + plotObject <- setLegend(plotObject, caption = mergeCaption) return(plotObject) } diff --git a/R/utilities-mapping.R b/R/utilities-mapping.R index 8b706378..ef98f1c2 100644 --- a/R/utilities-mapping.R +++ b/R/utilities-mapping.R @@ -244,10 +244,17 @@ DefaultDataMappingValues <- list( ddiRatio2 = c(2, 1 / 2), guestLine = 1 ), - obsVsPred = list("y=x" = 1), - tornado = 0 + obsVsPred = 1, + resVsPred = 0, + tornado = 0, + histogram = 0 ) +#' @title DDIComparisonTypes +#' @description Options for comparison: residuals vs pred or obs vs pred +#' @export +DDIComparisonTypes <- enum(c("resVsPred", "obsVsPred")) + getAggregatedData <- function(data, xParameterName, yParameterName, diff --git a/R/utils.R b/R/utils.R index 6cec018f..8043cc9e 100644 --- a/R/utils.R +++ b/R/utils.R @@ -64,3 +64,7 @@ ifIncluded <- function(x, y, outputIfIncluded, outputIfNotIncluded = NULL) { outputIfNotIncluded } } + +# Because collate put tlf-env and themes before utils, +# The curretnTheme is defined here: after the definition of %||% +tlfEnv$currentTheme <- Theme$new() diff --git a/appveyor.yml b/appveyor.yml index d1f49e6e..5cedd519 100644 --- a/appveyor.yml +++ b/appveyor.yml @@ -12,7 +12,7 @@ install: - git submodule update --init --recursive environment: - app_version: "1.1" + app_version: "1.2" USE_RTOOLS: true R_ARCH: x64 KEEP_VIGNETTES: true diff --git a/data/pkRatioDataExample.RData b/data/pkRatioDataExample.RData deleted file mode 100644 index be976a86..00000000 Binary files a/data/pkRatioDataExample.RData and /dev/null differ diff --git a/data/simulatedTimeProfiles.rda b/data/simulatedTimeProfiles.rda deleted file mode 100644 index 7aebb0b5..00000000 Binary files a/data/simulatedTimeProfiles.rda and /dev/null differ diff --git a/data/simulatedTimeProfilesMeta.rda b/data/simulatedTimeProfilesMeta.rda deleted file mode 100644 index 5423c46f..00000000 Binary files a/data/simulatedTimeProfilesMeta.rda and /dev/null differ diff --git a/data/simulatedTimeProfilesMetaData.rda b/data/simulatedTimeProfilesMetaData.rda deleted file mode 100644 index a7ee362c..00000000 Binary files a/data/simulatedTimeProfilesMetaData.rda and /dev/null differ diff --git a/data/timeProfileDataFrame.RData b/data/timeProfileDataFrame.RData deleted file mode 100644 index 1454339a..00000000 Binary files a/data/timeProfileDataFrame.RData and /dev/null differ diff --git a/data/tlf-output.RData b/data/tlf-output.RData deleted file mode 100644 index 0bbbdaa9..00000000 Binary files a/data/tlf-output.RData and /dev/null differ diff --git a/data/tlfEnvThemesProperties.RData b/data/tlfEnvThemesProperties.RData deleted file mode 100644 index 5cf467d5..00000000 Binary files a/data/tlfEnvThemesProperties.RData and /dev/null differ diff --git a/inst/boxplot/app.R b/inst/boxplot/app.R new file mode 100644 index 00000000..746523ff --- /dev/null +++ b/inst/boxplot/app.R @@ -0,0 +1,163 @@ +require(shiny) +require(tlf) + +useTheme(loadThemeFromJson(system.file("extdata", "template-theme.json", package = "tlf"))) + +# Define UI page ---- +ui <- fluidPage( + h1("Box Whisker Plot", align = "center"), + column( + 5, + tabsetPanel( + tabPanel( + "Data", + fluidRow( + selectInput("dataType", + label = h4("Data location"), + choices = list("environment" = "environment", "file" = "file") + ), + conditionalPanel( + condition = "input.dataType == 'environment'", + selectInput("dataFromEnv", label = h4("List of environment variables"), choices = sapply(ls(envir = sys.frame()), identity)) + ), + conditionalPanel( + condition = "input.dataType == 'file'", + fileInput("dataFromFile", label = h4("Choose a csv file"), accept = ".csv") + ), + uiOutput("yVariableNames"), + uiOutput("xVariableNames"), + uiOutput("fillVariableNames") + ) + ), + tabPanel( + "Analysis", + fluidRow( + selectInput("ymax", label = "Max whisker", choices = tlfStatFunctions, selected = tlfStatFunctions$`Percentile95%`), + selectInput("upper", label = "Box upper edge", choices = tlfStatFunctions, selected = tlfStatFunctions$`Percentile75%`), + selectInput("middle", label = "Middle edge", choices = tlfStatFunctions, selected = tlfStatFunctions$`Percentile50%`), + selectInput("lower", label = "Box lower edge", choices = tlfStatFunctions, selected = tlfStatFunctions$`Percentile25%`), + selectInput("ymin", label = "Min whisker", choices = tlfStatFunctions, selected = tlfStatFunctions$`Percentile5%`), + br(), + selectInput("outliers", label = "Flag outliers", choices = list(Yes = TRUE, No = FALSE)), + conditionalPanel( + condition = "input.outliers == 'TRUE'", + selectInput("maxOutliers", label = "Max value outlier flag", choices = tlfStatFunctions, selected = tlfStatFunctions$`Percentile75%+1.5IQR`), + selectInput("minOutliers", label = "Min value outlier flag", choices = tlfStatFunctions, selected = tlfStatFunctions$`Percentile25%-1.5IQR`) + ) + ) + ), + tabPanel( + "Axes", + fluidRow( + h4("y axis"), + numericInput("yAxisMin", label = "min", value = NULL), + numericInput("yAxisMax", label = "max", value = NULL), + selectInput("yAxisScale", label = "scale", choices = Scaling, selected = Scaling$log) + ) + ), + tabPanel( + "Labels", + fluidRow( + textInput("xLabel", label = "x label", value = NULL), + textInput("yLabel", label = "y label", value = NULL), + textInput("watermark", label = "watermark", value = NULL) + ) + ) + ) + ), + + # Plot Column + column( + 7, + br(), + plotOutput(outputId = "boxWhiskerPlot"), + br(), + actionButton("exportButton", "Save Plot"), + br(), + align = "center" + ) +) + +# Define server logic required to draw a histogram ---- +server <- function(input, output) { + + getBoxWhiskerData <- reactive({ + boxplotData <- data.frame(`Fill data first` = NULL) + if (input$dataType == "environment") { + if (input$dataFromEnv != "") { + boxplotData <- get(input$dataFromEnv, envir = sys.frame()) + } + } + if (input$dataType == "file") { + if (!isOfLength(input$dataFromFile, 0)) { + boxplotData <- read.csv(input$dataFromFile$datapath, stringsAsFactors = FALSE) + } + } + return(boxplotData) + }) + + getVariableNames <- reactive({ + boxplotData <- getBoxWhiskerData() + return(sapply(names(boxplotData), identity)) + }) + + output$yVariableNames <- renderUI({ + selectInput("yVariableNames2", "Variable in Y", getVariableNames()) + }) + + output$xVariableNames <- renderUI({ + selectInput("xVariableNames2", "Group variable in X", choices = c("none" = "none", getVariableNames())) + }) + + output$fillVariableNames <- renderUI({ + selectInput("fillVariableNames2", "Color group variable", choices = c("none" = "none", getVariableNames())) + }) + + getDataMapping <- reactive({ + xMapping <- input$xVariableNames2 + fillMapping <- input$fillVariableNames2 + if(isIncluded(xMapping, "none")){xMapping <- NULL} + if(isIncluded(fillMapping, "none")){fillMapping <- NULL} + + dataMapping <- BoxWhiskerDataMapping$new(x = xMapping, + y = input$yVariableNames2, + color = fillMapping, + fill = fillMapping, + ymax = input$ymax, + upper = input$upper, + middle = input$middle, + lower = input$lower, + maxOutlierLimit = input$maxOutliers, + minOutlierLimit = input$minOutliers) + return(dataMapping) + }) + + output$boxWhiskerPlot <- renderPlot({ + # Get the data + boxplotData <- getBoxWhiskerData() + if(!isOfType(boxplotData, "data.frame")){return()} + if(nrow(boxplotData)==0){return()} + # Meta Data + # DataMapping + dataMapping <- getDataMapping() + # PlotConfiguration + boxWhiskerPlot <- plotBoxWhisker( + data = boxplotData, + dataMapping = dataMapping, + outliers = as.logical(input$outliers) + ) + yLimits <- c(input$yAxisMin, input$yAxisMax) + if(any(is.na(yLimits))){yLimits <- NULL} + + boxWhiskerPlot <- setYAxis(boxWhiskerPlot, + limits = yLimits, + scale = input$yAxisScale + ) + if(input$xLabel != ""){boxWhiskerPlot <- setPlotLabels(boxWhiskerPlot, xlabel = input$xLabel)} + if(input$yLabel != ""){boxWhiskerPlot <- setPlotLabels(boxWhiskerPlot, ylabel = input$yLabel)} + boxWhiskerPlot <- setWatermark(boxWhiskerPlot, watermark = input$watermark) + boxWhiskerPlot + }) +} + +shinyApp(ui = ui, server = server) diff --git a/inst/ddi-ratio/app.R b/inst/ddi-ratio/app.R new file mode 100644 index 00000000..ffea1b46 --- /dev/null +++ b/inst/ddi-ratio/app.R @@ -0,0 +1,187 @@ +require(shiny) +require(tlf) + +# Use theme template but this could be modified in later versions +useTheme(loadThemeFromJson(system.file("extdata", "template-theme.json", package = "tlf"))) + +# Define UI page ---- +ui <- fluidPage( + h1("DDI Ratio Plot", align = "center"), + column( + 5, + tabsetPanel( + tabPanel( + "Data", + fluidRow( + selectInput("dataType", + label = h4("Data location"), + choices = list("environment" = "environment", "file" = "file") + ), + conditionalPanel( + condition = "input.dataType == 'environment'", + selectInput("dataFromEnv", label = h4("List of environment variables"), choices = sapply(ls(envir = sys.frame()), identity)) + ), + conditionalPanel( + condition = "input.dataType == 'file'", + fileInput("dataFromFile", label = h4("Choose a csv file"), accept = ".csv") + ), + uiOutput("xVariableNames"), + uiOutput("yVariableNames"), + uiOutput("shapeVariableNames"), + uiOutput("colorVariableNames"), + uiOutput("uncertaintyVariableNames") + ) + ), + tabPanel( + "Analysis", + fluidRow( + sliderInput("ratioLine", label = "Ratio Limit", min = 1, max = 10, step = 0.1, value = 2), + sliderInput("guestLine", label = "Guest et al. delta", min = 1, max = 2, step = 0.01, value = 1), + selectInput("comparisonType", label = "Comparison type", choices = DDIComparisonTypes, selected = DDIComparisonTypes$obsVsPred) + ) + ), + tabPanel( + "Axes", + fluidRow( + h4("x axis"), + numericInput("xAxisMin", label = "min", value = NULL), + numericInput("xAxisMax", label = "max", value = NULL), + selectInput("xAxisScale", label = "scale", choices = Scaling, selected = Scaling$log), + h4("y axis"), + numericInput("yAxisMin", label = "min", value = NULL), + numericInput("yAxisMax", label = "max", value = NULL), + selectInput("yAxisScale", label = "scale", choices = Scaling, selected = Scaling$log) + ) + ), + tabPanel( + "Labels", + fluidRow( + textInput("xLabel", label = "x label", value = NULL), + textInput("yLabel", label = "y label", value = NULL), + textInput("watermark", label = "watermark", value = NULL) + ) + ) + ) + ), + + # Plot Column + column( + 7, + br(), + plotOutput(outputId = "ddiRatioPlot"), + br(), + actionButton("exportButton", "Save Plot"), + br(), + tableOutput(outputId = "ddiRatioTable"), + align = "center" + ) +) + +# Define server logic required to draw a histogram ---- +server <- function(input, output) { + + getddiRatioData <- reactive({ + ddiRatioData <- data.frame(`Fill data first` = NULL) + if (input$dataType == "environment") { + if (input$dataFromEnv != "") { + ddiRatioData <- get(input$dataFromEnv, envir = sys.frame()) + } + } + if (input$dataType == "file") { + if (!isOfLength(input$dataFromFile, 0)) { + ddiRatioData <- read.csv(input$dataFromFile$datapath, stringsAsFactors = FALSE) + } + } + return(ddiRatioData) + }) + + getVariableNames <- reactive({ + ddiRatioData <- getddiRatioData() + return(sapply(names(ddiRatioData), identity)) + }) + + output$yVariableNames <- renderUI({ + selectInput("yVariableNames2", "Variable in Y", getVariableNames()) + }) + + output$xVariableNames <- renderUI({ + selectInput("xVariableNames2", "Variable in X", getVariableNames()) + }) + + output$shapeVariableNames <- renderUI({ + selectInput("shapeVariableNames2", "Shape group variable", c("none" = "none", getVariableNames())) + }) + + output$colorVariableNames <- renderUI({ + selectInput("colorVariableNames2", "Color group variable", c("none" = "none", getVariableNames())) + }) + + output$uncertaintyVariableNames <- renderUI({ + selectInput("uncertaintyVariableNames2", "Variable for error bars", c("none" = "none", getVariableNames())) + }) + + getDataMapping <- reactive({ + colorMapping <- input$colorVariableNames2 + shapeMapping <- input$shapeVariableNames2 + uncertaintyMapping <- input$uncertaintyVariableNames2 + if(isIncluded(colorMapping, "none")){colorMapping <- NULL} + if(isIncluded(shapeMapping, "none")){shapeMapping <- NULL} + if(isIncluded(uncertaintyMapping,"none")){uncertaintyMapping <- NULL} + dataMapping <- DDIRatioDataMapping$new(x = input$xVariableNames2, + y = input$yVariableNames2, + color = colorMapping, + shape = shapeMapping, + uncertainty = uncertaintyMapping) + dataMapping$lines$ddiRatio2 <- c(input$ratioLine, 1/input$ratioLine) + dataMapping$lines$guestRatio <- input$guestLine + dataMapping$comparisonType <- input$comparisonType + return(dataMapping) + }) + + output$ddiRatioPlot <- renderPlot({ + # Get the data + ddiRatioData <- getddiRatioData() + if(!isOfType(ddiRatioData, "data.frame")){return()} + if(nrow(ddiRatioData)==0){return()} + # Meta Data + # DataMapping + dataMapping <- getDataMapping() + # PlotConfiguration + ddiRatioPlot <- plotDDIRatio( + data = ddiRatioData, + dataMapping = dataMapping + ) + xLimits <- c(input$xAxisMin, input$xAxisMax) + yLimits <- c(input$yAxisMin, input$yAxisMax) + if(any(is.na(xLimits))){xLimits <- NULL} + if(any(is.na(yLimits))){yLimits <- NULL} + + ddiRatioPlot <- setXAxis(ddiRatioPlot, + limits = xLimits, + scale = input$xAxisScale + ) + ddiRatioPlot <- setYAxis(ddiRatioPlot, + limits = yLimits, + scale = input$yAxisScale + ) + if(input$xLabel != ""){ddiRatioPlot <- setPlotLabels(ddiRatioPlot, xlabel = input$xLabel)} + if(input$yLabel != ""){ddiRatioPlot <- setPlotLabels(ddiRatioPlot, ylabel = input$yLabel)} + ddiRatioPlot <- setWatermark(ddiRatioPlot, watermark = input$watermark) + ddiRatioPlot + }) + + output$ddiRatioTable = renderTable({ + ddiRatioData <- getddiRatioData() + if(!isOfType(ddiRatioData, "data.frame")){return(data.frame())} + if(nrow(ddiRatioData)==0){return(data.frame())} + dataMapping <- getDataMapping() + #ddiRatioTable <- getDDIRatioMeasure(data=ddiRatioData, + # dataMapping = dataMapping, + # ratioLimits = c(input$ratioLine1, input$ratioLine2)) + #ddiRatioTable <- cbind.data.frame(" "= row.names(ddiRatioTable), + # ddiRatioTable) + return(data.frame()) + }) +} + +shinyApp(ui = ui, server = server) diff --git a/inst/extdata/ospsuite-data.csv b/inst/extdata/ospsuite-data.csv new file mode 100644 index 00000000..d714b983 --- /dev/null +++ b/inst/extdata/ospsuite-data.csv @@ -0,0 +1,11 @@ +IndividualId,Gender,Race,Population Name,Organism|Age,Organism|Weight,Organism|BMI,Organism|Gestational age,Organism|Height,Organism|Hematocrit,Organism|VenousBlood|Volume,Organism|ArterialBlood|Volume,Organism|Bone|Specific blood flow rate,Organism|Bone|Volume,Organism|Brain|Volume,Compound,Dose +0,Male,Caucasian,pop_10,14.0688941,54.04230061,0.195913991,40,16.60864445,0.47,0.876713393,0.338426355,0.022446017,10.66401243,1.396369317,Aspirin,6 +1,Male,Caucasian,pop_10,23.4195473,61.2977258,0.215426284,40,16.86835903,0.47,0.813096398,0.31483232,0.028497795,9.444248287,1.453849113,Aspirin,3 +2,Male,Caucasian,pop_10,24.89980573,44.39078282,0.189779636,40,15.294018,0.47,0.805417161,0.365394195,0.028779037,9.399231211,1.524981272,Aspirin,6 +3,Male,Caucasian,pop_10,30.45042863,53.61099397,0.199399381,40,16.39702378,0.47,0.804892445,0.346861454,0.025951289,9.835422969,1.564810183,Sugar,3 +4,Male,Caucasian,pop_10,22.96949291,42.98249667,0.163437843,40,16.21696236,0.43,0.61278102,0.282665445,0.038788192,7.837624313,1.361570067,Sugar,6 +5,Female,Caucasian,pop_10,37.71187351,50.49204631,0.213857614,40,15.36558599,0.41,0.618652748,0.260777401,0.030497307,7.792168874,1.435596199,Aspirin,3 +6,Female,Caucasian,pop_10,50.12875437,54.03716448,0.20959491,40,16.05668585,0.41,0.670054595,0.273566437,0.033728373,8.49320878,1.359598208,Aspirin,6 +7,Female,Caucasian,pop_10,32.53951003,64.24662733,0.248101093,40,16.09202981,0.41,0.800346422,0.305947302,0.031138896,10.24093699,1.381420764,Sugar,3 +8,Female,Caucasian,pop_10,26.86401285,63.05924125,0.263004854,40,15.48433251,0.41,0.600189023,0.273958966,0.032767885,7.964833298,1.227012247,Sugar,6 +9,Female,Caucasian,pop_10,45.97137219,43.53328781,0.17762685,40,15.65512096,0.41,0.73507184,0.288503204,0.032356844,9.296652927,1.191015138,Sugar,3 diff --git a/inst/extdata/ospsuite-metadata.csv b/inst/extdata/ospsuite-metadata.csv new file mode 100644 index 00000000..b02f3176 --- /dev/null +++ b/inst/extdata/ospsuite-metadata.csv @@ -0,0 +1,18 @@ +Variable,Dimension,Unit +IndividualId,, +Gender,, +Race,, +Population Name,, +Organism|Age,Age,yrs +Organism|Weight,Mass,kg +Organism|BMI,,kg/m2 +Organism|Gestational age,Age,week(s) +Organism|Height,Length,dm +Organism|Hematocrit,Volume,l +Organism|VenousBlood|Volume,Volume,l +Organism|ArterialBlood|Volume,Volume,l +Organism|Bone|Specific blood flow rate,Flow,l/min +Organism|Bone|Volume,Volume,l +Organism|Brain|Volume,Volume,l +Compound,, +Dose,Mass,mg diff --git a/inst/extdata/template-theme.json b/inst/extdata/template-theme.json new file mode 100644 index 00000000..38fd69ff --- /dev/null +++ b/inst/extdata/template-theme.json @@ -0,0 +1,366 @@ +{ + "fonts": { + "title": { + "color": "black", + "size": 16, + "fontFace": "bold", + "fontFamily": "", + "angle": 0 + }, + "subtitle": { + "color": "black", + "size": 12, + "fontFace": "plain", + "fontFamily": "", + "angle": 0 + }, + "xlabel": { + "color": "black", + "size": 16, + "fontFace": "plain", + "fontFamily": "", + "angle": 0 + }, + "ylabel": { + "color": "black", + "size": 16, + "fontFace": "plain", + "fontFamily": "", + "angle": 90 + }, + "watermark": { + "color": "grey30", + "size": 12, + "fontFace": "plain", + "fontFamily": "", + "angle": 30 + }, + "legend": { + "color": "black", + "size": 14, + "fontFace": "plain", + "fontFamily": "", + "angle": 0 + }, + "xAxis": { + "color": "black", + "size": 14, + "fontFace": "plain", + "fontFamily": "", + "angle": 0 + }, + "yAxis": { + "color": "black", + "size": 14, + "fontFace": "plain", + "fontFamily": "", + "angle": 0 + } + }, + "background": { + "watermark": "template", + "legendPosition": "outsideRight", + "plot": { + "fill": "white", + "color": "black", + "size": 0.5, + "linetype": "blank" + }, + "panel": { + "fill": "white", + "color": "black", + "size": "0.5", + "linetype": "solid" + }, + "xAxis": { + "color": "black", + "size": "1", + "linetype": "solid" + }, + "yAxis": { + "color": "black", + "size": "1", + "linetype": "solid" + }, + "xGrid": { + "color": "grey", + "size": "0.5", + "linetype": "dashed" + }, + "yGrid": { + "color": "grey", + "size": "0.5", + "linetype": "dashed" + }, + "legend": { + "fill": "white", + "color": "white", + "size": "0.5", + "linetype": "blank" + } + }, + "aestheticMaps": { + "color": [ + "#0078D7", + "#D83B01", + "#107C10", + "#A80000", + "#002050", + "#B4009E" + ], + "fill": [ + "#0078D7", + "#D83B01", + "#107C10", + "#A80000", + "#002050", + "#B4009E" + ], + "shape": [ + "square", + "dot", + "circle", + "diamond", + "star", + "plus", + "cross", + "triangle" + ], + "linetype": [ + "solid", + "longdash", + "dotted", + "dashed", + "twodash", + "dotdash" + ], + "size": [ + 1, + 2, + 3, + 4, + 5 + ], + "alpha": [ + 0.75, + 0.5, + 0.25 + ] + }, + "plotConfigurations": { + "addScatter": { + "color": "next", + "fill": "NA", + "shape": "next", + "linetype": "blank", + "size": "first", + "alpha": 1 + }, + "addLine": { + "color": "next", + "fill": "NA", + "shape": "blank", + "linetype": "same", + "size": "first", + "alpha": 1 + }, + "addRibbon": { + "color": "next", + "fill": "next", + "shape": "blank", + "linetype": "same", + "size": "first", + "alpha": "first" + }, + "addErrorbar": { + "color": "next", + "fill": "NA", + "shape": "blank", + "linetype": "first", + "size": "first", + "alpha": 1 + }, + "plotPKRatio": { + "points": { + "color": "reset", + "fill": "NA", + "shape": "reset", + "linetype": "blank", + "size": 4, + "alpha": 1 + }, + "lines": { + "color": [ + "#000000", + "#0078D7", + "#D83B01" + ], + "fill": "NA", + "shape": "blank", + "linetype": "longdash", + "size": 1, + "alpha": 1 + }, + "errorbars": { + "color": "reset", + "fill": "NA", + "shape": "blank", + "linetype": "solid", + "size": 1, + "alpha": 1 + } + }, + "plotDDIRatio": { + "points": { + "color": "reset", + "fill": "NA", + "shape": "reset", + "linetype": "blank", + "size": 4, + "alpha": 1 + }, + "lines": { + "color": [ + "#000000", + "#0078D7", + "#D83B01" + ], + "fill": "NA", + "shape": "blank", + "linetype": "longdash", + "size": 1, + "alpha": 1 + }, + "errorbars": { + "color": "reset", + "fill": "NA", + "shape": "blank", + "linetype": "solid", + "size": 1, + "alpha": 1 + } + }, + "plotTimeProfile": { + "points": { + "color": "reset", + "fill": "NA", + "shape": "reset", + "linetype": "blank", + "size": 3, + "alpha": 1 + }, + "lines": { + "color": "reset", + "fill": "NA", + "shape": "blank", + "linetype": "reset", + "size": 1, + "alpha": 1 + }, + "ribbons": { + "color": "reset", + "fill": "reset", + "shape": "blank", + "linetype": "blank", + "size": 1, + "alpha": "first" + }, + "errorbars": { + "color": "reset", + "fill": "NA", + "shape": "blank", + "linetype": "solid", + "size": 1, + "alpha": 1 + } + }, + "plotObsVsPred": { + "points": { + "color": "reset", + "fill": "NA", + "shape": "reset", + "linetype": "blank", + "size": 4, + "alpha": 1 + }, + "lines": { + "color": "#111111", + "fill": "NA", + "shape": "blank", + "linetype": "longdash", + "size": 1, + "alpha": 1 + }, + "errorbars": { + "color": "reset", + "fill": "NA", + "shape": "blank", + "linetype": "solid", + "size": 1, + "alpha": 1 + } + }, + "plotBoxWhisker": { + "points": { + "color": "#111111", + "fill": "NA", + "shape": "dot", + "linetype": "blank", + "size": 2, + "alpha": 1 + }, + "ribbons": { + "color": "#000000", + "fill": "reset", + "shape": "blank", + "linetype": "solid", + "size": 1, + "alpha": "first" + } + }, + "plotTornado": { + "lines": { + "color": "#111111", + "fill": "NA", + "shape": "blank", + "linetype": "longdash", + "size": 1, + "alpha": 1 + }, + "points": { + "color": "reset", + "fill": "NA", + "shape": "reset", + "linetype": "blank", + "size": 3, + "alpha": 1 + }, + "ribbons": { + "color": "reset", + "fill": "reset", + "shape": "blank", + "linetype": "solid", + "size": 1, + "alpha": "first" + } + }, + "plotHistogram": { + "lines": { + "color": "reset", + "fill": "NA", + "shape": "blank", + "linetype": "solid", + "size": 1, + "alpha": 1 + }, + "ribbons": { + "color": "#000000", + "fill": "reset", + "shape": "blank", + "linetype": "solid", + "size": 1, + "alpha": "first" + } + } + } +} \ No newline at end of file diff --git a/inst/extdata/test-data.csv b/inst/extdata/test-data.csv new file mode 100644 index 00000000..fd2b98ae --- /dev/null +++ b/inst/extdata/test-data.csv @@ -0,0 +1,51 @@ +ID,Age,Obs,Pred,Ratio,AgeBin,Sex,Country,SD +1,48,4,2.9,0.725,Adults,Male,Canada,0.693 +2,36,4.4,5.75,1.307,Adults,Male,Canada,0.188 +3,52,2.8,2.7,0.964,Adults,Male,Canada,0.984 +4,47,3.75,3.05,0.813,Adults,Male,Canada,0.591 +5,0,1.95,5.25,2.692,Peds,Male,Canada,0.443 +6,48,2.45,5.3,2.163,Adults,Male,Canada,0.072 +7,34,2,4.4,2.2,Adults,Male,Canada,0.489 +8,55,1.05,1.75,1.667,Adults,Male,Canada,0.354 +9,12,3.7,4.3,1.162,Peds,Male,Canada,0.128 +10,54,1.65,4.2,2.545,Adults,Male,Canada,0.096 +11,27,3.95,1.75,0.443,Adults,Male,Canada,0.972 +12,3,1.8,3,1.667,Peds,Male,Canada,0.988 +13,8,2.8,5.95,2.125,Peds,Male,Canada,0.689 +14,12,1.3,3.5,2.692,Peds,Male,Canada,0.845 +15,2,1.45,2.05,1.414,Peds,Male,Canada,0.578 +16,5,4.35,5.95,1.368,Peds,Male,Canada,0.449 +17,22,5.6,2.95,0.527,Adults,Male,Canada,0.631 +18,58,5.3,5.85,1.104,Adults,Male,Canada,0.766 +19,39,5.15,5.45,1.058,Adults,Male,Canada,0.132 +20,21,4.6,3.3,0.717,Adults,Male,Germany,0.713 +21,41,1.05,5.6,5.333,Adults,Male,Germany,0.847 +22,57,2.4,1.65,0.688,Adults,Male,Germany,0.83 +23,1,5.3,2.1,0.396,Peds,Male,Germany,0.94 +24,1,4.05,5.15,1.272,Peds,Male,Germany,0.843 +25,35,3.65,3.25,0.89,Adults,Male,Germany,0.01 +26,39,3.45,3.9,1.13,Adults,Female,Germany,0.414 +27,1,3.9,5.4,1.385,Peds,Female,Germany,0.746 +28,49,3.6,6,1.667,Adults,Female,Germany,0.776 +29,37,6,3.25,0.542,Adults,Female,Germany,0.606 +30,51,1.15,1.8,1.565,Adults,Female,Germany,0.571 +31,38,4,1.4,0.35,Adults,Female,Germany,0.657 +32,54,3.45,4.25,1.232,Adults,Female,Germany,0.923 +33,10,2.2,1.25,0.568,Peds,Female,Germany,0.336 +34,44,4.05,2.35,0.58,Adults,Female,Germany,0.746 +35,11,5,1.3,0.26,Peds,Female,Germany,0.473 +36,28,2.2,3,1.364,Adults,Female,Germany,0.222 +37,28,3.35,3.4,1.015,Adults,Female,Germany,0.867 +38,8,4.15,4.2,1.012,Peds,Female,Germany,0.714 +39,53,3.9,1.25,0.321,Adults,Female,Germany,0.995 +40,13,5.5,5.8,1.055,Peds,Female,Germany,0.803 +41,29,3.8,1.5,0.395,Adults,Female,France,0.058 +42,21,2.65,3.8,1.434,Adults,Female,France,0.884 +43,12,3.4,2.5,0.735,Peds,Female,France,0.304 +44,54,2.4,2.85,1.188,Adults,Female,France,0.423 +45,17,5.75,1.7,0.296,Peds,Female,France,0.058 +46,20,3.75,4,1.067,Adults,Female,France,0.156 +47,23,1.1,3.4,3.091,Adults,Female,France,0.065 +48,48,1.55,3.3,2.129,Adults,Female,France,0.15 +49,29,5.3,1.35,0.255,Adults,Female,France,0.841 +50,53,3.95,1.6,0.405,Adults,Female,France,0.717 diff --git a/inst/histogram/app.R b/inst/histogram/app.R new file mode 100644 index 00000000..1251ac61 --- /dev/null +++ b/inst/histogram/app.R @@ -0,0 +1,158 @@ +require(shiny) +require(tlf) + +useTheme(loadThemeFromJson(system.file("extdata", "template-theme.json", package = "tlf"))) + +# Define UI page ---- +ui <- fluidPage( + h1("Histogram", align = "center"), + column( + 5, + tabsetPanel( + tabPanel( + "Data", + fluidRow( + selectInput("dataType", + label = h4("Data location"), + choices = list("environment" = "environment", "file" = "file") + ), + conditionalPanel( + condition = "input.dataType == 'environment'", + selectInput("dataFromEnv", label = h4("List of environment variables"), choices = sapply(ls(envir = sys.frame()), identity)) + ), + conditionalPanel( + condition = "input.dataType == 'file'", + fileInput("dataFromFile", label = h4("Choose a csv file"), accept = ".csv") + ), + uiOutput("xVariableNames"), + uiOutput("fillVariableNames") + ) + ), + tabPanel( + "Analysis", + fluidRow( + uiOutput("bins"), + selectInput("stack", label = "Stack bars", choices = list(Yes = "Yes", No = "No")), + selectInput("fitNormalDist", label = "Fit normal distribution", choices = list(Yes = "Yes", No = "No")) + ) + ), + tabPanel( + "Axes", + fluidRow( + h4("x axis"), + numericInput("xAxisMin", label = "min", value = NULL), + numericInput("xAxisMax", label = "max", value = NULL), + selectInput("XAxisScale", label = "scale", choices = Scaling, selected = Scaling$lin), + h4("y axis"), + numericInput("yAxisMin", label = "min", value = NULL), + numericInput("yAxisMax", label = "max", value = NULL), + selectInput("yAxisScale", label = "scale", choices = Scaling, selected = Scaling$lin) + ) + ), + tabPanel( + "Labels", + fluidRow( + textInput("xLabel", label = "x label", value = NULL), + textInput("yLabel", label = "y label", value = NULL), + textInput("watermark", label = "watermark", value = NULL) + ) + ) + ) + ), + + # Plot Column + column( + 7, + br(), + plotOutput(outputId = "histogramPlot"), + br(), + actionButton("exportButton", "Save Plot"), + br(), + align = "center" + ) +) + +# Define server logic required to draw a histogram ---- +server <- function(input, output) { + + getHistogramData <- reactive({ + histogramData <- data.frame(`Fill data first` = NULL) + if (input$dataType == "environment") { + if (input$dataFromEnv != "") { + histogramData <- get(input$dataFromEnv, envir = sys.frame()) + } + } + if (input$dataType == "file") { + if (!isOfLength(input$dataFromFile, 0)) { + histogramData <- read.csv(input$dataFromFile$datapath, stringsAsFactors = FALSE) + } + } + return(histogramData) + }) + + getVariableNames <- reactive({ + histogramData <- getHistogramData() + return(sapply(names(histogramData), identity)) + }) + + output$xVariableNames <- renderUI({ + selectInput("xVariableNames2", "Group variable in X", choices = getVariableNames()) + }) + + output$fillVariableNames <- renderUI({ + selectInput("fillVariableNames2", "Color group variable", choices = c("none" = "none", getVariableNames())) + }) + + output$bins <- renderUI({ + histogramData <- getHistogramData() + sliderInput("bins2", "Number of bins", min = 1, max = max(10, nrow(histogramData)), step = 1, value = 10) + }) + + getDataMapping <- reactive({ + xMapping <- input$xVariableNames2 + fillMapping <- input$fillVariableNames2 + if(isIncluded(xMapping, "none")){xMapping <- NULL} + if(isIncluded(fillMapping, "none")){fillMapping <- NULL} + + dataMapping <- HistogramDataMapping$new(stack = as.logical(input$stack %in% "Yes"), + x = input$xVariableNames2, + fill = fillMapping, + bins = input$bins2, + fitNormalDist = as.logical(input$fitNormalDist %in% "Yes")) + return(dataMapping) + }) + + output$histogramPlot <- renderPlot({ + # Get the data + histogramData <- getHistogramData() + if(!isOfType(histogramData, "data.frame")){return()} + if(nrow(histogramData)==0){return()} + # Meta Data + # DataMapping + dataMapping <- getDataMapping() + # PlotConfiguration + histogramPlot <- plotHistogram( + data = histogramData, + dataMapping = dataMapping + ) + xLimits <- c(input$xAxisMin, input$xAxisMax) + yLimits <- c(input$yAxisMin, input$yAxisMax) + if(any(is.na(xLimits))){xLimits <- NULL} + if(any(is.na(yLimits))){yLimits <- NULL} + + histogramPlot <- setXAxis(histogramPlot, + limits = xLimits, + scale = input$xAxisScale + ) + histogramPlot <- setYAxis(histogramPlot, + limits = yLimits, + scale = input$yAxisScale + ) + if(input$xLabel != ""){histogramPlot <- setPlotLabels(histogramPlot, xlabel = input$xLabel)} + if(input$yLabel != ""){histogramPlot <- setPlotLabels(histogramPlot, ylabel = input$yLabel)} + histogramPlot <- setWatermark(histogramPlot, watermark = input$watermark) + histogramPlot + }) +} + +shinyApp(ui = ui, server = server) diff --git a/inst/obs-vs-pred/app.R b/inst/obs-vs-pred/app.R new file mode 100644 index 00000000..0871981c --- /dev/null +++ b/inst/obs-vs-pred/app.R @@ -0,0 +1,183 @@ +require(shiny) +require(tlf) + +# Use theme template but this could be modified in later versions +useTheme(loadThemeFromJson(system.file("extdata", "template-theme.json", package = "tlf"))) + +# Define UI page ---- +ui <- fluidPage( + h1("Obs vs Pred Plot", align = "center"), + column( + 5, + tabsetPanel( + tabPanel( + "Data", + fluidRow( + selectInput("dataType", + label = h4("Data location"), + choices = list("environment" = "environment", "file" = "file") + ), + conditionalPanel( + condition = "input.dataType == 'environment'", + selectInput("dataFromEnv", label = h4("List of environment variables"), choices = sapply(ls(envir = sys.frame()), identity)) + ), + conditionalPanel( + condition = "input.dataType == 'file'", + fileInput("dataFromFile", label = h4("Choose a csv file"), accept = ".csv") + ), + uiOutput("xVariableNames"), + uiOutput("yVariableNames"), + uiOutput("groupingVariableNames"), + uiOutput("uncertaintyVariableNames"), + uiOutput("lloqVariableNames") + ) + ), + tabPanel( + "Analysis", + fluidRow( + selectInput("regression", label = "Regression", choices = list(none = "none", linear = "lm", loess = "loess")) + ) + ), + tabPanel( + "Axes", + fluidRow( + h4("x axis"), + numericInput("xAxisMin", label = "min", value = NULL), + numericInput("xAxisMax", label = "max", value = NULL), + selectInput("xAxisScale", label = "scale", choices = Scaling, selected = Scaling$lin), + h4("y axis"), + numericInput("yAxisMin", label = "min", value = NULL), + numericInput("yAxisMax", label = "max", value = NULL), + selectInput("yAxisScale", label = "scale", choices = Scaling, selected = Scaling$lin) + ) + ), + tabPanel( + "Labels", + fluidRow( + textInput("xLabel", label = "x label", value = NULL), + textInput("yLabel", label = "y label", value = NULL), + textInput("watermark", label = "watermark", value = NULL) + ) + ) + ) + ), + + # Plot Column + column( + 7, + br(), + plotOutput(outputId = "obsVsPredPlot"), + br(), + actionButton("exportButton", "Save Plot"), + br(), + tableOutput(outputId = "obsVsPredTable"), + align = "center" + ) +) + +# Define server logic required to draw a histogram ---- +server <- function(input, output) { + + getObsVsPredData <- reactive({ + obsVsPredData <- data.frame(`Fill data first` = NULL) + if (input$dataType == "environment") { + if (input$dataFromEnv != "") { + obsVsPredData <- get(input$dataFromEnv, envir = sys.frame()) + } + } + if (input$dataType == "file") { + if (!isOfLength(input$dataFromFile, 0)) { + obsVsPredData <- read.csv(input$dataFromFile$datapath, stringsAsFactors = FALSE) + } + } + return(obsVsPredData) + }) + + getVariableNames <- reactive({ + obsVsPredData <- getObsVsPredData() + return(sapply(names(obsVsPredData), identity)) + }) + + output$yVariableNames <- renderUI({ + selectInput("yVariableNames2", "Variable in Y", getVariableNames()) + }) + + output$xVariableNames <- renderUI({ + selectInput("xVariableNames2", "Variable in X", getVariableNames()) + }) + + output$groupingVariableNames <- renderUI({ + selectInput("groupingVariableNames2", "Group variable", c("none" = "none", getVariableNames())) + }) + + output$uncertaintyVariableNames <- renderUI({ + selectInput("uncertaintyVariableNames2", "Variable for error bars", c("none" = "none", getVariableNames())) + }) + output$lloqVariableNames <- renderUI({ + selectInput("lloqVariableNames2", "Variable for LLOQ", c("none" = "none", getVariableNames())) + }) + + getDataMapping <- reactive({ + colorMapping <- input$groupingVariableNames2 + uncertaintyMapping <- input$uncertaintyVariableNames2 + lloqMapping <- input$lloqVariableNames2 + if(isIncluded(colorMapping, "none")){colorMapping <- NULL} + if(isIncluded(uncertaintyMapping,"none")){uncertaintyMapping <- NULL} + if(isIncluded(lloqMapping,"none")){lloqMapping <- NULL} + dataMapping <- ObsVsPredDataMapping$new(x = input$xVariableNames2, + y = input$yVariableNames2, + color = colorMapping, + uncertainty = uncertaintyMapping, + lloq = lloqMapping) + smoother <- input$regression + if(smoother=="none"){smoother <- NULL} + dataMapping$smoother <- smoother + return(dataMapping) + }) + + output$obsVsPredPlot <- renderPlot({ + # Get the data + obsVsPredData <- getObsVsPredData() + if(!isOfType(obsVsPredData, "data.frame")){return()} + if(nrow(obsVsPredData)==0){return()} + # Meta Data + # DataMapping + dataMapping <- getDataMapping() + # PlotConfiguration + obsVsPredPlot <- plotObsVsPred( + data = obsVsPredData, + dataMapping = dataMapping + ) + xLimits <- c(input$xAxisMin, input$xAxisMax) + yLimits <- c(input$yAxisMin, input$yAxisMax) + if(any(is.na(xLimits))){xLimits <- NULL} + if(any(is.na(yLimits))){yLimits <- NULL} + + obsVsPredPlot <- setXAxis(obsVsPredPlot, + limits = xLimits, + scale = input$xAxisScale + ) + obsVsPredPlot <- setYAxis(obsVsPredPlot, + limits = yLimits, + scale = input$yAxisScale + ) + if(input$xLabel != ""){obsVsPredPlot <- setPlotLabels(obsVsPredPlot, xlabel = input$xLabel)} + if(input$yLabel != ""){obsVsPredPlot <- setPlotLabels(obsVsPredPlot, ylabel = input$yLabel)} + obsVsPredPlot <- setWatermark(obsVsPredPlot, watermark = input$watermark) + obsVsPredPlot + }) + + output$obsVsPredTable = renderTable({ + obsVsPredData <- getObsVsPredData() + if(!isOfType(obsVsPredData, "data.frame")){return(data.frame())} + if(nrow(obsVsPredData)==0){return(data.frame())} + dataMapping <- getDataMapping() + R2 <- 1 - var(obsVsPredData[,dataMapping$y]-obsVsPredData[,dataMapping$x])/var(obsVsPredData[,dataMapping$x]) + MFE <- 10^(mean(log10(obsVsPredData[,dataMapping$y])-log10(obsVsPredData[,dataMapping$x]))) + obsVsPredTable <- data.frame(Evaluation = c("R2", "MFE"), + Value = c(R2, MFE)) + return(obsVsPredTable) + }) +} + +shinyApp(ui = ui, server = server) diff --git a/inst/pk-ratio/app.R b/inst/pk-ratio/app.R new file mode 100644 index 00000000..9c09b333 --- /dev/null +++ b/inst/pk-ratio/app.R @@ -0,0 +1,185 @@ +require(shiny) +require(tlf) + +# Use theme template but this could be modified in later versions +useTheme(loadThemeFromJson(system.file("extdata", "template-theme.json", package = "tlf"))) + +# Define UI page ---- +ui <- fluidPage( + h1("PK Ratio Plot", align = "center"), + column( + 5, + tabsetPanel( + tabPanel( + "Data", + fluidRow( + selectInput("dataType", + label = h4("Data location"), + choices = list("environment" = "environment", "file" = "file") + ), + conditionalPanel( + condition = "input.dataType == 'environment'", + selectInput("dataFromEnv", label = h4("List of environment variables"), choices = sapply(ls(envir = sys.frame()), identity)) + ), + conditionalPanel( + condition = "input.dataType == 'file'", + fileInput("dataFromFile", label = h4("Choose a csv file"), accept = ".csv") + ), + uiOutput("xVariableNames"), + uiOutput("yVariableNames"), + uiOutput("shapeVariableNames"), + uiOutput("colorVariableNames"), + uiOutput("uncertaintyVariableNames") + ) + ), + tabPanel( + "Analysis", + fluidRow( + sliderInput("ratioLine1", label = "Ratio Limit #1", min = 1, max = 10, step = 0.1, value = 1.5), + sliderInput("ratioLine2", label = "Ratio Limit #2", min = 1, max = 10, step = 0.1, value = 2) + ) + ), + tabPanel( + "Axes", + fluidRow( + h4("x axis"), + numericInput("xAxisMin", label = "min", value = NULL), + numericInput("xAxisMax", label = "max", value = NULL), + selectInput("xAxisScale", label = "scale", choices = Scaling, selected = Scaling$lin), + h4("y axis"), + numericInput("yAxisMin", label = "min", value = NULL), + numericInput("yAxisMax", label = "max", value = NULL), + selectInput("yAxisScale", label = "scale", choices = Scaling, selected = Scaling$log) + ) + ), + tabPanel( + "Labels", + fluidRow( + textInput("xLabel", label = "x label", value = NULL), + textInput("yLabel", label = "y label", value = NULL), + textInput("watermark", label = "watermark", value = NULL) + ) + ) + ) + ), + + # Plot Column + column( + 7, + br(), + plotOutput(outputId = "pkRatioPlot"), + br(), + actionButton("exportButton", "Save Plot"), + br(), + tableOutput(outputId = "pkRatioTable"), + align = "center" + ) +) + +# Define server logic required to draw a histogram ---- +server <- function(input, output) { + + getPKRatioData <- reactive({ + pkRatioData <- data.frame(`Fill data first` = NULL) + if (input$dataType == "environment") { + if (input$dataFromEnv != "") { + pkRatioData <- get(input$dataFromEnv, envir = sys.frame()) + } + } + if (input$dataType == "file") { + if (!isOfLength(input$dataFromFile, 0)) { + pkRatioData <- read.csv(input$dataFromFile$datapath, stringsAsFactors = FALSE) + } + } + return(pkRatioData) + }) + + getVariableNames <- reactive({ + pkRatioData <- getPKRatioData() + return(sapply(names(pkRatioData), identity)) + }) + + output$yVariableNames <- renderUI({ + selectInput("yVariableNames2", "Variable in Y", getVariableNames()) + }) + + output$xVariableNames <- renderUI({ + selectInput("xVariableNames2", "Variable in X", getVariableNames()) + }) + + output$shapeVariableNames <- renderUI({ + selectInput("shapeVariableNames2", "Shape group variable", c("none" = "none", getVariableNames())) + }) + + output$colorVariableNames <- renderUI({ + selectInput("colorVariableNames2", "Color group variable", c("none" = "none", getVariableNames())) + }) + + output$uncertaintyVariableNames <- renderUI({ + selectInput("uncertaintyVariableNames2", "Variable for error bars", c("none" = "none", getVariableNames())) + }) + + getDataMapping <- reactive({ + colorMapping <- input$colorVariableNames2 + shapeMapping <- input$shapeVariableNames2 + uncertaintyMapping <- input$uncertaintyVariableNames2 + if(isIncluded(colorMapping, "none")){colorMapping <- NULL} + if(isIncluded(shapeMapping, "none")){shapeMapping <- NULL} + if(isIncluded(uncertaintyMapping,"none")){uncertaintyMapping <- NULL} + dataMapping <- PKRatioDataMapping$new(x = input$xVariableNames2, + y = input$yVariableNames2, + color = colorMapping, + shape = shapeMapping, + uncertainty = uncertaintyMapping) + dataMapping$lines[[2]] <- c(input$ratioLine1, 1/input$ratioLine1) + dataMapping$lines[[3]] <- c(input$ratioLine2, 1/input$ratioLine2) + return(dataMapping) + }) + + output$pkRatioPlot <- renderPlot({ + # Get the data + pkRatioData <- getPKRatioData() + if(!isOfType(pkRatioData, "data.frame")){return()} + if(nrow(pkRatioData)==0){return()} + # Meta Data + # DataMapping + dataMapping <- getDataMapping() + # PlotConfiguration + pkRatioPlot <- plotPKRatio( + data = pkRatioData, + dataMapping = dataMapping + ) + xLimits <- c(input$xAxisMin, input$xAxisMax) + yLimits <- c(input$yAxisMin, input$yAxisMax) + if(any(is.na(xLimits))){xLimits <- NULL} + if(any(is.na(yLimits))){yLimits <- NULL} + + pkRatioPlot <- setXAxis(pkRatioPlot, + limits = xLimits, + scale = input$xAxisScale + ) + pkRatioPlot <- setYAxis(pkRatioPlot, + limits = yLimits, + scale = input$yAxisScale + ) + if(input$xLabel != ""){pkRatioPlot <- setPlotLabels(pkRatioPlot, xlabel = input$xLabel)} + if(input$yLabel != ""){pkRatioPlot <- setPlotLabels(pkRatioPlot, ylabel = input$yLabel)} + pkRatioPlot <- setWatermark(pkRatioPlot, watermark = input$watermark) + pkRatioPlot + }) + + output$pkRatioTable = renderTable({ + pkRatioData <- getPKRatioData() + if(!isOfType(pkRatioData, "data.frame")){return(data.frame())} + if(nrow(pkRatioData)==0){return(data.frame())} + dataMapping <- getDataMapping() + pkRatioTable <- getPKRatioMeasure(data=pkRatioData, + dataMapping = dataMapping, + ratioLimits = c(input$ratioLine1, input$ratioLine2)) + pkRatioTable <- cbind.data.frame(" "= row.names(pkRatioTable), + pkRatioTable) + return(pkRatioTable) + }) +} + +shinyApp(ui = ui, server = server) diff --git a/inst/theme-maker/app.R b/inst/theme-maker/app.R new file mode 100644 index 00000000..a55675fa --- /dev/null +++ b/inst/theme-maker/app.R @@ -0,0 +1,514 @@ +require(shiny) +require(tlf) + +jsonTheme <- loadThemeFromJson(system.file("extdata", "template-theme.json", package = "tlf")) +useTheme(jsonTheme) + +# Define UI page ---- +ui <- fluidPage( + h1("Theme Maker", align = "center"), + column( + 5, + tabsetPanel( + tabPanel( + "Labels", + tabsetPanel( + tabPanel("Title", + fluidRow( + textInput("titleColor", label = "color", value = jsonTheme$fonts$title$color), + sliderInput("titleSize", label = "size", min = 1, max = 30, value = jsonTheme$fonts$title$size, step = 0.5), + sliderInput("titleAngle", label = "angle", min = -180, max = 180, value = jsonTheme$fonts$title$angle, step = 5) + )), + tabPanel("Subtitle", + fluidRow( + textInput("subtitleColor", label = "color", value = jsonTheme$fonts$subtitle$color), + sliderInput("subtitleSize", label = "size", min = 1, max = 30, value = jsonTheme$fonts$subtitle$size, step = 0.5), + sliderInput("subtitleAngle", label = "angle", min = -180, max = 180, value = jsonTheme$fonts$subtitle$angle, step = 5) + )), + tabPanel("X-label", + fluidRow( + textInput("xlabelColor", label = "color", value = jsonTheme$fonts$xlabel$color), + sliderInput("xlabelSize", label = "size", min = 1, max = 30, value = jsonTheme$fonts$xlabel$size, step = 0.5), + sliderInput("xlabelAngle", label = "angle", min = -180, max = 180, value = jsonTheme$fonts$xlabel$angle, step = 5) + )), + tabPanel("Y-label", + fluidRow( + textInput("ylabelColor", label = "color", value = jsonTheme$fonts$ylabel$color), + sliderInput("ylabelSize", label = "size", min = 1, max = 30, value = jsonTheme$fonts$ylabel$size, step = 0.5), + sliderInput("ylabelAngle", label = "angle", min = -180, max = 180, value = jsonTheme$fonts$ylabel$angle, step = 5) + )) + )), + tabPanel( + "Watermark", + fluidRow( + textInput("watermarkText", label = h4("text"), value = jsonTheme$background$watermark), + textInput("watermarkColor", label = h4("color"), value = jsonTheme$fonts$watermark$color), + sliderInput("watermarkSize", label = h4("size"), min = 1, max = 30, value = jsonTheme$fonts$watermark$size, step = 0.5), + sliderInput("watermarkAngle", label = h4("angle"), min = -180, max = 180, value = jsonTheme$fonts$watermark$angle, step = 5) + ) + ), + tabPanel( + "Background", + tabsetPanel( + tabPanel("Plot Area", + textInput("plotFill", label = h4("plot area fill"), value = jsonTheme$background$plot$fill), + textInput("plotColor", label = h4("plot area frame color"), value = jsonTheme$background$plot$color), + sliderInput("plotSize", label = h4("plot area frame size"), min = 0, max = 5, value = jsonTheme$background$plot$size, step = 0.05), + selectInput("plotLinetype", label = h4("plot area frame linetype"), choices = Linetypes, selected = jsonTheme$background$plot$linetype) + ), + tabPanel("Panel Area", + textInput("panelFill", label = h4("panel area fill"), value = jsonTheme$background$panel$fill), + textInput("panelColor", label = h4("panel area frame color"), value = jsonTheme$background$panel$color), + sliderInput("panelSize", label = h4("panel area frame size"), min = 0, max = 5, value = jsonTheme$background$panel$size, step = 0.05), + selectInput("panelLinetype", label = h4("panel area frame linetype"), choices = Linetypes, selected = jsonTheme$background$panel$linetype) + ) + )), + tabPanel( + "Axes", + tabsetPanel( + tabPanel("X-axis", + textInput("xAxisColor", label = h4("axis color"), value = jsonTheme$background$xAxis$color), + sliderInput("xAxisSize", label = h4("axis size"), min = 0, max = 5, value = jsonTheme$background$xAxis$size, step = 0.05), + selectInput("xAxisLinetype", label = h4("axis linetype"), choices = Linetypes, selected = jsonTheme$background$xAxis$linetype), + textInput("xAxisTicksColor", label = h4("ticklabels color"), value = jsonTheme$fonts$xAxis$color), + sliderInput("xAxisTicksSize", label = h4("ticklabels size"), min = 0, max = 30, value = jsonTheme$fonts$xAxis$size, step = 0.5), + sliderInput("xAxisTicksAngle", label = h4("ticklabels angle"), min = -180, max = 180, value = jsonTheme$fonts$xAxis$angle, step = 5) + ), + tabPanel("Y-axis", + textInput("yAxisColor", label = h4("y-axis color"), value = jsonTheme$background$yAxis$color), + sliderInput("yAxisSize", label = h4("y-axis size"), min = 0, max = 5, value = jsonTheme$background$yAxis$size, step = 0.05), + selectInput("yAxisLinetype", label = h4("y-axis linetype"), choices = Linetypes, selected = jsonTheme$background$yAxis$linetype), + textInput("yAxisTicksColor", label = h4("ticklabels color"), value = jsonTheme$fonts$xAxis$color), + sliderInput("yAxisTicksSize", label = h4("ticklabels size"), min = 0, max = 30, value = jsonTheme$fonts$yAxis$size, step = 0.5), + sliderInput("yAxisTicksAngle", label = h4("ticklabels angle"), min = -180, max = 180, value = jsonTheme$fonts$yAxis$angle, step = 5) + ) + )), + tabPanel( + "Grid", + tabsetPanel( + tabPanel("X-grid", + textInput("xGridColor", label = h4("color"), value = jsonTheme$background$xGrid$color), + sliderInput("xGridSize", label = h4("size"), min = 0, max = 5, value = jsonTheme$background$xGrid$size, step = 0.05), + selectInput("xGridLinetype", label = h4("linetype"), choices = Linetypes, selected = jsonTheme$background$xGrid$linetype) + ), + tabPanel("Y-Grid", + textInput("yGridColor", label = h4("color"), value = jsonTheme$background$yGrid$color), + sliderInput("yGridSize", label = h4("size"), min = 0, max = 5, value = jsonTheme$background$yGrid$size, step = 0.05), + selectInput("yGridLinetype", label = h4("linetype"), choices = Linetypes, selected = jsonTheme$background$yGrid$linetype) + ) + )), + tabPanel( + "Legend", + # fluidRow( + # h4("Title"), + # textInput("legendTitleText", label = h4("text"), value = "TO DO"), + # textInput("legendTitleColor", label = h4("color"), value = jsonTheme$fonts$legendTitle$color), + # sliderInput("legendTitleSize", label = h4("size"), min = 1, max = 30, value = jsonTheme$fonts$legendTitle$size, step = 0.5), + # sliderInput("legendTitleAngle", label = h4("angle"), min = -180, max = 180, value = jsonTheme$fonts$legendTitle$angle, step = 5) + # ), + tabsetPanel( + tabPanel("Position", + selectInput("legendPosition", label = h4("position"), choices = LegendPositions, selected = jsonTheme$background$legendPosition) + ), + tabPanel("Font", + textInput("legendFontColor", label = h4("color"), value = jsonTheme$fonts$legend$color), + sliderInput("legendFontSize", label = h4("size"), min = 1, max = 30, value = jsonTheme$fonts$legend$size, step = 0.5), + sliderInput("legendFontAngle", label = h4("angle"), min = -180, max = 180, value = jsonTheme$fonts$legend$angle, step = 5) + ), + tabPanel("Background", + textInput("legendFill", label = h4("fill"), value = jsonTheme$background$legend$fill), + textInput("legendColor", label = h4("color"), value = jsonTheme$background$legend$color), + sliderInput("legendSize", label = h4("size"), min = 0, max = 5, value = jsonTheme$background$legend$size, step = 0.05), + selectInput("legendLinetype", label = h4("linetype"), choices = Linetypes, selected = jsonTheme$background$legend$linetype) + ) + )), + tabPanel( + "Aesthetic Maps", + tabsetPanel( + tabPanel("Color", + sliderInput("colorMapIndex", label = h4("rank"), min = 1, max = length(jsonTheme$aestheticMaps$color), value = 1, step = 1), + uiOutput("colorMapValue")), + tabPanel("Fill", + sliderInput("fillMapIndex", label = h4("rank"), min = 1, max = length(jsonTheme$aestheticMaps$fill), value = 1, step = 1), + uiOutput("fillMapValue")), + tabPanel("Linetype", + sliderInput("linetypeMapIndex", label = h4("rank"), min = 1, max = length(jsonTheme$aestheticMaps$linetype), value = 1, step = 1), + uiOutput("linetypeMapValue")), + tabPanel("Shape", + sliderInput("shapeMapIndex", label = h4("rank"), min = 1, max = length(jsonTheme$aestheticMaps$shape), value = 1, step = 1), + uiOutput("shapeMapValue")), + tabPanel("Size", + sliderInput("sizeMapIndex", label = h4("rank"), min = 1, max = length(jsonTheme$aestheticMaps$size), value = 1, step = 1), + uiOutput("sizeMapValue")), + tabPanel("Alpha", + sliderInput("alphaMapIndex", label = h4("rank"), min = 1, max = length(jsonTheme$aestheticMaps$alpha), value = 1, step = 1), + uiOutput("alphaMapValue")) + ) + ), + tabPanel( + "Plot Configurations", + p("The following arguments define how the plot will use the aesthetic map"), + p("Selection key 'next': use next aesthetic value from map"), + p("Selection key 'same': use same aesthetic value from map"), + p("Selection key 'first': use first aesthetic value from map"), + p("Selection key 'reset': use next aesthetic value from map, but reset every time the function is called"), + p("No selection key, the specific value is used every time (e.g. 'blank')"), + conditionalPanel( + condition = "input.plotType == 'addScatter()'", + textInput("addScatterColor", label = h4("color"), value = jsonTheme$plotConfigurations$addScatter$color), + textInput("addScatterLinetype", label = h4("linetype"), value = jsonTheme$plotConfigurations$addScatter$linetype), + textInput("addScatterShape", label = h4("shape"), value = jsonTheme$plotConfigurations$addScatter$shape), + textInput("addScatterSize", label = h4("size"), value = jsonTheme$plotConfigurations$addScatter$size), + textInput("addScatterFill", label = h4("fill"), value = jsonTheme$plotConfigurations$addScatter$fill), + textInput("addScatterAlpha", label = h4("alpha"), value = jsonTheme$plotConfigurations$addScatter$alpha) + ), + conditionalPanel( + condition = "input.plotType == 'addLine()'", + textInput("addLineColor", label = h4("color"), value = jsonTheme$plotConfigurations$addLine$color), + textInput("addLineLinetype", label = h4("linetype"), value = jsonTheme$plotConfigurations$addLine$linetype), + textInput("addLineShape", label = h4("shape"), value = jsonTheme$plotConfigurations$addLine$shape), + textInput("addLineSize", label = h4("size"), value = jsonTheme$plotConfigurations$addLine$size), + textInput("addLineFill", label = h4("fill"), value = jsonTheme$plotConfigurations$addLine$fill), + textInput("addLineAlpha", label = h4("alpha"), value = jsonTheme$plotConfigurations$addLine$alpha) + ), + conditionalPanel( + condition = "input.plotType == 'addRibbon()'", + textInput("addRibbonColor", label = h4("color"), value = jsonTheme$plotConfigurations$addRibbon$color), + textInput("addRibbonLinetype", label = h4("linetype"), value = jsonTheme$plotConfigurations$addRibbon$linetype), + textInput("addRibbonShape", label = h4("shape"), value = jsonTheme$plotConfigurations$addRibbon$shape), + textInput("addRibbonSize", label = h4("size"), value = jsonTheme$plotConfigurations$addRibbon$size), + textInput("addRibbonFill", label = h4("fill"), value = jsonTheme$plotConfigurations$addRibbon$fill), + textInput("addRibbonAlpha", label = h4("alpha"), value = jsonTheme$plotConfigurations$addRibbon$alpha) + ), + conditionalPanel( + condition = "input.plotType == 'addErrorbar()'", + textInput("addErrorbarColor", label = h4("color"), value = jsonTheme$plotConfigurations$addErrorbar$color), + textInput("addErrorbarLinetype", label = h4("linetype"), value = jsonTheme$plotConfigurations$addErrorbar$linetype), + textInput("addErrorbarShape", label = h4("shape"), value = jsonTheme$plotConfigurations$addErrorbar$shape), + textInput("addErrorbarSize", label = h4("size"), value = jsonTheme$plotConfigurations$addErrorbar$size), + textInput("addErrorbarFill", label = h4("fill"), value = jsonTheme$plotConfigurations$addErrorbar$fill), + textInput("addErrorbarAlpha", label = h4("alpha"), value = jsonTheme$plotConfigurations$addErrorbar$alpha) + ), + conditionalPanel( + condition = "input.plotType == 'plotPKRatio()'", + h4("PK Ratio Line of unity"), + textInput("pkRatioLine1.color", label = h4("color"), value = jsonTheme$defaultCaption$pkRatio$color[1]), + selectInput("pkRatioLine1.linetype", label = h4("linetype"), choices = Linetypes, selected = jsonTheme$defaultCaption$pkRatio$linetype[1]), + sliderInput("pkRatioLine1.size", label = h4("size"), min = 0.05, max = 5, value = jsonTheme$defaultCaption$pkRatio$size[1], step = 0.05), + h4("PK Ratio Lines of 1.5 fold error"), + textInput("pkRatioLine2.color", label = h4("color"), value = jsonTheme$defaultCaption$pkRatio$color[2]), + selectInput("pkRatioLine2.linetype", label = h4("linetype"), choices = Linetypes, selected = jsonTheme$defaultCaption$pkRatio$linetype[2]), + sliderInput("pkRatioLine2.size", label = h4("size"), min = 0.05, max = 5, value = jsonTheme$defaultCaption$pkRatio$size[2], step = 0.05), + h4("PK Ratio Lines of 2 fold error"), + textInput("pkRatioLine3.color", label = h4("color"), value = jsonTheme$defaultCaption$pkRatio$color[3]), + selectInput("pkRatioLine3.linetype", label = h4("linetype"), choices = Linetypes, selected = jsonTheme$defaultCaption$pkRatio$linetype[3]), + sliderInput("pkRatioLine3.size", label = h4("size"), min = 0.05, max = 5, value = jsonTheme$defaultCaption$pkRatio$size[3], step = 0.05) + ), + conditionalPanel( + condition = "input.plotType == 'plotTornado()'", + textInput("colorPalette", label = h4("Color Palette"), value = NULL) + ) + ) + ) + ), + + # Plot Column + column( + 7, + h2("Sample Plot", align = "center"), + + plotOutput(outputId = "samplePlot"), + + selectInput( + inputId = "plotType", label = h3("Available plot functions"), + choices = as.list(sapply( + c( + "initializePlot()", + "addScatter()", + "addLine()", + "addRibbon()", + "addErrorbar()", + "plotPKRatio()", + "plotDDIRatio()", + "plotBoxWhisker()", + "plotHistogram()", + "plotTimeProfile()", + "plotTornado()", + "plotObsVsPred()" + ), + identity + )), + selected = 1 + ), + + fileInput("loadTheme", "Load a Theme from Json", accept = ".json"), + textInput("jsonFileName", label = "File name", value = "new-theme.json"), + actionButton("saveTheme", "Save Theme to Json") + ) +) + +# Define server logic required to draw a histogram ---- +server <- function(input, output) { + + output$samplePlot <- renderPlot({ + # Create copy of json template + updatedThemeProperties <- jsonTheme + # Update every template feature + jsonTheme$fonts$title$color <- input$titleColor + jsonTheme$fonts$subtitle$color <- input$subtitleColor + jsonTheme$fonts$xlabel$color <- input$xlabelColor + jsonTheme$fonts$ylabel$color <- input$ylabelColor + + jsonTheme$fonts$title$size <- input$titleSize + jsonTheme$fonts$subtitle$size <- input$subtitleSize + jsonTheme$fonts$xlabel$size <- input$xlabelSize + jsonTheme$fonts$ylabel$size <- input$ylabelSize + + jsonTheme$fonts$title$angle <- input$titleAngle + jsonTheme$fonts$subtitle$angle <- input$subtitleAngle + jsonTheme$fonts$xlabel$angle <- input$xlabelAngle + jsonTheme$fonts$ylabel$angle <- input$ylabelAngle + + jsonTheme$background$watermark <- input$watermarkText + jsonTheme$fonts$watermark$color <- input$watermarkColor + jsonTheme$fonts$watermark$size <- input$watermarkSize + jsonTheme$fonts$watermark$angle <- input$watermarkAngle + + jsonTheme$background$plot$fill <- input$plotFill + jsonTheme$background$plot$color <- input$plotColor + jsonTheme$background$plot$size <- input$plotSize + jsonTheme$background$plot$linetype <- input$plotLinetype + + jsonTheme$background$panel$fill <- input$panelFill + jsonTheme$background$panel$color <- input$panelColor + jsonTheme$background$panel$size <- input$panelSize + jsonTheme$background$panel$linetype <- input$panelLinetype + + jsonTheme$background$xAxis$color <- input$xAxisColor + jsonTheme$background$xAxis$size <- input$xAxisSize + jsonTheme$background$xAxis$linetype <- input$xAxisLinetype + jsonTheme$fonts$xAxis$color <- input$xAxisTicksColor + jsonTheme$fonts$xAxis$size <- input$xAxisTicksSize + jsonTheme$fonts$xAxis$angle <- input$xAxisTicksAngle + + jsonTheme$background$yAxis$color <- input$yAxisColor + jsonTheme$background$yAxis$size <- input$yAxisSize + jsonTheme$background$yAxis$linetype <- input$yAxisLinetype + jsonTheme$fonts$yAxis$color <- input$yAxisTicksColor + jsonTheme$fonts$yAxis$size <- input$yAxisTicksSize + jsonTheme$fonts$yAxis$angle <- input$yAxisTicksAngle + + jsonTheme$background$xGrid$color <- input$xGridColor + jsonTheme$background$xGrid$size <- input$xGridSize + jsonTheme$background$xGrid$linetype <- input$xGridLinetype + + jsonTheme$background$yGrid$color <- input$yGridColor + jsonTheme$background$yGrid$size <- input$yGridSize + jsonTheme$background$yGrid$linetype <- input$yGridLinetype + + jsonTheme$background$legendPosition <- input$legendPosition + + jsonTheme$background$legend$fill <- input$legendFill + jsonTheme$background$legend$color <- input$legendColor + jsonTheme$background$legend$size <- input$legendSize + jsonTheme$background$legend$linetype <- input$legendLinetype + + jsonTheme$fonts$legend$color <- input$legendFontColor + jsonTheme$fonts$legend$size <- input$legendFontSize + jsonTheme$fonts$legend$angle <- input$legendFontAngle + + # jsonTheme$fonts$legendTitle$color <- input$legendTitleColor + # jsonTheme$fonts$legendTitle$size <- input$legendTitleSize + # jsonTheme$fonts$legendTitle$angle <- input$legendTitleAngle + + # Color maps + if(!isOfLength(input$colorMapValue2,0)){jsonTheme$aestheticMaps$color[input$colorMapIndex] <- input$colorMapValue2} + if(!isOfLength(input$fillMapValue2,0)){jsonTheme$aestheticMaps$fill[input$fillMapIndex] <- input$fillMapValue2} + if(!isOfLength(input$linetypeMapValue2,0)){jsonTheme$aestheticMaps$linetype[input$linetypeMapIndex] <- input$linetypeMapValue2} + if(!isOfLength(input$shapeMapValue2,0)){jsonTheme$aestheticMaps$shape[input$shapeMapIndex] <- as.numeric(input$shapeMapValue2)} + if(!isOfLength(input$sizeMapValue2,0)){jsonTheme$aestheticMaps$size[input$sizeMapIndex] <- input$sizeMapValue2} + if(!isOfLength(input$alphaMapValue2,0)){jsonTheme$aestheticMaps$alpha[input$alphaMapIndex] <- input$alphaMapValue2} + + # initializePlot() from Theme + useTheme(jsonTheme) + plotConfiguration <- PlotConfiguration$new(title = "Title", subtitle = "Subtitle", xlabel = "X-label", ylabel = "Y-label") + samplePlot <- initializePlot(plotConfiguration = plotConfiguration) + + # addScatter() from Theme + if (input$plotType %in% "addScatter()") { + jsonTheme$plotConfigurations$addScatter$color <- input$addScatterColor + jsonTheme$plotConfigurations$addScatter$linetype <- input$addScatterLinetype + jsonTheme$plotConfigurations$addScatter$shape <- input$addScatterShape + jsonTheme$plotConfigurations$addScatter$size <- input$addScatterSize + jsonTheme$plotConfigurations$addScatter$fill <- input$addScatterFill + jsonTheme$plotConfigurations$addScatter$alpha <- input$addScatterAlpha + useTheme(jsonTheme) + plotConfiguration <- PlotConfiguration$new(title = "Title", subtitle = "Subtitle", xlabel = "X-label", ylabel = "Y-label") + + sampleData <- data.frame( + x = seq(-3, 3, 0.1), + y = cos(2 * seq(-3, 3, 0.1)) + ) + samplePlot <- addScatter(data = sampleData, plotConfiguration = plotConfiguration) + for (sampleIndex in 1:4) { + sampleData$y <- 1.2 * sampleData$y + samplePlot <- addScatter(data = sampleData, plotObject = samplePlot) + } + } + if (input$plotType %in% "addLine()") { + jsonTheme$plotConfigurations$addLine$color <- input$addLineColor + jsonTheme$plotConfigurations$addLine$linetype <- input$addLineLinetype + jsonTheme$plotConfigurations$addLine$shape <- input$addLineShape + jsonTheme$plotConfigurations$addLine$size <- input$addLineSize + jsonTheme$plotConfigurations$addLine$fill <- input$addLineFill + jsonTheme$plotConfigurations$addLine$alpha <- input$addLineAlpha + useTheme(jsonTheme) + plotConfiguration <- PlotConfiguration$new(title = "Title", subtitle = "Subtitle", xlabel = "X-label", ylabel = "Y-label") + + sampleData <- data.frame( + x = seq(-3, 3, 0.1), + y = cos(2 * seq(-3, 3, 0.1)) + ) + samplePlot <- addLine(data = sampleData, plotConfiguration = plotConfiguration) + for (sampleIndex in 1:4) { + sampleData$y <- 1.2 * sampleData$y + samplePlot <- addLine(data = sampleData, plotObject = samplePlot) + } + } + if (input$plotType %in% "addRibbon()") { + jsonTheme$plotConfigurations$addRibbon$color <- input$addRibbonColor + jsonTheme$plotConfigurations$addRibbon$linetype <- input$addRibbonLinetype + jsonTheme$plotConfigurations$addRibbon$shape <- input$addRibbonShape + jsonTheme$plotConfigurations$addRibbon$size <- input$addRibbonSize + jsonTheme$plotConfigurations$addRibbon$fill <- input$addRibbonFill + jsonTheme$plotConfigurations$addRibbon$alpha <- input$addRibbonAlpha + useTheme(jsonTheme) + plotConfiguration <- PlotConfiguration$new(title = "Title", subtitle = "Subtitle", xlabel = "X-label", ylabel = "Y-label") + + sampleData <- data.frame( + x = seq(-3, 3, 0.1), + ymax = cos(2 * seq(-3, 3, 0.1)), + ymin = 0 + ) + samplePlot <- addRibbon(data = sampleData, plotConfiguration = plotConfiguration) + for (sampleIndex in 1:4) { + sampleData$ymin <- sampleData$ymax + sampleData$ymax <- 1.2 * sampleData$ymax + samplePlot <- addRibbon(data = sampleData, plotObject = samplePlot) + } + } + if (input$plotType %in% "addErrorbar()") { + jsonTheme$plotConfigurations$addErrorbar$color <- input$addErrorbarColor + jsonTheme$plotConfigurations$addErrorbar$linetype <- input$addErrorbarLinetype + jsonTheme$plotConfigurations$addErrorbar$shape <- input$addErrorbarShape + jsonTheme$plotConfigurations$addErrorbar$size <- input$addErrorbarSize + jsonTheme$plotConfigurations$addErrorbar$fill <- input$addErrorbarFill + jsonTheme$plotConfigurations$addErrorbar$alpha <- input$addErrorbarAlpha + useTheme(jsonTheme) + + plotConfiguration <- PlotConfiguration$new(title = "Title", subtitle = "Subtitle", xlabel = "X-label", ylabel = "Y-label") + + sampleData <- data.frame( + x = seq(-3, 3, 0.1), + ymax = cos(2 * seq(-3, 3, 0.1)), + ymin = 0 + ) + samplePlot <- addErrorbar(data = sampleData, plotConfiguration = plotConfiguration) + } + if (input$plotType %in% "plotPKRatio()") { + pkRatioCaption <- data.frame( + name = c("pkRatioLine1", "pkRatioLine2", "pkRatioLine3"), + label = c("pkRatioLine1", "pkRatioLine2", "pkRatioLine3"), + visibility = rep(FALSE, 3), order = c(1, 2, 3), + color = c(input$pkRatioLine1.color, input$pkRatioLine2.color, input$pkRatioLine3.color), + shape = rep(-2, 3), + size = c(input$pkRatioLine1.size, input$pkRatioLine2.size, input$pkRatioLine3.size), + linetype = c(input$pkRatioLine1.linetype, input$pkRatioLine2.linetype, input$pkRatioLine3.linetype), + fill = NA, + stringsAsFactors = FALSE + ) + + plotConfiguration <- PKRatioPlotConfiguration$new( + pkRatioCaption = pkRatioCaption, + title = "Title", + subtitle = "Subtitle", + xlabel = Label$new("X-label", color = input$xlabelColor, size = input$xlabelSize), + ylabel = Label$new("Y-label", color = input$ylabelColor, size = input$ylabelSize), + theme = updatedTheme + ) + samplePlot <- plotPKRatio( + data = sampleData, + plotConfiguration = plotConfiguration + ) + } + if (input$plotType %in% "plotDDIRatio()") { + plotConfiguration <- DDIRatioPlotConfiguration$new( + title = "Title", + subtitle = "Subtitle", + xlabel = Label$new("X-label", color = input$xlabelColor, size = input$xlabelSize), + ylabel = Label$new("Y-label", color = input$ylabelColor, size = input$ylabelSize), + theme = updatedTheme + ) + samplePlot <- plotDDIRatio(data = sampleData, plotConfiguration = plotConfiguration) + } + if (input$plotType %in% "plotBoxWhisker()") { + # plotConfiguration <- BoxWhiskerPlotConfiguration$new( + # samplePlot <- plotBoxWhisker(data = sampleData, plotConfiguration = plotConfiguration) + } + if (input$plotType %in% "plotHistogram()") { + # plotConfiguration <- HistogramPlotConfiguration$new( + # samplePlot <- plotHistogram(data = sampleData, plotConfiguration = plotConfiguration) + } + if (input$plotType %in% "plotTimeProfile()") { + # plotConfiguration <- TimeProfilePlotConfiguration$new( + # samplePlot <- plotTimeProfile(data = sampleData, plotConfiguration = plotConfiguration) + } + if (input$plotType %in% "plotObsVsPred()") { + # plotConfiguration <- ObsVsPredPlotConfiguration$new( + # samplePlot <- plotBoxWhisker(data = sampleData, plotConfiguration = plotConfiguration) + } + + if (input$plotType %in% "plotTornado()") { + plotConfiguration <- TornadoPlotConfiguration$new( + title = "Title", + subtitle = "Subtitle", + xlabel = Label$new("X-label", color = input$xlabelColor, size = input$xlabelSize), + ylabel = Label$new("Y-label", color = input$ylabelColor, size = input$ylabelSize), + theme = updatedTheme, + colorPalette = input$colorPalette + ) + samplePlot <- plotTornado( + x = c(1, 0.5, -0.25, -0.2, -0.1), + y = c("A", "B", "C", "D", "E"), + plotConfiguration = plotConfiguration + ) + } + samplePlot + }) + + # Interactive way of updating aesthetic map element + getColorMapValue <- reactive({jsonTheme$aestheticMaps$color[input$colorMapIndex]}) + getFillMapValue <- reactive({jsonTheme$aestheticMaps$fill[input$fillMapIndex]}) + getLinetypeMapValue <- reactive({jsonTheme$aestheticMaps$linetype[input$linetypeMapIndex]}) + getShapeMapValue <- reactive({jsonTheme$aestheticMaps$shape[input$shapeMapIndex]}) + getSizeMapValue <- reactive({jsonTheme$aestheticMaps$size[input$sizeMapIndex]}) + getAlphaMapValue <- reactive({jsonTheme$aestheticMaps$alpha[input$alphaMapIndex]}) + + output$colorMapValue <- renderUI({textInput("colorMapValue2", "value", getColorMapValue())}) + output$fillMapValue <- renderUI({textInput("fillMapValue2", "value", getFillMapValue())}) + output$linetypeMapValue <- renderUI({ + selectInput("linetypeMapValue2", "value", choices = Linetypes, selected = getLinetypeMapValue())}) + output$shapeMapValue <- renderUI({ + selectInput("shapeMapValue2", "value", choices = Shapes, selected = getShapeMapValue())}) + output$sizeMapValue <- renderUI({numericInput("sizeMapValue2", "value", getSizeMapValue())}) + output$alphaMapValue <- renderUI({numericInput("alphaMapValue2", "value", getAlphaMapValue())}) + + # Load/save Theme + observeEvent(input$loadTheme, { + jsonTheme <- loadThemeFromJson(input$loadTheme$datapath) + useTheme(jsonTheme) + }) + observeEvent(input$saveTheme, {saveThemeToJson(jsonFile = input$jsonFileName, theme = jsonTheme)}) +} + +shinyApp(ui = ui, server = server) diff --git a/inst/tornado/app.R b/inst/tornado/app.R new file mode 100644 index 00000000..4244d221 --- /dev/null +++ b/inst/tornado/app.R @@ -0,0 +1,166 @@ +require(shiny) +require(tlf) + +# Use theme template but this could be modified in later versions +useTheme(loadThemeFromJson(system.file("extdata", "template-theme.json", package = "tlf"))) + +# Define UI page ---- +ui <- fluidPage( + h1("Tornado Plot", align = "center"), + column( + 5, + tabsetPanel( + tabPanel( + "Data", + fluidRow( + selectInput("dataType", + label = h4("Data location"), + choices = list("environment" = "environment", "file" = "file") + ), + conditionalPanel( + condition = "input.dataType == 'environment'", + selectInput("dataFromEnv", label = h4("List of environment variables"), choices = sapply(ls(envir = sys.frame()), identity)) + ), + conditionalPanel( + condition = "input.dataType == 'file'", + fileInput("dataFromFile", label = h4("Choose a csv file"), accept = ".csv") + ), + uiOutput("xVariableNames"), + uiOutput("yVariableNames"), + uiOutput("colorVariableNames"), + conditionalPanel( + condition = "input.bar == 'No'", + uiOutput("shapeVariableNames") + ) + ) + ), + tabPanel( + "Analysis", + fluidRow( + selectInput("bar", label = "Tornado as bar plot", choices = list(Yes = "Yes", No = "No")), + selectInput("sort", label = "Sort values", choices = list(Yes = "Yes", No = "No")), + selectInput("colorPalette", label = "Color palette", choices = list(none = "none", + Spectral = "Spectral", + Greys = "Greys", + Blues = "Blues", + RedToBlue = "RdBu", + RedToGreen = "RdYlGn")) + ) + ), + tabPanel( + "Axes", + fluidRow( + h4("x axis"), + numericInput("xAxisMin", label = "min", value = NULL), + numericInput("xAxisMax", label = "max", value = NULL), + selectInput("xAxisScale", label = "scale", choices = Scaling, selected = Scaling$lin) + ) + ), + tabPanel( + "Labels", + fluidRow( + textInput("xLabel", label = "x label", value = NULL), + textInput("yLabel", label = "y label", value = NULL), + textInput("watermark", label = "watermark", value = NULL) + ) + ) + ) + ), + + # Plot Column + column( + 7, + br(), + plotOutput(outputId = "tornadoPlot"), + br(), + actionButton("exportButton", "Save Plot"), + align = "center" + ) +) + +# Define server logic required to draw a histogram ---- +server <- function(input, output) { + + getTornadoData <- reactive({ + tornadoData <- data.frame(`Fill data first` = NULL) + if (input$dataType == "environment") { + if (input$dataFromEnv != "") { + tornadoData <- get(input$dataFromEnv, envir = sys.frame()) + } + } + if (input$dataType == "file") { + if (!isOfLength(input$dataFromFile, 0)) { + tornadoData <- read.csv(input$dataFromFile$datapath, stringsAsFactors = FALSE) + } + } + return(tornadoData) + }) + + getVariableNames <- reactive({ + tornadoData <- getTornadoData() + return(sapply(names(tornadoData), identity)) + }) + + output$yVariableNames <- renderUI({ + selectInput("yVariableNames2", "Variable in Y", getVariableNames()) + }) + + output$xVariableNames <- renderUI({ + selectInput("xVariableNames2", "Variable in X", getVariableNames()) + }) + + output$shapeVariableNames <- renderUI({ + selectInput("shapeVariableNames2", "Shape group variable", c("none" = "none", getVariableNames())) + }) + + output$colorVariableNames <- renderUI({ + selectInput("colorVariableNames2", "Color group variable", c("none" = "none", getVariableNames())) + }) + + getDataMapping <- reactive({ + colorMapping <- input$colorVariableNames2 + shapeMapping <- input$shapeVariableNames2 + if(isIncluded(colorMapping, "none")){colorMapping <- NULL} + if(isIncluded(shapeMapping, "none")){shapeMapping <- NULL} + dataMapping <- TornadoDataMapping$new(x = input$xVariableNames2, + y = input$yVariableNames2, + color = colorMapping, + fill = colorMapping, + shape = shapeMapping) + dataMapping$sorted <- (input$sort == 'Yes') + return(dataMapping) + }) + + output$tornadoPlot <- renderPlot({ + # Get the data + tornadoData <- getTornadoData() + if(!isOfType(tornadoData, "data.frame")){return()} + if(nrow(tornadoData)==0){return()} + # Meta Data + # DataMapping + dataMapping <- getDataMapping() + # PlotConfiguration + colorPalette <- input$colorPalette + if(colorPalette %in% "none"){colorPalette <- NULL} + tornadoPlot <- plotTornado( + data = tornadoData, + dataMapping = dataMapping, + bar = (input$bar == "Yes"), + colorPalette = colorPalette + ) + xLimits <- c(input$xAxisMin, input$xAxisMax) + if(any(is.na(xLimits))){xLimits <- NULL} + + tornadoPlot <- setXAxis(tornadoPlot, + limits = xLimits, + scale = input$xAxisScale + ) + + if(input$xLabel != ""){tornadoPlot <- setPlotLabels(tornadoPlot, xlabel = input$xLabel)} + if(input$yLabel != ""){tornadoPlot <- setPlotLabels(tornadoPlot, ylabel = input$yLabel)} + tornadoPlot <- setWatermark(tornadoPlot, watermark = input$watermark) + tornadoPlot + }) +} + +shinyApp(ui = ui, server = server) diff --git a/man/AestheticProperties.Rd b/man/AestheticProperties.Rd new file mode 100644 index 00000000..70a578d5 --- /dev/null +++ b/man/AestheticProperties.Rd @@ -0,0 +1,16 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utilities-aesthetics.R +\docType{data} +\name{AestheticProperties} +\alias{AestheticProperties} +\title{AestheticProperties} +\format{ +An object of class \code{list} of length 6. +} +\usage{ +AestheticProperties +} +\description{ +Enum of aesthetic property names of \code{ggplot2} +} +\keyword{datasets} diff --git a/man/AestheticSelectionKeys.Rd b/man/AestheticSelectionKeys.Rd new file mode 100644 index 00000000..ccf5f21f --- /dev/null +++ b/man/AestheticSelectionKeys.Rd @@ -0,0 +1,16 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utilities-aesthetics.R +\docType{data} +\name{AestheticSelectionKeys} +\alias{AestheticSelectionKeys} +\title{AestheticSelectionKeys} +\format{ +An object of class \code{list} of length 4. +} +\usage{ +AestheticSelectionKeys +} +\description{ +List of some \code{ggplot2} shapes +} +\keyword{datasets} diff --git a/man/AxisConfiguration.Rd b/man/AxisConfiguration.Rd index 36eda93d..bef781d2 100644 --- a/man/AxisConfiguration.Rd +++ b/man/AxisConfiguration.Rd @@ -6,16 +6,20 @@ \description{ R6 class defining the configuration of axis } -\section{Public fields}{ -\if{html}{\out{
}} +\section{Active bindings}{ +\if{html}{\out{
}} \describe{ -\item{\code{limits}}{numeric vector of axis limits} +\item{\code{limits}}{numeric vector of length 2 defining limits of axis. +A value of \code{NULL} is allowed and lead to default \code{ggplot2} behaviour} -\item{\code{scale}}{character defining axis scale} +\item{\code{scale}}{name of axis scale from Enum \code{Scaling} +A value of \code{NULL} is allowed and will lead to a default linear scale} -\item{\code{ticks}}{numeric vector or function defining where to position axis ticks} +\item{\code{ticks}}{function or values defining where axis ticks are placed} -\item{\code{ticklabels}}{character vector or function defining what to print on axis ticks} +\item{\code{ticklabels}}{function or values defining the axis tick labels} + +\item{\code{font}}{\code{Font} object defining the font of the ticklabels} } \if{html}{\out{
}} } @@ -23,7 +27,6 @@ R6 class defining the configuration of axis \subsection{Public methods}{ \itemize{ \item \href{#method-new}{\code{AxisConfiguration$new()}} -\item \href{#method-print}{\code{AxisConfiguration$print()}} \item \href{#method-clone}{\code{AxisConfiguration$clone()}} } } @@ -36,8 +39,9 @@ Create a new \code{AxisConfiguration} object \if{html}{\out{
}}\preformatted{AxisConfiguration$new( limits = NULL, scale = Scaling$lin, - ticks = "default", - ticklabels = "default" + ticks = NULL, + ticklabels = NULL, + font = NULL )}\if{html}{\out{
}} } @@ -52,6 +56,8 @@ Use enum \code{Scaling} to access predefined scales.} \item{\code{ticks}}{numeric vector or function defining where to position axis ticks} \item{\code{ticklabels}}{character vector or function defining what to print on axis ticks} + +\item{\code{font}}{\code{Font} object defining the font of ticklabels} } \if{html}{\out{
}} } @@ -60,19 +66,6 @@ A new \code{AxisConfiguration} object } } \if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-print}{}}} -\subsection{Method \code{print()}}{ -Print axis properties -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{AxisConfiguration$print()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -Axis properties -} -} -\if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-clone}{}}} \subsection{Method \code{clone()}}{ diff --git a/man/BackgroundConfiguration.Rd b/man/BackgroundConfiguration.Rd index 19709476..79c73f4f 100644 --- a/man/BackgroundConfiguration.Rd +++ b/man/BackgroundConfiguration.Rd @@ -6,16 +6,22 @@ \description{ R6 class defining the configuration of background } -\section{Public fields}{ -\if{html}{\out{
}} +\section{Active bindings}{ +\if{html}{\out{
}} \describe{ -\item{\code{outerBackground}}{R6 class \code{BackgroundElementConfiguration} object} +\item{\code{watermark}}{\code{Label} object} -\item{\code{innerBackground}}{R6 class \code{BackgroundElementConfiguration} object} +\item{\code{plot}}{\code{BackgroundElement} object} -\item{\code{grid}}{R6 class \code{BackgroundElementConfiguration} object} +\item{\code{panel}}{\code{BackgroundElement} object} -\item{\code{watermark}}{R6 class \code{Label} object defining watermark background} +\item{\code{xAxis}}{\code{LineElement} object} + +\item{\code{yAxis}}{\code{LineElement} object} + +\item{\code{xGrid}}{\code{LineElement} object} + +\item{\code{yGrid}}{\code{LineElement} object} } \if{html}{\out{
}} } @@ -23,8 +29,7 @@ R6 class defining the configuration of background \subsection{Public methods}{ \itemize{ \item \href{#method-new}{\code{BackgroundConfiguration$new()}} -\item \href{#method-print}{\code{BackgroundConfiguration$print()}} -\item \href{#method-setBackground}{\code{BackgroundConfiguration$setBackground()}} +\item \href{#method-updatePlot}{\code{BackgroundConfiguration$updatePlot()}} \item \href{#method-clone}{\code{BackgroundConfiguration$clone()}} } } @@ -35,29 +40,32 @@ R6 class defining the configuration of background Create a new \code{BackgroundConfiguration} object \subsection{Usage}{ \if{html}{\out{
}}\preformatted{BackgroundConfiguration$new( - outerBackground = NULL, - innerBackground = NULL, - grid = NULL, watermark = NULL, - watermarkFont = NULL, - theme = tlfEnv$currentTheme + plot = NULL, + panel = NULL, + xAxis = NULL, + yAxis = NULL, + xGrid = NULL, + yGrid = NULL )}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ -\item{\code{outerBackground}}{R6 class \code{BackgroundElementConfiguration} object} +\item{\code{watermark}}{\code{Label} object defining properties of watermark} -\item{\code{innerBackground}}{R6 class \code{BackgroundElementConfiguration} object} +\item{\code{plot}}{\code{BackgroundElement} object defining oustide plot background properties} -\item{\code{grid}}{R6 class \code{BackgroundElementConfiguration} object} +\item{\code{panel}}{\code{BackgroundElement} object defining panel (inside of plot) background properties} -\item{\code{watermark}}{R6 class \code{Label} object defining watermark background} +\item{\code{xAxis}}{\code{LineElement} object defining properties of x-axis} -\item{\code{watermarkFont}}{R6 class \code{Font} object defining watermark font} +\item{\code{yAxis}}{\code{LineElement} object defining properties of y-axis} -\item{\code{theme}}{R6 class \code{Theme} object} +\item{\code{xGrid}}{\code{LineElement} object defining properties of x-grid} + +\item{\code{yGrid}}{\code{LineElement} object defining properties of y-grid} } \if{html}{\out{
}} } @@ -66,25 +74,12 @@ A new \code{BackgroundConfiguration} object } } \if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-print}{}}} -\subsection{Method \code{print()}}{ -Print background properties -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{BackgroundConfiguration$print()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -Background properties -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-setBackground}{}}} -\subsection{Method \code{setBackground()}}{ -Set background properties of a \code{ggplot} object +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-updatePlot}{}}} +\subsection{Method \code{updatePlot()}}{ +Update background a \code{ggplot} object from \code{BackgroundConfiguration} properties \subsection{Usage}{ -\if{html}{\out{
}}\preformatted{BackgroundConfiguration$setBackground(plotObject)}\if{html}{\out{
}} +\if{html}{\out{
}}\preformatted{BackgroundConfiguration$updatePlot(plotObject)}\if{html}{\out{
}} } \subsection{Arguments}{ diff --git a/man/BackgroundElement.Rd b/man/BackgroundElement.Rd new file mode 100644 index 00000000..e97ae032 --- /dev/null +++ b/man/BackgroundElement.Rd @@ -0,0 +1,86 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/plotconfiguration-background.R +\name{BackgroundElement} +\alias{BackgroundElement} +\title{BackgroundElement} +\description{ +R6 class defining the properties of background elements +} +\section{Public fields}{ +\if{html}{\out{
}} +\describe{ +\item{\code{fill}}{character defining the color filling of the background element} + +\item{\code{color}}{character defining the color of the background element frame/line} + +\item{\code{size}}{numeric defining the size of the background element frame/line} + +\item{\code{linetype}}{character defining the size of the background element frame/line} +} +\if{html}{\out{
}} +} +\section{Methods}{ +\subsection{Public methods}{ +\itemize{ +\item \href{#method-new}{\code{BackgroundElement$new()}} +\item \href{#method-createPlotElement}{\code{BackgroundElement$createPlotElement()}} +\item \href{#method-clone}{\code{BackgroundElement$clone()}} +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-new}{}}} +\subsection{Method \code{new()}}{ +Create a new \code{BackgroundElement} object +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{BackgroundElement$new(fill = NULL, color = NULL, size = NULL, linetype = NULL)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{fill}}{character color filling of the background element} + +\item{\code{color}}{character color of the frame of the background element} + +\item{\code{size}}{character size of the frame of the background element} + +\item{\code{linetype}}{character linetype of the frame of the background element} +} +\if{html}{\out{
}} +} +\subsection{Returns}{ +A new \code{BackgroundElement} object +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-createPlotElement}{}}} +\subsection{Method \code{createPlotElement()}}{ +Create a \code{ggplot2::element_rect} directly usable by \code{ggplot2::theme}. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{BackgroundElement$createPlotElement()}\if{html}{\out{
}} +} + +\subsection{Returns}{ +An \code{element_rect} object. +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-clone}{}}} +\subsection{Method \code{clone()}}{ +The objects of this class are cloneable with this method. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{BackgroundElement$clone(deep = FALSE)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{deep}}{Whether to make a deep clone.} +} +\if{html}{\out{
}} +} +} +} diff --git a/man/BackgroundElementConfiguration.Rd b/man/BackgroundElementConfiguration.Rd deleted file mode 100644 index 21d8aebb..00000000 --- a/man/BackgroundElementConfiguration.Rd +++ /dev/null @@ -1,94 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/plotconfiguration-background.R -\name{BackgroundElementConfiguration} -\alias{BackgroundElementConfiguration} -\title{BackgroundElementConfiguration} -\description{ -R6 class defining the configuration of background elements -} -\section{Public fields}{ -\if{html}{\out{
}} -\describe{ -\item{\code{fill}}{character color filling of the background element} - -\item{\code{color}}{character color of the frame of the background element} - -\item{\code{size}}{character size of the frame of the background element} - -\item{\code{linetype}}{character linetype of the frame of the background element} -} -\if{html}{\out{
}} -} -\section{Methods}{ -\subsection{Public methods}{ -\itemize{ -\item \href{#method-new}{\code{BackgroundElementConfiguration$new()}} -\item \href{#method-print}{\code{BackgroundElementConfiguration$print()}} -\item \href{#method-clone}{\code{BackgroundElementConfiguration$clone()}} -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-new}{}}} -\subsection{Method \code{new()}}{ -Create a new \code{BackgroundElementConfiguration} object -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{BackgroundElementConfiguration$new( - fill = NULL, - color = NULL, - size = NULL, - linetype = NULL, - theme = NULL -)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{fill}}{character color filling of the background element} - -\item{\code{color}}{character color of the frame of the background element} - -\item{\code{size}}{character size of the frame of the background element} - -\item{\code{linetype}}{character linetype of the frame of the background element} - -\item{\code{theme}}{R6 class \code{Theme} object} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -A new \code{BackgroundElementConfiguration} object -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-print}{}}} -\subsection{Method \code{print()}}{ -Print background element properties -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{BackgroundElementConfiguration$print()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -Background element properties -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-clone}{}}} -\subsection{Method \code{clone()}}{ -The objects of this class are cloneable with this method. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{BackgroundElementConfiguration$clone(deep = FALSE)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{deep}}{Whether to make a deep clone.} -} -\if{html}{\out{
}} -} -} -} diff --git a/man/BoxWhiskerPlotConfiguration.Rd b/man/BoxWhiskerPlotConfiguration.Rd index a7767788..c8e9dba4 100644 --- a/man/BoxWhiskerPlotConfiguration.Rd +++ b/man/BoxWhiskerPlotConfiguration.Rd @@ -9,19 +9,23 @@ R6 class defining the configuration of a \code{ggplot} object \section{Super class}{ \code{\link[tlf:PlotConfiguration]{tlf::PlotConfiguration}} -> \code{BoxWhiskerPlotConfiguration} } +\section{Active bindings}{ +\if{html}{\out{
}} +\describe{ +\item{\code{outliers}}{logical defining if outliers should be included in boxplot} +} +\if{html}{\out{
}} +} \section{Methods}{ \subsection{Public methods}{ \itemize{ \item \href{#method-new}{\code{BoxWhiskerPlotConfiguration$new()}} -\item \href{#method-addBoxWhisker}{\code{BoxWhiskerPlotConfiguration$addBoxWhisker()}} -\item \href{#method-addOutliers}{\code{BoxWhiskerPlotConfiguration$addOutliers()}} \item \href{#method-clone}{\code{BoxWhiskerPlotConfiguration$clone()}} } } \if{html}{ \out{
Inherited methods} \itemize{ -\item \out{}\href{../../tlf/html/PlotConfiguration.html#method-print}{\code{tlf::PlotConfiguration$print()}}\out{} } \out{
} } @@ -29,82 +33,31 @@ R6 class defining the configuration of a \code{ggplot} object \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-new}{}}} \subsection{Method \code{new()}}{ -Create a new \code{BoxWhiskerPlotConfiguration} object -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{BoxWhiskerPlotConfiguration$new(...)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{...}}{parameters inherited from \code{PlotConfiguration}} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -A new \code{BoxWhiskerPlotConfiguration} object -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-addBoxWhisker}{}}} -\subsection{Method \code{addBoxWhisker()}}{ -Add a boxplot layer to a \code{ggplot} object +Create a new \code{PKRatioPlotConfiguration} object \subsection{Usage}{ -\if{html}{\out{
}}\preformatted{BoxWhiskerPlotConfiguration$addBoxWhisker( - plotObject, - data, - metaData, - dataMapping +\if{html}{\out{
}}\preformatted{BoxWhiskerPlotConfiguration$new( + outliers = TRUE, + ribbons = NULL, + points = NULL, + ... )}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ -\item{\code{plotObject}}{a \code{ggplot} object} +\item{\code{outliers}}{logical defining if outliers should be included in boxplot} -\item{\code{data}}{data.frame} +\item{\code{ribbons}}{\code{ThemeAestheticSelections} object defining properties for boxes of boxplot} -\item{\code{metaData}}{list of information on \code{data}} +\item{\code{points}}{\code{ThemeAestheticSelections} object defining properties for outlier scatter points} -\item{\code{dataMapping}}{R6 class \code{BoxWhiskerDataMapping}} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -A \code{ggplot} object -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-addOutliers}{}}} -\subsection{Method \code{addOutliers()}}{ -Add a outlier points layer to a \code{ggplot} object -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{BoxWhiskerPlotConfiguration$addOutliers( - plotObject, - data, - metaData, - dataMapping -)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{plotObject}}{a \code{ggplot} object} - -\item{\code{data}}{data.frame} - -\item{\code{metaData}}{list of information on \code{data}} - -\item{\code{dataMapping}}{R6 class \code{BoxWhiskerDataMapping}} +\item{\code{...}}{parameters inherited from \code{PlotConfiguration}} } \if{html}{\out{
}} } \subsection{Returns}{ -A \code{ggplot} object +A new \code{PKRatioPlotConfiguration} object } } \if{html}{\out{
}} diff --git a/man/ColorMaps.Rd b/man/ColorMaps.Rd new file mode 100644 index 00000000..0dd2ef34 --- /dev/null +++ b/man/ColorMaps.Rd @@ -0,0 +1,16 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utilities-aesthetics.R +\docType{data} +\name{ColorMaps} +\alias{ColorMaps} +\title{ColorMaps} +\format{ +An object of class \code{list} of length 5. +} +\usage{ +ColorMaps +} +\description{ +List with some color maps for \code{Theme} object +} +\keyword{datasets} diff --git a/man/DDIComparisonTypes.Rd b/man/DDIComparisonTypes.Rd new file mode 100644 index 00000000..a40d5b2c --- /dev/null +++ b/man/DDIComparisonTypes.Rd @@ -0,0 +1,16 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utilities-mapping.R +\docType{data} +\name{DDIComparisonTypes} +\alias{DDIComparisonTypes} +\title{DDIComparisonTypes} +\format{ +An object of class \code{list} of length 2. +} +\usage{ +DDIComparisonTypes +} +\description{ +Options for comparison: residuals vs pred or obs vs pred +} +\keyword{datasets} diff --git a/man/DDIRatioDataMapping.Rd b/man/DDIRatioDataMapping.Rd index d84cb02d..420de7ed 100644 --- a/man/DDIRatioDataMapping.Rd +++ b/man/DDIRatioDataMapping.Rd @@ -7,16 +7,14 @@ R6 class for mapping \code{x}, \code{y}, \code{GroupMapping} and \code{ddiRatioLines} variables to \code{data} } \section{Super classes}{ -\code{\link[tlf:XYDataMapping]{tlf::XYDataMapping}} -> \code{\link[tlf:XYGDataMapping]{tlf::XYGDataMapping}} -> \code{DDIRatioDataMapping} +\code{\link[tlf:XYDataMapping]{tlf::XYDataMapping}} -> \code{\link[tlf:XYGDataMapping]{tlf::XYGDataMapping}} -> \code{\link[tlf:PKRatioDataMapping]{tlf::PKRatioDataMapping}} -> \code{DDIRatioDataMapping} } \section{Public fields}{ \if{html}{\out{
}} \describe{ -\item{\code{ddiRatioLines}}{numeric vector of ratio limits to plot} +\item{\code{comparisonType}}{Options for comparison from enum \code{MappingComparisonTypes}} -\item{\code{deltaGuest}}{numeric value of Guest et al ratio limits} - -\item{\code{range}}{2 elements vector of x limits} +\item{\code{minRange}}{Mininmum range for guest and ratio lines} } \if{html}{\out{
}} } @@ -32,7 +30,7 @@ R6 class for mapping \code{x}, \code{y}, \code{GroupMapping} and \code{ddiRatioL \if{html}{ \out{
Inherited methods} \itemize{ -\item \out{}\href{../../tlf/html/XYGDataMapping.html#method-checkMapData}{\code{tlf::XYGDataMapping$checkMapData()}}\out{} +\item \out{}\href{../../tlf/html/PKRatioDataMapping.html#method-checkMapData}{\code{tlf::PKRatioDataMapping$checkMapData()}}\out{} } \out{
} } @@ -43,8 +41,9 @@ R6 class for mapping \code{x}, \code{y}, \code{GroupMapping} and \code{ddiRatioL Create a new \code{DDIRatioDataMapping} object \subsection{Usage}{ \if{html}{\out{
}}\preformatted{DDIRatioDataMapping$new( - ddiRatioValues = DefaultDataMappingValues$ddiRatio, - range = c(0.01, 100), + comparisonType = DDIComparisonTypes$obsVsPred, + minRange = c(0.01, 100), + lines = DefaultDataMappingValues$ddiRatio, ... )}\if{html}{\out{
}} } @@ -52,11 +51,13 @@ Create a new \code{DDIRatioDataMapping} object \subsection{Arguments}{ \if{html}{\out{
}} \describe{ -\item{\code{ddiRatioValues}}{list of values for ratio and guest limits to plot} +\item{\code{comparisonType}}{Options for comparison from enum \code{DDIComparisonTypes}} + +\item{\code{minRange}}{Mininmum range for guest and ratio lines} -\item{\code{range}}{2 elements vector of x limits} +\item{\code{lines}}{list of ratio and guest limits to plot as horizontal lines} -\item{\code{...}}{parameters inherited from \code{XYGDataMapping}} +\item{\code{...}}{parameters inherited from \code{PKRatioDataMapping}} } \if{html}{\out{
}} } diff --git a/man/DDIRatioPlotConfiguration.Rd b/man/DDIRatioPlotConfiguration.Rd index fb59b27b..8f352c5a 100644 --- a/man/DDIRatioPlotConfiguration.Rd +++ b/man/DDIRatioPlotConfiguration.Rd @@ -6,56 +6,23 @@ \description{ R6 class defining the configuration of a \code{ggplot} object for DDI Ratio plots } -\section{Super class}{ -\code{\link[tlf:PlotConfiguration]{tlf::PlotConfiguration}} -> \code{DDIRatioPlotConfiguration} -} -\section{Public fields}{ -\if{html}{\out{
}} -\describe{ -\item{\code{ddiRatioCaption}}{list of properties for DDI ratio plot specific features} -} -\if{html}{\out{
}} +\section{Super classes}{ +\code{\link[tlf:PlotConfiguration]{tlf::PlotConfiguration}} -> \code{\link[tlf:PKRatioPlotConfiguration]{tlf::PKRatioPlotConfiguration}} -> \code{DDIRatioPlotConfiguration} } \section{Methods}{ \subsection{Public methods}{ \itemize{ -\item \href{#method-new}{\code{DDIRatioPlotConfiguration$new()}} \item \href{#method-clone}{\code{DDIRatioPlotConfiguration$clone()}} } } \if{html}{ \out{
Inherited methods} \itemize{ -\item \out{}\href{../../tlf/html/PlotConfiguration.html#method-print}{\code{tlf::PlotConfiguration$print()}}\out{} +\item \out{}\href{../../tlf/html/PKRatioPlotConfiguration.html#method-initialize}{\code{tlf::PKRatioPlotConfiguration$initialize()}}\out{} } \out{
} } \if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-new}{}}} -\subsection{Method \code{new()}}{ -Create a new \code{DDIRatioPlotConfiguration} object -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{DDIRatioPlotConfiguration$new( - ddiRatioCaption = getDefaultCaptionFor("ddiRatio"), - ... -)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{ddiRatioCaption}}{list of properties for DDI ratio plot specific features} - -\item{\code{...}}{parameters inherited from \code{PlotConfiguration}} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -A new \code{DDIRatioPlotConfiguration} object -} -} -\if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-clone}{}}} \subsection{Method \code{clone()}}{ diff --git a/man/Font.Rd b/man/Font.Rd index f6b9e9de..870e00b3 100644 --- a/man/Font.Rd +++ b/man/Font.Rd @@ -4,18 +4,20 @@ \alias{Font} \title{Font} \description{ -R6 class defining \code{size}, \code{color}, \code{fontFamily}, \code{fontFace} of font +R6 class defining font properties } \section{Public fields}{ \if{html}{\out{
}} \describe{ -\item{\code{size}}{numeric size of font} +\item{\code{size}}{numeric defining the size of font} -\item{\code{color}}{character color of font} +\item{\code{color}}{character defining the color of font} -\item{\code{fontFamily}}{character family of font} +\item{\code{fontFamily}}{character defining the family of font} -\item{\code{fontFace}}{character face of font} +\item{\code{fontFace}}{character defining the face of font} + +\item{\code{angle}}{numeric defining the angle of font} } \if{html}{\out{
}} } @@ -23,8 +25,7 @@ R6 class defining \code{size}, \code{color}, \code{fontFamily}, \code{fontFace} \subsection{Public methods}{ \itemize{ \item \href{#method-new}{\code{Font$new()}} -\item \href{#method-print}{\code{Font$print()}} -\item \href{#method-setFont}{\code{Font$setFont()}} +\item \href{#method-createPlotFont}{\code{Font$createPlotFont()}} \item \href{#method-clone}{\code{Font$clone()}} } } @@ -36,19 +37,27 @@ Create a new \code{Font} object. Default font properties are defined directly in the object field, so \code{NULL} input is allowed will lead to default properties. \subsection{Usage}{ -\if{html}{\out{
}}\preformatted{Font$new(size = NULL, color = NULL, fontFamily = NULL, fontFace = NULL)}\if{html}{\out{
}} +\if{html}{\out{
}}\preformatted{Font$new( + size = NULL, + color = NULL, + fontFamily = NULL, + fontFace = NULL, + angle = NULL +)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ -\item{\code{size}}{numeric size of font} +\item{\code{size}}{numeric defining the size of font} + +\item{\code{color}}{character defining the color of font} -\item{\code{color}}{character color of font} +\item{\code{fontFamily}}{character defining the family of font} -\item{\code{fontFamily}}{character family of font} +\item{\code{fontFace}}{character defining the face of font} -\item{\code{fontFace}}{character face of font} +\item{\code{angle}}{numeric defining the angle of font} } \if{html}{\out{
}} } @@ -57,26 +66,16 @@ A new \code{Font} object } } \if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-print}{}}} -\subsection{Method \code{print()}}{ -Print \code{Font} properties. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{Font$print()}\if{html}{\out{
}} -} - -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-setFont}{}}} -\subsection{Method \code{setFont()}}{ -Create an \code{element_text} for ggplot with \code{Font} properties. +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-createPlotFont}{}}} +\subsection{Method \code{createPlotFont()}}{ +Create a \code{ggplot2::element_text} directly convertible by \code{ggplot2::theme}. \subsection{Usage}{ -\if{html}{\out{
}}\preformatted{Font$setFont()}\if{html}{\out{
}} +\if{html}{\out{
}}\preformatted{Font$createPlotFont()}\if{html}{\out{
}} } \subsection{Returns}{ -An \code{element_text} for ggplot with \code{Font} properties. +An \code{element_text} object. } } \if{html}{\out{
}} diff --git a/man/HistogramDataMapping.Rd b/man/HistogramDataMapping.Rd index 29f22fbf..edebb4f3 100644 --- a/man/HistogramDataMapping.Rd +++ b/man/HistogramDataMapping.Rd @@ -13,13 +13,15 @@ R6 class for mapping \code{x}, \code{verticalLineGroupings}, \section{Public fields}{ \if{html}{\out{
}} \describe{ -\item{\code{verticalLineGroupings}}{R6 class \code{Grouping} variable} +\item{\code{stack}}{logical defining if histogram bars should be stacked} -\item{\code{verticalLineFunctionNames}}{Vector of function name -to be indicated in captions of the histogram} +\item{\code{bins}}{number of bins or binning values/methods passed on \code{ggplot2::geom_histogram}} -\item{\code{verticalLineFunctions}}{List of functions calculated on \code{data} -to obtain vertical lines on the histogram} +\item{\code{lines}}{values or functions to define vertical lines} + +\item{\code{fitNormalDist}}{logical defining if a normal distribution should be fitted} + +\item{\code{fitDensity}}{logical defining if a density distribution function should be fitted} } \if{html}{\out{
}} } @@ -44,9 +46,11 @@ to obtain vertical lines on the histogram} Create a new \code{HistogramDataMapping} object \subsection{Usage}{ \if{html}{\out{
}}\preformatted{HistogramDataMapping$new( - verticalLineGroupings = NULL, - verticalLineFunctionNames = c("mean", "median"), - verticalLineFunctions = c(mean, median), + stack = FALSE, + bins = NULL, + lines = DefaultDataMappingValues$histogram, + fitNormalDist = FALSE, + fitDensity = FALSE, ... )}\if{html}{\out{
}} } @@ -54,13 +58,15 @@ Create a new \code{HistogramDataMapping} object \subsection{Arguments}{ \if{html}{\out{
}} \describe{ -\item{\code{verticalLineGroupings}}{R6 class \code{Grouping} variable} +\item{\code{stack}}{logical defining if histogram bars should be stacked} + +\item{\code{bins}}{argument passed on \code{ggplot2::geom_histogram}} + +\item{\code{lines}}{values or functions to define vertical lines} -\item{\code{verticalLineFunctionNames}}{Vector of function name to be indicated in captions of the histogram -Default value uses \code{mean} and \code{median}.} +\item{\code{fitNormalDist}}{logical defining if a normal distribution should be fitted} -\item{\code{verticalLineFunctions}}{List of functions calculated on \code{data} -Default value uses \code{mean} and \code{median}.} +\item{\code{fitDensity}}{logical defining if a density distribution should be fitted} \item{\code{...}}{parameters inherited from \code{XYGDataMapping}} } diff --git a/man/HistogramPlotConfiguration.Rd b/man/HistogramPlotConfiguration.Rd index 9f8c6406..232a6081 100644 --- a/man/HistogramPlotConfiguration.Rd +++ b/man/HistogramPlotConfiguration.Rd @@ -9,22 +9,10 @@ R6 class defining the configuration of a \code{ggplot} object for histograms \section{Super class}{ \code{\link[tlf:PlotConfiguration]{tlf::PlotConfiguration}} -> \code{HistogramPlotConfiguration} } -\section{Public fields}{ -\if{html}{\out{
}} -\describe{ -\item{\code{mapData}}{data.frame after dataMapping} - -\item{\code{bins}}{numeric vector of bin edges} - -\item{\code{binWidth}}{numeric value of bin width} -} -\if{html}{\out{
}} -} \section{Methods}{ \subsection{Public methods}{ \itemize{ \item \href{#method-new}{\code{HistogramPlotConfiguration$new()}} -\item \href{#method-addHistograms}{\code{HistogramPlotConfiguration$addHistograms()}} \item \href{#method-addVerticalLines}{\code{HistogramPlotConfiguration$addVerticalLines()}} \item \href{#method-clone}{\code{HistogramPlotConfiguration$clone()}} } @@ -32,7 +20,6 @@ R6 class defining the configuration of a \code{ggplot} object for histograms \if{html}{ \out{
Inherited methods} \itemize{ -\item \out{}\href{../../tlf/html/PlotConfiguration.html#method-print}{\code{tlf::PlotConfiguration$print()}}\out{} } \out{
} } @@ -40,61 +27,31 @@ R6 class defining the configuration of a \code{ggplot} object for histograms \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-new}{}}} \subsection{Method \code{new()}}{ -Create a new \code{TimeProfilePlotConfiguration} object +Create a new \code{HistogramPlotConfiguration} object \subsection{Usage}{ -\if{html}{\out{
}}\preformatted{HistogramPlotConfiguration$new(binWidth = NULL, bins = NULL, ...)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{binWidth}}{numeric value of bin width} - -\item{\code{bins}}{numeric vector of bin edges} - -\item{\code{...}}{parameters inherited from \code{PlotConfiguration}} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -A new \code{TimeProfilePlotConfiguration} object -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-addHistograms}{}}} -\subsection{Method \code{addHistograms()}}{ -Add histogram as histogram layer to a \code{ggplot} object -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{HistogramPlotConfiguration$addHistograms( - plotObject, - data, - metaData = NULL, - dataMapping, - binWidth = NULL, - bins = NULL +\if{html}{\out{
}}\preformatted{HistogramPlotConfiguration$new( + lines = NULL, + ribbons = NULL, + ylabel = "Count", + ... )}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ -\item{\code{plotObject}}{\code{ggplot} object} - -\item{\code{data}}{data.frame} - -\item{\code{metaData}}{list of information on \code{data}} +\item{\code{lines}}{\code{ThemeAestheticSelections} object defining properties for vertical lines} -\item{\code{dataMapping}}{R6 class \code{HistogramDataMapping}} +\item{\code{ribbons}}{\code{ThemeAestheticSelections} object defining properties for histogram} -\item{\code{binWidth}}{numeric value of bin width} +\item{\code{ylabel}}{Histograms default display is "Count"} -\item{\code{bins}}{numeric vector of bin edges} +\item{\code{...}}{parameters inherited from \code{PlotConfiguration}} } \if{html}{\out{
}} } \subsection{Returns}{ -A \code{ggplot} object with histogram +A new \code{TimeProfilePlotConfiguration} object } } \if{html}{\out{
}} diff --git a/man/Label.Rd b/man/Label.Rd index 2f607414..01920c00 100644 --- a/man/Label.Rd +++ b/man/Label.Rd @@ -6,12 +6,12 @@ \description{ R6 class defining \code{text} and \code{font} of label } -\section{Public fields}{ -\if{html}{\out{
}} +\section{Active bindings}{ +\if{html}{\out{
}} \describe{ -\item{\code{text}}{character text of label} +\item{\code{text}}{character text of the label} -\item{\code{font}}{R6 class \code{Font} object} +\item{\code{font}}{\code{Font} object} } \if{html}{\out{
}} } @@ -19,8 +19,7 @@ R6 class defining \code{text} and \code{font} of label \subsection{Public methods}{ \itemize{ \item \href{#method-new}{\code{Label$new()}} -\item \href{#method-print}{\code{Label$print()}} -\item \href{#method-setFontProperties}{\code{Label$setFontProperties()}} +\item \href{#method-createPlotFont}{\code{Label$createPlotFont()}} \item \href{#method-clone}{\code{Label$clone()}} } } @@ -36,24 +35,27 @@ Create a new \code{Label} object. color = NULL, size = NULL, fontFace = NULL, - fontFamily = NULL + fontFamily = NULL, + angle = NULL )}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ -\item{\code{text}}{character text of label} +\item{\code{text}}{character text of the \code{Label} object} -\item{\code{font}}{R6 class \code{Font} object} +\item{\code{font}}{\code{Font} object defining the font of the \code{Label} object} -\item{\code{color}}{character color of font} +\item{\code{color}}{character defining the color of the \code{Label} object} -\item{\code{size}}{numeric size of font} +\item{\code{size}}{numeric defining the size of the \code{Label} object} -\item{\code{fontFace}}{character face of font} +\item{\code{fontFace}}{character defining the font face of the \code{Label} object} -\item{\code{fontFamily}}{character family of font} +\item{\code{fontFamily}}{character defining the font family of the \code{Label} object} + +\item{\code{angle}}{numeric defining the angle of the \code{Label} object} } \if{html}{\out{
}} } @@ -62,41 +64,16 @@ A new \code{Label} object } } \if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-print}{}}} -\subsection{Method \code{print()}}{ -Print \code{Label} properties. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{Label$print()}\if{html}{\out{
}} -} - -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-setFontProperties}{}}} -\subsection{Method \code{setFontProperties()}}{ -Set font properties of Label +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-createPlotFont}{}}} +\subsection{Method \code{createPlotFont()}}{ +Create a \code{ggplot2::element_text} directly convertible by \code{ggplot2::theme}. \subsection{Usage}{ -\if{html}{\out{
}}\preformatted{Label$setFontProperties( - color = self$font$color, - size = self$font$size, - fontFamily = self$font$fontFamily, - fontFace = self$font$fontFace -)}\if{html}{\out{
}} +\if{html}{\out{
}}\preformatted{Label$createPlotFont()}\if{html}{\out{
}} } -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{color}}{character color of font} - -\item{\code{size}}{numeric size of font} - -\item{\code{fontFamily}}{character family of font} - -\item{\code{fontFace}}{character face of font} -} -\if{html}{\out{
}} +\subsection{Returns}{ +An \code{element_text} or \code{element_blank}object. } } \if{html}{\out{
}} diff --git a/man/LabelConfiguration.Rd b/man/LabelConfiguration.Rd index 3c59c6e7..2aadb3b8 100644 --- a/man/LabelConfiguration.Rd +++ b/man/LabelConfiguration.Rd @@ -6,16 +6,16 @@ \description{ R6 class defining the configuration of the labels of a \code{ggplot} object } -\section{Public fields}{ -\if{html}{\out{
}} +\section{Active bindings}{ +\if{html}{\out{
}} \describe{ -\item{\code{title}}{R6 class \code{Label} object} +\item{\code{title}}{\code{Label} object defining the title of the plot} -\item{\code{subtitle}}{R6 class \code{Label} object} +\item{\code{subtitle}}{\code{Label} object defining the subtitle of the plot} -\item{\code{xlabel}}{R6 class \code{Label} object} +\item{\code{xlabel}}{\code{Label} object defining the xlabel of the plot} -\item{\code{ylabel}}{R6 class \code{Label} object} +\item{\code{ylabel}}{\code{Label} object defining the ylabel of the plot} } \if{html}{\out{
}} } @@ -23,8 +23,7 @@ R6 class defining the configuration of the labels of a \code{ggplot} object \subsection{Public methods}{ \itemize{ \item \href{#method-new}{\code{LabelConfiguration$new()}} -\item \href{#method-setPlotLabels}{\code{LabelConfiguration$setPlotLabels()}} -\item \href{#method-print}{\code{LabelConfiguration$print()}} +\item \href{#method-updatePlot}{\code{LabelConfiguration$updatePlot()}} \item \href{#method-clone}{\code{LabelConfiguration$clone()}} } } @@ -38,23 +37,20 @@ Create a new \code{LabelConfiguration} object title = NULL, subtitle = NULL, xlabel = NULL, - ylabel = NULL, - theme = tlfEnv$currentTheme + ylabel = NULL )}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ -\item{\code{title}}{R6 class \code{Label} object} +\item{\code{title}}{character or \code{Label} object defining title} -\item{\code{subtitle}}{R6 class \code{Label} object} +\item{\code{subtitle}}{character or \code{Label} object defining subtitle} -\item{\code{xlabel}}{R6 class \code{Label} object} +\item{\code{xlabel}}{character or \code{Label} object defining xlabel} -\item{\code{ylabel}}{R6 class \code{Label} object} - -\item{\code{theme}}{R6 class \code{Theme}} +\item{\code{ylabel}}{character or \code{Label} object defining ylabel} } \if{html}{\out{
}} } @@ -63,12 +59,12 @@ A new \code{LabelConfiguration} object } } \if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-setPlotLabels}{}}} -\subsection{Method \code{setPlotLabels()}}{ -Set plot labels properties of a \code{ggplot} object +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-updatePlot}{}}} +\subsection{Method \code{updatePlot()}}{ +Update labels of a \code{ggplot} object and their properties \subsection{Usage}{ -\if{html}{\out{
}}\preformatted{LabelConfiguration$setPlotLabels(plotObject)}\if{html}{\out{
}} +\if{html}{\out{
}}\preformatted{LabelConfiguration$updatePlot(plotObject)}\if{html}{\out{
}} } \subsection{Arguments}{ @@ -83,19 +79,6 @@ A \code{ggplot} object } } \if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-print}{}}} -\subsection{Method \code{print()}}{ -Print plot label properties -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{LabelConfiguration$print()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -Plot label properties -} -} -\if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-clone}{}}} \subsection{Method \code{clone()}}{ diff --git a/man/LegendConfiguration.Rd b/man/LegendConfiguration.Rd index 5f5bc35d..72e14b77 100644 --- a/man/LegendConfiguration.Rd +++ b/man/LegendConfiguration.Rd @@ -6,14 +6,20 @@ \description{ R6 class defining the legend configuration of a \code{ggplot} object } -\section{Public fields}{ -\if{html}{\out{
}} +\section{Active bindings}{ +\if{html}{\out{
}} \describe{ -\item{\code{position}}{character position of the legend} +\item{\code{caption}}{of legend defined as data.frame with caption properties} -\item{\code{title}}{character name of the legend} +\item{\code{position}}{of legend as defined in Enum \code{LegendPositions}} -\item{\code{caption}}{data.frame with} +\item{\code{font}}{\code{Font} object defining the font of the legend} + +\item{\code{titleFont}}{\code{Font} object defining the font of the legend title} + +\item{\code{background}}{\code{Background} object defining the background of the legend} + +\item{\code{title}}{character defining title of the legend} } \if{html}{\out{
}} } @@ -21,7 +27,7 @@ R6 class defining the legend configuration of a \code{ggplot} object \subsection{Public methods}{ \itemize{ \item \href{#method-new}{\code{LegendConfiguration$new()}} -\item \href{#method-print}{\code{LegendConfiguration$print()}} +\item \href{#method-updatePlot}{\code{LegendConfiguration$updatePlot()}} \item \href{#method-clone}{\code{LegendConfiguration$clone()}} } } @@ -32,22 +38,29 @@ R6 class defining the legend configuration of a \code{ggplot} object Create a new \code{LegendConfiguration} object \subsection{Usage}{ \if{html}{\out{
}}\preformatted{LegendConfiguration$new( - position = tlfEnv$defaultLegendPosition, + position = NULL, + caption = NULL, title = NULL, - caption = NULL + titleFont = NULL, + font = NULL, + background = NULL )}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ -\item{\code{position}}{character position of the legend. -Use enum \code{LegendPositions} to assess available legend positions.} +\item{\code{position}}{position of the legend as defined by enum \code{LegendPositions}} + +\item{\code{caption}}{data.frame containing the properties of the legend caption} + +\item{\code{title}}{character title of the legend caption. A value of \code{NULL} removes the title.} + +\item{\code{titleFont}}{\code{Font} object defining the font of the legend title} -\item{\code{title}}{character title of the legend caption. -Default \code{NULL} does not provide any legend title.} +\item{\code{font}}{\code{Font} object defining the font of the legend caption} -\item{\code{caption}}{data.frame containing the legend caption properties} +\item{\code{background}}{\code{BackgroundElement} object defining the background of the legend} } \if{html}{\out{
}} } @@ -56,16 +69,23 @@ A new \code{LegendConfiguration} object } } \if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-print}{}}} -\subsection{Method \code{print()}}{ -Print legend properties +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-updatePlot}{}}} +\subsection{Method \code{updatePlot()}}{ +Update legend configuration on a \code{ggplot} object \subsection{Usage}{ -\if{html}{\out{
}}\preformatted{LegendConfiguration$print()}\if{html}{\out{
}} +\if{html}{\out{
}}\preformatted{LegendConfiguration$updatePlot(plotObject)}\if{html}{\out{
}} } +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{plotObject}}{\code{ggplot} object} +} +\if{html}{\out{
}} +} \subsection{Returns}{ -Legend properties +A \code{ggplot} object with updated axis properties } } \if{html}{\out{
}} diff --git a/man/LineElement.Rd b/man/LineElement.Rd new file mode 100644 index 00000000..35f059b0 --- /dev/null +++ b/man/LineElement.Rd @@ -0,0 +1,56 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/plotconfiguration-background.R +\name{LineElement} +\alias{LineElement} +\title{LineElement} +\description{ +R6 class defining the properties of background line elements +} +\section{Super class}{ +\code{\link[tlf:BackgroundElement]{tlf::BackgroundElement}} -> \code{LineElement} +} +\section{Methods}{ +\subsection{Public methods}{ +\itemize{ +\item \href{#method-createPlotElement}{\code{LineElement$createPlotElement()}} +\item \href{#method-clone}{\code{LineElement$clone()}} +} +} +\if{html}{ +\out{
Inherited methods} +\itemize{ +\item \out{}\href{../../tlf/html/BackgroundElement.html#method-initialize}{\code{tlf::BackgroundElement$initialize()}}\out{} +} +\out{
} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-createPlotElement}{}}} +\subsection{Method \code{createPlotElement()}}{ +Create a \code{ggplot2::element_line} directly usable by \code{ggplot2::theme}. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{LineElement$createPlotElement()}\if{html}{\out{
}} +} + +\subsection{Returns}{ +An \code{element_line} object. +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-clone}{}}} +\subsection{Method \code{clone()}}{ +The objects of this class are cloneable with this method. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{LineElement$clone(deep = FALSE)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{deep}}{Whether to make a deep clone.} +} +\if{html}{\out{
}} +} +} +} diff --git a/man/Linetypes.Rd b/man/Linetypes.Rd new file mode 100644 index 00000000..2348ea0e --- /dev/null +++ b/man/Linetypes.Rd @@ -0,0 +1,16 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utilities-aesthetics.R +\docType{data} +\name{Linetypes} +\alias{Linetypes} +\title{Linetypes} +\format{ +An object of class \code{list} of length 7. +} +\usage{ +Linetypes +} +\description{ +Enum of \code{ggplot2} linetypes +} +\keyword{datasets} diff --git a/man/ObsVsPredDataMapping.Rd b/man/ObsVsPredDataMapping.Rd index 377f23b7..a0d14e51 100644 --- a/man/ObsVsPredDataMapping.Rd +++ b/man/ObsVsPredDataMapping.Rd @@ -7,18 +7,16 @@ R6 class for mapping \code{x}, \code{y}, \code{GroupMapping} and \code{obsVsPredLines} variables to \code{data} } \section{Super classes}{ -\code{\link[tlf:XYDataMapping]{tlf::XYDataMapping}} -> \code{\link[tlf:XYGDataMapping]{tlf::XYGDataMapping}} -> \code{ObsVsPredDataMapping} +\code{\link[tlf:XYDataMapping]{tlf::XYDataMapping}} -> \code{\link[tlf:XYGDataMapping]{tlf::XYGDataMapping}} -> \code{\link[tlf:ObservedDataMapping]{tlf::ObservedDataMapping}} -> \code{ObsVsPredDataMapping} } \section{Public fields}{ \if{html}{\out{
}} \describe{ -\item{\code{obsVsPredValues}}{numeric vector of limits to plot} +\item{\code{lines}}{list of lines to plot} -\item{\code{lloq}}{numeric value of lower limit of quantification} +\item{\code{minRange}}{Mininmum range for the lines} \item{\code{smoother}}{regression function name} - -\item{\code{range}}{2 elements vector of x limits} } \if{html}{\out{
}} } @@ -26,14 +24,13 @@ R6 class for mapping \code{x}, \code{y}, \code{GroupMapping} and \code{obsVsPred \subsection{Public methods}{ \itemize{ \item \href{#method-new}{\code{ObsVsPredDataMapping$new()}} -\item \href{#method-getObsVsPredLines}{\code{ObsVsPredDataMapping$getObsVsPredLines()}} \item \href{#method-clone}{\code{ObsVsPredDataMapping$clone()}} } } \if{html}{ \out{
Inherited methods} \itemize{ -\item \out{}\href{../../tlf/html/XYGDataMapping.html#method-checkMapData}{\code{tlf::XYGDataMapping$checkMapData()}}\out{} +\item \out{}\href{../../tlf/html/ObservedDataMapping.html#method-checkMapData}{\code{tlf::ObservedDataMapping$checkMapData()}}\out{} } \out{
} } @@ -44,9 +41,8 @@ R6 class for mapping \code{x}, \code{y}, \code{GroupMapping} and \code{obsVsPred Create a new \code{ObsVsPredDataMapping} object \subsection{Usage}{ \if{html}{\out{
}}\preformatted{ObsVsPredDataMapping$new( - obsVsPredValues = DefaultDataMappingValues$obsVsPred, - lloq = NULL, - range = NULL, + lines = DefaultDataMappingValues$obsVsPred, + minRange = NULL, smoother = NULL, ... )}\if{html}{\out{
}} @@ -55,11 +51,9 @@ Create a new \code{ObsVsPredDataMapping} object \subsection{Arguments}{ \if{html}{\out{
}} \describe{ -\item{\code{obsVsPredValues}}{list of values for obs vs pred plot} - -\item{\code{lloq}}{numeric value of lower limit of quantification} +\item{\code{lines}}{list of lines to plot} -\item{\code{range}}{2 elements vector of x limits} +\item{\code{minRange}}{Mininmum range for guest and ratio lines} \item{\code{smoother}}{smoother function or parameter To map a loess smoother to the plot, use \code{smoother}="loess"} @@ -73,28 +67,6 @@ A new \code{ObsVsPredDataMapping} object } } \if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-getObsVsPredLines}{}}} -\subsection{Method \code{getObsVsPredLines()}}{ -Create a data.frame with of limits to plot -This data.frame is necessary in case if log-log plots as -\code{geom_abline} doesn't work properly in log scale -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{ObsVsPredDataMapping$getObsVsPredLines(data)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{data}}{data.frame of data} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -A data.frame -} -} -\if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-clone}{}}} \subsection{Method \code{clone()}}{ diff --git a/man/ObsVsPredPlotConfiguration.Rd b/man/ObsVsPredPlotConfiguration.Rd index bdf58cbc..fd423b02 100644 --- a/man/ObsVsPredPlotConfiguration.Rd +++ b/man/ObsVsPredPlotConfiguration.Rd @@ -9,26 +9,16 @@ R6 class defining the configuration of a \code{ggplot} object for Obs vs Pred pl \section{Super class}{ \code{\link[tlf:PlotConfiguration]{tlf::PlotConfiguration}} -> \code{ObsVsPredPlotConfiguration} } -\section{Public fields}{ -\if{html}{\out{
}} -\describe{ -\item{\code{obsVsPredCaption}}{list of properties for obs vs pred plot specific features} -} -\if{html}{\out{
}} -} \section{Methods}{ \subsection{Public methods}{ \itemize{ \item \href{#method-new}{\code{ObsVsPredPlotConfiguration$new()}} -\item \href{#method-addSmoother}{\code{ObsVsPredPlotConfiguration$addSmoother()}} -\item \href{#method-addObsVsPred}{\code{ObsVsPredPlotConfiguration$addObsVsPred()}} \item \href{#method-clone}{\code{ObsVsPredPlotConfiguration$clone()}} } } \if{html}{ \out{
Inherited methods} \itemize{ -\item \out{}\href{../../tlf/html/PlotConfiguration.html#method-print}{\code{tlf::PlotConfiguration$print()}}\out{} } \out{
} } @@ -39,7 +29,9 @@ R6 class defining the configuration of a \code{ggplot} object for Obs vs Pred pl Create a new \code{ObsVsPredPlotConfiguration} object \subsection{Usage}{ \if{html}{\out{
}}\preformatted{ObsVsPredPlotConfiguration$new( - obsVsPredCaption = getDefaultCaptionFor("obsVsPred"), + lines = NULL, + points = NULL, + errorbars = NULL, ... )}\if{html}{\out{
}} } @@ -47,71 +39,18 @@ Create a new \code{ObsVsPredPlotConfiguration} object \subsection{Arguments}{ \if{html}{\out{
}} \describe{ -\item{\code{obsVsPredCaption}}{list of properties for DDI ratio plot specific features} - -\item{\code{...}}{parameters inherited from \code{PlotConfiguration}} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -A new \code{obsVsPredProperties} object -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-addSmoother}{}}} -\subsection{Method \code{addSmoother()}}{ -Add smoother layer to a \code{ggplot} object -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{ObsVsPredPlotConfiguration$addSmoother(plotObject, data, metaData, dataMapping)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{plotObject}}{\code{ggplot} object} +\item{\code{lines}}{\code{ThemeAestheticSelections} object defining properties for lines} -\item{\code{data}}{data.frame} +\item{\code{points}}{\code{ThemeAestheticSelections} object defining properties for scatter points} -\item{\code{metaData}}{list of information on \code{data}} +\item{\code{errorbars}}{\code{ThemeAestheticSelections} object defining properties for error bars} -\item{\code{dataMapping}}{R6 class \code{ObsVsPredDataMapping}} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -A \code{ggplot} object with smoother -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-addObsVsPred}{}}} -\subsection{Method \code{addObsVsPred()}}{ -Add obs vs pred as scatter layer to a \code{ggplot} object -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{ObsVsPredPlotConfiguration$addObsVsPred( - plotObject, - data, - metaData, - dataMapping -)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{plotObject}}{\code{ggplot} object} - -\item{\code{data}}{data.frame} - -\item{\code{metaData}}{list of information on \code{data}} - -\item{\code{dataMapping}}{R6 class \code{ObsVsPredDataMapping}} +\item{\code{...}}{parameters inherited from \code{PlotConfiguration}} } \if{html}{\out{
}} } \subsection{Returns}{ -A \code{ggplot} object +A new \code{ObsVsPredPlotConfiguration} object } } \if{html}{\out{
}} diff --git a/man/ObservedDataMapping.Rd b/man/ObservedDataMapping.Rd new file mode 100644 index 00000000..55ce2de4 --- /dev/null +++ b/man/ObservedDataMapping.Rd @@ -0,0 +1,107 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/observed-data-mapping.R +\name{ObservedDataMapping} +\alias{ObservedDataMapping} +\title{ObservedDataMapping} +\description{ +R6 class for mapping \code{x}, \code{y}, of observed data for a time profile plot +} +\section{Super classes}{ +\code{\link[tlf:XYDataMapping]{tlf::XYDataMapping}} -> \code{\link[tlf:XYGDataMapping]{tlf::XYGDataMapping}} -> \code{ObservedDataMapping} +} +\section{Public fields}{ +\if{html}{\out{
}} +\describe{ +\item{\code{lloq}}{mapping lower limit of quantitation variable} + +\item{\code{uncertainty}}{mapping error bars around scatter points} + +\item{\code{mdv}}{mapping missing dependent variable} + +\item{\code{ymin}}{mapping error bars around scatter points} + +\item{\code{ymax}}{mapping error bars around scatter points} +} +\if{html}{\out{
}} +} +\section{Methods}{ +\subsection{Public methods}{ +\itemize{ +\item \href{#method-new}{\code{ObservedDataMapping$new()}} +\item \href{#method-checkMapData}{\code{ObservedDataMapping$checkMapData()}} +\item \href{#method-clone}{\code{ObservedDataMapping$clone()}} +} +} +\if{html}{ +\out{
Inherited methods} +\itemize{ +} +\out{
} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-new}{}}} +\subsection{Method \code{new()}}{ +Create a new \code{PKRatioDataMapping} object +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{ObservedDataMapping$new(lloq = NULL, uncertainty = NULL, mdv = NULL, ...)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{lloq}}{mapping lower limit of quantitation variable} + +\item{\code{uncertainty}}{mapping error bars around scatter points} + +\item{\code{mdv}}{mapping missing dependent variable} + +\item{\code{...}}{parameters inherited from \code{XYGDataMapping}} +} +\if{html}{\out{
}} +} +\subsection{Returns}{ +A new \code{PKRatioDataMapping} object +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-checkMapData}{}}} +\subsection{Method \code{checkMapData()}}{ +Check that \code{data} variables include map variables +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{ObservedDataMapping$checkMapData(data, metaData = NULL)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{data}}{data.frame to check} + +\item{\code{metaData}}{list containing information on \code{data}} +} +\if{html}{\out{
}} +} +\subsection{Returns}{ +A data.frame with map and \code{defaultAes} variables. +Dummy variable \code{defaultAes} is necessary to allow further modification of plots. +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-clone}{}}} +\subsection{Method \code{clone()}}{ +The objects of this class are cloneable with this method. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{ObservedDataMapping$clone(deep = FALSE)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{deep}}{Whether to make a deep clone.} +} +\if{html}{\out{
}} +} +} +} diff --git a/man/PKRatioDataMapping.Rd b/man/PKRatioDataMapping.Rd index ccde206d..261371f5 100644 --- a/man/PKRatioDataMapping.Rd +++ b/man/PKRatioDataMapping.Rd @@ -4,7 +4,7 @@ \alias{PKRatioDataMapping} \title{PKRatioDataMapping} \description{ -R6 class for mapping \code{x}, \code{y}, \code{GroupMapping} and \code{pkRatioLines} variables to \code{data} +R6 class for mapping \code{x}, \code{y}, \code{GroupMapping} and pkRatio \code{lines} variables to \code{data} } \section{Super classes}{ \code{\link[tlf:XYDataMapping]{tlf::XYDataMapping}} -> \code{\link[tlf:XYGDataMapping]{tlf::XYGDataMapping}} -> \code{PKRatioDataMapping} @@ -12,7 +12,9 @@ R6 class for mapping \code{x}, \code{y}, \code{GroupMapping} and \code{pkRatioLi \section{Public fields}{ \if{html}{\out{
}} \describe{ -\item{\code{pkRatioValues}}{numeric vector of ratio limits to plot} +\item{\code{lines}}{list of ratio limits to plot as horizontal lines} + +\item{\code{uncertainty}}{mapping error bars around scatter points} } \if{html}{\out{
}} } @@ -20,13 +22,13 @@ R6 class for mapping \code{x}, \code{y}, \code{GroupMapping} and \code{pkRatioLi \subsection{Public methods}{ \itemize{ \item \href{#method-new}{\code{PKRatioDataMapping$new()}} +\item \href{#method-checkMapData}{\code{PKRatioDataMapping$checkMapData()}} \item \href{#method-clone}{\code{PKRatioDataMapping$clone()}} } } \if{html}{ \out{
Inherited methods} \itemize{ -\item \out{}\href{../../tlf/html/XYGDataMapping.html#method-checkMapData}{\code{tlf::XYGDataMapping$checkMapData()}}\out{} } \out{
} } @@ -36,13 +38,19 @@ R6 class for mapping \code{x}, \code{y}, \code{GroupMapping} and \code{pkRatioLi \subsection{Method \code{new()}}{ Create a new \code{PKRatioDataMapping} object \subsection{Usage}{ -\if{html}{\out{
}}\preformatted{PKRatioDataMapping$new(pkRatioValues = DefaultDataMappingValues$pkRatio, ...)}\if{html}{\out{
}} +\if{html}{\out{
}}\preformatted{PKRatioDataMapping$new( + lines = DefaultDataMappingValues$pkRatio, + uncertainty = NULL, + ... +)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ -\item{\code{pkRatioValues}}{numeric vector of ratio limits to plot} +\item{\code{lines}}{list of ratio limits to plot as horizontal lines} + +\item{\code{uncertainty}}{mapping error bars around scatter points} \item{\code{...}}{parameters inherited from \code{XYGDataMapping}} } @@ -53,6 +61,29 @@ A new \code{PKRatioDataMapping} object } } \if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-checkMapData}{}}} +\subsection{Method \code{checkMapData()}}{ +Check that \code{data} variables include map variables +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{PKRatioDataMapping$checkMapData(data, metaData = NULL)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{data}}{data.frame to check} + +\item{\code{metaData}}{list containing information on \code{data}} +} +\if{html}{\out{
}} +} +\subsection{Returns}{ +A data.frame with map and \code{defaultAes} variables. +Dummy variable \code{defaultAes} is necessary to allow further modification of plots. +} +} +\if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-clone}{}}} \subsection{Method \code{clone()}}{ diff --git a/man/PKRatioPlotConfiguration.Rd b/man/PKRatioPlotConfiguration.Rd index 362dd457..26ea9168 100644 --- a/man/PKRatioPlotConfiguration.Rd +++ b/man/PKRatioPlotConfiguration.Rd @@ -9,13 +9,6 @@ R6 class defining the configuration of a \code{ggplot} object for PK ratio plots \section{Super class}{ \code{\link[tlf:PlotConfiguration]{tlf::PlotConfiguration}} -> \code{PKRatioPlotConfiguration} } -\section{Public fields}{ -\if{html}{\out{
}} -\describe{ -\item{\code{pkRatioCaption}}{list of properties for PK ratio plot specific features} -} -\if{html}{\out{
}} -} \section{Methods}{ \subsection{Public methods}{ \itemize{ @@ -26,7 +19,6 @@ R6 class defining the configuration of a \code{ggplot} object for PK ratio plots \if{html}{ \out{
Inherited methods} \itemize{ -\item \out{}\href{../../tlf/html/PlotConfiguration.html#method-print}{\code{tlf::PlotConfiguration$print()}}\out{} } \out{
} } @@ -37,7 +29,9 @@ R6 class defining the configuration of a \code{ggplot} object for PK ratio plots Create a new \code{PKRatioPlotConfiguration} object \subsection{Usage}{ \if{html}{\out{
}}\preformatted{PKRatioPlotConfiguration$new( - pkRatioCaption = getDefaultCaptionFor("pkRatio"), + lines = NULL, + points = NULL, + errorbars = NULL, ... )}\if{html}{\out{
}} } @@ -45,7 +39,11 @@ Create a new \code{PKRatioPlotConfiguration} object \subsection{Arguments}{ \if{html}{\out{
}} \describe{ -\item{\code{pkRatioCaption}}{list of properties for PK ratio plot specific features} +\item{\code{lines}}{\code{ThemeAestheticSelections} object defining properties for PK ratio horizontal lines} + +\item{\code{points}}{\code{ThemeAestheticSelections} object defining properties for PK ratio scatter points} + +\item{\code{errorbars}}{\code{ThemeAestheticSelections} object defining properties for PK ratio error bars} \item{\code{...}}{parameters inherited from \code{PlotConfiguration}} } diff --git a/man/PlotConfiguration.Rd b/man/PlotConfiguration.Rd index 08aa349a..488c0b3b 100644 --- a/man/PlotConfiguration.Rd +++ b/man/PlotConfiguration.Rd @@ -9,19 +9,30 @@ R6 class defining the configuration of a \code{ggplot} object \section{Public fields}{ \if{html}{\out{
}} \describe{ -\item{\code{labels}}{R6 class \code{LabelConfiguration} defining labels properties} +\item{\code{export}}{R6 class \code{ExportConfiguration} defining export properties} +} +\if{html}{\out{
}} +} +\section{Active bindings}{ +\if{html}{\out{
}} +\describe{ +\item{\code{labels}}{\code{LabelConfiguration} object defining properties of labels} -\item{\code{legend}}{R6 class \code{LegendConfiguration} defining legend properties} +\item{\code{legend}}{\code{LegendConfiguration} object defining properties of legend} -\item{\code{xAxis}}{R6 class \code{XAxisConfiguration} defining X-axis properties} +\item{\code{xAxis}}{\code{XAxisConfiguration} object defining properties of x-axis} -\item{\code{yAxis}}{R6 class \code{YAxisConfiguration} defining Y-axis properties} +\item{\code{yAxis}}{\code{YAxisConfiguration} object defining properties of x-axis} -\item{\code{background}}{R6 class \code{BackgroundConfiguration} defining background properties} +\item{\code{background}}{\code{BackgroundConfiguration} object defining properties of x-axis} -\item{\code{export}}{R6 class \code{ExportConfiguration} defining export properties} +\item{\code{lines}}{\code{ThemeAestheticSelections} defining properties of lines} + +\item{\code{ribbons}}{\code{ThemeAestheticSelections} defining properties of ribbons} + +\item{\code{points}}{\code{ThemeAestheticSelections} defining properties of points} -\item{\code{theme}}{\code{Theme} R6 class defining theme aesthetic properties} +\item{\code{errorbars}}{\code{ThemeAestheticSelections} defining properties of error bars} } \if{html}{\out{
}} } @@ -29,7 +40,6 @@ R6 class defining the configuration of a \code{ggplot} object \subsection{Public methods}{ \itemize{ \item \href{#method-new}{\code{PlotConfiguration$new()}} -\item \href{#method-print}{\code{PlotConfiguration$print()}} \item \href{#method-clone}{\code{PlotConfiguration$clone()}} } } @@ -54,6 +64,10 @@ Create a new \code{PlotConfiguration} object yScale = NULL, yLimits = NULL, background = NULL, + plotArea = NULL, + panelArea = NULL, + xGrid = NULL, + yGrid = NULL, watermark = NULL, export = NULL, format = NULL, @@ -62,44 +76,51 @@ Create a new \code{PlotConfiguration} object units = NULL, data = NULL, metaData = NULL, - dataMapping = NULL, - theme = tlfEnv$currentTheme + dataMapping = NULL )}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ -\item{\code{title}}{R6 class \code{Label} object} +\item{\code{title}}{character or \code{Label} object defining plot title} -\item{\code{subtitle}}{R6 class \code{Label} object} +\item{\code{subtitle}}{character or \code{Label} object defining plot subtitle} -\item{\code{xlabel}}{R6 class \code{Label} object} +\item{\code{xlabel}}{character or \code{Label} object defining plot xlabel} -\item{\code{ylabel}}{R6 class \code{Label} object} +\item{\code{ylabel}}{character or \code{Label} object defining plot ylabel} -\item{\code{legend}}{R6 class \code{LegendConfiguration} object defining legend properties} +\item{\code{legend}}{\code{LegendConfiguration} object defining legend properties} -\item{\code{legendTitle}}{character legend title} +\item{\code{legendTitle}}{character defining legend title} -\item{\code{legendPosition}}{character legend position. +\item{\code{legendPosition}}{character defining legend position. Use Enum \code{LegendPositions} to get a list of available to legend positions.} -\item{\code{xAxis}}{R6 class \code{XAxisConfiguration} object defining X-axis properties} +\item{\code{xAxis}}{\code{XAxisConfiguration} object defining x-axis properties} + +\item{\code{xScale}}{name of X-axis scale. Use enum \code{Scaling} to access predefined scales.} + +\item{\code{xLimits}}{numeric vector of length 2 defining x-axis limits} -\item{\code{xScale}}{character defining X-axis scale. Use enum \code{Scaling} to access predefined scales.} +\item{\code{yAxis}}{\code{YAxisConfiguration} object defining y-axis properties} -\item{\code{xLimits}}{numeric vector of X-axis limits} +\item{\code{yScale}}{name of y-axis scale. Use enum \code{Scaling} to access predefined scales.} -\item{\code{yAxis}}{R6 class \code{YAxisConfiguration} object defining X-axis properties} +\item{\code{yLimits}}{numeric vector of length 2 defining y-axis limits} -\item{\code{yScale}}{character defining Y-axis scale. Use enum \code{Scaling} to access predefined scales.} +\item{\code{background}}{\code{BackgroundConfiguration} object defining background properties} -\item{\code{yLimits}}{numeric vector of Y-axis limits} +\item{\code{plotArea}}{\code{BackgroundElement} object defining properties of plot area} -\item{\code{background}}{R6 class \code{BackgroundConfiguration} defining background properties} +\item{\code{panelArea}}{\code{BackgroundElement} object defining properties of panel area} -\item{\code{watermark}}{R6 class \code{Label} object defining watermark background} +\item{\code{xGrid}}{\code{LineElement} object defining properties of x-grid background} + +\item{\code{yGrid}}{\code{LineElement} object defining properties of y-grid background} + +\item{\code{watermark}}{\code{Label} object defining watermark} \item{\code{export}}{R6 class \code{SaveConfiguration} defining saving properties} @@ -116,8 +137,6 @@ Use Enum \code{LegendPositions} to get a list of available to legend positions.} \item{\code{metaData}}{list of information on \code{data}} \item{\code{dataMapping}}{R6 class or subclass \code{XYDataMapping}} - -\item{\code{theme}}{R6 class \code{Theme}} } \if{html}{\out{
}} } @@ -126,19 +145,6 @@ A new \code{PlotConfiguration} object } } \if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-print}{}}} -\subsection{Method \code{print()}}{ -Print plot configuration -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{PlotConfiguration$print()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -Plot configuration -} -} -\if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-clone}{}}} \subsection{Method \code{clone()}}{ diff --git a/man/RangeDataMapping.Rd b/man/RangeDataMapping.Rd index d489d19c..7500279a 100644 --- a/man/RangeDataMapping.Rd +++ b/man/RangeDataMapping.Rd @@ -100,8 +100,8 @@ Check that \code{data} variables include map variables \if{html}{\out{
}} } \subsection{Returns}{ -A data.frame with map and \code{defaultAes} variables. -Dummy variable \code{defaultAes} is necessary to allow further modification of plots. +A data.frame with map and \code{legendLabels} variables. +Dummy variable \code{legendLabels} is necessary to allow further modification of plots. } } \if{html}{\out{
}} diff --git a/man/Scaling.Rd b/man/Scaling.Rd index cde14665..05625244 100644 --- a/man/Scaling.Rd +++ b/man/Scaling.Rd @@ -5,13 +5,13 @@ \alias{Scaling} \title{Scaling} \format{ -An object of class \code{list} of length 8. +An object of class \code{list} of length 7. } \usage{ Scaling } \description{ Pre-defined transformation of axes -Not that built-in transformations from ggplot2 includes more transformations +Not that built-in transformations from \code{ggplot2} includes more transformations } \keyword{datasets} diff --git a/man/Shapes.Rd b/man/Shapes.Rd new file mode 100644 index 00000000..262b1be3 --- /dev/null +++ b/man/Shapes.Rd @@ -0,0 +1,16 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utilities-aesthetics.R +\docType{data} +\name{Shapes} +\alias{Shapes} +\title{Shapes} +\format{ +An object of class \code{list} of length 9. +} +\usage{ +Shapes +} +\description{ +List of some \code{ggplot2} shapes +} +\keyword{datasets} diff --git a/man/Theme.Rd b/man/Theme.Rd index af5fefc0..1fd2dddc 100644 --- a/man/Theme.Rd +++ b/man/Theme.Rd @@ -4,21 +4,18 @@ \alias{Theme} \title{Theme} \description{ -R6 class defining theme +R6 class defining theme properties } -\section{Super class}{ -\code{\link[tlf:ThemeFont]{tlf::ThemeFont}} -> \code{Theme} -} -\section{Public fields}{ -\if{html}{\out{
}} +\section{Active bindings}{ +\if{html}{\out{
}} \describe{ -\item{\code{watermark}}{list of font properties for watermark} +\item{\code{fonts}}{\code{ThemeFont} object} -\item{\code{background}}{list of aesthetic properties for background configuration} +\item{\code{background}}{\code{ThemeBackground} object} -\item{\code{aesProperties}}{list of aesthetic properties for plots in general} +\item{\code{aestheticMaps}}{\code{ThemeAestheticMaps} object} -\item{\code{defaultCaption}}{aesthetic properties for specific plots} +\item{\code{plotConfigurations}}{\code{ThemePlotConfiguration} object} } \if{html}{\out{
}} } @@ -26,15 +23,10 @@ R6 class defining theme \subsection{Public methods}{ \itemize{ \item \href{#method-new}{\code{Theme$new()}} +\item \href{#method-save}{\code{Theme$save()}} \item \href{#method-clone}{\code{Theme$clone()}} } } -\if{html}{ -\out{
Inherited methods} -\itemize{ -} -\out{
} -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-new}{}}} @@ -42,32 +34,23 @@ R6 class defining theme Create a new \code{Theme} object \subsection{Usage}{ \if{html}{\out{
}}\preformatted{Theme$new( - themesProperties = tlfEnvThemesProperties$default, - labelColors = NULL, - labelBaseSize = 14, + fonts = NULL, background = NULL, - watermark = NULL, - aesProperties = NULL, - defaultCaption = NULL + aestheticMaps = NULL, + plotConfigurations = NULL )}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ -\item{\code{themesProperties}}{list of aesthetic properties} - -\item{\code{labelColors}}{list of colors for each label} +\item{\code{fonts}}{\code{ThemeFont} object} -\item{\code{labelBaseSize}}{numeric value for theme base size} +\item{\code{background}}{\code{ThemeBackground} object} -\item{\code{background}}{list of aesthetic properties for background configuration} +\item{\code{aestheticMaps}}{\code{ThemeAestheticMaps} object} -\item{\code{watermark}}{list of font properties for watermark} - -\item{\code{aesProperties}}{list of aesthetic properties for plots in general} - -\item{\code{defaultCaption}}{list of aesthetic properties for specific plot features} +\item{\code{plotConfigurations}}{\code{ThemePlotConfiguration} object} } \if{html}{\out{
}} } @@ -76,6 +59,23 @@ A new \code{Theme} object } } \if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-save}{}}} +\subsection{Method \code{save()}}{ +Save \code{Theme} as a json file +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{Theme$save(jsonFile)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{jsonFile}}{name of json file} +} +\if{html}{\out{
}} +} +} +\if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-clone}{}}} \subsection{Method \code{clone()}}{ diff --git a/man/ThemeAesProperties.Rd b/man/ThemeAesProperties.Rd deleted file mode 100644 index 0e8f3cb0..00000000 --- a/man/ThemeAesProperties.Rd +++ /dev/null @@ -1,90 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/themes.R -\name{ThemeAesProperties} -\alias{ThemeAesProperties} -\title{ThemeAesProperties} -\description{ -R6 class defining theme aesthetic properties plots -} -\section{Public fields}{ -\if{html}{\out{
}} -\describe{ -\item{\code{color}}{character vector of color properties} - -\item{\code{shape}}{character vector of shape properties} - -\item{\code{size}}{numeric vector of size properties} - -\item{\code{fill}}{character vector of fill properties} - -\item{\code{linetype}}{character vector of linetype properties} - -\item{\code{alpha}}{numeric vector of alpha properties} -} -\if{html}{\out{
}} -} -\section{Methods}{ -\subsection{Public methods}{ -\itemize{ -\item \href{#method-new}{\code{ThemeAesProperties$new()}} -\item \href{#method-clone}{\code{ThemeAesProperties$clone()}} -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-new}{}}} -\subsection{Method \code{new()}}{ -Create a new \code{ThemeAesProperties} object -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{ThemeAesProperties$new( - aesProperties = tlfEnvThemesProperties$default$aesProperties, - color = NULL, - shape = NULL, - size = NULL, - fill = NULL, - linetype = NULL, - alpha = NULL -)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{aesProperties}}{list of aesthetic properties} - -\item{\code{color}}{character vector of color properties} - -\item{\code{shape}}{character vector of shape properties} - -\item{\code{size}}{numeric vector of size properties} - -\item{\code{fill}}{character vector of fill properties} - -\item{\code{linetype}}{character vector of linetype properties} - -\item{\code{alpha}}{numeric vector of alpha properties} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -A new \code{ThemeAesProperties} object -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-clone}{}}} -\subsection{Method \code{clone()}}{ -The objects of this class are cloneable with this method. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{ThemeAesProperties$clone(deep = FALSE)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{deep}}{Whether to make a deep clone.} -} -\if{html}{\out{
}} -} -} -} diff --git a/man/ThemeAestheticMaps.Rd b/man/ThemeAestheticMaps.Rd new file mode 100644 index 00000000..3bf0c58a --- /dev/null +++ b/man/ThemeAestheticMaps.Rd @@ -0,0 +1,101 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/themes.R +\name{ThemeAestheticMaps} +\alias{ThemeAestheticMaps} +\title{ThemeAestheticMaps} +\description{ +R6 class defining theme aesthetic maps +} +\section{Public fields}{ +\if{html}{\out{
}} +\describe{ +\item{\code{color}}{color map as character or numeric vector} + +\item{\code{fill}}{fill map as character or numeric vector} + +\item{\code{size}}{size map as numeric vector} + +\item{\code{shape}}{shape map as numeric vector} + +\item{\code{linetype}}{linetype as character vector} + +\item{\code{alpha}}{map as numeric vector} +} +\if{html}{\out{
}} +} +\section{Methods}{ +\subsection{Public methods}{ +\itemize{ +\item \href{#method-new}{\code{ThemeAestheticMaps$new()}} +\item \href{#method-toJson}{\code{ThemeAestheticMaps$toJson()}} +\item \href{#method-clone}{\code{ThemeAestheticMaps$clone()}} +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-new}{}}} +\subsection{Method \code{new()}}{ +Create a new \code{ThemeAestheticMaps} object +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{ThemeAestheticMaps$new( + color = NULL, + fill = NULL, + shape = NULL, + size = NULL, + linetype = NULL, + alpha = NULL +)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{color}}{color map as list, character or numeric vector} + +\item{\code{fill}}{fill map as list, character or numeric vector} + +\item{\code{shape}}{shape map as list, character or numeric vector} + +\item{\code{size}}{size map as list, character or numeric vector} + +\item{\code{linetype}}{linetype map as list, character or numeric vector} + +\item{\code{alpha}}{alpha map as list, character or numeric vector} +} +\if{html}{\out{
}} +} +\subsection{Returns}{ +A new \code{ThemeAestheticMaps} object +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-toJson}{}}} +\subsection{Method \code{toJson()}}{ +Translate object into a json list +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{ThemeAestheticMaps$toJson()}\if{html}{\out{
}} +} + +\subsection{Returns}{ +A list that can be saved into a json file +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-clone}{}}} +\subsection{Method \code{clone()}}{ +The objects of this class are cloneable with this method. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{ThemeAestheticMaps$clone(deep = FALSE)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{deep}}{Whether to make a deep clone.} +} +\if{html}{\out{
}} +} +} +} diff --git a/man/ThemeAestheticSelections.Rd b/man/ThemeAestheticSelections.Rd new file mode 100644 index 00000000..999cdefa --- /dev/null +++ b/man/ThemeAestheticSelections.Rd @@ -0,0 +1,93 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/themes.R +\name{ThemeAestheticSelections} +\alias{ThemeAestheticSelections} +\title{ThemeAestheticSelections} +\description{ +R6 class defining how plot configurations will use aesthetic maps +} +\section{Super class}{ +\code{\link[tlf:ThemeAestheticMaps]{tlf::ThemeAestheticMaps}} -> \code{ThemeAestheticSelections} +} +\section{Methods}{ +\subsection{Public methods}{ +\itemize{ +\item \href{#method-new}{\code{ThemeAestheticSelections$new()}} +\item \href{#method-toJson}{\code{ThemeAestheticSelections$toJson()}} +\item \href{#method-clone}{\code{ThemeAestheticSelections$clone()}} +} +} +\if{html}{ +\out{
Inherited methods} +\itemize{ +} +\out{
} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-new}{}}} +\subsection{Method \code{new()}}{ +Create a new \code{ThemeAestheticSelections} object +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{ThemeAestheticSelections$new( + color = NULL, + fill = NULL, + shape = NULL, + size = NULL, + linetype = NULL, + alpha = NULL +)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{color}}{selection key or values for choice of color} + +\item{\code{fill}}{selection key or values for choice of fill} + +\item{\code{shape}}{selection key or values for choice of shape} + +\item{\code{size}}{selection key or values for choice of size} + +\item{\code{linetype}}{selection key or values for choice of linetype} + +\item{\code{alpha}}{selection key or values for choice of alpha} +} +\if{html}{\out{
}} +} +\subsection{Returns}{ +A new \code{ThemeAestheticSelections} object +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-toJson}{}}} +\subsection{Method \code{toJson()}}{ +Translate object into a json list +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{ThemeAestheticSelections$toJson()}\if{html}{\out{
}} +} + +\subsection{Returns}{ +A list that can be saved into a json file +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-clone}{}}} +\subsection{Method \code{clone()}}{ +The objects of this class are cloneable with this method. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{ThemeAestheticSelections$clone(deep = FALSE)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{deep}}{Whether to make a deep clone.} +} +\if{html}{\out{
}} +} +} +} diff --git a/man/ThemeBackground.Rd b/man/ThemeBackground.Rd new file mode 100644 index 00000000..fb04aeb4 --- /dev/null +++ b/man/ThemeBackground.Rd @@ -0,0 +1,128 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/themes.R +\name{ThemeBackground} +\alias{ThemeBackground} +\title{ThemeBackground} +\description{ +R6 class defining theme background properties +} +\section{Public fields}{ +\if{html}{\out{
}} +\describe{ +\item{\code{watermark}}{character defining content of watermark} + +\item{\code{legendPosition}}{character defining where legend should usually be placed} + +\item{\code{plot}}{\code{BackgroundElement} object for plot area properties (outside of panel)} + +\item{\code{panel}}{\code{BackgroundElement} object for plot area properties (inside of panel)} + +\item{\code{xAxis}}{\code{BackgroundElement} object for x axis properties} + +\item{\code{yAxis}}{\code{BackgroundElement} object for y axis properties} + +\item{\code{xGrid}}{\code{BackgroundElement} object for x grid properties} + +\item{\code{yGrid}}{\code{BackgroundElement} object for y grid properties} + +\item{\code{legend}}{\code{BackgroundElement} object for legend area properties} +} +\if{html}{\out{
}} +} +\section{Methods}{ +\subsection{Public methods}{ +\itemize{ +\item \href{#method-new}{\code{ThemeBackground$new()}} +\item \href{#method-toJson}{\code{ThemeBackground$toJson()}} +\item \href{#method-clone}{\code{ThemeBackground$clone()}} +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-new}{}}} +\subsection{Method \code{new()}}{ +Create a new \code{ThemeBackground} object +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{ThemeBackground$new( + watermark = NULL, + legendPosition = NULL, + plot = NULL, + panel = NULL, + xAxis = NULL, + yAxis = NULL, + xGrid = NULL, + yGrid = NULL, + legend = NULL, + baseFill = "white", + baseColor = "black", + baseSize = 0.5, + baseLinetype = "solid" +)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{watermark}}{character defining content of watermark} + +\item{\code{legendPosition}}{character defining where legend should usually be placed} + +\item{\code{plot}}{\code{BackgroundElement} object or list for plot area properties (outside of panel)} + +\item{\code{panel}}{\code{BackgroundElement} object or list for plot area properties (inside of panel)} + +\item{\code{xAxis}}{\code{BackgroundElement} object or list for x axis properties} + +\item{\code{yAxis}}{\code{BackgroundElement} object or list for y axis properties} + +\item{\code{xGrid}}{\code{BackgroundElement} object or list for x grid properties} + +\item{\code{yGrid}}{\code{BackgroundElement} object or list for y grid properties} + +\item{\code{legend}}{\code{BackgroundElement} object or list for legend area properties} + +\item{\code{baseFill}}{name of base color fill of undefined background elements. Default is white.} + +\item{\code{baseColor}}{name of base color of undefined background elements. Default is black.} + +\item{\code{baseSize}}{name of base size of undefined background elements. Default is 0.5.} + +\item{\code{baseLinetype}}{name of base size of undefined background elements. Default is "solid".} +} +\if{html}{\out{
}} +} +\subsection{Returns}{ +A new \code{ThemeFont} object +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-toJson}{}}} +\subsection{Method \code{toJson()}}{ +Translate object into a json list +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{ThemeBackground$toJson()}\if{html}{\out{
}} +} + +\subsection{Returns}{ +A list that can be saved into a json file +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-clone}{}}} +\subsection{Method \code{clone()}}{ +The objects of this class are cloneable with this method. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{ThemeBackground$clone(deep = FALSE)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{deep}}{Whether to make a deep clone.} +} +\if{html}{\out{
}} +} +} +} diff --git a/man/ThemeFont.Rd b/man/ThemeFont.Rd index b94cdcba..42be777a 100644 --- a/man/ThemeFont.Rd +++ b/man/ThemeFont.Rd @@ -4,20 +4,28 @@ \alias{ThemeFont} \title{ThemeFont} \description{ -R6 class defining theme fonts +R6 class defining theme font properties } \section{Public fields}{ \if{html}{\out{
}} \describe{ -\item{\code{titleFont}}{R6 class \code{Font} object} +\item{\code{title}}{\code{Font} object for font properties title} -\item{\code{subtitleFont}}{R6 class \code{Font} object} +\item{\code{subtitle}}{\code{Font} object for font properties of subtitle} -\item{\code{xlabelFont}}{R6 class \code{Font} object} +\item{\code{xlabel}}{\code{Font} object for font properties of xlabel} -\item{\code{ylabelFont}}{R6 class \code{Font} object} +\item{\code{ylabel}}{\code{Font} object for font properties of ylabel} -\item{\code{watermarkFont}}{R6 class \code{Font} object} +\item{\code{watermark}}{\code{Font} object for font properties of watermark} + +\item{\code{legendTitle}}{\code{Font} object for font properties of legend title} + +\item{\code{legend}}{\code{Font} object for font properties of legend} + +\item{\code{xAxis}}{\code{Font} object for font properties of xAxis} + +\item{\code{yAxis}}{\code{Font} object for font properties of yAxis} } \if{html}{\out{
}} } @@ -25,6 +33,7 @@ R6 class defining theme fonts \subsection{Public methods}{ \itemize{ \item \href{#method-new}{\code{ThemeFont$new()}} +\item \href{#method-toJson}{\code{ThemeFont$toJson()}} \item \href{#method-clone}{\code{ThemeFont$clone()}} } } @@ -35,17 +44,53 @@ R6 class defining theme fonts Create a new \code{ThemeFont} object \subsection{Usage}{ \if{html}{\out{
}}\preformatted{ThemeFont$new( - labelColors = tlfEnvThemesProperties$default$labelColors, - labelBaseSize = 14 + title = NULL, + subtitle = NULL, + xlabel = NULL, + ylabel = NULL, + watermark = NULL, + legendTitle = NULL, + legend = NULL, + xAxis = NULL, + yAxis = NULL, + baseColor = "black", + baseSize = 12, + baseFace = "plain", + baseFamily = "", + baseAngle = 0 )}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ -\item{\code{labelColors}}{list of colors for each label} +\item{\code{title}}{\code{Font} object or list for font properties title} + +\item{\code{subtitle}}{\code{Font} object or list for font properties of subtitle} + +\item{\code{xlabel}}{\code{Font} object or list for font properties of xlabel} + +\item{\code{ylabel}}{\code{Font} object or list for font properties of ylabel} + +\item{\code{watermark}}{\code{Font} object or list for font properties of watermark} + +\item{\code{legendTitle}}{\code{Font} object or list for font properties of legend} + +\item{\code{legend}}{\code{Font} object or list for font properties of legend} + +\item{\code{xAxis}}{\code{Font} object or list for font properties of xAxis} + +\item{\code{yAxis}}{\code{Font} object or list for font properties of yAxis} -\item{\code{labelBaseSize}}{numeric value for theme base size} +\item{\code{baseColor}}{name of base color of undefined fonts. Default is black.} + +\item{\code{baseSize}}{base size of undefined fonts. Default is 12.} + +\item{\code{baseFace}}{name of base face of undefined fonts. Default is "plain".} + +\item{\code{baseFamily}}{name of base family of undefined fonts. Default is "".} + +\item{\code{baseAngle}}{base angle of undefined fonts. Default is 0 degree.} } \if{html}{\out{
}} } @@ -54,6 +99,19 @@ A new \code{ThemeFont} object } } \if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-toJson}{}}} +\subsection{Method \code{toJson()}}{ +Translate object into a json list +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{ThemeFont$toJson()}\if{html}{\out{
}} +} + +\subsection{Returns}{ +A list that can be saved into a json file +} +} +\if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-clone}{}}} \subsection{Method \code{clone()}}{ diff --git a/man/ThemePlotConfigurations.Rd b/man/ThemePlotConfigurations.Rd new file mode 100644 index 00000000..df7338a7 --- /dev/null +++ b/man/ThemePlotConfigurations.Rd @@ -0,0 +1,126 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/themes.R +\name{ThemePlotConfigurations} +\alias{ThemePlotConfigurations} +\title{ThemePlotConfigurations} +\description{ +R6 class defining theme of plot configuration objects +} +\section{Public fields}{ +\if{html}{\out{
}} +\describe{ +\item{\code{addScatter}}{theme properties for \code{PlotConfiguration} objects as used in function \code{addScatter()}} + +\item{\code{addLine}}{theme properties for \code{PlotConfiguration} objects as used in function \code{addLine()}} + +\item{\code{addRibbon}}{theme properties for \code{PlotConfiguration} objects as used in function \code{addRibbon()}} + +\item{\code{addErrorbar}}{theme properties for \code{PlotConfiguration} objects as used in function \code{addErrorbar()}} + +\item{\code{plotPKRatio}}{theme properties for \code{PlotConfiguration} objects as used in function \code{plotPKRatio()}} + +\item{\code{plotDDIRatio}}{theme properties for \code{PlotConfiguration} objects as used in function \code{plotDDIRatio()}} + +\item{\code{plotTimeProfile}}{theme properties for \code{PlotConfiguration} objects as used in function \code{plotTimeProfile()}} + +\item{\code{plotObsVsPred}}{theme properties for \code{PlotConfiguration} objects as used in function \code{plotObsVsPred()}} + +\item{\code{plotBoxWhisker}}{theme properties for \code{PlotConfiguration} objects as used in function \code{plotBoxWhisker()}} + +\item{\code{plotTornado}}{theme properties for \code{PlotConfiguration} objects as used in function \code{plotTornado()}} + +\item{\code{plotHistogram}}{theme properties for \code{PlotConfiguration} objects as used in function \code{plotHistogram()}} +} +\if{html}{\out{
}} +} +\section{Methods}{ +\subsection{Public methods}{ +\itemize{ +\item \href{#method-new}{\code{ThemePlotConfigurations$new()}} +\item \href{#method-toJson}{\code{ThemePlotConfigurations$toJson()}} +\item \href{#method-clone}{\code{ThemePlotConfigurations$clone()}} +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-new}{}}} +\subsection{Method \code{new()}}{ +Create a new \code{ThemePlotConfigurations} object +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{ThemePlotConfigurations$new( + addScatter = NULL, + addLine = NULL, + addRibbon = NULL, + addErrorbar = NULL, + plotPKRatio = NULL, + plotDDIRatio = NULL, + plotTimeProfile = NULL, + plotObsVsPred = NULL, + plotBoxWhisker = NULL, + plotTornado = NULL, + plotHistogram = NULL +)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{addScatter}}{theme properties for \code{PlotConfiguration} objects as used in function \code{addScatter()}} + +\item{\code{addLine}}{theme properties for \code{PlotConfiguration} objects as used in function \code{addLine()}} + +\item{\code{addRibbon}}{theme properties for \code{PlotConfiguration} objects as used in function \code{addRibbon()}} + +\item{\code{addErrorbar}}{theme properties for \code{PlotConfiguration} objects as used in function \code{addErrorbar()}} + +\item{\code{plotPKRatio}}{theme properties for \code{PlotConfiguration} objects as used in function \code{plotPKRatio()}} + +\item{\code{plotDDIRatio}}{theme properties for \code{PlotConfiguration} objects as used in function \code{plotDDIRatio()}} + +\item{\code{plotTimeProfile}}{theme properties for \code{PlotConfiguration} objects as used in function \code{plotTimeProfile()}} + +\item{\code{plotObsVsPred}}{theme properties for \code{PlotConfiguration} objects as used in function \code{plotObsVsPred()}} + +\item{\code{plotBoxWhisker}}{theme properties for \code{PlotConfiguration} objects as used in function \code{plotBoxWhisker()}} + +\item{\code{plotTornado}}{theme properties for \code{PlotConfiguration} objects as used in function \code{plotTornado()}} + +\item{\code{plotHistogram}}{theme properties for \code{PlotConfiguration} objects as used in function \code{plotHistogram()}} +} +\if{html}{\out{
}} +} +\subsection{Returns}{ +A new \code{ThemePlotConfigurations} object +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-toJson}{}}} +\subsection{Method \code{toJson()}}{ +Translate object into a json list +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{ThemePlotConfigurations$toJson()}\if{html}{\out{
}} +} + +\subsection{Returns}{ +A list that can be saved into a json file +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-clone}{}}} +\subsection{Method \code{clone()}}{ +The objects of this class are cloneable with this method. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{ThemePlotConfigurations$clone(deep = FALSE)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{deep}}{Whether to make a deep clone.} +} +\if{html}{\out{
}} +} +} +} diff --git a/man/TimeProfileDataMapping.Rd b/man/TimeProfileDataMapping.Rd index d02a1d7c..e8290d91 100644 --- a/man/TimeProfileDataMapping.Rd +++ b/man/TimeProfileDataMapping.Rd @@ -7,28 +7,19 @@ R6 class defining the configuration of a \code{ggplot} object for time profile plot } \section{Super classes}{ -\code{\link[tlf:XYDataMapping]{tlf::XYDataMapping}} -> \code{\link[tlf:XYGDataMapping]{tlf::XYGDataMapping}} -> \code{TimeProfileDataMapping} -} -\section{Public fields}{ -\if{html}{\out{
}} -\describe{ -\item{\code{lloq}}{numeric value of lower limit of quantification} - -\item{\code{isRangeTimeProfile}}{logical to set aggregation of data} -} -\if{html}{\out{
}} +\code{\link[tlf:XYDataMapping]{tlf::XYDataMapping}} -> \code{\link[tlf:XYGDataMapping]{tlf::XYGDataMapping}} -> \code{\link[tlf:RangeDataMapping]{tlf::RangeDataMapping}} -> \code{TimeProfileDataMapping} } \section{Methods}{ \subsection{Public methods}{ \itemize{ \item \href{#method-new}{\code{TimeProfileDataMapping$new()}} +\item \href{#method-checkMapData}{\code{TimeProfileDataMapping$checkMapData()}} \item \href{#method-clone}{\code{TimeProfileDataMapping$clone()}} } } \if{html}{ \out{
Inherited methods} \itemize{ -\item \out{}\href{../../tlf/html/XYGDataMapping.html#method-checkMapData}{\code{tlf::XYGDataMapping$checkMapData()}}\out{} } \out{
} } @@ -38,22 +29,73 @@ R6 class defining the configuration of a \code{ggplot} object for time profile p \subsection{Method \code{new()}}{ Create a new \code{TimeProfileDataMapping} object \subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TimeProfileDataMapping$new(lloq = NULL, isRangeTimeProfile = FALSE, ...)}\if{html}{\out{
}} +\if{html}{\out{
}}\preformatted{TimeProfileDataMapping$new( + x = NULL, + y = NULL, + ymin = NULL, + ymax = NULL, + groupMapping = NULL, + color = NULL, + fill = NULL, + linetype = NULL, + shape = NULL, + size = NULL, + data = NULL +)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ -\item{\code{lloq}}{numeric value of lower limit of quantification} +\item{\code{x}}{Name of x variable to map} + +\item{\code{y}}{Name of y variable to map} + +\item{\code{ymin}}{Name of ymin variable to map} + +\item{\code{ymax}}{Name of ymax variable to map} + +\item{\code{groupMapping}}{R6 class \code{GroupMapping} object} + +\item{\code{color}}{R6 class \code{Grouping} object or its input} + +\item{\code{fill}}{R6 class \code{Grouping} object or its input} + +\item{\code{linetype}}{R6 class \code{Grouping} object or its input} + +\item{\code{shape}}{R6 class \code{Grouping} object or its input} + +\item{\code{size}}{R6 class \code{Grouping} object or its input} -\item{\code{isRangeTimeProfile}}{Name of x variable to map} +\item{\code{data}}{data.frame to map used by \code{smartMapping}} +} +\if{html}{\out{
}} +} +\subsection{Returns}{ +A new \code{RangeDataMapping} object +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-checkMapData}{}}} +\subsection{Method \code{checkMapData()}}{ +Check that \code{data} variables include map variables +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{TimeProfileDataMapping$checkMapData(data, metaData = NULL)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{data}}{data.frame to check} -\item{\code{...}}{parameters inherited from \code{XYGDataMapping}} +\item{\code{metaData}}{list containing information on \code{data}} } \if{html}{\out{
}} } \subsection{Returns}{ -A new \code{TimeProfileDataMapping} object +A data.frame with map and \code{legendLabels} variables. +Dummy variable \code{legendLabels} is necessary to allow further modification of plots. } } \if{html}{\out{
}} diff --git a/man/TimeProfilePlotConfiguration.Rd b/man/TimeProfilePlotConfiguration.Rd index 0e9d5134..a2fab9bb 100644 --- a/man/TimeProfilePlotConfiguration.Rd +++ b/man/TimeProfilePlotConfiguration.Rd @@ -9,13 +9,6 @@ R6 class defining the configuration of a \code{ggplot} object for time profile p \section{Super class}{ \code{\link[tlf:PlotConfiguration]{tlf::PlotConfiguration}} -> \code{TimeProfilePlotConfiguration} } -\section{Public fields}{ -\if{html}{\out{
}} -\describe{ -\item{\code{timeProfileCaption}}{list of properties for time profile plot specific features} -} -\if{html}{\out{
}} -} \section{Methods}{ \subsection{Public methods}{ \itemize{ @@ -26,7 +19,6 @@ R6 class defining the configuration of a \code{ggplot} object for time profile p \if{html}{ \out{
Inherited methods} \itemize{ -\item \out{}\href{../../tlf/html/PlotConfiguration.html#method-print}{\code{tlf::PlotConfiguration$print()}}\out{} } \out{
} } @@ -37,7 +29,10 @@ R6 class defining the configuration of a \code{ggplot} object for time profile p Create a new \code{TimeProfilePlotConfiguration} object \subsection{Usage}{ \if{html}{\out{
}}\preformatted{TimeProfilePlotConfiguration$new( - timeProfileCaption = getDefaultCaptionFor("timeProfile"), + lines = NULL, + ribbons = NULL, + points = NULL, + errorbars = NULL, ... )}\if{html}{\out{
}} } @@ -45,7 +40,13 @@ Create a new \code{TimeProfilePlotConfiguration} object \subsection{Arguments}{ \if{html}{\out{
}} \describe{ -\item{\code{timeProfileCaption}}{list of properties for PK ratio plot specific features} +\item{\code{lines}}{\code{ThemeAestheticSelections} defining properties of lines} + +\item{\code{ribbons}}{\code{ThemeAestheticSelections} defining properties of ribbons} + +\item{\code{points}}{\code{ThemeAestheticSelections} defining properties of points} + +\item{\code{errorbars}}{\code{ThemeAestheticSelections} defining properties of error bars} \item{\code{...}}{parameters inherited from \code{PlotConfiguration}} } diff --git a/man/TornadoDataMapping.Rd b/man/TornadoDataMapping.Rd index 2f6afffe..620de26d 100644 --- a/man/TornadoDataMapping.Rd +++ b/man/TornadoDataMapping.Rd @@ -12,7 +12,7 @@ R6 class for mapping \code{values}, \code{labels} to \code{data} \section{Public fields}{ \if{html}{\out{
}} \describe{ -\item{\code{tornadoValues}}{numeric vector of limits to plot} +\item{\code{lines}}{numeric vector of limits to plot} \item{\code{sorted}}{logical indicating if values should be sorted} } @@ -39,7 +39,7 @@ R6 class for mapping \code{values}, \code{labels} to \code{data} Create a new \code{TornadoDataMapping} object \subsection{Usage}{ \if{html}{\out{
}}\preformatted{TornadoDataMapping$new( - tornadoValues = DefaultDataMappingValues$tornado, + lines = DefaultDataMappingValues$tornado, sorted = NULL, x = NULL, y = NULL, @@ -50,7 +50,7 @@ Create a new \code{TornadoDataMapping} object \subsection{Arguments}{ \if{html}{\out{
}} \describe{ -\item{\code{tornadoValues}}{numeric vector of ratio limits to plot} +\item{\code{lines}}{numeric vector of limits to plot} \item{\code{sorted}}{logical indicating if values should be sorted} diff --git a/man/TornadoPlotConfiguration.Rd b/man/TornadoPlotConfiguration.Rd index 1acdebe6..3b09c270 100644 --- a/man/TornadoPlotConfiguration.Rd +++ b/man/TornadoPlotConfiguration.Rd @@ -12,8 +12,6 @@ R6 class defining the configuration of a \code{ggplot} object for tornado plots \section{Public fields}{ \if{html}{\out{
}} \describe{ -\item{\code{tornadoCaption}}{list of properties for tornado plot specific features} - \item{\code{bar}}{logical setting if tornado is uses a bar plot instead of regular points} \item{\code{colorPalette}}{color palette property from \code{ggplot2}} @@ -32,7 +30,6 @@ R6 class defining the configuration of a \code{ggplot} object for tornado plots \if{html}{ \out{
Inherited methods} \itemize{ -\item \out{}\href{../../tlf/html/PlotConfiguration.html#method-print}{\code{tlf::PlotConfiguration$print()}}\out{} } \out{
} } @@ -43,10 +40,12 @@ R6 class defining the configuration of a \code{ggplot} object for tornado plots Create a new \code{TornadoPlotConfiguration} object \subsection{Usage}{ \if{html}{\out{
}}\preformatted{TornadoPlotConfiguration$new( - tornadoCaption = getDefaultCaptionFor("tornado"), bar = TRUE, colorPalette = NULL, dodge = 0.5, + lines = NULL, + points = NULL, + ribbons = NULL, ... )}\if{html}{\out{
}} } @@ -54,14 +53,18 @@ Create a new \code{TornadoPlotConfiguration} object \subsection{Arguments}{ \if{html}{\out{
}} \describe{ -\item{\code{tornadoCaption}}{list of properties for tornado plot specific features} - \item{\code{bar}}{logical setting if tornado is uses a bar plot instead of regular points} \item{\code{colorPalette}}{color palette property from \code{ggplot2}} \item{\code{dodge}}{space between the bars/points} +\item{\code{lines}}{\code{ThemeAestheticSelections} object defining properties for Tornado vertical lines} + +\item{\code{points}}{\code{ThemeAestheticSelections} object defining properties for scatter points} + +\item{\code{ribbons}}{\code{ThemeAestheticSelections} object defining properties for bars} + \item{\code{...}}{parameters inherited from \code{PlotConfiguration}} } \if{html}{\out{
}} diff --git a/man/XAxisConfiguration.Rd b/man/XAxisConfiguration.Rd index ef92e968..0bccd6d1 100644 --- a/man/XAxisConfiguration.Rd +++ b/man/XAxisConfiguration.Rd @@ -12,7 +12,7 @@ R6 class defining the configuration of X-axis \section{Methods}{ \subsection{Public methods}{ \itemize{ -\item \href{#method-setPlotAxis}{\code{XAxisConfiguration$setPlotAxis()}} +\item \href{#method-updatePlot}{\code{XAxisConfiguration$updatePlot()}} \item \href{#method-clone}{\code{XAxisConfiguration$clone()}} } } @@ -20,17 +20,16 @@ R6 class defining the configuration of X-axis \out{
Inherited methods} \itemize{ \item \out{}\href{../../tlf/html/AxisConfiguration.html#method-initialize}{\code{tlf::AxisConfiguration$initialize()}}\out{} -\item \out{}\href{../../tlf/html/AxisConfiguration.html#method-print}{\code{tlf::AxisConfiguration$print()}}\out{} } \out{
} } \if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-setPlotAxis}{}}} -\subsection{Method \code{setPlotAxis()}}{ -Set axis configuration on a \code{ggplot} object +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-updatePlot}{}}} +\subsection{Method \code{updatePlot()}}{ +Update axis configuration on a \code{ggplot} object \subsection{Usage}{ -\if{html}{\out{
}}\preformatted{XAxisConfiguration$setPlotAxis(plotObject)}\if{html}{\out{
}} +\if{html}{\out{
}}\preformatted{XAxisConfiguration$updatePlot(plotObject)}\if{html}{\out{
}} } \subsection{Arguments}{ diff --git a/man/YAxisConfiguration.Rd b/man/YAxisConfiguration.Rd index d5a221b1..1c51f123 100644 --- a/man/YAxisConfiguration.Rd +++ b/man/YAxisConfiguration.Rd @@ -19,7 +19,7 @@ R6 class defining the configuration of Y-axis \section{Methods}{ \subsection{Public methods}{ \itemize{ -\item \href{#method-setPlotAxis}{\code{YAxisConfiguration$setPlotAxis()}} +\item \href{#method-updatePlot}{\code{YAxisConfiguration$updatePlot()}} \item \href{#method-clone}{\code{YAxisConfiguration$clone()}} } } @@ -27,17 +27,16 @@ R6 class defining the configuration of Y-axis \out{
Inherited methods} \itemize{ \item \out{}\href{../../tlf/html/AxisConfiguration.html#method-initialize}{\code{tlf::AxisConfiguration$initialize()}}\out{} -\item \out{}\href{../../tlf/html/AxisConfiguration.html#method-print}{\code{tlf::AxisConfiguration$print()}}\out{} } \out{
} } \if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-setPlotAxis}{}}} -\subsection{Method \code{setPlotAxis()}}{ -Set axis configuration on a \code{ggplot} object +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-updatePlot}{}}} +\subsection{Method \code{updatePlot()}}{ +Update axis configuration on a \code{ggplot} object \subsection{Usage}{ -\if{html}{\out{
}}\preformatted{YAxisConfiguration$setPlotAxis(plotObject)}\if{html}{\out{
}} +\if{html}{\out{
}}\preformatted{YAxisConfiguration$updatePlot(plotObject)}\if{html}{\out{
}} } \subsection{Arguments}{ diff --git a/man/addBoxWhisker.Rd b/man/addBoxWhisker.Rd new file mode 100644 index 00000000..85a18163 --- /dev/null +++ b/man/addBoxWhisker.Rd @@ -0,0 +1,25 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/plot-boxwhisker.R +\name{addBoxWhisker} +\alias{addBoxWhisker} +\title{addBoxWhisker} +\usage{ +addBoxWhisker(data, metaData, dataMapping, plotConfiguration, plotObject) +} +\arguments{ +\item{data}{data.frame} + +\item{metaData}{list of information on \code{data}} + +\item{dataMapping}{\code{BoxWhiskerDataMapping} object} + +\item{plotConfiguration}{\code{BoxWhiskerPlotConfiguration} object} + +\item{plotObject}{a \code{ggplot} object} +} +\value{ +A \code{ggplot} object +} +\description{ +Add layer of boxes and whiskers to a \code{ggplot} object +} diff --git a/man/addDDIRatioLines.Rd b/man/addDDIRatioLines.Rd new file mode 100644 index 00000000..5be1b018 --- /dev/null +++ b/man/addDDIRatioLines.Rd @@ -0,0 +1,34 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/plot-ddiratio.R +\name{addDDIRatioLines} +\alias{addDDIRatioLines} +\title{addDDIRatioLines} +\usage{ +addDDIRatioLines( + data, + metaData = NULL, + dataMapping = NULL, + comparisonType = NULL, + plotConfiguration = NULL, + plotObject = NULL +) +} +\arguments{ +\item{data}{data.frame (or list of data.frames? TO BE DISCUSSED) +containing the data to be used for the plot} + +\item{metaData}{list of lists (structure TO BE DISCUSSED) +containing complementary information to data (e.g. unit)} + +\item{dataMapping}{R6 class PKRatioDataMapping +mapping of x, y axes + mapping of colorGrouping, sizeGrouping, shapeGrouping} + +\item{plotConfiguration}{R6 class PKRatioPlotConfiguration +Plot Configuration defining title, subtitle, xlabel, ylabel watermark, and legend} +} +\value{ +a ggplot graphical object +} +\description{ +addDDIRatioLines(data, metaData, dataMapping, plotConfiguration, plotObject) +} diff --git a/man/addObsVsPredLines.Rd b/man/addObsVsPredLines.Rd new file mode 100644 index 00000000..c3ef687a --- /dev/null +++ b/man/addObsVsPredLines.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/plot-obs-vs-pred.R +\name{addObsVsPredLines} +\alias{addObsVsPredLines} +\title{addObsVsPredLines} +\usage{ +addObsVsPredLines( + data, + metaData = NULL, + dataMapping = NULL, + plotConfiguration = NULL, + plotObject = NULL +) +} +\arguments{ +\item{data}{data.frame containing the data to be used for the plot} + +\item{metaData}{list of lists} + +\item{dataMapping}{\code{ObsVsPredDataMapping} object} + +\item{plotConfiguration}{\code{ObsVsPredConfiguration} object} + +\item{plotObject}{\code{ggplot} graphical object} +} +\value{ +A \code{ggplot} graphical object +} +\description{ +Add layers of identity line and smoother +} diff --git a/man/addOutliers.Rd b/man/addOutliers.Rd new file mode 100644 index 00000000..061cc070 --- /dev/null +++ b/man/addOutliers.Rd @@ -0,0 +1,25 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/plot-boxwhisker.R +\name{addOutliers} +\alias{addOutliers} +\title{addOutliers} +\usage{ +addOutliers(data, metaData, dataMapping, plotConfiguration, plotObject) +} +\arguments{ +\item{data}{data.frame} + +\item{metaData}{list of information on \code{data}} + +\item{dataMapping}{\code{BoxWhiskerDataMapping} object} + +\item{plotConfiguration}{\code{BoxWhiskerPlotConfiguration} object} + +\item{plotObject}{a \code{ggplot} object} +} +\value{ +A \code{ggplot} object +} +\description{ +Add a outlier points layer to a \code{ggplot} object +} diff --git a/man/addWatermark.Rd b/man/addWatermark.Rd index f014dd99..327e7e26 100644 --- a/man/addWatermark.Rd +++ b/man/addWatermark.Rd @@ -4,19 +4,29 @@ \alias{addWatermark} \title{addWatermark} \usage{ -addWatermark(plotObject, label, angle = 30, alpha = 0.4) +addWatermark( + plotObject, + watermark, + color = NULL, + size = NULL, + angle = NULL, + alpha = NULL +) } \arguments{ \item{plotObject}{ggplot object to which the watermark is added} -\item{label}{Character or Label class object corresponding to the watermark text -(and its font properties if Label)} +\item{watermark}{Character or \code{Label} object corresponding to the watermark text +(and its font properties if \code{Label})} -\item{angle}{Angle in degree from horizontal of the watermark label. Default angle is 30 degrees.} +\item{color}{Color of the watermark label.} + +\item{size}{Size of the watermark label.} + +\item{angle}{Angle of the watermark label (in degree).} \item{alpha}{Transparency of the watermark label. -Alpha is a numeric between 0 and 1: 0 label is totally transparent, 1 label is totally opaque. -Default alpha is 0.4.} +Alpha is a numeric between 0 and 1: 0 label is totally transparent, 1 label is totally opaque.} } \value{ \code{plotObject} ggplot object to which the watermark is added. @@ -24,7 +34,6 @@ Default alpha is 0.4.} \description{ addWatermark creates a ggplot grob based on the label text and its font properties. Then, adds the grob to the ggplot object input \code{plotObject} as a new layer using \code{ggplot2::annotation_custom}. -\code{angle} and \code{alpha} are optional input to customize the angle and transparency of the watermark text. } \examples{ p <- ggplot2::ggplot() @@ -43,8 +52,8 @@ addWatermark(p, watermarkLabel, alpha = 1) # Create a sun as background for (angle in seq(0, 340, 20)) { p <- addWatermark(p, - label = Label$new(text = " >", color = "yellow"), - angle = angle, alpha = 1 + watermark = " >", + color = "yellow", angle = angle, alpha = 1 ) } } diff --git a/man/bigTheme.Rd b/man/bigTheme.Rd deleted file mode 100644 index 8403808a..00000000 --- a/man/bigTheme.Rd +++ /dev/null @@ -1,16 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/themes.R -\docType{data} -\name{bigTheme} -\alias{bigTheme} -\title{bigTheme} -\format{ -An object of class \code{Theme} (inherits from \code{ThemeFont}, \code{R6}) of length 12. -} -\usage{ -bigTheme -} -\description{ -Big theme for plot configuration -} -\keyword{datasets} diff --git a/man/bwTheme.Rd b/man/bwTheme.Rd deleted file mode 100644 index 2c8ed6fa..00000000 --- a/man/bwTheme.Rd +++ /dev/null @@ -1,16 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/themes.R -\docType{data} -\name{bwTheme} -\alias{bwTheme} -\title{bwTheme} -\format{ -An object of class \code{Theme} (inherits from \code{ThemeFont}, \code{R6}) of length 12. -} -\usage{ -bwTheme -} -\description{ -Black and White theme for plot configuration -} -\keyword{datasets} diff --git a/man/createPlotScale.Rd b/man/createPlotScale.Rd new file mode 100644 index 00000000..80a7e848 --- /dev/null +++ b/man/createPlotScale.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/plotconfiguration-axis.R +\name{createPlotScale} +\alias{createPlotScale} +\title{createPlotScale} +\usage{ +createPlotScale(scale) +} +\arguments{ +\item{scale}{character defining the name of the scale} +} +\value{ +name of the \code{ggplot2} scale +} +\description{ +Translate scale into a value directly usable by \code{ggplot2} +to give more flexibilty in the next functions +} diff --git a/man/createPlotTicks.Rd b/man/createPlotTicks.Rd new file mode 100644 index 00000000..6e382a63 --- /dev/null +++ b/man/createPlotTicks.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/plotconfiguration-axis.R +\name{createPlotTicks} +\alias{createPlotTicks} +\title{createPlotTicks} +\usage{ +createPlotTicks(ticks) +} +\arguments{ +\item{ticks}{character, numeric or function defining the ticks} +} +\value{ +name of the \code{ggplot2} scale +} +\description{ +Translate ticks and ticklabels into a value directly usable by \code{ggplot2} +to give more flexibilty in the next functions +} diff --git a/man/createWatermarkGrob.Rd b/man/createWatermarkGrob.Rd index ed694128..2edf1351 100644 --- a/man/createWatermarkGrob.Rd +++ b/man/createWatermarkGrob.Rd @@ -4,17 +4,15 @@ \alias{createWatermarkGrob} \title{createWatermarkGrob} \usage{ -createWatermarkGrob(label, angle = 30, alpha = 0.6) +createWatermarkGrob(label, alpha = NULL) } \arguments{ -\item{label}{Character or Label class object corresponding to the watermark text +\item{label}{Character or Label object corresponding to the watermark text (and its font properties if Label)} -\item{angle}{Angle in degree from horizontal of the watermark label. Default angle is 30 degrees.} - \item{alpha}{Transparency of the watermark label. Alpha is a numeric between 0 and 1: 0 label is totally transparent, 1 label is totally opaque. -Default alpha is 0.6.} +Default alpha is defined from theme aesthetic alpha map} } \value{ Watermark background as a ggplot grob object diff --git a/man/defaultTheme.Rd b/man/defaultTheme.Rd deleted file mode 100644 index a3fc03aa..00000000 --- a/man/defaultTheme.Rd +++ /dev/null @@ -1,16 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/themes.R -\docType{data} -\name{defaultTheme} -\alias{defaultTheme} -\title{defaultTheme} -\format{ -An object of class \code{Theme} (inherits from \code{ThemeFont}, \code{R6}) of length 12. -} -\usage{ -defaultTheme -} -\description{ -Default theme for plot configuration -} -\keyword{datasets} diff --git a/man/getAestheticValues.Rd b/man/getAestheticValues.Rd new file mode 100644 index 00000000..0c1cb019 --- /dev/null +++ b/man/getAestheticValues.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utilities-aesthetics.R +\name{getAestheticValues} +\alias{getAestheticValues} +\title{getAestheticValues} +\usage{ +getAestheticValues(n, selectionKey = NA, position = 0, aesthetic = "color") +} +\arguments{ +\item{n}{integer defining size of returned aesthetic vector} + +\item{selectionKey}{value of aesthetic to be returned or key function from enum \code{AestheticSelectionKeys}} +} +\value{ +Vector of aesthetics +} +\description{ +Get aesthetic values (e.g color, shape, linetype) based on a selected strategy +} diff --git a/man/getFirstAestheticValues.Rd b/man/getFirstAestheticValues.Rd new file mode 100644 index 00000000..077421c8 --- /dev/null +++ b/man/getFirstAestheticValues.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utilities-aesthetics.R +\name{getFirstAestheticValues} +\alias{getFirstAestheticValues} +\title{getFirstAestheticValues} +\usage{ +getFirstAestheticValues(n, map) +} +\arguments{ +\item{n}{integer defining size of returned aesthetic vector} + +\item{map}{Aesthetic (e.g. color, shape, linetype) map from \code{Theme} object.} + +\item{position}{integer defining at which position to look for aesthetic vector} +} +\value{ +Vector of aesthetics +} +\description{ +Get the next aesthetic values (e.g color, shape, linetype) from an aesthetic map defined in \code{Theme} +} diff --git a/man/getGuestValues.Rd b/man/getGuestValues.Rd new file mode 100644 index 00000000..3dba1a66 --- /dev/null +++ b/man/getGuestValues.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/plot-ddiratio.R +\name{getGuestValues} +\alias{getGuestValues} +\title{getGuestValues} +\usage{ +getGuestValues(x, delta = 1) +} +\arguments{ +\item{x}{input values of Guest function} + +\item{delta}{parameter of Guest function} +} +\value{ +A data.frame with Guest et al. ratio limits as ymin and ymax +} +\description{ +Get a data.frame with Guest et al. ratio limits +} diff --git a/man/getNextAestheticValues.Rd b/man/getNextAestheticValues.Rd new file mode 100644 index 00000000..5cd1a353 --- /dev/null +++ b/man/getNextAestheticValues.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utilities-aesthetics.R +\name{getNextAestheticValues} +\alias{getNextAestheticValues} +\title{getNextAestheticValues} +\usage{ +getNextAestheticValues(n, position = 0, map) +} +\arguments{ +\item{n}{integer defining size of returned aesthetic vector} + +\item{position}{integer defining at which position to look for aesthetic vector} + +\item{map}{Aesthetic (e.g. color, shape, linetype) map from \code{Theme} object.} +} +\value{ +Vector of aesthetics +} +\description{ +Get the next aesthetic values (e.g color, shape, linetype) from an aesthetic map defined in \code{Theme} +} diff --git a/man/getResetAestheticvalues.Rd b/man/getResetAestheticvalues.Rd new file mode 100644 index 00000000..45454532 --- /dev/null +++ b/man/getResetAestheticvalues.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utilities-aesthetics.R +\name{getResetAestheticvalues} +\alias{getResetAestheticvalues} +\title{getResetAestheticvalues} +\usage{ +getResetAestheticvalues(n, map) +} +\arguments{ +\item{n}{integer defining size of returned aesthetic vector} + +\item{map}{Aesthetic (e.g. color, shape, linetype) map from \code{Theme} object.} +} +\value{ +Vector of aesthetics +} +\description{ +Get the aesthetic values (e.g color, shape, linetype) from an aesthetic map defined in \code{Theme}. +Reset the value every time it is used. +} diff --git a/man/getSameAestheticValues.Rd b/man/getSameAestheticValues.Rd new file mode 100644 index 00000000..7d1a1db6 --- /dev/null +++ b/man/getSameAestheticValues.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utilities-aesthetics.R +\name{getSameAestheticValues} +\alias{getSameAestheticValues} +\title{getSameAestheticValues} +\usage{ +getSameAestheticValues(n, position = 0, map) +} +\arguments{ +\item{n}{integer defining size of returned aesthetic vector} + +\item{position}{integer defining at which position to look for aesthetic vector} + +\item{map}{Aesthetic (e.g. color, shape, linetype) map from \code{Theme} object.} +} +\value{ +Vector of aesthetics +} +\description{ +Get the same aesthetic values (e.g color, shape, linetype) from an aesthetic map defined in \code{Theme} +} diff --git a/man/initializePlot.Rd b/man/initializePlot.Rd index 79fe80c7..33aa71db 100644 --- a/man/initializePlot.Rd +++ b/man/initializePlot.Rd @@ -7,7 +7,7 @@ initializePlot(plotConfiguration = NULL) } \arguments{ -\item{plotConfiguration}{\code{PlotConfiguration} class or subclass defining labels, grid, background and watermark +\item{plotConfiguration}{\code{PlotConfiguration} objecct defining labels, grid, background and watermark This parameter is optional: the \code{tlf} library provides a default configuration according to the current theme} } \value{ @@ -20,10 +20,6 @@ Initialize a \code{ggplot} object and set the labels, grid, background and water # Initialize an empty plot p <- initializePlot() -# Use a predifined theme -useTheme(tlfTheme) -p <- initializePlot() - # Implement a customized configuration using PlotConfiguration config <- PlotConfiguration$new(title = "My Plot", xlabel = "x variable", ylabel = "y variable") p <- initializePlot(config) diff --git a/man/loadThemeFromJson.Rd b/man/loadThemeFromJson.Rd new file mode 100644 index 00000000..6e94bde2 --- /dev/null +++ b/man/loadThemeFromJson.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/themes.R +\name{loadThemeFromJson} +\alias{loadThemeFromJson} +\title{loadThemeFromJson} +\usage{ +loadThemeFromJson(jsonFile) +} +\arguments{ +\item{jsonFile}{path of json file} +} +\value{ +A \code{Theme} object +} +\description{ +Load theme object from json file. +A template of a json theme is available at system.file(package= "tlf", "theme-maker","theme-template.json") +} diff --git a/man/mergeLegend.Rd b/man/mergeLegend.Rd new file mode 100644 index 00000000..93bdd9e2 --- /dev/null +++ b/man/mergeLegend.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utilities-legend.R +\name{mergeLegend} +\alias{mergeLegend} +\title{mergeLegend} +\usage{ +mergeLegend(plotObject, newLabels, aestheticSelections) +} +\arguments{ +\item{plotObject}{ggplot object} + +\item{newLabels}{labels of caption to merge} + +\item{aestheticSelections}{\code{ThemeAestheticSelections} object} +} +\description{ +merge legend caption with existing legend caption +} diff --git a/man/pkRatioData.Rd b/man/pkRatioData.Rd deleted file mode 100644 index b93da62f..00000000 --- a/man/pkRatioData.Rd +++ /dev/null @@ -1,29 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/data-description.R -\docType{data} -\name{pkRatioData} -\alias{pkRatioData} -\title{Test dataset of PK Ratios for 40 subjects.} -\format{ -A data frame with 40 rows and 11 variables: -\describe{ -\item{IndividualID}{} -\item{Population}{} -\item{Gender}{} -\item{Age}{} -\item{Compound}{} -\item{Dose}{} -\item{Organ}{} -\item{Compartment}{} -\item{Simulated}{} -\item{Observed}{} -\item{Ratio}{} -} -} -\usage{ -pkRatioData -} -\description{ -Test dataset of PK Ratios for 40 subjects. -} -\keyword{datasets} diff --git a/man/pkRatioMetaData.Rd b/man/pkRatioMetaData.Rd deleted file mode 100644 index 1363807c..00000000 --- a/man/pkRatioMetaData.Rd +++ /dev/null @@ -1,21 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/data-description.R -\docType{data} -\name{pkRatioMetaData} -\alias{pkRatioMetaData} -\title{Test metaData for pkRatioData} -\format{ -A list of lists for the 11 variables of pkRatioData -Each variable includes: -\describe{ -\item{unit}{} -\item{dimension}{} -} -} -\usage{ -pkRatioMetaData -} -\description{ -Test metaData for pkRatioData -} -\keyword{datasets} diff --git a/man/plotBoxWhisker.Rd b/man/plotBoxWhisker.Rd index f9a3146a..a2f497d6 100644 --- a/man/plotBoxWhisker.Rd +++ b/man/plotBoxWhisker.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/boxwhisker-plot.R +% Please edit documentation in R/plot-boxwhisker.R \name{plotBoxWhisker} \alias{plotBoxWhisker} \title{plotBoxWhisker} @@ -7,6 +7,7 @@ plotBoxWhisker( data, metaData = NULL, + outliers = NULL, dataMapping = NULL, plotConfiguration = NULL, plotObject = NULL @@ -19,10 +20,12 @@ containing the data to be used for the plot} \item{metaData}{list of lists (structure TO BE DISCUSSED) containing complementary information to data (e.g. unit)} -\item{dataMapping}{R6 class BoxWhiskerDataMapping +\item{outliers}{logical defining if outliers should be included in boxplot} + +\item{dataMapping}{\code{BoxWhiskerDataMapping} object mapping of x, y axes + mapping of colorGrouping, sizeGrouping, shapeGrouping} -\item{plotConfiguration}{R6 class BoxWhiskerConfiguration +\item{plotConfiguration}{\code{BoxWhiskerConfiguration} object Plot Configuration defining title, subtitle, xlabel, ylabel watermark, and legend} \item{plotObject}{ggplot object, if null creates new plot, if not add time profile layers to ggplot} diff --git a/man/plotDDIRatio.Rd b/man/plotDDIRatio.Rd index c29927ad..4922af4f 100644 --- a/man/plotDDIRatio.Rd +++ b/man/plotDDIRatio.Rd @@ -8,6 +8,7 @@ plotDDIRatio( data, metaData = NULL, dataMapping = NULL, + comparisonType = NULL, plotConfiguration = NULL, plotObject = NULL ) diff --git a/man/plotHistogram.Rd b/man/plotHistogram.Rd index 73947353..aa0ea9c4 100644 --- a/man/plotHistogram.Rd +++ b/man/plotHistogram.Rd @@ -8,11 +8,11 @@ plotHistogram( data, metaData = NULL, dataMapping = NULL, - plotConfiguration = NULL, - binWidth = NULL, bins = NULL, - verticalLineFunctions = NULL, - verticalLineFunctionNames = NULL, + stack = NULL, + fitNormalDist = NULL, + fitDensity = NULL, + plotConfiguration = NULL, plotObject = NULL ) } @@ -25,18 +25,18 @@ containing complementary information to data (e.g. unit)} \item{dataMapping}{R6 class HistogramDataMapping mapping of which data to use for histogram} +\item{bins}{(optional)} + \item{plotConfiguration}{R6 class HistogramPlotConfiguration Plot Configuration defining title, subtitle, xlabel, ylabel watermark, and legend} -\item{binWidth}{(optional)} +\item{plotObject}{ggplot object, if null creates new plot, if not add time profile layers to ggplot} -\item{bins}{(optional)} +\item{binWidth}{(optional)} \item{verticalLineFunctions}{(optional)} \item{verticalLineFunctionNames}{(optional)} - -\item{plotObject}{ggplot object, if null creates new plot, if not add time profile layers to ggplot} } \value{ a ggplot graphical object diff --git a/man/plotTimeProfile.Rd b/man/plotTimeProfile.Rd index d3ef4fc9..d2508207 100644 --- a/man/plotTimeProfile.Rd +++ b/man/plotTimeProfile.Rd @@ -5,11 +5,11 @@ \title{plotTimeProfile} \usage{ plotTimeProfile( - data, + data = NULL, metaData = NULL, dataMapping = NULL, observedData = NULL, - dataMappingForObserved = NULL, + observedDataMapping = NULL, plotConfiguration = NULL, plotObject = NULL ) diff --git a/man/runDDIRatioPlot.Rd b/man/runDDIRatioPlot.Rd new file mode 100644 index 00000000..727d05c8 --- /dev/null +++ b/man/runDDIRatioPlot.Rd @@ -0,0 +1,11 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/plot-ddiratio.R +\name{runDDIRatioPlot} +\alias{runDDIRatioPlot} +\title{runDDIRatioPlot} +\usage{ +runDDIRatioPlot() +} +\description{ +Run shiny app to use \code{plotDDIRatio()} from user interface +} diff --git a/man/runObsVsPredPlot.Rd b/man/runObsVsPredPlot.Rd new file mode 100644 index 00000000..fdffd653 --- /dev/null +++ b/man/runObsVsPredPlot.Rd @@ -0,0 +1,11 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/plot-obs-vs-pred.R +\name{runObsVsPredPlot} +\alias{runObsVsPredPlot} +\title{runObsVsPredPlot} +\usage{ +runObsVsPredPlot() +} +\description{ +Run shiny app to use \code{plotObsVsPred()} from user interface +} diff --git a/man/runPKRatioPlot.Rd b/man/runPKRatioPlot.Rd new file mode 100644 index 00000000..eebbb1cf --- /dev/null +++ b/man/runPKRatioPlot.Rd @@ -0,0 +1,11 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/plot-pkratio.R +\name{runPKRatioPlot} +\alias{runPKRatioPlot} +\title{runPKRatioPlot} +\usage{ +runPKRatioPlot() +} +\description{ +Run shiny app to use \code{plotPKRatio()} from user interface +} diff --git a/man/runThemeMaker.Rd b/man/runThemeMaker.Rd new file mode 100644 index 00000000..7e261605 --- /dev/null +++ b/man/runThemeMaker.Rd @@ -0,0 +1,12 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/themes.R +\name{runThemeMaker} +\alias{runThemeMaker} +\title{runThemeMaker} +\usage{ +runThemeMaker() +} +\description{ +Run shiny app that allows easy setting of Theme objects. +Theme objects drive default properties of plots +} diff --git a/man/saveThemeToJson.Rd b/man/saveThemeToJson.Rd new file mode 100644 index 00000000..7ff7e405 --- /dev/null +++ b/man/saveThemeToJson.Rd @@ -0,0 +1,16 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/themes.R +\name{saveThemeToJson} +\alias{saveThemeToJson} +\title{saveThemeToJson} +\usage{ +saveThemeToJson(jsonFile, theme = NULL) +} +\arguments{ +\item{jsonFile}{path of json file} + +\item{theme}{\code{Theme} object path of json file} +} +\description{ +Save theme object to a json file. +} diff --git a/man/setBackground.Rd b/man/setBackground.Rd index 3ba3d279..73df462f 100644 --- a/man/setBackground.Rd +++ b/man/setBackground.Rd @@ -9,8 +9,7 @@ setBackground( fill = NULL, color = NULL, linetype = NULL, - size = NULL, - outerBackgroundFill = NULL + size = NULL ) } \arguments{ @@ -23,11 +22,9 @@ setBackground( \item{linetype}{character linetype of the background frame} \item{size}{numeric size of the background frame} - -\item{outerBackgroundFill}{character color fill of the outerBackground} } \value{ -ggplot object with updated Y-axis +ggplot object } \description{ Set background properties on a ggplot object diff --git a/man/setBackgroundPanelArea.Rd b/man/setBackgroundPanelArea.Rd new file mode 100644 index 00000000..92f2109a --- /dev/null +++ b/man/setBackgroundPanelArea.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utilities-background.R +\name{setBackgroundPanelArea} +\alias{setBackgroundPanelArea} +\title{setBackgroundPanelArea} +\usage{ +setBackgroundPanelArea( + plotObject, + fill = NULL, + color = NULL, + linetype = NULL, + size = NULL +) +} +\arguments{ +\item{plotObject}{ggplot object to set} + +\item{fill}{character color fill of the background} + +\item{color}{character color of the background frame} + +\item{linetype}{character linetype of the background frame} + +\item{size}{numeric size of the background frame} +} +\value{ +ggplot object +} +\description{ +Set background panel area properties on a ggplot object +} diff --git a/man/setBackgroundPlotArea.Rd b/man/setBackgroundPlotArea.Rd new file mode 100644 index 00000000..c0e5ac68 --- /dev/null +++ b/man/setBackgroundPlotArea.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utilities-background.R +\name{setBackgroundPlotArea} +\alias{setBackgroundPlotArea} +\title{setBackgroundPlotArea} +\usage{ +setBackgroundPlotArea( + plotObject, + fill = NULL, + color = NULL, + linetype = NULL, + size = NULL +) +} +\arguments{ +\item{plotObject}{ggplot object to set} + +\item{fill}{character color fill of the background} + +\item{color}{character color of the background frame} + +\item{linetype}{character linetype of the background frame} + +\item{size}{numeric size of the background frame} +} +\value{ +ggplot object +} +\description{ +Set background plot area properties on a ggplot object +} diff --git a/man/setFontProperties.Rd b/man/setFontProperties.Rd deleted file mode 100644 index df13cc19..00000000 --- a/man/setFontProperties.Rd +++ /dev/null @@ -1,39 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/utilities-label.R -\name{setFontProperties} -\alias{setFontProperties} -\title{setFontProperties} -\usage{ -setFontProperties( - plotObject, - titleFont = NULL, - subtitleFont = NULL, - xAxisFont = NULL, - yAxisFont = NULL, - legendFont = NULL -) -} -\arguments{ -\item{plotObject}{ggplot object} - -\item{titleFont}{Font Class for title} - -\item{subtitleFont}{Font Class for subtitle} - -\item{xAxisFont}{Font Class for xaxis and ticks} - -\item{yAxisFont}{Font Class for yaxis and ticks} - -\item{legendFont}{Font Class for legend} -} -\value{ -plotObject ggplot object with updated fonts -} -\description{ -setFontProperties set Font Properties on a ggplot object -} -\examples{ -p <- ggplot2::ggplot() + ggplot2::labs(title = "Title") -newFont <- Font$new(color = "blue", size = 20) -p <- setFontProperties(plotObject = p, titleFont = newFont) -} diff --git a/man/setGrid.Rd b/man/setGrid.Rd index be92c902..ce372268 100644 --- a/man/setGrid.Rd +++ b/man/setGrid.Rd @@ -16,8 +16,8 @@ setGrid(plotObject, color = NULL, linetype = NULL, size = NULL) \item{size}{numeric size of the grid lines} } \value{ -ggplot object with updated Y-axis +ggplot object } \description{ -Set grid properties on a ggplot object +Set x and y grid properties on a ggplot object } diff --git a/man/setLegend.Rd b/man/setLegend.Rd index a43fc2f7..65f8a10f 100644 --- a/man/setLegend.Rd +++ b/man/setLegend.Rd @@ -4,7 +4,13 @@ \alias{setLegend} \title{setLegend} \usage{ -setLegend(plotObject, position, title = NULL, caption = NULL) +setLegend( + plotObject, + position = NULL, + title = NULL, + font = NULL, + caption = NULL +) } \arguments{ \item{plotObject}{Graphical object created from ggplot} @@ -12,13 +18,15 @@ setLegend(plotObject, position, title = NULL, caption = NULL) \item{position}{legend position. Use enum \code{LegendPositions} to access the list of legend positions.} -\item{title}{title of legend} +\item{title}{character or \code{Label} object} + +\item{font}{\code{Font} object defining legend font} \item{caption}{data.frame containing the caption properties of the legend} } \value{ -A \code{ggplot} graphical object +A \code{ggplot} object } \description{ -Set legend position, title and/or caption +Set legend position, title, font and/or caption } diff --git a/man/setLegendCaption.Rd b/man/setLegendCaption.Rd index 2dab6e1a..539d8aad 100644 --- a/man/setLegendCaption.Rd +++ b/man/setLegendCaption.Rd @@ -4,7 +4,7 @@ \alias{setLegendCaption} \title{setLegendCaption} \usage{ -setLegendCaption(plotObject, caption) +setLegendCaption(plotObject, caption = NULL) } \arguments{ \item{plotObject}{\code{ggplot} graphical object} diff --git a/man/setLegendFont.Rd b/man/setLegendFont.Rd new file mode 100644 index 00000000..7487400c --- /dev/null +++ b/man/setLegendFont.Rd @@ -0,0 +1,29 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utilities-legend.R +\name{setLegendFont} +\alias{setLegendFont} +\title{setLegendFont} +\usage{ +setLegendFont( + plotObject, + color = NULL, + size = NULL, + fontFace = NULL, + angle = NULL +) +} +\arguments{ +\item{plotObject}{ggplot object} + +\item{color}{color of legend font} + +\item{size}{size of legend font} + +\item{fontFace}{color of legend font} +} +\value{ +A ggplot object +} +\description{ +Set legend font properties +} diff --git a/man/setLegendPosition.Rd b/man/setLegendPosition.Rd index e348e87d..6aa220b4 100644 --- a/man/setLegendPosition.Rd +++ b/man/setLegendPosition.Rd @@ -2,9 +2,9 @@ % Please edit documentation in R/utilities-legend.R \name{setLegendPosition} \alias{setLegendPosition} -\title{setLegendTitle} +\title{setLegendPosition} \usage{ -setLegendPosition(plotObject, position) +setLegendPosition(plotObject, position = NULL) } \arguments{ \item{plotObject}{\code{ggplot} graphical object} diff --git a/man/setLegendTitle.Rd b/man/setLegendTitle.Rd index 829cd666..bafc28b6 100644 --- a/man/setLegendTitle.Rd +++ b/man/setLegendTitle.Rd @@ -4,16 +4,29 @@ \alias{setLegendTitle} \title{setLegendTitle} \usage{ -setLegendTitle(plotObject, title) +setLegendTitle( + plotObject, + title = NULL, + color = NULL, + size = NULL, + fontFace = NULL, + angle = NULL +) } \arguments{ -\item{plotObject}{\code{ggplot} graphical object} +\item{plotObject}{ggplot object} -\item{title}{title of legend} +\item{title}{character or \code{Label} object} + +\item{color}{color of legend font} + +\item{size}{size of legend font} + +\item{fontFace}{color of legend font} } \value{ -A \code{ggplot} graphical object +A ggplot object } \description{ -Set the legend title +Set legend title } diff --git a/man/setPlotLabels.Rd b/man/setPlotLabels.Rd index c226b4ea..aa5b256e 100644 --- a/man/setPlotLabels.Rd +++ b/man/setPlotLabels.Rd @@ -15,16 +15,16 @@ setPlotLabels( \arguments{ \item{plotObject}{ggplot object to set} -\item{title}{character or Label class object} +\item{title}{character or \code{Label} object} -\item{subtitle}{character or Label class object} +\item{subtitle}{character or \code{Label} object} -\item{xlabel}{character or Label class object} +\item{xlabel}{character or \code{Label} object} -\item{ylabel}{character or Label class object} +\item{ylabel}{character or \code{Label} object} } \value{ -ggplot object with updated labels +ggplot object } \description{ Set labels properties on a ggplot object diff --git a/man/setWatermark.Rd b/man/setWatermark.Rd index 20b681b3..c5bc5717 100644 --- a/man/setWatermark.Rd +++ b/man/setWatermark.Rd @@ -4,18 +4,29 @@ \alias{setWatermark} \title{setWatermark} \usage{ -setWatermark(plotObject, watermark = NULL, angle = 30, alpha = 0.4) +setWatermark( + plotObject, + watermark = NULL, + color = NULL, + size = NULL, + angle = NULL, + alpha = NULL +) } \arguments{ \item{plotObject}{ggplot object to which the watermark is set} -\item{watermark}{character or Label class object} +\item{watermark}{Character or \code{Label} object corresponding to the watermark text +(and its font properties if \code{Label})} -\item{angle}{Angle in degree from horizontal of the watermark label. Default angle is 30 degrees.} +\item{color}{Color of the watermark label.} + +\item{size}{Size of the watermark label.} + +\item{angle}{Angle of the watermark label (in degree).} \item{alpha}{Transparency of the watermark label. -Alpha is a numeric between 0 and 1: 0 label is totally transparent, 1 label is totally opaque. -Default alpha is 0.6.} +Alpha is a numeric between 0 and 1: 0 label is totally transparent, 1 label is totally opaque.} } \value{ ggplot object to which the watermark is added. diff --git a/man/setXAxis.Rd b/man/setXAxis.Rd index 1579f543..5e86aebb 100644 --- a/man/setXAxis.Rd +++ b/man/setXAxis.Rd @@ -9,7 +9,8 @@ setXAxis( scale = NULL, limits = NULL, ticks = NULL, - ticklabels = NULL + ticklabels = NULL, + font = NULL ) } \arguments{ @@ -22,6 +23,8 @@ setXAxis( \item{ticks}{X-axis ticks} \item{ticklabels}{X-axis ticklabels} + +\item{font}{\code{Font} object defining font of ticklabels} } \value{ ggplot object with updated X-axis diff --git a/man/setXGrid.Rd b/man/setXGrid.Rd new file mode 100644 index 00000000..ccf1bc88 --- /dev/null +++ b/man/setXGrid.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utilities-background.R +\name{setXGrid} +\alias{setXGrid} +\title{setXGrid} +\usage{ +setXGrid(plotObject, color = NULL, linetype = NULL, size = NULL) +} +\arguments{ +\item{plotObject}{ggplot object to set} + +\item{color}{character color of the grid} + +\item{linetype}{character linetype of the grid. Use "blank" to remove grid.} + +\item{size}{numeric size of the grid lines} +} +\value{ +ggplot object +} +\description{ +Set x-grid properties on a ggplot object +} diff --git a/man/setYAxis.Rd b/man/setYAxis.Rd index bc8d9556..e42d8172 100644 --- a/man/setYAxis.Rd +++ b/man/setYAxis.Rd @@ -9,7 +9,8 @@ setYAxis( scale = NULL, limits = NULL, ticks = NULL, - ticklabels = NULL + ticklabels = NULL, + font = NULL ) } \arguments{ @@ -22,6 +23,8 @@ setYAxis( \item{ticks}{Y-axis ticks} \item{ticklabels}{Y-axis ticklabels} + +\item{font}{\code{Font} object defining font of ticklabels} } \value{ ggplot object with updated Y-axis diff --git a/man/setYGrid.Rd b/man/setYGrid.Rd new file mode 100644 index 00000000..c6953cdf --- /dev/null +++ b/man/setYGrid.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utilities-background.R +\name{setYGrid} +\alias{setYGrid} +\title{setYGrid} +\usage{ +setYGrid(plotObject, color = NULL, linetype = NULL, size = NULL) +} +\arguments{ +\item{plotObject}{ggplot object to set} + +\item{color}{character color of the grid} + +\item{linetype}{character linetype of the grid. Use "blank" to remove grid.} + +\item{size}{numeric size of the grid lines} +} +\value{ +ggplot object +} +\description{ +Set x and y grid properties on a ggplot object +} diff --git a/man/timeProfileDataFrame.Rd b/man/timeProfileDataFrame.Rd deleted file mode 100644 index 6bd9e683..00000000 --- a/man/timeProfileDataFrame.Rd +++ /dev/null @@ -1,28 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/data-description.R -\docType{data} -\name{timeProfileDataFrame} -\alias{timeProfileDataFrame} -\title{Test dataset for time profiles with 3 subjects.} -\format{ -A data frame with 12 rows and 10 variables: -\describe{ -\item{Time}{} -\item{IndividualID}{} -\item{Population}{} -\item{Gender}{} -\item{Age}{} -\item{Compound}{} -\item{Dose}{} -\item{Organ}{} -\item{Compartment}{} -\item{Simulated}{} -} -} -\usage{ -timeProfileDataFrame -} -\description{ -Test dataset for time profiles with 3 subjects. -} -\keyword{datasets} diff --git a/man/tlfTheme.Rd b/man/tlfTheme.Rd deleted file mode 100644 index 05ce3f28..00000000 --- a/man/tlfTheme.Rd +++ /dev/null @@ -1,16 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/themes.R -\docType{data} -\name{tlfTheme} -\alias{tlfTheme} -\title{tlfTheme} -\format{ -An object of class \code{Theme} (inherits from \code{ThemeFont}, \code{R6}) of length 12. -} -\usage{ -tlfTheme -} -\description{ -tlf theme for plot configuration -} -\keyword{datasets} diff --git a/tests/testthat/test-atoms.R b/tests/testthat/test-atoms.R index 32491258..ce88a775 100644 --- a/tests/testthat/test-atoms.R +++ b/tests/testthat/test-atoms.R @@ -2,17 +2,17 @@ context("Atom Plots") test_that("Regular atom plots provide ggplot objects that includes a PlotConfiguration object", { emptyPlot <- initializePlot() - scatterPlot <- addScatter(x=c(1,2,3),y=c(1,2,3)) - linePlot <- addLine(x=c(1,2,3),y=c(1,2,3)) - ribbonPlot <- addRibbon(x=c(1,2,3),ymin=c(1,2,3),ymax=c(3,4,5)) - errorbarPlot <- addErrorbar(x=c(1,2,3),ymin=c(1,2,3),ymax=c(3,4,5)) - + scatterPlot <- addScatter(x = c(1, 2, 3), y = c(1, 2, 3)) + linePlot <- addLine(x = c(1, 2, 3), y = c(1, 2, 3)) + ribbonPlot <- addRibbon(x = c(1, 2, 3), ymin = c(1, 2, 3), ymax = c(3, 4, 5)) + errorbarPlot <- addErrorbar(x = c(1, 2, 3), ymin = c(1, 2, 3), ymax = c(3, 4, 5)) + expect_is(emptyPlot, "ggplot") expect_is(scatterPlot, "ggplot") expect_is(linePlot, "ggplot") expect_is(ribbonPlot, "ggplot") expect_is(errorbarPlot, "ggplot") - + expect_is(emptyPlot$plotConfiguration, "PlotConfiguration") expect_is(scatterPlot$plotConfiguration, "PlotConfiguration") expect_is(linePlot$plotConfiguration, "PlotConfiguration") @@ -21,42 +21,44 @@ test_that("Regular atom plots provide ggplot objects that includes a PlotConfigu }) test_that("A PlotConfiguration input is correctlty used to create the plot when specified", { - testPlotConfiguration <- PlotConfiguration$new(xlabel = "test X", - ylabel = "test Y", - watermark = "test watermark") + testPlotConfiguration <- PlotConfiguration$new( + xlabel = "test X", + ylabel = "test Y", + watermark = "test watermark" + ) emptyPlot <- initializePlot(plotConfiguration = testPlotConfiguration) - scatterPlot <- addScatter(x=c(1,2,3),y=c(1,2,3),plotConfiguration = testPlotConfiguration) - linePlot <- addLine(x=c(1,2,3),y=c(1,2,3),plotConfiguration = testPlotConfiguration) - ribbonPlot <- addRibbon(x=c(1,2,3),ymin=c(1,2,3),ymax=c(3,4,5),plotConfiguration = testPlotConfiguration) - errorbarPlot <- addErrorbar(x=c(1,2,3),ymin=c(1,2,3),ymax=c(3,4,5),plotConfiguration = testPlotConfiguration) - + scatterPlot <- addScatter(x = c(1, 2, 3), y = c(1, 2, 3), plotConfiguration = testPlotConfiguration) + linePlot <- addLine(x = c(1, 2, 3), y = c(1, 2, 3), plotConfiguration = testPlotConfiguration) + ribbonPlot <- addRibbon(x = c(1, 2, 3), ymin = c(1, 2, 3), ymax = c(3, 4, 5), plotConfiguration = testPlotConfiguration) + errorbarPlot <- addErrorbar(x = c(1, 2, 3), ymin = c(1, 2, 3), ymax = c(3, 4, 5), plotConfiguration = testPlotConfiguration) + expect_error(initializePlot(plotConfiguration = "testPlotConfiguration")) - expect_error(addScatter(x=c(1,2,3),y=c(1,2,3),plotConfiguration = "testPlotConfiguration")) - expect_error(addLine(x=c(1,2,3),y=c(1,2,3),plotConfiguration = "testPlotConfiguration")) - expect_error(addRibbon(x=c(1,2,3),ymin=c(1,2,3),ymax=c(3,4,5),plotConfiguration = "testPlotConfiguration")) - expect_error(addErrorbar(x=c(1,2,3),ymin=c(1,2,3),ymax=c(3,4,5),plotConfiguration = "testPlotConfiguration")) - + expect_error(addScatter(x = c(1, 2, 3), y = c(1, 2, 3), plotConfiguration = "testPlotConfiguration")) + expect_error(addLine(x = c(1, 2, 3), y = c(1, 2, 3), plotConfiguration = "testPlotConfiguration")) + expect_error(addRibbon(x = c(1, 2, 3), ymin = c(1, 2, 3), ymax = c(3, 4, 5), plotConfiguration = "testPlotConfiguration")) + expect_error(addErrorbar(x = c(1, 2, 3), ymin = c(1, 2, 3), ymax = c(3, 4, 5), plotConfiguration = "testPlotConfiguration")) + # Same Labels expect_equivalent(emptyPlot$plotConfiguration$labels, testPlotConfiguration$labels) expect_equivalent(scatterPlot$plotConfiguration$labels, testPlotConfiguration$labels) expect_equivalent(linePlot$plotConfiguration$labels, testPlotConfiguration$labels) expect_equivalent(ribbonPlot$plotConfiguration$labels, testPlotConfiguration$labels) expect_equivalent(errorbarPlot$plotConfiguration$labels, testPlotConfiguration$labels) - + # Same Background expect_equivalent(emptyPlot$plotConfiguration$background, testPlotConfiguration$background) expect_equivalent(scatterPlot$plotConfiguration$background, testPlotConfiguration$background) expect_equivalent(linePlot$plotConfiguration$background, testPlotConfiguration$background) expect_equivalent(ribbonPlot$plotConfiguration$background, testPlotConfiguration$background) expect_equivalent(errorbarPlot$plotConfiguration$background, testPlotConfiguration$background) - + # Same xAxis expect_equivalent(emptyPlot$plotConfiguration$xAxis, testPlotConfiguration$xAxis) expect_equivalent(scatterPlot$plotConfiguration$xAxis, testPlotConfiguration$xAxis) expect_equivalent(linePlot$plotConfiguration$xAxis, testPlotConfiguration$xAxis) expect_equivalent(ribbonPlot$plotConfiguration$xAxis, testPlotConfiguration$xAxis) expect_equivalent(errorbarPlot$plotConfiguration$xAxis, testPlotConfiguration$xAxis) - + # Same yAxis expect_equivalent(emptyPlot$plotConfiguration$yAxis, testPlotConfiguration$yAxis) expect_equivalent(scatterPlot$plotConfiguration$yAxis, testPlotConfiguration$yAxis) diff --git a/tests/testthat/test-font-label.R b/tests/testthat/test-font-label.R index 44cb2540..28174ca4 100644 --- a/tests/testthat/test-font-label.R +++ b/tests/testthat/test-font-label.R @@ -11,6 +11,7 @@ test_that("Font default works", { expect_is(defaultFont, "Font") expect_is(defaultFont$size, "numeric") + expect_is(defaultFont$angle, "numeric") expect_is(defaultFont$color, "character") expect_is(defaultFont$fontFace, "character") expect_is(defaultFont$fontFamily, "character") @@ -26,8 +27,6 @@ test_that("Label default works", { test_that("Label gives error when initialized with wrong arguments", { expect_error(Label$new(font = "")) - expect_error(Label$new( - font = Font$new(color = "blue"), - color = "red" - )) + expect_error(Font$new(color = 3)) + expect_error(Font$new(size = "3")) }) diff --git a/tests/testthat/test-pkratio.R b/tests/testthat/test-pkratio.R index 84b3c6e3..7ece401c 100644 --- a/tests/testthat/test-pkratio.R +++ b/tests/testthat/test-pkratio.R @@ -3,8 +3,6 @@ context("PK Ratio Plot") # Load data of comprehensive examples load("pkRatioDataExample.RData") -useTheme(tlfTheme) - test_that("plotPKRatio() function works properly", { pkrp <- plotPKRatio(data = data.frame( x = c(1, 2, 10, 20, 100), @@ -34,7 +32,7 @@ test_that("PK Ratio default settings work", { expect_null(pkRatioMapping$x) expect_null(pkRatioMapping$y) - expect_equal(pkRatioMapping$pkRatioValues, list( + expect_equal(pkRatioMapping$lines, list( pkRatio1 = 1, pkRatio2 = c(1.5, 1 / 1.5), pkRatio3 = c(2, 1 / 2) @@ -56,11 +54,7 @@ test_that("PK Ratio default settings work", { }) test_that("PK Ratio typical test works", { - - # tlf theme - useTheme(tlfTheme) - - # Data mapping: +# Data mapping: # x = Age, y = Ratio, color = Gender, shape = c(Dose, Compound) pkRatioMap <- PKRatioDataMapping$new( x = "Age", diff --git a/tests/testthat/test-tornado.R b/tests/testthat/test-tornado.R index c86a86a6..a0089bbc 100644 --- a/tests/testthat/test-tornado.R +++ b/tests/testthat/test-tornado.R @@ -2,31 +2,34 @@ context("Tornado plots") # Create a data.frames for the plot tests tornadoPopData <- data.frame( - sensitivity = c(c(1,2,3, -1,-2,-3), c(1,2,3, -1,-2,-3)-0.2), - path = rep(rep(c("liver","kidney"),each=3),2), - quantile = rep(rep(c("5th","50th","95th"),2),2), - population = rep(c("Adults", "Peds"),each=6)) + sensitivity = c(c(1, 2, 3, -1, -2, -3), c(1, 2, 3, -1, -2, -3) - 0.2), + path = rep(rep(c("liver", "kidney"), each = 3), 2), + quantile = rep(rep(c("5th", "50th", "95th"), 2), 2), + population = rep(c("Adults", "Peds"), each = 6) +) -tornadoMeanData <- tornadoPopData[tornadoPopData$population %in% "Adults" & - tornadoPopData$quantile %in% "50th",] +tornadoMeanData <- tornadoPopData[tornadoPopData$population %in% "Adults" & + tornadoPopData$quantile %in% "50th", ] test_that("TornadoDataMapping features", { - dataMapping0 <- TornadoDataMapping$new(x="sensitivity", y="path") - dataMappingWithOption <- TornadoDataMapping$new(x="sensitivity", y="path",sorted=FALSE) - - dataMappingColor <- TornadoDataMapping$new(x="sensitivity",y="path",color = "path") - - dataMappingShape <- TornadoDataMapping$new(x= "sensitivity", y = "path", - color="population",shape="quantile") - + dataMapping0 <- TornadoDataMapping$new(x = "sensitivity", y = "path") + dataMappingWithOption <- TornadoDataMapping$new(x = "sensitivity", y = "path", sorted = FALSE) + + dataMappingColor <- TornadoDataMapping$new(x = "sensitivity", y = "path", color = "path") + + dataMappingShape <- TornadoDataMapping$new( + x = "sensitivity", y = "path", + color = "population", shape = "quantile" + ) + expect_equal(dataMapping0$x, "sensitivity") expect_equal(dataMapping0$y, "path") expect_true(dataMapping0$sorted) - + expect_equal(dataMappingWithOption$x, "sensitivity") expect_equal(dataMappingWithOption$y, "path") expect_false(dataMappingWithOption$sorted) - + expect_equal(dataMappingColor$x, "sensitivity") expect_equal(dataMappingColor$y, "path") # For tornado, if not specified, fill, shape and color properties are linked @@ -34,7 +37,7 @@ test_that("TornadoDataMapping features", { expect_equal(dataMappingColor$groupMapping$color$group, "path") expect_equal(dataMappingColor$groupMapping$fill$group, "path") expect_equal(dataMappingColor$groupMapping$shape$group, "path") - + expect_equal(dataMappingShape$x, "sensitivity") expect_equal(dataMappingShape$y, "path") # Since it is specified, shape variable is different here @@ -45,35 +48,38 @@ test_that("TornadoDataMapping features", { test_that("Regular tornado plots with their options work properly", { # Direct Tornado Plot - defaultPlot <- plotTornado(x=tornadoMeanData$sensitivity,y=tornadoMeanData$path) + defaultPlot <- plotTornado(x = tornadoMeanData$sensitivity, y = tornadoMeanData$path) # Options/Features - unsortedPlot <- plotTornado(x=tornadoMeanData$sensitivity,y=tornadoMeanData$path,sorted=FALSE) - colorPalettePlot <- plotTornado(x=tornadoMeanData$sensitivity,y=tornadoMeanData$path,colorPalette="Dark2") - pointPlot <- plotTornado(x=tornadoMeanData$sensitivity,y=tornadoMeanData$path,bar=FALSE) - + unsortedPlot <- plotTornado(x = tornadoMeanData$sensitivity, y = tornadoMeanData$path, sorted = FALSE) + colorPalettePlot <- plotTornado(x = tornadoMeanData$sensitivity, y = tornadoMeanData$path, colorPalette = "Dark2") + pointPlot <- plotTornado(x = tornadoMeanData$sensitivity, y = tornadoMeanData$path, bar = FALSE) + # Higher level with dataMapping used in population sensitivity plots # bar is an input option that can be directly provided to plotConfig input - popSensitivityPlot <- plotTornado(data = tornadoPopData, - bar = FALSE, - dataMapping = TornadoDataMapping$new(x = "sensitivity", - y = "path", - color = "quantile", - shape = "population")) - + popSensitivityPlot <- plotTornado( + data = tornadoPopData, + bar = FALSE, + dataMapping = TornadoDataMapping$new( + x = "sensitivity", + y = "path", + color = "quantile", + shape = "population" + ) + ) + expect_is(defaultPlot, "ggplot") expect_is(unsortedPlot, "ggplot") expect_is(colorPalettePlot, "ggplot") expect_is(pointPlot, "ggplot") expect_is(popSensitivityPlot, "ggplot") - + expect_is(defaultPlot$plotConfiguration, "TornadoPlotConfiguration") expect_is(unsortedPlot$plotConfiguration, "TornadoPlotConfiguration") expect_is(colorPalettePlot$plotConfiguration, "TornadoPlotConfiguration") expect_is(pointPlot$plotConfiguration, "TornadoPlotConfiguration") expect_is(popSensitivityPlot$plotConfiguration, "TornadoPlotConfiguration") - + expect_equal(colorPalettePlot$plotConfiguration$colorPalette, "Dark2") expect_false(pointPlot$plotConfiguration$bar) expect_false(popSensitivityPlot$plotConfiguration$bar) - }) diff --git a/vignettes/atom-plots.Rmd b/vignettes/atom-plots.Rmd index 9c2359c1..2c6e78af 100644 --- a/vignettes/atom-plots.Rmd +++ b/vignettes/atom-plots.Rmd @@ -1,8 +1,7 @@ --- title: "Atom plots" -output: - rmarkdown::html_vignette: - number_sections: true +author: "OSPSuiteR 2019" +output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{atom-plots} %\VignetteEngine{knitr::rmarkdown} @@ -17,9 +16,13 @@ knitr::opts_chunk$set( ``` ```{r setup} -library(tlf) +require(tlf) ``` +```{r load theme, echo=FALSE} +vignetteTheme <- loadThemeFromJson(system.file("extdata", "template-theme.json", package = "tlf")) +useTheme(vignetteTheme) +``` This vignette tackles how to use atom plots to perform simple to more complex plots with the `tlf`-library. # Introduction to atom plots @@ -35,27 +38,33 @@ In the sequel, the following atoms are detailed: # Initialize a plot object: *initializePlot* -The `tlf` method *initializePlot* aims at creating an empty plot with properties defined by a *PlotConfiguration* R6 class or subclass object. -The output plot is a regular `ggplot` object to which a *plotConfiguration* field is implanted. -Since this method is at the core of every atom and molecule plots, any plot generated using the `tlf`-library will include such a *plotConfiguration*. +The `tlf` method *initializePlot* aims at creating an empty plot with properties defined by a *PlotConfiguration* R6 class or subclass object. +More details on *PlotConfiguration* objects are available in a separate vignette. +The default option for *initializePlot()* does not require a *plotConfiguration* object to be specifically input by the user; +in which case, *plotConfiguration* will be derived automatically from the current theme. -If no *plotConfiguration* is provided to the method *initializePlot*, the default configuration from the current theme will be used. +The output plot from *initializePlot()* is a regular `ggplot` object to which a *plotConfiguration* field is inclduded. +Since this method is at the core of every atom and molecule plots of the `tlf`-library, any plot generated using this package will include a *plotConfiguration* field. Below are a few examples of use case of *initializePlot*: -```{r} -# No specific configuration +```{r initializePlot} +# Inintialize an empty plot without specific configuration, use the current theme emptyPlot <- initializePlot() -# PlotConfiguration +# Create a PlotConfiguration object with some specifications myConfiguration <- PlotConfiguration$new(title = "My empty plot", xlabel = "X", ylabel = "Y") +# Use the specification to create the plot emptyPlotWithLabels <- initializePlot(myConfiguration) -# Smart PlotConfiguration +# PlotConfiguration class has a smart mapping feature, +# directly deriving labels from data and its metaData and its dataMapping time <- seq(0,20, 0.1) myData <- data.frame(x = time, y = 2*cos(time)) +# If metaData includes dimension and unit, +# they can be use by the smart configuration to generate labels as "dimension [unit]" myMetaData <- list(x = list(dimension = "Time", unit = "min"), y = list(dimension = "Amplitude", @@ -63,46 +72,36 @@ myMetaData <- list(x = list(dimension = "Time", myMapping <- XYGDataMapping$new(x = "x", y = "y") +# In this example, the configuration will use the x/y mapping from dataMapping +# to fetch dimension and unit from metaData mySmartConfiguration <- PlotConfiguration$new(title = "My smart plot", data = myData, metaData = myMetaData, dataMapping = myMapping) smartEmptyPlot <- initializePlot(mySmartConfiguration) - -# Using another theme to change default -useTheme(tlfTheme) -myNewSmartConfiguration <- PlotConfiguration$new(title = "My smart plot", - data = myData, - metaData = myMetaData, - dataMapping = myMapping) -smartEmptyPlotNewTheme <- initializePlot(myNewSmartConfiguration) -``` - -```{r, echo=FALSE} -useTheme(defaultTheme) ``` -```{r, echo=FALSE, fig.cap="top left: emptyPlot; top right: emptyPlotWithLabels; bottom left: smartEmptyPlot; bottom right: ", fig.width=7.5} -gridExtra::grid.arrange(emptyPlot, emptyPlotWithLabels, smartEmptyPlot, smartEmptyPlotNewTheme, ncol=2) +```{r initializePlot output, echo=FALSE, fig.cap="Left: emptyPlot; Middle: emptyPlotWithLabels; Right: smartEmptyPlot", fig.width=7.5} +gridExtra::grid.arrange(emptyPlot, emptyPlotWithLabels, smartEmptyPlot, ncol=3) ``` # Add scatter or lines to a plot object: *addScatter*, *addLine* -The functions *addScatter* and *addLines* can be used to add scatter and line layers. -They can be used directly, in which case the function *initializePlot* will be called from within these functions. Or they can be added on top of a previous plot object using the parameter *plotObject*. +The functions *addScatter* and *addLine* aims at providing an easy interface to add points or lines to a plot object. +If a plot object is specified in *plotObject* input, then the layer will be added on top of the previous plot. +In the case the input is `NULL` (default value), the function *initializePlot* is called internally. The following data will be used as an example in the next section: -```{r} -myCosData <- rbind.data.frame(data.frame(x = time, - y = 2*cos(time), - type = "cosinus"), - data.frame(x = time, - y = 2*sin(time), - type = "sinus"), - data.frame(x = time, - y = round(2*sin(time)), - type = "stairs")) +```{r get ExampleData, echo=FALSE} +myTestData <- read.csv(system.file("extdata", "test-data.csv", package = "tlf"), stringsAsFactors = FALSE) +myTestData <- data.frame(x = myTestData$Obs, + y = myTestData$Pred, + type = myTestData$Sex, + country = myTestData$Country) +``` +```{r show ExampleData, results='asis'} +knitr::kable(utils::head(myTestData)) ``` ## *addScatter* @@ -110,7 +109,7 @@ myCosData <- rbind.data.frame(data.frame(x = time, The primary input parameter of function *addScatter* is *data* and can be used along with its *metaData* and *dataMapping*. However, it is also possible to directly use the input parameters *x* and *y* instead to plot directly *y* as a function of *x*. -```{r} +```{r scatter mapping} # Naive mapping on x and y myMapping <- XYGDataMapping$new(x = "x", y = "y") @@ -120,40 +119,57 @@ myGroupMapping <- XYGDataMapping$new(x = "x", y = "y", color = "type") # Using the naive mapping -pNaive <- addScatter(data = myCosData, +pNaive <- addScatter(data = myTestData, metaData = myMetaData, dataMapping = myMapping) # Using tlf smart mapping (same as naive) -pSmart <- addScatter(data = myCosData, +pSmart <- addScatter(data = myTestData, metaData = myMetaData) # Using group in mapping -pGroup <- addScatter(data = myCosData, +pGroup <- addScatter(data = myTestData, metaData = myMetaData, dataMapping = myGroupMapping) # Using x and y (same as naive but without metaData, no label) -pXY <- addScatter(x = myCosData$x, - y = myCosData$y) +pXY <- addScatter(x = myTestData$x, + y = myTestData$y) ``` -```{r, echo=FALSE, fig.cap="top left: pNaive; top right: pSmart; bottom left: pGroup; bottom right: pXY", fig.width=7.5} +```{r show scatter mapping, echo=FALSE, fig.cap="top left: pNaive; top right: pSmart; bottom left: pGroup; bottom right: pXY", fig.width=7.5} gridExtra::grid.arrange(pNaive, pSmart, pGroup, pXY, ncol=2) ``` -In the other input parameters, *plotConfiguration* or a previous *plotObject* can be used to define the either which will be the plot configuration or on top of which previous plot the scatter layer should be added. +Input parameters of *addScatter* also include *plotConfiguration* and *plotObject* as previously described. +Input parameters *caption*, *color*, *size*, *shape* and *linetype* can overwrite the default aesthetic and legend values defined by *plotConfiguration*. +These parameters are optional and will be `NULL` by default, which will lead to use aesthetic from the current theme. +In particular, *dataMapping* also allows to create a legend caption, the input parameter *caption* can overwrtie such legend caption. -```{r} +```{r addScatter options} +males <- myTestData$type %in% "Male" +females <- myTestData$type %in% "Female" # Using x and y -pScatter1 <- addScatter(x = myCosData$x[myCosData$type %in% "cosinus"], - y = myCosData$y[myCosData$type %in% "cosinus"]) - - +pScatter1 <- addScatter(x = myTestData$x[males], + y = myTestData$y[males], + color = "blue", + size = 3, + caption = "Male") +pScatter2 <- addScatter(x = myTestData$x[females], + y = myTestData$y[females], + color = "pink", + size = 3, + caption = "Female") +pScatter3 <- addScatter(x = myTestData$x[females], + y = myTestData$y[females], + color = "pink", + size = 3, + caption = "Female", + plotObject = pScatter1) ``` -```{r, echo=FALSE, fig.cap="top left: pNaive; top right: pSmart; bottom left: pGroup; bottom right: pXY", fig.width=7.5} -gridExtra::grid.arrange(pScatter1, pScatter1, pScatter1, pScatter1, ncol=2) +```{r show addScatter, echo=FALSE, fig.cap="Left: pScatter1; Middle: pScatter2; Right: pScatter3", fig.width=7.5} +gridExtra::grid.arrange(pScatter1, pScatter2, pScatter3, ncol=3) ``` Finally, the last input parameters include *caption*, *color*, *size*, *shape* and *linetype*. @@ -164,40 +180,13 @@ In particular, *dataMapping* also allows to create a legend caption, the input p The function *addLine* is almost identical to *addScatter*. It differs regarding its default aesthetic properties: lines are replacing the points, even if points can be used. -It also differs by the possibility of using only *y* input for y-intercepts. - -Using the example with *myData*, - -```{r} - -line1 <- addLine(data = myCosData[myCosData$type %in% "cosinus",], - metaData = myMetaData, - dataMapping = myMapping, - caption = "cosinus") -# y intercepts -line2 <- addLine(y = c(-2,0,2), - caption = "y-intercepts", - color = "darkblue", - size = 2, - linetype = "longdash", - plotObject = line1) - -line3 <- addLine(data = myCosData, - metaData = myMetaData, - dataMapping = myGroupMapping) - -line4 <- addLine(x = seq(0, 5*pi, pi), - y = rep(c(-1, 1), 3), - caption = "frame", - color = "brown4", - linetype = "solid", - plotObject = line3) +It also differs by the possibility of using *x* or *y* input for x/y-intercepts. -``` +# Add ribbon or errorbars to a plot object: *addRibbon*, *addErrorbar* -```{r, echo=FALSE, fig.cap="top left: line1; top right: line2; bottom left: line3; bottom right: line4", fig.width=7.5} -gridExtra::grid.arrange(line1, line2, line3, line4, ncol=2) -``` +These 2 atoms work in a similar fashion to *addScatter* and *addLine* but they use a different mapping that require *ymin* and *ymax* insteada of *y*. + +## *addRibbon* -# Add ribbon or errorbarsa plot object: *addRibbon*, *addErrorbar* +## *addErrorbar* diff --git a/vignettes/box-whisker-vignette.Rmd b/vignettes/box-whisker-vignette.Rmd index e1e7a935..5753201c 100644 --- a/vignettes/box-whisker-vignette.Rmd +++ b/vignettes/box-whisker-vignette.Rmd @@ -1,5 +1,6 @@ --- title: "Box-whisker plots" +author: "OSPSuiteR 2019" output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{box-whisker-vignette} @@ -7,15 +8,20 @@ vignette: > %\VignetteEncoding{UTF-8} --- -```{r setup, include = FALSE} +```{r, include = FALSE} knitr::opts_chunk$set( collapse = TRUE, comment = "#>" ) -library(tlf) -useTheme(tlfTheme) +``` +```{r setup} +require(tlf) ``` +```{r load theme, echo=FALSE} +vignetteTheme <- loadThemeFromJson(system.file("extdata", "template-theme.json", package = "tlf")) +useTheme(vignetteTheme) +``` # 1. Introduction ## 1.1. Objectives @@ -41,35 +47,43 @@ Beside these common input, it is possible to overwrite the aggregation functions - For the whiskers, `ymin` and `ymax` use the 5th and 95th percentiles. - For outliers, points lower than the 25th percentile - 1.5IQR and points higher than 75th percentiles + 1.5IQR (where IQR is the inter-quartile range) are flagged and plotted. -In order to help with the boxplot aggregation functions, a bank of predefined function names is already available in the tlfStatFunctions (as an enum). Consequently, a tree with the available predefined function names will appear when writing `tlfStatFunctions$`. -```{r, results='asis', echo=FALSE} -tlfFunctionsTable <- data.frame("tlfStatFunctions" = as.character(sapply(tlfStatFunctions, identity))) - -knitr::kable(tlfFunctionsTable) -``` +In order to help with the boxplot aggregation functions, a bank of predefined function names is already available in the tlfStatFunctions (as an enum). Consequently, a tree with the available predefined function names will appear when writing `tlfStatFunctions$`: `r paste0("'", names(tlfStatFunctions), "'", sep = ", ", collapse = "")` # 3. Examples ## 3.1. Data To illustrate the workflow leading to performing boxplots. The `pkRatioDataExample.RData` example can be loaded from the `data` folder. It includes the dataset `pkRatioData` and its metaData `pkRatioMetaData`. -```{r, results='asis'} +```{r load data, results='asis'} # Load example -load("../data/pkRatioDataExample.RData") +pkRatioData <- read.csv(system.file("extdata", "test-data.csv", package = "tlf"), stringsAsFactors = FALSE) # pkRatioData knitr::kable(utils::head(pkRatioData), digits = 2) +``` -# pkRatioMetaData is a list of variables contianing a lists with unit, dimension and lloq for each -# Unit and dimension of pkRatioData are consequently the following: -knitr::kable(data.frame(unit = t(rbind(sapply(pkRatioMetaData, function(x){x$unit}))), - dimension = t(rbind(sapply(pkRatioMetaData, function(x){x$dimension}))))) +```{r load metadata, echo=FALSE} +# Load example +pkRatioMetaData <- list(Age = list(dimension = "Age", + unit = "yrs"), + Obs = list(dimension = "Clearance", + unit = "dL/h/kg"), + Pred = list(dimension = "Clearance", + unit = "dL/h/kg"), + Ratio = list(dimension = "Ratio", + unit = "") + ) +``` +```{r show metadata, results='asis'} +knitr::kable(data.frame(Variable = c("Age", "Obs", "Pred", "Ratio"), + Dimension = c("Age", "Clearance", "Clearance", "Ratio"), + Unit = c("yrs", "dL/h/kg", "dL/h/kg", ""))) ``` ## 3.2. Minimal example In the minimal example, only the basic `y` variable name is indicated. Here, `"Age"` was chosen for the boxplot. -```{r, fig.height=5, fig.width=7.5} +```{r minimal example, fig.height=5, fig.width=7.5} minMap <- BoxWhiskerDataMapping$new(y = "Age") minBoxplot <- plotBoxWhisker(data = pkRatioData, @@ -82,67 +96,58 @@ minBoxplot As explained in section 2, `x` and/or `fill` can be provided. If providing only `x`, the plot will use the `x` variable for aggregation and the boxplots will be disposed according to `x`. If providing `fill`, the plot will use the `fill` groupMapping for aggregation and the boxplots will be disposed around the same `x` but comparing the color filling. Consequently, the `fill` variable is useful when performing a double comparison. -In the example below, `"Population"` and `"Gender"` can both be used for comparison of `"Age"`. +In the example below, `"Country"` and `"Sex"` can both be used for comparison of `"Age"`. -```{r} -xPopMap <- BoxWhiskerDataMapping$new(x = "Population", +```{r difference x vs fill} +xPopMap <- BoxWhiskerDataMapping$new(x = "Country", y = "Age") -xGenderMap <- BoxWhiskerDataMapping$new(x = "Gender", - y = "Age") -fillPopMap <- BoxWhiskerDataMapping$new(y = "Age", - fill = "Population") -fillGenderMap <- BoxWhiskerDataMapping$new(y = "Age", - fill = "Gender") -xPopFillGenderMap <- BoxWhiskerDataMapping$new(x = "Population", - y = "Age", - fill = "Gender") -xGenderFillPopMap <- BoxWhiskerDataMapping$new(x = "Gender", - y = "Age", - fill = "Population") - -xPopPlot <- plotBoxWhisker(data = pkRatioData, - metaData = pkRatioMetaData, - dataMapping = xPopMap) - -xGenderPlot <- plotBoxWhisker(data = pkRatioData, - metaData = pkRatioMetaData, - dataMapping = xGenderMap) -fillPopPlot <- plotBoxWhisker(data = pkRatioData, - metaData = pkRatioMetaData, - dataMapping = fillPopMap) - -fillGenderPlot <- plotBoxWhisker(data = pkRatioData, - metaData = pkRatioMetaData, - dataMapping = fillGenderMap) +xSexMap <- BoxWhiskerDataMapping$new(x = "Sex", + y = "Age") -xPopFillGenderPlot <- plotBoxWhisker(data = pkRatioData, - metaData = pkRatioMetaData, - dataMapping = xPopFillGenderMap) +fillPopMap <- BoxWhiskerDataMapping$new(y = "Age", + fill = "Country") -xGenderFillPopPlot <- plotBoxWhisker(data = pkRatioData, - metaData = pkRatioMetaData, - dataMapping = xGenderFillPopMap) +fillSexMap <- BoxWhiskerDataMapping$new(y = "Age", + fill = "Sex") +xPopFillSexMap <- BoxWhiskerDataMapping$new(x = "Country", + y = "Age", + fill = "Sex") +xSexFillPopMap <- BoxWhiskerDataMapping$new(x = "Sex", + y = "Age", + fill = "Country") ``` -```{r, fig.height=5, fig.width=7.5, fig.cap="Boxplot mapping Population as x"} -xPopPlot +```{r boxplot country x, fig.height=5, fig.width=7.5, fig.cap="Boxplot mapping Country as x"} +plotBoxWhisker(data = pkRatioData, + metaData = pkRatioMetaData, + dataMapping = xPopMap) ``` -```{r, fig.height=5, fig.width=7.5, fig.cap="Boxplot mapping Gender as x"} -xGenderPlot +```{r boxplot sex x, fig.height=5, fig.width=7.5, fig.cap="Boxplot mapping Sex as x"} +plotBoxWhisker(data = pkRatioData, + metaData = pkRatioMetaData, + dataMapping = xSexMap) ``` -```{r, fig.height=5, fig.width=7.5, fig.cap="Boxplot mapping Population as fill"} -fillPopPlot +```{r boxplot country fill, fig.height=5, fig.width=7.5, fig.cap="Boxplot mapping Country as fill"} +plotBoxWhisker(data = pkRatioData, + metaData = pkRatioMetaData, + dataMapping = fillPopMap) ``` -```{r, fig.height=5, fig.width=7.5, fig.cap="Boxplot mapping Gender as fill"} -fillGenderPlot +```{r boxplot sex fill, fig.height=5, fig.width=7.5, fig.cap="Boxplot mapping Sex as fill"} +plotBoxWhisker(data = pkRatioData, + metaData = pkRatioMetaData, + dataMapping = fillSexMap) ``` -```{r, fig.height=5, fig.width=7.5, fig.cap="Boxplot mapping Population as x and Gender as fill"} -xPopFillGenderPlot +```{r boxplot country x sex fill, fig.height=5, fig.width=7.5, fig.cap="Boxplot mapping Country as x and Sex as fill"} +plotBoxWhisker(data = pkRatioData, + metaData = pkRatioMetaData, + dataMapping = xPopFillSexMap) ``` -```{r, fig.height=5, fig.width=7.5, fig.cap="Boxplot mapping Gender as x and Population as fill"} -xGenderFillPopPlot +```{r boxplot country fill sex x, fig.height=5, fig.width=7.5, fig.cap="Boxplot mapping Sex as x and Country as fill"} +plotBoxWhisker(data = pkRatioData, + metaData = pkRatioMetaData, + dataMapping = xSexFillPopMap) ``` ## 3.4. Boxplot functions @@ -150,11 +155,11 @@ In some cases, 5th and 95th percentiles are not wanted for whiskers for instance In these cases, it is easy to overwrite the default functions by specifying either using an home made function or directly using predifined functions as suggested in section 2.2. In the 2 following examples, the boxplot will use the mean for the middle line and mean +/- 1.96 standard deviation for the whiskers: -```{r, fig.height=5, fig.width=7.5, fig.cap="Boxplot mapping Population as x, Gender as fill and assuming normal distribution"} +```{r aggregation functions 1, fig.height=5, fig.width=7.5, fig.cap="Boxplot mapping Country as x, Sex as fill and assuming normal distribution"} -normMap <- BoxWhiskerDataMapping$new(x = "Population", +normMap <- BoxWhiskerDataMapping$new(x = "Country", y = "Age", - fill = "Gender", + fill = "Sex", ymin = tlfStatFunctions$`mean-1.96sd`, middle = tlfStatFunctions$mean, ymax = tlfStatFunctions$`mean+1.96sd`) @@ -166,11 +171,11 @@ normBoxplot ``` In this example, the boxplot use also mean +/- standard deviation for the box edges -```{r, fig.height=5, fig.width=7.5, fig.cap="Boxplot mapping Population as x, Gender as fill and assuming normal distribution"} +```{r aggregation functions 2, fig.height=5, fig.width=7.5, fig.cap="Boxplot mapping Country as x, Sex as fill and assuming normal distribution"} -normMap2 <- BoxWhiskerDataMapping$new(x = "Population", +normMap2 <- BoxWhiskerDataMapping$new(x = "Country", y = "Age", - fill = "Gender", + fill = "Sex", ymin = tlfStatFunctions$`mean-1.96sd`, lower = tlfStatFunctions$`mean-sd`, middle = tlfStatFunctions$mean, @@ -189,11 +194,11 @@ Default outliers are flagged when oustide the range from 25th percentiles - 1.5I However, these default can also be overwritten. In the following example, outliers will be flagged when values are out of the 10th-90th percentiles, while whiskers will go until these same percentiles: -```{r, fig.height=5, fig.width=7.5, fig.cap="Boxplot mapping Population as x, Gender as fill and assuming normal distribution"} +```{r outlier function, fig.height=5, fig.width=7.5, fig.cap="Boxplot mapping Country as x, Sex as fill and assuming normal distribution"} -outlierMap <- BoxWhiskerDataMapping$new(x = "Population", +outlierMap <- BoxWhiskerDataMapping$new(x = "Country", y = "Age", - fill = "Gender", + fill = "Sex", ymin = tlfStatFunctions$`Percentile10%`, ymax = tlfStatFunctions$`Percentile90%`, minOutlierLimit = tlfStatFunctions$`Percentile10%`, @@ -207,6 +212,30 @@ outlierBoxplot ## 3.4. plotConfiguration of boxplots: `BoxWhiskerPlotConfiguration` +To define the properties of the boxes and points of the box whisker plots, a *BoxWhiskerPlotConfiguration* object can be defined to overwrite the default properties. +The *ribbons* and *points* fields will define how the boxes and outliers will be handled. + +Using the previous example where country was defined in X and gender as a color. +```{r boxplot update configuration, fig.height=5, fig.width=7.5, fig.cap="Boxplot with updated plot configuration"} +# Define a PlotConfiguration object using smart mapping +boxplotConfiguration <- BoxWhiskerPlotConfiguration$new(data = pkRatioData, + metaData = pkRatioMetaData, + dataMapping = xPopFillSexMap) + +# Change the properties of the box colors +boxplotConfiguration$ribbons$fill <- c("pink", "dodgerblue") +boxplotConfiguration$ribbons$color <- "black" + +# Change the properties of the points (outliers) +boxplotConfiguration$points$size <- 2 +boxplotConfiguration$points$shape <- Shapes$diamond + +plotBoxWhisker(data = pkRatioData, + metaData = pkRatioMetaData, + dataMapping = xPopFillSexMap, + plotConfiguration = boxplotConfiguration) +``` + # 4. Derive use of `BoxWhiskerDataMapping` Since the boxplot datamapping performs an aggregation of the data, it possible to get directly the resulting aggregated statistic as a table using `getBoxWhiskerLimits()` @@ -214,16 +243,16 @@ Similarly, it can be used to flag any values out of a certain range using `getOu For instance, using the example from section 3.5., one can get the following results -```{r, results='as.is'} +```{r box plot measure, results='as.is'} boxplotSummary <- outlierMap$getBoxWhiskerLimits(pkRatioData) knitr::kable(boxplotSummary, digits = 2) ``` -```{r, results='as.is'} +```{r get outliers, results='as.is'} outliers <- outlierMap$getOutliers(pkRatioData) outliers <- outliers[, c("Age", "minOutlierLimit", "maxOutlierLimit", "minOutliers", "maxOutliers")] -knitr::kable(outliers, digits = 2) +knitr::kable(utils::head(outliers), digits = 2) ``` diff --git a/vignettes/pk-ratio-vignette.Rmd b/vignettes/pk-ratio-vignette.Rmd index 89880df5..67f9973e 100644 --- a/vignettes/pk-ratio-vignette.Rmd +++ b/vignettes/pk-ratio-vignette.Rmd @@ -1,7 +1,6 @@ --- title: "PK Ratio plots" author: "OSPSuiteR 2019" -date: "`r Sys.Date()`" output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{pk-ratio-vignette} @@ -9,12 +8,19 @@ vignette: > %\VignetteEngine{knitr::rmarkdown} --- -```{r setup, include = FALSE} +```{r, include = FALSE} knitr::opts_chunk$set( collapse = TRUE, comment = "#>" ) -library(tlf) +``` +```{r setup} +require(tlf) +``` + +```{r load theme, echo=FALSE} +vignetteTheme <- loadThemeFromJson(system.file("extdata", "template-theme.json", package = "tlf")) +useTheme(vignetteTheme) ``` # 1. Introduction @@ -26,25 +32,48 @@ This vignette focuses PK ratio plots examples. Detailed documentation on typical # 2. Illustration of basic PK ratio plots ## 2.1. Data -To illustrate the workflow leading to performing PK ratio plots. The `pkRatioDataExample.RData` example can be loaded from the `data` folder. -It includes the dataset `pkRatioData` and its metaData `pkRatioMetaData`. +The data showed in the sequel is available at the following path: `system.file("extdata", "test-data.csv", package = "tlf")`. +In the code below, the data is loaded and will be named `pkRatioData`. -```{r, results='asis'} +```{r load data, results='asis'} # Load example -load("../data/pkRatioDataExample.RData") +pkRatioData <- read.csv(system.file("extdata", "test-data.csv", package = "tlf"), stringsAsFactors = FALSE) # pkRatioData knitr::kable(utils::head(pkRatioData), digits = 2) +``` -# pkRatioMetaData is a list of variables contianing a lists with unit, dimension and lloq for each -# Unit and dimension of pkRatioData are consequently the following: -knitr::kable(data.frame(unit = t(rbind(sapply(pkRatioMetaData, function(x){x$unit}))), - dimension = t(rbind(sapply(pkRatioMetaData, function(x){x$dimension}))))) +A list of information about `pkRatioData` can be provided through `metaData`. + +```{r load metadata, echo=FALSE} +# Load example +pkRatioMetaData <- list(Age = list(dimension = "Age", + unit = "yrs"), + Obs = list(dimension = "Clearance", + unit = "dL/h/kg"), + Pred = list(dimension = "Clearance", + unit = "dL/h/kg"), + Ratio = list(dimension = "Ratio", + unit = "") + ) +``` +```{r show metadata, results='asis'} +knitr::kable(data.frame(Variable = c("Age", "Obs", "Pred", "Ratio"), + Dimension = c("Age", "Clearance", "Clearance", "Ratio"), + Unit = c("yrs", "dL/h/kg", "dL/h/kg", ""))) ``` +## User interface: *runPKRatioPlot()* + +A user interface is available using the function `runPKRatioPlot()` and provides an easy way to understand and tune the feature of PK Ratio plots. +```{r embedded app, echo=FALSE} +#runPKRatioPlot() +# or knitr::include_app() +``` ## 2.2. `plotPKRatio` -The function plotting PK ratios is: `plotPKRatio`. + +The function plotting PK ratios is: `plotPKRatio()`. Basic documentation of the function can be found using: `?plotPKRatio`. The typical usage of this function is: `plotPKRatio(data, metaData = NULL, dataMapping = NULL, plotConfiguration = NULL)`. The output of the function is a `ggplot` object. @@ -55,39 +84,43 @@ If the `data` has only two columns not named `"x"` and `"y"`, it will assume the Then, `PKRatioPlotConfiguration` is initialized if not provided, defining a standard configuration with `PK Ratio Plot` as title, the current date as subtitle and using predifned fonts as defined by the current theme. ## 2.3. Minimal example + The minimal example can work using directly the function `plotPKRatio(data = pkRatioData[, c("Age", "Ratio")])`. -```{r, fig.height=5, fig.width=7.5} +```{r minimal example, fig.height=5, fig.width=7.5} plotPKRatio(data = pkRatioData[,c("Age", "Ratio")]) ``` ## 2.4. Examples with `dataMapping` -For PK ratio, the `dataMapping` class `PKRatioDataMapping` includes 4 fields: `x`, `y`, `groupMapping` and `pkRatioLines`. -`x` and `y` define which variables from the data will be plotted in X- and Y-axes, `groupMapping` is a class mapping which aesthtic property will split which variables, and `pkRatioLines` defines horizontal lines performed in PK ratio plots. + +For PK ratio, the `dataMapping` class `PKRatioDataMapping` includes 4 fields: `x`, `y`, `groupMapping` and `lines`. +`x` and `y` define which variables from the data will be plotted in X- and Y-axes, `groupMapping` is a class mapping which aesthtic property will split which variables, and `lines` defines horizontal lines performed in PK ratio plots. ### 2.4.1 `groupMapping` -The `groupMapping` input is assumed a `GroupMapping` class, meaning it should be initialized prior the dataMapping. -To simplify this process, `groupMapping` input can directly be initilized within the `dataMapping`. -Consequently, The following examples are identical: -```{r} + +Some variables can be used to cluster the data. +To this end, *PKRatioDataMapping* objects include *GroupMapping* objects that can define how to cluster based on a variable or a data.frame. +As illustrated below, most of the time, the direct input of `color` and `shape` is faster to define such objects. +Consequently, the following examples are identical: +```{r group mapping} # Two-step process -colorMapping <- GroupMapping$new(color = "Gender") -dataMappingA <- PKRatioDataMapping$new(x = "Age", - y = "Ratio", - groupMapping = colorMapping) +colorMapping <- GroupMapping$new(color = "Sex") +dataMappingA <- PKRatioDataMapping$new(x = "Age", + y = "Ratio", + groupMapping = colorMapping) print(dataMappingA$groupMapping$color$label) # One-step process dataMappingB <- PKRatioDataMapping$new(x = "Age", - y = "Ratio", - color = "Gender") + y = "Ratio", + color = "Sex") print(dataMappingB$groupMapping$color$label) ``` Then, in this example, `plotPKRatio` can use the groupMapping to split the data by "Gender" and associate different colors to each "Gender": -```{r, fig.height=5, fig.width=7.5} +```{r dataMappingB, fig.height=5, fig.width=7.5} plotPKRatio(data = pkRatioData, dataMapping = dataMappingB) ``` @@ -95,11 +128,11 @@ plotPKRatio(data = pkRatioData, Multiple groupMappings can be performed for PK ratio: data can be regrouped by `color`, `shape` and/or `size`. The next example uses 2 groups in the groupMapping: One group splits "Gender" by `color`, the other splits `shape` by "Amount" and "Compound". -```{r, fig.height=5, fig.width=7.5} +```{r dataMapping2groups, fig.height=5, fig.width=7.5} dataMapping2groups <- PKRatioDataMapping$new(x = "Age", y = "Ratio", - color = "Gender", - shape = c("Dose", "Compound")) + color = "Sex", + shape = c("Country", "AgeBin")) plotPKRatio(data = pkRatioData, dataMapping = dataMapping2groups) ``` @@ -107,9 +140,9 @@ plotPKRatio(data = pkRatioData, The last examples uses another feature available in the `groupMapping` class. The class can be initilized using a `data.frame` where the last column of the data.frame will be used to split the data. In the following example, the data.frame is the following: ```{r, echo=FALSE, results='asis'} -groupDataFrame <- data.frame(Dose = c(50, 100, 50, 100, 50, 100, 50, 100), - Compound = c("Aspirin", "Aspirin", "Vancomycin", "Vancomycin", "Aspirin", "Aspirin", "Vancomycin", "Vancomycin"), - Gender = c("M", "M", "M", "M", "F", "F", "F", "F"), +groupDataFrame <- data.frame(AgeBin = c(50, 100, 50, 100, 50, 100, 50, 100), + Country = c("Aspirin", "Aspirin", "Vancomycin", "Vancomycin", "Aspirin", "Aspirin", "Vancomycin", "Vancomycin"), + Sex = c("M", "M", "M", "M", "F", "F", "F", "F"), Group = c("Males infused with 50mg of Aspirin", "Males infused with 100mg of Aspirin", "Males infused with 50mg of Vancomycin", "Males infused with 100mg of Vancomycin", "Females infused with 50mg of Aspirin", "Females infused with 100mg of Aspirin", @@ -118,91 +151,39 @@ knitr::kable(groupDataFrame) ``` The `dataMapping` introduced below will split the `color` and `shape` using the data frame. -```{r, fig.height=5, fig.width=7.5} +```{r dataMappingDF, fig.height=5, fig.width=7.5} dataMappingDF <- PKRatioDataMapping$new(x = "Age", - y = "Ratio", - color = groupDataFrame, - shape = groupDataFrame) + y = "Ratio", + color = groupDataFrame, + shape = groupDataFrame) plotPKRatio(data = pkRatioData, dataMapping = dataMappingDF) ``` -### 2.4.2 `pkRatioValues` +### 2.4.2 PK values defined in `lines` In PK ratio examples, usually horizontal lines are added allowing to flag values in and out of the [0.67-1.5] as well as [0.5-2.0] ranges. The value mapping these horizontal lines was predifined as a list: "pkRatioLine1" is 1, "pkRatioLine2" is c(0.67, 1.5) and "pkRatioLine3" is c(0.5, 2). Consequently, for any default `PKRatioDataMapping`, you have: -```{r} +```{r linesMapping} linesMapping <- PKRatioDataMapping$new() -linesMapping$pkRatioValues +linesMapping$lines ``` Overwriting these value is possible by updating the value either when initializing the mapping or afterwards. For instance: -```{r, fig.height=5, fig.width=7.5} -linesMapping <- PKRatioDataMapping$new(pkRatioValues = list(pkRatioLine1 = 1, pkRatioLine2 = c(0.2, 5)), +```{r linesMapping plot, fig.height=5, fig.width=7.5} +linesMapping <- PKRatioDataMapping$new(lines = list(pkRatio1 = 1, pkRatio2 = c(0.2, 5)), x = "Age", y = "Ratio", - color = "Gender") + color = "Sex") plotPKRatio(data = pkRatioData, dataMapping = linesMapping) ``` -## 2.5. Plot Configuration - -To configure the plot properties, `PlotConfiguration` objects derived from `R6Class` can be used. -They associate the following features: - -* `LabelConfiguration`, inherited `R6Class` defining the labels of the plot (title, subtitles, x axis, y axis) -* `LegendConfiguration`, `R6Class` defining the legend properties of the plot -* `BackgroundConfiguration`, `R6Class` defining the background properties of the plot (color, grid and watermark) -* `xAxisConfiguration`, `R6Class` defining the properties of the X axis (scale, limits, printed values) -* `yAxisConfiguration`, `R6Class` defining the properties of the Y axis (scale, limits, printed values) +## 2.5. Qualification of PK Ratios -Plot configuration uses default properties from theme but can be overwritten (either by indicating the updated input or by redifing the value after the creation of the object). - -## 2.5.1 Themes - -Plot configuration uses default properties from an `R6 class` Theme. -Currently, 3 main themes are predefined and available. However, it is possible to create one's own theme by initiliazing the `Theme` class. - -To set theme, use function `useTheme` as introduced in the following example: -```{r, fig.height=5, fig.width=7.5} -useTheme(bwTheme) -plotPKRatio(data = pkRatioData[,c("Age", "Ratio")]) -``` -```{r, fig.height=5, fig.width=7.5} -useTheme(tlfTheme) -plotPKRatio(data = pkRatioData[,c("Age", "Ratio")]) -``` - - -## 2.5.2 Labels -Default labels are implemented for titles and axes. -The default title is the type of the plot here "PK Ratio Plot", the default subtitle is the current date, as for the axes metaData are searched and the `dimension [unit]` of the metaData is provided as default. -However, it is possible to overwrite the text using the follwong example: -```{r, fig.height=5, fig.width=7.5} -labelConfiguration <- PKRatioPlotConfiguration$new(title = "New Title", - subtitle = "New subtitle", - xlabel = "New X-axis", - ylabel = "New Y-axis") -plotPKRatio(data = pkRatioData[,c("Age", "Ratio")], - plotConfiguration = labelConfiguration) -``` - -If needed, it is also possible to update the font properties either by using a `Label` class as input or by updating the `Label` output of the plotConfiguration. -For instance, the 2 following examples are equivalent: -```{r, fig.height=5, fig.width=7.5} -labelConfiguration1 <- PKRatioPlotConfiguration$new(title = Label$new(text = "Title as Label", - font = Font$new(color = "red"))) -labelConfiguration2 <- PKRatioPlotConfiguration$new(title = "Title as Label") -labelConfiguration2$labels$title$font$color <- "red" - -isTRUE(labelConfiguration1$labels$title$font$color == labelConfiguration2$labels$title$font$color) -``` - -# 3. Qualification of PK Ratios The qualification of the PK Ratios can be performed using `getPKRatioMeasure`. This function return a `data.frame` with the PK ratios within specific ranges. As a default, these ranges are within 1.5 and 2 folds. However, they can be updated using the option `ratioLimits =` when running the function. @@ -215,41 +196,12 @@ knitr::kable(x = PKRatioMeasure, caption = "Qualification of PK Ratios") ``` -# 4. Going further: DDI Ratio plot examples -PK ratio plots and DDI ratio plots are very similar in their structure. -The difference is the plotting of diagonal lines and limits as defined by the Guest et al. equation. -These plots introduce 4 new fields in the method: `xmin`, `xmax`, `ddiRatioLines`, `deltaGuest`. -`xmin` and `xmax` defining the range where the diagonal lines and Guest limits should be plotted, the default range is [0.1-10]. -`ddiRatioLines` the values of the ratios (similar as `pkRatioLines` the dfault is `c(1,2,0.5)`). -`deltaGuest` is the value of `delta` used in the Guest equation (default set as 1). - -The definition of such lines and limits is pre-defined within the dataMapping class for DDI ratios: `DDIRatioDataMapping`, as shown below: -```{r} -linesMapping <- DDIRatioDataMapping$new() -``` - -Then, keeping the workflow as provided in the PK ratio examples, DDI ratio plot can be performed in very few steps: -```{r, fig.height=5, fig.width=7.5} -useTheme(tlfTheme) - -# Process data -pkRatioData$Observed <- pkRatioData$Observed/10 -pkRatioData$Simulated <- pkRatioData$Simulated/10 - -# Define Mapping -ddiMapping <- DDIRatioDataMapping$new(x = "Observed", - y = "Simulated", - color = "Gender", - shape = c("Dose", "Compound")) -# Define configuration -ddiConfiguration <- DDIRatioPlotConfiguration$new(xlabel = "Obs", - ylabel = "Pred", - data = pkRatioData, - metaData = pkRatioMetaData, - dataMapping = ddiMapping) -# Plot -plotDDIRatio(data = pkRatioData, - metaData = pkRatioMetaData, - dataMapping = ddiMapping, - plotConfiguration = ddiConfiguration) -``` \ No newline at end of file + +## 2.6. Plot Configuration + +To configure the plot properties, `PKRatioPlotConfiguration` objects can be used. +They combine multiple features that set the plot properties. +PK ratio plos consists in *lines* and *points*. +As illustrated in the vignette related to *PlotConfiguration* objects and *Theme*, you can tune the aesthetic maps and their selections. +Colors, shapes and size of the PK ratio scatter points can be tuned in the plotConfiguration *points* field. +Likewise, colors, linetype and size of the PK ratio lines can be tuned in the plotConfiguration *lines* field. diff --git a/vignettes/plot-configuration.Rmd b/vignettes/plot-configuration.Rmd index 9d5a2668..b2c5535e 100644 --- a/vignettes/plot-configuration.Rmd +++ b/vignettes/plot-configuration.Rmd @@ -1,8 +1,7 @@ --- -title: "Plot configuration" -output: - rmarkdown::html_vignette: - number_sections: true +title: "Introduction to PlotConfiguration objects" +author: "OSPSuiteR 2019" +output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{plot-configuration} %\VignetteEngine{knitr::rmarkdown} @@ -15,15 +14,19 @@ knitr::opts_chunk$set( comment = "#>" ) ``` - ```{r setup} -library(tlf) +require(tlf) +``` + +```{r load theme, echo=FALSE} +vignetteTheme <- loadThemeFromJson(system.file("extdata", "template-theme.json", package = "tlf")) +useTheme(vignetteTheme) ``` This vignette tackles about *PlotConfiguration* objects and their implementation within the `tlf`-library. -# Introduction +# 1. Introduction *PlotConfiguration* objects are R6 class objects that define plot properties. @@ -31,8 +34,6 @@ To create such an object, the method *new()* is required. Multiple arguments can be passed on the method in order to directly define the properties. The properties default values can be handled and managed using the concept of themes. -The class possesses also a *print()* method that will print the configuration of the properties below. - As the example below illustrates, the following properties are accounted for by the *PlotConfiguration* class. Each of these properties is managed by a different R6 class object detailed in the next sections: @@ -42,7 +43,7 @@ Each of these properties is managed by a different R6 class object detailed in t - *legend* - *save* -```{r} +```{r empty configuration plots} myConfiguration <- PlotConfiguration$new() # myConfiguration$print() @@ -56,20 +57,20 @@ The *plotConfiguration* field is class or subclass of *PlotConfiguration* that a *PlotConfiguration* objects can also be pass on the method *initializePlot* as shown below: -```{r} +```{r empty plots} emptyPlot <- initializePlot() myEmptyPlot <- initializePlot(myConfiguration) ``` -```{r, echo=FALSE, fig.cap="left: emptyPlot; right: myEmptyPlot", fig.width=7.5} +```{r show empty plots, echo=FALSE, fig.cap="left: emptyPlot; right: myEmptyPlot", fig.width=7.5} gridExtra::grid.arrange(emptyPlot, myEmptyPlot, ncol=2) ``` -# Label configuration: *labels* +# 2. Label configuration: *labels* -## Label and Label configuration objects +## 2.1. Label and Label configuration objects -The field *labels* from the *PlotConfiguration* object is a *LabelConfiguration* R6 class object. +The field *labels* from the *PlotConfiguration* object is a *LabelConfiguration* object. It defines the label properties of the following plot captions: - title @@ -77,41 +78,48 @@ It defines the label properties of the following plot captions: - xlabel - ylabel -Each field is a *Label* R6 class object that associate a text with font properties: -```{r} -myEmptyLabel <- Label$new() -myEmptyLabel$print() - -myLabel <- Label$new(text = "some text", - color = "blue") -myLabel$print() +Each field is a *Label* object that associate a text with font properties: +```{r label example} +title <- Label$new(text = "This is a title text", + font = Font$new(color = "red", + size = 12)) +``` +```{r show label example, results='asis', echo=FALSE} +knitr::kable(data.frame("text" = title$text, + "color" = title$font$color, + "size" = title$font$size, + "face" = title$font$fontFace, + "family" = title$font$fontFamily, + "angle" = title$font$angle + )) ``` When initializating a *LabelConfiguration* or *PlotConfiguration* object, *Label* or/and *character* objects can be passed on. *Character* objects will be converted into *Label* objects internally using the current theme. - -```{r} +```{r label configuration} myRedPlotLabel <- LabelConfiguration$new(title = Label$new(text = "my title", color = "red")) -myRedPlotLabel$title$print() -myRedPlotLabel$print() - -myPlotLabel <- LabelConfiguration$new(title = "my title") -myPlotLabel$title$print() -myPlotLabel$print() ``` - -It can be noted that in the latter case, the label configuration is equivalent to the label configuration defined in the previous plot configuration "myConfiguration": - -```{r} -myConfiguration$labels$title$print() -myConfiguration$labels$print() +```{r show label configuration, results='asis', echo=FALSE} +knitr::kable( + data.frame( + Property = c("text", "color", "size", "angle", "fontFace", "fontFamily"), + title = c(myRedPlotLabel$title$text, myRedPlotLabel$title$font$color, myRedPlotLabel$title$font$size, + myRedPlotLabel$title$font$angle, myRedPlotLabel$title$font$fontFace, myRedPlotLabel$title$font$fontFamily), + subtitle = c("", myRedPlotLabel$subtitle$font$color, myRedPlotLabel$subtitle$font$size, + myRedPlotLabel$subtitle$font$angle, myRedPlotLabel$subtitle$font$fontFace, myRedPlotLabel$subtitle$font$fontFamily), + xlabel = c("", myRedPlotLabel$xlabel$font$color, myRedPlotLabel$xlabel$font$size, + myRedPlotLabel$xlabel$font$angle, myRedPlotLabel$xlabel$font$fontFace, myRedPlotLabel$xlabel$font$fontFamily), + ylabel = c("", myRedPlotLabel$ylabel$font$color, myRedPlotLabel$ylabel$font$size, + myRedPlotLabel$ylabel$font$angle, myRedPlotLabel$ylabel$font$fontFace, myRedPlotLabel$ylabel$font$fontFamily) + ) + ) ``` -## Label configuration in plots +## 2.2. Label configuration in plots The effect of label configuration in plots is straightforward: -```{r} +```{r label in plot configuration} plotConfigurationLabel1 <- PlotConfiguration$new(title = "Title", subtitle = "Subtitle", xlabel = "x label", @@ -126,31 +134,26 @@ plotConfigurationLabel2 <- PlotConfiguration$new(title = Label$new(text = "Title pLab2 <- initializePlot(plotConfigurationLabel2) ``` -```{r, echo=FALSE, fig.cap="left: pLab1; right: pLab2", fig.width=7.5} +```{r show label in plot configuration, echo=FALSE, fig.cap="left: pLab1; right: pLab2", fig.width=7.5} gridExtra::grid.arrange(pLab1, pLab2, ncol=2) ``` -## Changing plot labels +## 2.3. Changing plot labels After creating a plot, it is possible to change its label configuration using the `tlf` method *setPlotLabels*. The metod requires the plot object and which label property to update. Similar to the construction of the Label configuration, *Label* or/and *character* objects can be passed on. Using the previous example, *pLab2*, -```{r} -pLab2$plotConfiguration$labels$title$print() - -pLab2Title <- setPlotLabels(pLab2, title = "new title") -pLab2RedTitle <- setPlotLabels(pLab2, title = Label$new(text = "new title", color = "red")) - -pLab2Title$plotConfiguration$labels$title$print() -pLab2RedTitle$plotConfiguration$labels$title$print() +```{r set new title, fig.width=7.5} +setPlotLabels(pLab2, title = "new title") ``` -```{r, echo=FALSE, fig.cap="left: pLab2Title; right: pLab2RedTitle", fig.width=7.5} -gridExtra::grid.arrange(pLab2Title, pLab2RedTitle, ncol=2) + +```{r set new redtitle, fig.width=7.5} +setPlotLabels(pLab2, title = Label$new(text = "new title", color = "red")) ``` -## Smart plot configurations +## 2.4. Smart plot configurations Smart plot labels are available for initializing *PlotConfiguration* objects. The principle is to provide in advance the *data* that will be used within the plot. @@ -159,7 +162,7 @@ If no label is specifically defined, the smart configuration will fetch x and y *dataMapping* uses also smart functions that will check the input data.frame if not specifically initialized and will use variables named "x" and "y" as *x* and *y*. The 4 examples below illustrates the smart configurations. *pSmart1* and *pSmart2* will turn out the same, while *pSmart3* will use the information from *metaData* to write the x and y labels. *pSmart4* will overwrite the y label and title based on the input. -```{r} +```{r smart example} time <- seq(0,20, 0.1) myData <- data.frame(x = time, y = 2*cos(time)) @@ -186,17 +189,17 @@ pSmart3 <- initializePlot(smartConfig3) pSmart4 <- initializePlot(smartConfig4) ``` -```{r, echo=FALSE, fig.cap="left: pSmart1; right: pSmart2", fig.width=7.5} +```{r show smart example 1, echo=FALSE, fig.cap="left: pSmart1; right: pSmart2", fig.width=7.5} gridExtra::grid.arrange(pSmart1, pSmart2, ncol=2) ``` -```{r, echo=FALSE, fig.cap="left: pSmart3; right: pSmart4", fig.width=7.5} +```{r show smart example 2, echo=FALSE, fig.cap="left: pSmart3; right: pSmart4", fig.width=7.5} gridExtra::grid.arrange(pSmart3, pSmart4, ncol=2) ``` Since all of the `tlf` plots are using internally *initializePlot* if a previous plot is not provided, the smart configurations can directly be used through the plot functions. Consequently, if *scatter1* will provide simple x and y labels, *scatter2* will name these labels after the metaData properties. As for *scatter3* and *scatter4*, they will use the plotConfiguration defined by *smartConfig4* and lead to the exact same plot. -```{r} +```{r smart sccatter} scatter1 <- addScatter(data = myData) scatter2 <- addScatter(data = myData, metaData = myMetaData) @@ -208,164 +211,110 @@ scatter4 <- addScatter(data = myData, plotObject = scatter4) ``` -```{r, echo=FALSE, fig.cap="left: scatter1; right: scatter2", fig.width=7.5} +```{r show smart scatter 1, echo=FALSE, fig.cap="left: scatter1; right: scatter2", fig.width=7.5} gridExtra::grid.arrange(scatter1, scatter2, ncol=2) ``` -```{r, echo=FALSE, fig.cap="left: scatter3; right: scatter4", fig.width=7.5} +```{r show smart scatter 2, echo=FALSE, fig.cap="left: scatter3; right: scatter4", fig.width=7.5} gridExtra::grid.arrange(scatter3, scatter4, ncol=2) ``` -# Background configuration: *background* +# 3. Background configuration: *background* -The field *background* from the *PlotConfiguration* object is a *BackgroundConfiguration* R6 class object. -It defines the following plot properties: +## 3.1. Background configuration properties -- inner and outer backgrounds -- grid -- watermark +Background configuration defines the configuration of the following Background elements: `plot`, `panel`, `xGrid`, `yGrid`, `xAxis`, `yAxis`, `legendPosition` and `watermark`. +Except for `watermark` and `legendPosition` which are the text of the watermark and the position of the legend defined as an element of `LegendPositions` enum; +background fields are `LineElement` and `BackgroundElement` objects which defines the properties of the background element. +As for all the `PlotConfiguration` inputs, their default values are defined from the current `Theme`, however this default can be overwritten. -Inner, outer backgrounds and grid are all *BackgroundElementConfiguration* R6 class object that associate one or multiple aesthetic properties to the background element. -Watermark is a *Label* R6 class object to which it is also possible to set the angle and transparency. +For instance: +```{r background object, result='as.is'} +background <- BackgroundConfiguration$new() -When initializating a *BackgroundConfiguration* or *PlotConfiguration* object, the background properties and watermark can be passed on. +knitr::kable( + data.frame(Property = c("color", "size", "linetype", "fill"), + plot = c(background$plot$color, background$plot$size, background$plot$linetype, background$plot$fill), + panel = c(background$panel$color, background$panel$size, background$panel$linetype, background$panel$fill), + xGrid = c(background$xGrid$color, background$xGrid$size, background$xGrid$linetype, ""), + yGrid = c(background$yGrid$color, background$yGrid$size, background$yGrid$linetype, ""), + xAxis = c(background$xAxis$color, background$xAxis$size, background$xAxis$linetype, ""), + yAxis = c(background$yAxis$color, background$yAxis$size, background$yAxis$linetype, "") + ) + ) -```{r} -myEmptyBackgroundConfiguration <- BackgroundConfiguration$new() -myEmptyBackgroundConfiguration$print() ``` -## Background configuration in plots +## 3.2. Background configuration in plots -The effect of background configuration in plots is quite straightforward: -```{r} +The effect of background configuration in plots is also quite straightforward: +```{r background in plot configuration} plotConfigurationBackground1 <- PlotConfiguration$new(watermark = "My Watermark") pBack1 <- initializePlot(plotConfigurationBackground1) -plotConfigurationBackground2 <- PlotConfiguration$new( - watermark = Label$new(text = "Hello world", color = "goldenrod4", size = 8), - background = BackgroundConfiguration$new(outerBackground = BackgroundElementConfiguration$new(fill = "lemonchiffon"), - innerBackground = BackgroundElementConfiguration$new(fill = "lemonchiffon", - color = "goldenrod3"), - grid = BackgroundElementConfiguration$new(color = "goldenrod3"))) - -pBack2 <- initializePlot(plotConfigurationBackground2) +plotConfigurationBackground1$background$watermark <- Label$new(text = "Hello world", color = "goldenrod4", size = 8) +plotConfigurationBackground1$background$plot <- BackgroundElement$new(fill = "lemonchiffon", color = "goldenrod3", linetype = "solid") +plotConfigurationBackground1$background$panel <- BackgroundElement$new(fill = "grey", color = "black", linetype = "solid") +pBack2 <- initializePlot(plotConfigurationBackground1) ``` -```{r, echo=FALSE, fig.cap="left: pBack1; right: pBack2", fig.width=7.5} +```{r show background in plot configuration, echo=FALSE, fig.cap="left: pBack1; right: pBack2", fig.width=7.5} gridExtra::grid.arrange(pBack1, pBack2, ncol=2) ``` -## Changing background properties +## 3.3. Changing background properties After creating a plot, it is possible to change its background configuration using the following `tlf` methods: -- *setBackground* -- *setGrid* +- *setBackground*, *setBackgroundPanelArea* and *setBackgroundPlotArea* +- *setGrid*, *setXGrid* and *setYGrid* - *setWatermark* -### Set Background +### 3.3.1. Set Background -The metod *setBackground* requires the plot object and which inner/outer background properties to update. +The methods *setBackground*, *setBackgroundPanelArea* and *setBackgroundPlotArea* require the plot object and which properties to update. Using the previous example, *scatter1*, -```{r} -scatter1$plotConfiguration$background$print() - -scatterNewBackground1 <- setBackground(scatter1, - outerBackgroundFill = "darkolivegreen1", - fill = "darkolivegreen2", - color = "darkgreen", - linetype = "blank") -scatterNewBackground2 <- setBackground(scatter1, - outerBackgroundFill = "lemonchiffon", - fill = "lemonchiffon", - size = 2, - linetype = "solid") - -scatterNewBackground1$plotConfiguration$background$print() -scatterNewBackground2$plotConfiguration$background$print() +```{r set plot background 1, fig.width=7.5} +setBackground(scatter1, fill = "lemonchiffon", color = "darkgreen", linetype = "solid") ``` -```{r, echo=FALSE, fig.cap="top: scatter1; bottom left: scatterNewBackground1; bottom right: scatterNewBackground2", fig.width=7.5} -gridExtra::grid.arrange(grobs = list(scatter1, scatterNewBackground1, scatterNewBackground2), layout_matrix=rbind(c(1,1), c(2,3))) +```{r set panel background 1, fig.width=7.5} +setBackgroundPanelArea(scatter1, fill = "lemonchiffon", color = "darkgreen", linetype = "solid") ``` -### Set Grid - -The metod *setGrid* is very similar and requires the plot object and which grid properties to update. +### 3.3.2. Set Grid -Using the previous examples, *scatterNewBackground1* and *scatterNewBackground2*: -```{r} -scatterNewBackground1$plotConfiguration$background$grid$print() +The methods *setGrid*, *setXGrid* and *setYGrid* are very similar and requires the plot object and which grid properties to update. -# Remove grid -scatterNewGrid1 <- setGrid(scatterNewBackground1, - linetype = "blank") - -scatterNewGrid1$plotConfiguration$background$grid$print() - -scatterNewGrid2 <- setGrid(scatterNewBackground2, - color = "darkgreen", - size = 0.5, - linetype = "dotted") - -scatterNewGrid2$plotConfiguration$background$grid$print() -``` - -```{r, echo=FALSE, fig.cap="left: scatterNewBackground1; right: scatterNewGrid1", fig.width=7.5} -gridExtra::grid.arrange(scatterNewBackground1, scatterNewGrid1, ncol=2) +Using the previous example *scatter1*: +```{r set plot grid 1, fig.width=7.5} +setGrid(scatter1, linetype = "blank") ``` -```{r, echo=FALSE, fig.cap="left: scatterNewBackground2; right: scatterNewGrid2", fig.width=7.5} -gridExtra::grid.arrange(scatterNewBackground2, scatterNewGrid2, ncol=2) +```{r set plot y grid, fig.width=7.5} +setXGrid(scatter1, linetype = "blank") ``` - -### Set Watermark +### 3.3.3. Set Watermark The metod *setWatermark* requires the plot object, the watermark and its properties to update. -In the properties, *alpha* is a value between 0 and 1 managing transparency of the watermark. -The closer to 0, the more transparent the watermark will be. -The closer to 1, the more opaque the watermark will be. -The propert *angle*, is the angle of the watermark in degrees. - -Using the previous examples, *pBack2* and *scatterNewGrid2*, -```{r} -pBack2$plotConfiguration$background$watermark$print() - -pWatermark1 <- setWatermark(pBack2, - watermark = "Hi !!", - alpha = 1, - angle = 0) - -pWatermark2 <- setWatermark(pBack2, - alpha = 1, - angle = 45) +Included in the properties, *alpha* is a value between 0 and 1 managing transparency of the watermark. +The closer to 0, the more transparent the watermark will be. The closer to 1, the more opaque the watermark will be. +The property *angle*, is the angle of the watermark in degrees. -pWatermark1$plotConfiguration$background$watermark$print() -pWatermark2$plotConfiguration$background$watermark$print() +Using the previous example *scatter1*: +```{r set watermark 1, fig.width=7.5} +setWatermark(scatter1, watermark = "Hello watermark !!") ``` -```{r} -scatterNewGrid2$plotConfiguration$background$watermark$print() - -scatterWatermark <- setWatermark(scatterNewGrid2, - watermark = Label$new(text = "Confidential", color = "firebrick")) - -scatterWatermark$plotConfiguration$background$watermark$print() +```{r set watermark 2, fig.width=7.5} +setWatermark(scatter1, watermark = "Confidential", angle = 45, size = 6, color = "firebrick") ``` -```{r, echo=FALSE, fig.cap="top: pBack2; bottom left: pWatermark2; bottom right: pWatermark2", fig.width=7.5} -gridExtra::grid.arrange(grobs = list(pBack2, pWatermark1, pWatermark2), layout_matrix = rbind(c(1,1),c(2,3))) -``` - -```{r, echo=FALSE, fig.cap="left: scatterNewGrid2; right: scatterWatermark", fig.width=7.5} -gridExtra::grid.arrange(scatterNewGrid2, scatterWatermark, ncol=2) -``` -# X/Y axes configurations: *xAxis*/*yAxis* +# 4. X/Y axes configurations: *xAxis*/*yAxis* The fields *xAxis* and *yAxis* from the *PlotConfiguration* object are a *XAxisConfiguration* and *YAxisConfiguration* R6 class objects. They define the following plot properties: @@ -374,56 +323,45 @@ They define the following plot properties: - limits - ticks - ticklabels +- font The property *scale* is a character string corresponding the axis scale. -Available scales are `r paste0(c('"', paste0(Scaling, collapse = '", "'), '"'), collapse="")` and can be accessed using the enum *Scaling*. +Available scales are *`r paste0(c('"', paste0(Scaling, collapse = '", "'), '"'), collapse="")`* and can be accessed using the enum *Scaling*. The property *limits* is a vector defining the range of the axis. + +Regarding ticks and ticklabels their values are directly be passed on and managed by `ggplot2`. The value *"default"* will leave the management of the limits to R. The properties *ticks* and *ticklabels* are vectors defining the plot ticks and their labels. These vectors are required to have the same length. The value *"default"* will leave the management of the limits to R. When initializating a *XAxisConfiguration*, *YAxisConfiguration* or *PlotConfiguration* objects, the axis properties can be passed on. +```{r define axis} +myAxisConfiguration <- XAxisConfiguration$new() -```{r} -myEmptyAxisConfiguration <- XAxisConfiguration$new() -myEmptyAxisConfiguration$print() - -myAxisConfiguration <- XAxisConfiguration$new(scale = Scaling$log10, - limits = c(1, 100)) -myAxisConfiguration$print() +myAxisConfiguration$scale +myAxisConfiguration$ticklabels ``` -## Axis configuration in plots +## 4.1. Axis configuration in plots ## Changing axis properties -The metods *setXAxis* and *setYAxis* requires the plot object, and the axis properties to update. - +The methods *setXAxis* and *setYAxis* require the plot object, and the axis properties to update. Using the previous example, *scatter1*: -```{r} -scatter1$plotConfiguration$xAxis$print() -scatter1$plotConfiguration$yAxis$print() - -scatterXlog <- setXAxis(scatter1, - scale = Scaling$log10) - -scatterXlog$plotConfiguration$xAxis$print() - -scatterXTicks <- setXAxis(scatter1, - limits = c(0, 6*pi), - ticks = seq(0, 6*pi, pi), - ticklabels = parse(text = c("0", "pi", paste0(seq(2, 6), "*pi")))) - -scatterXTicks$plotConfiguration$xAxis$print() - +```{r set x axis, fig.width=7.5} +setXAxis(scatter1, limits = c(0.5, 20), scale = Scaling$sqrt) ``` -```{r, echo=FALSE, fig.cap="top: scatter1; bottom left: scatterXlog; bottom right: scatterXTicks", fig.width=7.5} -gridExtra::grid.arrange(grobs = list(scatter1, scatterXlog, scatterXTicks), layout_matrix = rbind(c(1,1),c(2,3))) +```{r set x axis ticks, fig.width=7.5} +setXAxis(scatter1, + limits = c(0, 6*pi), + ticks = seq(0, 6*pi, pi), + ticklabels = c("0", "pi", paste0(seq(2, 6), "*pi")), + font = Font$new(color = "dodgerblue")) ``` -# Legend configuration: *legend* +# 5. Legend configuration: *legend* The field *legend* from the *PlotConfiguration* object is a *LegendConfiguration* R6 class object. It defines the following plot properties: @@ -434,131 +372,29 @@ It defines the following plot properties: The property *title* is a character string corresponding the legend title. The property *position* is a character string corresponding the legend position. -Available legend positions are `r paste0(c('"', paste0(LegendPositions, collapse = '", "'), '"'), collapse="")` and can be accessed using the enum *LegendPositions*. +Available legend positions are *`r paste0(c('"', paste0(LegendPositions, collapse = '", "'), '"'), collapse="")`* and can be accessed using the enum *LegendPositions*. The property *caption* is a data.frame defining the caption properties of the legend. -When initializating a *LegendConfiguration* or *PlotConfiguration* object, the background properties and watermark can be passed on. - -```{r} -myEmptyLegendConfiguration <- LegendConfiguration$new() -myEmptyLegendConfiguration$print() - -myLegendConfiguration <- LegendConfiguration$new(title = "Legend Title", - position = LegendPositions$insideTopRight) -myLegendConfiguration$print() -``` - -## Legend configuration in plots - -The effect of legend configuration in plots is straightforward. -Using the previous example with *myData*, initializing the plot won't print the legend on the plot since no data are plotted, but will keep in memory the configuration when adding layers. -The legend caption is updated every type a new layer is added. -The atom plots also allow to manually indicates desired legend properties for the corresponding layer. - -```{r} -plotConfigurationLegend1 <- PlotConfiguration$new() -plotConfigurationLegend1$legend$print() - -emptyLegend1 <- initializePlot(plotConfigurationLegend1) -emptyLegend1$plotConfiguration$legend$print() - -scatterLegend1 <- addScatter(data = myData, - plotConfiguration = plotConfigurationLegend1) -scatterLegend1$plotConfiguration$legend$print() - -scatterLegend2 <- addLine(y = c(-1, 0, 1), - plotObject = scatterLegend1) -scatterLegend2$plotConfiguration$legend$print() - -scatterLegend3 <- addScatter(data = myData, - caption = "Cosinus data", - color = "darkblue", - size = 2, - plotConfiguration = plotConfigurationLegend1) -scatterLegend3 <- addLine(y = c(-1, 0, 1), - caption = "Some lines", - color = "coral3", - linetype = "solid", - plotObject = scatterLegend3) -scatterLegend3$plotConfiguration$legend$print() -``` - -```{r, echo=FALSE, fig.cap="top left: emptyLegend1; top right: scatterLegend1; bottom left: scatterLegend2; bottom right: scatterLegend3", fig.width=7.5} -gridExtra::grid.arrange(emptyLegend1, scatterLegend1, scatterLegend2, scatterLegend3, ncol=2) -``` - -```{r} -plotConfigurationLegend1 <- PlotConfiguration$new(legendTitle = "my legend", - legendPosition = LegendPositions$outsideTopLeft) -plotConfigurationLegend1$legend$print() - -emptyLegend1 <- initializePlot(plotConfigurationLegend1) -emptyLegend1$plotConfiguration$legend$print() - -scatterLegend1 <- addScatter(data = myData, - plotConfiguration = plotConfigurationLegend1) -scatterLegend1$plotConfiguration$legend$print() - -scatterLegend2 <- addLine(y = c(-1, 0, 1), - plotObject = scatterLegend1) -scatterLegend2$plotConfiguration$legend$print() - -scatterLegend3 <- addScatter(data = myData, - caption = "Cosinus data", - color = "darkblue", - size = 2, - plotConfiguration = plotConfigurationLegend1) -scatterLegend3 <- addLine(y = c(-1, 0, 1), - caption = "Some lines", - color = "coral3", - linetype = "solid", - plotObject = scatterLegend3) -scatterLegend3$plotConfiguration$legend$print() -``` - -```{r, echo=FALSE, fig.cap="top left: emptyLegend1; top right: scatterLegend1; bottom left: scatterLegend2; bottom right: scatterLegend3", fig.width=7.5} -gridExtra::grid.arrange(emptyLegend1, scatterLegend1, scatterLegend2, scatterLegend3, ncol=2) -``` - -## Changing plot legend - -### Changing a legend title - -After creating a plot, it is possible to change its legend title using the `tlf` method *setLegendTitle*. -The metod requires the plot object and the text of title to update with. - -Using *scatterLegend3* from the previous example: -```{r} -scatterLegend3$legend$title - -scatterLegend4<- setLegendTitle(scatterLegend3, "My new legend") -scatterLegend4$legend$title -``` - -```{r, echo=FALSE, fig.cap="left: scatterLegend3; right: scatterLegend4", fig.width=7.5} -gridExtra::grid.arrange(scatterLegend3, scatterLegend4, ncol=2) +```{r legend configuration} +myLegend <- LegendConfiguration$new(position = LegendPositions$insideTopRight) ``` -### Changing a legend position +## 5.1. Legend configuration in plots -After creating a plot, it is also possible to change its legend position using the `tlf` method *setLegendPosition*. -The metod requires the plot object and the new position of the legend to update with. - -Using *scatterLegend3* from the previous example: -```{r} -scatterLegend3$legend$position - -scatterLegend3Inside<- setLegendPosition(scatterLegend3, LegendPositions$insideTopRight) -scatterLegend3Inside$legend$position +Legend position can be modified using the function `setLegendPosition` +The methods *setLegendPosition* requires the plot object, and the position as defined by the elements of the enum *LegendPositions* +Using the previous example, *scatter1*: +```{r legend position, fig.width=7.5} +setLegendPosition(scatter1, LegendPositions$insideTopLeft) ``` -```{r, echo=FALSE, fig.cap="left: scatterLegend3; right: scatterLegend3Inside", fig.width=7.5} -gridExtra::grid.arrange(scatterLegend3, scatterLegend3Inside, ncol=2) -``` - -### Changing a legend caption -# Usage of *theme* +# 6. Default plot configuration: `Theme` objects -# *PlotConfiguration* derived classes +The class `Theme` allows a user-friendly way to set many default plot settings. +To allow a smooth way to set and update themes, themes snapshots can be saved to json files using the function `saveThemeToJson(theme)` and can be loaded from json files using the function `loadThemeFromJson(jsonFile)`. +In order to define a theme as the current default, the function `useTheme(theme)` needs to be called. +A shiny app has been created to tune `Theme` objects live and save them as json files. +With this app, it becomes quite easy to create one's own theme with a few clicks. +To call for the shiny app, users only needed to run the function `runThemeMaker()`. diff --git a/vignettes/tlf-workflow.Rmd b/vignettes/tlf-workflow.Rmd index 6d7803b6..eaae7fe5 100644 --- a/vignettes/tlf-workflow.Rmd +++ b/vignettes/tlf-workflow.Rmd @@ -1,37 +1,40 @@ --- -title: "tlf-workflow" -output: - rmarkdown::html_vignette: - number_sections: true +title: "Introduction to tlf workflows" +author: "OSPSuiteR 2019" +output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{tlf-workflow} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- -```{r setup, include = FALSE} +```{r, include = FALSE} knitr::opts_chunk$set( collapse = TRUE, comment = "#>" ) -load("../data/pkRatioDataExample.RData") -load("../data/tlf-output.RData") -load("../data/timeProfileDataFrame.RData") -library(tlf) +``` +```{r setup} +require(tlf) +``` + +```{r load theme, echo=FALSE} +vignetteTheme <- loadThemeFromJson(system.file("extdata", "template-theme.json", package = "tlf")) +useTheme(vignetteTheme) ``` -# Introduction -## Objectives +# 1. Introduction +## 1.1. Objectives The aim of this vignette is to document and illustrate the typical workflow needed for the production of plots using the `tlf`-library. -## Libraries +## 1.2. Libraries The main purpose of the `tlf`-library is to standardized the production of `ggplot` objects from data output by the `OSPSuiteR`. As such, `tlf`-library requires that the `ggplot2` package be installed. -## `tlf` typical workflow +## 1.3. `tlf` typical workflow The suggested workflow for performing any kind of plot with the `tlf`-library is illustrated in the figure below. -```{r, out.width="100%", include=TRUE, fig.align="center", echo=FALSE} +```{r workflow illustration, out.width="100%", include=TRUE, fig.align="center", echo=FALSE} # echo=FALSE prints only code chunk output knitr::include_graphics("workflow.png") ``` @@ -53,14 +56,14 @@ The standard workflow then proceeds as follows: Steps 1, 2, 3 and 4 are not mandatory. If not implemented, `tlf`-libray uses default settings in lieu of the objects that are otherwise created in these optional steps. In addition, the `PlotConfiguration` object and the `DataMapping` object can be created independently. Sections 2 to 4 will focus on `AggregationSummary`, `DataMapping` and `PlotConfiguration`. -## Naming Conventions +## 1.4. Naming Conventions In this package, it was chosen to use specific names for functions and classes referring to specific plots. The naming convention for classes is `` and for function ``. Below presents the table of specific classes and functions that are created using this convention: -```{r, echo = FALSE, results='asis'} +```{r naming convention, echo = FALSE, results='asis'} # This small script gives a fast way to introduce the nomenclature of the classes and functions -plotNames <- c("PKRatio", "TimeProfile", "Histogram", "BoxWhisker", "DDIRatio") #"GOF", +plotNames <- c("PKRatio", "DDIRatio", "IndividualIdProfile", "ObsVsPred", "Histogram", "BoxWhisker") classesNames <- c("DataMapping", "PlotConfiguration") functionNames <- c("plot") @@ -72,32 +75,39 @@ conventionTable <- data.frame(sapply(classesNames, function(x){paste0(plotNames, knitr::kable(conventionTable) ``` -# Data pre-processing: `AggregationSummary` class +# 2. Data pre-processing: `AggregationSummary` class -## Data format +## 2.1. Data format -The workflow assumes that the data to be plotted has been gathered in the form of a [*tidy*](https://cran.r-project.org/web/packages/tidyr/vignettes/tidy-data.html) dataframe. In a tidy format dataframe, each *measurement*, such as a simulation result or experimental observation, is described entirely in one row. The columns of the dataframe are limited to no more than the *independent variable* columns of the measurement (in this example, *Time* and *IndividualID*) and the *dependent variable* columns (in this case *Organism|ArterialBlood|Aciclovir|Whole Blood*), which hold the value of the measurement. Since no additional columns are allowed, two dependent variables that have differing sets of independent variables should each have their own tidy dataframes. +The workflow assumes that the data to be plotted has been gathered in the form of a [*tidy*](https://cran.r-project.org/web/packages/tidyr/vignettes/tidy-data.html) dataframe. +In a tidy format dataframe, each *measurement*, such as a simulation result or experimental observation, is described entirely in one row. +The columns of the data.frame are limited to no more than the *independent variable* columns of the measurement (for example, *time* and *IndividualId*) and the *dependent variable* columns (in this case *Organism|VenousBlood|Volume*), which hold the value of the measurement. +Since no additional columns are allowed, two dependent variables that have differing sets of independent variables should each have their own tidy dataframes. -In the sequel, we will use a standard dataset exported from the `OSPSuiteR` package: `testData`. This data is a `data.frame` with 10 variables and 22500 observations. +In the sequel, we will use a dataset derived from the `OSPSuiteR` package: `testData`. -```{r, echo=FALSE, results='asis'} -testData <- outputValues$data -knitr::kable(head(testData)) #For aesthetics of the table align='c', digits =2) +```{r get test data, echo=FALSE, results='asis'} +testData <- read.csv(system.file("extdata", "ospsuite-data.csv", package = "tlf"), check.names = FALSE, stringsAsFactors = FALSE) +knitr::kable(head(testData[,1:6])) #For aesthetics of the table align='c', digits =2) ``` -## MetaData - -A `metaData` variable associated with the data can be used to define additional information such as the `dimension` and `unit` of each column in the `data.frame`. The lower limit of quantitiation of a time profile can also be stored in the `metaData`. The format of metaData is currently expected to be a list on each variable of lists showing unit and dimension. +## 2.2. MetaData -```{r, results='asis', echo=FALSE} -testMetaData <- outputValues$metaData -metaDataTable <- data.frame("unit" = sapply(testMetaData, function(x){x$unit}), - "dimension" = sapply(testMetaData, function(x){x$dimension})) +A `metaData` variable associated with the data can be used to define additional information such as the `dimension` and `unit` of each column in the `data.frame`. The lower limit of quantitiation of a IndividualId profile can also be stored in the `metaData`. The format of metaData is currently expected to be a list on each variable of lists showing unit and dimension. +```{r get test metadata, results='asis', echo=FALSE} +metaDataTable <- read.csv(system.file("extdata", "ospsuite-metadata.csv", package = "tlf"), check.names = FALSE, stringsAsFactors = FALSE) knitr::kable(metaDataTable) ``` +```{r get test metadata as list, include=FALSE} +testMetaData <- list() +for(variableIndex in 1:nrow(metaDataTable)){ + testMetaData[[metaDataTable$Variable[variableIndex]]] <- list(dimension = metaDataTable$Dimension[variableIndex], + unit = metaDataTable$Unit[variableIndex]) +} +``` -## Aggregation +## 2.3. Aggregation A common processing of the data is its aggregation. The aggregation consists in splitting the data into subsets, then computes summary statistics for each, and returns the result in a convenient form. Visual predictive checks are typical plots where such method is useful. @@ -105,9 +115,9 @@ Visual predictive checks are typical plots where such method is useful. The `AggregationSummary` class is a helper class that simplifies the use of aggregation methods on the data. The `R6` class `AggregationSummary` automates the computation of multiple summary statistics of the raw data that is output by **Step 0**. The output of this optional data pre-processing step is a dataframe with a column for each summary statistic. This dataframe can be input into the subsequent steps of the workflow. The user also has the option of generating `metaData` for each of the summary statistics evaluated. -To illustrate the functions of this class for the example of the dataframe `testData`, let's suppose that for each timepoint in the *Time* column, the *minimum* and the *mean* value of the simulated *Organism|ArterialBlood|Aciclovir|Whole Blood* column is to be computed for each gender in the *Gender* column. The `AggregationSummary` class works in 3 steps: +To illustrate the functions of this class for the example of the dataframe `testData`, let's suppose that for each individual in the *IndividualId* column, the *minimum* and the *mean* value of the simulated *Organism|VenousBlood|Volume* column is to be computed for each gender in the *Gender* column. The `AggregationSummary` class works in 3 steps: -1. Three sets of columns are selected from the input dataframe `data`: an *independent variable* set called `xColumnNames` (in this case, the *Time* column in `testData`), a *grouping variables* set called `groupingColumnNames` (the *Gender* column in `testData`) and a *dependent variables* set called `yColumnNames` (the *Organism|ArterialBlood|Aciclovir|Whole Blood* column in `testData`). +1. Three sets of columns are selected from the input dataframe `data`: an *independent variable* set called `xColumnNames` (in this case, the *IndividualId* column in `testData`), a *grouping variables* set called `groupingColumnNames` (the *Gender* column in `testData`) and a *dependent variables* set called `yColumnNames` (the *Organism|VenousBlood|Volume* column in `testData`). 2. For each value of the independent variable `xColumnNames`, the rows of the dataframe are aggregated into groups defined by unique combinations of the elements in the grouping variable columns `groupingColumnNames`. @@ -115,29 +125,29 @@ To illustrate the functions of this class for the example of the dataframe `test For this example, the `AggregationSummary` object `aggSummary` is instatiated as follows: -```{r, results='asis'} +```{r aggregate example, results='asis'} aggSummary <- AggregationSummary$new(data = testData , metaData = testMetaData, - xColumnNames = "Time", + xColumnNames = "IndividualId", groupingColumnNames = "Gender", - yColumnNames = "Organism|ArterialBlood|Aciclovir|Whole Blood", + yColumnNames = "Organism|VenousBlood|Volume", aggregationFunctionsVector = c(min,mean), aggregationFunctionNames =c("Simulated Min", "Simulated Mean"), - aggregationUnitsVector = c("?mol/l","?mol/l"), - aggregationDimensionsVector = c("Concentration", - "Concentration")) + aggregationUnitsVector = c("l","l"), + aggregationDimensionsVector = c("Volume", + "Volume")) ``` The dataframe that holds the summary statistics of the aggregated rows is stored in the `dfHelper` property of the resulting `aggSummary` object. Since two functions (`min` and `mean`) were specified in `aggregationFunctionsVector`, the dataframe `aggSummary$dfHelper` has, in addition to the `xColumnNames`and `groupingColumnNames` columns, two additional columns named `Simulated Min` and `Simulated Mean`, which were the names specified in `aggregationFunctionNames`. -```{r, echo=FALSE, results='asis'} +```{r show aggregation summary, echo=FALSE, results='asis'} knitr::kable(head(aggSummary$dfHelper, digits=2)) ``` The `metaData` corresponding to the columns of the resulting dataframes are lists that are stored together in a list with the `metaData` of the `xColumnNames`and `groupingColumnNames` columns. The `metaData` for the new `aggSummary$dfHelper` dataframe is stored as the `metaDataHelper` property of the `aggSummary` object. For this example, the two `metaData` lists corresponding to the `Simulated Min` and `Simulated Mean` columns are also are labeled `Simulated Min` and `Simulated Mean`. The contents of the list `aggSummary$metaDataHelper` are: -```{r, results='asis'} +```{r show meta data of aggregation, results='asis'} # Currently issue with metaData of Gender aggSummary$metaDataHelper[[2]] <- NULL aggMetaData <- data.frame("unit" = sapply(aggSummary$metaDataHelper, function(x){x$unit}), @@ -149,7 +159,7 @@ knitr::kable(aggMetaData) # 3. Mapping and grouping of data: `DataMapping` class. The role of the `DataMapping` class is to provide a user-friendly interface to indicate what data should plotted. -In most cases, this class needs to be initiliazed to map what variable is `x`, `y` and sometimes what variable(s) will group the data. +In most cases, this class needs to be initiliazed to map what variable is `x`, `y` and someIndividualIds what variable(s) will group the data. Thus, the most common input are `x` and `y`, however, for more advanced plots input such as `groupMapping` may be used often. For advanced plots, subclasses are derived from `DataMapping`, they use unique input and default related to the advanced plot to make it easier to use them. @@ -158,19 +168,19 @@ For advanced plots, subclasses are derived from `DataMapping`, they use unique i An `R6` class called `Grouping` can be used to group the data into subsets that, in the final plots, are to be distinguished both aesthetically and in legend captions. In addition, these subsets can be listed under descriptive legend titles. - As an example, a `Grouping` object called `grouping1` can be used to specify that the data in a *tidy* dataframe such as `timeProfileDataFrame` should be grouped by both "Compound" and "Dose": -```{r, results='asis'} +As an example, a `Grouping` object called `grouping1` can be used to specify that the data in a *tidy* data.frame should be grouped by both "Compound" and "Dose": +```{r grouping 2 variables, results='asis'} # Grouping by variable names: grouping1 <- Grouping$new(c("Compound","Dose")) ``` With this minimal input, a legend associated with this grouping will have the default title "Compound-Dose". On the other hand, a custom title for this grouping and its legend can be supplied by the user with the optional `label` input: -```{r, results='asis'} +```{r grouping 2 variable with label, results='asis'} # Grouping by variable names and overwriting the default label: grouping2 <- Grouping$new(group = c("Compound","Dose"), label = "Compound & Dose") ``` In the above two examples, default captions are constructed by hyphenating the compound type and the dose amount for each row. Alternatively, the captions can be customized by the user by supplying a dataframe with the custom captions to the `group` input of the `Grouping` object constructor. The format of this dataframe is such that the rightmost column contains the desired captions, the name of this rightmost column is the default legend title for this grouping, and the remaining columns define the combinations of row entries that are to receive each caption in the rightmost column. To illustrate this method, the following dataframe `mappingDataFrame` is used to assign captions based on entries in the "Dose" and "Compound" columns. For example the caption "6mg of Aspirin" is assigned to any row in which the "Dose" entry is 6 and the "Compound" entry is "Aspirin". -```{r, results='asis'} +```{r grouping using data.frame, results='asis'} # Grouping using a data.frame: mappingDataFrame <- data.frame(Compound = c("Aspirin","Aspirin","Sugar","Sugar"), Dose = c(6,3,6,3), @@ -186,24 +196,24 @@ grouping3 <- Grouping$new(group = mappingDataFrame) The default title of the legend that results from this grouping is the name of the rightmost column, which is "Compound & Dose". Note that the `check.names` option should be set to `FALSE` when creating the dataframe `mappingDataFrame` since the legend title contains spaces in this instance. This legend title can be overridden to be another string by using the `label` input of the object constructor, as in the case of `grouping2` above. The three `Grouping` objects, `grouping1`, `grouping2` and `grouping3` respectively yield the last three columns of the following dataframe: -```{r, results='asis'} +```{r grouping show captions, results='asis'} # Apply the mapping to get the grouping captions: -groupingsDataFrame <- data.frame(timeProfileDataFrame$IndividualID, - timeProfileDataFrame$Dose, - timeProfileDataFrame$Compound, - grouping1$getCaptions(timeProfileDataFrame), - grouping2$getCaptions(timeProfileDataFrame), - grouping3$getCaptions(timeProfileDataFrame)) - -names(groupingsDataFrame) <- c("IndividualID", "Dose", "Compound", +groupingsDataFrame <- data.frame(testData$IndividualId, + testData$Dose, + testData$Compound, + grouping1$getCaptions(testData), + grouping2$getCaptions(testData), + grouping3$getCaptions(testData)) + +names(groupingsDataFrame) <- c("IndividualId", "Dose", "Compound", grouping1$label, grouping2$label, grouping3$label) # Show results for all groupings: knitr::kable(groupingsDataFrame) ``` -A dataframe can also be used to create a `Grouping` object that subsets the data based on whether a numeric grouping variable satisfies an specific inequality. For example, individuals in `timeProfileDataFrame` can be grouped according to whether or not their age exceeds 6 years by first defining the following dataframe: -```{r, results='asis'} +A dataframe can also be used to create a `Grouping` object that subsets the data based on whether a numeric grouping variable satisfies an specific inequality. For example, individuals in `testData` can be grouped according to whether or not their age exceeds 6 years by first defining the following dataframe: +```{r binning age, results='asis'} # Grouping using a data.frame: binningDataFrame <- data.frame(Age = I( list(c(0,6),c(7,100)) ), "Age Range" = c("Age 6 or lower", @@ -211,19 +221,20 @@ binningDataFrame <- data.frame(Age = I( list(c(0,6),c(7,100)) ), check.names = FALSE) ``` Then creating a new grouping: -```{r, results='asis'} +```{r grouping with age bins, results='asis'} grouping4 <- Grouping$new(group = binningDataFrame) ``` This new `Grouping` object `grouping4` yields the following captions -```{r, results='asis'} +```{r show grouping with age bins, results='asis'} # Apply the mapping to get the grouping captions: -binnedGroupingsDataFrame <- data.frame(timeProfileDataFrame$IndividualID, - timeProfileDataFrame$Age, - grouping4$getCaptions(timeProfileDataFrame)) +testData$Age <- testData$`Organism|Age` +binnedGroupingsDataFrame <- data.frame(testData$IndividualId, + testData$Age, + grouping4$getCaptions(testData)) -names(binnedGroupingsDataFrame) <- c("IndividualID", "Age", grouping4$label) +names(binnedGroupingsDataFrame) <- c("IndividualId", "Age", grouping4$label) # Show results for all groupings: knitr::kable(binnedGroupingsDataFrame) @@ -233,7 +244,7 @@ knitr::kable(binnedGroupingsDataFrame) An additional `R6` class called `GroupMapping` maps `Grouping` objects to aesthetic parameters such as `color` or `linetype`. To distinguish between "Compound" and "Dose" groups by color and to use the captions and legend title specified in `grouping2`, the following groupings object `groups1` is constructed: -```{r, results='asis'} +```{r group mapping class, results='asis'} # Map groups to aesthtic properties groups1 <- GroupMapping$new(color = grouping2 ) ``` @@ -246,180 +257,30 @@ groups2 <- GroupMapping$new(color = c("Compound", "Dose")) or to a `Grouping` object directly: ```{r, results='asis'} -# Map groups to aesthtic properties +# Map groups to aesthetic properties groups3 <- GroupMapping$new(color = Grouping$new(group = c("Compound", "Dose"), label = c("Compound & Dose"))) ``` -## DataMapping +## 3.2. DataMapping -The `R6` class `TimeProfileDataMapping` extracts the time profile plot data from an input dataframe and groups it according to the aesthetics specified in an input `GroupMapping` object. This mapping is carried out by an internal function of this class named `checkMapData` which check if the variables indicated the `GroupMapping` are included in the data. Then, this method returns a simplified data.frame with the variables defined by the dataMapping. +The `R6` class `XYGDataMapping` extracts the maps the x, y and groups of data according to the aesthetics specified in an input `GroupMapping` object. This mapping is carried out by an internal function of this class named `checkMapData` which check if the variables indicated the `GroupMapping` are included in the data. Then, this method returns a simplified data.frame with the variables defined by the dataMapping. -When no `GroupMapping` object is supplied upon construction of a `TimeProfileDataMapping` object, the function `checkMapData` returns a dataframe with `x` and `y`. +When no `GroupMapping` object is supplied upon construction of a `XYGDataMapping` object, the function `checkMapData` returns a dataframe with `x` and `y`. A dummy variable named `aesDefault` is added to the data.frame, its sole purpose is to allow modifications of aesthetic properties after the creation of the ggplot object (not possible otherwise). -```{r, results='asis'} -tpMapping <- TimeProfileDataMapping$new(x="Time", y="Simulated") -knitr::kable(tpMapping$checkMapData(data = timeProfileDataFrame, - metaData = timeProfileMetaData)) +```{r data mapping, results='asis'} +tpMapping <- XYGDataMapping$new(x="IndividualId", y="Organism|VenousBlood|Volume") +knitr::kable(tpMapping$checkMapData(data = testData, + metaData = IndividualIdProfileMetaData)) ``` -When a `GroupMapping` object is supplied upon construction of the `TimeProfileDataMapping` object, each `x`,`y` pair is associated with a group that can be used to distinguish the pair aesthetically in the final plot: -```{r, results='asis'} +When a `GroupMapping` object is supplied upon construction of the `XYGDataMapping` object, each `x`,`y` pair is associated with a group that can be used to distinguish the pair aesthetically in the final plot: +```{r data mapping groups 1, results='asis'} # Re-use the variable groups previously defined -tpMapping <- TimeProfileDataMapping$new(x="Time", y="Simulated", +tpMapping <- XYGDataMapping$new(x="IndividualId", y="Organism|VenousBlood|Volume", groupMapping = groups1) -knitr::kable(tpMapping$checkMapData(data = timeProfileDataFrame)) -``` - -A feature of `TimeProfileDataMapping` class is that, in addition to specifying a `y` column, the user may also supply `ymin` and `ymax` columns that can represent the boundaries of error bars. If only `ymin` and `ymax` are input when constructing the `TimeProfileDataMapping` object, with `y` left undefined or `NULL`, the default profile that will ultimately be plotted is a range plot. If `y`, `ymin` and `ymax` are all input, the default plot will be a time profile plot with an error bar. - - -# 4. Configure plot features: `PlotConfiguration` class. - -The role of the `PlotConfiguration` class is to provide a user-friendly interface to configure how the plot should look like. -In most cases, this class may be initialized with default settings within the plot function. -For cases where the plot needs specific settings or default, the class or its default values can be overwritten. -For advanced plots, subclasses are derived from `PlotConfiguration`, they use unique inputs and default related to the advanced plot to make it easier to use them. - -In more details, the `PlotConfiguration` class is a `R6Class` regrouping other `R6Class` objecrs defining specific settings to be implemented: -* `LabelConfiguration` defines the labels of the plot (title, subtitles, x axis, y axis) -* `LegendConfiguration` defines the legend properties of the plot -* `BackgroundConfiguration` defines the bakground properties of the plot (color, grid, watermark) -* `xAxisConfiguration` defines the properties of the X axis (scale, limits, printed values) -* `yAxisConfiguration` defines the properties of the Y axis (scale, limits, printed values) - -## Labels Configuration - -The labels configuration is a class that define a `Label` class for each plot label. -The `Label` class is defined by its `text` and `font`. The `font` is a class regrouping the `color`, `size`, `fontFace` and `fontFamily` of the font. -For instance, -```{r, result='as.is'} -title <- Label$new(text = "This is a title text", - font = Font$new(color = "red", - size = 12)) - -knitr::kable(data.frame("text" = title$text, - "color" = title$font$color, - "size" = title$font$size, - "face" = title$font$fontFace, - "family" = title$font$fontFamily - )) -``` - -Within the `PlotConfiguration` each label uses a default font and text defined from the current `Theme`, however this default can be overwritten. -```{r, result='as.is'} -config <- PlotConfiguration$new() -tilteConfig <- config$title - -knitr::kable(data.frame("text" = tilteConfig$text, - "color" = tilteConfig$font$color, - "size" = tilteConfig$font$color, - "face" = tilteConfig$font$fontFace, - "family" = tilteConfig$font$fontFamily - )) - -``` - -Advanced plots can use different defaults, which can be overwritten as well: -```{r, result='as.is'} -config <- PKRatioPlotConfiguration$new() -tilteConfig <- config$title - -knitr::kable(data.frame("text" = tilteConfig$text, - "color" = tilteConfig$font$color, - "size" = tilteConfig$font$color, - "face" = tilteConfig$font$fontFace, - "family" = tilteConfig$font$fontFamily - )) - -``` - -## 4.2. Background Configuration - -Background configuration defines the configuration of the following Background elements: `innerBackground`, `outerBackground`, `grid` and `watermark`. -If `watermark` is also a `Label` class, the 3 other elements are `BackgroundElementConfiguration` which can associate a color, linetype and size to the frame or grid of the background as well as a color fill for inner and outer background. -As for all the `PlotConfiguration` input, default is defined from the current `Theme`, however this default can be overwritten. -For instance: -```{r, result='as.is'} -background <- BackgroundConfiguration$new() - -knitr::kable(data.frame("grid color" = background$grid$color, - "grid linetype" = background$grid$linetype, - "grid size" = background$grid$size)) - -``` - - -## Axes Configuration - -`XAxisConfiguration` and `YAxisConfiguration` define the axes settings of the plot. -Within each axis configuration, `limits`, `scale`, `ticks` and their `ticklabels` can be defined. -A list of available scales can be used directly from the enum `Scaling`: -```{r, results='as.is', echo=FALSE} -knitr::kable(data.frame("Scaling" = as.character(sapply(Scaling, identity)))) - -``` - -## Legend Configuration - -The legend configuration set the `position`, `title(s)` and `caption` of the legend(s). -A list of available positions can be used directly from the enum `LegendPositions`: -```{r, results='as.is', echo=FALSE} -knitr::kable(data.frame("LegendPositions" = as.character(sapply(LegendPositions, identity)))) -``` - -## Themes - -The class `Theme` allows a user-friendly way to set many default plot settings. -Three predefined themes `defaultTheme`, `tlfTheme` and `bwTheme` are already available and can be used as templates, or it is possible to creates one's own theme either by initiliazing the class with overwritten or default input. -The themes defines not only the default for simple but account for advanced plots as well. - -In order to define a theme as the current default, the function `useTheme(theme)` needs to be called. -For instance, -```{r} -useTheme(tlfTheme) -``` - -# Minimal example - -The following minimal example show how to perform a basic time profile plot: -Data output from the `OSPSuiteR` is available in `data/tlf-output.RData` and includes `outputValues` which is a list containing data in as a data.frame and metaData as a list. - -A basic workflow defining the steps of mapping and setting the plot configuration can be: - -```{r, fig.height=5, fig.width=7.5} -# Input data and their metaData -data <- outputValues$data -metaData <- outputValues$metaData - -variableNames <- names(data) - -# Mapping x as Time, 8th variable of data as y and group the color by Gender -variableNames[8] - -map <- TimeProfileDataMapping$new(x = "Time", - y = variableNames[8], - color = "Gender") - -# Define the default Theme -useTheme(tlfTheme) - -# Define Y axis as a log scale -yAxis <- YAxisConfiguration$new(scale = Scaling$log10) - -# By using metaData and dataMapping, the configuration get the label as dimension [unit] directly -config <- TimeProfilePlotConfiguration$new(title = "Minimal Example", - yAxis = yAxis, - data = data, - metaData = metaData, - dataMapping = map) - -# Get the ggplot object -timeProfile <- plotTimeProfile(data = data, - metaData = metaData, - dataMapping = map, - plotConfiguration = config) -timeProfile +knitr::kable(tpMapping$checkMapData(data = testData)) ``` +A feature of `XYGDataMapping` class is that, in addition to specifying a `y` column, the user may also supply `ymin` and `ymax` columns that can represent the boundaries of error bars. If only `ymin` and `ymax` are input when constructing the `XYGDataMapping` object, with `y` left undefined or `NULL`, the default profile that will ultimately be plotted is a range plot. If `y`, `ymin` and `ymax` are all input, the default plot will be a IndividualId profile plot with an error bar.