diff --git a/DESCRIPTION b/DESCRIPTION index 2f9f7203..cebb9f48 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -41,6 +41,7 @@ Encoding: UTF-8 RoxygenNote: 7.2.1 Roxygen: list(markdown = TRUE) Suggests: + cowplot, knitr, rmarkdown, scales, @@ -99,6 +100,7 @@ Collate: 'themes.R' 'timeprofile-datamapping.R' 'timeprofile-helper.R' + 'timeprofile-plotconfiguration.R' 'tlf-env.R' 'tornado-datamapping.R' 'tornado-plotconfiguration.R' diff --git a/NAMESPACE b/NAMESPACE index a741a7a6..277ff99c 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -110,6 +110,7 @@ export(exportPlot) export(exportPlotConfigurationCode) export(getBoxWhiskerMeasure) export(getDefaultCaptions) +export(getDualAxisPlot) export(getGreekTickLabels) export(getGuestValues) export(getGuestValuesFromDataMapping) @@ -179,6 +180,7 @@ export(setPlotLabels) export(setWatermark) export(setXAxis) export(setXGrid) +export(setY2Axis) export(setYAxis) export(setYGrid) export(tlfStatFunctions) diff --git a/R/observed-data-mapping.R b/R/observed-data-mapping.R index 921786e3..4cdba0a8 100644 --- a/R/observed-data-mapping.R +++ b/R/observed-data-mapping.R @@ -14,12 +14,15 @@ ObservedDataMapping <- R6::R6Class( ymin = NULL, #' @field ymax mapping error bars around scatter points ymax = NULL, + #' @field y2Axis Name of y2Axis variable to map + y2Axis = NULL, #' @description Create a new `ObservedDataMapping` object #' @param x Name of x variable to map #' @param y Name of y variable to map #' @param ymin mapping lower end of error bars around scatter points #' @param ymax mapping upper end of error bars around scatter points + #' @param y2Axis Name of y2Axis variable to map #' @param color R6 class `Grouping` object or its input #' @param shape R6 class `Grouping` object or its input #' @param group R6 class `Grouping` object or its input @@ -33,9 +36,10 @@ ObservedDataMapping <- R6::R6Class( y, ymin = NULL, ymax = NULL, + y2Axis = NULL, + group = NULL, color = NULL, shape = NULL, - group = NULL, error = NULL, uncertainty = NULL, mdv = NULL, @@ -45,7 +49,16 @@ ObservedDataMapping <- R6::R6Class( validateIsString(ymin, nullAllowed = TRUE) validateIsString(ymax, nullAllowed = TRUE) validateIsString(mdv, nullAllowed = TRUE) - super$initialize(x = x, y = y, color = color, shape = shape, group = group, data = data) + # .smartMapping is available in utilities-mapping.R + smartMap <- .smartMapping(data) + super$initialize( + x = x %||% smartMap$x, + y = y %||% smartMap$y, + color = color, + shape = shape, + group = group, + data = data + ) # If defined, ymin and ymax are used as is # If not, error/uncertainty are used and @@ -54,6 +67,7 @@ ObservedDataMapping <- R6::R6Class( self$ymin <- ymin %||% ifNotNull(self$error, "ymin") self$ymax <- ymax %||% ifNotNull(self$error, "ymax") self$mdv <- mdv + self$y2Axis <- y2Axis }, #' @description Check that `data` variables include map variables @@ -63,8 +77,9 @@ ObservedDataMapping <- R6::R6Class( #' Dummy variable `defaultAes` is necessary to allow further modification of plots. checkMapData = function(data, metaData = NULL) { validateIsOfType(data, "data.frame") - validateIsIncluded(self$error, names(data), nullAllowed = TRUE) - validateIsIncluded(self$mdv, names(data), nullAllowed = TRUE) + .validateMapping(self$error, data, nullAllowed = TRUE) + .validateMapping(self$mdv, data, nullAllowed = TRUE) + .validateMapping(self$y2Axis, data, nullAllowed = TRUE) # Using super method, fetches x, y and groups mapData <- super$checkMapData(data, metaData) @@ -84,12 +99,68 @@ ObservedDataMapping <- R6::R6Class( if (isIncluded(self$ymin, names(data))) { mapData[, self$ymin] <- data[, self$ymin] } + if (!isEmpty(self$y2Axis)) { + mapData[, self$y2Axis] <- as.logical(data[, self$y2Axis]) + } # MDV is a Nonmem notation in which values with MDV==1 are removed if (!isEmpty(self$mdv)) { mapData[, self$mdv] <- as.logical(data[, self$mdv]) mapData <- mapData[!mapData[, self$mdv], ] } return(mapData) + }, + + #' @description Assess if `data` require a dual axis plot + #' @param data data.frame to check + #' @return A logical + requireDualAxis = function(data) { + .validateMapping(self$y2Axis, data, nullAllowed = TRUE) + if(isEmpty(self$y2Axis)){ + return(FALSE) + } + return(any(as.logical(data[, self$y2Axis]), na.rm = TRUE)) + }, + + #' @description Render NA values for all right axis data + #' @param data A data.frame + #' @return A data.frame to be plotted in left axis + getLeftAxis = function(data) { + if(!self$requireDualAxis(data)){ + return(data) + } + # Ensure NAs in that data don't mess up the selection + selectedRows <- as.logical(data[, self$y2Axis]) %in% TRUE + if (isIncluded(self$ymax, names(data))) { + data[selectedRows, self$ymax] <- NA + } + if (isIncluded(self$ymin, names(data))) { + data[selectedRows, self$ymin] <- NA + } + if (isIncluded(self$y, names(data))) { + data[selectedRows, self$y] <- NA + } + return(data) + }, + + #' @description Render NA values for all left axis data + #' @param data A data.frame + #' @return A data.frame to be plotted in right axis + getRightAxis = function(data) { + if(!self$requireDualAxis(data)){ + return(NULL) + } + # Ensure NAs in that data don't mess up the selection + selectedRows <- as.logical(data[, self$y2Axis]) %in% FALSE + if (isIncluded(self$ymax, names(data))) { + data[selectedRows, self$ymax] <- NA + } + if (isIncluded(self$ymin, names(data))) { + data[selectedRows, self$ymin] <- NA + } + if (isIncluded(self$y, names(data))) { + data[selectedRows, self$y] <- NA + } + return(data) } ) ) diff --git a/R/plot-observed-time-profile.R b/R/plot-observed-time-profile.R index 68bbecc6..6962f704 100644 --- a/R/plot-observed-time-profile.R +++ b/R/plot-observed-time-profile.R @@ -18,7 +18,7 @@ #' data = obsData, #' dataMapping = ObservedDataMapping$new(x = "x", y = "y") #' ) -plotObservedTimeProfile <- function(data = NULL, +plotObservedTimeProfile <- function(data, metaData = NULL, dataMapping = NULL, plotConfiguration = NULL, @@ -33,9 +33,50 @@ plotObservedTimeProfile <- function(data = NULL, ) plotObject <- .setPlotObject(plotObject, plotConfiguration) + requireDualAxis <- dataMapping$requireDualAxis(data) + + if (!requireDualAxis) { + plotObject <- .plotObservedTimeProfileCore( + data = data, + metaData = metaData, + dataMapping = dataMapping, + plotConfiguration = plotConfiguration, + plotObject = plotObject + ) + return(plotObject) + } + + leftPlotObject <- .plotObservedTimeProfileCore( + data = dataMapping$getLeftAxis(data), + metaData = metaData, + dataMapping = dataMapping, + plotConfiguration = plotConfiguration, + plotObject = plotObject + ) + rightPlotObject <- .plotObservedTimeProfileCore( + data = dataMapping$getRightAxis(data), + metaData = metaData, + dataMapping = dataMapping, + plotConfiguration = plotConfiguration, + plotObject = plotObject + ) + plotObject <- getDualAxisPlot(leftPlotObject, rightPlotObject) + return(plotObject) +} + + +#' @title .plotObservedTimeProfileCore +#' @description Producing Core of Time Profile plots for observed data +#' @inheritParams plotObservedTimeProfile +#' @return A `ggplot` object +#' @keywords internal +.plotObservedTimeProfileCore <- function(data = NULL, + metaData = NULL, + dataMapping = NULL, + plotConfiguration = NULL, + plotObject = NULL) { mapData <- dataMapping$checkMapData(data) mapLabels <- .getAesStringMapping(dataMapping) - #----- Build layers of molecule plot ----- # 1- Error bars if available if (!any(isEmpty(dataMapping$ymin), isEmpty(dataMapping$ymax))) { diff --git a/R/plot-simulated-time-profile.R b/R/plot-simulated-time-profile.R index 4ba83a02..749e52d0 100644 --- a/R/plot-simulated-time-profile.R +++ b/R/plot-simulated-time-profile.R @@ -39,10 +39,51 @@ plotSimulatedTimeProfile <- function(data = NULL, data, metaData, dataMapping ) plotObject <- .setPlotObject(plotObject, plotConfiguration) + + requireDualAxis <- dataMapping$requireDualAxis(data) + + if (!requireDualAxis) { + plotObject <- .plotSimulatedTimeProfileCore( + data = data, + metaData = metaData, + dataMapping = dataMapping, + plotConfiguration = plotConfiguration, + plotObject = plotObject + ) + return(plotObject) + } + + leftPlotObject <- .plotSimulatedTimeProfileCore( + data = dataMapping$getLeftAxis(data), + metaData = metaData, + dataMapping = dataMapping, + plotConfiguration = plotConfiguration, + plotObject = plotObject + ) + rightPlotObject <- .plotSimulatedTimeProfileCore( + data = dataMapping$getRightAxis(data), + metaData = metaData, + dataMapping = dataMapping, + plotConfiguration = plotConfiguration, + plotObject = plotObject + ) + plotObject <- getDualAxisPlot(leftPlotObject, rightPlotObject) + return(plotObject) +} +#' @title .plotSimulatedTimeProfileCore +#' @description Producing Core of Time Profile plots for simulated data +#' @inheritParams plotSimulatedTimeProfile +#' @return A `ggplot` object +#' @keywords internal +.plotSimulatedTimeProfileCore <- function(data = NULL, + metaData = NULL, + dataMapping = NULL, + plotConfiguration = NULL, + plotObject = NULL) { mapData <- dataMapping$checkMapData(data) mapLabels <- .getAesStringMapping(dataMapping) - + #----- Build layers of molecule plot ----- # 1- Ribbons if available if (!any(isEmpty(dataMapping$ymin), isEmpty(dataMapping$ymax))) { @@ -67,7 +108,7 @@ plotSimulatedTimeProfile <- function(data = NULL, show.legend = TRUE ) } - + # 2- Lines if (!isEmpty(dataMapping$y)) { aestheticValues <- .getAestheticValuesFromConfiguration( @@ -91,7 +132,7 @@ plotSimulatedTimeProfile <- function(data = NULL, show.legend = TRUE, ) } - + #----- Update properties using ggplot2::scale functions ----- plotObject <- .updateAesProperties( plotObject, diff --git a/R/plot-timeprofile.R b/R/plot-timeprofile.R index 3f8d2bce..b408a244 100644 --- a/R/plot-timeprofile.R +++ b/R/plot-timeprofile.R @@ -79,6 +79,59 @@ plotTimeProfile <- function(data = NULL, plotObject <- .setPlotObject(plotObject, plotConfiguration) + requireDualAxis <- any( + dataMapping$requireDualAxis(data), + observedDataMapping$requireDualAxis(observedData) + ) + + if (!requireDualAxis) { + plotObject <- .plotTimeProfileCore( + data = data, + metaData = metaData, + dataMapping = dataMapping, + observedData = observedData, + observedDataMapping = observedDataMapping, + plotConfiguration = plotConfiguration, + plotObject = plotObject + ) + return(plotObject) + } + + leftPlotObject <- .plotTimeProfileCore( + data = dataMapping$getLeftAxis(data), + metaData = metaData, + dataMapping = dataMapping, + observedData = observedDataMapping$getLeftAxis(observedData), + observedDataMapping = observedDataMapping, + plotConfiguration = plotConfiguration, + plotObject = plotObject + ) + rightPlotObject <- .plotTimeProfileCore( + data = dataMapping$getRightAxis(data), + metaData = metaData, + dataMapping = dataMapping, + observedData = observedDataMapping$getRightAxis(observedData), + observedDataMapping = observedDataMapping, + plotConfiguration = plotConfiguration, + plotObject = plotObject + ) + plotObject <- getDualAxisPlot(leftPlotObject, rightPlotObject) + return(plotObject) +} + + +#' @title .plotTimeProfileCore +#' @description Producing Core of Time Profile plots +#' @inheritParams plotTimeProfile +#' @return A `ggplot` object +#' @keywords internal +.plotTimeProfileCore <- function(data = NULL, + metaData = NULL, + dataMapping = NULL, + observedData = NULL, + observedDataMapping = NULL, + plotConfiguration = NULL, + plotObject = NULL) { mapData <- dataMapping$checkMapData(data) mapLabels <- .getAesStringMapping(dataMapping) @@ -288,6 +341,7 @@ plotTimeProfile <- function(data = NULL, } + #' @title updateTimeProfileLegend #' @description Update time profile legend caption #' @param plotObject A ggplot object diff --git a/R/plotconfiguration-axis.R b/R/plotconfiguration-axis.R index d90dadf1..7781383d 100644 --- a/R/plotconfiguration-axis.R +++ b/R/plotconfiguration-axis.R @@ -357,8 +357,8 @@ YAxisConfiguration <- R6::R6Class( "YAxisConfiguration", inherit = AxisConfiguration, public = list( - #' @field position character poistion of the Y-axis - position = NULL, # TO DO: find a way to include position in y axis, then scale position = "left" or "right" + #' @field position character position of the Y-axis + position = "left", #' @description Update axis configuration on a `ggplot` object #' @param plotObject `ggplot` object @@ -367,7 +367,12 @@ YAxisConfiguration <- R6::R6Class( updatePlot = function(plotObject, xlim = NULL) { validateIsOfType(plotObject, "ggplot") # Update font properties - plotObject <- plotObject + ggplot2::theme(axis.text.y = private$.font$createPlotFont()) + plotObject <- plotObject + switch( + self$position, + "left" = ggplot2::theme(axis.text.y = private$.font$createPlotFont()), + "right" = ggplot2::theme(axis.text.y.right = private$.font$createPlotFont()) + ) + suppressMessages( plotObject <- plotObject + ggplot2::coord_cartesian(xlim = xlim, ylim = private$.limits) ) @@ -376,6 +381,7 @@ YAxisConfiguration <- R6::R6Class( suppressMessages( plotObject <- plotObject + ggplot2::scale_y_discrete( + position = self$position, breaks = private$.ticks, labels = private$.ticklabels, expand = self$ggplotExpansion() @@ -388,6 +394,7 @@ YAxisConfiguration <- R6::R6Class( suppressMessages( plotObject <- plotObject + ggplot2::scale_y_continuous( + position = self$position, trans = self$ggplotScale(), breaks = self$prettyTicks(), minor_breaks = self$prettyMinorTicks(), @@ -415,8 +422,15 @@ YAxisConfiguration <- R6::R6Class( } suppressMessages({ plotObject <- switch(private$.scale, - "log" = plotObject + ggplot2::annotation_logticks(sides = "l", color = private$.font$color), - "ln" = plotObject + ggplot2::annotation_logticks(base = exp(1), sides = "l", color = private$.font$color), + "log" = plotObject + ggplot2::annotation_logticks( + sides = switch(self$position, "left" = "l", "right" = "r"), + color = private$.font$color + ), + "ln" = plotObject + ggplot2::annotation_logticks( + base = exp(1), + sides = switch(self$position, "left" = "l", "right" = "r"), + color = private$.font$color + ), plotObject ) }) diff --git a/R/plotconfiguration-background.R b/R/plotconfiguration-background.R index 26682a76..10f8ab7c 100644 --- a/R/plotconfiguration-background.R +++ b/R/plotconfiguration-background.R @@ -10,16 +10,20 @@ BackgroundConfiguration <- R6::R6Class( #' @param panel `BackgroundElement` object defining panel (inside of plot) background properties #' @param xAxis `LineElement` object defining properties of x-axis #' @param yAxis `LineElement` object defining properties of y-axis + #' @param y2Axis `LineElement` object defining properties of right y-axis #' @param xGrid `LineElement` object defining properties of x-grid #' @param yGrid `LineElement` object defining properties of y-grid + #' @param y2Grid `LineElement` object defining properties of right y-grid #' @return A new `BackgroundConfiguration` object initialize = function(watermark = NULL, plot = NULL, panel = NULL, xAxis = NULL, yAxis = NULL, + y2Axis = NULL, xGrid = NULL, - yGrid = NULL) { + yGrid = NULL, + y2Grid = NULL) { validateIsOfType(watermark, c("character", "Label"), nullAllowed = TRUE) currentTheme <- tlfEnv$currentTheme$clone(deep = TRUE) watermark <- watermark %||% currentTheme$background$watermark @@ -30,7 +34,7 @@ BackgroundConfiguration <- R6::R6Class( private$.watermark <- watermark areaFieldNames <- c("plot", "panel") - lineFieldNames <- c("xAxis", "yAxis", "xGrid", "yGrid") + lineFieldNames <- c("xAxis", "yAxis", "y2Axis", "xGrid", "yGrid", "y2Grid") validateAreaExpression <- parse(text = paste0("validateIsOfType(", areaFieldNames, ", 'BackgroundElement', nullAllowed = TRUE)")) validateLineExpression <- parse(text = paste0("validateIsOfType(", lineFieldNames, ", 'LineElement', nullAllowed = TRUE)")) @@ -108,6 +112,14 @@ BackgroundConfiguration <- R6::R6Class( validateIsOfType(value, "LineElement", nullAllowed = TRUE) private$.yAxis <- value %||% private$.yAxis }, + #' @field y2Axis `LineElement` object + y2Axis = function(value) { + if (missing(value)) { + return(private$.y2Axis) + } + validateIsOfType(value, "LineElement", nullAllowed = TRUE) + private$.y2Axis <- value %||% private$.y2Axis + }, #' @field xGrid `LineElement` object xGrid = function(value) { if (missing(value)) { @@ -123,6 +135,14 @@ BackgroundConfiguration <- R6::R6Class( } validateIsOfType(value, "LineElement", nullAllowed = TRUE) private$.yGrid <- value %||% private$.yGrid + }, + #' @field y2Grid `LineElement` object + y2Grid = function(value) { + if (missing(value)) { + return(private$.y2Grid) + } + validateIsOfType(value, "LineElement", nullAllowed = TRUE) + private$.y2Grid <- value %||% private$.y2Grid } ), private = list( @@ -131,9 +151,11 @@ BackgroundConfiguration <- R6::R6Class( .panel = NULL, .xAxis = NULL, .yAxis = NULL, + .y2Axis = NULL, .xGrid = NULL, - .yGrid = NULL - ), + .yGrid = NULL, + .y2Grid = NULL + ) ) #' @title BackgroundElement diff --git a/R/plotconfiguration-label.R b/R/plotconfiguration-label.R index 019f897a..8317617c 100644 --- a/R/plotconfiguration-label.R +++ b/R/plotconfiguration-label.R @@ -16,7 +16,9 @@ LabelConfiguration <- R6::R6Class( xlabel = NULL, ylabel = NULL, caption = NULL) { - inputs <- c("title", "subtitle", "xlabel", "ylabel", "caption") + # y2label not available for all plots but time profile + y2label <- NULL + inputs <- c("title", "subtitle", "xlabel", "ylabel", "caption", "y2label") validateExpressions <- parse(text = paste0("validateIsOfType(", inputs, ', c("Label", "character"), nullAllowed =TRUE)')) eval(validateExpressions) @@ -49,6 +51,7 @@ LabelConfiguration <- R6::R6Class( plot.subtitle = private$.subtitle$createPlotFont(), axis.title.x = private$.xlabel$createPlotFont(), axis.title.y = private$.ylabel$createPlotFont(), + axis.title.y.right = private$.y2label$createPlotFont(), plot.caption = private$.caption$createPlotFont() ) return(plotObject) @@ -114,6 +117,18 @@ LabelConfiguration <- R6::R6Class( } private$.caption <- asLabel(value, font = private$.caption$font) return(invisible()) + }, + #' @field y2label `Label` object defining the y2label of the plot + y2label = function(value) { + if (missing(value)) { + return(private$.y2label) + } + validateIsOfType(value, c("character", "Label"), nullAllowed = TRUE) + if (isOfType(value, "Label")) { + private$.y2label <- asLabel(value) + } + private$.y2label <- asLabel(value, font = private$.y2label$font) + return(invisible()) } ), private = list( @@ -121,6 +136,7 @@ LabelConfiguration <- R6::R6Class( .subtitle = NULL, .xlabel = NULL, .ylabel = NULL, - .caption = NULL + .caption = NULL, + .y2label = NULL ) ) diff --git a/R/plotconfiguration-sub-classes.R b/R/plotconfiguration-sub-classes.R index 13b3e4d3..468c9e22 100644 --- a/R/plotconfiguration-sub-classes.R +++ b/R/plotconfiguration-sub-classes.R @@ -1,12 +1,3 @@ -#' @title TimeProfilePlotConfiguration -#' @description R6 class defining the configuration of a `ggplot` object for time profile plots -#' @export -#' @family PlotConfiguration classes -TimeProfilePlotConfiguration <- R6::R6Class( - "TimeProfilePlotConfiguration", - inherit = PlotConfiguration -) - #' @title PKRatioPlotConfiguration #' @description R6 class defining the configuration of a `ggplot` object for PK ratio plots #' @field defaultYScale Default yAxis scale value when creating a `PKRatioPlotConfiguration` object diff --git a/R/themes.R b/R/themes.R index 16a7e2a5..466f0755 100644 --- a/R/themes.R +++ b/R/themes.R @@ -6,12 +6,14 @@ #' @field subtitle `Font` object for font properties of subtitle #' @field xlabel `Font` object for font properties of xlabel #' @field ylabel `Font` object for font properties of ylabel +#' @field y2label `Font` object for font properties of y2label #' @field caption `Font` object for font properties of caption #' @field watermark `Font` object for font properties of watermark #' @field legendTitle `Font` object for font properties of legend title #' @field legend `Font` object for font properties of legend #' @field xAxis `Font` object for font properties of xAxis #' @field yAxis `Font` object for font properties of yAxis +#' @field y2Axis `Font` object for font properties of y2Axis #' @export ThemeFont <- R6::R6Class( "ThemeFont", @@ -20,24 +22,28 @@ ThemeFont <- R6::R6Class( subtitle = NULL, xlabel = NULL, ylabel = NULL, + y2label = NULL, caption = NULL, watermark = NULL, legendTitle = NULL, legend = NULL, xAxis = NULL, yAxis = NULL, + y2Axis = NULL, #' @description Create a new `ThemeFont` object #' @param title `Font` object or list for font properties title #' @param subtitle `Font` object or list for font properties of subtitle #' @param xlabel `Font` object or list for font properties of xlabel #' @param ylabel `Font` object or list for font properties of ylabel + #' @param y2label `Font` object or list for font properties of y2label #' @param caption `Font` object or list for font properties of caption #' @param watermark `Font` object or list for font properties of watermark #' @param legendTitle `Font` object or list for font properties of legend title #' @param legend `Font` object or list for font properties of legend #' @param xAxis `Font` object or list for font properties of xAxis #' @param yAxis `Font` object or list for font properties of yAxis + #' @param y2Axis `Font` object or list for font properties of y2Axis #' @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". @@ -49,12 +55,14 @@ ThemeFont <- R6::R6Class( subtitle = NULL, xlabel = NULL, ylabel = NULL, + y2label = NULL, caption = NULL, watermark = NULL, legendTitle = NULL, legend = NULL, xAxis = NULL, yAxis = NULL, + y2Axis = NULL, baseColor = "black", baseSize = 12, baseFace = "plain", @@ -70,7 +78,7 @@ ThemeFont <- R6::R6Class( validateIsIncluded(baseAlign, Alignments) # Create all field properties by parsing and evaluating their expression - fieldNames <- c("title", "subtitle", "xlabel", "ylabel", "caption", "watermark", "legendTitle", "legend", "xAxis", "yAxis") + fieldNames <- c("title", "subtitle", "xlabel", "ylabel", "y2label", "caption", "watermark", "legendTitle", "legend", "xAxis", "yAxis", "y2Axis") setFontExpression <- parse(text = paste0( "self$", fieldNames, " <- Font$new(", "color = ", fieldNames, "$color %||% baseColor,", @@ -87,7 +95,7 @@ ThemeFont <- R6::R6Class( #' @return A list that can be saved into a json file toJson = function() { jsonObject <- list() - fieldNames <- c("title", "subtitle", "xlabel", "ylabel", "caption", "watermark", "legendTitle", "legend", "xAxis", "yAxis") + fieldNames <- c("title", "subtitle", "xlabel", "ylabel", "caption", "watermark", "legendTitle", "legend", "xAxis", "yAxis", "y2Axis") setJsonExpression <- parse(text = paste0( "jsonObject$", fieldNames, " <- list(", "color = self$", fieldNames, "$color,", @@ -112,8 +120,10 @@ ThemeFont <- R6::R6Class( #' @field panel `BackgroundElement` object for plot area properties (inside of panel) #' @field xAxis `BackgroundElement` object for x axis properties #' @field yAxis `BackgroundElement` object for y axis properties +#' @field y2Axis `BackgroundElement` object for right y axis properties #' @field xGrid `BackgroundElement` object for x grid properties #' @field yGrid `BackgroundElement` object for y grid properties +#' @field y2Grid `BackgroundElement` object for right y grid properties #' @field legend `BackgroundElement` object for legend area properties #' @export ThemeBackground <- R6::R6Class( @@ -126,8 +136,10 @@ ThemeBackground <- R6::R6Class( panel = NULL, xAxis = NULL, yAxis = NULL, + y2Axis = NULL, xGrid = NULL, yGrid = NULL, + y2Grid = NULL, legend = NULL, #' @description Create a new `ThemeBackground` object @@ -138,8 +150,10 @@ ThemeBackground <- R6::R6Class( #' @param panel `BackgroundElement` object or list for plot area properties (inside of panel) #' @param xAxis `BackgroundElement` object or list for x axis properties #' @param yAxis `BackgroundElement` object or list for y axis properties + #' @param y2Axis `BackgroundElement` object or list for right y axis properties #' @param xGrid `BackgroundElement` object or list for x grid properties #' @param yGrid `BackgroundElement` object or list for y grid properties + #' @param y2Grid `BackgroundElement` object or list for right y grid properties #' @param legend `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". @@ -153,8 +167,10 @@ ThemeBackground <- R6::R6Class( panel = NULL, xAxis = NULL, yAxis = NULL, + y2Axis = NULL, xGrid = NULL, yGrid = NULL, + y2Grid = NULL, legend = NULL, baseFill = "white", baseColor = "black", @@ -175,7 +191,7 @@ ThemeBackground <- R6::R6Class( # Create all field properties by parsing and evaluating their expression areaFieldNames <- c("plot", "panel", "legend") - lineFieldNames <- c("xAxis", "yAxis", "xGrid", "yGrid") + lineFieldNames <- c("xAxis", "yAxis", "y2Axis", "xGrid", "yGrid", "y2Grid") setAreaExpression <- parse(text = paste0( "self$", areaFieldNames, " <- BackgroundElement$new(", @@ -202,7 +218,7 @@ ThemeBackground <- R6::R6Class( jsonObject$legendPosition <- self$legendPosition jsonObject$legendTitle <- self$legendTitle areaFieldNames <- c("plot", "panel", "legend") - lineFieldNames <- c("xAxis", "yAxis", "xGrid", "yGrid") + lineFieldNames <- c("xAxis", "yAxis", "y2Axis", "xGrid", "yGrid", "y2Grid") setJsonAreaExpression <- parse(text = paste0( "jsonObject$", areaFieldNames, " <- list(", diff --git a/R/timeprofile-datamapping.R b/R/timeprofile-datamapping.R index c71f6a30..7d913276 100644 --- a/R/timeprofile-datamapping.R +++ b/R/timeprofile-datamapping.R @@ -6,11 +6,15 @@ TimeProfileDataMapping <- R6::R6Class( "TimeProfileDataMapping", inherit = RangeDataMapping, public = list( + #' @field y2Axis Name of y2Axis variable to map + y2Axis = NULL, + #' @description Create a new `TimeProfileDataMapping` object #' @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 y2Axis Name of y2Axis variable to map #' @param group R6 class `Grouping` object or its input #' @param color R6 class `Grouping` object or its input #' @param fill R6 class `Grouping` object or its input @@ -22,6 +26,7 @@ TimeProfileDataMapping <- R6::R6Class( ymin = NULL, ymax = NULL, group = NULL, + y2Axis = NULL, color = NULL, fill = NULL, linetype = NULL, @@ -37,6 +42,7 @@ TimeProfileDataMapping <- R6::R6Class( # Since TimeProfileDataMapping inherits from RangeDataMapping # super$initialize introduce a self$y which is NULL self$y <- y %||% smartMap$y + self$y2Axis <- y2Axis }, #' @description Check that `data` variables include map variables #' @param data data.frame to check @@ -46,13 +52,70 @@ TimeProfileDataMapping <- R6::R6Class( checkMapData = function(data, metaData = NULL) { validateIsOfType(data, "data.frame") .validateMapping(self$y, data, nullAllowed = TRUE) + .validateMapping(self$y2Axis, data, nullAllowed = TRUE) mapData <- super$checkMapData(data, metaData) # This may change depending of how we want to include options if (!isEmpty(self$y)) { mapData[, self$y] <- data[, self$y] } + if (!isEmpty(self$y2Axis)) { + mapData[, self$y2Axis] <- as.logical(data[, self$y2Axis]) + } self$data <- mapData return(mapData) + }, + + #' @description Assess if `data` require a dual axis plot + #' @param data data.frame to check + #' @return A logical + requireDualAxis = function(data) { + .validateMapping(self$y2Axis, data, nullAllowed = TRUE) + if (isEmpty(self$y2Axis)) { + return(FALSE) + } + return(any(as.logical(data[, self$y2Axis]), na.rm = TRUE)) + }, + + #' @description Render NA values for all right axis data + #' @param data A data.frame + #' @return A data.frame to be plotted in left axis + getLeftAxis = function(data) { + if (!self$requireDualAxis(data)) { + return(data) + } + # Ensure NAs in that data don't mess up the selection + selectedRows <- as.logical(data[, self$y2Axis]) %in% TRUE + if (isIncluded(self$ymax, names(data))) { + data[selectedRows, self$ymax] <- NA + } + if (isIncluded(self$ymin, names(data))) { + data[selectedRows, self$ymin] <- NA + } + if (isIncluded(self$y, names(data))) { + data[selectedRows, self$y] <- NA + } + return(data) + }, + + #' @description Render NA values for all left axis data + #' @param data A data.frame + #' @return A data.frame to be plotted in right axis + getRightAxis = function(data) { + if (!self$requireDualAxis(data)) { + return(NULL) + } + # Ensure NAs in that data don't mess up the selection + selectedRows <- as.logical(data[, self$y2Axis]) %in% FALSE + if (isIncluded(self$ymax, names(data))) { + data[selectedRows, self$ymax] <- NA + } + if (isIncluded(self$ymin, names(data))) { + data[selectedRows, self$ymin] <- NA + } + if (isIncluded(self$y, names(data))) { + data[selectedRows, self$y] <- NA + } + return(data) } ) ) diff --git a/R/timeprofile-plotconfiguration.R b/R/timeprofile-plotconfiguration.R new file mode 100644 index 00000000..3d632729 --- /dev/null +++ b/R/timeprofile-plotconfiguration.R @@ -0,0 +1,74 @@ +#' @title TimeProfilePlotConfiguration +#' @description R6 class defining the configuration of a `ggplot` object for time profile plots +#' @export +#' @family PlotConfiguration classes +TimeProfilePlotConfiguration <- R6::R6Class( + "TimeProfilePlotConfiguration", + inherit = PlotConfiguration, + public = list( + #' @description Create a new `TimeProfilePlotConfiguration` object + #' @param y2label character or `Label` object defining plot y2label + #' @param y2Axis `YAxisConfiguration` object defining y-axis properties + #' @param y2Scale name of y2-axis scale. Use enum `Scaling` to access predefined scales. + #' @param y2Limits numeric vector of length 2 defining y-axis limits + #' @param data data.frame used by `.smartMapping` + #' @param metaData list of information on `data` + #' @param dataMapping R6 class or subclass `TimeProfileDataMapping` + #' @param ... parameters inherited from `PlotConfiguration` + #' @return A new `TimeProfilePlotConfiguration` object + initialize = function(..., + # Y2 label + y2label = NULL, + # Y2-Axis configuration + y2Axis = NULL, + y2Scale = NULL, + y2Limits = NULL, + # Smart configuration using metaData + data = NULL, + metaData = NULL, + dataMapping = NULL) { + super$initialize( + ..., + data = data, + metaData = metaData, + dataMapping = dataMapping + ) + # Update Y2 label + private$.labels$y2label <- y2label %||% private$.labels$y2label + if (!is.null(data)) { + dataMapping <- dataMapping %||% TimeProfileDataMapping$new(data = data) + } + private$.labels$y2label <- asLabel( + y2label %||% + .dataMappingLabel(dataMapping$y2Axis, metaData) %||% + dataMapping$y2Axis %||% + private$.labels$y2label$text, font = private$.labels$y2label$font + ) + + # Y2-Axis configuration, overwrite some properties only if they are defined + validateIsOfType(y2Axis, "YAxisConfiguration", nullAllowed = TRUE) + private$.y2Axis <- y2Axis %||% YAxisConfiguration$new( + scale = self$defaultYScale, + expand = self$defaultExpand + ) + private$.y2Axis$position <- "right" + private$.y2Axis$limits <- y2Limits %||% private$.y2Axis$limits + private$.y2Axis$scale <- y2Scale %||% private$.y2Axis$scale + } + ), + active = list( + #' @field y2Axis `YAxisConfiguration` object defining properties of y2-axis + y2Axis = function(value) { + if (missing(value)) { + return(private$.y2Axis) + } + validateIsOfType(value, "YAxisConfiguration", nullAllowed = TRUE) + private$.y2Axis <- value %||% private$.y2Axis + private$.y2Axis$position <- "right" + return(invisible()) + } + ), + private = list( + .y2Axis = NULL + ) +) diff --git a/R/utilities-axis.R b/R/utilities-axis.R index de1aa023..478b4d35 100644 --- a/R/utilities-axis.R +++ b/R/utilities-axis.R @@ -95,6 +95,38 @@ setYAxis <- function(plotObject, return(newPlotObject) } +#' @title setY2Axis +#' @description Set right Y-axis properties of a `ggplot` object +#' @inheritParams setXAxis +#' @return A `ggplot` object +#' @export +setY2Axis <- function(plotObject, + scale = NULL, + limits = NULL, + ticks = NULL, + ticklabels = NULL, + minorTicks = NULL, + font = NULL, + expand = NULL) { + validateIsOfType(plotObject, "ggplot") + validateIsIncluded(scale, Scaling, nullAllowed = TRUE) + validateIsNumeric(limits, nullAllowed = TRUE) + validateIsOfType(font, "Font", nullAllowed = TRUE) + validateIsLogical(expand, 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 + y2Axis <- newPlotObject$plotConfiguration$y2Axis %||% YAxisConfiguration$new() + y2Axis$position <- "right" + eval(.parseVariableToObject("y2Axis", c("limits", "scale", "ticks", "ticklabels", "minorTicks", "font", "expand"), keepIfNull = TRUE)) + newPlotObject <- y2Axis$updatePlot(newPlotObject, xlim = newPlotObject$plotConfiguration$xAxis$limits) + return(newPlotObject) +} + #' @title getLogTickLabels #' @description Get ticklabels expressions for log scale plots diff --git a/R/utilities-molecule-plots.R b/R/utilities-molecule-plots.R index a5cf6049..81341171 100644 --- a/R/utilities-molecule-plots.R +++ b/R/utilities-molecule-plots.R @@ -242,3 +242,69 @@ ) return(plotObject) } + +#' @title getDualAxisPlot +#' @description Check if dual Y Axis is needed +#' @param leftPlotObject A `ggplot` object with left y-axis +#' @param rightPlotObject A `ggplot` object with right y-axis +#' @return A `ggplot` object with dual y-axis +#' @export +getDualAxisPlot <- function(leftPlotObject, rightPlotObject){ + stopifnot(requireNamespace("cowplot", quietly = TRUE)) + # Only one legend shall be kept to prevent text not aligned and on top of plot axes text + # For most cases, right plot legend is kept as is while left plot legend is removed + # If left side legend, left plot legend is kept as is while right plot legend is removed + legendPosition <- getLegendPosition(leftPlotObject) + if(isIncluded(legendPosition, LegendPositions$outsideLeft)){ + rightPlotObject <- setLegendPosition(rightPlotObject, position = LegendPositions$none) + } else { + leftPlotObject <- setLegendPosition(leftPlotObject, position = LegendPositions$none) + } + # Set same X-Axis between plots + leftScale <- ggplot2::layer_scales(leftPlotObject) + rightScale <- ggplot2::layer_scales(rightPlotObject) + mergeXRange <- range(leftScale$x$range$range, rightScale$x$range$range) + + leftPlotObject <- setXAxis(leftPlotObject, limits = mergeXRange) + rightPlotObject <- setXAxis(rightPlotObject, limits = mergeXRange) + + # Transformed right plot to be compatible with left plot + rightPlotObject <- rightPlotObject + + ggplot2::theme( + # Update right axis properties + axis.text.y.right = rightPlotObject$plotConfiguration$y2Axis$font$createPlotFont(), + axis.title.y.right = rightPlotObject$plotConfiguration$labels$y2label$createPlotFont(), + axis.line.y.right = rightPlotObject$plotConfiguration$background$y2Axis$createPlotElement(), + panel.grid.major.y = rightPlotObject$plotConfiguration$background$y2Grid$createPlotElement(), + panel.grid.minor.y = rightPlotObject$plotConfiguration$background$y2Grid$createPlotElement( + size = as.numeric(rightPlotObject$plotConfiguration$background$y2Grid$size) / 2 + ), + # Remove all other background properties + plot.background = ggplot2::element_blank(), + panel.background = ggplot2::element_blank(), + axis.line.x = ggplot2::element_blank(), + axis.line.y.left = ggplot2::element_blank(), + panel.grid.major.x = ggplot2::element_blank(), + panel.grid.minor.x = ggplot2::element_blank() + ) + rightPlotObject <- setPlotLabels( + rightPlotObject, + ylabel = rightPlotObject$plotConfiguration$labels$y2label + ) + rightPlotObject <- setY2Axis(rightPlotObject) + leftPlotObject <- setYAxis(leftPlotObject) + + alignedPlots <- cowplot::align_plots( + leftPlotObject, + rightPlotObject, + align = "hv", + axis = "tblr" + ) + + mergedPlotObject <- cowplot::ggdraw(alignedPlots[[1]]) + + cowplot::draw_plot(alignedPlots[[2]]) + # In case of additional updates, clone plotConfiguration + mergedPlotObject$plotConfiguration <- leftPlotObject$plotConfiguration$clone(deep = TRUE) + + return(mergedPlotObject) +} \ No newline at end of file diff --git a/inst/themes/minimal-theme.json b/inst/themes/minimal-theme.json index 17b41f36..a796a2ac 100644 --- a/inst/themes/minimal-theme.json +++ b/inst/themes/minimal-theme.json @@ -32,6 +32,14 @@ "angle": 90, "align": "center" }, + "y2label": { + "color": "grey20", + "size": 10, + "fontFace": "plain", + "fontFamily": "", + "angle": -90, + "align": "center" + }, "caption": { "color": "grey20", "size": 8, @@ -79,6 +87,14 @@ "fontFamily": "", "angle": 0, "align": "right" + }, + "y2Axis": { + "color": "grey20", + "size": 10, + "fontFace": "plain", + "fontFamily": "", + "angle": 0, + "align": "right" } }, "background": { @@ -106,6 +122,11 @@ "size": "0.5", "linetype": "solid" }, + "y2Axis": { + "color": "grey20", + "size": "0.5", + "linetype": "solid" + }, "xGrid": { "color": "grey20", "size": "0.5", @@ -116,6 +137,11 @@ "size": "0.5", "linetype": "blank" }, + "y2Grid": { + "color": "grey20", + "size": "0.5", + "linetype": "blank" + }, "legend": { "fill": "white", "color": "white", diff --git a/man/BackgroundConfiguration.Rd b/man/BackgroundConfiguration.Rd index 75e4b8f9..eeb78cd0 100644 --- a/man/BackgroundConfiguration.Rd +++ b/man/BackgroundConfiguration.Rd @@ -19,9 +19,13 @@ R6 class defining the configuration of background \item{\code{yAxis}}{\code{LineElement} object} +\item{\code{y2Axis}}{\code{LineElement} object} + \item{\code{xGrid}}{\code{LineElement} object} \item{\code{yGrid}}{\code{LineElement} object} + +\item{\code{y2Grid}}{\code{LineElement} object} } \if{html}{\out{}} } @@ -45,8 +49,10 @@ Create a new \code{BackgroundConfiguration} object panel = NULL, xAxis = NULL, yAxis = NULL, + y2Axis = NULL, xGrid = NULL, - yGrid = NULL + yGrid = NULL, + y2Grid = NULL )}\if{html}{\out{}} } @@ -63,9 +69,13 @@ Create a new \code{BackgroundConfiguration} object \item{\code{yAxis}}{\code{LineElement} object defining properties of y-axis} +\item{\code{y2Axis}}{\code{LineElement} object defining properties of right y-axis} + \item{\code{xGrid}}{\code{LineElement} object defining properties of x-grid} \item{\code{yGrid}}{\code{LineElement} object defining properties of y-grid} + +\item{\code{y2Grid}}{\code{LineElement} object defining properties of right y-grid} } \if{html}{\out{}} } diff --git a/man/DataMappings.Rd b/man/DataMappings.Rd index 5f6db8ea..7af6c405 100644 --- a/man/DataMappings.Rd +++ b/man/DataMappings.Rd @@ -5,7 +5,7 @@ \alias{DataMappings} \title{DataMappings} \format{ -An object of class \code{list} of length 16. +An object of class \code{list} of length 17. } \usage{ DataMappings diff --git a/man/LabelConfiguration.Rd b/man/LabelConfiguration.Rd index afa2e194..7e019b48 100644 --- a/man/LabelConfiguration.Rd +++ b/man/LabelConfiguration.Rd @@ -18,6 +18,8 @@ R6 class defining the configuration of the labels of a \code{ggplot} object \item{\code{ylabel}}{\code{Label} object defining the ylabel of the plot} \item{\code{caption}}{\code{Label} object defining the caption of the plot} + +\item{\code{y2label}}{\code{Label} object defining the y2label of the plot} } \if{html}{\out{}} } diff --git a/man/ObservedDataMapping.Rd b/man/ObservedDataMapping.Rd index 7e56daf2..17ac845a 100644 --- a/man/ObservedDataMapping.Rd +++ b/man/ObservedDataMapping.Rd @@ -39,6 +39,8 @@ Other DataMapping classes: \item{\code{ymin}}{mapping error bars around scatter points} \item{\code{ymax}}{mapping error bars around scatter points} + +\item{\code{y2Axis}}{Name of y2Axis variable to map} } \if{html}{\out{}} } @@ -47,6 +49,9 @@ Other DataMapping classes: \itemize{ \item \href{#method-ObservedDataMapping-new}{\code{ObservedDataMapping$new()}} \item \href{#method-ObservedDataMapping-checkMapData}{\code{ObservedDataMapping$checkMapData()}} +\item \href{#method-ObservedDataMapping-requireDualAxis}{\code{ObservedDataMapping$requireDualAxis()}} +\item \href{#method-ObservedDataMapping-getLeftAxis}{\code{ObservedDataMapping$getLeftAxis()}} +\item \href{#method-ObservedDataMapping-getRightAxis}{\code{ObservedDataMapping$getRightAxis()}} \item \href{#method-ObservedDataMapping-clone}{\code{ObservedDataMapping$clone()}} } } @@ -61,9 +66,10 @@ Create a new \code{ObservedDataMapping} object y, ymin = NULL, ymax = NULL, + y2Axis = NULL, + group = NULL, color = NULL, shape = NULL, - group = NULL, error = NULL, uncertainty = NULL, mdv = NULL, @@ -82,12 +88,14 @@ Create a new \code{ObservedDataMapping} object \item{\code{ymax}}{mapping upper end of error bars around scatter points} +\item{\code{y2Axis}}{Name of y2Axis variable to map} + +\item{\code{group}}{R6 class \code{Grouping} object or its input} + \item{\code{color}}{R6 class \code{Grouping} object or its input} \item{\code{shape}}{R6 class \code{Grouping} object or its input} -\item{\code{group}}{R6 class \code{Grouping} object or its input} - \item{\code{error}}{mapping error bars around scatter points} \item{\code{uncertainty}}{mapping error bars around scatter points. @@ -127,6 +135,66 @@ Dummy variable \code{defaultAes} is necessary to allow further modification of p } } \if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-ObservedDataMapping-requireDualAxis}{}}} +\subsection{Method \code{requireDualAxis()}}{ +Assess if \code{data} require a dual axis plot +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{ObservedDataMapping$requireDualAxis(data)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{data}}{data.frame to check} +} +\if{html}{\out{
}} +} +\subsection{Returns}{ +A logical +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-ObservedDataMapping-getLeftAxis}{}}} +\subsection{Method \code{getLeftAxis()}}{ +Render NA values for all right axis data +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{ObservedDataMapping$getLeftAxis(data)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{data}}{A data.frame} +} +\if{html}{\out{
}} +} +\subsection{Returns}{ +A data.frame to be plotted in left axis +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-ObservedDataMapping-getRightAxis}{}}} +\subsection{Method \code{getRightAxis()}}{ +Render NA values for all left axis data +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{ObservedDataMapping$getRightAxis(data)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{data}}{A data.frame} +} +\if{html}{\out{
}} +} +\subsection{Returns}{ +A data.frame to be plotted in right axis +} +} +\if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-ObservedDataMapping-clone}{}}} \subsection{Method \code{clone()}}{ diff --git a/man/PlotConfigurations.Rd b/man/PlotConfigurations.Rd index 2548dd10..12cdfe97 100644 --- a/man/PlotConfigurations.Rd +++ b/man/PlotConfigurations.Rd @@ -5,7 +5,7 @@ \alias{PlotConfigurations} \title{PlotConfigurations} \format{ -An object of class \code{list} of length 9. +An object of class \code{list} of length 10. } \usage{ PlotConfigurations diff --git a/man/ThemeBackground.Rd b/man/ThemeBackground.Rd index 94317db8..dc0e23f2 100644 --- a/man/ThemeBackground.Rd +++ b/man/ThemeBackground.Rd @@ -23,10 +23,14 @@ R6 class defining theme background properties \item{\code{yAxis}}{\code{BackgroundElement} object for y axis properties} +\item{\code{y2Axis}}{\code{BackgroundElement} object for right 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{y2Grid}}{\code{BackgroundElement} object for right y grid properties} + \item{\code{legend}}{\code{BackgroundElement} object for legend area properties} } \if{html}{\out{}} @@ -53,8 +57,10 @@ Create a new \code{ThemeBackground} object panel = NULL, xAxis = NULL, yAxis = NULL, + y2Axis = NULL, xGrid = NULL, yGrid = NULL, + y2Grid = NULL, legend = NULL, baseFill = "white", baseColor = "black", @@ -80,10 +86,14 @@ Create a new \code{ThemeBackground} object \item{\code{yAxis}}{\code{BackgroundElement} object or list for y axis properties} +\item{\code{y2Axis}}{\code{BackgroundElement} object or list for right 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{y2Grid}}{\code{BackgroundElement} object or list for right 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".} diff --git a/man/ThemeFont.Rd b/man/ThemeFont.Rd index ec29d9f7..a8b7b753 100644 --- a/man/ThemeFont.Rd +++ b/man/ThemeFont.Rd @@ -17,6 +17,8 @@ R6 class defining theme font properties \item{\code{ylabel}}{\code{Font} object for font properties of ylabel} +\item{\code{y2label}}{\code{Font} object for font properties of y2label} + \item{\code{caption}}{\code{Font} object for font properties of caption} \item{\code{watermark}}{\code{Font} object for font properties of watermark} @@ -28,6 +30,8 @@ R6 class defining theme font properties \item{\code{xAxis}}{\code{Font} object for font properties of xAxis} \item{\code{yAxis}}{\code{Font} object for font properties of yAxis} + +\item{\code{y2Axis}}{\code{Font} object for font properties of y2Axis} } \if{html}{\out{}} } @@ -50,12 +54,14 @@ Create a new \code{ThemeFont} object subtitle = NULL, xlabel = NULL, ylabel = NULL, + y2label = NULL, caption = NULL, watermark = NULL, legendTitle = NULL, legend = NULL, xAxis = NULL, yAxis = NULL, + y2Axis = NULL, baseColor = "black", baseSize = 12, baseFace = "plain", @@ -76,6 +82,8 @@ Create a new \code{ThemeFont} object \item{\code{ylabel}}{\code{Font} object or list for font properties of ylabel} +\item{\code{y2label}}{\code{Font} object or list for font properties of y2label} + \item{\code{caption}}{\code{Font} object or list for font properties of caption} \item{\code{watermark}}{\code{Font} object or list for font properties of watermark} @@ -88,6 +96,8 @@ Create a new \code{ThemeFont} object \item{\code{yAxis}}{\code{Font} object or list for font properties of yAxis} +\item{\code{y2Axis}}{\code{Font} object or list for font properties of y2Axis} + \item{\code{baseColor}}{name of base color of undefined fonts. Default is "black".} \item{\code{baseSize}}{base size of undefined fonts. Default is 12.} diff --git a/man/TimeProfileDataMapping.Rd b/man/TimeProfileDataMapping.Rd index 89470cd5..4b6c12c0 100644 --- a/man/TimeProfileDataMapping.Rd +++ b/man/TimeProfileDataMapping.Rd @@ -29,11 +29,21 @@ Other DataMapping classes: \section{Super classes}{ \code{tlf::XYDataMapping} -> \code{tlf::XYGDataMapping} -> \code{tlf::RangeDataMapping} -> \code{TimeProfileDataMapping} } +\section{Public fields}{ +\if{html}{\out{
}} +\describe{ +\item{\code{y2Axis}}{Name of y2Axis variable to map} +} +\if{html}{\out{
}} +} \section{Methods}{ \subsection{Public methods}{ \itemize{ \item \href{#method-TimeProfileDataMapping-new}{\code{TimeProfileDataMapping$new()}} \item \href{#method-TimeProfileDataMapping-checkMapData}{\code{TimeProfileDataMapping$checkMapData()}} +\item \href{#method-TimeProfileDataMapping-requireDualAxis}{\code{TimeProfileDataMapping$requireDualAxis()}} +\item \href{#method-TimeProfileDataMapping-getLeftAxis}{\code{TimeProfileDataMapping$getLeftAxis()}} +\item \href{#method-TimeProfileDataMapping-getRightAxis}{\code{TimeProfileDataMapping$getRightAxis()}} \item \href{#method-TimeProfileDataMapping-clone}{\code{TimeProfileDataMapping$clone()}} } } @@ -49,6 +59,7 @@ Create a new \code{TimeProfileDataMapping} object ymin = NULL, ymax = NULL, group = NULL, + y2Axis = NULL, color = NULL, fill = NULL, linetype = NULL, @@ -69,6 +80,8 @@ Create a new \code{TimeProfileDataMapping} object \item{\code{group}}{R6 class \code{Grouping} object or its input} +\item{\code{y2Axis}}{Name of y2Axis variable to map} + \item{\code{color}}{R6 class \code{Grouping} object or its input} \item{\code{fill}}{R6 class \code{Grouping} object or its input} @@ -107,6 +120,66 @@ Dummy variable \code{legendLabels} is necessary to allow further modification of } } \if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-TimeProfileDataMapping-requireDualAxis}{}}} +\subsection{Method \code{requireDualAxis()}}{ +Assess if \code{data} require a dual axis plot +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{TimeProfileDataMapping$requireDualAxis(data)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{data}}{data.frame to check} +} +\if{html}{\out{
}} +} +\subsection{Returns}{ +A logical +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-TimeProfileDataMapping-getLeftAxis}{}}} +\subsection{Method \code{getLeftAxis()}}{ +Render NA values for all right axis data +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{TimeProfileDataMapping$getLeftAxis(data)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{data}}{A data.frame} +} +\if{html}{\out{
}} +} +\subsection{Returns}{ +A data.frame to be plotted in left axis +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-TimeProfileDataMapping-getRightAxis}{}}} +\subsection{Method \code{getRightAxis()}}{ +Render NA values for all left axis data +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{TimeProfileDataMapping$getRightAxis(data)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{data}}{A data.frame} +} +\if{html}{\out{
}} +} +\subsection{Returns}{ +A data.frame to be plotted in right axis +} +} +\if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-TimeProfileDataMapping-clone}{}}} \subsection{Method \code{clone()}}{ diff --git a/man/TimeProfilePlotConfiguration.Rd b/man/TimeProfilePlotConfiguration.Rd index 2eb8132d..e085210b 100644 --- a/man/TimeProfilePlotConfiguration.Rd +++ b/man/TimeProfilePlotConfiguration.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/plotconfiguration-sub-classes.R +% Please edit documentation in R/timeprofile-plotconfiguration.R \name{TimeProfilePlotConfiguration} \alias{TimeProfilePlotConfiguration} \title{TimeProfilePlotConfiguration} @@ -22,19 +22,63 @@ Other PlotConfiguration classes: \section{Super class}{ \code{tlf::PlotConfiguration} -> \code{TimeProfilePlotConfiguration} } +\section{Active bindings}{ +\if{html}{\out{
}} +\describe{ +\item{\code{y2Axis}}{\code{YAxisConfiguration} object defining properties of y2-axis} +} +\if{html}{\out{
}} +} \section{Methods}{ \subsection{Public methods}{ \itemize{ +\item \href{#method-TimeProfilePlotConfiguration-new}{\code{TimeProfilePlotConfiguration$new()}} \item \href{#method-TimeProfilePlotConfiguration-clone}{\code{TimeProfilePlotConfiguration$clone()}} } } -\if{html}{\out{ -
Inherited methods - -
-}} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-TimeProfilePlotConfiguration-new}{}}} +\subsection{Method \code{new()}}{ +Create a new \code{TimeProfilePlotConfiguration} object +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{TimeProfilePlotConfiguration$new( + ..., + y2label = NULL, + y2Axis = NULL, + y2Scale = NULL, + y2Limits = NULL, + data = NULL, + metaData = NULL, + dataMapping = NULL +)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{...}}{parameters inherited from \code{PlotConfiguration}} + +\item{\code{y2label}}{character or \code{Label} object defining plot y2label} + +\item{\code{y2Axis}}{\code{YAxisConfiguration} object defining y-axis properties} + +\item{\code{y2Scale}}{name of y2-axis scale. Use enum \code{Scaling} to access predefined scales.} + +\item{\code{y2Limits}}{numeric vector of length 2 defining y-axis limits} + +\item{\code{data}}{data.frame used by \code{.smartMapping}} + +\item{\code{metaData}}{list of information on \code{data}} + +\item{\code{dataMapping}}{R6 class or subclass \code{TimeProfileDataMapping}} +} +\if{html}{\out{
}} +} +\subsection{Returns}{ +A new \code{TimeProfilePlotConfiguration} object +} +} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-TimeProfilePlotConfiguration-clone}{}}} diff --git a/man/YAxisConfiguration.Rd b/man/YAxisConfiguration.Rd index fb46e1db..9713dc10 100644 --- a/man/YAxisConfiguration.Rd +++ b/man/YAxisConfiguration.Rd @@ -12,7 +12,7 @@ R6 class defining the configuration of Y-axis \section{Public fields}{ \if{html}{\out{
}} \describe{ -\item{\code{position}}{character poistion of the Y-axis} +\item{\code{position}}{character position of the Y-axis} } \if{html}{\out{
}} } diff --git a/man/dot-plotObservedTimeProfileCore.Rd b/man/dot-plotObservedTimeProfileCore.Rd new file mode 100644 index 00000000..736dfe51 --- /dev/null +++ b/man/dot-plotObservedTimeProfileCore.Rd @@ -0,0 +1,32 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/plot-observed-time-profile.R +\name{.plotObservedTimeProfileCore} +\alias{.plotObservedTimeProfileCore} +\title{.plotObservedTimeProfileCore} +\usage{ +.plotObservedTimeProfileCore( + data = NULL, + metaData = NULL, + dataMapping = NULL, + plotConfiguration = NULL, + plotObject = NULL +) +} +\arguments{ +\item{data}{A data.frame to use for plot.} + +\item{metaData}{A named list of information about \code{data} such as the \code{dimension} and \code{unit} of its variables.} + +\item{dataMapping}{An \code{ObservedDataMapping} object mapping \code{x}, \code{y}, \code{ymin}, \code{ymax} and aesthetic groups to their variable names of \code{observedData}.} + +\item{plotConfiguration}{An optional \code{TimeProfilePlotConfiguration} object defining labels, grid, background and watermark.} + +\item{plotObject}{An optional \code{ggplot} object on which to add the plot layer} +} +\value{ +A \code{ggplot} object +} +\description{ +Producing Core of Time Profile plots for observed data +} +\keyword{internal} diff --git a/man/dot-plotSimulatedTimeProfileCore.Rd b/man/dot-plotSimulatedTimeProfileCore.Rd new file mode 100644 index 00000000..16a3596d --- /dev/null +++ b/man/dot-plotSimulatedTimeProfileCore.Rd @@ -0,0 +1,32 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/plot-simulated-time-profile.R +\name{.plotSimulatedTimeProfileCore} +\alias{.plotSimulatedTimeProfileCore} +\title{.plotSimulatedTimeProfileCore} +\usage{ +.plotSimulatedTimeProfileCore( + data = NULL, + metaData = NULL, + dataMapping = NULL, + plotConfiguration = NULL, + plotObject = NULL +) +} +\arguments{ +\item{data}{A data.frame to use for plot.} + +\item{metaData}{A named list of information about \code{data} such as the \code{dimension} and \code{unit} of its variables.} + +\item{dataMapping}{A \code{TimeProfileDataMapping} object mapping \code{x}, \code{y}, \code{ymin}, \code{ymax} and aesthetic groups to their variable names of \code{data}.} + +\item{plotConfiguration}{An optional \code{TimeProfilePlotConfiguration} object defining labels, grid, background and watermark.} + +\item{plotObject}{An optional \code{ggplot} object on which to add the plot layer} +} +\value{ +A \code{ggplot} object +} +\description{ +Producing Core of Time Profile plots for simulated data +} +\keyword{internal} diff --git a/man/dot-plotTimeProfileCore.Rd b/man/dot-plotTimeProfileCore.Rd new file mode 100644 index 00000000..c0daf24c --- /dev/null +++ b/man/dot-plotTimeProfileCore.Rd @@ -0,0 +1,40 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/plot-timeprofile.R +\name{.plotTimeProfileCore} +\alias{.plotTimeProfileCore} +\title{.plotTimeProfileCore} +\usage{ +.plotTimeProfileCore( + data = NULL, + metaData = NULL, + dataMapping = NULL, + observedData = NULL, + observedDataMapping = NULL, + plotConfiguration = NULL, + plotObject = NULL +) +} +\arguments{ +\item{data}{A data.frame to use for plot.} + +\item{metaData}{A named list of information about \code{data} such as the \code{dimension} and \code{unit} of its variables.} + +\item{dataMapping}{A \code{TimeProfileDataMapping} object mapping \code{x}, \code{y}, \code{ymin}, \code{ymax} and aesthetic groups to their variable names of \code{data}.} + +\item{observedData}{A data.frame to use for plot. +Unlike \code{data}, meant for simulated data, plotted as lines and ribbons; +\code{observedData} is plotted as scatter points and errorbars.} + +\item{observedDataMapping}{An \code{ObservedDataMapping} object mapping \code{x}, \code{y}, \code{ymin}, \code{ymax} and aesthetic groups to their variable names of \code{observedData}.} + +\item{plotConfiguration}{An optional \code{TimeProfilePlotConfiguration} object defining labels, grid, background and watermark.} + +\item{plotObject}{An optional \code{ggplot} object on which to add the plot layer} +} +\value{ +A \code{ggplot} object +} +\description{ +Producing Core of Time Profile plots +} +\keyword{internal} diff --git a/man/getDualAxisPlot.Rd b/man/getDualAxisPlot.Rd new file mode 100644 index 00000000..53df2d87 --- /dev/null +++ b/man/getDualAxisPlot.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utilities-molecule-plots.R +\name{getDualAxisPlot} +\alias{getDualAxisPlot} +\title{getDualAxisPlot} +\usage{ +getDualAxisPlot(leftPlotObject, rightPlotObject) +} +\arguments{ +\item{leftPlotObject}{A \code{ggplot} object with left y-axis} + +\item{rightPlotObject}{A \code{ggplot} object with right y-axis} +} +\value{ +A \code{ggplot} object with dual y-axis +} +\description{ +Check if dual Y Axis is needed +} diff --git a/man/plotObservedTimeProfile.Rd b/man/plotObservedTimeProfile.Rd index 18bbb7c4..34b563d5 100644 --- a/man/plotObservedTimeProfile.Rd +++ b/man/plotObservedTimeProfile.Rd @@ -5,7 +5,7 @@ \title{plotObservedTimeProfile} \usage{ plotObservedTimeProfile( - data = NULL, + data, metaData = NULL, dataMapping = NULL, plotConfiguration = NULL, diff --git a/man/setY2Axis.Rd b/man/setY2Axis.Rd new file mode 100644 index 00000000..33b55257 --- /dev/null +++ b/man/setY2Axis.Rd @@ -0,0 +1,40 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utilities-axis.R +\name{setY2Axis} +\alias{setY2Axis} +\title{setY2Axis} +\usage{ +setY2Axis( + plotObject, + scale = NULL, + limits = NULL, + ticks = NULL, + ticklabels = NULL, + minorTicks = NULL, + font = NULL, + expand = NULL +) +} +\arguments{ +\item{plotObject}{A \code{ggplot} object to set X-axis properties} + +\item{scale}{Scale of axis. Use enum \code{Scaling} to access names of scales.} + +\item{limits}{Optional numeric values of axis limits} + +\item{ticks}{Optional values or function for axis ticks} + +\item{ticklabels}{Optional values or function for axis ticklabels} + +\item{minorTicks}{Optional values or function for axis minor ticks} + +\item{font}{A \code{Font} object defining font of ticklabels} + +\item{expand}{Logical defining if data is expanded until axis} +} +\value{ +A \code{ggplot} object +} +\description{ +Set right Y-axis properties of a \code{ggplot} object +} diff --git a/tests/testthat/_snaps/plot-grid/plotgrid-works-as-expected.svg b/tests/testthat/_snaps/plot-grid/plotgrid-works-as-expected.svg index 94ae5f05..a24d6c56 100644 --- a/tests/testthat/_snaps/plot-grid/plotgrid-works-as-expected.svg +++ b/tests/testthat/_snaps/plot-grid/plotgrid-works-as-expected.svg @@ -103,12 +103,12 @@ - - + + - - + + @@ -212,12 +212,12 @@ - - + + - - + +