P281424/AMR
1
0
Fork 0
mirror of https://github.com/msberends/AMR.git synced 2024-12-26 06:06:12 +01:00
Code Releases Activity

MDRO update

Browse Source
This commit is contained in:
dr. M.S. (Matthijs) Berends 2018-11-16 20:50:50 +01:00
parent fab64e6728
commit 4fcc2b409a
10 changed files with 207 additions and 186 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
DESCRIPTION
View File

@ -1,6 +1,6 @@
Package: AMR Package: AMR
Version: 0.4.0.9010 Version: 0.4.0.9011
Date: 2018-11-09 Date: 2018-11-16
Title: Antimicrobial Resistance Analysis Title: Antimicrobial Resistance Analysis
Authors@R: c( Authors@R: c(
person( person(

9
NAMESPACE
View File

@ -35,11 +35,7 @@ S3method(skewness,matrix)
S3method(summary,mic) S3method(summary,mic)
S3method(summary,rsi) S3method(summary,rsi)
export("%like%") export("%like%")
export(BRMO)
export(EUCAST_exceptional_phenotypes)
export(EUCAST_rules) export(EUCAST_rules)
export(MDRO)
export(MRGN)
export(ab_atc) export(ab_atc)
export(ab_certe) export(ab_certe)
export(ab_name) export(ab_name)
@ -58,6 +54,7 @@ export(as.rsi)
export(atc_ddd) export(atc_ddd)
export(atc_groups) export(atc_groups)
export(atc_property) export(atc_property)
export(brmo)
export(count_I) export(count_I)
export(count_IR) export(count_IR)
export(count_R) export(count_R)
@ -65,6 +62,8 @@ export(count_S)
export(count_SI) export(count_SI)
export(count_all) export(count_all)
export(count_df) export(count_df)
export(eucast_exceptional_phenotypes)
export(eucast_rules)
export(facet_rsi) export(facet_rsi)
export(first_isolate) export(first_isolate)
export(freq) export(freq)
@ -91,6 +90,7 @@ export(kurtosis)
export(labels_rsi_count) export(labels_rsi_count)
export(left_join_microorganisms) export(left_join_microorganisms)
export(like) export(like)
export(mdro)
export(mo_TSN) export(mo_TSN)
export(mo_authors) export(mo_authors)
export(mo_class) export(mo_class)
@ -110,6 +110,7 @@ export(mo_subspecies)
export(mo_taxonomy) export(mo_taxonomy)
export(mo_type) export(mo_type)
export(mo_year) export(mo_year)
export(mrgn)
export(n_rsi) export(n_rsi)
export(p.symbol) export(p.symbol)
export(portion_I) export(portion_I)

10
NEWS.md
View File

@ -9,14 +9,16 @@
* Functions `mo_authors` and `mo_year` to get specific values about the scientific reference of a taxonomic entry * Functions `mo_authors` and `mo_year` to get specific values about the scientific reference of a taxonomic entry
#### Changed #### Changed
* Big changes to the `EUCAST_rules` function: * Functions `MDRO`, `BRMO`, `MRGN` and `EUCAST_exceptional_phenotypes` were renamed to `mdro`, `brmo`, `mrgn` and `eucast_exceptional_phenotypes`
* `EUCAST_rules` was renamed to `eucast_rules`, the old function still exists as a deprecated function
* Big changes to the `eucast_rules` function:
* Now also applies rules from the EUCAST 'Breakpoint tables for bacteria', version 8.1, 2018, http://www.eucast.org/clinical_breakpoints/ (see Source of the function) * Now also applies rules from the EUCAST 'Breakpoint tables for bacteria', version 8.1, 2018, http://www.eucast.org/clinical_breakpoints/ (see Source of the function)
* New parameter `rules` to specify which rules should be applied (expert rules, breakpoints, others or all) * New parameter `rules` to specify which rules should be applied (expert rules, breakpoints, others or all)
* New parameter `verbose` which can be set to `TRUE` to get very specific messages about which columns and rows were affected * New parameter `verbose` which can be set to `TRUE` to get very specific messages about which columns and rows were affected
* Better error handling when rules cannot be applied (i.e. new values could not be inserted) * Better error handling when rules cannot be applied (i.e. new values could not be inserted)
* The number of affected values will now only be measured once per row/column combination * The number of affected values will now only be measured once per row/column combination
* Data set `septic_patients` now reflects these changes * Data set `septic_patients` now reflects these changes
* Added parameter `pipe` for piperacillin (J01CA12), also to the `MDRO` function * Added parameter `pipe` for piperacillin (J01CA12), also to the `mdro` function
* Small fixes to EUCAST clinical breakpoint rules * Small fixes to EUCAST clinical breakpoint rules
* Added column `kingdom` to the microorganisms data set, and function `mo_kingdom` to look up values * Added column `kingdom` to the microorganisms data set, and function `mo_kingdom` to look up values
* Tremendous speed improvement for `as.mo` (and subsequently all `mo_*` functions), as empty values wil be ignored *a priori* * Tremendous speed improvement for `as.mo` (and subsequently all `mo_*` functions), as empty values wil be ignored *a priori*
@ -41,11 +43,11 @@
* New parameter `header` to turn it off (default when `markdown = TRUE`) * New parameter `header` to turn it off (default when `markdown = TRUE`)
* New parameter `title` to replace the automatically set title * New parameter `title` to replace the automatically set title
* `first_isolate` now tries to find columns to use as input when parameters are left blank * `first_isolate` now tries to find columns to use as input when parameters are left blank
* Improvement for MDRO algorithm * Improvement for MDRO algorithm (function `mdro`)
* Data set `septic_patients` is now a `data.frame`, not a tibble anymore * Data set `septic_patients` is now a `data.frame`, not a tibble anymore
* Removed diacritics from all authors (columns `microorganisms$ref` and `microorganisms.old$ref`) to comply with CRAN policy to only allow ASCII characters * Removed diacritics from all authors (columns `microorganisms$ref` and `microorganisms.old$ref`) to comply with CRAN policy to only allow ASCII characters
* Fix for `mo_property` not working properly * Fix for `mo_property` not working properly
* Fix for `EUCAST_rules` where some Streptococci would become ceftazidime R in EUCAST rule 4.5 * Fix for `eucast_rules` where some Streptococci would become ceftazidime R in EUCAST rule 4.5
* Support for named vectors of class `mo`, useful for `top_freq()` * Support for named vectors of class `mo`, useful for `top_freq()`
* `ggplot_rsi` and `scale_y_percent` have `breaks` parameter * `ggplot_rsi` and `scale_y_percent` have `breaks` parameter
* AI improvements for `as.mo`: * AI improvements for `as.mo`:

22
R/eucast.R → R/eucast_rules.R
View File

@ -25,7 +25,7 @@
#' @param verbose a logical to indicate whether extensive info should be returned as a \code{data.frame} with info about which rows and columns are effected #' @param verbose a logical to indicate whether extensive info should be returned as a \code{data.frame} with info about which rows and columns are effected
#' @param amcl,amik,amox,ampi,azit,azlo,aztr,cefa,cfep,cfot,cfox,cfra,cfta,cftr,cfur,chlo,cipr,clar,clin,clox,coli,czol,dapt,doxy,erta,eryt,fosf,fusi,gent,imip,kana,levo,linc,line,mero,mezl,mino,moxi,nali,neom,neti,nitr,norf,novo,oflo,oxac,peni,pipe,pita,poly,pris,qida,rifa,roxi,siso,teic,tetr,tica,tige,tobr,trim,trsu,vanc column name of an antibiotic, see Details #' @param amcl,amik,amox,ampi,azit,azlo,aztr,cefa,cfep,cfot,cfox,cfra,cfta,cftr,cfur,chlo,cipr,clar,clin,clox,coli,czol,dapt,doxy,erta,eryt,fosf,fusi,gent,imip,kana,levo,linc,line,mero,mezl,mino,moxi,nali,neom,neti,nitr,norf,novo,oflo,oxac,peni,pipe,pita,poly,pris,qida,rifa,roxi,siso,teic,tetr,tica,tige,tobr,trim,trsu,vanc column name of an antibiotic, see Details
#' @param col_bactid deprecated, use \code{col_mo} instead. #' @param col_bactid deprecated, use \code{col_mo} instead.
#' @param ... parameters that are passed on to \code{EUCAST_rules} #' @param ... parameters that are passed on to \code{eucast_rules}
#' @inheritParams first_isolate #' @inheritParams first_isolate
#' @details To define antibiotics column names, input a text or use \code{NA} to skip a column (e.g. \code{tica = NA}). Non-existing columns will anyway be skipped with a warning. See the Antibiotics section for an explanation of the abbreviations. #' @details To define antibiotics column names, input a text or use \code{NA} to skip a column (e.g. \code{tica = NA}). Non-existing columns will anyway be skipped with a warning. See the Antibiotics section for an explanation of the abbreviations.
#' @section Antibiotics: #' @section Antibiotics:
@ -94,7 +94,7 @@
#' \strong{trsu}: sulfamethoxazole and trimethoprim (\emph{J01EE01}), #' \strong{trsu}: sulfamethoxazole and trimethoprim (\emph{J01EE01}),
#' \strong{vanc}: vancomycin (\emph{J01XA01}). #' \strong{vanc}: vancomycin (\emph{J01XA01}).
#' @keywords interpretive eucast reading resistance #' @keywords interpretive eucast reading resistance
#' @rdname EUCAST #' @rdname eucast_rules
#' @export #' @export
#' @importFrom dplyr %>% select pull mutate_at vars #' @importFrom dplyr %>% select pull mutate_at vars
#' @importFrom crayon bold bgGreen bgYellow bgRed black green blue italic strip_style #' @importFrom crayon bold bgGreen bgYellow bgRed black green blue italic strip_style
@ -116,7 +116,7 @@
#' } #' }
#' } #' }
#' @examples #' @examples
#' a <- EUCAST_rules(septic_patients) #' a <- eucast_rules(septic_patients)
#' #'
#' a <- data.frame(mo = c("Staphylococcus aureus", #' a <- data.frame(mo = c("Staphylococcus aureus",
#' "Enterococcus faecalis", #' "Enterococcus faecalis",
@ -140,7 +140,7 @@
#' # 4 Klebsiella pneumoniae - - - - - S S #' # 4 Klebsiella pneumoniae - - - - - S S
#' # 5 Pseudomonas aeruginosa - - - - - S S #' # 5 Pseudomonas aeruginosa - - - - - S S
#' #'
#' b <- EUCAST_rules(a, "mo") # 18 results are forced as R or S #' b <- eucast_rules(a, "mo") # 18 results are forced as R or S
#' #'
#' b #' b
#' # mo vanc amox coli cfta cfur peni cfox #' # mo vanc amox coli cfta cfur peni cfox
@ -149,7 +149,7 @@
#' # 3 Escherichia coli R - - - - R S #' # 3 Escherichia coli R - - - - R S
#' # 4 Klebsiella pneumoniae R R - - - R S #' # 4 Klebsiella pneumoniae R R - - - R S
#' # 5 Pseudomonas aeruginosa R R - - R R R #' # 5 Pseudomonas aeruginosa R R - - R R R
EUCAST_rules <- function(tbl, eucast_rules <- function(tbl,
col_mo = NULL, col_mo = NULL,
info = TRUE, info = TRUE,
rules = c("breakpoints", "expert", "other", "all"), rules = c("breakpoints", "expert", "other", "all"),
@ -1745,8 +1745,16 @@ EUCAST_rules <- function(tbl,
tbl_original tbl_original
} }
#' @rdname EUCAST #' @rdname eucast_rules
#' @export
EUCAST_rules <- function(...) {
.Deprecated("eucast_rules")
eucast_rules(...)
}
#' @rdname eucast_rules
#' @export #' @export
interpretive_reading <- function(...) { interpretive_reading <- function(...) {
EUCAST_rules(...) .Deprecated("eucast_rules")
eucast_rules(...)
} }

227
R/mdro.R
View File

@ -22,13 +22,13 @@
#' @param tbl table with antibiotic columns, like e.g. \code{amox} and \code{amcl} #' @param tbl table with antibiotic columns, like e.g. \code{amox} and \code{amcl}
#' @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 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 info print progress #' @param info print progress
#' @inheritParams EUCAST_rules #' @inheritParams eucast_rules
#' @param metr column name of an antibiotic. Use \code{NA} to skip a column, like \code{tica = NA}. Non-existing columns will anyway be skipped. See the Antibiotics section for an explanation of the abbreviations. #' @param metr column name of an antibiotic. Use \code{NA} to skip a column, like \code{tica = NA}. Non-existing columns will anyway be skipped. See the Antibiotics section for an explanation of the abbreviations.
#' @param ... parameters that are passed on to methods #' @param ... parameters that are passed on to methods
#' @inheritSection EUCAST_rules Antibiotics #' @inheritSection eucast_rules Antibiotics
#' @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}). #' @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}. #' @return Ordered factor with levels \code{Negative < Positive, unconfirmed < Positive}.
#' @rdname MDRO #' @rdname mdro
#' @importFrom dplyr %>% #' @importFrom dplyr %>%
#' @importFrom crayon red blue #' @importFrom crayon red blue
#' @export #' @export
@ -36,9 +36,9 @@
#' library(dplyr) #' library(dplyr)
#' #'
#' septic_patients %>% #' septic_patients %>%
#' mutate(EUCAST = MDRO(.), #' mutate(EUCAST = mdro(.),
#' BRMO = BRMO(.)) #' BRMO = brmo(.))
MDRO <- function(tbl, mdro <- function(tbl,
country = NULL, country = NULL,
col_mo = NULL, col_mo = NULL,
info = TRUE, info = TRUE,
@ -129,8 +129,8 @@ MDRO <- function(tbl,
country <- 'EUCAST' country <- 'EUCAST'
} }
country <- trimws(country) country <- trimws(country)
if (country != 'EUCAST' & !country %like% '^[a-z]{2}$') { if (tolower(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) 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 # create list and make country code case-independent
@ -243,10 +243,17 @@ MDRO <- function(tbl,
fluoroquinolones <- c(oflo, cipr, levo, moxi) fluoroquinolones <- c(oflo, cipr, levo, moxi)
# helper function for editing the table # helper function for editing the table
trans_tbl <- function(to, rows, cols) { trans_tbl <- function(to, rows, cols, any_all) {
cols <- cols[!is.na(cols)] cols <- cols[!is.na(cols)]
if (length(rows) > 0 & length(cols) > 0) { if (length(rows) > 0 & length(cols) > 0) {
if (any_all == "any") {
col_filter <- which(tbl[, cols] == 'R') col_filter <- which(tbl[, cols] == 'R')
} else if (any_all == "all") {
col_filter <- tbl %>%
mutate(index = 1:nrow(.)) %>%
filter_at(vars(cols), all_vars(. == "R")) %>%
pull((index))
}
rows <- rows[rows %in% col_filter] rows <- rows[rows %in% col_filter]
tbl[rows, 'MDRO'] <<- to tbl[rows, 'MDRO'] <<- to
} }
@ -265,52 +272,66 @@ MDRO <- function(tbl,
if (guideline$country$code == 'eucast') { if (guideline$country$code == 'eucast') {
# EUCAST ------------------------------------------------------------------ # EUCAST ------------------------------------------------------------------
# Table 5 # Table 5
trans_tbl(4, trans_tbl(3,
which(tbl$family == 'Enterobacteriaceae' which(tbl$family == 'Enterobacteriaceae'
| tbl$fullname %like% '^Pseudomonas aeruginosa' | tbl$fullname %like% '^Pseudomonas aeruginosa'
| tbl$genus == 'Acinetobacter'), | tbl$genus == 'Acinetobacter'),
coli) coli,
trans_tbl(4, "all")
trans_tbl(3,
which(tbl$fullname %like% '^Salmonella Typhi'), which(tbl$fullname %like% '^Salmonella Typhi'),
c(carbapenems, fluoroquinolones)) c(carbapenems, fluoroquinolones),
trans_tbl(4, "any")
trans_tbl(3,
which(tbl$fullname %like% '^Haemophilus influenzae'), which(tbl$fullname %like% '^Haemophilus influenzae'),
c(cephalosporins_3rd, carbapenems, fluoroquinolones)) c(cephalosporins_3rd, carbapenems, fluoroquinolones),
trans_tbl(4, "any")
trans_tbl(3,
which(tbl$fullname %like% '^Moraxella catarrhalis'), which(tbl$fullname %like% '^Moraxella catarrhalis'),
c(cephalosporins_3rd, fluoroquinolones)) c(cephalosporins_3rd, fluoroquinolones),
trans_tbl(4, "any")
trans_tbl(3,
which(tbl$fullname %like% '^Neisseria meningitidis'), which(tbl$fullname %like% '^Neisseria meningitidis'),
c(cephalosporins_3rd, fluoroquinolones)) c(cephalosporins_3rd, fluoroquinolones),
trans_tbl(4, "any")
trans_tbl(3,
which(tbl$fullname %like% '^Neisseria gonorrhoeae'), which(tbl$fullname %like% '^Neisseria gonorrhoeae'),
azit) azit,
"any")
# Table 6 # Table 6
trans_tbl(4, trans_tbl(3,
which(tbl$fullname %like% '^Staphylococcus (aureus|epidermidis|coagulase negatief|hominis|haemolyticus|intermedius|pseudointermedius)'), which(tbl$fullname %like% '^Staphylococcus (aureus|epidermidis|coagulase negatief|hominis|haemolyticus|intermedius|pseudointermedius)'),
c(vanc, teic, dapt, line, qida, tige)) c(vanc, teic, dapt, line, qida, tige),
trans_tbl(4, "any")
trans_tbl(3,
which(tbl$genus == 'Corynebacterium'), which(tbl$genus == 'Corynebacterium'),
c(vanc, teic, dapt, line, qida, tige)) c(vanc, teic, dapt, line, qida, tige),
trans_tbl(4, "any")
trans_tbl(3,
which(tbl$fullname %like% '^Streptococcus pneumoniae'), which(tbl$fullname %like% '^Streptococcus pneumoniae'),
c(carbapenems, vanc, teic, dapt, line, qida, tige, rifa)) c(carbapenems, vanc, teic, dapt, line, qida, tige, rifa),
trans_tbl(4, # Sr. groups A/B/C/G "any")
trans_tbl(3, # Sr. groups A/B/C/G
which(tbl$fullname %like% '^Streptococcus (pyogenes|agalactiae|equisimilis|equi|zooepidemicus|dysgalactiae|anginosus)'), which(tbl$fullname %like% '^Streptococcus (pyogenes|agalactiae|equisimilis|equi|zooepidemicus|dysgalactiae|anginosus)'),
c(peni, cephalosporins, vanc, teic, dapt, line, qida, tige)) c(peni, cephalosporins, vanc, teic, dapt, line, qida, tige),
trans_tbl(4, "any")
trans_tbl(3,
which(tbl$genus == 'Enterococcus'), which(tbl$genus == 'Enterococcus'),
c(dapt, line, tige, teic)) c(dapt, line, tige, teic),
trans_tbl(4, "any")
trans_tbl(3,
which(tbl$fullname %like% '^Enterococcus faecalis'), which(tbl$fullname %like% '^Enterococcus faecalis'),
c(ampi, amox)) c(ampi, amox),
"any")
# Table 7 # Table 7
trans_tbl(4, trans_tbl(3,
which(tbl$genus == 'Bacteroides'), which(tbl$genus == 'Bacteroides'),
metr) metr,
trans_tbl(4, "any")
trans_tbl(3,
which(tbl$fullname %like% '^Clostridium difficile'), which(tbl$fullname %like% '^Clostridium difficile'),
c(metr, vanc)) c(metr, vanc),
"any")
} }
if (guideline$country$code == 'de') { if (guideline$country$code == 'de') {
@ -325,47 +346,36 @@ MDRO <- function(tbl,
carbapenems <- carbapenems[!is.na(carbapenems)] carbapenems <- carbapenems[!is.na(carbapenems)]
# Table 1 # Table 1
tbl[which( trans_tbl(3,
tbl$family == 'Enterobacteriaceae' which(tbl$family == 'Enterobacteriaceae'),
& rowSums(tbl[, aminoglycosides] == 'R', na.rm = TRUE) >= 1 c(aminoglycosides, fluoroquinolones),
& rowSums(tbl[, fluoroquinolones] == 'R', na.rm = TRUE) >= 1 "all")
), 'MDRO'] <- 4
tbl[which( trans_tbl(2,
tbl$family == 'Enterobacteriaceae' which(tbl$family == 'Enterobacteriaceae'),
& rowSums(tbl[, carbapenems] == 'R', na.rm = TRUE) >= 1 c(carbapenems),
), 'MDRO'] <- 3 "any")
# rest is negative
tbl[which(
tbl$family == 'Enterobacteriaceae'
& tbl$MDRO == 1
), 'MDRO'] <- 2
# Table 2 # Table 2
tbl[which( trans_tbl(2,
tbl$genus == 'Acinetobacter' which(tbl$genus == 'Acinetobacter'),
& rowSums(tbl[, carbapenems] == 'R', na.rm = TRUE) >= 1 c(carbapenems),
), 'MDRO'] <- 3 "any")
tbl[which( trans_tbl(3,
tbl$genus == 'Acinetobacter' which(tbl$genus == 'Acinetobacter'),
& rowSums(tbl[, aminoglycosides] == 'R', na.rm = TRUE) >= 1 c(aminoglycosides, fluoroquinolones),
& rowSums(tbl[, fluoroquinolones] == 'R', na.rm = TRUE) >= 1 "all")
), 'MDRO'] <- 4
# rest of Acinetobacter is negative
tbl[which(
tbl$genus == 'Acinetobacter'
& tbl$MDRO == 1
), 'MDRO'] <- 2
tbl[which( trans_tbl(3,
tbl$fullname %like% 'Stenotrophomonas maltophilia' which(tbl$fullname %like% '^Stenotrophomonas maltophilia'),
& tbl[, trsu] == 'R' trsu,
), 'MDRO'] <- 4 "all")
# rest of Stenotrophomonas is negative
tbl[which(
tbl$fullname %like% 'Stenotrophomonas maltophilia'
& tbl$MDRO == 1
), 'MDRO'] <- 2
if (!is.na(mero) & !is.na(imip)
& !is.na(gent) & !is.na(tobr)
& !is.na(cipr)
& !is.na(cfta)
& !is.na(pita) ) {
tbl <- tbl %>% mutate( tbl <- tbl %>% mutate(
psae = 0, psae = 0,
psae = ifelse(mero == "R" | imip == "R", psae + 1, psae), psae = ifelse(mero == "R" | imip == "R", psae + 1, psae),
@ -375,62 +385,49 @@ MDRO <- function(tbl,
psae = ifelse(pita == "R", psae + 1, psae), psae = ifelse(pita == "R", psae + 1, psae),
psae = ifelse(is.na(psae), 0, psae) psae = ifelse(is.na(psae), 0, psae)
) )
} else {
tbl$psae <- 0
}
tbl[which( tbl[which(
tbl$fullname %like% 'Pseudomonas aeruginosa' tbl$fullname %like% 'Pseudomonas aeruginosa'
& tbl$psae >= 3 & tbl$psae >= 3
), 'MDRO'] <- 4 ), 'MDRO'] <- 3
# rest of Pseudomonas is negative
tbl[which(
tbl$fullname %like% 'Pseudomonas aeruginosa'
& tbl$MDRO == 1
), 'MDRO'] <- 2
# Table 3 # Table 3
tbl[which( trans_tbl(3,
tbl$fullname %like% 'Streptococcus pneumoniae' which(tbl$fullname %like% 'Streptococcus pneumoniae'),
& tbl[, peni] == 'R' peni,
), 'MDRO'] <- 4 "all")
tbl[which( trans_tbl(3,
tbl$fullname %like% 'Streptococcus pneumoniae' which(tbl$fullname %like% 'Streptococcus pneumoniae'),
& tbl[, vanc] == 'R' vanc,
), 'MDRO'] <- 4 "all")
# rest of Streptococcus pneumoniae is negative trans_tbl(3,
tbl[which( which(tbl$fullname %like% 'Enterococcus faecium'),
tbl$fullname %like% 'Streptococcus pneumoniae' c(peni, vanc),
& tbl$MDRO == 1 "all")
), 'MDRO'] <- 2
tbl[which(
tbl$fullname %like% 'Enterococcus faecium'
& rowSums(tbl[, c(peni, vanc)] == 'R', na.rm = TRUE) >= 1
), 'MDRO'] <- 4
# rest of Enterococcus faecium is negative
tbl[which(
tbl$fullname %like% 'Enterococcus faecium'
& tbl$MDRO == 1
), 'MDRO'] <- 2
} }
factor(x = tbl$MDRO, factor(x = tbl$MDRO,
levels = c(1:4), levels = 1:3,
labels = c('Not evaluated', 'Negative', 'Unconfirmed', 'Positive'), labels = c('Negative', 'Positive, unconfirmed', 'Positive'),
ordered = TRUE) ordered = TRUE)
} }
#' @rdname MDRO #' @rdname mdro
#' @export #' @export
BRMO <- function(tbl, country = "nl", ...) { brmo <- function(..., country = "nl") {
MDRO(tbl = tbl, country = "nl", ...) mdro(..., country = "nl")
} }
#' @rdname MDRO #' @rdname mdro
#' @export #' @export
MRGN <- function(tbl, country = "de", ...) { mrgn <- function(tbl, country = "de", ...) {
MDRO(tbl = tbl, country = "de", ...) mdro(tbl = tbl, country = "de", ...)
} }
#' @rdname MDRO #' @rdname mdro
#' @export #' @export
EUCAST_exceptional_phenotypes <- function(tbl, country = "EUCAST", ...) { eucast_exceptional_phenotypes <- function(tbl, country = "EUCAST", ...) {
MDRO(tbl = tbl, country = "EUCAST", ...) mdro(tbl = tbl, country = "EUCAST", ...)
} }

11
R/read.4d.R
View File

@ -110,7 +110,7 @@ read.4D <- function(file,
# backup original column names # backup original column names
colnames.bak <- toupper(colnames(data_4D)) colnames.bak <- toupper(colnames(data_4D))
colnames.bak[colnames.bak == "AGE"] <- NULL colnames.bak[colnames.bak == "AGE"] <- NA_character_
# rename of columns # rename of columns
colnames(data_4D) <- gsub("patientnr", "patient_id", colnames(data_4D), fixed = TRUE) colnames(data_4D) <- gsub("patientnr", "patient_id", colnames(data_4D), fixed = TRUE)
@ -162,8 +162,17 @@ read.4D <- function(file,
message("OK\nSetting original column names as label... ", appendLF = FALSE) message("OK\nSetting original column names as label... ", appendLF = FALSE)
} }
for (i in 1:ncol(data_4D)) { for (i in 1:ncol(data_4D)) {
if (!is.na(colnames.bak[i])) {
attr(data_4D[, i], "label") <- colnames.bak[i] attr(data_4D[, i], "label") <- colnames.bak[i]
} }
}
if (info == TRUE) {
message("OK\nSetting query as label to data.frame... ", appendLF = FALSE)
}
qry <- readLines(con <- file(file, open="r"))[1]
close(con)
attr(data_4D, "label") <- qry
if (info == TRUE) { if (info == TRUE) {
message("OK") message("OK")

15
man/EUCAST.Rd → man/eucast_rules.Rd Executable file → Normal file
View File

@ -1,6 +1,7 @@
% Generated by roxygen2: do not edit by hand % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/eucast.R % Please edit documentation in R/eucast_rules.R
\name{EUCAST_rules} \name{eucast_rules}
\alias{eucast_rules}
\alias{EUCAST_rules} \alias{EUCAST_rules}
\alias{interpretive_reading} \alias{interpretive_reading}
\title{EUCAST rules} \title{EUCAST rules}
@ -22,7 +23,7 @@
} }
} }
\usage{ \usage{
EUCAST_rules(tbl, col_mo = NULL, info = TRUE, eucast_rules(tbl, col_mo = NULL, info = TRUE,
rules = c("breakpoints", "expert", "other", "all"), verbose = FALSE, rules = c("breakpoints", "expert", "other", "all"), verbose = FALSE,
amcl = "amcl", amik = "amik", amox = "amox", ampi = "ampi", amcl = "amcl", amik = "amik", amox = "amox", ampi = "ampi",
azit = "azit", azlo = "azlo", aztr = "aztr", cefa = "cefa", azit = "azit", azlo = "azlo", aztr = "aztr", cefa = "cefa",
@ -41,6 +42,8 @@ EUCAST_rules(tbl, col_mo = NULL, info = TRUE,
tetr = "tetr", tica = "tica", tige = "tige", tobr = "tobr", tetr = "tetr", tica = "tica", tige = "tige", tobr = "tobr",
trim = "trim", trsu = "trsu", vanc = "vanc", col_bactid = NULL) trim = "trim", trsu = "trsu", vanc = "vanc", col_bactid = NULL)
EUCAST_rules(...)
interpretive_reading(...) interpretive_reading(...)
} }
\arguments{ \arguments{
@ -58,7 +61,7 @@ interpretive_reading(...)
\item{col_bactid}{deprecated, use \code{col_mo} instead.} \item{col_bactid}{deprecated, use \code{col_mo} instead.}
\item{...}{parameters that are passed on to \code{EUCAST_rules}} \item{...}{parameters that are passed on to \code{eucast_rules}}
} }
\value{ \value{
The input of \code{tbl}, possibly with edited values of antibiotics. Or, if \code{verbose = TRUE}, a \code{data.frame} with verbose info. The input of \code{tbl}, possibly with edited values of antibiotics. Or, if \code{verbose = TRUE}, a \code{data.frame} with verbose info.
@ -138,7 +141,7 @@ Abbrevations of the column containing antibiotics in the form: \strong{abbreviat
} }
\examples{ \examples{
a <- EUCAST_rules(septic_patients) a <- eucast_rules(septic_patients)
a <- data.frame(mo = c("Staphylococcus aureus", a <- data.frame(mo = c("Staphylococcus aureus",
"Enterococcus faecalis", "Enterococcus faecalis",
@ -162,7 +165,7 @@ a
# 4 Klebsiella pneumoniae - - - - - S S # 4 Klebsiella pneumoniae - - - - - S S
# 5 Pseudomonas aeruginosa - - - - - S S # 5 Pseudomonas aeruginosa - - - - - S S
b <- EUCAST_rules(a, "mo") # 18 results are forced as R or S b <- eucast_rules(a, "mo") # 18 results are forced as R or S
b b
# mo vanc amox coli cfta cfur peni cfox # mo vanc amox coli cfta cfur peni cfox

24
man/MDRO.Rd → man/mdro.Rd Executable file → Normal file
View File

@ -1,13 +1,13 @@
% Generated by roxygen2: do not edit by hand % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/mdro.R % Please edit documentation in R/mdro.R
\name{MDRO} \name{mdro}
\alias{MDRO} \alias{mdro}
\alias{BRMO} \alias{brmo}
\alias{MRGN} \alias{mrgn}
\alias{EUCAST_exceptional_phenotypes} \alias{eucast_exceptional_phenotypes}
\title{Determine multidrug-resistant organisms (MDRO)} \title{Determine multidrug-resistant organisms (MDRO)}
\usage{ \usage{
MDRO(tbl, country = NULL, col_mo = NULL, info = TRUE, mdro(tbl, country = NULL, col_mo = NULL, info = TRUE,
amcl = "amcl", amik = "amik", amox = "amox", ampi = "ampi", amcl = "amcl", amik = "amik", amox = "amox", ampi = "ampi",
azit = "azit", aztr = "aztr", cefa = "cefa", cfra = "cfra", azit = "azit", aztr = "aztr", cefa = "cefa", cfra = "cfra",
cfep = "cfep", cfot = "cfot", cfox = "cfox", cfta = "cfta", cfep = "cfep", cfot = "cfot", cfox = "cfox", cfta = "cfta",
@ -25,11 +25,11 @@ MDRO(tbl, country = NULL, col_mo = NULL, info = TRUE,
tobr = "tobr", trim = "trim", trsu = "trsu", vanc = "vanc", tobr = "tobr", trim = "trim", trsu = "trsu", vanc = "vanc",
col_bactid = NULL) col_bactid = NULL)
BRMO(tbl, country = "nl", ...) brmo(..., country = "nl")
MRGN(tbl, country = "de", ...) mrgn(tbl, country = "de", ...)
EUCAST_exceptional_phenotypes(tbl, country = "EUCAST", ...) eucast_exceptional_phenotypes(tbl, country = "EUCAST", ...)
} }
\arguments{ \arguments{
\item{tbl}{table with antibiotic columns, like e.g. \code{amox} and \code{amcl}} \item{tbl}{table with antibiotic columns, like e.g. \code{amox} and \code{amcl}}
@ -165,7 +165,7 @@ EUCAST_exceptional_phenotypes(tbl, country = "EUCAST", ...)
\item{...}{parameters that are passed on to methods} \item{...}{parameters that are passed on to methods}
} }
\value{ \value{
Ordered factor with levels \code{Unknown < Negative < Unconfirmed < Positive}. Ordered factor with levels \code{Negative < Positive, unconfirmed < Positive}.
} }
\description{ \description{
Determine which isolates are multidrug-resistant organisms (MDRO) according to country-specific guidelines. Determine which isolates are multidrug-resistant organisms (MDRO) according to country-specific guidelines.
@ -245,6 +245,6 @@ Abbrevations of the column containing antibiotics in the form: \strong{abbreviat
library(dplyr) library(dplyr)
septic_patients \%>\% septic_patients \%>\%
mutate(EUCAST = MDRO(.), mutate(EUCAST = mdro(.),
BRMO = BRMO(.)) BRMO = brmo(.))
} }

21
tests/testthat/test-eucast.R → tests/testthat/test-eucast_rules.R
View File

@ -1,11 +1,11 @@
context("eucast.R") context("eucast_rules.R")
test_that("EUCAST rules work", { test_that("EUCAST rules work", {
expect_error(suppressWarnings(EUCAST_rules(septic_patients, col_mo = "Non-existing"))) expect_error(suppressWarnings(eucast_rules(septic_patients, col_mo = "Non-existing")))
expect_identical(colnames(septic_patients), expect_identical(colnames(septic_patients),
colnames(suppressWarnings(EUCAST_rules(septic_patients)))) colnames(suppressWarnings(eucast_rules(septic_patients))))
a <- data.frame(mo = c("KLEPNE", # Klebsiella pneumoniae a <- data.frame(mo = c("KLEPNE", # Klebsiella pneumoniae
"PSEAER", # Pseudomonas aeruginosa "PSEAER", # Pseudomonas aeruginosa
@ -17,7 +17,8 @@ test_that("EUCAST rules work", {
"ENTAER"), # Enterobacter aerogenes "ENTAER"), # Enterobacter aerogenes
amox = "R", # Amoxicillin amox = "R", # Amoxicillin
stringsAsFactors = FALSE) stringsAsFactors = FALSE)
expect_identical(suppressWarnings(EUCAST_rules(a, "mo", info = FALSE)), b) expect_identical(suppressWarnings(eucast_rules(a, "mo", info = FALSE)), b)
expect_identical(suppressWarnings(eucast_rules(a, "mo", info = TRUE)), b)
expect_identical(suppressWarnings(interpretive_reading(a, "mo", info = TRUE)), b) expect_identical(suppressWarnings(interpretive_reading(a, "mo", info = TRUE)), b)
a <- data.frame(mo = c("STAAUR", # Staphylococcus aureus a <- data.frame(mo = c("STAAUR", # Staphylococcus aureus
@ -28,7 +29,7 @@ test_that("EUCAST rules work", {
"STCGRA"), # Streptococcus pyognenes (Lancefield Group A) "STCGRA"), # Streptococcus pyognenes (Lancefield Group A)
coli = "R", # Colistin coli = "R", # Colistin
stringsAsFactors = FALSE) stringsAsFactors = FALSE)
expect_equal(suppressWarnings(EUCAST_rules(a, "mo", info = FALSE)), b) expect_equal(suppressWarnings(eucast_rules(a, "mo", info = FALSE)), b)
# piperacillin must be R in Enterobacteriaceae when tica is R # piperacillin must be R in Enterobacteriaceae when tica is R
library(dplyr) library(dplyr)
@ -36,7 +37,7 @@ test_that("EUCAST rules work", {
septic_patients %>% septic_patients %>%
mutate(tica = as.rsi("R"), mutate(tica = as.rsi("R"),
pipe = as.rsi("S")) %>% pipe = as.rsi("S")) %>%
EUCAST_rules(col_mo = "mo") %>% eucast_rules(col_mo = "mo") %>%
left_join_microorganisms() %>% left_join_microorganisms() %>%
filter(family == "Enterobacteriaceae") %>% filter(family == "Enterobacteriaceae") %>%
pull(pipe) %>% pull(pipe) %>%
@ -51,12 +52,12 @@ test_that("EUCAST rules work", {
eryt, eryt,
azit = as.rsi("R"), azit = as.rsi("R"),
clar = as.rsi("R")) %>% clar = as.rsi("R")) %>%
EUCAST_rules(col_mo = "mo") %>% eucast_rules(col_mo = "mo") %>%
pull(clar)) pull(clar))
b <- suppressWarnings( b <- suppressWarnings(
septic_patients %>% septic_patients %>%
select(mo, eryt) %>% select(mo, eryt) %>%
EUCAST_rules(col_mo = "mo") %>% eucast_rules(col_mo = "mo") %>%
pull(eryt)) pull(eryt))
expect_identical(a[!is.na(b)], expect_identical(a[!is.na(b)],
@ -64,7 +65,7 @@ test_that("EUCAST rules work", {
# amox is inferred by benzylpenicillin in Kingella kingae # amox is inferred by benzylpenicillin in Kingella kingae
expect_equal( expect_equal(
as.list(EUCAST_rules( as.list(eucast_rules(
data.frame(mo = as.mo("Kingella kingae"), data.frame(mo = as.mo("Kingella kingae"),
peni = "S", peni = "S",
amox = "-", amox = "-",
@ -72,6 +73,6 @@ test_that("EUCAST rules work", {
, info = FALSE))$amox, , info = FALSE))$amox,
"S") "S")
expect_output(suppressWarnings(EUCAST_rules(septic_patients, verbose = TRUE))) expect_output(suppressWarnings(eucast_rules(septic_patients, verbose = TRUE)))
}) })

22
tests/testthat/test-mdro.R
View File

@ -1,30 +1,30 @@
context("mdro.R") context("mdro.R")
test_that("MDRO works", { test_that("mdro works", {
library(dplyr) library(dplyr)
expect_error(suppressWarnings(MDRO(septic_patients, "invalid", col_bactid = "mo", info = TRUE))) expect_error(suppressWarnings(mdro(septic_patients, "invalid", col_bactid = "mo", info = TRUE)))
expect_error(suppressWarnings(MDRO(septic_patients, "fr", col_bactid = "mo", info = TRUE))) expect_error(suppressWarnings(mdro(septic_patients, "fr", col_bactid = "mo", info = TRUE)))
expect_error(suppressWarnings(MDRO(septic_patients, country = c("de", "nl"), info = TRUE))) expect_error(suppressWarnings(mdro(septic_patients, country = c("de", "nl"), info = TRUE)))
expect_error(suppressWarnings(MDRO(septic_patients, col_mo = "invalid", info = TRUE))) expect_error(suppressWarnings(mdro(septic_patients, col_mo = "invalid", info = TRUE)))
outcome <- suppressWarnings(MDRO(septic_patients)) outcome <- suppressWarnings(mdro(septic_patients))
outcome <- suppressWarnings(EUCAST_exceptional_phenotypes(septic_patients, info = TRUE)) outcome <- suppressWarnings(eucast_exceptional_phenotypes(septic_patients, info = TRUE))
# check class # check class
expect_equal(outcome %>% class(), c('ordered', 'factor')) expect_equal(outcome %>% class(), c('ordered', 'factor'))
outcome <- suppressWarnings(MDRO(septic_patients, "nl", info = TRUE)) outcome <- suppressWarnings(mdro(septic_patients, "nl", info = TRUE))
# check class # check class
expect_equal(outcome %>% class(), c('ordered', 'factor')) expect_equal(outcome %>% class(), c('ordered', 'factor'))
# septic_patients should have these finding using Dutch guidelines # septic_patients should have these finding using Dutch guidelines
expect_equal(outcome %>% freq() %>% pull(count), expect_equal(outcome %>% freq() %>% pull(count),
c(1167, 817, 14, 2)) # 1167 not eval., 817 neg, 14 pos, 2 unconfirmed c(19989, 9, 2)) # 1167 not eval., 817 neg, 14 pos, 2 unconfirmed
expect_equal(BRMO(septic_patients, info = FALSE), MDRO(septic_patients, "nl", info = FALSE)) expect_equal(brmo(septic_patients, info = FALSE), mdro(septic_patients, "nl", info = FALSE))
# still working on German guidelines # still working on German guidelines
expect_error(suppressWarnings(MRGN(septic_patients, info = TRUE))) expect_error(suppressWarnings(mrgn(septic_patients, info = TRUE)))
}) })