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 8bd44fb2..ede6b632 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 e36cd4b4..2e7848f3 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 e1dc7c88..6f31e632 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 f4de1267..89e6ffce 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 8ce33d2f..2c889954 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 38e620ee..d0029d50 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 73b32342..a86f58dc 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 4f13ee73..2bd1f38f 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 6972970f..3df48f24 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())