Fixes #1209 allow different outputs for pop PK parameter plots (#1222)

* Fixes #1209 allow different outputs for pop PK parameter plots

* Fix skip logic checking reference set data is present

* Keep reference set as first in the PK parameter summaries

* Add test for different PK parameters and output paths

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

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) {

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)
+}

tests/data/pop-pk-diff/11_pk_parameters_C_max.csv

@@ -0,0 +1,2 @@
+"Population","N","5<sup>th</sup> pctl","25<sup>th</sup> pctl","50<sup>th</sup> pctl","75<sup>th</sup> pctl","95<sup>th</sup> pctl","Mean","SD","Geo Mean","Geo SD"
+"Pediatric",100,1.62024307074021,1.37856550981097,1.40225541303946,1.41401283394198,1.63118301540273,1.5105438452436,1.80346323636488,1.48746137029503,1.03060463296714

tests/data/pop-pk-diff/14_pk_parameters_Thalf.csv

@@ -0,0 +1,2 @@
+"Population","N","5<sup>th</sup> pctl","25<sup>th</sup> pctl","50<sup>th</sup> pctl","75<sup>th</sup> pctl","95<sup>th</sup> pctl","Mean","SD","Geo Mean","Geo SD"
+"Pediatric",100,2.6718474,3.20246725,3.703302,4.33782725,9.45496805,5.0152532,7.16856473488834,4.04297352336446,1.61114262893437

tests/data/pop-pk-diff/18_pk_parameters_AUC_tEnd.csv

@@ -0,0 +1,2 @@
+"Population","N","5<sup>th</sup> pctl","25<sup>th</sup> pctl","50<sup>th</sup> pctl","75<sup>th</sup> pctl","95<sup>th</sup> pctl","Mean","SD","Geo Mean","Geo SD"
+"Pediatric",100,185.691355,223.086375,264.4261,322.711725,398.277415,276.893055,71.1736784654361,268.613582178082,1.27682192538938

tests/data/pop-pk-diff/21_pk_parameters_C_max.csv

@@ -0,0 +1,2 @@
+"Population","N","5<sup>th</sup> pctl","25<sup>th</sup> pctl","50<sup>th</sup> pctl","75<sup>th</sup> pctl","95<sup>th</sup> pctl","Mean","SD","Geo Mean","Geo SD"
+"Pediatric",100,0.49638881,0.692672975,0.88179135,1.19939175,1.62077775,0.962632795,0.38752584204697,0.89348446740771,1.4714492167564

tests/data/pop-pk-diff/4_pk_parameters_AUC_tEnd.csv

@@ -0,0 +1,3 @@
+"Population","N","5<sup>th</sup> pctl","25<sup>th</sup> pctl","50<sup>th</sup> pctl","75<sup>th</sup> pctl","95<sup>th</sup> pctl","Mean","SD","Geo Mean","Geo SD"
+"Adults",100,725.21641,943.26235,1129.8035,1363.26475,1764.97505,1181.104562,320.807889400206,1138.85331223173,1.31346575932359
+"Pediatric",100,1067.15685,1299.56425,1570.4085,1901.34675,2575.60545,1639.460566,463.068489852523,1580.93166118953,1.30649062461577

tests/data/pop-pk-diff/6_pk_parameters_AUC_tEnd.csv

@@ -0,0 +1,2 @@
+"Population","N","5<sup>th</sup> pctl","25<sup>th</sup> pctl","50<sup>th</sup> pctl","75<sup>th</sup> pctl","95<sup>th</sup> pctl","Mean","SD","Geo Mean","Geo SD"
+"Pediatric",100,1.47150124471122,1.37773361779997,1.38998374496096,1.39470102927549,1.45928717235975,1.38807402726804,1.44344483147934,1.38817848111755,0.994689519191265

tests/data/pop-pk-diff/9_pk_parameters_C_max.csv

@@ -0,0 +1,3 @@
+"Population","N","5<sup>th</sup> pctl","25<sup>th</sup> pctl","50<sup>th</sup> pctl","75<sup>th</sup> pctl","95<sup>th</sup> pctl","Mean","SD","Geo Mean","Geo SD"
+"Adults",100,1.79217375,2.94131325,3.6337025,4.58841875,6.12726215,3.75946195,1.30846781361633,3.53530137849457,1.43304539627776
+"Pediatric",100,2.9037571,4.054793,5.095379,6.488083,9.99468595,5.67883211,2.35977359782379,5.25862423286142,1.4769032246561