mirror of
https://github.com/msberends/AMR.git
synced 2025-07-09 17:02:03 +02:00
update
This commit is contained in:
@ -1,90 +0,0 @@
|
||||
# ==================================================================== #
|
||||
# TITLE #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data #
|
||||
# #
|
||||
# SOURCE #
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# CITE AS #
|
||||
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
|
||||
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
|
||||
# Data. Journal of Statistical Software, 104(3), 1-31. #
|
||||
# doi:10.18637/jss.v104.i03 #
|
||||
# #
|
||||
# Developed at the University of Groningen and the University Medical #
|
||||
# Center Groningen in The Netherlands, in collaboration with many #
|
||||
# colleagues from around the world, see our website. #
|
||||
# #
|
||||
# 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. #
|
||||
# We created this package for both routine data analysis and academic #
|
||||
# research and it was publicly released in the hope that it will be #
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
|
||||
# ==================================================================== #
|
||||
|
||||
#' Deprecated Functions
|
||||
#'
|
||||
#' These functions are so-called '[Deprecated]'. **They will be removed in a future release.** Using the functions will give a warning with the name of the function it has been replaced by (if there is one).
|
||||
#' @keywords internal
|
||||
#' @name AMR-deprecated
|
||||
#' @rdname AMR-deprecated
|
||||
#' @export
|
||||
as.rsi <- function(...) {
|
||||
deprecation_warning("as.rsi", "as.sir")
|
||||
as.sir(...)
|
||||
}
|
||||
|
||||
#' @rdname AMR-deprecated
|
||||
#' @export
|
||||
is.rsi.eligible <- function(...) {
|
||||
deprecation_warning("is.rsi.eligible", "is_sir_eligible")
|
||||
is_sir_eligible(...)
|
||||
}
|
||||
|
||||
# NAMESPACE NALOPEN
|
||||
|
||||
# will be exported using s3_register() in R/zzz.R
|
||||
pillar_shaft.rsi <- function(x, ...) {
|
||||
out <- trimws(format(x))
|
||||
if (has_colour()) {
|
||||
# colours will anyway not work when has_colour() == FALSE,
|
||||
# but then the indentation should also not be applied
|
||||
out[is.na(x)] <- font_grey(" NA")
|
||||
out[x == "S"] <- font_green_bg(" S ")
|
||||
out[x == "I"] <- font_orange_bg(" I ")
|
||||
out[x == "R"] <- font_red_bg(" R ")
|
||||
}
|
||||
create_pillar_column(out, align = "left", width = 5)
|
||||
}
|
||||
type_sum.rsi <- function(x, ...) {
|
||||
deprecation_warning("as.rsi", "as.sir", "Transform your old 'rsi' class to the new 'sir' with `as.sir()` using e.g.:\n your_data %>% mutate_if(~inherits(.x, \"rsi\"), as.sir)")
|
||||
"rsi"
|
||||
}
|
||||
|
||||
#' @method print rsi
|
||||
#' @export
|
||||
#' @noRd
|
||||
print.rsi <- function(x, ...) {
|
||||
deprecation_warning("as.rsi", "as.sir", "Transform your old 'rsi' class to the new 'sir' with `as.sir()`")
|
||||
print(x, ...)
|
||||
}
|
||||
|
||||
deprecation_warning <- function(old, new = NULL, extra_msg = NULL) {
|
||||
env <- paste0("deprecated_", old)
|
||||
if (!env %in% names(AMR_env)) {
|
||||
AMR_env[[paste0("deprecated_", old)]] <- 1
|
||||
warning_(ifelse(is.null(new),
|
||||
paste0("The `", old, "()` function is no longer in use"),
|
||||
paste0("The `", old, "()` function has been replaced with `", new, "()`")),
|
||||
", see `?AMR-deprecated`.",
|
||||
ifelse(!is.null(extra_msg),
|
||||
paste0(" ", extra_msg),
|
||||
""),
|
||||
"\nThis warning will be shown once per session.")
|
||||
}
|
||||
}
|
||||
@ -34,7 +34,7 @@
|
||||
#' [count_resistant()] should be used to count resistant isolates, [count_susceptible()] should be used to count susceptible isolates.
|
||||
#' @param ... one or more vectors (or columns) with antibiotic interpretations. They will be transformed internally with [as.sir()] if needed.
|
||||
#' @inheritParams proportion
|
||||
#' @inheritSection as.sir Interpretation of R and S/I
|
||||
#' @inheritSection as.sir Interpretation of SIR
|
||||
#' @details These functions are meant to count isolates. Use the [resistance()]/[susceptibility()] functions to calculate microbial resistance/susceptibility.
|
||||
#'
|
||||
#' The function [count_resistant()] is equal to the function [count_R()]. The function [count_susceptible()] is equal to the function [count_SI()].
|
||||
|
||||
4
R/mdro.R
4
R/mdro.R
@ -127,7 +127,7 @@
|
||||
#' ```
|
||||
#'
|
||||
#' The rules set (the `custom` object in this case) could be exported to a shared file location using [saveRDS()] if you collaborate with multiple users. The custom rules set could then be imported using [readRDS()].
|
||||
#' @inheritSection as.sir Interpretation of R and S/I
|
||||
#' @inheritSection as.sir Interpretation of SIR
|
||||
#' @return
|
||||
#' - CMI 2012 paper - function [mdr_cmi2012()] or [mdro()]:\cr
|
||||
#' Ordered [factor] with levels `Negative` < `Multi-drug-resistant (MDR)` < `Extensively drug-resistant (XDR)` < `Pandrug-resistant (PDR)`
|
||||
@ -1998,7 +1998,7 @@ run_custom_mdro_guideline <- function(df, guideline, info) {
|
||||
out <- factor(out, levels = attributes(guideline)$values, ordered = TRUE)
|
||||
}
|
||||
|
||||
columns_nonsusceptible <- as.data.frame(t(df[, as.sir(df), drop = FALSE] == "R"))
|
||||
columns_nonsusceptible <- as.data.frame(t(df[, is.sir(df), drop = FALSE] == "R"))
|
||||
columns_nonsusceptible <- vapply(
|
||||
FUN.VALUE = character(1),
|
||||
columns_nonsusceptible,
|
||||
|
||||
@ -43,7 +43,7 @@
|
||||
#' @param ab_result antibiotic results to test against, must be one of more values of "R", "S", "I"
|
||||
#' @param confidence_level the confidence level for the returned confidence interval. For the calculation, the number of S or SI isolates, and R isolates are compared with the total number of available isolates with R, S, or I by using [binom.test()], i.e., the Clopper-Pearson method.
|
||||
#' @param side the side of the confidence interval to return. Defaults to `"both"` for a length 2 vector, but can also be (abbreviated as) `"min"`/`"left"`/`"lower"`/`"less"` or `"max"`/`"right"`/`"higher"`/`"greater"`.
|
||||
#' @inheritSection as.sir Interpretation of R and S/I
|
||||
#' @inheritSection as.sir Interpretation of SIR
|
||||
#' @details
|
||||
#' The function [resistance()] is equal to the function [proportion_R()]. The function [susceptibility()] is equal to the function [proportion_SI()].
|
||||
#'
|
||||
|
||||
@ -44,7 +44,7 @@
|
||||
#' @param main title of the plot
|
||||
#' @param ribbon a [logical] to indicate whether a ribbon should be shown (default) or error bars
|
||||
#' @param ... arguments passed on to functions
|
||||
#' @inheritSection as.sir Interpretation of R and S/I
|
||||
#' @inheritSection as.sir Interpretation of SIR
|
||||
#' @inheritParams first_isolate
|
||||
#' @inheritParams graphics::plot
|
||||
#' @details Valid options for the statistical model (argument `model`) are:
|
||||
|
||||
18
R/sir.R
18
R/sir.R
@ -95,15 +95,17 @@
|
||||
#' The function [is.sir()] detects if the input contains class `sir`. If the input is a [data.frame], it iterates over all columns and returns a [logical] vector.
|
||||
#'
|
||||
#' The function [is_sir_eligible()] returns `TRUE` when a columns contains at most 5% invalid antimicrobial interpretations (not S and/or I and/or R), and `FALSE` otherwise. The threshold of 5% can be set with the `threshold` argument. If the input is a [data.frame], it iterates over all columns and returns a [logical] vector.
|
||||
#' @section Interpretation of R and S/I:
|
||||
#' In 2019, the European Committee on Antimicrobial Susceptibility Testing (EUCAST) has decided to change the definitions of susceptibility testing categories R and S/I as shown below (<https://www.eucast.org/newsiandr/>).
|
||||
#' @section Interpretation of SIR:
|
||||
#' In 2019, the European Committee on Antimicrobial Susceptibility Testing (EUCAST) has decided to change the definitions of susceptibility testing categories S, I, and R as shown below (<https://www.eucast.org/newsiandr/>):
|
||||
#'
|
||||
#' - **S - Susceptible, standard dosing regimen**\cr
|
||||
#' A microorganism is categorised as "Susceptible, standard dosing regimen", when there is a high likelihood of therapeutic success using a standard dosing regimen of the agent.
|
||||
#' - **I - Susceptible, increased exposure** *\cr
|
||||
#' A microorganism is categorised as "Susceptible, Increased exposure*" when there is a high likelihood of therapeutic success because exposure to the agent is increased by adjusting the dosing regimen or by its concentration at the site of infection.
|
||||
#' - **R = Resistant**\cr
|
||||
#' A microorganism is categorised as *Resistant* when there is a high likelihood of therapeutic failure even when there is increased exposure. Exposure is a function of how the mode of administration, dose, dosing interval, infusion time, as well as distribution and excretion of the antimicrobial agent will influence the infecting organism at the site of infection.
|
||||
#' - **S = Susceptible**\cr
|
||||
#' A microorganism is categorised as *Susceptible, standard dosing regimen*, when there is a high likelihood of therapeutic success using a standard dosing regimen of the agent.
|
||||
#' - **I = Susceptible, Increased exposure**\cr
|
||||
#' A microorganism is categorised as *Susceptible, Increased exposure* when there is a high likelihood of therapeutic success because exposure to the agent is increased by adjusting the dosing regimen or by its concentration at the site of infection.
|
||||
#' A microorganism is categorised as "Resistant" when there is a high likelihood of therapeutic failure even when there is increased exposure.
|
||||
#'
|
||||
#' * *Exposure* is a function of how the mode of administration, dose, dosing interval, infusion time, as well as distribution and excretion of the antimicrobial agent will influence the infecting organism at the site of infection.
|
||||
#'
|
||||
#' This AMR package honours this insight. Use [susceptibility()] (equal to [proportion_SI()]) to determine antimicrobial susceptibility and [count_susceptible()] (equal to [count_SI()]) to count susceptible isolates.
|
||||
#' @return Ordered [factor] with new class `sir`
|
||||
@ -216,7 +218,7 @@ as.sir <- function(x, ...) {
|
||||
#' @rdname as.sir
|
||||
#' @details `NA_sir_` is a missing value of the new `sir` class, analogous to e.g. base \R's [`NA_character_`][base::NA].
|
||||
#' @export
|
||||
NA_sir_ <- set_clean_class(factor(NA, levels = c("S", "I", "R"), ordered = TRUE),
|
||||
NA_sir_ <- set_clean_class(factor(NA_character_, levels = c("S", "I", "R"), ordered = TRUE),
|
||||
new_class = c("sir", "ordered", "factor")
|
||||
)
|
||||
|
||||
|
||||
@ -140,7 +140,11 @@ reset_AMR_locale <- function() {
|
||||
#' @rdname translate
|
||||
#' @export
|
||||
translate_AMR <- function(x, language = get_AMR_locale()) {
|
||||
translate_into_language(x, language = language)
|
||||
translate_into_language(x,
|
||||
language = language,
|
||||
only_unknown = FALSE,
|
||||
only_affect_ab_names = FALSE,
|
||||
only_affect_mo_names = FALSE)
|
||||
}
|
||||
|
||||
|
||||
@ -192,6 +196,7 @@ translate_into_language <- function(from,
|
||||
only_unknown = FALSE,
|
||||
only_affect_ab_names = FALSE,
|
||||
only_affect_mo_names = FALSE) {
|
||||
|
||||
# get ISO-639-1 of language
|
||||
lang <- validate_language(language)
|
||||
if (lang == "en") {
|
||||
@ -259,7 +264,7 @@ translate_into_language <- function(from,
|
||||
# a kind of left join to get all results back
|
||||
out <- from_unique_translated[match(from.bak, from_unique)]
|
||||
|
||||
if (!identical(from.bak, out) && message_not_thrown_before("translation", entire_session = TRUE) && interactive()) {
|
||||
if (!identical(from.bak, out) && get_AMR_locale() == lang && message_not_thrown_before("translation", entire_session = TRUE) && interactive()) {
|
||||
message(word_wrap(
|
||||
"Assuming the ", LANGUAGES_SUPPORTED_NAMES[[lang]]$exonym, " language (",
|
||||
LANGUAGES_SUPPORTED_NAMES[[lang]]$endonym, ") for the AMR package. See `set_AMR_locale()` to change this or to silence this once-per-session note.",
|
||||
|
||||
182
R/zz_deprecated.R
Executable file
182
R/zz_deprecated.R
Executable file
@ -0,0 +1,182 @@
|
||||
# ==================================================================== #
|
||||
# TITLE #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data #
|
||||
# #
|
||||
# SOURCE #
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# CITE AS #
|
||||
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
|
||||
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
|
||||
# Data. Journal of Statistical Software, 104(3), 1-31. #
|
||||
# doi:10.18637/jss.v104.i03 #
|
||||
# #
|
||||
# Developed at the University of Groningen and the University Medical #
|
||||
# Center Groningen in The Netherlands, in collaboration with many #
|
||||
# colleagues from around the world, see our website. #
|
||||
# #
|
||||
# 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. #
|
||||
# We created this package for both routine data analysis and academic #
|
||||
# research and it was publicly released in the hope that it will be #
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
|
||||
# ==================================================================== #
|
||||
|
||||
#' Deprecated Functions
|
||||
#'
|
||||
#' These functions are so-called '[Deprecated]'. **They will be removed in a future release.** Using the functions will give a warning with the name of the function it has been replaced by (if there is one).
|
||||
#' @keywords internal
|
||||
#' @name AMR-deprecated
|
||||
#' @rdname AMR-deprecated
|
||||
#' @export
|
||||
NA_rsi_ <- set_clean_class(factor(NA_character_, levels = c("S", "I", "R"), ordered = TRUE),
|
||||
new_class = c("rsi", "ordered", "factor"))
|
||||
#' @rdname AMR-deprecated
|
||||
#' @export
|
||||
as.rsi <- function(x, ...) {
|
||||
deprecation_warning("as.rsi", "as.sir")
|
||||
UseMethod("as.rsi")
|
||||
}
|
||||
#' @noRd
|
||||
#' @export
|
||||
as.rsi.default <- function(...) {
|
||||
as.sir.default(...)
|
||||
}
|
||||
#' @noRd
|
||||
#' @export
|
||||
as.rsi.mic <- function(...) {
|
||||
as.sir.mic(...)
|
||||
}
|
||||
#' @noRd
|
||||
#' @export
|
||||
as.rsi.disk <- function(...) {
|
||||
as.sir.disk(...)
|
||||
}
|
||||
#' @noRd
|
||||
#' @export
|
||||
as.rsi.data.frame <- function(...) {
|
||||
as.sir.data.frame(...)
|
||||
}
|
||||
|
||||
#' @rdname AMR-deprecated
|
||||
#' @export
|
||||
facet_rsi <- function(...) {
|
||||
deprecation_warning("facet_rsi", "facet_sir")
|
||||
facet_sir(...)
|
||||
}
|
||||
#' @rdname AMR-deprecated
|
||||
#' @export
|
||||
geom_rsi <- function(...) {
|
||||
deprecation_warning("geom_rsi", "geom_sir")
|
||||
geom_sir(...)
|
||||
}
|
||||
#' @rdname AMR-deprecated
|
||||
#' @export
|
||||
ggplot_rsi <- function(...) {
|
||||
deprecation_warning("ggplot_rsi", "ggplot_sir")
|
||||
ggplot_sir(...)
|
||||
}
|
||||
#' @rdname AMR-deprecated
|
||||
#' @export
|
||||
ggplot_rsi_predict <- function(...) {
|
||||
deprecation_warning("ggplot_rsi_predict", "ggplot_sir_predict")
|
||||
ggplot_sir_predict(...)
|
||||
}
|
||||
#' @rdname AMR-deprecated
|
||||
#' @export
|
||||
is.rsi <- function(x, ...) {
|
||||
# this is an exception, so mutate_if(is.rsi, as.sir) can be used
|
||||
if (inherits(x, "data.frame")) {
|
||||
unname(vapply(FUN.VALUE = logical(1), x, is.rsi))
|
||||
} else {
|
||||
inherits(x, "rsi")
|
||||
}
|
||||
}
|
||||
#' @rdname AMR-deprecated
|
||||
#' @export
|
||||
is.rsi.eligible <- function(...) {
|
||||
deprecation_warning("is.rsi.eligible", "is_sir_eligible")
|
||||
is_sir_eligible(...)
|
||||
}
|
||||
#' @rdname AMR-deprecated
|
||||
#' @export
|
||||
labels_rsi_count <- function(...) {
|
||||
deprecation_warning("labels_rsi_count", "labels_sir_count")
|
||||
labels_sir_count(...)
|
||||
}
|
||||
#' @rdname AMR-deprecated
|
||||
#' @export
|
||||
n_rsi <- function(...) {
|
||||
deprecation_warning("n_rsi", "n_sir")
|
||||
n_sir(...)
|
||||
}
|
||||
#' @rdname AMR-deprecated
|
||||
#' @export
|
||||
random_rsi <- function(...) {
|
||||
deprecation_warning("random_rsi", "random_sir")
|
||||
random_sir(...)
|
||||
}
|
||||
#' @rdname AMR-deprecated
|
||||
#' @export
|
||||
rsi_df <- function(...) {
|
||||
deprecation_warning("rsi_df", "sir_df")
|
||||
sir_df(...)
|
||||
}
|
||||
#' @rdname AMR-deprecated
|
||||
#' @export
|
||||
rsi_predict <- function(...) {
|
||||
deprecation_warning("rsi_predict", "sir_predict")
|
||||
sir_predict(...)
|
||||
}
|
||||
#' @rdname AMR-deprecated
|
||||
#' @export
|
||||
scale_rsi_colours <- function(...) {
|
||||
deprecation_warning("scale_rsi_colours", "scale_sir_colours")
|
||||
scale_sir_colours(...)
|
||||
}
|
||||
#' @rdname AMR-deprecated
|
||||
#' @export
|
||||
theme_rsi <- function(...) {
|
||||
deprecation_warning("theme_rsi", "theme_sir")
|
||||
theme_sir(...)
|
||||
}
|
||||
|
||||
# will be exported using s3_register() in R/zzz.R
|
||||
pillar_shaft.rsi <- pillar_shaft.sir
|
||||
type_sum.rsi <- function(x, ...) {
|
||||
deprecation_warning(extra_msg = "* Transform your old 'rsi' class to the new 'sir' class with `as.sir()` using e.g.:\n your_data %>% mutate_if(is.rsi, as.sir)")
|
||||
paste0("rsi", font_bold(font_red("[!]")))
|
||||
}
|
||||
|
||||
#' @method print rsi
|
||||
#' @export
|
||||
#' @noRd
|
||||
print.rsi <- function(x, ...) {
|
||||
deprecation_warning(extra_msg = "Transform your old 'rsi' class to the new 'sir' class with `as.sir()`")
|
||||
cat("Class 'rsi'", font_bold(font_red("[!]\n")))
|
||||
print(as.character(x), quote = FALSE)
|
||||
}
|
||||
|
||||
deprecation_warning <- function(old = NULL, new = NULL, extra_msg = NULL) {
|
||||
if (is.null(old)) {
|
||||
warning_(extra_msg)
|
||||
} else {
|
||||
env <- paste0("deprecated_", old)
|
||||
if (!env %in% names(AMR_env)) {
|
||||
AMR_env[[paste0("deprecated_", old)]] <- 1
|
||||
warning_(ifelse(is.null(new),
|
||||
paste0("The `", old, "()` function is no longer in use"),
|
||||
paste0("The `", old, "()` function has been replaced with `", new, "()`")),
|
||||
", see `?AMR-deprecated`.",
|
||||
ifelse(!is.null(extra_msg),
|
||||
paste0(" ", extra_msg),
|
||||
""),
|
||||
"\nThis warning will be shown once per session.")
|
||||
}
|
||||
}
|
||||
}
|
||||
Reference in New Issue
Block a user