Do not create new quantity objects if utilities-simulation-results if…

R/dot-net-wrapper.R

@@ -59,6 +59,17 @@ DotNetWrapper <- R6::R6Class(
       }
     },
 
+    wrapExtensionMethodCached = function(typename, methodName, propertyName, cachedValue, value) {
+      if (missing(value)) {
+        if (is.null(cachedValue)) {
+          return(rClr::clrCallStatic(typename, methodName, self$ref))
+        }
+        return(cachedValue)
+      } else {
+        private$throwPropertyIsReadonly(propertyName)
+      }
+    },
+
     readOnlyProperty = function(propertyName, value, returnValue) {
       if (missing(value)) {
         returnValue

R/entity.R

@@ -10,12 +10,14 @@ Entity <- R6::R6Class(
   cloneable = FALSE,
   inherit = ObjectBase,
   private = list(
-    .parentContainer = NULL
+    .parentContainer = NULL,
+    .path = NULL
   ),
   active = list(
-    #' @field path The path of the entity in the container hiearchy without the simulation name. (read-only)
+    #' @field path The path of the entity in the container hierarchy without the simulation name. (read-only)
     path = function(value) {
-      private$wrapExtensionMethod(EntityExtensions, "ConsolidatedPath", "path", value)
+      private$.path <- private$wrapExtensionMethodCached(EntityExtensions, "ConsolidatedPath", "path", private$.path, value)
+      return(private$.path)
     },
     #' @field fullPath Same as \code{path}, but with the simulation name. (read-only)
     fullPath = function(value) {

R/formula.R

@@ -11,27 +11,27 @@ Formula <- R6::R6Class(
   active = list(
     #' @field isTable Is this a table formula (Read-Only)
     isTable = function(value) {
-      private$wrapExtensionMethod(FormulaExtensions, "IsTable", 'isTable', value)
+      private$wrapExtensionMethod(FormulaExtensions, "IsTable", "isTable", value)
     },
     #' @field isTableWithOffSet Is this a table formula with Offset (Read-Only)
     isTableWithOffSet = function(value) {
-      private$wrapExtensionMethod(FormulaExtensions, "IsTableWithOffSet", 'isTableWithOffSet', value)
+      private$wrapExtensionMethod(FormulaExtensions, "IsTableWithOffSet", "isTableWithOffSet", value)
     },
     #' @field isTableWithXArgument Is this a table formula with xArgs (typically time, or pH) (Read-Only)
     isTableWithXArgument = function(value) {
-      private$wrapExtensionMethod(FormulaExtensions, "IsTableWithXArgument", 'isTableWithXArgument', value)
+      private$wrapExtensionMethod(FormulaExtensions, "IsTableWithXArgument", "isTableWithXArgument", value)
     },
     #' @field isConstant Is this a constant formula (Read-Only)
     isConstant = function(value) {
-      private$wrapExtensionMethod(FormulaExtensions, "IsConstant", 'isConstant', value)
+      private$wrapExtensionMethod(FormulaExtensions, "IsConstant", "isConstant", value)
     },
     #' @field isExplicit Is this an explicit formula (Read-Only)
     isExplicit = function(value) {
-      private$wrapExtensionMethod(FormulaExtensions, "IsExplicit", 'isExplicit', value)
+      private$wrapExtensionMethod(FormulaExtensions, "IsExplicit", "isExplicit", value)
     },
     #' @field isDistributed Is this a distributed formula (Read-Only)
     isDistributed = function(value) {
-      private$wrapExtensionMethod(FormulaExtensions, "IsDistributed", 'isDistributed', value)
+      private$wrapExtensionMethod(FormulaExtensions, "IsDistributed", "isDistributed", value)
     },
     #' @field dimension The dimension in which the quantity is defined  (Read-Only)
     dimension = function(value) {

R/quantity.R

@@ -17,22 +17,22 @@ Quantity <- R6::R6Class(
     },
     #' @field unit The base unit in which the quantity value is defined (Read-Only)
     unit = function(value) {
-      private$wrapExtensionMethod(WITH_DIMENSION_EXTENSION, "BaseUnitName", "unit", value)
+      private$.unit <- private$wrapExtensionMethodCached(WITH_DIMENSION_EXTENSION, "BaseUnitName", "unit", private$.unit, value)
+      return(private$.unit)
     },
     #' @field displayUnit The unit in which the quantity value is usually displayed (Read-Only)
     displayUnit = function(value) {
       private$wrapExtensionMethod(WITH_DISPLAY_UNIT_EXTENSION, "DisplayUnitName", "displayUnit", value)
     },
     #' @field dimension The dimension in which the quantity is defined  (Read-Only)
     dimension = function(value) {
-      private$wrapExtensionMethod(WITH_DIMENSION_EXTENSION, "DimensionName", "dimension", value)
+      private$.dimension <- private$wrapExtensionMethodCached(WITH_DIMENSION_EXTENSION, "DimensionName", "dimension", private$.dimension, value)
+      return(private$.dimension)
     },
     #' @field  allUnits the list of all supported units (Read-Only)
     allUnits = function(value) {
-      # Optimized implememtation to avoid constant marshalling with .NET. We saved the array of units once the first time it is accessed
-      if (is.null(private$.allUnits)) {
-        private$.allUnits <- private$wrapExtensionMethod(WITH_DIMENSION_EXTENSION, "AllUnitNames", allUnits, value)
-      }
+      # Optimized implementation to avoid constant marshalling with .NET. We saved the array of units once the first time it is accessed
+      private$.allUnits <- private$wrapExtensionMethodCached(WITH_DIMENSION_EXTENSION, "AllUnitNames", "allUnits", private$.allUnits, value)
       return(private$.allUnits)
     },
     #' @field quantityType The type of the quantity (Read-Only)
@@ -71,6 +71,8 @@ Quantity <- R6::R6Class(
   private = list(
     .formula = NULL,
     .allUnits = NULL,
+    .unit = NULL,
+    .dimension = NULL,
     printQuantity = function(valueCaption = "Value") {
       private$printClass()
       private$printLine("Path", self$path)

R/sensitivity-analysis-results.R

@@ -47,9 +47,9 @@ SensitivityAnalysisResults <- R6::R6Class("SensitivityAnalysisResults",
     #' @param totalSensitivityThreshold Threshold used to filter out the most sensitive parameter. A threshold of 0.9 means that only
     #' parameter participating to a total of 90 percent of the sensitivity would be returned. A value of 1 would return the sensitivity for all parameters.
     allPKParameterSensitivitiesFor = function(
-                                                  pkParameterName,
-                                                  outputPath,
-                                                  totalSensitivityThreshold = ospsuiteEnv$sensitivityAnalysisConfig$totalSensitivityThreshold) {
+                                              pkParameterName,
+                                              outputPath,
+                                              totalSensitivityThreshold = ospsuiteEnv$sensitivityAnalysisConfig$totalSensitivityThreshold) {
       validateIsString(pkParameterName)
       validateIsString(outputPath)
       validateIsNumeric(totalSensitivityThreshold)

R/sensitivity-analysis-run-options.R

@@ -14,7 +14,7 @@ SensitivityAnalysisRunOptions <- R6::R6Class(
     #' @param showProgress Should a progress information be displayed. Default value is \code{getOSPSuiteSetting("showProgress")}
     #' @return A new `SensitivityAnalysisRunOptions` object.
     initialize = function(numberOfCores = NULL,
-                              showProgress = NULL) {
+                          showProgress = NULL) {
       ref <- rClr::clrNew("OSPSuite.R.Domain.SensitivityAnalysisRunOptions")
       super$initialize(ref)
 

R/sensitivity-analysis.R

@@ -33,10 +33,10 @@ SensitivityAnalysis <- R6::R6Class(
     #' @param variationRange Variation applied to the parameter (optional, default specified in \code{getOSPSuiteSetting("sensitivityAnalysisConfig")})
     #' @return A new `SensitivityAnalysis` object.
     initialize = function(
-                              simulation,
-                              parameterPaths = NULL,
-                              numberOfSteps = ospsuiteEnv$sensitivityAnalysisConfig$numberOfSteps,
-                              variationRange = ospsuiteEnv$sensitivityAnalysisConfig$variationRange) {
+                          simulation,
+                          parameterPaths = NULL,
+                          numberOfSteps = ospsuiteEnv$sensitivityAnalysisConfig$numberOfSteps,
+                          variationRange = ospsuiteEnv$sensitivityAnalysisConfig$variationRange) {
       validateIsOfType(simulation, Simulation)
       validateIsString(parameterPaths, nullAllowed = TRUE)
       ref <- rClr::clrNew("OSPSuite.R.Domain.SensitivityAnalysis", simulation$ref)

R/simulation-run-options.R

@@ -15,8 +15,8 @@ SimulationRunOptions <- R6::R6Class(
     #' @param showProgress Should a progress information be displayed. Default value is \code{getOSPSuiteSetting("showProgress")}
     #' @return A new `SimulationRunOptions` object.
     initialize = function(numberOfCores = NULL,
-                              checkForNegativeValues = NULL,
-                              showProgress = NULL) {
+                          checkForNegativeValues = NULL,
+                          showProgress = NULL) {
       ref <- rClr::clrNew("OSPSuite.R.Domain.SimulationRunOptions")
       super$initialize(ref)
       self$numberOfCores <- numberOfCores %||% getOSPSuiteSetting("numberOfCores")

R/utilities-pk-analysis.R

@@ -66,18 +66,19 @@ importPKAnalysesFromCSV <- function(filePath, simulation) {
 pkAnalysesAsDataFrame <- function(pkAnalyses) {
   validateIsOfType(pkAnalyses, SimulationPKAnalyses)
   pkParameterResultsFilePath <- tempfile()
-  dataFrame <- tryCatch({
-    exportPKAnalysesToCSV(pkAnalyses, pkParameterResultsFilePath)
-    pkResultsDataFrame <- read.csv(pkParameterResultsFilePath, encoding = "UTF-8", check.names = FALSE)
-    colnames(pkResultsDataFrame) <- c("IndividualId", "QuantityPath", "Parameter", "Value", "Unit")
-    pkResultsDataFrame$QuantityPath <- as.factor(pkResultsDataFrame$QuantityPath)
-    pkResultsDataFrame$Parameter <- as.factor(pkResultsDataFrame$Parameter)
-    pkResultsDataFrame$Unit <- as.factor(pkResultsDataFrame$Unit)
-    return(pkResultsDataFrame)
-  },
-  finally = {
-    file.remove(pkParameterResultsFilePath)
-  }
+  dataFrame <- tryCatch(
+    {
+      exportPKAnalysesToCSV(pkAnalyses, pkParameterResultsFilePath)
+      pkResultsDataFrame <- read.csv(pkParameterResultsFilePath, encoding = "UTF-8", check.names = FALSE)
+      colnames(pkResultsDataFrame) <- c("IndividualId", "QuantityPath", "Parameter", "Value", "Unit")
+      pkResultsDataFrame$QuantityPath <- as.factor(pkResultsDataFrame$QuantityPath)
+      pkResultsDataFrame$Parameter <- as.factor(pkResultsDataFrame$Parameter)
+      pkResultsDataFrame$Unit <- as.factor(pkResultsDataFrame$Unit)
+      return(pkResultsDataFrame)
+    },
+    finally = {
+      file.remove(pkParameterResultsFilePath)
+    }
   )
   return(dataFrame)
 }

R/utilities-simulation-results.R

@@ -34,16 +34,21 @@ getOutputValues <- function(simulationResults,
   quantitiesOrPaths <- quantitiesOrPaths %||% simulationResults$allQuantityPaths
   quantitiesOrPaths <- c(quantitiesOrPaths)
 
-  # If quantities are passed, get their paths.
-  paths <- quantitiesOrPaths
-  if (isOfType(paths, Quantity)) {
-    paths <- unlist(lapply(paths, function(x) x$path))
+  if (length(quantitiesOrPaths) == 0) {
+    return(list(data = NULL, metaData = NULL))
   }
-  paths <- unique(paths)
 
-  if (length(paths) == 0) {
-    return(list(data = NULL, metaData = NULL))
+  # If quantities are passed, get their paths.
+  if (isOfType(quantitiesOrPaths, Quantity)) {
+    quantities <- uniqueEntities(quantitiesOrPaths)
+    paths <- unlist(lapply(quantities, function(x) x$path))
+  } else {
+    paths <- unique(quantitiesOrPaths)
+    quantities <- lapply(paths, function(path) {
+      getQuantity(path, simulationResults$simulation, stopIfNotFound)
+    })
   }
+  names(quantities) <- paths
 
   # If no specific individual ids are passed, iterate through all individuals
   individualIds <- ifNotNull(individualIds, unique(individualIds), simulationResults$allIndividualIds)
@@ -53,13 +58,8 @@ getOutputValues <- function(simulationResults,
   valueLength <- length(timeValues)
   covariateNames <- ifNotNull(population, population$allCovariateNames, NULL)
 
-  values <- list()
-  metaData <- list(
-    Time = list(unit = "min", dimension = "Time")
-  )
-
   individualPropertiesCache <- vector("list", length(individualIds))
-  # create a cache of all indivdual values that are constant independent from the path
+  # create a cache of all individual values that are constant independent from the path
   for (individualIndex in seq_along(individualIds)) {
     individualId <- individualIds[individualIndex]
     individualProperties <- list(IndividualId = rep(individualId, valueLength))
@@ -78,11 +78,17 @@ getOutputValues <- function(simulationResults,
   allIndividualProperties <- do.call(rbind.data.frame, c(individualPropertiesCache, stringsAsFactors = FALSE))
 
 
-  for (path in paths) {
-    quantity <- getQuantity(path, simulationResults$simulation, stopIfNotFound = stopIfNotFound)
-    metaData[[path]] <- list(unit = quantity$unit, dimension = quantity$dimension)
-    values[[path]] <- simulationResults$getValuesByPath(path, individualIds, stopIfNotFound)
-  }
+  values <- lapply(paths, function(path){
+  simulationResults$getValuesByPath(path, individualIds, stopIfNotFound)
+})
+names(values) <- paths
+
+metaData <- lapply(paths, function(path){
+  quantity <- quantities[[path]]
+  list(unit = quantity$unit, dimension = quantity$dimension)
+})
+names(metaData) <- paths
+metaData[["Time"]] <- list(unit = "min", dimension = "Time")
 
   data <- data.frame(allIndividualProperties, values, stringsAsFactors = FALSE, check.names = FALSE)
   return(list(data = data, metaData = metaData))

tests/dev/script.R

@@ -79,10 +79,11 @@ simRunOptions <- SimulationRunOptions$new(numberOfCores = 4, checkForNegativeVal
 populationResults <- importResultsFromCSV(sim, "C:/temp/export/results.csv")
 # populationPkAnalyses <- calculatePKAnalyses(populationResults)
 #
-profvis({
-  outputValues <- getOutputValues(populationResults, population, populationResults$allQuantityPaths)
-},
-prof_output = "C:/temp/export/prof.html"
+profvis(
+  {
+    outputValues <- getOutputValues(populationResults, population, populationResults$allQuantityPaths)
+  },
+  prof_output = "C:/temp/export/prof.html"
 )
 
 outputValues <- getOutputValues(populationResults, population, populationResults$allQuantityPaths, c(1))

tests/testthat/test-create-individual.R

@@ -1,6 +1,6 @@
 context("createIndividual")
 
-#initPKSim("C:/projects/PK-Sim/src/PKSim/bin/Debug/net472")
+# initPKSim("C:/projects/PK-Sim/src/PKSim/bin/Debug/net472")
 
 test_that("It can create a standard dog for a given bodyweight", {
   dog <- createIndividualCharacteristics(

tests/testthat/test-ospsuiteEnv.R

@@ -5,8 +5,10 @@ test_that("It returns a value of a setting", {
 })
 
 test_that("It returns a value of a nested setting", {
-  expect_equal(getOSPSuiteSetting("sensitivityAnalysisConfig")$totalSensitivityThreshold,
-               ospsuiteEnv$sensitivityAnalysisConfig$totalSensitivityThreshold)
+  expect_equal(
+    getOSPSuiteSetting("sensitivityAnalysisConfig")$totalSensitivityThreshold,
+    ospsuiteEnv$sensitivityAnalysisConfig$totalSensitivityThreshold
+  )
 })