Fix cohort covariates and add predictGlm to package (#465)

* add predictGlm and createGlmModel functions

* remove plpModel class and add predictionFunction to GLM

* fix cohort covariates when missing table and schema in settings

* move glm to it's one file

* add error message and logging

* fix case when popSettings or restrictSettings not specified

* add warnings and refactor to reduce complexity of function

* docs of params in new helper functions

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)
-}
+}