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

new, automated website

Browse Source
This commit is contained in:
dr. M.S. (Matthijs) Berends
2022-08-21 16:37:20 +02:00
parent 7226b70c3d
commit 952d16de33
315 changed files with 839 additions and 34495 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
R/ab.R
View File

@ -26,7 +26,6 @@
#' Transform Input to an Antibiotic ID
#'
#' Use this function to determine the antibiotic code of one or more antibiotics. The data set [antibiotics] will be searched for abbreviations, official names and synonyms (brand names).
#' @inheritSection lifecycle Stable Lifecycle
#' @param x a [character] vector to determine to antibiotic ID
#' @param flag_multiple_results a [logical] to indicate whether a note should be printed to the console that probably more than one antibiotic code or name can be retrieved from a single input value.
#' @param info a [logical] to indicate whether a progress bar should be printed, defaults to `TRUE` only in interactive mode
@ -55,7 +54,6 @@
#' * [antibiotics] for the [data.frame] that is being used to determine ATCs
#' * [ab_from_text()] for a function to retrieve antimicrobial drugs from clinical text (from health care records)
#' @inheritSection AMR Reference Data Publicly Available
#' @inheritSection AMR Read more on Our Website!
#' @export
#' @examples
#' # these examples all return "ERY", the ID of erythromycin:

2
R/ab_from_text.R
View File

@ -26,7 +26,6 @@
#' Retrieve Antimicrobial Drug Names and Doses from Clinical Text
#'
#' Use this function on e.g. clinical texts from health care records. It returns a [list] with all antimicrobial drugs, doses and forms of administration found in the texts.
#' @inheritSection lifecycle Stable Lifecycle
#' @param text text to analyse
#' @param type type of property to search for, either `"drug"`, `"dose"` or `"administration"`, see *Examples*
#' @param collapse a [character] to pass on to `paste(, collapse = ...)` to only return one [character] per element of `text`, see *Examples*
@ -53,7 +52,6 @@
#' `df %>% mutate(abx = ab_from_text(clinical_text, collapse = "|"))`
#' @export
#' @return A [list], or a [character] if `collapse` is not `NULL`
#' @inheritSection AMR Read more on Our Website!
#' @examples
#' # mind the bad spelling of amoxicillin in this line,
#' # straight from a true health care record:

11
R/ab_property.R
View File

@ -26,7 +26,6 @@
#' Get Properties of an Antibiotic
#'
#' Use these functions to return a specific property of an antibiotic from the [antibiotics] data set. All input values will be evaluated internally with [as.ab()].
#' @inheritSection lifecycle Stable Lifecycle
#' @param x any (vector of) text that can be coerced to a valid antibiotic code with [as.ab()]
#' @param tolower a [logical] to indicate whether the first [character] of every output should be transformed to a lower case [character]. This will lead to e.g. "polymyxin B" and not "polymyxin b".
#' @param property one of the column names of one of the [antibiotics] data set: `vector_or(colnames(antibiotics), sort = FALSE)`.
@ -54,7 +53,6 @@
#' @export
#' @seealso [antibiotics]
#' @inheritSection AMR Reference Data Publicly Available
#' @inheritSection AMR Read more on Our Website!
#' @examples
#' # all properties:
#' ab_name("AMX") # "Amoxicillin"
@ -101,15 +99,18 @@
#' \donttest{
#' if (require("dplyr")) {
#' example_isolates %>%
#' set_ab_names()
#' set_ab_names() %>%
#' head()
#'
#' # this does the same:
#' example_isolates %>%
#' rename_with(set_ab_names)
#' rename_with(set_ab_names)%>%
#' head()
#'
#' # set_ab_names() works with any AB property:
#' example_isolates %>%
#' set_ab_names(property = "atc")
#' set_ab_names(property = "atc")%>%
#' head()
#'
#' example_isolates %>%
#' set_ab_names(where(is.rsi)) %>%

65
R/ab_selectors.R
View File

