429 save cdm database name (#430)

* save dev database name and schema in trainDetails

.github/workflows/R_CMD_check_Hades.yaml

@@ -87,13 +87,13 @@ jobs:
           path: check/*.tar.gz
 
       - name: Install covr
-        if: runner.os == 'Windows'
+        if: runner.os == 'Linux'
         run: |
           remotes::install_cran("covr")
         shell: Rscript {0}
-
+        
       - name: Test coverage
-        if: runner.os == 'Windows'
+        if: runner.os == 'Linux'
         run: covr::codecov()
         shell: Rscript {0}
 

DESCRIPTION

@@ -75,5 +75,5 @@ Remotes:
     ohdsi/FeatureExtraction,
     ohdsi/ShinyAppBuilder,
     ohdsi/ResultModelManager,
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.1
 Encoding: UTF-8

R/AdditionalCovariates.R

@@ -30,7 +30,7 @@
 #' @param cohortTable  the table name that contains the target population cohort
 #' @param rowIdField  string representing the unique identifier in the target population cohort
 #' @param aggregated  whether the covariate should be aggregated
-#' @param cohortId  cohort id for the target cohort
+#' @param cohortIds  cohort id for the target cohort
 #' @param covariateSettings  settings for the covariate cohorts and time periods
 #'
 #' @return
@@ -45,7 +45,7 @@ getCohortCovariateData <- function(
   cohortTable = "#cohort_person",
   rowIdField = "row_id",
   aggregated,
-  cohortId,
+  cohortIds,
   covariateSettings
   ){
 
@@ -69,7 +69,7 @@ getCohortCovariateData <- function(
     sql,
     covariate_cohort_schema = covariateSettings$cohortDatabaseSchema,
     covariate_cohort_table = covariateSettings$cohortTable,
-    covariate_cohort_id = covariateSettings$cohortId,
+    covariate_cohort_id = covariateSettings$cohortIds,
     cohort_temp_table = cohortTable,
     row_id_field = rowIdField,
     startDay = covariateSettings$startDay,
@@ -191,7 +191,7 @@ createCohortCovariateSettings <- function(
     covariateId = cohortId*100000+settingId*1000+analysisId,
     cohortDatabaseSchema = cohortDatabaseSchema,
     cohortTable = cohortTable,
-    cohortId = cohortId,
+    cohortIds = cohortId,
     startDay = startDay,
     endDays = endDay,
     count = count,

R/CyclopsModels.R

@@ -211,7 +211,8 @@ fitCyclopsModel <- function(
     trainDetails = list(
       analysisId = analysisId, 
       analysisSource = '', #TODO add from model
-      developmentDatabase = attr(trainData, "metaData")$cdmDatabaseSchema,
+      developmentDatabase = attr(trainData, "metaData")$cdmDatabaseName,
+      developmentDatabaseSchema = attr(trainData, "metaData")$cdmDatabaseSchema, 
       attrition = attr(trainData, "metaData")$attrition, 
       trainingTime =  paste(as.character(abs(comp)), attr(comp,'units')),
       trainingDate = Sys.Date(),

R/DataSplitting.R

@@ -148,6 +148,7 @@ splitData <- function(plpData = plpData,
       outcomeId = attr(population, "metaData")$outcomeId,
       targetId = attr(population, "metaData")$targetId,
       cdmDatabaseSchema = plpData$metaData$databaseDetails$cdmDatabaseSchema,
+      cdmDatabaseName = plpData$metaData$databaseDetails$cdmDatabaseName,
       cdmDatabaseId = plpData$metaData$databaseDetails$cdmDatabaseId,
       restrictPlpDataSettings = attr(population, "metaData")$restrictPlpDataSettings,
       covariateSettings = plpData$metaData$covariateSettings,
@@ -186,6 +187,7 @@ splitData <- function(plpData = plpData,
       outcomeId = attr(population, "metaData")$outcomeId,
       targetId = attr(population, "metaData")$targetId,
       cdmDatabaseSchema = plpData$metaData$databaseDetails$cdmDatabaseSchema,
+      cdmDatabaseName = plpData$metaData$databaseDetails$cdmDatabaseName,
       cdmDatabaseId = plpData$metaData$databaseDetails$cdmDatabaseId,
       restrictPlpDataSettings = attr(population, "metaData")$restrictPlpDataSettings,
       covariateSettings = plpData$metaData$covariateSettings,

R/HelperFunctions.R

@@ -1,6 +1,8 @@
 # fix issue with nrow - temp fix for me locally
 nrow <- function(x){UseMethod("nrow",x)}
+#' @exportS3Method NULL
 nrow.default <- base::nrow
+#' @exportS3Method NULL
 nrow.tbl <- function(x){x %>% dplyr::tally() %>% dplyr::pull()}
 
 

R/KNN.R

@@ -145,7 +145,8 @@ fitKNN <- function(trainData, modelSettings, search = 'none', analysisId, ...){
 
     trainDetails = list(
       analysisId = analysisId,
-      developmentDatabase = attr(trainData, "metaData")$cdmDatabaseSchema,
+      developmentDatabase = attr(trainData, "metaData")$cdmDatabaseName,
+      developmentDatabaseSchema = attr(trainData, "metaData")$cdmDatabaseSchema, 
       attrition = attr(trainData, "metaData")$attrition, 
       trainingTime = paste(as.character(abs(comp)), attr(comp,'units')),
       trainingDate = Sys.Date(),

R/PatientLevelPrediction.R

@@ -20,12 +20,11 @@
 #' 
 #' @description A package for running predictions using data in the OMOP CDM
 #'
-#' @docType package
 #' @name PatientLevelPrediction
 #' @keywords internal
 #' @importFrom dplyr %>%
 #' @importFrom rlang .data
-NULL
+"_PACKAGE"
 
 #' A simulation profile
 #' @docType data

R/RClassifier.R

@@ -83,7 +83,8 @@ fitRclassifier <- function(
     trainDetails = list(
       analysisId = analysisId,
       analysisSource = '', #TODO add from model
-      developmentDatabase = attr(trainData, "metaData")$cdmDatabaseSchema,
+      developmentDatabase = attr(trainData, "metaData")$cdmDatabaseName,
+      developmentDatabaseSchema = attr(trainData, "metaData")$cdmDatabaseSchema, 
       attrition = attr(trainData, "metaData")$attrition, 
       trainingTime = paste(as.character(abs(comp)), attr(comp,'units')),
       trainingDate = Sys.Date(),

R/Simulation.R

@@ -162,7 +162,8 @@ simulatePlpData <- function(plpDataSimulationProfile, n = 10000) {
   metaData = list()
 
   metaData$databaseDetails <- list(
-    cdmDatabaseSchema = 'Profile',
+    cdmDatabaseSchema = 'CDM_SCHEMA',
+    cdmDatabaseName = "CDM_NAME",
     outcomeDatabaseSchema = NULL,
     cohortDatabaseSchema = NULL,
     connectionDetails = NULL,

R/SklearnClassifier.R

@@ -115,7 +115,8 @@ fitSklearn <- function(
     trainDetails = list(
       analysisId = analysisId,
       analysisSource = '', #TODO add from model
-      developmentDatabase = attr(trainData, "metaData")$cdmDatabaseSchema,
+      developmentDatabase = attr(trainData, "metaData")$cdmDatabaseName,
+      developmentDatabaseSchema = attr(trainData, "metaData")$cdmDatabaseSchema,
       attrition = attr(trainData, "metaData")$attrition, 
       trainingTime = paste(as.character(abs(comp)), attr(comp,'units')),
       trainingDate = Sys.Date(),

tests/testthat/test-covariateExtras.R

@@ -113,7 +113,7 @@ covs <- FeatureExtraction::getDbCovariateData(
   cohortTable = "cohort", 
   cohortDatabaseSchema = "main", 
   cohortTableIsTemp = F, 
-  cohortId = 1, 
+  cohortIds = c(1), 
   rowIdField = 'rowId', 
   covariateSettings = covSet, 
   aggregated = F