1
0
mirror of https://github.com/msberends/AMR.git synced 2025-07-08 11:11:54 +02:00

EUCAST rules for MDRO

This commit is contained in:
2018-04-25 15:33:58 +02:00
parent 0b22ddef8e
commit 970e3ed7f1
19 changed files with 694 additions and 173 deletions

84
R/atc.R
View File

@ -367,3 +367,87 @@ guess_bactid <- function(x) {
}
x
}
#' Find ATC code based on antibiotic property
#'
#' Use this function to determine the ATC code of one or more antibiotics. The dataset \code{\link{antibiotics}} will be searched for abbreviations, official names and trade names.
#' @param x character vector to determine \code{ATC} code
#' @export
#' @importFrom dplyr %>% filter slice pull
#' @details In the ATC classification system, the active substances are classified in a hierarchy with five different levels. The system has fourteen main anatomical/pharmacological groups or 1st levels. Each ATC main group is divided into 2nd levels which could be either pharmacological or therapeutic groups. The 3rd and 4th levels are chemical, pharmacological or therapeutic subgroups and the 5th level is the chemical substance. The 2nd, 3rd and 4th levels are often used to identify pharmacological subgroups when that is considered more appropriate than therapeutic or chemical subgroups.
#' Source: \url{https://www.whocc.no/atc/structure_and_principles/}
#' @return Character (vector).
#' @seealso \code{\link{antibiotics}} for the dataframe that is being used to determine ATC's.
#' @examples
#' # These examples all return "J01FA01", the ATC code of Erythromycin:
#' guess_atc("J01FA01")
#' guess_atc("Erythromycin")
#' guess_atc("eryt")
#' guess_atc("ERYT")
#' guess_atc("ERY")
#' guess_atc("Erythrocin") # Trade name
#' guess_atc("Eryzole") # Trade name
#' guess_atc("Pediamycin") # Trade name
guess_atc <- function(x) {
# use this later to further fill AMR::antibiotics
# drug <- "Ciprofloxacin"
# url <- xml2::read_html(paste0("https://www.ncbi.nlm.nih.gov/pccompound?term=", drug)) %>%
# html_nodes(".rslt") %>%
# .[[1]] %>%
# html_nodes(".title a") %>%
# html_attr("href") %>%
# gsub("/compound/", "/rest/pug_view/data/compound/", ., fixed = TRUE) %>%
# paste0("/XML/?response_type=display")
# synonyms <- url %>%
# read_xml() %>%
# xml_contents() %>% .[[6]] %>%
# xml_contents() %>% .[[8]] %>%
# xml_contents() %>% .[[3]] %>%
# xml_contents() %>% .[[3]] %>%
# xml_contents() %>%
# paste() %>%
# .[. %like% "StringValueList"] %>%
# gsub("[</]+StringValueList[>]", "", .)
for (i in 1:length(x)) {
# first try atc
found <- AMR::antibiotics %>% filter(atc == x[i])
if (nrow(found) == 0) {
# try abbreviation of molis and glims
found <- AMR::antibiotics %>% filter(molis == x[i] | umcg == x[i])
}
if (nrow(found) == 0) {
# try exact official name
found <- AMR::antibiotics[which(AMR::antibiotics$official == x[i]),]
}
if (nrow(found) == 0) {
# try trade name
found <- AMR::antibiotics[which(paste0("(", AMR::antibiotics$trade_name, ")") %like% x[i]),]
}
if (nrow(found) == 0) {
# try abbreviation
found <- AMR::antibiotics[which(paste0("(", AMR::antibiotics$abbr, ")") %like% x[i]),]
}
# if (nrow(found) == 0) {
# # loosely try official name
# found <- AMR::antibiotics[which(AMR::antibiotics$official %like% x[i]),]
# }
if (nrow(found) != 0) {
x[i] <- found %>%
slice(1) %>%
pull(atc)
} else {
x[i] <- NA
}
}
x
}

View File

