mirror of
https://github.com/msberends/AMR.git
synced 2025-07-08 18:01:50 +02:00
(v0.7.0.9008) T. vaginalis, rsi_df
This commit is contained in:
1
R/ab.R
1
R/ab.R
@ -203,7 +203,6 @@ as.ab <- function(x) {
|
||||
# try by removing all spaces
|
||||
if (x[i] %like% " ") {
|
||||
found <- suppressWarnings(as.ab(gsub(" +", "", x[i])))
|
||||
print(found)
|
||||
if (length(found) > 0 & !is.na(found)) {
|
||||
x_new[i] <- found[1L]
|
||||
next
|
||||
|
||||
9
R/age.R
9
R/age.R
@ -136,6 +136,9 @@ age <- function(x, reference = Sys.Date(), exact = FALSE) {
|
||||
#' select(age_group, CIP) %>%
|
||||
#' ggplot_rsi(x = "age_group")
|
||||
age_groups <- function(x, split_at = c(12, 25, 55, 75)) {
|
||||
if (!is.numeric(x)) {
|
||||
stop("`x` and must be numeric, not a ", paste0(class(x), collapse = "/"), ".")
|
||||
}
|
||||
if (is.character(split_at)) {
|
||||
split_at <- split_at[1L]
|
||||
if (split_at %like% "^(child|kid|junior)") {
|
||||
@ -148,11 +151,7 @@ age_groups <- function(x, split_at = c(12, 25, 55, 75)) {
|
||||
split_at <- 1:10 * 10
|
||||
}
|
||||
}
|
||||
split_at <- as.integer(split_at)
|
||||
if (!is.numeric(x) | !is.numeric(split_at)) {
|
||||
stop("`x` and `split_at` must both be numeric.")
|
||||
}
|
||||
split_at <- sort(unique(split_at))
|
||||
split_at <- sort(unique(as.integer(split_at)))
|
||||
if (!split_at[1] == 0) {
|
||||
# add base number 0
|
||||
split_at <- c(0, split_at)
|
||||
|
||||
@ -29,9 +29,11 @@
|
||||
#' @inheritSection as.rsi Interpretation of S, I and R
|
||||
#' @details These functions are meant to count isolates. Use the \code{\link{portion}_*} functions to calculate microbial resistance.
|
||||
#'
|
||||
#' \code{n_rsi} is an alias of \code{count_all}. They can be used to count all available isolates, i.e. where all input antibiotics have an available result (S, I or R). Their use is equal to \code{\link{n_distinct}}. Their function is equal to \code{count_S(...) + count_IR(...)}.
|
||||
#' The function \code{n_rsi} is an alias of \code{count_all}. They can be used to count all available isolates, i.e. where all input antibiotics have an available result (S, I or R). Their use is equal to \code{\link{n_distinct}}. Their function is equal to \code{count_S(...) + count_IR(...)}.
|
||||
#'
|
||||
#' \code{count_df} takes any variable from \code{data} that has an \code{"rsi"} class (created with \code{\link{as.rsi}}) and counts the amounts of R, I and S. The resulting \emph{tidy data} (see Source) \code{data.frame} will have three rows (S/I/R) and a column for each variable with class \code{"rsi"}.
|
||||
#' The function \code{count_df} takes any variable from \code{data} that has an \code{"rsi"} class (created with \code{\link{as.rsi}}) and counts the amounts of S, I and R. The resulting \emph{tidy data} (see Source) \code{data.frame} will have three rows (S/I/R) and a column for each variable with class \code{"rsi"}.
|
||||
#'
|
||||
#' The function \code{rsi_df} works exactly like \code{count_df}, but add the percentage of S, I and R.
|
||||
#' @source Wickham H. \strong{Tidy Data.} The Journal of Statistical Software, vol. 59, 2014. \url{http://vita.had.co.nz/papers/tidy-data.html}
|
||||
#' @seealso \code{\link{portion}_*} to calculate microbial resistance and susceptibility.
|
||||
#' @keywords resistance susceptibility rsi antibiotics isolate isolates
|
||||
|
||||
9
R/data.R
9
R/data.R
@ -55,7 +55,7 @@
|
||||
#'
|
||||
#' A data set containing the microbial taxonomy of six kingdoms from the Catalogue of Life. MO codes can be looked up using \code{\link{as.mo}}.
|
||||
#' @inheritSection catalogue_of_life Catalogue of Life
|
||||
#' @format A \code{\link{data.frame}} with 67,903 observations and 16 variables:
|
||||
#' @format A \code{\link{data.frame}} with 67,906 observations and 16 variables:
|
||||
#' \describe{
|
||||
#' \item{\code{mo}}{ID of microorganism as used by this package}
|
||||
#' \item{\code{col_id}}{Catalogue of Life ID}
|
||||
@ -69,9 +69,10 @@
|
||||
#' }
|
||||
#' @details Manually added were:
|
||||
#' \itemize{
|
||||
#' \item{9 species of \emph{Streptococcus} (beta haemolytic groups A, B, C, D, F, G, H, K and unspecified)}
|
||||
#' \item{2 species of \emph{Staphylococcus} (coagulase-negative [CoNS] and coagulase-positive [CoPS])}
|
||||
#' \item{3 other undefined (unknown, unknown Gram negatives and unknown Gram positives)}
|
||||
#' \item{9 entries of \emph{Streptococcus} (beta haemolytic groups A, B, C, D, F, G, H, K and unspecified)}
|
||||
#' \item{2 entries of \emph{Staphylococcus} (coagulase-negative [CoNS] and coagulase-positive [CoPS])}
|
||||
#' \item{3 entries of Trichomonas (Trichomonas vaginalis, and its family and genus)}
|
||||
#' \item{3 other 'undefined' entries (unknown, unknown Gram negatives and unknown Gram positives)}
|
||||
#' \item{8,830 species from the DSMZ (Deutsche Sammlung von Mikroorganismen und Zellkulturen) that are not in the Catalogue of Life}
|
||||
#' }
|
||||
#' @section About the records from DSMZ (see source):
|
||||
|
||||
@ -24,11 +24,11 @@
|
||||
#' Use these functions to create bar plots for antimicrobial resistance analysis. All functions rely on internal \code{\link[ggplot2]{ggplot}2} functions.
|
||||
#' @param data a \code{data.frame} with column(s) of class \code{"rsi"} (see \code{\link{as.rsi}})
|
||||
#' @param position position adjustment of bars, either \code{"fill"} (default when \code{fun} is \code{\link{count_df}}), \code{"stack"} (default when \code{fun} is \code{\link{portion_df}}) or \code{"dodge"}
|
||||
#' @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 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 breaks numeric vector of positions
|
||||
#' @param limits numeric vector of length two providing limits of the scale, use \code{NA} to refer to the existing minimum or maximum
|
||||
#' @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 fun function to transform \code{data}, either \code{\link{count_df}} (default) or \code{\link{portion_df}}
|
||||
#' @inheritParams portion
|
||||
#' @param nrow (when using \code{facet}) number of rows
|
||||
@ -129,7 +129,7 @@
|
||||
#' select(hospital_id, AMX, NIT, FOS, TMP, CIP) %>%
|
||||
#' group_by(hospital_id) %>%
|
||||
#' ggplot_rsi(x = "hospital_id",
|
||||
#' facet = "Antibiotic",
|
||||
#' facet = "antibiotic",
|
||||
#' nrow = 1,
|
||||
#' title = "AMR of Anti-UTI Drugs Per Hospital",
|
||||
#' x.title = "Hospital",
|
||||
@ -150,7 +150,7 @@
|
||||
#' # group by MO
|
||||
#' group_by(bug) %>%
|
||||
#' # plot the thing, putting MOs on the facet
|
||||
#' ggplot_rsi(x = "Antibiotic",
|
||||
#' ggplot_rsi(x = "antibiotic",
|
||||
#' facet = "bug",
|
||||
#' translate_ab = FALSE,
|
||||
#' nrow = 1,
|
||||
@ -161,8 +161,8 @@
|
||||
#' }
|
||||
ggplot_rsi <- function(data,
|
||||
position = NULL,
|
||||
x = "Antibiotic",
|
||||
fill = "Interpretation",
|
||||
x = "antibiotic",
|
||||
fill = "interpretation",
|
||||
# params = list(),
|
||||
facet = NULL,
|
||||
breaks = seq(0, 1, 0.1),
|
||||
@ -226,7 +226,7 @@ ggplot_rsi <- function(data,
|
||||
fun = fun, combine_SI = combine_SI, combine_IR = combine_IR, ...) +
|
||||
theme_rsi()
|
||||
|
||||
if (fill == "Interpretation") {
|
||||
if (fill == "interpretation") {
|
||||
# set RSI colours
|
||||
if (isFALSE(colours) & missing(datalabels.colour)) {
|
||||
# set datalabel colour to middle gray
|
||||
@ -267,8 +267,8 @@ ggplot_rsi <- function(data,
|
||||
#' @rdname ggplot_rsi
|
||||
#' @export
|
||||
geom_rsi <- function(position = NULL,
|
||||
x = c("Antibiotic", "Interpretation"),
|
||||
fill = "Interpretation",
|
||||
x = c("antibiotic", "interpretation"),
|
||||
fill = "interpretation",
|
||||
translate_ab = "name",
|
||||
language = get_locale(),
|
||||
combine_SI = TRUE,
|
||||
@ -286,7 +286,7 @@ geom_rsi <- function(position = NULL,
|
||||
if (!fun_name %in% c("portion_df", "count_df", "fun")) {
|
||||
stop("`fun` must be portion_df or count_df")
|
||||
}
|
||||
y <- "Value"
|
||||
y <- "value"
|
||||
if (identical(fun, count_df)) {
|
||||
if (missing(position) | is.null(position)) {
|
||||
position <- "fill"
|
||||
@ -312,10 +312,10 @@ geom_rsi <- function(position = NULL,
|
||||
x <- substr(x, 2, nchar(x) - 1)
|
||||
}
|
||||
|
||||
if (tolower(x) %in% tolower(c('ab', 'antibiotic', 'abx', 'antibiotics'))) {
|
||||
x <- "Antibiotic"
|
||||
} else if (tolower(x) %in% tolower(c('SIR', 'RSI', 'interpretation', 'interpretations', 'result'))) {
|
||||
x <- "Interpretation"
|
||||
if (tolower(x) %in% tolower(c('ab', 'abx', 'antibiotics'))) {
|
||||
x <- "antibiotic"
|
||||
} else if (tolower(x) %in% tolower(c('SIR', 'RSI', 'interpretations', 'result'))) {
|
||||
x <- "interpretation"
|
||||
}
|
||||
|
||||
ggplot2::layer(geom = "bar", stat = "identity", position = position,
|
||||
@ -332,7 +332,7 @@ geom_rsi <- function(position = NULL,
|
||||
|
||||
#' @rdname ggplot_rsi
|
||||
#' @export
|
||||
facet_rsi <- function(facet = c("Interpretation", "Antibiotic"), nrow = NULL) {
|
||||
facet_rsi <- function(facet = c("interpretation", "antibiotic"), nrow = NULL) {
|
||||
|
||||
stopifnot_installed_package("ggplot2")
|
||||
|
||||
@ -347,10 +347,10 @@ facet_rsi <- function(facet = c("Interpretation", "Antibiotic"), nrow = NULL) {
|
||||
facet <- substr(facet, 2, nchar(facet) - 1)
|
||||
}
|
||||
|
||||
if (tolower(facet) %in% tolower(c('SIR', 'RSI', 'interpretation', 'interpretations', 'result'))) {
|
||||
facet <- "Interpretation"
|
||||
} else if (tolower(facet) %in% tolower(c('ab', 'antibiotic', 'abx', 'antibiotics'))) {
|
||||
facet <- "Antibiotic"
|
||||
if (tolower(facet) %in% tolower(c('SIR', 'RSI', 'interpretations', 'result'))) {
|
||||
facet <- "interpretation"
|
||||
} else if (tolower(facet) %in% tolower(c('ab', 'abx', 'antibiotics'))) {
|
||||
facet <- "antibiotic"
|
||||
}
|
||||
|
||||
ggplot2::facet_wrap(facets = facet, scales = "free_x", nrow = nrow)
|
||||
@ -408,7 +408,7 @@ theme_rsi <- function() {
|
||||
#' @importFrom dplyr mutate %>% group_by_at
|
||||
#' @export
|
||||
labels_rsi_count <- function(position = NULL,
|
||||
x = "Antibiotic",
|
||||
x = "antibiotic",
|
||||
translate_ab = "name",
|
||||
combine_SI = TRUE,
|
||||
combine_IR = FALSE,
|
||||
@ -424,7 +424,7 @@ labels_rsi_count <- function(position = NULL,
|
||||
x_name <- x
|
||||
ggplot2::geom_text(mapping = ggplot2::aes_string(label = "lbl",
|
||||
x = x,
|
||||
y = "Value"),
|
||||
y = "value"),
|
||||
position = position,
|
||||
inherit.aes = FALSE,
|
||||
size = datalabels.size,
|
||||
@ -438,7 +438,7 @@ labels_rsi_count <- function(position = NULL,
|
||||
combine_SI = combine_SI,
|
||||
combine_IR = combine_IR) %>%
|
||||
group_by_at(x_name) %>%
|
||||
mutate(lbl = paste0(percent(Value / sum(Value, na.rm = TRUE), force_zero = TRUE),
|
||||
"\n(n=", Value, ")"))
|
||||
mutate(lbl = paste0(percent(value / sum(value, na.rm = TRUE), force_zero = TRUE),
|
||||
"\n(n=", value, ")"))
|
||||
})
|
||||
}
|
||||
|
||||
@ -38,7 +38,9 @@
|
||||
#'
|
||||
#' These functions are not meant to count isolates, but to calculate the portion of resistance/susceptibility. Use the \code{\link[AMR]{count}} functions to count isolates. \emph{Low counts can infuence the outcome - these \code{portion} functions may camouflage this, since they only return the portion albeit being dependent on the \code{minimum} parameter.}
|
||||
#'
|
||||
#' \code{portion_df} takes any variable from \code{data} that has an \code{"rsi"} class (created with \code{\link{as.rsi}}) and calculates the portions R, I and S. The resulting \emph{tidy data} (see Source) \code{data.frame} will have three rows (S/I/R) and a column for each variable with class \code{"rsi"}.
|
||||
#' The function \code{portion_df} takes any variable from \code{data} that has an \code{"rsi"} class (created with \code{\link{as.rsi}}) and calculates the portions R, I and S. The resulting \emph{tidy data} (see Source) \code{data.frame} will have three rows (S/I/R) and a column for each group and each variable with class \code{"rsi"}.
|
||||
#'
|
||||
#' The function \code{rsi_df} works exactly like \code{portion_df}, but add the number of isolates.
|
||||
#' \if{html}{
|
||||
# (created with https://www.latex4technics.com/)
|
||||
#' \cr\cr
|
||||
|
||||
16
R/rsi_calc.R
16
R/rsi_calc.R
@ -151,6 +151,7 @@ rsi_calc <- function(...,
|
||||
}
|
||||
}
|
||||
|
||||
#' @importFrom dplyr %>% summarise_if mutate select everything bind_rows
|
||||
rsi_calc_df <- function(type, # "portion" or "count"
|
||||
data,
|
||||
translate_ab = "name",
|
||||
@ -196,8 +197,8 @@ rsi_calc_df <- function(type, # "portion" or "count"
|
||||
.funs = int_fn)
|
||||
}
|
||||
summ %>%
|
||||
mutate(Interpretation = int) %>%
|
||||
select(Interpretation, everything())
|
||||
mutate(interpretation = int) %>%
|
||||
select(interpretation, everything())
|
||||
}
|
||||
|
||||
resS <- get_summaryfunction("S")
|
||||
@ -209,28 +210,29 @@ rsi_calc_df <- function(type, # "portion" or "count"
|
||||
|
||||
if (isFALSE(combine_SI) & isFALSE(combine_IR)) {
|
||||
res <- bind_rows(resS, resI, resR) %>%
|
||||
mutate(Interpretation = factor(Interpretation,
|
||||
mutate(interpretation = factor(interpretation,
|
||||
levels = c("S", "I", "R"),
|
||||
ordered = TRUE))
|
||||
|
||||
} else if (isTRUE(combine_IR)) {
|
||||
res <- bind_rows(resS, resIR) %>%
|
||||
mutate(Interpretation = factor(Interpretation,
|
||||
mutate(interpretation = factor(interpretation,
|
||||
levels = c("S", "IR"),
|
||||
ordered = TRUE))
|
||||
|
||||
} else if (isTRUE(combine_SI)) {
|
||||
res <- bind_rows(resSI, resR) %>%
|
||||
mutate(Interpretation = factor(Interpretation,
|
||||
mutate(interpretation = factor(interpretation,
|
||||
levels = c("SI", "R"),
|
||||
ordered = TRUE))
|
||||
}
|
||||
|
||||
res <- res %>%
|
||||
tidyr::gather(Antibiotic, Value, -Interpretation, -data.groups)
|
||||
tidyr::gather(antibiotic, value, -interpretation, -data.groups) %>%
|
||||
select(antibiotic, everything())
|
||||
|
||||
if (!translate_ab == FALSE) {
|
||||
res <- res %>% mutate(Antibiotic = ab_property(Antibiotic, property = translate_ab, language = language))
|
||||
res <- res %>% mutate(antibiotic = ab_property(antibiotic, property = translate_ab, language = language))
|
||||
}
|
||||
|
||||
res
|
||||
|
||||
58
R/rsi_df.R
Normal file
58
R/rsi_df.R
Normal file
@ -0,0 +1,58 @@
|
||||
# ==================================================================== #
|
||||
# TITLE #
|
||||
# Antimicrobial Resistance (AMR) Analysis #
|
||||
# #
|
||||
# SOURCE #
|
||||
# https://gitlab.com/msberends/AMR #
|
||||
# #
|
||||
# LICENCE #
|
||||
# (c) 2019 Berends MS (m.s.berends@umcg.nl), Luz CF (c.f.luz@umcg.nl) #
|
||||
# #
|
||||
# This R package is free software; you can freely use and distribute #
|
||||
# it for both personal and commercial purposes under the terms of the #
|
||||
# GNU General Public License version 2.0 (GNU GPL-2), as published by #
|
||||
# the Free Software Foundation. #
|
||||
# #
|
||||
# This R package was created for academic research and was publicly #
|
||||
# released in the hope that it will be useful, but it comes WITHOUT #
|
||||
# ANY WARRANTY OR LIABILITY. #
|
||||
# Visit our website for more info: https://msberends.gitlab.io/AMR. #
|
||||
# ==================================================================== #
|
||||
|
||||
#' @rdname portion
|
||||
#' @rdname count
|
||||
#' @importFrom dplyr %>% select_if bind_rows summarise_if mutate group_vars select everything
|
||||
#' @export
|
||||
rsi_df <- function(data,
|
||||
translate_ab = "name",
|
||||
language = get_locale(),
|
||||
minimum = 30,
|
||||
as_percent = FALSE,
|
||||
combine_SI = TRUE,
|
||||
combine_IR = FALSE) {
|
||||
|
||||
portions <- rsi_calc_df(type = "portion",
|
||||
data = data,
|
||||
translate_ab = translate_ab,
|
||||
language = language,
|
||||
minimum = minimum,
|
||||
as_percent = as_percent,
|
||||
combine_SI = combine_SI,
|
||||
combine_IR = combine_IR,
|
||||
combine_SI_missing = missing(combine_SI))
|
||||
|
||||
counts <- rsi_calc_df(type = "count",
|
||||
data = data,
|
||||
translate_ab = FALSE,
|
||||
language = "en",
|
||||
minimum = minimum,
|
||||
as_percent = as_percent,
|
||||
combine_SI = combine_SI,
|
||||
combine_IR = combine_IR,
|
||||
combine_SI_missing = missing(combine_SI))
|
||||
|
||||
data.frame(portions,
|
||||
isolates = counts$value,
|
||||
stringsAsFactors = FALSE)
|
||||
|
||||
}
|
||||
BIN
R/sysdata.rda
BIN
R/sysdata.rda
Binary file not shown.
Reference in New Issue
Block a user