mirror of
https://github.com/msberends/AMR.git
synced 2024-12-26 07:26:13 +01:00
Remove RSI from package, add extra MIC scale functions
This commit is contained in:
parent
6f417d0ef2
commit
c7461766ce
@ -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)
|
||||
|
||||
33
NAMESPACE
33
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)
|
||||
|
||||
2
NEWS.md
2
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.
|
||||
|
||||
108
R/ab_selectors.R
108
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)
|
||||
}
|
||||
|
||||
|
||||
@ -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()
|
||||
|
||||
|
||||
@ -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.
|
||||
|
||||
@ -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")
|
||||
#' }
|
||||
#' }
|
||||
#' }
|
||||
|
||||
@ -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
4
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))) {
|
||||
|
||||
89
R/mic.R
89
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 = ""
|
||||
)
|
||||
|
||||
216
R/plot.R
216
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
|
||||
|
||||
@ -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
7
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"))
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
@ -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)))
|
||||
}
|
||||
|
||||
@ -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
2
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
|
||||
|
||||
34
_pkgdown.yml
34
_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`"
|
||||
|
||||
@ -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}
|
||||
@ -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),
|
||||
|
||||
@ -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")
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
60
man/plot.Rd
60
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)
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
Loading…
Reference in New Issue
Block a user