diff --git a/R/error-checks.R b/R/error-checks.R index 8ceb5338..a5dc67bc 100644 --- a/R/error-checks.R +++ b/R/error-checks.R @@ -264,35 +264,6 @@ validateHasReferencePopulation <- function(workflowType, simulationSets) { stop(messages$warningNoReferencePopulation(workflowType)) } -validateSameOutputsBetweenSets <- function(simulationSets) { - pkParametersTableRef <- NULL - for (set in simulationSets) { - pkParametersTable <- getPKParametersInSimulationSet(set) - # In case output or pkParameters are in different orders - pkParametersTable <- pkParametersTable[order(pkParametersTable$path, pkParametersTable$group), c("path", "group")] - - if (is.null(pkParametersTableRef)) { - pkParametersTableRef <- pkParametersTable - next - } - if (all(pkParametersTable$path == pkParametersTableRef$path)) { - pkParametersTableTest <- NULL - for (pkParameterIndex in seq_along(pkParametersTable$group)) { - pkParametersTableTest[pkParameterIndex] <- isIncluded(pkParametersTable$group[pkParameterIndex], pkParametersTableRef$group[pkParameterIndex]) - } - if (all(pkParametersTableTest)) { - pkParametersTableRef <- pkParametersTable - next - } - } - stop(messages$errorNotSameOutputsBetweenSets(sapply( - simulationSets, function(set) { - set$simulationSetName - } - ))) - } -} - #' @title validateNoDuplicate #' @description #' Leverage `ospsuite.utils::validateHasOnlyDistinctValues()` to diff --git a/R/messages.R b/R/messages.R index 750434d2..6b019047 100644 --- a/R/messages.R +++ b/R/messages.R @@ -112,9 +112,6 @@ messages <- list( errorUnitNotFromDimension = function(unit, dimension) { paste0(callingFunction(), "Unit '", paste0(unit, collapse = "', '"), "' is not included in available units for dimension: '", paste0(dimension, collapse = "', '"), "'.") }, - errorNotSameOutputsBetweenSets = function(setNames) { - paste0(callingFunction(), "Simulation sets '", paste0(setNames, collapse = "', '"), "' require same outputs and PK parameters. Verify the outputs and PK parameters of simulation sets using the function: 'getPKParametersInSimulationSet'.") - }, errorHasNoUniqueValues = function(values, variableName = NULL, na.rm = TRUE) { if (na.rm) { values <- values[!is.na(values)] @@ -265,6 +262,33 @@ messages <- list( paste0("'", highlight(ids), "'", collapse = ", ") ) }, + warningPKAnalysesMissingIds = function(ids, setName){ + paste0( + "Missing ", highlight("IndividualIds"), " in PKAnalysis file for simulation set '", + highlight(setName), "': ", + paste0("'", highlight(ids), "'", collapse = ", ") + ) + }, + warningMissingFromReferenceSet = function(path, simulationSetName, pkParameters = NULL){ + if(is.null(pkParameters)){ + return( + paste0( + "Output path '", highlight(path), + "' was NOT defined for reference simulation set '", highlight(simulationSetName), + "'. Ouptut path and its PK Parameters were added to the list of figures to export." + ) + ) + } + return( + paste0( + "The following PK Parameters '", + paste(highlight(pkParameters), collapse = "', '"), + "' were NOT defined for the Ouptut path '", highlight(path), + "' in the reference simulation set '", highlight(simulationSetName), + "'. The PK Parameters were added to the list of figures to export." + ) + ) + }, #----- Info messages ---- runStarting = function(runName, subRun = NULL) { diff --git a/R/utilities-pop-pk-parameters.R b/R/utilities-pop-pk-parameters.R index 46b0feed..6d3b1f8d 100644 --- a/R/utilities-pop-pk-parameters.R +++ b/R/utilities-pop-pk-parameters.R @@ -22,14 +22,9 @@ plotPopulationPKParameters <- function(structureSets, validateIsOfType(c(structureSets), "SimulationStructure") validateIsString(c(xParameters), nullAllowed = TRUE) validateIsOfType(c(yParameters), "Output", nullAllowed = TRUE) - validateSameOutputsBetweenSets( - c(lapply(structureSets, function(set) { - set$simulationSet - })) - ) - - # Use first structure set as reference - yParameters <- yParameters %||% structureSets[[1]]$simulationSet$outputs + + # Use union of outputs from all the structure sets + yParameters <- yParameters %||% getOutputsForPKPlot(structureSets) # Get first simulation, in case mol weight is needed simulation <- loadSimulationWithUpdatedPaths(structureSets[[1]]$simulationSet, loadFromCache = TRUE) simulationSetDescriptor <- structureSets[[1]]$simulationSetDescriptor @@ -164,8 +159,16 @@ plotPopulationPKParameters <- function(structureSets, } # Report tables summarizing the distributions + # Caution: since simulationSetName is a factor, + # Unused levels need to be removed first to prevent errors in tlf::getPKParameterMeasure + allSetNames <-levels(pkParameterData$simulationSetName) + usedSetNames <- unique(as.character(pkParameterData$simulationSetName)) pkParameterTable <- getPKParameterMeasure( - data = pkParameterData, + data = pkParameterData %>% + mutate(simulationSetName = factor( + simulationSetName, + levels = intersect(allSetNames, usedSetNames) + )), dataMapping = pkParametersMapping ) # A different table needs to be created here @@ -210,7 +213,12 @@ plotPopulationPKParameters <- function(structureSets, "median" = pkParameterMetaData$Value ) # Include reference population if defined - if (!isEmpty(referenceSimulationSetName)) { + includeReferenceInRangePlot <- all( + !isEmpty(referenceSimulationSetName), + isIncluded(referenceSimulationSetName, unique(pkParameterData$simulationSetName)), + length(unique(pkParameterData$simulationSetName)) > 1 + ) + if (includeReferenceInRangePlot) { # Get the table for reference population referenceData <- data.frame( x = c(-Inf, Inf), @@ -296,6 +304,16 @@ plotPopulationPKParameters <- function(structureSets, # Regular range plots not associated to workflow type for (simulationSetName in simulationSetNames) { vpcData <- pkParameterData[pkParameterData$simulationSetName %in% simulationSetName, ] + if(nrow(vpcData) == 0){ + logDebug(paste( + "No data found for simulation set", + simulationSetName, + "for parameter", + pkParameter$pkParameter, + "of output", output$displayName + )) + next + } vpcData <- getDemographyAggregatedData( data = vpcData, xParameterName = demographyParameter, @@ -359,7 +377,12 @@ plotPopulationPKParameters <- function(structureSets, #---- Ratio comparisons ----- # Checks ratios of statistics and parameters # Table is output for every workflow except parallel no reference - if (isEmpty(referenceSimulationSetName)) { + noRatio <- any( + isEmpty(referenceSimulationSetName), + !isIncluded(referenceSimulationSetName, unique(pkParameterData$simulationSetName)), + isOfLength(unique(pkParameterData$simulationSetName), 1) + ) + if (noRatio) { next } # Output table of relative change in the respective statistics @@ -778,3 +801,73 @@ getPopulationPKAnalysesFromOutput <- function(data, metaData, output, pkParamete metaData = pkAnalysesFromOutputMetaData )) } + +#' @title getOutputsForPKPlot +#' @description +#' Get the list of outputs and their PK parameters for population PK parameter plot +#' @param structureSets List of `SimulationStructure` objects +#' @return list of `Output` objects +#' @keywords internal +#' @import dplyr +getOutputsForPKPlot <- function(structureSets){ + # Use the first simulation set as reference for PK parameters to plot + # Clone R6 objects to prevent potential issues in other workflow steps + outputsToPlot <- lapply( + structureSets[[1]]$simulationSet$outputs, + function(output){ + output$clone() + }) + for (structureSet in structureSets) { + outputsToAdd <- structureSet$simulationSet$outputs + for(output in outputsToAdd){ + # Check if output path is included in the initial outputs to plot + outputIndex <- head(which(sapply( + outputsToPlot, + function(outputToPlot) { + isIncluded(outputToPlot$path, output$path) + } + )), 1) + if(isEmpty(outputIndex)){ + warning( + messages$warningMissingFromReferenceSet( + path = output$path, + simulationSetName = structureSets[[1]]$simulationSet$simulationSetName + ), + call. = FALSE + ) + outputsToPlot <- c(outputsToPlot, output$clone()) + next + } + # If output path is included, check if PK parameters are the same + pkParametersToPlot <- sapply( + outputsToPlot[[outputIndex]]$pkParameters, + function(pkParameter){ + pkParameter$pkParameter + } + ) + pkParametersToAdd <- sapply( + output$pkParameters, + function(pkParameter){ + pkParameter$pkParameter + } + ) + if(isIncluded(pkParametersToAdd, pkParametersToPlot)){ + next + } + indicesToAdd <- which(!(pkParametersToAdd %in% pkParametersToPlot)) + warning( + messages$warningMissingFromReferenceSet( + path = output$path, + simulationSetName = structureSets[[1]]$simulationSet$simulationSetName, + pkParameters = pkParametersToAdd[indicesToAdd] + ), + call. = FALSE + ) + outputsToPlot[[outputIndex]]$pkParameters <- c( + outputsToPlot[[outputIndex]]$pkParameters, + output$pkParameters[indicesToAdd] + ) + } + } + return(outputsToPlot) +} \ No newline at end of file diff --git a/man/CalculatePKParametersTask.Rd b/man/CalculatePKParametersTask.Rd index 9b5a06a2..4e9d409a 100644 --- a/man/CalculatePKParametersTask.Rd +++ b/man/CalculatePKParametersTask.Rd @@ -8,7 +8,7 @@ R6 class for defining how pk parameters are calculated and save } \keyword{internal} \section{Super classes}{ -\code{ospsuite.reportingengine::Task} -> \code{ospsuite.reportingengine::SimulationTask} -> \code{CalculatePKParametersTask} +\code{\link[ospsuite.reportingengine:Task]{ospsuite.reportingengine::Task}} -> \code{\link[ospsuite.reportingengine:SimulationTask]{ospsuite.reportingengine::SimulationTask}} -> \code{CalculatePKParametersTask} } \section{Public fields}{ \if{html}{\out{