From 935612d188e197e9202126a7c102a4a3887c2b71 Mon Sep 17 00:00:00 2001
From: Pierre Chelle <45343665+pchelle@users.noreply.github.com>
Date: Fri, 26 Apr 2024 21:54:48 +0200
Subject: [PATCH] Fixes #1208 use IndividualId intersect for PK ratio in same
 population (#1217)

---
 R/error-checks.R               | 33 +++++++++++++++++++++++++++++++++
 R/messages.R                   |  9 ++++++++-
 R/utilities-ratio-comparison.R | 10 ++++++++++
 man/checkSamePopulationIds.Rd  | 21 +++++++++++++++++++++
 4 files changed, 72 insertions(+), 1 deletion(-)
 create mode 100644 man/checkSamePopulationIds.Rd

diff --git a/R/error-checks.R b/R/error-checks.R
index 20b37e72..8ceb5338 100644
--- a/R/error-checks.R
+++ b/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())
+}
diff --git a/R/messages.R b/R/messages.R
index 646ac714..750434d2 100644
--- a/R/messages.R
+++ b/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)) {
diff --git a/R/utilities-ratio-comparison.R b/R/utilities-ratio-comparison.R
index 9f9537bc..bfff8510 100644
--- a/R/utilities-ratio-comparison.R
+++ b/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)
diff --git a/man/checkSamePopulationIds.Rd b/man/checkSamePopulationIds.Rd
new file mode 100644
index 00000000..2568fc69
--- /dev/null
+++ b/man/checkSamePopulationIds.Rd
@@ -0,0 +1,21 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/error-checks.R
+\name{checkSamePopulationIds}
+\alias{checkSamePopulationIds}
+\title{checkSamePopulationIds}
+\usage{
+checkSamePopulationIds(setIds, referenceSetIds, setName, referenceSetName)
+}
+\arguments{
+\item{setIds}{A vector of IndividualIds for a simulation set}
+
+\item{referenceSetIds}{A vector of IndividualIds for the reference simulation set}
+
+\item{setName}{Name of simulation set for warning message}
+
+\item{referenceSetName}{Name of the reference simulation set for warning message}
+}
+\description{
+Check if PKAnalses with same population actually use the same IndividualIds
+}
+\keyword{internal}