Merge pull request #78 from OHDSI/develop

Capr v2.0.6 release candidate.

.github/workflows/R_CMD_check_Hades.yaml

@@ -51,6 +51,7 @@ jobs:
       - uses: r-lib/actions/setup-r@v2
         with:
           r-version: ${{ matrix.config.r }}
+          use-public-rspm: true
 
       - uses: r-lib/actions/setup-tinytex@v2
 
@@ -86,6 +87,7 @@ jobs:
 
       - name: Install dependencies
         run: |
+          install.packages("curl")
           remotes::install_deps(dependencies = TRUE, INSTALL_opts=c("--no-multiarch"))
           remotes::install_cran("rcmdcheck")
         shell: Rscript {0}

CRAN-SUBMISSION

@@ -0,0 +1,3 @@
+Version: 2.0.6
+Date: 2023-09-06 18:37:34 UTC
+SHA: 71f1dd8bb419ec22cb023ee8502417a1bb82ccef

DESCRIPTION

@@ -1,20 +1,20 @@
 Package: Capr
 Title: Cohort Definition Application Programming
-Version: 2.0.5
+Version: 2.0.6
 Authors@R: c(
-    person("Martin", "Lavallee", , "mdlavallee92@gmail.com", role = c("aut", "cre")),
-    person("Adam", "Black", , "[email protected]", role = "aut")
+    person("Martin", "Lavallee", , "martin.lavallee@odysseusinc.com", role = c("aut")),
+    person("Adam", "Black", , "[email protected]", role = c("aut", "cre"))
   )
-Description: Provides a programming language for defining OHDSI cohort definitions in R to use in studies for Observational 
+Description: Provides a programming language for defining cohort definitions in R to use in studies for Observational 
     Health Data Sciences and Informatics (OHDSI). The functions in 'Capr' allow for the programmatic creation of 
-    OHDSI concept sets and cohorts that can be serialized to 'Atlas/CIRCE-BE' compatible 'json' files or to 'OHDSI-SQL'. 
+    OHDSI concept sets and cohorts that can be serialized to 'OHDSI' compatible 'json' files or to 'OHDSI-SQL'. 
     'Capr' functions can be used to create, save, and load component parts to a cohort definition allowing 
     R programmers to easily reuse cohort logic. 'Capr' provides tools to create a large number of OHDSI cohorts 
-    programmatically while also helping bridge the gap between human readable descriptions of clinical phenotypes 
-    and their computational implmentation. 
+    while also helping bridge the gap between human readable descriptions of clinical phenotypes
+    and their computational implementation. 
 License: Apache License (>= 2)
-URL: https://ohdsi.github.io/Capr, https://github.com/OHDSI/Capr
-BugReports: https://github.com/OHDSI/Capr/issues
+URL: https://ohdsi.github.io/Capr/, https://github.com/OHDSI/Capr/
+BugReports: https://github.com/OHDSI/Capr/issues/
 Encoding: UTF-8
 RoxygenNote: 7.2.3
 Depends: 
@@ -41,22 +41,26 @@ Imports:
     SqlRender,
     generics
 Suggests:
-  testthat (>= 3.0.0),
-  knitr,
-  rmarkdown
+    testthat (>= 3.0.0),
+    knitr,
+    rmarkdown
+Enhances:
+    CirceR
 VignetteBuilder: knitr
 Config/testthat/edition: 3
+Additional_repositories: https://OHDSI.github.io/drat
 Collate: 
     'Capr.R'
     'conceptSet.R'
+    'attributes-concept.R'
+    'attributes-dateAdjustment.R'
+    'attributes-logic.R'
     'query.R'
     'window.R'
     'criteria.R'
-    'exit.R'
-    'cohort.R'
-    'attributes-concept.R'
-    'attributes-logic.R'
     'attributes-nested.R'
     'attributes-op.R'
+    'exit.R'
+    'cohort.R'
     'collectCodesetId.R'
     'utils.R'

NAMESPACE

@@ -10,11 +10,12 @@ export(attrition)
 export(bt)
 export(censoringEvents)
 export(cohort)
-export(compile.Cohort)
+export(compile)
 export(conditionEra)
 export(conditionOccurrence)
 export(continuousObservation)
 export(cs)
+export(dateAdjustment)
 export(daysOfSupply)
 export(death)
 export(descendants)
@@ -36,12 +37,12 @@ export(exit)
 export(female)
 export(firstOccurrence)
 export(fixedExit)
-export(generateCaprTemplate)
 export(getConceptSetDetails)
 export(gt)
 export(gte)
 export(lt)
 export(lte)
+export(makeCohortSet)
 export(male)
 export(mapped)
 export(measurement)
@@ -68,6 +69,7 @@ export(withAtMost)
 export(writeCohort)
 export(writeConceptSet)
 exportMethods("==")
+exportMethods(compile)
 import(dplyr)
 importFrom(generics,compile)
 importFrom(magrittr,"%>%")

NEWS.md

