Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

224 time profile mapping #229

Merged
merged 4 commits into from
Mar 24, 2022
Merged

224 time profile mapping #229

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
4 commits
Select commit Hold shift + click to select a range
16b3fe3
Fixes #224 plotTimeProfile and its mapping are more versatile
pchelle Mar 24, 2022
1a09592
Remove ggplot2 messages when aesthetic scales are updated
pchelle Mar 24, 2022
a66c2e9
Export function to update time profile plot legend easily
pchelle Mar 24, 2022
49530a0
Prevent time profile errors
pchelle Mar 24, 2022
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 1 addition & 0 deletions NAMESPACE
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -146,6 +146,7 @@ export(setXGrid)
export(setYAxis)
export(setYGrid)
export(tlfStatFunctions)
export(updateTimeProfileLegend)
export(useDarkTheme)
export(useExcelTheme)
export(useHighChartTheme)
Expand Down
4 changes: 2 additions & 2 deletions R/aaa-utilities.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -87,10 +87,10 @@ parseUpdateAestheticProperty <- function(aestheticProperty, plotConfigurationPro
parse(text = paste0(aestheticProperty, "Length <- length(unique(mapData[, ", aestheticProperty, "Variable]))")),
# Update the property using ggplot `scale` functions
parse(text = paste0(
"plotObject <- plotObject + ggplot2::scale_", aestheticProperty, "_manual(",
"suppressMessages(plotObject <- plotObject + ggplot2::scale_", aestheticProperty, "_manual(",
"values=getAestheticValues(n=", aestheticProperty, "Length,",
"selectionKey=plotConfiguration$", plotConfigurationProperty, "$", aestheticProperty,
',aesthetic = "', aestheticProperty, '"))'
',aesthetic = "', aestheticProperty, '")))'
)),
# remove the legend of aesthetic if default unmapped aesthetic
parse(text = paste0("if(isIncluded(", aestheticProperty, 'Variable, "legendLabels")){plotObject <- plotObject + ggplot2::guides(', aestheticProperty, " = 'none')}"))
Expand Down
4 changes: 3 additions & 1 deletion R/datamapping-range.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -21,6 +21,7 @@ RangeDataMapping <- R6::R6Class(
#' @param linetype R6 class `Grouping` object or its input
#' @param shape R6 class `Grouping` object or its input
#' @param size R6 class `Grouping` object or its input
#' @param group R6 class `Grouping` object or its input
#' @param data data.frame to map used by `smartMapping`
#' @return A new `RangeDataMapping` object
initialize = function(x = NULL,
Expand All @@ -32,14 +33,15 @@ RangeDataMapping <- R6::R6Class(
linetype = NULL,
shape = NULL,
size = NULL,
group = NULL,
data = NULL) {

# smartMapping is available in utilities-mapping.R
smartMap <- smartMapping(data)
super$initialize(x %||% smartMap$x,
y = NULL,
groupMapping = groupMapping, color = color, fill = fill,
linetype = linetype, shape = shape, size = size
linetype = linetype, shape = shape, size = size, group = group
)

self$ymin <- ymin %||% smartMap$ymin
Expand Down
15 changes: 9 additions & 6 deletions R/datamapping-xygroup.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -18,6 +18,7 @@ XYGDataMapping <- R6::R6Class(
#' @param linetype R6 class `Grouping` object or its input
#' @param shape R6 class `Grouping` object or its input
#' @param size R6 class `Grouping` object or its input
#' @param group R6 class `Grouping` object or its input
#' @param data data.frame to map used by `smartMapping`
#' @return A new `XYGDataMapping` object
initialize = function(x = NULL,
Expand All @@ -28,6 +29,7 @@ XYGDataMapping <- R6::R6Class(
linetype = NULL,
shape = NULL,
size = NULL,
group = NULL,
data = NULL) {

# smartMapping is available in utilities-mapping.R
Expand All @@ -39,15 +41,16 @@ XYGDataMapping <- R6::R6Class(
"fill" = fill,
"linetype" = linetype,
"shape" = shape,
"size" = size
"size" = size,
"group" = group
))
# To simplify the process workflow, groupMapping inputs color, fill... can be used directly instead of groupMapping
self$groupMapping <- groupMapping %||% GroupMapping$new(
color %||% smartMap$color,
fill %||% smartMap$fill,
linetype %||% smartMap$linetype,
shape %||% smartMap$shape,
size %||% smartMap$size
color %||% group %||% smartMap$color,
fill %||% group %||% smartMap$fill,
linetype %||% group %||% smartMap$linetype,
shape %||% group %||% smartMap$shape,
size %||% group %||% smartMap$size
)
},

Expand Down
23 changes: 8 additions & 15 deletions R/observed-data-mapping.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -6,8 +6,6 @@ ObservedDataMapping <- R6::R6Class(
"ObservedDataMapping",
inherit = XYGDataMapping,
public = list(
#' @field lloq mapping lower limit of quantitation variable
lloq = NULL,
#' @field error mapping error bars around scatter points
error = NULL,
#' @field mdv mapping missing dependent variable
Expand All @@ -21,8 +19,9 @@ ObservedDataMapping <- R6::R6Class(
#' @param x Name of x variable to map
#' @param y Name of y variable to map
#' @param group R6 class `Grouping` object or its input
#' @param color R6 class `Grouping` object or its input
#' @param shape R6 class `Grouping` object or its input
#' @param data data.frame to map used by `smartMapping`
#' @param lloq mapping lower limit of quantitation variable
#' @param uncertainty mapping error bars around scatter points.
#' Deprecated parameter replaced by `error`.
#' @param error mapping error bars around scatter points
Expand All @@ -36,19 +35,18 @@ ObservedDataMapping <- R6::R6Class(
error = NULL,
ymin = NULL,
ymax = NULL,
lloq = NULL,
mdv = NULL,
color = NULL,
shape = NULL,
group = NULL,
data = NULL){
validateIsString(lloq, nullAllowed = TRUE)
validateIsString(uncertainty, nullAllowed = TRUE)
validateIsString(error, nullAllowed = TRUE)
validateIsString(ymin, nullAllowed = TRUE)
validateIsString(ymax, nullAllowed = TRUE)
validateIsString(mdv, nullAllowed = TRUE)
super$initialize(x = x, y = y, color = group, data = data)
super$initialize(x = x, y = y, color = color, shape = shape, group = group, data = data)

self$lloq <- lloq
# If defined, ymin and ymax are used as is
# If not, error/uncertainty are used and
# creates ymin and ymax as y +/- error
Expand All @@ -66,19 +64,14 @@ ObservedDataMapping <- R6::R6Class(
checkMapData = function(data, metaData = NULL) {
validateIsOfType(data, "data.frame")
validateIsIncluded(self$error, names(data), nullAllowed = TRUE)
validateIsIncluded(self$lloq, names(data), nullAllowed = TRUE)
validateIsIncluded(self$mdv, names(data), nullAllowed = TRUE)

# Using super method, fetches x, y and groups
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 error bars
# This section may change depending on how we want to include options
if (!isOfLength(self$error, 0)) {
if (!isEmpty(self$error)) {
mapData[, self$error] <- data[, self$error]
# Symetric error bars
mapData[, self$ymax] <- data[, self$y] + data[, self$error]
Expand All @@ -92,7 +85,7 @@ ObservedDataMapping <- R6::R6Class(
mapData[, self$ymin] <- data[,self$ymin]
}
# MDV is a Nonmem notation in which values with MDV==1 are removed
if (!isOfLength(self$mdv, 0)) {
if (!isEmpty(self$mdv)) {
mapData[, self$mdv] <- as.logical(data[,self$mdv])
mapData <- mapData[!mapData[, self$mdv], ]
}
Expand Down
Loading