diff --git a/NAMESPACE b/NAMESPACE index c32c5da7a..0cb4e1200 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -100,6 +100,7 @@ export(setMoleculeScaleDivisors) export(setOutputInterval) export(setParameterValues) export(setParameterValuesByPath) +export(setQuantityValuesByPath) export(splitPopulationFile) export(toBaseUnit) export(toDisplayUnit) diff --git a/R/error-checks.R b/R/error-checks.R index 402324f00..4af1cc02d 100644 --- a/R/error-checks.R +++ b/R/error-checks.R @@ -138,3 +138,10 @@ validateIsSameLength <- function(...) { stop(messages$errorDifferentLength(arguments)) } + +validatePathIsAbsolute <- function(path) { + wildcardChar <- "*" + if (any(unlist(strsplit(path, ""), use.names = FALSE) == wildcardChar)) { + stop(messages$errorEntityPathNotAbsolute(path)) + } +} diff --git a/R/messages.R b/R/messages.R index ea947f995..27a56ce61 100644 --- a/R/messages.R +++ b/R/messages.R @@ -67,6 +67,13 @@ messages <- list( errorPKParameterNotFound = function(pkParameterName, allPKParameterNames) { paste0("PK-Parameter '", pkParameterName, "' not found.\nAvailable PK-Parameters are:\n", paste0(allPKParameterNames, collapse = ", ")) }, + errorEntityPathNotAbsolute = function(path) { + callingFunction <- .getCallingFunctionName() + paste0( + callingFunction, ": Only absolut paths (i.e. without the wildcard(s) `*`) are allowed, but the given path is: ", + path + ) + }, pkSimRPathInvalid = function(pksimPath) { paste0("Path to PKSim.R.dll '", pksimPath, "' is invalid.") }, diff --git a/R/utilities-output-selections.R b/R/utilities-output-selections.R index 0596ebfa7..54aeb74e7 100644 --- a/R/utilities-output-selections.R +++ b/R/utilities-output-selections.R @@ -4,10 +4,7 @@ #' @param quantitiesOrPaths Quantity instances (element or vector) (typically retrieved using \code{getAllQuantitiesMatching}) or quantity path (element or vector) to add. #' @param simulation Instance of a simulation for which output selection should be updated. #' -#' @return A list of quantities added as output (Especially useful when a wildcard was used to verify) -#' -#' @examples -#' +#' @examples#' #' simPath <- system.file("extdata", "simple.pkml", package = "ospsuite") #' sim <- loadSimulation(simPath) #' @@ -22,20 +19,22 @@ addOutputs <- function(quantitiesOrPaths, simulation) { validateIsOfType(quantitiesOrPaths, c(Quantity, "character")) validateIsOfType(simulation, Simulation) - quantities <- quantitiesOrPaths - if (isOfType(quantitiesOrPaths, "character")) { - quantities <- getAllQuantitiesMatching(quantitiesOrPaths, simulation) + # If quantities are provided, get their paths + paths <- vector("character", length(quantitiesOrPaths)) + if (isOfType(quantitiesOrPaths, Quantity)) { + for (idx in seq_along(quantitiesOrPaths)) { + paths[[idx]] <- quantitiesOrPaths[[idx]]$path + } + } else { + paths <- quantitiesOrPaths } + paths <- unique(paths) - quantities <- uniqueEntities(quantities, compareBy = "path") - outputSelections <- simulation$outputSelections - - for (quantity in quantities) { - outputSelections$addQuantity(quantity) + task <- getContainerTask() + for (path in paths) { + rClr::clrCall(task, "AddQuantitiesToSimulationOutputByPath", simulation$ref, enc2utf8(path)) } - - invisible(quantities) } #' @title Removes all selected output from the given \code{simulation} diff --git a/R/utilities-parameter.R b/R/utilities-parameter.R index d7e2e9de0..460201fa1 100644 --- a/R/utilities-parameter.R +++ b/R/utilities-parameter.R @@ -120,11 +120,9 @@ setParameterValues <- function(parameters, values) { #' setParameterValuesByPath(c("Organism|Liver|Volume", "Organism|Volume"), c(2, 3), sim) #' @export setParameterValuesByPath <- function(parameterPaths, values, simulation) { - validateIsString(parameterPaths) - validateIsNumeric(values) - validateIsOfType(simulation, Simulation) - parameters <- sapply(parameterPaths, function(p) getParameter(p, simulation)) - setParameterValues(parameters, values) + setQuantityValuesByPath( + quantityPaths = parameterPaths, values = values, simulation = simulation + ) } #' Scale current values of parameters using a factor diff --git a/R/utilities-quantity.R b/R/utilities-quantity.R index 172625738..fdbf524b2 100644 --- a/R/utilities-quantity.R +++ b/R/utilities-quantity.R @@ -96,6 +96,36 @@ setQuantityValues <- function(quantities, values) { } } +#' Set the values of parameters in the simulation by path +#' +#' @param quantityPaths A single or a list of absolute quantity path +#' @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. +#' @examples +#' +#' simPath <- system.file("extdata", "simple.pkml", package = "ospsuite") +#' sim <- loadSimulation(simPath) +#' setQuantityValuesByPath("Organism|Liver|Volume", 1, sim) +#' +#' setParameterValuesByPath(list("Organism|Liver|Volume", "Organism|Liver|A"), c(2, 3), sim) +#' @export +setQuantityValuesByPath <- function(quantityPaths, values, simulation) { + validateIsString(quantityPaths) + validateIsNumeric(values) + validateIsSameLength(quantityPaths, values) + validateIsOfType(simulation, Simulation) + + task <- getContainerTask() + for (i in seq_along(quantityPaths)) { + rClr::clrCall( + task, "SetValueByPath", simulation$ref, + enc2utf8(quantityPaths[[i]]), values[[i]] + ) + } +} + #' Scale current values of quantities using a factor #' #' @param quantities A single or a list of \code{Quantity} diff --git a/R/utilities-simulation-results.R b/R/utilities-simulation-results.R index 9f8187284..ab37831c1 100644 --- a/R/utilities-simulation-results.R +++ b/R/utilities-simulation-results.R @@ -18,14 +18,18 @@ #' @param population population used to calculate the simulationResults (optional). This is used only to add the population covariates to the resulting data table. #' #' @param stopIfNotFound Boolean. If TRUE and no result exist for the given path, an error is thrown. Default is \code{TRUE} -#' @param stopIfNotFound If \code{TRUE} (default) an error is thrown if no results exist for any `path` -#' If \code{FALSE}, a list of \code{NA} values is returned for the repsecitve path. +#' @param stopIfNotFound If \code{TRUE} (default) an error is thrown if no results exist for any `path`. If \code{FALSE}, a list of \code{NA} values is returned for the respective path. +#' @param addMetaData If \code{TRUE} (default), the output is a list two sublists `data`and +#' `metaData`, with latter storing information about units and dimensions of the outputs. If \code{FALSE}, \code{metaData} is \code{NULL}. Setting this option to \code{FALSE} might improve +#' the performance of the function. +#' #' @export getOutputValues <- function(simulationResults, quantitiesOrPaths = NULL, population = NULL, individualIds = NULL, - stopIfNotFound = TRUE) { + stopIfNotFound = TRUE, + addMetaData = TRUE) { validateIsOfType(simulationResults, SimulationResults) validateIsOfType(population, Population, nullAllowed = TRUE) validateIsNumeric(individualIds, nullAllowed = TRUE) @@ -38,17 +42,16 @@ getOutputValues <- function(simulationResults, return(list(data = NULL, metaData = NULL)) } - # If quantities are passed, get their paths. + # If quantities are provided, get their paths + paths <- vector("character", length(quantitiesOrPaths)) if (isOfType(quantitiesOrPaths, Quantity)) { - quantities <- uniqueEntities(quantitiesOrPaths) - paths <- unlist(lapply(quantities, function(x) x$path), use.names = FALSE) + for (idx in seq_along(quantitiesOrPaths)) { + paths[[idx]] <- quantitiesOrPaths[[idx]]$path + } } else { - paths <- unique(quantitiesOrPaths) - quantities <- lapply(paths, function(path) { - getQuantity(path, simulationResults$simulation, stopIfNotFound) - }) + paths <- quantitiesOrPaths } - names(quantities) <- paths + paths <- unique(paths) # If no specific individual ids are passed, iterate through all individuals individualIds <- ifNotNull(individualIds, unique(individualIds), simulationResults$allIndividualIds) @@ -77,18 +80,29 @@ getOutputValues <- function(simulationResults, # Cache of all individual properties over all individual that will be duplicated in all resulting data.frame allIndividualProperties <- do.call(rbind.data.frame, c(individualPropertiesCache, stringsAsFactors = FALSE)) - 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") + # Use low-level methods to get unit and dimension + task <- getContainerTask() + metaData <- NULL + if (addMetaData) { + metaData <- lapply(paths, function(path) { + unit <- NULL + dimension <- NULL + # Get the dimension and unit from path if the results are obtained. If the results + # are NA, the entity with such path does not exist + if (!all(is.na(values[[path]]))) { + unit <- rClr::clrCall(task, "BaseUnitNameByPath", simulationResults$simulation$ref, enc2utf8(path)) + dimension <- rClr::clrCall(task, "DimensionNameByPath", simulationResults$simulation$ref, enc2utf8(path)) + } + list(unit = unit, dimension = 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)) diff --git a/R/utilities.R b/R/utilities.R index 0331a16ba..2cbfb8cb7 100644 --- a/R/utilities.R +++ b/R/utilities.R @@ -1,7 +1,7 @@ -#' Transforms a single .NET object or a list of .NET Object to their correpsonding wrapper class in R. +#' Transforms a single .NET object or a list of .NET Object to their corresponding wrapper class in R. #' Note that if the object is a single object, NULL will be returned if the .NET object is null. This allows semantic equivalence between .NET and R #' -#' @param netObject The .NET object instances (single or list) to wrapp +#' @param netObject The .NET object instances (single or list) to wrap #' @param class The class definition that will be used to convert the parameter #' #' @return The wrapped object (single or list) diff --git a/inst/lib/OSPSuite.Assets.dll b/inst/lib/OSPSuite.Assets.dll index eb3fd6e90..97472c4e4 100644 Binary files a/inst/lib/OSPSuite.Assets.dll and b/inst/lib/OSPSuite.Assets.dll differ diff --git a/inst/lib/OSPSuite.Core.dll b/inst/lib/OSPSuite.Core.dll index 0a2a709bb..7dd8e1064 100644 Binary files a/inst/lib/OSPSuite.Core.dll and b/inst/lib/OSPSuite.Core.dll differ diff --git a/inst/lib/OSPSuite.Infrastructure.Autofac.dll b/inst/lib/OSPSuite.Infrastructure.Autofac.dll index 17674312a..5b81087a5 100644 Binary files a/inst/lib/OSPSuite.Infrastructure.Autofac.dll and b/inst/lib/OSPSuite.Infrastructure.Autofac.dll differ diff --git a/inst/lib/OSPSuite.Infrastructure.Import.dll b/inst/lib/OSPSuite.Infrastructure.Import.dll index a392efdf2..bf04221b6 100644 Binary files a/inst/lib/OSPSuite.Infrastructure.Import.dll and b/inst/lib/OSPSuite.Infrastructure.Import.dll differ diff --git a/inst/lib/OSPSuite.Infrastructure.dll b/inst/lib/OSPSuite.Infrastructure.dll index 826a23733..4d7f842a3 100644 Binary files a/inst/lib/OSPSuite.Infrastructure.dll and b/inst/lib/OSPSuite.Infrastructure.dll differ diff --git a/inst/lib/OSPSuite.R.dll b/inst/lib/OSPSuite.R.dll index 0521475bf..28493f56c 100644 Binary files a/inst/lib/OSPSuite.R.dll and b/inst/lib/OSPSuite.R.dll differ diff --git a/man/addOutputs.Rd b/man/addOutputs.Rd index fadbc90d2..8f5209098 100644 --- a/man/addOutputs.Rd +++ b/man/addOutputs.Rd @@ -11,14 +11,11 @@ addOutputs(quantitiesOrPaths, simulation) \item{simulation}{Instance of a simulation for which output selection should be updated.} } -\value{ -A list of quantities added as output (Especially useful when a wildcard was used to verify) -} \description{ Adds the quantities as output into the \code{simulation}. The quantities can either be specified using explicit instances or using paths. } \examples{ - +#' simPath <- system.file("extdata", "simple.pkml", package = "ospsuite") sim <- loadSimulation(simPath) diff --git a/man/getOutputValues.Rd b/man/getOutputValues.Rd index c1f037618..d9157378c 100644 --- a/man/getOutputValues.Rd +++ b/man/getOutputValues.Rd @@ -9,7 +9,8 @@ getOutputValues( quantitiesOrPaths = NULL, population = NULL, individualIds = NULL, - stopIfNotFound = TRUE + stopIfNotFound = TRUE, + addMetaData = TRUE ) } \arguments{ @@ -26,8 +27,11 @@ If quantitiesOrPaths is \code{NULL} (default value), returns the results for all \item{individualIds}{\code{numeric} IDs of individiuals 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 is ignored} -\item{stopIfNotFound}{If \code{TRUE} (default) an error is thrown if no results exist for any \code{path} -If \code{FALSE}, a list of \code{NA} values is returned for the repsecitve path.} +\item{stopIfNotFound}{If \code{TRUE} (default) an error is thrown if no results exist for any \code{path}. If \code{FALSE}, a list of \code{NA} values is returned for the respective path.} + +\item{addMetaData}{If \code{TRUE} (default), the output is a list two sublists \code{data}and +\code{metaData}, with latter storing information about units and dimensions of the outputs. If \code{FALSE}, \code{metaData} is \code{NULL}. Setting this option to \code{FALSE} might improve +the performance of the function.} } \description{ The function receives an object of simulation results generated by running the simulation diff --git a/man/setQuantityValuesByPath.Rd b/man/setQuantityValuesByPath.Rd new file mode 100644 index 000000000..e19dd4011 --- /dev/null +++ b/man/setQuantityValuesByPath.Rd @@ -0,0 +1,28 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utilities-quantity.R +\name{setQuantityValuesByPath} +\alias{setQuantityValuesByPath} +\title{Set the values of parameters in the simulation by path} +\usage{ +setQuantityValuesByPath(quantityPaths, values, simulation) +} +\arguments{ +\item{quantityPaths}{A single or a list of absolute quantity path} + +\item{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'} + +\item{simulation}{Simulation uses to retrieve quantity instances from given paths.} +} +\description{ +Set the values of parameters in the simulation by path +} +\examples{ + +simPath <- system.file("extdata", "simple.pkml", package = "ospsuite") +sim <- loadSimulation(simPath) +setQuantityValuesByPath("Organism|Liver|Volume", 1, sim) + +setParameterValuesByPath(list("Organism|Liver|Volume", "Organism|Liver|A"), c(2, 3), sim) +} diff --git a/man/toObjectType.Rd b/man/toObjectType.Rd index 50d8421a2..ca9aef806 100644 --- a/man/toObjectType.Rd +++ b/man/toObjectType.Rd @@ -2,13 +2,13 @@ % Please edit documentation in R/utilities.R \name{toObjectType} \alias{toObjectType} -\title{Transforms a single .NET object or a list of .NET Object to their correpsonding wrapper class in R. +\title{Transforms a single .NET object or a list of .NET Object to their corresponding wrapper class in R. Note that if the object is a single object, NULL will be returned if the .NET object is null. This allows semantic equivalence between .NET and R} \usage{ toObjectType(netObject, class) } \arguments{ -\item{netObject}{The .NET object instances (single or list) to wrapp} +\item{netObject}{The .NET object instances (single or list) to wrap} \item{class}{The class definition that will be used to convert the parameter} } @@ -16,6 +16,6 @@ toObjectType(netObject, class) The wrapped object (single or list) } \description{ -Transforms a single .NET object or a list of .NET Object to their correpsonding wrapper class in R. +Transforms a single .NET object or a list of .NET Object to their corresponding wrapper class in R. Note that if the object is a single object, NULL will be returned if the .NET object is null. This allows semantic equivalence between .NET and R } diff --git a/packages.config b/packages.config index 517b19fe3..1df1f592a 100644 --- a/packages.config +++ b/packages.config @@ -1,11 +1,11 @@ - - - - - - + + + + + + diff --git a/tests/testthat/test-error-checks.R b/tests/testthat/test-error-checks.R index ce63f9988..81f5d2f6f 100644 --- a/tests/testthat/test-error-checks.R +++ b/tests/testthat/test-error-checks.R @@ -13,7 +13,21 @@ test_that("it can validate that an integer array type is an integer", { expect_true(TRUE) }) -test_that("it throws a vlaidatin error when an object is not an integer", { +test_that("it throws a validation error when an object is not an integer", { expect_that(validateIsInteger(c(1.5, 5)), throws_error()) expect_that(validateIsInteger(2.4), throws_error()) }) + +test_that("It accepts an empty string", { + expect_error(validatePathIsAbsolute(""), NA) +}) + +test_that("It accepts a path without wildcard", { + path <- "Organism|path" + expect_error(validatePathIsAbsolute(path), NA) +}) + +test_that("It throws an error for a path with a wildcard", { + path <- "Organism|*path" + expect_error(validatePathIsAbsolute(path), messages$errorEntityPathNotAbsolute(path)) +}) diff --git a/tests/testthat/test-utilities-output-selections.R b/tests/testthat/test-utilities-output-selections.R index 9b1874c14..c7aeab95e 100644 --- a/tests/testthat/test-utilities-output-selections.R +++ b/tests/testthat/test-utilities-output-selections.R @@ -5,36 +5,32 @@ context("addOutputs") test_that("It can add multiple outputs by path", { outputSelections$clear() - quantities <- addOutputs(c("Organism|Liver|Volume", "Organism|ArterialBlood|Plasma|Caffeine"), sim) - expect_equal(length(quantities), 2) - expect_equal(length(outputSelections$allOutputs), 2) + addOutputs(c("Organism|Liver|Volume", "Organism|ArterialBlood|Plasma|Caffeine"), sim) + expect_equal(length(sim$outputSelections$allOutputs), 2) }) test_that("It can add single output by path", { outputSelections$clear() path <- "Organism|ArterialBlood|Plasma|Caffeine" - quantities <- addOutputs(path, sim) - expect_equal(length(quantities), 1) - expect_equal(length(outputSelections$allOutputs), 1) - expect_equal(outputSelections$allOutputs[[1]]$path, path) + addOutputs(path, sim) + expect_equal(length(sim$outputSelections$allOutputs), 1) + expect_equal(sim$outputSelections$allOutputs[[1]]$path, path) }) test_that("It can add multiple outputs by reference", { outputSelections$clear() parameter <- getParameter("Organism|Liver|Volume", sim) quantity <- getAllQuantitiesMatching("Organism|ArterialBlood|Plasma|Caffeine", sim)[[1]] - quantities <- addOutputs(c(parameter, quantity), sim) - expect_equal(length(quantities), 2) - expect_equal(length(outputSelections$allOutputs), 2) + addOutputs(c(parameter, quantity), sim) + expect_equal(length(sim$outputSelections$allOutputs), 2) }) test_that("It can add single output by reference", { outputSelections$clear() parameter <- getParameter("Organism|Liver|Volume", sim) - quantities <- addOutputs(parameter, sim) - expect_equal(length(quantities), 1) - expect_equal(length(outputSelections$allOutputs), 1) - expect_equal(quantities[[1]], parameter) + addOutputs(parameter, sim) + expect_equal(length(sim$outputSelections$allOutputs), 1) + expect_equal(sim$outputSelections$allOutputs[[1]]$path, parameter$path) }) test_that("It throws an exception if the parameters do not have the expect type", { diff --git a/tests/testthat/test-utilities-quantity.R b/tests/testthat/test-utilities-quantity.R index 7ed458503..fce96bd9f 100644 --- a/tests/testthat/test-utilities-quantity.R +++ b/tests/testthat/test-utilities-quantity.R @@ -1,4 +1,3 @@ - context("getAllQuantitiesMatching") sim <- loadTestSimulation("S1") @@ -46,3 +45,31 @@ test_that("It returns null if the quantity by path does not exist and stopIfNotF test_that("It throws an error when trying to retrieve a quantity by path that would result in multiple quantities", { expect_that(getQuantity(toPathString(c("Organism", "Liver", "*")), sim), throws_error()) }) + + +context("setQuantityValuesByPath") + +test_that("It can set single parameter values", { + sim <- loadTestSimulation("S1", loadFromCache = TRUE) + parameterPath <- "Organism|Liver|Intracellular|Volume" + setQuantityValuesByPath(parameterPath, 100, sim) + parameter <- getParameter(parameterPath, sim) + expect_equal(parameter$value, 100) +}) + +test_that("It can set multiple quantity values", { + sim <- loadTestSimulation("S1", loadFromCache = TRUE) + quantityPath1 <- "Organism|Liver|Intracellular|Volume" + quantityPath2 <- "Organism|VenousBlood|Plasma|CYP3A4" + setQuantityValuesByPath(c(quantityPath1, quantityPath2), c(40, 50), sim) + quantity1 <- getQuantity(quantityPath1, sim) + quantity2 <- getQuantity(quantityPath2, sim) + expect_equal(quantity1$value, 40) + expect_equal(quantity2$value, 50) +}) + +test_that("It throws an exception when setting values for a quantity that does not exist", { + sim <- loadTestSimulation("S1", loadFromCache = TRUE) + parameterPath <- "Organism|Liver|NOPE|Volume" + expect_that(setQuantityValuesByPath(parameterPath, 100, sim), throws_error()) +}) diff --git a/tests/testthat/test-utilities-simulation-results.R b/tests/testthat/test-utilities-simulation-results.R index 3eb90bfc0..4e8e8e21a 100644 --- a/tests/testthat/test-utilities-simulation-results.R +++ b/tests/testthat/test-utilities-simulation-results.R @@ -17,7 +17,7 @@ test_that("It throws an error when no valid simulation results are provided", { }) test_that("It returns an array of NA if specific result is not found and stopIfNotFound = FALSE", { - res <- getOutputValues(individualResults, "NoPath", stopIfNotFound = FALSE) + res <- getOutputValues(simulationResults = individualResults, quantitiesOrPaths = "NoPath", stopIfNotFound = FALSE) data <- res$data expect_equal(length(data), 1 + NUMBER_OF_STATIC_COLUMNS) @@ -47,6 +47,16 @@ test_that("It can retrieve results by quantities", { expect_equal(length(data), length(resultsPaths) + NUMBER_OF_EXTRA_COLUMNS) }) +test_that("It can retrieve correct unit and dimension", { + res <- getOutputValues(populationResults, population = population, getAllQuantitiesMatching(resultsPaths, sim)) + path <- resultsPaths[[1]] + quantity <- getQuantity(path = path, sim) + + metadata <- res$metaData + expect_equal(metadata[[path]]$unit, quantity$unit) + expect_equal(metadata[[path]]$dimension, quantity$dimension) +}) + test_that("It should return a data and meta data data frame per output paths", { path <- resultsPaths[[1]] res <- getOutputValues(populationResults, population = population, path, individualIds = c(0, 1)) @@ -58,6 +68,17 @@ test_that("It should return a data and meta data data frame per output paths", { expect_null(data[[resultsPaths[[2]]]]) }) +test_that("It should return NULL for meta data if addMetaData = FALSE", { + path <- resultsPaths[[1]] + res <- getOutputValues(populationResults, population = population, path, individualIds = c(0, 1), addMetaData = FALSE) + data <- res$data + metaData <- res$metaData + expect_equal(length(data), 1 + NUMBER_OF_EXTRA_COLUMNS) + expect_false(is.null(data)) + expect_null(metaData) + expect_null(data[[resultsPaths[[2]]]]) +}) + test_that("It can retrieve results with provided individual id", { res <- getOutputValues(populationResults, population = population, individualIds = c(1, 3, 5)) data <- res$data