Merge pull request #203 from darwin-eu/cran_submission

3.1.0
darwin-eu · Jul 12, 2024 · dcaec80 · dcaec80
2 parents 4bb5cb9 + eaa1c45
commit dcaec80
Show file tree

Hide file tree

Showing 8 changed files with 52 additions and 10 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,6 +1,6 @@
 Package: CodelistGenerator
 Title: Identify Relevant Clinical Codes and Evaluate Their Use
-Version: 3.0.0.900
+Version: 3.1.0
 Authors@R: c(
     person("Edward", "Burn", email = "[email protected]", 
     role = c("aut", "cre"),

diff --git a/R/stratifyByDoseUnit.R b/R/stratifyByDoseUnit.R
@@ -69,10 +69,12 @@ stratifyByDoseUnit <- function(x, cdm, keepOriginal = FALSE){
     workingName <- names(x)[i]
 
     workingCodesWithDoseUnit <- cdm[[tableCodelist]] |>
+      dplyr::left_join(cdm$concept,
+                       by = "concept_id")|>
       dplyr::left_join(drugStrengthNamed,
                         by = c("concept_id" = "drug_concept_id")
       ) |>
-      dplyr::select("concept_id",
+      dplyr::select("concept_id", "domain_id",
                     "amount_concept_name",
                     "numerator_concept_name") |>
       dplyr::distinct() |>
@@ -83,9 +85,10 @@ stratifyByDoseUnit <- function(x, cdm, keepOriginal = FALSE){
         unit_group = dplyr::case_when(
           !is.na(.data$amount_concept_name) ~ omopgenerics::toSnakeCase(.data$amount_concept_name),
           !is.na(.data$numerator_concept_name) ~ omopgenerics::toSnakeCase(.data$numerator_concept_name),
-          .default = "unkown_dose_unit"
+          tolower(.data$domain_id) == "drug" ~ "unkown_dose_unit"
         )
-      )
+      ) |>
+      dplyr::filter(!is.na(.data$unit_group))
 
     if(isTRUE(withDetails)){
       workingCodesWithDoseUnit <-  x_original[[i]] |>
@@ -98,8 +101,10 @@ stratifyByDoseUnit <- function(x, cdm, keepOriginal = FALSE){
       workingCodesWithDoseUnit[, c("unit_group")]
     )
 
+    if(length(workingCodesWithDoseUnit)>0){
     names(workingCodesWithDoseUnit) <- paste0(workingName, "_",
                                            names(workingCodesWithDoseUnit))
+    }
 
     if(isFALSE(withDetails)){
       for(j in seq_along(workingCodesWithDoseUnit)){

diff --git a/R/stratifyByRoute.R b/R/stratifyByRoute.R
@@ -32,6 +32,7 @@ stratifyByRouteCategory <- function(x, cdm, keepOriginal = FALSE){
     withDetails <- TRUE
     x <- codelistFromCodelistWithDetails(x)
   } else {
+    omopgenerics::newCodelist(x)
     withDetails <- FALSE
   }
 
@@ -59,23 +60,28 @@ stratifyByRouteCategory <- function(x, cdm, keepOriginal = FALSE){
     workingName <- names(x)[i]
 
     workingCodesWithRoute <- cdm[[tableCodelist]] |>
+      dplyr::left_join(cdm$concept |>
+                         dplyr::select("concept_id", "domain_id"),
+                       by = "concept_id") |>
       dplyr::left_join(cdm$concept_relationship |>
                           dplyr::filter(.data$relationship_id == "RxNorm has dose form"),
                         by = c("concept_id" = "concept_id_1")
       ) |>
       dplyr::select("concept_id",
-                    "concept_id_2") |>
+                    "concept_id_2",
+                    "domain_id") |>
       dplyr::collect() |>
       dplyr::left_join(
         doseRouteData, by = c("concept_id_2" = "dose_form_concept_id")
       ) |>
       dplyr::mutate(route_category = dplyr::if_else(
-        is.na(.data$route_category),
+        is.na(.data$route_category) & (tolower(.data$domain_id) == "drug"),
         "unclassified_route",
         .data$route_category
       )) |>
       dplyr::select("concept_id", "route_category") |>
       dplyr::distinct() |>
+      dplyr::filter(!is.na(.data$route_category)) |>
       dplyr::collect()
 
     if(isTRUE(withDetails)){
@@ -89,8 +95,10 @@ stratifyByRouteCategory <- function(x, cdm, keepOriginal = FALSE){
       workingCodesWithRoute[, c("route_category")]
     )
 
+    if(length(workingCodesWithRoute) > 0){
     names(workingCodesWithRoute) <- paste0(workingName, "_",
                                            names(workingCodesWithRoute))
+    }
 
     if(isFALSE(withDetails)){
     for(j in seq_along(workingCodesWithRoute)){

diff --git a/R/summariseOrphanCodes.R b/R/summariseOrphanCodes.R
@@ -1,4 +1,5 @@
-#' Find orphan codes related to a codelist
+#' Find orphan codes related to a codelist using achilles counts and, if
+#' available, PHOEBE concept recommendations
 #'
 #' @param x A codelist for which to find related codes used in the database
 #' @param cdm cdm_reference via CDMConnector
@@ -68,7 +69,7 @@ summariseOrphanCodes <- function(x,
   } else {
     phoebe <- FALSE
     cli::cli_inform(c("PHOEBE results not available",
-                      "i" = "The concept_recommened table is not present in the cdm."))
+                      "i" = "The concept_recommended table is not present in the cdm."))
   }
 
   orphanCodes <- list()

diff --git a/man/summariseOrphanCodes.Rd b/man/summariseOrphanCodes.Rd
diff --git a/tests/testthat/test-dbms.R b/tests/testthat/test-dbms.R
@@ -324,6 +324,12 @@ test_that("postgres", {
   codes <- getDrugIngredientCodes(cdm, "metformin")
   codes[["asthma"]] <- 317009
 
+  expect_no_error(stratifyByDoseUnit(codes, cdm))
+  expect_no_error(stratifyByDoseUnit(codes, cdm, keepOriginal = TRUE))
+  expect_no_error(stratifyByRouteCategory(codes, cdm))
+  expect_no_error(stratifyByRouteCategory(codes, cdm, keepOriginal = TRUE))
+
+
   drug_codes <- getDrugIngredientCodes(cdm, name = c("metformin",
                                                      "diclofenac"))
 

diff --git a/tests/testthat/test-stratifyByDoseUnit.R b/tests/testthat/test-stratifyByDoseUnit.R
@@ -5,6 +5,15 @@ test_that("stratifyByDoseUnit in mock", {
   # no dose units in the mock
   expect_no_error(stratifyByDoseUnit(x = ing, cdm = cdm))
 
+  # if concepts are not from the drug domain we should get empty codelist back
+  oa <- getCandidateCodes(cdm = cdm, "osteoarthritis")
+  oa_str <- stratifyByDoseUnit(list(oa = oa$concept_id),
+                                    cdm, keepOriginal = FALSE)
+  expect_true(length(oa_str)==0)
+
+  oa_str <- stratifyByDoseUnit(omopgenerics::newCodelistWithDetails(list(oa = oa)),
+                                    cdm, keepOriginal = FALSE)
+  expect_true(length(oa_str)==0)
 
   # expected errors
   expect_error(stratifyByDoseUnit(x = ing, cdm = "a"))

diff --git a/tests/testthat/test-stratifyByRouteCategory.R b/tests/testthat/test-stratifyByRouteCategory.R
@@ -15,6 +15,17 @@ test_that("stratify by route works", {
                                                  keepOriginal = TRUE)
     expect_true(length(ing_codes_str_all) == 4)
 
+
+    # if concepts are not from the drug domain we should get empty codelist back
+    oa <- getCandidateCodes(cdm = cdm, "osteoarthritis")
+    oa_str <- stratifyByRouteCategory(list(oa = oa$concept_id),
+                                      cdm, keepOriginal = FALSE)
+    expect_true(length(oa_str)==0)
+
+    oa_str <- stratifyByRouteCategory(omopgenerics::newCodelistWithDetails(list(oa = oa)),
+                                      cdm, keepOriginal = FALSE)
+    expect_true(length(oa_str)==0)
+
     # expected errors
     expect_error(stratifyByRouteCategory("a",  cdm))
     expect_error(stratifyByRouteCategory(ing_codes,  "a"))