@ -21,7 +21,7 @@
#' This transforms a vector to a new class \code{rsi}, which is an ordered factor with levels \code{S < I < R}. Invalid antimicrobial interpretations will be translated as \code{NA} with a warning.
#' @rdname as.rsi
#' @param x vector
#' @return New class \code{rsi}
#' @return Ordered factor with new class \code{rsi} and new attributes \code{package} and \code{package.version}
#' @export
#' @importFrom dplyr %>%
#' @importFrom utils packageDescription
@ -92,20 +92,13 @@ print.rsi <- function(x, ...) {
I <- x[x == 'I'] %>% length()
R <- x[x == 'R'] %>% length()
IR <- x[x %in% c('I', 'R')] %>% length()
cat("Class 'rsi': ", n, " isolates\n", sep = '')
cat("Class 'rsi'\n")
cat(n, " results (missing: ", n_total - n, ' = ', percent((n_total - n) / n, force_zero = TRUE), ')\n', sep = "")
cat('\n')
cat('<NA>: ', n_total - n, '\n')
cat('Sum of S: ', S, '\n')
cat('Sum of IR: ', IR, '\n')
cat('- Sum of R:', R, '\n')
cat('- Sum of I:', I, '\n')
cat('\n')
print(c(
`%S` = round((S / n) * 100, 1),
`%IR` = round((IR / n) * 100, 1),
`%I` = round((I / n) * 100, 1),
`%R` = round((R / n) * 100, 1)
))
cat('Sum of S: ', S, ' (', percent(S / n, force_zero = TRUE), ')\n', sep = "")
cat('Sum of IR: ', IR, ' (', percent(IR / n, force_zero = TRUE), ')\n', sep = "")
cat('- Sum of R: ', R, ' (', percent(R / n, force_zero = TRUE), ')\n', sep = "")
cat('- Sum of I: ', I, ' (', percent(I / n, force_zero = TRUE), ')\n', sep = "")
}
#' @exportMethod summary.rsi
@ -197,7 +190,7 @@ barplot.rsi <- function(height, ...) {
#' @rdname as.mic
#' @param x vector
#' @param na.rm a logical indicating whether missing values should be removed
#' @return New class \code{mic}
#' @return Ordered factor with new class \code{mic} and new attributes \code{package} and \code{package.version}
#' @export
#' @importFrom dplyr %>%
#' @importFrom utils packageDescription

173
R/data.R
View File

@ -24,9 +24,11 @@
#' \item{\code{atc}}{ATC code, like \code{J01CR02}}
#' \item{\code{molis}}{MOLIS code, like \code{amcl}}
#' \item{\code{umcg}}{UMCG code, like \code{AMCL}}
#' \item{\code{abbr}}{Abbreviation as used by many countries, to be used for \code{\link{guess_atc}}}
#' \item{\code{official}}{Official name by the WHO, like \code{"Amoxicillin and enzyme inhibitor"}}
#' \item{\code{official_nl}}{Official name in the Netherlands, like \code{"Amoxicilline met enzymremmer"}}
#' \item{\code{trivial_nl}}{Trivial name in Dutch, like \code{"Amoxicilline/clavulaanzuur"}}
#' \item{\code{trade_name}}{Trade name as used by many countries, to be used for \code{\link{guess_atc}}}
#' \item{\code{oral_ddd}}{Defined Daily Dose (DDD), oral treatment}
#' \item{\code{oral_units}}{Units of \code{ddd_units}}
#' \item{\code{iv_ddd}}{Defined Daily Dose (DDD), parenteral treatment}
@ -40,6 +42,177 @@
#' }
#' @source - World Health Organization: \url{https://www.whocc.no/atc_ddd_index/} \cr - EUCAST - Expert rules intrinsic exceptional V3.1 \cr - MOLIS (LIS of Certe): \url{https://www.certe.nl} \cr - GLIMS (LIS of UMCG): \url{https://www.umcg.nl}
#' @seealso \code{\link{microorganisms}}
# abbr and trade_name created with:
# https://hs.unr.edu/Documents/dhs/chs/NVPHTC/antibiotic_refeference_guide.pdf
# antibiotics %>%
# mutate(abbr =
# case_when(
# official == 'Amikacin' ~ 'Ak|AN|AMI|AMK',
# official == 'Amoxicillin' ~ 'AMX|AMOX|AC',
# official == 'Amoxicillin and beta-lactamase inhibitor' ~ 'AUG|A/C|XL|AML',
# official == 'Ampicillin' ~ 'AM|AMP',
# official == 'Ampicillin and beta-lactamase inhibitor' ~ 'A/S|SAM|AMS|AB',
# official == 'Azithromycin' ~ 'Azi|AZM|AZ',
# official == 'Azlocillin' ~ 'AZ|AZL',
# official == 'Aztreonam' ~ 'Azt|ATM|AT|AZM',
# official == 'Carbenicillin' ~ 'Cb|BAR',
# official == 'Cefaclor' ~ 'Ccl|CEC|Cfr|FAC|CF',
# official == 'Cefadroxil' ~ 'CFR|FAD',
# official == 'Cefazolin' ~ 'Cfz|CZ|FAZ|KZ',
# official == 'Cefdinir' ~ 'Cdn|CDR|DIN|CD|CFD',
# official == 'Cefditoren' ~ 'CDN',
# official == 'Cefepime' ~ 'Cpe|FEP|PM|CPM',
# official == 'Cefixime' ~ 'Cfe|DCFM|FIX|IX',
# official == 'Cefoperazone' ~ 'Cfp|CPZ|PER|FOP|CP',
# official == 'Cefotaxime' ~ 'Cft|CTX|TAX|FOT|CT',
# official == 'Cefotetan' ~ 'Ctn|CTT|CTE|TANS|CN',
# official == 'Cefoxitin' ~ 'Cfx|FOX|CX|FX',
# official == 'Cefpodoxime' ~ 'Cpd|POD|PX',
# official == 'Cefprozil' ~ 'Cpz|CPR|FP',
# official == 'Ceftaroline' ~ 'CPT',
# official == 'Ceftazidime' ~ 'Caz|TAZ|TZ',
# official == 'Ceftibuten' ~ 'CTB|TIB|CB',
# official == 'Ceftizoxime' ~ 'Cz|ZOX|CZX|CZ|CTZ|TIZ',
# official == 'Ceftriaxone' ~ 'Cax|CRO|CTR|FRX|AXO|TX',
# official == 'Cefuroxime' ~ 'Crm|CXM|CFX|ROX|FUR|XM',
# official == 'Cephalexin' ~ 'CN|LX|CFL',
# official == 'Cephalothin' ~ 'Cf',
# official == 'Chloramphenicol' ~ 'C|CHL|CL',
# official == 'Ciprofloxacin' ~ 'Cp|CIP|CI',
# official == 'Clarithromycin' ~ 'Cla|CLR|CLM|CH',
# official == 'Clindamycin' ~ 'Cd|CC|CM|CLI|DA',
# official == 'Colistin' ~ 'CL|CS|CT',
# official == 'Daptomycin' ~ 'Dap',
# official == 'Doxycycline' ~ 'Dox',
# official == 'Doripenem' ~ 'DOR|Dor',
# official == 'Ertapenem' ~ 'Etp',
# official == 'Erythromycin' ~ 'E|ERY|EM',
# official == 'Fosfomycin' ~ 'FOS|FF|FO|FM',
# official == 'Flucloxacillin' ~ 'CLOX',
# official == 'Gentamicin' ~ 'Gm|CN|GEN',
# official == 'Imipenem' ~ 'Imp|IPM|IMI|IP',
# official == 'Kanamycin' ~ 'K|KAN|HLK|KM',
# official == 'Levofloxacin' ~ 'Lvx|LEV|LEVO|LE',
# official == 'Linezolid' ~ 'Lzd|LNZ|LZ',
# official == 'Lomefloxacin' ~ 'Lmf|LOM',
# official == 'Meropenem' ~ 'Mer|MEM|MERO|MRP|MP',
# official == 'Metronidazole' ~ 'MNZ',
# official == 'Mezlocillin' ~ 'Mz|MEZ',
# official == 'Minocycline' ~ 'Min|MI|MN|MNO|MC|MH',
# official == 'Moxifloxacin' ~ 'Mox|MXF',
# official == 'Mupirocin' ~ 'MUP',
# official == 'Nafcillin' ~ 'Naf|NF',
# official == 'Nalidixic acid' ~ 'NA|NAL',
# official == 'Nitrofurantoin' ~ 'Fd|F/M|FT|NIT|NI|F',
# official == 'Norfloxacin' ~ 'Nxn|NOR|NX',
# official == 'Ofloxacin' ~ 'Ofl|OFX|OF',
# official == 'Oxacillin' ~ 'Ox|OXS|OXA',
# official == 'Benzylpenicillin' ~ 'P|PEN|PV',
# official == 'Penicillins, combinations with other antibacterials' ~ 'P|PEN|PV',
# official == 'Piperacillin' ~ 'Pi|PIP|PP',
# official == 'Piperacillin and beta-lactamase inhibitor' ~ 'PT|TZP|PTZ|P/T|PTc',
# official == 'Polymyxin B' ~ 'PB',
# official == 'Quinupristin/dalfopristin' ~ 'Syn|Q/D|QDA|RP',
# official == 'Rifampin' ~ 'Rif|RA|RI|RD',
# official == 'Spectinomycin' ~ 'SPT|SPE|SC',
# official == 'Streptomycin' ~ 'S|STR',
# official == 'Teicoplanin' ~ 'Tei|TEC|TPN|TP|TPL',
# official == 'Telavancin' ~ 'TLV',
# official == 'Telithromcyin' ~ 'Tel',
# official == 'Tetracycline' ~ 'Te|TET|TC',
# official == 'Ticarcillin' ~ 'Ti|TIC|TC',
# official == 'Ticarcillin and beta-lactamase inhibitor' ~ 'Tim|T/C|TCC|TLc',
# official == 'Tigecycline' ~ 'TGC',
# official == 'Tobramycin' ~ 'To|NN|TM|TOB',
# official == 'Trimethoprim' ~ 'T|TMP|TR|W',
# official == 'Sulfamethoxazole and trimethoprim' ~ 'T/S|SXT|SxT|TS|COT',
# official == 'Vancomycin' ~ 'Va|VAN',
# TRUE ~ NA_character_),
#
# trade_name =
# case_when(
# official == 'Amikacin' ~ 'Amikin',
# official == 'Amoxicillin' ~ 'Amoxil|Dispermox|Larotid|Trimox',
# official == 'Amoxicillin and beta-lactamase inhibitor' ~ 'Augmentin',
# official == 'Ampicillin' ~ 'Pfizerpen-A|Principen',
# official == 'Ampicillin and beta-lactamase inhibitor' ~ 'Unasyn',
# official == 'Azithromycin' ~ 'Zithromax',
# official == 'Azlocillin' ~ 'Azlin',
# official == 'Aztreonam' ~ 'Azactam',
# official == 'Carbenicillin' ~ 'Geocillin',
# official == 'Cefaclor' ~ 'Ceclor',
# official == 'Cefadroxil' ~ 'Duricef',
# official == 'Cefazolin' ~ 'Ancef',
# official == 'Cefdinir' ~ 'Omnicef',
# official == 'Cefditoren' ~ 'Spectracef',
# official == 'Cefepime' ~ 'Maxipime',
# official == 'Cefixime' ~ 'Suprax',
# official == 'Cefoperazone' ~ 'Cefobid',
# official == 'Cefotaxime' ~ 'Claforan',
# official == 'Cefotetan' ~ 'Cefotan',
# official == 'Cefoxitin' ~ 'Mefoxin',
# official == 'Cefpodoxime' ~ 'Vantin',
# official == 'Cefprozil' ~ 'Cefzil',
# official == 'Ceftaroline' ~ 'Teflaro',
# official == 'Ceftazidime' ~ 'Fortaz|Tazicef|Tazidime',
# official == 'Ceftibuten' ~ 'Cedax',
# official == 'Ceftizoxime' ~ 'Cefizox',
# official == 'Ceftriaxone' ~ 'Rocephin',
# official == 'Cefuroxime' ~ 'Ceftin|Zinacef',
# official == 'Cephalexin' ~ 'Keflex|Panixine',
# official == 'Cephalothin' ~ 'Keflin',
# official == 'Chloramphenicol' ~ 'Chloromycetin',
# official == 'Ciprofloxacin' ~ 'Cipro|Ciloxan|Ciproxin',
# official == 'Clarithromycin' ~ 'Biaxin',
# official == 'Clindamycin' ~ 'Cleocin|Clinda-Derm|Clindagel|Clindesse|Clindets|Evoclin',
# official == 'Colistin' ~ 'Coly-Mycin',
# official == 'Daptomycin' ~ 'Cubicin',
# official == 'Doxycycline' ~ 'Doryx|Monodox|Vibramycin|Atridox|Oracea|Periostat|Vibra-Tabs',
# official == 'Doripenem' ~ 'Doribax',
# official == 'Ertapenem' ~ 'Invanz',
# official == 'Erythromycin' ~ 'Eryc|EryPed|Erythrocin|E-Base|E-Glades|E-Mycin|E.E.S.|Ery-Tab|Eryderm|Erygel|Erythra-derm|Eryzole|Pediamycin',
# official == 'Fosfomycin' ~ 'Monurol',
# official == 'Flucloxacillin' ~ 'Flopen|Floxapen|Fluclox|Sesamol|Softapen|Staphylex',
# official == 'Gentamicin' ~ 'Garamycin|Genoptic',
# official == 'Imipenem' ~ 'Primaxin',
# official == 'Kanamycin' ~ 'Kantrex',
# official == 'Levofloxacin' ~ 'Levaquin|Quixin',
# official == 'Linezolid' ~ 'Zyvox',
# official == 'Lomefloxacin' ~ 'Maxaquin',
# official == 'Meropenem' ~ 'Merrem',
# official == 'Metronidazole' ~ 'Flagyl|MetroGel|MetroCream|MetroLotion',
# official == 'Mezlocillin' ~ 'Mezlin',
# official == 'Minocycline' ~ 'Arestin|Solodyn',
# official == 'Moxifloxacin' ~ 'Avelox|Vigamox',
# official == 'Mupirocin' ~ 'Bactroban|Centany',
# official == 'Nafcillin' ~ 'Unipen',
# official == 'Nalidixic acid' ~ 'NegGram',
# official == 'Nitrofurantoin' ~ 'Furadantin|Macrobid|Macrodantin',
# official == 'Norfloxacin' ~ 'Noroxin',
# official == 'Ofloxacin' ~ 'Floxin|Ocuflox|Ophthalmic',
# official == 'Oxacillin' ~ 'Bactocill',
# official == 'Benzylpenicillin' ~ 'Permapen|Pfizerpen|Veetids',
# official == 'Penicillins, combinations with other antibacterials' ~ 'Permapen|Pfizerpen|Veetids',
# official == 'Piperacillin' ~ 'Pipracil',
# official == 'Piperacillin and beta-lactamase inhibitor' ~ 'Zosyn',
# official == 'Polymyxin B' ~ 'Poly-RX',
# official == 'Quinupristin/dalfopristin' ~ 'Synercid',
# official == 'Rifampin' ~ 'Rifadin|Rifamate|Rimactane',
# official == 'Spectinomycin' ~ 'Trobicin',
# official == 'Streptomycin' ~ 'Streptomycin Sulfate',
# official == 'Teicoplanin' ~ 'Targocid',
# official == 'Telavancin' ~ 'Vibativ',
# official == 'Telithromcyin' ~ 'Ketek',
# official == 'Tetracycline' ~ 'Sumycin|Bristacycline|Tetrex',
# official == 'Ticarcillin' ~ 'Ticar',
# official == 'Ticarcillin and beta-lactamase inhibitor' ~ 'Timentin',
# official == 'Tigecycline' ~ 'Tygacil',
# official == 'Tobramycin' ~ 'Tobi|Aktob|Tobre',
# official == 'Trimethoprim' ~ 'Primsol|Proloprim',
# official == 'Sulfamethoxazole and trimethoprim' ~ 'Bactrim|Septra|Sulfatrim',
# official == 'Vancomycin' ~ 'Vancocin|Vancomycin Hydrochloride',
# TRUE ~ NA_character_)
# )
# last two columns created with:
# antibiotics %>%
# mutate(useful_gramnegative =

View File

@ -116,7 +116,7 @@ EUCAST_rules <- function(tbl,
EUCAST_VERSION <- "3.1"
if (!col_bactid %in% colnames(tbl)) {
stop('Column ', col_bactid, ' not found.')
stop('Column ', col_bactid, ' not found.', call. = FALSE)
}
# check columns
@ -126,88 +126,65 @@ EUCAST_rules <- function(tbl,
levo, linc, line, mero, mino, moxi, nali, neom, neti, nitr,
novo, norf, oflo, peni, pita, poly, qida, rifa, roxi, siso,
teic, tetr, tica, tige, tobr, trim, trsu, vanc)
col.list <- col.list[!is.na(col.list)]
col.list.bak <- col.list
# are they available as upper case or lower case then?
for (i in 1:length(col.list)) {
if (toupper(col.list[i]) %in% colnames(tbl)) {
col.list[i] <- toupper(col.list[i])
} else if (tolower(col.list[i]) %in% colnames(tbl)) {
col.list[i] <- tolower(col.list[i])
} else if (!col.list[i] %in% colnames(tbl)) {
col.list[i] <- NA
}
}
if (!all(col.list %in% colnames(tbl))) {
if (info == TRUE) {
cat('\n')
}
if (info == TRUE) {
warning('These columns do not exist and will be ignored: ',
col.list.bak[!(col.list %in% colnames(tbl))] %>% toString(),
immediate. = TRUE,
call. = FALSE)
}
}
amcl <- col.list[1]
amik <- col.list[2]
amox <- col.list[3]
ampi <- col.list[4]
azit <- col.list[5]
aztr <- col.list[6]
cefa <- col.list[7]
cfra <- col.list[8]
cfep <- col.list[9]
cfot <- col.list[10]
cfox <- col.list[11]
cfta <- col.list[12]
cftr <- col.list[13]
cfur <- col.list[14]
chlo <- col.list[15]
cipr <- col.list[16]
clar <- col.list[17]
clin <- col.list[18]
clox <- col.list[19]
coli <- col.list[20]
czol <- col.list[21]
dapt <- col.list[22]
doxy <- col.list[23]
erta <- col.list[24]
eryt <- col.list[25]
fosf <- col.list[26]
fusi <- col.list[27]
gent <- col.list[28]
imip <- col.list[29]
kana <- col.list[30]
levo <- col.list[31]
linc <- col.list[32]
line <- col.list[33]
mero <- col.list[34]
mino <- col.list[35]
moxi <- col.list[36]
nali <- col.list[37]
neom <- col.list[38]
neti <- col.list[39]
nitr <- col.list[40]
novo <- col.list[41]
norf <- col.list[42]
oflo <- col.list[43]
peni <- col.list[44]
pita <- col.list[45]
poly <- col.list[46]
qida <- col.list[47]
rifa <- col.list[48]
roxi <- col.list[49]
siso <- col.list[50]
teic <- col.list[51]
tetr <- col.list[52]
tica <- col.list[53]
tige <- col.list[54]
tobr <- col.list[55]
trim <- col.list[56]
trsu <- col.list[57]
vanc <- col.list[58]
col.list <- check_available_columns(tbl = tbl, col.list = col.list, info = info)
amcl <- col.list[amcl]
amik <- col.list[amik]
amox <- col.list[amox]
ampi <- col.list[ampi]
azit <- col.list[azit]
aztr <- col.list[aztr]
cefa <- col.list[cefa]
cfra <- col.list[cfra]
cfep <- col.list[cfep]
cfot <- col.list[cfot]
cfox <- col.list[cfox]
cfta <- col.list[cfta]
cftr <- col.list[cftr]
cfur <- col.list[cfur]
chlo <- col.list[chlo]
cipr <- col.list[cipr]
clar <- col.list[clar]
clin <- col.list[clin]
clox <- col.list[clox]
coli <- col.list[coli]
czol <- col.list[czol]
dapt <- col.list[dapt]
doxy <- col.list[doxy]
erta <- col.list[erta]
eryt <- col.list[eryt]
fosf <- col.list[fosf]
fusi <- col.list[fusi]
gent <- col.list[gent]
imip <- col.list[imip]
kana <- col.list[kana]
levo <- col.list[levo]
linc <- col.list[linc]
line <- col.list[line]
mero <- col.list[mero]
mino <- col.list[mino]
moxi <- col.list[moxi]
nali <- col.list[nali]
neom <- col.list[neom]
neti <- col.list[neti]
nitr <- col.list[nitr]
novo <- col.list[novo]
norf <- col.list[norf]
oflo <- col.list[oflo]
peni <- col.list[peni]
pita <- col.list[pita]
poly <- col.list[poly]
qida <- col.list[qida]
rifa <- col.list[rifa]
roxi <- col.list[roxi]
siso <- col.list[siso]
teic <- col.list[teic]
tetr <- col.list[tetr]
tica <- col.list[tica]
tige <- col.list[tige]
tobr <- col.list[tobr]
trim <- col.list[trim]
trsu <- col.list[trsu]
vanc <- col.list[vanc]
total <- 0
total_rows <- integer(0)

View File

@ -436,6 +436,10 @@ key_antibiotics <- function(tbl,
keylist <- character(length = nrow(tbl))
if (!col_bactid %in% colnames(tbl)) {
stop('Column ', col_bactid, ' not found.', call. = FALSE)
}
# check columns
col.list <- c(amox, cfot, cfta, cftr, cfur, cipr, clar,
clin, clox, doxy, gent, line, mero, peni,

View File

@ -17,6 +17,7 @@
# ==================================================================== #
globalVariables(c('abname',
'atc',
'bactid',
'cnt',
'Count',
@ -35,6 +36,7 @@ globalVariables(c('abname',
'key_ab_other',
'mic',
'mocode',
'molis',
'n',
'other_pat_or_mo',
'patient_id',
@ -42,5 +44,6 @@ globalVariables(c('abname',
'quantile',
'real_first_isolate',
'species',
'umcg',
'y',
'.'))

295
R/mdro.R
View File

@ -20,42 +20,112 @@
#'
#' Determine which isolates are multidrug-resistant organisms (MDRO) according to country-specific guidelines.
#' @param tbl table with antibiotic columns, like e.g. \code{amox} and \code{amcl}
#' @param country country to determine guidelines. Should be a code from the \href{https://en.wikipedia.org/wiki/ISO_3166-1_alpha-2#Officially_assigned_code_elements}{list of ISO 3166-1 alpha-2 country codes}. Case-insensitive. Currently supported are \code{de} (Germany) and \code{nl} (the Netherlands).
#' @param country country code to determine guidelines. EUCAST rules will be used when left empty, see Details. Should be or a code from the \href{https://en.wikipedia.org/wiki/ISO_3166-1_alpha-2#Officially_assigned_code_elements}{list of ISO 3166-1 alpha-2 country codes}. Case-insensitive. Currently supported are \code{de} (Germany) and \code{nl} (the Netherlands).
#' @param col_bactid column name of the bacteria ID in \code{tbl} - values of this column should be present in \code{microorganisms$bactid}, see \code{\link{microorganisms}}
#' @param info print progress
#' @param aminoglycosides,quinolones,carbapenems character vector with column names of antibiotics
#' @param ceftazidime,piperacillin,trimethoprim_sulfa,penicillin,vancomycin column names of antibiotics
#' @param ... parameters that are passed on to \code{MDR}
#' @return Ordered factor with values \code{Positive}, \code{Unconfirmed}, \code{Negative}.
#' @param amcl,amik,amox,ampi,azit,aztr,cefa,cfra,cfep,cfot,cfox,cfta,cftr,cfur,chlo,cipr,clar,clin,clox,coli,czol,dapt,doxy,erta,eryt,fosf,fusi,gent,imip,kana,levo,linc,line,mero,metr,mino,moxi,nali,neom,neti,nitr,novo,norf,oflo,peni,pita,poly,qida,rifa,roxi,siso,teic,tetr,tica,tige,tobr,trim,trsu,vanc column names of antibiotics. column names of antibiotics
#' @param ... parameters that are passed on to methods
#' @details When \code{country} will be left blank, guidelines will be taken from EUCAST Expert Rules Version 3.1 "Intrinsic Resistance and Exceptional Phenotypes Tables" (\url{http://www.eucast.org/fileadmin/src/media/PDFs/EUCAST_files/Expert_Rules/Expert_rules_intrinsic_exceptional_V3.1.pdf}).
#' @return Ordered factor with levels \code{Unknown < Negative < Unconfirmed < Positive}.
#' @rdname MDRO
#' @export
#' @examples
#' library(dplyr)
#'
#' septic_patients %>%
#' mutate(EUCAST = MDRO(.),
#' BRMO = MDRO(., "nl"))
MDRO <- function(tbl,
country,
country = NULL,
col_bactid = 'bactid',
info = TRUE,
aminoglycosides = c('gent', 'tobr', 'kana'),
quinolones = c('cipr', 'norf'),
carbapenems = c('imip', 'mero', 'erta'),
ceftazidime = 'cfta',
piperacillin = 'pita',
trimethoprim_sulfa = 'trsu',
penicillin = 'peni',
vancomycin = 'vanc') {
amcl = 'amcl',
amik = 'amik',
amox = 'amox',
ampi = 'ampi',
azit = 'azit',
aztr = 'aztr',
cefa = 'cefa',
cfra = 'cfra',
cfep = 'cfep',
cfot = 'cfot',
cfox = 'cfox',
cfta = 'cfta',
cftr = 'cftr',
cfur = 'cfur',
chlo = 'chlo',
cipr = 'cipr',
clar = 'clar',
clin = 'clin',
clox = 'clox',
coli = 'coli',
czol = 'czol',
dapt = 'dapt',
doxy = 'doxy',
erta = 'erta',
eryt = 'eryt',
fosf = 'fosf',
fusi = 'fusi',
gent = 'gent',
imip = 'imip',
kana = 'kana',
levo = 'levo',
linc = 'linc',
line = 'line',
mero = 'mero',
metr = 'metr',
mino = 'mino',
moxi = 'moxi',
nali = 'nali',
neom = 'neom',
neti = 'neti',
nitr = 'nitr',
novo = 'novo',
norf = 'norf',
oflo = 'oflo',
peni = 'peni',
pita = 'pita',
poly = 'poly',
qida = 'qida',
rifa = 'rifa',
roxi = 'roxi',
siso = 'siso',
teic = 'teic',
tetr = 'tetr',
tica = 'tica',
tige = 'tige',
tobr = 'tobr',
trim = 'trim',
trsu = 'trsu',
vanc = 'vanc') {
if (!col_bactid %in% colnames(tbl)) {
stop('Column ', col_bactid, ' not found.', call. = FALSE)
}
# strip whitespaces
country <- trimws(country)
if (length(country) > 1) {
stop('`country` must be a length one character string.', call. = FALSE)
}
if (!country %like% '^[a-z]{2}$') {
if (is.null(country)) {
country <- 'EUCAST'
}
country <- trimws(country)
if (country != 'EUCAST' & !country %like% '^[a-z]{2}$') {
stop('This is not a valid ISO 3166-1 alpha-2 country code: "', country, '". Please see ?MDRO.', call. = FALSE)
}
# create list and make country code case-independent
guideline <- list(country = list(code = tolower(country)))
# support per country
if (guideline$country$code == 'de') {
if (guideline$country$code == 'eucast') {
guideline$country$name <- '(European guidelines)'
guideline$name <- 'EUCAST Expert Rules, "Intrinsic Resistance and Exceptional Phenotypes Tables"'
guideline$version <- 'Version 3.1'
guideline$source <- 'http://www.eucast.org/fileadmin/src/media/PDFs/EUCAST_files/Expert_Rules/Expert_rules_intrinsic_exceptional_V3.1.pdf'
# support per country:
} else if (guideline$country$code == 'de') {
guideline$country$name <- 'Germany'
guideline$name <- ''
guideline$version <- ''
@ -79,38 +149,177 @@ MDRO <- function(tbl,
ANSI_reset <- "\033[0m"
if (info == TRUE) {
cat("Determining Highly Resistant Microorganisms (MDRO), according to:\n",
cat("Determining multidrug-resistant organisms (MDRO), according to:\n",
"Guideline: ", ANSI_red, guideline$name, ", ", guideline$version, ANSI_reset, "\n",
"Country : ", ANSI_red, guideline$country$name, ANSI_reset, "\n",
"Source : ", ANSI_blue, guideline$source, ANSI_reset, "\n",
"\n", sep = "")
}
# check columns
col.list <- c(amcl, amik, amox, ampi, azit, aztr, cefa, cfra, cfep, cfot,
cfox, cfta, cftr, cfur, chlo, cipr, clar, clin, clox, coli,
czol, dapt, doxy, erta, eryt, fosf, fusi, gent, imip, kana,
levo, linc, line, mero, metr, mino, moxi, nali, neom, neti, nitr,
novo, norf, oflo, peni, pita, poly, qida, rifa, roxi, siso,
teic, tetr, tica, tige, tobr, trim, trsu, vanc)
col.list <- check_available_columns(tbl = tbl, col.list = col.list, info = info)
amcl <- col.list[amcl]
amik <- col.list[amik]
amox <- col.list[amox]
ampi <- col.list[ampi]
azit <- col.list[azit]
aztr <- col.list[aztr]
cefa <- col.list[cefa]
cfra <- col.list[cfra]
cfep <- col.list[cfep]
cfot <- col.list[cfot]
cfox <- col.list[cfox]
cfta <- col.list[cfta]
cftr <- col.list[cftr]
cfur <- col.list[cfur]
chlo <- col.list[chlo]
cipr <- col.list[cipr]
clar <- col.list[clar]
clin <- col.list[clin]
clox <- col.list[clox]
coli <- col.list[coli]
czol <- col.list[czol]
dapt <- col.list[dapt]
doxy <- col.list[doxy]
erta <- col.list[erta]
eryt <- col.list[eryt]
fosf <- col.list[fosf]
fusi <- col.list[fusi]
gent <- col.list[gent]
imip <- col.list[imip]
kana <- col.list[kana]
levo <- col.list[levo]
linc <- col.list[linc]
line <- col.list[line]
mero <- col.list[mero]
metr <- col.list[metr]
mino <- col.list[mino]
moxi <- col.list[moxi]
nali <- col.list[nali]
neom <- col.list[neom]
neti <- col.list[neti]
nitr <- col.list[nitr]
novo <- col.list[novo]
norf <- col.list[norf]
oflo <- col.list[oflo]
peni <- col.list[peni]
pita <- col.list[pita]
poly <- col.list[poly]
qida <- col.list[qida]
rifa <- col.list[rifa]
roxi <- col.list[roxi]
siso <- col.list[siso]
teic <- col.list[teic]
tetr <- col.list[tetr]
tica <- col.list[tica]
tige <- col.list[tige]
tobr <- col.list[tobr]
trim <- col.list[trim]
trsu <- col.list[trsu]
vanc <- col.list[vanc]
# antibiotic classes
aminoglycosides <- c(tobr, gent, kana, neom, neti, siso)
tetracyclines <- c(doxy, mino, tetr) # since EUCAST v3.1 tige(cycline) is set apart
polymyxins <- c(poly, coli)
macrolides <- c(eryt, azit, roxi, clar) # since EUCAST v3.1 clin(damycin) is set apart
glycopeptides <- c(vanc, teic)
streptogramins <- qida # should officially also be pristinamycin and quinupristin/dalfopristin
cephalosporins <- c(cfep, cfot, cfox, cfra, cfta, cftr, cfur, czol)
cephalosporins_3rd <- c(cfot, cftr, cfta)
carbapenems <- c(erta, imip, mero)
aminopenicillins <- c(ampi, amox)
ureidopenicillins <- pita # should officially also be azlo and mezlo
fluoroquinolones <- c(oflo, cipr, norf, levo, moxi)
# helper function for editing the table
trans_tbl <- function(to, rows, cols) {
cols <- cols[!is.na(cols)]
if (length(rows) > 0 & length(cols) > 0) {
col_filter <- which(tbl[, cols] == 'R')
rows <- rows[rows %in% col_filter]
tbl[rows, 'MDRO'] <<- to
}
}
# join microorganisms
tbl <- tbl %>% left_join_microorganisms(col_bactid)
tbl$MDRO <- 1
tbl$MDRO <- NA_integer_
if (guideline$country$code == 'eucast') {
# EUCAST ------------------------------------------------------------------
# Table 5
trans_tbl(4,
which(tbl$family == 'Enterobacteriaceae'
| tbl$fullname %like% '^Pseudomonas aeruginosa'
| tbl$genus == 'Acinetobacter'),
coli)
trans_tbl(4,
which(tbl$fullname %like% '^Salmonella Typhi'),
c(carbapenems, fluoroquinolones))
trans_tbl(4,
which(tbl$fullname %like% '^Haemophilus influenzae'),
c(cephalosporins_3rd, carbapenems, fluoroquinolones))
trans_tbl(4,
which(tbl$fullname %like% '^Moraxella catarrhalis'),
c(cephalosporins_3rd, fluoroquinolones))
trans_tbl(4,
which(tbl$fullname %like% '^Neisseria meningitidis'),
c(cephalosporins_3rd, fluoroquinolones))
trans_tbl(4,
which(tbl$fullname %like% '^Neisseria gonorrhoeae'),
azit)
# Table 6
trans_tbl(4,
which(tbl$fullname %like% '^Staphylococcus (aureus|epidermidis|coagulase negatief|hominis|haemolyticus|intermedius|pseudointermedius)'),
c(vanc, teic, dapt, line, qida, tige))
trans_tbl(4,
which(tbl$genus == 'Corynebacterium'),
c(vanc, teic, dapt, line, qida, tige))
trans_tbl(4,
which(tbl$fullname %like% '^Streptococcus pneumoniae'),
c(carbapenems, vanc, teic, dapt, line, qida, tige, rifa))
trans_tbl(4, # Sr. groups A/B/C/G
which(tbl$fullname %like% '^Streptococcus (pyogenes|agalactiae|equisimilis|equi|zooepidemicus|dysgalactiae|anginosus)'),
c(peni, cephalosporins, vanc, teic, dapt, line, qida, tige))
trans_tbl(4,
which(tbl$genus == 'Enterococcus'),
c(dapt, line, tige, teic))
trans_tbl(4,
which(tbl$fullname %like% '^Enterococcus faecalis'),
c(ampi, amox))
# Table 7
trans_tbl(4,
which(tbl$genus == 'Bacteroides'),
metr)
trans_tbl(4,
which(tbl$fullname %like% '^Clostridium difficile'),
c(metr, vanc))
}
if (guideline$country$code == 'de') {
# Germany -----------------------------------------------------------------
stop("We are still working on German guidelines in this beta version.", call. = FALSE)
}
if (guideline$country$code == 'nl') {
# BRMO; Bijzonder Resistente Micro-Organismen
aminoglycosides <- aminoglycosides[aminoglycosides %in% colnames(tbl)]
quinolones <- quinolones[quinolones %in% colnames(tbl)]
carbapenems <- carbapenems[carbapenems %in% colnames(tbl)]
if (!ceftazidime %in% colnames(tbl)) { ceftazidime <- NA }
if (!piperacillin %in% colnames(tbl)) { piperacillin <- NA }
if (!trimethoprim_sulfa %in% colnames(tbl)) { trimethoprim_sulfa <- NA }
if (!penicillin %in% colnames(tbl)) { penicillin <- NA }
if (!vancomycin %in% colnames(tbl)) { vancomycin <- NA }
# Netherlands -------------------------------------------------------------
aminoglycosides <- aminoglycosides[!is.na(aminoglycosides)]
fluoroquinolones <- fluoroquinolones[!is.na(fluoroquinolones)]
carbapenems <- carbapenems[!is.na(carbapenems)]
# Table 1
tbl[which(
tbl$family == 'Enterobacteriaceae'
& rowSums(tbl[, aminoglycosides] == 'R', na.rm = TRUE) >= 1
& rowSums(tbl[, quinolones] == 'R', na.rm = TRUE) >= 1
& rowSums(tbl[, fluoroquinolones] == 'R', na.rm = TRUE) >= 1
), 'MDRO'] <- 4
tbl[which(
tbl$family == 'Enterobacteriaceae'
@ -130,7 +339,7 @@ MDRO <- function(tbl,
tbl[which(
tbl$genus == 'Acinetobacter'
& rowSums(tbl[, aminoglycosides] == 'R', na.rm = TRUE) >= 1
& rowSums(tbl[, quinolones] == 'R', na.rm = TRUE) >= 1
& rowSums(tbl[, fluoroquinolones] == 'R', na.rm = TRUE) >= 1
), 'MDRO'] <- 4
# rest of Acinetobacter is negative
tbl[which(
@ -140,7 +349,7 @@ MDRO <- function(tbl,
tbl[which(
tbl$fullname %like% 'Stenotrophomonas maltophilia'
& tbl[, trimethoprim_sulfa] == 'R'
& tbl[, trsu] == 'R'
), 'MDRO'] <- 4
# rest of Stenotrophomonas is negative
tbl[which(
@ -152,9 +361,9 @@ MDRO <- function(tbl,
tbl$fullname %like% 'Pseudomonas aeruginosa'
& sum(rowSums(tbl[, carbapenems] == 'R', na.rm = TRUE) >= 1,
rowSums(tbl[, aminoglycosides] == 'R', na.rm = TRUE) >= 1,
rowSums(tbl[, quinolones] == 'R', na.rm = TRUE) >= 1,
tbl[, ceftazidime] == 'R',
tbl[, piperacillin] == 'R') >= 3
rowSums(tbl[, fluoroquinolones] == 'R', na.rm = TRUE) >= 1,
tbl[, cfta] == 'R',
tbl[, pita] == 'R') >= 3
), 'MDRO'] <- 4
# rest of Pseudomonas is negative
tbl[which(
@ -165,11 +374,11 @@ MDRO <- function(tbl,
# Table 3
tbl[which(
tbl$fullname %like% 'Streptococcus pneumoniae'
& tbl[, penicillin] == 'R'
& tbl[, peni] == 'R'
), 'MDRO'] <- 4
tbl[which(
tbl$fullname %like% 'Streptococcus pneumoniae'
& tbl[, vancomycin] == 'R'
& tbl[, vanc] == 'R'
), 'MDRO'] <- 4
# rest of Streptococcus pneumoniae is negative
tbl[which(
@ -179,7 +388,7 @@ MDRO <- function(tbl,
tbl[which(
tbl$fullname %like% 'Enterococcus faecium'
& rowSums(tbl[, c(penicillin, vancomycin)] == 'R', na.rm = TRUE) >= 1
& rowSums(tbl[, c(peni, vanc)] == 'R', na.rm = TRUE) >= 1
), 'MDRO'] <- 4
# rest of Enterococcus faecium is negative
tbl[which(
@ -197,11 +406,17 @@ MDRO <- function(tbl,
#' @rdname MDRO
#' @export
BRMO <- function(tbl, country = "nl", ...) {
MDRO(tbl = tbl, country = country, ...)
MDRO(tbl = tbl, country = "nl", ...)
}
#' @rdname MDRO
#' @export
MRGN <- function(tbl, country = "de", ...) {
MDRO(tbl = tbl, country = country, ...)
MDRO(tbl = tbl, country = "de", ...)
}
#' @rdname MDRO
#' @export
EUCAST_exceptional_phenotypes <- function(tbl, country = "EUCAST", ...) {
MDRO(tbl = tbl, country = "EUCAST", ...)
}

View File

@ -73,6 +73,7 @@ check_available_columns <- function(tbl, col.list, info = TRUE) {
if (info == TRUE) {
warning('These columns do not exist and will be ignored: ',
col.list.bak[!(col.list %in% colnames(tbl))] %>% toString(),
'.\nTHIS MAY STRONGLY INFLUENCE THE OUTCOME.',
immediate. = TRUE,
call. = FALSE)
}