mirror of
https://github.com/msberends/AMR.git
synced 2025-07-12 21:41:55 +02:00
(v1.4.0.9043) documentation update
This commit is contained in:
@ -250,13 +250,22 @@ word_wrap <- function(...,
|
||||
width = 0.95 * getOption("width"),
|
||||
extra_indent = 0) {
|
||||
msg <- paste0(c(...), collapse = "")
|
||||
# replace new lines to add them again later
|
||||
msg <- gsub("\n", "*|*", msg, fixed = TRUE)
|
||||
|
||||
if (isTRUE(as_note)) {
|
||||
msg <- paste0("NOTE: ", gsub("^note:? ?", "", msg, ignore.case = TRUE))
|
||||
}
|
||||
|
||||
if (msg %like% "\n") {
|
||||
# run word_wraps() over every line here, bind them and return again
|
||||
return(paste0(sapply(trimws(unlist(strsplit(msg, "\n")), which = "right"),
|
||||
word_wrap,
|
||||
add_fn = add_fn,
|
||||
as_note = FALSE,
|
||||
width = width,
|
||||
extra_indent = extra_indent),
|
||||
collapse = "\n"))
|
||||
}
|
||||
|
||||
# we need to correct for already applied style, that adds text like "\033[31m\"
|
||||
msg_stripped <- font_stripstyle(msg)
|
||||
# where are the spaces now?
|
||||
@ -284,7 +293,7 @@ word_wrap <- function(...,
|
||||
indentation <- 0 + extra_indent
|
||||
}
|
||||
msg <- gsub("\n", paste0("\n", strrep(" ", indentation)), msg, fixed = TRUE)
|
||||
msg <- gsub("*|*", paste0("*|*", strrep(" ", indentation)), msg, fixed = TRUE)
|
||||
# msg <- gsub("*|*", paste0("*|*", strrep(" ", indentation)), msg, fixed = TRUE)
|
||||
# remove trailing empty characters
|
||||
msg <- gsub("(\n| )+$", "", msg)
|
||||
|
||||
@ -297,9 +306,6 @@ word_wrap <- function(...,
|
||||
}
|
||||
}
|
||||
|
||||
# place back spaces
|
||||
msg <- gsub("*|*", "\n", msg, fixed = TRUE)
|
||||
|
||||
# format backticks
|
||||
msg <- gsub("(`.+?`)", font_grey_bg("\\1"), msg)
|
||||
|
||||
@ -629,7 +635,7 @@ font_grey <- function(..., collapse = " ") {
|
||||
try_colour(..., before = "\033[38;5;249m", after = "\033[39m", collapse = collapse)
|
||||
}
|
||||
font_grey_bg <- function(..., collapse = " ") {
|
||||
try_colour(..., before = "\033[48;5;255m", after = "\033[49m", collapse = collapse)
|
||||
try_colour(..., before = "\033[48;5;254m", after = "\033[49m", collapse = collapse)
|
||||
}
|
||||
font_green_bg <- function(..., collapse = " ") {
|
||||
try_colour(..., before = "\033[42m", after = "\033[49m", collapse = collapse)
|
||||
@ -875,6 +881,6 @@ str2lang <- function(s) {
|
||||
isNamespaceLoaded <- function(pkg) {
|
||||
pkg %in% loadedNamespaces()
|
||||
}
|
||||
lengths = function(x, use.names = TRUE) {
|
||||
lengths <- function(x, use.names = TRUE) {
|
||||
vapply(x, length, FUN.VALUE = NA_integer_, USE.NAMES = use.names)
|
||||
}
|
||||
|
||||
@ -32,21 +32,21 @@
|
||||
#' @param collapse character to pass on to `paste(..., collapse = ...)` to only return one character per element of `text`, see *Examples*
|
||||
#' @param translate_ab if `type = "drug"`: a column name of the [antibiotics] data set to translate the antibiotic abbreviations to, using [ab_property()]. Defaults to `FALSE`. Using `TRUE` is equal to using "name".
|
||||
#' @param thorough_search logical to indicate whether the input must be extensively searched for misspelling and other faulty input values. Setting this to `TRUE` will take considerably more time than when using `FALSE`. At default, it will turn `TRUE` when all input elements contain a maximum of three words.
|
||||
#' @param ... parameters passed on to [as.ab()]
|
||||
#' @param ... arguments passed on to [as.ab()]
|
||||
#' @details This function is also internally used by [as.ab()], although it then only searches for the first drug name and will throw a note if more drug names could have been returned.
|
||||
#'
|
||||
#' ## Parameter `type`
|
||||
#' ## Argument `type`
|
||||
#' At default, the function will search for antimicrobial drug names. All text elements will be searched for official names, ATC codes and brand names. As it uses [as.ab()] internally, it will correct for misspelling.
|
||||
#'
|
||||
#' With `type = "dose"` (or similar, like "dosing", "doses"), all text elements will be searched for numeric values that are higher than 100 and do not resemble years. The output will be numeric. It supports any unit (g, mg, IE, etc.) and multiple values in one clinical text, see *Examples*.
|
||||
#'
|
||||
#' With `type = "administration"` (or abbreviations, like "admin", "adm"), all text elements will be searched for a form of drug administration. It supports the following forms (including common abbreviations): buccal, implant, inhalation, instillation, intravenous, nasal, oral, parenteral, rectal, sublingual, transdermal and vaginal. Abbreviations for oral (such as 'po', 'per os') will become "oral", all values for intravenous (such as 'iv', 'intraven') will become "iv". It supports multiple values in one clinical text, see *Examples*.
|
||||
#'
|
||||
#' ## Parameter `collapse`
|
||||
#' ## Argument `collapse`
|
||||
#' Without using `collapse`, this function will return a [list]. This can be convenient to use e.g. inside a `mutate()`):\cr
|
||||
#' `df %>% mutate(abx = ab_from_text(clinical_text))`
|
||||
#'
|
||||
#' The returned AB codes can be transformed to official names, groups, etc. with all [`ab_*`][ab_property()] functions such as [ab_name()] and [ab_group()], or by using the `translate_ab` parameter.
|
||||
#' The returned AB codes can be transformed to official names, groups, etc. with all [`ab_*`][ab_property()] functions such as [ab_name()] and [ab_group()], or by using the `translate_ab` argument.
|
||||
#'
|
||||
#' With using `collapse`, this function will return a [character]:\cr
|
||||
#' `df %>% mutate(abx = ab_from_text(clinical_text, collapse = "|"))`
|
||||
|
||||
@ -34,7 +34,7 @@
|
||||
#' @param administration way of administration, either `"oral"` or `"iv"`
|
||||
#' @param units a logical to indicate whether the units instead of the DDDs itself must be returned, see Examples
|
||||
#' @param open browse the URL using [utils::browseURL()]
|
||||
#' @param ... other parameters passed on to [as.ab()]
|
||||
#' @param ... other arguments passed on to [as.ab()]
|
||||
#' @details All output will be [translate]d where possible.
|
||||
#'
|
||||
#' The function [ab_url()] will return the direct URL to the official WHO website. A warning will be returned if the required ATC code is not available.
|
||||
@ -252,7 +252,7 @@ ab_validate <- function(x, property, ...) {
|
||||
|
||||
check_dataset_integrity()
|
||||
|
||||
# try to catch an error when inputting an invalid parameter
|
||||
# try to catch an error when inputting an invalid argument
|
||||
# so the 'call.' can be set to FALSE
|
||||
tryCatch(x[1L] %in% antibiotics[1, property],
|
||||
error = function(e) stop(e$message, call. = FALSE))
|
||||
|
||||
6
R/age.R
6
R/age.R
@ -31,7 +31,7 @@
|
||||
#' @param reference reference date(s) (defaults to today), will be coerced with [as.POSIXlt()]
|
||||
#' @param exact a logical to indicate whether age calculation should be exact, i.e. with decimals. It divides the number of days of [year-to-date](https://en.wikipedia.org/wiki/Year-to-date) (YTD) of `x` by the number of days in the year of `reference` (either 365 or 366).
|
||||
#' @param na.rm a logical to indicate whether missing values should be removed
|
||||
#' @param ... parameters passed on to [as.POSIXlt()], such as `origin`
|
||||
#' @param ... arguments passed on to [as.POSIXlt()], such as `origin`
|
||||
#' @details Ages below 0 will be returned as `NA` with a warning. Ages above 120 will only give a warning.
|
||||
#' @return An [integer] (no decimals) if `exact = FALSE`, a [double] (with decimals) otherwise
|
||||
#' @seealso To split ages into groups, use the [age_groups()] function.
|
||||
@ -98,12 +98,12 @@ age <- function(x, reference = Sys.Date(), exact = FALSE, na.rm = FALSE, ...) {
|
||||
|
||||
#' Split ages into age groups
|
||||
#'
|
||||
#' Split ages into age groups defined by the `split` parameter. This allows for easier demographic (antimicrobial resistance) analysis.
|
||||
#' Split ages into age groups defined by the `split` argument. This allows for easier demographic (antimicrobial resistance) analysis.
|
||||
#' @inheritSection lifecycle Stable lifecycle
|
||||
#' @param x age, e.g. calculated with [age()]
|
||||
#' @param split_at values to split `x` at, defaults to age groups 0-11, 12-24, 25-54, 55-74 and 75+. See Details.
|
||||
#' @param na.rm a [logical] to indicate whether missing values should be removed
|
||||
#' @details To split ages, the input for the `split_at` parameter can be:
|
||||
#' @details To split ages, the input for the `split_at` argument can be:
|
||||
#'
|
||||
#' * A numeric vector. A value of e.g. `c(10, 20)` will split `x` on 0-9, 10-19 and 20+. A value of only `50` will split `x` on 0-49 and 50+.
|
||||
#' The default is to split on young children (0-11), youth (12-24), young adults (25-54), middle-aged adults (55-74) and elderly (75+).
|
||||
|
||||
2
R/amr.R
2
R/amr.R
@ -79,7 +79,7 @@ NULL
|
||||
#' Functions to print classes of the `AMR` package.
|
||||
#' @inheritSection lifecycle Stable lifecycle
|
||||
#' @inheritSection AMR Read more on our website!
|
||||
#' @param ... Parameters passed on to functions
|
||||
#' @param ... Arguments passed on to functions
|
||||
#' @inheritParams base::plot
|
||||
#' @inheritParams graphics::barplot
|
||||
#' @name plot
|
||||
|
||||
@ -32,9 +32,9 @@
|
||||
#' @param administration type of administration when using `property = "Adm.R"`, see Details
|
||||
#' @param url url of website of the WHOCC. The sign `%s` can be used as a placeholder for ATC codes.
|
||||
#' @param url_vet url of website of the WHOCC for veterinary medicine. The sign `%s` can be used as a placeholder for ATC_vet codes (that all start with "Q").
|
||||
#' @param ... parameters to pass on to `atc_property`
|
||||
#' @param ... arguments to pass on to `atc_property`
|
||||
#' @details
|
||||
#' Options for parameter `administration`:
|
||||
#' Options for argument `administration`:
|
||||
#'
|
||||
#' - `"Implant"` = Implant
|
||||
#' - `"Inhal"` = Inhalation
|
||||
|
||||
@ -81,7 +81,7 @@ 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` parameter, or use `eucast_rules(..., rules = "all")`.
|
||||
#' 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")`.
|
||||
#' @section Antibiotics:
|
||||
#' To define antibiotics column names, leave as it is to determine it automatically with [guess_ab_col()] or input a text (case-insensitive), or use `NULL` to skip a column (e.g. `TIC = NULL` to skip ticarcillin). Manually defined but non-existing columns will be skipped with a warning.
|
||||
#'
|
||||
|
||||
@ -37,16 +37,16 @@
|
||||
#' @param col_keyantibiotics column name of the key antibiotics to determine first *weighted* isolates, see [key_antibiotics()]. Defaults to the first column that starts with 'key' followed by 'ab' or 'antibiotics' (case insensitive). Use `col_keyantibiotics = FALSE` to prevent this.
|
||||
#' @param episode_days episode in days after which a genus/species combination will be determined as 'first isolate' again. The default of 365 days is based on the guideline by CLSI, see Source.
|
||||
#' @param testcodes_exclude character vector with test codes that should be excluded (case-insensitive)
|
||||
#' @param icu_exclude logical whether ICU isolates should be excluded (rows with value `TRUE` in column `col_icu`)
|
||||
#' @param specimen_group value in column `col_specimen` to filter on
|
||||
#' @param icu_exclude logical whether ICU isolates should be excluded (rows with value `TRUE` in the column set with `col_icu`)
|
||||
#' @param specimen_group value in the column set with `col_specimen` to filter on
|
||||
#' @param type type to determine weighed isolates; can be `"keyantibiotics"` or `"points"`, see Details
|
||||
#' @param ignore_I logical to determine whether antibiotic interpretations with `"I"` will be ignored when `type = "keyantibiotics"`, see Details
|
||||
#' @param points_threshold points until the comparison of key antibiotics will lead to inclusion of an isolate when `type = "points"`, see Details
|
||||
#' @param info print progress
|
||||
#' @param include_unknown logical to determine whether 'unknown' microorganisms should be included too, i.e. microbial code `"UNKNOWN"`, which defaults to `FALSE`. For WHONET users, this means that all records with organism code `"con"` (*contamination*) will be excluded at default. Isolates with a microbial ID of `NA` will always be excluded as first isolate.
|
||||
#' @param ... parameters passed on to [first_isolate()] when using [filter_first_isolate()], or parameters passed on to [key_antibiotics()] when using [filter_first_weighted_isolate()]
|
||||
#' @param ... arguments passed on to [first_isolate()] when using [filter_first_isolate()], or arguments passed on to [key_antibiotics()] when using [filter_first_weighted_isolate()]
|
||||
#' @details
|
||||
#' These functions are context-aware when used inside `dplyr` verbs, such as `filter()`, `mutate()` and `summarise()`. This means that then the `x` parameter can be omitted, please see *Examples*.
|
||||
#' These functions are context-aware when used inside `dplyr` verbs, such as `filter()`, `mutate()` and `summarise()`. This means that then the `x` argument can be omitted, please see *Examples*.
|
||||
#'
|
||||
#' The [first_isolate()] function is a wrapper around the [is_new_episode()] function, but more efficient for data sets containing microorganism codes or names.
|
||||
#'
|
||||
@ -80,11 +80,11 @@
|
||||
#' @section Key antibiotics:
|
||||
#' There are two ways to determine whether isolates can be included as first *weighted* isolates which will give generally the same results:
|
||||
#'
|
||||
#' 1. Using `type = "keyantibiotics"` and parameter `ignore_I`
|
||||
#' 1. Using `type = "keyantibiotics"` and argument `ignore_I`
|
||||
#'
|
||||
#' Any difference from S to R (or vice versa) will (re)select an isolate as a first weighted isolate. With `ignore_I = FALSE`, also differences from I to S|R (or vice versa) will lead to this. This is a reliable method and 30-35 times faster than method 2. Read more about this in the [key_antibiotics()] function.
|
||||
#'
|
||||
#' 2. Using `type = "points"` and parameter `points_threshold`
|
||||
#' 2. Using `type = "points"` and argument `points_threshold`
|
||||
#'
|
||||
#' A difference from I to S|R (or vice versa) means 0.5 points, a difference from S to R (or vice versa) means 1 point. When the sum of points exceeds `points_threshold`, which default to `2`, an isolate will be (re)selected as a first weighted isolate.
|
||||
#' @rdname first_isolate
|
||||
@ -184,7 +184,7 @@ first_isolate <- function(x,
|
||||
|
||||
dots <- unlist(list(...))
|
||||
if (length(dots) != 0) {
|
||||
# backwards compatibility with old parameters
|
||||
# backwards compatibility with old arguments
|
||||
dots.names <- dots %pm>% names()
|
||||
if ("filter_specimen" %in% dots.names) {
|
||||
specimen_group <- dots[which(dots.names == "filter_specimen")]
|
||||
@ -238,7 +238,7 @@ first_isolate <- function(x,
|
||||
check_columns_existance <- function(column, tblname = x) {
|
||||
if (!is.null(column)) {
|
||||
stop_ifnot(column %in% colnames(tblname),
|
||||
"Column `", column, "` not found.", call = FALSE)
|
||||
"Column '", column, "' not found.", call = FALSE)
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
@ -200,7 +200,7 @@ g.test <- function(x,
|
||||
if (any(E < 5) && is.finite(PARAMETER))
|
||||
warning("G-statistic approximation may be incorrect due to E < 5")
|
||||
|
||||
structure(list(statistic = STATISTIC, parameter = PARAMETER,
|
||||
structure(list(statistic = STATISTIC, argument = PARAMETER,
|
||||
p.value = PVAL, method = METHOD, data.name = DNAME,
|
||||
observed = x, expected = E, residuals = (x - E) / sqrt(E),
|
||||
stdres = (x - E) / sqrt(V)), class = "htest")
|
||||
|
||||
@ -47,13 +47,13 @@
|
||||
#' @param arrows_textangled a logical whether the text at the end of the arrows should be angled
|
||||
#' @param arrows_alpha the alpha (transparency) of the arrows and their text
|
||||
#' @param base_textsize the text size for all plot elements except the labels and arrows
|
||||
#' @param ... Parameters passed on to functions
|
||||
#' @param ... Arguments passed on to functions
|
||||
#' @source The [ggplot_pca()] function is based on the `ggbiplot()` function from the `ggbiplot` package by Vince Vu, as found on GitHub: <https://github.com/vqv/ggbiplot> (retrieved: 2 March 2020, their latest commit: [`7325e88`](https://github.com/vqv/ggbiplot/commit/7325e880485bea4c07465a0304c470608fffb5d9); 12 February 2015).
|
||||
#'
|
||||
#' As per their GPL-2 licence that demands documentation of code changes, the changes made based on the source code were:
|
||||
#' 1. Rewritten code to remove the dependency on packages `plyr`, `scales` and `grid`
|
||||
#' 2. Parametrised more options, like arrow and ellipse settings
|
||||
#' 3. Hardened all input possibilities by defining the exact type of user input for every parameter
|
||||
#' 3. Hardened all input possibilities by defining the exact type of user input for every argument
|
||||
#' 4. Added total amount of explained variance as a caption in the plot
|
||||
#' 5. Cleaned all syntax based on the `lintr` package, fixed grammatical errors and added integrity checks
|
||||
#' 6. Updated documentation
|
||||
|
||||
@ -45,8 +45,8 @@
|
||||
#' @param caption text to show as caption of the plot
|
||||
#' @param x.title text to show as x axis description
|
||||
#' @param y.title text to show as y axis description
|
||||
#' @param ... other parameters passed on to [geom_rsi()]
|
||||
#' @details At default, the names of antibiotics will be shown on the plots using [ab_name()]. This can be set with the `translate_ab` parameter. See [count_df()].
|
||||
#' @param ... other arguments passed on to [geom_rsi()]
|
||||
#' @details At default, the names of antibiotics will be shown on the plots using [ab_name()]. This can be set with the `translate_ab` argument. See [count_df()].
|
||||
#'
|
||||
#' ## The functions
|
||||
#' [geom_rsi()] will take any variable from the data that has an [`rsi`] class (created with [as.rsi()]) using [rsi_df()] and will plot bars with the percentage R, I and S. The default behaviour is to have the bars stacked and to have the different antibiotics on the x axis.
|
||||
@ -91,7 +91,7 @@
|
||||
#' select(AMX, NIT, FOS, TMP, CIP) %>%
|
||||
#' ggplot_rsi(datalabels = FALSE)
|
||||
#'
|
||||
#' # add other ggplot2 parameters as you like:
|
||||
#' # add other ggplot2 arguments as you like:
|
||||
#' example_isolates %>%
|
||||
#' select(AMX, NIT, FOS, TMP, CIP) %>%
|
||||
#' ggplot_rsi(width = 0.5,
|
||||
|
||||
@ -25,7 +25,7 @@
|
||||
|
||||
#' Determine (new) episodes for patients
|
||||
#'
|
||||
#' This function determines which items in a vector can be considered (the start of) a new episode, based on the parameter `episode_days`. This can be used to determine clinical episodes for any epidemiological analysis.
|
||||
#' This function determines which items in a vector can be considered (the start of) a new episode, based on the argument `episode_days`. This can be used to determine clinical episodes for any epidemiological analysis.
|
||||
#' @inheritSection lifecycle Stable lifecycle
|
||||
#' @param x vector of dates (class `Date` or `POSIXt`)
|
||||
#' @param episode_days length of the required episode in days, defaults to 365. Every element in the input will return `TRUE` after this number of days has passed since the last included date, independent of calendar years. Please see *Details*.
|
||||
|
||||
@ -34,9 +34,9 @@
|
||||
#' @param GramPos_1,GramPos_2,GramPos_3,GramPos_4,GramPos_5,GramPos_6 column names of antibiotics for **Gram-positives**, case-insensitive. See details for which antibiotics will be used at default (which are guessed with [guess_ab_col()]).
|
||||
#' @param GramNeg_1,GramNeg_2,GramNeg_3,GramNeg_4,GramNeg_5,GramNeg_6 column names of antibiotics for **Gram-negatives**, case-insensitive. See details for which antibiotics will be used at default (which are guessed with [guess_ab_col()]).
|
||||
#' @param warnings give a warning about missing antibiotic columns (they will be ignored)
|
||||
#' @param ... other parameters passed on to functions
|
||||
#' @param ... other arguments passed on to functions
|
||||
#' @details
|
||||
#' The [key_antibiotics()] function is context-aware when used inside `dplyr` verbs, such as `filter()`, `mutate()` and `summarise()`. This means that then the `x` parameter can be omitted, please see *Examples*.
|
||||
#' The [key_antibiotics()] function is context-aware when used inside `dplyr` verbs, such as `filter()`, `mutate()` and `summarise()`. This means that then the `x` argument can be omitted, please see *Examples*.
|
||||
#'
|
||||
#' The function [key_antibiotics()] returns a character vector with 12 antibiotic results for every isolate. These isolates can then be compared using [key_antibiotics_equal()], to check if two isolates have generally the same antibiogram. Missing and invalid values are replaced with a dot (`"."`) by [key_antibiotics()] and ignored by [key_antibiotics_equal()].
|
||||
#'
|
||||
@ -157,7 +157,7 @@ key_antibiotics <- function(x,
|
||||
|
||||
dots <- unlist(list(...))
|
||||
if (length(dots) != 0) {
|
||||
# backwards compatibility with old parameters
|
||||
# backwards compatibility with old arguments
|
||||
dots.names <- dots %pm>% names()
|
||||
if ("info" %in% dots.names) {
|
||||
warnings <- dots[which(dots.names == "info")]
|
||||
|
||||
@ -44,7 +44,7 @@
|
||||
#' \if{html}{\figure{lifecycle_stable.svg}{options: style=margin-bottom:5px} \cr}
|
||||
#' The [lifecycle][AMR::lifecycle] of this function is **stable**. In a stable function, major changes are unlikely. This means that the unlying code will generally evolve by adding new arguments; removing arguments or changing the meaning of existing arguments will be avoided.
|
||||
#'
|
||||
#' If the unlying code needs breaking changes, they will occur gradually. For example, a parameter will be deprecated and first continue to work, but will emit an message informing you of the change. Next, typically after at least one newly released version on CRAN, the message will be transformed to an error.
|
||||
#' If the unlying code needs breaking changes, they will occur gradually. For example, a argument will be deprecated and first continue to work, but will emit an message informing you of the change. Next, typically after at least one newly released version on CRAN, the message will be transformed to an error.
|
||||
#' @section Retired lifecycle:
|
||||
#' \if{html}{\figure{lifecycle_retired.svg}{options: style=margin-bottom:5px} \cr}
|
||||
#' The [lifecycle][AMR::lifecycle] of this function is **retired**. A retired function is no longer under active development, and (if appropiate) a better alternative is available. No new arguments will be added, and only the most critical bugs will be fixed. In a future version, this function will be removed.
|
||||
|
||||
2
R/mdro.R
2
R/mdro.R
@ -35,7 +35,7 @@
|
||||
#' @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 Antibiotics
|
||||
#' @details
|
||||
#' These functions are context-aware when used inside `dplyr` verbs, such as `filter()`, `mutate()` and `summarise()`. This means that then the `x` parameter can be omitted, please see *Examples*.
|
||||
#' These functions are context-aware when used inside `dplyr` verbs, such as `filter()`, `mutate()` and `summarise()`. This means that then the `x` argument can be omitted, please see *Examples*.
|
||||
#'
|
||||
#' For the `pct_required_classes` argument, values above 1 will be divided by 100. This is to support both fractions (`0.75` or `3/4`) and percentages (`75`).
|
||||
#'
|
||||
|
||||
12
R/mo.R
12
R/mo.R
@ -38,7 +38,7 @@
|
||||
#' @param reference_df a [data.frame] to be used for extra reference when translating `x` to a valid [`mo`]. See [set_mo_source()] and [get_mo_source()] to automate the usage of your own codes (e.g. used in your analysis or organisation).
|
||||
#' @param ignore_pattern a regular expression (case-insensitive) of which all matches in `x` must return `NA`. This can be convenient to exclude known non-relevant input and can also be set with the option `AMR_ignore_pattern`, e.g. `options(AMR_ignore_pattern = "(not reported|contaminated flora)")`.
|
||||
#' @param language language to translate text like "no growth", which defaults to the system language (see [get_locale()])
|
||||
#' @param ... other parameters passed on to functions
|
||||
#' @param ... other arguments passed on to functions
|
||||
#' @rdname as.mo
|
||||
#' @aliases mo
|
||||
#' @keywords mo Becker becker Lancefield lancefield guess
|
||||
@ -200,7 +200,7 @@ as.mo <- function(x,
|
||||
uncertainty_level <- translate_allow_uncertain(allow_uncertain)
|
||||
|
||||
if (!is.null(reference_df)
|
||||
&& mo_source_isvalid(reference_df)
|
||||
&& check_validity_mo_source(reference_df)
|
||||
&& isFALSE(Becker)
|
||||
&& isFALSE(Lancefield)
|
||||
&& all(x %in% unlist(reference_df), na.rm = TRUE)) {
|
||||
@ -388,7 +388,7 @@ exec_as.mo <- function(x,
|
||||
|
||||
# defined df to check for
|
||||
if (!is.null(reference_df)) {
|
||||
mo_source_isvalid(reference_df)
|
||||
check_validity_mo_source(reference_df)
|
||||
reference_df <- repair_reference_df(reference_df)
|
||||
}
|
||||
|
||||
@ -1408,10 +1408,10 @@ exec_as.mo <- function(x,
|
||||
msg <- paste0(msg, ": ", paste('"', unique(failures), '"', sep = "", collapse = ", "))
|
||||
}
|
||||
msg <- paste0(msg,
|
||||
".\nUse mo_failures() to review ", plural[2], ". Edit the `allow_uncertain` parameter if needed (see ?as.mo).\n",
|
||||
".\nUse mo_failures() to review ", plural[2], ". Edit the `allow_uncertain` argument if needed (see ?as.mo).\n",
|
||||
"You can also use your own reference data, e.g.:\n",
|
||||
' as.mo("mycode", reference_df = data.frame(own = "mycode", mo = "B_ESCHR_COLI"))\n',
|
||||
' mo_name("mycode", reference_df = data.frame(own = "mycode", mo = "B_ESCHR_COLI"))\n')
|
||||
' as.mo("mycode", reference_df = data.frame(own = "mycode", mo = "', MO_lookup$mo[match("Escherichia coli", MO_lookup$fullname)], '"))\n',
|
||||
' mo_name("mycode", reference_df = data.frame(own = "mycode", mo = "', MO_lookup$mo[match("Escherichia coli", MO_lookup$fullname)], '"))\n')
|
||||
warning_(paste0("\n", msg),
|
||||
add_fn = font_red,
|
||||
call = FALSE,
|
||||
|
||||
@ -30,7 +30,7 @@
|
||||
#' @param x any character (vector) that can be coerced to a valid microorganism code with [as.mo()]. Can be omitted for auto-guessing in `mo_is_*()` functions when used inside `dplyr` verbs, such as [`filter()`][dplyr::filter()], [`mutate()`][dplyr::mutate()] and [`summarise()`][dplyr::summarise()], please see *Examples*.
|
||||
#' @param property one of the column names of the [microorganisms] data set: `r paste0('"``', colnames(microorganisms), '\``"', collapse = ", ")`, or must be `"shortname"`
|
||||
#' @param language language of the returned text, defaults to system language (see [get_locale()]) and can be overwritten by setting the option `AMR_locale`, e.g. `options(AMR_locale = "de")`, see [translate]. Also used to translate text like "no growth". Use `language = NULL` or `language = ""` to prevent translation.
|
||||
#' @param ... other parameters passed on to [as.mo()], such as 'allow_uncertain' and 'ignore_pattern'
|
||||
#' @param ... other arguments passed on to [as.mo()], such as 'allow_uncertain' and 'ignore_pattern'
|
||||
#' @param ab any (vector of) text that can be coerced to a valid antibiotic code with [as.ab()]
|
||||
#' @param open browse the URL using [utils::browseURL()]
|
||||
#' @details All functions will return the most recently known taxonomic property according to the Catalogue of Life, except for [mo_ref()], [mo_authors()] and [mo_year()]. Please refer to this example, knowing that *Escherichia blattae* was renamed to *Shimwellia blattae* in 2010:
|
||||
@ -44,7 +44,7 @@
|
||||
#'
|
||||
#' The Gram stain - [mo_gramstain()] - will be determined based on the taxonomic kingdom and phylum. According to Cavalier-Smith (2002, [PMID 11837318](https://pubmed.ncbi.nlm.nih.gov/11837318)), who defined subkingdoms Negibacteria and Posibacteria, only these phyla are Posibacteria: Actinobacteria, Chloroflexi, Firmicutes and Tenericutes. These bacteria are considered Gram-positive - all other bacteria are considered Gram-negative. Species outside the kingdom of Bacteria will return a value `NA`. Functions [mo_is_gram_negative()] and [mo_is_gram_positive()] always return `TRUE` or `FALSE` (except when the input is `NA` or the MO code is `UNKNOWN`), thus always return `FALSE` for species outside the taxonomic kingdom of Bacteria.
|
||||
#'
|
||||
#' Intrinsic resistance - [mo_is_intrinsic_resistant()] - will be determined based on the [intrinsic_resistant] data set, which is based on `r format_eucast_version_nr(3.2)`. The [mo_is_intrinsic_resistant()] can be vectorised over parameters `x` (input for microorganisms) and over `ab` (input for antibiotics).
|
||||
#' Intrinsic resistance - [mo_is_intrinsic_resistant()] - will be determined based on the [intrinsic_resistant] data set, which is based on `r format_eucast_version_nr(3.2)`. The [mo_is_intrinsic_resistant()] can be vectorised over arguments `x` (input for microorganisms) and over `ab` (input for antibiotics).
|
||||
#'
|
||||
#' All output will be [translate]d where possible.
|
||||
#'
|
||||
@ -585,7 +585,7 @@ mo_validate <- function(x, property, language, ...) {
|
||||
Lancefield <- FALSE
|
||||
}
|
||||
|
||||
# try to catch an error when inputting an invalid parameter
|
||||
# try to catch an error when inputting an invalid argument
|
||||
# so the 'call.' can be set to FALSE
|
||||
tryCatch(x[1L] %in% MO_lookup[1, property, drop = TRUE],
|
||||
error = function(e) stop(e$message, call. = FALSE))
|
||||
|
||||
@ -36,7 +36,7 @@
|
||||
#' @aliases set_mo_source get_mo_source
|
||||
#' @details The reference file can be a text file separated with commas (CSV) or tabs or pipes, an Excel file (either 'xls' or 'xlsx' format) or an \R object file (extension '.rds'). To use an Excel file, you will need to have the `readxl` package installed.
|
||||
#'
|
||||
#' [set_mo_source()] will check the file for validity: it must be a [data.frame], must have a column named `"mo"` which contains values from [`microorganisms$mo`][microorganisms] and must have a reference column with your own defined values. If all tests pass, [set_mo_source()] will read the file into \R and will ask to export it to `"~/mo_source.rds"`. The CRAN policy disallows packages to write to the file system, although '*exceptions may be allowed in interactive sessions if the package obtains confirmation from the user*'. For this reason, this function only works in interactive sessions so that the user can **specifically confirm and allow** that this file will be created. The destination of this file can be set with the `destination` parameter and defaults to the user's home directory. It can also be set as an \R option, using `options(AMR_mo_source = "my/location/file.rds")`.
|
||||
#' [set_mo_source()] will check the file for validity: it must be a [data.frame], must have a column named `"mo"` which contains values from [`microorganisms$mo`][microorganisms] and must have a reference column with your own defined values. If all tests pass, [set_mo_source()] will read the file into \R and will ask to export it to `"~/mo_source.rds"`. The CRAN policy disallows packages to write to the file system, although '*exceptions may be allowed in interactive sessions if the package obtains confirmation from the user*'. For this reason, this function only works in interactive sessions so that the user can **specifically confirm and allow** that this file will be created. The destination of this file can be set with the `destination` argument and defaults to the user's home directory. It can also be set as an \R option, using `options(AMR_mo_source = "my/location/file.rds")`.
|
||||
#'
|
||||
#' The created compressed data file `"mo_source.rds"` will be used at default for MO determination (function [as.mo()] and consequently all `mo_*` functions like [mo_genus()] and [mo_gramstain()]). The location and timestamp of the original file will be saved as an attribute to the compressed data file.
|
||||
#'
|
||||
@ -125,11 +125,11 @@
|
||||
set_mo_source <- function(path, destination = getOption("AMR_mo_source", "~/mo_source.rds")) {
|
||||
meet_criteria(path, allow_class = "character", has_length = 1, allow_NULL = TRUE)
|
||||
meet_criteria(destination, allow_class = "character", has_length = 1)
|
||||
stop_ifnot(destination %like% "[.]rds$", "the `destination` must be a file location with file extension .rds")
|
||||
stop_ifnot(destination %like% "[.]rds$", "the `destination` must be a file location with file extension .rds.")
|
||||
|
||||
mo_source_destination <- path.expand(destination)
|
||||
|
||||
stop_ifnot(interactive(), "This function can only be used in interactive mode, since it must ask for the user's permission to write a file to their home folder.")
|
||||
stop_ifnot(interactive(), "this function can only be used in interactive mode, since it must ask for the user's permission to write a file to their home folder.")
|
||||
|
||||
if (is.null(path) || path %in% c(FALSE, "")) {
|
||||
mo_env$mo_source <- NULL
|
||||
@ -160,13 +160,13 @@ set_mo_source <- function(path, destination = getOption("AMR_mo_source", "~/mo_s
|
||||
try(
|
||||
df <- utils::read.table(header = TRUE, sep = ",", stringsAsFactors = FALSE),
|
||||
silent = TRUE)
|
||||
if (!mo_source_isvalid(df, stop_on_error = FALSE)) {
|
||||
if (!check_validity_mo_source(df, stop_on_error = FALSE)) {
|
||||
# try tab
|
||||
try(
|
||||
df <- utils::read.table(header = TRUE, sep = "\t", stringsAsFactors = FALSE),
|
||||
silent = TRUE)
|
||||
}
|
||||
if (!mo_source_isvalid(df, stop_on_error = FALSE)) {
|
||||
if (!check_validity_mo_source(df, stop_on_error = FALSE)) {
|
||||
# try pipe
|
||||
try(
|
||||
df <- utils::read.table(header = TRUE, sep = "|", stringsAsFactors = FALSE),
|
||||
@ -175,7 +175,7 @@ set_mo_source <- function(path, destination = getOption("AMR_mo_source", "~/mo_s
|
||||
}
|
||||
|
||||
# check integrity
|
||||
mo_source_isvalid(df)
|
||||
check_validity_mo_source(df)
|
||||
|
||||
df <- subset(df, !is.na(mo))
|
||||
|
||||
@ -211,6 +211,7 @@ set_mo_source <- function(path, destination = getOption("AMR_mo_source", "~/mo_s
|
||||
}
|
||||
}
|
||||
attr(df, "mo_source_location") <- path
|
||||
attr(df, "mo_source_destination") <- mo_source_destination
|
||||
attr(df, "mo_source_timestamp") <- file.mtime(path)
|
||||
saveRDS(df, mo_source_destination)
|
||||
mo_env$mo_source <- df
|
||||
@ -226,7 +227,7 @@ set_mo_source <- function(path, destination = getOption("AMR_mo_source", "~/mo_s
|
||||
get_mo_source <- function(destination = getOption("AMR_mo_source", "~/mo_source.rds")) {
|
||||
if (!file.exists(path.expand(destination))) {
|
||||
if (interactive()) {
|
||||
# source file might have been deleted, update reference
|
||||
# source file might have been deleted, so update reference
|
||||
set_mo_source("")
|
||||
}
|
||||
return(NULL)
|
||||
@ -244,7 +245,7 @@ get_mo_source <- function(destination = getOption("AMR_mo_source", "~/mo_source.
|
||||
mo_env$mo_source
|
||||
}
|
||||
|
||||
mo_source_isvalid <- function(x, refer_to_name = "`reference_df`", stop_on_error = TRUE) {
|
||||
check_validity_mo_source <- function(x, refer_to_name = "`reference_df`", stop_on_error = TRUE) {
|
||||
check_dataset_integrity()
|
||||
|
||||
if (paste(deparse(substitute(x)), collapse = "") == "get_mo_source()") {
|
||||
|
||||
2
R/pca.R
2
R/pca.R
@ -90,7 +90,7 @@ pca <- function(x,
|
||||
# this is to support quoted variables: df %pm>% pca("mycol1", "mycol2")
|
||||
new_list[[i]] <- x[, new_list[[i]]]
|
||||
} else {
|
||||
# remove item - it's a parameter like `center`
|
||||
# remove item - it's a argument like `center`
|
||||
new_list[[i]] <- NULL
|
||||
}
|
||||
}
|
||||
|
||||
@ -36,15 +36,15 @@
|
||||
#' @param data a [data.frame] containing columns with class [`rsi`] (see [as.rsi()])
|
||||
#' @param translate_ab a column name of the [antibiotics] data set to translate the antibiotic abbreviations to, using [ab_property()]
|
||||
#' @inheritParams ab_property
|
||||
#' @param combine_SI a logical to indicate whether all values of S and I must be merged into one, so the output only consists of S+I vs. R (susceptible vs. resistant). This used to be the parameter `combine_IR`, but this now follows the redefinition by EUCAST about the interpretation of I (increased exposure) in 2019, see section 'Interpretation of S, I and R' below. Default is `TRUE`.
|
||||
#' @param combine_IR a logical to indicate whether all values of I and R must be merged into one, so the output only consists of S vs. I+R (susceptible vs. non-susceptible). This is outdated, see parameter `combine_SI`.
|
||||
#' @param combine_SI a logical to indicate whether all values of S and I must be merged into one, so the output only consists of S+I vs. R (susceptible vs. resistant). This used to be the argument `combine_IR`, but this now follows the redefinition by EUCAST about the interpretation of I (increased exposure) in 2019, see section 'Interpretation of S, I and R' below. Default is `TRUE`.
|
||||
#' @param combine_IR a logical to indicate whether all values of I and R must be merged into one, so the output only consists of S vs. I+R (susceptible vs. non-susceptible). This is outdated, see argument `combine_SI`.
|
||||
#' @inheritSection as.rsi Interpretation of R and S/I
|
||||
#' @details
|
||||
#' The function [resistance()] is equal to the function [proportion_R()]. The function [susceptibility()] is equal to the function [proportion_SI()].
|
||||
#'
|
||||
#' **Remember that you should filter your table to let it contain only first isolates!** This is needed to exclude duplicates and to reduce selection bias. Use [first_isolate()] to determine them in your data set.
|
||||
#'
|
||||
#' These functions are not meant to count isolates, but to calculate the proportion of resistance/susceptibility. Use the [`count()`][AMR::count()] functions to count isolates. The function [susceptibility()] is essentially equal to `count_susceptible() / count_all()`. *Low counts can influence the outcome - the `proportion` functions may camouflage this, since they only return the proportion (albeit being dependent on the `minimum` parameter).*
|
||||
#' These functions are not meant to count isolates, but to calculate the proportion of resistance/susceptibility. Use the [`count()`][AMR::count()] functions to count isolates. The function [susceptibility()] is essentially equal to `count_susceptible() / count_all()`. *Low counts can influence the outcome - the `proportion` functions may camouflage this, since they only return the proportion (albeit being dependent on the `minimum` argument).*
|
||||
#'
|
||||
#' The function [proportion_df()] takes any variable from `data` that has an [`rsi`] class (created with [as.rsi()]) and calculates the proportions R, I and S. It also supports grouped variables. The function [rsi_df()] works exactly like [proportion_df()], but adds the number of isolates.
|
||||
#' @section Combination therapy:
|
||||
|
||||
@ -34,7 +34,7 @@
|
||||
#' @param ... extension for future versions, not used at the moment
|
||||
#' @details The base R function [sample()] is used for generating values.
|
||||
#'
|
||||
#' Generated values are based on the latest EUCAST guideline implemented in the [rsi_translation] data set. To create specific generated values per bug or drug, set the `mo` and/or `ab` parameter.
|
||||
#' Generated values are based on the latest EUCAST guideline implemented in the [rsi_translation] data set. To create specific generated values per bug or drug, set the `mo` and/or `ab` argument.
|
||||
#' @return class `<mic>` for [random_mic()] (see [as.mic()]) and class `<disk>` for [random_disk()] (see [as.disk()])
|
||||
#' @name random
|
||||
#' @rdname random
|
||||
@ -89,7 +89,7 @@ random_exec <- function(type, size, mo = NULL, ab = NULL) {
|
||||
if (nrow(df_new) > 0) {
|
||||
df <- df_new
|
||||
} else {
|
||||
warning_("No rows found that match mo '", mo, "', ignoring parameter `mo`", call = FALSE)
|
||||
warning_("No rows found that match mo '", mo, "', ignoring argument `mo`", call = FALSE)
|
||||
}
|
||||
}
|
||||
|
||||
@ -100,7 +100,7 @@ random_exec <- function(type, size, mo = NULL, ab = NULL) {
|
||||
if (nrow(df_new) > 0) {
|
||||
df <- df_new
|
||||
} else {
|
||||
warning_("No rows found that match ab '", ab, "', ignoring parameter `ab`", call = FALSE)
|
||||
warning_("No rows found that match ab '", ab, "', ignoring argument `ab`", call = FALSE)
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
@ -39,11 +39,11 @@
|
||||
#' @param info a logical to indicate whether textual analysis should be printed with the name and [summary()] of the statistical model.
|
||||
#' @param main title of the plot
|
||||
#' @param ribbon a logical to indicate whether a ribbon should be shown (default) or error bars
|
||||
#' @param ... parameters passed on to functions
|
||||
#' @param ... arguments passed on to functions
|
||||
#' @inheritSection as.rsi Interpretation of R and S/I
|
||||
#' @inheritParams first_isolate
|
||||
#' @inheritParams graphics::plot
|
||||
#' @details Valid options for the statistical model (parameter `model`) are:
|
||||
#' @details Valid options for the statistical model (argument `model`) are:
|
||||
#' - `"binomial"` or `"binom"` or `"logit"`: a generalised linear regression model with binomial distribution
|
||||
#' - `"loglin"` or `"poisson"`: a generalised log-linear regression model with poisson distribution
|
||||
#' - `"lin"` or `"linear"`: a linear regression model
|
||||
@ -138,11 +138,11 @@ resistance_predict <- function(x,
|
||||
meet_criteria(preserve_measurements, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(info, allow_class = "logical", has_length = 1)
|
||||
|
||||
stop_if(is.null(model), 'choose a regression model with the `model` parameter, e.g. resistance_predict(..., model = "binomial")')
|
||||
stop_if(is.null(model), 'choose a regression model with the `model` argument, e.g. resistance_predict(..., model = "binomial")')
|
||||
|
||||
dots <- unlist(list(...))
|
||||
if (length(dots) != 0) {
|
||||
# backwards compatibility with old parameters
|
||||
# backwards compatibility with old arguments
|
||||
dots.names <- dots %pm>% names()
|
||||
if ("tbl" %in% dots.names) {
|
||||
x <- dots[which(dots.names == "tbl")]
|
||||
@ -158,7 +158,7 @@ resistance_predict <- function(x,
|
||||
stop_if(is.null(col_date), "`col_date` must be set")
|
||||
}
|
||||
stop_ifnot(col_date %in% colnames(x),
|
||||
"column `", col_date, "` not found")
|
||||
"column '", col_date, "' not found")
|
||||
|
||||
# no grouped tibbles
|
||||
x <- as.data.frame(x, stringsAsFactors = FALSE)
|
||||
|
||||
74
R/rsi.R
74
R/rsi.R
@ -36,9 +36,9 @@
|
||||
#' @param guideline defaults to the latest included EUCAST guideline, see Details for all options
|
||||
#' @param conserve_capped_values a logical to indicate that MIC values starting with `">"` (but not `">="`) must always return "R" , and that MIC values starting with `"<"` (but not `"<="`) must always return "S"
|
||||
#' @param add_intrinsic_resistance *(only useful when using a EUCAST guideline)* a logical to indicate whether intrinsic antibiotic resistance must also be considered for applicable bug-drug combinations, meaning that e.g. ampicillin will always return "R" in *Klebsiella* species. Determination is based on the [intrinsic_resistant] data set, that itself is based on `r format_eucast_version_nr(3.2)`.
|
||||
#' @param reference_data a [data.frame] to be used for interpretation, which defaults to the [rsi_translation] data set. Changing this parameter allows for using own interpretation guidelines. This parameter must contain a data set that is equal in structure to the [rsi_translation] data set (same column names and column types). Please note that the `guideline` parameter will be ignored when `reference_data` is manually set.
|
||||
#' @param reference_data a [data.frame] to be used for interpretation, which defaults to the [rsi_translation] data set. Changing this argument allows for using own interpretation guidelines. This argument must contain a data set that is equal in structure to the [rsi_translation] data set (same column names and column types). Please note that the `guideline` argument will be ignored when `reference_data` is manually set.
|
||||
#' @param threshold maximum fraction of invalid antimicrobial interpretations of `x`, please see *Examples*
|
||||
#' @param ... for using on a [data.frame]: names of columns to apply [as.rsi()] on (supports tidy selection like `AMX:VAN`). Otherwise: parameters passed on to methods.
|
||||
#' @param ... for using on a [data.frame]: names of columns to apply [as.rsi()] on (supports tidy selection like `AMX:VAN`). Otherwise: arguments passed on to methods.
|
||||
#' @details
|
||||
#' ## How it works
|
||||
#'
|
||||
@ -46,7 +46,7 @@
|
||||
#'
|
||||
#' 1. For **cleaning raw / untransformed data**. The data will be cleaned to only contain values S, I and R and will try its best to determine this with some intelligence. For example, mixed values with R/SI interpretations and MIC values such as `"<0.25; S"` will be coerced to `"S"`. Combined interpretations for multiple test methods (as seen in laboratory records) such as `"S; S"` will be coerced to `"S"`, but a value like `"S; I"` will return `NA` with a warning that the input is unclear.
|
||||
#'
|
||||
#' 2. For **interpreting minimum inhibitory concentration (MIC) values** according to EUCAST or CLSI. You must clean your MIC values first using [as.mic()], that also gives your columns the new data class [`mic`]. Also, be sure to have a column with microorganism names or codes. It will be found automatically, but can be set manually using the `mo` parameter.
|
||||
#' 2. For **interpreting minimum inhibitory concentration (MIC) values** according to EUCAST or CLSI. You must clean your MIC values first using [as.mic()], that also gives your columns the new data class [`mic`]. Also, be sure to have a column with microorganism names or codes. It will be found automatically, but can be set manually using the `mo` argument.
|
||||
#' * Using `dplyr`, R/SI interpretation can be done very easily with either:
|
||||
#' ```
|
||||
#' your_data %>% mutate_if(is.mic, as.rsi) # until dplyr 1.0.0
|
||||
@ -54,7 +54,7 @@
|
||||
#' ```
|
||||
#' * Operators like "<=" will be stripped before interpretation. When using `conserve_capped_values = TRUE`, an MIC value of e.g. ">2" will always return "R", even if the breakpoint according to the chosen guideline is ">=4". This is to prevent that capped values from raw laboratory data would not be treated conservatively. The default behaviour (`conserve_capped_values = FALSE`) considers ">2" to be lower than ">=4" and might in this case return "S" or "I".
|
||||
#'
|
||||
#' 3. For **interpreting disk diffusion diameters** according to EUCAST or CLSI. You must clean your disk zones first using [as.disk()], that also gives your columns the new data class [`disk`]. Also, be sure to have a column with microorganism names or codes. It will be found automatically, but can be set manually using the `mo` parameter.
|
||||
#' 3. For **interpreting disk diffusion diameters** according to EUCAST or CLSI. You must clean your disk zones first using [as.disk()], that also gives your columns the new data class [`disk`]. Also, be sure to have a column with microorganism names or codes. It will be found automatically, but can be set manually using the `mo` argument.
|
||||
#' * Using `dplyr`, R/SI interpretation can be done very easily with either:
|
||||
#' ```
|
||||
#' your_data %>% mutate_if(is.disk, as.rsi) # until dplyr 1.0.0
|
||||
@ -65,9 +65,9 @@
|
||||
#'
|
||||
#' ## Supported guidelines
|
||||
#'
|
||||
#' For interpreting MIC values as well as disk diffusion diameters, supported guidelines to be used as input for the `guideline` parameter are: `r paste0('"', sort(unique(AMR::rsi_translation$guideline)), '"', collapse = ", ")`.
|
||||
#' For interpreting MIC values as well as disk diffusion diameters, supported guidelines to be used as input for the `guideline` argument are: `r paste0('"', sort(unique(AMR::rsi_translation$guideline)), '"', collapse = ", ")`.
|
||||
#'
|
||||
#' Simply using `"CLSI"` or `"EUCAST"` as input will automatically select the latest version of that guideline. You can set your own data set using the `reference_data` parameter. The `guideline` parameter will then be ignored.
|
||||
#' Simply using `"CLSI"` or `"EUCAST"` as input will automatically select the latest version of that guideline. You can set your own data set using the `reference_data` argument. The `guideline` argument will then be ignored.
|
||||
#'
|
||||
#' ## After interpretation
|
||||
#'
|
||||
@ -79,7 +79,7 @@
|
||||
#'
|
||||
#' ## Other
|
||||
#'
|
||||
#' The function [is.rsi.eligible()] returns `TRUE` when a columns contains at most 5% invalid antimicrobial interpretations (not S and/or I and/or R), and `FALSE` otherwise. The threshold of 5% can be set with the `threshold` parameter.
|
||||
#' The function [is.rsi.eligible()] returns `TRUE` when a columns contains at most 5% invalid antimicrobial interpretations (not S and/or I and/or R), and `FALSE` otherwise. The threshold of 5% can be set with the `threshold` argument.
|
||||
#' @section Interpretation of R and S/I:
|
||||
#' In 2019, the European Committee on Antimicrobial Susceptibility Testing (EUCAST) has decided to change the definitions of susceptibility testing categories R and S/I as shown below (<https://www.eucast.org/newsiandr/>).
|
||||
#'
|
||||
@ -113,7 +113,8 @@
|
||||
#' CIP = as.mic(0.256),
|
||||
#' GEN = as.disk(18),
|
||||
#' TOB = as.disk(16),
|
||||
#' NIT = as.mic(32))
|
||||
#' NIT = as.mic(32),
|
||||
#' ERY = "R")
|
||||
#' as.rsi(df)
|
||||
#'
|
||||
#' # for single values
|
||||
@ -323,25 +324,25 @@ as.rsi.mic <- function(x,
|
||||
mo <- suppressMessages(search_type_in_df(df, "mo"))
|
||||
}, silent = TRUE)
|
||||
if (!is.null(df) && !is.null(mo) && is.data.frame(df)) {
|
||||
mo_var_found <- paste0(" based on column `", font_bold(mo), "`")
|
||||
mo_var_found <- paste0(" based on column '", font_bold(mo), "'")
|
||||
mo <- df[, mo, drop = TRUE]
|
||||
}
|
||||
}, error = function(e)
|
||||
stop_('No information was supplied about the microorganisms (missing parameter "mo"). See ?as.rsi.\n\n',
|
||||
stop_('No information was supplied about the microorganisms (missing argument `mo`). See ?as.rsi.\n\n',
|
||||
"To transform certain columns with e.g. mutate_at(), use `data %>% mutate_at(vars(...), as.rsi, mo = .$x)`, where x is your column with microorganisms.\n",
|
||||
"To tranform all disk diffusion zones in a data set, use `data %>% as.rsi()` or data %>% mutate_if(is.disk, as.rsi).", call = FALSE)
|
||||
)
|
||||
}
|
||||
if (length(ab) == 1 && ab %like% "as.mic") {
|
||||
stop_('No unambiguous name was supplied about the antibiotic (parameter "ab"). See ?as.rsi.', call = FALSE)
|
||||
stop_('No unambiguous name was supplied about the antibiotic (argument `ab`). See ?as.rsi.', call = FALSE)
|
||||
}
|
||||
|
||||
ab_coerced <- suppressWarnings(as.ab(ab))
|
||||
mo_coerced <- suppressWarnings(as.mo(mo))
|
||||
guideline_coerced <- get_guideline(guideline, reference_data)
|
||||
if (is.na(ab_coerced)) {
|
||||
message_("Returning NAs for unknown drug: `", font_bold(ab),
|
||||
"`. Rename this column to a drug name or code, and check the output with as.ab().",
|
||||
message_("Returning NAs for unknown drug: '", font_bold(ab),
|
||||
"'. Rename this column to a drug name or code, and check the output with `as.ab()`.",
|
||||
add_fn = font_red,
|
||||
as_note = FALSE)
|
||||
return(as.rsi(rep(NA, length(x))))
|
||||
@ -353,7 +354,7 @@ as.rsi.mic <- function(x,
|
||||
uti <- rep(uti, length(x))
|
||||
}
|
||||
|
||||
message_("=> Interpreting MIC values of '", font_bold(ab), "' (",
|
||||
message_("=> Interpreting MIC values of ", ifelse(isTRUE(list(...)$is_data.frame), "column ", ""), "'", font_bold(ab), "' (",
|
||||
ifelse(ab_coerced != ab, paste0(ab_coerced, ", "), ""),
|
||||
ab_name(ab_coerced, tolower = TRUE), ")", mo_var_found,
|
||||
" according to ", ifelse(identical(reference_data, AMR::rsi_translation),
|
||||
@ -412,25 +413,25 @@ as.rsi.disk <- function(x,
|
||||
mo <- suppressMessages(search_type_in_df(df, "mo"))
|
||||
}, silent = TRUE)
|
||||
if (!is.null(df) && !is.null(mo) && is.data.frame(df)) {
|
||||
mo_var_found <- paste0(" based on column `", font_bold(mo), "`")
|
||||
mo_var_found <- paste0(" based on column '", font_bold(mo), "'")
|
||||
mo <- df[, mo, drop = TRUE]
|
||||
}
|
||||
}, error = function(e)
|
||||
stop_('No information was supplied about the microorganisms (missing parameter "mo"). See ?as.rsi.\n\n',
|
||||
stop_('No information was supplied about the microorganisms (missing argument `mo`). See ?as.rsi.\n\n',
|
||||
"To transform certain columns with e.g. mutate_at(), use `data %>% mutate_at(vars(...), as.rsi, mo = .$x)`, where x is your column with microorganisms.\n",
|
||||
"To tranform all disk diffusion zones in a data set, use `data %>% as.rsi()` or data %>% mutate_if(is.disk, as.rsi).", call = FALSE)
|
||||
)
|
||||
}
|
||||
if (length(ab) == 1 && ab %like% "as.disk") {
|
||||
stop_('No unambiguous name was supplied about the antibiotic (parameter "ab"). See ?as.rsi.', call = FALSE)
|
||||
stop_('No unambiguous name was supplied about the antibiotic (argument `ab`). See ?as.rsi.', call = FALSE)
|
||||
}
|
||||
|
||||
ab_coerced <- suppressWarnings(as.ab(ab))
|
||||
mo_coerced <- suppressWarnings(as.mo(mo))
|
||||
guideline_coerced <- get_guideline(guideline, reference_data)
|
||||
if (is.na(ab_coerced)) {
|
||||
message_("Returning NAs for unknown drug: `", font_bold(ab),
|
||||
"`. Rename this column to a drug name or code, and check the output with as.ab().",
|
||||
message_("Returning NAs for unknown drug: '", font_bold(ab),
|
||||
"'. Rename this column to a drug name or code, and check the output with `as.ab()`.",
|
||||
add_fn = font_red,
|
||||
as_note = FALSE)
|
||||
return(as.rsi(rep(NA, length(x))))
|
||||
@ -442,7 +443,7 @@ as.rsi.disk <- function(x,
|
||||
uti <- rep(uti, length(x))
|
||||
}
|
||||
|
||||
message_("=> Interpreting disk zones of '", font_bold(ab), "' (",
|
||||
message_("=> Interpreting disk zones of ", ifelse(isTRUE(list(...)$is_data.frame), "column ", ""), "'", font_bold(ab), "' (",
|
||||
ifelse(ab_coerced != ab, paste0(ab_coerced, ", "), ""),
|
||||
ab_name(ab_coerced, tolower = TRUE), ")", mo_var_found,
|
||||
" according to ", ifelse(identical(reference_data, AMR::rsi_translation),
|
||||
@ -482,6 +483,7 @@ as.rsi.data.frame <- function(x,
|
||||
meet_criteria(add_intrinsic_resistance, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(reference_data, allow_class = "data.frame")
|
||||
|
||||
x.bak <- x
|
||||
for (i in seq_len(ncol(x))) {
|
||||
# don't keep factors
|
||||
if (is.factor(x[, i, drop = TRUE])) {
|
||||
@ -527,8 +529,8 @@ as.rsi.data.frame <- function(x,
|
||||
}
|
||||
message_("Assuming value", plural[1], " ",
|
||||
paste(paste0('"', values, '"'), collapse = ", "),
|
||||
" in column `", font_bold(col_specimen),
|
||||
"` reflect", plural[2], " ", plural[3], "urinary tract infection", plural[1],
|
||||
" in column '", font_bold(col_specimen),
|
||||
"' reflect", plural[2], " ", plural[3], "urinary tract infection", plural[1],
|
||||
".\n Use `as.rsi(uti = FALSE)` to prevent this.")
|
||||
} else {
|
||||
# no data about UTI's found
|
||||
@ -569,11 +571,11 @@ as.rsi.data.frame <- function(x,
|
||||
"no columns with MIC values, disk zones or antibiotic column names found in this data set. Use as.mic() or as.disk() to transform antimicrobial columns.")
|
||||
# set type per column
|
||||
types <- character(length(ab_cols))
|
||||
types[sapply(x[, ab_cols, drop = FALSE], is.disk)] <- "disk"
|
||||
types[sapply(x.bak[, ab_cols, drop = FALSE], is.disk)] <- "disk"
|
||||
types[sapply(x.bak[, ab_cols, drop = FALSE], is.mic)] <- "mic"
|
||||
types[types == "" & sapply(x[, ab_cols, drop = FALSE], all_valid_disks)] <- "disk"
|
||||
types[sapply(x[, ab_cols, drop = FALSE], is.mic)] <- "mic"
|
||||
types[types == "" & sapply(x[, ab_cols, drop = FALSE], all_valid_mics)] <- "mic"
|
||||
types[types == "" & !sapply(x[, ab_cols, drop = FALSE], is.rsi)] <- "rsi"
|
||||
types[types == "" & !sapply(x.bak[, ab_cols, drop = FALSE], is.rsi)] <- "rsi"
|
||||
if (any(types %in% c("mic", "disk"), na.rm = TRUE)) {
|
||||
# now we need an mo column
|
||||
stop_if(is.null(col_mo), "`col_mo` must be set")
|
||||
@ -597,7 +599,8 @@ as.rsi.data.frame <- function(x,
|
||||
uti = uti,
|
||||
conserve_capped_values = conserve_capped_values,
|
||||
add_intrinsic_resistance = add_intrinsic_resistance,
|
||||
reference_data = reference_data)
|
||||
reference_data = reference_data,
|
||||
is_data.frame = TRUE)
|
||||
} else if (types[i] == "disk") {
|
||||
x[, ab_cols[i]] <- as.rsi(x = x %pm>%
|
||||
pm_pull(ab_cols[i]) %pm>%
|
||||
@ -608,20 +611,31 @@ as.rsi.data.frame <- function(x,
|
||||
guideline = guideline,
|
||||
uti = uti,
|
||||
add_intrinsic_resistance = add_intrinsic_resistance,
|
||||
reference_data = reference_data)
|
||||
reference_data = reference_data,
|
||||
is_data.frame = TRUE)
|
||||
} else if (types[i] == "rsi") {
|
||||
show_message <- FALSE
|
||||
ab <- ab_cols[i]
|
||||
ab_coerced <- suppressWarnings(as.ab(ab))
|
||||
if (!all(x[, ab_cols[i], drop = TRUE] %in% c("R", "S", "I"), na.rm = TRUE)) {
|
||||
show_message <- TRUE
|
||||
# only print message if values are not already clean
|
||||
message_("=> Cleaning values in column `", font_bold(ab), "` (",
|
||||
message_("=> Cleaning values in column '", font_bold(ab), "' (",
|
||||
ifelse(ab_coerced != ab, paste0(ab_coerced, ", "), ""),
|
||||
ab_name(ab_coerced, tolower = TRUE), ")... ",
|
||||
appendLF = FALSE,
|
||||
as_note = FALSE)
|
||||
} else if (!is.rsi(x.bak[, ab_cols[i], drop = TRUE])) {
|
||||
show_message <- TRUE
|
||||
# only print message if class not already set
|
||||
message_("=> Assigning class <rsi> to already clean column '", font_bold(ab), "' (",
|
||||
ifelse(ab_coerced != ab, paste0(ab_coerced, ", "), ""),
|
||||
ab_name(ab_coerced, tolower = TRUE), ")... ",
|
||||
appendLF = FALSE,
|
||||
as_note = FALSE)
|
||||
}
|
||||
x[, ab_cols[i]] <- as.rsi.default(x = as.character(x[, ab_cols[i], drop = TRUE]))
|
||||
if (!all(x[, ab_cols[i], drop = TRUE] %in% c("R", "S", "I"), na.rm = TRUE)) {
|
||||
if (show_message == TRUE) {
|
||||
message_(" OK.", add_fn = list(font_green, font_bold), as_note = FALSE)
|
||||
}
|
||||
}
|
||||
@ -719,7 +733,7 @@ exec_as.rsi <- function(method,
|
||||
|
||||
if (all(trans$uti == TRUE, na.rm = TRUE) & all(uti == FALSE)) {
|
||||
message_("WARNING.", add_fn = list(font_yellow, font_bold), as_note = FALSE)
|
||||
warning_("Interpretation of ", font_bold(ab_name(ab, tolower = TRUE)), " for some microorganisms is only available for (uncomplicated) urinary tract infections (UTI). Use parameter 'uti' to set which isolates are from urine. See ?as.rsi.", call = FALSE)
|
||||
warning_("Introducing NA: interpretation of ", font_bold(ab_name(ab, tolower = TRUE)), " for some microorganisms is only available for (uncomplicated) urinary tract infections (UTI). Use argument `uti` to set which isolates are from urine. See ?as.rsi.", call = FALSE)
|
||||
warned <- TRUE
|
||||
}
|
||||
|
||||
|
||||
@ -70,7 +70,7 @@ rsi_calc <- function(...,
|
||||
}
|
||||
if (length(dots) == 0 | all(dots == "df")) {
|
||||
# for complete data.frames, like example_isolates %pm>% select(AMC, GEN) %pm>% proportion_S()
|
||||
# and the old rsi function, which has "df" as name of the first parameter
|
||||
# and the old rsi function, which has "df" as name of the first argument
|
||||
x <- dots_df
|
||||
} else {
|
||||
# get dots that are in column names already, and the ones that will be once evaluated using dots_df or global env
|
||||
|
||||
@ -45,7 +45,7 @@
|
||||
#' @name translate
|
||||
#' @export
|
||||
#' @examples
|
||||
#' # The 'language' parameter of below functions
|
||||
#' # The 'language' argument of below functions
|
||||
#' # will be set automatically to your system language
|
||||
#' # with get_locale()
|
||||
#'
|
||||
|
||||
Reference in New Issue
Block a user