diff --git a/.Rbuildignore b/.Rbuildignore
index 5b7c9bddb..0415ac81f 100644
--- a/.Rbuildignore
+++ b/.Rbuildignore
@@ -1,6 +1,6 @@
^.*\.Rproj$
^\.Rproj\.user$
-^appveyor\.yml$
+(^appveyor)(.*)(.yml$)
^README\.md$
^tests/dev
^tools
@@ -20,7 +20,6 @@
^doc$
^docs$
^_pkgdown\.yml$
-^appveyor\.yml$
^.gitlab-ci\.yml$
^data-raw$
^pkgdown$
diff --git a/.covrignore b/.covrignore
deleted file mode 100644
index e69de29bb..000000000
diff --git a/DESCRIPTION b/DESCRIPTION
index c52fb372e..70646ea8a 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,7 +1,7 @@
Type: Package
Package: ospsuite
Title: R package to manipulate OSPSuite Models
-Version: 11.0.0
+Version: 11.1.0
Authors@R:
c(person("Open-Systems-Pharmacology Community", role = "cph"),
person("Michael", "Sevestre", role = c("aut", "cre"), email = "michael@design2code.ca"),
@@ -12,7 +12,9 @@ Authors@R:
Description: The ospsuite-R package provides the functionality of loading, manipulating, and simulating the simulations
created in the Open Systems Pharmacology Software tools PK-Sim and MoBi.
License: GPL-2 | file LICENSE
-URL: https://github.com/open-systems-pharmacology/ospsuite-r
+URL: https://github.com/open-systems-pharmacology/ospsuite-r,
+ https://www.open-systems-pharmacology.org/OSPSuite-R/ (release),
+ https://www.open-systems-pharmacology.org/OSPSuite-R/dev (development)
BugReports:
https://github.com/open-systems-pharmacology/ospsuite-r/issues
Depends:
@@ -20,21 +22,24 @@ Depends:
rClr (>= 0.9.1)
Imports:
dplyr (>= 1.0.0),
- ospsuite.utils (>= 1.3.0),
+ ospsuite.utils (>= 1.4.0),
purrr,
- R6,
readr,
stringr,
tidyr,
- tlf (>= 1.3.0)
+ ggplot2,
+ rlang,
+ tlf (>= 1.4.0)
Suggests:
knitr,
rmarkdown,
testthat (>= 3.0.3),
- vdiffr (>= 1.0.0)
+ vdiffr (>= 1.0.0),
+ withr
+Language: en-US
Encoding: UTF-8
LazyData: true
-RoxygenNote: 7.2.0
+RoxygenNote: 7.2.3
Roxygen: list(markdown = TRUE)
VignetteBuilder: knitr
Collate:
@@ -66,12 +71,14 @@ Collate:
'output-selections.R'
'parameter-range.R'
'parameter.R'
- 'path-explorer.R'
'pk-parameter-sensitivity.R'
'pk-parameter.R'
'pk-sim.R'
'plot-individual-time-profile.R'
+ 'plot-observed-vs-simulated.R'
'plot-population-time-profile.R'
+ 'plot-residuals-vs-simulated.R'
+ 'plot-residuals-vs-time.R'
'population-characteristics.R'
'population.R'
'quantity-pk-parameter.R'
diff --git a/NAMESPACE b/NAMESPACE
index 179b2316d..644644829 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -34,9 +34,11 @@ export(addUserDefinedPKParameter)
export(allAvailableDimensions)
export(allPKParameterNames)
export(calculatePKAnalyses)
+export(calculateResiduals)
export(clearMemory)
export(clearOutputIntervals)
export(clearOutputs)
+export(convertUnits)
export(createDistributions)
export(createImporterConfigurationForFile)
export(createIndividual)
@@ -69,6 +71,7 @@ export(getAllParametersForSensitivityAnalysisMatching)
export(getAllParametersMatching)
export(getAllQuantitiesMatching)
export(getAllQuantityPathsIn)
+export(getAllStateVariableParametersPaths)
export(getAllStateVariablesPaths)
export(getBaseUnit)
export(getContainer)
@@ -80,6 +83,7 @@ export(getOutputValues)
export(getParameter)
export(getParameterDisplayPaths)
export(getQuantity)
+export(getQuantityValuesByPath)
export(getSimulationTree)
export(getStandardMoleculeParameters)
export(getUnitsForDimension)
@@ -89,6 +93,7 @@ export(importPKAnalysesFromCSV)
export(importResultsFromCSV)
export(importSensitivityAnalysisResultsFromCSV)
export(initPKSim)
+export(isExplicitFormulaByPath)
export(loadAgingDataFromCSV)
export(loadDataImporterConfiguration)
export(loadDataSetFromPKML)
@@ -104,7 +109,10 @@ export(pkAnalysesToTibble)
export(pkParameterByName)
export(plotGrid)
export(plotIndividualTimeProfile)
+export(plotObservedVsSimulated)
export(plotPopulationTimeProfile)
+export(plotResidualsVsSimulated)
+export(plotResidualsVsTime)
export(populationAsDataFrame)
export(populationToDataFrame)
export(populationToTibble)
diff --git a/NEWS.md b/NEWS.md
index 73e21d5c1..636605b32 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,4 +1,39 @@
-# ospsuite 11.0 (development version)
+# ospsuite 11.1.197
+
+## New features
+
+* Adds new visualization functions:
+
+ - `plotObservedVsSimulated()` for observed versus simulated data scatter plot.
+ - `plotResidualsVsTime()` for time versus residuals data scatter plot.
+ - `plotResidualsVsSimulated()` for simulated versus residuals data scatter plot.
+
+* Adds new helper functions to work with `DataCombined` objects:
+
+ - `convertUnits()` to convert datasets in `DataCombined` to common units.
+ - `calculateResiduals()` to calculate residuals for datasets in `DataCombined`.
+
+## Major Changes
+
+* The class `SimulationBatch` gets a new property `id`.
+
+* The output of `runSimulationBatches()` is now a named list with names being
+ the ids of `SimulationBatch`.
+
+* `calculateResiduals()` now uses `log(base = 10)` for calculation of residuals
+in logarithmic scale instead if `log(base = exp(1))`
+* `calculateResiduals()` does also return residuals for entries where simulated
+or observed value is 0 in logarithmic scale. These values were ignored in previous
+versions. If the observed or simulated value is zero or negative, it is replaced
+by an arbitrary small value `getOSPSuiteSetting("LOG_SAFE_EPSILON")` (1e-20 by default).
+
+## Minor Changes
+
+* `SimulationBatch$addRunValues()` will throw an error when any start value is `NaN`
+* `SimulatioBatch` gets methods `getVariableParameters()` and `getVariableMolecules()`
+that return list of parameter resp. molecule paths that are defined variable.
+
+# ospsuite 11.0.123
## New features
diff --git a/R/cache.R b/R/cache.R
index 5962d3ebd..7ad9e75ab 100644
--- a/R/cache.R
+++ b/R/cache.R
@@ -94,7 +94,7 @@ Cache <- R6::R6Class(
if (missing(value)) {
ls(private$cachedObjects)
} else {
- stop(messages$errorPropertyReadOnly("keys"), call. = FALSE)
+ stop(messages$errorPropertyReadOnly("keys"))
}
}
),
diff --git a/R/container.R b/R/container.R
index 68040e83c..2798bc259 100644
--- a/R/container.R
+++ b/R/container.R
@@ -2,6 +2,7 @@
#' @docType class
#' @description Contains other entities such as Parameter or containers
#' @format NULL
+#' @keywords internal
Container <- R6::R6Class(
"Container",
cloneable = FALSE,
diff --git a/R/data-combined.R b/R/data-combined.R
index 15cd77e1f..b07823b41 100644
--- a/R/data-combined.R
+++ b/R/data-combined.R
@@ -14,33 +14,61 @@
#' @import tidyr
#' @import ospsuite.utils
#'
-#' @param groups A string or a list of strings assigning the data set to a
-#' group. If an entry within the list is `NULL`, the corresponding data set is
-#' not assigned to any group (and the corresponding entry in the `group`
-#' column will be an `NA`). If provided, `groups` must have the same length as
-#' `dataSets` and/or `simulationResults$quantityPath`. If no grouping is
-#' specified for any of the dataset, the column `group` in the data frame
-#' output will be all `NA`.
+#' @param names A string or a `list` of strings assigning new names. These new
+#' names can be either for renaming `DataSet` objects, or for renaming
+#' quantities/paths in `SimulationResults` object. If an entity is not to be
+#' renamed, this can be specified as `NULL`. E.g., in `names = list("oldName1"
+#' = "newName1", "oldName2" = NULL)`), dataset with name `"oldName2"` will not
+#' be renamed. The list can either be named or unnamed. Names act as unique
+#' identifiers for data sets in the `DataCombined` object and, therefore,
+#' duplicate names are not allowed.
+#' @param groups A string or a list of strings specifying group name
+#' corresponding to each data set. If an entry within the list is `NULL`, the
+#' corresponding data set is not assigned to any group (and the corresponding
+#' entry in the `group` column will be an `NA`). If provided, `groups` must
+#' have the same length as `dataSets` and/or `simulationResults$quantityPath`.
+#' If no grouping is specified for any of the dataset, the column `group` in
+#' the data frame output will be all `NA`.
#'
#' @examples
-#'
-#' # load the simulation
+#' # simulated data
#' simFilePath <- system.file("extdata", "Aciclovir.pkml", package = "ospsuite")
#' sim <- loadSimulation(simFilePath)
-#' simulationResults <- runSimulation(simulation = sim)
+#' simResults <- runSimulation(sim)
+#' outputPath <- "Organism|PeripheralVenousBlood|Aciclovir|Plasma (Peripheral Venous Blood)"
#'
-#' # create a new dataset object
-#' dataSet <- DataSet$new(name = "DS")
+#' # observed data
+#' obsData <- lapply(
+#' c("ObsDataAciclovir_1.pkml", "ObsDataAciclovir_2.pkml", "ObsDataAciclovir_3.pkml"),
+#' function(x) loadDataSetFromPKML(system.file("extdata", x, package = "ospsuite"))
+#' )
+#' names(obsData) <- lapply(obsData, function(x) x$name)
#'
-#' # created object with datasets combined
-#' myCombDat <- DataCombined$new()
-#' myCombDat$addSimulationResults(simulationResults)
-#' myCombDat$addDataSets(dataSet)
#'
-#' # print the object
-#' myCombDat
-#' @docType class
+#' # Create a new instance of `DataCombined` class
+#' myDataCombined <- DataCombined$new()
+#'
+#' # Add simulated results
+#' myDataCombined$addSimulationResults(
+#' simulationResults = simResults,
+#' quantitiesOrPaths = outputPath,
+#' groups = "Aciclovir PVB"
+#' )
+#'
+#' # Add observed data set
+#' myDataCombined$addDataSets(obsData$`Vergin 1995.Iv`, groups = "Aciclovir PVB")
+#'
+#' # Looking at group mappings
+#' myDataCombined$groupMap
+#'
+#' # Looking at the applied transformations
+#' myDataCombined$dataTransformations
#'
+#' # Accessing the combined data frame
+#' myDataCombined$toDataFrame()
+#'
+#' @family data-combined
+#' @docType class
#' @export
DataCombined <- R6::R6Class(
classname = "DataCombined",
@@ -50,13 +78,8 @@ DataCombined <- R6::R6Class(
public = list(
- #' @param dataSets Instance (or a `list` of instances) of the `DataSet`
+ #' @param dataSets An instance (or a `list` of instances) of the `DataSet`
#' class.
- #' @param names A string or a list of strings assigning new names to the
- #' list of instances of the `DataSet` class. If a dataset is not to be
- #' renamed, this can be specified as `NULL` in the list. For example, in
- #' `names = list("dataName" = "dataNewName", "dataName2" = NULL)`),
- #' dataset with name `"dataName2"` will not be renamed.
#'
#' @description
#' Adds observed data.
@@ -65,11 +88,13 @@ DataCombined <- R6::R6Class(
addDataSets = function(dataSets, names = NULL, groups = NULL) {
# Validate vector arguments' type and length
validateIsOfType(dataSets, "DataSet", FALSE)
- names <- .cleanVectorArgs(names, objectCount(dataSets), type = "character")
+ numberOfDatasets <- objectCount(dataSets)
+ names <- .cleanVectorArgs(names, numberOfDatasets, type = "character")
- # The original names for datasets can be "plucked" from respective
- # objects. `purrr::map()` is used to iterate over the vector and the
- # anonymous function is used to pluck an object. The `map_chr()` variant
+ # The original names for datasets can be "plucked" from objects.
+ #
+ # `purrr::map()` iterates over the vector and applies the anonymous
+ # function to pluck name from the object. The `map_chr()` variant
# clarifies that we are always expecting a character type in return.
datasetNames <- purrr::map_chr(c(dataSets), function(x) purrr::pluck(x, "name"))
@@ -104,14 +129,15 @@ DataCombined <- R6::R6Class(
# from `ospsuite::getOutputValues()` to avoid repetition.
#' @param simulationResults Object of type `SimulationResults` produced by
- #' calling `runSimulation()` on a `Simulation` object.
+ #' calling `runSimulation()` on a `Simulation` object. Only a single
+ #' instance is allowed in a given `$addSimulationResults()` method call.
#' @param quantitiesOrPaths Quantity instances (element or list) typically
- #' retrieved using `getAllQuantitiesMatching()` or quantity path (element or
- #' list of strings) for which the results are to be returned. (optional)
- #' When providing the paths, only absolute full paths are supported (i.e.,
- #' no matching with '*' possible). If `quantitiesOrPaths` is `NULL`
- #' (default value), returns the results for all output defined in the
- #' results.
+ #' retrieved using `getAllQuantitiesMatching()` or quantity path (element
+ #' or list of strings) for which the results are to be returned.
+ #' (optional) When providing the paths, only absolute full paths are
+ #' supported (i.e., no matching with '*' possible). If `quantitiesOrPaths`
+ #' is `NULL` (default value), returns the results for all output defined
+ #' in the results.
#' @param individualIds Numeric IDs of individuals for which the results
#' should be extracted. By default, all individuals from the results are
#' considered. If the individual with the provided ID is not found, the ID
@@ -119,12 +145,6 @@ DataCombined <- R6::R6Class(
#' @param population Population used to calculate the `simulationResults`
#' (optional). This is used only to add the population covariates to the
#' resulting data frame.
- #' @param names A string or a list of strings assigning new names to the
- #' quantities or paths present in the entered `SimulationResults` object.
- #' If a dataset is not to be renamed, this can be specified as `NULL` in
- #' the list. For example, in `names = list("dataName" = "dataNewName",
- #' "dataName2" = NULL)`), dataset with name `"dataName2"` will not be
- #' renamed.
#'
#' @description
#'
@@ -137,10 +157,10 @@ DataCombined <- R6::R6Class(
individualIds = NULL,
names = NULL,
groups = NULL) {
- # validate vector arguments' type and length
+ # Validate vector arguments' type and length
validateIsOfType(simulationResults, "SimulationResults", FALSE)
- # A list or a vector of `SimulationResults` class instances is not allowed.
+ # A vector of `SimulationResults` class instances is not allowed. Why?
#
# If this were to be allowed, `quantitiesOrPaths`, `population`, and
# `individualIds ` could all be different for every `SimulationResults`
@@ -154,7 +174,7 @@ DataCombined <- R6::R6Class(
pathsNames <- quantitiesOrPaths %||% simulationResults$allQuantityPaths
pathsLength <- length(pathsNames)
- # validate alternative names for their length and type
+ # Validate alternative names for their length and type
names <- .cleanVectorArgs(names, pathsLength, type = "character")
# If alternate names are provided for datasets, use them instead.
@@ -172,9 +192,9 @@ DataCombined <- R6::R6Class(
private$.simResultsToDataFrame(
simulationResults = simulationResults,
quantitiesOrPaths = quantitiesOrPaths,
- population = population,
- individualIds = individualIds,
- names = names
+ population = population,
+ individualIds = individualIds,
+ names = names
)
)
@@ -200,15 +220,15 @@ DataCombined <- R6::R6Class(
#' @param groups A list specifying which datasets belong to which group(s).
#' Please note that the order in which groups are specified should match
#' the order in which datasets were specified for `names` parameter. For
- #' example, if datsets are named `"x"`, `"y"`, `"z"`, and the desired
- #' groupings for them are, respectively, `"a"`, `"b"`, and no grouping,
- #' this can be specified as `names = list("x", "y"), groups = list("a",
- #' "b")`. Datasets for which no grouping is to be specified, can be left
- #' out of the `groups` argument. The column `group` in the data frame
- #' output will be `NA` for such datasets. If you wish to remove *existing*
- #' grouping assignment for a given dataset, you can specify it as
- #' following: `list("x" = NA)` or `list("x" = NULL)`. This will not change
- #' any of the other (previously specified) groupings.
+ #' example, if data sets are named `"x"`, `"y"`, `"z"`, and the desired
+ #' groupings for them are, respectively, `"a"`, `"b"`, this can be
+ #' specified as `names = list("x", "y"), groups = list("a", "b")`.
+ #' Datasets for which no grouping is to be specified, can be left out of
+ #' the `groups` argument. The column `group` in the data frame output will
+ #' be `NA` for such datasets. If you wish to remove an *existing* grouping
+ #' assignment for a given dataset, you can specify it as following:
+ #' `list("x" = NA)` or `list("x" = NULL)`. This will not change any of the
+ #' other groupings.
#'
#' @description
#' Adds grouping information to (observed and/or simulated) datasets.
@@ -223,14 +243,26 @@ DataCombined <- R6::R6Class(
# Sanitize vector arguments of `character` type
names <- .cleanVectorArgs(names, type = "character")
groups <- .cleanVectorArgs(groups, type = "character")
- validateIsSameLength(names, groups)
+
+ # `names` and `groups` need to be of the same length only if each dataset
+ # is assigned to a different group. But it is possible that the users
+ # want to assign all entered datasets to the same group.
+ #
+ # In the latter case, `groups` argument can be a scalar (length 1, i.e.)
+ # and we don't need to check that names and groups are of the same length.
+ if (length(groups) > 1L) {
+ validateIsSameLength(names, groups)
+ }
+
+ # All entered datasets should be unique, name being their identifier.
validateHasOnlyDistinctValues(names)
# Extract groupings and dataset names in a data frame.
#
# `purrr::simplify()` will simplify input vector (which can be an atomic
- # vector or a list) to an atomic vector, and covers both of these
+ # vector or a list) to an atomic vector. That is, it'll cover both of these
# contexts:
+ #
# - `names/groups = c(...)`
# - `names/groups = list(...)`
groupData <- dplyr::tibble(
@@ -266,7 +298,7 @@ DataCombined <- R6::R6Class(
validateHasOnlyDistinctValues(names)
# Extract dataset names in a data frame. Groupings for all of them are
- # going to be `NA`, so make avail of tibble's recycling rule.
+ # going to be `NA`, so make avail of `{tibble}`'s recycling rule.
groupData <- dplyr::tibble(
name = purrr::simplify(names),
group = NA_character_
@@ -291,7 +323,11 @@ DataCombined <- R6::R6Class(
#' numeric value or a list of numeric values specifying offsets and
#' scale factors to apply to raw values. The default offset is `0`, while
#' default scale factor is `1`, i.e., the data will not be modified. If a
- #' list is specified, it should be the same length as `names` argument.
+ #' list is specified, it should be the same length as `forNames` argument.
+ #' @param reset IF `TRUE`, only data transformations that are specified will
+ #' be retained. Not specified transformations will be reset to their defaults.
+ #' Default behavior is `FALSE`, e.g., setting only `xOffsets` will not reset
+ #' `xScaleFactors` if those have been set previously.
#'
#' @details
#'
@@ -307,24 +343,43 @@ DataCombined <- R6::R6Class(
xOffsets = 0,
yOffsets = 0,
xScaleFactors = 1,
- yScaleFactors = 1) {
-
+ yScaleFactors = 1,
+ reset = FALSE) {
# Check that the arguments to parameters make sense
- xOffsets <- .cleanVectorArgs(xOffsets, type = "numeric")
- yOffsets <- .cleanVectorArgs(yOffsets, type = "numeric")
- xScaleFactors <- .cleanVectorArgs(xScaleFactors, type = "numeric")
- yScaleFactors <- .cleanVectorArgs(yScaleFactors, type = "numeric")
+ xOffsetsNew <- .cleanVectorArgs(xOffsets, type = "numeric")
+ yOffsetsNew <- .cleanVectorArgs(yOffsets, type = "numeric")
+ xScaleFactorsNew <- .cleanVectorArgs(xScaleFactors, type = "numeric")
+ yScaleFactorsNew <- .cleanVectorArgs(yScaleFactors, type = "numeric")
forNames <- .cleanVectorArgs(forNames, type = "character")
+ # If any of the values is missing, they are retained from already existing values
+ if ((!reset) & (!is.null(private$.dataTransformations))) {
+ if (any(!missing(xOffsets), !missing(yOffsets), !missing(xScaleFactors), !missing(yScaleFactors))) {
+ if (missing(xOffsets)) {
+ xOffsetsNew <- private$.dataTransformations$xOffsets
+ }
+ if (missing(yOffsets)) {
+ yOffsetsNew <- private$.dataTransformations$yOffsets
+ }
+ if (missing(xScaleFactors)) {
+ xScaleFactorsNew <- private$.dataTransformations$xScaleFactors
+ }
+ if (missing(yScaleFactors)) {
+ yScaleFactorsNew <- private$.dataTransformations$yScaleFactors
+ }
+ }
+ }
+
+
# Apply specified data transformations
private$.dataCombined <- private$.dataTransform(
data = private$.dataCombined,
forNames = forNames,
- xOffsets = xOffsets,
- yOffsets = yOffsets,
- xScaleFactors = xScaleFactors,
- yScaleFactors = yScaleFactors
+ xOffsets = xOffsetsNew,
+ yOffsets = yOffsetsNew,
+ xScaleFactors = xScaleFactorsNew,
+ yScaleFactors = yScaleFactorsNew
)
# Update private field with transformation values
@@ -345,7 +400,7 @@ DataCombined <- R6::R6Class(
#'
#' @return
#'
- #' In the returned data frame, the following columns will always be present:
+ #' In the returned tibble data frame, the following columns will always be present:
#'
#' name - group - dataType - xValues - xDimension - xUnit - yValues -
#' yErrorValues - yDimension - yUnit - yErrorType - yErrorUnit - molWeight
@@ -375,7 +430,8 @@ DataCombined <- R6::R6Class(
#' @description
#' Print the object to the console.
print = function() {
- # group map contains names and nature of the datasets and grouping details
+ # Group map contains names, types, and groupings for all datasets, providing
+ # the most succinct snapshot of the object.
private$printClass()
private$printLine("Datasets and groupings", addTab = FALSE)
cat("\n")
@@ -527,13 +583,13 @@ DataCombined <- R6::R6Class(
# If the newly entered dataset(s) are already present, then replace the
# existing ones with the new ones.
#
- # For example, someone can all `$addSimulationResults(dataSet1)` and
- # then again call `$addSimulationResults(dataSet1)` with the same class
+ # For example, someone can all `$addDataSets(dataSet1)` and
+ # then again call `$addDataSets(dataSet1)` with the same class
# instance because they realized that the first time they created the
- # DataSet object, they had made a mistake. In this case, data frame
+ # `DataSet` object, they had made a mistake. In this case, data frame
# created in the latter call should replace the one created in the
# former call. If we were not to allow this, the user will need to
- # restart their work with a new instance of this class.
+ # restart with a new instance of this class.
if (length(dupDatasets) > 0L) {
dataCurrent <- dplyr::filter(dataCurrent, !name %in% dupDatasets)
}
@@ -625,11 +681,10 @@ DataCombined <- R6::R6Class(
data <- dplyr::select(data, -dplyr::ends_with(c("Offsets", "ScaleFactors")))
# Datasets for which no data transformations were specified, there will be
- # missing values, which need to be replaced by values representing no
- # change.
+ # missing values, which need to be replaced by defaults for no change.
data <- dplyr::left_join(data, private$.dataTransformations, by = "name")
- # For offsets: 0
+ # For offsets: `0` (default for no change)
data <- dplyr::mutate(
data,
dplyr::across(
@@ -638,7 +693,7 @@ DataCombined <- R6::R6Class(
)
)
- # For scale factors: 1
+ # For scale factors: `1` (default for no change)
data <- dplyr::mutate(
data,
dplyr::across(
@@ -651,7 +706,7 @@ DataCombined <- R6::R6Class(
data <- dplyr::mutate(data,
xValues = (xRawValues + xOffsets) * xScaleFactors,
yValues = (yRawValues + yOffsets) * yScaleFactors,
- yErrorValues = yRawErrorValues * yScaleFactors
+ yErrorValues = yRawErrorValues * abs(yScaleFactors)
)
return(data)
diff --git a/R/data-importer-configuration.R b/R/data-importer-configuration.R
index 955bdbd51..bb8d91550 100644
--- a/R/data-importer-configuration.R
+++ b/R/data-importer-configuration.R
@@ -270,12 +270,12 @@ DataImporterConfiguration <- R6::R6Class(
},
#' @description
- #' Save configuration to a XML file that can be used in PKSim/MoBi
+ #' Save configuration to a XML file that can be used in PK-Sim/MoBi
#' @param filePath Path (incl. file name) to the location where the configuration
#' will be exported to.
saveConfiguration = function(filePath) {
validateIsString(filePath)
- filePath <- expandPath(filePath)
+ filePath <- .expandPath(filePath)
rClr::clrCall(private$.dataImporterTask, "SaveConfiguration", self$ref, filePath)
invisible(self)
diff --git a/R/data-set.R b/R/data-set.R
index b0e47bda8..38c7a9d87 100644
--- a/R/data-set.R
+++ b/R/data-set.R
@@ -118,7 +118,7 @@ DataSet <- R6::R6Class(
}
if (!is.null((private$.yErrorColumn))) {
- private$.yErrorColumn$displayUnit <- value
+ private$.setColumnUnit(private$.yErrorColumn, value)
}
invisible(self)
},
@@ -168,6 +168,10 @@ DataSet <- R6::R6Class(
return(toUnit(quantityOrDimension = private$.yColumn$dimension, values = lloq, targetUnit = private$.yColumn$displayUnit))
}
+ # Only one LLOQ value per data set is supported
+ if (!isOfLength(value, 1)) {
+ stop(messages$lloqOnlyScalar())
+ }
private$.yColumn$LLOQ <- toBaseUnit(
quantityOrDimension = private$.yColumn$dimension,
values = value,
@@ -227,7 +231,7 @@ DataSet <- R6::R6Class(
},
#' @description
- #' Sets the xValues, yValues, and (optionally) yErrorValuues into the dataSet.
+ #' Sets the xValues, yValues, and (optionally) yErrorValues into the dataSet.
#' Note: xValues, yValues and yErrorValues must have the same length
#' @param xValues xValues to use
#' @param yValues yValues to use
diff --git a/R/default-plot-configuration.R b/R/default-plot-configuration.R
index a7dbd9c62..78d0b96be 100644
--- a/R/default-plot-configuration.R
+++ b/R/default-plot-configuration.R
@@ -2,10 +2,13 @@
#'
#' @description
#'
-#' R6 configuration class defining properties of plots that can be created with
-#' `plotIndividualTimeProfile()`, `plotPopulationTimeProfile()`,
+#' R6 configuration class defining aesthetic properties of plots that can be
+#' created with `plotIndividualTimeProfile()`, `plotPopulationTimeProfile()`,
#' `plotObservedVsSimulated()`, and `plotResidualsVsTime()`.
#'
+#' To interactively explore various aesthetic properties and appearance of plots
+#' with these properties, you can use the [Shiny app](https://www.open-systems-pharmacology.org/TLF-Library/articles/theme-maker.html) from `{tlf}` package.
+#'
#' The following sections provide more details on how to customize it further.
#'
#' # Specifying aesthetic properties
@@ -88,6 +91,13 @@
#'
#' The available transformations can be seen in the `tlf::Scaling` list.
#'
+#' # Specifying tick labels
+#'
+#' `tlf::TickLabelTransforms` lists of all available tick label transformations.
+#' For example, selecting `tlf::TickLabelTransforms$identity` will display tick
+#' labels as they are, while selecting `tlf::TickLabelTransforms$log` will
+#' display tick labels in logarithmic scale format.
+#'
#' # Saving plot
#'
#' By default, the plots will be shown in plot pane of your IDE, but the plots
@@ -110,9 +120,9 @@
#' @field legendPosition A character string defining the legend position.
#' Available options can be seen using `tlf::LegendPositions` list.
#' @field legendTitleSize,legendTitleColor,legendTitleFontFamily,legendTitleFontFace,legendTitleAngle,legendTitleAlign Aesthetic properties for the legend title.
-#' @field legendCaptionSize,legendCaptionColor,legendCaptionFontFamily,legendCaptionFontFace,legendCaptionAngle,legendCaptionAlign Aesthetic properties for the legend caption.
-#' @field xAxisTicksLabels,xAxisLabelTicksSize,xAxisLabelTicksColor,xAxisLabelTicksFontFamily,xAxisLabelTicksFontFace,xAxisLabelTicksAngle,xAxisLabelTicksAlign Aesthetic properties for the x-axis label.
-#' @field yAxisTicksLabels,yAxisLabelTicksSize,yAxisLabelTicksColor,yAxisLabelTicksFontFamily,yAxisLabelTicksFontFace,yAxisLabelTicksAngle,yAxisLabelTicksAlign Aesthetic properties for the y-axis label.
+#' @field legendKeysSize,legendKeysColor,legendKeysFontFamily,legendKeysFontFace,legendKeysAngle,legendKeysAlign Aesthetic properties for the legend caption.
+#' @field xAxisTicksLabels,xAxisLabelTicksSize,xAxisLabelTicksColor,xAxisLabelTicksFontFamily,xAxisLabelTicksFontFace,xAxisLabelTicksAngle,xAxisLabelTicksAlign,xAxisExpand Aesthetic properties for the x-axis label.
+#' @field yAxisTicksLabels,yAxisLabelTicksSize,yAxisLabelTicksColor,yAxisLabelTicksFontFamily,yAxisLabelTicksFontFace,yAxisLabelTicksAngle,yAxisLabelTicksAlign,yAxisExpand Aesthetic properties for the y-axis label.
#' @field xAxisLimits,yAxisLimits A numeric vector of axis limits for the x-and
#' y-axis, respectively.
#' @field xAxisTicks,yAxisTicks A numeric vector or a function defining where to
@@ -129,7 +139,7 @@
#' @field linesColor,linesSize,linesLinetype,linesAlpha A selection key or values for choice of color, fill, shape, size, linetype, alpha, respectively, for lines.
#' @field pointsColor,pointsShape,pointsSize,pointsAlpha A selection key or values for choice of color, fill, shape, size, linetype, alpha, respectively, for points.
#' @field ribbonsFill,ribbonsSize,ribbonsLinetype,ribbonsAlpha A selection key or values for choice of color, fill, shape, size, linetype, alpha, respectively, for ribbons.
-#' @field errorbarsSize,errorbarsLinetype,errorbarsAlpha A selection key or values for choice of color, fill, shape, size, linetype, alpha, respectively, for errorbars.
+#' @field errorbarsSize,errorbarsLinetype,errorbarsAlpha,errorbarsCapSize A selection key or values for choice of color, fill, shape, size, linetype, alpha, cap width/height, respectively, for error bars.
#'
#' @examples
#'
@@ -161,7 +171,7 @@ DefaultPlotConfiguration <- R6::R6Class(
title = NULL,
titleColor = "black",
- titleSize = 12,
+ titleSize = tlf::PlotAnnotationTextSize$plotTitleSize,
titleFontFace = tlf::FontFaces$plain,
titleFontFamily = "",
titleAngle = 0,
@@ -171,7 +181,7 @@ DefaultPlotConfiguration <- R6::R6Class(
subtitle = NULL,
subtitleColor = "black",
- subtitleSize = 10,
+ subtitleSize = tlf::PlotAnnotationTextSize$plotSubtitleSize,
subtitleFontFace = tlf::FontFaces$plain,
subtitleFontFamily = "",
subtitleAngle = 0,
@@ -181,7 +191,7 @@ DefaultPlotConfiguration <- R6::R6Class(
caption = NULL,
captionColor = "black",
- captionSize = 8,
+ captionSize = tlf::PlotAnnotationTextSize$plotCaptionSize,
captionFontFace = tlf::FontFaces$plain,
captionFontFamily = "",
captionAngle = 0,
@@ -191,7 +201,7 @@ DefaultPlotConfiguration <- R6::R6Class(
xLabel = NULL,
xLabelColor = "black",
- xLabelSize = 10,
+ xLabelSize = tlf::PlotAnnotationTextSize$plotXLabelSize,
xLabelFontFace = tlf::FontFaces$plain,
xLabelFontFamily = "",
xLabelAngle = 0,
@@ -201,7 +211,7 @@ DefaultPlotConfiguration <- R6::R6Class(
yLabel = NULL,
yLabelColor = "black",
- yLabelSize = 10,
+ yLabelSize = tlf::PlotAnnotationTextSize$plotYLabelSize,
yLabelFontFace = tlf::FontFaces$plain,
yLabelFontFamily = "",
yLabelAngle = 90,
@@ -211,28 +221,28 @@ DefaultPlotConfiguration <- R6::R6Class(
legendPosition = NULL,
legendTitle = NULL,
- legendTitleSize = 10,
+ legendTitleSize = tlf::PlotAnnotationTextSize$plotLegendTitleSize,
legendTitleColor = "black",
legendTitleFontFamily = "",
legendTitleFontFace = tlf::FontFaces$plain,
legendTitleAngle = 0,
- legendTitleAlign = tlf::Alignments$center,
+ legendTitleAlign = tlf::Alignments$left,
- # legendCaption ------------------------------------
+ # legendKeys ------------------------------------
- legendCaptionSize = 10,
- legendCaptionColor = "black",
- legendCaptionFontFamily = "",
- legendCaptionFontFace = tlf::FontFaces$plain,
- legendCaptionAngle = 0,
- legendCaptionAlign = tlf::Alignments$center,
+ legendKeysSize = tlf::PlotAnnotationTextSize$plotLegendCaptionSize,
+ legendKeysColor = "black",
+ legendKeysFontFamily = "",
+ legendKeysFontFace = tlf::FontFaces$plain,
+ legendKeysAngle = 0,
+ legendKeysAlign = tlf::Alignments$left,
# XAxisConfiguration ------------------------------------
xAxisLimits = NULL,
- xAxisScale = tlf::Scaling$lin,
+ xAxisScale = NULL,
xAxisTicks = NULL,
- xAxisTicksLabels = NULL,
+ xAxisTicksLabels = tlf::TickLabelTransforms$identity,
xAxisLabelTicksSize = NULL,
xAxisLabelTicksColor = "black",
xAxisLabelTicksFontFamily = "",
@@ -243,9 +253,9 @@ DefaultPlotConfiguration <- R6::R6Class(
# YAxisConfiguration ------------------------------------
yAxisLimits = NULL,
- yAxisScale = tlf::Scaling$lin,
+ yAxisScale = NULL,
yAxisTicks = NULL,
- yAxisTicksLabels = NULL,
+ yAxisTicksLabels = tlf::TickLabelTransforms$identity,
yAxisLabelTicksSize = NULL,
yAxisLabelTicksColor = "black",
yAxisLabelTicksFontFamily = "",
@@ -256,7 +266,7 @@ DefaultPlotConfiguration <- R6::R6Class(
# watermark ------------------------------------
watermark = NULL,
- watermarkSize = 20,
+ watermarkSize = tlf::PlotAnnotationTextSize$plotWatermarkSize,
watermarkColor = "grey40",
watermarkFontFamily = "",
watermarkFontFace = tlf::FontFaces$plain,
@@ -282,12 +292,14 @@ DefaultPlotConfiguration <- R6::R6Class(
xAxisColor = "black",
xAxisSize = 0.5,
xAxisLinetype = tlf::Linetypes$solid,
+ xAxisExpand = FALSE,
# yAxis ------------------------------------
yAxisColor = "black",
yAxisSize = 0.5,
yAxisLinetype = tlf::Linetypes$solid,
+ yAxisExpand = FALSE,
# xGrid ------------------------------------
@@ -314,8 +326,8 @@ DefaultPlotConfiguration <- R6::R6Class(
# There is no `pointsFill` because it doesn't make sense to "fill" a line
# with color. There is already `pointsColor` for that.
- pointsColor = NULL,
- pointsShape = NULL,
+ pointsColor = tlf::ColorMaps$ospDefault,
+ pointsShape = names(tlf::Shapes),
pointsSize = 3,
pointsAlpha = 0.75,
@@ -333,6 +345,7 @@ DefaultPlotConfiguration <- R6::R6Class(
# Color and fill are taken from point mapping, therefore no
# `errorbarsColor`, `errorbarsFill` parameters
errorbarsSize = 1,
+ errorbarsCapSize = 5,
errorbarsLinetype = tlf::Linetypes$solid,
errorbarsAlpha = 0.75
)
diff --git a/R/dot-net-wrapper.R b/R/dot-net-wrapper.R
index 19149a2b0..cecaba07f 100644
--- a/R/dot-net-wrapper.R
+++ b/R/dot-net-wrapper.R
@@ -134,7 +134,7 @@ DotNetWrapper <- R6::R6Class(
}
},
throwPropertyIsReadonly = function(propertyName) {
- stop(messages$errorPropertyReadOnly(propertyName), call. = FALSE)
+ stop(messages$errorPropertyReadOnly(propertyName))
},
# maybe dispose should be called to if available
diff --git a/R/get-net-task.R b/R/get-net-task.R
index a7b78221e..accd6fee5 100644
--- a/R/get-net-task.R
+++ b/R/get-net-task.R
@@ -1,5 +1,4 @@
-#' @title Returns an instance of the specified `.NET` Task
-#' @name .getNetTask
+#' Get an instance of the specified `.NET` Task
#'
#' @param taskName The name of the task to retrieve (**without** `Get` prefix).
#'
diff --git a/R/init-package.R b/R/init-package.R
index 464b85fac..db52c9d22 100644
--- a/R/init-package.R
+++ b/R/init-package.R
@@ -4,7 +4,7 @@
#'
#' @import rClr
#' @keywords internal
-initPackage <- function() {
+.initPackage <- function() {
filePathFor <- function(name) {
system.file("lib", name, package = ospsuiteEnv$packageName)
}
@@ -20,5 +20,5 @@ initPackage <- function() {
rClr::clrCallStatic("OSPSuite.R.Api", "InitializeOnce", apiConfig$ref)
- initializeDimensionAndUnitLists()
+ .initializeDimensionAndUnitLists()
}
diff --git a/R/interval.R b/R/interval.R
index 7c9a773c8..0ff3dfc0e 100644
--- a/R/interval.R
+++ b/R/interval.R
@@ -1,8 +1,8 @@
#' @title Interval
#' @docType class
#' @description Simulation Interval (typically associated with an instance of `OutputSchema`)
-#'
#' @format NULL
+#' @keywords internal
Interval <- R6::R6Class(
"Interval",
cloneable = FALSE,
diff --git a/R/messages.R b/R/messages.R
index b71a6f5e2..d5b6307a4 100644
--- a/R/messages.R
+++ b/R/messages.R
@@ -26,10 +26,43 @@ messages$unpairableDatasetsRemoved <- function() {
"Following non-grouped or unpairable datasets have been removed"
}
+messages$valuesNotInterpolated <- function() {
+ "Predicted values couldn't be interpolated at following time points"
+}
+
messages$printMultipleEntries <- function(header, entries) {
message(paste0(header, ":\n"), paste0(entries, collapse = "\n"))
}
+messages$linearScaleWithFoldDistance <- function() {
+ "Linear scale is inappropriate when `foldDistance` argument is specified."
+}
+
messages$errorLoadingUnitsForDimension <- function(dimensions) {
messages$printMultipleEntries("Could not load units for the following dimensions", dimensions)
}
+
+messages$plottingWithEmptyDataCombined <- function() {
+ "No plot can be created because the entered `DataCombined` object does not contain any datasets."
+}
+
+messages$residualsCanNotBeComputed <- function() {
+ "No residuals can be computed because the entered `DataCombined` object does not contain any observed-simulated datasets that can be paired."
+}
+
+messages$logScaleNotAllowed <- function() {
+ "The Y-axis for this plot should not be on a log scale, since the residuals are expected to be centered around 0."
+}
+
+messages$lloqOnlyScalar <- function() {
+ "Only one LLOQ value per `DataSet` is supported! Please provide a scalar value and not a vector."
+}
+
+messages$simBatchStartValueNaN <- function(entityPaths) {
+ paste0("Start values of the entities with paths '", paste(entityPaths, collapse = ", "), "' is `NaN`! Cannot add such run values set")
+}
+
+messages$plotObservedVsSimulatedWrongFoldDistance <- function(parameterName, foldDistances) {
+ paste0("Parameter '", parameterName, "' should be >1! Following values have
+ been passed: '", paste(foldDistances, collapse = ", "), "'.")
+}
diff --git a/R/molecule.R b/R/molecule.R
index 620b9a01d..b54c7f622 100644
--- a/R/molecule.R
+++ b/R/molecule.R
@@ -7,7 +7,7 @@
#' @docType class
#' @name Molecule
#'
-#' @keywords Molecule
+#' @keywords internal
#' @format NULL
Molecule <- R6::R6Class(
"Molecule",
@@ -27,7 +27,7 @@ Molecule <- R6::R6Class(
}
},
#' @field scaleDivisor Scale divisor. Its purpose is to reduce numerical noise and to enhance computation performance.
- #' see https://docs.open-systems-pharmacology.org/working-with-mobi/mobi-documentation/model-building-components#import-molecule-and-parameter-start-values-from-excel
+ #' see \url{https://docs.open-systems-pharmacology.org/working-with-mobi/mobi-documentation/model-building-components#import-molecule-and-parameter-start-values-from-excel}
scaleDivisor = function(value) {
private$wrapProperty("ScaleDivisor", value)
}
diff --git a/R/ospsuite-env.R b/R/ospsuite-env.R
index e124afb4f..a9b111068 100644
--- a/R/ospsuite-env.R
+++ b/R/ospsuite-env.R
@@ -54,6 +54,9 @@ ospsuiteEnv$isPKSimLoaded <- FALSE
# NetTask `DimensionTask` cached for performance benefits. Created the first time it is requested.
ospsuiteEnv$dimensionTask <- NULL
+# Small value added to zero when calculating log
+ospsuiteEnv$LOG_SAFE_EPSILON <- 1e-20
+
#' Names of the settings stored in ospsuiteEnv. Can be used with `getOSPSuiteSetting()`
#' @include utilities.R
#' @export
diff --git a/R/output-selections.R b/R/output-selections.R
index badc01531..00be150c7 100644
--- a/R/output-selections.R
+++ b/R/output-selections.R
@@ -12,7 +12,7 @@ OutputSelections <- R6::R6Class(
if (missing(value)) {
.toObjectType(rClr::clrGet(self$ref, "OutputsAsArray"), QuantitySelection)
} else {
- stop(messages$errorPropertyReadOnly("allOutputs"), call. = FALSE)
+ stop(messages$errorPropertyReadOnly("allOutputs"))
}
}
),
diff --git a/R/parameter-range.R b/R/parameter-range.R
index 5b57375e7..7f14abfcd 100644
--- a/R/parameter-range.R
+++ b/R/parameter-range.R
@@ -68,7 +68,7 @@ ParameterRange <- R6::R6Class(
)
)
-createParameterRange <- function(min, max, unit) {
+.createParameterRange <- function(min, max, unit) {
if (is.null(min) && is.null(max)) {
return(NULL)
}
diff --git a/R/parameter.R b/R/parameter.R
index e8f0c5198..c71339f27 100644
--- a/R/parameter.R
+++ b/R/parameter.R
@@ -18,7 +18,8 @@ Parameter <- R6::R6Class(
),
active = list(
#' @field isStateVariable Returns `TRUE` is the parameter has a RHS otherwise `FALSE`.
- #' @details Setting the value to `FALSE` will delete the RHS Formula. Setting it to `TRUE` is not currently supported and will throw an error
+ #' Setting the value to `FALSE` will delete the RHS Formula.
+ #' Setting it to `TRUE` is not currently supported and will throw an error.
isStateVariable = function(value) {
hasRHSFormula <- !is.null(private$.rhsFormula)
if (missing(value)) {
@@ -33,7 +34,7 @@ Parameter <- R6::R6Class(
# Set to true and no RHS => error
if (value) {
- stop(messages$errorCannotSetRHSFormula, call. = FALSE)
+ stop(messages$errorCannotSetRHSFormula)
}
# we are deleting the RHS Formula
diff --git a/R/path-explorer.R b/R/path-explorer.R
deleted file mode 100644
index dedfaab8f..000000000
--- a/R/path-explorer.R
+++ /dev/null
@@ -1,91 +0,0 @@
-
-addBranch <- function(originalPathString, arrayToGo) {
- # Function to create a multilayered list called endList with a branched structure corresponding to the structure of arrayToGo that terminates with a string called 'path' that is equal to the string originalString
- if (length(arrayToGo) == 0) {
- # If arrayToGo is empty, create a terminal list with a string called 'path' and value equal to originalString
- endList <- list()
- endList$path <- originalPathString
- return(endList)
- } else {
- # If arrayToGo is still not empty, remove its leading element and create a sub-branch list corresponding to the structure of the remaining elements of arrayToGo
- newBranch <- list()
- newBranch[[arrayToGo[1]]] <- addBranch(originalPathString, tail(arrayToGo, -1))
- return(newBranch)
- }
-}
-
-nextStep <- function(listSoFar, originalString, arrayToGo) {
- # Recursive function that adds a multilayer list to listSoFar that has a branched structure representing the vector of strings arrayToGo.
- if (length(arrayToGo) == 0) { # If end of string vector arrayToGo has been reached, create a vector called 'path' and give it the value 'originalString'.
- listSoFar$path <- originalString
- } else { # End of branch has not been reached.
- # If this portion of the string vector arrayToGo has not been added to listToGo yet, add it using the function addBranch
- if (is.null(listSoFar[[arrayToGo[1]]])) {
- listSoFar[[arrayToGo[1]]] <- addBranch(originalString, tail(arrayToGo, -1))
- }
- # If this portion of the string vector arrayToGo has already been added to listSoFar, remove the leading element of arrayToGo and recursively apply this function using the remaining elements of arrayToGo.
- else {
- listSoFar[[arrayToGo[1]]] <- nextStep(listSoFar[[arrayToGo[1]]], originalString, tail(arrayToGo, -1))
- }
- }
- return(listSoFar)
-}
-
-
-
-#' Given a simulation file path or an instance of a simulation, traverses the simulation structure and returns a tree like structure
-#' allowing for intuitive navigation in the simulation tree
-#
-#' @param simulationOrFilePath Full path of the simulation to load or instance of a simulation
-#' @param quantityType A vector of strings that specify the types of the entities to be included in the tree. The types can be any combination of "Quantity", "Molecule", "Parameter" and "Observer"
-#' @return A list with a branched structure representing the path tree of entities in the simulation file that fall under the types specified in `quantityType`.
-#' At the end of each branch is a string called 'path' that is the path of the quantity represented by the branch.
-#'
-#' @importFrom utils tail
-#' @examples
-#' simPath <- system.file("extdata", "simple.pkml", package = "ospsuite")
-#' sim <- loadSimulation(simPath)
-#'
-#' tree <- getSimulationTree(sim)
-#'
-#' liver_volume_path <- tree$Organism$Liver$Volume$path
-#' @export
-getSimulationTree <- function(simulationOrFilePath, quantityType = "Quantity") {
- validateIsOfType(simulationOrFilePath, c("Simulation", "character"))
-
- quantityTypeList <- list(
- "Quantity" = getAllQuantityPathsIn,
- "Molecule" = getAllMoleculePathsIn,
- "Parameter" = getAllParameterPathsIn,
- "Observer" = getAllObserverPathsIn
- )
-
- validateIsIncluded(values = quantityType, parentValues = names(quantityTypeList))
-
- simulation <- simulationOrFilePath
- if (isOfType(simulationOrFilePath, "character")) {
- simulation <- loadSimulation(simulationOrFilePath)
- }
-
- # Build a vector, with no duplicated entries, of all paths corresponding to
- # entities in `simulation` that fall under the types specified in quantityType
- allPaths <- sapply(quantityType, function(type) {
- quantityTypeList[[type]](simulation)
- }) %>%
- unname() %>%
- unlist() %>%
- unique()
-
- # Initiate list to be returned as a null list.
- pathEnumList <- list()
-
- for (path in allPaths) {
- # Convert the path string to a vector of strings, each representing a branch portion.
- pathArray <- toPathArray(path)
-
- # Begin recursive loop to generate branched list.
- pathEnumList <- nextStep(pathEnumList, path, pathArray)
- }
-
- return(pathEnumList)
-}
diff --git a/R/plot-individual-time-profile.R b/R/plot-individual-time-profile.R
index 03b25cf39..f7c6ad971 100644
--- a/R/plot-individual-time-profile.R
+++ b/R/plot-individual-time-profile.R
@@ -1,6 +1,6 @@
#' Time-profile plot of individual data
#'
-#' @param dataCombined A `DataCombined` object.
+#' @inheritParams calculateResiduals
#' @param defaultPlotConfiguration A `DefaultPlotConfiguration` object, which is
#' an `R6` class object that defines plot properties.
#'
@@ -9,8 +9,41 @@
#' @family plotting
#'
#' @examples
+#' # simulated data
+#' simFilePath <- system.file("extdata", "Aciclovir.pkml", package = "ospsuite")
+#' sim <- loadSimulation(simFilePath)
+#' simResults <- runSimulation(sim)
+#' outputPath <- "Organism|PeripheralVenousBlood|Aciclovir|Plasma (Peripheral Venous Blood)"
#'
-#' # TODO: add example
+#' # observed data
+#' obsData <- lapply(
+#' c("ObsDataAciclovir_1.pkml", "ObsDataAciclovir_2.pkml", "ObsDataAciclovir_3.pkml"),
+#' function(x) loadDataSetFromPKML(system.file("extdata", x, package = "ospsuite"))
+#' )
+#' names(obsData) <- lapply(obsData, function(x) x$name)
+#'
+#'
+#' # Create a new instance of `DataCombined` class
+#' myDataCombined <- DataCombined$new()
+#'
+#' # Add simulated results
+#' myDataCombined$addSimulationResults(
+#' simulationResults = simResults,
+#' quantitiesOrPaths = outputPath,
+#' groups = "Aciclovir PVB"
+#' )
+#'
+#' # Add observed data set
+#' myDataCombined$addDataSets(obsData$`Vergin 1995.Iv`, groups = "Aciclovir PVB")
+#'
+#' # Create a new instance of `DefaultPlotConfiguration` class
+#' myPlotConfiguration <- DefaultPlotConfiguration$new()
+#' myPlotConfiguration$title <- "My Plot Title"
+#' myPlotConfiguration$subtitle <- "My Plot Subtitle"
+#' myPlotConfiguration$caption <- "My Sources"
+#'
+#' # plot
+#' plotIndividualTimeProfile(myDataCombined, myPlotConfiguration)
#'
#' @export
plotIndividualTimeProfile <- function(dataCombined,
@@ -28,40 +61,33 @@ plotIndividualTimeProfile <- function(dataCombined,
quantiles = NULL) {
# validation -----------------------------
- validateIsOfType(defaultPlotConfiguration, "DefaultPlotConfiguration", nullAllowed = TRUE)
- defaultPlotConfiguration <- defaultPlotConfiguration %||% DefaultPlotConfiguration$new()
- validateIsOfType(dataCombined, "DataCombined")
- validateIsSameLength(objectCount(dataCombined), 1L) # only single instance is allowed
-
- # data frames -----------------------------
-
- combinedData <- dataCombined$toDataFrame()
+ defaultPlotConfiguration <- .validateDefaultPlotConfiguration(defaultPlotConfiguration)
- # Getting all units on the same scale
- combinedData <- .unitConverter(combinedData, defaultPlotConfiguration$xUnit, defaultPlotConfiguration$yUnit)
-
- # Datasets which haven't been assigned to any group will be plotted as a group
- # on its own. That is, the `group` column entries for them will be their names.
- combinedData <- .addMissingGroupings(combinedData)
+ .validateDataCombinedForPlotting(dataCombined)
+ if (is.null(dataCombined$groupMap)) {
+ return(NULL)
+ }
# `TimeProfilePlotConfiguration` object -----------------------------
- # Create an instance of `TimeProfilePlotConfiguration` class by doing a
- # one-to-one mapping of internal plot configuration object's public fields
+ # Create an instance of plot-specific class object
timeProfilePlotConfiguration <- .convertGeneralToSpecificPlotConfiguration(
- data = combinedData,
specificPlotConfiguration = tlf::TimeProfilePlotConfiguration$new(),
generalPlotConfiguration = defaultPlotConfiguration
)
+ # data frames -----------------------------
+
+ # Getting all units on the same scale
+ combinedData <- convertUnits(dataCombined, defaultPlotConfiguration$xUnit, defaultPlotConfiguration$yUnit)
+
+ # Datasets which haven't been assigned to any group will be plotted as a group
+ # on its own. That is, the `group` column entries for them will be their names.
+ combinedData <- .addMissingGroupings(combinedData)
+
# axes labels -----------------------------
- # The type of plot can be guessed from the specific `PlotConfiguration` object
- # used, since each plot has a unique corresponding class. The labels can then
- # be prepared accordingly.
- axesLabels <- .createAxesLabels(combinedData, timeProfilePlotConfiguration)
- timeProfilePlotConfiguration$labels$xlabel$text <- timeProfilePlotConfiguration$labels$xlabel$text %||% axesLabels$xLabel
- timeProfilePlotConfiguration$labels$ylabel$text <- timeProfilePlotConfiguration$labels$ylabel$text %||% axesLabels$yLabel
+ timeProfilePlotConfiguration <- .updatePlotConfigurationAxesLabels(combinedData, timeProfilePlotConfiguration)
# plot -----------------------------
@@ -69,6 +95,8 @@ plotIndividualTimeProfile <- function(dataCombined,
if (nrow(obsData) == 0) {
obsData <- NULL
+ } else {
+ obsData <- .computeBoundsFromErrorType(obsData)
}
simData <- as.data.frame(dplyr::filter(combinedData, dataType == "simulated"))
@@ -82,34 +110,57 @@ plotIndividualTimeProfile <- function(dataCombined,
simData <- as.data.frame(.extractAggregatedSimulatedData(simData, quantiles))
}
+ # To avoid repetition, assign column names to variables and use them instead
+ x <- "xValues"
+ y <- "yValues"
+ ymin <- "yValuesLower"
+ ymax <- "yValuesHigher"
+ color <- fill <- "group"
+ linetype <- shape <- "name"
+
+ # population time profile mappings ------------------------------
+
+ # The exact mappings chosen will depend on whether there are multiple datasets
+ # of a given type present per group
if (!is.null(quantiles)) {
- dataMapping <- tlf::TimeProfileDataMapping$new(
- x = "xValues",
- y = "yValuesCentral",
- ymin = "yValuesLower",
- ymax = "yValuesHigher",
- group = "group"
+ simulatedDataMapping <- tlf::TimeProfileDataMapping$new(x, y, ymin, ymax,
+ color = color,
+ linetype = linetype,
+ fill = fill
)
- } else {
- dataMapping <- tlf::TimeProfileDataMapping$new(
- x = "xValues",
- y = "yValues",
- group = "group"
+
+ observedDataMapping <- tlf::ObservedDataMapping$new(x, y, ymin, ymax,
+ shape = shape,
+ color = color
)
}
+ # individual time profile mappings ------------------------------
+
+ if (is.null(quantiles)) {
+ simulatedDataMapping <- tlf::TimeProfileDataMapping$new(x, y,
+ color = color,
+ linetype = linetype
+ )
+
+ observedDataMapping <- tlf::ObservedDataMapping$new(x, y, ymin, ymax,
+ shape = shape,
+ color = color
+ )
+ }
+
+ tlf::setDefaultErrorbarCapSize(defaultPlotConfiguration$errorbarsCapSize)
+
profilePlot <- tlf::plotTimeProfile(
data = simData,
- dataMapping = dataMapping,
+ dataMapping = simulatedDataMapping,
observedData = obsData,
- observedDataMapping = tlf::ObservedDataMapping$new(
- x = "xValues",
- y = "yValues",
- group = "group",
- error = "yErrorValues"
- ),
+ observedDataMapping = observedDataMapping,
plotConfiguration = timeProfilePlotConfiguration
)
+ # Suppress certain mappings in the legend
+ profilePlot <- profilePlot + ggplot2::guides(linetype = "none", shape = "none")
+
return(profilePlot)
}
diff --git a/R/plot-observed-vs-simulated.R b/R/plot-observed-vs-simulated.R
new file mode 100644
index 000000000..99a432a7b
--- /dev/null
+++ b/R/plot-observed-vs-simulated.R
@@ -0,0 +1,194 @@
+#' Observed versus predicted/simulated scatter plot
+#'
+#' @inheritParams plotIndividualTimeProfile
+#' @param foldDistance A vector for plotting lines at required fold distances
+#' The vector can include only fold distance values `>1`. An
+#' `x`-fold distance is defined as all simulated values within the range
+#' between `x`-fold (depicted by the upper fold range line) and `1/x`-fold
+#' (depicted by the lower fold range line) of observed values. The identity
+#' line can be interpreted as the `1`-fold range.
+#'
+#' @import tlf
+#'
+#' @family plotting
+#'
+#' @examples
+#' # simulated data
+#' simFilePath <- system.file("extdata", "Aciclovir.pkml", package = "ospsuite")
+#' sim <- loadSimulation(simFilePath)
+#' simResults <- runSimulation(sim)
+#' outputPath <- "Organism|PeripheralVenousBlood|Aciclovir|Plasma (Peripheral Venous Blood)"
+#'
+#' # observed data
+#' obsData <- lapply(
+#' c("ObsDataAciclovir_1.pkml", "ObsDataAciclovir_2.pkml", "ObsDataAciclovir_3.pkml"),
+#' function(x) loadDataSetFromPKML(system.file("extdata", x, package = "ospsuite"))
+#' )
+#' names(obsData) <- lapply(obsData, function(x) x$name)
+#'
+#'
+#' # Create a new instance of `DataCombined` class
+#' myDataCombined <- DataCombined$new()
+#'
+#' # Add simulated results
+#' myDataCombined$addSimulationResults(
+#' simulationResults = simResults,
+#' quantitiesOrPaths = outputPath,
+#' groups = "Aciclovir PVB"
+#' )
+#'
+#' # Add observed data set
+#' myDataCombined$addDataSets(obsData$`Vergin 1995.Iv`, groups = "Aciclovir PVB")
+#'
+#' # Create a new instance of `DefaultPlotConfiguration` class
+#' myPlotConfiguration <- DefaultPlotConfiguration$new()
+#' myPlotConfiguration$title <- "My Plot Title"
+#' myPlotConfiguration$subtitle <- "My Plot Subtitle"
+#' myPlotConfiguration$caption <- "My Sources"
+#'
+#' # plot
+#' plotObservedVsSimulated(myDataCombined, myPlotConfiguration)
+#' @export
+plotObservedVsSimulated <- function(dataCombined,
+ defaultPlotConfiguration = NULL,
+ foldDistance = 2) {
+ # validation -----------------------------
+
+ defaultPlotConfiguration <- .validateDefaultPlotConfiguration(defaultPlotConfiguration)
+
+ .validateDataCombinedForPlotting(dataCombined)
+ if (is.null(dataCombined$groupMap)) {
+ return(NULL)
+ }
+
+ # `ObsVsPredPlotConfiguration` object -----------------------------
+
+ # Create an instance of plot-specific class object
+ obsVsPredPlotConfiguration <- .convertGeneralToSpecificPlotConfiguration(
+ specificPlotConfiguration = tlf::ObsVsPredPlotConfiguration$new(),
+ generalPlotConfiguration = defaultPlotConfiguration
+ )
+
+ # Linear scaling is stored as identity scaling in `{tlf}`
+ is_any_scale_linear <- (
+ obsVsPredPlotConfiguration$xAxis$scale == tlf::Scaling$identity ||
+ obsVsPredPlotConfiguration$yAxis$scale == tlf::Scaling$identity
+ )
+
+ # The argument `foldDistance` should only include fold values different from
+ # the default value, which must always be present.
+ #
+ # The default value depends on the scale:
+ #
+ # - For linear scale: `1`
+ # - For logarithmic scale: `0`
+ defaultFoldDistance <- ifelse(is_any_scale_linear, 0, 1)
+
+ # foldDistance should be above 1
+ if (any(foldDistance <= 1)) {
+ stop(messages$plotObservedVsSimulatedWrongFoldDistance("foldDistance", foldDistance))
+ }
+
+ if (!any(dplyr::near(defaultFoldDistance, foldDistance))) {
+ foldDistance <- c(defaultFoldDistance, foldDistance)
+ }
+
+ if (is_any_scale_linear && !is.null(foldDistance)) {
+ warning(messages$linearScaleWithFoldDistance())
+ foldDistance <- 0
+ }
+
+ # data frames -----------------------------
+
+ # Create a paired data frame (observed versus simulated) from `DataCombined` object.
+ #
+ # `DefaultPlotConfiguration` provides units for conversion.
+ # `PlotConfiguration` provides scaling details needed while computing residuals.
+ pairedData <- calculateResiduals(dataCombined,
+ scaling = obsVsPredPlotConfiguration$yAxis$scale,
+ xUnit = defaultPlotConfiguration$xUnit,
+ yUnit = defaultPlotConfiguration$yUnit
+ )
+
+ # Quit early if there is no data to visualize.
+ if (is.null(pairedData)) {
+ return(NULL)
+ }
+
+ # In logarithmic scale, if any of the values are `0`, plotting will fail.
+ #
+ # To avoid this, just remove rows where any of the quantities are `0`s.
+ if (obsVsPredPlotConfiguration$yAxis$scale %in% c(tlf::Scaling$log, tlf::Scaling$ln)) {
+ pairedData <- dplyr::filter(
+ pairedData,
+ yValuesObserved != 0, yValuesSimulated != 0
+ )
+ }
+
+ # Add minimum and maximum values for observed data to plot error bars
+ pairedData <- dplyr::mutate(
+ pairedData,
+ yValuesObservedLower = yValuesObserved - yErrorValues,
+ yValuesObservedHigher = yValuesObserved + yErrorValues,
+ .after = yValuesObserved # Create new columns after `yValuesObserved` column
+ )
+
+ # Time points at which predicted values can't be interpolated, and need to be
+ # extrapolated.
+ #
+ # This will happen in rare case scenarios where simulated data is sampled at a
+ # lower frequency than observed data.
+ predictedValuesMissingIndices <- which(is.na(pairedData$yValuesSimulated))
+
+ # Warn the user about failure to interpolate.
+ if (length(predictedValuesMissingIndices) > 0) {
+ warning(
+ messages$printMultipleEntries(
+ header = messages$valuesNotInterpolated(),
+ entries = pairedData$xValues[predictedValuesMissingIndices]
+ )
+ )
+ }
+
+ # axes labels -----------------------------
+
+ obsVsPredPlotConfiguration <- .updatePlotConfigurationAxesLabels(pairedData, obsVsPredPlotConfiguration)
+
+ # plot -----------------------------
+
+ tlf::setDefaultErrorbarCapSize(defaultPlotConfiguration$errorbarsCapSize)
+
+ # Since groups might include more than one observed dataset (indicated by shape)
+ # in a group (indicated by color), we have to override the default shape legend
+ # and assign a manual shape to each legend entry
+ # The shapes follow the settings in the user-provided plot configuration
+ overrideShapeAssignment <- pairedData %>%
+ dplyr::select(name, group) %>%
+ dplyr::distinct() %>%
+ dplyr::arrange(name) %>%
+ dplyr::mutate(shapeAssn = obsVsPredPlotConfiguration$points$shape[1:nrow(.)]) %>%
+ dplyr::filter(!duplicated(group))
+
+ plotObject <- tlf::plotObsVsPred(
+ data = as.data.frame(pairedData),
+ dataMapping = tlf::ObsVsPredDataMapping$new(
+ x = "yValuesObserved",
+ y = "yValuesSimulated",
+ group = "group",
+ xmin = "yValuesObservedLower",
+ xmax = "yValuesObservedHigher",
+ shape = "name"
+ ),
+ foldDistance = foldDistance,
+ plotConfiguration = obsVsPredPlotConfiguration
+ )
+
+ return(plotObject + ggplot2::guides(
+ shape = "none",
+ col = ggplot2::guide_legend(
+ title = obsVsPredPlotConfiguration$legend$title$text,
+ title.theme = obsVsPredPlotConfiguration$legend$title$createPlotFont(),
+ override.aes = list(shape = overrideShapeAssignment$shapeAssn)
+ )
+ ))
+}
diff --git a/R/plot-population-time-profile.R b/R/plot-population-time-profile.R
index cadeaf223..95d2d0efe 100644
--- a/R/plot-population-time-profile.R
+++ b/R/plot-population-time-profile.R
@@ -11,15 +11,31 @@
#' @family plotting
#'
#' @examples
+#' simFilePath <- system.file("extdata", "Aciclovir.pkml", package = "ospsuite")
+#' sim <- loadSimulation(simFilePath)
#'
-#' # TODO: add example
+#' populationResults <- importResultsFromCSV(
+#' simulation = sim,
+#' filePaths = system.file("extdata", "SimResults_pop.csv", package = "ospsuite")
+#' )
+#'
+#' # Create a new instance of `DataCombined` class
+#' myDataComb <- DataCombined$new()
+#' myDataComb$addSimulationResults(populationResults)
+#'
+#' # Create a new instance of `DefaultPlotConfiguration` class
+#' myPlotConfiguration <- DefaultPlotConfiguration$new()
+#' myPlotConfiguration$title <- "My Plot Title"
+#' myPlotConfiguration$subtitle <- "My Plot Subtitle"
+#' myPlotConfiguration$caption <- "My Sources"
+#'
+#' # plot
+#' plotPopulationTimeProfile(myDataComb, myPlotConfiguration)
#'
#' @export
plotPopulationTimeProfile <- function(dataCombined,
defaultPlotConfiguration = NULL,
quantiles = c(0.05, 0.5, 0.95)) {
- # validation -----------------------------
-
validateIsNumeric(quantiles, nullAllowed = FALSE)
validateIsOfLength(quantiles, 3L)
diff --git a/R/plot-residuals-vs-simulated.R b/R/plot-residuals-vs-simulated.R
new file mode 100644
index 000000000..4dfeb9338
--- /dev/null
+++ b/R/plot-residuals-vs-simulated.R
@@ -0,0 +1,127 @@
+#' Residuals versus time scatter plot
+#'
+#' @inheritParams plotIndividualTimeProfile
+#' @inheritParams tlf::plotResVsPred
+#'
+#' @import tlf
+#'
+#' @family plotting
+#'
+#' @examples
+#'
+#' # simulated data
+#' simFilePath <- system.file("extdata", "Aciclovir.pkml", package = "ospsuite")
+#' sim <- loadSimulation(simFilePath)
+#' simResults <- runSimulation(sim)
+#' outputPath <- "Organism|PeripheralVenousBlood|Aciclovir|Plasma (Peripheral Venous Blood)"
+#'
+#' # observed data
+#' obsData <- lapply(
+#' c("ObsDataAciclovir_1.pkml", "ObsDataAciclovir_2.pkml", "ObsDataAciclovir_3.pkml"),
+#' function(x) loadDataSetFromPKML(system.file("extdata", x, package = "ospsuite"))
+#' )
+#' names(obsData) <- lapply(obsData, function(x) x$name)
+#'
+#'
+#' # Create a new instance of `DataCombined` class
+#' myDataCombined <- DataCombined$new()
+#'
+#' # Add simulated results
+#' myDataCombined$addSimulationResults(
+#' simulationResults = simResults,
+#' quantitiesOrPaths = outputPath,
+#' groups = "Aciclovir PVB"
+#' )
+#'
+#' # Add observed data set
+#' myDataCombined$addDataSets(obsData$`Vergin 1995.Iv`, groups = "Aciclovir PVB")
+#'
+#' # Create a new instance of `DefaultPlotConfiguration` class
+#' myPlotConfiguration <- DefaultPlotConfiguration$new()
+#' myPlotConfiguration$title <- "My Plot Title"
+#' myPlotConfiguration$subtitle <- "My Plot Subtitle"
+#' myPlotConfiguration$caption <- "My Sources"
+#'
+#' # plot
+#' plotResidualsVsSimulated(myDataCombined, myPlotConfiguration)
+#'
+#' @export
+plotResidualsVsSimulated <- function(dataCombined,
+ defaultPlotConfiguration = NULL) {
+ # validation -----------------------------
+
+ defaultPlotConfiguration <- .validateDefaultPlotConfiguration(defaultPlotConfiguration)
+
+ .validateDataCombinedForPlotting(dataCombined)
+ if (is.null(dataCombined$groupMap)) {
+ return(NULL)
+ }
+
+ # `ResVsPredPlotConfiguration` object -----------------------------
+
+ # Create an instance of plot-specific class object
+ resVsPredPlotConfiguration <- .convertGeneralToSpecificPlotConfiguration(
+ specificPlotConfiguration = tlf::ResVsPredPlotConfiguration$new(),
+ generalPlotConfiguration = defaultPlotConfiguration
+ )
+
+ # This should never be the case as the residuals should be centered around 0.
+ is_y_scale_logarithmic <- resVsPredPlotConfiguration$yAxis$scale == "log"
+ if (is_y_scale_logarithmic) {
+ stop(messages$logScaleNotAllowed())
+ }
+
+ # data frames -----------------------------
+
+ # Create a paired data frame (observed versus simulated) from `DataCombined` object.
+ #
+ # `DefaultPlotConfiguration` provides units for conversion.
+ # `PlotConfiguration` provides scaling details needed while computing residuals.
+ pairedData <- calculateResiduals(dataCombined,
+ scaling = resVsPredPlotConfiguration$yAxis$scale,
+ xUnit = defaultPlotConfiguration$xUnit,
+ yUnit = defaultPlotConfiguration$yUnit
+ )
+
+ # Quit early if there is no data to visualize.
+ if (is.null(pairedData)) {
+ return(NULL)
+ }
+
+ # Since groups might include more than one observed dataset (indicated by shape)
+ # in a group (indicated by color), we have to override the default shape legend
+ # and assign a manual shape to each legend entry
+ # The shapes follow the settings in the user-provided plot configuration
+ overrideShapeAssignment <- pairedData %>%
+ dplyr::select(name, group) %>%
+ dplyr::distinct() %>%
+ dplyr::arrange(name) %>%
+ dplyr::mutate(shapeAssn = resVsPredPlotConfiguration$points$shape[1:nrow(.)]) %>%
+ dplyr::filter(!duplicated(group))
+
+ # axes labels -----------------------------
+
+ resVsPredPlotConfiguration <- .updatePlotConfigurationAxesLabels(pairedData, resVsPredPlotConfiguration)
+
+ # plot -----------------------------
+
+ tlf::setDefaultErrorbarCapSize(defaultPlotConfiguration$errorbarsCapSize)
+
+ tlf::plotResVsPred(
+ data = as.data.frame(pairedData),
+ dataMapping = tlf::ResVsPredDataMapping$new(
+ x = "yValuesSimulated",
+ y = "residualValues",
+ group = "group",
+ shape = "name"
+ ),
+ plotConfiguration = resVsPredPlotConfiguration
+ ) + ggplot2::guides(
+ shape = "none",
+ col = ggplot2::guide_legend(
+ title = resVsPredPlotConfiguration$legend$title$text,
+ title.theme = resVsPredPlotConfiguration$legend$title$createPlotFont(),
+ override.aes = list(shape = overrideShapeAssignment$shapeAssn)
+ )
+ )
+}
diff --git a/R/plot-residuals-vs-time.R b/R/plot-residuals-vs-time.R
new file mode 100644
index 000000000..d7d3f5efd
--- /dev/null
+++ b/R/plot-residuals-vs-time.R
@@ -0,0 +1,126 @@
+#' Residuals versus time scatter plot
+#'
+#' @inheritParams plotIndividualTimeProfile
+#' @inheritParams tlf::plotResVsTime
+#'
+#' @import tlf
+#'
+#' @family plotting
+#'
+#' @examples
+#' # simulated data
+#' simFilePath <- system.file("extdata", "Aciclovir.pkml", package = "ospsuite")
+#' sim <- loadSimulation(simFilePath)
+#' simResults <- runSimulation(sim)
+#' outputPath <- "Organism|PeripheralVenousBlood|Aciclovir|Plasma (Peripheral Venous Blood)"
+#'
+#' # observed data
+#' obsData <- lapply(
+#' c("ObsDataAciclovir_1.pkml", "ObsDataAciclovir_2.pkml", "ObsDataAciclovir_3.pkml"),
+#' function(x) loadDataSetFromPKML(system.file("extdata", x, package = "ospsuite"))
+#' )
+#' names(obsData) <- lapply(obsData, function(x) x$name)
+#'
+#'
+#' # Create a new instance of `DataCombined` class
+#' myDataCombined <- DataCombined$new()
+#'
+#' # Add simulated results
+#' myDataCombined$addSimulationResults(
+#' simulationResults = simResults,
+#' quantitiesOrPaths = outputPath,
+#' groups = "Aciclovir PVB"
+#' )
+#'
+#' # Add observed data set
+#' myDataCombined$addDataSets(obsData$`Vergin 1995.Iv`, groups = "Aciclovir PVB")
+#'
+#' # Create a new instance of `DefaultPlotConfiguration` class
+#' myPlotConfiguration <- DefaultPlotConfiguration$new()
+#' myPlotConfiguration$title <- "My Plot Title"
+#' myPlotConfiguration$subtitle <- "My Plot Subtitle"
+#' myPlotConfiguration$caption <- "My Sources"
+#'
+#' # plot
+#' plotResidualsVsTime(myDataCombined, myPlotConfiguration)
+#'
+#' @export
+plotResidualsVsTime <- function(dataCombined,
+ defaultPlotConfiguration = NULL) {
+ # validation -----------------------------
+
+ defaultPlotConfiguration <- .validateDefaultPlotConfiguration(defaultPlotConfiguration)
+
+ .validateDataCombinedForPlotting(dataCombined)
+ if (is.null(dataCombined$groupMap)) {
+ return(NULL)
+ }
+
+ # `ResVsTimePlotConfiguration` object -----------------------------
+
+ # Create an instance of plot-specific class object
+ resVsTimePlotConfiguration <- .convertGeneralToSpecificPlotConfiguration(
+ specificPlotConfiguration = tlf::ResVsTimePlotConfiguration$new(),
+ generalPlotConfiguration = defaultPlotConfiguration
+ )
+
+ # This should never be the case as the residuals should be centered around 0.
+ is_y_scale_logarithmic <- resVsTimePlotConfiguration$yAxis$scale == "log"
+ if (is_y_scale_logarithmic) {
+ stop(messages$logScaleNotAllowed())
+ }
+
+ # data frames -----------------------------
+
+ # Create a paired data frame (observed versus simulated) from `DataCombined` object.
+ #
+ # `DefaultPlotConfiguration` provides units for conversion.
+ # `PlotConfiguration` provides scaling details needed while computing residuals.
+ pairedData <- calculateResiduals(dataCombined,
+ scaling = resVsTimePlotConfiguration$yAxis$scale,
+ xUnit = defaultPlotConfiguration$xUnit,
+ yUnit = defaultPlotConfiguration$yUnit
+ )
+
+ # Quit early if there is no data to visualize.
+ if (is.null(pairedData)) {
+ return(NULL)
+ }
+
+ # Since groups might include more than one observed dataset (indicated by shape)
+ # in a group (indicated by color), we have to override the default shape legend
+ # and assign a manual shape to each legend entry
+ # The shapes follow the settings in the user-provided plot configuration
+ overrideShapeAssignment <- pairedData %>%
+ dplyr::select(name, group) %>%
+ dplyr::distinct() %>%
+ dplyr::arrange(name) %>%
+ dplyr::mutate(shapeAssn = resVsTimePlotConfiguration$points$shape[1:nrow(.)]) %>%
+ dplyr::filter(!duplicated(group))
+
+ # axes labels -----------------------------
+
+ resVsTimePlotConfiguration <- .updatePlotConfigurationAxesLabels(pairedData, resVsTimePlotConfiguration)
+
+ # plot -----------------------------
+
+ tlf::setDefaultErrorbarCapSize(defaultPlotConfiguration$errorbarsCapSize)
+
+ tlf::plotResVsTime(
+ data = as.data.frame(pairedData),
+ dataMapping = tlf::ResVsTimeDataMapping$new(
+ x = "xValues",
+ y = "residualValues",
+ group = "group",
+ shape = "name"
+ ),
+ plotConfiguration = resVsTimePlotConfiguration
+ ) + ggplot2::guides(
+ shape = "none",
+ col = ggplot2::guide_legend(
+ title = resVsTimePlotConfiguration$legend$title$text,
+ title.theme = resVsTimePlotConfiguration$legend$title$createPlotFont(),
+ override.aes = list(shape = overrideShapeAssignment$shapeAssn)
+ )
+ )
+}
diff --git a/R/population.R b/R/population.R
index 9add715ea..a73635513 100644
--- a/R/population.R
+++ b/R/population.R
@@ -67,7 +67,7 @@ Population <- R6::R6Class(
#' Returns all values defined in the population the individual with id `individualId`
#' @param individualId Id of individual for which all values should be returned
getParameterValuesForIndividual = function(individualId) {
- parameterValueListFrom(rClr::clrCall(self$ref, "AllParameterValuesForIndividual", as.integer(individualId)))
+ .parameterValueListFrom(rClr::clrCall(self$ref, "AllParameterValuesForIndividual", as.integer(individualId)))
},
#' @description
#' Removes the value of a parameter by path
diff --git a/R/quantity.R b/R/quantity.R
index 00e965620..2d6bece31 100644
--- a/R/quantity.R
+++ b/R/quantity.R
@@ -129,7 +129,7 @@ Quantity <- R6::R6Class(
validateIsString(unit, nullAllowed = TRUE)
if (!is.null(unit)) {
unit <- .encodeUnit(unit)
- validateHasUnit(self, unit)
+ .validateHasUnit(self, unit)
value <- rClr::clrCallStatic(WITH_DIMENSION_EXTENSION, "ConvertToBaseUnit", self$ref, value, unit)
}
self$value <- value
diff --git a/R/simulation-batch.R b/R/simulation-batch.R
index 6167418b4..2b0f25eec 100644
--- a/R/simulation-batch.R
+++ b/R/simulation-batch.R
@@ -31,7 +31,8 @@ SimulationBatch <- R6::R6Class(
#' @description Add a set of parameter and start values for next execution.
#' @details Intended for the use with `runSimulationBatches`. The simulation batch is executed
- #' with the sets of parameter and initial values that have been scheduled. The set of run values is cleared after successful run.
+ #' with the sets of parameter and initial values that have been scheduled.
+ #' The set of run values is cleared after successful run.
#'
#' @param parameterValues Vector of parameter values to set in the simulation (default is `NULL`)
#' @param initialValues Vector of initial values to set in the simulation (default is `NULL`)
@@ -68,28 +69,62 @@ SimulationBatch <- R6::R6Class(
stop(messages$errorOnlyOneValuesSetAllowed("parameterValues, initialValues"))
}
+ # Check if any of the values is `NA`. If so, throw an error, as such
+ # values set will produce empty results
+ if (any(is.na(parameterValues))) {
+ naIdx <- which(is.na(parameterValues))
+ stop(messages$simBatchStartValueNaN(self$getVariableParameters()[naIdx]))
+ }
+ if (any(is.na(initialValues))) {
+ naIdx <- which(is.na(initialValues))
+ stop(messages$simBatchStartValueNaN(self$getVariableMolecules()[naIdx]))
+ }
+
batchRunValues <- SimulationBatchRunValues$new(parameterValues, initialValues)
rClr::clrCall(self$ref, "AddSimulationBatchRunValues", batchRunValues$ref)
return(batchRunValues$id)
},
+ #' @description Returns a list of parameter paths that are variable in this batch.
+ #' @details The order of parameters is the same as the order of parameter
+ #' values added with `$addRunValues()` method.
+ #'
+ #' @return List of parameter paths, or `NULL` if no parameter is variable.
+ #' @export
+ getVariableParameters = function() {
+ simulationBatchOptions <- rClr::clrGet(self$ref, "SimulationBatchOptions")
+
+ rClr::clrGet(simulationBatchOptions, "VariableParameters") %||%
+ rClr::clrGet(simulationBatchOptions, "VariableParameter")
+ },
+
+ #' @description Returns a list of molecules paths that are variable in this batch
+ #'
+ #' @details The order of molecules is the same as the order of molecule
+ #' start values added with `$addRunValues()` method.
+ #'
+ #' @return List of parameter paths, or `NULL` if no molecule is variable.
+ #' @export
+ getVariableMolecules = function() {
+ simulationBatchOptions <- rClr::clrGet(self$ref, "SimulationBatchOptions")
+
+ rClr::clrGet(simulationBatchOptions, "VariableMolecules") %||%
+ rClr::clrGet(simulationBatchOptions, "VariableMolecule")
+ },
+
#' @description
#' Print the object to the console
#' @param ... Additional arguments.
print = function(...) {
- simulationBatchOptions <- rClr::clrGet(self$ref, "SimulationBatchOptions")
private$printClass()
+ private$printLine("Id", self$id)
private$printLine("Simulation", self$simulation$name)
private$printLine("runValuesIds", self$runValuesIds)
private$printLine(
- "Parameters",
- rClr::clrGet(simulationBatchOptions, "VariableParameters") %||%
- rClr::clrGet(simulationBatchOptions, "VariableParameter")
+ "Parameters", self$getVariableParameters()
)
private$printLine(
- "Molecules",
- rClr::clrGet(simulationBatchOptions, "VariableMolecules") %||%
- rClr::clrGet(simulationBatchOptions, "VariableMolecule")
+ "Molecules", self$getVariableMolecules()
)
invisible(self)
}
@@ -110,6 +145,10 @@ SimulationBatch <- R6::R6Class(
} else {
private$throwPropertyIsReadonly("runValuesIds")
}
+ },
+ #' @field id The id of the .NET wrapped object. (read-only)
+ id = function(value) {
+ private$wrapReadOnlyProperty("Id", value)
}
),
)
diff --git a/R/simulation.R b/R/simulation.R
index 55ee1ce46..6fccefc85 100644
--- a/R/simulation.R
+++ b/R/simulation.R
@@ -61,7 +61,7 @@ Simulation <- R6::R6Class(
rClr::clrCall(private$.buildConfiguration, "AllPresentEndogenousStationaryMoleculeNames")
},
#' @description
- #' Returns the name of all xenobiotoc floating molecules defined in the simulation. (e.g. with the flag IsStationary = FALSE)
+ #' Returns the name of all xenobiotic floating molecules defined in the simulation. (e.g. with the flag IsStationary = FALSE)
#' This is typically a molecule that is being explicitly simulated such as Compound, Inhibitor, DrugComplex.
allXenobioticFloatingMoleculeNames = function() {
rClr::clrCall(private$.buildConfiguration, "AllPresentXenobioticFloatingMoleculeNames")
diff --git a/R/table-formula.R b/R/table-formula.R
index e59ac16fe..295f298f6 100644
--- a/R/table-formula.R
+++ b/R/table-formula.R
@@ -8,7 +8,7 @@ TableFormula <- R6::R6Class(
cloneable = FALSE,
inherit = Formula,
active = list(
- #' @field allPoints Returns all points defined in the table formulafor a `TableFormula` or `NULL` otherwise (Read-Only).
+ #' @field allPoints Returns all points defined in the table formula for a `TableFormula` or `NULL` otherwise (Read-Only).
allPoints = function(value) {
if (missing(value)) {
.toObjectType(rClr::clrCall(self$ref, "AllPointsAsArray"), ValuePoint)
diff --git a/R/user-defined-pk-parameter.R b/R/user-defined-pk-parameter.R
index 96ebcb9c2..efc0044c5 100644
--- a/R/user-defined-pk-parameter.R
+++ b/R/user-defined-pk-parameter.R
@@ -35,7 +35,7 @@ UserDefinedPKParameter <- R6::R6Class("UserDefinedPKParameter",
endApplicationIndex = function(value) {
private$wrapIndexProperty("EndApplicationIndex", value)
},
- #' @field normalizationFactor Factor to use to normalized the calculated PK-Parameter. (typically DrugMass, Dose, Dose per bodyweight).
+ #' @field normalizationFactor Factor to use to normalized the calculated PK-Parameter. (typically DrugMass, Dose, DosePerBodyWeight).
#' It is the responsibility of the caller to ensure that the value is in the correct unit. (optional)
normalizationFactor = function(value) {
private$wrapProperty("NormalizationFactor", value)
diff --git a/R/utilities-data-combined.R b/R/utilities-data-combined.R
index 247825472..e925d0bcc 100644
--- a/R/utilities-data-combined.R
+++ b/R/utilities-data-combined.R
@@ -1,4 +1,359 @@
-#' Validate arguments provided as vectors
+#' Convert datasets in `DataCombined` to common units
+#'
+#' @description
+#'
+#' When multiple (observed and/or simulated) datasets are present in a data
+#' frame, they are likely to have different units. This function helps to
+#' convert them to a common unit specified by the user.
+#'
+#' This is especially helpful while plotting since the quantities from different
+#' datasets to be plotted on the X-and Y-axis need to have same units to be
+#' meaningfully compared.
+#'
+#' @note
+#'
+#' Molecular weight is **required** for the conversion between certain
+#' dimensions (`Amount`, `Mass`, `Concentration (molar)`, and `Concentration
+#' (mass)`). Therefore, if molecular weight is missing for these dimension, the
+#' unit conversion will fail.
+#'
+#' @return A data frame with measurement columns transformed to have common units.
+#'
+#' @param dataCombined A single instance of `DataCombined` class.
+#' @param xUnit,yUnit Target units for `xValues` and `yValues`, respectively. If
+#' not specified (`NULL`), first of the existing units in the respective
+#' columns (`xUnit` and `yUnit`) will be selected as the common unit. For
+#' available dimensions and units, see `ospsuite::ospDimensions` and
+#' `ospsuite::ospUnits`, respectively.
+#'
+#' @return
+#'
+#' In the returned tibble data frame, the following columns will always be present:
+#'
+#' name - group - dataType - xValues - xDimension - xUnit - yValues -
+#' yErrorValues - yDimension - yUnit - yErrorType - yErrorUnit - molWeight
+#'
+#' Importantly, the `xUnit` and `yUnit` columns will have unique entries.
+#'
+#' @family data-combined
+#'
+#' @examples
+#' # simulated data
+#' simFilePath <- system.file("extdata", "Aciclovir.pkml", package = "ospsuite")
+#' sim <- loadSimulation(simFilePath)
+#' simResults <- runSimulation(sim)
+#' outputPath <- "Organism|PeripheralVenousBlood|Aciclovir|Plasma (Peripheral Venous Blood)"
+#'
+#' # observed data
+#' obsData <- lapply(
+#' c("ObsDataAciclovir_1.pkml", "ObsDataAciclovir_2.pkml", "ObsDataAciclovir_3.pkml"),
+#' function(x) loadDataSetFromPKML(system.file("extdata", x, package = "ospsuite"))
+#' )
+#' names(obsData) <- lapply(obsData, function(x) x$name)
+#'
+#'
+#' # Create a new instance of `DataCombined` class
+#' myDataCombined <- DataCombined$new()
+#'
+#' # Add simulated results
+#' myDataCombined$addSimulationResults(
+#' simulationResults = simResults,
+#' quantitiesOrPaths = outputPath,
+#' groups = "Aciclovir PVB"
+#' )
+#'
+#' # Add observed data set
+#' myDataCombined$addDataSets(obsData$`Vergin 1995.Iv`, groups = "Aciclovir PVB")
+#'
+#' convertUnits(
+#' myDataCombined,
+#' xUnit = ospUnits$Time$s,
+#' yUnit = ospUnits$`Concentration [mass]`$`µg/l`
+#' )
+#'
+#' @export
+convertUnits <- function(dataCombined, xUnit = NULL, yUnit = NULL) {
+ .validateScalarDataCombined(dataCombined)
+
+ # Extract combined data frame
+ combinedData <- dataCombined$toDataFrame()
+
+ # Getting all units on the same scale
+ combinedData <- .unitConverter(combinedData, xUnit, yUnit)
+
+ return(combinedData)
+}
+
+#' Calculate residuals for datasets in `DataCombined`
+#'
+#' @details
+#'
+#' To compute residuals, for every simulated dataset in a given group, there
+#' should also be a corresponding observed dataset. If this is not the case, the
+#' corresponding observed or simulated datasets will be removed.
+#'
+#' When multiple (observed and/or simulated) datasets are present in
+#' `DataCombined`, they are likely to have different units. The `xUnit` and
+#' `yUnit` arguments help you specify a common unit to convert them to.
+#'
+#' @param scaling A character specifying scale: either `tlf::Scaling$lin`
+#' (linear) or `tlf::Scaling$log` (logarithmic).
+#' @inheritParams convertUnits
+#'
+#' @return
+#'
+#' In the returned tibble data frame, the following columns will always be present:
+#'
+#' xValues - xUnit - xDimension - yValuesObserved - yUnit - yDimension -
+#' yErrorValues - yErrorType - yErrorUnit - yValuesSimulated - residualValues
+#'
+#' @family data-combined
+#'
+#' @examples
+#' # simulated data
+#' simFilePath <- system.file("extdata", "Aciclovir.pkml", package = "ospsuite")
+#' sim <- loadSimulation(simFilePath)
+#' simResults <- runSimulation(sim)
+#' outputPath <- "Organism|PeripheralVenousBlood|Aciclovir|Plasma (Peripheral Venous Blood)"
+#'
+#' # observed data
+#' obsData <- lapply(
+#' c("ObsDataAciclovir_1.pkml", "ObsDataAciclovir_2.pkml", "ObsDataAciclovir_3.pkml"),
+#' function(x) loadDataSetFromPKML(system.file("extdata", x, package = "ospsuite"))
+#' )
+#' names(obsData) <- lapply(obsData, function(x) x$name)
+#'
+#'
+#' # Create a new instance of `DataCombined` class
+#' myDataCombined <- DataCombined$new()
+#'
+#' # Add simulated results
+#' myDataCombined$addSimulationResults(
+#' simulationResults = simResults,
+#' quantitiesOrPaths = outputPath,
+#' groups = "Aciclovir PVB"
+#' )
+#'
+#' # Add observed data set
+#' myDataCombined$addDataSets(obsData$`Vergin 1995.Iv`, groups = "Aciclovir PVB")
+#'
+#' calculateResiduals(myDataCombined, scaling = tlf::Scaling$lin)
+#' @export
+calculateResiduals <- function(dataCombined,
+ scaling,
+ xUnit = NULL,
+ yUnit = NULL) {
+ .validateScalarDataCombined(dataCombined)
+
+ # Validation has already taken place in the calling plotting function
+ combinedData <- dataCombined$toDataFrame()
+
+ # Remove the observed and simulated datasets which can't be paired.
+ combinedData <- .removeUnpairableDatasets(combinedData)
+
+ # Return early if there are no pair-able datasets present
+ if (nrow(combinedData) == 0L) {
+ warning(messages$residualsCanNotBeComputed())
+ return(NULL)
+ }
+
+ # Getting all datasets to have the same units.
+ combinedData <- .unitConverter(combinedData, xUnit, yUnit)
+
+ # Create observed versus simulated paired data using interpolation for each
+ # grouping level and combine the resulting data frames in a row-wise manner.
+ #
+ # Both of these routines will be carried out by `dplyr::group_modify()`.
+ pairedData <- combinedData %>%
+ dplyr::group_by(group) %>%
+ dplyr::group_modify(.f = ~ .extractResidualsToTibble(.x, scaling)) %>%
+ dplyr::ungroup()
+
+ return(pairedData)
+}
+
+#' Created observed versus simulated paired data
+#'
+#' @param data A data frame from `DataCombined$toDataFrame()`, which has been
+#' further tidied using `.removeUnpairableDatasets()` and then
+#' `.unitConverter()` functions.
+#'
+#' @keywords internal
+.extractResidualsToTibble <- function(data, scaling) {
+ # Since the data frames will be fed to `matrix()`, make sure that data has
+ # `data.frame` class. That is, if tibbles are supplied, coerce them to a
+ # simple data frame.
+ observedData <- as.data.frame(dplyr::filter(data, dataType == "observed"))
+ simulatedData <- as.data.frame(dplyr::filter(data, dataType == "simulated"))
+
+ # If available, error values will be useful for plotting error bars in the
+ # scatter plot. Even if not available, add missing values to be consistent.
+ if ("yErrorValues" %in% colnames(data)) {
+ yErrorValues <- data$yErrorValues[data$dataType == "observed"]
+ } else {
+ yErrorValues <- rep(NA_real_, nrow(observedData))
+ }
+
+ # Most of the columns in the observed data frame should also be included in
+ # the paired data frame for completeness.
+ pairedData <- dplyr::select(
+ observedData,
+ # Identifier column
+ name,
+ # Everything related to the X-variable
+ "xValues", "xUnit", "xDimension", dplyr::matches("^x"),
+ # Everything related to the Y-variable
+ "yValuesObserved" = "yValues", "yUnit", "yDimension", dplyr::matches("^y"),
+ # lower limit of quantification
+ "lloq"
+ )
+
+ # Add predicted values
+ # the approx function with a default rule = 1 argument returns NA for extrapolated points
+ pairedData <- dplyr::mutate(pairedData,
+ "yValuesSimulated" = approx(
+ simulatedData$xValues, simulatedData$yValues,
+ observedData$xValues
+ )$y
+ )
+ # Residual computation will depend on the scaling.
+ if (scaling %in% c(tlf::Scaling$lin, tlf::Scaling$identity)) {
+ pairedData <- dplyr::mutate(pairedData, residualValues = yValuesSimulated - yValuesObserved)
+ } else {
+ # Epsilon for safe log calculation should be converted to the units of the values
+ epsilon <- toUnit(
+ quantityOrDimension = pairedData$yDimension[[1]],
+ values = ospsuiteEnv$LOG_SAFE_EPSILON,
+ targetUnit = pairedData$yUnit[[1]],
+ molWeight = 1
+ )
+ pairedData <- dplyr::mutate(pairedData, residualValues = .log_safe(yValuesSimulated, epsilon = epsilon) - .log_safe(yValuesObserved, epsilon = epsilon))
+ }
+
+ # some residual values might turn out to be NA (for example, when extrapolating)
+ # they are not returned in the output tibble
+ pairedData <- dplyr::filter(
+ pairedData,
+ !is.na(residualValues)
+ )
+
+ return(pairedData)
+}
+
+# TODO:
+#
+# Depending on what is decided in issue
+# https://github.com/Open-Systems-Pharmacology/OSPSuite-R/issues/1091, change
+# defaults for `base` for `.log_safe`.
+
+#' @keywords internal
+#' @noRd
+.log_safe <- function(x, base = 10, epsilon = ospsuiteEnv$LOG_SAFE_EPSILON) {
+ x <- sapply(X = x, function(element){
+ element <- ospsuite.utils::toMissingOfType(element, type = "double")
+ if (is.na(element)) {
+ return(NA_real_)
+ } else if (element < epsilon) {
+ return(log(epsilon, base = base))
+ } else {
+ return(log(element, base = base))
+ }
+ })
+
+ return(x)
+}
+
+#' Remove unpairable datasets for computing residuals
+#'
+#' @description
+#'
+#' Computing residuals by definition requires that data should be in pairs, i.e.
+#' for every simulated dataset in a given group, there should also be a
+#' corresponding observed dataset.
+#'
+#' To this end, current function removes the following datasets:
+#'
+#' - Datasets which haven't been assigned to any group.
+#' - Datasets that are not part of a pair (i.e. a simulated dataset without
+#' observed dataset partner, and vice versa).
+#'
+#' @param data A data frame returned by `DataCombined$toDataFrame()`.
+#'
+#' @examples
+#'
+#' df <- dplyr::tribble(
+#' ~name, ~dataType, ~group,
+#' "Sim1", "Simulated", "GroupA",
+#' "Sim2", "Simulated", "GroupA",
+#' "Obs1", "Observed", "GroupB",
+#' "Obs2", "Observed", "GroupB",
+#' "Sim3", "Simulated", "GroupC",
+#' "Obs3", "Observed", "GroupC",
+#' "Sim4", "Simulated", "GroupD",
+#' "Obs4", "Observed", "GroupD",
+#' "Obs5", "Observed", "GroupD",
+#' "Sim5", "Simulated", "GroupE",
+#' "Sim6", "Simulated", "GroupE",
+#' "Obs7", "Observed", "GroupE",
+#' "Sim7", "Simulated", "GroupF",
+#' "Sim8", "Simulated", "GroupF",
+#' "Obs8", "Observed", "GroupF",
+#' "Obs9", "Observed", "GroupF",
+#' "Sim9", "Simulated", NA,
+#' "Obs10", "Observed", NA
+#' )
+#'
+#' # original
+#' df
+#'
+#' # transformed
+#' ospsuite:::.removeUnpairableDatasets(df)
+#'
+#' @keywords internal
+.removeUnpairableDatasets <- function(data) {
+ # How many rows were originally present?
+ originalDatasets <- unique(data$name)
+
+ # Remove datasets that don't belong to any group.
+ data <- dplyr::filter(data, !is.na(group))
+
+ # Remove groups (and the datasets therein) with only one type (either only
+ # observed or only simulated) of dataset.
+ data <- data %>%
+ dplyr::group_by(group) %>%
+ dplyr::filter(length(unique(dataType)) > 1L) %>%
+ dplyr::ungroup()
+
+ # How many rows are left after filtering?
+ finalDatasets <- unique(data$name)
+
+ # Inform the user about which (if any) datasets were removed.
+ if (length(finalDatasets) < length(originalDatasets)) {
+ missingDatasets <- originalDatasets[!originalDatasets %in% finalDatasets]
+
+ message(messages$printMultipleEntries(
+ header = messages$datasetsToGroupNotFound(),
+ entries = missingDatasets
+ ))
+ }
+
+ return(data)
+}
+
+#' Validate that single instance of `DataCombined`
+#'
+#' @examples
+#' ospsuite:::.validateScalarDataCombined(DataCombined$new()) # okay
+#' # ospsuite:::.validateScalarDataCombined(list(DataCombined$new(), DataCombined$new())) # error
+#'
+#' @keywords internal
+.validateScalarDataCombined <- function(dataCombined) {
+ validateIsOfType(dataCombined, "DataCombined")
+ validateIsSameLength(objectCount(dataCombined), 1L)
+}
+
+
+#' Validate arguments provided as vectors
#'
#' @details
#'
@@ -16,15 +371,11 @@
#' @inheritParams ospsuite.utils::validateIsOfType
#'
#' @return
-#'
#' An atomic vector of desired data type.
#'
#' @examples
-#'
#' ospsuite:::.cleanVectorArgs(list(1, 2, NA, NULL), 4L, "numeric")
-#' ospsuite:::.cleanVectorArgs(c(1, 2, NA, NA_complex), 4L, "numeric")
#' @keywords internal
-#' @noRd
.cleanVectorArgs <- function(arg = NULL, expectedLength = NULL, type) {
# Return early if no argument was specified
if (is.null(arg)) {
@@ -42,7 +393,7 @@
# convert `NULL`s or logical `NA`s to `NA` of required type
# Note that `purrr::map()` will return a list
- arg <- purrr::map(arg, function(x) .toMissingOfType(x, type))
+ arg <- purrr::map(arg, function(x) toMissingOfType(x, type))
# validate the type of arguments
@@ -52,75 +403,7 @@
# arguments are still in a list
# flatten them to an atomic vector of required type
- arg <- .flattenList(arg, type)
+ arg <- flattenList(arg, type)
return(arg)
}
-
-#' Flatten a list to an atomic vector of desired type
-#'
-#' @param x A list or an atomic vector. If the latter, no change will be made.
-#' @param type Type of atomic vector to be returned.
-#'
-#' @details
-#'
-#' The `type` argument will decide which variant from `purrr::flatten()` family
-#' is used to flatten the list.
-#'
-#' @examples
-#'
-#' ospsuite:::.flattenList(list(1, 2, 3, NA), type = "numeric")
-#' ospsuite:::.flattenList(list(TRUE, FALSE, NA), type = "integer")
-#' @return An atomic vector of desired type.
-#'
-#' @keywords internal
-#' @noRd
-.flattenList <- function(x, type) {
- if (!is.null(dim(x))) {
- stop("Argument to parameter `x` can only be a vector.")
- }
-
- if (is.list(x)) {
- x <- switch(type,
- "character" = purrr::flatten_chr(x),
- "numeric" = ,
- "real" = ,
- "double" = purrr::flatten_dbl(x),
- "integer" = purrr::flatten_int(x),
- "logical" = purrr::flatten_lgl(x),
- purrr::flatten(x)
- )
- }
-
- return(x)
-}
-
-
-#' Convert `NULL` or `NA`s to `NA` of desired type
-#'
-#' @param x A single element.
-#' @inheritParams .flattenList
-#'
-#' @examples
-#'
-#' ospsuite:::.toMissingOfType(NA, type = "real")
-#' ospsuite:::.toMissingOfType(NULL, type = "integer")
-#' @keywords internal
-#' @noRd
-.toMissingOfType <- function(x, type) {
- # all unexpected values will be converted to `NA` of a desired type
- if (is.null(x) || is.na(x) || is.nan(x) || is.infinite(x)) {
- x <- switch(type,
- "character" = NA_character_,
- "numeric" = ,
- "real" = ,
- "double" = NA_real_,
- "integer" = NA_integer_,
- "complex" = NA_complex_,
- "logical" = NA,
- stop("Incorrect type entered.")
- )
- }
-
- return(x)
-}
diff --git a/R/utilities-data-repository.R b/R/utilities-data-repository.R
index 7030c060e..e90e272cf 100644
--- a/R/utilities-data-repository.R
+++ b/R/utilities-data-repository.R
@@ -5,7 +5,7 @@
#' @keywords internal
.loadDataRepositoryFromPKML <- function(filePath) {
validateIsString(filePath)
- filePath <- expandPath(filePath)
+ filePath <- .expandPath(filePath)
dataRepositoryTask <- .getNetTask("DataRepositoryTask")
dataRepository <- rClr::clrCall(dataRepositoryTask, "LoadDataRepository", filePath)
DataRepository$new(dataRepository)
diff --git a/R/utilities-data-set.R b/R/utilities-data-set.R
index ef74a53d6..358c5cd8e 100644
--- a/R/utilities-data-set.R
+++ b/R/utilities-data-set.R
@@ -56,7 +56,7 @@ loadDataSetFromPKML <- function(filePath) {
saveDataSetToPKML <- function(dataSet, filePath) {
validateIsString(filePath)
validateIsOfType(dataSet, "DataSet")
- filePath <- expandPath(filePath)
+ filePath <- .expandPath(filePath)
dataRepositoryTask <- .getNetTask("DataRepositoryTask")
rClr::clrCall(dataRepositoryTask, "SaveDataRepository", dataSet$dataRepository$ref, filePath)
}
diff --git a/R/utilities-dot-net.R b/R/utilities-dot-net.R
index 307cc893c..754bc0a7e 100644
--- a/R/utilities-dot-net.R
+++ b/R/utilities-dot-net.R
@@ -4,8 +4,8 @@
#' @param netObjects List of .NET object
#' @param propertyName Property name that should be retrieved from the `netObjects`
#' @keywords internal
-getPropertyValues <- function(netObjects, propertyName) {
- sapply(netObjects, function(x) getPropertyValue(x, propertyName))
+.getPropertyValues <- function(netObjects, propertyName) {
+ sapply(netObjects, function(x) .getPropertyValue(x, propertyName))
}
#' Returns the value of property named `propertyName` from .NET object instance `netObject`
@@ -13,6 +13,6 @@ getPropertyValues <- function(netObjects, propertyName) {
#' @param netObject .NET object
#' @param propertyName Property name that should be retrieved from the `netObject`
#' @keywords internal
-getPropertyValue <- function(netObject, propertyName) {
+.getPropertyValue <- function(netObject, propertyName) {
rClr::clrGet(netObject, name = propertyName)
}
diff --git a/R/utilities-file.R b/R/utilities-file.R
index 72f88fbe7..72b2a3e64 100644
--- a/R/utilities-file.R
+++ b/R/utilities-file.R
@@ -37,6 +37,6 @@
#' Returns the expanded path for `path` and ensure that encoding is applied properly
#'
#' @param path Path to expand
-expandPath <- function(path) {
+.expandPath <- function(path) {
path.expand(enc2utf8(path))
}
diff --git a/R/utilities-individual.R b/R/utilities-individual.R
index c0faef695..c40271f63 100644
--- a/R/utilities-individual.R
+++ b/R/utilities-individual.R
@@ -1,4 +1,4 @@
-#' Creates an individual using the PKSim Database
+#' Creates an individual using the PK-Sim Database
#'
#' @param individualCharacteristics Characteristics of the individual to create
#' as an instance of `IndividualCharacteristics`
@@ -19,12 +19,12 @@ createIndividual <- function(individualCharacteristics) {
individualFactory <- rClr::clrCallStatic("PKSim.R.Api", "GetIndividualFactory")
createIndividualResults <- rClr::clrCall(individualFactory, "CreateIndividual", individualCharacteristics$ref)
- distributedParameters <- getPropertyValue(createIndividualResults, "DistributedParameters")
- derivedParameters <- getPropertyValue(createIndividualResults, "DerivedParameters")
- seed <- getPropertyValue(createIndividualResults, "Seed")
+ distributedParameters <- .getPropertyValue(createIndividualResults, "DistributedParameters")
+ derivedParameters <- .getPropertyValue(createIndividualResults, "DerivedParameters")
+ seed <- .getPropertyValue(createIndividualResults, "Seed")
- distributedParameters <- parameterValueListFrom(distributedParameters, addUnits = TRUE)
- derivedParameters <- parameterValueListFrom(derivedParameters, addUnits = TRUE)
+ distributedParameters <- .parameterValueListFrom(distributedParameters, addUnits = TRUE)
+ derivedParameters <- .parameterValueListFrom(derivedParameters, addUnits = TRUE)
list(distributedParameters = distributedParameters, derivedParameters = derivedParameters, seed = seed)
}
@@ -43,16 +43,16 @@ createDistributions <- function(individualCharacteristics) {
distributedParameters <- rClr::clrCall(individualFactory, "DistributionsFor", individualCharacteristics$ref)
list(
- paths = getPropertyValues(distributedParameters, "ParameterPath"),
- values = getPropertyValues(distributedParameters, "Value"),
- units = getPropertyValues(distributedParameters, "Unit"),
- means = getPropertyValues(distributedParameters, "Mean"),
- stds = getPropertyValues(distributedParameters, "Std"),
- distributionTypes = getPropertyValues(getPropertyValues(distributedParameters, "DistributionType"), "DisplayName")
+ paths = .getPropertyValues(distributedParameters, "ParameterPath"),
+ values = .getPropertyValues(distributedParameters, "Value"),
+ units = .getPropertyValues(distributedParameters, "Unit"),
+ means = .getPropertyValues(distributedParameters, "Mean"),
+ stds = .getPropertyValues(distributedParameters, "Std"),
+ distributionTypes = .getPropertyValues(.getPropertyValues(distributedParameters, "DistributionType"), "DisplayName")
)
}
-#' Creates an individual using the PKSim Database.
+#' Creates an individual using the PK-Sim Database.
#'
#' @param species Species of the individual as defined in PK-Sim (see Species enum)
#' @param population Population to use to create the individual. This is required only when the species is Human. (See HumanPopulation enum)
@@ -89,7 +89,6 @@ createIndividualCharacteristics <- function(species,
gestationalAgeUnit = "week(s)",
moleculeOntogenies = NULL,
seed = NULL) {
-
# Assuming that if this function is called directly, PK-Sim was either initialized already
# or should be initialized automatically
initPKSim()
diff --git a/R/utilities-molecule.R b/R/utilities-molecule.R
index abd078a93..8378cbcb1 100644
--- a/R/utilities-molecule.R
+++ b/R/utilities-molecule.R
@@ -73,7 +73,7 @@ getMolecule <- function(path, container, stopIfNotFound = TRUE) {
#' @param values A numeric value that should be assigned to the molecule start value or a vector
#' of numeric values, if the start value of more than one molecule should be changed. Must have the same
#' length as `molecules`
-#' @inheritParams setQuantityValues
+#' @inheritParams .setQuantityValues
#'
#' @examples
#'
@@ -86,7 +86,7 @@ getMolecule <- function(path, container, stopIfNotFound = TRUE) {
#' @export
setMoleculeInitialValues <- function(molecules, values, units = NULL) {
validateIsOfType(molecules, "Molecule")
- setQuantityValues(molecules, values, units)
+ .setQuantityValues(molecules, values, units)
}
diff --git a/R/utilities-parameter-value.R b/R/utilities-parameter-value.R
index 89edfcc23..0a2e369fc 100644
--- a/R/utilities-parameter-value.R
+++ b/R/utilities-parameter-value.R
@@ -7,14 +7,14 @@
#' @param addUnits If `TRUE`, a a third list will be returned containing the units in which the parameters are defined. Default is `FALSE`
#'
#' @return A list with 3 sublist: `paths`, `values`, and optionally `units` containing the corresponding values from each parameter value
-parameterValueListFrom <- function(netParameterValues, addUnits = FALSE) {
+.parameterValueListFrom <- function(netParameterValues, addUnits = FALSE) {
parameterList <- list(
- paths = getPropertyValues(netParameterValues, "ParameterPath"),
- values = getPropertyValues(netParameterValues, "Value")
+ paths = .getPropertyValues(netParameterValues, "ParameterPath"),
+ values = .getPropertyValues(netParameterValues, "Value")
)
if (addUnits) {
- parameterList$units <- getPropertyValues(netParameterValues, "Unit")
+ parameterList$units <- .getPropertyValues(netParameterValues, "Unit")
}
return(parameterList)
diff --git a/R/utilities-parameter.R b/R/utilities-parameter.R
index 6eccad102..cc82e809a 100644
--- a/R/utilities-parameter.R
+++ b/R/utilities-parameter.R
@@ -77,7 +77,7 @@ getParameter <- function(path, container, stopIfNotFound = TRUE) {
#' displayPath <- getParameterDisplayPaths("Organism|Liver|Volume", sim)
#' @export
getParameterDisplayPaths <- function(paths, simulation) {
- getQuantityDisplayPaths(paths, simulation)
+ .getQuantityDisplayPaths(paths, simulation)
}
#' Set values of parameters
@@ -88,7 +88,7 @@ getParameterDisplayPaths <- function(paths, simulation) {
#' @param values A numeric value that should be assigned to the parameter or a vector
#' of numeric values, if the value of more than one parameter should be changed. Must have the same
#' length as 'parameters'. Alternatively, the value can be a unique number. In that case, the same value will be set in all parameters
-#' @inheritParams setQuantityValues
+#' @inheritParams .setQuantityValues
#'
#' @examples
#'
@@ -101,7 +101,7 @@ getParameterDisplayPaths <- function(paths, simulation) {
#' @export
setParameterValues <- function(parameters, values, units = NULL) {
validateIsOfType(parameters, "Parameter")
- setQuantityValues(parameters, values, units)
+ .setQuantityValues(parameters, values, units)
}
@@ -152,5 +152,5 @@ setParameterValuesByPath <- function(parameterPaths, values, simulation, units =
#' @export
scaleParameterValues <- function(parameters, factor) {
validateIsOfType(parameters, "Parameter")
- scaleQuantityValues(parameters, factor)
+ .scaleQuantityValues(parameters, factor)
}
diff --git a/R/utilities-pk-analysis.R b/R/utilities-pk-analysis.R
index 3d1935182..96be3e30d 100644
--- a/R/utilities-pk-analysis.R
+++ b/R/utilities-pk-analysis.R
@@ -33,14 +33,14 @@ calculatePKAnalyses <- function(results) {
exportPKAnalysesToCSV <- function(pkAnalyses, filePath) {
validateIsOfType(pkAnalyses, "SimulationPKAnalyses")
validateIsString(filePath)
- filePath <- expandPath(filePath)
+ filePath <- .expandPath(filePath)
pkAnalysisTask <- .getNetTask("PKAnalysisTask")
rClr::clrCall(pkAnalysisTask, "ExportPKAnalysesToCSV", pkAnalyses$ref, pkAnalyses$simulation$ref, filePath)
invisible()
}
#' @inherit exportPKAnalysesToCSV
-savePKAnalysesToCSV <- function(pkAnalyses, filePath) {
+.savePKAnalysesToCSV <- function(pkAnalyses, filePath) {
exportPKAnalysesToCSV(pkAnalyses, filePath)
}
@@ -54,7 +54,7 @@ savePKAnalysesToCSV <- function(pkAnalyses, filePath) {
importPKAnalysesFromCSV <- function(filePath, simulation) {
validateIsOfType(simulation, "Simulation")
validateIsString(filePath)
- filePath <- expandPath(filePath)
+ filePath <- .expandPath(filePath)
pkAnalysisTask <- .getNetTask("PKAnalysisTask")
pkAnalyses <- rClr::clrCall(pkAnalysisTask, "ImportPKAnalysesFromCSV", filePath, simulation$ref)
SimulationPKAnalyses$new(pkAnalyses, simulation)
diff --git a/R/utilities-pksim.R b/R/utilities-pksim.R
index 7d8e0f6fc..e09b10565 100644
--- a/R/utilities-pksim.R
+++ b/R/utilities-pksim.R
@@ -1,5 +1,5 @@
-#' Loads the PKSim.R that will enable create individual and create population workflows.
+#' Loads the `PKSim.R` that will enable create individual and create population workflows.
#' @param pksimFolderPath Path where PK-Sim is installed. If this is not specified, path will be read from registry using the package version
#'
#' @note This will only work on Windows machine and should not be called on any other OS.
@@ -8,7 +8,6 @@
#' @import rClr
#' @export
initPKSim <- function(pksimFolderPath = NULL) {
-
# pksimFolderPath <- "C:/dev/PK-Sim/src/PKSim/bin/Debug/net472"
if (ospsuiteEnv$isPKSimLoaded) {
@@ -39,7 +38,7 @@ initPKSim <- function(pksimFolderPath = NULL) {
#' @param pksim.version The version number of Pk-Sim as a string.
#'
#' @return
-#' The path to the PK-Sim installation for version pksim.version or NA if no path could be found.
+#' The path to the PK-Sim installation for version `pksim.version` or NA if no path could be found.
#' The path is separated with slashes (unix-style) and in compliance with base-R without a trailing slash.
#'
#' @examples
@@ -74,16 +73,16 @@ initPKSim <- function(pksimFolderPath = NULL) {
return(NA_character_)
}
-#' Tries to find the installation path for a specific version of PK-Sim via the filesystem.
+#' Tries to find the installation path for a specific version of PK-Sim via the file system.
#' Searching is done in the following order:
-#' 1. Search via filesystem in a guessed installation folder from the base.search.folder
-#' 3. Search via filesystem for PKSim.exe recursively from the defined base.search.folder (fallback)
+#' 1. Search via file system in a guessed installation folder from the base.search.folder
+#' 3. Search via file system for `PKSim.exe` recursively from the defined base.search.folder (fallback)
#'
#' @param pksim.version The version number of Pk-Sim as a string.
-#' @param base.search.folder The base folder for filesystem-lookup fallback (default: 64-bit program folder)
+#' @param base.search.folder The base folder for file system lookup fallback (default: 64-bit program folder)
#'
#' @return
-#' The path to the PK-Sim installation for version pksim.version or NA if no path could be found.
+#' The path to the PK-Sim installation for version `pksim.version` or NA if no path could be found.
#' The path is separated with slashes (unix-style) and in compliance with base-R without a trailing slash.
#' If more than one matching path is found a warning is produced.
#'
@@ -143,13 +142,13 @@ initPKSim <- function(pksimFolderPath = NULL) {
#' Tries to find the installation path for a specific version of PK-Sim.
#' Searching is done in the following order:
#' 1. Search via Windows registry entry
-#' 2. Search via filesystem in a guessed installation folder from the base.search.folder (fallback 1)
+#' 2. Search via file system in a guessed installation folder from the base.search.folder (fallback 1)
#'
#' @param pksim.version The version number of Pk-Sim as a string.
-#' @param base.search.folder The base folder for filesystem-lookup fallback (default: 64-bit program folder)
+#' @param base.search.folder The base folder for file system lookup fallback (default: 64-bit program folder)
#'
#' @return
-#' The path to the PK-Sim installation for version pksim.version or NA if no path could be found.
+#' The path to the PK-Sim installation for version `pksim.version` or NA if no path could be found.
#' The path is separated with slashes (unix-style) and in compliance with base-R without a trailing slash.
#' If more than one matching path is found a warning is produced.
#'
diff --git a/R/utilities-plotting.R b/R/utilities-plotting.R
index 2560065c9..4f38f253b 100644
--- a/R/utilities-plotting.R
+++ b/R/utilities-plotting.R
@@ -1,3 +1,34 @@
+#' Make sure entered `DataCombined` object is valid for plotting
+#'
+#' @family utilities-plotting
+#'
+#' @keywords internal
+#' @noRd
+.validateDataCombinedForPlotting <- function(dataCombined) {
+ .validateScalarDataCombined(dataCombined)
+
+ # If there are no datasets in the object, no plot will be created.
+ if (is.null(dataCombined$groupMap)) {
+ warning(messages$plottingWithEmptyDataCombined())
+ }
+}
+
+#' Make sure entered `DefaultPlotConfiguration` object is valid for plotting
+#'
+#' @family utilities-plotting
+#'
+#' @keywords internal
+#' @noRd
+.validateDefaultPlotConfiguration <- function(defaultPlotConfiguration = NULL) {
+ defaultPlotConfiguration <- defaultPlotConfiguration %||% DefaultPlotConfiguration$new()
+ validateIsOfType(defaultPlotConfiguration, "DefaultPlotConfiguration")
+
+ # Plotting functions should not update the configuration objects
+ defaultPlotConfiguration <- defaultPlotConfiguration$clone(deep = TRUE)
+
+ return(defaultPlotConfiguration)
+}
+
#' Replace missing groupings with dataset names
#'
#' @description
@@ -7,6 +38,8 @@
#'
#' @param data A data frame returned by `DataCombined$toDataFrame()`.
#'
+#' @family utilities-plotting
+#'
#' @examples
#'
#' df <- dplyr::tibble(
@@ -54,106 +87,93 @@
return(data)
}
-#' Remove unpairable datasets for scatter plots
+
+#' Extract aggregated simulated data
#'
-#' @description
+#' @param simData A data frame with simulated data from
+#' `DataCombined$toDataFrame()`.
+#' @inheritParams plotPopulationTimeProfile
+#'
+#' @details
#'
-#' Datasets which haven't been assigned to any group will be removed from the
-#' combined data frame.
+#' The simulated values will be aggregated across individuals for each time
+#' point.
#'
-#' @param data A data frame returned by `DataCombined$toDataFrame()`.
+#' @family utilities-plotting
#'
#' @examples
#'
-#' df <- dplyr::tribble(
-#' ~name, ~dataType, ~group,
-#' "Sim1", "Simulated", "GroupA",
-#' "Sim2", "Simulated", "GroupA",
-#' "Obs1", "Observed", "GroupB",
-#' "Obs2", "Observed", "GroupB",
-#' "Sim3", "Simulated", "GroupC",
-#' "Obs3", "Observed", "GroupC",
-#' "Sim4", "Simulated", "GroupD",
-#' "Obs4", "Observed", "GroupD",
-#' "Obs5", "Observed", "GroupD",
-#' "Sim5", "Simulated", "GroupE",
-#' "Sim6", "Simulated", "GroupE",
-#' "Obs7", "Observed", "GroupE",
-#' "Sim7", "Simulated", "GroupF",
-#' "Sim8", "Simulated", "GroupF",
-#' "Obs8", "Observed", "GroupF",
-#' "Obs9", "Observed", "GroupF",
-#' "Sim9", "Simulated", NA,
-#' "Obs10", "Observed", NA
+#' # let's create a data frame to test this function
+#' df <- dplyr::tibble(
+#' xValues = c(
+#' 0, 1, 2, 3, 4, 5, 0, 1, 2, 3, 4, 5,
+#' 0, 1, 2, 3, 4, 5, 0, 1, 2, 3, 4, 5, 0, 1, 2, 3, 4, 5, 0, 1, 2,
+#' 3, 4, 5, 0, 1, 2, 3, 4, 5, 0, 1, 2, 3, 4, 5
+#' ),
+#' yValues = c(
+#' 0,
+#' 0.990956723690033, 0.981773018836975, 0.972471475601196, 0.963047087192535,
+#' 0.953498184680939, 0, 0.990953505039215, 0.981729507446289, 0.97233647108078,
+#' 0.962786376476288, 0.953093528747559, 0, 0.990955889225006, 0.981753170490265,
+#' 0.972399413585663, 0.962896287441254, 0.953253626823425, 0, 0.990950107574463,
+#' 0.981710314750671, 0.972296476364136, 0.962724387645721, 0.953009009361267,
+#' 0, 0.261394888162613, 0.266657412052155, 0.27151620388031, 0.275971591472626,
+#' 0.280027687549591, 0, 0.26139160990715, 0.266613900661469, 0.271381109952927,
+#' 0.275710910558701, 0.279623001813889, 0, 0.261393994092941, 0.266637593507767,
+#' 0.271443992853165, 0.275820910930634, 0.279783099889755, 0, 0.261388212442398,
+#' 0.266594797372818, 0.27134120464325, 0.275649011135101, 0.279538512229919
+#' ),
+#' group = c(rep("Stevens 2012 solid total", 24), rep("Stevens 2012 solid distal", 24)),
+#' name = group
#' )
#'
-#' # original
+#' # raw data
#' df
#'
-#' # transformed
-#' ospsuite:::.removeUnpairableDatasets(df)
-#'
-#' @keywords internal
-.removeUnpairableDatasets <- function(data) {
- # How many rows were originally present
- originalDatasets <- unique(data$name)
-
- # Remove datasets that don't belong to any group.
- data <- dplyr::filter(data, !is.na(group))
-
- # Remove groups (and the datasets therein) with only one type (either only
- # observed or only simulated) of dataset.
- data <- data %>%
- dplyr::group_by(group) %>%
- dplyr::filter(length(unique(dataType)) > 1L) %>%
- dplyr::ungroup()
-
- # How many rows are present after filtering
- finalDatasets <- unique(data$name)
-
- # Warn the user about the filtering if it took place
- if (length(finalDatasets) < length(originalDatasets)) {
- missingDatasets <- originalDatasets[!originalDatasets %in% finalDatasets]
-
- message(messages$printMultipleEntries(
- header = messages$datasetsToGroupNotFound(),
- entries = missingDatasets
- ))
- }
-
- return(data)
-}
-
-
-#' Extract aggregated simulated data
+#' # aggregated data
+#' ospsuite:::.extractAggregatedSimulatedData(df)
#'
#' @keywords internal
-#' @noRd
-.extractAggregatedSimulatedData <- function(simData, quantiles) {
- # Compute quantiles
+.extractAggregatedSimulatedData <- function(simData,
+ quantiles = c(0.05, 0.5, 0.95)) {
simAggregatedData <- simData %>%
- # For each dataset, compute across all individuals for each time point
- dplyr::group_by(group, xValues) %>% #
+ # For each dataset, compute quantiles across all individuals for each time point
+ #
+ # Each group should always a single dataset, so grouping by `group` *and* `name`
+ # should produce the same result as grouping by only `group` column.
+ #
+ # The reason `name` column also needs to be retained in the resulting data
+ # is because it is mapped to linetype property in population profile type.
+ dplyr::group_by(group, name, xValues) %>%
dplyr::summarise(
- yValuesLower = stats::quantile(yValues, quantiles[[1]]),
+ yValuesLower = stats::quantile(yValues, quantiles[[1]]),
yValuesCentral = stats::quantile(yValues, quantiles[[2]]),
- yValuesHigher = stats::quantile(yValues, quantiles[[3]]),
- .groups = "drop" # drop grouping information from the summary data frame
- )
+ yValuesHigher = stats::quantile(yValues, quantiles[[3]]),
+ .groups = "drop" # drop grouping information from the summary data frame
+ ) %>% # Naming schema expected by plotting functions
+ dplyr::rename(yValues = yValuesCentral)
return(simAggregatedData)
}
#' Create axes labels
#'
+#' @details
+#'
+#' If axes labels haven't been specified, create them using information about
+#' dimensions and units present in the data frame produced by
+#' `DataCombined$toDataFrame()`.
+#'
#' @param data A data frame from `DataCombined$toDataFrame()`, which has
-#' additionally been cleaned using `.unitConverter()` to have the same units
-#' across datasets.
+#' additionally been cleaned using `ospsuite:::.unitConverter()` to have the
+#' same units across datasets.
#' @param specificPlotConfiguration The nature of labels will change depending
-#' on the type of plot, which can be guessed from the specific
+#' on the type of plot. The type of plot can be guessed from the specific
#' `PlotConfiguration` object used, since each plot has a unique corresponding
#' class.
#'
+#' @family utilities-plotting
+#'
#' @examples
#'
#' df <- dplyr::tibble(
@@ -172,10 +192,6 @@
#'
#' ospsuite:::.createAxesLabels(df, tlf::TimeProfilePlotConfiguration$new())
#'
-#' @details
-#'
-#' If axes labels haven't been specified, create them using dimensions and units.
-#'
#' @keywords internal
.createAxesLabels <- function(data, specificPlotConfiguration) {
# If empty data frame is entered or plot type is not specified, return early
@@ -183,15 +199,40 @@
return(NULL)
}
- # The type of plot can be guessed from the specific `PlotConfiguration` object
- # used, since each plot has a unique corresponding class.
- plotType <- class(specificPlotConfiguration)[[1]]
+ # special concern for concentration --------------------------
+
+ # If there are multiple dimensions for Y-axis variable, it is most likely to
+ # be due to multiple concentration dimensions.
+ #
+ # Hard code these to a single dimension: `"Concentration"`.
+ #
+ # For more, see:
+ # https://github.com/Open-Systems-Pharmacology/OSPSuite-R/issues/938
+ concDimensions <- c(ospDimensions$`Concentration (mass)`, ospDimensions$`Concentration (molar)`)
+
+ if (!all(is.na(data$yDimension))) {
+ data <- dplyr::mutate(data,
+ yDimension = dplyr::case_when(
+ yDimension %in% concDimensions ~ "Concentration",
+ TRUE ~ yDimension
+ )
+ )
+ }
+
+ if (!all(is.na(data$xDimension))) {
+ data <- dplyr::mutate(data,
+ xDimension = dplyr::case_when(
+ xDimension %in% concDimensions ~ "Concentration",
+ TRUE ~ xDimension
+ )
+ )
+ }
# Initialize strings with unique values for units and dimensions.
#
# The`.unitConverter()` has already ensured that there is only a single unit
- # for x and y quantities, so we can safely take the unique unit to prepare
- # axes labels.
+ # for quantities, so we can safely take the unique unit to prepare axes
+ # labels.
xUnitString <- unique(data$xUnit)
yUnitString <- unique(data$yUnit)
@@ -199,54 +240,38 @@
xDimensionString <- unique(data$xDimension)[[1]]
yDimensionString <- unique(data$yDimension)[[1]]
- # Currently, hard code any of the different concentration dimensions to just
- # one dimension: "Concentration"
- #
- # https://github.com/Open-Systems-Pharmacology/OSPSuite-R/issues/938
- concDimensions <- c(
- ospDimensions$`Concentration (mass)`,
- ospDimensions$`Concentration (molar)`
- )
-
- if (any(xDimensionString %in% concDimensions)) {
- xDimensionString <- "Concentration"
- }
-
- if (any(yDimensionString %in% concDimensions)) {
- yDimensionString <- "Concentration"
- }
-
- # If quantities are unitless, no unit information will be displayed.
- # Otherwise, `Dimension [Unit]` pattern will be followed.
+ # If quantities are unitless, no unit information needs to be displayed.
+ # Otherwise, `Dimension [Unit]` pattern is followed.
xUnitString <- ifelse(xUnitString == "", xUnitString, paste0(" [", xUnitString, "]"))
xUnitString <- paste0(xDimensionString, xUnitString)
yUnitString <- ifelse(yUnitString == "", yUnitString, paste0(" [", yUnitString, "]"))
yUnitString <- paste0(yDimensionString, yUnitString)
# The exact axis label will depend on the type of the plot, and the type
- # of the plot can be guessed using the specific `PlotConfiguration` object
- # entered in this function.
- #
+ # of the plot can be guessed using the specific `PlotConfiguration` object.
+ plotType <- class(specificPlotConfiguration)[[1]]
+
# If the specific `PlotConfiguration` object is not any of the cases included
- # in the `switch` below, the result will be no change; i.e., the labels will
- # continue to be `NULL`.
+ # in the `switch` below, the the labels will remain `NULL`.
- # x-axis label
+ # X-axis label
xLabel <- switch(plotType,
- "TimeProfilePlotConfiguration" = xUnitString,
- "ResVsPredPlotConfiguration" = xUnitString,
+ "TimeProfilePlotConfiguration" = ,
+ "ResVsTimePlotConfiguration" = xUnitString,
# Note that `yUnitString` here is deliberate.
#
# In case of an observed versus simulated plot, `yValues` are plotted on
# both x- and y-axes, and therefore the units strings are going to be the
# same for both axes.
- "ObsVsPredPlotConfiguration" = paste0("Observed values (", yUnitString, ")")
+ "ObsVsPredPlotConfiguration" = paste0("Observed values (", yUnitString, ")"),
+ "ResVsPredPlotConfiguration" = paste0("Simulated values (", yUnitString, ")")
)
- # y-axis label
+ # Y-axis label
yLabel <- switch(plotType,
"TimeProfilePlotConfiguration" = yUnitString,
- "ResVsPredPlotConfiguration" = "Residuals",
+ "ResVsPredPlotConfiguration" = ,
+ "ResVsTimePlotConfiguration" = "Residuals",
"ObsVsPredPlotConfiguration" = paste0("Simulated values (", yUnitString, ")")
)
@@ -254,54 +279,138 @@
}
+#' Update axes label fields in `PlotConfiguration` object
+#'
+#' @family utilities-plotting
+#'
+#' @keywords internal
+#' @noRd
+.updatePlotConfigurationAxesLabels <- function(data, plotConfiguration) {
+ axesLabels <- .createAxesLabels(data, plotConfiguration)
+
+ # Update only if the user hasn't already specified labels.
+ plotConfiguration$labels$xlabel$text <- plotConfiguration$labels$xlabel$text %||% axesLabels$xLabel
+ plotConfiguration$labels$ylabel$text <- plotConfiguration$labels$ylabel$text %||% axesLabels$yLabel
+
+ return(plotConfiguration)
+}
+
+
+#' Compute error bar bounds from error type
+#'
+#' @keywords internal
+#' @noRd
+.computeBoundsFromErrorType <- function(data) {
+ if (is.null(data)) {
+ return(NULL)
+ }
+
+ if (!all(is.na(data$yErrorValues)) && !all(is.na(data$yErrorType))) {
+ data <- dplyr::mutate(data,
+ # If the error values are 0, the error bar caps will be displayed even
+ # when there are no error bars. Replacing `0`s with `NA`s gets rid of this
+ # problem.
+ #
+ # For more, see: https://github.com/Open-Systems-Pharmacology/TLF-Library/issues/348
+ yErrorValues = dplyr::case_when(
+ dplyr::near(yErrorValues, 0) ~ NA_real_,
+ TRUE ~ yErrorValues
+ ),
+ # For compuring uncertainty, there are only three possibilities:
+ #
+ # - The error type is arithmetic (`DataErrorType$ArithmeticStdDev`).
+ # - The error type is geometric (`DataErrorType$GeometricStdDev`).
+ # - If the errors are none of these, then add `NA`s (of type `double`),
+ # since these are the only error types supported in `DataErrorType`.
+ yValuesLower = dplyr::case_when(
+ yErrorType == DataErrorType$ArithmeticStdDev ~ yValues - yErrorValues,
+ yErrorType == DataErrorType$GeometricStdDev ~ yValues / yErrorValues,
+ TRUE ~ NA_real_
+ ),
+ yValuesHigher = dplyr::case_when(
+ yErrorType == DataErrorType$ArithmeticStdDev ~ yValues + yErrorValues,
+ yErrorType == DataErrorType$GeometricStdDev ~ yValues * yErrorValues,
+ TRUE ~ NA_real_
+ )
+ )
+ } else {
+ # These columns should always be present in the data frame because they are
+ # part of `{tlf}` mapping.
+ data <- dplyr::mutate(data, yValuesLower = NA_real_, yValuesHigher = NA_real_)
+ }
+
+ return(data)
+}
+
+
+
+
+
#' Create plot-specific `tlf::PlotConfiguration` object
#'
-#' @param data A data frame containing information about dimensions and units
-#' for the x-and y-axes quantities.
+#' @details
+#'
+#' The default plot configuration and the labels needs to vary from plot-to-plot
+#' because each plot has its specific (default) aesthetic needs that need to be
+#' met.
+#'
+#' For example, although the axes labels for profile plots will be (e.g.) "Time
+#' vs Fraction", they will be (e.g.) "Observed vs simulated values" for scatter
+#' plots. Additionally, mapping group to line colors might be desirable for a
+#' profile plot, it is not so for scatter plots.
+#'
+#' This function generates object of specific subclass of
+#' `tlf::PlotConfiguration` needed for the given plot but with suitable defaults
+#' taken from the `DefaultPlotConfiguration` object.
+#'
#' @param specificPlotConfiguration A specific subclass of
#' `tlf::PlotConfiguration` needed for the given plot.
#' @param generalPlotConfiguration A `DefaultPlotConfiguration` object.
#'
+#' @family utilities-plotting
+#'
+#' @examples
+#'
+#' ospsuite:::.convertGeneralToSpecificPlotConfiguration(
+#' tlf::TimeProfilePlotConfiguration$new(),
+#' ospsuite::DefaultPlotConfiguration$new()
+#' )
+#'
#' @keywords internal
-#' @noRd
-.convertGeneralToSpecificPlotConfiguration <- function(data,
- specificPlotConfiguration,
+.convertGeneralToSpecificPlotConfiguration <- function(specificPlotConfiguration,
generalPlotConfiguration) {
- validateIsOfType(generalPlotConfiguration, "DefaultPlotConfiguration", nullAllowed = FALSE)
-
# Plot-specific configuration defaults -----------------------------------
- # The default plot configuration and the labels will vary from plot-to-plot.
- #
- # For example, although the axes labels for profile plots will be (e.g.) "Time
- # vs Fraction", it will be "observed vs simulated values" with the same unit
- # for scatter plot. Additionally, mapping group to line colors might be
- # desirable for a profile plot, it is not so for scatter plots.
-
# The type of plot can be guessed from the specific `PlotConfiguration` object
# used, since each plot has a unique corresponding class.
plotType <- class(specificPlotConfiguration)[[1]]
# For `plotIndividualTimeProfile()` and `plotPopulationTimeProfile()`
if (plotType == "TimeProfilePlotConfiguration") {
- generalPlotConfiguration$pointsColor <- generalPlotConfiguration$pointsColor %||% tlf::ColorMaps$ospDefault
- generalPlotConfiguration$pointsShape <- generalPlotConfiguration$pointsShape %||% names(tlf::Shapes)
-
generalPlotConfiguration$linesColor <- generalPlotConfiguration$linesColor %||% tlf::ColorMaps$ospDefault
- generalPlotConfiguration$linesLinetype <- generalPlotConfiguration$linesLinetype %||% tlf::Linetypes$solid
-
+ # This is especially necessary when multiple simulated datasets are present per group
+ generalPlotConfiguration$linesLinetype <- generalPlotConfiguration$linesLinetype %||% names(tlf::Linetypes)
generalPlotConfiguration$legendPosition <- generalPlotConfiguration$legendPosition %||% tlf::LegendPositions$insideTopRight
+ generalPlotConfiguration$xAxisScale <- generalPlotConfiguration$xAxisScale %||% tlf::Scaling$lin
+ generalPlotConfiguration$yAxisScale <- generalPlotConfiguration$yAxisScale %||% tlf::Scaling$lin
}
# For `plotObservedVsSimulated()`
if (plotType == "ObsVsPredPlotConfiguration") {
- generalPlotConfiguration$pointsColor <- generalPlotConfiguration$pointsColor %||% tlf::ColorMaps$ospDefault
- generalPlotConfiguration$pointsShape <- generalPlotConfiguration$pointsShape %||% names(tlf::Shapes)
+ generalPlotConfiguration$linesColor <- generalPlotConfiguration$linesColor %||% "black"
+ generalPlotConfiguration$legendPosition <- generalPlotConfiguration$legendPosition %||% tlf::LegendPositions$insideBottomRight
+ generalPlotConfiguration$xAxisScale <- generalPlotConfiguration$xAxisScale %||% tlf::Scaling$log
+ generalPlotConfiguration$yAxisScale <- generalPlotConfiguration$yAxisScale %||% tlf::Scaling$log
+ # every fold distance line should get a unique type of line
+ generalPlotConfiguration$linesLinetype <- generalPlotConfiguration$linesLinetype %||% names(tlf::Linetypes)
+ }
+ # For `plotResidualsVsTime()` and `plotResidualsVsSimulated()`
+ if (plotType %in% c("ResVsTimePlotConfiguration", "ResVsPredPlotConfiguration")) {
generalPlotConfiguration$linesColor <- generalPlotConfiguration$linesColor %||% "black"
generalPlotConfiguration$linesLinetype <- generalPlotConfiguration$linesLinetype %||% tlf::Linetypes$dashed
-
- generalPlotConfiguration$legendPosition <- generalPlotConfiguration$legendPosition %||% tlf::LegendPositions$insideBottomRight
+ generalPlotConfiguration$xAxisScale <- generalPlotConfiguration$xAxisScale %||% tlf::Scaling$lin
+ generalPlotConfiguration$yAxisScale <- generalPlotConfiguration$yAxisScale %||% tlf::Scaling$lin
}
# labels object ---------------------------------------
@@ -375,20 +484,25 @@
align = generalPlotConfiguration$legendTitleAlign
)
- legendCaptionFont <- tlf::Font$new(
- size = generalPlotConfiguration$legendCaptionSize,
- color = generalPlotConfiguration$legendCaptionColor,
- fontFamily = generalPlotConfiguration$legendCaptionFontFamily,
- fontFace = generalPlotConfiguration$legendCaptionFontFace,
- angle = generalPlotConfiguration$legendCaptionAngle,
- align = generalPlotConfiguration$legendCaptionAlign
+ legendTitleLabel <- tlf::Label$new(
+ text = generalPlotConfiguration$legendTitle,
+ font = legendTitleFont
+ )
+
+ legendKeysFont <- tlf::Font$new(
+ size = generalPlotConfiguration$legendKeysSize,
+ color = generalPlotConfiguration$legendKeysColor,
+ fontFamily = generalPlotConfiguration$legendKeysFontFamily,
+ fontFace = generalPlotConfiguration$legendKeysFontFace,
+ angle = generalPlotConfiguration$legendKeysAngle,
+ align = generalPlotConfiguration$legendKeysAlign
)
legendConfiguration <- tlf::LegendConfiguration$new(
position = generalPlotConfiguration$legendPosition,
caption = NULL,
- title = generalPlotConfiguration$legendTitle,
- font = generalPlotConfiguration$legendCaptionFont,
+ title = legendTitleLabel, # for legend title aesthetics
+ font = legendKeysFont, # for legend keys aesthetics
background = NULL
)
@@ -468,7 +582,8 @@
scale = generalPlotConfiguration$xAxisScale,
ticks = generalPlotConfiguration$xAxisTicks,
ticklabels = generalPlotConfiguration$xAxisTicksLabels,
- font = generalPlotConfiguration$xAxisFont
+ font = generalPlotConfiguration$xAxisFont,
+ expand = generalPlotConfiguration$xAxisExpand
)
# yAxis objects -----------------------------------
@@ -487,7 +602,8 @@
scale = generalPlotConfiguration$yAxisScale,
ticks = generalPlotConfiguration$yAxisTicks,
ticklabels = generalPlotConfiguration$yAxisTicksLabels,
- font = generalPlotConfiguration$yAxisFont
+ font = generalPlotConfiguration$yAxisFont,
+ expand = generalPlotConfiguration$yAxisExpand
)
# lines -------------------------------------------------------
@@ -522,8 +638,9 @@
# errorbars -------------------------------------------------------
errorbarsConfiguration <- tlf::ThemeAestheticSelections$new(
- shape = generalPlotConfiguration$errorbarsShape,
size = generalPlotConfiguration$errorbarsSize,
+ # TODO: https://github.com/Open-Systems-Pharmacology/TLF-Library/issues/347
+ # capSize = generalPlotConfiguration$errorbarsCapSize,
linetype = generalPlotConfiguration$errorbarsLinetype,
alpha = generalPlotConfiguration$errorbarsAlpha
)
diff --git a/R/utilities-population.R b/R/utilities-population.R
index 73b82b96b..ecb969c86 100644
--- a/R/utilities-population.R
+++ b/R/utilities-population.R
@@ -9,7 +9,7 @@
#' @export
loadPopulation <- function(csvPopulationFile) {
validateIsString(csvPopulationFile)
- csvPopulationFile <- expandPath(csvPopulationFile)
+ csvPopulationFile <- .expandPath(csvPopulationFile)
populationTask <- .getNetTask("PopulationTask")
population <- rClr::clrCall(populationTask, "ImportPopulation", csvPopulationFile)
Population$new(population)
@@ -34,7 +34,7 @@ splitPopulationFile <- function(csvPopulationFile, numberOfCores, outputFolder,
validateIsNumeric(numberOfCores)
validateIsString(outputFolder)
validateIsString(outputFileName)
- csvPopulationFile <- expandPath(csvPopulationFile)
+ csvPopulationFile <- .expandPath(csvPopulationFile)
outputFileName <- enc2utf8(outputFileName)
populationTask <- .getNetTask("PopulationTask")
rClr::clrCall(populationTask, "SplitPopulation", csvPopulationFile, as.integer(numberOfCores), outputFolder, outputFileName)
@@ -97,14 +97,14 @@ populationToTibble <- function(population) {
exportPopulationToCSV <- function(population, filePath) {
validateIsOfType(population, "Population")
validateIsString(filePath)
- filePath <- expandPath(filePath)
+ filePath <- .expandPath(filePath)
df <- populationToDataFrame(population)
write.csv(df, file = filePath, row.names = FALSE, fileEncoding = "UTF-8")
invisible()
}
#' @inherit exportPopulationToCSV
-savePopulationToCSV <- function(population, filePath) {
+.savePopulationToCSV <- function(population, filePath) {
exportPopulationToCSV(population, filePath)
}
@@ -129,7 +129,7 @@ loadAgingDataFromCSV <- function(filePath) {
}
-#' Creates an population using the PKSim Database
+#' Creates an population using the PK-Sim Database
#'
#' @param populationCharacteristics Characteristics of the population to create as an instance of `OriginData`
#' that are actually distributed parameters
@@ -145,8 +145,8 @@ createPopulation <- function(populationCharacteristics) {
populationFactory <- rClr::clrCallStatic("PKSim.R.Api", "GetPopulationFactory")
results <- rClr::clrCall(populationFactory, "CreatePopulation", populationCharacteristics$ref)
- netPopulation <- getPropertyValue(results, "IndividualValuesCache")
- seed <- getPropertyValue(results, "Seed")
+ netPopulation <- .getPropertyValue(results, "IndividualValuesCache")
+ seed <- .getPropertyValue(results, "Seed")
population <- Population$new(netPopulation)
individualCharacteristics <- NULL
@@ -161,7 +161,7 @@ createPopulation <- function(populationCharacteristics) {
derivedParameters <- list()
- # Even though those parameters are derived parameters, we keep them in the population for consistency purpose with the PKSim export.
+ # Even though those parameters are derived parameters, we keep them in the population for consistency purpose with the PK-Sim export.
standardDerivedParametersToKeep <- c(StandardPath$Weight, StandardPath$BMI, StandardPath$BSA)
for (derivedParameterPath in individual$derivedParameters$paths) {
@@ -234,8 +234,7 @@ createPopulationCharacteristics <- function(species,
gestationalAgeUnit = "week(s)",
moleculeOntogenies = NULL,
seed = NULL) {
-
- # Assuming that if this function is called directly, PKSim was either initialized already
+ # Assuming that if this function is called directly, PK-Sim was either initialized already
# or should be initialized automatically
initPKSim()
@@ -273,11 +272,11 @@ createPopulationCharacteristics <- function(species,
populationCharacteristics$population <- population
populationCharacteristics$numberOfIndividuals <- numberOfIndividuals
populationCharacteristics$proportionOfFemales <- proportionOfFemales
- populationCharacteristics$age <- createParameterRange(ageMin, ageMax, ageUnit)
- populationCharacteristics$weight <- createParameterRange(weightMin, weightMax, weightUnit)
- populationCharacteristics$height <- createParameterRange(heightMin, heightMax, heightUnit)
- populationCharacteristics$gestationalAge <- createParameterRange(gestationalAgeMin, gestationalAgeMax, gestationalAgeUnit)
- populationCharacteristics$BMI <- createParameterRange(BMIMin, BMIMax, BMIUnit)
+ populationCharacteristics$age <- .createParameterRange(ageMin, ageMax, ageUnit)
+ populationCharacteristics$weight <- .createParameterRange(weightMin, weightMax, weightUnit)
+ populationCharacteristics$height <- .createParameterRange(heightMin, heightMax, heightUnit)
+ populationCharacteristics$gestationalAge <- .createParameterRange(gestationalAgeMin, gestationalAgeMax, gestationalAgeUnit)
+ populationCharacteristics$BMI <- .createParameterRange(BMIMin, BMIMax, BMIUnit)
populationCharacteristics$seed <- seed
for (moleculeOntogeny in moleculeOntogenies) {
diff --git a/R/utilities-quantity.R b/R/utilities-quantity.R
index 3b34c8dfd..8316201b4 100644
--- a/R/utilities-quantity.R
+++ b/R/utilities-quantity.R
@@ -86,7 +86,7 @@ getQuantity <- function(path, container, stopIfNotFound = TRUE) {
#' `values`. If `NULL` (default), values are assumed to be in base units. If
#' not `NULL`, must have the same length as `quantities`.
#'
-setQuantityValues <- function(quantities, values, units = NULL) {
+.setQuantityValues <- function(quantities, values, units = NULL) {
# Must turn the input into a list so we can iterate through even when only
# one parameter is passed
quantities <- toList(quantities)
@@ -117,14 +117,13 @@ setQuantityValues <- function(quantities, values, units = NULL) {
}
}
-#' Set the values of parameters in the simulation by path
+#' Set the values of quantities in the simulation by path
#'
-#' @param quantityPaths A single or a list of absolute quantity path
+#' @param quantityPaths A single or a list of absolute quantity paths
#' @param values A numeric value that should be assigned to the quantities or a
#' vector of numeric values, if the value of more than one quantity should be
#' changed. Must have the same length as 'quantityPaths'.
-#' @param simulation Simulation uses to retrieve quantity instances from given
-#' paths.
+#' @param simulation Simulation containing the quantities
#' @param stopIfNotFound Boolean. If `TRUE` (default) and no quantity exists for
#' the given path, an error is thrown. If `FALSE`, a warning is shown to the
#' user.
@@ -160,7 +159,17 @@ setQuantityValuesByPath <- function(quantityPaths, values, simulation, units = N
if (dimension == "") {
next
}
- value <- toBaseUnit(quantityOrDimension = dimension, values = value, unit = units[[i]])
+ # If the unit is NULL, the value is assumend to be in base unit and no conversion
+ # in necessary
+ if (!is.null(units[[i]])) {
+ mw <- simulation$molWeightFor(path)
+ value <- toBaseUnit(
+ quantityOrDimension = dimension,
+ values = value,
+ unit = units[[i]],
+ molWeight = mw
+ )
+ }
}
rClr::clrCall(
@@ -173,13 +182,77 @@ setQuantityValuesByPath <- function(quantityPaths, values, simulation, units = N
}
}
+#' Get the values of quantities in the simulation by path
+#'
+#' @param quantityPaths A single or a list of absolute quantity paths
+#' @param simulation Simulation containing the quantities
+#' @param stopIfNotFound Boolean. If `TRUE` (default) and no quantity exists for
+#' the given path, an error is thrown. If `FALSE`, a warning is shown to the
+#' user.
+#' @param units A string or a list of strings defining the units of returned
+#' values. If `NULL` (default), values are returned in base units. If not
+#' `NULL`, must have the same length as `quantityPaths`. Single entries may be
+#' `NULL`.
+#' @examples
+#'
+#' simPath <- system.file("extdata", "simple.pkml", package = "ospsuite")
+#' sim <- loadSimulation(simPath)
+#' getQuantityValuesByPath(
+#' list("Organism|Liver|Volume", "Organism|Liver|A"),
+#' sim, list("ml", NULL)
+#' )
+#' @export
+getQuantityValuesByPath <- function(quantityPaths, simulation, units = NULL, stopIfNotFound = TRUE) {
+ validateIsString(quantityPaths)
+ validateIsOfType(simulation, "Simulation")
+
+ if (!is.null(units)) {
+ validateIsSameLength(quantityPaths, units)
+ validateIsString(units, nullAllowed = TRUE)
+ }
+
+ task <- .getContainerTask()
+ outputValues <- vector("numeric", length(quantityPaths))
+ for (i in seq_along(quantityPaths)) {
+ path <- enc2utf8(quantityPaths[[i]])
+ value <- rClr::clrCall(task, "GetValueByPath", simulation$ref, path, stopIfNotFound)
+ if (!is.null(units)) {
+ dimension <- rClr::clrCall(
+ task, "DimensionNameByPath",
+ simulation$ref,
+ path,
+ stopIfNotFound
+ )
+ # Dimension ca be be empty if the path was not found
+ if (dimension == "") {
+ next
+ }
+ # If the unit is NULL, the value is assumend to be in base unit and no conversion
+ # in necessary
+ if (!is.null(units[[i]])) {
+ mw <- simulation$molWeightFor(path)
+ value <- toUnit(
+ quantityOrDimension = dimension,
+ values = value,
+ targetUnit = units[[i]],
+ molWeight = mw
+ )
+ }
+ }
+
+ outputValues[[i]] <- value
+ }
+
+ return(outputValues)
+}
+
#' Scale current values of quantities using a factor
#'
#' @param quantities A single or a list of `Quantity`
#'
#' @param factor A numeric value that will be used to scale all quantities
#'
-scaleQuantityValues <- function(quantities, factor) {
+.scaleQuantityValues <- function(quantities, factor) {
quantities <- c(quantities)
# Test for correct inputs
@@ -193,12 +266,12 @@ scaleQuantityValues <- function(quantities, factor) {
#' Retrieves the display path of the quantity defined by path in the simulation
#'
-#' @param paths A single string or array of paths path relative to the `simulation`
-#' @param simulation A imulation used to find the entities
+#' @param paths A single string or array of paths path relative to the `Simulation`
+#' @param simulation A `Simulation` used to find the entities
#'
#' @return a display path for each entry in paths
#'
-getQuantityDisplayPaths <- function(paths, simulation) {
+.getQuantityDisplayPaths <- function(paths, simulation) {
validateIsString(paths)
validateIsOfType(simulation, "Simulation")
displayResolver <- .getNetTask("FullPathDisplayResolver")
@@ -237,3 +310,30 @@ getAllObserverPathsIn <- function(container) {
y = c(getAllParameterPathsIn(container), getAllMoleculePathsIn(container))
))
}
+
+#' Is the value defined by an explicit formula
+#'
+#' @param path Path to the quantity
+#' @param simulation A `Simulation` object that contains the quantity
+#' @param stopIfNotFound Boolean. If `TRUE` (default) and no quantity exists
+#' for the given path, an error is thrown. If `FALSE`, `FALSE` is returned.
+#'
+#' @return `TRUE` if the value is an explicit formula, `FALSE` otherwise.
+#' Also returns `FALSE` if no quantity with the given path is found and
+#' `stopInfNotFound` is set to `FALSE`.
+#' @export
+#'
+#' @examples
+#' simPath <- system.file("extdata", "simple.pkml", package = "ospsuite")
+#' sim <- loadSimulation(simPath)
+#' isExplicitFormulaByPath("Organism|Liver|Volume", sim) # FALSE
+isExplicitFormulaByPath <- function(path, simulation, stopIfNotFound = TRUE) {
+ validateIsString(path, nullAllowed = FALSE)
+ validateIsOfType(simulation, "Simulation")
+
+ task <- .getContainerTask()
+ # Check if the quantity is defined by an explicit formula
+ isFormulaExplicit <- rClr::clrCall(task, "IsExplicitFormulaByPath", simulation$ref, enc2utf8(path), stopIfNotFound)
+
+ return(isFormulaExplicit)
+}
diff --git a/R/utilities-sensitivity-analysis.R b/R/utilities-sensitivity-analysis.R
index dea86d77a..1d0432c97 100644
--- a/R/utilities-sensitivity-analysis.R
+++ b/R/utilities-sensitivity-analysis.R
@@ -49,14 +49,14 @@ runSensitivityAnalysis <- function(sensitivityAnalysis, sensitivityAnalysisRunOp
exportSensitivityAnalysisResultsToCSV <- function(results, filePath) {
validateIsOfType(results, "SensitivityAnalysisResults")
validateIsString(filePath)
- filePath <- expandPath(filePath)
+ filePath <- .expandPath(filePath)
sensitivityAnalysisTask <- .getNetTask("SensitivityAnalysisTask")
rClr::clrCall(sensitivityAnalysisTask, "ExportResultsToCSV", results$ref, results$simulation$ref, filePath)
invisible()
}
#' @inherit exportSensitivityAnalysisResultsToCSV
-saveSensitivityAnalysisResultsToCSV <- function(results, filePath) {
+.saveSensitivityAnalysisResultsToCSV <- function(results, filePath) {
exportSensitivityAnalysisResultsToCSV(results, filePath)
}
@@ -81,7 +81,7 @@ saveSensitivityAnalysisResultsToCSV <- function(results, filePath) {
importSensitivityAnalysisResultsFromCSV <- function(simulation, filePaths) {
validateIsOfType(simulation, "Simulation")
validateIsString(filePaths)
- filePaths <- unlist(lapply(filePaths, function(filePath) expandPath(filePath)))
+ filePaths <- unlist(lapply(filePaths, function(filePath) .expandPath(filePath)))
sensitivityAnalysisTask <- .getNetTask("SensitivityAnalysisTask")
results <- rClr::clrCall(sensitivityAnalysisTask, "ImportResultsFromCSV", simulation$ref, filePaths)
diff --git a/R/utilities-simulation-results.R b/R/utilities-simulation-results.R
index 654d09712..766e3dd73 100644
--- a/R/utilities-simulation-results.R
+++ b/R/utilities-simulation-results.R
@@ -155,14 +155,14 @@ getOutputValues <- function(simulationResults,
exportResultsToCSV <- function(results, filePath) {
validateIsOfType(results, "SimulationResults")
validateIsString(filePath)
- filePath <- expandPath(filePath)
+ filePath <- .expandPath(filePath)
simulationResultsTask <- .getNetTask("SimulationResultsTask")
rClr::clrCall(simulationResultsTask, "ExportResultsToCSV", results$ref, results$simulation$ref, filePath)
invisible()
}
#' @inherit exportResultsToCSV
-saveResultsToCSV <- function(results, filePath) {
+.saveResultsToCSV <- function(results, filePath) {
exportResultsToCSV(results, filePath)
}
@@ -187,7 +187,7 @@ importResultsFromCSV <- function(simulation, filePaths) {
validateIsOfType(simulation, "Simulation")
validateIsString(filePaths)
simulationResultsTask <- .getNetTask("SimulationResultsTask")
- filePaths <- unlist(lapply(filePaths, function(filePath) expandPath(filePath)), use.names = FALSE)
+ filePaths <- unlist(lapply(filePaths, function(filePath) .expandPath(filePath)), use.names = FALSE)
results <- rClr::clrCall(simulationResultsTask, "ImportResultsFromCSV", simulation$ref, filePaths)
SimulationResults$new(results, simulation)
diff --git a/R/utilities-simulation.R b/R/utilities-simulation.R
index fbbc2c216..354ca02f3 100644
--- a/R/utilities-simulation.R
+++ b/R/utilities-simulation.R
@@ -55,7 +55,7 @@ loadSimulation <- function(filePath, loadFromCache = FALSE, addToCache = TRUE, r
simulationPersister <- .getNetTask("SimulationPersister")
# Note: We do not expand the variable filePath here as we want the cache to be created using the path given by the user
- netSim <- rClr::clrCall(simulationPersister, "LoadSimulation", expandPath(filePath), resetIds)
+ netSim <- rClr::clrCall(simulationPersister, "LoadSimulation", .expandPath(filePath), resetIds)
simulation <- Simulation$new(netSim, filePath)
@@ -76,14 +76,19 @@ loadSimulation <- function(filePath, loadFromCache = FALSE, addToCache = TRUE, r
saveSimulation <- function(simulation, filePath) {
validateIsOfType(simulation, "Simulation")
validateIsString(filePath)
- filePath <- expandPath(filePath)
+ filePath <- .expandPath(filePath)
simulationPersister <- .getNetTask("SimulationPersister")
rClr::clrCall(simulationPersister, "SaveSimulation", simulation$ref, filePath)
invisible()
}
-#' @title
-#' Runs one simulation (individual or population) and returns a `SimulationResults` object containing all results of the simulation.
+
+#' @title Run a single simulation
+#'
+#' @details
+#'
+#' Runs one simulation (individual or population) and returns a
+#' `SimulationResults` object containing all results of the simulation.
#'
#' @param simulation One `Simulation` to simulate.
#' @param population Optional instance of a `Population` to use for the simulation. This is only used when simulating one simulation
@@ -124,7 +129,7 @@ runSimulation <- function(simulation, population = NULL, agingData = NULL, simul
#' @title Runs multiple simulations concurrently.
#'
#' @details For multiple simulations, only individual simulations are possible.
-#' For single simulatio, either individual or population simulations can be
+#' For single simulation, either individual or population simulations can be
#' performed.
#'
#' @param simulations One `Simulation` or list of `Simulation` objects
@@ -333,7 +338,10 @@ createSimulationBatch <- function(simulation, parametersOrPaths = NULL, molecule
#' @param silentMode If `TRUE`, no warnings are displayed if a simulation fails.
#' Default is `FALSE`.
#'
-#' @return Nested list of `SimulationResults` objects. The first level of the list are the IDs of the simulations of SimulationBatches, containing a list of `SimulationResults` for each set of parameter/initial values. If a simulation with a parameter/initial values set fails, the result for this run is `NULL`
+#' @return Nested list of `SimulationResults` objects. The first level of the
+#' fist are the IDs of the SimulationBatches, containing a list of
+#' `SimulationResults` for each set of parameter/initial values. If a simulation
+#' with a parameter/initial values set fails, the result for this run is `NULL`
#' @export
#'
#' @examples
@@ -369,35 +377,41 @@ runSimulationBatches <- function(simulationBatches, simulationRunOptions = NULL,
rClr::clrSet(simulationRunner, "SimulationRunOptions", simulationRunOptions$ref)
simulationBatches <- c(simulationBatches)
- # Result Id <-> simulation batch pointer id map to get the correct simulation for the results.
- # Using the Id of the pointer instead of the Id of the simulation as multiple
+ # Result Id <-> simulation batch id map to get the correct simulation for the results.
+ # Using the Id of the batch instead of the Id of the simulation as multiple
# SimulationBatches can be created with the same simulation
# Each SimulationBatchRunValues has its own id, which will be the id of the result
- resultsIdSimulationIdMap <- list()
+ resultsIdSimulationBatchIdMap <- list()
# Map of simulations ids to simulations objects
- simulationIdSimulationMap <- vector("list", length(simulationBatches))
+ simulationBatchIdSimulationMap <- vector("list", length(simulationBatches))
# Iterate through all simulation batches
for (simBatchIndex in seq_along(simulationBatches)) {
simBatch <- simulationBatches[[simBatchIndex]]
- simBatchId <- rClr::clrGet(simBatch$ref, "Id")
- simulationIdSimulationMap[[simBatchIndex]] <- simBatch$simulation
- names(simulationIdSimulationMap)[[simBatchIndex]] <- simBatchId
+ simBatchId <- simBatch$id
+ simulationBatchIdSimulationMap[[simBatchIndex]] <- simBatch$simulation
+ names(simulationBatchIdSimulationMap)[[simBatchIndex]] <- simBatchId
# Ids of the values of the batch
valuesIds <- simBatch$runValuesIds
# All results of this batch have the id of the same simulation
- resultsIdSimulationIdMap[valuesIds] <- simBatchId
+ resultsIdSimulationBatchIdMap[valuesIds] <- simBatchId
# Add the batch to concurrent runner
rClr::clrCall(simulationRunner, "AddSimulationBatch", simBatch$ref)
}
# Run the batch with the ConcurrentSimulationRunner
results <- rClr::clrCall(simulationRunner, "RunConcurrently")
- simulationResults <- .getConcurrentSimulationRunnerResults(results = results, resultsIdSimulationIdMap = resultsIdSimulationIdMap, simulationIdSimulationMap = simulationIdSimulationMap, silentMode = silentMode)
+ simulationResults <- .getConcurrentSimulationRunnerResults(
+ results = results,
+ resultsIdSimulationIdMap = resultsIdSimulationBatchIdMap,
+ simulationIdSimulationMap = simulationBatchIdSimulationMap,
+ silentMode = silentMode
+ )
- # output: list of lists of SimulationResults, one list per SimulationBatch
- output <- lapply(names(simulationIdSimulationMap), function(simId) {
- simulationResults[which(resultsIdSimulationIdMap == simId)]
+ # Returned is a named list of results with names being the IDs of the batches
+ output <- lapply(names(simulationBatchIdSimulationMap), function(simBatchId) {
+ simulationResults[which(resultsIdSimulationBatchIdMap == simBatchId)]
})
+ names(output) <- names(simulationBatchIdSimulationMap)
# Dispose of the runner to release any possible instances still in memory (.NET side)
rClr::clrCall(simulationRunner, "Dispose")
@@ -516,6 +530,19 @@ getAllStateVariablesPaths <- function(simulation) {
return(allQantitiesPaths)
}
+#' Get the paths of all state variable parameters of the simulation
+#'
+#' @param simulation `Simulation` object
+#' @details List of paths of all state variable parameters.
+#'
+#' @return A list of paths
+#' @export
+getAllStateVariableParametersPaths <- function(simulation) {
+ validateIsOfType(simulation, type = "Simulation")
+ allStateVariableParamsPaths <- .getAllEntityPathsIn(container = simulation, entityType = Parameter, method = "AllStateVariableParameterPathsIn")
+ return(allStateVariableParamsPaths)
+}
+
#' Export simulation PKMLs for given `individualIds`. Each pkml file will contain the original simulation updated with parameters of the corresponding individual.
#'
#' @param population A population object typically loaded with `loadPopulation`
@@ -540,7 +567,7 @@ exportIndividualSimulations <- function(population, individualIds, outputFolder,
validateIsOfType(simulation, "Simulation")
validateIsOfType(population, "Population")
individualIds <- c(individualIds)
- outputFolder <- expandPath(outputFolder)
+ outputFolder <- .expandPath(outputFolder)
simuationPaths <- NULL
for (individualId in individualIds) {
@@ -590,3 +617,125 @@ exportIndividualSimulations <- function(population, individualIds, outputFolder,
}
return(simulationResults)
}
+
+
+#' @keywords internal
+#' @noRd
+.addBranch <- function(originalPathString, arrayToGo) {
+ # Function to create a multilayered list called endList with a branched
+ # structure corresponding to the structure of arrayToGo that terminates with a
+ # string called 'path' that is equal to the string originalString
+ if (length(arrayToGo) == 0) {
+ # If arrayToGo is empty, create a terminal list with a string called 'path'
+ # and value equal to originalString
+ endList <- list()
+ endList$path <- originalPathString
+ return(endList)
+ } else {
+ # If arrayToGo is still not empty, remove its leading element and create a
+ # sub-branch list corresponding to the structure of the remaining elements
+ # of arrayToGo
+ newBranch <- list()
+ newBranch[[arrayToGo[1]]] <- .addBranch(originalPathString, tail(arrayToGo, -1))
+
+ return(newBranch)
+ }
+}
+
+#' @keywords internal
+#' @noRd
+.nextStep <- function(listSoFar, originalString, arrayToGo) {
+ # Recursive function that adds a multilayer list to listSoFar that has a
+ # branched structure representing the vector of strings arrayToGo.
+ if (length(arrayToGo) == 0) {
+ # If end of string vector arrayToGo has been reached, create a vector called
+ # 'path' and give it the value 'originalString'.
+ listSoFar$path <- originalString
+ } else {
+ # End of branch has not been reached. If this portion of the string vector
+ # arrayToGo has not been added to listToGo yet, add it using the function
+ # .addBranch
+ if (is.null(listSoFar[[arrayToGo[1]]])) {
+ listSoFar[[arrayToGo[1]]] <- .addBranch(originalString, tail(arrayToGo, -1))
+ }
+ # If this portion of the string vector arrayToGo has already been added to
+ # listSoFar, remove the leading element of arrayToGo and recursively apply
+ # this function using the remaining elements of arrayToGo.
+ else {
+ listSoFar[[arrayToGo[1]]] <- .nextStep(listSoFar[[arrayToGo[1]]], originalString, tail(arrayToGo, -1))
+ }
+ }
+
+ return(listSoFar)
+}
+
+
+#' Get simulation tree
+#'
+#' @description
+#'
+#' Given a simulation file path or an instance of a simulation, traverses the
+#' simulation structure and returns a tree like structure allowing for intuitive
+#' navigation in the simulation tree.
+#
+#' @param simulationOrFilePath Full path of the simulation to load or instance
+#' of a simulation.
+#' @param quantityType A vector of strings that specify the types of the
+#' entities to be included in the tree. The types can be any combination of
+#' "Quantity", "Molecule", "Parameter" and "Observer".
+#'
+#' @return
+#'
+#' A list with a branched structure representing the path tree of entities in
+#' the simulation file that fall under the types specified in `quantityType`. At
+#' the end of each branch is a string called 'path' that is the path of the
+#' quantity represented by the branch.
+#'
+#' @importFrom utils tail
+#' @examples
+#' simPath <- system.file("extdata", "simple.pkml", package = "ospsuite")
+#' sim <- loadSimulation(simPath)
+#'
+#' tree <- getSimulationTree(sim)
+#'
+#' liver_volume_path <- tree$Organism$Liver$Volume$path
+#' @export
+getSimulationTree <- function(simulationOrFilePath, quantityType = "Quantity") {
+ validateIsOfType(simulationOrFilePath, c("Simulation", "character"))
+
+ quantityTypeList <- list(
+ "Quantity" = getAllQuantityPathsIn,
+ "Molecule" = getAllMoleculePathsIn,
+ "Parameter" = getAllParameterPathsIn,
+ "Observer" = getAllObserverPathsIn
+ )
+
+ validateIsIncluded(values = quantityType, parentValues = names(quantityTypeList))
+
+ simulation <- simulationOrFilePath
+ if (isOfType(simulationOrFilePath, "character")) {
+ simulation <- loadSimulation(simulationOrFilePath)
+ }
+
+ # Build a vector, with no duplicated entries, of all paths corresponding to
+ # entities in `simulation` that fall under the types specified in quantityType
+ allPaths <- sapply(quantityType, function(type) {
+ quantityTypeList[[type]](simulation)
+ }) %>%
+ unname() %>%
+ unlist() %>%
+ unique()
+
+ # Initiate list to be returned as a null list.
+ pathEnumList <- list()
+
+ for (path in allPaths) {
+ # Convert the path string to a vector of strings, each representing a branch portion.
+ pathArray <- toPathArray(path)
+
+ # Begin recursive loop to generate branched list.
+ pathEnumList <- .nextStep(pathEnumList, path, pathArray)
+ }
+
+ return(pathEnumList)
+}
diff --git a/R/utilities-units.R b/R/utilities-units.R
index 953912ff0..b9bca8fb8 100644
--- a/R/utilities-units.R
+++ b/R/utilities-units.R
@@ -5,7 +5,7 @@
#' @export
hasDimension <- function(dimension) {
validateIsString(dimension)
- dimensionTask <- getDimensionTask()
+ dimensionTask <- .getDimensionTask()
rClr::clrCall(dimensionTask, "HasDimension", enc2utf8(dimension))
}
@@ -30,7 +30,7 @@ validateDimension <- function(dimension) {
hasUnit <- function(unit, dimension) {
validateIsString(unit)
validateDimension(dimension)
- dimensionTask <- getDimensionTask()
+ dimensionTask <- .getDimensionTask()
rClr::clrCall(dimensionTask, "HasUnit", enc2utf8(dimension), .encodeUnit(unit))
}
@@ -54,7 +54,7 @@ validateUnit <- function(unit, dimension) {
#' @return
#' If validations are successful, `NULL` is returned. Otherwise, error is
#' signaled.
-validateHasUnit <- function(quantity, unit) {
+.validateHasUnit <- function(quantity, unit) {
validateIsOfType(quantity, "Quantity")
validateIsString(unit)
if (quantity$hasUnit(unit)) {
@@ -71,7 +71,7 @@ validateHasUnit <- function(quantity, unit) {
#' @export
getBaseUnit <- function(dimension) {
validateDimension(dimension)
- dimensionTask <- getDimensionTask()
+ dimensionTask <- .getDimensionTask()
rClr::clrCall(dimensionTask, "BaseUnitFor", enc2utf8(dimension))
}
@@ -267,7 +267,7 @@ allAvailableDimensions <- function() {
getDimensionForUnit <- function(unit) {
validateIsString(unit)
unit <- .encodeUnit(unit)
- dimensionTask <- getDimensionTask()
+ dimensionTask <- .getDimensionTask()
dim <- rClr::clrCall(dimensionTask, "DimensionForUnit", unit)
ifNotNull(dim, rClr::clrGet(dim, "Name"))
}
@@ -286,7 +286,7 @@ getDimensionForUnit <- function(unit) {
#' @export
getUnitsForDimension <- function(dimension) {
validateIsString(dimension)
- dimensionTask <- getDimensionTask()
+ dimensionTask <- .getDimensionTask()
rClr::clrCall(dimensionTask, "AllAvailableUnitNamesFor", enc2utf8(dimension))
}
@@ -294,7 +294,7 @@ getUnitsForDimension <- function(dimension) {
#' This is purely for optimization purposes
#'
#' @return An instance of the Task
-getDimensionTask <- function() {
+.getDimensionTask <- function() {
dimensionTask <- ospsuiteEnv$dimensionTask
if (is.null(dimensionTask)) {
dimensionTask <- .getNetTask("DimensionTask")
@@ -318,7 +318,7 @@ getDimensionTask <- function() {
#' @export
getDimensionByName <- function(name) {
validateIsString(name)
- dimensionTask <- getDimensionTask()
+ dimensionTask <- .getDimensionTask()
rClr::clrCall(dimensionTask, "DimensionByName", enc2utf8(name))
}
@@ -334,9 +334,9 @@ getDimensionByName <- function(name) {
#'
#' @examples
#'
-#' ospsuite:::getUnitsEnum()
+#' ospsuite:::.getUnitsEnum()
#' @keywords internal
-getUnitsEnum <- function() {
+.getUnitsEnum <- function() {
dimensions <- allAvailableDimensions()
errors <- c()
units <- lapply(dimensions, function(dimension) {
@@ -373,9 +373,9 @@ getUnitsEnum <- function() {
#'
#' @examples
#'
-#' ospsuite:::getDimensionsEnum()
+#' ospsuite:::.getDimensionsEnum()
#' @keywords internal
-getDimensionsEnum <- function() {
+.getDimensionsEnum <- function() {
enum(allAvailableDimensions())
}
@@ -393,40 +393,17 @@ ospDimensions <- list()
#' @export
ospUnits <- list()
-initializeDimensionAndUnitLists <- function() {
+.initializeDimensionAndUnitLists <- function() {
# This initializes the two lists in the parent environment which is the package environments
- ospDimensions <<- getDimensionsEnum()
- ospUnits <<- getUnitsEnum()
+ ospDimensions <<- .getDimensionsEnum()
+ ospUnits <<- .getUnitsEnum()
}
-#' Convert data frame to common units
-#'
-#' @description
-#'
-#' When multiple (observed and/or simulated) datasets are present in a data
-#' frame, they are likely to have different units. This function helps to
-#' convert them to a common unit specified by the user.
-#'
-#' This is especially helpful while plotting since the quantities from different
-#' datasets to be plotted on the X-and Y-axis need to have same units to be
-#' meaningfully compared.
-#'
-#' @note
-#'
-#' Molecular weight is **required** for the conversion between certain
-#' dimensions (`Amount`, `Mass`, `Concentration (molar)`, and `Concentration
-#' (mass)`). Therefore, if molecular weight is missing for these dimension, the
-#' unit conversion will fail.
-#'
-#' @return A data frame with measurement columns transformed to have common units.
+#' Convert a data frame to common units
#'
#' @param data A data frame (or a tibble) from `DataCombined$toDataFrame()`.
-#' @param xUnit,yUnit Target units for `xValues` and `yValues`, respectively. If
-#' not specified (`NULL`), first of the existing units in the respective
-#' columns (`xUnit` and `yUnit`) will be selected as the common unit. For
-#' available dimensions and units, see `ospsuite::ospDimensions` and
-#' `ospsuite::ospUnits`, respectively.
+#' @inheritParams convertUnits
#'
#' @seealso toUnit
#'
@@ -455,10 +432,21 @@ initializeDimensionAndUnitLists <- function() {
#' ospsuite:::.unitConverter(df, xUnit = ospUnits$Time$s, yUnit = ospUnits$Amount$mmol)
#' @keywords internal
.unitConverter <- function(data, xUnit = NULL, yUnit = NULL) {
-
# No validation of inputs for this non-exported function.
# All validation will take place in the `DataCombined` class itself.
+ # early return --------------------------
+
+ # Return early if there are only unique units present in the provided data and
+ # `xUnit` and `yUnit` arguments are `NULL`. This helps avoid expensive and
+ # redundant computations.
+ #
+ # *DO NOT* use short-circuiting `&&` logical operator here.
+ if (length(unique(data$xUnit)) == 1L & is.null(xUnit) &
+ length(unique(data$yUnit)) == 1L & is.null(yUnit)) {
+ return(data)
+ }
+
# target units --------------------------
# The observed and simulated data should have the same units for
@@ -499,8 +487,8 @@ initializeDimensionAndUnitLists <- function() {
#
# If there is no `yErrorValues` column in the entered data frame, it doesn't
# make sense for this function to introduce a new column called `yErrorUnit`.
- if (("yErrorValues" %in% names(data)) &&
- !("yErrorUnit" %in% names(data))) {
+ if (("yErrorValues" %in% colnames(data)) &&
+ !("yErrorUnit" %in% colnames(data))) {
data <- dplyr::mutate(data, yErrorUnit = yUnit)
}
@@ -558,13 +546,20 @@ initializeDimensionAndUnitLists <- function() {
)
# yUnit error
- if ("yErrorValues" %in% names(data)) {
+ if ("yErrorValues" %in% colnames(data)) {
yErrorDataList <- .removeEmptyDataFrame(split(data, list(data$yErrorUnitSplit, data$molWeightSplit)))
data <- purrr::map_dfr(
.x = yErrorDataList,
.f = function(data) .yErrorUnitConverter(data, yTargetUnit)
)
+ } else {
+ # For some reason, if the user dataset doesn't have error values, but
+ # still have columns about error units, update them as well. The quantity
+ # and its error should always have the same unit in the final data frame.
+ if ("yErrorUnit" %in% colnames(data)) {
+ data <- dplyr::mutate(data, yErrorUnit = yUnit)
+ }
}
# clean up and return --------------------------
@@ -625,6 +620,17 @@ initializeDimensionAndUnitLists <- function() {
molWeightUnit = ospUnits$`Molecular weight`$`g/mol`
)
+ if ("lloq" %in% colnames(yData)) {
+ yData$lloq <- toUnit(
+ quantityOrDimension = yData$yDimension[[1]],
+ values = yData$lloq,
+ targetUnit = yTargetUnit,
+ sourceUnit = yData$yUnit[[1]],
+ molWeight = yData$molWeight[[1]],
+ molWeightUnit = ospUnits$`Molecular weight`$`g/mol`
+ )
+ }
+
yData$yUnit <- yTargetUnit
return(yData)
@@ -633,6 +639,14 @@ initializeDimensionAndUnitLists <- function() {
#' @keywords internal
#' @noRd
.yErrorUnitConverter <- function(yData, yTargetUnit) {
+ # If error type is geometric, conversion of `yValues` to different units
+ # should not trigger conversion of error values (and units)
+ if ("yErrorType" %in% colnames(yData) &&
+ !is.na(unique(yData$yErrorType)) &&
+ unique(yData$yErrorType) == DataErrorType$GeometricStdDev) {
+ return(yData)
+ }
+
yData$yErrorValues <- toUnit(
quantityOrDimension = yData$yDimension[[1]],
values = yData$yErrorValues,
@@ -686,14 +700,15 @@ initializeDimensionAndUnitLists <- function() {
mostFrequentUnit <- unitUsageFrequency %>%
# Select only the row(s) with maximum frequency.
- dplyr::filter(unitFrequency == max(unitFrequency)) %>%
- # In case of ties, there will be more than one row. In such cases, the first
- # unit is selected.
+ #
+ # In case of ties, there can be more than one row. In such cases, setting
+ # `with_ties = FALSE` make sure that only the first row (and the
+ # corresponding) unit will be selected.
#
# Do *not* select randomly as that would introduce randomness in plotting
# functions with each run of the plotting function defaulting to a different
# unit.
- dplyr::slice_head(n = 1L) %>%
+ dplyr::slice_max(unitFrequency, n = 1L, with_ties = FALSE) %>%
# Remove the frequency column, which is not useful outside the context of
# this function.
dplyr::select(-unitFrequency)
diff --git a/R/zzz.R b/R/zzz.R
index 80bfa9cd6..35f537b47 100644
--- a/R/zzz.R
+++ b/R/zzz.R
@@ -1,6 +1,5 @@
# nocov start
.onLoad <- function(...) {
-
# Only for x64 bits packages.
# This is required to avoid error when package is being checked on CI for x86
is64 <- (.Machine$sizeof.pointer == 8)
@@ -8,6 +7,12 @@
return()
}
- initPackage()
+ # Now verify that the package is running on R 64
+ isR64 <- R.version$arch == "x86_64"
+ if (!isR64) {
+ stop("64 bit version of R is required.")
+ }
+
+ .initPackage()
}
# nocov end
diff --git a/README.md b/README.md
index 5c1fd7aec..7cdbd85f8 100644
--- a/README.md
+++ b/README.md
@@ -1,136 +1,207 @@
-# OSPSuite-R
-
-
-
-[![AppVeyor build status](https://ci.appveyor.com/api/projects/status/github/Open-Systems-Pharmacology/OSPSuite-R?branch=develop&svg=true)](https://ci.appveyor.com/project/open-systems-pharmacology-ci/ospsuite-r)
-[![codecov](https://codecov.io/gh/Open-Systems-Pharmacology/OSPSuite-R/branch/develop/graph/badge.svg)](https://codecov.io/gh/Open-Systems-Pharmacology/OSPSuite-R)
-
-
-
-# Overview
-
-The **ospsuite-R** package provides the functionality of loading, manipulating, and simulating the simulations created in the Open Systems Pharmacology Software tools PK-Sim and MoBi.
-
-- [Documentation](#documentation)
-- [Installation](#installation)
-- [Usage](#usage)
-- [Known issues](#known-issues)
-- [Code of conduct](#code-of-conduct)
-- [Contribution](#contribution)
-- [Licence](#licence)
-
-# Documentation
-
-Please refer to the [online documentation](https://www.open-systems-pharmacology.org/OSPSuite-R/) for more details on the package
-
-# Installation
-
-The **ospsuite-R** package is compatible with version 3.6.x **AND** version 4.x.x of R. One of its dependency, **rClr** needs to be installed specifically for the targeted R version. Please follow the installation instructions below.
-
-**ospsuite** requires following packages to be installed:
-
-From CRAN:
-- [R6](https://github.com/r-lib/R6)
-- [stringr](https://cran.r-project.org/web/packages/stringr/)
-- [readr](https://cran.r-project.org/web/packages/readr/index.html)
-
-Must be downloaded manually:
-- rClr
- - [For R 4.x.x](https://github.com/Open-Systems-Pharmacology/rClr/releases/download/v0.9.1/rClr_0.9.1.zip)
- - [For R 3.6.x](https://github.com/Open-Systems-Pharmacology/rClr/releases/download/v0.9.1-R3/rClr_0.9.1.zip)
-
-
-
-## Under Windows
-
-The release version of the package comes as a binary *.zip and can be downloaded from [here](https://github.com/Open-Systems-Pharmacology/OSPSuite-R/releases).
-
-The package also requires the Visual C++ Runtime that is installed with OSPS and can be manually downloaded [here](https://aka.ms/vs/16/release/vc_redist.x64.exe).
-
-```r
-# Install dependencies
-install.packages('R6')
-
-# Install rClr from local file
-install.packages(pathTorCLR.zip, repos = NULL)
-
-# Install ospsuite-r from local file
-install.packages(pathToOSPSuite.zip, repos = NULL)
-```
-
-## Under Linux
-
-The **ospsuite** package has been tested under Linux distributions CentOS 7 and Ubuntu 18. Some functionality, such as creating individuals, is not available under Linux. Installation under Linux requires several prerequisites, the detailed instructions can be found in the [Wiki](https://github.com/Open-Systems-Pharmacology/OSPSuite-R/wiki/Setup-ospsuite-R-on-Ubuntu).
-For other Linux distributions Docker containers can be used (Dockerfiles based on CentOS 7 and Ubuntu 18 are available under https://github.com/Open-Systems-Pharmacology/OSPSuite-R/releases )
-
-## Build from source
-
-You can clone the GIT repository and build the package from source.
-
-### How to update dependencies from nuget?
-
-- `git submodule update --init --recursive` to install all submodules
-- Make sure you have [ruby](https://www.ruby-lang.org/de/downloads/) install and that it is available in your path
-- Run `rake postclean` or simply double click on `postclean.bat`. This will update all nuget packages and copy the dependencies in the package `inst/lib` folder.
-
-# Usage
-
-In general, every workflow starts with loading a simulation that has been exported to the `*.pkml` format. The method `loadSimulation()` returns the corresponding simulation that is used as input of other methods. The user can then change values of parameters and initial conditions, run the simulation, and retrieve the simulated results.
-
-```r
-library(ospsuite)
-
-# Load a simulation
-simFilePath <- system.file("extdata", "Aciclovir.pkml", package = "ospsuite")
-sim <- loadSimulation(simFilePath)
-
-# Get the parameter "Dose"
-doseParamPath <- "Applications|IV 250mg 10min|Application_1|ProtocolSchemaItem|Dose"
-doseParam <- getParameter(doseParamPath, sim)
-
-# Change the dose to 350mg. The values has to be converted to base unit, first
-newValue <- toBaseUnit(quantity = doseParam, values = 350, unit = "mg")
-setParameterValues(parameters = doseParam, values = newValue)
-
-# Simulate
-simResults <- runSimulation(simulation = sim)
-# Retrieve the results
-simulatedValues <- getOutputValues(simulationResults = simResults)
-
-# Plot time-concentration profile
-plot(simulatedValues$data$Time, simulatedValues$data$`Organism|PeripheralVenousBlood|Aciclovir|Plasma (Peripheral Venous Blood)`,
-type = "l",
-xlab = "Time [min]",
-ylab = "Concentration [µmol/l]")
-```
-
-More detailed description of the methods and the typical workflows can be found in the vignettes. You can see the list of all vignettes available for **ospsuite** by calling
-
-```r
-vignette(package = "ospsuite")
-```
-
-To open a specific vignette, call
-
-```r
-# Insert the name of the vignette you want to view as the argument
-vignette("introduction-ospsuite")
-```
-
-# Known issues
-
-**RStudio crashes when trying to load a workspace.** The ospsuite package uses the features implemented in PK-Sim and MoBi by creating .NET objects (e.g. a simulation) and using them from R. These objects cannot be saved as part of the workspace and reloaded on next start. When trying to do so, RStudio simply crashes. There is no possibility to overcome this limitation. To prevent RStudio from crashing, make sure to disable the check-box "Restore .RData into workspace at startup" in the options of RStudio. Keep in mind that you can also change this setting for specific projects.
-
-# Code of conduct
-
-Everyone interacting in the Open Systems Pharmacology community (codebases, issue trackers, chat rooms, mailing lists etc...) is expected to follow the Open Systems Pharmacology [code of conduct](https://github.com/Open-Systems-Pharmacology/Suite/blob/master/CODE_OF_CONDUCT.md).
-
-# Contribution
-
-We encourage contribution to the Open Systems Pharmacology community. Before getting started please read the [contribution guidelines](https://github.com/Open-Systems-Pharmacology/Suite/blob/master/CONTRIBUTING.md). If you are contributing code, please be familiar with the [coding standards](https://github.com/Open-Systems-Pharmacology/Suite/blob/master/CODING_STANDARDS_R.md).
-
-# License
-
-OSPSuite-R is released under the [GPLv2 License](LICENSE).
-
-All trademarks within this document belong to their legitimate owners.
+# OSPSuite-R
+
+
+
+
+
+
+
+
+
+
+# Overview
+
+The **ospsuite-R** package provides the functionality of loading, manipulating, and simulating the simulations created in the Open Systems Pharmacology Software tools PK-Sim and MoBi.
+
+- [Documentation](#documentation)
+- [Installation](#installation)
+- [Usage](#usage)
+- [Known issues](#known-issues)
+- [Code of conduct](#code-of-conduct)
+- [Contribution](#contribution)
+- [Licence](#licence)
+
+# Documentation
+
+If you are reading this on GitHub README, please refer to the [online documentation](https://www.open-systems-pharmacology.org/OSPSuite-R/) for more details on the package.
+
+In particular, we would recommend that you read the articles in the following order:
+
+* [Get Started](https://www.open-systems-pharmacology.org/OSPSuite-R/articles/ospsuite.html)
+* [Loading a simulation and accessing entities](https://www.open-systems-pharmacology.org/OSPSuite-R/articles/load-get.html)
+* [Changing parameter and molecule start values](https://www.open-systems-pharmacology.org/OSPSuite-R/articles/set-values.html)
+* [Running a simulation](https://www.open-systems-pharmacology.org/OSPSuite-R/articles/run-simulation.html)
+* [Efficient calculations](https://www.open-systems-pharmacology.org/OSPSuite-R/articles/efficient-calculations.html)
+* [Creating individuals](https://www.open-systems-pharmacology.org/OSPSuite-R/articles/create-individual.html)
+* [Population simulations](https://www.open-systems-pharmacology.org/OSPSuite-R/articles/create-run-population.html)
+* [PK Analysis](https://www.open-systems-pharmacology.org/OSPSuite-R/articles/pk-analysis.html)
+* [Sensitivity analysis](https://www.open-systems-pharmacology.org/OSPSuite-R/articles/sensitivity-analysis.html)
+* [Table parameters](https://www.open-systems-pharmacology.org/OSPSuite-R/articles/table-parameters.html)
+* [Dimensions and Units](https://www.open-systems-pharmacology.org/OSPSuite-R/articles/unit-conversion.html)
+* [Working with data sets and import from excel](https://www.open-systems-pharmacology.org/OSPSuite-R/articles/observed-data.html)
+* [Working with `DataCombined` class](https://www.open-systems-pharmacology.org/OSPSuite-R/articles/data-combined.html)
+* [Visualizations with `DataCombined`](https://www.open-systems-pharmacology.org/OSPSuite-R/articles/data-combined-plotting.html)
+
+# Installation
+
+The **ospsuite-R** package is compatible with version 3.6.x **AND** version 4.x.x of R. One of its dependency, **rClr** needs to be installed specifically for the targeted R version. Please follow the installation instructions below.
+
+**ospsuite** requires following packages to be installed:
+
+From CRAN:
+
+- [dplyr](https://cran.r-project.org/web/packages/dplyr/index.html)
+- [purrr](https://cran.r-project.org/web/packages/purrr/index.html)
+- [R6](https://cran.r-project.org/web/packages/R6/index.html)
+- [readr](https://cran.r-project.org/web/packages/readr/index.html)
+- [stringr](https://cran.r-project.org/web/packages/stringr/index.html)
+- [tidyr](https://cran.r-project.org/web/packages/tidyr/index.html)
+- [ggplot2](https://cran.r-project.org/web/packages/ggplot2/index.html)
+- [rlang](https://cran.r-project.org/web/packages/rlang/index.html)
+- [jsonlite](https://cran.r-project.org/web/packages/jsonlite/index.html)
+- [patchwork](https://cran.r-project.org/web/packages/patchwork/index.html)
+- [cowplot](https://cran.r-project.org/web/packages/cowplot/index.html)
+- [scales](https://cran.r-project.org/web/packages/scales/index.html)
+
+
+Must be downloaded manually:
+
+- rClr
+ - [For R 4.x.x](https://github.com/Open-Systems-Pharmacology/rClr/releases/download/v0.9.2/rClr_0.9.2.zip)
+ - [For R 3.6.x](https://github.com/Open-Systems-Pharmacology/rClr/releases/download/v0.9.1-R3/rClr_0.9.1.zip)
+
+- [ospsuite.utils](https://github.com/Open-Systems-Pharmacology/OSPSuite.RUtils/releases/latest)
+
+- [tlf](https://github.com/Open-Systems-Pharmacology/TLF-Library/releases/latest)
+
+
+## Under Windows
+
+The release version of the package comes as a binary `*.zip` and can be downloaded from [here](https://github.com/Open-Systems-Pharmacology/OSPSuite-R/releases).
+
+If you use [RStudio IDE](https://www.rstudio.com/), you can use the *Install* option in the *Packages* pane and select the option *Install from -> Package Archive File* to install a package from binary `*.zip` files.
+
+To install manually, follow these instructions:
+
+```r
+# Install dependencies (e.g. R6) which are on CRAN
+install.packages('R6')
+
+# Install `{rClr}` from local file
+# (`pathTo_rCLR.zip` here should be replaced with the actual path to the `.zip` file)
+install.packages(pathTo_rCLR.zip, repos = NULL)
+
+# Install `{ospsuite.utils}` from local file
+# (`pathTo_ospsuite.utils.zip` here should be replaced with the actual path to the `.zip` file)
+install.packages(pathTo_ospsuite.utils.zip, repos = NULL)
+
+# Install `{tlf}` from local file
+# (`pathTo_tlf.zip` here should be replaced with the actual path to the `.zip` file)
+install.packages(pathTo_tlf.zip, repos = NULL)
+
+# Install `{ospsuite}` from local file
+# (`pathToOSPSuite.zip` here should be replaced with the actual path to the `.zip` file)
+install.packages(pathToOSPSuite.zip, repos = NULL)
+```
+
+The package also requires the Visual C++ Runtime that is installed with OSPS and can be manually downloaded [here](https://aka.ms/vs/16/release/vc_redist.x64.exe).
+
+## Under Linux
+
+The **ospsuite** package has been tested under Linux distributions CentOS 7 and Ubuntu 18. Some functionality, such as creating individuals, is not available under Linux. Installation under Linux requires several prerequisites, the detailed instructions can be found in the [Wiki](https://github.com/Open-Systems-Pharmacology/OSPSuite-R/wiki/Setup-ospsuite-R-on-Ubuntu).
+For other Linux distributions Docker containers can be used (Dockerfiles based on CentOS 7 and Ubuntu 18 are available under https://github.com/Open-Systems-Pharmacology/OSPSuite-R/releases )
+
+## Build from source
+
+You can clone the GIT repository and build the package from source.
+
+### How to update dependencies from nuget?
+
+- `git submodule update --init --recursive` to install all submodules
+- Make sure you have [ruby](https://www.ruby-lang.org/de/downloads/) install and that it is available in your path
+- Run `rake postclean` or simply double click on `postclean.bat`. This will update all nuget packages and copy the dependencies in the package `inst/lib` folder.
+
+# Usage
+
+In general, every workflow starts with loading a simulation that has been exported to the `*.pkml` format. The method `loadSimulation()` returns the corresponding simulation that is used as input of other methods. The user can then change values of parameters and initial conditions, run the simulation, and retrieve the simulated results.
+
+```r
+library(ospsuite)
+
+# Load a simulation
+simFilePath <- system.file("extdata", "Aciclovir.pkml", package = "ospsuite")
+sim <- loadSimulation(simFilePath)
+
+# Get the parameter "Dose"
+doseParamPath <- "Applications|IV 250mg 10min|Application_1|ProtocolSchemaItem|Dose"
+doseParam <- getParameter(doseParamPath, sim)
+
+# Change the dose to 350mg. The values has to be converted to base unit, first
+newValue <- toBaseUnit(quantity = doseParam, values = 350, unit = "mg")
+setParameterValues(parameters = doseParam, values = newValue)
+
+# Simulate
+simResults <- runSimulation(simulation = sim)
+# Retrieve the results
+simulatedValues <- getOutputValues(simulationResults = simResults)
+
+# Plot time-concentration profile
+plot(simulatedValues$data$Time, simulatedValues$data$`Organism|PeripheralVenousBlood|Aciclovir|Plasma (Peripheral Venous Blood)`,
+type = "l",
+xlab = "Time [min]",
+ylab = "Concentration [µmol/l]")
+```
+
+More detailed description of the methods and the typical workflows can be found in the vignettes. You can see the list of all vignettes available for **ospsuite** by calling-
+
+```r
+vignette(package = "ospsuite")
+```
+
+To open a specific vignette, call-
+
+```r
+# Insert the name of the vignette you want to view as the argument
+vignette("introduction-ospsuite")
+```
+
+# Known issues
+
+
+- Loading `ospsuite` might fail if your systems locale is not set to *English*, e.g.:
+
+```ibrary(ospsuite)
+载入需要的程辑包:rClr
+Loading the dynamic library for Microsoft .NET runtime...
+Loaded Common Language Runtime version 4.0.30319.42000
+
+Error: package or namespace load failed for ‘ospsuite’:
+loadNamespace()里算'ospsuite'时.onLoad失败了,详细内容:
+调用: rClr::clrCall(dimensionTask, "AllAvailableUnitNamesFor", enc2utf8(dimension))
+错误: Type: System.Collections.Generic.KeyNotFoundException
+Message: Dimension 'CV mmHg*s虏/ml' not available in DimensionFactory.
+...
+```
+
+-- On Windows, set `Settings > Language > Administrative language settings > Current language for non-Unicode programs`
+to `English (United States)` and reboot.
+-- On Linux, set the environment variable `LC_ALL` before starting R:
+```
+export LC_ALL=en_US.UTF-8
+```
+
+- **RStudio crashes when trying to load a workspace.** The ospsuite package uses the features implemented in PK-Sim and MoBi by creating `.NET` objects (e.g. a simulation) and using them from R. These objects cannot be saved as part of the workspace and reloaded on next start. When trying to do so, RStudio simply crashes. There is no possibility to overcome this limitation. To prevent RStudio from crashing, make sure to disable the check-box "Restore `.RData` into workspace at startup" in the options of RStudio. Keep in mind that you can also change this setting for specific projects.
+
+# Code of Conduct
+
+Everyone interacting in the Open Systems Pharmacology community (codebases, issue trackers, chat rooms, mailing lists etc.) is expected to follow the Open Systems Pharmacology [code of conduct](https://github.com/Open-Systems-Pharmacology/Suite/blob/master/CODE_OF_CONDUCT.md).
+
+# Contribution
+
+We encourage contribution to the Open Systems Pharmacology community. Before getting started please read the [contribution guidelines](https://github.com/Open-Systems-Pharmacology/Suite/blob/master/CONTRIBUTING.md). If you are contributing code, please be familiar with the [coding standards](https://github.com/Open-Systems-Pharmacology/Suite/blob/master/CODING_STANDARDS_R.md).
+
+# License
+
+OSPSuite-R is released under the [GPLv2 License](LICENSE).
+
+All trademarks within this document belong to their legitimate owners.
diff --git a/_pkgdown.yml b/_pkgdown.yml
index 4f83dc5f3..34dd983d1 100644
--- a/_pkgdown.yml
+++ b/_pkgdown.yml
@@ -3,6 +3,9 @@ url: https://www.open-systems-pharmacology.org/OSPSuite-R/
template:
bootstrap: 5
+development:
+ mode: devel
+
authors:
Indrajeet Patil:
href: https://sites.google.com/site/indrajeetspatilmorality/
@@ -20,6 +23,13 @@ articles:
- sensitivity-analysis
- create-individual
- create-run-population
+ - title: Figure creation
+ navbar: Figure creation
+ desc: How to create standard figures
+ contents:
+ - observed-data
+ - data-combined
+ - data-combined-plotting
- title: Miscellaneous
navbar: Miscellaneous
diff --git a/appveyor-3.6.yml b/appveyor-3.6.yml
index bb49deedf..342b75fdb 100644
--- a/appveyor-3.6.yml
+++ b/appveyor-3.6.yml
@@ -1,10 +1,13 @@
image: Visual Studio 2019
-version: '{build}'
+# uncomment to use global ospsuite version (and comment line underneath)
+# version: '{build}'
+version: '11.1.{build}'
# Download script file from GitHub
init:
- - ps: Update-AppveyorBuild -Version "$($env:ospsuite_version).$($env:appveyor_build_version)"
+# uncomment to use global ospsuite version
+# - ps: Update-AppveyorBuild -Version "$($env:ospsuite_version).$($env:appveyor_build_version)"
- ps: |
$ErrorActionPreference = "Stop"
Invoke-WebRequest http://raw.github.com/krlmlr/r-appveyor/master/scripts/appveyor-tool.ps1 -OutFile "..\appveyor-tool.ps1"
diff --git a/appveyor-nightly.yml b/appveyor-nightly.yml
index 7087fe3cf..49a70fa6d 100644
--- a/appveyor-nightly.yml
+++ b/appveyor-nightly.yml
@@ -1,10 +1,13 @@
image: Visual Studio 2019
-version: '{build}'
+# uncomment to use global ospsuite version (and comment line underneath)
+# version: '{build}'
+version: '11.1.{build}'
# Download script file from GitHub
init:
- - ps: Update-AppveyorBuild -Version "$($env:ospsuite_version).$($env:appveyor_build_version)"
+# uncomment to use global ospsuite version
+# - ps: Update-AppveyorBuild -Version "$($env:ospsuite_version).$($env:appveyor_build_version)"
- ps: |
$ErrorActionPreference = "Stop"
Invoke-WebRequest http://raw.github.com/krlmlr/r-appveyor/master/scripts/appveyor-tool.ps1 -OutFile "..\appveyor-tool.ps1"
@@ -17,12 +20,14 @@ install:
platform: x64
+ #We use this set of variables to bypass issue with PK-Sim build. This should be removed when dealt with
environment:
USE_RTOOLS: true
NOT_CRAN: true
KEEP_VIGNETTES: true
R_ARCH: x64
R_VERSION: 4.1.0
+ R_CHECK_ARGS: --no-multiarch --no-manual --as-cran
COVERALLS_TOKEN:
secure: xIz/WZT0ex3bs/CMBJTzzdXLhl3sqfSqJ3MshlSY03pZKuyYQN7Z1FprVgnlFMUZ
diff --git a/appveyor.yml b/appveyor.yml
index d03acde21..0ba880287 100644
--- a/appveyor.yml
+++ b/appveyor.yml
@@ -1,10 +1,14 @@
image: Visual Studio 2019
-version: '{build}'
+
+# uncomment to use global ospsuite version (and comment line underneath)
+# version: '{build}'
+version: '11.1.{build}'
# Download script file from GitHub
init:
- - ps: Update-AppveyorBuild -Version "$($env:ospsuite_version).$($env:appveyor_build_version)"
+# uncomment to use global ospsuite version
+# - ps: Update-AppveyorBuild -Version "$($env:ospsuite_version).$($env:appveyor_build_version)"
- ps: |
$ErrorActionPreference = "Stop"
Invoke-WebRequest http://raw.github.com/krlmlr/r-appveyor/master/scripts/appveyor-tool.ps1 -OutFile "..\appveyor-tool.ps1"
@@ -19,7 +23,8 @@ environment:
USE_RTOOLS: true
NOT_CRAN: true
KEEP_VIGNETTES: false
- R_BUILD_ARGS: --no-build-vignettes --no-manual"
+ R_BUILD_ARGS: --no-build-vignettes --no-manual
+ R_CHECK_ARGS: --no-multiarch --no-manual --as-cran
R_ARCH: x64
R_VERSION: 4.1.0
#We use this variale to skip some long lasting tests using "skip_on_ci"
@@ -31,7 +36,7 @@ build_script:
- Rscript -e "install.packages('https://github.com/Open-Systems-Pharmacology/rClr/releases/download/v0.9.1/rClr_0.9.1.zip', repos = NULL, type = 'binary')"
- Rscript -e "install.packages('https://ci.appveyor.com/api/projects/open-systems-pharmacology-ci/ospsuite-rutils/artifacts/ospsuite.utils.zip', repos = NULL, type = 'binary')"
- Rscript -e "install.packages('https://ci.appveyor.com/api/projects/open-systems-pharmacology-ci/tlf-library/artifacts/tlf.zip', repos = NULL, type = 'binary')"
- - Rscript -e "install.packages(c('ggplot2', 'patchwork', 'vdiffr'), repos = 'http://cran.us.r-project.org')"
+ - Rscript -e "install.packages(c('ggplot2', 'patchwork', 'vdiffr', 'spelling'), repos = 'http://cran.us.r-project.org')"
test_script:
- travis-tool.sh run_tests
@@ -40,6 +45,9 @@ on_failure:
- 7z a failure.zip *.Rcheck\*
- appveyor PushArtifact failure.zip
+on_success:
+ - Rscript -e "spelling::spell_check_package()"
+
artifacts:
- path: '*.Rcheck\**\*.log'
name: Logs
diff --git a/dimensions b/dimensions
index b5df4d288..a31290e1a 160000
--- a/dimensions
+++ b/dimensions
@@ -1 +1 @@
-Subproject commit b5df4d288df8a05d3255dadb8268793b86aecd4c
+Subproject commit a31290e1a6d49c1f874762e7fec8c909bc230062
diff --git a/docs/404.html b/docs/404.html
index 88b08d41c..e927a1df4 100644
--- a/docs/404.html
+++ b/docs/404.html
@@ -7,8 +7,8 @@