Merge pull request #1 from darwin-eu/release123

v1.2.3

.gitignore

@@ -55,3 +55,4 @@ inst/doc
 .Rdata
 .DS_Store
 .quarto
+/revdep/

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: PatientProfiles
 Type: Package
 Title: Identify Characteristics of Patients in the OMOP Common Data Model
-Version: 1.2.1.900
+Version: 1.2.3
 Authors@R: c(
     person("Marti", "Catala", , "marti.catalasabate@ndorms.ox.ac.uk", 
     role = c("aut", "cre"), comment = c(ORCID = "0000-0003-3308-9905")),
@@ -47,15 +47,13 @@ Suggests:
     withr,
     scales
 Imports: 
-    magrittr,
     CDMConnector (>= 1.3.1),
     dplyr,
     tidyr,
     rlang,
     cli,
     stringr,
-    omopgenerics (>= 0.2.0),
-    visOmopResults (>= 0.2.0),
+    omopgenerics (>= 0.4.0),
     purrr,
     lifecycle
 URL: https://darwin-eu.github.io/PatientProfiles/

NAMESPACE

@@ -1,6 +1,5 @@
 # Generated by roxygen2: do not edit by hand
 
-export("%>%")
 export(addAge)
 export(addAgeQuery)
 export(addCategories)
@@ -47,7 +46,7 @@ export(startDateColumn)
 export(summariseResult)
 export(suppress)
 export(variableTypes)
-importFrom(magrittr,"%>%")
+importFrom(dplyr,"%>%")
 importFrom(omopgenerics,settings)
 importFrom(omopgenerics,suppress)
 importFrom(rlang,"%||%")

NEWS.md

@@ -1,3 +1,22 @@
+
+# PatientProfiles 1.2.3
+
+* Bug fix to correct NA columns when not in observation by @catalamarti
+
+# PatientProfiles 1.2.2
+
+* Update links and codecoverage by @catalamarti
+* Distinct individuals in addObservationPeriodId() by @martaalcalde
+* Remove dependencies on visOmopResults and magrittr @catalamarti
+
+# PatientProfiles 1.2.1
+
+* edge case where no concept in concept table by @edward-burn
+* update assertions in addDeath functions by @catalamarti
+* increase test coverage by @catalamarti
+* add internal compute to addInObservation by @edward-burn
+* conceptIntersect inObservation argument by @edward-burn
+
 # PatientProfiles 1.2.0
 
 * `addObservationPeriodId()` is a new function that adds the number of 

R/PatientProfiles-package.R

@@ -18,6 +18,7 @@
 "_PACKAGE"
 
 ## usethis namespace: start
+#' @importFrom dplyr %>%
 #' @importFrom rlang %||%
 #' @importFrom rlang .data
 #' @importFrom rlang .env

R/addCategories.R

@@ -21,8 +21,7 @@
 #' @param categories List of lists of named categories with lower and upper
 #' limit.
 #' @param missingCategoryValue Value to assign to those individuals not in
-#' any named category. If NULL or NA, missing will values will be
-#' given.
+#' any named category. If NULL or NA, missing values will not be changed.
 #' @param overlap TRUE if the categories given overlap.
 #' @param name Name of the new table, if NULL a temporary table is returned.
 #'
@@ -34,8 +33,8 @@
 #' \donttest{
 #' cdm <- mockPatientProfiles()
 #'
-#' result <- cdm$cohort1 %>%
-#'   addAge() %>%
+#' result <- cdm$cohort1 |>
+#'   addAge() |>
 #'   addCategories(
 #'     variable = "age",
 #'     categories = list("age_group" = list(
@@ -80,15 +79,15 @@ addCategories <- function(x,
   x <- warnOverwriteColumns(x, nameStyle = nam)
 
   if (
-    utils::head(x, 1) %>%
-      dplyr::pull(dplyr::all_of(variable)) %>%
+    utils::head(x, 1) |>
+      dplyr::pull(dplyr::all_of(variable)) |>
       inherits("Date")
   ) {
-    rand1 <- paste0("extra_", sample(letters, 5, TRUE) %>% paste0(collapse = ""))
-    rand2 <- paste0("extra_", sample(letters, 6, TRUE) %>% paste0(collapse = ""))
-    x <- x %>%
+    rand1 <- paste0("extra_", sample(letters, 5, TRUE) |> paste0(collapse = ""))
+    rand2 <- paste0("extra_", sample(letters, 6, TRUE) |> paste0(collapse = ""))
+    x <- x |>
       dplyr::mutate(!!rand1 := as.Date("1970-01-01")) %>%
-      dplyr::mutate(!!rand2 := !!CDMConnector::datediff(rand1, variable)) %>%
+      dplyr::mutate(!!rand2 := !!CDMConnector::datediff(rand1, variable)) |>
       dplyr::select(-dplyr::all_of(rand1))
     variable <- rand2
     categories <- lapply(categories, function(x) {
@@ -109,7 +108,7 @@ addCategories <- function(x,
       overlap = overlap
     )
     if (date & is.null(names(categories[[k]]))) {
-      categoryTibble[[nam[k]]] <- categoryTibble[[nam[k]]] %>%
+      categoryTibble[[nam[k]]] <- categoryTibble[[nam[k]]] |>
         dplyr::mutate(category_label = paste(
           as.Date(.data$lower_bound, origin = "1970-01-01"), "to",
           as.Date(.data$lower_bound, origin = "1970-01-01")
@@ -163,18 +162,18 @@ addCategories <- function(x,
           is.null(missingCategoryValue), NA, missingCategoryValue
         ), "\""), sqlCategories)
       }
-      sqlCategories <- sqlCategories %>%
-        rlang::parse_exprs() %>%
+      sqlCategories <- sqlCategories |>
+        rlang::parse_exprs() |>
         rlang::set_names(glue::glue(nm))
-      x <- x %>%
+      x <- x |>
         dplyr::mutate(!!!sqlCategories)
     } else {
       x <- dplyr::mutate(x, !!nm := as.character(NA))
       for (i in 1:nrow(categoryTibbleK)) {
         lower <- categoryTibbleK$lower_bound[i]
         upper <- categoryTibbleK$upper_bound[i]
         category <- categoryTibbleK$category_label[i]
-        x <- x %>%
+        x <- x |>
           dplyr::mutate(!!nm := dplyr::if_else(
             is.na(.data[[nm]]) &
               .data[[variable]] >= .env$lower &
@@ -191,22 +190,22 @@ addCategories <- function(x,
       }
       # add missing as category
       if (!is.null(missingCategoryValue) && !is.na(missingCategoryValue)) {
-        x <- x %>%
+        x <- x |>
           dplyr::mutate(!!nm := dplyr::if_else(!is.na(.data[[nm]]),
             .data[[nm]],
             .env$missingCategoryValue
           ))
       }
     }
 
-    x <- x %>%
+    x <- x |>
       dplyr::compute(
         name = omopgenerics::uniqueTableName(tablePrefix), temporary = FALSE
       )
   }
 
   if (date) {
-    x <- x %>% dplyr::select(-dplyr::all_of(variable))
+    x <- x |> dplyr::select(-dplyr::all_of(variable))
   }
 
   x <- x |> dplyr::compute(name = comp$name, temporary = comp$temporary)

R/addCohortIntersect.R

@@ -39,7 +39,7 @@
 #' \donttest{
 #' cdm <- mockPatientProfiles()
 #'
-#' cdm$cohort1 %>%
+#' cdm$cohort1 |>
 #'   addCohortIntersectFlag(
 #'     targetCohortTable = "cohort2"
 #'   )
@@ -63,7 +63,7 @@ addCohortIntersectFlag <- function(x,
   parameters <- checkCohortNames(cdm[[targetCohortTable]], targetCohortId, targetCohortTable)
   nameStyle <- gsub("\\{cohort_name\\}", "\\{id_name\\}", nameStyle)
 
-  x <- x %>%
+  x <- x |>
     .addIntersect(
       tableName = targetCohortTable,
       filterVariable = parameters$filter_variable,
@@ -108,10 +108,11 @@ addCohortIntersectFlag <- function(x,
 #' \donttest{
 #' cdm <- mockPatientProfiles()
 #'
-#' cdm$cohort1 %>%
+#' cdm$cohort1 |>
 #'   addCohortIntersectCount(
 #'     targetCohortTable = "cohort2"
 #'   )
+#'
 #' mockDisconnect(cdm = cdm)
 #' }
 #'
@@ -132,7 +133,7 @@ addCohortIntersectCount <- function(x,
   parameters <- checkCohortNames(cdm[[targetCohortTable]], targetCohortId, targetCohortTable)
   nameStyle <- gsub("\\{cohort_name\\}", "\\{id_name\\}", nameStyle)
 
-  x <- x %>%
+  x <- x |>
     .addIntersect(
       tableName = targetCohortTable,
       filterVariable = parameters$filter_variable,
@@ -180,10 +181,9 @@ addCohortIntersectCount <- function(x,
 #' \donttest{
 #' cdm <- mockPatientProfiles()
 #'
-#' cdm$cohort1 %>%
-#'   addCohortIntersectDays(
-#'     targetCohortTable = "cohort2"
-#'   )
+#' cdm$cohort1 |>
+#'   addCohortIntersectDays(targetCohortTable = "cohort2")
+#'
 #' mockDisconnect(cdm = cdm)
 #' }
 #'
@@ -204,7 +204,7 @@ addCohortIntersectDays <- function(x,
   parameters <- checkCohortNames(cdm[[targetCohortTable]], targetCohortId, targetCohortTable)
   nameStyle <- gsub("\\{cohort_name\\}", "\\{id_name\\}", nameStyle)
 
-  x <- x %>%
+  x <- x |>
     .addIntersect(
       tableName = targetCohortTable,
       indexDate = indexDate,
@@ -253,10 +253,9 @@ addCohortIntersectDays <- function(x,
 #' \donttest{
 #' cdm <- mockPatientProfiles()
 #'
-#' cdm$cohort1 %>%
-#'   addCohortIntersectDate(
-#'     targetCohortTable = "cohort2"
-#'   )
+#' cdm$cohort1 |>
+#'   addCohortIntersectDate(targetCohortTable = "cohort2")
+#'
 #' mockDisconnect(cdm = cdm)
 #' }
 #'
@@ -277,7 +276,7 @@ addCohortIntersectDate <- function(x,
   parameters <- checkCohortNames(cdm[[targetCohortTable]], targetCohortId, targetCohortTable)
   nameStyle <- gsub("\\{cohort_name\\}", "\\{id_name\\}", nameStyle)
 
-  x <- x %>%
+  x <- x |>
     .addIntersect(
       tableName = targetCohortTable,
       indexDate = indexDate,

R/addConceptIntersect.R

@@ -189,14 +189,13 @@ subsetTable <- function(x) {
 #'   valid_start_date = as.Date("1900-01-01"),
 #'   valid_end_date = as.Date("2099-01-01"),
 #'   invalid_reason = NA_character_
-#' ) %>%
+#' ) |>
 #'   dplyr::mutate(concept_name = paste0("concept: ", .data$concept_id))
 #' cdm <- CDMConnector::insertTable(cdm, "concept", concept)
-#' result <- cdm$cohort1 %>%
-#'   addConceptIntersectFlag(
-#'     conceptSet = list("acetaminophen" = 1125315)
-#'   ) %>%
-#'   dplyr::collect()
+#'
+#' cdm$cohort1 |>
+#'   addConceptIntersectFlag(conceptSet = list("acetaminophen" = 1125315))
+#'
 #' mockDisconnect(cdm = cdm)
 #' }
 #'
@@ -261,14 +260,13 @@ addConceptIntersectFlag <- function(x,
 #'   valid_start_date = as.Date("1900-01-01"),
 #'   valid_end_date = as.Date("2099-01-01"),
 #'   invalid_reason = NA_character_
-#' ) %>%
+#' ) |>
 #'   dplyr::mutate(concept_name = paste0("concept: ", .data$concept_id))
 #' cdm <- CDMConnector::insertTable(cdm, "concept", concept)
-#' result <- cdm$cohort1 %>%
-#'   addConceptIntersectCount(
-#'     conceptSet = list("acetaminophen" = 1125315)
-#'   ) %>%
-#'   dplyr::collect()
+#'
+#' cdm$cohort1 |>
+#'   addConceptIntersectCount(conceptSet = list("acetaminophen" = 1125315))
+#'
 #' mockDisconnect(cdm = cdm)
 #' }
 #'
@@ -333,14 +331,13 @@ addConceptIntersectCount <- function(x,
 #'   valid_start_date = as.Date("1900-01-01"),
 #'   valid_end_date = as.Date("2099-01-01"),
 #'   invalid_reason = NA_character_
-#' ) %>%
+#' ) |>
 #'   dplyr::mutate(concept_name = paste0("concept: ", .data$concept_id))
 #' cdm <- CDMConnector::insertTable(cdm, "concept", concept)
-#' result <- cdm$cohort1 %>%
-#'   addConceptIntersectDate(
-#'     conceptSet = list("acetaminophen" = 1125315)
-#'   ) %>%
-#'   dplyr::collect()
+#'
+#' cdm$cohort1 |>
+#'   addConceptIntersectDate(conceptSet = list("acetaminophen" = 1125315))
+#'
 #' mockDisconnect(cdm = cdm)
 #' }
 #'
@@ -405,14 +402,13 @@ addConceptIntersectDate <- function(x,
 #'   valid_start_date = as.Date("1900-01-01"),
 #'   valid_end_date = as.Date("2099-01-01"),
 #'   invalid_reason = NA_character_
-#' ) %>%
+#' ) |>
 #'   dplyr::mutate(concept_name = paste0("concept: ", .data$concept_id))
 #' cdm <- CDMConnector::insertTable(cdm, "concept", concept)
-#' result <- cdm$cohort1 %>%
-#'   addConceptIntersectDays(
-#'     conceptSet = list("acetaminophen" = 1125315)
-#'   ) %>%
-#'   dplyr::collect()
+#'
+#' cdm$cohort1 |>
+#'   addConceptIntersectDays(conceptSet = list("acetaminophen" = 1125315))
+#'
 #' mockDisconnect(cdm = cdm)
 #' }
 #'

R/addDeath.R

@@ -30,8 +30,10 @@
 #' @examples
 #' \donttest{
 #' cdm <- mockPatientProfiles()
-#' cdm$cohort1 %>%
+#'
+#' cdm$cohort1 |>
 #'   addDeathDate()
+#'
 #' mockDisconnect(cdm = cdm)
 #' }
 #'
@@ -68,8 +70,10 @@ addDeathDate <- function(x,
 #' @examples
 #' \donttest{
 #' cdm <- mockPatientProfiles()
-#' cdm$cohort1 %>%
+#'
+#' cdm$cohort1 |>
 #'   addDeathDays()
+#'
 #' mockDisconnect(cdm = cdm)
 #' }
 #'
@@ -107,8 +111,10 @@ addDeathDays <- function(x,
 #' @examples
 #' \donttest{
 #' cdm <- mockPatientProfiles()
-#' cdm$cohort1 %>%
+#'
+#' cdm$cohort1 |>
 #'   addDeathFlag()
+#'
 #' mockDisconnect(cdm = cdm)
 #' }
 #'