diff --git a/DESCRIPTION b/DESCRIPTION index d82324d9..ac9a1b5c 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -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) . 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 diff --git a/NAMESPACE b/NAMESPACE index 1654c1e5..45026ecc 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -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) diff --git a/NEWS b/NEWS index 1c223d99..a9135081 100644 --- a/NEWS +++ b/NEWS @@ -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 diff --git a/R/EUCAST.R b/R/EUCAST.R index 54f525f9..ef70190a 100644 --- a/R/EUCAST.R +++ b/R/EUCAST.R @@ -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() diff --git a/R/atc.R b/R/atc.R index b03032db..bcc4bff8 100644 --- a/R/atc.R +++ b/R/atc.R @@ -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) %>% diff --git a/R/clipboard.R b/R/clipboard.R new file mode 100644 index 00000000..1f6072cc --- /dev/null +++ b/R/clipboard.R @@ -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") + +} diff --git a/R/data.R b/R/data.R index 435f86f2..a8494f3a 100644 --- a/R/data.R +++ b/R/data.R @@ -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" diff --git a/R/first_isolates.R b/R/first_isolates.R index 67799511..a32cff0b 100644 --- a/R/first_isolates.R +++ b/R/first_isolates.R @@ -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) { diff --git a/R/join.R b/R/join.R index e4c26b1a..dc474eb3 100644 --- a/R/join.R +++ b/R/join.R @@ -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, ...) } diff --git a/R/misc.R b/R/misc.R index 8d14b600..f3839a42 100644 --- a/R/misc.R +++ b/R/misc.R @@ -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 diff --git a/R/rsi_analysis.R b/R/rsi_analysis.R index e9a2edf5..55edab3b 100644 --- a/R/rsi_analysis.R +++ b/R/rsi_analysis.R @@ -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(., diff --git a/data/bactlist.rda b/data/bactlist.rda deleted file mode 100644 index 743672e9..00000000 Binary files a/data/bactlist.rda and /dev/null differ diff --git a/data/bactlist.umcg.rda b/data/bactlist.umcg.rda deleted file mode 100644 index 6592fef9..00000000 Binary files a/data/bactlist.umcg.rda and /dev/null differ diff --git a/data/microorganisms.rda b/data/microorganisms.rda new file mode 100644 index 00000000..9db19073 Binary files /dev/null and b/data/microorganisms.rda differ diff --git a/data/microorganisms.umcg.rda b/data/microorganisms.umcg.rda new file mode 100644 index 00000000..8b67e19b Binary files /dev/null and b/data/microorganisms.umcg.rda differ diff --git a/man/EUCAST.Rd b/man/EUCAST.Rd index ef9cb483..4315a55b 100644 --- a/man/EUCAST.Rd +++ b/man/EUCAST.Rd @@ -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} diff --git a/man/abname.Rd b/man/abname.Rd index 8478d17d..9ea36200 100644 --- a/man/abname.Rd +++ b/man/abname.Rd @@ -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} diff --git a/man/antibiotics.Rd b/man/antibiotics.Rd index 44db1565..ce1eaf20 100644 --- a/man/antibiotics.Rd +++ b/man/antibiotics.Rd @@ -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} diff --git a/man/clipboard.Rd b/man/clipboard.Rd new file mode 100644 index 00000000..2ac96484 --- /dev/null +++ b/man/clipboard.Rd @@ -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} diff --git a/man/first_isolate.Rd b/man/first_isolate.Rd index f8054f89..0b11f33c 100644 --- a/man/first_isolate.Rd +++ b/man/first_isolate.Rd @@ -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, diff --git a/man/guess_bactid.Rd b/man/guess_bactid.Rd index df6c8c02..32bbbb27 100644 --- a/man/guess_bactid.Rd +++ b/man/guess_bactid.Rd @@ -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. } diff --git a/man/join.Rd b/man/join.Rd index 16266435..09254631 100644 --- a/man/join.Rd +++ b/man/join.Rd @@ -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) } diff --git a/man/key_antibiotics.Rd b/man/key_antibiotics.Rd index 9d66c0f9..12932662 100644 --- a/man/key_antibiotics.Rd +++ b/man/key_antibiotics.Rd @@ -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} diff --git a/man/bactlist.Rd b/man/microorganisms.Rd similarity index 86% rename from man/bactlist.Rd rename to man/microorganisms.Rd index 8c4abafa..deac25ac 100644 --- a/man/bactlist.Rd +++ b/man/microorganisms.Rd @@ -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} diff --git a/man/bactlist.umcg.Rd b/man/microorganisms.umcg.Rd similarity index 56% rename from man/bactlist.umcg.Rd rename to man/microorganisms.umcg.Rd index bc14b777..18c98600 100644 --- a/man/bactlist.umcg.Rd +++ b/man/microorganisms.umcg.Rd @@ -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} diff --git a/man/mo_property.Rd b/man/mo_property.Rd index 16d9a422..3f7e9e49 100644 --- a/man/mo_property.Rd +++ b/man/mo_property.Rd @@ -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}} } diff --git a/man/rsi_df.Rd b/man/rsi_df.Rd index 05edbe8b..3f553f4c 100644 --- a/man/rsi_df.Rd +++ b/man/rsi_df.Rd @@ -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{ diff --git a/man/rsi_predict.Rd b/man/rsi_predict.Rd index 42b0e670..5caa6c67 100644 --- a/man/rsi_predict.Rd +++ b/man/rsi_predict.Rd @@ -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(., diff --git a/man/septic_patients.Rd b/man/septic_patients.Rd index 510e6aeb..8b5176d0 100644 --- a/man/septic_patients.Rd +++ b/man/septic_patients.Rd @@ -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}