mirror of
https://github.com/msberends/AMR.git
synced 2024-12-25 18:46:11 +01:00
geom_rsi - any parameter
This commit is contained in:
parent
eee122825c
commit
febd0ca885
2
NEWS.md
2
NEWS.md
@ -13,7 +13,7 @@
|
|||||||
* `septic_patients %>% portion_S(amcl, gent, pita)`
|
* `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`.
|
* 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
|
* 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)
|
# 0.3.0 (latest stable version)
|
||||||
**Published on CRAN: 2018-08-14**
|
**Published on CRAN: 2018-08-14**
|
||||||
|
14
R/bactid.R
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
|
# try any match keeping spaces
|
||||||
found <- AMR::microorganisms[which(AMR::microorganisms$fullname %like% x_withspaces[i]),]$bactid
|
found <- AMR::microorganisms[which(AMR::microorganisms$fullname %like% x_withspaces[i]),]$bactid
|
||||||
if (length(found) > 0) {
|
if (length(found) > 0) {
|
||||||
|
22
R/freq.R
22
R/freq.R
@ -350,9 +350,17 @@ frequency_tbl <- function(x,
|
|||||||
mediandate <- x %>% median(na.rm = TRUE)
|
mediandate <- x %>% median(na.rm = TRUE)
|
||||||
median_days <- difftime(mediandate, mindate, units = 'auto') %>% as.double()
|
median_days <- difftime(mediandate, mindate, units = 'auto') %>% as.double()
|
||||||
|
|
||||||
header <- header %>% paste0(markdown_line, '\nOldest: ', mindate %>% format(formatdates) %>% trimws())
|
if (formatdates == "%H:%M:%S") {
|
||||||
header <- header %>% paste0(markdown_line, '\nNewest: ', maxdate %>% format(formatdates) %>% trimws(),
|
# hms
|
||||||
' (+', difftime(maxdate, mindate, units = 'auto') %>% as.double() %>% format(), ')')
|
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(),
|
header <- header %>% paste0(markdown_line, '\nMedian: ', mediandate %>% format(formatdates) %>% trimws(),
|
||||||
' (~', percent(median_days / maxdate_days, round = 0), ')')
|
' (~', 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 <- nmax
|
||||||
opt$nmax.set <- TRUE
|
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")
|
cat("Frequency table", title, "\n")
|
||||||
|
|
||||||
|
@ -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 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 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 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 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 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 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)}.
|
#' @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
|
#' \strong{The functions}\cr
|
||||||
@ -112,9 +112,9 @@ ggplot_rsi <- function(data,
|
|||||||
position = NULL,
|
position = NULL,
|
||||||
x = "Antibiotic",
|
x = "Antibiotic",
|
||||||
fill = "Interpretation",
|
fill = "Interpretation",
|
||||||
|
# params = list(),
|
||||||
facet = NULL,
|
facet = NULL,
|
||||||
translate_ab = "official",
|
translate_ab = "official",
|
||||||
alpha = 1,
|
|
||||||
fun = portion_df,
|
fun = portion_df,
|
||||||
...) {
|
...) {
|
||||||
|
|
||||||
@ -128,7 +128,7 @@ ggplot_rsi <- function(data,
|
|||||||
}
|
}
|
||||||
|
|
||||||
p <- ggplot2::ggplot(data = 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()
|
theme_rsi()
|
||||||
|
|
||||||
if (fill == "Interpretation") {
|
if (fill == "Interpretation") {
|
||||||
@ -141,7 +141,7 @@ ggplot_rsi <- function(data,
|
|||||||
}
|
}
|
||||||
|
|
||||||
if (!is.null(facet)) {
|
if (!is.null(facet)) {
|
||||||
p <- p + facet_rsi(facet = facet, ...)
|
p <- p + facet_rsi(facet = facet)
|
||||||
}
|
}
|
||||||
|
|
||||||
p
|
p
|
||||||
@ -152,9 +152,10 @@ ggplot_rsi <- function(data,
|
|||||||
geom_rsi <- function(position = NULL,
|
geom_rsi <- function(position = NULL,
|
||||||
x = c("Antibiotic", "Interpretation"),
|
x = c("Antibiotic", "Interpretation"),
|
||||||
fill = "Interpretation",
|
fill = "Interpretation",
|
||||||
|
# params = list(),
|
||||||
translate_ab = "official",
|
translate_ab = "official",
|
||||||
alpha = 1,
|
fun = portion_df,
|
||||||
fun = portion_df) {
|
...) {
|
||||||
|
|
||||||
fun_name <- deparse(substitute(fun))
|
fun_name <- deparse(substitute(fun))
|
||||||
if (!fun_name %in% c("portion_df", "count_df", "fun")) {
|
if (!fun_name %in% c("portion_df", "count_df", "fun")) {
|
||||||
@ -173,32 +174,36 @@ geom_rsi <- function(position = NULL,
|
|||||||
}
|
}
|
||||||
|
|
||||||
x <- x[1]
|
x <- x[1]
|
||||||
if (x %in% tolower(c('ab', 'antibiotic', 'abx', 'antibiotics'))) {
|
if (tolower(x) %in% tolower(c('ab', 'antibiotic', 'abx', 'antibiotics'))) {
|
||||||
x <- "Antibiotic"
|
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"
|
x <- "Interpretation"
|
||||||
}
|
}
|
||||||
|
|
||||||
options(get_antibiotic_names = translate_ab)
|
options(get_antibiotic_names = translate_ab)
|
||||||
|
|
||||||
|
# if (!is.list(params)) {
|
||||||
|
# params <- as.list(params)
|
||||||
|
# }
|
||||||
|
|
||||||
ggplot2::layer(geom = "bar", stat = "identity", position = position,
|
ggplot2::layer(geom = "bar", stat = "identity", position = position,
|
||||||
mapping = ggplot2::aes_string(x = x, y = y, fill = fill),
|
mapping = ggplot2::aes_string(x = x, y = y, fill = fill),
|
||||||
data = fun, params = list(alpha = alpha))
|
data = fun, params = list(...))
|
||||||
|
|
||||||
}
|
}
|
||||||
|
|
||||||
#' @rdname ggplot_rsi
|
#' @rdname ggplot_rsi
|
||||||
#' @export
|
#' @export
|
||||||
facet_rsi <- function(facet = c("Interpretation", "Antibiotic"), ...) {
|
facet_rsi <- function(facet = c("Interpretation", "Antibiotic")) {
|
||||||
|
|
||||||
facet <- facet[1]
|
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"
|
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"
|
facet <- "Antibiotic"
|
||||||
}
|
}
|
||||||
|
|
||||||
ggplot2::facet_wrap(facets = facet, scales = "free_x", ...)
|
ggplot2::facet_wrap(facets = facet, scales = "free_x")
|
||||||
}
|
}
|
||||||
|
|
||||||
#' @rdname ggplot_rsi
|
#' @rdname ggplot_rsi
|
||||||
|
@ -82,6 +82,8 @@ All versions of this package [are published on CRAN](http://cran.r-project.org/p
|
|||||||
- `install.packages("AMR")`
|
- `install.packages("AMR")`
|
||||||
|
|
||||||
### Install from GitHub
|
### 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)
|
[![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)
|
[![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)
|
[![Last_Commit](https://img.shields.io/github/last-commit/msberends/AMR.svg)](https://github.com/msberends/AMR/commits/master)
|
||||||
|
@ -11,13 +11,13 @@
|
|||||||
\usage{
|
\usage{
|
||||||
ggplot_rsi(data, position = NULL, x = "Antibiotic",
|
ggplot_rsi(data, position = NULL, x = "Antibiotic",
|
||||||
fill = "Interpretation", facet = NULL, translate_ab = "official",
|
fill = "Interpretation", facet = NULL, translate_ab = "official",
|
||||||
alpha = 1, fun = portion_df, ...)
|
fun = portion_df, ...)
|
||||||
|
|
||||||
geom_rsi(position = NULL, x = c("Antibiotic", "Interpretation"),
|
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()
|
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{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{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{
|
\description{
|
||||||
Use these functions to create bar plots for antimicrobial resistance analysis. All functions rely on internal \code{\link[ggplot2]{ggplot}} functions.
|
Use these functions to create bar plots for antimicrobial resistance analysis. All functions rely on internal \code{\link[ggplot2]{ggplot}} functions.
|
||||||
|
@ -6,10 +6,18 @@ test_that("as.bactid works", {
|
|||||||
c("ESCCOL", "HAEINF"))
|
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 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("P. aer")), "PSEAER") # not Pasteurella aerogenes
|
||||||
|
|
||||||
expect_equal(as.character(as.bactid("Negative rods")), "GNR")
|
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("MRSE")), "STAEPI")
|
||||||
expect_equal(as.character(as.bactid("VRE")), "ENC")
|
expect_equal(as.character(as.bactid("VRE")), "ENC")
|
||||||
expect_equal(as.character(as.bactid("MRPA")), "PSEAER")
|
expect_equal(as.character(as.bactid("MRPA")), "PSEAER")
|
||||||
|
@ -85,4 +85,11 @@ test_that("first isolates work", {
|
|||||||
info = TRUE),
|
info = TRUE),
|
||||||
na.rm = TRUE),
|
na.rm = TRUE),
|
||||||
1501)
|
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"))
|
||||||
})
|
})
|
||||||
|
@ -9,6 +9,15 @@ test_that("frequency table works", {
|
|||||||
expect_equal(nrow(freq(septic_patients$date)),
|
expect_equal(nrow(freq(septic_patients$date)),
|
||||||
length(unique(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
|
# character
|
||||||
expect_output(print(freq(septic_patients$bactid)))
|
expect_output(print(freq(septic_patients$bactid)))
|
||||||
# integer
|
# integer
|
||||||
@ -21,6 +30,8 @@ test_that("frequency table works", {
|
|||||||
expect_output(print(freq(table(septic_patients$sex, septic_patients$age))))
|
expect_output(print(freq(table(septic_patients$sex, septic_patients$age))))
|
||||||
# rsi
|
# rsi
|
||||||
expect_output(print(freq(septic_patients$amcl)))
|
expect_output(print(freq(septic_patients$amcl)))
|
||||||
|
# hms
|
||||||
|
expect_output(print(freq(hms::as.hms(sample(c(0:86399), 50)))))
|
||||||
|
|
||||||
library(dplyr)
|
library(dplyr)
|
||||||
expect_output(septic_patients %>% select(1:2) %>% freq() %>% print())
|
expect_output(septic_patients %>% select(1:2) %>% freq() %>% print())
|
||||||
|
Loading…
Reference in New Issue
Block a user