@@ -1,3 +1,11 @@
+
+Capr 2.0.6
+==========
+- correct date attribute names (OccurrenceStartDate, OccurrenceEndDate)
+- add `makeCohortSet()` function to pipe into `CohortGenerator` (from Issue #79)
+- add `dateAdjustment()` function to deploy new circe attribute to a query (from Issue #77)
+- prepare for CRAN release
+
 Capr 2.0.5
 ==========
 - change query functions to match known syntax (i.e. drug => drugExposure, condition => conditionOccurrence)

R/attributes-concept.R

@@ -5,7 +5,7 @@
 #' name the name of the attribute
 #' @slot
 #' conceptSet a list representing the concepts for the attribute
-# @include conceptSet.R
+#' @include conceptSet.R
 setClass("conceptAttribute",
          slots = c(name = "character",
                    conceptSet = "list"  # TODO why is this a list and not a concept set object?
@@ -46,11 +46,9 @@ setMethod("show", "conceptAttribute", function(object) {
 #' attributes male demographic attribute
 #'
 #' @examples
-#' \dontrun{
 #' # Create a cohort of males with Type 1 diabetes
-#' t1dm <- cs(descendants(201254, 435216, 40484648))
-#' t1dm_males <- cohort(condition(t1dm, male()))
-#' }
+#' t1dm <- cs(descendants(201254, 435216, 40484648), name = "type 1 diabetes")
+#' t1dm_males <- cohort(conditionOccurrence(t1dm, male()))
 male <- function() {
 
   methods::new("conceptAttribute",
@@ -68,11 +66,9 @@ male <- function() {
 #' @describeIn
 #' attributes female demographic attribute
 #' @examples
-#' \dontrun{
 #' # Create a cohort of males with Type 1 diabetes
-#' t1dm <- cs(descendants(201254, 435216, 40484648))
-#' t1dm_females <- cohort(condition(t1dm, female()))
-#' }
+#' t1dm <- cs(descendants(201254, 435216, 40484648), name = "type 1 diabetes")
+#' t1dm_females <- cohort(conditionOccurrence(t1dm, female()))
 female <- function() {
 
   methods::new("conceptAttribute",
@@ -88,12 +84,12 @@ female <- function() {
 #' @return
 #' An attribute that can be used in a query function
 #' @export
+#'
+#'
 #' @examples
-#' \dontrun{
 #' # create a unit attribute
 #' unit(8713L)
 #' unit("%")
-#' }
 unit <- function(x) {
   if (missing(x)) {
     rlang::abort("Unit must be specified")

R/attributes-dateAdjustment.R

@@ -0,0 +1,62 @@
+# date Adjustment Attribute
+
+
+# Class ----------------------------
+
+#' An S4 class for a date adjustment attribute
+#' @slot name the name of the attribute
+#' @slot startWith character string either START_DATE or END_DATE
+#' @slot startOffset an integer value, default 0
+#' @slot endWith character string either START_DATE or END_DATE
+#' @slot endOffset an integer value, default 0
+setClass("dateAdjustmentAttribute",
+         slots = c(name = "character",
+                   startWith = "character",
+                   startOffset = "integer",
+                   endWith = "character",
+                   endOffset = "integer"
+         ),
+         prototype = list(
+           name = "DateAdjustment",
+           startWith = "START_DATE",
+           startOffset = 0L,
+           endWith = "END_DATE",
+           endOffset = 0L
+         )
+)
+
+# Builder -----------------
+
+#' Function to create age attribute
+#' @param startWith character string either START_DATE or END_DATE
+#' @param startOffset an integer value, default 0
+#' @param endWith character string either START_DATE or END_DATE
+#' @param endOffset an integer value, default 0
+#' @return A dateAdjustment attribute class that can be used with a query
+#' @export
+dateAdjustment <- function(startWith = "START_DATE",
+                           startOffset = 0L,
+                           endWith = "END_DATE",
+                           endOffset = 0L) {
+
+
+  methods::new("dateAdjustmentAttribute",
+               startWith = startWith,
+               startOffset = startOffset,
+               endWith = endWith,
+               endOffset = endOffset)
+
+}
+
+# Coercion --------------
+
+setMethod("as.list", "dateAdjustmentAttribute", function(x) {
+
+  atr <- list(
+    StartWith = x@startWith,
+    StartOffset = x@startOffset,
+    EndWith = x@endWith,
+    EndOffset = x@endOffset)
+
+  tibble::lst(`:=`(!!x@name, atr))
+})

R/attributes-nested.R

@@ -5,7 +5,8 @@
 #' name the name of the attribute
 #' @slot
 #' conceptSet a list representing the concepts for the attribute
-# @include criteria.R
+#'
+#' @include criteria.R
 setClass("nestedAttribute",
          slots = c(name = "character", group = "Group"),
          prototype = list(name = "CorrelatedCriteria",
@@ -14,16 +15,17 @@ setClass("nestedAttribute",
 
 # Constructor -------------------
 
-#' Function to construct a nested group where all criteria and groups must be satisfied
+#' Construct a nested group where all criteria and groups must be satisfied
 #' @param ...   a set of criteria or groups
 #'
 #' @export
 nestedWithAll <- function(...) {
   items <- list(...)
   methods::new("nestedAttribute",
-               group = methods::new("Group", occurrence = methods::new("Occurrence",
-    type = "all"), criteria = purrr::discard(items, is.Group), group = purrr::keep(items, is.Group)))
-
+               group = methods::new("Group",
+                                    occurrence = methods::new("Occurrence", type = "all"),
+                                    criteria = purrr::discard(items, is.Group),
+                                    group = purrr::keep(items, is.Group)))
 }
 
 #' Function to construct a nested group where any criteria and groups may be satisfied
@@ -32,8 +34,10 @@ nestedWithAll <- function(...) {
 nestedWithAny <- function(...) {
   items <- list(...)
   methods::new("nestedAttribute",
-               group = methods::new("Group", occurrence = methods::new("Occurrence",
-    type = "any"), criteria = purrr::discard(items, is.Group), group = purrr::keep(items, is.Group)))
+               group = methods::new("Group",
+                                    occurrence = methods::new("Occurrence", type = "any"),
+                                    criteria = purrr::discard(items, is.Group),
+                                    group = purrr::keep(items, is.Group)))
 }
 
 #' Function to construct a nested group where at least some of the criteria or groups must be

R/attributes-op.R

@@ -328,6 +328,7 @@ setMethod("nbt", "Date", function(x, y) {
 #' Function to create age attribute
 #' @param op   an opAttribute object that is either numeric or integer that defines the logical
 #'             operation used to determine eligible patient age
+#' @return An age attribute that can be used in a cohort definition
 #' @export
 age <- function(op) {
 
@@ -349,6 +350,7 @@ age <- function(op) {
 #' the op logic.
 #' @param op   an opAttribute object that is either numeric or integer that defines the logical
 #'             operation used to determine eligible number of days of supply
+#' @return An attribute that can be used in a cohort definition
 #' @export
 daysOfSupply <- function(op) {
 
@@ -368,6 +370,7 @@ daysOfSupply <- function(op) {
 #' op logic.
 #' @param op   an opAttribute object that is either numeric or integer that defines the logical
 #'             operation used to determine eligible number of refills
+#' @return An attribute that can be used in a cohort definition
 #' @export
 drugRefills <- function(op) {
 
@@ -391,6 +394,7 @@ drugRefills <- function(op) {
 #' determined by the op logic.
 #' @param op   an opAttribute object that is either numeric or integer that defines the logical
 #'             operation used to determine eligible patient age
+#' @return An attribute that can be used in a cohort definition
 #' @export
 valueAsNumber <- function(op) {
 
@@ -412,6 +416,7 @@ valueAsNumber <- function(op) {
 #' determined by the op logic.
 #' @param op   an opAttribute object that is either numeric or integer that defines the logical
 #'             operation used to determine eligible range high
+#' @return An attribute that can be used in a cohort definition
 #' @export
 rangeHigh <- function(op) {
 
@@ -433,6 +438,7 @@ rangeHigh <- function(op) {
 #' determined by the op logic.
 #' @param op   an opAttribute object that is either numeric or integer that defines the logical
 #'             operation used to determine eligible range low
+#' @return An attribute that can be used in a cohort definition
 #' @export
 rangeLow <- function(op) {
 
@@ -456,6 +462,7 @@ rangeLow <- function(op) {
 #' op logic.
 #' @param op   an opAttribute object that is either numeric or integer that defines the logical
 #'             operation used to determine eligible quantity
+#' @return An attribute that can be used in a cohort definition
 #' @export
 drugQuantity <- function(op) {
 
@@ -478,6 +485,7 @@ drugQuantity <- function(op) {
 #' Function that creates a start date attribute
 #' @param op   an opAttribute object must be a date that defines the logical operation used to
 #'             determine eligible start dates
+#' @return An attribute that can be used in a cohort definition
 #' @export
 startDate <- function(op) {
 
@@ -487,7 +495,7 @@ startDate <- function(op) {
   }
 
   methods::new("opAttributeDate",
-               name = "StartDate",
+               name = "OccurrenceStartDate",
                op = op@op,
                value = op@value,
                extent = op@extent)
@@ -496,6 +504,7 @@ startDate <- function(op) {
 #' Function that creates a end date attribute
 #' @param op   an opAttribute object must be a date that defines the logical operation used to
 #'             determine eligible end dates
+#' @return An attribute that can be used in a cohort definition
 #' @export
 endDate <- function(op) {
 
@@ -505,7 +514,7 @@ endDate <- function(op) {
   }
 
   methods::new("opAttributeDate",
-               name = "EndDate",
+               name = "OccurrenceEndDate",
                op = op@op,
                value = op@value,
                extent = op@extent)