P281424/AMR
1
0
Fork 0
mirror of https://github.com/msberends/AMR.git synced 2025-07-09 02:03:04 +02:00
Code Releases Activity

Remove RSI from package, add extra MIC scale functions

Browse Source
This commit is contained in:
dr. M.S. (Matthijs) Berends
2023-12-03 11:34:48 +01:00
parent 6f417d0ef2
commit c7461766ce
21 changed files with 260 additions and 580 deletions
Download Patch File Download Diff File Expand all files Collapse all files

108
R/ab_selectors.R
View File

@ -226,10 +226,6 @@ ab_class <- function(ab_class,
meet_criteria(ab_class, allow_class = "character", has_length = 1, allow_NULL = TRUE)
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
meet_criteria(only_treatable, allow_class = "logical", has_length = 1)
if ("only_rsi_columns" %in% names(list(...))) {
deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
only_sir_columns <- list(...)$only_rsi_columns
}
ab_select_exec(NULL, only_sir_columns = only_sir_columns, ab_class_args = ab_class, only_treatable = only_treatable)
}
@ -242,10 +238,6 @@ ab_selector <- function(filter,
...) {
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
meet_criteria(only_treatable, allow_class = "logical", has_length = 1)
if ("only_rsi_columns" %in% names(list(...))) {
deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
only_sir_columns <- list(...)$only_rsi_columns
}
# get_current_data() has to run each time, for cases where e.g., filter() and select() are used in same call
# but it only takes a couple of milliseconds
@ -277,10 +269,6 @@ ab_selector <- function(filter,
aminoglycosides <- function(only_sir_columns = FALSE, only_treatable = TRUE, ...) {
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
meet_criteria(only_treatable, allow_class = "logical", has_length = 1)
if ("only_rsi_columns" %in% names(list(...))) {
deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
only_sir_columns <- list(...)$only_rsi_columns
}
ab_select_exec("aminoglycosides", only_sir_columns = only_sir_columns, only_treatable = only_treatable)
}
@ -288,10 +276,6 @@ aminoglycosides <- function(only_sir_columns = FALSE, only_treatable = TRUE, ...
#' @export
aminopenicillins <- function(only_sir_columns = FALSE, ...) {
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
if ("only_rsi_columns" %in% names(list(...))) {
deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
only_sir_columns <- list(...)$only_rsi_columns
}
ab_select_exec("aminopenicillins", only_sir_columns = only_sir_columns)
}
@ -299,10 +283,6 @@ aminopenicillins <- function(only_sir_columns = FALSE, ...) {
#' @export
antifungals <- function(only_sir_columns = FALSE, ...) {
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
if ("only_rsi_columns" %in% names(list(...))) {
deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
only_sir_columns <- list(...)$only_rsi_columns
}
ab_select_exec("antifungals", only_sir_columns = only_sir_columns)
}
@ -310,10 +290,6 @@ antifungals <- function(only_sir_columns = FALSE, ...) {
#' @export
antimycobacterials <- function(only_sir_columns = FALSE, ...) {
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
if ("only_rsi_columns" %in% names(list(...))) {
deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
only_sir_columns <- list(...)$only_rsi_columns
}
ab_select_exec("antimycobacterials", only_sir_columns = only_sir_columns)
}
@ -322,10 +298,6 @@ antimycobacterials <- function(only_sir_columns = FALSE, ...) {
betalactams <- function(only_sir_columns = FALSE, only_treatable = TRUE, ...) {
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
meet_criteria(only_treatable, allow_class = "logical", has_length = 1)
if ("only_rsi_columns" %in% names(list(...))) {
deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
only_sir_columns <- list(...)$only_rsi_columns
}
ab_select_exec("betalactams", only_sir_columns = only_sir_columns, only_treatable = only_treatable)
}
@ -334,10 +306,6 @@ betalactams <- function(only_sir_columns = FALSE, only_treatable = TRUE, ...) {
carbapenems <- function(only_sir_columns = FALSE, only_treatable = TRUE, ...) {
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
meet_criteria(only_treatable, allow_class = "logical", has_length = 1)
if ("only_rsi_columns" %in% names(list(...))) {
deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
only_sir_columns <- list(...)$only_rsi_columns
}
ab_select_exec("carbapenems", only_sir_columns = only_sir_columns, only_treatable = only_treatable)
}
@ -345,10 +313,6 @@ carbapenems <- function(only_sir_columns = FALSE, only_treatable = TRUE, ...) {
#' @export
cephalosporins <- function(only_sir_columns = FALSE, ...) {
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
if ("only_rsi_columns" %in% names(list(...))) {
deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
only_sir_columns <- list(...)$only_rsi_columns
}
ab_select_exec("cephalosporins", only_sir_columns = only_sir_columns)
}
@ -356,10 +320,6 @@ cephalosporins <- function(only_sir_columns = FALSE, ...) {
#' @export
cephalosporins_1st <- function(only_sir_columns = FALSE, ...) {
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
if ("only_rsi_columns" %in% names(list(...))) {
deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
only_sir_columns <- list(...)$only_rsi_columns
}
ab_select_exec("cephalosporins_1st", only_sir_columns = only_sir_columns)
}
@ -367,10 +327,6 @@ cephalosporins_1st <- function(only_sir_columns = FALSE, ...) {
#' @export
cephalosporins_2nd <- function(only_sir_columns = FALSE, ...) {
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
if ("only_rsi_columns" %in% names(list(...))) {
deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
only_sir_columns <- list(...)$only_rsi_columns
}
ab_select_exec("cephalosporins_2nd", only_sir_columns = only_sir_columns)
}
@ -378,10 +334,6 @@ cephalosporins_2nd <- function(only_sir_columns = FALSE, ...) {
#' @export
cephalosporins_3rd <- function(only_sir_columns = FALSE, ...) {
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
if ("only_rsi_columns" %in% names(list(...))) {
deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
only_sir_columns <- list(...)$only_rsi_columns
}
ab_select_exec("cephalosporins_3rd", only_sir_columns = only_sir_columns)
}
@ -389,10 +341,6 @@ cephalosporins_3rd <- function(only_sir_columns = FALSE, ...) {
#' @export
cephalosporins_4th <- function(only_sir_columns = FALSE, ...) {
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
if ("only_rsi_columns" %in% names(list(...))) {
deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
only_sir_columns <- list(...)$only_rsi_columns
}
ab_select_exec("cephalosporins_4th", only_sir_columns = only_sir_columns)
}
@ -400,10 +348,6 @@ cephalosporins_4th <- function(only_sir_columns = FALSE, ...) {
#' @export
cephalosporins_5th <- function(only_sir_columns = FALSE, ...) {
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
if ("only_rsi_columns" %in% names(list(...))) {
deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
only_sir_columns <- list(...)$only_rsi_columns
}
ab_select_exec("cephalosporins_5th", only_sir_columns = only_sir_columns)
}
@ -411,10 +355,6 @@ cephalosporins_5th <- function(only_sir_columns = FALSE, ...) {
#' @export
fluoroquinolones <- function(only_sir_columns = FALSE, ...) {
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
if ("only_rsi_columns" %in% names(list(...))) {
deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
only_sir_columns <- list(...)$only_rsi_columns
}
ab_select_exec("fluoroquinolones", only_sir_columns = only_sir_columns)
}
@ -422,10 +362,6 @@ fluoroquinolones <- function(only_sir_columns = FALSE, ...) {
#' @export
glycopeptides <- function(only_sir_columns = FALSE, ...) {
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
if ("only_rsi_columns" %in% names(list(...))) {
deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
only_sir_columns <- list(...)$only_rsi_columns
}
ab_select_exec("glycopeptides", only_sir_columns = only_sir_columns)
}
@ -433,10 +369,6 @@ glycopeptides <- function(only_sir_columns = FALSE, ...) {
#' @export
lincosamides <- function(only_sir_columns = FALSE, ...) {
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
if ("only_rsi_columns" %in% names(list(...))) {
deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
only_sir_columns <- list(...)$only_rsi_columns
}
ab_select_exec("lincosamides", only_sir_columns = only_sir_columns)
}
@ -444,10 +376,6 @@ lincosamides <- function(only_sir_columns = FALSE, ...) {
#' @export
lipoglycopeptides <- function(only_sir_columns = FALSE, ...) {
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
if ("only_rsi_columns" %in% names(list(...))) {
deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
only_sir_columns <- list(...)$only_rsi_columns
}
ab_select_exec("lipoglycopeptides", only_sir_columns = only_sir_columns)
}
@ -455,10 +383,6 @@ lipoglycopeptides <- function(only_sir_columns = FALSE, ...) {
#' @export
macrolides <- function(only_sir_columns = FALSE, ...) {
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
if ("only_rsi_columns" %in% names(list(...))) {
deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
only_sir_columns <- list(...)$only_rsi_columns
}
ab_select_exec("macrolides", only_sir_columns = only_sir_columns)
}
@ -466,10 +390,6 @@ macrolides <- function(only_sir_columns = FALSE, ...) {
#' @export
oxazolidinones <- function(only_sir_columns = FALSE, ...) {
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
if ("only_rsi_columns" %in% names(list(...))) {
deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
only_sir_columns <- list(...)$only_rsi_columns
}
ab_select_exec("oxazolidinones", only_sir_columns = only_sir_columns)
}
@ -477,10 +397,6 @@ oxazolidinones <- function(only_sir_columns = FALSE, ...) {
#' @export
penicillins <- function(only_sir_columns = FALSE, ...) {
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
if ("only_rsi_columns" %in% names(list(...))) {
deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
only_sir_columns <- list(...)$only_rsi_columns
}
ab_select_exec("penicillins", only_sir_columns = only_sir_columns)
}
@ -489,10 +405,6 @@ penicillins <- function(only_sir_columns = FALSE, ...) {
polymyxins <- function(only_sir_columns = FALSE, only_treatable = TRUE, ...) {
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
meet_criteria(only_treatable, allow_class = "logical", has_length = 1)
if ("only_rsi_columns" %in% names(list(...))) {
deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
only_sir_columns <- list(...)$only_rsi_columns
}
ab_select_exec("polymyxins", only_sir_columns = only_sir_columns, only_treatable = only_treatable)
}
@ -500,10 +412,6 @@ polymyxins <- function(only_sir_columns = FALSE, only_treatable = TRUE, ...) {
#' @export
streptogramins <- function(only_sir_columns = FALSE, ...) {
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
if ("only_rsi_columns" %in% names(list(...))) {
deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
only_sir_columns <- list(...)$only_rsi_columns
}
ab_select_exec("streptogramins", only_sir_columns = only_sir_columns)
}
@ -511,10 +419,6 @@ streptogramins <- function(only_sir_columns = FALSE, ...) {
#' @export
quinolones <- function(only_sir_columns = FALSE, ...) {
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
if ("only_rsi_columns" %in% names(list(...))) {
deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
only_sir_columns <- list(...)$only_rsi_columns
}
ab_select_exec("quinolones", only_sir_columns = only_sir_columns)
}
@ -522,10 +426,6 @@ quinolones <- function(only_sir_columns = FALSE, ...) {
#' @export
tetracyclines <- function(only_sir_columns = FALSE, ...) {
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
if ("only_rsi_columns" %in% names(list(...))) {
deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
only_sir_columns <- list(...)$only_rsi_columns
}
ab_select_exec("tetracyclines", only_sir_columns = only_sir_columns)
}
@ -533,10 +433,6 @@ tetracyclines <- function(only_sir_columns = FALSE, ...) {
#' @export
trimethoprims <- function(only_sir_columns = FALSE, ...) {
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
if ("only_rsi_columns" %in% names(list(...))) {
deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
only_sir_columns <- list(...)$only_rsi_columns
}
ab_select_exec("trimethoprims", only_sir_columns = only_sir_columns)
}
@ -544,10 +440,6 @@ trimethoprims <- function(only_sir_columns = FALSE, ...) {
#' @export
ureidopenicillins <- function(only_sir_columns = FALSE, ...) {
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
if ("only_rsi_columns" %in% names(list(...))) {
deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
only_sir_columns <- list(...)$only_rsi_columns
}
ab_select_exec("ureidopenicillins", only_sir_columns = only_sir_columns)
}

1
R/eucast_rules.R
View File

@ -184,7 +184,6 @@ eucast_rules <- function(x,
meet_criteria(ampc_cephalosporin_resistance, allow_class = c("logical", "character", "sir"), has_length = 1, allow_NA = TRUE, allow_NULL = TRUE)
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
meet_criteria(custom_rules, allow_class = "custom_eucast_rules", allow_NULL = TRUE)
if ("only_rsi_columns" %in% names(list(...))) only_sir_columns <- list(...)$only_rsi_columns
add_MO_lookup_to_AMR_env()

4
R/first_isolate.R
View File

@ -227,10 +227,6 @@ first_isolate <- function(x = NULL,
meet_criteria(points_threshold, allow_class = c("numeric", "integer"), has_length = 1, is_positive = TRUE, is_finite = TRUE)
meet_criteria(info, allow_class = "logical", has_length = 1)
meet_criteria(include_unknown, allow_class = "logical", has_length = 1)
if ("include_untested_rsi" %in% names(list(...))) {
deprecation_warning("include_untested_rsi", "include_untested_sir", is_function = FALSE)
include_untested_sir <- list(...)$include_untested_rsi
}
meet_criteria(include_untested_sir, allow_class = "logical", has_length = 1)
# remove data.table, grouping from tibbles, etc.

10
R/ggplot_pca.R
View File

@ -85,16 +85,18 @@
#' summary(pca_result)
#'
#' # old base R plotting method:
#' biplot(pca_result)
#' biplot(pca_result, main = "Base R biplot")
#'
#' # new ggplot2 plotting method using this package:
#' if (require("ggplot2")) {
#' ggplot_pca(pca_result)
#'
#' ggplot_pca(pca_result) +
#' labs(title = "ggplot2 biplot")
#' }
#' if (require("ggplot2")) {
#' # still extendible with any ggplot2 function
#' ggplot_pca(pca_result) +
#' scale_colour_viridis_d() +
#' labs(title = "Title here")
#' labs(title = "ggplot2 biplot")
#' }
#' }
#' }

4
R/key_antimicrobials.R
View File

@ -149,10 +149,6 @@ key_antimicrobials <- function(x = NULL,
meet_criteria(gram_positive, allow_class = "character", allow_NULL = TRUE)
meet_criteria(antifungal, allow_class = "character", allow_NULL = TRUE)
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
if ("only_rsi_columns" %in% names(list(...))) {
deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
only_sir_columns <- list(...)$only_rsi_columns
}
# force regular data.frame, not a tibble or data.table
x <- as.data.frame(x, stringsAsFactors = FALSE)

4
R/mdro.R
View File

@ -192,10 +192,6 @@ mdro <- function(x = NULL,
meet_criteria(pct_required_classes, allow_class = "numeric", has_length = 1)
meet_criteria(combine_SI, allow_class = "logical", has_length = 1)
meet_criteria(verbose, allow_class = "logical", has_length = 1)
if ("only_rsi_columns" %in% names(list(...))) {
deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
only_sir_columns <- list(...)$only_rsi_columns
}
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
if (!any(is_sir_eligible(x))) {

89
R/mic.R
View File

@ -29,7 +29,7 @@
# these are allowed MIC values and will become [factor] levels
operators <- c("<", "<=", "", ">=", ">")
valid_mic_levels <- c(
VALID_MIC_LEVELS <- c(
c(t(vapply(
FUN.VALUE = character(6), operators,
function(x) paste0(x, "0.000", c(1:4, 6, 8))
@ -121,6 +121,8 @@ valid_mic_levels <- c(
#' Using [as.double()] or [as.numeric()] on MIC values will remove the operators and return a numeric vector. Do **not** use [as.integer()] on MIC values as by the \R convention on [factor]s, it will return the index of the factor levels (which is often useless for regular users).
#'
#' Use [droplevels()] to drop unused levels. At default, it will return a plain factor. Use `droplevels(..., as.mic = TRUE)` to maintain the `mic` class.
#'
#' With [rescale_mic()], existing MIC ranges can be rescaled to a defined range of MIC values. This can be useful to better compare MIC distributions.
#' @return Ordered [factor] with additional class [`mic`], that in mathematical operations acts as decimal numbers. Bare in mind that the outcome of any mathematical operation on MICs will return a [numeric] value.
#' @aliases mic
#' @export
@ -137,6 +139,9 @@ valid_mic_levels <- c(
#' fivenum(mic_data)
#' quantile(mic_data)
#' all(mic_data < 512)
#'
#' # rescale MICs using rescale_mic()
#' rescale_mic(mic_data, mic_range = c(4, 16))
#'
#' # interpret MIC values
#' as.sir(
@ -231,7 +236,7 @@ as.mic <- function(x, na.rm = FALSE, keep_operators = "all") {
x[x.bak != "" & x == ""] <- "invalid"
na_before <- x[is.na(x) | x == ""] %pm>% length()
x[!x %in% valid_mic_levels] <- NA
x[!x %in% VALID_MIC_LEVELS] <- NA
na_after <- x[is.na(x) | x == ""] %pm>% length()
if (na_before != na_after) {
@ -261,34 +266,78 @@ as.mic <- function(x, na.rm = FALSE, keep_operators = "all") {
x[!x %in% keep] <- gsub("[>=<]", "", x[!x %in% keep])
}
set_clean_class(factor(x, levels = valid_mic_levels, ordered = TRUE),
set_clean_class(factor(x, levels = VALID_MIC_LEVELS, ordered = TRUE),
new_class = c("mic", "ordered", "factor")
)
}
}
all_valid_mics <- function(x) {
if (!inherits(x, c("mic", "character", "factor", "numeric", "integer"))) {
return(FALSE)
}
x_mic <- tryCatch(suppressWarnings(as.mic(x[!is.na(x)])),
error = function(e) NA
)
!any(is.na(x_mic)) && !all(is.na(x))
#' @rdname as.mic
#' @export
is.mic <- function(x) {
inherits(x, "mic")
}
#' @rdname as.mic
#' @details `NA_mic_` is a missing value of the new `mic` class, analogous to e.g. base \R's [`NA_character_`][base::NA].
#' @format NULL
#' @export
NA_mic_ <- set_clean_class(factor(NA, levels = valid_mic_levels, ordered = TRUE),
NA_mic_ <- set_clean_class(factor(NA, levels = VALID_MIC_LEVELS, ordered = TRUE),
new_class = c("mic", "ordered", "factor")
)
#' @rdname as.mic
#' @param mic_range a manual range to plot the MIC values, e.g., `mic_range = c(0.001, 32)`. Use `NA` to set no limit on one side, e.g., `mic_range = c(NA, 32)`.
#' @export
is.mic <- function(x) {
inherits(x, "mic")
rescale_mic <- function(x, mic_range, keep_operators = "edges", as.mic = TRUE) {
meet_criteria(mic_range, allow_class = c("numeric", "integer", "logical"), has_length = 2, allow_NA = TRUE, allow_NULL = TRUE)
stop_ifnot(all(mic_range %in% c(VALID_MIC_LEVELS, NA)),
"Values in `mic_range` must be valid MIC values. Unvalid: ", vector_and(mic_range[mic_range %in% c(levels(as.mic(1)), NA)]))
x <- as.mic(x)
if (is.null(mic_range)) {
mic_range <- c(NA, NA)
}
mic_range <- as.mic(mic_range)
min_mic <- mic_range[1]
max_mic <- mic_range[2]
if (!is.na(min_mic)) {
x[x < min_mic] <- min_mic
}
if (!is.na(max_mic)) {
x[x > max_mic] <- max_mic
}
x <- as.mic(x, keep_operators = ifelse(keep_operators == "edges", "none", keep_operators))
if (isTRUE(as.mic)) {
if (keep_operators == "edges") {
x[x == min(x, na.rm = TRUE)] <- paste0("<=", x[x == min(x, na.rm = TRUE)])
x[x == max(x, na.rm = TRUE)] <- paste0(">=", x[x == max(x, na.rm = TRUE)])
}
return(x)
}
# create a manual factor with levels only within desired range
expanded <- range_as_table(x,
expand = TRUE,
keep_operators = ifelse(keep_operators == "edges", "none", keep_operators),
mic_range = mic_range)
if (keep_operators == "edges") {
names(expanded)[1] <- paste0("<=", names(expanded)[1])
names(expanded)[length(expanded)] <- paste0(">=", names(expanded)[length(expanded)])
}
# MICs contain all MIC levels, so strip this to only existing levels and their intermediate values
out <- factor(names(expanded),
levels = names(expanded),
ordered = TRUE)
# and only keep the ones in the data
if (keep_operators == "edges") {
out <- out[match(x, as.double(as.mic(out, keep_operators = "all")))]
} else {
out <- out[match(x, out)]
}
out
}
#' @method as.double mic
@ -317,6 +366,16 @@ droplevels.mic <- function(x, as.mic = FALSE, ...) {
x
}
all_valid_mics <- function(x) {
if (!inherits(x, c("mic", "character", "factor", "numeric", "integer"))) {
return(FALSE)
}
x_mic <- tryCatch(suppressWarnings(as.mic(x[!is.na(x)])),
error = function(e) NA
)
!any(is.na(x_mic)) && !all(is.na(x))
}
# will be exported using s3_register() in R/zzz.R
pillar_shaft.mic <- function(x, ...) {
crude_numbers <- as.double(x)
@ -339,7 +398,7 @@ type_sum.mic <- function(x, ...) {
#' @noRd
print.mic <- function(x, ...) {
cat("Class 'mic'",
ifelse(length(levels(x)) < length(valid_mic_levels), font_red(" with dropped levels"), ""),
ifelse(length(levels(x)) < length(VALID_MIC_LEVELS), font_red(" with dropped levels"), ""),
"\n",
sep = ""
)

216
R/plot.R
View File

@ -32,7 +32,7 @@
#' @description
#' Functions to plot classes `sir`, `mic` and `disk`, with support for base \R and `ggplot2`.
#'
#' Especially [scale_x_mic()] is a relevant wrapper to plot MIC values for `ggplot2`. It allows custom MIC ranges and to plot intermediate log2 levels for missing MIC values.
#' Especially the [scale_*_mic()] functions are relevant wrappers to plot MIC values for `ggplot2`. They allows custom MIC ranges and to plot intermediate log2 levels for missing MIC values.
#' @param x,object values created with [as.mic()], [as.disk()] or [as.sir()] (or their `random_*` variants, such as [random_mic()])
#' @param mo any (vector of) text that can be coerced to a valid microorganism code with [as.mo()]
#' @param ab any (vector of) text that can be coerced to a valid antimicrobial drug code with [as.ab()]
@ -68,9 +68,35 @@
#' plot(some_mic_values, mo = "S. aureus", ab = "ampicillin")
#' plot(some_disk_values, mo = "Escherichia coli", ab = "cipro")
#' plot(some_disk_values, mo = "Escherichia coli", ab = "cipro", language = "nl")
#'
#'
#'
#' # Plotting using scale_x_mic()
#' \donttest{
#' if (require("ggplot2")) {
#' mic_plot <- ggplot(data.frame(mics = as.mic(c(0.125, "<=4", 4, 8, 32, ">=32")),
#' counts = c(1, 1, 2, 2, 3, 3)),
#' aes(mics, counts)) +
#' geom_col()
#' mic_plot +
#' labs(title = "without scale_x_mic()")
#' }
#' if (require("ggplot2")) {
#' mic_plot +
#' scale_x_mic() +
#' labs(title = "with scale_x_mic()")
#' }
#' if (require("ggplot2")) {
#' mic_plot +
#' scale_x_mic(keep_operators = "all") +
#' labs(title = "with scale_x_mic() keeping all operators")
#' }
#' if (require("ggplot2")) {
#' mic_plot +
#' scale_x_mic(mic_range = c(1, 128)) +
#' labs(title = "with scale_x_mic() using a manual range")
#' }
#'
#' if (require("ggplot2")) {
#' autoplot(some_mic_values)
#' }
#' if (require("ggplot2")) {
@ -82,6 +108,54 @@
#' }
NULL
#' @export
#' @inheritParams as.mic
#' @rdname plot
scale_x_mic <- function(keep_operators = "edges", mic_range = NULL, ...) {
stop_ifnot_installed("ggplot2")
scale <- ggplot2::scale_x_discrete(...)
scale$transform <- function(x, keep_ops = keep_operators, mic_rng = mic_range) {
rescale_mic(x = x, keep_operators = keep_ops, mic_range = mic_rng, as.mic = FALSE)
}
scale
}
#' @export
#' @inheritParams as.mic
#' @rdname plot
scale_y_mic <- function(keep_operators = "edges", mic_range = NULL, ...) {
stop_ifnot_installed("ggplot2")
scale <- ggplot2::scale_y_discrete(...)
scale$transform <- function(x, keep_ops = keep_operators, mic_rng = mic_range) {
rescale_mic(x = x, keep_operators = keep_ops, mic_range = mic_rng, as.mic = FALSE)
}
scale
}
#' @export
#' @inheritParams as.mic
#' @rdname plot
scale_colour_mic <- function(keep_operators = "edges", mic_range = NULL, ...) {
stop_ifnot_installed("ggplot2")
scale <- ggplot2::scale_colour_discrete(...)
scale$transform <- function(x, keep_ops = keep_operators, mic_rng = mic_range) {
rescale_mic(x = x, keep_operators = keep_ops, mic_range = mic_rng, as.mic = FALSE)
}
scale
}
#' @export
#' @inheritParams as.mic
#' @rdname plot
scale_fill_mic <- function(keep_operators = "edges", mic_range = NULL, ...) {
stop_ifnot_installed("ggplot2")
scale <- ggplot2::scale_fill_discrete(...)
scale$transform <- function(x, keep_ops = keep_operators, mic_rng = mic_range) {
rescale_mic(x = x, keep_operators = keep_ops, mic_range = mic_rng, as.mic = FALSE)
}
scale
}
#' @method plot mic
#' @importFrom graphics barplot axis mtext legend
#' @export
@ -105,10 +179,6 @@ plot.mic <- function(x,
meet_criteria(main, allow_class = "character", has_length = 1, allow_NULL = TRUE)
meet_criteria(ylab, allow_class = "character", has_length = 1)
meet_criteria(xlab, allow_class = "character", has_length = 1)
if ("colours_RSI" %in% names(list(...))) {
deprecation_warning(extra_msg = "The 'colours_RSI' argument has been replaced with 'colours_SIR'.")
colours_SIR <- list(...)$colours_RSI
}
meet_criteria(colours_SIR, allow_class = "character", has_length = c(1, 3))
language <- validate_language(language)
meet_criteria(expand, allow_class = "logical", has_length = 1)
@ -118,8 +188,7 @@ plot.mic <- function(x,
}
main <- gsub(" +", " ", paste0(main, collapse = " "))
x <- plot_prepare_table(x, expand = expand)
x <- range_as_table(x, expand = expand)
cols_sub <- plot_colours_subtitle_guideline(
x = x,
mo = mo,
@ -195,10 +264,6 @@ barplot.mic <- function(height,
meet_criteria(mo, allow_class = c("mo", "character"), allow_NULL = TRUE)
meet_criteria(ab, allow_class = c("ab", "character"), allow_NULL = TRUE)
meet_criteria(guideline, allow_class = "character", has_length = 1)
if ("colours_RSI" %in% names(list(...))) {
deprecation_warning(extra_msg = "The 'colours_RSI' argument has been replaced with 'colours_SIR'.")
colours_SIR <- list(...)$colours_RSI
}
meet_criteria(colours_SIR, allow_class = "character", has_length = c(1, 3))
language <- validate_language(language)
meet_criteria(expand, allow_class = "logical", has_length = 1)
@ -241,10 +306,6 @@ autoplot.mic <- function(object,
meet_criteria(title, allow_class = "character", allow_NULL = TRUE)
meet_criteria(ylab, allow_class = "character", has_length = 1)
meet_criteria(xlab, allow_class = "character", has_length = 1)
if ("colours_RSI" %in% names(list(...))) {
deprecation_warning(extra_msg = "The 'colours_RSI' argument has been replaced with 'colours_SIR'.")
colours_SIR <- list(...)$colours_RSI
}
meet_criteria(colours_SIR, allow_class = "character", has_length = c(1, 3))
language <- validate_language(language)
meet_criteria(expand, allow_class = "logical", has_length = 1)
@ -256,7 +317,7 @@ autoplot.mic <- function(object,
title <- gsub(" +", " ", paste0(title, collapse = " "))
}
x <- plot_prepare_table(object, expand = expand)
x <- range_as_table(object, expand = expand)
cols_sub <- plot_colours_subtitle_guideline(
x = x,
mo = mo,
@ -319,93 +380,11 @@ autoplot.mic <- function(object,
# will be exported using s3_register() in R/zzz.R
fortify.mic <- function(object, ...) {
stats::setNames(
as.data.frame(plot_prepare_table(object, expand = FALSE)),
as.data.frame(range_as_table(object, expand = FALSE)),
c("x", "y")
)
}
#' @export
#' @inheritParams as.mic
#' @param mic_range a manual range to plot the MIC values, e.g., `mic_range = c(0.001, 32)`. Use `NA` to set no limit on one side, e.g., `mic_range = c(NA, 32)`.
#' @param drop,guide,position,na.translate arguments passed on to [ggplot2::scale_x_discrete()]
#' @rdname plot
#' @examples
#'
#' # Plotting using scale_x_mic()
#' \donttest{
#' if (require("ggplot2")) {
#' mic_plot <- ggplot(data.frame(mics = as.mic(c(0.125, "<=4", 4, 8, 32, ">=32")),
#' counts = c(1, 1, 2, 2, 3, 3)),
#' aes(mics, counts)) +
#' geom_col()
#' mic_plot +
#' labs(title = "without scale_x_mic()")
#' }
#' if (require("ggplot2")) {
#' mic_plot +
#' scale_x_mic() +
#' labs(title = "with scale_x_mic()")
#' }
#' if (require("ggplot2")) {
#' mic_plot +
#' scale_x_mic(keep_operators = "all") +
#' labs(title = "with scale_x_mic() keeping all operators")
#' }
#' if (require("ggplot2")) {
#' mic_plot +
#' scale_x_mic(mic_range = c(1, 128)) +
#' labs(title = "with scale_x_mic() using a manual range")
#' }
#' }
scale_x_mic <- function(keep_operators = "edges", mic_range = NULL, ..., drop = FALSE, guide = waiver(), position = "bottom", na.translate = TRUE) {
meet_criteria(keep_operators, allow_class = c("character", "logical"), is_in = c("all", "none", "edges", FALSE, TRUE), has_length = 1)
meet_criteria(mic_range, allow_class = c("numeric", "integer", "logical"), has_length = 2, allow_NA = TRUE, allow_NULL = TRUE)
stop_ifnot(all(mic_range %in% c(levels(as.mic(1)), NA)),
"Values in `mic_range` must be valid MIC values")
stop_ifnot_installed("ggplot2")
ggplot2::ggproto(NULL, ggplot2::ScaleDiscretePosition,
aesthetics = c("x", "xmin", "xmax", "xend"),
na.translate = na.translate,
drop = drop,
guide = guide,
position = position,
transform = function(x, keep_ops = keep_operators, mic_rng = mic_range) {
if (!is.null(mic_rng)) {
min_mic <- mic_rng[1]
max_mic <- mic_rng[2]
if (!is.na(min_mic)) {
x[x < as.mic(min_mic)] <- as.mic(min_mic)
}
if (!is.na(max_mic)) {
x[x > as.mic(max_mic)] <- as.mic(max_mic)
}
}
# transform MICs to only keep required operators
x <- as.mic(x, keep_operators = ifelse(keep_ops == "edges", "none", keep_ops))
# get range betwen min and max of MICs
expanded <- plot_prepare_table(x,
expand = TRUE,
keep_operators = ifelse(keep_ops == "edges", "none", keep_ops),
mic_range = mic_rng)
if (keep_ops == "edges") {
names(expanded)[1] <- paste0("<=", names(expanded)[1])
names(expanded)[length(expanded)] <- paste0(">=", names(expanded)[length(expanded)])
}
# MICs contain all MIC levels, so strip this to only existing levels and their intermediate values
out <- factor(names(expanded),
levels = names(expanded),
ordered = TRUE)
# and only keep the ones in the data
if (keep_ops == "edges") {
out <- out[match(x, as.double(as.mic(out, keep_operators = "all")))]
} else {
out <- out[match(x, out)]
}
out
},
...)
}
#' @method plot disk
#' @export
@ -430,10 +409,6 @@ plot.disk <- function(x,
meet_criteria(mo, allow_class = c("mo", "character"), allow_NULL = TRUE)
meet_criteria(ab, allow_class = c("ab", "character"), allow_NULL = TRUE)
meet_criteria(guideline, allow_class = "character", has_length = 1)
if ("colours_RSI" %in% names(list(...))) {
deprecation_warning(extra_msg = "The 'colours_RSI' argument has been replaced with 'colours_SIR'.")
colours_SIR <- list(...)$colours_RSI
}
meet_criteria(colours_SIR, allow_class = "character", has_length = c(1, 3))
language <- validate_language(language)
meet_criteria(expand, allow_class = "logical", has_length = 1)
@ -443,8 +418,7 @@ plot.disk <- function(x,
}
main <- gsub(" +", " ", paste0(main, collapse = " "))
x <- plot_prepare_table(x, expand = expand)
x <- range_as_table(x, expand = expand)
cols_sub <- plot_colours_subtitle_guideline(
x = x,
mo = mo,
@ -520,10 +494,6 @@ barplot.disk <- function(height,
meet_criteria(mo, allow_class = c("mo", "character"), allow_NULL = TRUE)
meet_criteria(ab, allow_class = c("ab", "character"), allow_NULL = TRUE)
meet_criteria(guideline, allow_class = "character", has_length = 1)
if ("colours_RSI" %in% names(list(...))) {
deprecation_warning(extra_msg = "The 'colours_RSI' argument has been replaced with 'colours_SIR'.")
colours_SIR <- list(...)$colours_RSI
}
meet_criteria(colours_SIR, allow_class = "character", has_length = c(1, 3))
language <- validate_language(language)
meet_criteria(expand, allow_class = "logical", has_length = 1)
@ -566,10 +536,6 @@ autoplot.disk <- function(object,
meet_criteria(mo, allow_class = c("mo", "character"), allow_NULL = TRUE)
meet_criteria(ab, allow_class = c("ab", "character"), allow_NULL = TRUE)
meet_criteria(guideline, allow_class = "character", has_length = 1)
if ("colours_RSI" %in% names(list(...))) {
deprecation_warning(extra_msg = "The 'colours_RSI' argument has been replaced with 'colours_SIR'.")
colours_SIR <- list(...)$colours_RSI
}
meet_criteria(colours_SIR, allow_class = "character", has_length = c(1, 3))
language <- validate_language(language)
meet_criteria(expand, allow_class = "logical", has_length = 1)
@ -581,7 +547,7 @@ autoplot.disk <- function(object,
title <- gsub(" +", " ", paste0(title, collapse = " "))
}
x <- plot_prepare_table(object, expand = expand)
x <- range_as_table(object, expand = expand)
cols_sub <- plot_colours_subtitle_guideline(
x = x,
mo = mo,
@ -645,7 +611,7 @@ autoplot.disk <- function(object,
# will be exported using s3_register() in R/zzz.R
fortify.disk <- function(object, ...) {
stats::setNames(
as.data.frame(plot_prepare_table(object, expand = FALSE)),
as.data.frame(range_as_table(object, expand = FALSE)),
c("x", "y")
)
}
@ -720,10 +686,6 @@ barplot.sir <- function(height,
meet_criteria(xlab, allow_class = "character", has_length = 1)
meet_criteria(main, allow_class = "character", has_length = 1, allow_NULL = TRUE)
meet_criteria(ylab, allow_class = "character", has_length = 1)
if ("colours_RSI" %in% names(list(...))) {
deprecation_warning(extra_msg = "The 'colours_RSI' argument has been replaced with 'colours_SIR'.")
colours_SIR <- list(...)$colours_RSI
}
meet_criteria(colours_SIR, allow_class = "character", has_length = c(1, 3))
language <- validate_language(language)
meet_criteria(expand, allow_class = "logical", has_length = 1)
@ -799,9 +761,8 @@ fortify.sir <- function(object, ...) {
)
}
plot_prepare_table <- function(x, expand, keep_operators = "all", mic_range = NULL) {
range_as_table <- function(x, expand, keep_operators = "all", mic_range = NULL) {
x <- x[!is.na(x)]
stop_if(length(x) == 0, "no observations to plot", call = FALSE)
if (is.mic(x)) {
x <- as.mic(x, keep_operators = keep_operators)
if (expand == TRUE) {
@ -847,6 +808,15 @@ plot_prepare_table <- function(x, expand, keep_operators = "all", mic_range = NU
as.table(x)
}
ggplot2_get_from_dots <- function(arg, default, ...) {
dots <- list(...)
if (!arg %in% names(dots)) {
default
} else {
dots[[arg]]
}
}
plot_name_of_I <- function(guideline) {
if (guideline %unlike% "CLSI" && as.double(gsub("[^0-9]+", "", guideline)) >= 2019) {
# interpretation since 2019
@ -858,6 +828,8 @@ plot_name_of_I <- function(guideline) {
}
plot_colours_subtitle_guideline <- function(x, mo, ab, guideline, colours_SIR, fn, language, method, breakpoint_type, include_PKPD, ...) {
stop_if(length(x) == 0, "no observations to plot", call = FALSE)
guideline <- get_guideline(guideline, AMR::clinical_breakpoints)
# store previous interpretations to backup

4
R/random.R
View File

@ -83,10 +83,6 @@ random_disk <- function(size = NULL, mo = NULL, ab = NULL, ...) {
#' @export
random_sir <- function(size = NULL, prob_SIR = c(0.33, 0.33, 0.33), ...) {
meet_criteria(size, allow_class = c("numeric", "integer"), has_length = 1, is_positive = TRUE, is_finite = TRUE, allow_NULL = TRUE)
if ("prob_RSI" %in% names(list(...))) {
deprecation_warning("prob_RSI", "prob_SIR", is_function = FALSE)
prob_SIR <- list(...)$prob_RSI
}
meet_criteria(prob_SIR, allow_class = c("numeric", "integer"), has_length = 3)
if (is.null(size)) {
size <- NROW(get_current_data(arg_name = "size", call = -3))

7
R/sir.R
View File

@ -237,12 +237,7 @@ is.sir <- function(x) {
if (inherits(x, "data.frame")) {
unname(vapply(FUN.VALUE = logical(1), x, is.sir))
} else {
rsi <- inherits(x, "rsi")
sir <- inherits(x, "sir")
if (isTRUE(rsi) && message_not_thrown_before("is.sir-rsi")) {
deprecation_warning(extra_msg = "The 'rsi' class has been replaced with 'sir'. Transform your 'rsi' columns to 'sir' with `as.sir()`, e.g.:\n your_data %>% mutate_if(is.rsi, as.sir)")
}
isTRUE(rsi) || isTRUE(sir)
isTRUE(inherits(x, "sir"))
}
}

4
R/sir_calc.R
View File

@ -223,7 +223,7 @@ sir_calc_df <- function(type, # "proportion", "count" or "both"
combine_SI = TRUE,
confidence_level = 0.95) {
meet_criteria(type, is_in = c("proportion", "count", "both"), has_length = 1)
meet_criteria(data, allow_class = "data.frame", contains_column_class = c("sir", "rsi"))
meet_criteria(data, allow_class = "data.frame", contains_column_class = "sir")
meet_criteria(translate_ab, allow_class = c("character", "logical"), has_length = 1, allow_NA = TRUE)
language <- validate_language(language)
meet_criteria(minimum, allow_class = c("numeric", "integer"), has_length = 1, is_positive_or_zero = TRUE, is_finite = TRUE)
@ -373,5 +373,5 @@ sir_calc_df <- function(type, # "proportion", "count" or "both"
rownames(out) <- NULL
out <- as_original_data_class(out, class(data.bak)) # will remove tibble groups
structure(out, class = c("sir_df", "rsi_df", class(out)))
structure(out, class = c("sir_df", class(out)))
}

173
R/zz_deprecated.R
View File

@ -27,171 +27,14 @@
# 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(...) {
# REMINDER: change as.sir() to remove the deprecation warning there
suppressWarnings(is.sir(...))
}
#' @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, ...) {
if (message_not_thrown_before("type_sum.rsi")) {
deprecation_warning(extra_msg = "The 'rsi' class has been replaced with 'sir'. Transform your 'rsi' columns to 'sir' with `as.sir()`, e.g.:\n your_data %>% mutate_if(is.rsi, as.sir)")
}
"rsi"
}
#' @method print rsi
#' @export
#' @noRd
print.rsi <- function(x, ...) {
deprecation_warning(extra_msg = "The 'rsi' class has been replaced with 'sir' - transform your 'rsi' data with `as.sir()`")
cat("Class 'rsi'", font_bold(font_red("[!]\n")))
print(as.character(x), quote = FALSE)
}
#' @noRd
#' @export
`[<-.rsi` <- `[<-.sir`
#' @noRd
#' @export
`[[<-.rsi` <- `[[<-.sir`
#' @noRd
#' @export
barplot.rsi <- barplot.sir
#' @noRd
#' @export
c.rsi <- c.sir
#' @noRd
#' @export
droplevels.rsi <- droplevels.sir
#' @noRd
#' @export
plot.rsi <- plot.sir
#' @noRd
#' @export
rep.rsi <- rep.sir
#' @noRd
#' @export
summary.rsi <- summary.sir
#' @noRd
#' @export
unique.rsi <- unique.sir
# WHEN REMOVING RSI, DON'T FORGET TO REMOVE :
# - THE "rsi_df" CLASS FROM R/sir_calc.R
# - CODE CONTAINING only_rsi_columns, colours_RSI, include_untested_rsi, prob_RSI
# #' 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
# NULL
deprecation_warning <- function(old = NULL, new = NULL, extra_msg = NULL, is_function = TRUE) {
if (is.null(old)) {

2
R/zzz.R
View File

@ -98,14 +98,12 @@ if (pkg_is_available("cli")) {
s3_register("pillar::pillar_shaft", "av")
s3_register("pillar::pillar_shaft", "mo")
s3_register("pillar::pillar_shaft", "sir")
s3_register("pillar::pillar_shaft", "rsi") # remove in a later version
s3_register("pillar::pillar_shaft", "mic")
s3_register("pillar::pillar_shaft", "disk")
s3_register("pillar::type_sum", "ab")
s3_register("pillar::type_sum", "av")
s3_register("pillar::type_sum", "mo")
s3_register("pillar::type_sum", "sir")
s3_register("pillar::type_sum", "rsi") # remove in a later version
s3_register("pillar::type_sum", "mic")
s3_register("pillar::type_sum", "disk")
# Support for frequency tables from the cleaner package