P281424
/
AMR
mirror of https://github.com/msberends/AMR
1
0
Fork 0
Code Releases Activity

(v1.3.0.9035) mdro() for EUCAST 3.2, examples cleanup

pull/67/head
dr. M.S. (Matthijs) Berends 2020-09-29 23:35:46 +02:00
parent 68e6e1e329
commit 4e0374af29
94 changed files with 1143 additions and 1165 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.github/workflows/codecovr.yaml vendored
View File

@ -63,5 +63,5 @@ jobs:
shell: Rscript {0}
- name: Test coverage
run: covr::codecov(line_exclusions = list("R/atc_online.R", "R/mo_source.R", "R/resistance_predict.R", "R/aa_helper_pm_functions.R", "R/zzz.R"), quiet = FALSE)
run: covr::codecov(line_exclusions = list("R/atc_online.R", "R/mo_source.R", "R/resistance_predict.R", "R/aa_helper_functions.R", "R/aa_helper_pm_functions.R", "R/zzz.R"), quiet = FALSE)
shell: Rscript {0}

2
DESCRIPTION
View File

@ -1,5 +1,5 @@
Package: AMR
Version: 1.3.0.9034
Version: 1.3.0.9035
Date: 2020-09-29
Title: Antimicrobial Resistance Analysis
Authors@R: c(

6
NAMESPACE
View File

@ -193,12 +193,6 @@ export(n_rsi)
export(p_symbol)
export(pca)
export(penicillins)
export(portion_I)
export(portion_IR)
export(portion_R)
export(portion_S)
export(portion_SI)
export(portion_df)
export(proportion_I)
export(proportion_IR)
export(proportion_R)

7
NEWS.md
View File

@ -1,10 +1,13 @@
# AMR 1.3.0.9034
# AMR 1.3.0.9035
## <small>Last updated: 29 September 2020</small>
Note: some changes in this version were suggested by anonymous reviewers from the journal we submitted our manuscipt to. We are those reviewers very grateful for going through our code so thoroughly!
### Breaking
* Removed functions `portion_R()`, `portion_S()` and `portion_I()` that were deprecated since version 0.9.0 (November 2019) and were replaced with `proportion_R()`, `proportion_S()` and `proportion_I()`.
### New
* Support for 'EUCAST Expert Rules' / 'EUCAST Intrinsic Resistance and Unusual Phenotypes' version 3.2 of May 2020. With this addition to the previously implemented version 3.1 of 2016, the `eucast_rules()` function can now correct for more than 180 different antibiotics. All previously implemented versions of the EUCAST rules are now maintained and kept available in this package. The `eucast_rules()` function consequently gained the parameters `version_breakpoints` (at the moment defaults to v10.0, 2020) and `version_expertrules` (at the moment defaults to v3.2, 2020). The `example_isolates` data set now also reflects the change from v3.1 to v3.2.
* Support for 'EUCAST Expert Rules' / 'EUCAST Intrinsic Resistance and Unusual Phenotypes' version 3.2 of May 2020. With this addition to the previously implemented version 3.1 of 2016, the `eucast_rules()` function can now correct for more than 180 different antibiotics and the `mdro()` function can determine multidrug resistance based on more than 150 different antibiotics. All previously implemented versions of the EUCAST rules are now maintained and kept available in this package. The `eucast_rules()` function consequently gained the parameters `version_breakpoints` (at the moment defaults to v10.0, 2020) and `version_expertrules` (at the moment defaults to v3.2, 2020). The `example_isolates` data set now also reflects the change from v3.1 to v3.2. The `mdro()` function now accepts `guideline == "EUCAST3.1"` and `guideline == "EUCAST3.2"`.
* A new vignette and website page with info about all our public and freely available data sets, that can be downloaded as flat files or in formats for use in R, SPSS, SAS, Stata and Excel: https://msberends.github.io/AMR/articles/datasets.html
* Data set `intrinsic_resistant`. This data set contains all bug-drug combinations where the 'bug' is intrinsic resistant to the 'drug' according to the latest EUCAST insights. It contains just two columns: `microorganism` and `antibiotic`.

7
R/ab_class_selectors.R
View File

@ -33,8 +33,7 @@
#' @inheritSection AMR Reference data publicly available
#' @inheritSection AMR Read more on our website!
#' @examples
#' \dontrun{
#' library(dplyr)
#' if (require("dplyr")) {
#'
#' # this will select columns 'IPM' (imipenem) and 'MEM' (meropenem):
#' example_isolates %>%
@ -57,9 +56,9 @@
#' format()
#'
#'
#' data.frame(irrelevant = "value",
#' data.frame(some_column = "some_value",
#' J01CA01 = "S") %>% # ATC code of ampicillin
#' select(penicillins()) # the 'J01CA01' column will be selected
#' select(penicillins()) # only the 'J01CA01' column will be selected
#'
#' }
ab_class <- function(ab_class) {

2
R/age.R
View File

@ -127,7 +127,7 @@ age <- function(x, reference = Sys.Date(), exact = FALSE, na.rm = FALSE) {
#' # same:
#' age_groups(ages, c(1, 2, 4, 6, 13, 17))
#'
#' \dontrun{
#' \donttest{
#' # resistance of ciprofloxacine per age group
#' library(dplyr)
#' example_isolates %>%

7
R/atc_online.R
View File

@ -60,17 +60,14 @@
#' @inheritSection AMR Read more on our website!
#' @source <https://www.whocc.no/atc_ddd_alterations__cumulative/ddd_alterations/abbrevations/>
#' @examples
#' \dontrun{
#' \donttest{
#' # oral DDD (Defined Daily Dose) of amoxicillin
#' atc_online_property("J01CA04", "DDD", "O")
#'
#' # parenteral DDD (Defined Daily Dose) of amoxicillin
#' atc_online_property("J01CA04", "DDD", "P")
#'
#' atc_online_property("J01CA04", property = "groups") # search hierarchical groups of amoxicillin
#' # [1] "ANTIINFECTIVES FOR SYSTEMIC USE"
#' # [2] "ANTIBACTERIALS FOR SYSTEMIC USE"
#' # [3] "BETA-LACTAM ANTIBACTERIALS, PENICILLINS"
#' # [4] "Penicillins with extended spectrum"
#' }
atc_online_property <- function(atc_code,
property,

17
R/availability.R
View File

@ -32,18 +32,11 @@
#' @examples
#' availability(example_isolates)
#'
#' \dontrun{
#' library(dplyr)
#' example_isolates %>% availability()
#'
#' example_isolates %>%
#' select_if(is.rsi) %>%
#' availability()
#'
#' example_isolates %>%
#' filter(mo == as.mo("E. coli")) %>%
#' select_if(is.rsi) %>%
#' availability()
#' if (require("dplyr")) {
#' example_isolates %>%
#' filter(mo == as.mo("E. coli")) %>%
#' select_if(is.rsi) %>%
#' availability()
#' }
availability <- function(tbl, width = NULL) {
stop_ifnot(is.data.frame(tbl), "`tbl` must be a data.frame")

28
R/bug_drug_combinations.R
View File

@ -26,7 +26,7 @@
#' @inheritParams eucast_rules
#' @param combine_IR logical to indicate whether values R and I should be summed
#' @param add_ab_group logical to indicate where the group of the antimicrobials must be included as a first column
#' @param remove_intrinsic_resistant logical to indicate that rows with 100% resistance for all tested antimicrobials must be removed from the table
#' @param remove_intrinsic_resistant logical to indicate that rows and columns with 100% resistance for all tested antimicrobials must be removed from the table
#' @param FUN the function to call on the `mo` column to transform the microorganism IDs, defaults to [mo_shortname()]
#' @param translate_ab a character of length 1 containing column names of the [antibiotics] data set
#' @param ... arguments passed on to `FUN`
@ -45,13 +45,13 @@
#' format(x, translate_ab = "name (atc)")
#'
#' # Use FUN to change to transformation of microorganism codes
#' x <- bug_drug_combinations(example_isolates,
#' FUN = mo_gramstain)
#' bug_drug_combinations(example_isolates,
#' FUN = mo_gramstain)
#'
#' x <- bug_drug_combinations(example_isolates,
#' FUN = function(x) ifelse(x == as.mo("E. coli"),
#' "E. coli",
#' "Others"))
#' bug_drug_combinations(example_isolates,
#' FUN = function(x) ifelse(x == as.mo("E. coli"),
#' "E. coli",
#' "Others"))
#' }
bug_drug_combinations <- function(x,
col_mo = NULL,
@ -183,13 +183,12 @@ format.bug_drug_combinations <- function(x,
y <- y %pm>%
pm_left_join(mo_group, by = "ab")
}
y <<- y
y <- y %pm>%
pm_distinct(ab, .keep_all = TRUE) %pm>%
pm_select(-mo, -txt) %pm>%
# replace tidyr::pivot_wider() until here
remove_NAs()
select_ab_vars <- function(.data) {
.data[, c("ab_group", "ab_txt", colnames(.data)[!colnames(.data) %in% c("ab_group", "ab_txt", "ab")])]
}
@ -205,12 +204,19 @@ format.bug_drug_combinations <- function(x,
y <- y %pm>%
pm_select(-ab_group) %pm>%
pm_rename("Drug" = ab_txt)
colnames(y)[1] <- translate_AMR(colnames(y)[1], language = get_locale(), only_unknown = FALSE)
colnames(y)[1] <- translate_AMR(colnames(y)[1], language, only_unknown = FALSE)
} else {
y <- y %pm>%
pm_rename("Group" = ab_group,
"Drug" = ab_txt)
colnames(y)[1:2] <- translate_AMR(colnames(y)[1:2], language = get_locale(), only_unknown = FALSE)
}
if (!is.null(language)) {
colnames(y) <- translate_AMR(colnames(y), language, only_unknown = FALSE)
}
if (remove_intrinsic_resistant == TRUE) {
y <- y[, !sapply(y, function(col) all(col %like% "100", na.rm = TRUE) & !any(is.na(col))), drop = FALSE]
}
rownames(y) <- NULL

42
R/deprecated.R
View File

@ -24,46 +24,6 @@
#' 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!
#' @export
#' @keywords internal
#' @name AMR-deprecated
#' @export
portion_R <- function(...) {
.Deprecated("resistance()", package = "AMR")
proportion_R(...)
}
#' @rdname AMR-deprecated
#' @export
portion_IR <- function(...) {
.Deprecated("proportion_IR()", package = "AMR")
proportion_IR(...)
}
#' @rdname AMR-deprecated
#' @export
portion_I <- function(...) {
.Deprecated("proportion_I()", package = "AMR")
proportion_I(...)
}
#' @rdname AMR-deprecated
#' @export
portion_SI <- function(...) {
.Deprecated("susceptibility()", package = "AMR")
proportion_SI(...)
}
#' @rdname AMR-deprecated
#' @export
portion_S <- function(...) {
.Deprecated("proportion_S()", package = "AMR")
proportion_S(...)
}
#' @rdname AMR-deprecated
#' @export
portion_df <- function(...) {
.Deprecated("proportion_df()", package = "AMR")
proportion_df(...)
}
# @export

7
R/disk.R
View File

@ -33,7 +33,7 @@
#' @seealso [as.rsi()]
#' @inheritSection AMR Read more on our website!
#' @examples
#' \dontrun{
#' \donttest{
#' # transform existing disk zones to the `disk` class
#' library(dplyr)
#' df <- data.frame(microorganism = "E. coli",
@ -41,8 +41,9 @@
#' CIP = 14,
#' GEN = 18,
#' TOB = 16)
#' df <- df %>% mutate_at(vars(AMP:TOB), as.disk)
#' df
#' df[, 2:5] <- lapply(df[, 2:5], as.disk)
#' # same with dplyr:
#' # df %>% mutate(across(AMP:TOB, as.disk))
#'
#' # interpret disk values, see ?as.rsi
#' as.rsi(x = as.disk(18),

19
R/eucast_rules.R
View File

@ -67,23 +67,18 @@ EUCAST_VERSION_EXPERT_RULES <- list("3.1" = list(version_txt = "v3.1",
#'
#' The following antibiotics are used for the functions [eucast_rules()] and [mdro()]. These are shown below in the format 'name (`antimicrobial ID`, [ATC code](https://www.whocc.no/atc/structure_and_principles/))', sorted alphabetically:
#'
#' `r create_ab_documentation(c("AMC", "AMK", "AMP", "AMX", "ATM", "AVO", "AZL", "AZM", "BAM", "BPR", "CAC", "CAP", "CAT", "CAZ", "CCV", "CDR", "CDZ", "CEC", "CED", "CEI", "CEP", "CFM", "CFM1", "CFP", "CFR", "CFS", "CHL", "CID", "CIP", "CLI", "CLR", "CMX", "CMZ", "CND", "COL", "CPD", "CPM", "CPO", "CPR", "CPT", "CRB", "CRD", "CRN", "CRO", "CSL", "CTB", "CTF", "CTL", "CTT", "CTX", "CTZ", "CXM", "CYC", "CZD", "CZO", "CZX", "DAL", "DAP", "DIR", "DIT", "DIZ", "DKB", "DOR", "DOX", "ENX", "EPC", "ERY", "ETH", "ETP", "FEP", "FLC", "FLE", "FLR1", "FOS", "FOX", "FOX1", "FUS", "GAT", "GEH", "GEM", "GEN", "GRX", "HAP", "HET", "INH", "IPM", "ISE", "JOS", "KAN", "LEX", "LIN", "LNZ", "LOM", "LOR", "LTM", "LVX", "MAN", "MCM", "MEC", "MEM", "MEV", "MEZ", "MFX", "MID", "MNO", "MTM", "NAL", "NEO", "NET", "NIT", "NOR", "NOV", "NVA", "OFX", "OLE", "ORI", "OXA", "PAZ", "PEF", "PEN", "PHN", "PIP", "PLB", "PME", "PRI", "PRL", "PRU", "PVM", "PZA", "QDA", "RAM", "RFL", "RFP", "RIB", "RID", "RIF", "ROK", "RST", "RXT", "SAM", "SBC", "SDI", "SDM", "SIS", "SLF", "SLF1", "SLF10", "SLF11", "SLF12", "SLF13", "SLF2", "SLF3", "SLF4", "SLF5", "SLF6", "SLF7", "SLF8", "SLF9", "SLT1", "SLT2", "SLT3", "SLT4", "SLT5", "SMX", "SPI", "SPX", "STH", "STR", "STR1", "SUD", "SUT", "SXT", "SZO", "TAL", "TCC", "TCM", "TCY", "TEC", "TEM", "TGC", "THA", "TIC", "TLT", "TLV", "TMP", "TMX", "TOB", "TRL", "TVA", "TZD", "TZP", "VAN"))`
#' `r create_ab_documentation(c("AMC", "AMK", "AMP", "AMX", "ATM", "AVO", "AZL", "AZM", "BAM", "BPR", "CAC", "CAP", "CAT", "CAZ", "CCV", "CDR", "CDZ", "CEC", "CED", "CEI", "CEP", "CFM", "CFM1", "CFP", "CFR", "CFS", "CHL", "CID", "CIP", "CLI", "CLR", "CMX", "CMZ", "CND", "COL", "CPD", "CPM", "CPO", "CPR", "CPT", "CRB", "CRD", "CRN", "CRO", "CSL", "CTB", "CTF", "CTL", "CTT", "CTX", "CTZ", "CXM", "CYC", "CZD", "CZO", "CZX", "DAL", "DAP", "DIR", "DIT", "DIZ", "DKB", "DOR", "DOX", "ENX", "EPC", "ERV", "ERY", "ETH", "ETP", "FDX", "FEP", "FLC", "FLE", "FLR1", "FOS", "FOX", "FOX1", "FUS", "GAT", "GEH", "GEM", "GEN", "GRX", "HAP", "HET", "INH", "IPM", "ISE", "JOS", "KAN", "LEX", "LIN", "LNZ", "LOM", "LOR", "LTM", "LVX", "MAN", "MCM", "MEC", "MEM", "MEV", "MEZ", "MFX", "MID", "MNO", "MTM", "MTR", "NAL", "NEO", "NET", "NIT", "NOR", "NOV", "NVA", "OFX", "OLE", "OMC", "ORI", "OXA", "PAZ", "PEF", "PEN", "PHN", "PIP", "PLB", "PME", "PRI", "PRL", "PRU", "PVM", "PZA", "QDA", "RAM", "RFL", "RFP", "RIB", "RID", "RIF", "ROK", "RST", "RXT", "SAM", "SBC", "SDI", "SDM", "SIS", "SLF", "SLF1", "SLF10", "SLF11", "SLF12", "SLF13", "SLF2", "SLF3", "SLF4", "SLF5", "SLF6", "SLF7", "SLF8", "SLF9", "SLT1", "SLT2", "SLT3", "SLT4", "SLT5", "SMX", "SPI", "SPT", "SPX", "STH", "STR", "STR1", "SUD", "SUT", "SXT", "SZO", "TAL", "TCC", "TCM", "TCY", "TEC", "TEM", "TGC", "THA", "TIC", "TLT", "TLV", "TMP", "TMX", "TOB", "TRL", "TVA", "TZD", "TZP", "VAN"))`
#' @aliases EUCAST
#' @rdname eucast_rules
#' @export
#' @return The input of `x`, possibly with edited values of antibiotics. Or, if `verbose = TRUE`, a [data.frame] with all original and new values of the affected bug-drug combinations.
#' @source
#' - EUCAST Expert Rules. Version 2.0, 2012. \cr
#' Leclercq et al. **EUCAST expert rules in antimicrobial susceptibility testing.** *Clin Microbiol Infect.* 2013;19(2):141-60. \cr
#' <https://doi.org/10.1111/j.1469-0691.2011.03703.x>
#' - EUCAST Expert Rules, Intrinsic Resistance and Exceptional Phenotypes Tables. Version 3.1, 2016. \cr
#' <https://www.eucast.org/fileadmin/src/media/PDFs/EUCAST_files/Expert_Rules/Expert_rules_intrinsic_exceptional_V3.1.pdf>
#' - EUCAST Intrinsic Resistance and Unusual Phenotypes. Version 3.2, 2020. \cr
#' <https://www.eucast.org/fileadmin/src/media/PDFs/EUCAST_files/Expert_Rules/2020/Intrinsic_Resistance_and_Unusual_Phenotypes_Tables_v3.2_20200225.pdf>
#' - EUCAST Breakpoint tables for interpretation of MICs and zone diameters. Version 9.0, 2019. \cr
#' <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. \cr
#' <https://www.eucast.org/fileadmin/src/media/PDFs/EUCAST_files/Breakpoint_tables/v_10.0_Breakpoint_Tables.xlsx>
#' - EUCAST Expert Rules. Version 2.0, 2012.\cr
#' Leclercq et al. **EUCAST expert rules in antimicrobial susceptibility testing.** *Clin Microbiol Infect.* 2013;19(2):141-60. [(link)](https://doi.org/10.1111/j.1469-0691.2011.03703.x)
#' - EUCAST Expert Rules, Intrinsic Resistance and Exceptional Phenotypes Tables. Version 3.1, 2016. [(link)](https://www.eucast.org/fileadmin/src/media/PDFs/EUCAST_files/Expert_Rules/Expert_rules_intrinsic_exceptional_V3.1.pdf)
#' - EUCAST Intrinsic Resistance and Unusual Phenotypes. Version 3.2, 2020. [(link)](https://www.eucast.org/fileadmin/src/media/PDFs/EUCAST_files/Expert_Rules/2020/Intrinsic_Resistance_and_Unusual_Phenotypes_Tables_v3.2_20200225.pdf)
#' - 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)
#' @inheritSection AMR Reference data publicly available
#' @inheritSection AMR Read more on our website!
#' @examples

69
R/filter_ab_class.R
View File

@ -33,40 +33,43 @@
#' @seealso [antibiotic_class_selectors()] for the `select()` equivalent.
#' @export
#' @examples
#' \dontrun{
#' library(dplyr)
#'
#' # filter on isolates that have any result for any aminoglycoside
#' example_isolates %>% filter_ab_class("aminoglycoside")
#' example_isolates %>% filter_aminoglycosides()
#'
#' # this is essentially the same as (but without determination of column names):
#' example_isolates %>%
#' filter_at(.vars = vars(c("GEN", "TOB", "AMK", "KAN")),
#' .vars_predicate = any_vars(. %in% c("S", "I", "R")))
#'
#'
#' # filter on isolates that show resistance to ANY aminoglycoside
#' example_isolates %>% filter_aminoglycosides("R", "any")
#'
#' # filter on isolates that show resistance to ALL aminoglycosides
#' example_isolates %>% filter_aminoglycosides("R", "all")
#'
#' # filter on isolates that show resistance to
#' # any aminoglycoside and any fluoroquinolone
#' example_isolates %>%
#' filter_aminoglycosides("R") %>%
#' filter_fluoroquinolones("R")
#'
#' # filter on isolates that show resistance to
#' # all aminoglycosides and all fluoroquinolones
#' example_isolates %>%
#' filter_aminoglycosides("R", "all") %>%
#' filter_fluoroquinolones("R", "all")
#' filter_aminoglycosides(example_isolates)
#'
#' # with dplyr 1.0.0 and higher (that adds 'across()'), this is equal:
#' example_isolates %>% filter_carbapenems("R", "all")
#' example_isolates %>% filter(across(carbapenems(), ~. == "R"))
#' \donttest{
#' if (require("dplyr")) {
#'
#' # filter on isolates that have any result for any aminoglycoside
#' example_isolates %>% filter_aminoglycosides()
#' example_isolates %>% filter_ab_class("aminoglycoside")
#'
#' # this is essentially the same as (but without determination of column names):
#' example_isolates %>%
#' filter_at(.vars = vars(c("GEN", "TOB", "AMK", "KAN")),
#' .vars_predicate = any_vars(. %in% c("S", "I", "R")))
#'
#'
#' # filter on isolates that show resistance to ANY aminoglycoside
#' example_isolates %>% filter_aminoglycosides("R", "any")
#'
#' # filter on isolates that show resistance to ALL aminoglycosides
#' example_isolates %>% filter_aminoglycosides("R", "all")
#'
#' # filter on isolates that show resistance to
#' # any aminoglycoside and any fluoroquinolone
#' example_isolates %>%
#' filter_aminoglycosides("R") %>%
#' filter_fluoroquinolones("R")
#'
#' # filter on isolates that show resistance to
#' # all aminoglycosides and all fluoroquinolones
#' example_isolates %>%
#' filter_aminoglycosides("R", "all") %>%
#' filter_fluoroquinolones("R", "all")
#'
#' # with dplyr 1.0.0 and higher (that adds 'across()'), this is equal:
#' example_isolates %>% filter_carbapenems("R", "all")
#' example_isolates %>% filter(across(carbapenems(), ~. == "R"))
#' }
#' }
filter_ab_class <- function(x,
ab_class,

90
R/first_isolate.R
View File

@ -46,18 +46,19 @@
#'
#' All isolates with a microbial ID of `NA` will be excluded as first isolate.
#'
#' The functions [filter_first_isolate()] and [filter_first_weighted_isolate()] are helper functions to quickly filter on first isolates. The function [filter_first_isolate()] is essentially equal to one of:
#' The functions [filter_first_isolate()] and [filter_first_weighted_isolate()] are helper functions to quickly filter on first isolates. The function [filter_first_isolate()] is essentially equal to either:
#' ```
#' x %>% filter(first_isolate(., ...))
#' x[first_isolate(x, ...), ]
#' x %>% filter(first_isolate(x, ...))
#' ```
#' The function [filter_first_weighted_isolate()] is essentially equal to:
#' ```
#' x %>%
#' mutate(keyab = key_antibiotics(.)) %>%
#' mutate(only_weighted_firsts = first_isolate(x,
#' col_keyantibiotics = "keyab", ...)) %>%
#' filter(only_weighted_firsts == TRUE) %>%
#' select(-only_weighted_firsts, -keyab)
#' x %>%
#' mutate(keyab = key_antibiotics(.)) %>%
#' mutate(only_weighted_firsts = first_isolate(x,
#' col_keyantibiotics = "keyab", ...)) %>%
#' filter(only_weighted_firsts == TRUE) %>%
#' select(-only_weighted_firsts, -keyab)
#' ```
#' @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:
@ -80,50 +81,41 @@
#' @examples
#' # `example_isolates` is a dataset available in the AMR package.
#' # See ?example_isolates.
#'
#' \dontrun{
#' library(dplyr)
#' # Filter on first isolates:
#' example_isolates %>%
#' mutate(first_isolate = first_isolate(.)) %>%
#' filter(first_isolate == TRUE)
#'
#' # Now let's see if first isolates matter:
#' A <- example_isolates %>%
#' group_by(hospital_id) %>%
#' summarise(count = n_rsi(GEN), # gentamicin availability
#' resistance = resistance(GEN)) # gentamicin resistance
#'
#' B <- example_isolates %>%
#' filter_first_weighted_isolate() %>% # the 1st isolate filter
#' group_by(hospital_id) %>%
#' summarise(count = n_rsi(GEN), # gentamicin availability
#' resistance = resistance(GEN)) # gentamicin resistance
#'
#' # Have a look at A and B.
#' # B is more reliable because every isolate is counted only once.
#' # Gentamicin resistance in hospital D appears to be 3.7% higher than
#' # when you (erroneously) would have used all isolates for analysis.
#'
#'
#' ## OTHER EXAMPLES:
#' # basic filtering on first isolates
#' example_isolates[first_isolate(example_isolates), ]
#'
#' # Short-hand versions:
#' example_isolates %>%
#' filter_first_isolate()
#' \donttest{
#' if (require("dplyr")) {
#' # Filter on first isolates:
#' example_isolates %>%
#' mutate(first_isolate = first_isolate(.)) %>%
#' filter(first_isolate == TRUE)
#'
#' # Short-hand versions:
#' example_isolates %>%
#' filter_first_isolate()
#'
#' example_isolates %>%
#' filter_first_weighted_isolate()
#'
#' example_isolates %>%
#' filter_first_weighted_isolate()
#'
#'
#' # set key antibiotics to a new variable
#' x$keyab <- key_antibiotics(x)
#'
#' x$first_isolate <- first_isolate(x)
#'
#' x$first_isolate_weighed <- first_isolate(x, col_keyantibiotics = 'keyab')
#'
#' x$first_blood_isolate <- first_isolate(x, specimen_group = "Blood")
#' # Now let's see if first isolates matter:
#' A <- example_isolates %>%
#' group_by(hospital_id) %>%
#' summarise(count = n_rsi(GEN), # gentamicin availability
#' resistance = resistance(GEN)) # gentamicin resistance
#'
#' B <- example_isolates %>%
#' filter_first_weighted_isolate() %>% # the 1st isolate filter
#' group_by(hospital_id) %>%
#' summarise(count = n_rsi(GEN), # gentamicin availability
#' resistance = resistance(GEN)) # gentamicin resistance
#'
#' # Have a look at A and B.
#' # B is more reliable because every isolate is counted only once.
#' # Gentamicin resistance in hospital D appears to be 3.7% higher than
#' # when you (erroneously) would have used all isolates for analysis.
#' }
#' }
first_isolate <- function(x,
col_date = NULL,

3
R/ggplot_pca.R
View File

@ -60,8 +60,7 @@
#' # See ?example_isolates.
#'
#' # See ?pca for more info about Principal Component Analysis (PCA).
#' \dontrun{
#' library(dplyr)
#' if (require("dplyr")) {
#' pca_model <- example_isolates %>%
#' filter(mo_genus(mo) == "Staphylococcus") %>%
#' group_by(species = mo_shortname(mo)) %>%

7
R/ggplot_rsi.R
View File

@ -102,14 +102,14 @@
#'
#' }
#'
#' \dontrun{
#' \donttest{
#'
#' # resistance of ciprofloxacine per age group
#' example_isolates %>%
#' mutate(first_isolate = first_isolate(.)) %>%
#' filter(first_isolate == TRUE,
#' mo == as.mo("E. coli")) %>%
#' # `age_group` is also a function of this package:
#' # `age_groups` is also a function of this AMR package:
#' group_by(age_group = age_groups(age)) %>%
#' select(age_group,
#' CIP) %>%
@ -118,7 +118,8 @@
#' # for colourblind mode, use divergent colours from the viridis package:
#' example_isolates %>%
#' select(AMX, NIT, FOS, TMP, CIP) %>%
#' ggplot_rsi() + scale_fill_viridis_d()
#' ggplot_rsi() +
#' scale_fill_viridis_d()
#' # a shorter version which also adjusts data label colours:
#' example_isolates %>%
#' select(AMX, NIT, FOS, TMP, CIP) %>%

29
R/join_microorganisms.R
View File

@ -39,19 +39,22 @@
#' left_join_microorganisms(as.mo("K. pneumoniae"))
#' left_join_microorganisms("B_KLBSL_PNE")
#'
#' \dontrun{
#' library(dplyr)
#' example_isolates %>% left_join_microorganisms()
#'
#' df <- data.frame(date = seq(from = as.Date("2018-01-01"),
#' to = as.Date("2018-01-07"),
#' by = 1),
#' bacteria = as.mo(c("S. aureus", "MRSA", "MSSA", "STAAUR",
#' "E. coli", "E. coli", "E. coli")),
#' stringsAsFactors = FALSE)
#' colnames(df)
#' df_joined <- left_join_microorganisms(df, "bacteria")
#' colnames(df_joined)
#' \donttest{
#' if (require("dplyr")) {
#' example_isolates %>%
#' left_join_microorganisms() %>%
#' colnames()
#'
#' df <- data.frame(date = seq(from = as.Date("2018-01-01"),
#' to = as.Date("2018-01-07"),
#' by = 1),
#' bacteria = as.mo(c("S. aureus", "MRSA", "MSSA", "STAAUR",
#' "E. coli", "E. coli", "E. coli")),
#' stringsAsFactors = FALSE)
#' colnames(df)
#' df_joined <- left_join_microorganisms(df, "bacteria")
#' colnames(df_joined)
#' }
#' }
inner_join_microorganisms <- function(x, by = NULL, suffix = c("2", ""), ...) {
check_dataset_integrity()

38
R/key_antibiotics.R
View File

@ -72,33 +72,35 @@
#' @examples
#' # `example_isolates` is a dataset available in the AMR package.
#' # See ?example_isolates.
#'
#' \dontrun{
#' library(dplyr)
#' # set key antibiotics to a new variable
#' my_patients <- example_isolates %>%
#' mutate(keyab = key_antibiotics(.)) %>%
#' mutate(
#' # now calculate first isolates
#' first_regular = first_isolate(., col_keyantibiotics = FALSE),
#' # and first WEIGHTED isolates
#' first_weighted = first_isolate(., col_keyantibiotics = "keyab")
#' )
#'
#' # Check the difference, in this data set it results in 7% more isolates:
#' sum(my_patients$first_regular, na.rm = TRUE)
#' sum(my_patients$first_weighted, na.rm = TRUE)
#' }
#'
#'
#' # output of the `key_antibiotics` function could be like this:
#' strainA <- "SSSRR.S.R..S"
#' strainB <- "SSSIRSSSRSSS"
#'
#' # can those strings can be compared with:
#' key_antibiotics_equal(strainA, strainB)
#' # TRUE, because I is ignored (as well as missing values)
#'
#' key_antibiotics_equal(strainA, strainB, ignore_I = FALSE)
#' # FALSE, because I is not ignored and so the 4th value differs
#'
#' \donttest{
#' if (require("dplyr")) {
#' # set key antibiotics to a new variable
#' my_patients <- example_isolates %>%
#' mutate(keyab = key_antibiotics(.)) %>%
#' mutate(
#' # now calculate first isolates
#' first_regular = first_isolate(., col_keyantibiotics = FALSE),
#' # and first WEIGHTED isolates
#' first_weighted = first_isolate(., col_keyantibiotics = "keyab")
#' )
#'
#' # Check the difference, in this data set it results in 7% more isolates:
#' sum(my_patients$first_regular, na.rm = TRUE)
#' sum(my_patients$first_weighted, na.rm = TRUE)
#' }
#' }
key_antibiotics <- function(x,
col_mo = NULL,
universal_1 = guess_ab_col(x, "amoxicillin"),

9
R/like.R
View File

@ -57,10 +57,11 @@
#' #> TRUE TRUE TRUE
#'
#' # get isolates whose name start with 'Ent' or 'ent'
#' \dontrun{
#' library(dplyr)
#' example_isolates %>%
#' filter(mo_name(mo) %like% "^ent")
#' \donttest{
#' if (require("dplyr")) {
#' example_isolates %>%
#' filter(mo_name(mo) %like% "^ent")
#' }
#' }
like <- function(x, pattern, ignore.case = TRUE) {
# set to fixed if no regex found

284
R/mdro.R
View File

@ -27,7 +27,7 @@
#' @param info a logical to indicate whether progress should be printed to the console
#' @inheritParams eucast_rules
#' @param pct_required_classes minimal required percentage of antimicrobial classes that must be available per isolate, rounded down. For example, with the default guideline, 17 antimicrobial classes must be available for *S. aureus*. Setting this `pct_required_classes` argument to `0.5` (default) means that for every *S. aureus* isolate at least 8 different classes must be available. Any lower number of available classes will return `NA` for that isolate.
#' @param combine_SI a logical to indicate whether all values of S and I must be merged into one, so resistance is only considered when isolates are R, not I. As this is the default behaviour of the [mdro()] function, it follows the redefinition by EUCAST about the interpretion of I (increased exposure) in 2019, see section 'Interpretation of S, I and R' below. When using `combine_SI = FALSE`, resistance is considered when isolates are R or I.
#' @param combine_SI a [logical] to indicate whether all values of S and I must be merged into one, so resistance is only considered when isolates are R, not I. As this is the default behaviour of the [mdro()] function, it follows the redefinition by EUCAST about the interpretation of I (increased exposure) in 2019, see section 'Interpretation of S, I and R' below. When using `combine_SI = FALSE`, resistance is considered when isolates are R or I.
#' @param verbose a logical to turn Verbose mode on and off (default is off). In Verbose mode, the function does not return the MDRO results, but instead returns a data set in logbook form with extensive info about which isolates would be MDRO-positive, or why they are not.
#' @inheritSection eucast_rules Antibiotics
#' @details
@ -37,8 +37,10 @@
#'
#' - `guideline = "CMI2012"`\cr
#' Magiorakos AP, Srinivasan A *et al.* "Multidrug-resistant, extensively drug-resistant and pandrug-resistant bacteria: an international expert proposal for interim standard definitions for acquired resistance." Clinical Microbiology and Infection (2012) ([link](https://www.clinicalmicrobiologyandinfection.com/article/S1198-743X(14)61632-3/fulltext))
#' - `guideline = "EUCAST"`\cr
#' The European international guideline - EUCAST Expert Rules Version 3.1 "Intrinsic Resistance and Exceptional Phenotypes Tables" ([link](http://www.eucast.org/fileadmin/src/media/PDFs/EUCAST_files/Expert_Rules/Expert_rules_intrinsic_exceptional_V3.1.pdf))
#' - `guideline = "EUCAST3.2"` (or simply `guideline = "EUCAST"`)\cr
#' The European international guideline - EUCAST Expert Rules Version 3.2 "Intrinsic Resistance and Unusual Phenotypes" ([link](https://www.eucast.org/fileadmin/src/media/PDFs/EUCAST_files/Expert_Rules/2020/Intrinsic_Resistance_and_Unusual_Phenotypes_Tables_v3.2_20200225.pdf))
#' - `guideline = "EUCAST3.1"`\cr
#' The European international guideline - EUCAST Expert Rules Version 3.1 "Intrinsic Resistance and Exceptional Phenotypes Tables" ([link](https://www.eucast.org/fileadmin/src/media/PDFs/EUCAST_files/Expert_Rules/Expert_rules_intrinsic_exceptional_V3.1.pdf))
#' - `guideline = "TB"`\cr
#' The international guideline for multi-drug resistant tuberculosis - World Health Organization "Companion handbook to the WHO guidelines for the programmatic management of drug-resistant tuberculosis" ([link](https://www.who.int/tb/publications/pmdt_companionhandbook/en/))
#' - `guideline = "MRGN"`\cr
@ -48,7 +50,7 @@
#'
#' Please suggest your own (country-specific) guidelines by letting us know: <https://github.com/msberends/AMR/issues/new>.
#'
#' **Note:** Every test that involves the Enterobacteriaceae family, will internally be performed using its newly named order Enterobacterales, since the Enterobacteriaceae family has been taxonomically reclassified by Adeolu *et al.* in 2016. Before that, Enterobacteriaceae was the only family under the Enterobacteriales (with an i) order. All species under the old Enterobacteriaceae family are still under the new Enterobacterales (without an i) order, but divided into multiple families. The way tests are performed now by this [mdro()] function makes sure that results from before 2016 and after 2016 are identical.
#' **Note:** Every test that involves the Enterobacteriaceae family, will internally be performed using its newly named *order* Enterobacterales, since the Enterobacteriaceae family has been taxonomically reclassified by Adeolu *et al.* in 2016. Before that, Enterobacteriaceae was the only family under the Enterobacteriales (with an i) order. All species under the old Enterobacteriaceae family are still under the new Enterobacterales (without an i) order, but divided into multiple families. The way tests are performed now by this [mdro()] function makes sure that results from before 2016 and after 2016 are identical.
#' @inheritSection as.rsi Interpretation of R and S/I
#' @return
#' - CMI 2012 paper - function [mdr_cmi2012()] or [mdro()]:\cr
@ -66,18 +68,19 @@
#' @source
#' Please see *Details* for the list of publications used for this function.
#' @examples
#' \dontrun{
#' library(dplyr)
#' library(cleaner)
#' mdro(example_isolates, guideline = "EUCAST")
#'
#' example_isolates %>%
#' mdro() %>%
#' freq()
#' \donttest{
#' if (require("dplyr")) {
#' example_isolates %>%
#' mdro() %>%
#' table()
#'
#' example_isolates %>%
#' mutate(EUCAST = eucast_exceptional_phenotypes(.),
#' BRMO = brmo(.),
#' MRGN = mrgn(.))
#' example_isolates %>%
#' mutate(EUCAST = eucast_exceptional_phenotypes(.),
#' BRMO = brmo(.),
#' MRGN = mrgn(.))
#' }
#' }
mdro <- function(x,
guideline = "CMI2012",
@ -90,12 +93,12 @@ mdro <- function(x,
check_dataset_integrity()
if (verbose == TRUE & interactive()) {
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.:",
"\ndata <- mdro(data, verbose = TRUE)\n\nDo you want to continue?")
if ("rstudioapi" %in% rownames(utils::installed.packages())) {
showQuestion <- import_fn("showQuestion", "rstudioapi")
showQuestion <- import_fn("showQuestion", "rstudioapi", error_on_fail = FALSE)
if (!is.null(showQuestion)) {
q_continue <- showQuestion("Using verbose = TRUE with mdro()", txt)
} else {
q_continue <- utils::menu(choices = c("OK", "Cancel"), graphics = FALSE, title = txt)
@ -124,19 +127,25 @@ mdro <- function(x,
}
stop_ifnot(length(guideline) == 1, "`guideline` must be of length 1")
guideline.bak <- guideline
guideline <- tolower(gsub("[^a-zA-Z0-9.]+", "", guideline))
if (is.null(guideline)) {
# default to the paper by Magiorakos et al. (2012)
guideline <- "cmi2012"
}
if (tolower(guideline) == "nl") {
guideline <- "BRMO"
if (guideline == "eucast") {
# turn into latest EUCAST guideline
guideline <- "eucast3.2"
}
if (tolower(guideline) == "de") {
guideline <- "MRGN"
if (guideline == "nl") {
guideline <- "brmo"
}
stop_ifnot(tolower(guideline) %in% c("brmo", "mrgn", "eucast", "tb", "cmi2012"),
"invalid guideline: ", guideline)
guideline <- list(code = tolower(guideline))
if (guideline == "de") {
guideline <- "mrgn"
}
stop_ifnot(guideline %in% c("brmo", "mrgn", "eucast3.1", "eucast3.2", "tb", "cmi2012"),
"invalid guideline: ", guideline.bak)
guideline <- list(code = guideline)
# try to find columns based on type
# -- mo
@ -158,16 +167,22 @@ mdro <- function(x,
guideline$version <- "N/A"
guideline$source <- "Clinical Microbiology and Infection 18:3, 2012. DOI: 10.1111/j.1469-0691.2011.03570.x"
} else if (guideline$code == "eucast") {
} else if (guideline$code == "eucast3.2") {
guideline$name <- "EUCAST Expert Rules, \"Intrinsic Resistance and Unusual Phenotypes\""
guideline$author <- "EUCAST (European Committee on Antimicrobial Susceptibility Testing)"
guideline$version <- "3.2, 2020"
guideline$source <- "https://www.eucast.org/fileadmin/src/media/PDFs/EUCAST_files/Expert_Rules/2020/Intrinsic_Resistance_and_Unusual_Phenotypes_Tables_v3.2_20200225.pdf"
} else if (guideline$code == "eucast3.1") {
guideline$name <- "EUCAST Expert Rules, \"Intrinsic Resistance and Exceptional Phenotypes Tables\""
guideline$author <- "EUCAST (European Committee on Antimicrobial Susceptibility Testing)"
guideline$version <- "3.1"
guideline$source <- "http://www.eucast.org/fileadmin/src/media/PDFs/EUCAST_files/Expert_Rules/Expert_rules_intrinsic_exceptional_V3.1.pdf"
guideline$version <- "3.1, 2016"
guideline$source <- "https://www.eucast.org/fileadmin/src/media/PDFs/EUCAST_files/Expert_Rules/Expert_rules_intrinsic_exceptional_V3.1.pdf"
} else if (guideline$code == "tb") {
guideline$name <- "Companion handbook to the WHO guidelines for the programmatic management of drug-resistant tuberculosis"
guideline$author <- "WHO (World Health Organization)"
guideline$version <- "WHO/HTM/TB/2014.11"
guideline$version <- "WHO/HTM/TB/2014.11, 2014"
guideline$source <- "https://www.who.int/tb/publications/pmdt_companionhandbook/en/"
# support per country:
@ -306,6 +321,33 @@ mdro <- function(x,
verbose = verbose,
info = info,
...)
} else if (guideline$code == "eucast3.2") {
cols_ab <- get_column_abx(x = x,
soft_dependencies = c("AMP",
"AMX",
"CIP",
"DAL",
"DAP",
"ERV",
"FDX",
"GEN",
"LNZ",
"MEM",
"MTR",
"OMC",
"ORI",
"PEN",
"QDA",
"RIF",
"TEC",
"TGC",
"TLV",
"TOB",
"TZD",
"VAN"),
info = info,
verbose = verbose,
...)
} else if (guideline$code == "tb") {
cols_ab <- get_column_abx(x = x,
soft_dependencies = c("CAP",
@ -344,41 +386,88 @@ mdro <- function(x,
ATM <- cols_ab["ATM"]
AZL <- cols_ab["AZL"]
AZM <- cols_ab["AZM"]
BPR <- cols_ab["BPR"]
CAC <- cols_ab["CAC"]
CAT <- cols_ab["CAT"]
CAZ <- cols_ab["CAZ"]
CCV <- cols_ab["CCV"]
CDR <- cols_ab["CDR"]
CDZ <- cols_ab["CDZ"]
CEC <- cols_ab["CEC"]
CED <- cols_ab["CED"]
CEI <- cols_ab["CEI"]
CEP <- cols_ab["CEP"]
CFM <- cols_ab["CFM"]
CFM1 <- cols_ab["CFM1"]
CFP <- cols_ab["CFP"]
CFR <- cols_ab["CFR"]
CFS <- cols_ab["CFS"]
CHL <- cols_ab["CHL"]
CID <- cols_ab["CID"]
CIP <- cols_ab["CIP"]
CLI <- cols_ab["CLI"]
CLR <- cols_ab["CLR"]
CMX <- cols_ab["CMX"]
CMZ <- cols_ab["CMZ"]
CND <- cols_ab["CND"]
COL <- cols_ab["COL"]
CPD <- cols_ab["CPD"]
CPM <- cols_ab["CPM"]
CPO <- cols_ab["CPO"]
CPR <- cols_ab["CPR"]
CPT <- cols_ab["CPT"]
CRD <- cols_ab["CRD"]
CRO <- cols_ab["CRO"]
CSL <- cols_ab["CSL"]
CTB <- cols_ab["CTB"]
CTF <- cols_ab["CTF"]
CTL <- cols_ab["CTL"]
CTT <- cols_ab["CTT"]
CTX <- cols_ab["CTX"]
CTZ <- cols_ab["CTZ"]
CXM <- cols_ab["CXM"]
CZD <- cols_ab["CZD"]
CZO <- cols_ab["CZO"]
CZX <- cols_ab["CZX"]
DAL <- cols_ab["DAL"]
DAP <- cols_ab["DAP"]
DIT <- cols_ab["DIT"]
DIZ <- cols_ab["DIZ"]
DOR <- cols_ab["DOR"]
DOX <- cols_ab["DOX"]
ENX <- cols_ab["ENX"]
ERV <- cols_ab["ERV"]
ERY <- cols_ab["ERY"]
ETP <- cols_ab["ETP"]
FDX <- cols_ab["FDX"]
FEP <- cols_ab["FEP"]
FLC <- cols_ab["FLC"]
FLE <- cols_ab["FLE"]
FOS <- cols_ab["FOS"]
FOX <- cols_ab["FOX"]
FUS <- cols_ab["FUS"]
GAT <- cols_ab["GAT"]
GEH <- cols_ab["GEH"]
GEM <- cols_ab["GEM"]
GEN <- cols_ab["GEN"]
GRX <- cols_ab["GRX"]
HAP <- cols_ab["HAP"]
IPM <- cols_ab["IPM"]
KAN <- cols_ab["KAN"]
LEX <- cols_ab["LEX"]
LIN <- cols_ab["LIN"]
LNZ <- cols_ab["LNZ"]
LOM <- cols_ab["LOM"]
LOR <- cols_ab["LOR"]
LTM <- cols_ab["LTM"]
LVX <- cols_ab["LVX"]
MAN <- cols_ab["MAN"]
MEM <- cols_ab["MEM"]
MEV <- cols_ab["MEV"]
MEZ <- cols_ab["MEZ"]
MTR <- cols_ab["MTR"]
MFX <- cols_ab["MFX"]
MNO <- cols_ab["MNO"]
MTR <- cols_ab["MTR"]
NAL <- cols_ab["NAL"]
NEO <- cols_ab["NEO"]
NET <- cols_ab["NET"]
@ -386,17 +475,25 @@ mdro <- function(x,
NOR <- cols_ab["NOR"]
NOV <- cols_ab["NOV"]
OFX <- cols_ab["OFX"]
OMC <- cols_ab["OMC"]
ORI <- cols_ab["ORI"]
OXA <- cols_ab["OXA"]
PAZ <- cols_ab["PAZ"]
PEF <- cols_ab["PEF"]
PEN <- cols_ab["PEN"]
PIP <- cols_ab["PIP"]
PLB <- cols_ab["PLB"]
PRI <- cols_ab["PRI"]
PRU <- cols_ab["PRU"]
QDA <- cols_ab["QDA"]
RFL <- cols_ab["RFL"]
RID <- cols_ab["RID"]
RIF <- cols_ab["RIF"]
RXT <- cols_ab["RXT"]
SAM <- cols_ab["SAM"]
SIS <- cols_ab["SIS"]
SPT <- cols_ab["SPT"]
SPX <- cols_ab["SPX"]
STH <- cols_ab["STH"]
SXT <- cols_ab["SXT"]
TCC <- cols_ab["TCC"]
@ -406,7 +503,10 @@ mdro <- function(x,
TIC <- cols_ab["TIC"]
TLV <- cols_ab["TLV"]
TMP <- cols_ab["TMP"]
TMX <- cols_ab["TMX"]
TOB <- cols_ab["TOB"]
TVA <- cols_ab["TVA"]
TZD <- cols_ab["TZD"]
TZP <- cols_ab["TZP"]
VAN <- cols_ab["VAN"]
# additional for TB
@ -453,10 +553,12 @@ mdro <- function(x,
# antibiotic classes
aminoglycosides <- c(TOB, GEN)
cephalosporins <- c(FEP, CTX, FOX, CED, CAZ, CRO, CXM, CZO)
cephalosporins_3rd <- c(CTX, CRO, CAZ)
carbapenems <- c(ETP, IPM, MEM)
fluoroquinolones <- c(OFX, CIP, LVX, MFX)
cephalosporins <- c(CDZ, CAC, CEC, CFR, RID, MAN, CTZ, CZD, CZO, CDR, DIT, FEP, CAT, CFM, CMX, CMZ, DIZ, CID, CFP, CSL, CND, CTX, CTT, CTF, FOX, CPM, CPO, CPD, CPR, CRD, CFS, CPT, CAZ, CCV, CTL, CTB, CZX, BPR, CFM1, CEI, CRO, CXM, LEX, CEP, HAP, CED, LTM, LOR)
cephalosporins_1st <- c(CAC, CFR, RID, CTZ, CZD, CZO, CRD, CTL, LEX, CEP, HAP, CED)
cephalosporins_2nd <- c(CEC, MAN, CMZ, CID, CND, CTT, CTF, FOX, CPR, CXM, LOR)
cephalosporins_3rd <- c(CDZ, CDR, DIT, CAT, CFM, CMX, DIZ, CFP, CSL, CTX, CPM, CPD, CFS, CAZ, CCV, CTB, CZX, CRO, LTM)
carbapenems <- c(DOR, ETP, IPM, MEM, MEV)
fluoroquinolones <- c(CIP, ENX, FLE, GAT, GEM, GRX, LVX, LOM, MFX, NOR, OFX, PAZ, PEF, PRU, RFL, SPX, TMX, TVA)
# helper function for editing the table
trans_tbl <- function(to, rows, cols, any_all) {
@ -749,33 +851,33 @@ mdro <- function(x,
}
if (guideline$code == "eucast") {
# EUCAST ------------------------------------------------------------------
if (guideline$code == "eucast3.1") {
# EUCAST 3.1 --------------------------------------------------------------
# Table 5
trans_tbl(3,
which(x$order == "Enterobacterales"
| x$fullname %like% "^Pseudomonas aeruginosa"
| (x$genus == "Pseudomonas" & x$species == "aeruginosa")
| x$genus == "Acinetobacter"),
COL,
"all")
trans_tbl(3,
which(x$fullname %like% "^Salmonella Typhi"),
which(x$genus == "Salmonella" & x$species == "Typhi"),
c(carbapenems, fluoroquinolones),
"any")
trans_tbl(3,
which(x$fullname %like% "^Haemophilus influenzae"),
which(x$genus == "Haemophilus" & x$species == "influenzae"),
c(cephalosporins_3rd, carbapenems, fluoroquinolones),
"any")
trans_tbl(3,
which(x$fullname %like% "^Moraxella catarrhalis"),
which(x$genus == "Moraxella" & x$species == "catarrhalis"),
c(cephalosporins_3rd, fluoroquinolones),
"any")
trans_tbl(3,
which(x$fullname %like% "^Neisseria meningitidis"),
which(x$genus == "Neisseria" & x$species == "meningitidis"),
c(cephalosporins_3rd, fluoroquinolones),
"any")
trans_tbl(3,
which(x$fullname %like% "^Neisseria gonorrhoeae"),
which(x$genus == "Neisseria" & x$species == "gonorrhoeae"),
AZM,
"any")
# Table 6
@ -788,7 +890,7 @@ mdro <- function(x,
c(VAN, TEC, DAP, LNZ, QDA, TGC),
"any")
trans_tbl(3,
which(x$fullname %like% "^Streptococcus pneumoniae"),
which(x$genus == "Streptococcus" & x$species == "pneumoniae"),
c(carbapenems, VAN, TEC, DAP, LNZ, QDA, TGC, RIF),
"any")
trans_tbl(3, # Sr. groups A/B/C/G
@ -800,7 +902,7 @@ mdro <- function(x,
c(DAP, LNZ, TGC, TEC),
"any")
trans_tbl(3,
which(x$fullname %like% "^Enterococcus faecalis"),
which(x$genus == "Enterococcus" & x$species == "faecalis"),
c(AMP, AMX),
"any")
# Table 7
@ -809,11 +911,84 @@ mdro <- function(x,
MTR,
"any")
trans_tbl(3,
which(x$fullname %like% "^Clostridium difficile"),
which(x$genus == "Clostridium" & x$species == "difficile"),
c(MTR, VAN),
"any")
}
if (guideline$code == "eucast3.2") {
# EUCAST 3.2 --------------------------------------------------------------
# Table 6
trans_tbl(3,
which((x$order == "Enterobacterales" &
!x$family == "Morganellaceae" &
!(x$genus == "Serratia" & x$species == "marcescens"))
| (x$genus == "Pseudomonas" & x$species == "aeruginosa")
| x$genus == "Acinetobacter"),
COL,
"all")
trans_tbl(3,
which(x$genus == "Salmonella" & x$species == "Typhi"),
c(carbapenems),
"any")
trans_tbl(3,
which(x$genus == "Haemophilus" & x$species == "influenzae"),
c(cephalosporins_3rd, carbapenems, fluoroquinolones),
"any")
trans_tbl(3,
which(x$genus == "Moraxella" & x$species == "catarrhalis"),
c(cephalosporins_3rd, fluoroquinolones),
"any")
trans_tbl(3,
which(x$genus == "Neisseria" & x$species == "meningitidis"),
c(cephalosporins_3rd, fluoroquinolones),
"any")
trans_tbl(3,
which(x$genus == "Neisseria" & x$species == "gonorrhoeae"),
SPT,
"any")
# Table 7
trans_tbl(3,
which(x$genus == "Staphylococcus" & x$species == "aureus"),
c(VAN, TEC, TLV, DAL, ORI, DAP, LNZ, TZD, QDA, TGC, ERV, OMC),
"any")
trans_tbl(3,
which(x$mo %in% MO_CONS), # coagulase-negative Staphylococcus
c( VAN, TLV, DAL, ORI, DAP, LNZ, TZD, QDA, TGC, ERV, OMC),
"any")
trans_tbl(3,
which(x$genus == "Corynebacterium"),
c(VAN, TEC, TLV, DAL, ORI, DAP, LNZ, TZD, QDA, TGC),
"any")
trans_tbl(3,
which(x$genus == "Streptococcus" & x$species == "pneumoniae"),
c(carbapenems, VAN, TEC, TLV, DAL, ORI, DAP, LNZ, TZD, QDA, TGC, ERV, OMC, RIF),
"any")
streps <- MO_lookup[which(MO_lookup$genus == "Streptococcus"), "mo", drop = TRUE]
streps_ABCG <- streps[as.mo(streps, Lancefield = TRUE) %in% c("B_STRPT_GRPA", "B_STRPT_GRPB", "B_STRPT_GRPC", "B_STRPT_GRPG")]
trans_tbl(3, # Sr. groups A/B/C/G
which(x$mo %in% streps_ABCG),
c(PEN, cephalosporins, VAN, TEC, TLV, DAL, ORI, DAP, LNZ, TZD, QDA, TGC, ERV, OMC),
"any")
trans_tbl(3,
which(x$genus == "Enterococcus"),
c(DAP, LNZ, TGC, ERV, OMC, TEC),
"any")
trans_tbl(3,
which(x$genus == "Enterococcus" & x$species == "faecalis"),
c(AMP, AMX),
"any")
# Table 8
trans_tbl(3,
which(x$genus == "Bacteroides"),
MTR,
"any")
trans_tbl(3,
which(x$genus == "Clostridium" & x$species == "difficile"),
c(MTR, VAN, FDX),
"any")
}
if (guideline$code == "mrgn") {
# Germany -----------------------------------------------------------------
CTX_or_CAZ <- CTX %or% CAZ
@ -828,7 +1003,7 @@ mdro <- function(x,
# Table 1
x[which((x$order == "Enterobacterales" | # following in fact the old Enterobacteriaceae classification
x$fullname %like% "^Acinetobacter baumannii") &
(x$genus == "Acinetobacter" & x$species == "baumannii")) &
x[, PIP] == "R" &
x[, CTX_or_CAZ] == "R" &
x[, IPM_or_MEM] == "S" &
@ -836,7 +1011,7 @@ mdro <- function(x,
"MDRO"] <- 2 # 2 = 3MRGN
x[which((x$order == "Enterobacterales" | # following in fact the old Enterobacteriaceae classification
x$fullname %like% "^Acinetobacter baumannii") &
(x$genus == "Acinetobacter" & x$species == "baumannii")) &
x[, PIP] == "R" &
x[, CTX_or_CAZ] == "R" &
x[, IPM_or_MEM] == "R" &
@ -844,18 +1019,18 @@ mdro <- function(x,
"MDRO"] <- 3 # 3 = 4MRGN, overwrites 3MRGN if applicable
x[which((x$order == "Enterobacterales" | # following in fact the old Enterobacteriaceae classification
x$fullname %like% "^Acinetobacter baumannii") &
(x$genus == "Acinetobacter" & x$species == "baumannii")) &
x[, IPM] == "R" | x[, MEM] == "R"),
"MDRO"] <- 3 # 3 = 4MRGN, always when imipenem or meropenem is R
x[which(x$fullname %like% "^Pseudomonas aeruginosa" &
x[which(x$genus == "Pseudomonas" & x$species == "aeruginosa" &
(x[, PIP] == "S") +
(x[, CTX_or_CAZ] == "S") +
(x[, IPM_or_MEM] == "S") +
(x[, CIP] == "S") == 1),
"MDRO"] <- 2 # 2 = 3MRGN, if only 1 group is S
x[which((x$fullname %like% "^Pseudomonas aeruginosa") &
x[which((x$genus == "Pseudomonas" & x$species == "aeruginosa") &
x[, PIP] == "R" &
x[, CTX_or_CAZ] == "R" &
x[, IPM_or_MEM] == "R" &
@ -903,7 +1078,7 @@ mdro <- function(x,
"all")
trans_tbl(3,
which(x$fullname %like% "^Stenotrophomonas maltophilia"),
which(x$genus == "Stenotrophomonas" & x$species == "maltophilia"),
SXT,
"all")
@ -922,20 +1097,20 @@ mdro <- function(x,
x$psae <- 0
}
x[which(
x$fullname %like% "Pseudomonas aeruginosa"
x$genus == "Pseudomonas" & x$species == "aeruginosa"
& x$psae >= 3), "MDRO"] <- 3
# Table 3
trans_tbl(3,
which(x$fullname %like% "Streptococcus pneumoniae"),
which(x$genus == "Streptococcus" & x$species == "pneumoniae"),
PEN,
"all")
trans_tbl(3,
which(x$fullname %like% "Streptococcus pneumoniae"),
which(x$genus == "Streptococcus" & x$species == "pneumoniae"),
VAN,
"all")
trans_tbl(3,
which(x$fullname %like% "Enterococcus faecium"),
which(x$genus == "Enterococcus" & x$species == "faecium"),
c(PEN, VAN),
"all")
}
@ -1086,7 +1261,6 @@ mdr_cmi2012 <- function(x, guideline = "CMI2012", ...) {
mdro(x = x, guideline = "CMI2012", ...)
}
#' @rdname mdro
#' @export
eucast_exceptional_phenotypes <- function(x, guideline = "EUCAST", ...) {

61
R/mo.R
View File

@ -93,14 +93,7 @@
#'
#' ## Microbial prevalence of pathogens in humans
#'
#' The intelligent rules consider the prevalence of microorganisms in humans grouped into three groups, which is available as the `prevalence` columns in the [microorganisms] and [microorganisms.old] data sets. The grouping into prevalence groups is based on experience from several microbiological laboratories in the Netherlands in conjunction with international reports on pathogen prevalence.
#'
#' Group 1 (most prevalent microorganisms) consists of all microorganisms where the taxonomic class is Gammaproteobacteria or where the taxonomic genus is *Enterococcus*, *Staphylococcus* or *Streptococcus*. This group consequently contains all common Gram-negative bacteria, such as *Klebsiella*, *Pseudomonas* and *Legionella*.
#'
#' Group 2 consists of all microorganisms where the taxonomic phylum is Proteobacteria, Firmicutes, Actinobacteria or Sarcomastigophora, or where the taxonomic genus is *Aspergillus*, *Bacteroides*, *Candida*, *Capnocytophaga*, *Chryseobacterium*, *Cryptococcus*, *Elisabethkingia*, *Flavobacterium*, *Fusobacterium*, *Giardia*, *Leptotrichia*, *Mycoplasma*, *Prevotella*, *Rhodotorula*, *Treponema*, *Trichophyton* or *Ureaplasma*. This group consequently contains all less common and rare human pathogens.
#'
#' Group 3 (least prevalent microorganisms) consists of all other microorganisms. This group contains microorganisms most probably not found in humans.
#'
#' The intelligent rules consider the prevalence of microorganisms in humans grouped into three groups, which is available as the `prevalence` columns in the [microorganisms] and [microorganisms.old] data sets. The grouping into human pathogenic prevalence is explained in the section *Matching score for microorganisms* below.
#' @inheritSection mo_matching_score Matching score for microorganisms
#' @inheritSection catalogue_of_life Catalogue of Life
# (source as a section here, so it can be inherited by other man pages:)
@ -152,25 +145,6 @@
#' # All mo_* functions use as.mo() internally too (see ?mo_property):
#' mo_genus("E. coli") # returns "Escherichia"
#' mo_gramstain("E. coli") # returns "Gram negative"
#'
#' }
#' \dontrun{
#' df$mo <- as.mo(df$microorganism_name)
#'
#' # the select function of the Tidyverse is also supported:
#' library(dplyr)
#' df$mo <- df %>%
#' select(microorganism_name) %>%
#' as.mo()
#'
#' # and can even contain 2 columns, which is convenient
#' # for genus/species combinations:
#' df$mo <- df %>%
#' select(genus, species) %>%
#' as.mo()
#' # although this works easier and does the same:
#' df <- df %>%
#' mutate(mo = as.mo(paste(genus, species)))
#' }
as.mo <- function(x,
Becker = FALSE,
@ -1439,45 +1413,26 @@ exec_as.mo <- function(x,
# Becker ----
if (Becker == TRUE | Becker == "all") {
# See Source. It's this figure:
# https://www.ncbi.nlm.nih.gov/pmc/articles/PMC4187637/figure/F3/
MOs_staph <- MO_lookup[which(MO_lookup$genus == "Staphylococcus"), ]
CoNS <- MOs_staph[which(MOs_staph$species %in% c("arlettae", "auricularis", "capitis",
"caprae", "carnosus", "chromogenes", "cohnii", "condimenti",
"devriesei", "epidermidis", "equorum", "felis",
"fleurettii", "gallinarum", "haemolyticus",
"hominis", "jettensis", "kloosii", "lentus",
"lugdunensis", "massiliensis", "microti",
"muscae", "nepalensis", "pasteuri", "petrasii",
"pettenkoferi", "piscifermentans", "rostri",
"saccharolyticus", "saprophyticus", "sciuri",
"stepanovicii", "simulans", "succinus",
"vitulinus", "warneri", "xylosus")
| (MOs_staph$species == "schleiferi" & MOs_staph$subspecies %in% c("schleiferi", ""))),
property]
CoPS <- MOs_staph[which(MOs_staph$species %in% c("simiae", "agnetis",
"delphini", "lutrae",
"hyicus", "intermedius",
"pseudintermedius", "pseudointermedius",
"schweitzeri", "argenteus")
| (MOs_staph$species == "schleiferi" & MOs_staph$subspecies == "coagulans")),
property]
# warn when species found that are not in Becker (2014, PMID 25278577) and Becker (2019, PMID 30872103)
post_Becker <- c("argensis", "caeli", "cornubiensis", "edaphicus")
if (any(x %in% MOs_staph[which(MOs_staph$species %in% post_Becker), property])) {
if (any(x %in% MO_lookup[which(MO_lookup$species %in% post_Becker), property])) {
warning("Becker ", font_italic("et al."), " (2014, 2019) does not contain these species named after their publication: ",
font_italic(paste("S.",
sort(mo_species(unique(x[x %in% MOs_staph[which(MOs_staph$species %in% post_Becker), property]]))),
sort(mo_species(unique(x[x %in% MO_lookup[which(MO_lookup$species %in% post_Becker), property]]))),
collapse = ", ")),
".",
call. = FALSE,
immediate. = TRUE)
}
# 'MO_CONS' and 'MO_COPS' are <mo> vectors created in R/zzz.R
CoNS <- MO_lookup[which(MO_lookup$mo %in% MO_CONS), property, drop = TRUE]
x[x %in% CoNS] <- lookup(mo == "B_STPHY_CONS", uncertainty = -1)
CoPS <- MO_lookup[which(MO_lookup$mo %in% MO_COPS), property, drop = TRUE]
x[x %in% CoPS] <- lookup(mo == "B_STPHY_COPS", uncertainty = -1)
if (Becker == "all") {
x[x %in% lookup(fullname %like_case% "^Staphylococcus aureus", n = Inf)] <- lookup(mo == "B_STPHY_COPS", uncertainty = -1)
}

17
R/mo_matching_score.R
View File

@ -32,21 +32,22 @@
#' where:
#'
#' * \eqn{x} is the user input;
#' * \eqn{n} is a taxonomic name (genus, species and subspecies) as found in [`microorganisms$fullname`][microorganisms];
#' * \eqn{l_{n}}{l_n} is the length of \eqn{n};
#' * \eqn{\operatorname{lev}}{lev} is the [Levenshtein distance function](https://en.wikipedia.org/wiki/Levenshtein_distance);
#' * \eqn{p_{n}}{p_n} is the human pathogenic prevalence of \eqn{n}, categorised into group \eqn{1}, \eqn{2} and \eqn{3} (see *Details* in `?as.mo`), meaning that \eqn{p = \{1, 2 , 3\}}{p = {1, 2, 3}};
#' * \eqn{k_{n}}{k_n} is the kingdom index of \eqn{n}, set as follows: Bacteria = \eqn{1}, Fungi = \eqn{2}, Protozoa = \eqn{3}, Archaea = \eqn{4}, and all others = \eqn{5}, meaning that \eqn{k = \{1, 2 , 3, 4, 5\}}{k = {1, 2, 3, 4, 5}}.
#' * \eqn{n} is a taxonomic name (genus, species, and subspecies);
#' * \eqn{l_n}{l_n} is the length of \eqn{n};
#' * lev is the [Levenshtein distance function](https://en.wikipedia.org/wiki/Levenshtein_distance), which counts any insertion, deletion and substitution as 1 that is needed to change \eqn{x} into \eqn{n};
#' * \eqn{p_n}{p_n} is the human pathogenic prevalence group of \eqn{n}, as described below;
#' * \eqn{k_n}{p_n} is the taxonomic kingdom of \eqn{n}, set as Bacteria = 1, Fungi = 2, Protozoa = 3, Archaea = 4, others = 5.
#'
#' This means that the user input `x = "E. coli"` gets for *Escherichia coli* a matching score of `r percentage(mo_matching_score("E. coli", "Escherichia coli"), 1)` and for *Entamoeba coli* a matching score of `r percentage(mo_matching_score("E. coli", "Entamoeba coli"), 1)`.
#' The grouping into human pathogenic prevalence (\eqn{p}) is based on experience from several microbiological laboratories in the Netherlands in conjunction with international reports on pathogen prevalence. **Group 1** (most prevalent microorganisms) consists of all microorganisms where the taxonomic class is Gammaproteobacteria or where the taxonomic genus is *Enterococcus*, *Staphylococcus* or *Streptococcus*. This group consequently contains all common Gram-negative bacteria, such as *Pseudomonas* and *Legionella* and all species within the order Enterobacterales. **Group 2** consists of all microorganisms where the taxonomic phylum is Proteobacteria, Firmicutes, Actinobacteria or Sarcomastigophora, or where the taxonomic genus is *Absidia*, *Acremonium*, *Actinotignum*, *Alternaria*, *Anaerosalibacter*, *Apophysomyces*, *Arachnia*, *Aspergillus*, *Aureobacterium*, *Aureobasidium*, *Bacteroides*, *Basidiobolus*, *Beauveria*, *Blastocystis*, *Branhamella*, *Calymmatobacterium*, *Candida*, *Capnocytophaga*, *Catabacter*, *Chaetomium*, *Chryseobacterium*, *Chryseomonas*, *Chrysonilia*, *Cladophialophora*, *Cladosporium*, *Conidiobolus*, *Cryptococcus*, *Curvularia*, *Exophiala*, *Exserohilum*, *Flavobacterium*, *Fonsecaea*, *Fusarium*, *Fusobacterium*, *Hendersonula*, *Hypomyces*, *Koserella*, *Lelliottia*, *Leptosphaeria*, *Leptotrichia*, *Malassezia*, *Malbranchea*, *Mortierella*, *Mucor*, *Mycocentrospora*, *Mycoplasma*, *Nectria*, *Ochroconis*, *Oidiodendron*, *Phoma*, *Piedraia*, *Pithomyces*, *Pityrosporum*, *Prevotella*,\\*Pseudallescheria*, *Rhizomucor*, *Rhizopus*, *Rhodotorula*, *Scolecobasidium*, *Scopulariopsis*, *Scytalidium*,*Sporobolomyces*, *Stachybotrys*, *Stomatococcus*, *Treponema*, *Trichoderma*, *Trichophyton*, *Trichosporon*, *Tritirachium* or *Ureaplasma*. **Group 3** consists of all other microorganisms.
#'
#' All matches are sorted descending on their matching score and for all user input values, the top match will be returned.
#' All matches are sorted descending on their matching score and for all user input values, the top match will be returned. This will lead to the effect that e.g., `"E. coli"` will return the microbial ID of *Escherichia coli* (\eqn{m = `r round(mo_matching_score("E. coli", "Escherichia coli"), 3)`}, a highly prevalent microorganism found in humans) and not *Entamoeba coli* (\eqn{m = `r round(mo_matching_score("E. coli", "Entamoeba coli"), 3)`}, a less prevalent microorganism in humans), although the latter would alphabetically come first.
#' @export
#' @examples
#' as.mo("E. coli")