diff --git a/DESCRIPTION b/DESCRIPTION index fbd83a7..150eee1 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: CohortGenerator Type: Package Title: Cohort Generation for the OMOP Common Data Model -Version: 0.11.2 +Version: 0.12.0 Date: 2024-09-30 Authors@R: c( person("Anthony", "Sena", email = "sena@ohdsi.org", role = c("aut", "cre")), @@ -46,6 +46,6 @@ License: Apache License VignetteBuilder: knitr URL: https://ohdsi.github.io/CohortGenerator/, https://github.com/OHDSI/CohortGenerator BugReports: https://github.com/OHDSI/CohortGenerator/issues -RoxygenNote: 7.3.1 +RoxygenNote: 7.3.2 Encoding: UTF-8 Language: en-US diff --git a/NEWS.md b/NEWS.md index 9271fa2..9e617ca 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,10 @@ +CohortGenerator 0.12.0 +====================== + +- Backwards compatable extension to CohortSubsetOperators and cohortSubsetWindows to allow windowing to be logic of any +length + + CohortGenerator 0.11.2 ======================= diff --git a/R/SubsetQueryBuilders.R b/R/SubsetQueryBuilders.R index 4edef34..358dbbc 100644 --- a/R/SubsetQueryBuilders.R +++ b/R/SubsetQueryBuilders.R @@ -49,23 +49,27 @@ CohortSubsetQb <- R6::R6Class( inherit = QueryBuilder, private = list( innerQuery = function(targetTable) { + cohortWindowLogic <- lapply(private$operator$windows, function(window) { + lsql <- " AND (S.@s_cohort_anchor >= DATEADD(d, @window_start_day, T.@window_anchor) AND S.@s_cohort_anchor <= DATEADD(d, @window_end_day, T.@window_anchor))" + SqlRender::render(lsql, + window_anchor = ifelse(window$targetAnchor == "cohortStart", + yes = "cohort_start_date", + no = "cohort_end_date"), + s_cohort_anchor = ifelse(window$subsetAnchor == "cohortStart", + yes = "cohort_start_date", + no = "cohort_end_date"), + window_end_day = window$endDay, + window_start_day = window$startDay) + }) + + cohortWindowLogic <- paste(cohortWindowLogic, collapse = "\n ") + sql <- SqlRender::readSql(system.file("sql", "sql_server", "subsets", "CohortSubsetOperator.sql", package = "CohortGenerator")) sql <- SqlRender::render(sql, target_table = targetTable, output_table = self$getTableObjectId(), - end_window_anchor = ifelse(private$operator$endWindow$targetAnchor == "cohortStart", - yes = "cohort_start_date", - no = "cohort_end_date" - ), - end_window_end_day = private$operator$endWindow$endDay, - end_window_start_day = private$operator$endWindow$startDay, negate = ifelse(private$operator$negate == TRUE, yes = "1", no = "0"), - start_window_anchor = ifelse(private$operator$startWindow$targetAnchor == "cohortStart", - yes = "cohort_start_date", - no = "cohort_end_date" - ), - start_window_end_day = private$operator$startWindow$endDay, - start_window_start_day = private$operator$startWindow$startDay, + cohort_window_logic = cohortWindowLogic, cohort_ids = private$operator$cohortIds, subset_length = ifelse(private$operator$cohortCombinationOperator == "any", yes = 1, diff --git a/R/Subsets.R b/R/Subsets.R index 7bbcc5a..cfab717 100644 --- a/R/Subsets.R +++ b/R/Subsets.R @@ -44,7 +44,8 @@ SubsetCohortWindow <- R6::R6Class( private = list( .startDay = as.integer(0), .endDay = as.integer(0), - .targetAnchor = "cohortStart" + .targetAnchor = "cohortStart", + .subsetAnchor = "cohortStart" ), public = list( #' @description List representation of object @@ -60,6 +61,10 @@ SubsetCohortWindow <- R6::R6Class( objRepr$targetAnchor <- jsonlite::unbox(private$.targetAnchor) } + if (length(private$.subsetAnchor)) { + objRepr$subsetAnchor <- jsonlite::unbox(private$.subsetAnchor) + } + objRepr }, #' To JSON @@ -76,7 +81,8 @@ SubsetCohortWindow <- R6::R6Class( return(all( self$startDay == criteria$startDay, self$endDay == criteria$endDay, - self$targetAnchor == criteria$targetAnchor + self$targetAnchor == criteria$targetAnchor, + self$subsetAnchor == criteria$subsetAnchor )) } ), @@ -107,22 +113,43 @@ SubsetCohortWindow <- R6::R6Class( checkmate::assertChoice(x = targetAnchor, choices = c("cohortStart", "cohortEnd")) private$.targetAnchor <- targetAnchor return(self) + }, + #' @field subsetAnchor Boolean + subsetAnchor = function(subsetAnchor) { + if (missing(subsetAnchor)) { + return(private$.subsetAnchor) + } + checkmate::assertChoice(x = subsetAnchor, choices = c("cohortStart", "cohortEnd")) + private$.subsetAnchor <- subsetAnchor + return(self) } ) ) # createSubsetCohortWindow ------------------------------ -#' A definition of subset functions to be applied to a set of cohorts +#' @title Create a relative time window for cohort subset operations +#' @description +#' This function is used to create a relative time window for +#' cohort subset operations. The cohort window allows you to define an interval +#' of time relative to the target cohort's start/end date and the +#' subset cohort's start/end date. #' @export -#' @param startDay The start day for the window -#' @param endDay The end day for the window -#' @param targetAnchor To anchor using the target cohort's start date or end date +#' @param startDay The start day for the time window +#' @param endDay The end day for the time window +#' @param targetAnchor To anchor using the target cohort's start date or end date. +#' The parameter is specified as 'cohortStart' or 'cohortEnd'. +#' @param subsetAnchor To anchor using the subset cohort's start date or end date. +#' The parameter is specified as 'cohortStart' or 'cohortEnd'. #' @returns a SubsetCohortWindow instance -createSubsetCohortWindow <- function(startDay, endDay, targetAnchor) { +createSubsetCohortWindow <- function(startDay, endDay, targetAnchor, subsetAnchor = NULL) { + if (is.null(subsetAnchor)) + subsetAnchor <- "cohortStart" + window <- SubsetCohortWindow$new() window$startDay <- startDay window$endDay <- endDay window$targetAnchor <- targetAnchor + window$subsetAnchor <- subsetAnchor window } @@ -271,10 +298,27 @@ CohortSubsetOperator <- R6::R6Class( .cohortIds = integer(0), .cohortCombinationOperator = "all", .negate = FALSE, - .startWindow = SubsetCohortWindow$new(), - .endWindow = SubsetCohortWindow$new() + .windows = list() ), public = list( + + #' @param definition json character or list - definition of subset operator + #' + #' @return instance of object + initialize = function(definition = NULL) { + # support backwards compatibility with old style of storing definitions + if (!is.null(definition)) { + oldFormat <- c("startWindow", "endWindow") %in% names(definition) + if (any(oldFormat)) { + definition$startWindow$subsetAnchor <- "cohortStart" + definition$startWindow$subsetAnchor <- "cohortEnd" + definition["windows"] <- list(definition$startWindow, definition$endWindow) + definition$startWindow <- NULL + definition$endWindow <- NULL + } + } + super$initialize(definition) + }, #' to List #' @description List representation of object toList = function() { @@ -282,8 +326,7 @@ CohortSubsetOperator <- R6::R6Class( objRepr$cohortIds <- private$.cohortIds objRepr$cohortCombinationOperator <- jsonlite::unbox(private$.cohortCombinationOperator) objRepr$negate <- jsonlite::unbox(private$.negate) - objRepr$startWindow <- private$.startWindow$toList() - objRepr$endWindow <- private$.endWindow$toList() + objRepr$windows <- lapply(private$.windows, function(x) { x$toList() }) objRepr }, @@ -306,20 +349,23 @@ CohortSubsetOperator <- R6::R6Class( cohortIds <- sprintf("cohorts: (%s)", paste(self$cohortIds, collapse = ", ")) nameString <- paste0(nameString, cohortIds) + windowString <- lapply(self$windows, function(window) { + paste( + "subset", + tolower(SqlRender::camelCaseToTitleCase(window$subsetAnchor)), + "is within D:", + window$startDay, + "- D:", + window$endDay, + "of target", + tolower(SqlRender::camelCaseToTitleCase(window$targetAnchor)) + ) + }) + nameString <- paste( nameString, - "starts within D:", - self$startWindow$startDay, - "- D:", - self$startWindow$endDay, - "of", - tolower(SqlRender::camelCaseToTitleCase(self$startWindow$targetAnchor)), - "and ends D:", - self$endWindow$startDay, - "- D:", - self$endWindow$endDay, - "of", - tolower(SqlRender::camelCaseToTitleCase(self$endWindow$targetAnchor)) + "where", + paste(windowString, collapse = " and ") ) return(paste0(nameString)) @@ -358,34 +404,21 @@ CohortSubsetOperator <- R6::R6Class( private$.negate <- negate self }, - #' @field startWindow The time window to use evaluating the subset cohort - #' start relative to the target cohort - startWindow = function(startWindow) { - if (missing(startWindow)) { - return(private$.startWindow) + #' @field windows list of time windows to use when evaluating the subset + #' cohort relative to the target cohort + windows = function(windows) { + if (missing(windows)) { + return(private$.windows) } - - if (is.list(startWindow)) { - startWindow <- do.call(createSubsetCohortWindow, startWindow) + realWindows <- list() + for (window in windows) { + if (is.list(window)) + window <- do.call(createSubsetCohortWindow, window) + realWindows[[length(realWindows) + 1]] <- window } - checkmate::assertClass(x = startWindow, classes = "SubsetCohortWindow") - private$.startWindow <- startWindow - self - }, - #' @field endWindow The time window to use evaluating the subset cohort - #' end relative to the target cohort - endWindow = function(endWindow) { - if (missing(endWindow)) { - return(private$.endWindow) - } - - if (is.list(endWindow)) { - endWindow <- do.call(createSubsetCohortWindow, endWindow) - } - - checkmate::assertClass(x = endWindow, classes = "SubsetCohortWindow") - private$.endWindow <- endWindow + checkmate::assertList(x = realWindows, types = "SubsetCohortWindow") + private$.windows <- realWindows self } ) @@ -400,19 +433,37 @@ CohortSubsetOperator <- R6::R6Class( #' @param cohortCombinationOperator "any" or "all" if using more than one cohort id allow a subject to be in any cohort #' or require that they are in all cohorts in specified windows #' -#' @param startWindow A SubsetCohortWindow that patients must fall inside (see createSubsetCohortWindow) -#' @param endWindow A SubsetCohortWindow that patients must fall inside (see createSubsetCohortWindow) +#' @param startWindow DEPRECATED: Use `windows` instead. +#' @param endWindow DEPRECATED: Use `windows` instead. +#' @param windows A list of time windows to use to evaluate subset cohorts in relation to the +#' target cohorts. The logic is to always apply these windows with logical AND conditions. +#' See [@seealso [createSubsetCohortWindow()]] for more details on how to create +#' these windows. #' @param negate The opposite of this definition - include patients who do NOT meet the specified criteria #' @returns a CohortSubsetOperator instance -createCohortSubset <- function(name = NULL, cohortIds, cohortCombinationOperator, negate, startWindow, endWindow) { +createCohortSubset <- function(name = NULL, cohortIds, cohortCombinationOperator, negate, windows = list(), startWindow = NULL, endWindow = NULL) { subset <- CohortSubsetOperator$new() subset$name <- name subset$cohortIds <- cohortIds subset$cohortCombinationOperator <- cohortCombinationOperator subset$negate <- negate - subset$startWindow <- startWindow - subset$endWindow <- endWindow + # Start and end windows must always have subset anchor values set to support backwards compatibility + if (!is.null(startWindow) || !is.null(endWindow)) { + warning("Arguments 'startWindow' and 'endWindow' is deprecated. Use 'windows' instead.") + } + + if (!is.null(startWindow)){ + startWindow$subsetAnchor <- "cohortStart" + windows[[length(windows) + 1]] <- startWindow + } + + if (!is.null(endWindow)) { + endWindow$subsetAnchor <- "cohortEnd" + windows[[length(windows) + 1]] <- endWindow + } + + subset$windows <- windows subset } diff --git a/inst/sql/sql_server/subsets/CohortSubsetOperator.sql b/inst/sql/sql_server/subsets/CohortSubsetOperator.sql index d93448d..1d67230 100644 --- a/inst/sql/sql_server/subsets/CohortSubsetOperator.sql +++ b/inst/sql/sql_server/subsets/CohortSubsetOperator.sql @@ -14,8 +14,8 @@ FROM ( FROM @target_table T JOIN @cohort_database_schema.@cohort_table S ON T.subject_id = S.subject_id WHERE S.cohort_definition_id in (@cohort_ids) - AND (S.cohort_start_date >= DATEADD(d, @start_window_start_day, T.@start_window_anchor) AND S.cohort_start_date <= DATEADD(d, @start_window_end_day, T.@start_window_anchor)) - AND (S.cohort_end_date >= DATEADD(d, @end_window_start_day, T.@end_window_anchor) and S.cohort_end_date <= DATEADD(d, @end_window_end_day, T.@end_window_anchor)) + -- AND Cohort lies within window criteria + @cohort_window_logic GROUP BY T.subject_id, T.cohort_start_date, T.cohort_end_date HAVING COUNT (DISTINCT S.COHORT_DEFINITION_ID) >= @subset_length ) A diff --git a/man/CohortSubsetOperator.Rd b/man/CohortSubsetOperator.Rd index 4ce6f6f..4895168 100644 --- a/man/CohortSubsetOperator.Rd +++ b/man/CohortSubsetOperator.Rd @@ -5,7 +5,6 @@ \title{Cohort Subset Operator} \description{ A subset of type cohort - subset a population to only those contained within defined cohort -to List } \section{Super class}{ \code{\link[CohortGenerator:SubsetOperator]{CohortGenerator::SubsetOperator}} -> \code{CohortSubsetOperator} @@ -19,28 +18,25 @@ to List \item{\code{negate}}{Inverse the subset rule? TRUE will take the patients NOT in the subset} -\item{\code{startWindow}}{The time window to use evaluating the subset cohort -start relative to the target cohort} - -\item{\code{endWindow}}{The time window to use evaluating the subset cohort -end relative to the target cohort} +\item{\code{windows}}{list of time windows to use when evaluating the subset +cohort relative to the target cohort} } \if{html}{\out{}} } \section{Methods}{ \subsection{Public methods}{ \itemize{ +\item \href{#method-CohortSubsetOperator-new}{\code{CohortSubsetOperator$new()}} \item \href{#method-CohortSubsetOperator-toList}{\code{CohortSubsetOperator$toList()}} \item \href{#method-CohortSubsetOperator-getAutoGeneratedName}{\code{CohortSubsetOperator$getAutoGeneratedName()}} \item \href{#method-CohortSubsetOperator-clone}{\code{CohortSubsetOperator$clone()}} } } \if{html}{\out{ -
Inherited methods +
Inherited methods
}} \if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-CohortSubsetOperator-new}{}}} +\subsection{Method \code{new()}}{ +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{CohortSubsetOperator$new(definition = NULL)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{definition}}{json character or list - definition of subset operator} +} +\if{html}{\out{
}} +} +\subsection{Returns}{ +instance of object +to List +} +} +\if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-CohortSubsetOperator-toList}{}}} \subsection{Method \code{toList()}}{ diff --git a/man/SubsetCohortWindow.Rd b/man/SubsetCohortWindow.Rd index c0a1e13..2d49f21 100644 --- a/man/SubsetCohortWindow.Rd +++ b/man/SubsetCohortWindow.Rd @@ -14,6 +14,8 @@ Representation of a time window to use when subsetting a target cohort with a su \item{\code{endDay}}{Integer} \item{\code{targetAnchor}}{Boolean} + +\item{\code{subsetAnchor}}{Boolean} } \if{html}{\out{}} } diff --git a/man/createCohortSubset.Rd b/man/createCohortSubset.Rd index d2250e6..e774709 100644 --- a/man/createCohortSubset.Rd +++ b/man/createCohortSubset.Rd @@ -9,8 +9,9 @@ createCohortSubset( cohortIds, cohortCombinationOperator, negate, - startWindow, - endWindow + windows = list(), + startWindow = NULL, + endWindow = NULL ) } \arguments{ @@ -23,9 +24,14 @@ or require that they are in all cohorts in specified windows} \item{negate}{The opposite of this definition - include patients who do NOT meet the specified criteria} -\item{startWindow}{A SubsetCohortWindow that patients must fall inside (see createSubsetCohortWindow)} +\item{windows}{A list of time windows to use to evaluate subset cohorts in relation to the +target cohorts. The logic is to always apply these windows with logical AND conditions. +See [@seealso [createSubsetCohortWindow()]] for more details on how to create +these windows.} -\item{endWindow}{A SubsetCohortWindow that patients must fall inside (see createSubsetCohortWindow)} +\item{startWindow}{DEPRECATED: Use `windows` instead.} + +\item{endWindow}{DEPRECATED: Use `windows` instead.} } \value{ a CohortSubsetOperator instance diff --git a/man/createSubsetCohortWindow.Rd b/man/createSubsetCohortWindow.Rd index 7706d11..5a11552 100644 --- a/man/createSubsetCohortWindow.Rd +++ b/man/createSubsetCohortWindow.Rd @@ -2,20 +2,27 @@ % Please edit documentation in R/Subsets.R \name{createSubsetCohortWindow} \alias{createSubsetCohortWindow} -\title{A definition of subset functions to be applied to a set of cohorts} +\title{Create a relative time window for cohort subset operations} \usage{ -createSubsetCohortWindow(startDay, endDay, targetAnchor) +createSubsetCohortWindow(startDay, endDay, targetAnchor, subsetAnchor = NULL) } \arguments{ -\item{startDay}{The start day for the window} +\item{startDay}{The start day for the time window} -\item{endDay}{The end day for the window} +\item{endDay}{The end day for the time window} -\item{targetAnchor}{To anchor using the target cohort's start date or end date} +\item{targetAnchor}{To anchor using the target cohort's start date or end date. +The parameter is specified as 'cohortStart' or 'cohortEnd'.} + +\item{subsetAnchor}{To anchor using the subset cohort's start date or end date. +The parameter is specified as 'cohortStart' or 'cohortEnd'.} } \value{ a SubsetCohortWindow instance } \description{ -A definition of subset functions to be applied to a set of cohorts +This function is used to create a relative time window for +cohort subset operations. The cohort window allows you to define an interval +of time relative to the target cohort's start/end date and the +subset cohort's start/end date. } diff --git a/tests/testthat/test-SubsetOperations.R b/tests/testthat/test-SubsetOperations.R index 850c5ed..0cc61f5 100644 --- a/tests/testthat/test-SubsetOperations.R +++ b/tests/testthat/test-SubsetOperations.R @@ -6,7 +6,7 @@ test_that("Cohort subset naming and instantitation", { startWindow = createSubsetCohortWindow(0, 90, "cohortStart"), endWindow = createSubsetCohortWindow(0, 50, "cohortEnd") ) - expectedName <- "in all of cohorts: (11, 22) starts within D: 0 - D: 90 of cohort start and ends D: 0 - D: 50 of cohort end" + expectedName <- "in all of cohorts: (11, 22) where subset cohort start is within D: 0 - D: 90 of target cohort start and subset cohort end is within D: 0 - D: 50 of target cohort end" expect_equal(expectedName, cohortSubsetNamed$name) cohortSubsetNamed$name <- "foo" @@ -19,7 +19,7 @@ test_that("Cohort subset naming and instantitation", { startWindow = createSubsetCohortWindow(0, 90, "cohortStart"), endWindow = createSubsetCohortWindow(0, 50, "cohortEnd") ) - expectedName <- "not in any of cohorts: (11, 22) starts within D: 0 - D: 90 of cohort start and ends D: 0 - D: 50 of cohort end" + expectedName <- "not in any of cohorts: (11, 22) where subset cohort start is within D: 0 - D: 90 of target cohort start and subset cohort end is within D: 0 - D: 50 of target cohort end" expect_equal(expectedName, cohortSubsetNamed$name) })