P281424
/
AMR
mirror of https://github.com/msberends/AMR.git
1
0
Fork 0
Code Releases Activity

geom_rsi - any parameter

This commit is contained in:
dr. M.S. (Matthijs) Berends 2018-08-23 21:27:15 +02:00
parent eee122825c
commit febd0ca885
9 changed files with 72 additions and 39 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
NEWS.md
View File

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

14
R/bactid.R
View File

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

22
R/freq.R
View File

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

33
R/ggplot_rsi.R
View File

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

2
README.md
View File

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

12
man/ggplot_rsi.Rd
View File

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

8
tests/testthat/test-bactid.R
View File

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

7
tests/testthat/test-first_isolate.R
View File

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

11
tests/testthat/test-freq.R
View File

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