ggplot_rsi example update, more unit tests

NEWS.md

@@ -6,7 +6,7 @@
 * Function `is.rsi.eligible` to check for columns that have valid antimicrobial results, but do not have the `rsi` class yet. Transform the columns of your raw data with: `data %>% mutate_if(is.rsi.eligible, as.rsi)`
 * Functions `as.atc` and `is.atc` to transform/look up antibiotic ATC codes as defined by the WHO. The existing function `guess_atc` is now an alias of `as.atc`.
 * Aliases for existing function `mo_property`: `mo_aerobic`, `mo_family`, `mo_fullname`, `mo_genus`, `mo_gramstain`, `mo_gramstain_nl`, `mo_property`, `mo_species`, `mo_subspecies`, `mo_type`, `mo_type_nl`
-* Function `ab_property` and its aliases: `ab_certe`, `ab_official`, `ab_official_nl`, `ab_property`, `ab_trivial_nl`, `ab_umcg`
+* Function `ab_property` and its aliases: `ab_certe`, `ab_official`, `ab_official_nl`, `ab_property`, `ab_trivial_nl`, `ab_umcg`, `ab_tradenames`
 * Introduction to AMR as a vignette
 
 #### Changed
@@ -22,7 +22,7 @@
   # [1] "R01AX06" "J01CA04" "J01FA10" "J01CF05"
   ```
 * Removed function `ratio` as it is not really the scope of this package
-* Fix in `as.mic` for values ending in zeroes after a real number
+* Fix for `as.mic` for values ending in zeroes after a real number
 * Huge speed improvement for `as.bactid`
 * Added parameters `minimum` and `as_percent` to `portion_df`
 * Support for quasiquotation in the functions series `count_*` and `portions_*`, and `n_rsi`. This allows to check for more than 2 vectors or columns.
@@ -46,7 +46,6 @@
     my_list %>% freq(age)
     my_list %>% freq(sex)
     ```
-* Added "Furabid" as a trade name to Nitrofurantoine in the `antibiotics` data set
 
 #### Other
 * More unit tests to ensure better integrity of functions

R/ggplot_rsi.R

@@ -23,7 +23,6 @@
 #' @param position position adjustment of bars, either \code{"stack"} (default when \code{fun} is \code{\link{portion_df}}) or \code{"dodge"} (default when \code{fun} is \code{\link{count_df}})
 #' @param x variable to show on x axis, either \code{"Antibiotic"} (default) or \code{"Interpretation"} or a grouping variable
 #' @param fill variable to categorise using the plots legend, either \code{"Antibiotic"} (default) or \code{"Interpretation"} or a grouping variable
-# @param params a list with parameters passed on to the new \code{geom_rsi} layer, like \code{alpha} and \code{width}
 #' @param facet variable to split plots by, either \code{"Interpretation"} (default) or \code{"Antibiotic"} or a grouping variable
 #' @param translate_ab a column name of the \code{\link{antibiotics}} data set to translate the antibiotic abbreviations into, using \code{\link{abname}}. Default behaviour is to translate to official names according to the WHO. Use \code{translate_ab = FALSE} to disable translation.
 #' @param fun function to transform \code{data}, either \code{\link{portion_df}} (default) or \code{\link{count_df}}
@@ -66,10 +65,24 @@
 #'   select(amox, nitr, fosf, trim, cipr) %>%
 #'   ggplot_rsi()
 #'
+#' # for colourblind mode, use divergent colours from the viridis package:
+#' septic_patients %>%
+#'   select(amox, nitr, fosf, trim, cipr) %>%
+#'   ggplot_rsi() + scale_fill_viridis_d()
+#'
 #' # get counts instead of percentages:
 #' septic_patients %>%
 #'   select(amox, nitr, fosf, trim, cipr) %>%
 #'   ggplot_rsi(fun = count_df)
+#'
+#' # add other ggplot2 parameters as you like:
+#' septic_patients %>%
+#'   select(amox, nitr, fosf, trim, cipr) %>%
+#'   ggplot_rsi(width = 0.5,
+#'              colour = "black",
+#'              size = 1,
+#'              linetype = 2,
+#'              alpha = 0.25)
 #' \donttest{
 #' # it also supports groups (don't forget to use the group on `x` or `facet`):
 #' septic_patients %>%
@@ -98,7 +111,7 @@
 #'   left_join_microorganisms() %>%
 #'   # select full name and some antiseptic drugs
 #'   select(mo = fullname,
-#'             cfur, gent, cipr) %>%
+#'          cfur, gent, cipr) %>%
 #'   # group by MO
 #'   group_by(mo) %>%
 #'   # plot the thing, putting MOs on the facet
