examples edit

add badges to readme

.Rbuildignore

@@ -1,2 +1,3 @@
 ^.*\.Rproj$
 ^\.Rproj\.user$
+.travis.yml

.travis.yml

@@ -0,0 +1,2 @@
+language: r
+cache: packages

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: AMR
 Version: 0.1.1
-Date: 2018-02-22
+Date: 2018-03-13
 Title: Antimicrobial Resistance Analysis
 Authors@R: c(
     person(

NAMESPACE

@@ -3,6 +3,8 @@
 S3method(as.double,mic)
 S3method(as.integer,mic)
 S3method(as.numeric,mic)
+S3method(barplot,mic)
+S3method(barplot,rsi)
 S3method(plot,mic)
 S3method(plot,rsi)
 S3method(print,mic)
@@ -15,6 +17,7 @@ export(anti_join_bactlist)
 export(as.mic)
 export(as.rsi)
 export(atc_property)
+export(first_isolate)
 export(full_join_bactlist)
 export(inner_join_bactlist)
 export(interpretive_reading)
@@ -31,6 +34,8 @@ export(semi_join_bactlist)
 exportMethods(as.double.mic)
 exportMethods(as.integer.mic)
 exportMethods(as.numeric.mic)
+exportMethods(barplot.mic)
+exportMethods(barplot.rsi)
 exportMethods(plot.mic)
 exportMethods(plot.rsi)
 exportMethods(print.mic)
@@ -60,6 +65,8 @@ importFrom(dplyr,slice)
 importFrom(dplyr,summarise)
 importFrom(dplyr,tibble)
 importFrom(dplyr,vars)
+importFrom(graphics,axis)
+importFrom(graphics,barplot)
 importFrom(graphics,plot)
 importFrom(graphics,text)
 importFrom(reshape2,dcast)

NEWS

@@ -0,0 +1,9 @@
+## 0.1.1
+- `EUCAST_rules` applies for amoxicillin even if ampicillin is missing
+- Edited column names to comply with GLIMS, the laboratory information system
+- Added more valid MIC values
+- Renamed 'Daily Defined Dose' to 'Defined Daily Dose'
+- Added barplots for `rsi` and `mic` classes
+
+## 0.1.0
+- First submission to CRAN.

R/EUCAST.R

@@ -20,11 +20,10 @@
 #'
 #' 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} - should also be present in \code{bactlist$bactid}, see \code{\link{bactlist}}.
+#' @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 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}
-#' @name EUCAST
 #' @rdname EUCAST
 #' @export
 #' @importFrom dplyr %>% left_join select
@@ -37,11 +36,23 @@
 #'   EUCAST Expert Rules Version 3.1: \cr
 #'   \url{http://www.eucast.org/expert_rules_and_intrinsic_resistance}
 #' @examples
-#' \dontrun{
-#' tbl <- EUCAST_rules(tbl)
-#' }
+#' a <- data.frame(bactid = c("STAAUR",  # Staphylococcus aureus
+#'                            "ENCFAE",  # Enterococcus faecalis
+#'                            "ESCCOL",  # Escherichia coli
+#'                            "KLEPNE",  # Klebsiella pneumoniae
+#'                            "PSEAER"), # Pseudomonas aeruginosa
+#'                 vanc = "-",           # Vancomycin
+#'                 amox = "-",           # Amoxicillin
+#'                 coli = "-",           # Colistin
+#'                 cfta = "-",           # Ceftazidime
+#'                 cfur = "-",           # Cefuroxime
+#'                 stringsAsFactors = FALSE)
+#' a
+#' 
+#' b <- EUCAST_rules(a)
+#' b
 EUCAST_rules <- function(tbl,
-                         col_bactcode = 'bacteriecode',
+                         col_bactcode = 'bactid',
                          info = TRUE,
                          amcl = 'amcl',
                          amik = 'amik',
@@ -185,6 +196,7 @@ EUCAST_rules <- function(tbl,
   }
   
   total <- 0
+  total_rows <- integer(0)
   
   # functie voor uitvoeren
   edit_rsi <- function(to, rows, cols) {
@@ -193,6 +205,7 @@ EUCAST_rules <- function(tbl,
     if (length(rows) > 0 & length(cols) > 0) {
       tbl[rows, cols] <<- to
       total <<- total + (length(rows) * length(cols))
+      total_rows <<- c(total_rows, rows)
     }
   }
   
@@ -215,9 +228,9 @@ EUCAST_rules <- function(tbl,
   fluorochinolonen <- c(oflo, cipr, norf, levo, moxi)
   
   if (info == TRUE) {
-    cat('\nApplying EUCAST expert rules on',
-        tbl[!is.na(tbl$genus),] %>% nrow(),
-        'isolates according to "EUCAST Expert Rules Version 3.1"\n\n')
+    cat('\nApplying rules to',
+        tbl[!is.na(tbl$genus),] %>% nrow() %>% format(big.mark = ","),
+        'rows according to "EUCAST Expert Rules Version 3.1"\n\n')
   }
   
   # Table 1: Intrinsic resistance in Enterobacteriaceae ----
@@ -232,61 +245,61 @@ EUCAST_rules <- function(tbl,
   # Citrobacter
   edit_rsi(to = 'R',
            rows = which(tbl$fullname %like% '^Citrobacter (koseri|amalonaticus|sedlakii|farmeri|rodentium)'),
-           cols = c(ampi, tica))
+           cols = c(aminopenicillines, tica))
   edit_rsi(to = 'R',
            rows = which(tbl$fullname %like% '^Citrobacter (freundii|braakii|murliniae|werkmanii|youngae)'),
-           cols = c(ampi, amcl, czol, cfox))
+           cols = c(aminopenicillines, amcl, czol, cfox))
   # Enterobacter
   edit_rsi(to = 'R',
            rows = which(tbl$fullname %like% '^Enterobacter cloacae'),
-           cols = c(ampi, amcl, czol, cfox))
+           cols = c(aminopenicillines, amcl, czol, cfox))
   edit_rsi(to = 'R',
            rows = which(tbl$fullname %like% '^Enterobacter aerogenes'),
-           cols = c(ampi, amcl, czol, cfox))
+           cols = c(aminopenicillines, amcl, czol, cfox))
   # Escherichia
   edit_rsi(to = 'R',
            rows = which(tbl$fullname %like% '^Escherichia hermanni'),
-           cols = c(ampi, tica))
+           cols = c(aminopenicillines, tica))
   # Hafnia
   edit_rsi(to = 'R',
            rows = which(tbl$fullname %like% '^Hafnia alvei'),
-           cols = c(ampi, amcl, czol, cfox))
+           cols = c(aminopenicillines, amcl, czol, cfox))
   # Klebsiella
   edit_rsi(to = 'R',
            rows = which(tbl$fullname %like% '^Klebsiella'),
-           cols = c(ampi, tica))
+           cols = c(aminopenicillines, tica))
   # Morganella / Proteus
   edit_rsi(to = 'R',
            rows = which(tbl$fullname %like% '^Morganella morganii'),
-           cols = c(ampi, amcl, czol, tetracyclines, polymyxines, nitr))
+           cols = c(aminopenicillines, amcl, czol, tetracyclines, polymyxines, nitr))
   edit_rsi(to = 'R',
            rows = which(tbl$fullname %like% '^Proteus mirabilis'),
            cols = c(tetracyclines, tige, polymyxines, nitr))
   edit_rsi(to = 'R',
            rows = which(tbl$fullname %like% '^Proteus penneri'),
-           cols = c(ampi, czol, cfur, tetracyclines, tige, polymyxines, nitr))
+           cols = c(aminopenicillines, czol, cfur, tetracyclines, tige, polymyxines, nitr))
   edit_rsi(to = 'R',
            rows = which(tbl$fullname %like% '^Proteus vulgaris'),
-           cols = c(ampi, czol, cfur, tetracyclines, tige, polymyxines, nitr))
+           cols = c(aminopenicillines, czol, cfur, tetracyclines, tige, polymyxines, nitr))
   # Providencia
   edit_rsi(to = 'R',
            rows = which(tbl$fullname %like% '^Providencia rettgeri'),
-           cols = c(ampi, amcl, czol, cfur, tetracyclines, tige, polymyxines, nitr))
+           cols = c(aminopenicillines, amcl, czol, cfur, tetracyclines, tige, polymyxines, nitr))
   edit_rsi(to = 'R',
            rows = which(tbl$fullname %like% '^Providencia stuartii'),
-           cols = c(ampi, amcl, czol, cfur, tetracyclines, tige, polymyxines, nitr))
+           cols = c(aminopenicillines, amcl, czol, cfur, tetracyclines, tige, polymyxines, nitr))
   # Raoultella
   edit_rsi(to = 'R',
            rows = which(tbl$fullname %like% '^Raoultella'),
-           cols = c(ampi, tica))
+           cols = c(aminopenicillines, tica))
   # Serratia
   edit_rsi(to = 'R',
            rows = which(tbl$fullname %like% '^Serratia marcescens'),
-           cols = c(ampi, amcl, czol, cfox, cfur, tetracyclines[tetracyclines != 'mino'], polymyxines, nitr))
+           cols = c(aminopenicillines, amcl, czol, cfox, cfur, tetracyclines[tetracyclines != 'mino'], polymyxines, nitr))
   # Yersinia
   edit_rsi(to = 'R',
            rows = which(tbl$fullname %like% '^Yersinia enterocolitica'),
-           cols = c(ampi, amcl, tica, czol, cfox))
+           cols = c(aminopenicillines, amcl, tica, czol, cfox))
   edit_rsi(to = 'R',
            rows = which(tbl$fullname %like% '^Yersinia pseudotuberculosis'),
            cols = c(poly, coli))
