v2.2.3

darwin-eu · Mar 8, 2024 · ba898af · ba898af
1 parent 361fe1c
commit ba898af
Show file tree

Hide file tree

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

diff --git a/NEWS.md b/NEWS.md
@@ -1,3 +1,12 @@
+# CodelistGenerator 2.2.3
+* Fix for forthcoming breaking change in dependency omopgenerics
+
+# CodelistGenerator 2.2.2
+* Fix for edge case with multiple exclusion criteria
+
+# CodelistGenerator 2.2.1
+* Working with omopgenerics
+
 # CodelistGenerator 2.2.0
 * Added functions findOrphanCodes, restrictToCodesInUse, sourceCodesInUse.
 * Speed improvements in getCandidateCodes from doing search in place (e.g. on database side).

diff --git a/R/achillesCodeUse.R b/R/achillesCodeUse.R
@@ -122,7 +122,7 @@ achillesCodeUse <- function(x,
     tidyr::unite(
       col = "additional_level", dplyr::all_of(cols), sep = " ; ", remove = TRUE
     ) %>%
-    dplyr::select(omopgenerics::resultColumns("summarised_result"))
+    dplyr::select(dplyr::any_of(omopgenerics::resultColumns("summarised_result")))
 
 
 

diff --git a/R/runSearch.R b/R/runSearch.R
@@ -25,8 +25,8 @@ runSearch <- function(keywords,
                       includeAncestor) {
 
   if(!is.null(attr(cdm, "dbcon"))){
-   prefix <- paste0(sample(letters, 5, TRUE),
-                    collapse = "")
+    prefix <- paste0(sample(letters, 5, TRUE),
+                     collapse = "")
   }
 
   # connect to relevant vocabulary tables
@@ -62,17 +62,17 @@ runSearch <- function(keywords,
 
   # will only collect conceptSynonym later if needed
   if (searchInSynonyms == TRUE) {
-  conceptSynonymDb <- conceptSynonymDb %>%
-    dplyr::left_join(
-      conceptDb %>%
-        dplyr::select("concept_id", "domain_id", "standard_concept"),
-      by = "concept_id"
-    )
+    conceptSynonymDb <- conceptSynonymDb %>%
+      dplyr::left_join(
+        conceptDb %>%
+          dplyr::select("concept_id", "domain_id", "standard_concept"),
+        by = "concept_id"
+      )
 
-  conceptSynonymDb <- conceptSynonymDb %>%
-    dplyr::filter(.data$domain_id %in% .env$domains &
-                  .data$standard_concept %in% .env$standardConceptFlags) %>%
-    dplyr::select(-c("domain_id", "standard_concept"))
+    conceptSynonymDb <- conceptSynonymDb %>%
+      dplyr::filter(.data$domain_id %in% .env$domains &
+                      .data$standard_concept %in% .env$standardConceptFlags) %>%
+      dplyr::select(-c("domain_id", "standard_concept"))
 
     conceptSynonym <- conceptSynonymDb %>%
       # dplyr::collect() %>%
@@ -89,7 +89,7 @@ runSearch <- function(keywords,
         by = "drug_concept_id"
       ) %>%
       dplyr::filter(.data$domain_id %in% .env$domains &
-                    .data$standard_concept %in% .env$standardConceptFlags) %>%
+                      .data$standard_concept %in% .env$standardConceptFlags) %>%
       # dplyr::collect() %>%
       dplyr::rename_with(tolower)
   }
@@ -131,19 +131,19 @@ runSearch <- function(keywords,
   # include one of the keywords
   cli::cli_inform("{domains}: Getting concepts to include")
   candidateCodes <- getMatches(
-      words = tidyWords(keywords),
-      conceptDf = workingConcept
-    )
+    words = tidyWords(keywords),
+    conceptDf = workingConcept
+  )
 
   candidateCodes <- candidateCodes %>%
     dplyr::mutate(found_from = "From initial search")
 
   # run exclusion
   if (length(exclude) > 0) {
     if (excludeCodes %>%
-             utils::head(10) %>%
-             dplyr::tally() %>%
-             dplyr::pull("n") > 0) {
+        utils::head(10) %>%
+        dplyr::tally() %>%
+        dplyr::pull("n") > 0) {
       candidateCodes <- candidateCodes %>%
         dplyr::anti_join(
           excludeCodes %>%
@@ -157,16 +157,16 @@ runSearch <- function(keywords,
   # left join back to concept from workingConcept table
   if (searchInSynonyms == TRUE) {
     cli::cli_inform("{domains} domain: Adding concepts using synonymns")
-      candidateCodesInSynonyms <- getMatches(
-        words = tidyWords(keywords),
-        conceptDf = workingconceptSynonym %>%
-          dplyr::rename("concept_name" = "concept_synonym_name")
-      ) %>%
-        dplyr::select("concept_id") %>%
-        dplyr::distinct() %>%
-        dplyr::left_join(workingConcept,
-          by = "concept_id", copy = TRUE
-        )
+    candidateCodesInSynonyms <- getMatches(
+      words = tidyWords(keywords),
+      conceptDf = workingconceptSynonym %>%
+        dplyr::rename("concept_name" = "concept_synonym_name")
+    ) %>%
+      dplyr::select("concept_id") %>%
+      dplyr::distinct() %>%
+      dplyr::left_join(workingConcept,
+                       by = "concept_id", copy = TRUE
+      )
 
     candidateCodes <- dplyr::union_all(
       candidateCodes,
@@ -197,9 +197,9 @@ runSearch <- function(keywords,
   # 5) add any codes lower in the hierarchy
   if (includeDescendants == TRUE) {
     if (candidateCodes %>%
-          utils::head(10) %>%
-          dplyr::tally() %>%
-          dplyr::pull("n") > 0) {
+        utils::head(10) %>%
+        dplyr::tally() %>%
+        dplyr::pull("n") > 0) {
       cli::cli_inform("{domains} domain: Adding descendants")
       candidateCodeDescendants <- addDescendants(
         workingCandidateCodes = candidateCodes,
@@ -212,8 +212,8 @@ runSearch <- function(keywords,
         candidateCodeDescendants %>%
           dplyr::mutate(found_from = "From descendants") %>%
           dplyr::anti_join(candidateCodes %>%
-                      dplyr::select("concept_id"),
-                      by = "concept_id"))
+                             dplyr::select("concept_id"),
+                           by = "concept_id"))
 
       # run exclusion
       if (length(exclude) > 0) {
@@ -224,7 +224,7 @@ runSearch <- function(keywords,
           candidateCodes <- candidateCodes %>%
             dplyr::anti_join(excludeCodes %>%
                                dplyr::select("concept_id"),
-              by = "concept_id", copy = TRUE
+                             by = "concept_id", copy = TRUE
             )
         }
       }
@@ -260,7 +260,7 @@ runSearch <- function(keywords,
             dplyr::pull("n") > 0) {
           candidateCodes <- candidateCodes %>%
             dplyr::anti_join(excludeCodes %>% dplyr::select("concept_id"),
-              by = "concept_id"
+                             by = "concept_id"
             )
         }
       }
@@ -304,7 +304,7 @@ runSearch <- function(keywords,
         dplyr::rename("concept_id" = "concept_id_1") %>%
         dplyr::distinct() %>%
         dplyr::left_join(concept,
-          by = "concept_id", copy = TRUE
+                         by = "concept_id", copy = TRUE
         )
 
       candidateCodes <- dplyr::union_all(
@@ -323,7 +323,7 @@ runSearch <- function(keywords,
           dplyr::pull("n") > 0) {
         candidateCodes <- candidateCodes %>%
           dplyr::anti_join(excludeCodes %>% dplyr::select("concept_id"),
-            by = "concept_id"
+                           by = "concept_id"
           )
       }
     }
@@ -335,7 +335,7 @@ runSearch <- function(keywords,
 
 
   if (nrow(candidateCodes) > 0) {
-  # 8) Finish up
+    # 8) Finish up
     if (domains == "drug") { #add drug_strength information and dose form
       candidateCodes <- candidateCodes %>%
         dplyr::left_join(
@@ -486,22 +486,21 @@ getMatches <- function(words,
 
       }
     }
-    conceptsFound[[i]] <- workingConcepts
-
-    # %>% dplyr::collect()
+    conceptsFound[[i]] <- workingConcepts %>%
+      dplyr::collect()
   }
 
   if(length(conceptsFound)==1){
     conceptsFound <- conceptsFound[[1]] %>% dplyr::distinct()
   } else {
     conceptsFoundList <- list()
+    conceptsFoundList[[1]] <- conceptsFound[[1]]
     for(i in 1:(length(conceptsFound)-1)){
-      conceptsFoundList <- dplyr::union_all(conceptsFound[[i]],
-                                            conceptsFound[[i+1]])
+      conceptsFoundList[[1]] <- dplyr::union_all(conceptsFoundList[[1]],
+                                                 conceptsFound[[i+1]])
 
     }
-    conceptsFound <- conceptsFoundList %>% dplyr::distinct()
-
+    conceptsFound <- conceptsFoundList[[1]] %>% dplyr::distinct()
   }
 
 
@@ -539,13 +538,13 @@ addAncestor <- function(workingCandidateCodes,
     dplyr::select("concept_id") %>%
     dplyr::rename("descendant_concept_id" = "concept_id") %>%
     dplyr::left_join(conceptAncestorDf,
-      by = "descendant_concept_id", copy = TRUE
+                     by = "descendant_concept_id", copy = TRUE
     ) %>%
     dplyr::filter(.data$min_levels_of_separation == "1") %>%
     dplyr::select("ancestor_concept_id") %>%
     dplyr::rename("concept_id" = "ancestor_concept_id") %>%
     dplyr::left_join(conceptDf,
-      by = "concept_id", copy = TRUE
+                     by = "concept_id", copy = TRUE
     )
 
   # keep if not already in candidateCodes

diff --git a/tests/testthat/test-getCandidateCodes.R b/tests/testthat/test-getCandidateCodes.R
@@ -101,6 +101,23 @@ test_that("tests with mock db", {
     )
     expect_true(any(!codes$concept_name %in% "Osteoarthritis of hip"))
 
+    codes <- getCandidateCodes(
+      cdm = cdm,
+      keywords = "arthritis",
+      exclude = c("Osteoarthritis of hip", "something else", "shoulder"),
+      domains = "Condition"
+    )
+    expect_true(all(codes$concept_name != "Osteoarthritis of hip"))
+
+    codes <- getCandidateCodes(
+      cdm = cdm,
+      keywords = "arthritis",
+      exclude = c("something else", "shoulder", "Osteoarthritis of hip"),
+      domains = "Condition"
+    )
+    expect_true(all(codes$concept_name != "Osteoarthritis of hip"))
+
+
     # test non-standard
     codes <- getCandidateCodes(
       cdm = cdm,