assign population if existing and added a test

OHDSI · Jan 29, 2024 · 118cc7c · 118cc7c
1 parent f212580
commit 118cc7c
Show file tree

Hide file tree

Showing 2 changed files with 28 additions and 0 deletions.
diff --git a/R/RunPlp.R b/R/RunPlp.R
@@ -270,6 +270,7 @@ runPlp <- function(
   # create the population
   if(!is.null(plpData$population)) {
     ParallelLogger::logInfo('Using existing population')
+    population <- plpData$population
   } else {
     ParallelLogger::logInfo('Creating population')
     population <- tryCatch({

diff --git a/tests/testthat/test-population.R b/tests/testthat/test-population.R
@@ -495,4 +495,31 @@ test_that("population creation parameters", {
 
 })
 
+testthat::test_that("Providing an existing population and skipping population creation works", {
+  popSize <- 400
+  newPopulation <- population[sample.int(nrow.default(population), popSize), ]
+
+  tinyPlpData$population <- newPopulation
+
+  plpResults <- runPlp(
+    plpData = tinyPlpData,
+    outcomeId = 2,
+    analysisId = "1",
+    analysisName = "existing population",
+    populationSettings = createStudyPopulationSettings(),
+    splitSettings = createDefaultSplitSetting(),
+    modelSettings = setLassoLogisticRegression(),
+    executeSettings = createExecuteSettings(
+      runSplitData = TRUE,
+      runPreprocessData = FALSE,
+      runModelDevelopment = TRUE
+    )
+  )
+
+  trainPredictions <- plpResults$prediction %>%
+    dplyr::filter(.data$evaluationType == "Train") %>% nrow.default()
+  testPredictions <- plpResults$prediction %>%
+    dplyr::filter(.data$evaluationType == "Test") %>% nrow.default()
+  expect_equal(popSize, trainPredictions + testPredictions)
+})