@@ -313,32 +326,32 @@ EUCAST_rules <- function(tbl,
   # Acinetobacter
   edit_rsi(to = 'R',
            rows = which(tbl$fullname %like% '^Acinetobacter (baumannii|pittii|nosocomialis|calcoaceticus)'),
-           cols = c(ampi, amcl, czol, cfot, cftr, aztr, erta, trim, fosf, tetracyclines[tetracyclines != 'mino']))
+           cols = c(aminopenicillines, 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(ampi, czol, cfot, cftr, erta))
+           cols = c(aminopenicillines, 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(ampi, amcl, tica, pita, czol, cfot, cftr, aztr, erta, cipr, chlo, aminoglycosiden, trim, fosf, polymyxines))
+           cols = c(aminopenicillines, amcl, tica, pita, czol, cfot, cftr, aztr, erta, cipr, chlo, aminoglycosiden, trim, fosf, polymyxines))
   # Elizabethkingia
   edit_rsi(to = 'R',
            rows = which(tbl$fullname %like% '^Elizabethkingia meningoseptic(a|um)'),
-           cols = c(ampi, amcl, tica, czol, cfot, cftr, cfta, cfep, aztr, erta, imip, mero, polymyxines))
+           cols = c(aminopenicillines, amcl, tica, czol, cfot, cftr, cfta, cfep, aztr, erta, imip, mero, polymyxines))
   # Ochrobactrum
   edit_rsi(to = 'R',
            rows = which(tbl$fullname %like% '^Ochrobactrum anthropi'),
-           cols = c(ampi, amcl, tica, pita, czol, cfot, cftr, cfta, cfep, aztr, erta))
+           cols = c(aminopenicillines, amcl, tica, pita, czol, cfot, cftr, cfta, cfep, aztr, erta))
   # Pseudomonas
   edit_rsi(to = 'R',
            rows = which(tbl$fullname %like% '^Pseudomonas aeruginosa'),
-           cols = c(ampi, amcl, czol, cfot, cftr, erta, chlo, kana, neom, trim, trsu, tetracyclines, tige))
+           cols = c(aminopenicillines, 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(ampi, amcl, tica, pita, czol, cfot, cftr, cfta, aztr, erta, imip, mero, aminoglycosiden, trim, fosf, tetr))
+           cols = c(aminopenicillines, amcl, tica, pita, czol, cfot, cftr, cfta, aztr, erta, imip, mero, aminoglycosiden, trim, fosf, tetr))
   
   
   # Table 3: Intrinsic resistance in other Gram-negative bacteria ----
@@ -448,6 +461,12 @@ EUCAST_rules <- function(tbl,
                           & tbl[, ampi] == 'R'),
              cols = c(ureidopenicillines, carbapenems))
   }
+  if (!is.na(amox)) {
+    edit_rsi(to = 'R',
+             rows = which(tbl$genus == 'Enterococcus'
+                          & tbl[, amox] == 'R'),
+             cols = c(ureidopenicillines, carbapenems))
+  }
   
   # Table 9: Interpretive rules for B-lactam agents and Gram-negative rods ----
   if (info == TRUE) {
@@ -579,7 +598,7 @@ EUCAST_rules <- function(tbl,
              cols = trim)
   }
   if (!is.na(ampi) & !is.na(amox)) {
-    tbl[, amox] <- tbl[, ampi]
+    tbl[, amox] <- tbl %>% pull(ampi)
   }
   
   # Toegevoegde kolommen weer verwijderen
