1
0
mirror of https://github.com/msberends/AMR.git synced 2024-12-25 18:46:11 +01:00

ggplot_rsi example update, more unit tests

This commit is contained in:
dr. M.S. (Matthijs) Berends 2018-08-29 16:25:57 +02:00
parent 029157b3be
commit d9e68e0a50
10 changed files with 121 additions and 18 deletions

View File

@ -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

View File

@ -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(...))

View File

@ -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)

Binary file not shown.

Before

Width:  |  Height:  |  Size: 7.7 KiB

After

Width:  |  Height:  |  Size: 8.2 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 7.0 KiB

After

Width:  |  Height:  |  Size: 29 KiB

View File

@ -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

View File

@ -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"))),

View File

@ -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))))

View File

@ -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)))
})

View File

@ -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"))
})