Merge pull request #108 from OHDSI/develop

update to v2.0.9

Author: mdlavallee92

.github/workflows/R_CMD_check_Hades.yaml

@@ -20,13 +20,13 @@ jobs:
       fail-fast: false
       matrix:
         config:
-          - {os: windows-latest, r: 'release'}  # Does not appear to have Java 32-bit, hence the --no-multiarch
+          - {os: windows-latest, r: 'release'}
           - {os: macOS-latest, r: 'release'}
           - {os: ubuntu-20.04, r: 'release', rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest"}
 
-
     env:
       GITHUB_PAT: ${{ secrets.GH_TOKEN }}
+      CODECOV_TOKEN: ${{ secrets.CODECOV_TOKEN }}
       R_REMOTES_NO_ERRORS_FROM_WARNINGS: true
       RSPM: ${{ matrix.config.rspm }}
       CDM5_ORACLE_CDM_SCHEMA: ${{ secrets.CDM5_ORACLE_CDM_SCHEMA }}
@@ -44,85 +44,64 @@ jobs:
       CDM5_SQL_SERVER_PASSWORD: ${{ secrets.CDM5_SQL_SERVER_PASSWORD }}
       CDM5_SQL_SERVER_SERVER: ${{ secrets.CDM5_SQL_SERVER_SERVER }}
       CDM5_SQL_SERVER_USER: ${{ secrets.CDM5_SQL_SERVER_USER }}
+      CDM5_REDSHIFT_CDM_SCHEMA: ${{ secrets.CDM5_REDSHIFT_CDM_SCHEMA }}
+      CDM5_REDSHIFT_OHDSI_SCHEMA: ${{ secrets.CDM5_REDSHIFT_OHDSI_SCHEMA }}
+      CDM5_REDSHIFT_PASSWORD: ${{ secrets.CDM5_REDSHIFT_PASSWORD }}
+      CDM5_REDSHIFT_SERVER: ${{ secrets.CDM5_REDSHIFT_SERVER }}
+      CDM5_REDSHIFT_USER: ${{ secrets.CDM5_REDSHIFT_USER }}
+      CDM5_SPARK_USER: ${{ secrets.CDM5_SPARK_USER }}
+      CDM5_SPARK_PASSWORD: ${{ secrets.CDM5_SPARK_PASSWORD }}
+      CDM5_SPARK_CONNECTION_STRING: ${{ secrets.CDM5_SPARK_CONNECTION_STRING }}
+      WEBAPI_TEST_WEBAPI_URL: ${{ secrets.WEBAPI_TEST_WEBAPI_URL }}
+      WEBAPI_TEST_SECURE_WEBAPI_URL: ${{ secrets.WEBAPI_TEST_SECURE_WEBAPI_URL }}
+      WEBAPI_TEST_ADMIN_USER_NAME: ${{ secrets.WEBAPI_TEST_ADMIN_USER_NAME }}
+      WEBAPI_TEST_ADMIN_USER_PASSWORD: ${{ secrets.WEBAPI_TEST_ADMIN_USER_PASSWORD }}
 
     steps:
       - uses: actions/checkout@v3
 
       - uses: r-lib/actions/setup-r@v2
         with:
           r-version: ${{ matrix.config.r }}
-          use-public-rspm: true
 
       - uses: r-lib/actions/setup-tinytex@v2
 
       - uses: r-lib/actions/setup-pandoc@v2
 
-      - name: Query dependencies
-        run: |
-          install.packages('remotes')
-          saveRDS(remotes::dev_package_deps(dependencies = TRUE), ".github/depends.Rds", version = 2)
-          writeLines(sprintf("R-%i.%i", getRversion()$major, getRversion()$minor), ".github/R-version")
-        shell: Rscript {0}
-
-      - name: Cache R packages
-        if: runner.os != 'Windows'
-        uses: actions/cache@v2
-        with:
-          path: ${{ env.R_LIBS_USER }}
-          key: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1-${{ hashFiles('.github/depends.Rds') }}
-          restore-keys: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1-
-
-      - name: Install system dependencies
+      - name: Install system requirements
         if: runner.os == 'Linux'
         run: |
+          sudo apt-get install -y libssh-dev
+          Rscript -e 'install.packages("remotes")'
           while read -r cmd
           do
             eval sudo $cmd
           done < <(Rscript -e 'writeLines(remotes::system_requirements("ubuntu", "20.04"))')
 
-      - name: Install libssh
-        if: runner.os == 'Linux'
-        run: |
-          sudo apt-get install libssh-dev
-
-      - name: Install dependencies
-        run: |
-          install.packages("curl")
-          remotes::install_deps(dependencies = TRUE, INSTALL_opts=c("--no-multiarch"))
-          remotes::install_cran("rcmdcheck")
-        shell: Rscript {0}
-
-      - name: Install covr
-        if: runner.os == 'macOS'
-        run: |
-          remotes::install_cran("covr")
-        shell: Rscript {0}
-
-      - name: Remove check folder if exists
-        if: runner.os == 'macOS'
-        run: unlink("check", recursive = TRUE)
-        shell: Rscript {0}
-
-      - name: Check
-        env:
-          _R_CHECK_CRAN_INCOMING_REMOTE_: false
-        run: rcmdcheck::rcmdcheck(args = c("--no-manual", "--as-cran", "--no-multiarch"), error_on = "warning", check_dir = "check")
-        shell: Rscript {0}
+      - uses: r-lib/actions/setup-r-dependencies@v2
+        with:
+          extra-packages: any::rcmdcheck
+          needs: check
 
-      - name: Upload check results
-        if: failure()
-        uses: actions/upload-artifact@v2
+      - uses: r-lib/actions/check-r-package@v2
         with:
-          name: ${{ runner.os }}-r${{ matrix.config.r }}-results
-          path: check
+          args: 'c("--no-manual", "--as-cran")'
+          error-on: '"warning"'
+          check-dir: '"check"'
 
       - name: Upload source package
         if: success() && runner.os == 'macOS' && github.event_name != 'pull_request' && github.ref == 'refs/heads/main'
-        uses: actions/upload-artifact@v2
+        uses: actions/upload-artifact@v4
         with:
           name: package_tarball
           path: check/*.tar.gz
 
+      - name: Install covr
+        if: runner.os == 'macOS'
+        run: |
+          install.packages("covr")
+        shell: Rscript {0}
+
       - name: Test coverage
         if: runner.os == 'macOS'
         run: covr::codecov()
@@ -182,7 +161,7 @@ jobs:
 
       - name: Download package tarball
         if: ${{ env.new_version != '' }}
-        uses: actions/download-artifact@v2
+        uses: actions/download-artifact@v4.1.7
         with:
           name: package_tarball
 

DESCRIPTION

@@ -1,9 +1,10 @@
 Package: Capr
 Title: Cohort Definition Application Programming
-Version: 2.0.8
+Version: 2.0.9
 Authors@R: c(
     person("Martin", "Lavallee", , "martin.lavallee@boehringer-ingelheim.com", role = c("aut", "cre")),
-    person("Adam", "Black", , "black@ohdsi.org", role = c("aut"))
+    person("Adam", "Black", , "black@ohdsi.org", role = c("aut")),
+    person("Katy", "Sadowski", , "sadowski@ohdsi.org", role = c("ctb"))
   )
 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 
@@ -16,11 +17,10 @@ License: Apache License (>= 2)
 URL: https://ohdsi.github.io/Capr/, https://github.com/OHDSI/Capr/
 BugReports: https://github.com/OHDSI/Capr/issues/
 Encoding: UTF-8
-RoxygenNote: 7.3.1
+RoxygenNote: 7.3.2
 Depends: 
-  R (>= 3.5.0)
+  R (>= 4.2.0)
 Imports: 
-    magrittr (>= 1.5.0),
     jsonlite,
     methods,
     purrr (>= 1.0.1),
@@ -61,4 +61,3 @@ Collate:
     'exit.R'
     'cohort.R'
     'collectCodesetId.R'
-    'utils.R'

NAMESPACE

@@ -1,7 +1,6 @@
 # Generated by roxygen2: do not edit by hand
 
 S3method(compile,Cohort)
-export("%>%")
 export(age)
 export(as.json)
 export(atLeast)
@@ -76,10 +75,10 @@ export(withAtMost)
 export(writeCohort)
 export(writeConceptSet)
 exportMethods("==")
+exportMethods(as.data.frame)
 exportMethods(compile)
 import(dplyr)
 importFrom(generics,compile)
-importFrom(magrittr,"%>%")
 importFrom(methods,"slot<-")
 importFrom(rlang,"%||%")
 importFrom(rlang,":=")

NEWS.md

@@ -1,3 +1,12 @@
+Capr 2.0.9
+==========
+- convert duplicate concept ids to a warning instead of error #107
+- add as.json function for cohorts #97
+- fix vignette for nested cohort example #106
+- add type to `startDate` and `endDate` attributes to make Era dates #103
+- remove magrittr pipe dependency #100
+- export as.data.frame #104
+
 Capr 2.0.8
 ==========
 - add conceptTypes to determine data provenance #93

R/Capr.R

@@ -1,4 +1,4 @@
-# Copyright 2024 Observational Health Data Sciences and Informatics
+# Copyright 2025 Observational Health Data Sciences and Informatics
 #
 # This file is part of Capr
 #

R/attributes-op.R

@@ -83,8 +83,8 @@ setClass("opAttributeDate",
 
 opToPrint <- function(x) {
   tibble::tibble(symbol = c("<", "<=", ">", ">=", "==", "-", "!-"), op = c("lt", "lte", "gt", "gte",
-                                                                           "eq", "bt", "!bt")) %>%
-    dplyr::filter(.data$op == x) %>%
+                                                                           "eq", "bt", "!bt")) |>
+    dplyr::filter(.data$op == x) |>
     dplyr::pull(.data$symbol)
 }
 
@@ -485,45 +485,75 @@ 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
+#' @param type specify the type of date to use either occurrence or era. default as occurrence
 #' @return An attribute that can be used in a cohort definition
 #' @export
-startDate <- function(op) {
+startDate <- function(op, type = "occurrence") {
+
+  type <- match.arg(type, choices = c("occurrence", "era"))
 
   check <- all(grepl("opAttribute(Date|Super)", methods::is(op)))
   if (!check) {
     stop("Input must be an opAttributeDate.")
   }
 
-  methods::new("opAttributeDate",
-               name = "OccurrenceStartDate",
-               op = op@op,
-               value = op@value,
-               extent = op@extent)
+  if (type == "occurrence") {
+    sd <- methods::new("opAttributeDate",
+                 name = "OccurrenceStartDate",
+                 op = op@op,
+                 value = op@value,
+                 extent = op@extent)
+  }
+
+  if (type == "era") {
+    sd <- methods::new("opAttributeDate",
+                 name = "EraStartDate",
+                 op = op@op,
+                 value = op@value,
+                 extent = op@extent)
+  }
+  return(sd)
+
 }
 
 #' 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
+#' @param type specify the type of date to use either occurrence or era. default as occurrence
 #' @return An attribute that can be used in a cohort definition
 #' @export
-endDate <- function(op) {
+endDate <- function(op, type = "occurrence") {
+
+  type <- match.arg(type, choices = c("occurrence", "era"))
 
   check <- all(grepl("opAttribute(Date|Super)", methods::is(op)))
   if (!check) {
     stop("Input must be an opAttributeDate.")
   }
 
-  methods::new("opAttributeDate",
-               name = "OccurrenceEndDate",
-               op = op@op,
-               value = op@value,
-               extent = op@extent)
+  if (type == "occurrence") {
+    ed <- methods::new("opAttributeDate",
+                       name = "OccurrenceEndDate",
+                       op = op@op,
+                       value = op@value,
+                       extent = op@extent)
+  }
+
+  if (type == "era") {
+    ed <- methods::new("opAttributeDate",
+                       name = "EraEndDate",
+                       op = op@op,
+                       value = op@value,
+                       extent = op@extent)
+  }
+  return(ed)
+
 }
 
 # Coercion ------------
 #' @importFrom rlang :=
 listOpAttribute <- function(x) {
-  atr <- list(Op = x@op, Value = x@value, Extent = x@extent) %>%
+  atr <- list(Op = x@op, Value = x@value, Extent = x@extent) |>
     purrr::discard(is.na)
 
   tibble::lst(`:=`(!!x@name, atr))

R/cohort.R

@@ -224,7 +224,7 @@ setMethod("as.list", "CohortEntry", function(x) {
     'QualifiedLimit' = list('Type' = x@qualifiedLimit)
   )
 
-  ll <- list('PrimaryCriteria' = pc) %>%
+  ll <- list('PrimaryCriteria' = pc) |>
     append(ac)
 
   if (is.na(ll$AdditionalCriteria$Type)) {
@@ -290,10 +290,10 @@ setMethod("as.list", "CohortEra", function(x) {
 ## Coerce Cohort ----------
 setMethod("as.list", "Cohort", function(x) {
 
-  ll <- as.list(x@entry) %>%
-    append(as.list(x@attrition)) %>%
-    append(as.list(x@exit)) %>%
-    append(as.list(x@era)) %>%
+  ll <- as.list(x@entry) |>
+    append(as.list(x@attrition)) |>
+    append(as.list(x@exit)) |>
+    append(as.list(x@era)) |>
     append(list("cdmVersionRange" = ">=5.0.0"))
 
   return(ll)
@@ -313,7 +313,7 @@ toCirce <- function(cd) {
   cdCirce <- list(
     #start with getting concept set structure
     'ConceptSets' = listConceptSets(cd2)
-  ) %>%
+  ) |>
     #append cohort structure
     append(as.list(cd2))
 
@@ -334,6 +334,16 @@ compile.Cohort <- function(object, ...) {
   as.character(jsonlite::toJSON(toCirce(object), auto_unbox = TRUE, ...))
 }
 
+
+#' @rdname as.json
+#' @aliases as.json,Cohort-method
+setMethod("as.json", "Cohort", function(x, pretty = TRUE, ...) {
+  # Use the existing toCirce function to get the proper structure
+  circe_data <- toCirce(x)
+  # Convert to JSON using jsonlite and ensure it's a character string
+  as.character(jsonlite::toJSON(x = circe_data, pretty = pretty, auto_unbox = TRUE, ...))
+})
+
 #' Compile a Capr cohort to json
 #'
 #' @param object A Capr cohort or list of Capr cohorts
@@ -392,7 +402,7 @@ writeCohort <- function(x, path) {
   checkmate::assertClass(x, "Cohort")
   checkmate::assertCharacter(path, len = 1, min.chars = 1, pattern = "\\.json$")
 
-  toCirce(x) %>%
+  toCirce(x) |>
     jsonlite::write_json(
       path = path,
       auto_unbox = TRUE,
@@ -432,8 +442,8 @@ writeCohort <- function(x, path) {
 
 # capr_to_circe <- function(cd) {
 #
-#   circeJson <- toCirce(cd) %>%
-#     jsonlite::toJSON(auto_unbox = TRUE, pretty = TRUE) %>%
+#   circeJson <- toCirce(cd) |>
+#     jsonlite::toJSON(auto_unbox = TRUE, pretty = TRUE) |>
 #     as.character()
 #
 #   return(circeJson)