diff --git a/NEWS.md b/NEWS.md index 1d940162..6acab483 100755 --- a/NEWS.md +++ b/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,8 +46,7 @@ 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 diff --git a/R/ggplot_rsi.R b/R/ggplot_rsi.R index 89e6ffce..fb8163df 100644 --- a/R/ggplot_rsi.R +++ b/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(...)) diff --git a/README.md b/README.md index 5c3f144b..a02317a0 100755 --- a/README.md +++ b/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) %>% - ggplot_rsi(x = "Interpretation", facet = "Antibiotic") + select(amox, nitr, fosf, trim, cipr) %>% + ggplot_rsi(width = 0.5, colour = "black", size = 1, linetype = 2, alpha = 0.25) ``` ![example_3_rsi](man/figures/rsi_example3.png) diff --git a/man/figures/rsi_example2.png b/man/figures/rsi_example2.png index d9240011..87f4d8b5 100644 Binary files a/man/figures/rsi_example2.png and b/man/figures/rsi_example2.png differ diff --git a/man/figures/rsi_example3.png b/man/figures/rsi_example3.png index 36857cc5..b2136dfa 100644 Binary files a/man/figures/rsi_example3.png and b/man/figures/rsi_example3.png differ diff --git a/man/ggplot_rsi.Rd b/man/ggplot_rsi.Rd index d0029d50..3590696b 100644 --- a/man/ggplot_rsi.Rd +++ b/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 diff --git a/tests/testthat/test-atc.R b/tests/testthat/test-atc.R index 5c09d22a..342aed7f 100755 --- a/tests/testthat/test-atc.R +++ b/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"))), diff --git a/tests/testthat/test-bactid.R b/tests/testthat/test-bactid.R index a86f58dc..8210b3bc 100644 --- a/tests/testthat/test-bactid.R +++ b/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)))) diff --git a/tests/testthat/test-eucast.R b/tests/testthat/test-eucast.R index 2efc363c..d2f977b6 100755 --- a/tests/testthat/test-eucast.R +++ b/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))) + }) diff --git a/tests/testthat/test-first_isolate.R b/tests/testthat/test-first_isolate.R index 2bd1f38f..5f1f973e 100755 --- a/tests/testthat/test-first_isolate.R +++ b/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", - filter_specimen = "something_unexisting"))) + col_bactid = "bactid", + 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")) + })