Merge branch 'develop' into merged_main

DESCRIPTION

@@ -2,7 +2,7 @@ Package: PatientLevelPrediction
 Type: Package
 Title: Developing patient level prediction using data in the OMOP Common Data
     Model
-Version: 6.3.9
+Version: 6.3.9.9999
 Date: 2024-08-21
 Authors@R: c(
     person("Jenna", "Reps", email = "[email protected]", role = c("aut", "cre")),
@@ -71,8 +71,7 @@ Suggests:
     lightgbm
 Remotes:
     ohdsi/BigKnn,
-    ohdsi/FeatureExtraction,
     ohdsi/ShinyAppBuilder,
-    ohdsi/ResultModelManager,
-RoxygenNote: 7.3.1
+    ohdsi/ResultModelManager
+RoxygenNote: 7.3.2
 Encoding: UTF-8

NAMESPACE

@@ -23,6 +23,7 @@ export(createDefaultExecuteSettings)
 export(createDefaultSplitSetting)
 export(createExecuteSettings)
 export(createFeatureEngineeringSettings)
+export(createGlmModel)
 export(createLearningCurve)
 export(createLogSettings)
 export(createModelDesign)
@@ -82,6 +83,7 @@ export(plotSparseCalibration2)
 export(plotSparseRoc)
 export(plotVariableScatterplot)
 export(predictCyclops)
+export(predictGlm)
 export(predictPlp)
 export(recalibratePlp)
 export(recalibratePlpRefit)

R/AdditionalCovariates.R

@@ -67,10 +67,29 @@ getCohortCovariateData <- function(
     group by a.@row_id_field; "
   )
 
+  if (is.null(covariateSettings$cohortTable) &&
+      (is.null(covariateSettings$cohortDatabaseSchema))) {
+    ParallelLogger::logInfo("cohortTable and cohortDatabaseSchema not specified in 
+      cohort covariateSettings. Attempting to fetch from databaseDetails")
+    # use settings from databaseDetails which is two frames up 
+    # in the call stack
+    tryCatch(databaseDetails <- get("databaseDetails", parent.frame(n = 2)),
+      error = function(e) {
+        stop("cohortTable and cohortDatabaseSchema not specified in 
+          cohort covariateSettings. Attempt to fetch databaseDetails from parent 
+          frame failed with error: ", e$message)
+      })
+    cohortCovariateTable <- databaseDetails$cohortTable
+    cohortCovariateDatabaseSchema <- databaseDetails$cohortDatabaseSchema
+  } else {
+    cohortCovariateTable <- covariateSettings$cohortTable
+    cohortCovariateDatabaseSchema <- covariateSettings$cohortDatabaseSchema
+  }
+
   sql <- SqlRender::render(
     sql,
-    covariate_cohort_schema = covariateSettings$cohortDatabaseSchema,
-    covariate_cohort_table = covariateSettings$cohortTable,
+    covariate_cohort_schema = cohortCovariateDatabaseSchema,
+    covariate_cohort_table = cohortCovariateTable,
     covariate_cohort_id = covariateSettings$cohortIds,
     cohort_temp_table = cohortTable,
     row_id_field = rowIdField,
@@ -154,8 +173,10 @@ getCohortCovariateData <- function(
 #'
 #' @param cohortName  Name for the cohort
 #' @param settingId   A unique id for the covariate time and 
-#' @param cohortDatabaseSchema  The schema of the database with the cohort
-#' @param cohortTable  the table name that contains the covariate cohort
+#' @param cohortDatabaseSchema  The schema of the database with the cohort. If 
+#' nothing is specified then the cohortDatabaseSchema from databaseDetails at runtime is used.
+#' @param cohortTable  the table name that contains the covariate cohort. If 
+#' nothing is specified then the cohortTable from databaseDetails at runtime is used.
 #' @param cohortId  cohort id for the covariate cohort
 #' @param startDay  The number of days prior to index to start observing the cohort
 #' @param endDay  The number of days prior to index to stop observing the cohort
@@ -173,8 +194,8 @@ getCohortCovariateData <- function(
 createCohortCovariateSettings <- function(
   cohortName, 
   settingId,
-  cohortDatabaseSchema, 
-  cohortTable, 
+  cohortDatabaseSchema=NULL, 
+  cohortTable=NULL, 
   cohortId,
   startDay = -30, 
   endDay = 0, 
@@ -205,4 +226,4 @@ createCohortCovariateSettings <- function(
   attr(covariateSettings, "fun") <- "PatientLevelPrediction::getCohortCovariateData"
   class(covariateSettings) <- "covariateSettings"
   return(covariateSettings)
-}
+}

R/EvaluationSummary.R

@@ -263,7 +263,8 @@ getEvaluationStatistics_survival <- function(prediction, evalColumn, timepoint,
     eStatistic <- eStatistic90 <- -1
     if (!is.null(w)) {
       eStatistic <- mean(abs(w$actual - w$estimatedSurvival)) 
-      eStatistic90 <- stats::quantile(abs(w$actual - w$estimatedSurvival), probs = .9)
+      eStatistic90 <- stats::quantile(abs(w$actual - w$estimatedSurvival),
+                                      probs = .9, na.rm = TRUE)
     }
 
     result <- rbind(