@ -26,7 +26,6 @@
#' Antibiotic Selectors
#'
#' These functions allow for filtering rows and selecting columns based on antibiotic test results that are of a specific antibiotic class or group, without the need to define the columns or antibiotic abbreviations. In short, if you have a column name that resembles an antimicrobial agent, it will be picked up by any of these functions that matches its pharmaceutical class: "cefazolin", "CZO" and "J01DB04" will all be picked up by [cephalosporins()].
#' @inheritSection lifecycle Stable Lifecycle
#' @param ab_class an antimicrobial class or a part of it, such as `"carba"` and `"carbapenems"`. The columns `group`, `atc_group1` and `atc_group2` of the [antibiotics] data set will be searched (case-insensitive) for this value.
#' @param filter an [expression] to be evaluated in the [antibiotics] data set, such as `name %like% "trim"`
#' @param only_rsi_columns a [logical] to indicate whether only columns of class `<rsi>` must be selected (defaults to `FALSE`), see [as.rsi()]
@ -46,103 +45,105 @@
#' @return (internally) a [character] vector of column names, with additional class `"ab_selector"`
#' @export
#' @inheritSection AMR Reference Data Publicly Available
#' @inheritSection AMR Read more on Our Website!
#' @examples
#' # `example_isolates` is a data set available in the AMR package.
#' # See ?example_isolates.
#' df <- example_isolates[ , c("hospital_id", "mo",
#' "AMP", "AMC", "TZP", "CXM", "CRO", "GEN",
#' "TOB", "COL", "IPM", "MEM", "TEC", "VAN")]
#'
#' # base R ------------------------------------------------------------------
#'
#' # select columns 'IPM' (imipenem) and 'MEM' (meropenem)
#' example_isolates[, carbapenems()]
#' df[, carbapenems()]
#'
#' # select columns 'mo', 'AMK', 'GEN', 'KAN' and 'TOB'
#' example_isolates[, c("mo", aminoglycosides())]
#' df[, c("mo", aminoglycosides())]
#'
#' # select only antibiotic columns with DDDs for oral treatment
#' example_isolates[, administrable_per_os()]
#' df[, administrable_per_os()]
#'
#' # filter using any() or all()
#' example_isolates[any(carbapenems() == "R"), ]
#' subset(example_isolates, any(carbapenems() == "R"))
#' df[any(carbapenems() == "R"), ]
#' subset(df, any(carbapenems() == "R"))
#'
#' # filter on any or all results in the carbapenem columns (i.e., IPM, MEM):
#' example_isolates[any(carbapenems()), ]
#' example_isolates[all(carbapenems()), ]
#' df[any(carbapenems()), ]
#' df[all(carbapenems()), ]
#'
#' # filter with multiple antibiotic selectors using c()
#' example_isolates[all(c(carbapenems(), aminoglycosides()) == "R"), ]
#' df[all(c(carbapenems(), aminoglycosides()) == "R"), ]
#'
#' # filter + select in one go: get penicillins in carbapenems-resistant strains
#' example_isolates[any(carbapenems() == "R"), penicillins()]
#' df[any(carbapenems() == "R"), penicillins()]
#'
#' # You can combine selectors with '&' to be more specific. For example,
#' # penicillins() would select benzylpenicillin ('peni G') and
#' # administrable_per_os() would select erythromycin. Yet, when combined these
#' # drugs are both omitted since benzylpenicillin is not administrable per os
#' # and erythromycin is not a penicillin:
#' example_isolates[, penicillins() & administrable_per_os()]
#' df[, penicillins() & administrable_per_os()]
#'
#' # ab_selector() applies a filter in the `antibiotics` data set and is thus very
#' # flexible. For instance, to select antibiotic columns with an oral DDD of at
#' # least 1 gram:
#' example_isolates[, ab_selector(oral_ddd > 1 & oral_units == "g")]
#' df[, ab_selector(oral_ddd > 1 & oral_units == "g")]
#'
#' # dplyr -------------------------------------------------------------------
#' \donttest{
#' if (require("dplyr")) {
#'
#' # get AMR for all aminoglycosides e.g., per hospital:
#' example_isolates %>%
#' df %>%
#' group_by(hospital_id) %>%
#' summarise(across(aminoglycosides(), resistance))
#'
#' # You can combine selectors with '&' to be more specific:
#' example_isolates %>%
#' df %>%
#' select(penicillins() & administrable_per_os())
#'
#' # get AMR for only drugs that matter - no intrinsic resistance:
#' example_isolates %>%
#' df %>%
#' filter(mo_genus() %in% c("Escherichia", "Klebsiella")) %>%
#' group_by(hospital_id) %>%
#' summarise(across(not_intrinsic_resistant(), resistance))
#'
#' # get susceptibility for antibiotics whose name contains "trim":
#' example_isolates %>%
#' df %>%
#' filter(first_isolate()) %>%
#' group_by(hospital_id) %>%
#' summarise(across(ab_selector(name %like% "trim"), susceptibility))
#'
#' # this will select columns 'IPM' (imipenem) and 'MEM' (meropenem):
#' example_isolates %>%
#' df %>%
#' select(carbapenems())
#'
#' # this will select columns 'mo', 'AMK', 'GEN', 'KAN' and 'TOB':
#' example_isolates %>%
#' df %>%
#' select(mo, aminoglycosides())
#'
#' # any() and all() work in dplyr's filter() too:
#' example_isolates %>%
#' df %>%
#' filter(any(aminoglycosides() == "R"),
#' all(cephalosporins_2nd() == "R"))
#'
#' # also works with c():
#' example_isolates %>%
#' df %>%
#' filter(any(c(carbapenems(), aminoglycosides()) == "R"))
#'
#' # not setting any/all will automatically apply all():
#' example_isolates %>%
#' df %>%
#' filter(aminoglycosides() == "R")
#' #> i Assuming a filter on all 4 aminoglycosides.
#'
#' # this will select columns 'mo' and all antimycobacterial drugs ('RIF'):
#' example_isolates %>%
#' df %>%
#' select(mo, ab_class("mycobact"))
#'
#' # get bug/drug combinations for only macrolides in Gram-positives:
#' example_isolates %>%
#' # get bug/drug combinations for only glycopeptides in Gram-positives:
#' df %>%
#' filter(mo_is_gram_positive()) %>%
#' select(mo, macrolides()) %>%
#' select(mo, glycopeptides()) %>%
#' bug_drug_combinations() %>%
#' format()
#'
@ -151,10 +152,12 @@
#' select(penicillins()) # only the 'J01CA01' column will be selected
#'
#'
#' # with dplyr 1.0.0 and higher (that adds 'across()'), this is all equal:
#' example_isolates[carbapenems() == "R", ]
#' example_isolates %>% filter(carbapenems() == "R")
#' example_isolates %>% filter(across(carbapenems(), ~.x == "R"))
#' # with recent versions of dplyr this is all equal:
#' x <- df[carbapenems() == "R", ]
#' y <- df %>% filter(carbapenems() == "R")
#' z <- df %>% filter(if_all(carbapenems(), ~.x == "R"))
#' identical(x, y)
#' identical(y, z)
#' }
#' }
ab_class <- function(ab_class,

23
R/age.R
View File

@ -25,8 +25,7 @@
#' Age in Years of Individuals
#'
#' Calculates age in years based on a reference date, which is the sytem date at default.
#' @inheritSection lifecycle Stable Lifecycle
#' Calculates age in years based on a reference date, which is the system date at default.
#' @param x date(s), [character] (vectors) will be coerced with [as.POSIXlt()]
#' @param reference reference date(s) (defaults to today), [character] (vectors) 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).
@ -37,15 +36,19 @@
#' This function vectorises over both `x` and `reference`, meaning that either can have a length of 1 while the other argument has a larger length.
#' @return An [integer] (no decimals) if `exact = FALSE`, a [double] (with decimals) otherwise
#' @seealso To split ages into groups, use the [age_groups()] function.
#' @inheritSection AMR Read more on Our Website!
#' @export
#' @examples
#' # 10 random birth dates
#' df <- data.frame(birth_date = Sys.Date() - runif(10) * 25000)
#' # 10 random pre-Y2K birth dates
#' df <- data.frame(birth_date = as.Date("2000-01-01") - runif(10) * 25000)
#'
#' # add ages
#' df$age <- age(df$birth_date)
#'
#' # add exact ages
#' df$age_exact <- age(df$birth_date, exact = TRUE)
#'
#' # add age at millenium switch
#' df$age_at_y2k <- age(df$birth_date, "2000-01-01")
#'
#' df
age <- function(x, reference = Sys.Date(), exact = FALSE, na.rm = FALSE, ...) {
@ -115,7 +118,6 @@ 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` 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
@ -131,7 +133,7 @@ age <- function(x, reference = Sys.Date(), exact = FALSE, na.rm = FALSE, ...) {
#' @return Ordered [factor]
#' @seealso To determine ages, based on one or more reference dates, use the [age()] function.
#' @export
#' @inheritSection AMR Read more on Our Website!
#' @examples
#' ages <- c(3, 8, 16, 54, 31, 76, 101, 43, 21)
#'
@ -150,7 +152,7 @@ age <- function(x, reference = Sys.Date(), exact = FALSE, na.rm = FALSE, ...) {
#' age_groups(ages, split_at = "fives")
#'
#' # split specifically for children
#' age_groups(ages, c(1, 2, 4, 6, 13, 17))
#' age_groups(ages, c(1, 2, 4, 6, 13, 18))
#' age_groups(ages, "children")
#'
#' \donttest{
@ -161,7 +163,10 @@ age <- function(x, reference = Sys.Date(), exact = FALSE, na.rm = FALSE, ...) {
#' filter(mo == as.mo("E. coli")) %>%
#' group_by(age_group = age_groups(age)) %>%
#' select(age_group, CIP) %>%
#' ggplot_rsi(x = "age_group", minimum = 0)
#' ggplot_rsi(x = "age_group",
#' minimum = 0,
#' x.title = "Age Group",
#' title = "Ciprofloxacin resistance per age group")
#' }
#' }
age_groups <- function(x, split_at = c(12, 25, 55, 75), na.rm = FALSE) {

2
R/atc_online.R
View File

@ -26,7 +26,6 @@
#' Get ATC Properties from WHOCC Website
#'
#' Gets data from the WHOCC website to determine properties of an Anatomical Therapeutic Chemical (ATC) (e.g. an antibiotic), such as the name, defined daily dose (DDD) or standard unit.
#' @inheritSection lifecycle Stable Lifecycle
#' @param atc_code a [character] (vector) with ATC code(s) of antibiotics, will be coerced with [as.ab()] and [ab_atc()] internally if not a valid ATC code
#' @param property property of an ATC code. Valid values are `"ATC"`, `"Name"`, `"DDD"`, `"U"` (`"unit"`), `"Adm.R"`, `"Note"` and `groups`. For this last option, all hierarchical groups of an ATC code will be returned, see *Examples*.
#' @param administration type of administration when using `property = "Adm.R"`, see *Details*
@ -61,7 +60,6 @@
#' **N.B. This function requires an internet connection and only works if the following packages are installed: `curl`, `rvest`, `xml2`.**
#' @export
#' @rdname atc_online
#' @inheritSection AMR Read more on Our Website!
#' @source <https://www.whocc.no/atc_ddd_alterations__cumulative/ddd_alterations/abbrevations/>
#' @examples
#' \donttest{

2
R/availability.R
View File

@ -26,12 +26,10 @@
#' Check Availability of Columns
#'
#' Easy check for data availability of all columns in a data set. This makes it easy to get an idea of which antimicrobial combinations can be used for calculation with e.g. [susceptibility()] and [resistance()].
#' @inheritSection lifecycle Stable Lifecycle
#' @param tbl a [data.frame] or [list]
#' @param width number of characters to present the visual availability, defaults to filling the width of the console
#' @details The function returns a [data.frame] with columns `"resistant"` and `"visual_resistance"`. The values in that columns are calculated with [resistance()].
#' @return [data.frame] with column names of `tbl` as row names
#' @inheritSection AMR Read more on Our Website!
#' @export
#' @examples
#' availability(example_isolates)

4
R/bug_drug_combinations.R
View File

@ -26,7 +26,6 @@
#' Determine Bug-Drug Combinations
#'
#' Determine antimicrobial resistance (AMR) of all bug-drug combinations in your data set where at least 30 (default) isolates are available per species. Use [format()] on the result to prettify it to a publishable/printable format, see *Examples*.
#' @inheritSection lifecycle Stable Lifecycle
#' @inheritParams eucast_rules
#' @param combine_IR a [logical] to indicate whether values R and I should be summed
#' @param add_ab_group a [logical] to indicate where the group of the antimicrobials must be included as a first column
@ -41,11 +40,10 @@
#' @rdname bug_drug_combinations
#' @return The function [bug_drug_combinations()] returns a [data.frame] with columns "mo", "ab", "S", "I", "R" and "total".
#' @source \strong{M39 Analysis and Presentation of Cumulative Antimicrobial Susceptibility Test Data, 4th Edition}, 2014, *Clinical and Laboratory Standards Institute (CLSI)*. <https://clsi.org/standards/products/microbiology/documents/m39/>.
#' @inheritSection AMR Read more on Our Website!
#' @examples
#' \donttest{
#' x <- bug_drug_combinations(example_isolates)
#' x
#' head(x)
#' format(x, translate_ab = "name (atc)")
#'
#' # Use FUN to change to transformation of microorganism codes

11
R/catalogue_of_life.R
View File

@ -59,7 +59,6 @@ format_included_data_number <- function(data) {
#' The Catalogue of Life (<http://www.catalogueoflife.org>) is the most comprehensive and authoritative global index of species currently available. It holds essential information on the names, relationships and distributions of over 1.9 million species. The Catalogue of Life is used to support the major biodiversity and conservation information services such as the Global Biodiversity Information Facility (GBIF), Encyclopedia of Life (EoL) and the International Union for Conservation of Nature Red List. It is recognised by the Convention on Biological Diversity as a significant component of the Global Taxonomy Initiative and a contribution to Target 1 of the Global Strategy for Plant Conservation.
#'
#' The syntax used to transform the original data to a cleansed \R format, can be found here: <https://github.com/msberends/AMR/blob/main/data-raw/reproduction_of_microorganisms.R>.
#' @inheritSection AMR Read more on Our Website!
#' @name catalogue_of_life
#' @rdname catalogue_of_life
#' @seealso Data set [microorganisms] for the actual data. \cr
@ -71,28 +70,19 @@ format_included_data_number <- function(data) {
#'
#' # Get a note when a species was renamed
#' mo_shortname("Chlamydophila psittaci")
#' # Note: 'Chlamydophila psittaci' (Everett et al., 1999) was renamed back to
#' # 'Chlamydia psittaci' (Page, 1968)
#' #> [1] "C. psittaci"
#'
#' # Get any property from the entire taxonomic tree for all included species
#' mo_class("E. coli")
#' #> [1] "Gammaproteobacteria"
#'
#' mo_family("E. coli")
#' #> [1] "Enterobacteriaceae"
#'
#' mo_gramstain("E. coli") # based on kingdom and phylum, see ?mo_gramstain
#' #> [1] "Gram-negative"
#'
#' mo_ref("E. coli")
#' #> [1] "Castellani et al., 1919"
#'
#' # Do not get mistaken - this package is about microorganisms
#' mo_kingdom("C. elegans")
#' #> [1] "Fungi" # Fungi?!
#' mo_name("C. elegans")
#' #> [1] "Cladosporium elegans" # Because a microorganism was found
NULL
#' Version info of included Catalogue of Life
@ -102,7 +92,6 @@ NULL
#' @details For LPSN, see [microorganisms].
#' @return a [list], which prints in pretty format
#' @inheritSection catalogue_of_life Catalogue of Life
#' @inheritSection AMR Read more on Our Website!
#' @export
catalogue_of_life_version <- function() {

6
R/count.R
View File

@ -28,7 +28,6 @@
#' @description These functions can be used to count resistant/susceptible microbial isolates. All functions support quasiquotation with pipes, can be used in `summarise()` from the `dplyr` package and also support grouped variables, see *Examples*.
#'
#' [count_resistant()] should be used to count resistant isolates, [count_susceptible()] should be used to count susceptible isolates.
#' @inheritSection lifecycle Stable Lifecycle
#' @param ... one or more vectors (or columns) with antibiotic interpretations. They will be transformed internally with [as.rsi()] if needed.
#' @inheritParams proportion
#' @inheritSection as.rsi Interpretation of R and S/I
@ -45,11 +44,11 @@
#' @rdname count
#' @name count
#' @export
#' @inheritSection AMR Read more on Our Website!
#' @examples
#' # example_isolates is a data set available in the AMR package.
#' ?example_isolates
#' # run ?example_isolates for more info.
#'
#' # base R ------------------------------------------------------------
#' count_resistant(example_isolates$AMX) # counts "R"
#' count_susceptible(example_isolates$AMX) # counts "S" and "I"
#' count_all(example_isolates$AMX) # counts "S", "I" and "R"
@ -72,6 +71,7 @@
#' count_susceptible(example_isolates$AMX)
#' susceptibility(example_isolates$AMX) * n_rsi(example_isolates$AMX)
#'
#' # dplyr -------------------------------------------------------------
#' \donttest{
#' if (require("dplyr")) {
#' example_isolates %>%

51
R/custom_eucast_rules.R
View File

@ -26,82 +26,67 @@
#' Define Custom EUCAST Rules
#'
#' Define custom EUCAST rules for your organisation or specific analysis and use the output of this function in [eucast_rules()].
#' @inheritSection lifecycle Stable Lifecycle
#' @param ... rules in [formula][`~`()] notation, see *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
#'
#' If you are familiar with the [`case_when()`][dplyr::case_when()] function of the `dplyr` package, you will recognise the input method to set your own rules. Rules must be set using what \R considers to be the 'formula notation'. The rule itself is written *before* the tilde (`~`) and the consequence of the rule is written *after* the tilde:
#'
#' ```
#' ```{r}
#' x <- custom_eucast_rules(TZP == "S" ~ aminopenicillins == "S",
#' TZP == "R" ~ aminopenicillins == "R")
#' ```
#'
#' These are two custom EUCAST rules: if TZP (piperacillin/tazobactam) is "S", all aminopenicillins (ampicillin and amoxicillin) must be made "S", and if TZP is "R", aminopenicillins must be made "R". These rules can also be printed to the console, so it is immediately clear how they work:
#'
#' ```
#' ```{r}
#' x
#' #> A set of custom EUCAST rules:
#' #>
#' #> 1. If TZP is S then set to S:
#' #> amoxicillin (AMX), ampicillin (AMP)
#' #>
#' #> 2. If TZP is R then set to R:
#' #> amoxicillin (AMX), ampicillin (AMP)
#' ```
#'
#' The rules (the part *before* the tilde, in above example `TZP == "S"` and `TZP == "R"`) must be evaluable in your data set: it should be able to run as a filter in your data set without errors. This means for the above example that the column `TZP` must exist. We will create a sample data set and test the rules set:
#'
#' ```
#' df <- data.frame(mo = c("E. coli", "K. pneumoniae"),
#' TZP = "R",
#' amox = "",
#' AMP = "")
#' ```{r}
#' df <- data.frame(mo = c("Escherichia coli", "Klebsiella pneumoniae"),
#' TZP = as.rsi("R"),
#' ampi = as.rsi("S"),
#' cipro = as.rsi("S"))
#' df
#' #> mo TZP amox AMP
#' #> 1 E. coli R
#' #> 2 K. pneumoniae R
#'
#' eucast_rules(df, rules = "custom", custom_rules = x)
#' #> mo TZP amox AMP
#' #> 1 E. coli R R R
#' #> 2 K. pneumoniae R R R
#'
#' eucast_rules(df, rules = "custom", custom_rules = x, info = FALSE)
#' ```
#'
#' ### Using taxonomic properties in rules
#'
#' There is one exception in variables 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), quote = "\u0096", sort = FALSE)`. Thus, this next example will work as well, despite the fact that the `df` data set does not contain a column `genus`:
#' There is one exception in variables 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")
#'
#' eucast_rules(df, rules = "custom", custom_rules = y)
#' #> mo TZP amox AMP
#' #> 1 E. coli R
#' #> 2 K. pneumoniae R R R
#' eucast_rules(df, rules = "custom", custom_rules = y, info = FALSE)
#' ```
#'
#' ### Usage of antibiotic group names
#'
#' It is possible to define antibiotic groups instead of single antibiotics for the rule consequence, the part *after* the tilde. In above examples, the antibiotic group `aminopenicillins` is used to include ampicillin and amoxicillin. The following groups are allowed (case-insensitive). Within parentheses are the agents that will be matched when running the rule.
#'
#' `r paste0(" * ", sapply(DEFINED_AB_GROUPS, function(x) paste0("\u0096", tolower(gsub("^AB_", "", x)), "\u0096\\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(" * ", 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 = "")`
#' @returns A [list] containing the custom rules
#' @inheritSection AMR Read more on Our Website!
#' @export
#' @examples
#' x <- custom_eucast_rules(AMC == "R" & genus == "Klebsiella" ~ aminopenicillins == "R",
#' AMC == "I" & genus == "Klebsiella" ~ aminopenicillins == "I")
#' x
#'
#' # run the custom rule set (verbose = TRUE will return a logbook instead of the data set):
#' eucast_rules(example_isolates,
#' rules = "custom",
#' custom_rules = x,
#' info = FALSE)
#' info = FALSE,
#' verbose = TRUE)
#'
#' # combine rule sets
#' x2 <- c(x,

46
R/data.R
View File

@ -72,8 +72,10 @@
#' European Commission Public Health PHARMACEUTICALS - COMMUNITY REGISTER: <https://ec.europa.eu/health/documents/community-register/html/reg_hum_atc.htm>
#' @inheritSection AMR Reference Data Publicly Available
#' @inheritSection WHOCC WHOCC
#' @inheritSection AMR Read more on Our Website!
#' @seealso [microorganisms], [intrinsic_resistant]
#' @examples
#' head(antibiotics)
#' head(antivirals)
"antibiotics"
#' @rdname antibiotics
@ -136,8 +138,9 @@
#'
#' * Retrieved from the `r SNOMED_VERSION$title`, OID `r SNOMED_VERSION$current_oid`, version `r SNOMED_VERSION$current_version`; url: <`r SNOMED_VERSION$url`>
#' @inheritSection AMR Reference Data Publicly Available
#' @inheritSection AMR Read more on Our Website!
#' @seealso [as.mo()], [mo_property()], [microorganisms.codes], [intrinsic_resistant]
#' @examples
#' head(microorganisms)
"microorganisms"
#' Data Set with Previously Accepted Taxonomic Names
@ -153,8 +156,9 @@
#'
#' Parte, A.C. (2018). LPSN - List of Prokaryotic names with Standing in Nomenclature (bacterio.net), 20 years on. International Journal of Systematic and Evolutionary Microbiology, 68, 1825-1829; \doi{10.1099/ijsem.0.002786}
#' @inheritSection AMR Reference Data Publicly Available
#' @inheritSection AMR Read more on Our Website!
#' @seealso [as.mo()] [mo_property()] [microorganisms]
#' @examples
#' head(microorganisms.old)
"microorganisms.old"
#' Data Set with `r format(nrow(microorganisms.codes), big.mark = ",")` Common Microorganism Codes
@ -165,8 +169,9 @@
#' - `mo`\cr ID of the microorganism in the [microorganisms] data set
#' @inheritSection AMR Reference Data Publicly Available
#' @inheritSection catalogue_of_life Catalogue of Life
#' @inheritSection AMR Read more on Our Website!
#' @seealso [as.mo()] [microorganisms]
#' @examples
#' head(microorganisms.codes)
"microorganisms.codes"
#' Data Set with `r format(nrow(example_isolates), big.mark = ",")` Example Isolates
@ -184,7 +189,8 @@
#' - `mo`\cr ID of microorganism created with [as.mo()], see also [microorganisms]
#' - `PEN:RIF`\cr `r sum(vapply(FUN.VALUE = logical(1), example_isolates, is.rsi))` different antibiotics with class [`rsi`] (see [as.rsi()]); these column names occur in the [antibiotics] data set and can be translated with [ab_name()]
#' @inheritSection AMR Reference Data Publicly Available
#' @inheritSection AMR Read more on Our Website!
#' @examples
#' head(example_isolates)
"example_isolates"
#' Data Set with Unclean Data
@ -197,7 +203,8 @@
#' - `bacteria`\cr info about microorganism that can be transformed with [as.mo()], see also [microorganisms]
#' - `AMX:GEN`\cr 4 different antibiotics that have to be transformed with [as.rsi()]
#' @inheritSection AMR Reference Data Publicly Available
#' @inheritSection AMR Read more on Our Website!
#' @examples
#' head(example_isolates_unclean)
"example_isolates_unclean"
#' Data Set with `r format(nrow(WHONET), big.mark = ",")` Isolates - WHONET Example
@ -231,7 +238,8 @@
#' - `Date of data entry`\cr [Date] this data was entered in WHONET
#' - `AMP_ND10:CIP_EE`\cr `r sum(vapply(FUN.VALUE = logical(1), WHONET, is.rsi))` different antibiotics. You can lookup the abbreviations in the [antibiotics] data set, or use e.g. [`ab_name("AMP")`][ab_name()] to get the official name immediately. Before analysis, you should transform this to a valid antibiotic class, using [as.rsi()].
#' @inheritSection AMR Reference Data Publicly Available
#' @inheritSection AMR Read more on Our Website!
#' @examples
#' head(WHONET)
"WHONET"
#' Data Set for R/SI Interpretation
@ -250,16 +258,11 @@
#' - `breakpoint_R`\cr Highest MIC value or lowest number of millimetres that leads to "R"
#' - `uti`\cr A [logical] value (`TRUE`/`FALSE`) to indicate whether the rule applies to a urinary tract infection (UTI)
#' @details
#' Overview of the data set:
#'
#' ```{r}
#' head(rsi_translation)
#' ```
#'
#' The repository of this `AMR` package contains a file comprising this exact data set: <https://github.com/msberends/AMR/blob/main/data-raw/rsi_translation.txt>. This file **allows for machine reading EUCAST and CLSI guidelines**, which is almost impossible with the Excel and PDF files distributed by EUCAST and CLSI. The file is updated automatically and the `mo` and `ab` columns have been transformed to contain the full official names instead of codes.
#' @inheritSection AMR Reference Data Publicly Available
#' @inheritSection AMR Read more on Our Website!
#' @seealso [intrinsic_resistant]
#' @examples
#' head(rsi_translation)
"rsi_translation"
#' Data Set with Bacterial Intrinsic Resistance
@ -272,18 +275,8 @@
#'
#' This data set is based on `r format_eucast_version_nr(3.3)`.
#' @inheritSection AMR Reference Data Publicly Available
#' @inheritSection AMR Read more on Our Website!
#' @examples
#' \donttest{
#' if (require("dplyr")) {
#' intrinsic_resistant %>%
#' mutate(mo = mo_name(mo),
#' ab = ab_name(mo))
#' filter(ab == "Vancomycin" & mo %like% "Enterococcus") %>%
#' pull(mo)
#' #> [1] "Enterococcus casseliflavus" "Enterococcus gallinarum"
#' }
#' }
#' head(intrinsic_resistant)
"intrinsic_resistant"
#' Data Set with Treatment Dosages as Defined by EUCAST
@ -301,5 +294,6 @@
#' - `eucast_version`\cr Version number of the EUCAST Clinical Breakpoints guideline to which these dosages apply
#' @details `r format_eucast_version_nr(11.0)` are based on the dosages in this data set.
#' @inheritSection AMR Reference Data Publicly Available
#' @inheritSection AMR Read more on Our Website!
#' @examples
#' head(dosage)
"dosage"

2
R/deprecated.R
View File

@ -26,8 +26,6 @@
#' Deprecated Functions
#'
#' These functions are so-called '[Deprecated]'. **They will be removed in a future release.** Using the functions will give a warning with the name of the function it has been replaced by (if there is one).
#' @inheritSection lifecycle Retired Lifecycle
#' @inheritSection AMR Read more on Our Website!
#' @keywords internal
#' @name AMR-deprecated
# @export

23
R/disk.R
View File

@ -26,7 +26,6 @@
#' Transform Input to Disk Diffusion Diameters
#'
#' This transforms a vector to a new class [`disk`], which is a disk diffusion growth zone size (around an antibiotic disk) in millimetres between 6 and 50.
#' @inheritSection lifecycle Stable Lifecycle
#' @rdname as.disk
#' @param x vector
#' @param na.rm a [logical] indicating whether missing values should be removed
@ -35,27 +34,31 @@
#' @aliases disk
#' @export
#' @seealso [as.rsi()]
#' @inheritSection AMR Read more on Our Website!
#' @examples
#' \donttest{
#' # transform existing disk zones to the `disk` class
#' df <- data.frame(microorganism = "E. coli",
#' # transform existing disk zones to the `disk` class (using base R)
#' df <- data.frame(microorganism = "Escherichia coli",
#' AMP = 20,
#' CIP = 14,
#' GEN = 18,
#' TOB = 16)
#' df[, 2:5] <- lapply(df[, 2:5], as.disk)
#' # same with dplyr:
#' # df %>% mutate(across(AMP:TOB, as.disk))
#' str(df)
#'
#' #' \donttest{
#' # transforming is easier with dplyr:
#' if (require("dplyr")) {
#' df %>% mutate(across(AMP:TOB, as.disk))
#' }
#' }
#'
#' # interpret disk values, see ?as.rsi
#' as.rsi(x = as.disk(18),
#' mo = "Strep pneu", # `mo` will be coerced with as.mo()
#' ab = "ampicillin", # and `ab` with as.ab()
#' guideline = "EUCAST")
#'
#' as.rsi(df)
#' }
#'
#' # interpret whole data set, pretend to be all from urinary tract infections:
#' as.rsi(df, uti = TRUE)
as.disk <- function(x, na.rm = FALSE) {
meet_criteria(x, allow_class = c("disk", "character", "numeric", "integer"), allow_NA = TRUE)
meet_criteria(na.rm, allow_class = "logical", has_length = 1)

37
R/episode.R
View File

@ -26,7 +26,6 @@
#' Determine (New) Episodes for Patients
#'
#' These functions determine 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. The [get_episode()] function returns the index number of the episode per group, while the [is_new_episode()] function returns values `TRUE`/`FALSE` to indicate whether an item in a vector is the start of a new episode.
#' @inheritSection lifecycle Stable Lifecycle
#' @param x vector of dates (class `Date` or `POSIXt`), will be sorted internally to determine episodes
#' @param episode_days required episode length in days, can also be less than a day or `Inf`, see *Details*
#' @param ... ignored, only in place to allow future extensions
@ -42,16 +41,16 @@
#' @seealso [first_isolate()]
#' @rdname get_episode
#' @export
#' @inheritSection AMR Read more on Our Website!
#' @examples
#' # `example_isolates` is a data set available in the AMR package.
#' # See ?example_isolates.
#' # See ?example_isolates
#' df <- example_isolates[sample(seq_len(2000), size = 200), ]
#'
#' get_episode(example_isolates$date, episode_days = 60) # indices
#' is_new_episode(example_isolates$date, episode_days = 60) # TRUE/FALSE
#' get_episode(df$date, episode_days = 60) # indices
#' is_new_episode(df$date, episode_days = 60) # TRUE/FALSE
#'
#' # filter on results from the third 60-day episode only, using base R
#' example_isolates[which(get_episode(example_isolates$date, 60) == 3), ]
#' df[which(get_episode(df$date, 60) == 3), ]
#'
#' # the functions also work for less than a day, e.g. to include one per hour:
#' get_episode(c(Sys.time(),
@ -62,24 +61,24 @@
#' if (require("dplyr")) {
#' # is_new_episode() can also be used in dplyr verbs to determine patient
#' # episodes based on any (combination of) grouping variables:
#' example_isolates %>%
#' df %>%
#' mutate(condition = sample(x = c("A", "B", "C"),
#' size = 2000,
#' replace = TRUE)) %>%
#' group_by(condition) %>%
#' mutate(new_episode = is_new_episode(date, 365))
#' mutate(new_episode = is_new_episode(date, 365)) %>%
#' select(patient_id, date, condition, new_episode)
#'
#' example_isolates %>%
#' df %>%
#' group_by(hospital_id, patient_id) %>%
#' transmute(date,
#' patient_id,
#' new_index = get_episode(date, 60),
#' new_logical = is_new_episode(date, 60))
#'
#'
#' example_isolates %>%
#' df %>%
#' group_by(hospital_id) %>%
#' summarise(patients = n_distinct(patient_id),
#' summarise(n_patients = n_distinct(patient_id),
#' n_episodes_365 = sum(is_new_episode(date, episode_days = 365)),
#' n_episodes_60 = sum(is_new_episode(date, episode_days = 60)),
#' n_episodes_30 = sum(is_new_episode(date, episode_days = 30)))
@ -87,21 +86,23 @@
#'
#' # grouping on patients and microorganisms leads to the same
#' # results as first_isolate() when using 'episode-based':
#' x <- example_isolates %>%
#' x <- df %>%
#' filter_first_isolate(include_unknown = TRUE,
#' method = "episode-based")
#'
#' y <- example_isolates %>%
#' y <- df %>%
#' group_by(patient_id, mo) %>%
#' filter(is_new_episode(date, 365))
#' filter(is_new_episode(date, 365)) %>%
#' ungroup()
#'
#' identical(x$patient_id, y$patient_id)
#' identical(x, y)
#'
#' # but is_new_episode() has a lot more flexibility than first_isolate(),
#' # since you can now group on anything that seems relevant:
#' example_isolates %>%
#' df %>%
#' group_by(patient_id, mo, hospital_id, ward_icu) %>%
#' mutate(flag_episode = is_new_episode(date, 365))
#' mutate(flag_episode = is_new_episode(date, 365)) %>%
#' select(group_vars(.), flag_episode)
#' }
#' }
get_episode <- function(x, episode_days, ...) {

29
R/eucast_rules.R
View File

@ -52,7 +52,6 @@ format_eucast_version_nr <- function(version, markdown = TRUE) {
#' Apply rules for clinical breakpoints and intrinsic resistance as defined by the European Committee on Antimicrobial Susceptibility Testing (EUCAST, <https://eucast.org>), see *Source*. Use [eucast_dosage()] to get a [data.frame] with advised dosages of a certain bug-drug combination, which is based on the [dosage] data set.
#'
#' To improve the interpretation of the antibiogram before EUCAST rules are applied, some non-EUCAST rules can applied at default, see *Details*.
#' @inheritSection lifecycle Stable Lifecycle
#' @param x data with antibiotic columns, such as `amox`, `AMX` and `AMC`
#' @param info a [logical] to indicate whether progress should be printed to the console, defaults to only print while in interactive sessions
#' @param rules a [character] vector that specifies which rules should be applied. Must be one or more of `"breakpoints"`, `"expert"`, `"other"`, `"custom"`, `"all"`, and defaults to `c("breakpoints", "expert")`. The default value can be set to another value, e.g. using `options(AMR_eucastrules = "all")`. If using `"custom"`, be sure to fill in argument `custom_rules` too. Custom rules can be created with [custom_eucast_rules()].
@ -76,11 +75,11 @@ format_eucast_version_nr <- function(version, markdown = TRUE) {
#'
#' Custom rules can be created using [custom_eucast_rules()], e.g.:
#'
#' ```
#' ```{r}
#' x <- custom_eucast_rules(AMC == "R" & genus == "Klebsiella" ~ aminopenicillins == "R",
#' AMC == "I" & genus == "Klebsiella" ~ aminopenicillins == "I")
#'
#' eucast_rules(example_isolates, rules = "custom", custom_rules = x)
#' eucast_rules(example_isolates, rules = "custom", custom_rules = x, info = FALSE)
#' ```
#'
#'
@ -113,8 +112,9 @@ format_eucast_version_nr <- function(version, markdown = TRUE) {
#' - EUCAST Breakpoint tables for interpretation of MICs and zone diameters. Version 9.0, 2019. [(link)](https://www.eucast.org/fileadmin/src/media/PDFs/EUCAST_files/Breakpoint_tables/v_9.0_Breakpoint_Tables.xlsx)
#' - EUCAST Breakpoint tables for interpretation of MICs and zone diameters. Version 10.0, 2020. [(link)](https://www.eucast.org/fileadmin/src/media/PDFs/EUCAST_files/Breakpoint_tables/v_10.0_Breakpoint_Tables.xlsx)
#' - EUCAST Breakpoint tables for interpretation of MICs and zone diameters. Version 11.0, 2021. [(link)](https://www.eucast.org/fileadmin/src/media/PDFs/EUCAST_files/Breakpoint_tables/v_11.0_Breakpoint_Tables.xlsx)
#' - EUCAST Breakpoint tables for interpretation of MICs and zone diameters. Version 12.0, 2022. [(link)](https://www.eucast.org/fileadmin/src/media/PDFs/EUCAST_files/Breakpoint_tables/v_12.0_Breakpoint_Tables.xlsx)
#' @inheritSection AMR Reference Data Publicly Available
#' @inheritSection AMR Read more on Our Website!
#' @examples
#' \donttest{
#' a <- data.frame(mo = c("Staphylococcus aureus",
@ -131,33 +131,26 @@ format_eucast_version_nr <- function(version, markdown = TRUE) {
#' FOX = "S", # Cefoxitin
#' stringsAsFactors = FALSE)
#'
#' a
#' # mo VAN AMX COL CAZ CXM PEN FOX
#' # 1 Staphylococcus aureus - - - - - S S
#' # 2 Enterococcus faecalis - - - - - S S
#' # 3 Escherichia coli - - - - - S S
#' # 4 Klebsiella pneumoniae - - - - - S S
#' # 5 Pseudomonas aeruginosa - - - - - S S
#' head(a)
#'
#'
#' # apply EUCAST rules: some results wil be changed
#' b <- eucast_rules(a)
#'
#' b
#' # mo VAN AMX COL CAZ CXM PEN FOX
#' # 1 Staphylococcus aureus - S R R S S S
#' # 2 Enterococcus faecalis - - R R R S R
#' # 3 Escherichia coli R - - - - R S
#' # 4 Klebsiella pneumoniae R R - - - R S
#' # 5 Pseudomonas aeruginosa R R - - R R R
#' head(b)
#'
#'
#' # do not apply EUCAST rules, but rather get a data.frame
#' # containing all details about the transformations:
#' c <- eucast_rules(a, verbose = TRUE)
#' head(c)
#' }
#'
#' # Dosage guidelines:
#'
#' eucast_dosage(c("tobra", "genta", "cipro"), "iv")
#'
#' eucast_dosage(c("tobra", "genta", "cipro"), "iv", version_breakpoints = 10)
eucast_rules <- function(x,
col_mo = NULL,
info = interactive(),

14
R/first_isolate.R
View File

@ -26,7 +26,6 @@
#' Determine First Isolates
#'
#' Determine first isolates of all microorganisms of every patient per episode and (if needed) per specimen type. These functions support all four methods as summarised by Hindler *et al.* in 2007 (\doi{10.1086/511864}). To determine patient episodes not necessarily based on microorganisms, use [is_new_episode()] that also supports grouping with the `dplyr` package.
#' @inheritSection lifecycle Stable Lifecycle
#' @param x a [data.frame] containing isolates. Can be left blank for automatic determination, see *Examples*.
#' @param col_date column name of the result date (or date that is was received on the lab), defaults to the first column with a date class
#' @param col_patient_id column name of the unique IDs of the patients, defaults to the first column that starts with 'patient' or 'patid' (case insensitive)
@ -126,7 +125,6 @@
#' - **M39 Analysis and Presentation of Cumulative Antimicrobial Susceptibility Test Data, 4th Edition**, 2014, *Clinical and Laboratory Standards Institute (CLSI)*. <https://clsi.org/standards/products/microbiology/documents/m39/>.
#'
#' - Hindler JF and Stelling J (2007). **Analysis and Presentation of Cumulative Antibiograms: A New Consensus Guideline from the Clinical and Laboratory Standards Institute.** Clinical Infectious Diseases, 44(6), 867-873. \doi{10.1086/511864}
#' @inheritSection AMR Read more on Our Website!
#' @examples
#' # `example_isolates` is a data set available in the AMR package.
#' # See ?example_isolates.
@ -134,7 +132,7 @@
#' example_isolates[first_isolate(), ]
#' \donttest{
#' # get all first Gram-negatives
#' example_isolates[which(first_isolate() & mo_is_gram_negative()), ]
#' example_isolates[which(first_isolate(info = FALSE) & mo_is_gram_negative()), ]
#'
#' if (require("dplyr")) {
#' # filter on first isolates using dplyr:
@ -143,12 +141,13 @@
#'
#' # short-hand version:
#' example_isolates %>%
#' filter_first_isolate()
#' filter_first_isolate(info = FALSE)
#'
#' # grouped determination of first isolates (also prints group names):
#' # flag the first isolates per group:
#' example_isolates %>%
#' group_by(hospital_id) %>%
#' mutate(first = first_isolate())
#' mutate(first = first_isolate()) %>%
#' select(hospital_id, date, patient_id, mo, first)
#'
#' # now let's see if first isolates matter:
#' A <- example_isolates %>%
@ -163,6 +162,9 @@
#' resistance = resistance(GEN)) # gentamicin resistance
#'
#' # Have a look at A and B.
#' A
#' B
#'
#' # B is more reliable because every isolate is counted only once.
#' # Gentamicin resistance in hospital D appears to be 4.2% higher than
#' # when you (erroneously) would have used all isolates for analysis.

7
R/g.test.R
View File

@ -26,7 +26,6 @@
#' *G*-test for Count Data
#'
#' [g.test()] performs chi-squared contingency table tests and goodness-of-fit tests, just like [chisq.test()] but is more reliable (1). A *G*-test can be used to see whether the number of observations in each category fits a theoretical expectation (called a ***G*-test of goodness-of-fit**), or to see whether the proportions of one variable are different for different values of the other variable (called a ***G*-test of independence**).
#' @inheritSection lifecycle Questioning Lifecycle
#' @inherit stats::chisq.test params return
#' @details If `x` is a [matrix] with one row or column, or if `x` is a vector and `y` is not given, then a *goodness-of-fit test* is performed (`x` is treated as a one-dimensional contingency table). The entries of `x` must be non-negative integers. In this case, the hypothesis tested is whether the population probabilities equal those in `p`, or are all equal if `p` is not given.
#'
@ -76,7 +75,6 @@
#' - The possibility to simulate p values with `simulate.p.value` was removed
#' @export
#' @importFrom stats pchisq complete.cases
#' @inheritSection AMR Read more on Our Website!
#' @examples
#' # = EXAMPLE 1 =
#' # Shivrain et al. (2006) crossed clearfield rice (which are resistant
@ -88,8 +86,7 @@
#' # ratio.
#'
#' x <- c(772, 1611, 737)
#' G <- g.test(x, p = c(1, 2, 1) / 4)
#' # G$p.value = 0.12574.
#' g.test(x, p = c(1, 2, 1) / 4)
#'
#' # There is no significant difference from a 1:2:1 ratio.
#' # Meaning: resistance controlled by a single gene with two co-dominant
@ -105,11 +102,9 @@
#'
#' x <- c(1752, 1895)
#' g.test(x)
#' # p = 0.01787343
#'
#' # There is a significant difference from a 1:1 ratio.
#' # Meaning: there are significantly more left-billed birds.
#'
g.test <- function(x,
y = NULL,
# correct = TRUE,

28
R/ggplot_pca.R
View File

@ -26,7 +26,6 @@
#' PCA Biplot with `ggplot2`
#'
#' Produces a `ggplot2` variant of a so-called [biplot](https://en.wikipedia.org/wiki/Biplot) for PCA (principal component analysis), but is more flexible and more appealing than the base \R [biplot()] function.
#' @inheritSection lifecycle Stable Lifecycle
#' @param x an object returned by [pca()], [prcomp()] or [princomp()]
#' @inheritParams stats::biplot.prcomp
#' @param labels an optional vector of labels for the observations. If set, the labels will be placed below their respective points. When using the [pca()] function as input for `x`, this will be determined automatically based on the attribute `non_numeric_cols`, see [pca()].
@ -64,23 +63,28 @@
#' # `example_isolates` is a data set available in the AMR package.
#' # See ?example_isolates.
#'
#' # See ?pca for more info about Principal Component Analysis (PCA).
#' \donttest{
#' if (require("dplyr")) {
#' pca_model <- example_isolates %>%
#' filter(mo_genus(mo) == "Staphylococcus") %>%
#' group_by(species = mo_shortname(mo)) %>%
#' summarise_if (is.rsi, resistance) %>%
#' pca(FLC, AMC, CXM, GEN, TOB, TMP, SXT, CIP, TEC, TCY, ERY)
#' # calculate the resistance per group first
#' resistance_data <- example_isolates %>%
#' group_by(order = mo_order(mo), # group on anything, like order
#' genus = mo_genus(mo)) %>% # and genus as we do here;
#' filter(n() >= 30) %>% # filter on only 30 results per group
#' summarise_if(is.rsi, resistance) # then get resistance of all drugs
#'
#' # old (base R)
#' biplot(pca_model)
#' # now conduct PCA for certain antimicrobial agents
#' pca_result <- resistance_data %>%
#' pca(AMC, CXM, CTX, CAZ, GEN, TOB, TMP, SXT)
#'
#' summary(pca_result)
#'
#' # new
#' ggplot_pca(pca_model)
#' # old base R plotting method:
#' biplot(pca_result)
#' # new ggplot2 plotting method using this package:
#' ggplot_pca(pca_result)
#'
#' if (require("ggplot2")) {
#' ggplot_pca(pca_model) +
#' ggplot_pca(pca_result) +
#' scale_colour_viridis_d() +
#' labs(title = "Title here")
#' }

2
R/ggplot_rsi.R
View File

@ -26,7 +26,6 @@
#' AMR Plots with `ggplot2`
#'
#' Use these functions to create bar plots for AMR data analysis. All functions rely on [ggplot2][ggplot2::ggplot()] functions.
#' @inheritSection lifecycle Stable Lifecycle
#' @param data a [data.frame] with column(s) of class [`rsi`] (see [as.rsi()])
#' @param position position adjustment of bars, either `"fill"`, `"stack"` or `"dodge"`
#' @param x variable to show on x axis, either `"antibiotic"` (default) or `"interpretation"` or a grouping variable
@ -65,7 +64,6 @@
#' [ggplot_rsi()] is a wrapper around all above functions that uses data as first input. This makes it possible to use this function after a pipe (`%>%`). See *Examples*.
#' @rdname ggplot_rsi
#' @export
#' @inheritSection AMR Read more on Our Website!
#' @examples
#' \donttest{
#' if (require("ggplot2") & require("dplyr")) {

2
R/guess_ab_col.R
View File

@ -26,7 +26,6 @@
#' Guess Antibiotic Column
#'
#' This tries to find a column name in a data set based on information from the [antibiotics] data set. Also supports WHONET abbreviations.
#' @inheritSection lifecycle Stable Lifecycle
#' @param x a [data.frame]
#' @param search_string a text to search `x` for, will be checked with [as.ab()] if this value is not a column in `x`
#' @param verbose a [logical] to indicate whether additional info should be printed
@ -34,7 +33,6 @@
#' @details You can look for an antibiotic (trade) name or abbreviation and it will search `x` and the [antibiotics] data set for any column containing a name or code of that antibiotic. **Longer columns names take precedence over shorter column names.**
#' @return A column name of `x`, or `NULL` when no result is found.
#' @export
#' @inheritSection AMR Read more on Our Website!
#' @examples
#' df <- data.frame(amox = "S",
#' tetr = "R")

14
R/italicise_taxonomy.R
View File

@ -25,8 +25,7 @@
#' Italicise Taxonomic Families, Genera, Species, Subspecies
#'
#' According to the binomial nomenclature, the lowest four taxonomic levels (family, genus, species, subspecies) should be printed in italic. This function finds taxonomic names within strings and makes them italic.
#' @inheritSection lifecycle Stable Lifecycle
#' According to the binomial nomenclature, the lowest four taxonomic levels (family, genus, species, subspecies) should be printed in italics. This function finds taxonomic names within strings and makes them italic.
#' @param string a [character] (vector)
#' @param type type of conversion of the taxonomic names, either "markdown" or "ansi", see *Details*
#' @details
@ -35,23 +34,12 @@
#' The taxonomic names can be italicised using markdown (the default) by adding `*` before and after the taxonomic names, or using ANSI colours by adding `\033[3m` before and `\033[23m` after the taxonomic names. If multiple ANSI colours are not available, no conversion will occur.
#'
#' This function also supports abbreviation of the genus if it is followed by a species, such as "E. coli" and "K. pneumoniae ozaenae".
#' @inheritSection AMR Read more on Our Website!
#' @export
#' @examples
#' italicise_taxonomy("An overview of Staphylococcus aureus isolates")
#' italicise_taxonomy("An overview of S. aureus isolates")
#'
#' cat(italicise_taxonomy("An overview of S. aureus isolates", type = "ansi"))
#'
#' # since ggplot2 supports no markdown (yet), use
#' # italicise_taxonomy() and the `ggtext` package for titles:
#' \donttest{
#' if (require("ggplot2") && require("ggtext")) {
#' autoplot(example_isolates$AMC,
#' title = italicise_taxonomy("Amoxi/clav in E. coli")) +
#' theme(plot.title = ggtext::element_markdown())
#' }
#' }
italicise_taxonomy <- function(string, type = c("markdown", "ansi")) {
if (missing(type)) {
type <- "markdown"

2
R/join_microorganisms.R
View File

@ -26,7 +26,6 @@
#' Join [microorganisms] to a Data Set
#'
#' Join the data set [microorganisms] easily to an existing data set or to a [character] vector.
#' @inheritSection lifecycle Stable Lifecycle
#' @rdname join
#' @name join
#' @aliases join inner_join
@ -37,7 +36,6 @@
#' @details **Note:** As opposed to the `join()` functions of `dplyr`, [character] vectors are supported and at default existing columns will get a suffix `"2"` and the newly joined columns will not get a suffix.
#'
#' If the `dplyr` package is installed, their join functions will be used. Otherwise, the much slower [merge()] and [interaction()] functions from base \R will be used.
#' @inheritSection AMR Read more on Our Website!
#' @return a [data.frame]
#' @export
#' @examples

4
R/key_antimicrobials.R
View File

@ -26,7 +26,6 @@
#' (Key) Antimicrobials for First Weighted Isolates
#'
#' These functions can be used to determine first weighted isolates by considering the phenotype for isolate selection (see [first_isolate()]). Using a phenotype-based method to determine first isolates is more reliable than methods that disregard phenotypes.
#' @inheritSection lifecycle Stable Lifecycle
#' @param x a [data.frame] with antibiotics columns, like `AMX` or `amox`. Can be left blank to determine automatically
#' @param y,z [character] vectors to compare
#' @inheritParams first_isolate
@ -82,7 +81,6 @@
#' @rdname key_antimicrobials
#' @export
#' @seealso [first_isolate()]
#' @inheritSection AMR Read more on Our Website!
#' @examples
#' # `example_isolates` is a data set available in the AMR package.
#' # See ?example_isolates.
@ -110,7 +108,7 @@
#' first_weighted = first_isolate(col_keyantimicrobials = "keyab")
#' )
#'
#' # Check the difference, in this data set it results in more isolates:
#' # Check the difference in this data set, 'weighted' results in more isolates:
#' sum(my_patients$first_regular, na.rm = TRUE)
#' sum(my_patients$first_weighted, na.rm = TRUE)
#' }

5
R/kurtosis.R
View File

@ -26,14 +26,15 @@
#' Kurtosis of the Sample
#'
#' @description Kurtosis is a measure of the "tailedness" of the probability distribution of a real-valued random variable. A normal distribution has a kurtosis of 3 and a excess kurtosis of 0.
#' @inheritSection lifecycle Stable Lifecycle
#' @param x a vector of values, a [matrix] or a [data.frame]
#' @param na.rm a [logical] to indicate whether `NA` values should be stripped before the computation proceeds
#' @param excess a [logical] to indicate whether the *excess kurtosis* should be returned, defined as the kurtosis minus 3.
#' @seealso [skewness()]
#' @rdname kurtosis
#' @inheritSection AMR Read more on Our Website!
#' @export
#' @examples
#' kurtosis(rnorm(10000))
#' kurtosis(rnorm(10000), excess = TRUE)
kurtosis <- function(x, na.rm = FALSE, excess = FALSE) {
meet_criteria(na.rm, allow_class = "logical", has_length = 1)
meet_criteria(excess, allow_class = "logical", has_length = 1)

54
R/lifecycle.R
View File

@ -1,54 +0,0 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2022 Berends MS, Luz CF et al. #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #
# #
# This R package is free software; you can freely use and distribute #
# it for both personal and commercial purposes under the terms of the #
# GNU General Public License version 2.0 (GNU GPL-2), as published by #
# the Free Software Foundation. #
# We created this package for both routine data analysis and academic #
# research and it was publicly released in the hope that it will be #
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
# #
# Visit our website for the full manual and a complete tutorial about #
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== #
###############
# NOTE TO SELF: could also have done this with the 'lifecycle' package, but why add a package dependency for such an easy job??
###############
#' Lifecycles of Functions in the `AMR` Package
#' @name lifecycle
#' @rdname lifecycle
#' @description Functions in this `AMR` package are categorised using [the lifecycle circle of the Tidyverse as found on www.tidyverse.org/lifecycle](https://lifecycle.r-lib.org/articles/stages.html).
#'
#' \if{html}{\figure{lifecycle_tidyverse.svg}{options: height="200" style=margin-bottom:"5"} \cr}
#' This page contains a section for every lifecycle (with text borrowed from the aforementioned Tidyverse website), so they can be used in the manual pages of the functions.
#' @section Experimental Lifecycle:
#' \if{html}{\figure{lifecycle_experimental.svg}{options: style=margin-bottom:"5"} \cr}
#' The [lifecycle][AMR::lifecycle] of this function is **experimental**. An experimental function is in early stages of development. The unlying code might be changing frequently. Experimental functions might be removed without deprecation, so you are generally best off waiting until a function is more mature before you use it in production code. Experimental functions are only available in development versions of this `AMR` package and will thus not be included in releases that are submitted to CRAN, since such functions have not yet matured enough.
#' @section Maturing Lifecycle:
#' \if{html}{\figure{lifecycle_maturing.svg}{options: style=margin-bottom:"5"} \cr}
#' The [lifecycle][AMR::lifecycle] of this function is **maturing**. The unlying code of a maturing function has been roughed out, but finer details might still change. Since this function needs wider usage and more extensive testing, you are very welcome [to suggest changes at our repository](https://github.com/msberends/AMR/issues) or [write us an email (see section 'Contact Us')][AMR::AMR].
#' @section Stable Lifecycle:
#' \if{html}{\figure{lifecycle_stable.svg}{options: style=margin-bottom:"5"} \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, an argument will be deprecated and first continue to work, but will emit a 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:"5"} \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.
#' @section Questioning Lifecycle:
#' \if{html}{\figure{lifecycle_questioning.svg}{options: style=margin-bottom:"5"} \cr}
#' The [lifecycle][AMR::lifecycle] of this function is **questioning**. This function might be no longer be optimal approach, or is it questionable whether this function should be in this `AMR` package at all.
NULL

9
R/like.R
View File

@ -26,7 +26,6 @@
#' Vectorised Pattern Matching with Keyboard Shortcut
#'
#' Convenient wrapper around [grepl()] to match a pattern: `x %like% pattern`. It always returns a [`logical`] vector and is always case-insensitive (use `x %like_case% pattern` for case-sensitive matching). Also, `pattern` can be as long as `x` to compare items of each index in both vectors, or they both can have the same length to iterate over all cases.
#' @inheritSection lifecycle Stable Lifecycle
#' @param x a [character] vector where matches are sought, or an object which can be coerced by [as.character()] to a [character] vector.
#' @param pattern a [character] vector containing regular expressions (or a [character] string for `fixed = TRUE`) to be matched in the given [character] vector. Coerced by [as.character()] to a [character] string if possible.
#' @param ignore.case if `FALSE`, the pattern matching is *case sensitive* and if `TRUE`, case is ignored during matching.
@ -44,27 +43,21 @@
#' Using RStudio? The `%like%`/`%unlike%` functions can also be directly inserted in your code from the Addins menu and can have its own keyboard shortcut like `Shift+Ctrl+L` or `Shift+Cmd+L` (see menu `Tools` > `Modify Keyboard Shortcuts...`). If you keep pressing your shortcut, the inserted text will be iterated over `%like%` -> `%unlike%` -> `%like_case%` -> `%unlike_case%`.
#' @source Idea from the [`like` function from the `data.table` package](https://github.com/Rdatatable/data.table/blob/ec1259af1bf13fc0c96a1d3f9e84d55d8106a9a4/R/like.R), although altered as explained in *Details*.
#' @seealso [grepl()]
#' @inheritSection AMR Read more on Our Website!
#' @examples
#' a <- "This is a test"
#' b <- "TEST"
#' a %like% b
#' #> TRUE
#' b %like% a
#' #> FALSE
#'
#' # also supports multiple patterns
#' a <- c("Test case", "Something different", "Yet another thing")
#' b <- c( "case", "diff", "yet")
#' a %like% b
#' #> TRUE TRUE TRUE
#' a %unlike% b
#' #> FALSE FALSE FALSE
#'
#' a[1] %like% b
#' #> TRUE FALSE FALSE
#' a %like% b[1]
#' #> TRUE FALSE FALSE
#'
#' # get isolates whose name start with 'Ent' or 'ent'
#' example_isolates[which(mo_name(example_isolates$mo) %like% "^ent"), ]

27
R/mdro.R
View File

@ -26,7 +26,6 @@
#' Determine Multidrug-Resistant Organisms (MDRO)
#'
#' Determine which isolates are multidrug-resistant organisms (MDRO) according to international, national and custom guidelines.
#' @inheritSection lifecycle Stable Lifecycle
#' @param x a [data.frame] with antibiotics columns, like `AMX` or `amox`. Can be left blank for automatic determination.
#' @param guideline a specific guideline to follow, see sections *Supported international / national guidelines* and *Using Custom Guidelines* below. When left empty, the publication by Magiorakos *et al.* (see below) will be followed.
#' @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 *Antibiotics* below.
@ -137,15 +136,17 @@
#' @rdname mdro
#' @aliases MDR XDR PDR BRMO 3MRGN 4MRGN
#' @export
#' @inheritSection AMR Read more on Our Website!
#' @source
#' See the supported guidelines above for the [list] of publications used for this function.
#' @examples
#' mdro(example_isolates, guideline = "EUCAST")
#' out <- mdro(example_isolates, guideline = "EUCAST")
#' str(out)
#' table(out)
#'
#' mdro(example_isolates,
#' guideline = custom_mdro_guideline(AMX == "R" ~ "Custom MDRO 1",
#' VAN == "R" ~ "Custom MDRO 2"))
#' out <- mdro(example_isolates,
#' guideline = custom_mdro_guideline(AMX == "R" ~ "Custom MDRO 1",
#' VAN == "R" ~ "Custom MDRO 2"))
#' table(out)
#'
#' \donttest{
#' if (require("dplyr")) {
@ -155,10 +156,10 @@
#'
#' # no need to define `x` when used inside dplyr verbs:
#' example_isolates %>%
#' mutate(MDRO = mdro(),
#' EUCAST = eucast_exceptional_phenotypes(),
#' BRMO = brmo(),
#' MRGN = mrgn())
#' mutate(MDRO = mdro()) %>%
#' pull(MDRO) %>%
#' table()
#'
#' }
#' }
mdro <- function(x = NULL,
@ -191,8 +192,10 @@ mdro <- function(x = NULL,
info.bak <- info
# don't thrown info's more than once per call
info <- message_not_thrown_before("mdro")
if (isTRUE(info)) {
info <- message_not_thrown_before("mdro")
}
if (interactive() & verbose == TRUE & info == TRUE) {
txt <- paste0("WARNING: In Verbose mode, the mdro() 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.",
"\n\nThis may overwrite your existing data if you use e.g.:",

16
R/mic.R
View File

@ -43,7 +43,6 @@ valid_mic_levels <- c(c(t(vapply(FUN.VALUE = character(9), ops,
#' Transform Input to Minimum Inhibitory Concentrations (MIC)
#'
#' This transforms vectors to a new class [`mic`], which treats the input as decimal numbers, while maintaining operators (such as ">=") and only allowing valid MIC values known to the field of (medical) microbiology.
#' @inheritSection lifecycle Stable Lifecycle
#' @rdname as.mic
#' @param x a [character] or [numeric] vector
#' @param na.rm a [logical] indicating whether missing values should be removed
@ -95,32 +94,35 @@ valid_mic_levels <- c(c(t(vapply(FUN.VALUE = character(9), ops,
#' @aliases mic
#' @export
#' @seealso [as.rsi()]
#' @inheritSection AMR Read more on Our Website!
#' @examples
#' mic_data <- as.mic(c(">=32", "1.0", "1", "1.00", 8, "<=0.128", "8", "16", "16"))
#' mic_data
#' is.mic(mic_data)
#'
#' # this can also coerce combined MIC/RSI values:
#' as.mic("<=0.002; S") # will return <=0.002
#' as.mic("<=0.002; S")
#'
#' # mathematical processing treats MICs as [numeric] values
#' # mathematical processing treats MICs as numeric values
#' fivenum(mic_data)
#' quantile(mic_data)
#' all(mic_data < 512)
#'
#' # interpret MIC values
#' as.rsi(x = as.mic(2),
#' mo = as.mo("S. pneumoniae"),
#' mo = as.mo("Streptococcus pneumoniae"),
#' ab = "AMX",
#' guideline = "EUCAST")
#' as.rsi(x = as.mic(4),
#' mo = as.mo("S. pneumoniae"),
#' as.rsi(x = as.mic(c(0.01, 2, 4, 8)),
#' mo = as.mo("Streptococcus pneumoniae"),
#' ab = "AMX",
#' guideline = "EUCAST")
#'
#' # plot MIC values, see ?plot
#' plot(mic_data)
#' plot(mic_data, mo = "E. coli", ab = "cipro")
#' autoplot(mic_data, mo = "E. coli", ab = "cipro")
#' autoplot(mic_data, mo = "E. coli", ab = "cipro", language = "nl") # Dutch
#' autoplot(mic_data, mo = "E. coli", ab = "cipro", language = "uk") # Ukrainian
as.mic <- function(x, na.rm = FALSE) {
meet_criteria(x, allow_class = c("mic", "character", "numeric", "integer", "factor"), allow_NA = TRUE)
meet_criteria(na.rm, allow_class = "logical", has_length = 1)

2
R/mo.R
View File

@ -26,7 +26,6 @@
#' Transform Input to a Microorganism Code
#'
#' Use this function to determine a valid microorganism code ([`mo`]). Determination is done using intelligent rules and the complete taxonomic kingdoms Bacteria, Chromista, Protozoa, Archaea and most microbial species from the kingdom Fungi (see *Source*). The input can be almost anything: a full name (like `"Staphylococcus aureus"`), an abbreviated name (such as `"S. aureus"`), an abbreviation known in the field (such as `"MRSA"`), or just a genus. See *Examples*.
#' @inheritSection lifecycle Stable Lifecycle
#' @param x a [character] vector or a [data.frame] with one or two columns
#' @param Becker a [logical] to indicate whether staphylococci should be categorised into coagulase-negative staphylococci ("CoNS") and coagulase-positive staphylococci ("CoPS") instead of their own species, according to Karsten Becker *et al.* (1,2,3).
#'
@ -116,7 +115,6 @@
#'
#' The [`mo_*`][mo_property()] functions (such as [mo_genus()], [mo_gramstain()]) to get properties based on the returned code.
#' @inheritSection AMR Reference Data Publicly Available
#' @inheritSection AMR Read more on Our Website!
#' @examples
#' \donttest{
#' # These examples all return "B_STPHY_AURS", the ID of S. aureus:

2
R/mo_matching_score.R
View File

@ -26,7 +26,6 @@
#' Calculate the Matching Score for Microorganisms
#'
#' This algorithm is used by [as.mo()] and all the [`mo_*`][mo_property()] functions to determine the most probable match of taxonomic records based on user input.
#' @inheritSection lifecycle Stable Lifecycle
#' @author Dr Matthijs Berends
#' @param x Any user input value(s)
#' @param n A full taxonomic name, that exists in [`microorganisms$fullname`][microorganisms]
@ -53,7 +52,6 @@
#' Since `AMR` version 1.8.1, common microorganism abbreviations are ignored in determining the matching score. These abbreviations are currently: `r vector_and(pkg_env$mo_field_abbreviations, quotes = FALSE)`.
#' @export
#' @inheritSection AMR Reference Data Publicly Available
#' @inheritSection AMR Read more on Our Website!
#' @examples
#' as.mo("E. coli")
#' mo_uncertainties()

113
R/mo_property.R
View File

@ -26,7 +26,6 @@
#' Get Properties of a Microorganism
#'
#' Use these functions to return a specific property of a microorganism based on the latest accepted taxonomy. All input values will be evaluated internally with [as.mo()], which makes it possible to use microbial abbreviations, codes and names as input. See *Examples*.
#' @inheritSection lifecycle Stable Lifecycle
#' @param x any [character] (vector) that can be coerced to a valid microorganism code with [as.mo()]. Can be left blank for auto-guessing the column containing microorganism codes if used in a data set, see *Examples*.
#' @param property one of the column names of the [microorganisms] data set: `r vector_or(colnames(microorganisms), sort = FALSE, quotes = TRUE)`, or must be `"shortname"`
#' @param language language of the returned text, defaults to system language (see [get_AMR_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.
@ -67,93 +66,91 @@
#' @export
#' @seealso Data set [microorganisms]
#' @inheritSection AMR Reference Data Publicly Available
#' @inheritSection AMR Read more on Our Website!
#' @examples
#' # taxonomic tree -----------------------------------------------------------
#' mo_kingdom("E. coli") # "Bacteria"
#' mo_phylum("E. coli") # "Proteobacteria"
#' mo_class("E. coli") # "Gammaproteobacteria"
#' mo_order("E. coli") # "Enterobacterales"
#' mo_family("E. coli") # "Enterobacteriaceae"
#' mo_genus("E. coli") # "Escherichia"
#' mo_species("E. coli") # "coli"
#' mo_subspecies("E. coli") # ""
#' mo_kingdom("Klebsiella pneumoniae")
#' mo_phylum("Klebsiella pneumoniae")
#' mo_class("Klebsiella pneumoniae")
#' mo_order("Klebsiella pneumoniae")
#' mo_family("Klebsiella pneumoniae")
#' mo_genus("Klebsiella pneumoniae")
#' mo_species("Klebsiella pneumoniae")
#' mo_subspecies("Klebsiella pneumoniae")
#'
#' # colloquial properties ----------------------------------------------------
#' mo_name("E. coli") # "Escherichia coli"
#' mo_fullname("E. coli") # "Escherichia coli" - same as mo_name()
#' mo_shortname("E. coli") # "E. coli"
#' mo_name("Klebsiella pneumoniae")
#' mo_fullname("Klebsiella pneumoniae")
#' mo_shortname("Klebsiella pneumoniae")
#'
#' # other properties ---------------------------------------------------------
#' mo_gramstain("E. coli") # "Gram-negative"
#' mo_snomed("E. coli") # 112283007, 116395006, ... (SNOMED codes)
#' mo_type("E. coli") # "Bacteria" (equal to kingdom, but may be translated)
#' mo_rank("E. coli") # "species"
#' mo_url("E. coli") # get the direct url to the online database entry
#' mo_synonyms("E. coli") # get previously accepted taxonomic names
#' mo_gramstain("Klebsiella pneumoniae")
#' mo_snomed("Klebsiella pneumoniae")
#' mo_type("Klebsiella pneumoniae")
#' mo_rank("Klebsiella pneumoniae")
#' mo_url("Klebsiella pneumoniae")
#' mo_synonyms("Klebsiella pneumoniae")
#'
#' # scientific reference -----------------------------------------------------
#' mo_ref("E. coli") # "Castellani et al., 1919"
#' mo_authors("E. coli") # "Castellani et al."
#' mo_year("E. coli") # 1919
#' mo_lpsn("E. coli") # 776057 (LPSN record ID)
#' mo_ref("Klebsiella pneumoniae")
#' mo_authors("Klebsiella pneumoniae")
#' mo_year("Klebsiella pneumoniae")
#' mo_lpsn("Klebsiella pneumoniae")
#'
#' # abbreviations known in the field -----------------------------------------
#' mo_genus("MRSA") # "Staphylococcus"
#' mo_species("MRSA") # "aureus"
#' mo_shortname("VISA") # "S. aureus"
#' mo_gramstain("VISA") # "Gram-positive"
#' mo_genus("MRSA")
#' mo_species("MRSA")
#' mo_shortname("VISA")
#' mo_gramstain("VISA")
#'
#' mo_genus("EHEC") # "Escherichia"
#' mo_species("EHEC") # "coli"
#' mo_genus("EHEC")
#' mo_species("EHEC")
#'
#' # known subspecies ---------------------------------------------------------
#' mo_name("doylei") # "Campylobacter jejuni doylei"
#' mo_genus("doylei") # "Campylobacter"
#' mo_species("doylei") # "jejuni"
#' mo_subspecies("doylei") # "doylei"
#' mo_name("doylei")
#' mo_genus("doylei")
#' mo_species("doylei")
#' mo_subspecies("doylei")
#'
#' mo_fullname("K. pneu rh") # "Klebsiella pneumoniae rhinoscleromatis"
#' mo_shortname("K. pneu rh") # "K. pneumoniae"
#' mo_fullname("K. pneu rh")
#' mo_shortname("K. pneu rh")
#'
#' \donttest{
#' # Becker classification, see ?as.mo ----------------------------------------
#' mo_fullname("S. epi") # "Staphylococcus epidermidis"
#' mo_fullname("S. epi", Becker = TRUE) # "Coagulase-negative Staphylococcus (CoNS)"
#' mo_shortname("S. epi") # "S. epidermidis"
#' mo_shortname("S. epi", Becker = TRUE) # "CoNS"
#' mo_fullname("S. epi")
#' mo_fullname("S. epi", Becker = TRUE)
#' mo_shortname("S. epi")
#' mo_shortname("S. epi", Becker = TRUE)
#'
#' # Lancefield classification, see ?as.mo ------------------------------------
#' mo_fullname("S. pyo") # "Streptococcus pyogenes"
#' mo_fullname("S. pyo", Lancefield = TRUE) # "Streptococcus group A"
#' mo_shortname("S. pyo") # "S. pyogenes"
#' mo_shortname("S. pyo", Lancefield = TRUE) # "GAS" (='Group A Streptococci')
#' mo_fullname("S. pyo")
#' mo_fullname("S. pyo", Lancefield = TRUE)
#' mo_shortname("S. pyo")
#' mo_shortname("S. pyo", Lancefield = TRUE)
#'
#'
#' # language support --------------------------------------------------------
#' mo_gramstain("E. coli", language = "de") # "Gramnegativ"
#' mo_gramstain("E. coli", language = "nl") # "Gram-negatief"
#' mo_gramstain("E. coli", language = "es") # "Gram negativo"
#' mo_gramstain("Klebsiella pneumoniae", language = "de")
#' mo_gramstain("Klebsiella pneumoniae", language = "nl")
#' mo_gramstain("Klebsiella pneumoniae", language = "es")
#'
#' # mo_type is equal to mo_kingdom, but mo_kingdom will remain official
#' mo_kingdom("E. coli") # "Bacteria" on a German system
#' mo_type("E. coli") # "Bakterien" on a German system
#' mo_type("E. coli") # "Bacteria" on an English system
#' mo_kingdom("Klebsiella pneumoniae")
#' mo_type("Klebsiella pneumoniae")
#' mo_type("Klebsiella pneumoniae")
#'
#' mo_fullname("S. pyogenes",
#' Lancefield = TRUE,
#' language = "de") # "Streptococcus Gruppe A"
#' language = "de")
#' mo_fullname("S. pyogenes",
#' Lancefield = TRUE,
#' language = "nl") # "Streptococcus groep A"
#' language = "nl")
#'
#'
#' # other --------------------------------------------------------------------
#'
#' mo_is_yeast(c("Candida", "E. coli")) # TRUE, FALSE
#' mo_is_yeast(c("Candida", "Trichophyton", "Klebsiella"))
#'
#' # gram stains and intrinsic resistance can also be used as a filter in dplyr verbs
#' \donttest{
#' # gram stains and intrinsic resistance can be used as a filter in dplyr verbs
#' if (require("dplyr")) {
#' example_isolates %>%
#' filter(mo_is_gram_positive())
@ -164,11 +161,11 @@
#'
#'
#' # get a list with the complete taxonomy (from kingdom to subspecies)
#' mo_taxonomy("E. coli")
#' mo_taxonomy("Klebsiella pneumoniae")
#'
#' # get a list with the taxonomy, the authors, Gram-stain,
#' # SNOMED codes, and URL to the online database
#' mo_info("E. coli")
#' }
#' # SNOMED codes, and URL to the online database
#' mo_info("Klebsiella pneumoniae")
#' }
mo_name <- function(x, language = get_AMR_locale(), ...) {
if (missing(x)) {

2
R/mo_source.R
View File

@ -28,7 +28,6 @@
#' @description These functions can be used to predefine your own reference to be used in [as.mo()] and consequently all [`mo_*`][mo_property()] functions (such as [mo_genus()] and [mo_gramstain()]).
#'
#' This is **the fastest way** to have your organisation (or analysis) specific codes picked up and translated by this package, since you don't have to bother about it again after setting it up once.
#' @inheritSection lifecycle Stable Lifecycle
#' @param path location of your reference file, this can be any text file (comma-, tab- or pipe-separated) or an Excel file (see *Details*). Can also be `""`, `NULL` or `FALSE` to delete the reference file.
#' @param destination destination of the compressed data file, default to the user's home directory.
#' @rdname mo_source
@ -121,7 +120,6 @@
#'
#' If the original file (in the previous case an Excel file) is moved or deleted, the `mo_source.rds` file will be removed upon the next use of [as.mo()] or any [`mo_*`][mo_property()] function.
#' @export
#' @inheritSection AMR Read more on Our Website!
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)

14
R/pca.R
View File

@ -26,7 +26,6 @@
#' Principal Component Analysis (for AMR)
#'
#' Performs a principal component analysis (PCA) based on a data set with automatic determination for afterwards plotting the groups and labels, and automatic filtering on only suitable (i.e. non-empty and numeric) variables.
#' @inheritSection lifecycle Stable Lifecycle
#' @param x a [data.frame] containing [numeric] columns
#' @param ... columns of `x` to be selected for PCA, can be unquoted since it supports quasiquotation.
#' @inheritParams stats::prcomp
@ -36,7 +35,6 @@
#' @return An object of classes [pca] and [prcomp]
#' @importFrom stats prcomp
#' @export
#' @inheritSection AMR Read more on Our Website!
#' @examples
#' # `example_isolates` is a data set available in the AMR package.
#' # See ?example_isolates.
@ -47,6 +45,7 @@
#' resistance_data <- example_isolates %>%
#' group_by(order = mo_order(mo), # group on anything, like order
#' genus = mo_genus(mo)) %>% # and genus as we do here;
#' filter(n() >= 30) %>% # filter on only 30 results per group
#' summarise_if(is.rsi, resistance) # then get resistance of all drugs
#'
#' # now conduct PCA for certain antimicrobial agents
@ -55,8 +54,17 @@
#'
#' pca_result
#' summary(pca_result)
#'
#' # old base R plotting method:
#' biplot(pca_result)
#' ggplot_pca(pca_result) # a new and convenient plot function
#' # new ggplot2 plotting method using this package:
#' ggplot_pca(pca_result)
#'
#' if (require("ggplot2")) {
#' ggplot_pca(pca_result) +
#' scale_colour_viridis_d() +
#' labs(title = "Title here")
#' }
#' }
#' }
pca <- function(x,

3
R/plot.R
View File

@ -26,8 +26,7 @@
#' Plotting for Classes `rsi`, `mic` and `disk`
#'
#' Functions to plot classes `rsi`, `mic` and `disk`, with support for base \R and `ggplot2`.
#' @inheritSection lifecycle Stable Lifecycle
#' @inheritSection AMR Read more on Our Website!
#' @param x,object values created with [as.mic()], [as.disk()] or [as.rsi()] (or their `random_*` variants, such as [random_mic()])
#' @param mo any (vector of) text that can be coerced to a valid microorganism code with [as.mo()]
#' @param ab any (vector of) text that can be coerced to a valid antimicrobial code with [as.ab()]

9
R/proportion.R
View File

@ -28,7 +28,6 @@
#' @description These functions can be used to calculate the (co-)resistance or susceptibility of microbial isolates (i.e. percentage of S, SI, I, IR or R). All functions support quasiquotation with pipes, can be used in `summarise()` from the `dplyr` package and also support grouped variables, see *Examples*.
#'
#' [resistance()] should be used to calculate resistance, [susceptibility()] should be used to calculate susceptibility.\cr
#' @inheritSection lifecycle Stable Lifecycle
#' @param ... one or more vectors (or columns) with antibiotic interpretations. They will be transformed internally with [as.rsi()] if needed. Use multiple columns to calculate (the lack of) co-resistance: the probability where one of two drugs have a resistant or susceptible result. See *Examples*.
#' @param minimum the minimum allowed number of available (tested) isolates. Any isolate count lower than `minimum` will return `NA` with a warning. The default number of `30` isolates is advised by the Clinical and Laboratory Standards Institute (CLSI) as best practice, see *Source*.
#' @param as_percent a [logical] to indicate whether the output must be returned as a hundred fold with % sign (a character). A value of `0.123456` will then be returned as `"12.3%"`.
@ -88,11 +87,11 @@
#' @aliases portion
#' @name proportion
#' @export
#' @inheritSection AMR Read more on Our Website!
#' @examples
#' # example_isolates is a data set available in the AMR package.
#' ?example_isolates
#' # run ?example_isolates for more info.
#'
#' # base R ------------------------------------------------------------
#' resistance(example_isolates$AMX) # determines %R
#' susceptibility(example_isolates$AMX) # determines %S+I
#'
@ -103,6 +102,7 @@
#' proportion_IR(example_isolates$AMX)
#' proportion_R(example_isolates$AMX)
#'
#' # dplyr -------------------------------------------------------------
#' \donttest{
#' if (require("dplyr")) {
#' example_isolates %>%
@ -157,10 +157,11 @@
#' proportion_df(translate = FALSE)
#'
#' # It also supports grouping variables
#' # (use rsi_df to also include the count)
#' example_isolates %>%
#' select(hospital_id, AMX, CIP) %>%
#' group_by(hospital_id) %>%
#' proportion_df(translate = FALSE)
#' rsi_df(translate = FALSE)
#' }
#' }
resistance <- function(...,

22
R/random.R
View File

@ -25,8 +25,7 @@
#' Random MIC Values/Disk Zones/RSI Generation
#'
#' These functions can be used for generating random MIC values and disk diffusion diameters, for AMR data analysis practice. By providing a microorganism and antimicrobial agent, the generated results will reflect reality as much as possible.
#' @inheritSection lifecycle Stable Lifecycle
#' These functions can be used for generating random MIC values and disk diffusion diameters, for AMR data analysis practice. By providing a microorganism and antimicrobial agent, the generated results will reflect reality as much as possible.
#' @param size desired size of the returned vector. If used in a [data.frame] call or `dplyr` verb, will get the current (group) size if left blank.
#' @param mo any [character] that can be coerced to a valid microorganism code with [as.mo()]
#' @param ab any [character] that can be coerced to a valid antimicrobial agent code with [as.ab()]
@ -39,21 +38,20 @@
#' @name random
#' @rdname random
#' @export
#' @inheritSection AMR Read more on Our Website!
#' @examples
#' random_mic(100)
#' random_disk(100)
#' random_rsi(100)
#' random_mic(25)
#' random_disk(25)
#' random_rsi(25)
#'
#' \donttest{
#' # make the random generation more realistic by setting a bug and/or drug:
#' random_mic(100, "Klebsiella pneumoniae") # range 0.0625-64
#' random_mic(100, "Klebsiella pneumoniae", "meropenem") # range 0.0625-16
#' random_mic(100, "Streptococcus pneumoniae", "meropenem") # range 0.0625-4
#' random_mic(25, "Klebsiella pneumoniae") # range 0.0625-64
#' random_mic(25, "Klebsiella pneumoniae", "meropenem") # range 0.0625-16
#' random_mic(25, "Streptococcus pneumoniae", "meropenem") # range 0.0625-4
#'
#' random_disk(100, "Klebsiella pneumoniae") # range 8-50
#' random_disk(100, "Klebsiella pneumoniae", "ampicillin") # range 11-17
#' random_disk(100, "Streptococcus pneumoniae", "ampicillin") # range 12-27
#' random_disk(25, "Klebsiella pneumoniae") # range 8-50
#' random_disk(25, "Klebsiella pneumoniae", "ampicillin") # range 11-17
#' random_disk(25, "Streptococcus pneumoniae", "ampicillin") # range 12-27
#' }
random_mic <- function(size = NULL, mo = NULL, ab = NULL, ...) {
meet_criteria(size, allow_class = c("numeric", "integer"), has_length = 1, is_positive = TRUE, is_finite = TRUE, allow_NULL = TRUE)

20
R/resistance_predict.R
View File

@ -26,7 +26,6 @@
#' Predict Antimicrobial Resistance
#'
#' Create a prediction model to predict antimicrobial resistance for the next years on statistical solid ground. Standard errors (SE) will be returned as columns `se_min` and `se_max`. See *Examples* for a real live example.
#' @inheritSection lifecycle Stable Lifecycle
#' @param object model data to be plotted
#' @param col_ab column name of `x` containing antimicrobial interpretations (`"R"`, `"I"` and `"S"`)
#' @param col_date column name of the date, will be used to calculate years if this column doesn't consist of years already, defaults to the first column of with a date class
@ -64,7 +63,6 @@
#' @rdname resistance_predict
#' @export
#' @importFrom stats predict glm lm
#' @inheritSection AMR Read more on Our Website!
#' @examples
#' x <- resistance_predict(example_isolates,
#' col_ab = "AMX",
@ -99,24 +97,8 @@
#' model = "binomial",
#' info = FALSE,
#' minimum = 15)
#'
#' head(data)
#' autoplot(data)
#'
#' ggplot(data,
#' aes(x = year)) +
#' geom_col(aes(y = value),
#' fill = "grey75") +
#' geom_errorbar(aes(ymin = se_min,
#' ymax = se_max),
#' colour = "grey50") +
#' scale_y_continuous(limits = c(0, 1),
#' breaks = seq(0, 1, 0.1),
#' labels = paste0(seq(0, 100, 10), "%")) +
#' labs(title = expression(paste("Forecast of Amoxicillin Resistance in ",
#' italic("E. coli"))),
#' y = "%R",
#' x = "Year") +
#' theme_minimal(base_size = 13)
#' }
#' }
resistance_predict <- function(x,

12
R/rsi.R
View File

@ -26,7 +26,6 @@
#' Interpret MIC and Disk Values, or Clean Raw R/SI Data
#'
#' Interpret minimum inhibitory concentration (MIC) values and disk diffusion diameters according to EUCAST or CLSI, or clean up existing R/SI values. This transforms the input to a new class [`rsi`], which is an ordered [factor] with levels `S < I < R`.
#' @inheritSection lifecycle Stable Lifecycle
#' @rdname as.rsi
#' @param x vector of values (for class [`mic`]: MIC values in mg/L, for class [`disk`]: a disk diffusion radius in millimetres)
#' @param mo any (vector of) text that can be coerced to valid microorganism codes with [as.mo()], can be left empty to determine it automatically
@ -98,15 +97,10 @@
#' @export
#' @seealso [as.mic()], [as.disk()], [as.mo()]
#' @inheritSection AMR Reference Data Publicly Available
#' @inheritSection AMR Read more on Our Website!
#' @examples
#' example_isolates
#' summary(example_isolates) # see all R/SI results at a glance
#' \donttest{
#' if (require("skimr")) {
#' # class <rsi> supported in skim() too:
#' skim(example_isolates)
#' }
#' }
#'
#' # For INTERPRETING disk diffusion and MIC values -----------------------
#'
#' # a whole data set, even with combined MIC values and disk zones
@ -796,7 +790,7 @@ exec_as.rsi <- function(method,
lookup_lancefield[i],
lookup_other[i]))
if (any(get_record$uti == TRUE, na.rm = TRUE) && message_not_thrown_before("as.rsi", "msg3", ab)) {
if (any(get_record$uti == TRUE, na.rm = TRUE) && !any(uti == TRUE, na.rm = TRUE) && message_not_thrown_before("as.rsi", "msg3", ab)) {
warning_("in `as.rsi()`: interpretation of ", font_bold(ab_name(ab, tolower = TRUE)), " is only available for (uncomplicated) urinary tract infections (UTI) for some microorganisms. Use argument `uti` to set which isolates are from urine. See ?as.rsi.")
rise_warning <- TRUE
}

4
R/skewness.R
View File

@ -28,13 +28,13 @@
#' @description Skewness is a measure of the asymmetry of the probability distribution of a real-valued random variable about its mean.
#'
#' When negative ('left-skewed'): the left tail is longer; the mass of the distribution is concentrated on the right of a histogram. When positive ('right-skewed'): the right tail is longer; the mass of the distribution is concentrated on the left of a histogram. A normal distribution has a skewness of 0.
#' @inheritSection lifecycle Stable Lifecycle
#' @param x a vector of values, a [matrix] or a [data.frame]
#' @param na.rm a [logical] value indicating whether `NA` values should be stripped before the computation proceeds
#' @seealso [kurtosis()]
#' @rdname skewness
#' @inheritSection AMR Read more on Our Website!
#' @export
#' @examples
#' skewness(runif(1000))
skewness <- function(x, na.rm = FALSE) {
meet_criteria(na.rm, allow_class = "logical", has_length = 1)
UseMethod("skewness")

4
R/translate.R
View File

@ -26,12 +26,11 @@
#' Translate Strings from the AMR Package
#'
#' For language-dependent output of AMR functions, like [mo_name()], [mo_gramstain()], [mo_type()] and [ab_name()].
#' @inheritSection lifecycle Stable Lifecycle
#' @param x text to translate
#' @param lang language to choose. Use one of these supported language names or ISO-639-1 codes: `r paste0('"', sapply(LANGUAGES_SUPPORTED_NAMES, function(x) x[[1]]), '" ("' , LANGUAGES_SUPPORTED, '")', collapse = ", ")`.
#' @details The currently `r length(LANGUAGES_SUPPORTED)` supported languages are `r vector_and(sapply(LANGUAGES_SUPPORTED_NAMES, function(x) x[[1]]), quotes = FALSE, sort = FALSE)`. All these languages have translations available for all antimicrobial agents and colloquial microorganism names.
#'
#' Please read about adding or updating a language in [our developer guideline](https://github.com/msberends/AMR/blob/main/developer-guideline.md).
#' Please read about adding or updating a language in [our Wiki](https://github.com/msberends/AMR/wiki/).
#'
#' ## Changing the Default Language
#' The system language will be used at default (as returned by `Sys.getenv("LANG")` or, if `LANG` is not set, [Sys.getlocale("LC_COLLATE")]), if that language is supported. But the language to be used can be overwritten in two ways and will be checked in this order:
@ -42,7 +41,6 @@
#' 2. Setting the system variable `LANGUAGE` or `LANG`, e.g. by adding `LANGUAGE="de_DE.utf8"` to your `.Renviron` file in your home directory.
#'
#' Thus, if the R option `AMR_locale` is set, the system variables `LANGUAGE` and `LANG` will be ignored.
#' @inheritSection AMR Read more on Our Website!
#' @rdname translate
#' @name translate
#' @export

14
R/vctrs.R
View File

@ -28,8 +28,9 @@
# They are to convert AMR-specific classes to bare characters and integers.
# All of them will be exported using s3_register() in R/zzz.R when loading the package.
# S3: ab_selector
# see https://github.com/tidyverse/dplyr/issues/5955 why this is required
# S3: ab_selector
vec_ptype2.character.ab_selector <- function(x, y, ...) {
x
}
@ -40,6 +41,17 @@ vec_cast.character.ab_selector <- function(x, to, ...) {
unclass(x)
}
# S3: ab_selector_any_all
vec_ptype2.logical.ab_selector_any_all <- function(x, y, ...) {
x
}
vec_ptype2.ab_selector_any_all.logical <- function(x, y, ...) {
y
}
vec_cast.logical.ab_selector_any_all <- function(x, to, ...) {
unclass(x)
}
# S3: ab
vec_ptype2.character.ab <- function(x, y, ...) {
x

2
R/whocc.R
View File

@ -35,7 +35,7 @@
#' The WHOCC is located in Oslo at the Norwegian Institute of Public Health and funded by the Norwegian government. The European Commission is the executive of the European Union and promotes its general interest.
#'
#' **NOTE: The WHOCC copyright does not allow use for commercial purposes, unlike any other info from this package.** See <https://www.whocc.no/copyright_disclaimer/.>
#' @inheritSection AMR Read more on Our Website!
#' @name WHOCC
#' @rdname WHOCC
#' @examples

8
R/zzz.R
View File

@ -87,6 +87,9 @@ if (utf8_supported && !is_latex) {
s3_register("vctrs::vec_ptype2", "ab_selector.character")
s3_register("vctrs::vec_ptype2", "character.ab_selector")
s3_register("vctrs::vec_cast", "character.ab_selector")
s3_register("vctrs::vec_ptype2", "ab_selector_any_all.logical")
s3_register("vctrs::vec_ptype2", "logical.ab_selector_any_all")
s3_register("vctrs::vec_cast", "logical.ab_selector_any_all")
s3_register("vctrs::vec_ptype2", "disk.integer")
s3_register("vctrs::vec_ptype2", "integer.disk")
s3_register("vctrs::vec_cast", "integer.disk")
@ -106,11 +109,6 @@ if (utf8_supported && !is_latex) {
assign(x = "MO.old_lookup", value = create_MO.old_lookup(), envir = asNamespace("AMR"))
# for mo_is_intrinsic_resistant() - saves a lot of time when executed on this vector
assign(x = "INTRINSIC_R", value = create_intr_resistance(), envir = asNamespace("AMR"))
# for building the website, only print first 5 rows of a data set
# if (Sys.getenv("IN_PKGDOWN") != "" && !interactive()) {
# ...
# }
}
# Helper functions --------------------------------------------------------