@@ -590,7 +609,10 @@ EUCAST_rules <- function(tbl,
   colnames(tbl) <- gsub("_tempbactlist", "", colnames(tbl))
   
   if (info == TRUE) {
-    cat('\nDone.\nExpert rules applied to', total, 'test results.\n')
+    cat('\nDone.\nEUCAST Expert rules applied to',
+        total_rows %>% unique() %>% length() %>% format(big.mark = ","),
+        'different rows, to a total of',
+        total %>% format(big.mark = ","), 'test results.\n\n')
   }
   
   tbl

R/atc.R

@@ -18,7 +18,7 @@
 
 #' Properties of an ATC code
 #'
-#' Gets data from the WHO to determine properties of an ATC of e.g. an antibiotic. \strong{This function requires an internet connection.}
+#' Gets data from the WHO to determine properties of an ATC (e.g. an antibiotic) like name, defined daily dose (DDD) or standard unit. \strong{This function requires an internet connection.}
 #' @param atc_code a character or character vector with ATC code(s) of antibiotic(s)
 #' @param property property of an ATC code. Valid values are \code{"ATC code"}, \code{"Name"}, \code{"DDD"}, \code{"U"} (\code{"unit"}), \code{"Adm.R"} en \code{"Note"}.
 #' @param administration type of administration, see \emph{Details}
@@ -56,8 +56,8 @@
 #' @source \url{https://www.whocc.no/atc_ddd_alterations__cumulative/ddd_alterations/abbrevations/}
 #' @examples 
 #' \donttest{
-#' atc_property("J01CA04", "DDD", "O") # oral DDD of amoxicillin
-#' atc_property("J01CA04", "DDD", "P") # parenteral DDD of amoxicillin
+#' atc_property("J01CA04", "DDD", "O") # oral DDD (Defined Daily Dose) of amoxicillin
+#' atc_property("J01CA04", "DDD", "P") # parenteral DDD (Defined Daily Dose) of amoxicillin
 #' }
 atc_property <- function(atc_code,
                          property,
@@ -128,7 +128,7 @@ atc_property <- function(atc_code,
 #' Name of an antibiotic
 #'
 #' 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{ablist}}.
-#' @param abcode a code or name, like \code{"amox"}, \code{"cftr"} or \code{"J01CA04"}
+#' @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{ablist}} for its column names.
 #' @param textbetween text to put between multiple returned texts
 #' @param tolower return output as lower case with function \code{\link{tolower}}.
@@ -146,7 +146,7 @@ atc_property <- function(atc_code,
 #' abname(c("AMCL", "GENT"))
 #' # "amoxicillin and enzyme inhibitor" "gentamicin" 
 #'
-#' abname("AMCL", to = "trivial")
+#' abname("AMCL", to = "trivial_nl")
 #' # "Amoxicilline/clavulaanzuur"
 #'
 #' abname("AMCL", to = "atc")
@@ -210,7 +210,7 @@ abname <- function(abcode, from = 'umcg', to = 'official', textbetween = ' + ',
           select(to) %>%
           slice(1) %>%
           as.character()
-        if (j > 1 & to %in% c('official', 'trivial')) {
+        if (j > 1 & to %in% c('official', 'trivial_nl')) {
           drug.group[j] <- drug.group[j] %>% tolower()
         }
       }

R/classes.R

@@ -28,14 +28,9 @@
 #' rsi_data <- as.rsi(c(rep("S", 474), rep("I", 36), rep("R", 370)))
 #' rsi_data <- as.rsi(c(rep("S", 474), rep("I", 36), rep("R", 370), "A", "B", "C"))
 #' is.rsi(rsi_data)
-#' plot(rsi_data)
 #' 
-#' \donttest{
-#' library(dplyr)
-#' tbl %>%
-#'   mutate_at(vars(ends_with("_rsi")), as.rsi)
-#' sapply(mic_data, is.rsi)
-#' }
+#' plot(rsi_data)    # for percentages
+#' barplot(rsi_data) # for frequencies
 as.rsi <- function(x) {
   if (is.rsi(x)) {
     x
@@ -125,7 +120,7 @@ summary.rsi <- function(object, ...) {
 
 #' @exportMethod plot.rsi
 #' @export
-#' @importFrom dplyr %>% group_by summarise filter mutate if_else
+#' @importFrom dplyr %>% group_by summarise filter mutate if_else n_distinct
 #' @importFrom graphics plot text
 #' @noRd
 plot.rsi <- function(x, ...) {
@@ -150,15 +145,47 @@ plot.rsi <- function(x, ...) {
        ylab = 'Percentage',
        xlab = 'Antimicrobial Interpretation',
        main = paste('Susceptibilty Analysis of', x_name),
+       axes = FALSE,
        ...)
+  # x axis
+  axis(side = 1, at = 1:n_distinct(data$x), labels = levels(data$x), lwd = 0)
+  # y axis, 0-100%
+  axis(side = 2, at = seq(0, 100, 5))
+  
   text(x = data$x,
-       y = data$s + 5,
+       y = data$s + 4,
        labels = paste0(data$s, '% (n = ', data$n, ')'))
 }
 
+
+#' @exportMethod barplot.rsi
+#' @export
+#' @importFrom dplyr %>% group_by summarise filter mutate if_else n_distinct
+#' @importFrom graphics barplot axis
+#' @noRd
+barplot.rsi <- function(height, ...) {
+  x <- height
+  x_name <- deparse(substitute(height))
+  
+  data <- data.frame(rsi = x, cnt = 1) %>%
+    group_by(rsi) %>%
+    summarise(cnt = sum(cnt)) %>%
+    droplevels()
+
+  barplot(table(x),
+          col = c('green3', 'orange2', 'red3'),
+          xlab = 'Antimicrobial Interpretation',
+          main = paste('Susceptibilty Analysis of', x_name),
+          ylab = 'Frequency',
+          axes = FALSE,
+          ...)
+  # y axis, 0-100%
+  axis(side = 2, at = seq(0, max(data$cnt) + max(data$cnt) * 1.1, by = 25))
+}
+
 #' Class 'mic'
 #'
-#' This transforms a vector to a new class\code{mic}, which is an ordered factor valid MIC values as levels. Invalid MIC values will be translated as \code{NA} with a warning.
+#' This transforms a vector to a new class\code{mic}, which is an ordered factor with valid MIC values as levels. Invalid MIC values will be translated as \code{NA} with a warning.
 #' @rdname as.mic
 #' @param x vector
 #' @param na.rm a logical indicating whether missing values should be removed
@@ -168,14 +195,9 @@ plot.rsi <- function(x, ...) {
 #' @examples
 #' mic_data <- as.mic(c(">=32", "1.0", "1", "1.00", 8, "<=0.128", "8", "16", "16"))
 #' is.mic(mic_data)
-#' plot(mic_data)
 #' 
-#' \donttest{
-#' library(dplyr)
-#' tbl %>%
-#'   mutate_at(vars(ends_with("_mic")), as.mic)
-#' sapply(mic_data, is.mic)
-#' }
+#' plot(mic_data)
+#' barplot(mic_data)
 as.mic <- function(x, na.rm = FALSE) {
   if (is.mic(x)) {
     x
@@ -207,24 +229,29 @@ as.mic <- function(x, na.rm = FALSE) {
               "<0.012", "<=0.012", "0.012", ">=0.012", ">0.012",
               "<0.016", "<=0.016", "0.016", ">=0.016", ">0.016",
               "<0.023", "<=0.023", "0.023", ">=0.023", ">0.023",
+              "<0.025", "<=0.025", "0.025", ">=0.025", ">0.025",
               "<0.03", "<=0.03", "0.03", ">=0.03", ">0.03",
               "<0.032", "<=0.032", "0.032", ">=0.032", ">0.032",
               "<0.047", "<=0.047", "0.047", ">=0.047", ">0.047",
               "<0.05", "<=0.05", "0.05", ">=0.05", ">0.05",
               "<0.06", "<=0.06", "0.06", ">=0.06", ">0.06",
               "<0.0625", "<=0.0625", "0.0625", ">=0.0625", ">0.0625",
+              "<0.063", "<=0.063", "0.063", ">=0.063", ">0.063",
               "<0.064", "<=0.064", "0.064", ">=0.064", ">0.064",
               "<0.09", "<=0.09", "0.09", ">=0.09", ">0.09",
               "<0.094", "<=0.094", "0.094", ">=0.094", ">0.094",
               "<0.12", "<=0.12", "0.12", ">=0.12", ">0.12",
               "<0.125", "<=0.125", "0.125", ">=0.125", ">0.125",
               "<0.128", "<=0.128", "0.128", ">=0.128", ">0.128",
+              "<0.16", "<=0.16", "0.16", ">=0.16", ">0.16",
               "<0.19", "<=0.19", "0.19", ">=0.19", ">0.19",
               "<0.25", "<=0.25", "0.25", ">=0.25", ">0.25",
               "<0.256", "<=0.256", "0.256", ">=0.256", ">0.256",
+              "<0.32", "<=0.32", "0.32", ">=0.32", ">0.32",
               "<0.38", "<=0.38", "0.38", ">=0.38", ">0.38",
               "<0.5", "<=0.5", "0.5", ">=0.5", ">0.5",
               "<0.512", "<=0.512", "0.512", ">=0.512", ">0.512",
+              "<0.64", "<=0.64", "0.64", ">=0.64", ">0.64",
               "<0.75", "<=0.75", "0.75", ">=0.75", ">0.75",
               "<1", "<=1", "1", ">=1", ">1",
               "<1.5", "<=1.5", "1.5", ">=1.5", ">1.5",
@@ -284,26 +311,23 @@ is.mic <- function(x) {
 
 #' @exportMethod as.double.mic
 #' @export
-#' @importFrom dplyr %>%
 #' @noRd
 as.double.mic <- function(x, ...) {
-  as.double(gsub('(<=)|(>=)', '', as.character(x)))
+  as.double(gsub('(<|=|>)+', '', as.character(x)))
 }
 
 #' @exportMethod as.integer.mic
 #' @export
-#' @importFrom dplyr %>%
 #' @noRd
 as.integer.mic <- function(x, ...) {
-  as.integer(gsub('(<=)|(>=)', '', as.character(x)))
+  as.integer(gsub('(<|=|>)+', '', as.character(x)))
 }
 
 #' @exportMethod as.numeric.mic
 #' @export
-#' @importFrom dplyr %>%
 #' @noRd
 as.numeric.mic <- function(x, ...) {
-  as.numeric(gsub('(<=)|(>=)', '', as.character(x)))
+  as.numeric(gsub('(<|=|>)+', '', as.character(x)))
 }
 
 #' @exportMethod print.mic
@@ -355,21 +379,30 @@ summary.mic <- function(object, ...) {
 #' @noRd
 plot.mic <- function(x, ...) {
   x_name <- deparse(substitute(x))
+  create_barplot_mic(x, x_name, ...)
+}
 
+#' @exportMethod barplot.mic
+#' @export
+#' @importFrom dplyr %>% group_by summarise
+#' @importFrom graphics barplot axis
+#' @noRd
+barplot.mic <- function(height, ...) {
+  x_name <- deparse(substitute(height))
+  create_barplot_mic(height, x_name, ...)
+}
+
+#' @importFrom graphics barplot axis
+create_barplot_mic <- function(x, x_name, ...) {
   data <- data.frame(mic = x, cnt = 1) %>%
     group_by(mic) %>%
     summarise(cnt = sum(cnt)) %>%
     droplevels()
-
-  plot(x = data$mic,
-       y = data$cnt,
-       lwd = 2,
-       ylim = c(-0.5, max(5, max(data$cnt))),
+  barplot(table(droplevels(x)),
           ylab = 'Frequency',
           xlab = 'MIC value',
           main = paste('MIC values of', x_name), 
+          axes = FALSE,
           ...)
-  text(x = data$mic,
-       y = -0.5,
-       labels = paste('n =', data$cnt))
+  axis(2, seq(0, max(data$cnt)))
 }

R/data.R

@@ -26,10 +26,10 @@
 #'   \item{\code{umcg}}{UMCG code, like \code{AMCL}}
 #'   \item{\code{official}}{Official name by the WHO, like \code{"amoxicillin and enzyme inhibitor"}}
 #'   \item{\code{official_nl}}{Official name in the Netherlands, like \code{"Amoxicilline met enzymremmer"}}
-#'   \item{\code{trivial}}{Trivial name in Dutch, like \code{"Amoxicilline/clavulaanzuur"}}
-#'   \item{\code{oral_ddd}}{Daily Defined Dose (DDD) according to the WHO, oral treatment}
+#'   \item{\code{trivial_nl}}{Trivial name in Dutch, like \code{"Amoxicilline/clavulaanzuur"}}
+#'   \item{\code{oral_ddd}}{Defined Daily Dose (DDD) according to the WHO, oral treatment}
 #'   \item{\code{oral_units}}{Units of \code{ddd_units}}
-#'   \item{\code{iv_ddd}}{Daily Defined Dose (DDD) according to the WHO, bij parenteral treatment}
+#'   \item{\code{iv_ddd}}{Defined Daily Dose (DDD) according to the WHO, parenteral treatment}
 #'   \item{\code{iv_units}}{Units of \code{iv_ddd}}
 #'   \item{\code{atc_group1}}{ATC group in Dutch, like \code{"Macroliden, lincosamiden en streptograminen"}}
 #'   \item{\code{atc_group2}}{Subgroup of \code{atc_group1} in Dutch, like \code{"Macroliden"}}
@@ -56,7 +56,7 @@
 #'   \item{\code{species}}{Species name of microorganism, like \code{"coli"}}
 #'   \item{\code{subspecies}}{Subspecies name of bio-/serovar of microorganism, like \code{"EHEC"}}
 #'   \item{\code{fullname}}{Full name, like \code{"Echerichia coli (EHEC)"}}
-#'   \item{\code{type}}{Type of microorganism, like \code{"Bacterie"} en \code{"Schimmel/gist"} (these are Dutch)}
+#'   \item{\code{type}}{Type of microorganism in Dutch, like \code{"Bacterie"} and \code{"Schimmel/gist"}}
 #'   \item{\code{gramstain}}{Gram of microorganism in Dutch, like \code{"Negatieve staven"}}
 #'   \item{\code{aerobic}}{Type aerobe/anaerobe of bacteria}
 #' }
@@ -75,3 +75,22 @@
 #' @source MOLIS (LIS of Certe) - \url{https://www.certe.nl} \cr \cr GLIMS (LIS of UMCG) - \url{https://www.umcg.nl}
 #' @seealso \code{\link{bactlist}}
 "bactlist.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.
+#' @format A data.frame with 2000 observations and 47 variables:
+#' \describe{
+#'   \item{\code{date}}{date of receipt at the laboratory}
+#'   \item{\code{hospital_id}}{ID of the hospital}
+#'   \item{\code{ward_icu}}{logical to determine if ward is an intensive care unit}
+#'   \item{\code{ward_clinical}}{logical to determine if ward is a regular clinical ward}
+#'   \item{\code{ward_outpatient}}{logical to determine if ward is an outpatient clinic}
+#'   \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{ablist}} and can be translated with \code{\link{abname}}}
+#' }
+#' @source MOLIS (LIS of Certe) - \url{https://www.certe.nl}
+"septic_patients"

R/first_isolates.R

@@ -21,10 +21,10 @@
 #' Determine first (weighted) isolates of all microorganisms of every patient per episode and (if needed) per specimen type.
 #' @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)
-#' @param col_patid column name of the unique IDs of the patients
+#' @param col_patient_id column name of the unique IDs of the patients
 #' @param col_genus column name of the genus of the microorganisms
 #' @param col_species column name of the species of the microorganisms
-#' @param col_testcode column name of the test codes, see Details
+#' @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.
 #' @param col_specimen column name of the specimen type or group
 #' @param col_icu column name of the logicals (\code{TRUE}/\code{FALSE}) whether a ward or department is an Intensive Care Unit (ICU)
 #' @param col_keyantibiotics column name of the key antibiotics to determine first \emph{weighted} isolates, see \code{\link{key_antibiotics}}.
@@ -33,14 +33,15 @@
 #' @param icu_exclude logical whether ICU isolates should be excluded
 #' @param filter_specimen specimen group or type that should be excluded
 #' @param output_logical return output as \code{logical} (will else the values \code{0} or \code{1})
-#' @param ignore_I ignore \code{"I"} as antimicrobial interpretation of key antibiotics (with \code{FALSE}, changes in antibiograms from S to I and I to R will be interpreted as difference)
+#' @param points_threshold points until the comparison of key antibiotics will lead to inclusion of an isolate, see Details
 #' @param info print progress
-# @param ... parameters to pass through to \code{first_isolate}.
-#' @rdname first_isolate
-#' @details To conduct an analysis of antimicrobial resistance, you should only include the first isolate of every patient per episode. 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 is 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 selection bias.
+#' @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}.
 #'
-#'     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.
+#'     \strong{Using parameter \code{points_threshold}} \cr
+#'     To compare key antibiotics, the difference between antimicrobial interpretations will be measured. A difference from I to S|R (or vice versa) means 0.5 points. A difference from S to R (or vice versa) means 1 point. When the sum of points exceeds \code{points_threshold}, an isolate will be (re)selected as a first weighted isolate.
 #' @keywords isolate isolates first
+#' @export
 #' @importFrom dplyr arrange_at lag between row_number filter mutate arrange
 #' @return A vector to add to table, see Examples.
 #' @examples
@@ -85,7 +86,7 @@
 #' }
 first_isolate <- function(tbl,
                           col_date,
-                          col_patid,
+                          col_patient_id,
                           col_genus,
                           col_species,
                           col_testcode = NA,
@@ -97,7 +98,7 @@ first_isolate <- function(tbl,
                           icu_exclude = FALSE,
                           filter_specimen = NA,
                           output_logical = TRUE,
-                          ignore_I = TRUE,
+                          points_threshold = 2,
                           info = TRUE) {
   
   # controleren of kolommen wel bestaan
@@ -114,7 +115,7 @@ first_isolate <- function(tbl,
   }
   
   check_columns_existance(col_date)
-  check_columns_existance(col_patid)
+  check_columns_existance(col_patient_id)
   check_columns_existance(col_genus)
   check_columns_existance(col_species)
   check_columns_existance(col_testcode)
@@ -163,7 +164,10 @@ first_isolate <- function(tbl,
     mutate(first_isolate_row_index = 1:nrow(tbl),
            eersteisolaatbepaling = 0,
            date_lab = tbl %>% pull(col_date),
-           species = if_else(is.na(species), '', species),
+           patient_id = tbl %>% pull(col_patient_id),
+           species = tbl %>% pull(col_species),
+           genus = tbl %>% pull(col_genus)) %>%
+    mutate(species = if_else(is.na(species), '', species),
            genus = if_else(is.na(genus), '', genus))
   
   if (filter_specimen == '') {
@@ -173,7 +177,7 @@ first_isolate <- function(tbl,
         cat('Isolates from ICU will *NOT* be ignored.\n')
       }
       tbl <- tbl %>%
-        arrange_at(c(col_patid,
+        arrange_at(c(col_patient_id,
                      col_genus,
                      col_species,
                      col_date))
@@ -185,7 +189,7 @@ first_isolate <- function(tbl,
       }
       tbl <- tbl %>%
         arrange_at(c(col_icu,
-                     col_patid,
+                     col_patient_id,
                      col_genus,
                      col_species,
                      col_date))
@@ -206,7 +210,7 @@ first_isolate <- function(tbl,
       }
       tbl <- tbl %>%
         arrange_at(c(col_specimen,
-                     col_patid,
+                     col_patient_id,
                      col_genus,
                      col_species,
                      col_date))
@@ -223,7 +227,7 @@ first_isolate <- function(tbl,
       tbl <- tbl %>%
         arrange_at(c(col_icu,
                      col_specimen,
-                     col_patid,
+                     col_patient_id,
                      col_genus,
                      col_species,
                      col_date))
@@ -272,19 +276,15 @@ first_isolate <- function(tbl,
                                0))
   
   if (col_keyantibiotics != '') {
-    # dit duurt 2 min bij 120.000 isolaten
     if (info == TRUE) {
-      cat('Comparing key antibiotics for first weighted isolates')
-      if (ignore_I == TRUE) {
-        cat(' (ignoring I)')
-      }
-      cat('...\n')
+      cat(paste0('Comparing key antibiotics for first weighted isolates (using points threshold of '
+                 , points_threshold, ')...\n'))
     }
     all_first <- all_first %>%
       mutate(key_ab_lag = lag(key_ab)) %>%
-      mutate(key_ab_other = !key_antibiotics_equal(key_ab,
-                                                  key_ab_lag,
-                                                  ignore_I = ignore_I,
+      mutate(key_ab_other = !key_antibiotics_equal(x = key_ab,
+                                                   y = key_ab_lag,
+                                                   points_threshold = points_threshold,
                                                    info = info)) %>%
       mutate(
         real_first_isolate =
@@ -364,7 +364,7 @@ first_isolate <- function(tbl,
 #' tbl$keyab <- key_antibiotics(tbl)
 #' }
 key_antibiotics <- function(tbl,
-                            col_bactcode = 'bacteriecode',
+                            col_bactcode = 'bactid',
                             info = TRUE,
                             amcl = 'amcl',
                             amox = 'amox',
@@ -446,18 +446,11 @@ key_antibiotics <- function(tbl,
   
 }
 
-# Compare key antibiotics
-#
-# Check whether two text values with key antibiotics match. Supports vectors.
-# @param x,y tekst (or multiple text vectors) with antimicrobial interpretations
-# @param ignore_I ignore \code{"I"} as antimicrobial interpretation of key antibiotics (with \code{FALSE}, changes in antibiograms from S to I and I to R will be interpreted as difference)
-# @param info print progress
-# @return logical
-# @export
-# @seealso \code{\link{key_antibiotics}}
+#' @importFrom dplyr progress_estimated %>%
+#' @noRd
+key_antibiotics_equal <- function(x, y, points_threshold = 2, info = FALSE) {
+  # x is active row, y is lag
 
-# only internal use
-key_antibiotics_equal <- function(x, y, ignore_I = TRUE, info = FALSE) {
   if (length(x) != length(y)) {
     stop('Length of `x` and `y` must be equal.')
   }
@@ -465,13 +458,13 @@ key_antibiotics_equal <- function(x, y, ignore_I = TRUE, info = FALSE) {
   result <- logical(length(x))
   
   if (info == TRUE) {
-    voortgang <- dplyr::progress_estimated(length(x))
+    p <- dplyr::progress_estimated(length(x))
   }
   
   for (i in 1:length(x)) {
     
     if (info == TRUE) {
-      voortgang$tick()$print()
+      p$tick()$print()
     }
     
     if (is.na(x[i])) {
@@ -491,22 +484,17 @@ key_antibiotics_equal <- function(x, y, ignore_I = TRUE, info = FALSE) {
       
     } else {
       
-      x2 <- strsplit(x[i], "")[[1]]
-      y2 <- strsplit(y[i], "")[[1]]
+      # count points for every single character:
+      # - no change is 0 points
+      # - I <-> S|R is 0.5 point
+      # - S|R <-> R|S is 1 point
+      # use the levels of as.rsi (S = 1, I = 2, R = 3)
 
-      if (ignore_I == TRUE) {
-        valid_chars <- c('S', 's', 'R', 'r')
-      } else {
-        valid_chars <- c('S', 's', 'I', 'i', 'R', 'r')
-      }
+      x2 <- strsplit(x[i], "")[[1]] %>% as.rsi() %>% as.double()
+      y2 <- strsplit(y[i], "")[[1]] %>% as.rsi() %>% as.double()
       
-      # Ongeldige waarden (zoals "-", NA) op beide locaties verwijderen
-      x2[which(!x2 %in% valid_chars)] <- '?'
-      x2[which(!y2 %in% valid_chars)] <- '?'
-      y2[which(!x2 %in% valid_chars)] <- '?'
-      y2[which(!y2 %in% valid_chars)] <- '?'
-      
-      result[i] <- all(x2 == y2)
+      points <- (x2 - y2) %>% abs() %>% sum(na.rm = TRUE)
+      result[i] <- ((points / 2) >= points_threshold)
     }
   }
   if (info == TRUE) {

R/join.R

@@ -6,7 +6,7 @@
 #' @aliases join inner_join
 #' @param x existing table to join
 #' @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 ... other parameters to pass trhough to \code{dplyr::\link[dplyr]{join}}.
+#' @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}, 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 
@@ -37,7 +37,7 @@ inner_join_bactlist <- function(x, by = 'bactid', ...) {
 
 #' @rdname join
 #' @export
-left_join_bactlist <- function(x, by = 'bacteriecode', ...) {
+left_join_bactlist <- function(x, by = 'bactid', ...) {
   # no name set to `by` parameter
   if (is.null(names(by))) {
     joinby <- colnames(AMR::bactlist)[1]
@@ -54,7 +54,7 @@ left_join_bactlist <- function(x, by = 'bacteriecode', ...) {
 
 #' @rdname join
 #' @export
-right_join_bactlist <- function(x, by = 'bacteriecode', ...) {
+right_join_bactlist <- function(x, by = 'bactid', ...) {
   # no name set to `by` parameter
   if (is.null(names(by))) {
     joinby <- colnames(AMR::bactlist)[1]
@@ -71,7 +71,7 @@ right_join_bactlist <- function(x, by = 'bacteriecode', ...) {
 
 #' @rdname join
 #' @export
-full_join_bactlist <- function(x, by = 'bacteriecode', ...) {
+full_join_bactlist <- function(x, by = 'bactid', ...) {
   # no name set to `by` parameter
   if (is.null(names(by))) {
     joinby <- colnames(AMR::bactlist)[1]
@@ -84,7 +84,7 @@ full_join_bactlist <- function(x, by = 'bacteriecode', ...) {
 
 #' @rdname join
 #' @export
-semi_join_bactlist <- function(x, by = 'bacteriecode', ...) {
+semi_join_bactlist <- function(x, by = 'bactid', ...) {
   # no name set to `by` parameter
   if (is.null(names(by))) {
     joinby <- colnames(AMR::bactlist)[1]
@@ -97,7 +97,7 @@ semi_join_bactlist <- function(x, by = 'bacteriecode', ...) {
 
 #' @rdname join
 #' @export
-anti_join_bactlist <- function(x, by = 'bacteriecode', ...) {
+anti_join_bactlist <- function(x, by = 'bactid', ...) {
   # no name set to `by` parameter
   if (is.null(names(by))) {
     joinby <- colnames(AMR::bactlist)[1]

R/misc.R

@@ -29,3 +29,21 @@
 percent <- function(x, round = 1, ...) {
   base::paste0(base::round(x * 100, digits = round), "%")
 }
+
+quasiquotate <- function(deparsed, parsed) {
+  # when text: remove first and last "
+  if (any(deparsed %like% '^".+"$' | deparsed %like% "^'.+'$")) {
+    deparsed <- deparsed %>% substr(2, nchar(.) - 1)
+  }
+  # apply if needed
+  if (any(!deparsed %like% '[[$:()]'
+      & !deparsed %in% c('""', "''", "", # empty text
+                         ".", ".data", # dplyr references
+                         "TRUE", "FALSE", # logicals
+                         "NA", "NaN", "NULL", # empty values
+                         ls(.GlobalEnv)))) {
+    deparsed
+  } else {
+    parsed
+  }
+}

R/rsi_analysis.R

@@ -192,15 +192,15 @@ 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) {
-  functietekst <- as.character(match.call())
+  function_text <- as.character(match.call())
   # param 1 = functienaam
   # param 2 = ab1
   # param 3 = ab2
-  ab1.naam <- functietekst[2]
+  ab1.naam <- function_text[2]
   if (!grepl('^[a-z]{3,4}$', ab1.naam)) {
     ab1.naam <- 'rsi1'
   }
-  ab2.naam <- functietekst[3]
+  ab2.naam <- function_text[3]
   if (!grepl('^[a-z]{3,4}$', ab2.naam)) {
     ab2.naam <- 'rsi2'
   }
@@ -236,10 +236,10 @@ rsi <- function(ab1, ab2 = NA, interpretation = 'IR', minimum = 30, percent = FA
 
 #' Predict antimicrobial resistance
 #'
-#' Create a prediction model to predict antimicrobial resistance for the next years on statistical solid ground. Standard errors (SE) will be returned as columns \code{se_min} and \code{se_max}.
+#' Create a prediction model to predict antimicrobial resistance for the next years on statistical solid ground. Standard errors (SE) will be returned as columns \code{se_min} and \code{se_max}. See Examples for a real live example.
 #' @param tbl table that contains columns \code{col_ab} and \code{col_date}
-#' @param col_ab column name of \code{tbl} with antimicrobial interpretations (\code{R}, \code{I} and \code{S})
-#' @param col_date column name of the date, will be used to calculate years
+#' @param col_ab column name of \code{tbl} with antimicrobial interpretations (\code{R}, \code{I} and \code{S}), supports tidyverse-like quotation
+#' @param col_date column name of the date, will be used to calculate years if this column doesn't consist of years already, supports tidyverse-like quotation
 #' @param year_max highest year to use in the prediction model, deafults to 15 years after today
 #' @param year_every unit of sequence between lowest year found in the data and \code{year_max}
 #' @param model the statistical model of choice. Valid values are \code{"binomial"} (or \code{"binom"} or \code{"logit"}) or \code{"loglin"} or \code{"linear"} (or \code{"lin"}).
@@ -254,26 +254,45 @@ rsi <- function(ab1, ab2 = NA, interpretation = 'IR', minimum = 30, percent = FA
 #' @examples
 #' \dontrun{
 #' # use it directly:
-#' rsi_predict(tbl[which(first_isolate == TRUE & genus == "Haemophilus"),], "amcl")
+#' rsi_predict(tbl = tbl[which(first_isolate == TRUE & genus == "Haemophilus"),],
+#'             col_ab = "amcl", col_date = "date")
 #'   
 #' # or with dplyr so you can actually read it:
 #' library(dplyr)
 #' tbl %>%
 #'   filter(first_isolate == TRUE,
 #'          genus == "Haemophilus") %>%
-#'   rsi_predict("amcl")
-#'
-#' tbl %>%
-#'   filter(first_isolate_weighted == TRUE,
-#'          genus == "Haemophilus") %>%
-#'   rsi_predict(col_ab = "amcl",
-#'               year_max = 2050,
-#'               year_every = 5)
-#'
+#'   rsi_predict(amcl, date)
 #' }
+#'
+#'
+#' # real live example:
+#' library(dplyr)
+#' septic_patients %>%
+#'   # get bacteria properties like genus and species
+#'   left_join_bactlist("bactid") %>% 
+#'   # calculate first isolates
+#'   mutate(first_isolate = 
+#'            first_isolate(.,
+#'                          "date",
+#'                          "patient_id",
+#'                          "genus",
+#'                          "species",
+#'                          col_specimen = NA,
+#'                          col_icu = NA)) %>% 
+#'   # filter on first E. coli isolates
+#'   filter(genus == "Escherichia", 
+#'          species == "coli", 
+#'          first_isolate == TRUE) %>%
+#'   # predict resistance of cefotaxime for next years
+#'   rsi_predict(col_ab = cfot,
+#'               col_date = date,
+#'               year_max = 2025,
+#'               preserve_measurements = FALSE)
+#'
 rsi_predict <- function(tbl,
                         col_ab,
-                        col_date = 'ontvangstdatum',
+                        col_date,
                         year_max = as.integer(format(as.Date(Sys.Date()), '%Y')) + 15,
                         year_every = 1,
                         model = 'binomial',
@@ -281,13 +300,34 @@ rsi_predict <- function(tbl,
                         preserve_measurements = TRUE,
                         info = TRUE) {
   
+  col_ab <- quasiquotate(deparse(substitute(col_ab)), col_ab)
+  if (!col_ab %in% colnames(tbl)) {
+    stop('Column ', col_ab, ' not found.')
+  }
+  col_date <- quasiquotate(deparse(substitute(col_date)), col_date)
+  if (!col_date %in% colnames(tbl)) {
+    stop('Column ', col_date, ' not found.')
+  }
+  if ('grouped_df' %in% class(tbl)) {
+    # no grouped tibbles please, mutate will throw errors
+    tbl <- base::as.data.frame(tbl, stringsAsFactors = FALSE)
+  }
+
   if (I_as_R == TRUE) {
     tbl[, col_ab] <- gsub('I', 'R', tbl %>% pull(col_ab))
   }
 
+  if (!all(tbl %>% pull(col_ab) %>% as.rsi() %in% c(NA, 'S', 'I', 'R'))) {
+    stop('Column ', col_ab, ' must contain antimicrobial interpretations (S, I, R).')
+  }
+  
   year <- function(x) {
+    if (all(grepl('^[0-9]{4}$', x))) {
+      x
+    } else {
       as.integer(format(as.Date(x), '%Y'))
     }
+  }
   
   years_predict <- seq(from = min(year(tbl %>% pull(col_date))), to = year_max, by = year_every)
   

README.md

@@ -13,22 +13,26 @@ AMR can also be predicted for the forthcoming years with the `rsi_predict` funct
 It also contains functions to translate antibiotic codes from the lab (like `"AMOX"`) or the [WHO](https://www.whocc.no/atc_ddd_index/?code=J01CA04&showdescription=no) (like `"J01CA04"`) to trivial names (like `"amoxicillin"`) and vice versa.
 
 ## How to get it?
-[![CRAN_Badge](http://www.r-pkg.org/badges/version/AMR)](http://cran.r-project.org/package=AMR)
+This package is available on CRAN and also here on GitHub.
 
-This package is available on CRAN (latest stable version) and also here on GitHub (latest development version).
+### From CRAN (recommended, latest stable version)
+[![CRAN_Badge](https://img.shields.io/cran/v/AMR.svg?label=CRAN&colorB=3679BC)](http://cran.r-project.org/package=AMR)
+[![CRAN_Downloads](https://cranlogs.r-pkg.org/badges/grand-total/AMR)](http://cran.r-project.org/package=AMR)
 
-#### Latest stable version from CRAN (recommended)
-RStudio:
--  Click on `Tools` and then `Install Packages..`
--  Type in `AMR` and press <kbd>Install</kbd>
+- RStudio:
+  - Click on `Tools` and then `Install Packages...`
+  -  Type in `AMR` and press <kbd>Install</kbd>
+
+- R console:
+  - `install.packages("AMR")`
+
+### From GitHub (latest development version)
+[![Travis_Build](https://travis-ci.org/msberends/AMR.svg?branch=master)](https://travis-ci.org/msberends/AMR)
+[![Since_Release](https://img.shields.io/github/commits-since/msberends/AMR/latest.svg?colorB=3679BC)](https://github.com/msberends/AMR/releases)
+[![Last_Commit](https://img.shields.io/github/last-commit/msberends/AMR.svg?colorB=3679BC)](https://github.com/msberends/AMR/commits/master)
 
-Other:
-```r
-install.packages("AMR")
-```
-
-#### Latest development version from GitHub
 ```r
+install.packages("devtools")
 devtools::install_github("msberends/AMR")
 ```
 
@@ -40,14 +44,37 @@ library(AMR)
 # For a list of functions:
 help(package = "AMR")
 ```
-
-### Databases included in package
+### Overwrite/force resistance based on EUCAST rules
+This is also called *interpretive reading*.
 ```r
-# Dataset with ATC antibiotics codes, official names and DDD's (oral and parenteral)
-ablist        # A tibble: 420 x 12
+before <- data.frame(bactid = c("STAAUR",  # Staphylococcus aureus
+                                "ENCFAE",  # Enterococcus faecalis
+                                "ESCCOL",  # Escherichia coli
+                                "KLEPNE",  # Klebsiella pneumoniae
+                                "PSEAER"), # Pseudomonas aeruginosa
+                     vanc = "-",           # Vancomycin
+                     amox = "-",           # Amoxicillin
+                     coli = "-",           # Colistin
+                     cfta = "-",           # Ceftazidime
+                     cfur = "-",           # Cefuroxime
+                     stringsAsFactors = FALSE)
+before
+#   bactid vanc amox coli cfta cfur
+# 1 STAAUR    -    -    -    -    -
+# 2 ENCFAE    -    -    -    -    -
+# 3 ESCCOL    -    -    -    -    -
+# 4 KLEPNE    -    -    -    -    -
+# 5 PSEAER    -    -    -    -    -
 
-# Dataset with bacteria codes and properties like gram stain and aerobic/anaerobic
-bactlist      # A tibble: 2,507 x 10
+# Now apply those rules; just need a column with bacteria ID's and antibiotic results:
+after <- EUCAST_rules(before)
+after
+#   bactid vanc amox coli cfta cfur
+# 1 STAAUR    -    -    R    R    -
+# 2 ENCFAE    -    -    R    R    R
+# 3 ESCCOL    R    -    -    -    -
+# 4 KLEPNE    R    R    -    -    -
+# 5 PSEAER    R    R    -    -    R
 ```
 
 ### New classes
@@ -94,18 +121,13 @@ plot(rsi_data)
 Other epidemiological functions:
 
 ```r
-# Apply EUCAST Expert Rules v3.1 (latest) to antibiotic columns
-EUCAST_rules(...)
-
 # Determine key antibiotic based on bacteria ID
 key_antibiotics(...)
-# Check if key antibiotics are equal
-key_antibiotics_equal(...)
 
 # Selection of first isolates of any patient
 first_isolate(...)
 
-# Calculate resistance levels of antibiotics
+# Calculate resistance levels of antibiotics, can be used with `summarise` (dplyr)
 rsi(...)
 # Predict resistance levels of antibiotics
 rsi_predict(...)
@@ -115,6 +137,17 @@ abname(...)
 abname("J01CR02", from = "atc", to = "umcg") # "AMCL"
 ```
 
+### Databases included in package
+Datasets to work with antibiotics and bacteria properties.
+```r
+# Dataset with ATC antibiotics codes, official names and DDD's (oral and parenteral)
+ablist        # A tibble: 420 x 12
+
+# Dataset with bacteria codes and properties like gram stain and aerobic/anaerobic
+bactlist      # A tibble: 2,507 x 10
+```
+
+
 ## Authors
 
   - [Berends MS](https://github.com/msberends)<sup>1,2</sup>, PhD Student
@@ -126,6 +159,8 @@ abname("J01CR02", from = "atc", to = "umcg") # "AMCL"
 <sup>2</sup> Department of Medical, Market and Innovation (MMI), Certe Medische diagnostiek & advies, Groningen, the Netherlands
 
 ## Copyright
+[![License](https://img.shields.io/github/license/msberends/AMR.svg?colorB=3679BC)](https://github.com/msberends/AMR/blob/master/LICENSE)
+
 This R package is licensed under the [GNU General Public License (GPL) v2.0](https://github.com/msberends/AMR/blob/master/LICENSE). In a nutshell, this means that this package:
 
 - May be used for commercial purposes

man/EUCAST.Rd

@@ -1,7 +1,6 @@
 % Generated by roxygen2: do not edit by hand
 % Please edit documentation in R/EUCAST.R
-\name{EUCAST}
-\alias{EUCAST}
+\name{EUCAST_rules}
 \alias{EUCAST_rules}
 \alias{interpretive_reading}
 \title{EUCAST expert rules}
@@ -14,29 +13,29 @@ EUCAST Expert Rules Version 2.0: \cr
   \url{http://www.eucast.org/expert_rules_and_intrinsic_resistance}
 }
 \usage{
-EUCAST_rules(tbl, col_bactcode = "bacteriecode", info = TRUE,
-  amcl = "amcl", amik = "amik", amox = "amox", ampi = "ampi",
-  azit = "azit", aztr = "aztr", cefa = "cefa", cfra = "cfra",
-  cfep = "cfep", cfot = "cfot", cfox = "cfox", cfta = "cfta",
-  cftr = "cftr", cfur = "cfur", chlo = "chlo", cipr = "cipr",
-  clar = "clar", clin = "clin", clox = "clox", coli = "coli",
-  czol = "czol", dapt = "dapt", doxy = "doxy", erta = "erta",
-  eryt = "eryt", fosf = "fosf", fusi = "fusi", gent = "gent",
-  imip = "imip", kana = "kana", levo = "levo", linc = "linc",
-  line = "line", mero = "mero", mino = "mino", moxi = "moxi",
-  nali = "nali", neom = "neom", neti = "neti", nitr = "nitr",
-  novo = "novo", norf = "norf", oflo = "oflo", peni = "peni",
-  pita = "pita", poly = "poly", qida = "qida", rifa = "rifa",
-  roxi = "roxi", siso = "siso", teic = "teic", tetr = "tetr",
-  tica = "tica", tige = "tige", tobr = "tobr", trim = "trim",
-  trsu = "trsu", vanc = "vanc")
+EUCAST_rules(tbl, col_bactcode = "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",
+  cfur = "cfur", chlo = "chlo", cipr = "cipr", clar = "clar",
+  clin = "clin", clox = "clox", coli = "coli", czol = "czol",
+  dapt = "dapt", doxy = "doxy", erta = "erta", eryt = "eryt",
+  fosf = "fosf", fusi = "fusi", gent = "gent", imip = "imip",
+  kana = "kana", levo = "levo", linc = "linc", line = "line",
+  mero = "mero", mino = "mino", moxi = "moxi", nali = "nali",
+  neom = "neom", neti = "neti", nitr = "nitr", novo = "novo",
+  norf = "norf", oflo = "oflo", peni = "peni", pita = "pita",
+  poly = "poly", qida = "qida", rifa = "rifa", roxi = "roxi",
+  siso = "siso", teic = "teic", tetr = "tetr", tica = "tica",
+  tige = "tige", tobr = "tobr", trim = "trim", trsu = "trsu",
+  vanc = "vanc")
 
 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} - should also be present in \code{bactlist$bactid}, see \code{\link{bactlist}}.}
+\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{info}{print progress}
 
@@ -51,7 +50,19 @@ table with edited variables of antibiotics.
 Apply expert rules (like intrinsic resistance), as defined by the European Committee on Antimicrobial Susceptibility Testing (EUCAST, \url{http://eucast.org}), see \emph{Source}.
 }
 \examples{
-\dontrun{
-tbl <- EUCAST_rules(tbl)
-}
+a <- data.frame(bactid = c("STAAUR",  # Staphylococcus aureus
+                           "ENCFAE",  # Enterococcus faecalis
+                           "ESCCOL",  # Escherichia coli
+                           "KLEPNE",  # Klebsiella pneumoniae
+                           "PSEAER"), # Pseudomonas aeruginosa
+                vanc = "-",           # Vancomycin
+                amox = "-",           # Amoxicillin
+                coli = "-",           # Colistin
+                cfta = "-",           # Ceftazidime
+                cfur = "-",           # Cefuroxime
+                stringsAsFactors = FALSE)
+a
+
+b <- EUCAST_rules(a)
+b
 }

man/ablist.Rd

@@ -11,10 +11,10 @@
   \item{\code{umcg}}{UMCG code, like \code{AMCL}}
   \item{\code{official}}{Official name by the WHO, like \code{"amoxicillin and enzyme inhibitor"}}
   \item{\code{official_nl}}{Official name in the Netherlands, like \code{"Amoxicilline met enzymremmer"}}
-  \item{\code{trivial}}{Trivial name in Dutch, like \code{"Amoxicilline/clavulaanzuur"}}
-  \item{\code{oral_ddd}}{Daily Defined Dose (DDD) according to the WHO, oral treatment}
+  \item{\code{trivial_nl}}{Trivial name in Dutch, like \code{"Amoxicilline/clavulaanzuur"}}
+  \item{\code{oral_ddd}}{Defined Daily Dose (DDD) according to the WHO, oral treatment}
   \item{\code{oral_units}}{Units of \code{ddd_units}}
-  \item{\code{iv_ddd}}{Daily Defined Dose (DDD) according to the WHO, bij parenteral treatment}
+  \item{\code{iv_ddd}}{Defined Daily Dose (DDD) according to the WHO, parenteral treatment}
   \item{\code{iv_units}}{Units of \code{iv_ddd}}
   \item{\code{atc_group1}}{ATC group in Dutch, like \code{"Macroliden, lincosamiden en streptograminen"}}
   \item{\code{atc_group2}}{Subgroup of \code{atc_group1} in Dutch, like \code{"Macroliden"}}

man/abname.Rd

@@ -11,7 +11,7 @@ abname(abcode, from = "umcg", to = "official", textbetween = " + ",
   tolower = FALSE)
 }
 \arguments{
-\item{abcode}{a code or name, like \code{"amox"}, \code{"cftr"} or \code{"J01CA04"}}
+\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{ablist}} for its column names.}
 
@@ -32,7 +32,7 @@ abname("AMCL+GENT")
 abname(c("AMCL", "GENT"))
 # "amoxicillin and enzyme inhibitor" "gentamicin" 
 
-abname("AMCL", to = "trivial")
+abname("AMCL", to = "trivial_nl")
 # "Amoxicilline/clavulaanzuur"
 
 abname("AMCL", to = "atc")

man/as.mic.Rd

@@ -18,17 +18,12 @@ is.mic(x)
 New class \code{mic}
 }
 \description{
-This transforms a vector to a new class\code{mic}, which is an ordered factor valid MIC values as levels. Invalid MIC values will be translated as \code{NA} with a warning.
+This transforms a vector to a new class\code{mic}, which is an ordered factor with valid MIC values as levels. Invalid MIC values will be translated as \code{NA} with a warning.
 }
 \examples{
 mic_data <- as.mic(c(">=32", "1.0", "1", "1.00", 8, "<=0.128", "8", "16", "16"))
 is.mic(mic_data)
-plot(mic_data)
 
-\donttest{
-library(dplyr)
-tbl \%>\%
-  mutate_at(vars(ends_with("_mic")), as.mic)
-sapply(mic_data, is.mic)
-}
+plot(mic_data)
+barplot(mic_data)
 }

man/as.rsi.Rd

@@ -22,12 +22,7 @@ This transforms a vector to a new class \code{rsi}, which is an ordered factor w
 rsi_data <- as.rsi(c(rep("S", 474), rep("I", 36), rep("R", 370)))
 rsi_data <- as.rsi(c(rep("S", 474), rep("I", 36), rep("R", 370), "A", "B", "C"))
 is.rsi(rsi_data)
-plot(rsi_data)
 
-\donttest{
-library(dplyr)
-tbl \%>\%
-  mutate_at(vars(ends_with("_rsi")), as.rsi)
-sapply(mic_data, is.rsi)
-}
+plot(rsi_data)    # for percentages
+barplot(rsi_data) # for frequencies
 }

man/atc_property.Rd

@@ -20,7 +20,7 @@ atc_property(atc_code, property, administration = "O",
 \item{url}{url of website of the WHO. The sign \code{\%s} can be used as a placeholder for ATC codes.}
 }
 \description{
-Gets data from the WHO to determine properties of an ATC of e.g. an antibiotic. \strong{This function requires an internet connection.}
+Gets data from the WHO to determine properties of an ATC (e.g. an antibiotic) like name, defined daily dose (DDD) or standard unit. \strong{This function requires an internet connection.}
 }
 \details{
 Abbreviations for the property \code{"Adm.R"} (parameter \code{administration}):
@@ -51,7 +51,7 @@ Abbreviations for the property \code{"U"} (unit):
 }
 \examples{
 \donttest{
-atc_property("J01CA04", "DDD", "O") # oral DDD of amoxicillin
-atc_property("J01CA04", "DDD", "P") # parenteral DDD of amoxicillin
+atc_property("J01CA04", "DDD", "O") # oral DDD (Defined Daily Dose) of amoxicillin
+atc_property("J01CA04", "DDD", "P") # parenteral DDD (Defined Daily Dose) of amoxicillin
 }
 }

man/bactlist.Rd

@@ -13,7 +13,7 @@
   \item{\code{species}}{Species name of microorganism, like \code{"coli"}}
   \item{\code{subspecies}}{Subspecies name of bio-/serovar of microorganism, like \code{"EHEC"}}
   \item{\code{fullname}}{Full name, like \code{"Echerichia coli (EHEC)"}}
-  \item{\code{type}}{Type of microorganism, like \code{"Bacterie"} en \code{"Schimmel/gist"} (these are Dutch)}
+  \item{\code{type}}{Type of microorganism in Dutch, like \code{"Bacterie"} and \code{"Schimmel/gist"}}
   \item{\code{gramstain}}{Gram of microorganism in Dutch, like \code{"Negatieve staven"}}
   \item{\code{aerobic}}{Type aerobe/anaerobe of bacteria}
 }}

man/first_isolate.Rd

@@ -4,10 +4,10 @@
 \alias{first_isolate}
 \title{Determine first (weighted) isolates}
 \usage{
-first_isolate(tbl, col_date, col_patid, col_genus, col_species,
+first_isolate(tbl, col_date, col_patient_id, col_genus, col_species,
   col_testcode = NA, col_specimen, col_icu, col_keyantibiotics = NA,
   episode_days = 365, testcodes_exclude = "", icu_exclude = FALSE,
-  filter_specimen = NA, output_logical = TRUE, ignore_I = TRUE,
+  filter_specimen = NA, output_logical = TRUE, points_threshold = 2,
   info = TRUE)
 }
 \arguments{
@@ -15,13 +15,13 @@ first_isolate(tbl, col_date, col_patid, col_genus, col_species,
 
 \item{col_date}{column name of the result date (or date that is was received on the lab)}
 
-\item{col_patid}{column name of the unique IDs of the patients}
+\item{col_patient_id}{column name of the unique IDs of the patients}
 
 \item{col_genus}{column name of the genus of the microorganisms}
 
 \item{col_species}{column name of the species of the microorganisms}
 
-\item{col_testcode}{column name of the test codes, see Details}
+\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.}
 
 \item{col_specimen}{column name of the specimen type or group}
 
@@ -39,7 +39,7 @@ first_isolate(tbl, col_date, col_patid, col_genus, col_species,
 
 \item{output_logical}{return output as \code{logical} (will else the values \code{0} or \code{1})}
 
-\item{ignore_I}{ignore \code{"I"} as antimicrobial interpretation of key antibiotics (with \code{FALSE}, changes in antibiograms from S to I and I to R will be interpreted as difference)}
+\item{points_threshold}{points until the comparison of key antibiotics will lead to inclusion of an isolate, see Details}
 
 \item{info}{print progress}
 }
@@ -50,9 +50,11 @@ A vector to add to table, see Examples.
 Determine first (weighted) isolates of all microorganisms of every patient per episode and (if needed) per specimen type.
 }
 \details{
-To conduct an analysis of antimicrobial resistance, you should only include the first isolate of every patient per episode. 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 is 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 selection bias.
+\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}.
 
-    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.
+    \strong{Using parameter \code{points_threshold}} \cr
+    To compare key antibiotics, the difference between antimicrobial interpretations will be measured. A difference from I to S|R (or vice versa) means 0.5 points. A difference from S to R (or vice versa) means 1 point. When the sum of points exceeds \code{points_threshold}, an isolate will be (re)selected as a first weighted isolate.
 }
 \examples{
 \dontrun{

man/join.Rd

@@ -13,22 +13,22 @@
 \usage{
 inner_join_bactlist(x, by = "bactid", ...)
 
-left_join_bactlist(x, by = "bacteriecode", ...)
+left_join_bactlist(x, by = "bactid", ...)
 
-right_join_bactlist(x, by = "bacteriecode", ...)
+right_join_bactlist(x, by = "bactid", ...)
 
-full_join_bactlist(x, by = "bacteriecode", ...)
+full_join_bactlist(x, by = "bactid", ...)
 
-semi_join_bactlist(x, by = "bacteriecode", ...)
+semi_join_bactlist(x, by = "bactid", ...)
 
-anti_join_bactlist(x, by = "bacteriecode", ...)
+anti_join_bactlist(x, by = "bactid", ...)
 }
 \arguments{
 \item{x}{existing table to join}
 
 \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{...}{other parameters to pass trhough to \code{dplyr::\link[dplyr]{join}}.}
+\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.

man/key_antibiotics.Rd

@@ -4,12 +4,12 @@
 \alias{key_antibiotics}
 \title{Key antibiotics based on bacteria ID}
 \usage{
-key_antibiotics(tbl, col_bactcode = "bacteriecode", 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", mero = "mero", peni = "peni", pita = "pita",
-  rifa = "rifa", teic = "teic", trsu = "trsu", vanc = "vanc")
+key_antibiotics(tbl, col_bactcode = "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",
+  mero = "mero", peni = "peni", pita = "pita", rifa = "rifa",
+  teic = "teic", trsu = "trsu", vanc = "vanc")
 }
 \arguments{
 \item{tbl}{table with antibiotics coloms, like \code{amox} and \code{amcl}.}

man/rsi_predict.Rd

@@ -4,7 +4,7 @@
 \alias{rsi_predict}
 \title{Predict antimicrobial resistance}
 \usage{
-rsi_predict(tbl, col_ab, col_date = "ontvangstdatum",
+rsi_predict(tbl, col_ab, col_date,
   year_max = as.integer(format(as.Date(Sys.Date()), "\%Y")) + 15,
   year_every = 1, model = "binomial", I_as_R = TRUE,
   preserve_measurements = TRUE, info = TRUE)
@@ -12,9 +12,9 @@ rsi_predict(tbl, col_ab, col_date = "ontvangstdatum",
 \arguments{
 \item{tbl}{table that contains columns \code{col_ab} and \code{col_date}}
 
-\item{col_ab}{column name of \code{tbl} with antimicrobial interpretations (\code{R}, \code{I} and \code{S})}
+\item{col_ab}{column name of \code{tbl} with antimicrobial interpretations (\code{R}, \code{I} and \code{S}), supports tidyverse-like quotation}
 
-\item{col_date}{column name of the date, will be used to calculate years}
+\item{col_date}{column name of the date, will be used to calculate years if this column doesn't consist of years already, supports tidyverse-like quotation}
 
 \item{year_max}{highest year to use in the prediction model, deafults to 15 years after today}
 
@@ -32,28 +32,47 @@ rsi_predict(tbl, col_ab, col_date = "ontvangstdatum",
 \code{data.frame} with columns \code{year}, \code{probR}, \code{se_min} and \code{se_max}.
 }
 \description{
-Create a prediction model to predict antimicrobial resistance for the next years on statistical solid ground. Standard errors (SE) will be returned as columns \code{se_min} and \code{se_max}.
+Create a prediction model to predict antimicrobial resistance for the next years on statistical solid ground. Standard errors (SE) will be returned as columns \code{se_min} and \code{se_max}. See Examples for a real live example.
 }
 \examples{
 \dontrun{
 # use it directly:
-rsi_predict(tbl[which(first_isolate == TRUE & genus == "Haemophilus"),], "amcl")
+rsi_predict(tbl = tbl[which(first_isolate == TRUE & genus == "Haemophilus"),],
+            col_ab = "amcl", col_date = "date")
   
 # or with dplyr so you can actually read it:
 library(dplyr)
 tbl \%>\%
   filter(first_isolate == TRUE,
          genus == "Haemophilus") \%>\%
-  rsi_predict("amcl")
-
-tbl \%>\%
-  filter(first_isolate_weighted == TRUE,
-         genus == "Haemophilus") \%>\%
-  rsi_predict(col_ab = "amcl",
-              year_max = 2050,
-              year_every = 5)
-
+  rsi_predict(amcl, date)
 }
+
+
+# real live example:
+library(dplyr)
+septic_patients \%>\%
+  # get bacteria properties like genus and species
+  left_join_bactlist("bactid") \%>\% 
+  # calculate first isolates
+  mutate(first_isolate = 
+           first_isolate(.,
+                         "date",
+                         "patient_id",
+                         "genus",
+                         "species",
+                         col_specimen = NA,
+                         col_icu = NA)) \%>\% 
+  # filter on first E. coli isolates
+  filter(genus == "Escherichia", 
+         species == "coli", 
+         first_isolate == TRUE) \%>\%
+  # predict resistance of cefotaxime for next years
+  rsi_predict(col_ab = cfot,
+              col_date = date,
+              year_max = 2025,
+              preserve_measurements = FALSE)
+
 }
 \seealso{
 \code{\link{lm}} \cr \code{\link{glm}}

man/septic_patients.Rd

@@ -0,0 +1,29 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/data.R
+\docType{data}
+\name{septic_patients}
+\alias{septic_patients}
+\title{Dataset with 2000 blood culture isolates of septic patients}
+\format{A data.frame with 2000 observations and 47 variables:
+\describe{
+  \item{\code{date}}{date of receipt at the laboratory}
+  \item{\code{hospital_id}}{ID of the hospital}
+  \item{\code{ward_icu}}{logical to determine if ward is an intensive care unit}
+  \item{\code{ward_clinical}}{logical to determine if ward is a regular clinical ward}
+  \item{\code{ward_outpatient}}{logical to determine if ward is an outpatient clinic}
+  \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{ablist}} and can be translated with \code{\link{abname}}}
+}}
+\source{
+MOLIS (LIS of Certe) - \url{https://www.certe.nl}
+}
+\usage{
+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.
+}
+\keyword{datasets}