Fixes #1208 use IndividualId intersect for PK ratio in same population (

#1217)

R/error-checks.R

@@ -657,3 +657,36 @@ checkHasRunOnAllCores <- function(coreResults, inputName, inputType, runType = "
   )
   return(invisible())
 }
+
+#' @title checkSamePopulationIds
+#' @description
+#' Check if PKAnalses with same population actually use the same IndividualIds
+#' @param setIds A vector of IndividualIds for a simulation set
+#' @param referenceSetIds A vector of IndividualIds for the reference simulation set
+#' @param setName Name of simulation set for warning message
+#' @param referenceSetName Name of the reference simulation set for warning message
+#' @keywords internal
+checkSamePopulationIds <- function(setIds,
+                                   referenceSetIds,
+                                   setName,
+                                   referenceSetName) {
+  tryCatch(
+    {
+      validateIsIncluded(referenceSetIds, setIds)
+    },
+    error = function(e) {
+      missingIds <- setdiff(referenceSetIds, setIds)
+      warning(messages$warningPKAnalysesMissingIds(missingIds, setName), call. = FALSE)
+    }
+  )
+  tryCatch(
+    {
+      validateIsIncluded(setIds, referenceSetIds)
+    },
+    error = function(e) {
+      missingIds <- setdiff(setIds, referenceSetIds)
+      warning(messages$warningPKAnalysesMissingIds(missingIds, referenceSetName), call. = FALSE)
+    }
+  )
+  return(invisible())
+}

R/messages.R

@@ -258,7 +258,14 @@ messages <- list(
   warningNAFoundInPKAnalysisFile = function(filePath) {
     paste0(highlight("NaN"), " found in PK analysis file '", highlight(filePath), "'.")
   },
-
+  warningPKAnalysesMissingIds = function(ids, setName){
+    paste0(
+      "Missing ", highlight("IndividualIds"), " in PKAnalysis file for simulation set '", 
+      highlight(setName), "': ",
+      paste0("'", highlight(ids), "'", collapse = ", ")
+    )
+  },
+
   #----- Info messages ----
   runStarting = function(runName, subRun = NULL) {
     if (is.null(subRun)) {

R/utilities-ratio-comparison.R

@@ -114,6 +114,16 @@ getPKRatioSummaryForSamePopulation <- function(structureSet, referenceSet) {
   # Check that both PK data to be compared are included in reference PK data
   validateIsIncluded(unique(pkData$QuantityPath), unique(referencePKData$QuantityPath))
   validateIsIncluded(unique(pkData$Parameter), unique(referencePKData$Parameter))
+  # Check that same individuals are present in both data sets and use intersection
+  checkSamePopulationIds(
+    setIds = pkData$IndividualId,
+    referenceSetIds = referencePKData$IndividualId,
+    setName = structureSet$simulationSet$simulationSetName,
+    referenceSetName = referenceSet$simulationSet$simulationSetName
+  )
+  ids <- intersect(pkData$IndividualId, referencePKData$IndividualId)
+  pkData <- pkData %>% filter(IndividualId %in% ids)
+  referencePKData <- referencePKData %>% filter(IndividualId %in% ids)
 
   # Pivot table to get fast computation of ratios and their statistics
   quantityPaths <- unique(pkData$QuantityPath)