@@ -152,7 +165,6 @@ ggplot_rsi <- function(data,
 geom_rsi <- function(position = NULL,
                      x = c("Antibiotic", "Interpretation"),
                      fill = "Interpretation",
-                     # params = list(),
                      translate_ab = "official",
                      fun = portion_df,
                      ...)  {
@@ -182,10 +194,6 @@ geom_rsi <- function(position = NULL,
 
   options(get_antibiotic_names = translate_ab)
 
-  # if (!is.list(params)) {
-  #   params <- as.list(params)
-  # }
-
   ggplot2::layer(geom = "bar", stat = "identity", position = position,
                  mapping = ggplot2::aes_string(x = x, y = y, fill = fill),
                  data = fun, params = list(...))

README.md

@@ -151,16 +151,18 @@ library(dplyr)
 library(ggplot2)
 
 septic_patients %>%
-  select(amox, cipr) %>%
+  select(amox, nitr, fosf, trim, cipr) %>%
   ggplot_rsi()
 ```
 
 ![example_2_rsi](man/figures/rsi_example2.png)
 
+Adjust it with any parameter you know from the `ggplot2` package:
+
 ```r
 septic_patients %>%
-    select(amox, cipr) %>%
+  select(amox, nitr, fosf, trim, cipr) %>%
-    ggplot_rsi(x = "Interpretation", facet = "Antibiotic")
+  ggplot_rsi(width = 0.5, colour = "black", size = 1, linetype = 2, alpha = 0.25)
 ```
 
 ![example_3_rsi](man/figures/rsi_example3.png)

man/ggplot_rsi.Rd

@@ -83,10 +83,24 @@ septic_patients \%>\%
   select(amox, nitr, fosf, trim, cipr) \%>\%
   ggplot_rsi()
 
+# for colourblind mode, use divergent colours from the viridis package:
+septic_patients \%>\%
+  select(amox, nitr, fosf, trim, cipr) \%>\%
+  ggplot_rsi() + scale_fill_viridis_d()
+
 # get counts instead of percentages:
 septic_patients \%>\%
   select(amox, nitr, fosf, trim, cipr) \%>\%
   ggplot_rsi(fun = count_df)
+
+# add other ggplot2 parameters as you like:
+septic_patients \%>\%
+  select(amox, nitr, fosf, trim, cipr) \%>\%
+  ggplot_rsi(width = 0.5,
+             colour = "black",
+             size = 1,
+             linetype = 2,
+             alpha = 0.25)
 \donttest{
 # it also supports groups (don't forget to use the group on `x` or `facet`):
 septic_patients \%>\%
@@ -115,7 +129,7 @@ septic_patients \%>\%
   left_join_microorganisms() \%>\%
   # select full name and some antiseptic drugs
   select(mo = fullname,
-            cfur, gent, cipr) \%>\%
+         cfur, gent, cipr) \%>\%
   # group by MO
   group_by(mo) \%>\%
   # plot the thing, putting MOs on the facet

tests/testthat/test-atc.R

@@ -33,10 +33,13 @@ test_that("guess_atc works", {
                rep("J01FA01", 8))
 
   expect_identical(class(as.atc("amox")), "atc")
-
+  expect_identical(class(pull(antibiotics, atc)), "atc")
   expect_identical(ab_trivial_nl("Cefmenoxim"), "Cefmenoxim")
 
   expect_warning(as.atc("Z00ZZ00")) # not yet available in data set
+  expect_warning(as.atc("UNKNOWN"))
+
+  expect_output(print(as.atc("amox")))
 
   # first 5 chars of official name
   expect_equal(as.character(as.atc(c("nitro", "cipro"))),

tests/testthat/test-bactid.R

@@ -10,10 +10,13 @@ test_that("as.bactid works", {
   expect_equal(as.character(as.bactid("Escherichia  species")), "ESC")
   expect_equal(as.character(as.bactid(" ESCCOL ")), "ESCCOL")
   expect_equal(as.character(as.bactid("klpn")), "KLEPNE")
+  expect_equal(as.character(as.bactid("Klebsiella")), "KLE")
+  expect_equal(as.character(as.bactid("coagulase negative")), "STACNS")
 
   expect_equal(as.character(as.bactid("P. aer")), "PSEAER") # not Pasteurella aerogenes
 
   expect_equal(as.character(as.bactid("Negative rods")), "GNR")
+  expect_equal(as.character(as.bactid("Gram negative rods")), "GNR")
 
   # GLIMS
   expect_equal(as.character(as.bactid("shiboy")), "SHIBOY")
@@ -65,6 +68,8 @@ test_that("as.bactid works", {
   expect_identical(as.character(guess_bactid("S. salivarius",  Lancefield = FALSE)),  "STCSAL")
   expect_identical(as.character(guess_bactid("S. salivarius",  Lancefield = TRUE)),   "STCGRK") # group K
 
+  library(dplyr)
+
   # select with one column
   expect_identical(
     septic_patients[1:10,] %>%
@@ -88,6 +93,9 @@ test_that("as.bactid works", {
   # unknown results
   expect_warning(as.bactid(c("INVALID", "Yeah, unknown")))
 
+  # too many columns
+  expect_error(septic_patients %>% select(1:3) %>% as.bactid())
+
   # print
   expect_output(print(as.bactid(c("ESCCOL", NA))))
 

tests/testthat/test-eucast.R

@@ -1,6 +1,10 @@
 context("eucast.R")
 
 test_that("EUCAST rules work", {
+
+  expect_error(EUCAST_rules(septic_patients, col_bactid = "Non-existing"))
+
+
   expect_identical(colnames(septic_patients),
                    colnames(suppressWarnings(EUCAST_rules(septic_patients))))
 
@@ -31,4 +35,31 @@ test_that("EUCAST rules work", {
                   coli = "R",           # Colistin
                   stringsAsFactors = FALSE)
   expect_equal(suppressWarnings(EUCAST_rules(a, info = FALSE)), b)
+
+  # pita must be R in Enterobacteriaceae when tica is R
+  library(dplyr)
+  expect_equal(suppressWarnings(
+    septic_patients %>%
+      mutate(tica = as.rsi("R"),
+             pita = as.rsi("S")) %>%
+      EUCAST_rules(col_bactid = "bactid") %>%
+      left_join_microorganisms() %>%
+      filter(family == "Enterobacteriaceae") %>%
+      pull(pita) %>%
+      unique() %>%
+      as.character()),
+    "R")
+  # azit and clar must be equal to eryt
+  expect_equal(suppressWarnings(
+    septic_patients %>%
+      mutate(azit = as.rsi("R"),
+             clar = as.rsi("R")) %>%
+      EUCAST_rules(col_bactid = "bactid") %>%
+      pull(clar)),
+    suppressWarnings(
+      septic_patients %>%
+        EUCAST_rules(col_bactid = "bactid") %>%
+        left_join_microorganisms() %>%
+        pull(eryt)))
+
 })

tests/testthat/test-first_isolate.R

@@ -25,6 +25,20 @@ test_that("first isolates work", {
                       info = TRUE),
         na.rm = TRUE)),
     1426)
+  # and 1449 when not ignoring I
+  expect_equal(
+    suppressWarnings(
+      sum(
+        first_isolate(tbl = septic_patients %>% mutate(keyab = key_antibiotics(.)),
+                      col_date = "date",
+                      col_patient_id = "patient_id",
+                      col_bactid = "bactid",
+                      col_keyantibiotics = "keyab",
+                      ignore_I = FALSE,
+                      type = "keyantibiotics",
+                      info = TRUE),
+        na.rm = TRUE)),
+    1449)
   # and 1430 when using points
   expect_equal(
     suppressWarnings(
@@ -86,10 +100,34 @@ test_that("first isolates work", {
       na.rm = TRUE),
     1501)
 
+  # "No isolates found"
   expect_message(septic_patients %>%
                    mutate(specimen = "test") %>%
                    mutate(first = first_isolate(., "date", "patient_id",
-                                                col_bactid = "bactid", col_specimen = "specimen",
+                                                col_bactid = "bactid",
-                                                filter_specimen = "something_unexisting")))
+                                                col_specimen = "specimen",
+                                                filter_specimen = "something_unexisting",
+                                                output_logical = FALSE)))
+
+  # printing of exclusion message
+  expect_output(septic_patients %>%
+                            first_isolate(col_date = "date",
+                                          col_bactid = "bactid",
+                                          col_patient_id = "patient_id",
+                                          col_testcode = "sex",
+                                          testcodes_exclude = "M"))
+
+  # errors
   expect_error(first_isolate("date", "patient_id", col_bactid = "bactid"))
+  expect_error(first_isolate(septic_patients))
+  expect_error(first_isolate(septic_patients,
+                             col_date = "non-existing col",
+                             col_bactid = "bactid"))
+
+  expect_warning(septic_patients %>%
+                   mutate(bactid = as.character(bactid)) %>%
+                   first_isolate(col_date = "date",
+                                 col_bactid = "bactid",
+                                 col_patient_id = "patient_id"))
+
 })