From b699293cde7cadbc43e2aa383fe3d91c6f0ecb02 Mon Sep 17 00:00:00 2001
From: Henrik <l.john@erasmusmc.nl>
Date: Tue, 7 May 2024 16:34:35 +0200
Subject: [PATCH] Update validateExternal for Strategus (#452)

* Handle no outcomes

* close logger properly and go to next iteration if no outcomes

* Explicitly declare results object

* plpModel works as a string when externally validating

---------

Co-authored-by: egillax <egillax@gmail.com>
---
 R/ExternalValidatePlp.R | 30 +++++++++++++++++++++++-------
 1 file changed, 23 insertions(+), 7 deletions(-)

diff --git a/R/ExternalValidatePlp.R b/R/ExternalValidatePlp.R
index 8e3e7a64a..de68dc5e2 100644
--- a/R/ExternalValidatePlp.R
+++ b/R/ExternalValidatePlp.R
@@ -435,6 +435,7 @@ validateExternal <- function(validationDesignList,
   for (name in databaseNames) {
     analysisInfo[name] <- 1
   }
+  results <- NULL
   for (design in validationDesignList) {
     for (database in databaseDetails) {
       databaseName <- database$cdmDatabaseName
@@ -444,7 +445,7 @@ validateExternal <- function(validationDesignList,
       logSettings$logFileName <- 'validationLog'
       logger <- do.call(createLog, logSettings)
       ParallelLogger::registerLogger(logger)
-      on.exit(logger$close())
+      on.exit(closeLog(logger))
       
       ParallelLogger::logInfo(paste('Validating model on', database$cdmDatabaseName))
       
@@ -453,8 +454,16 @@ validateExternal <- function(validationDesignList,
       database$outcomeIds <- design$outcomeId
       
       allCovSettings <-
-        lapply(design$plpModelList, function(plpModel)
-          plpModel$modelDesign$covariateSettings)
+        lapply(design$plpModelList, function(plpModel) {
+          if (is.character(plpModel)) {
+            modelDesign <- ParallelLogger::loadSettingsFromJson(
+              normalizePath(file.path(plpModel, 'modelDesign.json'))
+            )
+            return(modelDesign$covariateSettings)
+          } else {
+          plpModel$modelDesign$covariateSettings
+          }
+        })
       # compare all to first covSettings, if not the same stop
       if (!Reduce(function(x, y)
         x &&
@@ -469,14 +478,18 @@ validateExternal <- function(validationDesignList,
           list(
             databaseDetails = database,
             restrictPlpDataSettings = design$restrictPlpDataSettings,
-            covariateSettings = design$plpModelList[[1]]$modelDesign$covariateSettings
+            covariateSettings = allCovSettings[[1]]
           )
         )
       },
       error = function(e) {
         ParallelLogger::logError(e)
         return(NULL)
-      })     
+      })   
+      if (is.null(plpData)) {
+        ParallelLogger::logInfo("Couldn't extract plpData for the given design and database, proceding to the next one.")
+        next
+      }
       plpDataName <-
         paste0("targetId_", design$targetId, "_L", "1") # Is the 1 for how many targetIds in file ?
       plpDataLocation <-
@@ -485,7 +498,7 @@ validateExternal <- function(validationDesignList,
         dir.create(file.path(outputFolder, databaseName), recursive = TRUE)
       }
       savePlpData(plpData, file = plpDataLocation)
-      
+
       # create study population
       population <- tryCatch({
         do.call(
@@ -501,7 +514,7 @@ validateExternal <- function(validationDesignList,
         ParallelLogger::logError(e)
         return(NULL)
       })
-      
+        
       results <- lapply(design$plpModelList, function(model) {
         analysisName <- paste0("Analysis_", analysisInfo[databaseName])
         validateModel(
@@ -549,6 +562,9 @@ validateModel <-
            outputFolder,
            databaseName,
            analysisName) {
+    if (is.character(plpModel)) {
+      plpModel <- loadPlpModel(plpModel)
+    }
     result <- externalValidatePlp(
       plpModel = plpModel,
       plpData = plpData,