From febd0ca8856ada3e158e63e8dac1b164e8260036 Mon Sep 17 00:00:00 2001 From: "Matthijs S. Berends" Date: Thu, 23 Aug 2018 21:27:15 +0200 Subject: [PATCH] geom_rsi - any parameter --- NEWS.md | 2 +- R/bactid.R | 14 ------------ R/freq.R | 22 ++++++++++++++++--- R/ggplot_rsi.R | 33 +++++++++++++++++------------ README.md | 2 ++ man/ggplot_rsi.Rd | 12 +++++------ tests/testthat/test-bactid.R | 8 +++++++ tests/testthat/test-first_isolate.R | 7 ++++++ tests/testthat/test-freq.R | 11 ++++++++++ 9 files changed, 72 insertions(+), 39 deletions(-) diff --git a/NEWS.md b/NEWS.md index 8bd44fb20..ede6b6326 100755 --- a/NEWS.md +++ b/NEWS.md @@ -13,7 +13,7 @@ * `septic_patients %>% portion_S(amcl, gent, pita)` * Edited `ggplot_rsi` and `geom_rsi` so they can cope with `count_df`. The new `fun` parameter has value `portion_df` at default, but can be set to `count_df`. * Fix for `ggplot_rsi` when the `ggplot2` package was not loaded -* Added parameter `alpha` to `ggplot_rsi` and `geom_rsi` +* Added possibility to set any parameter to `geom_rsi` (and `ggplot_rsi`) so you can set your own preferences # 0.3.0 (latest stable version) **Published on CRAN: 2018-08-14** diff --git a/R/bactid.R b/R/bactid.R index e36cd4b4c..2e7848f37 100644 --- a/R/bactid.R +++ b/R/bactid.R @@ -259,20 +259,6 @@ as.bactid <- function(x, Becker = FALSE, Lancefield = FALSE) { } } - # let's try the ID's first - found <- AMR::microorganisms[which(AMR::microorganisms$bactid == x.backup[i]),]$bactid - if (length(found) > 0) { - x[i] <- found[1L] - next - } - - # now try exact match - found <- AMR::microorganisms[which(AMR::microorganisms$fullname == x[i]),]$bactid - if (length(found) > 0) { - x[i] <- found[1L] - next - } - # try any match keeping spaces found <- AMR::microorganisms[which(AMR::microorganisms$fullname %like% x_withspaces[i]),]$bactid if (length(found) > 0) { diff --git a/R/freq.R b/R/freq.R index e1dc7c887..6f31e632a 100755 --- a/R/freq.R +++ b/R/freq.R @@ -350,9 +350,17 @@ frequency_tbl <- function(x, mediandate <- x %>% median(na.rm = TRUE) median_days <- difftime(mediandate, mindate, units = 'auto') %>% as.double() - header <- header %>% paste0(markdown_line, '\nOldest: ', mindate %>% format(formatdates) %>% trimws()) - header <- header %>% paste0(markdown_line, '\nNewest: ', maxdate %>% format(formatdates) %>% trimws(), - ' (+', difftime(maxdate, mindate, units = 'auto') %>% as.double() %>% format(), ')') + if (formatdates == "%H:%M:%S") { + # hms + header <- header %>% paste0(markdown_line, '\nEarliest: ', mindate %>% format(formatdates) %>% trimws()) + header <- header %>% paste0(markdown_line, '\nLatest: ', maxdate %>% format(formatdates) %>% trimws(), + ' (+', difftime(maxdate, mindate, units = 'mins') %>% as.double() %>% format(digits = digits), ' min.)') + } else { + # other date formats + header <- header %>% paste0(markdown_line, '\nOldest: ', mindate %>% format(formatdates) %>% trimws()) + header <- header %>% paste0(markdown_line, '\nNewest: ', maxdate %>% format(formatdates) %>% trimws(), + ' (+', difftime(maxdate, mindate, units = 'auto') %>% as.double() %>% format(digits = digits), ')') + } header <- header %>% paste0(markdown_line, '\nMedian: ', mediandate %>% format(formatdates) %>% trimws(), ' (~', percent(median_days / maxdate_days, round = 0), ')') } @@ -491,6 +499,14 @@ print.frequency_tbl <- function(x, nmax = getOption("max.print.freq", default = opt$nmax <- nmax opt$nmax.set <- TRUE } + dots <- list(...) + if ("markdown" %in% names(dots)) { + if (dots$markdown == TRUE) { + opt$tbl_format <- "markdown" + } else { + opt$tbl_format <- "pandoc" + } + } cat("Frequency table", title, "\n") diff --git a/R/ggplot_rsi.R b/R/ggplot_rsi.R index f4de12675..89e6ffce2 100644 --- a/R/ggplot_rsi.R +++ b/R/ggplot_rsi.R @@ -23,11 +23,11 @@ #' @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 alpha opacity of the fill colours #' @param fun function to transform \code{data}, either \code{\link{portion_df}} (default) or \code{\link{count_df}} -#' @param ... other parameters passed on to \code{\link[ggplot2]{facet_wrap}} +#' @param ... other parameters passed on to \code{geom_rsi} #' @details At default, the names of antibiotics will be shown on the plots using \code{\link{abname}}. This can be set with the option \code{get_antibiotic_names} (a logical value), so change it e.g. to \code{FALSE} with \code{options(get_antibiotic_names = FALSE)}. #' #' \strong{The functions}\cr @@ -112,9 +112,9 @@ ggplot_rsi <- function(data, position = NULL, x = "Antibiotic", fill = "Interpretation", + # params = list(), facet = NULL, translate_ab = "official", - alpha = 1, fun = portion_df, ...) { @@ -128,7 +128,7 @@ ggplot_rsi <- function(data, } p <- ggplot2::ggplot(data = data) + - geom_rsi(position = position, x = x, fill = fill, translate_ab = translate_ab, alpha = alpha, fun = fun) + + geom_rsi(position = position, x = x, fill = fill, translate_ab = translate_ab, fun = fun, ...) + theme_rsi() if (fill == "Interpretation") { @@ -141,7 +141,7 @@ ggplot_rsi <- function(data, } if (!is.null(facet)) { - p <- p + facet_rsi(facet = facet, ...) + p <- p + facet_rsi(facet = facet) } p @@ -152,9 +152,10 @@ ggplot_rsi <- function(data, geom_rsi <- function(position = NULL, x = c("Antibiotic", "Interpretation"), fill = "Interpretation", + # params = list(), translate_ab = "official", - alpha = 1, - fun = portion_df) { + fun = portion_df, + ...) { fun_name <- deparse(substitute(fun)) if (!fun_name %in% c("portion_df", "count_df", "fun")) { @@ -173,32 +174,36 @@ geom_rsi <- function(position = NULL, } x <- x[1] - if (x %in% tolower(c('ab', 'antibiotic', 'abx', 'antibiotics'))) { + if (tolower(x) %in% tolower(c('ab', 'antibiotic', 'abx', 'antibiotics'))) { x <- "Antibiotic" - } else if (x %in% tolower(c('SIR', 'RSI', 'interpretation', 'interpretations', 'result'))) { + } else if (tolower(x) %in% tolower(c('SIR', 'RSI', 'interpretation', 'interpretations', 'result'))) { x <- "Interpretation" } 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(alpha = alpha)) + data = fun, params = list(...)) } #' @rdname ggplot_rsi #' @export -facet_rsi <- function(facet = c("Interpretation", "Antibiotic"), ...) { +facet_rsi <- function(facet = c("Interpretation", "Antibiotic")) { facet <- facet[1] - if (facet %in% tolower(c('SIR', 'RSI', 'interpretation', 'interpretations', 'result'))) { + if (tolower(facet) %in% tolower(c('SIR', 'RSI', 'interpretation', 'interpretations', 'result'))) { facet <- "Interpretation" - } else if (facet %in% tolower(c('ab', 'antibiotic', 'abx', 'antibiotics'))) { + } else if (tolower(facet) %in% tolower(c('ab', 'antibiotic', 'abx', 'antibiotics'))) { facet <- "Antibiotic" } - ggplot2::facet_wrap(facets = facet, scales = "free_x", ...) + ggplot2::facet_wrap(facets = facet, scales = "free_x") } #' @rdname ggplot_rsi diff --git a/README.md b/README.md index 8ce33d2fa..2c8899548 100755 --- a/README.md +++ b/README.md @@ -82,6 +82,8 @@ All versions of this package [are published on CRAN](http://cran.r-project.org/p - `install.packages("AMR")` ### Install from GitHub +This is the latest development version. Although it may contain bugfixes and even new functions compared to the latest released version on CRAN, it is also subject to change and may be unstable or behave unexpectedly. Always consider this a beta version. + [![Travis_Build](https://travis-ci.org/msberends/AMR.svg?branch=master)](https://travis-ci.org/msberends/AMR) [![AppVeyor_Build](https://ci.appveyor.com/api/projects/status/github/msberends/AMR?branch=master&svg=true)](https://ci.appveyor.com/project/msberends/AMR) [![Last_Commit](https://img.shields.io/github/last-commit/msberends/AMR.svg)](https://github.com/msberends/AMR/commits/master) diff --git a/man/ggplot_rsi.Rd b/man/ggplot_rsi.Rd index 38e620eeb..d0029d502 100644 --- a/man/ggplot_rsi.Rd +++ b/man/ggplot_rsi.Rd @@ -11,13 +11,13 @@ \usage{ ggplot_rsi(data, position = NULL, x = "Antibiotic", fill = "Interpretation", facet = NULL, translate_ab = "official", - alpha = 1, fun = portion_df, ...) + fun = portion_df, ...) geom_rsi(position = NULL, x = c("Antibiotic", "Interpretation"), - fill = "Interpretation", translate_ab = "official", alpha = 1, - fun = portion_df) + fill = "Interpretation", translate_ab = "official", + fun = portion_df, ...) -facet_rsi(facet = c("Interpretation", "Antibiotic"), ...) +facet_rsi(facet = c("Interpretation", "Antibiotic")) scale_y_percent() @@ -38,11 +38,9 @@ theme_rsi() \item{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.} -\item{alpha}{opacity of the fill colours} - \item{fun}{function to transform \code{data}, either \code{\link{portion_df}} (default) or \code{\link{count_df}}} -\item{...}{other parameters passed on to \code{\link[ggplot2]{facet_wrap}}} +\item{...}{other parameters passed on to \code{geom_rsi}} } \description{ Use these functions to create bar plots for antimicrobial resistance analysis. All functions rely on internal \code{\link[ggplot2]{ggplot}} functions. diff --git a/tests/testthat/test-bactid.R b/tests/testthat/test-bactid.R index 73b323423..a86f58dcd 100644 --- a/tests/testthat/test-bactid.R +++ b/tests/testthat/test-bactid.R @@ -6,10 +6,18 @@ test_that("as.bactid works", { c("ESCCOL", "HAEINF")) expect_equal(as.character(as.bactid("Escherichia coli")), "ESCCOL") + expect_equal(as.character(as.bactid("Escherichia coli")), "ESCCOL") + 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("P. aer")), "PSEAER") # not Pasteurella aerogenes expect_equal(as.character(as.bactid("Negative rods")), "GNR") + # GLIMS + expect_equal(as.character(as.bactid("shiboy")), "SHIBOY") + expect_equal(as.character(as.bactid("MRSE")), "STAEPI") expect_equal(as.character(as.bactid("VRE")), "ENC") expect_equal(as.character(as.bactid("MRPA")), "PSEAER") diff --git a/tests/testthat/test-first_isolate.R b/tests/testthat/test-first_isolate.R index 4f13ee732..2bd1f38ff 100755 --- a/tests/testthat/test-first_isolate.R +++ b/tests/testthat/test-first_isolate.R @@ -85,4 +85,11 @@ test_that("first isolates work", { info = TRUE), na.rm = TRUE), 1501) + + expect_message(septic_patients %>% + mutate(specimen = "test") %>% + mutate(first = first_isolate(., "date", "patient_id", + col_bactid = "bactid", col_specimen = "specimen", + filter_specimen = "something_unexisting"))) + expect_error(first_isolate("date", "patient_id", col_bactid = "bactid")) }) diff --git a/tests/testthat/test-freq.R b/tests/testthat/test-freq.R index 6972970f3..3df48f244 100755 --- a/tests/testthat/test-freq.R +++ b/tests/testthat/test-freq.R @@ -9,6 +9,15 @@ test_that("frequency table works", { expect_equal(nrow(freq(septic_patients$date)), length(unique(septic_patients$date))) + expect_output(print(freq(septic_patients$age, nmax = Inf))) + expect_output(print(freq(septic_patients$age, nmax = NA))) + expect_output(print(freq(septic_patients$age, nmax = NULL))) + expect_output(print(freq(septic_patients$age, sort.count = FALSE))) + expect_output(print(freq(septic_patients$age, markdown = TRUE))) + expect_output(print(freq(septic_patients$age, markdown = TRUE), markdown = FALSE)) + expect_output(print(freq(septic_patients$age, markdown = TRUE), markdown = TRUE)) + expect_output(print(freq(septic_patients$age[0]))) + # character expect_output(print(freq(septic_patients$bactid))) # integer @@ -21,6 +30,8 @@ test_that("frequency table works", { expect_output(print(freq(table(septic_patients$sex, septic_patients$age)))) # rsi expect_output(print(freq(septic_patients$amcl))) + # hms + expect_output(print(freq(hms::as.hms(sample(c(0:86399), 50))))) library(dplyr) expect_output(septic_patients %>% select(1:2) %>% freq() %>% print())