From 7df638f9d402a04fa2de9a6a825e2ad8f7ca19ee Mon Sep 17 00:00:00 2001 From: Ger Inberg Date: Wed, 5 Apr 2023 12:28:50 +0200 Subject: [PATCH] #188 deprecate filterByCohortDefinitionId --- NAMESPACE | 1 + R/CovariateData.R | 15 ++++----------- R/GetCovariates.R | 2 +- R/GetCovariatesFromCohortAttributes.R | 2 +- R/HelperFunctions.R | 20 ++++++++++++++++---- R/UnitTestHelperFunctions.R | 4 ++-- man/createEmptyCovariateData.Rd | 10 +++------- man/filterByCohortDefinitionIds.Rd | 19 +++++++++++++++++++ man/getDbCohortAttrCovariatesData.Rd | 2 +- man/getDbDefaultCovariateData.Rd | 2 +- tests/testthat/test-HelperFunctions.R | 10 +++++----- 11 files changed, 54 insertions(+), 33 deletions(-) create mode 100644 man/filterByCohortDefinitionIds.Rd diff --git a/NAMESPACE b/NAMESPACE index ab4fcd70..78af0562 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -16,6 +16,7 @@ export(createTable1CovariateSettings) export(createTemporalCovariateSettings) export(createTemporalSequenceCovariateSettings) export(filterByCohortDefinitionId) +export(filterByCohortDefinitionIds) export(filterByRowId) export(getDbCohortAttrCovariatesData) export(getDbCovariateData) diff --git a/R/CovariateData.R b/R/CovariateData.R index f8807b33..1b88a27a 100644 --- a/R/CovariateData.R +++ b/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) { diff --git a/R/GetCovariates.R b/R/GetCovariates.R index 4ab453e3..890495a7 100644 --- a/R/GetCovariates.R +++ b/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")) { diff --git a/R/GetCovariatesFromCohortAttributes.R b/R/GetCovariatesFromCohortAttributes.R index 4982d8f1..79cda752 100644 --- a/R/GetCovariatesFromCohortAttributes.R +++ b/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 diff --git a/R/HelperFunctions.R b/R/HelperFunctions.R index abcb37bb..84f5fc74 100644 --- a/R/HelperFunctions.R +++ b/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" diff --git a/R/UnitTestHelperFunctions.R b/R/UnitTestHelperFunctions.R index b91f6371..0fa117e4 100644 --- a/R/UnitTestHelperFunctions.R +++ b/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) -} \ No newline at end of file +} diff --git a/man/createEmptyCovariateData.Rd b/man/createEmptyCovariateData.Rd index 020f5015..da6afbc8 100644 --- a/man/createEmptyCovariateData.Rd +++ b/man/createEmptyCovariateData.Rd @@ -4,21 +4,17 @@ \alias{createEmptyCovariateData} \title{Create an empty CovariateData object} \usage{ -createEmptyCovariateData(cohortId, cohortIds, aggregated, temporal) +createEmptyCovariateData(cohortIds, aggregated, temporal) } \arguments{ -\item{cohortId}{DEPRECATED} - -\item{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.} +\item{cohortIds}{For which cohort IDs should the covariate data be created?} \item{aggregated}{if the covariate data is aggregated} \item{temporal}{if the covariate data is temporal} } \value{ -A logical value. +the empty CovariateData object } \description{ Create an empty CovariateData object diff --git a/man/filterByCohortDefinitionIds.Rd b/man/filterByCohortDefinitionIds.Rd new file mode 100644 index 00000000..ea2c24d6 --- /dev/null +++ b/man/filterByCohortDefinitionIds.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/HelperFunctions.R +\name{filterByCohortDefinitionIds} +\alias{filterByCohortDefinitionIds} +\title{Filter covariates by cohort definition IDs} +\usage{ +filterByCohortDefinitionIds(covariateData, cohortIds) +} +\arguments{ +\item{covariateData}{An object of type \code{CovariateData}} + +\item{cohortIds}{The cohort definitions IDs to keep.} +} +\value{ +An object of type \code{covariateData}. +} +\description{ +Filter covariates by cohort definition IDs +} diff --git a/man/getDbCohortAttrCovariatesData.Rd b/man/getDbCohortAttrCovariatesData.Rd index f3f2d0b4..8dfdf47f 100644 --- a/man/getDbCohortAttrCovariatesData.Rd +++ b/man/getDbCohortAttrCovariatesData.Rd @@ -33,7 +33,7 @@ covariates. If it is a temp table, the name should have a hash prefix, e.g. '#temp_table'. If it is a non-temp table, it should include the database schema, e.g. 'cdm_database.cohort'.} -\item{cohortId}{DEPRECATED:For which cohort ID(s) should covariates be constructed? If set to -1, +\item{cohortId}{DEPRECATED:For which cohort ID should covariates be constructed? If set to -1, covariates will be constructed for all cohorts in the specified cohort table.} diff --git a/man/getDbDefaultCovariateData.Rd b/man/getDbDefaultCovariateData.Rd index f2fbda38..7a058c73 100644 --- a/man/getDbDefaultCovariateData.Rd +++ b/man/getDbDefaultCovariateData.Rd @@ -37,7 +37,7 @@ covariates. If it is a temp table, the name should have a hash prefix, e.g. '#temp_table'. If it is a non-temp table, it should include the database schema, e.g. 'cdm_database.cohort'.} -\item{cohortId}{DEPRECATED:For which cohort ID(s) should covariates be constructed? If set to -1, +\item{cohortId}{DEPRECATED:For which cohort ID should covariates be constructed? If set to -1, covariates will be constructed for all cohorts in the specified cohort table.} diff --git a/tests/testthat/test-HelperFunctions.R b/tests/testthat/test-HelperFunctions.R index de72785b..ed14e871 100644 --- a/tests/testthat/test-HelperFunctions.R +++ b/tests/testthat/test-HelperFunctions.R @@ -17,9 +17,9 @@ 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") @@ -27,7 +27,7 @@ test_that("Test helper functions for non-aggregated covariate data", { 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") })