Merge pull request #2 from darwin-eu/release_081

v0.8.1

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: DrugUtilisation
 Title: Summarise Patient-Level Drug Utilisation in Data Mapped to the OMOP 
     Common Data Model 
-Version: 0.8.0
+Version: 0.8.1
 Authors@R: c(
     person(
         "Martí", "Català", email = "marti.catalasabate@ndorms.ox.ac.uk", 

NAMESPACE

@@ -80,6 +80,7 @@ importFrom(omopgenerics,settingsColumns)
 importFrom(omopgenerics,strataColumns)
 importFrom(omopgenerics,suppress)
 importFrom(omopgenerics,tidy)
+importFrom(rlang,"%||%")
 importFrom(rlang,":=")
 importFrom(rlang,.data)
 importFrom(rlang,.env)

NEWS.md

@@ -1,33 +1,43 @@
+# DrugUtilisation 0.8.1
+
+* Arguments recorded in summarise* functions by @catalamarti
+* Improved performance of addIndication, addTreatment, summariseIndication, summariseTreatment by @catalamarti
+
 # DrugUtilisation 0.8.0
 
-* Account for omopgenerics 0.4.0 by @catalamarti
+## New features
 * Add argument ... to generateATC/IngredientCohortSet by @catalamarti
 * benchmarkDrugUtilisation to test all functions by @MimiYuchenGuo
-* Add messages about dropped records in cohort creation by @catalamarti
-* Refactor of table functions following visOmopResults 0.5.0 release by @catalamart
 * Add confidence intervals to PPC by @catalamarti
-* Cast settings to characters by @catalamarti
-* checkVersion utility function for tables and plots by @catalamarti
 * Export erafyCohort by @catalamarti
-* Deprecation warnings to errors for deprecated arguments in geenrateDrugUtilisation by @catalamarti
 * Add numberExposures and daysPrescribed to generate functions by @catalamarti
 * Add subsetCohort and subsetCohortId arguments to cohort creation functions by @catalamarti
 * New function: addDrugRestart by @catalamarti
 * Add initialExposureDuration by @catalamarti
+* add cohortId to summarise* functions by @catalamarti
+* addDaysPrescribed by @catalamarti
+* plotDrugUtilisation by @catalamarti
+
+## Minor updates
+* Account for omopgenerics 0.4.0 by @catalamarti
+* Add messages about dropped records in cohort creation by @catalamarti
+* Refactor of table functions following visOmopResults 0.5.0 release by @catalamart
+* Cast settings to characters by @catalamarti
+* checkVersion utility function for tables and plots by @catalamarti
+* Deprecation warnings to errors for deprecated arguments in geenrateDrugUtilisation by @catalamarti
 * Add message if too many indications by @catalamarti
 * not treated -> untreated by @catalamarti
 * warn overwrite columns by @catalamarti
 * Use omopgenerics assert function by @catalamarti
 * add documentation helpers for consistent argument documentation by @catalamarti
-* allow integer64 in sampleSize by @catalamarti
-* add cohortId to summarise* functions by @catalamarti
-* Fix cast warning in mock by @catalamarti
-* addDaysPrescribed by @catalamarti
 * exposedTime -> daysExposed by @catalamarti
+* Fix cast warning in mock by @catalamarti
 * test addDaysPrescribed by @catalamarti
-* plotDrugUtilisation by @catalamarti
 * refactor plots to use visOmopResults plot tools by @catalamarti
 
+## Bug fix
+* allow integer64 in sampleSize by @catalamarti
+
 # DrugUtilisation 0.7.0
 
 * Deprecate dose specific functions: `addDailyDose`, `addRoute`, 

R/DrugUtilisation-package.R

@@ -2,9 +2,10 @@
 "_PACKAGE"
 
 ## usethis namespace: start
+#' @importFrom dplyr %>%
+#' @importFrom rlang :=
 #' @importFrom rlang .data
 #' @importFrom rlang .env
-#' @importFrom rlang :=
-#' @importFrom dplyr %>%
+#' @importFrom rlang %||%
 ## usethis namespace: end
 NULL

R/addIntersect.R

@@ -62,7 +62,11 @@
 #' )
 #'
 #' cdm$drug_cohort |>
-#'   addIndication("indication_cohorts", indicationWindow = list(c(0, 0))) |>
+#'   addIndication(
+#'     indicationCohortName = "indication_cohorts",
+#'     indicationWindow = list(c(0, 0)),
+#'     unknownIndicationTable = "condition_occurrence"
+#'   ) |>
 #'   glimpse()
 #' }
 #'
@@ -314,7 +318,7 @@ addUnknownIntersect <- function(x, indexDate, censorDate, window, table, prefix)
 collapseIntersections <- function(x, windowNames, nameStyle, prefix, noLabel) {
   windowNames <- glue::glue(nameStyle, window_name = windowNames) |>
     as.character()
-
+  cdm <- omopgenerics::cdmReference(x)
   # get intersections names
   intersections <- colnames(x) |>
     purrr::keep(\(x) startsWith(x, "x_win")) |>
@@ -323,45 +327,69 @@ collapseIntersections <- function(x, windowNames, nameStyle, prefix, noLabel) {
       paste0(x[-(1:2)], collapse = "_")
     }) |>
     unique()
-  if ("unknown" %in% intersections) {
-    noLabel <- paste0(
-      "dplyr::if_else(.data[['x_win{k}_unknown']] == 1L, 'unknown', '", noLabel,
-      "')"
-    )
-  } else {
-    noLabel <- paste0("'", noLabel, "'")
-  }
-  intersections <- intersections[intersections != "unknown"]
-  q <- rep(list(c(1, 0)), length(intersections)) |>
-    rlang::set_names(intersections) |>
-    do.call(what = tidyr::expand_grid)
-  q <- purrr::map_chr(seq_len(nrow(q)), \(i) {
-    win <- "win{k}"
-    leftLab <- glue::glue(".data[['x_{win}_{intersections}']] == {q[i,]}L") |>
-      stringr::str_flatten(collapse = " & ")
-    if (sum(q[i,]) > 0) {
-      rightLab <- paste0(sort(intersections[as.logical(q[i,])]), collapse = " and ")
-      rightLab <- paste0("'", rightLab, "'")
+  unknown <- "unknown" %in% intersections
+  intersections <- sort(intersections[intersections != "unknown"])
+  prefixInternal <- omopgenerics::tmpPrefix()
+  xn <- x
+  for (k in seq_along(windowNames)) {
+    nm <- omopgenerics::uniqueTableName(prefix = prefixInternal)
+
+    cols <- as.character(glue::glue("x_win{k}_{intersections}"))
+
+    if (unknown) {
+      unknownK <- as.character(glue::glue("x_win{k}_unknown"))
     } else {
-      rightLab <- noLabel
+      unknownK <- character()
     }
-    paste0(leftLab, " ~ ", rightLab, "")
-  }) |>
-    paste0(collapse = ",\n")
-  q <- paste0("dplyr::coalesce(dplyr::case_when(", q, "), 'not in observation')")
-  q <- purrr::map_chr(seq_along(windowNames), \(k) {
-    q |>
-      glue::glue(k = k) |>
-      as.character()
-  }) |>
-    rlang::parse_exprs() |>
-    rlang::set_names(windowNames)
-  x |>
-    dplyr::mutate(!!!q) |>
+
+    colName <- windowNames[k]
+    xi <- x |>
+      dplyr::select(dplyr::all_of(c(cols, unknownK))) |>
+      dplyr::distinct() |>
+      dplyr::collect() |>
+      dplyr::filter(!dplyr::if_any(dplyr::everything(), is.na)) |>
+      dplyr::mutate(!!colName := "")
+
+    for (i in seq_along(cols)) {
+      xi <- xi |>
+        dplyr::mutate(!!colName := dplyr::case_when(
+          .data[[cols[i]]] == 1L & .data[[colName]] == "" ~ .env$intersections[i],
+          .data[[cols[i]]] == 1L & .data[[colName]] != "" ~ paste0(.data[[colName]], " and ", .env$intersections[i]),
+          .default = .data[[colName]]
+        ))
+    }
+
+    if (unknown) {
+      xi <- xi |>
+        dplyr::mutate(!!colName := dplyr::if_else(
+          .data[[colName]] == "",
+          dplyr::if_else(.data[[glue::glue('x_win{k}_unknown')]] == 1L, 'unknown', .env$noLabel),
+          .data[[colName]]
+        ))
+    } else {
+      xi <- xi |>
+        dplyr::mutate(!!colName := dplyr::if_else(
+          .data[[colName]] == "", .env$noLabel, .data[[colName]]
+        ))
+    }
+
+    cdm <- omopgenerics::insertTable(cdm = cdm, name = nm, table = xi)
+
+    xn <- xn |>
+      dplyr::left_join(cdm[[nm]], by = c(cols, unknownK))
+
+  }
+  xn <- xn |>
     dplyr::select(!dplyr::starts_with("x_win")) |>
+    dplyr::mutate(dplyr::across(
+      dplyr::all_of(windowNames),
+      \(x) dplyr::coalesce(x, "not in observation")
+    )) |>
     dplyr::compute(
       name = omopgenerics::uniqueTableName(prefix), temporary = FALSE
     )
+  omopgenerics::dropSourceTable(cdm = cdm, name = dplyr::starts_with(prefixInternal))
+  return(xn)
 }
 nameStyleColumns <- function(x, windowNames, nameStyle) {
   tib <- dplyr::tibble(original_name = colnames(x)) |>

R/summariseDrugRestart.R

@@ -83,6 +83,9 @@ summariseDrugRestart <- function(cohort,
     validateCohort()
   switchCohortId <- omopgenerics::validateCohortIdArgument({{switchCohortId}}, cdm[[switchCohortTable]])
 
+  cohortTableName <- omopgenerics::tableName(cohort)
+  cohortTableName[is.na(cohortTableName)] <- "temp"
+
   tmpName <- omopgenerics::uniqueTableName(omopgenerics::tmpPrefix())
 
   ns <- "drug_restart_in_{follow_up_days}_days"
@@ -207,8 +210,11 @@ summariseDrugRestart <- function(cohort,
         result_type = "summarise_drug_restart",
         package_name = "DrugUtilisation",
         package_version = pkgVersion(),
+        cohort_table_name = cohortTableName,
+        switch_cohort_table = switchCohortTable,
+        incident = as.character(incident),
         restrict_to_first_discontinuation = as.character(restrictToFirstDiscontinuation),
-        censor_date = censorDate
+        censor_date = as.character(censorDate %||% "NA")
       )
     )
 

R/summariseDrugUtilisation.R

@@ -109,6 +109,9 @@ summariseDrugUtilisation <- function(cohort,
   }
   conceptSet <- validateConceptSet(conceptSet, call = call)
 
+  cohortTableName <- omopgenerics::tableName(cohort)
+  cohortTableName[is.na(cohortTableName)] <- "temp"
+
   # concept dictionary
   dic <- dplyr::tibble(concept_set = names(conceptSet)) |>
     dplyr::mutate(
@@ -200,7 +203,12 @@ summariseDrugUtilisation <- function(cohort,
       result_id = 1L,
       result_type = "summarise_drug_utilisation",
       package_name = "DrugUtilisation",
-      package_version = pkgVersion()
+      package_version = pkgVersion(),
+      cohort_table_name = cohortTableName,
+      index_date = indexDate,
+      censor_date = as.character(censorDate %||% "NA"),
+      restrict_incident = as.character(restrictIncident),
+      gap_era = as.character(gapEra)
     ))
 }
 

R/summariseIntersect.R

@@ -79,7 +79,7 @@ summariseIndication <- function(cohort,
                                 indexDate = "cohort_start_date",
                                 mutuallyExclusive = TRUE,
                                 censorDate = NULL) {
-  .summariseIntersect(
+  res <- .summariseIntersect(
     cohort = cohort,
     cohortId = {{cohortId}},
     cohortTable = indicationCohortName,
@@ -91,15 +91,24 @@ summariseIndication <- function(cohort,
     indexDate = indexDate,
     censorDate = censorDate,
     nm = "indications"
-  ) |>
+  )
+
+  cohortTableName <- omopgenerics::tableName(cohort)
+  cohortTableName[is.na(cohortTableName)] <- "temp"
+
+  res <- res |>
     omopgenerics::newSummarisedResult(
       settings = dplyr::tibble(
         result_id = 1L,
         result_type = "summarise_indication",
         package_name = "DrugUtilisation",
         package_version = pkgVersion(),
         mutually_exclusive = as.character(mutuallyExclusive),
-        unknown_indication_table = paste0(unknownIndicationTable, collapse = "; ")
+        unknown_indication_table = paste0(unknownIndicationTable, collapse = "; "),
+        cohort_table_name = cohortTableName,
+        indication_cohort_name = indicationCohortName,
+        index_date = indexDate,
+        censor_date = as.character(censorDate %||% "NA")
       )
     )
 }
@@ -149,7 +158,7 @@ summariseTreatment <- function(cohort,
   if (lifecycle::is_present(minCellCount)) {
     lifecycle::deprecate_stop("0.7.0", "summariseTreatment(minCellCount= )")
   }
-  .summariseIntersect(
+  res <- .summariseIntersect(
     cohort = cohort,
     cohortId = {{cohortId}},
     cohortTable = treatmentCohortName,
@@ -161,14 +170,23 @@ summariseTreatment <- function(cohort,
     indexDate = indexDate,
     censorDate = censorDate,
     nm = "medications"
-  ) |>
+  )
+
+  cohortTableName <- omopgenerics::tableName(cohort)
+  cohortTableName[is.na(cohortTableName)] <- "temp"
+
+  res <- res |>
     omopgenerics::newSummarisedResult(
       settings = dplyr::tibble(
         result_id = 1L,
         result_type = "summarise_treatment",
         package_name = "DrugUtilisation",
         package_version = pkgVersion(),
-        mutually_exclusive = as.character(mutuallyExclusive)
+        mutually_exclusive = as.character(mutuallyExclusive),
+        cohort_table_name = cohortTableName,
+        treatment_cohort_name = treatmentCohortName,
+        index_date = as.character(indexDate),
+        censor_date = as.character(censorDate %||% "NA")
       )
     )
 }

R/summariseProportionOfPatientsCovered.R

@@ -41,13 +41,17 @@ summariseProportionOfPatientsCovered <- function(cohort,
   cohort <- validateCohort(cohort)
   cohortId <- omopgenerics::validateCohortIdArgument({{cohortId}}, cohort)
 
+  cohortTableName <- omopgenerics::tableName(cohort)
+  cohortTableName[is.na(cohortTableName)] <- "temp"
+
   cdm <- omopgenerics::cdmReference(cohort)
 
   analysisSettings <- dplyr::tibble(
     "result_id" = 1L,
     "result_type" = "summarise_proportion_of_patients_covered",
     package_name = "DrugUtilisation",
-    package_version = pkgVersion()
+    package_version = pkgVersion(),
+    cohort_table_name = cohortTableName
   )
   if (omopgenerics::isTableEmpty(cohort)) {
     cli::cli_warn("No records found in cohort table")