2018-02-21 11:52:31 +01:00
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Analysis #
# #
# AUTHORS #
# Berends MS (m.s.berends@umcg.nl), Luz CF (c.f.luz@umcg.nl) #
# #
# LICENCE #
# This program is free software; you can redistribute it and/or modify #
# it under the terms of the GNU General Public License version 2.0, #
# as published by the Free Software Foundation. #
# #
# This program is distributed in the hope that it will be useful, #
# but WITHOUT ANY WARRANTY; without even the implied warranty of #
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the #
# GNU General Public License for more details. #
# ==================================================================== #
#' EUCAST expert rules
#'
#' Apply expert rules (like intrinsic resistance), as defined by the European Committee on Antimicrobial Susceptibility Testing (EUCAST, \url{http://eucast.org}), see \emph{Source}.
#' @param tbl table with antibiotic columns, like e.g. \code{amox} and \code{amcl}
2018-03-23 14:46:02 +01:00
#' @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}}
2018-02-21 11:52:31 +01:00
#' @param info print progress
#' @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,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. Use \code{NA} to skip a column, like \code{tica = NA}. Non-existing column will be skipped.
#' @param ... parameters that are passed on to \code{EUCAST_rules}
#' @rdname EUCAST
#' @export
#' @importFrom dplyr %>% left_join select
2018-02-22 20:48:48 +01:00
#' @return table with edited variables of antibiotics.
2018-02-21 11:52:31 +01:00
#' @source
#' EUCAST Expert Rules Version 2.0: \cr
#' Leclercq et al. \strong{EUCAST expert rules in antimicrobial susceptibility testing.} \emph{Clin Microbiol Infect.} 2013;19(2):141-60. \cr
#' \url{https://doi.org/10.1111/j.1469-0691.2011.03703.x} \cr
#' \cr
2018-03-23 14:46:02 +01:00
#' EUCAST Expert Rules Version 3.1 (Intrinsic Resistance and Exceptional Phenotypes Tables): \cr
#' \url{http://www.eucast.org/fileadmin/src/media/PDFs/EUCAST_files/Expert_Rules/Expert_rules_intrinsic_exceptional_V3.1.pdf}
2018-02-21 11:52:31 +01:00
#' @examples
2018-05-02 14:56:25 +02:00
#' a <- EUCAST_rules(septic_patients)
2018-03-13 14:40:52 +01:00
#' a <- data.frame(bactid = c("STAAUR", # Staphylococcus aureus
#' "ENCFAE", # Enterococcus faecalis
#' "ESCCOL", # Escherichia coli
#' "KLEPNE", # Klebsiella pneumoniae
#' "PSEAER"), # Pseudomonas aeruginosa
#' vanc = "-", # Vancomycin
#' amox = "-", # Amoxicillin
#' coli = "-", # Colistin
#' cfta = "-", # Ceftazidime
#' cfur = "-", # Cefuroxime
2018-02-22 21:37:10 +01:00
#' stringsAsFactors = FALSE)
#' a
2018-04-02 16:05:09 +02:00
#'
2018-03-13 14:40:52 +01:00
#' b <- EUCAST_rules(a)
2018-02-22 21:37:10 +01:00
#' b
2018-02-21 11:52:31 +01:00
EUCAST_rules <- function ( tbl ,
2018-03-23 14:46:02 +01:00
col_bactid = ' bactid' ,
2018-02-21 11:52:31 +01:00
info = TRUE ,
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' ,
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' ) {
2018-03-23 14:46:02 +01:00
EUCAST_VERSION <- " 3.1"
if ( ! col_bactid %in% colnames ( tbl ) ) {
2018-04-25 15:33:58 +02:00
stop ( ' Column ' , col_bactid , ' not found.' , call. = FALSE )
2018-02-21 11:52:31 +01:00
}
2018-04-02 16:05:09 +02:00
2018-03-23 14:46:02 +01:00
# 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 , mino , moxi , nali , neom , neti , nitr ,
novo , norf , oflo , peni , pita , poly , qida , rifa , roxi , siso ,
teic , tetr , tica , tige , tobr , trim , trsu , vanc )
2018-04-25 15:33:58 +02:00
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 ]
2018-04-02 16:05:09 +02:00
2018-02-21 11:52:31 +01:00
total <- 0
2018-02-26 14:37:40 +01:00
total_rows <- integer ( 0 )
2018-04-02 16:05:09 +02:00
2018-03-23 14:46:02 +01:00
# helper function for editing the table
2018-02-21 11:52:31 +01:00
edit_rsi <- function ( to , rows , cols ) {
cols <- cols [ ! is.na ( cols ) ]
if ( length ( rows ) > 0 & length ( cols ) > 0 ) {
tbl [rows , cols ] <<- to
total <<- total + ( length ( rows ) * length ( cols ) )
2018-02-26 14:37:40 +01:00
total_rows <<- c ( total_rows , rows )
2018-02-21 11:52:31 +01:00
}
}
2018-04-02 16:05:09 +02:00
2018-03-23 14:46:02 +01:00
# join to microorganisms table
2018-07-23 14:14:03 +02:00
if ( ! tbl %>% pull ( col_bactid ) %>% is.bactid ( ) ) {
tbl [ , col_bactid ] <- tbl %>% pull ( col_bactid ) %>% as.bactid ( )
}
tbl <- tbl %>% left_join_microorganisms ( by = col_bactid , suffix = c ( " _tempmicroorganisms" , " " ) )
2018-04-02 16:05:09 +02:00
2018-03-23 14:46:02 +01:00
# 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 clinda 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 )
2018-02-21 11:52:31 +01:00
carbapenems <- c ( erta , imip , mero )
2018-03-23 14:46:02 +01:00
aminopenicillins <- c ( ampi , amox )
ureidopenicillins <- pita # should officially also be azlo and mezlo
fluoroquinolones <- c ( oflo , cipr , norf , levo , moxi )
2018-04-02 16:05:09 +02:00
2018-02-21 11:52:31 +01:00
if ( info == TRUE ) {
2018-03-23 14:46:02 +01:00
cat (
paste0 (
' \nApplying rules to ' ,
2018-02-26 14:37:40 +01:00
tbl [ ! is.na ( tbl $ genus ) , ] %>% nrow ( ) %>% format ( big.mark = " ," ) ,
2018-03-23 14:46:02 +01:00
' rows according to "EUCAST Expert Rules Version ' , EUCAST_VERSION , ' "\n' )
)
2018-02-21 11:52:31 +01:00
}
2018-04-02 16:05:09 +02:00
2018-02-21 11:52:31 +01:00
# Table 1: Intrinsic resistance in Enterobacteriaceae ----
if ( info == TRUE ) {
cat ( ' ...Table 1: Intrinsic resistance in Enterobacteriaceae\n' )
}
2018-03-23 14:46:02 +01:00
# Intrisiek R for this group
2018-02-21 11:52:31 +01:00
edit_rsi ( to = ' R' ,
rows = which ( tbl $ family == ' Enterobacteriaceae' ) ,
2018-03-23 14:46:02 +01:00
cols = c ( peni , glycopeptides , fusi , macrolides , linc , streptogramins , rifa , dapt , line ) )
2018-02-21 11:52:31 +01:00
# Citrobacter
edit_rsi ( to = ' R' ,
rows = which ( tbl $ fullname %like% ' ^Citrobacter (koseri|amalonaticus|sedlakii|farmeri|rodentium)' ) ,
2018-03-23 14:46:02 +01:00
cols = c ( aminopenicillins , tica ) )
2018-02-21 11:52:31 +01:00
edit_rsi ( to = ' R' ,
rows = which ( tbl $ fullname %like% ' ^Citrobacter (freundii|braakii|murliniae|werkmanii|youngae)' ) ,
2018-03-23 14:46:02 +01:00
cols = c ( aminopenicillins , amcl , czol , cfox ) )
2018-02-21 11:52:31 +01:00
# Enterobacter
edit_rsi ( to = ' R' ,
rows = which ( tbl $ fullname %like% ' ^Enterobacter cloacae' ) ,
2018-03-23 14:46:02 +01:00
cols = c ( aminopenicillins , amcl , czol , cfox ) )
2018-02-21 11:52:31 +01:00
edit_rsi ( to = ' R' ,
rows = which ( tbl $ fullname %like% ' ^Enterobacter aerogenes' ) ,
2018-03-23 14:46:02 +01:00
cols = c ( aminopenicillins , amcl , czol , cfox ) )
2018-02-21 11:52:31 +01:00
# Escherichia
edit_rsi ( to = ' R' ,
rows = which ( tbl $ fullname %like% ' ^Escherichia hermanni' ) ,
2018-03-23 14:46:02 +01:00
cols = c ( aminopenicillins , tica ) )
2018-02-21 11:52:31 +01:00
# Hafnia
edit_rsi ( to = ' R' ,
rows = which ( tbl $ fullname %like% ' ^Hafnia alvei' ) ,
2018-03-23 14:46:02 +01:00
cols = c ( aminopenicillins , amcl , czol , cfox ) )
2018-02-21 11:52:31 +01:00
# Klebsiella
edit_rsi ( to = ' R' ,
rows = which ( tbl $ fullname %like% ' ^Klebsiella' ) ,
2018-03-23 14:46:02 +01:00
cols = c ( aminopenicillins , tica ) )
2018-02-21 11:52:31 +01:00
# Morganella / Proteus
edit_rsi ( to = ' R' ,
rows = which ( tbl $ fullname %like% ' ^Morganella morganii' ) ,
2018-03-23 14:46:02 +01:00
cols = c ( aminopenicillins , amcl , czol , tetracyclines , polymyxins , nitr ) )
2018-02-21 11:52:31 +01:00
edit_rsi ( to = ' R' ,
rows = which ( tbl $ fullname %like% ' ^Proteus mirabilis' ) ,
2018-03-23 14:46:02 +01:00
cols = c ( tetracyclines , tige , polymyxins , nitr ) )
2018-02-21 11:52:31 +01:00
edit_rsi ( to = ' R' ,
rows = which ( tbl $ fullname %like% ' ^Proteus penneri' ) ,
2018-03-23 14:46:02 +01:00
cols = c ( aminopenicillins , czol , cfur , tetracyclines , tige , polymyxins , nitr ) )
2018-02-21 11:52:31 +01:00
edit_rsi ( to = ' R' ,
rows = which ( tbl $ fullname %like% ' ^Proteus vulgaris' ) ,
2018-03-23 14:46:02 +01:00
cols = c ( aminopenicillins , czol , cfur , tetracyclines , tige , polymyxins , nitr ) )
2018-02-21 11:52:31 +01:00
# Providencia
edit_rsi ( to = ' R' ,
rows = which ( tbl $ fullname %like% ' ^Providencia rettgeri' ) ,
2018-03-23 14:46:02 +01:00
cols = c ( aminopenicillins , amcl , czol , cfur , tetracyclines , tige , polymyxins , nitr ) )
2018-02-21 11:52:31 +01:00
edit_rsi ( to = ' R' ,
rows = which ( tbl $ fullname %like% ' ^Providencia stuartii' ) ,
2018-03-23 14:46:02 +01:00
cols = c ( aminopenicillins , amcl , czol , cfur , tetracyclines , tige , polymyxins , nitr ) )
2018-02-21 11:52:31 +01:00
# Raoultella
edit_rsi ( to = ' R' ,
rows = which ( tbl $ fullname %like% ' ^Raoultella' ) ,
2018-03-23 14:46:02 +01:00
cols = c ( aminopenicillins , tica ) )
2018-02-21 11:52:31 +01:00
# Serratia
edit_rsi ( to = ' R' ,
rows = which ( tbl $ fullname %like% ' ^Serratia marcescens' ) ,
2018-03-23 14:46:02 +01:00
cols = c ( aminopenicillins , amcl , czol , cfox , cfur , tetracyclines [tetracyclines != ' mino' ] , polymyxins , nitr ) )
2018-02-21 11:52:31 +01:00
# Yersinia
edit_rsi ( to = ' R' ,
rows = which ( tbl $ fullname %like% ' ^Yersinia enterocolitica' ) ,
2018-03-23 14:46:02 +01:00
cols = c ( aminopenicillins , amcl , tica , czol , cfox ) )
2018-02-21 11:52:31 +01:00
edit_rsi ( to = ' R' ,
rows = which ( tbl $ fullname %like% ' ^Yersinia pseudotuberculosis' ) ,
cols = c ( poly , coli ) )
2018-04-02 16:05:09 +02:00
2018-02-21 11:52:31 +01:00
# Table 2: Intrinsic resistance in non-fermentative Gram-negative bacteria ----
if ( info == TRUE ) {
cat ( ' ...Table 2: Intrinsic resistance in non-fermentative Gram-negative bacteria\n' )
}
2018-03-23 14:46:02 +01:00
# Intrisiek R for this group
2018-02-21 11:52:31 +01:00
edit_rsi ( to = ' R' ,
rows = which ( tbl $ genus %in% c ( ' Achromobacter' ,
' Acinetobacter' ,
' Alcaligenes' ,
' Bordatella' ,
' Burkholderia' ,
' Elizabethkingia' ,
' Flavobacterium' ,
' Ochrobactrum' ,
' Pseudomonas' ,
' Stenotrophomonas' ) ) ,
2018-03-23 14:46:02 +01:00
cols = c ( peni , cfox , cfur , glycopeptides , fusi , macrolides , linc , streptogramins , rifa , dapt , line ) )
2018-02-21 11:52:31 +01:00
# Acinetobacter
edit_rsi ( to = ' R' ,
rows = which ( tbl $ fullname %like% ' ^Acinetobacter (baumannii|pittii|nosocomialis|calcoaceticus)' ) ,
2018-03-23 14:46:02 +01:00
cols = c ( aminopenicillins , amcl , czol , cfot , cftr , aztr , erta , trim , fosf , tetracyclines [tetracyclines != ' mino' ] ) )
2018-02-21 11:52:31 +01:00
# Achromobacter
edit_rsi ( to = ' R' ,
rows = which ( tbl $ fullname %like% ' ^Achromobacter (xylosoxydans|xylosoxidans)' ) ,
2018-03-23 14:46:02 +01:00
cols = c ( aminopenicillins , czol , cfot , cftr , erta ) )
2018-02-21 11:52:31 +01:00
# Burkholderia
edit_rsi ( to = ' R' ,
# onder 'Burkholderia cepacia complex' vallen deze species allemaal: PMID 16217180.
rows = which ( tbl $ fullname %like% ' ^Burkholderia (cepacia|multivorans|cenocepacia|stabilis|vietnamiensis|dolosa|ambifaria|anthina|pyrrocinia|ubonensis)' ) ,
2018-03-23 14:46:02 +01:00
cols = c ( aminopenicillins , amcl , tica , pita , czol , cfot , cftr , aztr , erta , cipr , chlo , aminoglycosides , trim , fosf , polymyxins ) )
2018-02-21 11:52:31 +01:00
# Elizabethkingia
edit_rsi ( to = ' R' ,
rows = which ( tbl $ fullname %like% ' ^Elizabethkingia meningoseptic(a|um)' ) ,
2018-03-23 14:46:02 +01:00
cols = c ( aminopenicillins , amcl , tica , czol , cfot , cftr , cfta , cfep , aztr , erta , imip , mero , polymyxins ) )
2018-02-21 11:52:31 +01:00
# Ochrobactrum
edit_rsi ( to = ' R' ,
rows = which ( tbl $ fullname %like% ' ^Ochrobactrum anthropi' ) ,
2018-03-23 14:46:02 +01:00
cols = c ( aminopenicillins , amcl , tica , pita , czol , cfot , cftr , cfta , cfep , aztr , erta ) )
2018-02-21 11:52:31 +01:00
# Pseudomonas
edit_rsi ( to = ' R' ,
rows = which ( tbl $ fullname %like% ' ^Pseudomonas aeruginosa' ) ,
2018-03-23 14:46:02 +01:00
cols = c ( aminopenicillins , amcl , czol , cfot , cftr , erta , chlo , kana , neom , trim , trsu , tetracyclines , tige ) )
2018-02-21 11:52:31 +01:00
# Stenotrophomonas
edit_rsi ( to = ' R' ,
rows = which ( tbl $ fullname %like% ' ^Stenotrophomonas maltophilia' ) ,
2018-03-23 14:46:02 +01:00
cols = c ( aminopenicillins , amcl , tica , pita , czol , cfot , cftr , cfta , aztr , erta , imip , mero , aminoglycosides , trim , fosf , tetr ) )
2018-04-02 16:05:09 +02:00
2018-02-21 11:52:31 +01:00
# Table 3: Intrinsic resistance in other Gram-negative bacteria ----
if ( info == TRUE ) {
cat ( ' ...Table 3: Intrinsic resistance in other Gram-negative bacteria\n' )
}
2018-03-23 14:46:02 +01:00
# Intrisiek R for this group
2018-02-21 11:52:31 +01:00
edit_rsi ( to = ' R' ,
rows = which ( tbl $ genus %in% c ( ' Haemophilus' ,
' Moraxella' ,
' Neisseria' ,
' Campylobacter' ) ) ,
2018-03-23 14:46:02 +01:00
cols = c ( glycopeptides , linc , dapt , line ) )
2018-02-21 11:52:31 +01:00
# Haemophilus
edit_rsi ( to = ' R' ,
rows = which ( tbl $ fullname %like% ' ^Haemophilus influenzae' ) ,
2018-03-23 14:46:02 +01:00
cols = c ( fusi , streptogramins ) )
2018-02-21 11:52:31 +01:00
# Moraxella
edit_rsi ( to = ' R' ,
rows = which ( tbl $ fullname %like% ' ^Moraxella catarrhalis' ) ,
cols = trim )
# Neisseria
edit_rsi ( to = ' R' ,
rows = which ( tbl $ genus == ' Neisseria' ) ,
cols = trim )
# Campylobacter
edit_rsi ( to = ' R' ,
rows = which ( tbl $ fullname %like% ' ^Campylobacter fetus' ) ,
2018-03-23 14:46:02 +01:00
cols = c ( fusi , streptogramins , trim , nali ) )
2018-02-21 11:52:31 +01:00
edit_rsi ( to = ' R' ,
rows = which ( tbl $ fullname %like% ' ^Campylobacter (jejuni|coli)' ) ,
2018-03-23 14:46:02 +01:00
cols = c ( fusi , streptogramins , trim ) )
2018-04-02 16:05:09 +02:00
2018-02-21 11:52:31 +01:00
# Table 4: Intrinsic resistance in Gram-positive bacteria ----
if ( info == TRUE ) {
cat ( ' ...Table 4: Intrinsic resistance in Gram-positive bacteria\n' )
}
2018-03-23 14:46:02 +01:00
# Intrisiek R for this group
2018-02-21 11:52:31 +01:00
edit_rsi ( to = ' R' ,
rows = which ( tbl $ gramstain %like% ' Positi(e|)(v|f)' ) ,
2018-03-23 14:46:02 +01:00
cols = c ( aztr , polymyxins , nali ) )
2018-02-21 11:52:31 +01:00
# Staphylococcus
edit_rsi ( to = ' R' ,
rows = which ( tbl $ fullname %like% ' ^Staphylococcus saprophyticus' ) ,
cols = c ( fusi , cfta , fosf , novo ) )
edit_rsi ( to = ' R' ,
rows = which ( tbl $ fullname %like% ' ^Staphylococcus (cohnii|xylosus)' ) ,
cols = c ( cfta , novo ) )
edit_rsi ( to = ' R' ,
rows = which ( tbl $ fullname %like% ' ^Staphylococcus capitis' ) ,
cols = c ( cfta , fosf ) )
edit_rsi ( to = ' R' ,
rows = which ( tbl $ fullname %like% ' ^Staphylococcus (aureus|epidermidis|coagulase negatief|hominis|haemolyticus|intermedius|pseudointermedius)' ) ,
cols = cfta )
# Streptococcus
edit_rsi ( to = ' R' ,
rows = which ( tbl $ genus == ' Streptococcus' ) ,
2018-03-23 14:46:02 +01:00
cols = c ( fusi , cfta , aminoglycosides ) )
2018-02-21 11:52:31 +01:00
# Enterococcus
edit_rsi ( to = ' R' ,
rows = which ( tbl $ fullname %like% ' ^Enterococcus faecalis' ) ,
2018-03-23 14:46:02 +01:00
cols = c ( fusi , cfta , cephalosporins [cephalosporins != cfta ] , aminoglycosides , macrolides , clin , qida , trim , trsu ) )
2018-02-21 11:52:31 +01:00
edit_rsi ( to = ' R' ,
rows = which ( tbl $ fullname %like% ' ^Enterococcus (gallinarum|casseliflavus)' ) ,
2018-03-23 14:46:02 +01:00
cols = c ( fusi , cfta , cephalosporins [cephalosporins != cfta ] , aminoglycosides , macrolides , clin , qida , vanc , trim , trsu ) )
2018-02-21 11:52:31 +01:00
edit_rsi ( to = ' R' ,
rows = which ( tbl $ fullname %like% ' ^Enterococcus faecium' ) ,
2018-03-23 14:46:02 +01:00
cols = c ( fusi , cfta , cephalosporins [cephalosporins != cfta ] , aminoglycosides , macrolides , trim , trsu ) )
2018-02-21 11:52:31 +01:00
# Corynebacterium
edit_rsi ( to = ' R' ,
rows = which ( tbl $ genus == ' Corynebacterium' ) ,
cols = fosf )
# Listeria
edit_rsi ( to = ' R' ,
rows = which ( tbl $ fullname %like% ' ^Listeria monocytogenes' ) ,
2018-03-23 14:46:02 +01:00
cols = c ( cfta , cephalosporins [cephalosporins != cfta ] ) )
2018-02-21 11:52:31 +01:00
# overig
edit_rsi ( to = ' R' ,
rows = which ( tbl $ genus %in% c ( ' Leuconostoc' , ' Pediococcus' ) ) ,
cols = c ( vanc , teic ) )
edit_rsi ( to = ' R' ,
rows = which ( tbl $ genus == ' Lactobacillus' ) ,
cols = c ( vanc , teic ) )
edit_rsi ( to = ' R' ,
rows = which ( tbl $ fullname %like% ' ^Clostridium (ramosum|innocuum)' ) ,
cols = vanc )
2018-04-02 16:05:09 +02:00
2018-02-21 11:52:31 +01:00
# Table 8: Interpretive rules for B-lactam agents and Gram-positive cocci ----
if ( info == TRUE ) {
cat ( ' ...Table 8: Interpretive rules for B-lactam agents and Gram-positive cocci\n' )
}
2018-03-23 14:46:02 +01:00
# rule 8.3
2018-02-21 11:52:31 +01:00
if ( ! is.na ( peni ) ) {
edit_rsi ( to = ' S' ,
rows = which ( tbl $ fullname %like% ' ^Streptococcus (pyogenes|agalactiae|dysgalactiae|groep A|groep B|groep C|groep G)'
& tbl [ , peni ] == ' S' ) ,
2018-03-23 14:46:02 +01:00
cols = c ( aminopenicillins , cephalosporins , carbapenems ) )
2018-02-21 11:52:31 +01:00
}
2018-03-23 14:46:02 +01:00
# rule 8.6
2018-02-21 11:52:31 +01:00
if ( ! is.na ( ampi ) ) {
edit_rsi ( to = ' R' ,
rows = which ( tbl $ genus == ' Enterococcus'
& tbl [ , ampi ] == ' R' ) ,
2018-03-23 14:46:02 +01:00
cols = c ( ureidopenicillins , carbapenems ) )
2018-02-21 11:52:31 +01:00
}
2018-02-22 21:37:10 +01:00
if ( ! is.na ( amox ) ) {
edit_rsi ( to = ' R' ,
rows = which ( tbl $ genus == ' Enterococcus'
& tbl [ , amox ] == ' R' ) ,
2018-03-23 14:46:02 +01:00
cols = c ( ureidopenicillins , carbapenems ) )
2018-02-22 21:37:10 +01:00
}
2018-04-02 16:05:09 +02:00
2018-02-21 11:52:31 +01:00
# Table 9: Interpretive rules for B-lactam agents and Gram-negative rods ----
if ( info == TRUE ) {
cat ( ' ...Table 9: Interpretive rules for B-lactam agents and Gram-negative rods\n' )
}
2018-03-23 14:46:02 +01:00
# rule 9.3
2018-02-21 11:52:31 +01:00
if ( ! is.na ( tica ) & ! is.na ( pita ) ) {
edit_rsi ( to = ' R' ,
rows = which ( tbl $ family == ' Enterobacteriaceae'
& tbl [ , tica ] == ' R'
& tbl [ , pita ] == ' S' ) ,
cols = pita )
}
2018-04-02 16:05:09 +02:00
2018-02-21 11:52:31 +01:00
# Table 10: Interpretive rules for B-lactam agents and other Gram-negative bacteria ----
if ( info == TRUE ) {
cat ( ' ...Table 10: Interpretive rules for B-lactam agents and other Gram-negative bacteria\n' )
}
2018-03-23 14:46:02 +01:00
# rule 10.2
2018-02-21 11:52:31 +01:00
if ( ! is.na ( ampi ) ) {
2018-03-23 14:46:02 +01:00
# you should know first if the are B-lactamase positive, so do not run for now
2018-02-21 11:52:31 +01:00
# edit_rsi(to = 'R',
# rows = which(tbl$fullname %like% '^Haemophilus influenza'
# & tbl[, ampi] == 'R'),
# cols = c(ampi, amox, amcl, pita, cfur))
}
2018-04-02 16:05:09 +02:00
2018-02-21 11:52:31 +01:00
# Table 11: Interpretive rules for macrolides, lincosamides, and streptogramins ----
if ( info == TRUE ) {
cat ( ' ...Table 11: Interpretive rules for macrolides, lincosamides, and streptogramins\n' )
}
2018-03-23 14:46:02 +01:00
# rule 11.1
2018-02-21 11:52:31 +01:00
if ( ! is.na ( eryt ) ) {
if ( ! is.na ( azit ) ) {
tbl [ , azit ] <- tbl [ , eryt ]
}
if ( ! is.na ( clar ) ) {
tbl [ , clar ] <- tbl [ , eryt ]
}
}
2018-04-02 16:05:09 +02:00
2018-02-21 11:52:31 +01:00
# Table 12: Interpretive rules for aminoglycosides ----
if ( info == TRUE ) {
cat ( ' ...Table 12: Interpretive rules for aminoglycosides\n' )
}
2018-03-23 14:46:02 +01:00
# rule 12.2
2018-02-21 11:52:31 +01:00
if ( ! is.na ( tobr ) ) {
edit_rsi ( to = ' R' ,
rows = which ( tbl $ genus == ' Staphylococcus'
& tbl [ , tobr ] == ' R' ) ,
cols = c ( kana , amik ) )
}
2018-03-23 14:46:02 +01:00
# rule 12.3
2018-02-21 11:52:31 +01:00
if ( ! is.na ( gent ) ) {
edit_rsi ( to = ' R' ,
rows = which ( tbl $ genus == ' Staphylococcus'
& tbl [ , gent ] == ' R' ) ,
2018-03-23 14:46:02 +01:00
cols = aminoglycosides )
2018-02-21 11:52:31 +01:00
}
2018-03-23 14:46:02 +01:00
# rule 12.8
2018-02-21 11:52:31 +01:00
if ( ! is.na ( gent ) & ! is.na ( tobr ) ) {
edit_rsi ( to = ' R' ,
rows = which ( tbl $ family == ' Enterobacteriaceae'
& tbl [ , gent ] == ' I'
& tbl [ , tobr ] == ' S' ) ,
cols = gent )
}
2018-03-23 14:46:02 +01:00
# rule 12.9
2018-02-21 11:52:31 +01:00
if ( ! is.na ( gent ) & ! is.na ( tobr ) ) {
edit_rsi ( to = ' R' ,
rows = which ( tbl $ family == ' Enterobacteriaceae'
& tbl [ , tobr ] == ' I'
& tbl [ , gent ] == ' R' ) ,
cols = tobr )
}
2018-04-02 16:05:09 +02:00
2018-02-21 11:52:31 +01:00
# Table 13: Interpretive rules for quinolones ----
if ( info == TRUE ) {
cat ( ' ...Table 13: Interpretive rules for quinolones\n' )
}
2018-03-23 14:46:02 +01:00
# rule 13.2
2018-02-21 11:52:31 +01:00
if ( ! is.na ( moxi ) ) {
edit_rsi ( to = ' R' ,
rows = which ( tbl $ genus == ' Staphylococcus'
& tbl [ , moxi ] == ' R' ) ,
2018-03-23 14:46:02 +01:00
cols = fluoroquinolones )
2018-02-21 11:52:31 +01:00
}
2018-03-23 14:46:02 +01:00
# rule 13.4
2018-02-21 11:52:31 +01:00
if ( ! is.na ( moxi ) ) {
edit_rsi ( to = ' R' ,
rows = which ( tbl $ fullname %like% ' ^Streptococcus pneumoniae'
& tbl [ , moxi ] == ' R' ) ,
2018-03-23 14:46:02 +01:00
cols = fluoroquinolones )
2018-02-21 11:52:31 +01:00
}
2018-03-23 14:46:02 +01:00
# rule 13.5
2018-02-21 11:52:31 +01:00
if ( ! is.na ( cipr ) ) {
edit_rsi ( to = ' R' ,
rows = which ( tbl $ family == ' Enterobacteriaceae'
& tbl [ , cipr ] == ' R' ) ,
2018-03-23 14:46:02 +01:00
cols = fluoroquinolones )
2018-02-21 11:52:31 +01:00
}
2018-03-23 14:46:02 +01:00
# rule 13.8
2018-02-21 11:52:31 +01:00
if ( ! is.na ( cipr ) ) {
edit_rsi ( to = ' R' ,
rows = which ( tbl $ fullname %like% ' ^Neisseria gonorrhoeae'
& tbl [ , cipr ] == ' R' ) ,
2018-03-23 14:46:02 +01:00
cols = fluoroquinolones )
2018-02-21 11:52:31 +01:00
}
2018-04-02 16:05:09 +02:00
2018-02-21 11:52:31 +01:00
# Other ----
if ( info == TRUE ) {
2018-03-23 14:46:02 +01:00
cat ( ' ...Non-EUCAST: trim = R where trsu = R and ampi = R where amcl = R\n' )
2018-02-21 11:52:31 +01:00
}
if ( ! is.na ( amcl ) ) {
edit_rsi ( to = ' R' ,
rows = which ( tbl [ , amcl ] == ' R' ) ,
cols = ampi )
}
if ( ! is.na ( trsu ) ) {
edit_rsi ( to = ' R' ,
rows = which ( tbl [ , trsu ] == ' R' ) ,
cols = trim )
}
if ( ! is.na ( ampi ) & ! is.na ( amox ) ) {
2018-02-22 21:37:10 +01:00
tbl [ , amox ] <- tbl %>% pull ( ampi )
2018-02-21 11:52:31 +01:00
}
2018-04-02 16:05:09 +02:00
2018-03-23 14:46:02 +01:00
# Remove added columns again
microorganisms.ncol <- ncol ( AMR :: microorganisms ) - 2
2018-02-21 11:52:31 +01:00
tbl.ncol <- ncol ( tbl )
2018-03-23 14:46:02 +01:00
tbl <- tbl %>% select ( - c ( ( tbl.ncol - microorganisms.ncol ) : tbl.ncol ) )
# and remove added suffices
colnames ( tbl ) <- gsub ( " _tempmicroorganisms" , " " , colnames ( tbl ) )
2018-04-02 16:05:09 +02:00
2018-02-21 11:52:31 +01:00
if ( info == TRUE ) {
2018-03-23 14:46:02 +01:00
cat ( ' Done.\n\nEUCAST Expert rules applied to' ,
2018-02-26 14:37:40 +01:00
total_rows %>% unique ( ) %>% length ( ) %>% format ( big.mark = " ," ) ,
2018-03-23 14:46:02 +01:00
' different rows (isolates); edited a total of' ,
2018-02-26 14:37:40 +01:00
total %>% format ( big.mark = " ," ) , ' test results.\n\n' )
2018-02-21 11:52:31 +01:00
}
2018-04-02 16:05:09 +02:00
2018-02-21 11:52:31 +01:00
tbl
}
#' @rdname EUCAST
#' @export
interpretive_reading <- function ( ... ) {
EUCAST_rules ( ... )
}
#' Poperties of a microorganism
#'
2018-03-23 14:46:02 +01:00
#' @param bactid ID of a microorganisme, like \code{"STAAUR} and \code{"ESCCOL}
2018-02-21 11:52:31 +01:00
#' @param property One of the values \code{bactid}, \code{bactsys}, \code{family}, \code{genus}, \code{species}, \code{subspecies}, \code{fullname}, \code{type}, \code{gramstain}, \code{aerobic}
#' @export
#' @importFrom dplyr %>% filter select
2018-03-23 14:46:02 +01:00
#' @seealso \code{\link{microorganisms}}
mo_property <- function ( bactid , property = ' fullname' ) {
2018-04-02 16:05:09 +02:00
2018-03-23 14:46:02 +01:00
mocode <- as.character ( bactid )
2018-04-02 16:05:09 +02:00
2018-02-21 11:52:31 +01:00
for ( i in 1 : length ( mocode ) ) {
bug <- mocode [i ]
2018-04-02 16:05:09 +02:00
2018-02-21 11:52:31 +01:00
if ( ! is.na ( bug ) ) {
result = tryCatch ( {
mocode [i ] <-
2018-03-23 14:46:02 +01:00
AMR :: microorganisms %>%
2018-03-27 17:43:42 +02:00
filter ( bactid == bug ) %>%
2018-02-21 11:52:31 +01:00
select ( property ) %>%
unlist ( ) %>%
as.character ( )
} , error = function ( error_condition ) {
warning ( ' Code ' , bug , ' not found in bacteria list.' )
} , finally = {
if ( mocode [i ] == bug & ! property %in% c ( ' bactid' , ' bactsys' ) ) {
mocode [i ] <- NA
}
} )
}
2018-04-02 16:05:09 +02:00
2018-02-21 11:52:31 +01:00
}
mocode
}