From c5aeae4720ecba32bcb9a0931efb433565242f39 Mon Sep 17 00:00:00 2001 From: Ger Inberg Date: Wed, 4 Jun 2025 16:12:49 +0200 Subject: [PATCH 1/4] #292 add function to replace cohort schema and table --- NAMESPACE | 1 + R/GetCovariatesFromOtherCohorts.R | 36 +++++++++++++++++++++++++++++++ 2 files changed, 37 insertions(+) diff --git a/NAMESPACE b/NAMESPACE index 954d58b4..894ada85 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -29,6 +29,7 @@ export(isAggregatedCovariateData) export(isCovariateData) export(isTemporalCovariateData) export(loadCovariateData) +export(replaceCovariateSettingsCohortSchemaTable) export(saveCovariateData) export(tidyCovariateData) exportClasses(CovariateData) diff --git a/R/GetCovariatesFromOtherCohorts.R b/R/GetCovariatesFromOtherCohorts.R index ca40bbbc..87569a76 100644 --- a/R/GetCovariatesFromOtherCohorts.R +++ b/R/GetCovariatesFromOtherCohorts.R @@ -325,3 +325,39 @@ warnIfPredefined <- function(analysisId, temporal = FALSE) { warning(sprintf("Analysis ID %d also used for prespecified analysis '%s'.", analysisId, preSpecAnalysis$analysisName)) } } + +#' Utility function to set the cohort table & schema on createCohortBasedCovariateSettings +#' with information from the execution settings +#' +#' @param covariateSettings An object of type \code{covariateSettings} +#' @param executionSettings An object of type \code{CdmExecutionSettings} +#' +#' @return +#' An object of type \code{covariateSettings} +#' +#' @export +replaceCovariateSettingsCohortSchemaTable <- function(covariateSettings, executionSettings) { + errorMessages <- checkmate::makeAssertCollection() + checkmate::assertList(covariateSettings, min.len = 1, add = errorMessages) + checkmate::assertClass(executionSettings, "CdmExecutionSettings", add = errorMessages) + checkmate::reportAssertions(collection = errorMessages) + + replaceProperties <- function(s) { + if (inherits(s, "covariateSettings") && "fun" %in% names(attributes(s))) { + if (attr(s, "fun") == "getDbCohortBasedCovariatesData") { + # Set the covariateCohortDatabaseSchema & covariateCohortTable values + s$covariateCohortDatabaseSchema <- executionSettings$workDatabaseSchema + s$covariateCohortTable <- executionSettings$cohortTableNames$cohortTable + } + } + return(s) + } + if (is.null(names(covariateSettings))) { + # List of lists + modifiedCovariateSettings <- lapply(covariateSettings, replaceProperties) + } else { + # Plain list + modifiedCovariateSettings <- replaceProperties(covariateSettings) + } + return(modifiedCovariateSettings) +} From a6090c87893345ea7721bb665d7b020e6e50d2e5 Mon Sep 17 00:00:00 2001 From: Ger Inberg Date: Wed, 20 Aug 2025 13:36:01 +0200 Subject: [PATCH 2/4] #292 add params --- R/GetCovariates.R | 11 +++++++- R/GetCovariatesFromOtherCohorts.R | 14 ++++++---- man/getDbCovariateData.Rd | 8 +++++- ...placeCovariateSettingsCohortSchemaTable.Rd | 27 +++++++++++++++++++ 4 files changed, 53 insertions(+), 7 deletions(-) create mode 100644 man/replaceCovariateSettingsCohortSchemaTable.Rd diff --git a/R/GetCovariates.R b/R/GetCovariates.R index d7bd7c80..7881d90d 100644 --- a/R/GetCovariates.R +++ b/R/GetCovariates.R @@ -69,6 +69,8 @@ #' @param tempEmulationSchema Some database platforms like Oracle and Impala do not truly support #' temp tables. To emulate temp tables, provide a schema with write #' privileges where temp tables can be created. +#' @param covariateCohortDatabaseSchema database schema of the covariate cohort from the execution settings +#' @param covariateCohortTable table name of the covariate cohort from the execution settings #' #' @return #' Returns an object of type \code{covariateData}, containing information on the covariates. @@ -113,7 +115,9 @@ getDbCovariateData <- function(connectionDetails = NULL, covariateSettings, aggregated = FALSE, minCharacterizationMean = 0, - tempEmulationSchema = getOption("sqlRenderTempEmulationSchema")) { + tempEmulationSchema = getOption("sqlRenderTempEmulationSchema"), + covariateCohortDatabaseSchema = NULL, + covariateCohortTable = NULL) { if (is.null(connectionDetails) && is.null(connection)) { stop("Need to provide either connectionDetails or connection") } @@ -181,6 +185,11 @@ getDbCovariateData <- function(connectionDetails = NULL, hasData <- function(data) { return(!is.null(data) && (data %>% count() %>% pull()) > 0) } + if (!is.null(covariateCohortDatabaseSchema) && !is.null(covariateCohortTable)) { + covariateSettings <- replaceCovariateSettingsCohortSchemaTable(covariateSettings, + covariateCohortDatabaseSchema, + covariateCohortTable) + } for (i in 1:length(covariateSettings)) { fun <- attr(covariateSettings[[i]], "fun") args <- list( diff --git a/R/GetCovariatesFromOtherCohorts.R b/R/GetCovariatesFromOtherCohorts.R index 87569a76..1b34ff62 100644 --- a/R/GetCovariatesFromOtherCohorts.R +++ b/R/GetCovariatesFromOtherCohorts.R @@ -330,24 +330,28 @@ warnIfPredefined <- function(analysisId, temporal = FALSE) { #' with information from the execution settings #' #' @param covariateSettings An object of type \code{covariateSettings} -#' @param executionSettings An object of type \code{CdmExecutionSettings} +#' @param covariateCohortDatabaseSchema database schema of the covariate cohort from the execution settings +#' @param covariateCohortTable table name of the covariate cohort from the execution settings #' #' @return #' An object of type \code{covariateSettings} #' #' @export -replaceCovariateSettingsCohortSchemaTable <- function(covariateSettings, executionSettings) { +replaceCovariateSettingsCohortSchemaTable <- function(covariateSettings, + covariateCohortDatabaseSchema, + covariateCohortTable) { errorMessages <- checkmate::makeAssertCollection() checkmate::assertList(covariateSettings, min.len = 1, add = errorMessages) - checkmate::assertClass(executionSettings, "CdmExecutionSettings", add = errorMessages) + checkmate::assertCharacter(covariateCohortDatabaseSchema, add = errorMessages) + checkmate::assertCharacter(covariateCohortTable, add = errorMessages) checkmate::reportAssertions(collection = errorMessages) replaceProperties <- function(s) { if (inherits(s, "covariateSettings") && "fun" %in% names(attributes(s))) { if (attr(s, "fun") == "getDbCohortBasedCovariatesData") { # Set the covariateCohortDatabaseSchema & covariateCohortTable values - s$covariateCohortDatabaseSchema <- executionSettings$workDatabaseSchema - s$covariateCohortTable <- executionSettings$cohortTableNames$cohortTable + s$covariateCohortDatabaseSchema <- covariateCohortDatabaseSchema + s$covariateCohortTable <- covariateCohortTable } } return(s) diff --git a/man/getDbCovariateData.Rd b/man/getDbCovariateData.Rd index 74c36795..d65113d4 100644 --- a/man/getDbCovariateData.Rd +++ b/man/getDbCovariateData.Rd @@ -19,7 +19,9 @@ getDbCovariateData( covariateSettings, aggregated = FALSE, minCharacterizationMean = 0, - tempEmulationSchema = getOption("sqlRenderTempEmulationSchema") + tempEmulationSchema = getOption("sqlRenderTempEmulationSchema"), + covariateCohortDatabaseSchema = NULL, + covariateCohortTable = NULL ) } \arguments{ @@ -81,6 +83,10 @@ on covariates that have very low values. The default is 0.} \item{tempEmulationSchema}{Some database platforms like Oracle and Impala do not truly support temp tables. To emulate temp tables, provide a schema with write privileges where temp tables can be created.} + +\item{covariateCohortDatabaseSchema}{database schema of the covariate cohort from the execution settings} + +\item{covariateCohortTable}{table name of the covariate cohort from the execution settings} } \value{ Returns an object of type \code{covariateData}, containing information on the covariates. diff --git a/man/replaceCovariateSettingsCohortSchemaTable.Rd b/man/replaceCovariateSettingsCohortSchemaTable.Rd new file mode 100644 index 00000000..50eed681 --- /dev/null +++ b/man/replaceCovariateSettingsCohortSchemaTable.Rd @@ -0,0 +1,27 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/GetCovariatesFromOtherCohorts.R +\name{replaceCovariateSettingsCohortSchemaTable} +\alias{replaceCovariateSettingsCohortSchemaTable} +\title{Utility function to set the cohort table & schema on createCohortBasedCovariateSettings +with information from the execution settings} +\usage{ +replaceCovariateSettingsCohortSchemaTable( + covariateSettings, + covariateCohortDatabaseSchema, + covariateCohortTable +) +} +\arguments{ +\item{covariateSettings}{An object of type \code{covariateSettings}} + +\item{covariateCohortDatabaseSchema}{database schema of the covariate cohort from the execution settings} + +\item{covariateCohortTable}{table name of the covariate cohort from the execution settings} +} +\value{ +An object of type \code{covariateSettings} +} +\description{ +Utility function to set the cohort table & schema on createCohortBasedCovariateSettings +with information from the execution settings +} From 51480b3b54c2bfb07c9f457790c44cb39923bc7b Mon Sep 17 00:00:00 2001 From: Ger Inberg Date: Thu, 21 Aug 2025 10:45:29 +0200 Subject: [PATCH 3/4] add test --- NAMESPACE | 1 - R/GetCovariates.R | 4 +-- R/GetCovariatesFromOtherCohorts.R | 7 ++--- .../testthat/test-GetCohortBasedCovariates.R | 29 +++++++++++++++++-- 4 files changed, 32 insertions(+), 9 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 894ada85..954d58b4 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -29,7 +29,6 @@ export(isAggregatedCovariateData) export(isCovariateData) export(isTemporalCovariateData) export(loadCovariateData) -export(replaceCovariateSettingsCohortSchemaTable) export(saveCovariateData) export(tidyCovariateData) exportClasses(CovariateData) diff --git a/R/GetCovariates.R b/R/GetCovariates.R index 7881d90d..a0f11a91 100644 --- a/R/GetCovariates.R +++ b/R/GetCovariates.R @@ -69,8 +69,8 @@ #' @param tempEmulationSchema Some database platforms like Oracle and Impala do not truly support #' temp tables. To emulate temp tables, provide a schema with write #' privileges where temp tables can be created. -#' @param covariateCohortDatabaseSchema database schema of the covariate cohort from the execution settings -#' @param covariateCohortTable table name of the covariate cohort from the execution settings +#' @param covariateCohortDatabaseSchema The database schema where the cohorts used to define the covariates can be found. +#' @param covariateCohortTable The table where the cohorts used to define the covariates can be found. #' #' @return #' Returns an object of type \code{covariateData}, containing information on the covariates. diff --git a/R/GetCovariatesFromOtherCohorts.R b/R/GetCovariatesFromOtherCohorts.R index 1b34ff62..ca51742f 100644 --- a/R/GetCovariatesFromOtherCohorts.R +++ b/R/GetCovariatesFromOtherCohorts.R @@ -330,13 +330,12 @@ warnIfPredefined <- function(analysisId, temporal = FALSE) { #' with information from the execution settings #' #' @param covariateSettings An object of type \code{covariateSettings} -#' @param covariateCohortDatabaseSchema database schema of the covariate cohort from the execution settings -#' @param covariateCohortTable table name of the covariate cohort from the execution settings +#' @param covariateCohortDatabaseSchema The database schema where the cohorts used to define the covariates can be found. +#' @param covariateCohortTable The table where the cohorts used to define the covariates can be found. #' #' @return #' An object of type \code{covariateSettings} -#' -#' @export +#' replaceCovariateSettingsCohortSchemaTable <- function(covariateSettings, covariateCohortDatabaseSchema, covariateCohortTable) { diff --git a/tests/testthat/test-GetCohortBasedCovariates.R b/tests/testthat/test-GetCohortBasedCovariates.R index 34e8bccd..102f267a 100644 --- a/tests/testthat/test-GetCohortBasedCovariates.R +++ b/tests/testthat/test-GetCohortBasedCovariates.R @@ -70,7 +70,8 @@ dropCohortBasedCovariateTestData <- function(connection, } # Database specific tests --------------- -runCohortBasedBinaryNonAggTest <- function(connection, cdmDatabaseSchema, ohdsiDatabaseSchema, cohortTable) { +runCohortBasedBinaryNonAggTest <- function(connection, cdmDatabaseSchema, ohdsiDatabaseSchema, cohortTable, + covariateCohortDatabaseSchema = NULL, covariateCohortTable = NULL) { createCohortBasedCovariateTestData( connection = connection, databaseSchema = ohdsiDatabaseSchema, @@ -99,7 +100,9 @@ runCohortBasedBinaryNonAggTest <- function(connection, cdmDatabaseSchema, ohdsiD cdmVersion = "5", rowIdField = "subject_id", covariateSettings = settings, - aggregated = FALSE + aggregated = FALSE, + covariateCohortDatabaseSchema = covariateCohortDatabaseSchema, + covariateCohortTable = covariateCohortTable ) covariates <- dplyr::collect(covs$covariates) @@ -485,6 +488,28 @@ test_that("Cohort-based covariates: binary, non-aggregated on Eunomia", { ) }) +test_that("Cohort-based covariates: binary, non-aggregated, custom covariate cohort schema/table on Eunomia", { + skip_if_not(dbms == "sqlite" && exists("eunomiaConnection")) + runCohortBasedBinaryNonAggTest( + connection = eunomiaConnection, + cdmDatabaseSchema = eunomiaCdmDatabaseSchema, + ohdsiDatabaseSchema = eunomiaOhdsiDatabaseSchema, + cohortTable = "cohort_cov", + covariateCohortDatabaseSchema = eunomiaOhdsiDatabaseSchema, + covariateCohortTable = "cohort_cov" + ) + testthat::expect_error( + runCohortBasedBinaryNonAggTest( + connection = eunomiaConnection, + cdmDatabaseSchema = eunomiaCdmDatabaseSchema, + ohdsiDatabaseSchema = eunomiaOhdsiDatabaseSchema, + cohortTable = "cohort_cov", + covariateCohortDatabaseSchema = "unknown", + covariateCohortTable = "unknown" + ), + "no such table: unknown.unknown") +}) + test_that("Cohort-based covariates: binary, aggregated on Eunomia", { skip_on_cran() skip_if_not(dbms == "sqlite" && exists("eunomiaConnection")) From 5976c94681797af97e8d2e4d5d80bc5e311b03ad Mon Sep 17 00:00:00 2001 From: Ger Inberg Date: Thu, 21 Aug 2025 10:45:48 +0200 Subject: [PATCH 4/4] doc --- man/getDbCovariateData.Rd | 4 ++-- man/replaceCovariateSettingsCohortSchemaTable.Rd | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/man/getDbCovariateData.Rd b/man/getDbCovariateData.Rd index d65113d4..92aa19bb 100644 --- a/man/getDbCovariateData.Rd +++ b/man/getDbCovariateData.Rd @@ -84,9 +84,9 @@ on covariates that have very low values. The default is 0.} temp tables. To emulate temp tables, provide a schema with write privileges where temp tables can be created.} -\item{covariateCohortDatabaseSchema}{database schema of the covariate cohort from the execution settings} +\item{covariateCohortDatabaseSchema}{The database schema where the cohorts used to define the covariates can be found.} -\item{covariateCohortTable}{table name of the covariate cohort from the execution settings} +\item{covariateCohortTable}{The table where the cohorts used to define the covariates can be found.} } \value{ Returns an object of type \code{covariateData}, containing information on the covariates. diff --git a/man/replaceCovariateSettingsCohortSchemaTable.Rd b/man/replaceCovariateSettingsCohortSchemaTable.Rd index 50eed681..29c14639 100644 --- a/man/replaceCovariateSettingsCohortSchemaTable.Rd +++ b/man/replaceCovariateSettingsCohortSchemaTable.Rd @@ -14,9 +14,9 @@ replaceCovariateSettingsCohortSchemaTable( \arguments{ \item{covariateSettings}{An object of type \code{covariateSettings}} -\item{covariateCohortDatabaseSchema}{database schema of the covariate cohort from the execution settings} +\item{covariateCohortDatabaseSchema}{The database schema where the cohorts used to define the covariates can be found.} -\item{covariateCohortTable}{table name of the covariate cohort from the execution settings} +\item{covariateCohortTable}{The table where the cohorts used to define the covariates can be found.} } \value{ An object of type \code{covariateSettings}