Merge pull request #91 from ramses-antibiotics/develop

Ramses v0.4.3

.github/workflows/R-CMD-check.yaml

@@ -4,6 +4,7 @@ on:
       - master
       - develop
       - 'feature/**'
+      - 'bug_fix/**'
   pull_request:
     branches:
       - master

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: Ramses
 Type: Package
 Title: R Package for Antimicrobial Stewardship & Surveillance 
-Version: 0.4.2
+Version: 0.4.3
 Authors@R: c(
     person(given = "Peter",
            family = "Dutey-Magni",
@@ -29,8 +29,8 @@ Depends:
 Imports: 
     RSQLite (>= 2.1.4),
     DBI,
-    dplyr (>= 0.8.3),
-    dbplyr (>= 1.4.2),
+    dplyr (>= 1.0.1),
+    dbplyr (>= 2.1.0),
     magrittr,
     Rdpack (>= 0.7),
     data.table,
@@ -59,7 +59,7 @@ Suggests:
 Remotes: 
     ramses-antibiotics/snomedizer
 RdMacros: Rdpack    
-RoxygenNote: 7.1.1
+RoxygenNote: 7.2.0
 VignetteBuilder: knitr,rmarkdown
 Collate: 
     'Ramses-package.R'

NEWS.md

@@ -1,4 +1,20 @@
 
+# Ramses 0.4.3
+
+*2 August 2022*
+
+## Improvements
+
+* upgrade dependency on packages `dplyr` version >= 1.0.1 and `dbplyr` version >= 2.1.0
+* improve `validate_inpatient_episodes()` [#85](https://github.com/ramses-antibiotics/ramses-package/issues/85)
+
+## Bug fixes
+
+* fix bug in `map_charlson_comorbidities()` with `tbl_df` objects  [#84](https://github.com/ramses-antibiotics/ramses-package/issues/84)
+* fix bug in `compute()` with `TherapyEpisode` objects  [#83](https://github.com/ramses-antibiotics/ramses-package/issues/83)
+* fix uncommon bug in `clinical_feature_*()` functions with PostgreSQL [#88](https://github.com/ramses-antibiotics/ramses-package/issues/88)
+
+
 # Ramses 0.4.2
 
 *28 January 2022*
@@ -95,4 +111,4 @@
 
 *8 January 2021*
 
-* First minor version
+* First minor version

R/clinical_features.R

@@ -40,7 +40,7 @@
     dplyr::summarise(n = dplyr::n()) %>% 
     dplyr::collect() 
 
-  if ( any(db_observation_codes[["n"]] > 1) ) {
+  if ( any(as.numeric(db_observation_codes[["n"]]) > 1) ) {
     stop(paste0(
       "Some codes are ambiguous (exist in multiple code systems): '",
       paste(db_observation_codes[db_observation_codes[["n"]] > 1, 

R/database.R

@@ -1380,7 +1380,7 @@ create_mock_database <- function(file,
         dose,
         units,
         administration_date) %>% 
-      dplyr::mutate(administration_id = dplyr::group_indices()) %>% 
+      dplyr::mutate(administration_id = dplyr::cur_group_id()) %>% 
       dplyr::ungroup()
   }
 

R/metadata.R

@@ -189,7 +189,7 @@ map_charlson_comorbidities <- function(df, icd_column){
     icd_column <- names(df)[icd_column]
   }
 
-  icd <- unique(df[, icd_column])
+  icd <- unique(df[[icd_column]])
   loc <- lapply(charlson_regex, grep, icd, value = TRUE)
   loc <- utils::stack(loc)
   names(loc)[1] <- "icd_code"

R/objects.R

@@ -632,7 +632,7 @@ setMethod("compute", "TherapyEpisode", function(x) {
   if (is(x@conn, "SQLiteConnection")) {
     .create_sql_index(
       conn = x@conn,
-      table = x@therapy_table$ops$x$x,
+      table = dbplyr::remote_name(x@therapy_table),
       fields = c(
         "patient_id",
         "therapy_id",
@@ -642,15 +642,15 @@ setMethod("compute", "TherapyEpisode", function(x) {
   } else {
     .create_sql_primary_key(
       conn = x@conn,
-      table = x@therapy_table$ops$x$x,
+      table = dbplyr::remote_name(x@therapy_table),
       field = "t, patient_id, therapy_id",
-      override_index_name = paste0("idx_pk_", x@therapy_table$ops$x$x)
+      override_index_name = paste0("idx_pk_", dbplyr::remote_name(x@therapy_table))
     )
     .create_sql_index(
       conn = x@conn,
-      table = x@therapy_table$ops$x$x,
+      table = dbplyr::remote_name(x@therapy_table),
       fields = "patient_id, (t_start at time zone 'UTC')",
-      override_index_name = paste0("idx_pt_time_", x@therapy_table$ops$x$x)
+      override_index_name = paste0("idx_pt_time_", dbplyr::remote_name(x@therapy_table))
     )
   }
   x

R/validate_data.R

@@ -29,9 +29,10 @@
   if( any(duplicate_results) ){
     stop(
       simpleError(paste(
-        "The following variables must have unique values:",
+        "The following variables must have unique values",
+        "in the", substitute(data), "dataset:\n",
         paste(paste0("`", 
-                     must_be_unique[duplicate_results],
+                     names(duplicate_results),
                      "`"), collapse = ", "))
       )
     )
@@ -373,6 +374,13 @@ validate_inpatient_episodes <- function(patients,
     stop("All patients in `episodes` must exist in `patients`")
   }
 
+  variable_uniqueness <- .validate_values_unique(
+    data = patients,
+    col_names = patient_schema[
+      patient_schema$must_be_unique, 
+      "variable_name"]
+  )
+
   validation_result <- .validate_inpatient_spells(episodes)
   validation_result <- append(
     .validate_inpatient_episode_dates(data = episodes,
@@ -1394,7 +1402,7 @@ validate_investigations <- function(investigations,
     stop(
       "\nEvery `observation_code` must only be associated with one `observation_unit`.\n",
       "Please convert these observations to a single unit: \n\n ",
-      paste0(capture.output(data.frame(units_mixed[, 1:2])), collapse = "\n"), 
+      paste0(utils::capture.output(data.frame(units_mixed[, 1:2])), collapse = "\n"), 
       call. = FALSE
     )
   }

tests/testthat/test-metadata.R

@@ -6,6 +6,13 @@ test_that("ICD-10-CM downloads and maps to Charlson", {
   expect_true(icd10_charlson[icd10_charlson$icd_code=="J440", "comorb"] == "copd")
   expect_true(icd10_charlson[icd10_charlson$icd_code=="J440", "comorb_group"] == "copd")
   expect_equal(icd10_charlson[icd10_charlson$icd_code=="J440", "charlson_weights"], 1)
+
+  # Bug 84 fix verification
+  icd10cm_tbl <- dplyr::as_tibble(icd10cm)
+  icd10_charlson_tbl <- map_charlson_comorbidities(df = icd10cm_tbl, icd_column = "icd_code")
+  expect_true(icd10_charlson_tbl[icd10_charlson_tbl$icd_code=="J440", "comorb"] == "copd")
+  expect_true(icd10_charlson_tbl[icd10_charlson_tbl$icd_code=="J440", "comorb_group"] == "copd")
+  expect_equal(icd10_charlson_tbl[icd10_charlson_tbl$icd_code=="J440", "charlson_weights"], 1)
 })
 
 test_that("Infection mapping", {