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.

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

374 enum listing molecules #380

Merged
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
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
5 changes: 5 additions & 0 deletions NAMESPACE
Original file line number Diff line number Diff line change
Expand Up @@ -27,11 +27,13 @@ export("median+1.5IQR")
export("median+IQR")
export("median-1.5IQR")
export("median-IQR")
export(AestheticFields)
export(AestheticProperties)
export(AestheticSelectionKeys)
export(AggregationInput)
export(AggregationSummary)
export(Alignments)
export(AtomPlots)
export(AxisConfiguration)
export(BackgroundConfiguration)
export(BackgroundElement)
Expand All @@ -41,6 +43,7 @@ export(CaptionProperties)
export(ColorMaps)
export(DDIRatioDataMapping)
export(DDIRatioPlotConfiguration)
export(DataMappings)
export(ExportConfiguration)
export(ExportFormats)
export(ExportUnits)
Expand All @@ -58,13 +61,15 @@ export(LegendPositions)
export(LegendTypes)
export(LineElement)
export(Linetypes)
export(MoleculePlots)
export(ObsVsPredDataMapping)
export(ObsVsPredPlotConfiguration)
export(ObservedDataMapping)
export(PKRatioDataMapping)
export(PKRatioPlotConfiguration)
export(PlotAnnotationTextSize)
export(PlotConfiguration)
export(PlotConfigurations)
export(PlotGridConfiguration)
export(QQDataMapping)
export(QQPlotConfiguration)
Expand Down
105 changes: 36 additions & 69 deletions R/themes.R
Original file line number Diff line number Diff line change
Expand Up @@ -339,103 +339,70 @@ ThemeAestheticSelections <- R6::R6Class(
#' @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",
# This allows the R6 class to accept new fields
lock_objects = FALSE,
Comment on lines +345 to +346
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

interesting feature :)

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Totally.
I think it could be beneficial to apply it to other R6 objects such as workflows or task settings in RE (that would make user defined tasks or settings more flexible)

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 `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()`
#' @param ... theme properties for `PlotConfiguration` objects as used in molecule plots
#' @return A new `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")

atomPlotInputs <- as.character(setdiff(AtomPlots, "initializePlot"))
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
# Default aesthetics 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")
)
# Aesthetics for molecule plots
# This allows also user defined molecule plots
userMoleculePlots <- list(...)
moleculePlotInputs <- union(names(userMoleculePlots), as.character(MoleculePlots))

for (molecule in moleculePlotInputs) {
# Empty list if not defined by user
userMoleculePlot <- list()
if (isIncluded(molecule, names(userMoleculePlots))) {
# Need to clone R6 classes to prevent linking between each aesthetic
# ie. changing one property will change them all
userMoleculePlot <- lapply(
AestheticFields,
FUN = function(fieldName) {
fieldProperties <- userMoleculePlots[[molecule]][[fieldName]]
if (isEmpty(fieldProperties)) {
return(NULL)
}
fieldProperties <- .asThemeAestheticSelections(fieldProperties)
return(fieldProperties$clone())
}
)
}
self[[molecule]] <- list(
points = userMoleculePlot$points %||% self$addScatter$clone(),
lines = userMoleculePlot$lines %||% self$addLine$clone(),
ribbons = userMoleculePlot$ribbons %||% self$addRibbon$clone(),
errorbars = userMoleculePlot$errorbars %||% self$addErrorbar$clone()
)
}
},

#' @description Translate object into a json list
Expand Down
81 changes: 81 additions & 0 deletions R/utilities-enums.R
Original file line number Diff line number Diff line change
@@ -1,3 +1,84 @@
#' @title .getTitlesFromFamilyTag
#' @description Get all title names from documented functions/R6 classes that have specific family tags.
#' The function aims at created automated and synchronized enums
#' @param familyTag Family tag used to document functions or R6 classes
#' @return character array of titles
#' @import ospsuite.utils
#' @keywords internal
.getTitlesFromFamilyTag <- function(familyTag) {
functionNames <- NULL
for (filePath in list.files("./R", full.names = TRUE)) {
Copy link
Member

@Yuri05 Yuri05 Sep 12, 2022

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

no idea how it works - but it works :)
I thought list.files("./R", ... would require that my current folder is the package root folder, but it seems to work in any folder.

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

When building/documenting a package, the working directory is internally set to the package location during the procedure (I did some testing with devtools::check() and devtools::document()).

The function .getTitlesFromFamilyTag is only called during the build of the package to create the enums.
Thus, when the users check for e.g. Atoms, they do not call for .getTitlesFromFamilyTag but directly for the resulting list created during the package construction.

Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

ok, cool. Thanks for the explanation :)

fileContent <- readLines(filePath, warn = FALSE)
familyTagLines <- grep(pattern = paste0("#' @family ", familyTag), x = fileContent)
if (isEmpty(familyTagLines)) {
next
}
# Get closest title before tag
titleLines <- grep(pattern = "#' @title", x = fileContent)
functionNames <- c(
functionNames,
sapply(
familyTagLines,
# assumes that title tag is defined before family tag
FUN = function(familyTagLine) {
# Get line of closest title tag before family tag
titleLine <- titleLines[which.min(
familyTagLine - titleLines[titleLines < familyTagLine]
)]
functionName <- trimws(gsub(".*@title", "", fileContent[titleLine]))
return(functionName)
}
)
)
}
return(functionNames)
}

#' @title AestheticFields
#' @import ospsuite.utils
#' @export
#' @description
#' List of all available aesthetic fields that manage aesthetic properties
#' @family enum helpers
AestheticFields <- enum(c(
"lines",
"points",
"ribbons",
"errorbars"
))

#' @title AtomPlots
#' @import ospsuite.utils
#' @export
#' @description
#' List of all available atom plots
#' @family enum helpers
AtomPlots <- enum(c(.getTitlesFromFamilyTag("atom plots")))

#' @title MoleculePlots
#' @import ospsuite.utils
#' @export
#' @description
#' List of all available molecule plots
#' @family enum helpers
MoleculePlots <- enum(c(.getTitlesFromFamilyTag("molecule plots")))

#' @title PlotConfigurations
#' @import ospsuite.utils
#' @export
#' @description
#' List of all available molecule plots
#' @family enum helpers
PlotConfigurations <- enum(c(.getTitlesFromFamilyTag("PlotConfiguration classes")))

#' @title DataMappings
#' @import ospsuite.utils
#' @export
#' @description
#' List of all available molecule plots
#' @family enum helpers
DataMappings <- enum(c(.getTitlesFromFamilyTag("DataMapping classes")))

#' @title Alignments
#' @import ospsuite.utils
#' @export
Expand Down
2 changes: 1 addition & 1 deletion R/utils.R
Original file line number Diff line number Diff line change
@@ -1,5 +1,5 @@
# Because collate put tlf-env and themes before utils,
# The curretnTheme is defined here: after the definition of %||%
# The currentTheme is defined here: after the definition of %||%
tlfEnv$currentTheme <- Theme$new()

# Default theme is minimal when package is loaded
Expand Down
39 changes: 39 additions & 0 deletions man/AestheticFields.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

5 changes: 5 additions & 0 deletions man/AestheticProperties.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

5 changes: 5 additions & 0 deletions man/Alignments.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

39 changes: 39 additions & 0 deletions man/AtomPlots.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

Loading