#188 deprecate filterByCohortDefinitionId

NAMESPACE

@@ -16,6 +16,7 @@ export(createTable1CovariateSettings)
 export(createTemporalCovariateSettings)
 export(createTemporalSequenceCovariateSettings)
 export(filterByCohortDefinitionId)
+export(filterByCohortDefinitionIds)
 export(filterByRowId)
 export(getDbCohortAttrCovariatesData)
 export(getDbCovariateData)

R/CovariateData.R

@@ -195,20 +195,13 @@ isTemporalCovariateData <- function(x) {
 
 #' Create an empty CovariateData object
 #'
-#' @param cohortId   DEPRECATED
-#' @param cohortIds  For which cohort ID(s) should covariates be constructed? If set to c(-1),
-#'                   covariates will be constructed for all cohorts in the specified cohort
-#'                   table.
+#' @param cohortIds  For which cohort IDs should the covariate data be created?
 #' @param aggregated if the covariate data is aggregated
 #' @param temporal   if the covariate data is temporal
 #' 
-#' @return
-#' A logical value.
-createEmptyCovariateData <- function(cohortId, cohortIds, aggregated, temporal) {
-  if (!missing(cohortId)) { 
-    stop("cohortId argument has been deprecated, please use cohortIds")
-  }
-
+#' @return the empty CovariateData object
+#' 
+createEmptyCovariateData <- function(cohortIds, aggregated, temporal) {
   dummy <- tibble(covariateId = 1,
                   covariateValue = 1)
   if (!aggregated) {

R/GetCovariates.R

@@ -117,7 +117,7 @@ getDbCovariateData <- function(connectionDetails = NULL,
     populationSize <- sum(temp$populationSize)
   }
   if (sum(populationSize) == 0) {
-    covariateData <- createEmptyCovariateData(cohortIds = cohortIds, aggregated = aggregated, temporal = covariateSettings$temporal)
+    covariateData <- createEmptyCovariateData(cohortIds, aggregated, covariateSettings$temporal)
     warning("Population is empty. No covariates were constructed")
   } else {
     if (inherits(covariateSettings, "covariateSettings")) {

R/GetCovariatesFromCohortAttributes.R

@@ -103,7 +103,7 @@ getDbCohortAttrCovariatesData <- function(connection,
   delta <- Sys.time() - start
   writeLines(paste("Loading took", signif(delta, 3), attr(delta, "units")))
 
-  result <- createEmptyCovariateData(cohortIds = cohortIds, aggregated = aggregated, temporal = covariateSettings$temporal)
+  result <- createEmptyCovariateData(cohortIds, aggregated, covariateSettings$temporal)
   result$covariates = covariates
   result$covariateRef = covariateRef
   result$analysisRef = analysisRef

R/HelperFunctions.R

@@ -51,30 +51,42 @@ filterByRowId <- function(covariateData, rowIds) {
 #' An object of type \code{covariateData}.
 #' @export
 filterByCohortDefinitionId <- function(covariateData, cohortId) {
+    stop("filterByCohortDefinitionId has been deprecated, please use filterByCohortDefinitionIds")
+}
+
+#' Filter covariates by cohort definition IDs
+#'
+#' @param covariateData  An object of type \code{CovariateData}
+#' @param cohortIds      The cohort definitions IDs to keep.
+#'
+#' @return
+#' An object of type \code{covariateData}.
+#' @export
+filterByCohortDefinitionIds <- function(covariateData, cohortIds) {
   if (!isCovariateData(covariateData))
     stop("Data not of class CovariateData")
   if (!Andromeda::isValidAndromeda(covariateData)) 
     stop("CovariateData object is closed")
   if (!isAggregatedCovariateData(covariateData))
-    stop("Can only filter aggregated data by cohortId")
+    stop("Can only filter aggregated data by cohortIds")
   if (is.null(covariateData$covariates)) {
     covariates <- NULL
   } else {
     covariates <- covariateData$covariates %>%
-      filter(.data$cohortDefinitionId %in% cohortId)
+      filter(.data$cohortDefinitionId %in% cohortIds)
   }
   if (is.null(covariateData$covariatesContinuous)) {
     covariatesContinuous <- NULL
   } else {
     covariatesContinuous <- covariateData$covariatesContinuous %>%
-      filter(.data$cohortDefinitionId %in% cohortId)
+      filter(.data$cohortDefinitionId %in% cohortIds)
   }
   result <- Andromeda::andromeda(covariates = covariates,
                                  covariatesContinuous = covariatesContinuous,
                                  covariateRef = covariateData$covariateRef,
                                  analysisRef = covariateData$analysisRef)
   metaData <- attr(covariateData, "metaData")
-  metaData$populationSize <- metaData$populationSize[as.numeric(names(metaData$populationSize)) %in% cohortId]
+  metaData$populationSize <- metaData$populationSize[as.numeric(names(metaData$populationSize)) %in% cohortIds]
   attr(result, "metaData") <- metaData
   class(result) <- "CovariateData"
   attr(class(result), "package") <- "FeatureExtraction"

R/UnitTestHelperFunctions.R

@@ -47,7 +47,7 @@
                "ON op.person_id = c.subject_id",
                "WHERE cohort_start_date >= observation_period_start_date",
                "AND cohort_start_date <= observation_period_end_date",
-               "{@cohort_ids != -1} ? {AND cohort_definition_id = @cohort_ids}")
+               "{@cohort_ids != -1} ? {AND cohort_definition_id IN @cohort_ids}")
   sql <- SqlRender::render(sql,
                            cohort_table = cohortTable,
                            cohort_ids = cohortIds,
@@ -77,4 +77,4 @@
   attr(result, "metaData") <- metaData
   class(result) <- "CovariateData"
   return(result)
-}
+}

tests/testthat/test-HelperFunctions.R

@@ -17,17 +17,17 @@ test_that("Test helper functions for non-aggregated covariate data", {
   expect_equal(unique(pull(covariateDataFiltered$covariates, rowId)), 1)
 
   locallyAggregated <- aggregateCovariates(covariateData)
-  expect_error(filterByCohortDefinitionId(locallyAggregated, 1), "no such column")
+  expect_error(filterByCohortDefinitionIds(locallyAggregated, cohortIds = c(1)), "no such column")
 
-  expect_error(filterByCohortDefinitionId(covariateData, 1), "Can only filter aggregated")
+  expect_error(filterByCohortDefinitionIds(covariateData, cohortIds = c(1)), "Can only filter aggregated")
 
   Andromeda::close(covariateData)
   expect_error(filterByRowId(covariateData, 1), "closed")
 })
 
 test_that("Test helper functions for aggregated covariate data", {
   skip_if_not(runTestsOnEunomia)
-  expect_error(filterByCohortDefinitionId("blah", 1), "not of class CovariateData")
+  expect_error(filterByCohortDefinitionIds("blah", cohortIds = c(1)), "not of class CovariateData")
 
   aggregatedCovariateData <- getDbCovariateData(connection = eunomiaConnection,
                                                 cdmDatabaseSchema = eunomiaCdmDatabaseSchema,
@@ -36,10 +36,10 @@ test_that("Test helper functions for aggregated covariate data", {
                                                 covariateSettings = createCovariateSettings(useDemographicsAgeGroup = TRUE, useChads2Vasc = TRUE),
                                                 aggregated = TRUE)
 
-  aggCovariateDataFiltered <- filterByCohortDefinitionId(aggregatedCovariateData, 1)
+  aggCovariateDataFiltered <- filterByCohortDefinitionIds(aggregatedCovariateData, cohortIds = c(1))
   expect_equal(unique(pull(aggCovariateDataFiltered$covariates, cohortDefinitionId)), 1)
   expect_error(filterByRowId(aggregatedCovariateData, 1), "Cannot filter aggregated")
   Andromeda::close(aggregatedCovariateData)
-  expect_error(filterByCohortDefinitionId(aggregatedCovariateData, 1), "closed")
+  expect_error(filterByCohortDefinitionIds(aggregatedCovariateData, cohortIds = c(1)), "closed")
 })