mirror of
https://github.com/msberends/AMR.git
synced 2025-07-09 17:41:59 +02:00
(v2.1.1.9279) fix documentation, add foreign S3 exports to functions
This commit is contained in:
6
R/ab.R
6
R/ab.R
@ -503,7 +503,8 @@ ab_reset_session <- function() {
|
||||
}
|
||||
}
|
||||
|
||||
# will be exported using s3_register() in R/zzz.R
|
||||
# this prevents the requirement for putting the dependency in Imports:
|
||||
#' @rawNamespace if(getRversion() >= "3.0.0") S3method(pillar::pillar_shaft, ab)
|
||||
pillar_shaft.ab <- function(x, ...) {
|
||||
out <- trimws(format(x))
|
||||
out[is.na(x)] <- font_na(NA)
|
||||
@ -519,7 +520,8 @@ pillar_shaft.ab <- function(x, ...) {
|
||||
create_pillar_column(out, align = "left", min_width = 4)
|
||||
}
|
||||
|
||||
# will be exported using s3_register() in R/zzz.R
|
||||
# this prevents the requirement for putting the dependency in Imports:
|
||||
#' @rawNamespace if(getRversion() >= "3.0.0") S3method(pillar::type_sum, ab)
|
||||
type_sum.ab <- function(x, ...) {
|
||||
"ab"
|
||||
}
|
||||
|
@ -1190,7 +1190,8 @@ retrieve_wisca_parameters <- function(wisca_model, ...) {
|
||||
attributes(wisca_model)$wisca_parameters
|
||||
}
|
||||
|
||||
# will be exported in R/zzz.R
|
||||
# this prevents the requirement for putting the dependency in Imports:
|
||||
#' @rawNamespace if(getRversion() >= "3.0.0") S3method(pillar::tbl_sum, antibiogram)
|
||||
tbl_sum.antibiogram <- function(x, ...) {
|
||||
dims <- paste(format(NROW(x), big.mark = ","), AMR_env$cross_icon, format(NCOL(x), big.mark = ","))
|
||||
if (isTRUE(attributes(x)$wisca)) {
|
||||
@ -1203,7 +1204,8 @@ tbl_sum.antibiogram <- function(x, ...) {
|
||||
dims
|
||||
}
|
||||
|
||||
# will be exported in R/zzz.R
|
||||
# this prevents the requirement for putting the dependency in Imports:
|
||||
#' @rawNamespace if(getRversion() >= "3.0.0") S3method(pillar::tbl_format_footer, antibiogram)
|
||||
tbl_format_footer.antibiogram <- function(x, ...) {
|
||||
footer <- NextMethod()
|
||||
if (NROW(x) == 0) {
|
||||
@ -1271,7 +1273,8 @@ barplot.antibiogram <- function(height, ...) {
|
||||
|
||||
#' @method autoplot antibiogram
|
||||
#' @rdname antibiogram
|
||||
# will be exported using s3_register() in R/zzz.R
|
||||
# this prevents the requirement for putting the dependency in Imports:
|
||||
#' @rawNamespace if(getRversion() >= "3.0.0") S3method(ggplot2::autoplot, antibiogram)
|
||||
autoplot.antibiogram <- function(object, ...) {
|
||||
df <- attributes(object)$long_numeric
|
||||
if (!"mo" %in% colnames(df)) {
|
||||
@ -1318,11 +1321,12 @@ autoplot.antibiogram <- function(object, ...) {
|
||||
out
|
||||
}
|
||||
|
||||
# will be exported in zzz.R
|
||||
#' @method knit_print antibiogram
|
||||
#' @param italicise A [logical] to indicate whether the microorganism names in the [knitr][knitr::kable()] table should be made italic, using [italicise_taxonomy()].
|
||||
#' @param na Character to use for showing `NA` values.
|
||||
#' @rdname antibiogram
|
||||
# this prevents the requirement for putting the dependency in Imports:
|
||||
#' @rawNamespace if(getRversion() >= "3.0.0") S3method(knitr::knit_print, antibiogram)
|
||||
knit_print.antibiogram <- function(x, italicise = TRUE, na = getOption("knitr.kable.NA", default = ""), ...) {
|
||||
stop_ifnot_installed("knitr")
|
||||
meet_criteria(italicise, allow_class = "logical", has_length = 1)
|
||||
|
6
R/av.R
6
R/av.R
@ -507,7 +507,8 @@ is.av <- function(x) {
|
||||
inherits(x, "av")
|
||||
}
|
||||
|
||||
# will be exported using s3_register() in R/zzz.R
|
||||
# this prevents the requirement for putting the dependency in Imports:
|
||||
#' @rawNamespace if(getRversion() >= "3.0.0") S3method(pillar::pillar_shaft, av)
|
||||
pillar_shaft.av <- function(x, ...) {
|
||||
out <- trimws(format(x))
|
||||
out[!is.na(x)] <- gsub("+", font_subtle("+"), out[!is.na(x)], fixed = TRUE)
|
||||
@ -515,7 +516,8 @@ pillar_shaft.av <- function(x, ...) {
|
||||
create_pillar_column(out, align = "left", min_width = 4)
|
||||
}
|
||||
|
||||
# will be exported using s3_register() in R/zzz.R
|
||||
# this prevents the requirement for putting the dependency in Imports:
|
||||
#' @rawNamespace if(getRversion() >= "3.0.0") S3method(pillar::type_sum, av)
|
||||
type_sum.av <- function(x, ...) {
|
||||
"av"
|
||||
}
|
||||
|
@ -356,7 +356,8 @@ format.bug_drug_combinations <- function(x,
|
||||
as_original_data_class(y, class(x.bak), extra_class = "formatted_bug_drug_combinations") # will remove tibble groups
|
||||
}
|
||||
|
||||
# will be exported in zzz.R
|
||||
# this prevents the requirement for putting the dependency in Imports:
|
||||
#' @rawNamespace if(getRversion() >= "3.0.0") S3method(knitr::knit_print, formatted_bug_drug_combinations)
|
||||
knit_print.formatted_bug_drug_combinations <- function(x, ...) {
|
||||
stop_ifnot_installed("knitr")
|
||||
# make columns with MO names italic according to nomenclature
|
||||
|
@ -33,7 +33,6 @@
|
||||
#' @param ... Rules in [formula][base::tilde] notation, see below for instructions, and in *Examples*.
|
||||
#' @details
|
||||
#' Some organisations have their own adoption of EUCAST rules. This function can be used to define custom EUCAST rules to be used in the [eucast_rules()] function.
|
||||
#' @section How it works:
|
||||
#'
|
||||
#' ### Basics
|
||||
#'
|
||||
@ -69,7 +68,11 @@
|
||||
#' #> 1 Escherichia coli R S S
|
||||
#' #> 2 Klebsiella pneumoniae R S S
|
||||
#'
|
||||
#' eucast_rules(df, rules = "custom", custom_rules = x, info = FALSE, overwrite = TRUE)
|
||||
#' eucast_rules(df,
|
||||
#' rules = "custom",
|
||||
#' custom_rules = x,
|
||||
#' info = FALSE,
|
||||
#' overwrite = TRUE)
|
||||
#' #> mo TZP ampi cipro
|
||||
#' #> 1 Escherichia coli R R S
|
||||
#' #> 2 Klebsiella pneumoniae R R S
|
||||
@ -80,10 +83,16 @@
|
||||
#' There is one exception in columns used for the rules: all column names of the [microorganisms] data set can also be used, but do not have to exist in the data set. These column names are: `r vector_and(colnames(microorganisms), sort = FALSE)`. Thus, this next example will work as well, despite the fact that the `df` data set does not contain a column `genus`:
|
||||
#'
|
||||
#' ```r
|
||||
#' y <- custom_eucast_rules(TZP == "S" & genus == "Klebsiella" ~ aminopenicillins == "S",
|
||||
#' TZP == "R" & genus == "Klebsiella" ~ aminopenicillins == "R")
|
||||
#' y <- custom_eucast_rules(
|
||||
#' TZP == "S" & genus == "Klebsiella" ~ aminopenicillins == "S",
|
||||
#' TZP == "R" & genus == "Klebsiella" ~ aminopenicillins == "R"
|
||||
#' )
|
||||
#'
|
||||
#' eucast_rules(df, rules = "custom", custom_rules = y, info = FALSE, overwrite = TRUE)
|
||||
#' eucast_rules(df,
|
||||
#' rules = "custom",
|
||||
#' custom_rules = y,
|
||||
#' info = FALSE,
|
||||
#' overwrite = TRUE)
|
||||
#' #> mo TZP ampi cipro
|
||||
#' #> 1 Escherichia coli R S S
|
||||
#' #> 2 Klebsiella pneumoniae R R S
|
||||
|
@ -31,10 +31,9 @@
|
||||
#'
|
||||
#' Define custom a MDRO guideline for your organisation or specific analysis and use the output of this function in [mdro()].
|
||||
#' @param ... Guideline rules in [formula][base::tilde] notation, see below for instructions, and in *Examples*.
|
||||
#' @inheritParams mdro
|
||||
#' @param as_factor A [logical] to indicate whether the returned value should be an ordered [factor] (`TRUE`, default), or otherwise a [character] vector. For combining rules sets (using [c()]) this value will be inherited from the first set at default.
|
||||
#' @details
|
||||
#' Using a custom MDRO guideline is of importance if you have custom rules to determine MDROs in your hospital, e.g., rules that are dependent on ward, state of contact isolation or other variables in your data.
|
||||
#' @section How it works:
|
||||
#'
|
||||
#' ### Basics
|
||||
#'
|
||||
@ -109,9 +108,9 @@
|
||||
#' )
|
||||
#' ```
|
||||
#'
|
||||
#' These `r length(DEFINED_AB_GROUPS)` antimicrobial groups are allowed in the rules (case-insensitive) and can be used in any combination:
|
||||
#' All `r length(DEFINED_AB_GROUPS)` antimicrobial selectors are supported for use in the rules:
|
||||
#'
|
||||
#' `r paste0(" * ", sapply(DEFINED_AB_GROUPS, function(x) paste0(tolower(gsub("^AB_", "", x)), "\\cr(", vector_and(ab_name(eval(parse(text = x), envir = asNamespace("AMR")), language = NULL, tolower = TRUE), quotes = FALSE), ")"), USE.NAMES = FALSE), "\n", collapse = "")`
|
||||
#' `r paste0(" * ", na.omit(sapply(DEFINED_AB_GROUPS, function(ab) ifelse(tolower(gsub("^AB_", "", ab)) %in% ls(envir = asNamespace("AMR")), paste0("[", tolower(gsub("^AB_", "", ab)), "()] can select: \\cr ", vector_and(ab_name(eval(parse(text = ab), envir = asNamespace("AMR")), language = NULL, tolower = TRUE), quotes = FALSE, sort = TRUE)), character(0)), USE.NAMES = FALSE)), "\n", collapse = "")`
|
||||
#' @returns A [list] containing the custom rules
|
||||
#' @rdname custom_mdro_guideline
|
||||
#' @export
|
||||
@ -189,6 +188,7 @@ custom_mdro_guideline <- function(..., as_factor = TRUE) {
|
||||
}
|
||||
|
||||
#' @method c custom_mdro_guideline
|
||||
#' @param x Existing custom MDRO rules
|
||||
#' @rdname custom_mdro_guideline
|
||||
#' @export
|
||||
c.custom_mdro_guideline <- function(x, ..., as_factor = NULL) {
|
||||
@ -228,7 +228,7 @@ as.list.custom_mdro_guideline <- function(x, ...) {
|
||||
}
|
||||
|
||||
#' @method print custom_mdro_guideline
|
||||
#' @rdname custom_mdro_guideline
|
||||
#' @noRd
|
||||
#' @export
|
||||
print.custom_mdro_guideline <- function(x, ...) {
|
||||
cat("A set of custom MDRO rules:\n")
|
||||
|
6
R/disk.R
6
R/disk.R
@ -158,7 +158,8 @@ is.disk <- function(x) {
|
||||
inherits(x, "disk")
|
||||
}
|
||||
|
||||
# will be exported using s3_register() in R/zzz.R
|
||||
# this prevents the requirement for putting the dependency in Imports:
|
||||
#' @rawNamespace if(getRversion() >= "3.0.0") S3method(pillar::pillar_shaft, disk)
|
||||
pillar_shaft.disk <- function(x, ...) {
|
||||
out <- trimws(format(x))
|
||||
out[is.na(x)] <- font_na(NA)
|
||||
@ -232,7 +233,8 @@ rep.disk <- function(x, ...) {
|
||||
y
|
||||
}
|
||||
|
||||
# will be exported using s3_register() in R/zzz.R
|
||||
# this prevents the requirement for putting the dependency in Imports:
|
||||
#' @rawNamespace if(getRversion() >= "3.0.0") S3method(skimr::get_skimmers, disk)
|
||||
get_skimmers.disk <- function(column) {
|
||||
skimr::sfl(
|
||||
skim_type = "disk",
|
||||
|
@ -67,7 +67,7 @@ format_eucast_version_nr <- function(version, markdown = TRUE) {
|
||||
#' @param version_expected_phenotypes The version number to use for the EUCAST Expected Phenotypes. Can be `r vector_or(names(EUCAST_VERSION_EXPECTED_PHENOTYPES), reverse = TRUE)`.
|
||||
#' @param version_expertrules The version number to use for the EUCAST Expert Rules and Intrinsic Resistance guideline. Can be `r vector_or(names(EUCAST_VERSION_EXPERT_RULES), reverse = TRUE)`.
|
||||
#' @param ampc_cephalosporin_resistance (only applies when `rules` contains `"expert"` or `"all"`) a [character] value that should be applied to cefotaxime, ceftriaxone and ceftazidime for AmpC de-repressed cephalosporin-resistant mutants - the default is `NA`. Currently only works when `version_expertrules` is `3.2` and higher; these versions of '*EUCAST Expert Rules on Enterobacterales*' state that results of cefotaxime, ceftriaxone and ceftazidime should be reported with a note, or results should be suppressed (emptied) for these three drugs. A value of `NA` (the default) for this argument will remove results for these three drugs, while e.g. a value of `"R"` will make the results for these drugs resistant. Use `NULL` or `FALSE` to not alter results for these three drugs of AmpC de-repressed cephalosporin-resistant mutants. Using `TRUE` is equal to using `"R"`. \cr For *EUCAST Expert Rules* v3.2, this rule applies to: `r vector_and(gsub("[^a-zA-Z ]+", "", unlist(strsplit(EUCAST_RULES_DF[which(EUCAST_RULES_DF$reference.version %in% c(3.2, 3.3) & EUCAST_RULES_DF$reference.rule %like% "ampc"), "this_value"][1], "|", fixed = TRUE))), quotes = "*")`.
|
||||
#' @param ... Column name of an antimicrobial, see section *Antimicrobials* below.
|
||||
#' @param ... Column names of antimicrobials. To automatically detect antimicrobial column names, do not provide any named arguments; [guess_ab_col()] will then be used for detection. To manually specify a column, provide its name (case-insensitive) as an argument, e.g. `AMX = "amoxicillin"`. To skip a specific antimicrobial, set it to `NULL`, e.g. `TIC = NULL` to exclude ticarcillin. If a manually defined column does not exist in the data, it will be skipped with a warning.
|
||||
#' @param ab Any (vector of) text that can be coerced to a valid antimicrobial drug code with [as.ab()].
|
||||
#' @param administration Route of administration, either `r vector_or(dosage$administration)`.
|
||||
#' @param only_sir_columns A [logical] to indicate whether only antimicrobial columns must be included that were transformed to class [sir][as.sir()] on beforehand. Defaults to `FALSE` if no columns of `x` have a class [sir][as.sir()].
|
||||
@ -101,10 +101,6 @@ format_eucast_version_nr <- function(version, markdown = TRUE) {
|
||||
#' Important examples include amoxicillin and amoxicillin/clavulanic acid, and trimethoprim and trimethoprim/sulfamethoxazole. Needless to say, for these rules to work, both drugs must be available in the data set.
|
||||
#'
|
||||
#' Since these rules are not officially approved by EUCAST, they are not applied at default. To use these rules, include `"other"` to the `rules` argument, or use `eucast_rules(..., rules = "all")`. You can also set the package option [`AMR_eucastrules`][AMR-options], i.e. run `options(AMR_eucastrules = "all")`.
|
||||
#' @section Antimicrobials:
|
||||
#' To let the function automatically detect antimicrobial column names, do not provide any named arguments. It will then use [guess_ab_col()] to find them.
|
||||
#'
|
||||
#' To manually specify a column, provide its name (case-insensitive) as an argument, e.g. `AMX = "amoxicillin"`. To skip a specific antimicrobial, set it to `NULL`, e.g. `TIC = NULL` to exclude ticarcillin. If a manually defined column does not exist in the data, it will be skipped with a warning.
|
||||
#' @aliases EUCAST
|
||||
#' @rdname eucast_rules
|
||||
#' @export
|
||||
|
7
R/mdro.R
7
R/mdro.R
@ -38,13 +38,10 @@
|
||||
#' @param mecC [logical] values, or a column name containing logical values, indicating the presence of a *mecC* gene (or production of its proteins).
|
||||
#' @param vanA [logical] values, or a column name containing logical values, indicating the presence of a *vanA* gene (or production of its proteins).
|
||||
#' @param vanB [logical] values, or a column name containing logical values, indicating the presence of a *vanB* gene (or production of its proteins).
|
||||
#' @param ... In case of [custom_mdro_guideline()]: a set of rules, see section *Using Custom Guidelines* below. Otherwise: column name of an antibiotic, see section *Antimicrobials* below.
|
||||
#' @param as_factor A [logical] to indicate whether the returned value should be an ordered [factor] (`TRUE`, default), or otherwise a [character] vector.
|
||||
#' @inheritParams eucast_rules
|
||||
#' @param pct_required_classes Minimal required percentage of antimicrobial classes that must be available per isolate, rounded down. For example, with the default guideline, 17 antimicrobial classes must be available for *S. aureus*. Setting this `pct_required_classes` argument to `0.5` (default) means that for every *S. aureus* isolate at least 8 different classes must be available. Any lower number of available classes will return `NA` for that isolate.
|
||||
#' @param combine_SI A [logical] to indicate whether all values of S and I must be merged into one, so resistance is only considered when isolates are R, not I. As this is the default behaviour of the [mdro()] function, it follows the redefinition by EUCAST about the interpretation of I (increased exposure) in 2019, see section 'Interpretation of S, I and R' below. When using `combine_SI = FALSE`, resistance is considered when isolates are R or I.
|
||||
#' @param verbose A [logical] to turn Verbose mode on and off (default is off). In Verbose mode, the function does not return the MDRO results, but instead returns a data set in logbook form with extensive info about which isolates would be MDRO-positive, or why they are not.
|
||||
#' @inheritSection eucast_rules Antimicrobials
|
||||
#' @details
|
||||
#' These functions are context-aware. This means that the `x` argument can be left blank if used inside a [data.frame] call, see *Examples*.
|
||||
#'
|
||||
@ -701,7 +698,7 @@ mdro <- function(x = NULL,
|
||||
x
|
||||
}
|
||||
|
||||
# antibiotic classes
|
||||
# antimicrobial classes
|
||||
# nolint start
|
||||
aminoglycosides <- c(TOB, GEN)
|
||||
cephalosporins <- c(CDZ, CAC, CEC, CFR, RID, MAN, CTZ, CZD, CZO, CDR, DIT, FEP, CAT, CFM, CMX, CMZ, DIZ, CID, CFP, CSL, CND, CTX, CTT, CTF, FOX, CPM, CPO, CPD, CPR, CRD, CFS, CPT, CAZ, CCV, CTL, CTB, CZX, BPR, CFM1, CEI, CRO, CXM, LEX, CEP, HAP, CED, LTM, LOR)
|
||||
@ -1109,7 +1106,7 @@ mdro <- function(x = NULL,
|
||||
)
|
||||
}
|
||||
|
||||
# add antibiotic names of resistant ones to verbose output
|
||||
# add antimicrobial names of resistant ones to verbose output
|
||||
}
|
||||
|
||||
if (guideline$code == "eucast3.1") {
|
||||
|
9
R/mic.R
9
R/mic.R
@ -422,7 +422,8 @@ all_valid_mics <- function(x) {
|
||||
!any(is.na(x_mic)) && !all(is.na(x))
|
||||
}
|
||||
|
||||
# will be exported using s3_register() in R/zzz.R
|
||||
# this prevents the requirement for putting the dependency in Imports:
|
||||
#' @rawNamespace if(getRversion() >= "3.0.0") S3method(pillar::pillar_shaft, mic)
|
||||
pillar_shaft.mic <- function(x, ...) {
|
||||
if (!identical(levels(x), VALID_MIC_LEVELS) && message_not_thrown_before("pillar_shaft.mic")) {
|
||||
warning_(AMR_env$sup_1_icon, " These columns contain an outdated or altered structure - convert with `as.mic()` to update",
|
||||
@ -439,7 +440,8 @@ pillar_shaft.mic <- function(x, ...) {
|
||||
create_pillar_column(out, align = "right", width = max(nchar(font_stripstyle(out))))
|
||||
}
|
||||
|
||||
# will be exported using s3_register() in R/zzz.R
|
||||
# this prevents the requirement for putting the dependency in Imports:
|
||||
#' @rawNamespace if(getRversion() >= "3.0.0") S3method(pillar::type_sum, mic)
|
||||
type_sum.mic <- function(x, ...) {
|
||||
if (!identical(levels(x), VALID_MIC_LEVELS)) {
|
||||
paste0("mic", AMR_env$sup_1_icon)
|
||||
@ -582,7 +584,8 @@ hist.mic <- function(x, ...) {
|
||||
hist(log2(x))
|
||||
}
|
||||
|
||||
# will be exported using s3_register() in R/zzz.R
|
||||
# this prevents the requirement for putting the dependency in Imports:
|
||||
#' @rawNamespace if(getRversion() >= "3.0.0") S3method(skimr::get_skimmers, mic)
|
||||
get_skimmers.mic <- function(column) {
|
||||
column <- as.mic(column) # make sure that currently implemented MIC levels are used
|
||||
skimr::sfl(
|
||||
|
12
R/mo.R
12
R/mo.R
@ -620,7 +620,8 @@ mo_cleaning_regex <- function() {
|
||||
|
||||
# UNDOCUMENTED METHODS ----------------------------------------------------
|
||||
|
||||
# will be exported using s3_register() in R/zzz.R
|
||||
# this prevents the requirement for putting the dependency in Imports:
|
||||
#' @rawNamespace if(getRversion() >= "3.0.0") S3method(pillar::pillar_shaft, mo)
|
||||
pillar_shaft.mo <- function(x, ...) {
|
||||
add_MO_lookup_to_AMR_env()
|
||||
out <- trimws(format(x))
|
||||
@ -690,12 +691,14 @@ pillar_shaft.mo <- function(x, ...) {
|
||||
)
|
||||
}
|
||||
|
||||
# will be exported using s3_register() in R/zzz.R
|
||||
# this prevents the requirement for putting the dependency in Imports:
|
||||
#' @rawNamespace if(getRversion() >= "3.0.0") S3method(pillar::type_sum, mo)
|
||||
type_sum.mo <- function(x, ...) {
|
||||
"mo"
|
||||
}
|
||||
|
||||
# will be exported using s3_register() in R/zzz.R
|
||||
# this prevents the requirement for putting the dependency in Imports:
|
||||
#' @rawNamespace if(getRversion() >= "3.0.0") S3method(cleaner::freq, mo)
|
||||
freq.mo <- function(x, ...) {
|
||||
x_noNA <- as.mo(x[!is.na(x)]) # as.mo() to get the newest mo codes
|
||||
grams <- mo_gramstain(x_noNA, language = NULL)
|
||||
@ -736,7 +739,8 @@ freq.mo <- function(x, ...) {
|
||||
)
|
||||
}
|
||||
|
||||
# will be exported using s3_register() in R/zzz.R
|
||||
# this prevents the requirement for putting the dependency in Imports:
|
||||
#' @rawNamespace if(getRversion() >= "3.0.0") S3method(skimr::get_skimmers, mo)
|
||||
get_skimmers.mo <- function(column) {
|
||||
skimr::sfl(
|
||||
skim_type = "mo",
|
||||
|
18
R/plotting.R
18
R/plotting.R
@ -613,7 +613,8 @@ barplot.mic <- function(height,
|
||||
|
||||
#' @method autoplot mic
|
||||
#' @rdname plot
|
||||
# will be exported using s3_register() in R/zzz.R
|
||||
# this prevents the requirement for putting the dependency in Imports:
|
||||
#' @rawNamespace if(getRversion() >= "3.0.0") S3method(ggplot2::autoplot, mic)
|
||||
autoplot.mic <- function(object,
|
||||
mo = NULL,
|
||||
ab = NULL,
|
||||
@ -708,7 +709,8 @@ autoplot.mic <- function(object,
|
||||
|
||||
#' @method fortify mic
|
||||
#' @noRd
|
||||
# will be exported using s3_register() in R/zzz.R
|
||||
# this prevents the requirement for putting the dependency in Imports:
|
||||
#' @rawNamespace if(getRversion() >= "3.0.0") S3method(ggplot2::fortify, mic)
|
||||
fortify.mic <- function(object, ...) {
|
||||
object <- as.mic(object) # make sure that currently implemented MIC levels are used
|
||||
stats::setNames(
|
||||
@ -847,7 +849,8 @@ barplot.disk <- function(height,
|
||||
|
||||
#' @method autoplot disk
|
||||
#' @rdname plot
|
||||
# will be exported using s3_register() in R/zzz.R
|
||||
# this prevents the requirement for putting the dependency in Imports:
|
||||
#' @rawNamespace if(getRversion() >= "3.0.0") S3method(ggplot2::autoplot, disk)
|
||||
autoplot.disk <- function(object,
|
||||
mo = NULL,
|
||||
ab = NULL,
|
||||
@ -942,7 +945,8 @@ autoplot.disk <- function(object,
|
||||
|
||||
#' @method fortify disk
|
||||
#' @noRd
|
||||
# will be exported using s3_register() in R/zzz.R
|
||||
# this prevents the requirement for putting the dependency in Imports:
|
||||
#' @rawNamespace if(getRversion() >= "3.0.0") S3method(ggplot2::fortify, disk)
|
||||
fortify.disk <- function(object, ...) {
|
||||
stats::setNames(
|
||||
as.data.frame(plotrange_as_table(object, expand = FALSE)),
|
||||
@ -1055,7 +1059,8 @@ barplot.sir <- function(height,
|
||||
|
||||
#' @method autoplot sir
|
||||
#' @rdname plot
|
||||
# will be exported using s3_register() in R/zzz.R
|
||||
# this prevents the requirement for putting the dependency in Imports:
|
||||
#' @rawNamespace if(getRversion() >= "3.0.0") S3method(ggplot2::autoplot, sir)
|
||||
autoplot.sir <- function(object,
|
||||
title = deparse(substitute(object)),
|
||||
xlab = translate_AMR("Antimicrobial Interpretation", language = language),
|
||||
@ -1102,7 +1107,8 @@ autoplot.sir <- function(object,
|
||||
|
||||
#' @method fortify sir
|
||||
#' @noRd
|
||||
# will be exported using s3_register() in R/zzz.R
|
||||
# this prevents the requirement for putting the dependency in Imports:
|
||||
#' @rawNamespace if(getRversion() >= "3.0.0") S3method(ggplot2::fortify, sir)
|
||||
fortify.sir <- function(object, ...) {
|
||||
stats::setNames(
|
||||
as.data.frame(table(object)),
|
||||
|
@ -401,7 +401,8 @@ ggplot_sir_predict <- function(x,
|
||||
|
||||
#' @method autoplot resistance_predict
|
||||
#' @rdname resistance_predict
|
||||
# will be exported using s3_register() in R/zzz.R
|
||||
# this prevents the requirement for putting the dependency in Imports:
|
||||
#' @rawNamespace if(getRversion() >= "3.0.0") S3method(ggplot2::autoplot, resistance_predict)
|
||||
autoplot.resistance_predict <- function(object,
|
||||
main = paste("Resistance Prediction of", x_name),
|
||||
ribbon = TRUE,
|
||||
@ -414,7 +415,8 @@ autoplot.resistance_predict <- function(object,
|
||||
|
||||
#' @method fortify resistance_predict
|
||||
#' @noRd
|
||||
# will be exported using s3_register() in R/zzz.R
|
||||
# this prevents the requirement for putting the dependency in Imports:
|
||||
#' @rawNamespace if(getRversion() >= "3.0.0") S3method(ggplot2::fortify, resistance_predict)
|
||||
fortify.resistance_predict <- function(model, data, ...) {
|
||||
as.data.frame(model)
|
||||
}
|
||||
|
13
R/sir.R
13
R/sir.R
@ -1896,7 +1896,8 @@ print.sir_log <- function(x, ...) {
|
||||
print(x, ...)
|
||||
}
|
||||
|
||||
# will be exported using s3_register() in R/zzz.R
|
||||
# this prevents the requirement for putting the dependency in Imports:
|
||||
#' @rawNamespace if(getRversion() >= "3.0.0") S3method(pillar::pillar_shaft, sir)
|
||||
pillar_shaft.sir <- function(x, ...) {
|
||||
out <- trimws(format(x))
|
||||
if (has_colour()) {
|
||||
@ -1912,12 +1913,14 @@ pillar_shaft.sir <- function(x, ...) {
|
||||
create_pillar_column(out, align = "left", width = 5)
|
||||
}
|
||||
|
||||
# will be exported using s3_register() in R/zzz.R
|
||||
# this prevents the requirement for putting the dependency in Imports:
|
||||
#' @rawNamespace if(getRversion() >= "3.0.0") S3method(pillar::type_sum, sir)
|
||||
type_sum.sir <- function(x, ...) {
|
||||
"sir"
|
||||
}
|
||||
|
||||
# will be exported using s3_register() in R/zzz.R
|
||||
# this prevents the requirement for putting the dependency in Imports:
|
||||
#' @rawNamespace if(getRversion() >= "3.0.0") S3method(cleaner::freq, sir)
|
||||
freq.sir <- function(x, ...) {
|
||||
x_name <- deparse(substitute(x))
|
||||
x_name <- gsub(".*[$]", "", x_name)
|
||||
@ -1960,8 +1963,8 @@ freq.sir <- function(x, ...) {
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
# will be exported using s3_register() in R/zzz.R
|
||||
# this prevents the requirement for putting the dependency in Imports:
|
||||
#' @rawNamespace if(getRversion() >= "3.0.0") S3method(skimr::get_skimmers, sir)
|
||||
get_skimmers.sir <- function(column) {
|
||||
# get the variable name 'skim_variable'
|
||||
name_call <- function(.data) {
|
||||
|
61
R/vctrs.R
61
R/vctrs.R
@ -34,6 +34,67 @@
|
||||
|
||||
# see https://github.com/tidyverse/dplyr/issues/5955 why this is required
|
||||
|
||||
# LIST ALL EXPORTS
|
||||
# this prevents the requirement for putting `vctrs` as a the dependency in Imports
|
||||
|
||||
# (NOTE 2024-02-22 this is the right way - it should be 2 '.'-separated S3 classes in the second argument)
|
||||
# S3: amr_selector
|
||||
#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_ptype2, character.amr_selector)
|
||||
#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_ptype2, amr_selector.character)
|
||||
#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, character.amr_selector)
|
||||
# S3: amr_selector_any_all
|
||||
#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_ptype2, logical.amr_selector_any_all)
|
||||
#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_ptype2, amr_selector_any_all.logical)
|
||||
#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, logical.amr_selector_any_all)
|
||||
# S3: ab
|
||||
#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_ptype2, ab.default)
|
||||
#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_ptype2, ab.ab)
|
||||
#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, character.ab)
|
||||
#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, ab.character)
|
||||
# S3: av
|
||||
#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_ptype2, av.default)
|
||||
#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_ptype2, av.av)
|
||||
#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, character.av)
|
||||
#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, av.character)
|
||||
# S3: mo
|
||||
#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_ptype2, mo.default)
|
||||
#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_ptype2, mo.mo)
|
||||
#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, character.mo)
|
||||
#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, mo.character)
|
||||
# S3: disk
|
||||
#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_ptype_full, disk)
|
||||
#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_ptype_abbr, disk)
|
||||
#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_ptype2, disk.default)
|
||||
#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_ptype2, disk.disk)
|
||||
#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, disk.disk)
|
||||
#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, integer.disk)
|
||||
#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, disk.integer)
|
||||
#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, double.disk)
|
||||
#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, disk.double)
|
||||
#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, character.disk)
|
||||
#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, disk.character)
|
||||
# S3: mic
|
||||
#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_ptype2, mic.default)
|
||||
#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_ptype2, mic.mic)
|
||||
#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, character.mic)
|
||||
#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, double.mic)
|
||||
#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, integer.mic)
|
||||
#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, factor.mic)
|
||||
#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, mic.character)
|
||||
#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, mic.double)
|
||||
#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, mic.integer)
|
||||
#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, mic.factor)
|
||||
#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, mic.mic)
|
||||
#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_math, mic)
|
||||
#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_arith, mic)
|
||||
# S3: sir
|
||||
#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_ptype2, sir.default)
|
||||
#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_ptype2, sir.sir)
|
||||
#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_ptype2, character.sir)
|
||||
#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, character.sir)
|
||||
#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, sir.character)
|
||||
#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, sir.sir)
|
||||
|
||||
# S3: amr_selector ----
|
||||
# this does not need a .default method since it's used internally only
|
||||
vec_ptype2.character.amr_selector <- function(x, y, ...) {
|
||||
|
100
R/zzz.R
100
R/zzz.R
@ -94,106 +94,6 @@ AMR_env$cli_abort <- import_fn("cli_abort", "cli", error_on_fail = FALSE)
|
||||
AMR_env$cross_icon <- if (isTRUE(base::l10n_info()$`UTF-8`)) "\u00d7" else "x"
|
||||
|
||||
.onLoad <- function(libname, pkgname) {
|
||||
# Support for tibble headers (type_sum) and tibble columns content (pillar_shaft)
|
||||
# without the need to depend on other packages. This was suggested by the
|
||||
# developers of the vctrs package:
|
||||
# https://github.com/r-lib/vctrs/blob/05968ce8e669f73213e3e894b5f4424af4f46316/R/register-s3.R
|
||||
s3_register("pillar::pillar_shaft", "ab")
|
||||
s3_register("pillar::pillar_shaft", "av")
|
||||
s3_register("pillar::pillar_shaft", "mo")
|
||||
s3_register("pillar::pillar_shaft", "sir")
|
||||
s3_register("pillar::pillar_shaft", "mic")
|
||||
s3_register("pillar::pillar_shaft", "disk")
|
||||
# no type_sum of disk, that's now in vctrs::vec_ptype_full
|
||||
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", "mic")
|
||||
s3_register("pillar::tbl_sum", "antibiogram")
|
||||
s3_register("pillar::tbl_format_footer", "antibiogram")
|
||||
# Support for frequency tables from the cleaner package
|
||||
s3_register("cleaner::freq", "mo")
|
||||
s3_register("cleaner::freq", "sir")
|
||||
# Support for skim() from the skimr package
|
||||
if (pkg_is_available("skimr", min_version = "2.0.0")) {
|
||||
s3_register("skimr::get_skimmers", "mo")
|
||||
s3_register("skimr::get_skimmers", "sir")
|
||||
s3_register("skimr::get_skimmers", "mic")
|
||||
s3_register("skimr::get_skimmers", "disk")
|
||||
}
|
||||
# Support for autoplot() from the ggplot2 package
|
||||
s3_register("ggplot2::autoplot", "sir")
|
||||
s3_register("ggplot2::autoplot", "mic")
|
||||
s3_register("ggplot2::autoplot", "disk")
|
||||
s3_register("ggplot2::autoplot", "resistance_predict")
|
||||
s3_register("ggplot2::autoplot", "antibiogram")
|
||||
# Support for fortify from the ggplot2 package
|
||||
s3_register("ggplot2::fortify", "sir")
|
||||
s3_register("ggplot2::fortify", "mic")
|
||||
s3_register("ggplot2::fortify", "disk")
|
||||
# Support for knitr (R Markdown/Quarto)
|
||||
s3_register("knitr::knit_print", "antibiogram")
|
||||
s3_register("knitr::knit_print", "formatted_bug_drug_combinations")
|
||||
# Support vctrs package for use in e.g. dplyr verbs
|
||||
# (NOTE 2024-02-22 this is the right way - it should be 2 '.'-separated S3 classes in the second argument)
|
||||
# S3: amr_selector
|
||||
s3_register("vctrs::vec_ptype2", "character.amr_selector")
|
||||
s3_register("vctrs::vec_ptype2", "amr_selector.character")
|
||||
s3_register("vctrs::vec_cast", "character.amr_selector")
|
||||
# S3: amr_selector_any_all
|
||||
s3_register("vctrs::vec_ptype2", "logical.amr_selector_any_all")
|
||||
s3_register("vctrs::vec_ptype2", "amr_selector_any_all.logical")
|
||||
s3_register("vctrs::vec_cast", "logical.amr_selector_any_all")
|
||||
# S3: ab
|
||||
s3_register("vctrs::vec_ptype2", "ab.default")
|
||||
s3_register("vctrs::vec_ptype2", "ab.ab")
|
||||
s3_register("vctrs::vec_cast", "character.ab")
|
||||
s3_register("vctrs::vec_cast", "ab.character")
|
||||
# S3: av
|
||||
s3_register("vctrs::vec_ptype2", "av.default")
|
||||
s3_register("vctrs::vec_ptype2", "av.av")
|
||||
s3_register("vctrs::vec_cast", "character.av")
|
||||
s3_register("vctrs::vec_cast", "av.character")
|
||||
# S3: mo
|
||||
s3_register("vctrs::vec_ptype2", "mo.default")
|
||||
s3_register("vctrs::vec_ptype2", "mo.mo")
|
||||
s3_register("vctrs::vec_cast", "character.mo")
|
||||
s3_register("vctrs::vec_cast", "mo.character")
|
||||
# S3: disk
|
||||
s3_register("vctrs::vec_ptype_full", "disk")
|
||||
s3_register("vctrs::vec_ptype_abbr", "disk")
|
||||
s3_register("vctrs::vec_ptype2", "disk.default")
|
||||
s3_register("vctrs::vec_ptype2", "disk.disk")
|
||||
s3_register("vctrs::vec_cast", "disk.disk")
|
||||
s3_register("vctrs::vec_cast", "integer.disk")
|
||||
s3_register("vctrs::vec_cast", "disk.integer")
|
||||
s3_register("vctrs::vec_cast", "double.disk")
|
||||
s3_register("vctrs::vec_cast", "disk.double")
|
||||
s3_register("vctrs::vec_cast", "character.disk")
|
||||
s3_register("vctrs::vec_cast", "disk.character")
|
||||
# S3: mic
|
||||
s3_register("vctrs::vec_ptype2", "mic.default")
|
||||
s3_register("vctrs::vec_ptype2", "mic.mic")
|
||||
s3_register("vctrs::vec_cast", "character.mic")
|
||||
s3_register("vctrs::vec_cast", "double.mic")
|
||||
s3_register("vctrs::vec_cast", "integer.mic")
|
||||
s3_register("vctrs::vec_cast", "factor.mic")
|
||||
s3_register("vctrs::vec_cast", "mic.character")
|
||||
s3_register("vctrs::vec_cast", "mic.double")
|
||||
s3_register("vctrs::vec_cast", "mic.integer")
|
||||
s3_register("vctrs::vec_cast", "mic.factor")
|
||||
s3_register("vctrs::vec_cast", "mic.mic")
|
||||
s3_register("vctrs::vec_math", "mic")
|
||||
s3_register("vctrs::vec_arith", "mic")
|
||||
# S3: sir
|
||||
s3_register("vctrs::vec_ptype2", "sir.default")
|
||||
s3_register("vctrs::vec_ptype2", "sir.sir")
|
||||
s3_register("vctrs::vec_ptype2", "character.sir")
|
||||
s3_register("vctrs::vec_cast", "character.sir")
|
||||
s3_register("vctrs::vec_cast", "sir.character")
|
||||
s3_register("vctrs::vec_cast", "sir.sir")
|
||||
|
||||
# if mo source exists, fire it up (see mo_source())
|
||||
if (tryCatch(file.exists(getOption("AMR_mo_source", "~/mo_source.rds")), error = function(e) FALSE)) {
|
||||
try(invisible(get_mo_source()), silent = TRUE)
|
||||
|
Reference in New Issue
Block a user