From c7461766ce8faea14c3859118476608d30dc0152 Mon Sep 17 00:00:00 2001 From: Matthijs Berends Date: Sun, 3 Dec 2023 11:34:48 +0100 Subject: [PATCH] Remove RSI from package, add extra MIC scale functions --- DESCRIPTION | 2 +- NAMESPACE | 33 +------ NEWS.md | 2 +- R/ab_selectors.R | 108 --------------------- R/eucast_rules.R | 1 - R/first_isolate.R | 4 - R/ggplot_pca.R | 10 +- R/key_antimicrobials.R | 4 - R/mdro.R | 4 - R/mic.R | 89 ++++++++++++++--- R/plot.R | 216 ++++++++++++++++++----------------------- R/random.R | 4 - R/sir.R | 7 +- R/sir_calc.R | 4 +- R/zz_deprecated.R | 173 ++------------------------------- R/zzz.R | 2 - _pkgdown.yml | 34 ++++--- man/AMR-deprecated.Rd | 59 ----------- man/as.mic.Rd | 14 ++- man/ggplot_pca.Rd | 10 +- man/plot.Rd | 60 ++++++------ 21 files changed, 260 insertions(+), 580 deletions(-) delete mode 100644 man/AMR-deprecated.Rd diff --git a/DESCRIPTION b/DESCRIPTION index 22f425ee..c4ee124c 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,5 +1,5 @@ Package: AMR -Version: 2.1.1.9001 +Version: 2.1.1.9002 Date: 2023-12-03 Title: Antimicrobial Resistance Data Analysis Description: Functions to simplify and standardise antimicrobial resistance (AMR) diff --git a/NAMESPACE b/NAMESPACE index ca05ddbe..1f713d00 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -13,7 +13,6 @@ S3method("[<-",av) S3method("[<-",disk) S3method("[<-",mic) S3method("[<-",mo) -S3method("[<-",rsi) S3method("[<-",sir) S3method("[[",ab) S3method("[[",av) @@ -25,7 +24,6 @@ S3method("[[<-",av) S3method("[[<-",disk) S3method("[[<-",mic) S3method("[[<-",mo) -S3method("[[<-",rsi) S3method("[[<-",sir) S3method("|",ab_selector) S3method(Complex,mic) @@ -44,10 +42,6 @@ S3method(as.list,custom_eucast_rules) S3method(as.list,custom_mdro_guideline) S3method(as.matrix,mic) S3method(as.numeric,mic) -S3method(as.rsi,data.frame) -S3method(as.rsi,default) -S3method(as.rsi,disk) -S3method(as.rsi,mic) S3method(as.sir,data.frame) S3method(as.sir,default) S3method(as.sir,disk) @@ -55,7 +49,6 @@ S3method(as.sir,mic) S3method(barplot,antibiogram) S3method(barplot,disk) S3method(barplot,mic) -S3method(barplot,rsi) S3method(barplot,sir) S3method(c,ab) S3method(c,ab_selector) @@ -65,11 +58,9 @@ S3method(c,custom_mdro_guideline) S3method(c,disk) S3method(c,mic) S3method(c,mo) -S3method(c,rsi) S3method(c,sir) S3method(close,progress_bar) S3method(droplevels,mic) -S3method(droplevels,rsi) S3method(droplevels,sir) S3method(format,bug_drug_combinations) S3method(hist,mic) @@ -87,7 +78,6 @@ S3method(plot,antibiogram) S3method(plot,disk) S3method(plot,mic) S3method(plot,resistance_predict) -S3method(plot,rsi) S3method(plot,sir) S3method(print,ab) S3method(print,av) @@ -100,7 +90,6 @@ S3method(print,mo) S3method(print,mo_renamed) S3method(print,mo_uncertainties) S3method(print,pca) -S3method(print,rsi) S3method(print,sir) S3method(quantile,mic) S3method(rep,ab) @@ -108,7 +97,6 @@ S3method(rep,av) S3method(rep,disk) S3method(rep,mic) S3method(rep,mo) -S3method(rep,rsi) S3method(rep,sir) S3method(skewness,data.frame) S3method(skewness,default) @@ -117,14 +105,12 @@ S3method(sort,mic) S3method(summary,mic) S3method(summary,mo) S3method(summary,pca) -S3method(summary,rsi) S3method(summary,sir) S3method(unique,ab) S3method(unique,av) S3method(unique,disk) S3method(unique,mic) S3method(unique,mo) -S3method(unique,rsi) S3method(unique,sir) export("%like%") export("%like_case%") @@ -132,7 +118,6 @@ export("%unlike%") export("%unlike_case%") export(NA_disk_) export(NA_mic_) -export(NA_rsi_) export(NA_sir_) export(ab_atc) export(ab_atc_group1) @@ -171,7 +156,6 @@ export(as.av) export(as.disk) export(as.mic) export(as.mo) -export(as.rsi) export(as.sir) export(atc_online_ddd) export(atc_online_ddd_units) @@ -217,21 +201,17 @@ export(custom_mdro_guideline) export(eucast_dosage) export(eucast_exceptional_phenotypes) export(eucast_rules) -export(facet_rsi) export(facet_sir) export(filter_first_isolate) export(first_isolate) export(fluoroquinolones) export(full_join_microorganisms) export(g.test) -export(geom_rsi) export(geom_sir) export(get_AMR_locale) export(get_episode) export(get_mo_source) export(ggplot_pca) -export(ggplot_rsi) -export(ggplot_rsi_predict) export(ggplot_sir) export(ggplot_sir_predict) export(glycopeptides) @@ -242,8 +222,6 @@ export(is.av) export(is.disk) export(is.mic) export(is.mo) -export(is.rsi) -export(is.rsi.eligible) export(is.sir) export(is_new_episode) export(is_sir_eligible) @@ -251,7 +229,6 @@ export(italicise_taxonomy) export(italicize_taxonomy) export(key_antimicrobials) export(kurtosis) -export(labels_rsi_count) export(labels_sir_count) export(left_join_microorganisms) export(like) @@ -304,7 +281,6 @@ export(mo_uncertainties) export(mo_url) export(mo_year) export(mrgn) -export(n_rsi) export(n_sir) export(not_intrinsic_resistant) export(oxazolidinones) @@ -320,17 +296,17 @@ export(proportion_df) export(quinolones) export(random_disk) export(random_mic) -export(random_rsi) export(random_sir) +export(rescale_mic) export(reset_AMR_locale) export(resistance) export(resistance_predict) export(right_join_microorganisms) -export(rsi_df) -export(rsi_predict) -export(scale_rsi_colours) +export(scale_colour_mic) +export(scale_fill_mic) export(scale_sir_colours) export(scale_x_mic) +export(scale_y_mic) export(scale_y_percent) export(semi_join_microorganisms) export(set_AMR_locale) @@ -344,7 +320,6 @@ export(skewness) export(streptogramins) export(susceptibility) export(tetracyclines) -export(theme_rsi) export(theme_sir) export(translate_AMR) export(trimethoprims) diff --git a/NEWS.md b/NEWS.md index d33307a5..e808d831 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,4 @@ -# AMR 2.1.1.9001 +# AMR 2.1.1.9002 ## New * Function `scale_x_mic()`, an advanced function to use in ggplot, to allow plotting of MIC values on the x axis. It allow for manual range definition and plotting missing intermediate log2 levels. diff --git a/R/ab_selectors.R b/R/ab_selectors.R index dcc4b10f..bf24f30e 100755 --- a/R/ab_selectors.R +++ b/R/ab_selectors.R @@ -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) } diff --git a/R/eucast_rules.R b/R/eucast_rules.R index c71d5a1c..f5417db4 100755 --- a/R/eucast_rules.R +++ b/R/eucast_rules.R @@ -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() diff --git a/R/first_isolate.R b/R/first_isolate.R index a116dd2a..d19d3186 100644 --- a/R/first_isolate.R +++ b/R/first_isolate.R @@ -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. diff --git a/R/ggplot_pca.R b/R/ggplot_pca.R index 8fc8a34b..3976b431 100755 --- a/R/ggplot_pca.R +++ b/R/ggplot_pca.R @@ -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") #' } #' } #' } diff --git a/R/key_antimicrobials.R b/R/key_antimicrobials.R index 9623f8ce..d390fff5 100755 --- a/R/key_antimicrobials.R +++ b/R/key_antimicrobials.R @@ -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) diff --git a/R/mdro.R b/R/mdro.R index b6891aa0..bd588294 100755 --- a/R/mdro.R +++ b/R/mdro.R @@ -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))) { diff --git a/R/mic.R b/R/mic.R index 0a70f5d1..8acb0e57 100644 --- a/R/mic.R +++ b/R/mic.R @@ -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 = "" ) diff --git a/R/plot.R b/R/plot.R index 5b0fa585..a9e7f71d 100755 --- a/R/plot.R +++ b/R/plot.R @@ -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 diff --git a/R/random.R b/R/random.R index c9d14a89..a1f50ca0 100755 --- a/R/random.R +++ b/R/random.R @@ -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)) diff --git a/R/sir.R b/R/sir.R index d333f7e4..be0d66c8 100755 --- a/R/sir.R +++ b/R/sir.R @@ -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")) } } diff --git a/R/sir_calc.R b/R/sir_calc.R index e352710a..ccf57192 100755 --- a/R/sir_calc.R +++ b/R/sir_calc.R @@ -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))) } diff --git a/R/zz_deprecated.R b/R/zz_deprecated.R index d17fa850..54b89f12 100755 --- a/R/zz_deprecated.R +++ b/R/zz_deprecated.R @@ -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)) { diff --git a/R/zzz.R b/R/zzz.R index d1d6c0a5..61132423 100755 --- a/R/zzz.R +++ b/R/zzz.R @@ -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 diff --git a/_pkgdown.yml b/_pkgdown.yml index aa82ff17..ca7144ea 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -174,7 +174,7 @@ reference: - "`atc_online_property`" - "`add_custom_antimicrobials`" - - title: "Preparing data: antimicrobial resistance" + - title: "Preparing data" desc: > With `as.mic()` and `as.disk()` you can transform your raw input to valid MIC or disk diffusion values. Use `as.sir()` for cleaning raw data to let it only contain "R", "I" and "S", or to interpret MIC or disk diffusion values as SIR based on the lastest EUCAST and CLSI guidelines. @@ -186,7 +186,7 @@ reference: - "`eucast_rules`" - "`custom_eucast_rules`" - - title: "Analysing data: antimicrobial resistance" + - title: "Analysing data" desc: > Use these function for the analysis part. You can use `susceptibility()` or `resistance()` on any antibiotic column. With `antibiogram()`, you can generate a traditional, combined, syndromic, or weighted-incidence syndromic combination @@ -202,14 +202,25 @@ reference: - "`key_antimicrobials`" - "`mdro`" - "`count`" - - "`plot`" - - "`ggplot_sir`" - "`bug_drug_combinations`" - "`antibiotic_class_selectors`" - "`mean_amr_distance`" - "`resistance_predict`" - "`guess_ab_col`" + - title: "Plotting data" + desc: > + Use these functions for the plotting part. The `scale_*_mic()` functions extend the ggplot2 package to allow plotting of + MIC values, even within a manually set range. + If using `plot()` (base R) or `autoplot()` (ggplot2) on MIC values or disk diffusion values, the user can + set the interpretation guideline to give the bars the right SIR colours. + The `ggplot_sir()` function is a short wrapper for users not much accustomed to ggplot2 yet. + The `ggplot_pca()` function is a specific function to plot so-called biplots for PCA (principal component analysis). + contents: + - "`plot`" + - "`ggplot_sir`" + - "`ggplot_pca`" + - title: "Other: AMR-specific options" desc: > The AMR package is customisable, by providing settings that can be set per user or per team. For @@ -257,7 +268,6 @@ reference: - "`age`" - "`availability`" - "`get_AMR_locale`" - - "`ggplot_pca`" - "`italicise_taxonomy`" - "`join`" - "`like`" @@ -273,10 +283,10 @@ reference: - "`kurtosis`" - "`skewness`" - - title: "Other: deprecated functions" - desc: > - These functions are deprecated, meaning that they will still - work but show a warning with every use and will be removed - in a future version. - contents: - - "`AMR-deprecated`" + # - title: "Other: deprecated functions" + # desc: > + # These functions are deprecated, meaning that they will still + # work but show a warning with every use and will be removed + # in a future version. + # contents: + # - "`AMR-deprecated`" diff --git a/man/AMR-deprecated.Rd b/man/AMR-deprecated.Rd deleted file mode 100644 index 1ef2cd9f..00000000 --- a/man/AMR-deprecated.Rd +++ /dev/null @@ -1,59 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/zz_deprecated.R -\docType{data} -\name{AMR-deprecated} -\alias{AMR-deprecated} -\alias{NA_rsi_} -\alias{as.rsi} -\alias{facet_rsi} -\alias{geom_rsi} -\alias{ggplot_rsi} -\alias{ggplot_rsi_predict} -\alias{is.rsi} -\alias{is.rsi.eligible} -\alias{labels_rsi_count} -\alias{n_rsi} -\alias{random_rsi} -\alias{rsi_df} -\alias{rsi_predict} -\alias{scale_rsi_colours} -\alias{theme_rsi} -\title{Deprecated Functions} -\format{ -An object of class \code{rsi} (inherits from \code{ordered}, \code{factor}) of length 1. -} -\usage{ -NA_rsi_ - -as.rsi(x, ...) - -facet_rsi(...) - -geom_rsi(...) - -ggplot_rsi(...) - -ggplot_rsi_predict(...) - -is.rsi(...) - -is.rsi.eligible(...) - -labels_rsi_count(...) - -n_rsi(...) - -random_rsi(...) - -rsi_df(...) - -rsi_predict(...) - -scale_rsi_colours(...) - -theme_rsi(...) -} -\description{ -These functions are so-called '\link{Deprecated}'. \strong{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). -} -\keyword{internal} diff --git a/man/as.mic.Rd b/man/as.mic.Rd index 7f7920b4..09acf325 100644 --- a/man/as.mic.Rd +++ b/man/as.mic.Rd @@ -4,16 +4,19 @@ \name{as.mic} \alias{as.mic} \alias{mic} -\alias{NA_mic_} \alias{is.mic} +\alias{NA_mic_} +\alias{rescale_mic} \alias{droplevels.mic} \title{Transform Input to Minimum Inhibitory Concentrations (MIC)} \usage{ as.mic(x, na.rm = FALSE, keep_operators = "all") +is.mic(x) + NA_mic_ -is.mic(x) +rescale_mic(x, mic_range, keep_operators = "edges", as.mic = TRUE) \method{droplevels}{mic}(x, as.mic = FALSE, ...) } @@ -24,6 +27,8 @@ is.mic(x) \item{keep_operators}{a \link{character} specifying how to handle operators (such as \code{>} and \code{<=}) in the input. Accepts one of three values: \code{"all"} (or \code{TRUE}) to keep all operators, \code{"none"} (or \code{FALSE}) to remove all operators, or \code{"edges"} to keep operators only at both ends of the range.} +\item{mic_range}{a manual range to plot the MIC values, e.g., \code{mic_range = c(0.001, 32)}. Use \code{NA} to set no limit on one side, e.g., \code{mic_range = c(NA, 32)}.} + \item{as.mic}{a \link{logical} to indicate whether the \code{mic} class should be kept - the default is \code{FALSE}} \item{...}{arguments passed on to methods} @@ -77,6 +82,8 @@ Using \code{\link[=as.double]{as.double()}} or \code{\link[=as.numeric]{as.numer Use \code{\link[=droplevels]{droplevels()}} to drop unused levels. At default, it will return a plain factor. Use \code{droplevels(..., as.mic = TRUE)} to maintain the \code{mic} class. +With \code{\link[=rescale_mic]{rescale_mic()}}, existing MIC ranges can be rescaled to a defined range of MIC values. This can be useful to better compare MIC distributions. + \code{NA_mic_} is a missing value of the new \code{mic} class, analogous to e.g. base \R's \code{\link[base:NA]{NA_character_}}. } \examples{ @@ -92,6 +99,9 @@ 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( x = as.mic(2), diff --git a/man/ggplot_pca.Rd b/man/ggplot_pca.Rd index 3693bc07..1482b5d0 100644 --- a/man/ggplot_pca.Rd +++ b/man/ggplot_pca.Rd @@ -130,16 +130,18 @@ if (require("dplyr")) { 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") } } } diff --git a/man/plot.Rd b/man/plot.Rd index dcaa8561..a84c6fc0 100644 --- a/man/plot.Rd +++ b/man/plot.Rd @@ -2,10 +2,13 @@ % Please edit documentation in R/plot.R \name{plot} \alias{plot} +\alias{scale_x_mic} +\alias{scale_y_mic} +\alias{scale_colour_mic} +\alias{scale_fill_mic} \alias{plot.mic} \alias{autoplot.mic} \alias{fortify.mic} -\alias{scale_x_mic} \alias{plot.disk} \alias{autoplot.disk} \alias{fortify.disk} @@ -14,6 +17,14 @@ \alias{fortify.sir} \title{Plotting for Classes \code{sir}, \code{mic} and \code{disk}} \usage{ +scale_x_mic(keep_operators = "edges", mic_range = NULL, ...) + +scale_y_mic(keep_operators = "edges", mic_range = NULL, ...) + +scale_colour_mic(keep_operators = "edges", mic_range = NULL, ...) + +scale_fill_mic(keep_operators = "edges", mic_range = NULL, ...) + \method{plot}{mic}( x, mo = NULL, @@ -48,16 +59,6 @@ \method{fortify}{mic}(object, ...) -scale_x_mic( - keep_operators = "edges", - mic_range = NULL, - ..., - drop = FALSE, - guide = waiver(), - position = "bottom", - na.translate = TRUE -) - \method{plot}{disk}( x, main = deparse(substitute(x)), @@ -114,6 +115,12 @@ scale_x_mic( \method{fortify}{sir}(object, ...) } \arguments{ +\item{keep_operators}{a \link{character} specifying how to handle operators (such as \code{>} and \code{<=}) in the input. Accepts one of three values: \code{"all"} (or \code{TRUE}) to keep all operators, \code{"none"} (or \code{FALSE}) to remove all operators, or \code{"edges"} to keep operators only at both ends of the range.} + +\item{mic_range}{a manual range to plot the MIC values, e.g., \code{mic_range = c(0.001, 32)}. Use \code{NA} to set no limit on one side, e.g., \code{mic_range = c(NA, 32)}.} + +\item{...}{arguments passed on to methods} + \item{x, object}{values created with \code{\link[=as.mic]{as.mic()}}, \code{\link[=as.disk]{as.disk()}} or \code{\link[=as.sir]{as.sir()}} (or their \verb{random_*} variants, such as \code{\link[=random_mic]{random_mic()}})} \item{mo}{any (vector of) text that can be coerced to a valid microorganism code with \code{\link[=as.mo]{as.mo()}}} @@ -135,14 +142,6 @@ scale_x_mic( \item{include_PKPD}{a \link{logical} to indicate that PK/PD clinical breakpoints must be applied as a last resort - the default is \code{TRUE}. Can also be set with the \link[=AMR-options]{package option} \code{\link[=AMR-options]{AMR_include_PKPD}}.} \item{breakpoint_type}{the type of breakpoints to use, either "ECOFF", "animal", or "human". ECOFF stands for Epidemiological Cut-Off values. The default is \code{"human"}, which can also be set with the \link[=AMR-options]{package option} \code{\link[=AMR-options]{AMR_breakpoint_type}}.} - -\item{...}{arguments passed on to methods} - -\item{keep_operators}{a \link{character} specifying how to handle operators (such as \code{>} and \code{<=}) in the input. Accepts one of three values: \code{"all"} (or \code{TRUE}) to keep all operators, \code{"none"} (or \code{FALSE}) to remove all operators, or \code{"edges"} to keep operators only at both ends of the range.} - -\item{mic_range}{a manual range to plot the MIC values, e.g., \code{mic_range = c(0.001, 32)}. Use \code{NA} to set no limit on one side, e.g., \code{mic_range = c(NA, 32)}.} - -\item{drop, guide, position, na.translate}{arguments passed on to \code{\link[ggplot2:scale_discrete]{ggplot2::scale_x_discrete()}}} } \value{ The \code{autoplot()} functions return a \code{\link[ggplot2:ggplot]{ggplot}} model that is extendible with any \code{ggplot2} function. @@ -152,7 +151,7 @@ The \code{fortify()} functions return a \link{data.frame} as an extension for us \description{ Functions to plot classes \code{sir}, \code{mic} and \code{disk}, with support for base \R and \code{ggplot2}. -Especially \code{\link[=scale_x_mic]{scale_x_mic()}} is a relevant wrapper to plot MIC values for \code{ggplot2}. It allows custom MIC ranges and to plot intermediate log2 levels for missing MIC values. +Especially the \code{\link[=scale_*_mic]{scale_*_mic()}} functions are relevant wrappers to plot MIC values for \code{ggplot2}. They allows custom MIC ranges and to plot intermediate log2 levels for missing MIC values. } \details{ The interpretation of "I" will be named "Increased exposure" for all EUCAST guidelines since 2019, and will be named "Intermediate" in all other cases. @@ -175,17 +174,6 @@ 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") -\donttest{ -if (require("ggplot2")) { - autoplot(some_mic_values) -} -if (require("ggplot2")) { - autoplot(some_disk_values, mo = "Escherichia coli", ab = "cipro") -} -if (require("ggplot2")) { - autoplot(some_sir_values) -} -} # Plotting using scale_x_mic() \donttest{ @@ -212,5 +200,15 @@ if (require("ggplot2")) { 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")) { + autoplot(some_disk_values, mo = "Escherichia coli", ab = "cipro") +} +if (require("ggplot2")) { + autoplot(some_sir_values) +} } }