geom_rsi - any parameter

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

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

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()
 
+    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(), ')')
+                                  ' (+', 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")
 

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

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)

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,
+  fill = "Interpretation", translate_ab = "official",
-  fun = portion_df)
+  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.

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

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

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