P281424/AMR
1
0
Fork 0
mirror of https://github.com/msberends/AMR.git synced 2025-10-31 02:48:21 +01:00
Code Releases Activity

- For functions first_isolate, EUCAST_rules the antibiotic column names are case-insensitive

Browse Source 
- Functions `first_isolate`, `EUCAST_rules` and `rsi_predict` supports tidyverse-like evaluation of parameters (no need to quote columns them anymore)
- Functions `clipboard_import` and `clipboard_export` as helper functions to quickly copy and paste from/to software like Excel and SPSS
- Renamed dataset `bactlist` to `microorganisms`
This commit is contained in:
dr. M.S. (Matthijs) Berends
2018-03-23 14:46:02 +01:00
parent e1e19af625
commit 53464ff1c8
29 changed files with 693 additions and 373 deletions
Download Patch File Download Diff File Expand all files Collapse all files

6
DESCRIPTION
View File

@@ -1,6 +1,6 @@
Package: AMR
Version: 0.1.2
Date: 2018-03-19
Date: 2018-03-23
Title: Antimicrobial Resistance Analysis
Authors@R: c(
person(
@@ -25,8 +25,8 @@ Description: Functions to simplify the analysis of Antimicrobial Resistance (AMR
on antibiograms according to Leclercq (2013)
<doi:10.1111/j.1469-0691.2011.03703.x>.
Depends: R (>= 3.0)
Imports: dplyr (>= 0.7.0), reshape2 (>= 1.4.0), xml2, rvest
URL: https://github.com/msberends/AMR
Imports: dplyr (>= 0.7.0), knitr, reshape2 (>= 1.4.0), xml2, rvest
URL: https://cran.r-project.org/package=AMR
BugReports: https://github.com/msberends/AMR/issues
License: GPL-2 | file LICENSE
Encoding: UTF-8

19
NAMESPACE
View File

@@ -13,25 +13,27 @@ S3method(summary,mic)
S3method(summary,rsi)
export(EUCAST_rules)
export(abname)
export(anti_join_bactlist)
export(anti_join_microorganisms)
export(as.mic)
export(as.rsi)
export(atc_property)
export(clipboard_export)
export(clipboard_import)
export(first_isolate)
export(full_join_bactlist)
export(full_join_microorganisms)
export(guess_bactid)
export(inner_join_bactlist)
export(inner_join_microorganisms)
export(interpretive_reading)
export(is.mic)
export(is.rsi)
export(key_antibiotics)
export(left_join_bactlist)
export(left_join_microorganisms)
export(mo_property)
export(right_join_bactlist)
export(right_join_microorganisms)
export(rsi)
export(rsi_df)
export(rsi_predict)
export(semi_join_bactlist)
export(semi_join_microorganisms)
exportMethods(as.double.mic)
exportMethods(as.integer.mic)
exportMethods(as.numeric.mic)
@@ -48,6 +50,7 @@ importFrom(dplyr,all_vars)
importFrom(dplyr,any_vars)
importFrom(dplyr,arrange)
importFrom(dplyr,arrange_at)
importFrom(dplyr,as_tibble)
importFrom(dplyr,between)
importFrom(dplyr,filter)
importFrom(dplyr,filter_at)
@@ -73,5 +76,9 @@ importFrom(graphics,text)
importFrom(reshape2,dcast)
importFrom(rvest,html_nodes)
importFrom(rvest,html_table)
importFrom(utils,object.size)
importFrom(utils,packageDescription)
importFrom(utils,read.delim)
importFrom(utils,write.table)
importFrom(utils,writeClipboard)
importFrom(xml2,read_html)

17
NEWS
View File

@@ -1,11 +1,14 @@
## 0.1.2
- Added new function `guess_bactid` to determine the ID of a microorganism based on genus/species
- Renamed `ablist` to `antibiotics`
- Added support for character vector in join functions
- Altered `%like%` to make it case insensitive
- Added new algorithm to determine weighted isolates, can now be `points` or `keyantibiotics, see `?first_isolate`
- Function `first_isolate` supports tidyverse-like evaluation of parameters (no need to quote them anymore)
- Functions `as.rsi` and `as.mic` now add the package name and version as attribute
- NEW: Function `guess_bactid` to determine the ID of a microorganism based on genus/species
- NEW: Functions `clipboard_import` and `clipboard_export` as helper functions to quickly copy and paste from/to software like Excel and SPSS
- NEW: New algorithm to determine weighted isolates, can now be `"points"` or `"keyantibiotics"`, see `?first_isolate`
- EDIT: Renamed dataset `ablist` to `antibiotics`
- EDIT: Renamed dataset `bactlist` to `microorganisms`
- EDIT: Added support for character vector in join functions
- EDIT: Altered `%like%` to make it case insensitive
- EDIT: Functions `first_isolate`, `EUCAST_rules` and `rsi_predict` supports tidyverse-like evaluation of parameters (no need to quote columns them anymore)
- EDIT: For functions `first_isolate`, `EUCAST_rules` the antibiotic column names are case-insensitive
- EDIT: Functions `as.rsi` and `as.mic` now add the package name and version as attribute
## 0.1.1
- `EUCAST_rules` applies for amoxicillin even if ampicillin is missing

420
R/EUCAST.R
View File

@@ -20,7 +20,7 @@
#'
#' 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}
#' @param col_bactcode column name of the bacteria ID in \code{tbl} - values of this column should be present in \code{bactlist$bactid}, see \code{\link{bactlist}}
#' @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 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}
@@ -33,8 +33,8 @@
#' 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
#' EUCAST Expert Rules Version 3.1: \cr
#' \url{http://www.eucast.org/expert_rules_and_intrinsic_resistance}
#' 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}
#' @examples
#' a <- data.frame(bactid = c("STAAUR", # Staphylococcus aureus
#' "ENCFAE", # Enterococcus faecalis
@@ -52,7 +52,7 @@
#' b <- EUCAST_rules(a)
#' b
EUCAST_rules <- function(tbl,
col_bactcode = 'bactid',
col_bactid = 'bactid',
info = TRUE,
amcl = 'amcl',
amik = 'amik',
@@ -112,95 +112,168 @@ EUCAST_rules <- function(tbl,
trim = 'trim',
trsu = 'trsu',
vanc = 'vanc') {
EUCAST_VERSION <- "3.1"
if (!col_bactcode %in% colnames(tbl)) {
stop('Column ', col_bactcode, ' not found.')
# support using columns as objects; the tidyverse way
amcl <- quasiquotate(deparse(substitute(amcl)), amcl)
amik <- quasiquotate(deparse(substitute(amik)), amik)
amox <- quasiquotate(deparse(substitute(amox)), amox)
ampi <- quasiquotate(deparse(substitute(ampi)), ampi)
azit <- quasiquotate(deparse(substitute(azit)), azit)
aztr <- quasiquotate(deparse(substitute(aztr)), aztr)
cefa <- quasiquotate(deparse(substitute(cefa)), cefa)
cfra <- quasiquotate(deparse(substitute(cfra)), cfra)
cfep <- quasiquotate(deparse(substitute(cfep)), cfep)
cfot <- quasiquotate(deparse(substitute(cfot)), cfot)
cfox <- quasiquotate(deparse(substitute(cfox)), cfox)
cfta <- quasiquotate(deparse(substitute(cfta)), cfta)
cftr <- quasiquotate(deparse(substitute(cftr)), cftr)
cfur <- quasiquotate(deparse(substitute(cfur)), cfur)
chlo <- quasiquotate(deparse(substitute(chlo)), chlo)
cipr <- quasiquotate(deparse(substitute(cipr)), cipr)
clar <- quasiquotate(deparse(substitute(clar)), clar)
clin <- quasiquotate(deparse(substitute(clin)), clin)
clox <- quasiquotate(deparse(substitute(clox)), clox)
coli <- quasiquotate(deparse(substitute(coli)), coli)
czol <- quasiquotate(deparse(substitute(czol)), czol)
dapt <- quasiquotate(deparse(substitute(dapt)), dapt)
doxy <- quasiquotate(deparse(substitute(doxy)), doxy)
erta <- quasiquotate(deparse(substitute(erta)), erta)
eryt <- quasiquotate(deparse(substitute(eryt)), eryt)
fosf <- quasiquotate(deparse(substitute(fosf)), fosf)
fusi <- quasiquotate(deparse(substitute(fusi)), fusi)
gent <- quasiquotate(deparse(substitute(gent)), gent)
imip <- quasiquotate(deparse(substitute(imip)), imip)
kana <- quasiquotate(deparse(substitute(kana)), kana)
levo <- quasiquotate(deparse(substitute(levo)), levo)
linc <- quasiquotate(deparse(substitute(linc)), linc)
line <- quasiquotate(deparse(substitute(line)), line)
mero <- quasiquotate(deparse(substitute(mero)), mero)
mino <- quasiquotate(deparse(substitute(mino)), mino)
moxi <- quasiquotate(deparse(substitute(moxi)), moxi)
nali <- quasiquotate(deparse(substitute(nali)), nali)
neom <- quasiquotate(deparse(substitute(neom)), neom)
neti <- quasiquotate(deparse(substitute(neti)), neti)
nitr <- quasiquotate(deparse(substitute(nitr)), nitr)
novo <- quasiquotate(deparse(substitute(novo)), novo)
norf <- quasiquotate(deparse(substitute(norf)), norf)
oflo <- quasiquotate(deparse(substitute(oflo)), oflo)
peni <- quasiquotate(deparse(substitute(peni)), peni)
pita <- quasiquotate(deparse(substitute(pita)), pita)
poly <- quasiquotate(deparse(substitute(poly)), poly)
qida <- quasiquotate(deparse(substitute(qida)), qida)
rifa <- quasiquotate(deparse(substitute(rifa)), rifa)
roxi <- quasiquotate(deparse(substitute(roxi)), roxi)
siso <- quasiquotate(deparse(substitute(siso)), siso)
teic <- quasiquotate(deparse(substitute(teic)), teic)
tetr <- quasiquotate(deparse(substitute(tetr)), tetr)
tica <- quasiquotate(deparse(substitute(tica)), tica)
tige <- quasiquotate(deparse(substitute(tige)), tige)
tobr <- quasiquotate(deparse(substitute(tobr)), tobr)
trim <- quasiquotate(deparse(substitute(trim)), trim)
trsu <- quasiquotate(deparse(substitute(trsu)), trsu)
vanc <- quasiquotate(deparse(substitute(vanc)), vanc)
if (!col_bactid %in% colnames(tbl)) {
stop('Column ', col_bactid, ' not found.')
}
# kolommen controleren
col.list <- c(amcl, amik, amox, ampi, azit, aztr, cefa, cfra, cfep,
cfot, cfox, cfta, cftr, cfur, cipr, clar, clin, clox, coli, czol,
dapt, doxy, erta, eryt, 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)
# 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)
col.list <- col.list[!is.na(col.list)]
col.list.bak <- col.list
# are they available as upper 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:\n',
col.list[!(col.list %in% colnames(tbl))] %>% toString(),
warning('These columns do not exist and will be ignored: ',
col.list.bak[!(col.list %in% colnames(tbl))] %>% toString(),
immediate. = TRUE,
call. = FALSE)
}
if (!amcl %in% colnames(tbl)) { amcl <- NA }
if (!amik %in% colnames(tbl)) { amik <- NA }
if (!amox %in% colnames(tbl)) { amox <- NA }
if (!ampi %in% colnames(tbl)) { ampi <- NA }
if (!azit %in% colnames(tbl)) { azit <- NA }
if (!aztr %in% colnames(tbl)) { aztr <- NA }
if (!cefa %in% colnames(tbl)) { cefa <- NA }
if (!cfra %in% colnames(tbl)) { cfra <- NA }
if (!cfep %in% colnames(tbl)) { cfep <- NA }
if (!cfot %in% colnames(tbl)) { cfot <- NA }
if (!cfox %in% colnames(tbl)) { cfox <- NA }
if (!cfta %in% colnames(tbl)) { cfta <- NA }
if (!cftr %in% colnames(tbl)) { cftr <- NA }
if (!cfur %in% colnames(tbl)) { cfur <- NA }
if (!chlo %in% colnames(tbl)) { chlo <- NA }
if (!cipr %in% colnames(tbl)) { cipr <- NA }
if (!clar %in% colnames(tbl)) { clar <- NA }
if (!clin %in% colnames(tbl)) { clin <- NA }
if (!clox %in% colnames(tbl)) { clox <- NA }
if (!coli %in% colnames(tbl)) { coli <- NA }
if (!czol %in% colnames(tbl)) { czol <- NA }
if (!dapt %in% colnames(tbl)) { dapt <- NA }
if (!doxy %in% colnames(tbl)) { doxy <- NA }
if (!erta %in% colnames(tbl)) { erta <- NA }
if (!eryt %in% colnames(tbl)) { eryt <- NA }
if (!fosf %in% colnames(tbl)) { fosf <- NA }
if (!fusi %in% colnames(tbl)) { fusi <- NA }
if (!gent %in% colnames(tbl)) { gent <- NA }
if (!imip %in% colnames(tbl)) { imip <- NA }
if (!kana %in% colnames(tbl)) { kana <- NA }
if (!levo %in% colnames(tbl)) { levo <- NA }
if (!linc %in% colnames(tbl)) { linc <- NA }
if (!line %in% colnames(tbl)) { line <- NA }
if (!mero %in% colnames(tbl)) { mero <- NA }
if (!mino %in% colnames(tbl)) { mino <- NA }
if (!moxi %in% colnames(tbl)) { moxi <- NA }
if (!nali %in% colnames(tbl)) { nali <- NA }
if (!neom %in% colnames(tbl)) { neom <- NA }
if (!neti %in% colnames(tbl)) { neti <- NA }
if (!nitr %in% colnames(tbl)) { nitr <- NA }
if (!novo %in% colnames(tbl)) { novo <- NA }
if (!norf %in% colnames(tbl)) { norf <- NA }
if (!oflo %in% colnames(tbl)) { oflo <- NA }
if (!peni %in% colnames(tbl)) { peni <- NA }
if (!pita %in% colnames(tbl)) { pita <- NA }
if (!poly %in% colnames(tbl)) { poly <- NA }
if (!qida %in% colnames(tbl)) { qida <- NA }
if (!rifa %in% colnames(tbl)) { rifa <- NA }
if (!roxi %in% colnames(tbl)) { roxi <- NA }
if (!siso %in% colnames(tbl)) { siso <- NA }
if (!teic %in% colnames(tbl)) { teic <- NA }
if (!tetr %in% colnames(tbl)) { tetr <- NA }
if (!tica %in% colnames(tbl)) { tica <- NA }
if (!tige %in% colnames(tbl)) { tige <- NA }
if (!tobr %in% colnames(tbl)) { tobr <- NA }
if (!trim %in% colnames(tbl)) { trim <- NA }
if (!trsu %in% colnames(tbl)) { trsu <- NA }
if (!vanc %in% colnames(tbl)) { vanc <- NA }
}
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]
total <- 0
total_rows <- integer(0)
# functie voor uitvoeren
# helper function for editing the table
edit_rsi <- function(to, rows, cols) {
#voortgang$tick()$print()
cols <- cols[!is.na(cols)]
if (length(rows) > 0 & length(cols) > 0) {
tbl[rows, cols] <<- to
@@ -209,97 +282,99 @@ EUCAST_rules <- function(tbl,
}
}
# bactlist aan vastknopen (bestaande kolommen krijgen extra suffix)
joinby <- colnames(AMR::bactlist)[1]
names(joinby) <- col_bactcode
tbl <- tbl %>% left_join(y = AMR::bactlist, by = joinby, suffix = c("_tempbactlist", ""))
# join to microorganisms table
joinby <- colnames(AMR::microorganisms)[1]
names(joinby) <- col_bactid
tbl <- tbl %>% left_join(y = AMR::microorganisms, by = joinby, suffix = c("_tempmicroorganisms", ""))
# antibioticagroepen
aminoglycosiden <- c(tobr, gent, kana, neom, neti, siso)
tetracyclines <- c(doxy, mino, tetr) # sinds EUCAST v3.1 is tige(cycline) apart
polymyxines <- c(poly, coli)
macroliden <- c(eryt, azit, roxi, clar) # sinds EUCAST v3.1 is clinda apart
glycopeptiden <- c(vanc, teic)
streptogramines <- qida # eigenlijk pristinamycine en quinupristine/dalfopristine
cefalosporines <- c(cfep, cfot, cfox, cfra, cfta, cftr, cfur, czol)
# 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)
carbapenems <- c(erta, imip, mero)
aminopenicillines <- c(ampi, amox)
ureidopenicillines <- pita # eigenlijk ook azlo en mezlo
fluorochinolonen <- c(oflo, cipr, norf, levo, moxi)
aminopenicillins <- c(ampi, amox)
ureidopenicillins <- pita # should officially also be azlo and mezlo
fluoroquinolones <- c(oflo, cipr, norf, levo, moxi)
if (info == TRUE) {
cat('\nApplying rules to',
cat(
paste0(
'\nApplying rules to ',
tbl[!is.na(tbl$genus),] %>% nrow() %>% format(big.mark = ","),
'rows according to "EUCAST Expert Rules Version 3.1"\n\n')
' rows according to "EUCAST Expert Rules Version ', EUCAST_VERSION, '"\n')
)
}
# Table 1: Intrinsic resistance in Enterobacteriaceae ----
if (info == TRUE) {
cat('...Table 1: Intrinsic resistance in Enterobacteriaceae\n')
}
#voortgang <- progress_estimated(17)
# Intrisiek R voor groep
# Intrisiek R for this group
edit_rsi(to = 'R',
rows = which(tbl$family == 'Enterobacteriaceae'),
cols = c(peni, glycopeptiden, fusi, macroliden, linc, streptogramines, rifa, dapt, line))
cols = c(peni, glycopeptides, fusi, macrolides, linc, streptogramins, rifa, dapt, line))
# Citrobacter
edit_rsi(to = 'R',
rows = which(tbl$fullname %like% '^Citrobacter (koseri|amalonaticus|sedlakii|farmeri|rodentium)'),
cols = c(aminopenicillines, tica))
cols = c(aminopenicillins, tica))
edit_rsi(to = 'R',
rows = which(tbl$fullname %like% '^Citrobacter (freundii|braakii|murliniae|werkmanii|youngae)'),
cols = c(aminopenicillines, amcl, czol, cfox))
cols = c(aminopenicillins, amcl, czol, cfox))
# Enterobacter
edit_rsi(to = 'R',
rows = which(tbl$fullname %like% '^Enterobacter cloacae'),
cols = c(aminopenicillines, amcl, czol, cfox))
cols = c(aminopenicillins, amcl, czol, cfox))
edit_rsi(to = 'R',
rows = which(tbl$fullname %like% '^Enterobacter aerogenes'),
cols = c(aminopenicillines, amcl, czol, cfox))
cols = c(aminopenicillins, amcl, czol, cfox))
# Escherichia
edit_rsi(to = 'R',
rows = which(tbl$fullname %like% '^Escherichia hermanni'),
cols = c(aminopenicillines, tica))
cols = c(aminopenicillins, tica))
# Hafnia
edit_rsi(to = 'R',
rows = which(tbl$fullname %like% '^Hafnia alvei'),
cols = c(aminopenicillines, amcl, czol, cfox))
cols = c(aminopenicillins, amcl, czol, cfox))
# Klebsiella
edit_rsi(to = 'R',
rows = which(tbl$fullname %like% '^Klebsiella'),
cols = c(aminopenicillines, tica))
cols = c(aminopenicillins, tica))
# Morganella / Proteus
edit_rsi(to = 'R',
rows = which(tbl$fullname %like% '^Morganella morganii'),
cols = c(aminopenicillines, amcl, czol, tetracyclines, polymyxines, nitr))
cols = c(aminopenicillins, amcl, czol, tetracyclines, polymyxins, nitr))
edit_rsi(to = 'R',
rows = which(tbl$fullname %like% '^Proteus mirabilis'),
cols = c(tetracyclines, tige, polymyxines, nitr))
cols = c(tetracyclines, tige, polymyxins, nitr))
edit_rsi(to = 'R',
rows = which(tbl$fullname %like% '^Proteus penneri'),
cols = c(aminopenicillines, czol, cfur, tetracyclines, tige, polymyxines, nitr))
cols = c(aminopenicillins, czol, cfur, tetracyclines, tige, polymyxins, nitr))
edit_rsi(to = 'R',
rows = which(tbl$fullname %like% '^Proteus vulgaris'),
cols = c(aminopenicillines, czol, cfur, tetracyclines, tige, polymyxines, nitr))
cols = c(aminopenicillins, czol, cfur, tetracyclines, tige, polymyxins, nitr))
# Providencia
edit_rsi(to = 'R',
rows = which(tbl$fullname %like% '^Providencia rettgeri'),
cols = c(aminopenicillines, amcl, czol, cfur, tetracyclines, tige, polymyxines, nitr))
cols = c(aminopenicillins, amcl, czol, cfur, tetracyclines, tige, polymyxins, nitr))
edit_rsi(to = 'R',
rows = which(tbl$fullname %like% '^Providencia stuartii'),
cols = c(aminopenicillines, amcl, czol, cfur, tetracyclines, tige, polymyxines, nitr))
cols = c(aminopenicillins, amcl, czol, cfur, tetracyclines, tige, polymyxins, nitr))
# Raoultella
edit_rsi(to = 'R',
rows = which(tbl$fullname %like% '^Raoultella'),
cols = c(aminopenicillines, tica))
cols = c(aminopenicillins, tica))
# Serratia
edit_rsi(to = 'R',
rows = which(tbl$fullname %like% '^Serratia marcescens'),
cols = c(aminopenicillines, amcl, czol, cfox, cfur, tetracyclines[tetracyclines != 'mino'], polymyxines, nitr))
cols = c(aminopenicillins, amcl, czol, cfox, cfur, tetracyclines[tetracyclines != 'mino'], polymyxins, nitr))
# Yersinia
edit_rsi(to = 'R',
rows = which(tbl$fullname %like% '^Yersinia enterocolitica'),
cols = c(aminopenicillines, amcl, tica, czol, cfox))
cols = c(aminopenicillins, amcl, tica, czol, cfox))
edit_rsi(to = 'R',
rows = which(tbl$fullname %like% '^Yersinia pseudotuberculosis'),
cols = c(poly, coli))
@@ -309,8 +384,7 @@ EUCAST_rules <- function(tbl,
if (info == TRUE) {
cat('...Table 2: Intrinsic resistance in non-fermentative Gram-negative bacteria\n')
}
#voortgang <- progress_estimated(8)
# Intrisiek R voor groep
# Intrisiek R for this group
edit_rsi(to = 'R',
rows = which(tbl$genus %in% c('Achromobacter',
'Acinetobacter',
@@ -322,54 +396,53 @@ EUCAST_rules <- function(tbl,
'Ochrobactrum',
'Pseudomonas',
'Stenotrophomonas')),
cols = c(peni, cfox, cfur, glycopeptiden, fusi, macroliden, linc, streptogramines, rifa, dapt, line))
cols = c(peni, cfox, cfur, glycopeptides, fusi, macrolides, linc, streptogramins, rifa, dapt, line))
# Acinetobacter
edit_rsi(to = 'R',
rows = which(tbl$fullname %like% '^Acinetobacter (baumannii|pittii|nosocomialis|calcoaceticus)'),
cols = c(aminopenicillines, amcl, czol, cfot, cftr, aztr, erta, trim, fosf, tetracyclines[tetracyclines != 'mino']))
cols = c(aminopenicillins, amcl, czol, cfot, cftr, aztr, erta, trim, fosf, tetracyclines[tetracyclines != 'mino']))
# Achromobacter
edit_rsi(to = 'R',
rows = which(tbl$fullname %like% '^Achromobacter (xylosoxydans|xylosoxidans)'),
cols = c(aminopenicillines, czol, cfot, cftr, erta))
cols = c(aminopenicillins, czol, cfot, cftr, erta))
# 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)'),
cols = c(aminopenicillines, amcl, tica, pita, czol, cfot, cftr, aztr, erta, cipr, chlo, aminoglycosiden, trim, fosf, polymyxines))
cols = c(aminopenicillins, amcl, tica, pita, czol, cfot, cftr, aztr, erta, cipr, chlo, aminoglycosides, trim, fosf, polymyxins))
# Elizabethkingia
edit_rsi(to = 'R',
rows = which(tbl$fullname %like% '^Elizabethkingia meningoseptic(a|um)'),
cols = c(aminopenicillines, amcl, tica, czol, cfot, cftr, cfta, cfep, aztr, erta, imip, mero, polymyxines))
cols = c(aminopenicillins, amcl, tica, czol, cfot, cftr, cfta, cfep, aztr, erta, imip, mero, polymyxins))
# Ochrobactrum
edit_rsi(to = 'R',
rows = which(tbl$fullname %like% '^Ochrobactrum anthropi'),
cols = c(aminopenicillines, amcl, tica, pita, czol, cfot, cftr, cfta, cfep, aztr, erta))
cols = c(aminopenicillins, amcl, tica, pita, czol, cfot, cftr, cfta, cfep, aztr, erta))
# Pseudomonas
edit_rsi(to = 'R',
rows = which(tbl$fullname %like% '^Pseudomonas aeruginosa'),
cols = c(aminopenicillines, amcl, czol, cfot, cftr, erta, chlo, kana, neom, trim, trsu, tetracyclines, tige))
cols = c(aminopenicillins, amcl, czol, cfot, cftr, erta, chlo, kana, neom, trim, trsu, tetracyclines, tige))
# Stenotrophomonas
edit_rsi(to = 'R',
rows = which(tbl$fullname %like% '^Stenotrophomonas maltophilia'),
cols = c(aminopenicillines, amcl, tica, pita, czol, cfot, cftr, cfta, aztr, erta, imip, mero, aminoglycosiden, trim, fosf, tetr))
cols = c(aminopenicillins, amcl, tica, pita, czol, cfot, cftr, cfta, aztr, erta, imip, mero, aminoglycosides, trim, fosf, tetr))
# Table 3: Intrinsic resistance in other Gram-negative bacteria ----
if (info == TRUE) {
cat('...Table 3: Intrinsic resistance in other Gram-negative bacteria\n')
}
#voortgang <- progress_estimated(7)
# Intrisiek R voor groep
# Intrisiek R for this group
edit_rsi(to = 'R',
rows = which(tbl$genus %in% c('Haemophilus',
'Moraxella',
'Neisseria',
'Campylobacter')),
cols = c(glycopeptiden, linc, dapt, line))
cols = c(glycopeptides, linc, dapt, line))
# Haemophilus
edit_rsi(to = 'R',
rows = which(tbl$fullname %like% '^Haemophilus influenzae'),
cols = c(fusi, streptogramines))
cols = c(fusi, streptogramins))
# Moraxella
edit_rsi(to = 'R',
rows = which(tbl$fullname %like% '^Moraxella catarrhalis'),
@@ -381,21 +454,20 @@ EUCAST_rules <- function(tbl,
# Campylobacter
edit_rsi(to = 'R',
rows = which(tbl$fullname %like% '^Campylobacter fetus'),
cols = c(fusi, streptogramines, trim, nali))
cols = c(fusi, streptogramins, trim, nali))
edit_rsi(to = 'R',
rows = which(tbl$fullname %like% '^Campylobacter (jejuni|coli)'),
cols = c(fusi, streptogramines, trim))
cols = c(fusi, streptogramins, trim))
# Table 4: Intrinsic resistance in Gram-positive bacteria ----
if (info == TRUE) {
cat('...Table 4: Intrinsic resistance in Gram-positive bacteria\n')
}
#voortgang <- progress_estimated(14)
# Intrisiek R voor groep
# Intrisiek R for this group
edit_rsi(to = 'R',
rows = which(tbl$gramstain %like% 'Positi(e|)(v|f)'),
cols = c(aztr, polymyxines, nali))
cols = c(aztr, polymyxins, nali))
# Staphylococcus
edit_rsi(to = 'R',
rows = which(tbl$fullname %like% '^Staphylococcus saprophyticus'),
@@ -412,17 +484,17 @@ EUCAST_rules <- function(tbl,
# Streptococcus
edit_rsi(to = 'R',
rows = which(tbl$genus == 'Streptococcus'),
cols = c(fusi, cfta, aminoglycosiden))
cols = c(fusi, cfta, aminoglycosides))
# Enterococcus
edit_rsi(to = 'R',
rows = which(tbl$fullname %like% '^Enterococcus faecalis'),
cols = c(fusi, cfta, cefalosporines[cefalosporines != cfta], aminoglycosiden, macroliden, clin, qida, trim, trsu))
cols = c(fusi, cfta, cephalosporins[cephalosporins != cfta], aminoglycosides, macrolides, clin, qida, trim, trsu))
edit_rsi(to = 'R',
rows = which(tbl$fullname %like% '^Enterococcus (gallinarum|casseliflavus)'),
cols = c(fusi, cfta, cefalosporines[cefalosporines != cfta], aminoglycosiden, macroliden, clin, qida, vanc, trim, trsu))
cols = c(fusi, cfta, cephalosporins[cephalosporins != cfta], aminoglycosides, macrolides, clin, qida, vanc, trim, trsu))
edit_rsi(to = 'R',
rows = which(tbl$fullname %like% '^Enterococcus faecium'),
cols = c(fusi, cfta, cefalosporines[cefalosporines != cfta], aminoglycosiden, macroliden, trim, trsu))
cols = c(fusi, cfta, cephalosporins[cephalosporins != cfta], aminoglycosides, macrolides, trim, trsu))
# Corynebacterium
edit_rsi(to = 'R',
rows = which(tbl$genus == 'Corynebacterium'),
@@ -430,7 +502,7 @@ EUCAST_rules <- function(tbl,
# Listeria
edit_rsi(to = 'R',
rows = which(tbl$fullname %like% '^Listeria monocytogenes'),
cols = c(cfta, cefalosporines[cefalosporines != cfta]))
cols = c(cfta, cephalosporins[cephalosporins != cfta]))
# overig
edit_rsi(to = 'R',
rows = which(tbl$genus %in% c('Leuconostoc', 'Pediococcus')),
@@ -446,34 +518,32 @@ EUCAST_rules <- function(tbl,
if (info == TRUE) {
cat('...Table 8: Interpretive rules for B-lactam agents and Gram-positive cocci\n')
}
#voortgang <- progress_estimated(2)
# regel 8.3
# rule 8.3
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'),
cols = c(aminopenicillines, cefalosporines, carbapenems))
cols = c(aminopenicillins, cephalosporins, carbapenems))
}
# regel 8.6
# rule 8.6
if (!is.na(ampi)) {
edit_rsi(to = 'R',
rows = which(tbl$genus == 'Enterococcus'
& tbl[, ampi] == 'R'),
cols = c(ureidopenicillines, carbapenems))
cols = c(ureidopenicillins, carbapenems))
}
if (!is.na(amox)) {
edit_rsi(to = 'R',
rows = which(tbl$genus == 'Enterococcus'
& tbl[, amox] == 'R'),
cols = c(ureidopenicillines, carbapenems))
cols = c(ureidopenicillins, carbapenems))
}
# 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')
}
#voortgang <- progress_estimated(1)
# regel 9.3
# rule 9.3
if (!is.na(tica) & !is.na(pita)) {
edit_rsi(to = 'R',
rows = which(tbl$family == 'Enterobacteriaceae'
@@ -486,10 +556,9 @@ EUCAST_rules <- function(tbl,
if (info == TRUE) {
cat('...Table 10: Interpretive rules for B-lactam agents and other Gram-negative bacteria\n')
}
#voortgang <- progress_estimated(1)
# regel 10.2
# rule 10.2
if (!is.na(ampi)) {
# hiervoor moeten we eerst weten of ze B-lactamase-positief zijn
# you should know first if the are B-lactamase positive, so do not run for now
# edit_rsi(to = 'R',
# rows = which(tbl$fullname %like% '^Haemophilus influenza'
# & tbl[, ampi] == 'R'),
@@ -500,7 +569,7 @@ EUCAST_rules <- function(tbl,
if (info == TRUE) {
cat('...Table 11: Interpretive rules for macrolides, lincosamides, and streptogramins\n')
}
# regel 11.1
# rule 11.1
if (!is.na(eryt)) {
if (!is.na(azit)) {
tbl[, azit] <- tbl[, eryt]
@@ -514,22 +583,21 @@ EUCAST_rules <- function(tbl,
if (info == TRUE) {
cat('...Table 12: Interpretive rules for aminoglycosides\n')
}
#voortgang <- progress_estimated(4)
# regel 12.2
# rule 12.2
if (!is.na(tobr)) {
edit_rsi(to = 'R',
rows = which(tbl$genus == 'Staphylococcus'
& tbl[, tobr] == 'R'),
cols = c(kana, amik))
}
# regel 12.3
# rule 12.3
if (!is.na(gent)) {
edit_rsi(to = 'R',
rows = which(tbl$genus == 'Staphylococcus'
& tbl[, gent] == 'R'),
cols = aminoglycosiden)
cols = aminoglycosides)
}
# regel 12.8
# rule 12.8
if (!is.na(gent) & !is.na(tobr)) {
edit_rsi(to = 'R',
rows = which(tbl$family == 'Enterobacteriaceae'
@@ -537,7 +605,7 @@ EUCAST_rules <- function(tbl,
& tbl[, tobr] == 'S'),
cols = gent)
}
# regel 12.9
# rule 12.9
if (!is.na(gent) & !is.na(tobr)) {
edit_rsi(to = 'R',
rows = which(tbl$family == 'Enterobacteriaceae'
@@ -551,42 +619,40 @@ EUCAST_rules <- function(tbl,
if (info == TRUE) {
cat('...Table 13: Interpretive rules for quinolones\n')
}
#voortgang <- progress_estimated(4)
# regel 13.2
# rule 13.2
if (!is.na(moxi)) {
edit_rsi(to = 'R',
rows = which(tbl$genus == 'Staphylococcus'
& tbl[, moxi] == 'R'),
cols = fluorochinolonen)
cols = fluoroquinolones)
}
# regel 13.4
# rule 13.4
if (!is.na(moxi)) {
edit_rsi(to = 'R',
rows = which(tbl$fullname %like% '^Streptococcus pneumoniae'
& tbl[, moxi] == 'R'),
cols = fluorochinolonen)
cols = fluoroquinolones)
}
# regel 13.5
# rule 13.5
if (!is.na(cipr)) {
edit_rsi(to = 'R',
rows = which(tbl$family == 'Enterobacteriaceae'
& tbl[, cipr] == 'R'),
cols = fluorochinolonen)
cols = fluoroquinolones)
}
# regel 13.8
# rule 13.8
if (!is.na(cipr)) {
edit_rsi(to = 'R',
rows = which(tbl$fullname %like% '^Neisseria gonorrhoeae'
& tbl[, cipr] == 'R'),
cols = fluorochinolonen)
cols = fluoroquinolones)
}
# Other ----
if (info == TRUE) {
cat('...Other\n')
cat('...Non-EUCAST: trim = R where trsu = R and ampi = R where amcl = R\n')
}
#voortgang <- progress_estimated(2)
if (!is.na(amcl)) {
edit_rsi(to = 'R',
rows = which(tbl[, amcl] == 'R'),
@@ -601,17 +667,17 @@ EUCAST_rules <- function(tbl,
tbl[, amox] <- tbl %>% pull(ampi)
}
# Toegevoegde kolommen weer verwijderen
bactlist.ncol <- ncol(AMR::bactlist) - 2
# Remove added columns again
microorganisms.ncol <- ncol(AMR::microorganisms) - 2
tbl.ncol <- ncol(tbl)
tbl <- tbl %>% select(-c((tbl.ncol - bactlist.ncol):tbl.ncol))
# en eventueel toegevoegde suffix aan bestaande kolommen weer verwijderen
colnames(tbl) <- gsub("_tempbactlist", "", colnames(tbl))
tbl <- tbl %>% select(-c((tbl.ncol - microorganisms.ncol):tbl.ncol))
# and remove added suffices
colnames(tbl) <- gsub("_tempmicroorganisms", "", colnames(tbl))
if (info == TRUE) {
cat('\nDone.\nEUCAST Expert rules applied to',
cat('Done.\n\nEUCAST Expert rules applied to',
total_rows %>% unique() %>% length() %>% format(big.mark = ","),
'different rows, to a total of',
'different rows (isolates); edited a total of',
total %>% format(big.mark = ","), 'test results.\n\n')
}
@@ -626,14 +692,14 @@ interpretive_reading <- function(...) {
#' Poperties of a microorganism
#'
#' @param bactcode ID of a microorganisme, like \code{"STAAUR} and \code{"ESCCOL}
#' @param bactid ID of a microorganisme, like \code{"STAAUR} and \code{"ESCCOL}
#' @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
#' @seealso \code{\link{bactlist}}
mo_property <- function(bactcode, property = 'fullname') {
#' @seealso \code{\link{microorganisms}}
mo_property <- function(bactid, property = 'fullname') {
mocode <- as.character(bactcode)
mocode <- as.character(bactid)
for (i in 1:length(mocode)) {
bug <- mocode[i]
@@ -641,8 +707,8 @@ mo_property <- function(bactcode, property = 'fullname') {
if (!is.na(bug)) {
result = tryCatch({
mocode[i] <-
AMR::bactlist %>%
filter(bactid == bactcode) %>%
AMR::microorganisms %>%
filter(bactid == bactid) %>%
select(property) %>%
unlist() %>%
as.character()

25
R/atc.R
View File

@@ -129,7 +129,7 @@ atc_property <- function(atc_code,
#'
#' Convert antibiotic codes (from a laboratory information system like MOLIS or GLIMS) to a (trivial) antibiotic name or ATC code, or vice versa. This uses the data from \code{\link{antibiotics}}.
#' @param abcode a code or name, like \code{"AMOX"}, \code{"AMCL"} or \code{"J01CA04"}
#' @param from,to type to transform from and to. See \code{\link{antibiotics}} for its column names.
#' @param from,to type to transform from and to. See \code{\link{antibiotics}} for its column names. WIth \code{from = "guess"} the from will be guessed from \code{"atc"}, \code{"molis"} and \code{"umcg"}.
#' @param textbetween text to put between multiple returned texts
#' @param tolower return output as lower case with function \code{\link{tolower}}.
#' @keywords ab antibiotics
@@ -154,9 +154,22 @@ atc_property <- function(atc_code,
#'
#' abname("J01CR02", from = "atc", to = "umcg")
#' # "AMCL"
abname <- function(abcode, from = 'umcg', to = 'official', textbetween = ' + ', tolower = FALSE) {
abname <- function(abcode, from = c("guess", "atc", "molis", "umcg"), to = 'official', textbetween = ' + ', tolower = FALSE) {
antibiotics <- AMR::antibiotics
from <- from[1]
if (from == "guess") {
for (i in 1:3) {
if (abcode[1] %in% (antibiotics %>% pull(i))) {
from <- colnames(antibiotics)[i]
}
}
if (from == "guess") {
from <- "umcg"
}
}
colnames(antibiotics) <- colnames(antibiotics) %>% tolower()
from <- from %>% tolower()
to <- to %>% tolower()
@@ -172,8 +185,8 @@ abname <- function(abcode, from = 'umcg', to = 'official', textbetween = ' + ',
for (i in 1:length(abcode)) {
drug <- abcode[i]
if (!grepl('+', drug, fixed = TRUE) & !grepl(' en ', drug, fixed = TRUE)) {
# bestaat maar uit 1 middel
if (any(antibiotics[, from] == drug)) {
# only 1 drug
if (drug %in% (antibiotics %>% pull(from))) {
abcode[i] <-
antibiotics %>%
filter(.[, from] == drug) %>%
@@ -181,12 +194,12 @@ abname <- function(abcode, from = 'umcg', to = 'official', textbetween = ' + ',
slice(1) %>%
as.character()
} else {
# niet gevonden
# not found
warning('Code "', drug, '" not found in antibiotics list.', call. = FALSE)
abcode[i] <- NA
}
} else {
# meerdere middelen
# more than 1 drug
if (grepl('+', drug, fixed = TRUE)) {
drug.group <-
strsplit(drug, '+', fixed = TRUE) %>%

84
R/clipboard.R Normal file
View File

@@ -0,0 +1,84 @@
#' Import/export from clipboard
#'
#' These are helper functions around \code{\link{read.table}} and \code{\link{write.table}} to import from and export to clipboard. The data will be read and written as tab-separated by default, which makes it possible to copy and paste from other software like Excel and SPSS without further transformation.
#' @rdname clipboard
#' @name clipboard
#' @inheritParams utils::read.table
#' @inheritParams utils::write.table
#' @param startrow \emph{n}th row to start importing from. For \code{clipboard_import}, when \code{header = TRUE} the import will start on row \code{startrow} \emph{below} the header.
#' @param as_vector a logical value indicating whether data consisting of only one column should be imported as vector using \code{\link[dplyr]{pull}}. This will strip off the header.
#' @keywords clipboard clipboard_import clipboard_export import export
#' @importFrom dplyr %>% pull as_tibble
#' @importFrom utils read.delim write.table object.size writeClipboard
#' @details For \code{clipboard_export}, the reserved clipboard size for exporting will be set automatically to 125\% of the object size of \code{x}. This way, it is possible to export data with thousands of rows as the only limit will be your systems RAM.
#' @export
#' @return data.frame
clipboard_import <- function(sep = '\t',
header = TRUE,
dec = ".",
na = c("", "NA", "NULL"),
startrow = 1,
as_vector = TRUE) {
import_tbl <- read.delim(file = 'clipboard',
sep = sep,
header = header,
strip.white = TRUE,
dec = dec,
na.strings = na,
fileEncoding = 'UTF-8',
encoding = 'UTF-8',
stringsAsFactors = FALSE)
# use tibble, so column types will be translated correctly
import_tbl <- as_tibble(import_tbl)
if (startrow > 1) {
# would else lose column headers
import_tbl <- import_tbl[startrow:nrow(import_tbl),]
}
colnames(import_tbl) <- gsub('[.]+', '_', colnames(import_tbl))
if (NCOL(import_tbl) == 1 & as_vector == TRUE) {
import_tbl %>% pull(1)
} else {
import_tbl
}
}
#' @rdname clipboard
#' @importFrom dplyr %>% pull as_tibble
#' @export
clipboard_export <- function(x,
sep = '\t',
dec = ".",
na = "",
header = TRUE) {
x <- deparse(substitute(x))
size <- x %>%
get() %>%
object.size() %>%
formatC(format = 'd') %>%
as.integer()
x <- get(x)
if (size > 25 * 1024 * 1024) {
# above 25 MB use a hacker function
writeClipboard(knitr::kable(x))
} else {
# set size of clipboard to 125% of the object size of x
write.table(x = x,
file = paste0("clipboard-", size * 1.25),
sep = sep,
na = na,
row.names = FALSE,
col.names = header,
dec = dec,
quote = FALSE)
}
cat("Successfully exported to clipboard:", NROW(x), "obs. of", NCOL(x), "variables.\n")
}

61
R/data.R
View File

@@ -39,7 +39,7 @@
#' \item{\code{useful_grampositive}}{\code{FALSE} if not useful according to EUCAST, \code{NA} otherwise (see Source)}
#' }
#' @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{bactlist}}
#' @seealso \code{\link{microorganisms}}
# last two columns created with:
# antibiotics %>%
# mutate(useful_gramnegative =
@@ -63,7 +63,7 @@
#' Dataset with ~2500 microorganisms
#'
#' A dataset containing all microorganisms of MOLIS. MO codes of the UMCG can be looked up using \code{\link{bactlist.umcg}}.
#' A dataset containing 2500 microorganisms. MO codes of the UMCG can be looked up using \code{\link{microorganisms.umcg}}.
#' @format A data.frame with 2507 observations and 12 variables:
#' \describe{
#' \item{\code{bactid}}{ID of microorganism}
@@ -80,24 +80,24 @@
#' \item{\code{gramstain_nl}}{Gram of microorganism in Dutch, like \code{"Negatieve staven"}}
#' }
#' @source MOLIS (LIS of Certe) - \url{https://www.certe.nl}
#' @seealso \code{\link{guess_bactid}} \code{\link{antibiotics}} \code{\link{bactlist.umcg}}
"bactlist"
#' @seealso \code{\link{guess_bactid}} \code{\link{antibiotics}} \code{\link{microorganisms.umcg}}
"microorganisms"
#' Translation table for UMCG with ~1100 microorganisms
#'
#' A dataset containing all bacteria codes of UMCG MMB. These codes can be joined to data with an ID from \code{\link{bactlist}$bactid} (using \code{\link{left_join_bactlist}}). GLIMS codes can also be translated to valid \code{bactid}'s with \code{\link{guess_bactid}}.
#' A dataset containing all bacteria codes of UMCG MMB. These codes can be joined to data with an ID from \code{\link{microorganisms}$bactid} (using \code{\link{left_join_microorganisms}}). GLIMS codes can also be translated to valid \code{bactid}'s with \code{\link{guess_bactid}}.
#' @format A data.frame with 1090 observations and 2 variables:
#' \describe{
#' \item{\code{mocode}}{Code of microorganism according to UMCG MMB}
#' \item{\code{bactid}}{Code of microorganism in \code{\link{bactlist}}}
#' \item{\code{bactid}}{Code of microorganism in \code{\link{microorganisms}}}
#' }
#' @source MOLIS (LIS of Certe) - \url{https://www.certe.nl} \cr \cr GLIMS (LIS of UMCG) - \url{https://www.umcg.nl}
#' @seealso \code{\link{guess_bactid}} \code{\link{bactlist}}
"bactlist.umcg"
#' @seealso \code{\link{guess_bactid}} \code{\link{microorganisms}}
"microorganisms.umcg"
#' Dataset with 2000 blood culture isolates of septic patients
#'
#' An anonymised dataset containing 2000 microbial blood culture isolates with their antibiogram of septic patients found in 5 different hospitals in the Netherlands, between 2001 and 2017. This data.frame can be used to practice AMR analysis e.g. with \code{\link{rsi}} or \code{\link{rsi_predict}}, or it can be used to practice other statistics.
#' An anonymised dataset containing 2000 microbial blood culture isolates with their antibiogram of septic patients found in 5 different hospitals in the Netherlands, between 2001 and 2017. This data.frame can be used to practice AMR analysis. For examples, press F1.
#' @format A data.frame with 2000 observations and 47 variables:
#' \describe{
#' \item{\code{date}}{date of receipt at the laboratory}
@@ -108,8 +108,47 @@
#' \item{\code{age}}{age of the patient}
#' \item{\code{sex}}{sex of the patient}
#' \item{\code{patient_id}}{ID of the patient, first 10 characters of an SHA hash containing irretrievable information}
#' \item{\code{bactid}}{ID of microorganism, see \code{\link{bactlist}}}
#' \item{\code{peni:mupi}}{38 different antibiotics with class \code{rsi} (see \code{\link{as.rsi}}), these column names occur in \code{\link{antibiotics}} and can be translated with \code{\link{abname}}}
#' \item{\code{bactid}}{ID of microorganism, see \code{\link{microorganisms}}}
#' \item{\code{peni:mupi}}{38 different antibiotics with class \code{rsi} (see \code{\link{as.rsi}}); these column names occur in \code{\link{antibiotics}} and can be translated with \code{\link{abname}}}
#' }
#' @source MOLIS (LIS of Certe) - \url{https://www.certe.nl}
#' @examples
#' # ----------- #
#' # PREPARATION #
#' # ----------- #
#'
#' # Save this example dataset to an object, so we can edit it:
#' my_data <- septic_patients
#'
#' # load the dplyr package to make data science A LOT easier
#' library(dplyr)
#'
#' # Add first isolates to our dataset:
#' my_data <- my_data %>%
#' mutate(first_isolates = first_isolate(my_data, date, patient_id, bactid))
#'
#' # -------- #
#' # ANALYSIS #
#' # -------- #
#'
#' # 1. Get the amoxicillin resistance percentages
#' # of E. coli, divided by hospital:
#'
#' my_data %>%
#' filter(bactid == "ESCCOL",
#' first_isolates == TRUE) %>%
#' group_by(hospital_id) %>%
#' summarise(n = n(),
#' amoxicillin_resistance = rsi(amox))
#'
#'
#' # 2. Get the amoxicillin/clavulanic acid resistance
#' # percentages of E. coli, trend over the years:
#'
#' my_data %>%
#' filter(bactid == guess_bactid("E. coli"),
#' first_isolates == TRUE) %>%
#' group_by(year = format(date, "%Y")) %>%
#' summarise(n = n(),
#' amoxclav_resistance = rsi(amcl, minimum = 20))
"septic_patients"

50
R/first_isolates.R
View File

@@ -22,8 +22,7 @@
#' @param tbl a \code{data.frame} containing isolates.
#' @param col_date column name of the result date (or date that is was received on the lab), supports tidyverse-like quotation
#' @param col_patient_id column name of the unique IDs of the patients, supports tidyverse-like quotation
#' @param col_genus column name of the genus of the microorganisms, supports tidyverse-like quotation
#' @param col_species column name of the species of the microorganisms, supports tidyverse-like quotation
#' @param col_bactid column name of the unique IDs of the microorganisms (should occur in the \code{\link{microorganisms}} dataset), supports tidyverse-like quotation
#' @param col_testcode column name of the test codes. Use \code{col_testcode = NA} to \strong{not} exclude certain test codes (like test codes for screening). In that case \code{testcodes_exclude} will be ignored. Supports tidyverse-like quotation.
#' @param col_specimen column name of the specimen type or group, supports tidyverse-like quotation
#' @param col_icu column name of the logicals (\code{TRUE}/\code{FALSE}) whether a ward or department is an Intensive Care Unit (ICU), supports tidyverse-like quotation
@@ -37,6 +36,8 @@
#' @param ignore_I logical to determine whether antibiotic interpretations with \code{"I"} will be ignored when \code{type = "keyantibiotics"}, see Details
#' @param points_threshold points until the comparison of key antibiotics will lead to inclusion of an isolate when \code{type = "points"}, see Details
#' @param info print progress
#' @param col_genus (deprecated, use \code{col_bactid} instead) column name of the genus of the microorganisms, supports tidyverse-like quotation
#' @param col_species (deprecated, use \code{col_bactid} instead) column name of the species of the microorganisms, supports tidyverse-like quotation
#' @details \strong{WHY THIS IS SO IMPORTANT} \cr
#' To conduct an analysis of antimicrobial resistance, you should only include the first isolate of every patient per episode \href{https://www.ncbi.nlm.nih.gov/pubmed/17304462}{[1]}. If you would not do this, you could easily get an overestimate or underestimate of the resistance of an antibiotic. Imagine that a patient was admitted with an MRSA and that it was found in 5 different blood cultures the following week. The resistance percentage of oxacillin of all \emph{S. aureus} isolates would be overestimated, because you included this MRSA more than once. It would be \href{https://en.wikipedia.org/wiki/Selection_bias}{selection bias}.
#'
@@ -56,7 +57,7 @@
#'
#' library(dplyr)
#' my_patients$first_isolate <- my_patients %>%
#' left_join_bactlist() %>%
#' left_join_microorganisms() %>%
#' first_isolate(col_date = date,
#' col_patient_id = patient_id,
#' col_genus = genus,
@@ -104,8 +105,7 @@
first_isolate <- function(tbl,
col_date,
col_patient_id,
col_genus,
col_species,
col_bactid = NA,
col_testcode = NA,
col_specimen = NA,
col_icu = NA,
@@ -118,11 +118,14 @@ first_isolate <- function(tbl,
type = "keyantibiotics",
ignore_I = TRUE,
points_threshold = 2,
info = TRUE) {
info = TRUE,
col_genus = NA,
col_species = NA) {
# support tidyverse-like quotation
col_date <- quasiquotate(deparse(substitute(col_date)), col_date)
col_patient_id <- quasiquotate(deparse(substitute(col_patient_id)), col_patient_id)
col_bactid <- quasiquotate(deparse(substitute(col_bactid)), col_bactid)
col_genus <- quasiquotate(deparse(substitute(col_genus)), col_genus)
col_species <- quasiquotate(deparse(substitute(col_species)), col_species)
col_testcode <- quasiquotate(deparse(substitute(col_testcode)), col_testcode)
@@ -145,12 +148,19 @@ first_isolate <- function(tbl,
check_columns_existance(col_date)
check_columns_existance(col_patient_id)
check_columns_existance(col_bactid)
check_columns_existance(col_genus)
check_columns_existance(col_species)
check_columns_existance(col_testcode)
check_columns_existance(col_icu)
check_columns_existance(col_keyantibiotics)
if (!is.na(col_bactid)) {
tbl <- tbl %>% left_join_microorganisms()
col_genus <- "genus"
col_species <- "species"
}
if (is.na(col_testcode)) {
testcodes_exclude <- NA
}
@@ -395,7 +405,7 @@ first_isolate <- function(tbl,
#' Key antibiotics based on bacteria ID
#'
#' @param tbl table with antibiotics coloms, like \code{amox} and \code{amcl}.
#' @param col_bactcode column of bacteria IDs in \code{tbl}; these should occur in \code{bactlist$bactid}, see \code{\link{bactlist}}
#' @param col_bactid column of bacteria IDs in \code{tbl}; these should occur in \code{microorganisms$bactid}, see \code{\link{microorganisms}}
#' @param info print warnings
#' @param amcl,amox,cfot,cfta,cftr,cfur,cipr,clar,clin,clox,doxy,gent,line,mero,peni,pita,rifa,teic,trsu,vanc column names of antibiotics, case-insensitive
#' @export
@@ -408,7 +418,7 @@ first_isolate <- function(tbl,
#' tbl$keyab <- key_antibiotics(tbl)
#' }
key_antibiotics <- function(tbl,
col_bactcode = 'bactid',
col_bactid = 'bactid',
info = TRUE,
amcl = 'amcl',
amox = 'amox',
@@ -443,6 +453,8 @@ key_antibiotics <- function(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))) {
@@ -473,8 +485,8 @@ key_antibiotics <- function(tbl,
trsu <- col.list[18]
vanc <- col.list[19]
# join bactlist
tbl <- tbl %>% left_join_bactlist(col_bactcode)
# join microorganisms
tbl <- tbl %>% left_join_microorganisms(col_bactid)
tbl$key_ab <- NA_character_
@@ -595,7 +607,7 @@ key_antibiotics_equal <- function(x,
result[i] <- all(x2 == y2)
} else {
stop('`', type, '` is not a valid value for type, must be `points` or `keyantibiotics`. See ?first_isolate.')
stop('`', type, '` is not a valid value for type, must be "points" or "keyantibiotics". See ?first_isolate.')
}
}
}
@@ -612,7 +624,7 @@ key_antibiotics_equal <- function(x,
#' @export
#' @importFrom dplyr %>% filter slice pull
#' @return Character (vector).
#' @seealso \code{\link{bactlist}} for the dataframe that is being used to determine ID's.
#' @seealso \code{\link{microorganisms}} for the dataframe that is being used to determine ID's.
#' @examples
#' # These examples all return "STAAUR", the ID of S. aureus:
#' guess_bactid("stau")
@@ -662,24 +674,24 @@ guess_bactid <- function(x) {
}
# let's try the ID's first
found <- AMR::bactlist %>% filter(bactid == x.bak[i])
found <- AMR::microorganisms %>% filter(bactid == x.bak[i])
if (nrow(found) == 0) {
# now try exact match
found <- AMR::bactlist %>% filter(fullname == x[i])
found <- AMR::microorganisms %>% filter(fullname == x[i])
}
if (nrow(found) == 0) {
# try any match
found <- AMR::bactlist %>% filter(fullname %like% x[i])
found <- AMR::microorganisms %>% filter(fullname %like% x[i])
}
if (nrow(found) == 0) {
# try only genus, with 'species' attached
found <- AMR::bactlist %>% filter(fullname %like% x_species[i])
found <- AMR::microorganisms %>% filter(fullname %like% x_species[i])
}
if (nrow(found) == 0) {
# search for GLIMS code
if (toupper(x.bak[i]) %in% toupper(AMR::bactlist.umcg$mocode)) {
found <- AMR::bactlist.umcg %>% filter(toupper(mocode) == toupper(x.bak[i]))
if (toupper(x.bak[i]) %in% toupper(AMR::microorganisms.umcg$mocode)) {
found <- AMR::microorganisms.umcg %>% filter(toupper(mocode) == toupper(x.bak[i]))
}
}
if (nrow(found) == 0) {
@@ -689,7 +701,7 @@ guess_bactid <- function(x) {
x[i] <- paste0(x.bak[i] %>% substr(1, x_length / 2) %>% trimws(),
'.* ',
x.bak[i] %>% substr((x_length / 2) + 1, x_length) %>% trimws())
found <- AMR::bactlist %>% filter(fullname %like% paste0('^', x[i]))
found <- AMR::microorganisms %>% filter(fullname %like% paste0('^', x[i]))
}
if (nrow(found) != 0) {

48
R/join.R
View File

@@ -1,20 +1,20 @@
#' Join a table with \code{bactlist}
#' Join a table with \code{microorganisms}
#'
#' Join the list of microorganisms \code{\link{bactlist}} easily to an existing table.
#' Join the dataset \code{\link{microorganisms}} easily to an existing table or character vector.
#' @rdname join
#' @name join
#' @aliases join inner_join
#' @param x existing table to join, also supports character vectors
#' @param by a variable to join by - could be a column name of \code{x} with values that exist in \code{bactlist$bactid} (like \code{by = "bacteria_id"}), or another column in \code{\link{bactlist}} (but then it should be named, like \code{by = c("my_genus_species" = "fullname")})
#' @param by a variable to join by - could be a column name of \code{x} with values that exist in \code{microorganisms$bactid} (like \code{by = "bacteria_id"}), or another column in \code{\link{microorganisms}} (but then it should be named, like \code{by = c("my_genus_species" = "fullname")})
#' @param suffix if there are non-joined duplicate variables in \code{x} and \code{y}, these suffixes will be added to the output to disambiguate them. Should be a character vector of length 2.
#' @param ... other parameters to pass on to \code{dplyr::\link[dplyr]{join}}.
#' @details As opposed to the \code{\link[dplyr]{join}} functions of \code{dplyr}, characters vectors are supported and at default existing columns will get a suffix \code{"2"} and the newly joined columns will not get a suffix. See \code{\link[dplyr]{join}} for more information.
#' @export
#' @examples
#' left_join_bactlist("STAAUR")
#' left_join_microorganisms("STAAUR")
#'
#' library(dplyr)
#' septic_patients %>% left_join_bactlist()
#' septic_patients %>% left_join_microorganisms()
#'
#' df <- data.frame(date = seq(from = as.Date("2018-01-01"),
#' to = as.Date("2018-01-07"),
@@ -23,20 +23,20 @@
#' "ESCCOL", "ESCCOL", "ESCCOL"),
#' stringsAsFactors = FALSE)
#' colnames(df)
#' df2 <- left_join_bactlist(df, "bacteria_id")
#' df2 <- left_join_microorganisms(df, "bacteria_id")
#' colnames(df2)
inner_join_bactlist <- function(x, by = 'bactid', suffix = c("2", ""), ...) {
inner_join_microorganisms <- function(x, by = 'bactid', suffix = c("2", ""), ...) {
if (any(class(x) %in% c('character', 'factor'))) {
x <- data.frame(bactid = x, stringsAsFactors = FALSE)
}
# no name set to `by` parameter
if (is.null(names(by))) {
joinby <- colnames(AMR::bactlist)[1]
joinby <- colnames(AMR::microorganisms)[1]
names(joinby) <- by
} else {
joinby <- by
}
join <- dplyr::inner_join(x = x, y = AMR::bactlist, by = joinby, suffix = c("2", ""), ...)
join <- dplyr::inner_join(x = x, y = AMR::microorganisms, by = joinby, suffix = c("2", ""), ...)
if (nrow(join) > nrow(x)) {
warning('the newly joined tbl contains ', nrow(join) - nrow(x), ' rows more that its original')
}
@@ -45,18 +45,18 @@ inner_join_bactlist <- function(x, by = 'bactid', suffix = c("2", ""), ...) {
#' @rdname join
#' @export
left_join_bactlist <- function(x, by = 'bactid', suffix = c("2", ""), ...) {
left_join_microorganisms <- function(x, by = 'bactid', suffix = c("2", ""), ...) {
if (any(class(x) %in% c('character', 'factor'))) {
x <- data.frame(bactid = x, stringsAsFactors = FALSE)
}
# no name set to `by` parameter
if (is.null(names(by))) {
joinby <- colnames(AMR::bactlist)[1]
joinby <- colnames(AMR::microorganisms)[1]
names(joinby) <- by
} else {
joinby <- by
}
join <- dplyr::left_join(x = x, y = AMR::bactlist, by = joinby, suffix = c("2", ""), ...)
join <- dplyr::left_join(x = x, y = AMR::microorganisms, by = joinby, suffix = c("2", ""), ...)
if (nrow(join) > nrow(x)) {
warning('the newly joined tbl contains ', nrow(join) - nrow(x), ' rows more that its original')
}
@@ -65,18 +65,18 @@ left_join_bactlist <- function(x, by = 'bactid', suffix = c("2", ""), ...) {
#' @rdname join
#' @export
right_join_bactlist <- function(x, by = 'bactid', suffix = c("2", ""), ...) {
right_join_microorganisms <- function(x, by = 'bactid', suffix = c("2", ""), ...) {
if (any(class(x) %in% c('character', 'factor'))) {
x <- data.frame(bactid = x, stringsAsFactors = FALSE)
}
# no name set to `by` parameter
if (is.null(names(by))) {
joinby <- colnames(AMR::bactlist)[1]
joinby <- colnames(AMR::microorganisms)[1]
names(joinby) <- by
} else {
joinby <- by
}
join <- dplyr::right_join(x = x, y = AMR::bactlist, by = joinby, suffix = c("2", ""), ...)
join <- dplyr::right_join(x = x, y = AMR::microorganisms, by = joinby, suffix = c("2", ""), ...)
if (nrow(join) > nrow(x)) {
warning('the newly joined tbl contains ', nrow(join) - nrow(x), ' rows more that its original')
}
@@ -85,48 +85,48 @@ right_join_bactlist <- function(x, by = 'bactid', suffix = c("2", ""), ...) {
#' @rdname join
#' @export
full_join_bactlist <- function(x, by = 'bactid', suffix = c("2", ""), ...) {
full_join_microorganisms <- function(x, by = 'bactid', suffix = c("2", ""), ...) {
if (any(class(x) %in% c('character', 'factor'))) {
x <- data.frame(bactid = x, stringsAsFactors = FALSE)
}
# no name set to `by` parameter
if (is.null(names(by))) {
joinby <- colnames(AMR::bactlist)[1]
joinby <- colnames(AMR::microorganisms)[1]
names(joinby) <- by
} else {
joinby <- by
}
dplyr::full_join(x = x, y = AMR::bactlist, by = joinby, suffix = c("2", ""), ...)
dplyr::full_join(x = x, y = AMR::microorganisms, by = joinby, suffix = c("2", ""), ...)
}
#' @rdname join
#' @export
semi_join_bactlist <- function(x, by = 'bactid', ...) {
semi_join_microorganisms <- function(x, by = 'bactid', ...) {
if (any(class(x) %in% c('character', 'factor'))) {
x <- data.frame(bactid = x, stringsAsFactors = FALSE)
}
# no name set to `by` parameter
if (is.null(names(by))) {
joinby <- colnames(AMR::bactlist)[1]
joinby <- colnames(AMR::microorganisms)[1]
names(joinby) <- by
} else {
joinby <- by
}
dplyr::semi_join(x = x, y = AMR::bactlist, by = joinby, ...)
dplyr::semi_join(x = x, y = AMR::microorganisms, by = joinby, ...)
}
#' @rdname join
#' @export
anti_join_bactlist <- function(x, by = 'bactid', ...) {
anti_join_microorganisms <- function(x, by = 'bactid', ...) {
if (any(class(x) %in% c('character', 'factor'))) {
x <- data.frame(bactid = x, stringsAsFactors = FALSE)
}
# no name set to `by` parameter
if (is.null(names(by))) {
joinby <- colnames(AMR::bactlist)[1]
joinby <- colnames(AMR::microorganisms)[1]
names(joinby) <- by
} else {
joinby <- by
}
dplyr::anti_join(x = x, y = AMR::bactlist, by = joinby, ...)
dplyr::anti_join(x = x, y = AMR::microorganisms, by = joinby, ...)
}

6
R/misc.R
View File

@@ -40,9 +40,9 @@ quasiquotate <- function(deparsed, parsed) {
}
# apply if needed
if (any(!deparsed %like% '[[$:()]'
& !deparsed %in% c('""', "''", "", # empty text
".", ".data", # dplyr references
"TRUE", "FALSE", # logicals
& !deparsed %in% c('""', "''", "", # empty text
".", ".data", # dplyr references
"TRUE", "FALSE", # logicals
"NA", "NaN", "NULL", # empty values
ls(.GlobalEnv)))) {
deparsed

124
R/rsi_analysis.R
View File

@@ -20,7 +20,7 @@
#'
#' \strong{NOTE: use \code{\link{rsi}} in dplyr functions like \code{\link[dplyr]{summarise}}.} \cr Calculate the percentage of S, SI, I, IR or R of a \code{data.frame} containing isolates.
#' @param tbl \code{data.frame} containing columns with antibiotic interpretations.
#' @param antibiotics character vector with 1, 2 or 3 antibiotics that occur as column names in \code{tbl}, like \code{antibiotics = c("amox", "amcl")}
#' @param ab character vector with 1, 2 or 3 antibiotics that occur as column names in \code{tbl}, like \code{ab = c("amox", "amcl")}
#' @param interpretation antimicrobial interpretation of which the portion must be calculated. Valid values are \code{"S"}, \code{"SI"}, \code{"I"}, \code{"IR"} or \code{"R"}.
#' @param minimum minimal amount of available isolates. Any number lower than \code{minimum} will return \code{NA} with a warning (when \code{warning = TRUE}).
#' @param percent return output as percent (text), will else (at default) be a double
@@ -43,27 +43,27 @@
#' my_table %>%
#' filter(first_isolate == TRUE,
#' genus == "Helicobacter") %>%
#' rsi_df(antibiotics = c("amox", "metr"))
#' rsi_df(ab = c("amox", "metr"))
#' }
rsi_df <- function(tbl,
antibiotics,
ab,
interpretation = 'IR',
minimum = 30,
percent = FALSE,
info = TRUE,
warning = TRUE) {
# in case tbl$interpretation already exists:
interpretations_to_check <- paste(interpretation, collapse = "")
# we willen niet dat tbl$interpretation toevallig ook bestaat, dus:
te_testen_uitslag_ab <- interpretation
# validatie:
if (min(grepl('^[a-z]{3,4}$', antibiotics)) == 0 &
min(grepl('^rsi[1-2]$', antibiotics)) == 0) {
for (i in 1:length(antibiotics)) {
antibiotics[i] <- paste0('rsi', i)
# validate:
if (min(grepl('^[a-z]{3,4}$', ab)) == 0 &
min(grepl('^rsi[1-2]$', ab)) == 0) {
for (i in 1:length(ab)) {
ab[i] <- paste0('rsi', i)
}
}
if (!grepl('^(S|SI|IS|I|IR|RI|R){1}$', te_testen_uitslag_ab)) {
if (!grepl('^(S|SI|IS|I|IR|RI|R){1}$', interpretations_to_check)) {
stop('Invalid `interpretation`; must be "S", "SI", "I", "IR", or "R".')
}
if ('is_ic' %in% colnames(tbl)) {
@@ -72,59 +72,59 @@ rsi_df <- function(tbl,
}
}
# transformeren wanneer gezocht wordt op verschillende uitslagen
if (te_testen_uitslag_ab %in% c('SI', 'IS')) {
for (i in 1:length(antibiotics)) {
lijst <- tbl[, antibiotics[i]]
# transform when checking for different results
if (interpretations_to_check %in% c('SI', 'IS')) {
for (i in 1:length(ab)) {
lijst <- tbl[, ab[i]]
if ('I' %in% lijst) {
tbl[which(tbl[antibiotics[i]] == 'I'), ][antibiotics[i]] <- 'S'
tbl[which(tbl[ab[i]] == 'I'), ][ab[i]] <- 'S'
}
}
te_testen_uitslag_ab <- 'S'
interpretations_to_check <- 'S'
}
if (te_testen_uitslag_ab %in% c('RI', 'IR')) {
for (i in 1:length(antibiotics)) {
lijst <- tbl[, antibiotics[i]]
if (interpretations_to_check %in% c('RI', 'IR')) {
for (i in 1:length(ab)) {
lijst <- tbl[, ab[i]]
if ('I' %in% lijst) {
tbl[which(tbl[antibiotics[i]] == 'I'), ][antibiotics[i]] <- 'R'
tbl[which(tbl[ab[i]] == 'I'), ][ab[i]] <- 'R'
}
}
te_testen_uitslag_ab <- 'R'
interpretations_to_check <- 'R'
}
# breuk samenstellen
if (length(antibiotics) == 1) {
# get fraction
if (length(ab) == 1) {
numerator <- tbl %>%
filter(pull(., antibiotics[1]) == te_testen_uitslag_ab) %>%
filter(pull(., ab[1]) == interpretations_to_check) %>%
nrow()
denominator <- tbl %>%
filter(pull(., antibiotics[1]) %in% c("S", "I", "R")) %>%
filter(pull(., ab[1]) %in% c("S", "I", "R")) %>%
nrow()
} else if (length(antibiotics) == 2) {
} else if (length(ab) == 2) {
numerator <- tbl %>%
filter_at(vars(antibiotics[1], antibiotics[2]),
any_vars(. == te_testen_uitslag_ab)) %>%
filter_at(vars(antibiotics[1], antibiotics[2]),
filter_at(vars(ab[1], ab[2]),
any_vars(. == interpretations_to_check)) %>%
filter_at(vars(ab[1], ab[2]),
all_vars(. %in% c("S", "R", "I"))) %>%
nrow()
denominator <- tbl %>%
filter_at(vars(antibiotics[1], antibiotics[2]),
filter_at(vars(ab[1], ab[2]),
all_vars(. %in% c("S", "R", "I"))) %>%
nrow()
} else if (length(antibiotics) == 3) {
} else if (length(ab) == 3) {
numerator <- tbl %>%
filter_at(vars(antibiotics[1], antibiotics[2], antibiotics[3]),
any_vars(. == te_testen_uitslag_ab)) %>%
filter_at(vars(antibiotics[1], antibiotics[2], antibiotics[3]),
filter_at(vars(ab[1], ab[2], ab[3]),
any_vars(. == interpretations_to_check)) %>%
filter_at(vars(ab[1], ab[2], ab[3]),
all_vars(. %in% c("S", "R", "I"))) %>%
nrow()
denominator <- tbl %>%
filter_at(vars(antibiotics[1], antibiotics[2], antibiotics[3]),
filter_at(vars(ab[1], ab[2], ab[3]),
all_vars(. %in% c("S", "R", "I"))) %>%
nrow()
@@ -132,7 +132,7 @@ rsi_df <- function(tbl,
stop('Maximum of 3 drugs allowed.')
}
# tekstdeel opbouwen
# build text part
if (info == TRUE) {
cat('n =', denominator)
info.txt1 <- percent(denominator / nrow(tbl))
@@ -140,23 +140,22 @@ rsi_df <- function(tbl,
info.txt1 <- 'none'
}
info.txt2 <- gsub(',', ' and',
antibiotics %>%
abname(to = 'trivial',
tolower = TRUE) %>%
ab %>%
abname(tolower = TRUE) %>%
toString(), fixed = TRUE)
info.txt2 <- gsub('rsi1 and rsi2', 'these two drugs', info.txt2, fixed = TRUE)
info.txt2 <- gsub('rsi1', 'this drug', info.txt2, fixed = TRUE)
cat(paste0(' (of ', nrow(tbl), ' in total; ', info.txt1, ' tested on ', info.txt2, ')\n'))
}
# rekenen en opmaken
# calculate and format
y <- numerator / denominator
if (percent == TRUE) {
y <- percent(y)
}
if (denominator < minimum) {
if (warning == TRUE) {
warning(paste0('TOO FEW ISOLATES OF ', toString(antibiotics), ' (n = ', denominator, ', n < ', minimum, '); NO RESULT.'))
warning(paste0('TOO FEW ISOLATES OF ', toString(ab), ' (n = ', denominator, ', n < ', minimum, '); NO RESULT.'))
}
y <- NA
}
@@ -192,26 +191,31 @@ rsi_df <- function(tbl,
#' rsi(as.rsi(isolates$amcl), interpretation = "S")
#' }
rsi <- function(ab1, ab2 = NA, interpretation = 'IR', minimum = 30, percent = FALSE, info = FALSE, warning = FALSE) {
function_text <- as.character(match.call())
# param 1 = functienaam
# param 2 = ab1
# param 3 = ab2
ab1.naam <- function_text[2]
if (!grepl('^[a-z]{3,4}$', ab1.naam)) {
ab1.naam <- 'rsi1'
ab1.name <- deparse(substitute(ab1))
if (ab1.name %like% '.[$].') {
ab1.name <- unlist(strsplit(ab1.name, "$", fixed = TRUE))
ab1.name <- ab1.name[length(ab1.name)]
}
ab2.naam <- function_text[3]
if (!grepl('^[a-z]{3,4}$', ab2.naam)) {
ab2.naam <- 'rsi2'
if (!ab1.name %like% '^[a-z]{3,4}$') {
ab1.name <- 'rsi1'
}
ab2.name <- deparse(substitute(ab2))
if (ab2.name %like% '.[$].') {
ab2.name <- unlist(strsplit(ab2.name, "$", fixed = TRUE))
ab2.name <- ab2.name[length(ab2.name)]
}
if (!ab2.name %like% '^[a-z]{3,4}$') {
ab2.name <- 'rsi2'
}
interpretation <- paste(interpretation, collapse = "")
tbl <- tibble(rsi1 = ab1, rsi2 = ab2)
colnames(tbl) <- c(ab1.naam, ab2.naam)
colnames(tbl) <- c(ab1.name, ab2.name)
if (length(ab2) == 1) {
return(rsi_df(tbl = tbl,
antibiotics = ab1.naam,
ab = ab1.name,
interpretation = interpretation,
minimum = minimum,
percent = percent,
@@ -225,7 +229,7 @@ rsi <- function(ab1, ab2 = NA, interpretation = 'IR', minimum = 30, percent = FA
warning('`interpretation` is not set to S, albeit analysing a combination therapy.')
}
return(rsi_df(tbl = tbl,
antibiotics = c(ab1.naam, ab2.naam),
ab = c(ab1.name, ab2.name),
interpretation = interpretation,
minimum = minimum,
percent = percent,
@@ -270,7 +274,7 @@ rsi <- function(ab1, ab2 = NA, interpretation = 'IR', minimum = 30, percent = FA
#' library(dplyr)
#' septic_patients %>%
#' # get bacteria properties like genus and species
#' left_join_bactlist("bactid") %>%
#' left_join_microorganisms("bactid") %>%
#' # calculate first isolates
#' mutate(first_isolate =
#' first_isolate(.,

BIN
data/bactlist.rda
View File

Binary file not shown.

BIN
data/bactlist.umcg.rda
View File

Binary file not shown.

BIN
data/microorganisms.rda Normal file
View File

Binary file not shown.

BIN
data/microorganisms.umcg.rda Normal file
View File

Binary file not shown.

8
man/EUCAST.Rd
View File

@@ -9,11 +9,11 @@ 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
EUCAST Expert Rules Version 3.1: \cr
\url{http://www.eucast.org/expert_rules_and_intrinsic_resistance}
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}
}
\usage{
EUCAST_rules(tbl, col_bactcode = "bactid", info = TRUE, amcl = "amcl",
EUCAST_rules(tbl, col_bactid = "bactid", 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",
@@ -35,7 +35,7 @@ interpretive_reading(...)
\arguments{
\item{tbl}{table with antibiotic columns, like e.g. \code{amox} and \code{amcl}}
\item{col_bactcode}{column name of the bacteria ID in \code{tbl} - values of this column should be present in \code{bactlist$bactid}, see \code{\link{bactlist}}}
\item{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}}}
\item{info}{print progress}

6
man/abname.Rd
View File

@@ -7,13 +7,13 @@
\code{\link{antibiotics}}
}
\usage{
abname(abcode, from = "umcg", to = "official", textbetween = " + ",
tolower = FALSE)
abname(abcode, from = c("guess", "atc", "molis", "umcg"), to = "official",
textbetween = " + ", tolower = FALSE)
}
\arguments{
\item{abcode}{a code or name, like \code{"AMOX"}, \code{"AMCL"} or \code{"J01CA04"}}
\item{from, to}{type to transform from and to. See \code{\link{antibiotics}} for its column names.}
\item{from, to}{type to transform from and to. See \code{\link{antibiotics}} for its column names. WIth \code{from = "guess"} the from will be guessed from \code{"atc"}, \code{"molis"} and \code{"umcg"}.}
\item{textbetween}{text to put between multiple returned texts}

2
man/antibiotics.Rd
View File

@@ -33,6 +33,6 @@ antibiotics
A dataset containing all antibiotics with a J0 code, with their DDD's. Properties were downloaded from the WHO, see Source.
}
\seealso{
\code{\link{bactlist}}
\code{\link{microorganisms}}
}
\keyword{datasets}

50
man/clipboard.Rd Normal file
View File

@@ -0,0 +1,50 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/clipboard.R
\name{clipboard}
\alias{clipboard}
\alias{clipboard_import}
\alias{clipboard_export}
\title{Import/export from clipboard}
\usage{
clipboard_import(sep = "\\t", header = TRUE, dec = ".", na = c("", "NA",
"NULL"), startrow = 1, as_vector = TRUE)
clipboard_export(x, sep = "\\t", dec = ".", na = "", header = TRUE)
}
\arguments{
\item{sep}{the field separator character. Values on each line of the
file are separated by this character. If \code{sep = ""} (the
default for \code{read.table}) the separator is \sQuote{white space},
that is one or more spaces, tabs, newlines or carriage returns.}
\item{header}{a logical value indicating whether the file contains the
names of the variables as its first line. If missing, the value is
determined from the file format: \code{header} is set to \code{TRUE}
if and only if the first row contains one fewer field than the
number of columns.}
\item{dec}{the character used in the file for decimal points.}
\item{na}{the string to use for missing values in the data.}
\item{startrow}{\emph{n}th row to start importing from. For \code{clipboard_import}, when \code{header = TRUE} the import will start on row \code{startrow} \emph{below} the header.}
\item{as_vector}{a logical value indicating whether data consisting of only one column should be imported as vector using \code{\link[dplyr]{pull}}. This will strip off the header.}
\item{x}{the object to be written, preferably a matrix or data frame.
If not, it is attempted to coerce \code{x} to a data frame.}
}
\value{
data.frame
}
\description{
These are helper functions around \code{\link{read.table}} and \code{\link{write.table}} to import from and export to clipboard. The data will be read and written as tab-separated by default, which makes it possible to copy and paste from other software like Excel and SPSS without further transformation.
}
\details{
For \code{clipboard_export}, the reserved clipboard size for exporting will be set automatically to 125\% of the object size of \code{x}. This way, it is possible to export data with thousands of rows as the only limit will be your systems RAM.
}
\keyword{clipboard}
\keyword{clipboard_export}
\keyword{clipboard_import}
\keyword{export}
\keyword{import}

14
man/first_isolate.Rd
View File

@@ -4,12 +4,12 @@
\alias{first_isolate}
\title{Determine first (weighted) isolates}
\usage{
first_isolate(tbl, col_date, col_patient_id, col_genus, col_species,
first_isolate(tbl, col_date, col_patient_id, col_bactid = NA,
col_testcode = NA, col_specimen = NA, col_icu = NA,
col_keyantibiotics = NA, episode_days = 365, testcodes_exclude = "",
icu_exclude = FALSE, filter_specimen = NA, output_logical = TRUE,
type = "keyantibiotics", ignore_I = TRUE, points_threshold = 2,
info = TRUE)
info = TRUE, col_genus = NA, col_species = NA)
}
\arguments{
\item{tbl}{a \code{data.frame} containing isolates.}
@@ -18,9 +18,7 @@ first_isolate(tbl, col_date, col_patient_id, col_genus, col_species,
\item{col_patient_id}{column name of the unique IDs of the patients, supports tidyverse-like quotation}
\item{col_genus}{column name of the genus of the microorganisms, supports tidyverse-like quotation}
\item{col_species}{column name of the species of the microorganisms, supports tidyverse-like quotation}
\item{col_bactid}{column name of the unique IDs of the microorganisms (should occur in the \code{\link{microorganisms}} dataset), supports tidyverse-like quotation}
\item{col_testcode}{column name of the test codes. Use \code{col_testcode = NA} to \strong{not} exclude certain test codes (like test codes for screening). In that case \code{testcodes_exclude} will be ignored. Supports tidyverse-like quotation.}
@@ -47,6 +45,10 @@ first_isolate(tbl, col_date, col_patient_id, col_genus, col_species,
\item{points_threshold}{points until the comparison of key antibiotics will lead to inclusion of an isolate when \code{type = "points"}, see Details}
\item{info}{print progress}
\item{col_genus}{(deprecated, use \code{col_bactid} instead) column name of the genus of the microorganisms, supports tidyverse-like quotation}
\item{col_species}{(deprecated, use \code{col_bactid} instead) column name of the species of the microorganisms, supports tidyverse-like quotation}
}
\value{
A vector to add to table, see Examples.
@@ -71,7 +73,7 @@ my_patients <- septic_patients
library(dplyr)
my_patients$first_isolate <- my_patients \%>\%
left_join_bactlist() \%>\%
left_join_microorganisms() \%>\%
first_isolate(col_date = date,
col_patient_id = patient_id,
col_genus = genus,

2
man/guess_bactid.Rd
View File

@@ -27,5 +27,5 @@ guess_bactid("MRSA") # Methicillin-resistant S. aureus
guess_bactid("VISA") # Vancomycin Intermediate S. aureus
}
\seealso{
\code{\link{bactlist}} for the dataframe that is being used to determine ID's.
\code{\link{microorganisms}} for the dataframe that is being used to determine ID's.
}

36
man/join.Rd
View File

@@ -2,47 +2,47 @@
% Please edit documentation in R/join.R
\name{join}
\alias{join}
\alias{inner_join_bactlist}
\alias{inner_join_microorganisms}
\alias{inner_join}
\alias{left_join_bactlist}
\alias{right_join_bactlist}
\alias{full_join_bactlist}
\alias{semi_join_bactlist}
\alias{anti_join_bactlist}
\title{Join a table with \code{bactlist}}
\alias{left_join_microorganisms}
\alias{right_join_microorganisms}
\alias{full_join_microorganisms}
\alias{semi_join_microorganisms}
\alias{anti_join_microorganisms}
\title{Join a table with \code{microorganisms}}
\usage{
inner_join_bactlist(x, by = "bactid", suffix = c("2", ""), ...)
inner_join_microorganisms(x, by = "bactid", suffix = c("2", ""), ...)
left_join_bactlist(x, by = "bactid", suffix = c("2", ""), ...)
left_join_microorganisms(x, by = "bactid", suffix = c("2", ""), ...)
right_join_bactlist(x, by = "bactid", suffix = c("2", ""), ...)
right_join_microorganisms(x, by = "bactid", suffix = c("2", ""), ...)
full_join_bactlist(x, by = "bactid", suffix = c("2", ""), ...)
full_join_microorganisms(x, by = "bactid", suffix = c("2", ""), ...)
semi_join_bactlist(x, by = "bactid", ...)
semi_join_microorganisms(x, by = "bactid", ...)
anti_join_bactlist(x, by = "bactid", ...)
anti_join_microorganisms(x, by = "bactid", ...)
}
\arguments{
\item{x}{existing table to join, also supports character vectors}
\item{by}{a variable to join by - could be a column name of \code{x} with values that exist in \code{bactlist$bactid} (like \code{by = "bacteria_id"}), or another column in \code{\link{bactlist}} (but then it should be named, like \code{by = c("my_genus_species" = "fullname")})}
\item{by}{a variable to join by - could be a column name of \code{x} with values that exist in \code{microorganisms$bactid} (like \code{by = "bacteria_id"}), or another column in \code{\link{microorganisms}} (but then it should be named, like \code{by = c("my_genus_species" = "fullname")})}
\item{suffix}{if there are non-joined duplicate variables in \code{x} and \code{y}, these suffixes will be added to the output to disambiguate them. Should be a character vector of length 2.}
\item{...}{other parameters to pass on to \code{dplyr::\link[dplyr]{join}}.}
}
\description{
Join the list of microorganisms \code{\link{bactlist}} easily to an existing table.
Join the dataset \code{\link{microorganisms}} easily to an existing table or character vector.
}
\details{
As opposed to the \code{\link[dplyr]{join}} functions of \code{dplyr}, characters vectors are supported and at default existing columns will get a suffix \code{"2"} and the newly joined columns will not get a suffix. See \code{\link[dplyr]{join}} for more information.
}
\examples{
left_join_bactlist("STAAUR")
left_join_microorganisms("STAAUR")
library(dplyr)
septic_patients \%>\% left_join_bactlist()
septic_patients \%>\% left_join_microorganisms()
df <- data.frame(date = seq(from = as.Date("2018-01-01"),
to = as.Date("2018-01-07"),
@@ -51,6 +51,6 @@ df <- data.frame(date = seq(from = as.Date("2018-01-01"),
"ESCCOL", "ESCCOL", "ESCCOL"),
stringsAsFactors = FALSE)
colnames(df)
df2 <- left_join_bactlist(df, "bacteria_id")
df2 <- left_join_microorganisms(df, "bacteria_id")
colnames(df2)
}

4
man/key_antibiotics.Rd
View File

@@ -4,7 +4,7 @@
\alias{key_antibiotics}
\title{Key antibiotics based on bacteria ID}
\usage{
key_antibiotics(tbl, col_bactcode = "bactid", info = TRUE, amcl = "amcl",
key_antibiotics(tbl, col_bactid = "bactid", info = TRUE, amcl = "amcl",
amox = "amox", cfot = "cfot", cfta = "cfta", cftr = "cftr",
cfur = "cfur", cipr = "cipr", clar = "clar", clin = "clin",
clox = "clox", doxy = "doxy", gent = "gent", line = "line",
@@ -14,7 +14,7 @@ key_antibiotics(tbl, col_bactcode = "bactid", info = TRUE, amcl = "amcl",
\arguments{
\item{tbl}{table with antibiotics coloms, like \code{amox} and \code{amcl}.}
\item{col_bactcode}{column of bacteria IDs in \code{tbl}; these should occur in \code{bactlist$bactid}, see \code{\link{bactlist}}}
\item{col_bactid}{column of bacteria IDs in \code{tbl}; these should occur in \code{microorganisms$bactid}, see \code{\link{microorganisms}}}
\item{info}{print warnings}

10
man/bactlist.Rd → man/microorganisms.Rd
View File

@@ -1,8 +1,8 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/data.R
\docType{data}
\name{bactlist}
\alias{bactlist}
\name{microorganisms}
\alias{microorganisms}
\title{Dataset with ~2500 microorganisms}
\format{A data.frame with 2507 observations and 12 variables:
\describe{
@@ -23,12 +23,12 @@
MOLIS (LIS of Certe) - \url{https://www.certe.nl}
}
\usage{
bactlist
microorganisms
}
\description{
A dataset containing all microorganisms of MOLIS. MO codes of the UMCG can be looked up using \code{\link{bactlist.umcg}}.
A dataset containing 2500 microorganisms. MO codes of the UMCG can be looked up using \code{\link{microorganisms.umcg}}.
}
\seealso{
\code{\link{guess_bactid}} \code{\link{antibiotics}} \code{\link{bactlist.umcg}}
\code{\link{guess_bactid}} \code{\link{antibiotics}} \code{\link{microorganisms.umcg}}
}
\keyword{datasets}

12
man/bactlist.umcg.Rd → man/microorganisms.umcg.Rd
View File

@@ -1,24 +1,24 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/data.R
\docType{data}
\name{bactlist.umcg}
\alias{bactlist.umcg}
\name{microorganisms.umcg}
\alias{microorganisms.umcg}
\title{Translation table for UMCG with ~1100 microorganisms}
\format{A data.frame with 1090 observations and 2 variables:
\describe{
\item{\code{mocode}}{Code of microorganism according to UMCG MMB}
\item{\code{bactid}}{Code of microorganism in \code{\link{bactlist}}}
\item{\code{bactid}}{Code of microorganism in \code{\link{microorganisms}}}
}}
\source{
MOLIS (LIS of Certe) - \url{https://www.certe.nl} \cr \cr GLIMS (LIS of UMCG) - \url{https://www.umcg.nl}
}
\usage{
bactlist.umcg
microorganisms.umcg
}
\description{
A dataset containing all bacteria codes of UMCG MMB. These codes can be joined to data with an ID from \code{\link{bactlist}$bactid} (using \code{\link{left_join_bactlist}}). GLIMS codes can also be translated to valid \code{bactid}'s with \code{\link{guess_bactid}}.
A dataset containing all bacteria codes of UMCG MMB. These codes can be joined to data with an ID from \code{\link{microorganisms}$bactid} (using \code{\link{left_join_microorganisms}}). GLIMS codes can also be translated to valid \code{bactid}'s with \code{\link{guess_bactid}}.
}
\seealso{
\code{\link{guess_bactid}} \code{\link{bactlist}}
\code{\link{guess_bactid}} \code{\link{microorganisms}}
}
\keyword{datasets}

6
man/mo_property.Rd
View File

@@ -4,10 +4,10 @@
\alias{mo_property}
\title{Poperties of a microorganism}
\usage{
mo_property(bactcode, property = "fullname")
mo_property(bactid, property = "fullname")
}
\arguments{
\item{bactcode}{ID of a microorganisme, like \code{"STAAUR} and \code{"ESCCOL}}
\item{bactid}{ID of a microorganisme, like \code{"STAAUR} and \code{"ESCCOL}}
\item{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}}
}
@@ -15,5 +15,5 @@ mo_property(bactcode, property = "fullname")
Poperties of a microorganism
}
\seealso{
\code{\link{bactlist}}
\code{\link{microorganisms}}
}

8
man/rsi_df.Rd
View File

@@ -4,13 +4,13 @@
\alias{rsi_df}
\title{Resistance of isolates in data.frame}
\usage{
rsi_df(tbl, antibiotics, interpretation = "IR", minimum = 30,
percent = FALSE, info = TRUE, warning = TRUE)
rsi_df(tbl, ab, interpretation = "IR", minimum = 30, percent = FALSE,
info = TRUE, warning = TRUE)
}
\arguments{
\item{tbl}{\code{data.frame} containing columns with antibiotic interpretations.}
\item{antibiotics}{character vector with 1, 2 or 3 antibiotics that occur as column names in \code{tbl}, like \code{antibiotics = c("amox", "amcl")}}
\item{ab}{character vector with 1, 2 or 3 antibiotics that occur as column names in \code{tbl}, like \code{ab = c("amox", "amcl")}}
\item{interpretation}{antimicrobial interpretation of which the portion must be calculated. Valid values are \code{"S"}, \code{"SI"}, \code{"I"}, \code{"IR"} or \code{"R"}.}
@@ -42,7 +42,7 @@ library(dplyr)
my_table \%>\%
filter(first_isolate == TRUE,
genus == "Helicobacter") \%>\%
rsi_df(antibiotics = c("amox", "metr"))
rsi_df(ab = c("amox", "metr"))
}
}
\seealso{

2
man/rsi_predict.Rd
View File

@@ -53,7 +53,7 @@ tbl \%>\%
library(dplyr)
septic_patients \%>\%
# get bacteria properties like genus and species
left_join_bactlist("bactid") \%>\%
left_join_microorganisms("bactid") \%>\%
# calculate first isolates
mutate(first_isolate =
first_isolate(.,

46
man/septic_patients.Rd
View File

@@ -14,8 +14,8 @@
\item{\code{age}}{age of the patient}
\item{\code{sex}}{sex of the patient}
\item{\code{patient_id}}{ID of the patient, first 10 characters of an SHA hash containing irretrievable information}
\item{\code{bactid}}{ID of microorganism, see \code{\link{bactlist}}}
\item{\code{peni:mupi}}{38 different antibiotics with class \code{rsi} (see \code{\link{as.rsi}}), these column names occur in \code{\link{antibiotics}} and can be translated with \code{\link{abname}}}
\item{\code{bactid}}{ID of microorganism, see \code{\link{microorganisms}}}
\item{\code{peni:mupi}}{38 different antibiotics with class \code{rsi} (see \code{\link{as.rsi}}); these column names occur in \code{\link{antibiotics}} and can be translated with \code{\link{abname}}}
}}
\source{
MOLIS (LIS of Certe) - \url{https://www.certe.nl}
@@ -24,6 +24,46 @@ MOLIS (LIS of Certe) - \url{https://www.certe.nl}
septic_patients
}
\description{
An anonymised dataset containing 2000 microbial blood culture isolates with their antibiogram of septic patients found in 5 different hospitals in the Netherlands, between 2001 and 2017. This data.frame can be used to practice AMR analysis e.g. with \code{\link{rsi}} or \code{\link{rsi_predict}}, or it can be used to practice other statistics.
An anonymised dataset containing 2000 microbial blood culture isolates with their antibiogram of septic patients found in 5 different hospitals in the Netherlands, between 2001 and 2017. This data.frame can be used to practice AMR analysis. For examples, press F1.
}
\examples{
# ----------- #
# PREPARATION #
# ----------- #
# Save this example dataset to an object, so we can edit it:
my_data <- septic_patients
# load the dplyr package to make data science A LOT easier
library(dplyr)
# Add first isolates to our dataset:
my_data <- my_data \%>\%
mutate(first_isolates = first_isolate(my_data, date, patient_id, bactid))
# -------- #
# ANALYSIS #
# -------- #
# 1. Get the amoxicillin resistance percentages
# of E. coli, divided by hospital:
my_data \%>\%
filter(bactid == "ESCCOL",
first_isolates == TRUE) \%>\%
group_by(hospital_id) \%>\%
summarise(n = n(),
amoxicillin_resistance = rsi(amox))
# 2. Get the amoxicillin/clavulanic acid resistance
# percentages of E. coli, trend over the years:
my_data \%>\%
filter(bactid == guess_bactid("E. coli"),
first_isolates == TRUE) \%>\%
group_by(year = format(date, "\%Y")) \%>\%
summarise(n = n(),
amoxclav_resistance = rsi(amcl, minimum = 20))
}
\keyword{datasets}