Added function n_rsi

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: AMR
 Version: 0.2.0
-Date: 2018-04-30
+Date: 2018-05-02
 Title: Antimicrobial Resistance Analysis
 Authors@R: c(
     person(

NAMESPACE

@@ -38,6 +38,7 @@ export(is.rsi)
 export(key_antibiotics)
 export(left_join_microorganisms)
 export(mo_property)
+export(n_rsi)
 export(right_join_microorganisms)
 export(rsi)
 export(rsi_df)
@@ -96,5 +97,6 @@ importFrom(rvest,html_table)
 importFrom(stats,fivenum)
 importFrom(stats,quantile)
 importFrom(stats,sd)
+importFrom(utils,object.size)
 importFrom(utils,packageDescription)
 importFrom(xml2,read_html)

NEWS.md

@@ -2,6 +2,7 @@
 #### New
 * Full support for Windows, Linux and macOS
 * Full support for old R versions, only R-3.0.0 (April 2013) or later is needed (needed packages may have other dependencies)
+* Function `n_rsi` to count cases where antibiotic test results were available, to be used in conjunction with `dplyr::summarise`, see ?rsi
 * Function `guess_bactid` to **determine the ID** of a microorganism based on genus/species or known abbreviations like MRSA
 * Function `guess_atc` to **determine the ATC** of an antibiotic based on name, trade name, or known abbreviations
 * Function `freq` to create **frequency tables**, with additional info in a header
@@ -13,6 +14,7 @@
 * New print format for `tibble`s and `data.table`s
 
 #### Changed
+* Fixed `rsi` class for vectors that contain only invalid antimicrobial interpretations
 * Renamed dataset `ablist` to `antibiotics`
 * Renamed dataset `bactlist` to `microorganisms`
 * Added common abbreviations and trade names to the `antibiotics` dataset

R/classes.R

@@ -93,13 +93,15 @@ print.rsi <- function(x, ...) {
   R <- x[x == 'R'] %>% length()
   IR <- x[x %in% c('I', 'R')] %>% length()
   cat("Class 'rsi'\n")
-  cat(n, " results (missing: ", n_total - n, ' = ', percent((n_total - n) / n, force_zero = TRUE), ')\n', sep = "")
+  cat(n, " results (missing: ", n_total - n, ' = ', percent((n_total - n) / n_total, force_zero = TRUE), ')\n', sep = "")
+  if (n > 0) {
     cat('\n')
     cat('Sum of S:   ', S, ' (', percent(S / n, force_zero = TRUE), ')\n', sep = "")
     cat('Sum of IR:  ', IR, ' (', percent(IR / n, force_zero = TRUE), ')\n', sep = "")
     cat('- Sum of R: ', R, ' (', percent(R / n, force_zero = TRUE), ')\n', sep = "")
     cat('- Sum of I: ', I, ' (', percent(I / n, force_zero = TRUE), ')\n', sep = "")
   }
+}
 
 #' @exportMethod summary.rsi
 #' @export

R/eucast.R

@@ -36,6 +36,7 @@
 #'   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 <- EUCAST_rules(septic_patients)
 #' a <- data.frame(bactid = c("STAAUR",  # Staphylococcus aureus
 #'                            "ENCFAE",  # Enterococcus faecalis
 #'                            "ESCCOL",  # Escherichia coli

R/misc.R

@@ -48,10 +48,12 @@
 # No export, no Rd
 percent <- function(x, round = 1, force_zero = FALSE, ...) {
   val <- base::round(x * 100, digits = round)
-  if (force_zero & any(val == as.integer(val))) {
+  if (force_zero == TRUE & any(val == as.integer(val) & !is.na(val))) {
     val[val == as.integer(val)] <- paste0(val[val == as.integer(val)], ".", strrep(0, round))
   }
-  base::paste0(val, "%")
+  pct <- base::paste0(val, "%")
+  pct[pct == "NA%"] <- NA_character_
+  pct
 }
 
 check_available_columns <- function(tbl, col.list, info = TRUE) {

R/print.R

@@ -29,6 +29,7 @@
 #' @name print
 #' @importFrom dplyr %>% n_groups group_vars group_size filter pull select
 #' @importFrom data.table data.table
+#' @importFrom utils object.size
 #' @exportMethod print.tbl_df
 #' @export
 #' @examples
@@ -191,7 +192,8 @@ prettyprint_df <- function(x,
   if (n + 1 < nrow(x)) {
     # remove in between part, 1 extra for ~~~~ between first and last part
     rows_list <- c(1:(n / 2 + 1), (nrow(x) - (n / 2) + 1):nrow(x))
-    x <- x %>% filter(row_number() %in% rows_list)
+    x <- as.data.frame(x.bak[rows_list,])
+    colnames(x) <- colnames(x.bak)
     rownames(x) <- rownames(x.bak)[rows_list]
     # set inbetweener between parts
     rownames(x)[n / 2 + 1] <- strrep("~", maxrowchars)
@@ -217,9 +219,13 @@ prettyprint_df <- function(x,
                    c %>%
                      gsub('POSIX', '', .) %>%
                      paste0(collapse = '/'))
+          } else {
+            if (NCOL(.) > 1) {
+              .[1,]
             } else {
               c[[1]]
             }
+          }
         }) %>%
       unlist() %>%
       gsub("character",  "chr", ., fixed = TRUE) %>%

R/rsi_analysis.R

@@ -16,40 +16,164 @@
 # GNU General Public License for more details.                         #
 # ==================================================================== #
 
-#' Resistance of isolates in data.frame
+#' Resistance of isolates
 #'
-#' \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.
+#' This functions can be used to calculate the (co-)resistance of isolates (i.e. percentage S, SI, I, IR or R [of a vector] of isolates). The functions \code{rsi} and \code{n_rsi} can be used in \code{dplyr}s \code{\link[dplyr]{summarise}} and support grouped variables, see \emph{Examples}.
 #' @param tbl \code{data.frame} containing columns with antibiotic interpretations.
 #' @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 ab1,ab2 vector of antibiotic interpretations, they will be transformed internally with \code{\link{as.rsi}}
 #' @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
+#' @param as_percent return output as percent (text), will else (at default) be a double
 #' @param info calculate the amount of available isolates and print it, like \code{n = 423}
 #' @param warning show a warning when the available amount of isolates is below \code{minimum}
 #' @details Remember that you should filter your table to let it contain \strong{only first isolates}!
+#'
+#' To calculate the probability (\emph{p}) of susceptibility of one antibiotic, we use this formula:
+#' \if{html}{
+#'   \out{<div style="text-align: center">}\figure{mono_therapy.png}\out{</div>}
+#' }
+#' \if{latex}{
+#'   \deqn{p = \frac{\sum{ab1_S}}{\sum{ab1_{R|I|S}}}}
+#' }
+#' \cr
+#' To calculate the probability (\emph{p}) of susceptibility of more antibiotics a combination therapy, we need to check whether one of them has a susceptible result (as numerator) and count all cases where all antibiotics were tested (as denominator). \cr
+#' For two antibiotics:
+#' \if{html}{
+#'   \out{<div style="text-align: center">}\figure{combi_therapy_2.png}\out{</div>}
+#' }
+#' \if{latex}{
+#'   \deqn{p = \frac{\sum{ab1_S}\mid{ab2_S}}{\sum{ab1_{R|I|S},ab2_{R|I|S}}}}
+#' }
+#' \cr
+#' For three antibiotics:
+#' \if{html}{
+#'   \out{<div style="text-align: center">}\figure{combi_therapy_3.png}\out{</div>}
+#' }
+#' \if{latex}{
+#'   \deqn{p = \frac{\sum{ab1_S}\mid{ab2_S}\mid{ab3_S}}{\sum{ab1_{R|I|S},ab2_{R|I|S},ab3_{R|I|S}}}}
+#' }
+#'
 #' @keywords rsi antibiotics isolate isolates
-#' @return Double or, when \code{percent = TRUE}, a character.
+#' @return Double or, when \code{as_percent = TRUE}, a character.
+#' @rdname rsi
 #' @export
 #' @importFrom dplyr %>% n_distinct filter filter_at pull vars all_vars any_vars
-#' @seealso \code{\link{rsi}} for the function that can be used with \code{\link[dplyr]{summarise}} directly.
 #' @examples
-#' \dontrun{
-#' rsi_df(tbl_with_bloodcultures, 'amcl')
-#'
-#' rsi_df(tbl_with_bloodcultures, c('amcl', 'gent'), interpretation = 'IR')
-#'
 #' library(dplyr)
-#' # calculate current empiric therapy of Helicobacter gastritis:
+#'
+#' septic_patients %>%
+#'   group_by(hospital_id) %>%
+#'   summarise(cipro_susceptibility = rsi(cipr, interpretation = "S"),
+#'             n = n_rsi(cipr)) # n_rsi works like n_distinct in dplyr
+#'
+#' septic_patients %>%
+#'   group_by(hospital_id) %>%
+#'   summarise(cipro_S = rsi(cipr, interpretation = "S",
+#'                           as_percent = TRUE, warning = FALSE),
+#'             cipro_n = n_rsi(cipr),
+#'             genta_S = rsi(gent, interpretation = "S",
+#'                           as_percent = TRUE, warning = FALSE),
+#'             genta_n = n_rsi(gent),
+#'             combination_S = rsi(cipr, gent, interpretation = "S",
+#'                                 as_percent = TRUE, warning = FALSE),
+#'             combination_n = n_rsi(cipr, gent))
+#'
+#' # calculate resistance
+#' rsi(septic_patients$amox)
+#' # or susceptibility
+#' rsi(septic_patients$amox, interpretation = "S")
+#'
+#' # calculate co-resistance between amoxicillin/clav acid and gentamicin,
+#' # so we can review that combination therapy does a lot more than mono therapy:
+#' septic_patients %>% rsi_df(ab = "amcl", interpretation = "S") # = 67.8%
+#' septic_patients %>% rsi_df(ab = "gent", interpretation = "S") # = 69.1%
+#' septic_patients %>% rsi_df(ab = c("amcl", "gent"), interpretation = "S") # = 90.6%
+#'
+#' \dontrun{
+#' # calculate current empiric combination therapy of Helicobacter gastritis:
 #' my_table %>%
 #'   filter(first_isolate == TRUE,
 #'          genus == "Helicobacter") %>%
-#'   rsi_df(ab = c("amox", "metr"))
+#'   rsi_df(ab = c("amox", "metr")) # amoxicillin with metronidazole
 #' }
+rsi <- function(ab1,
+                ab2 = NA,
+                interpretation = 'IR',
+                minimum = 30,
+                as_percent = FALSE,
+                info = FALSE,
+                warning = TRUE) {
+  ab1.name <- deparse(substitute(ab1))
+  if (ab1.name %like% '.[$].') {
+    ab1.name <- unlist(strsplit(ab1.name, "$", fixed = TRUE))
+    ab1.name <- ab1.name[length(ab1.name)]
+  }
+  if (!ab1.name %like% '^[a-z]{3,4}$') {
+    ab1.name <- 'rsi1'
+  }
+  if (length(ab1) == 1 & is.character(ab1)) {
+    stop('`ab1` must be a vector of antibiotic interpretations.',
+         '\n  Try rsi(', ab1, ', ...) instead of rsi("', ab1, '", ...)', call. = FALSE)
+  }
+  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'
+  }
+  if (length(ab2) == 1 & is.character(ab2)) {
+    stop('`ab2` must be a vector of antibiotic interpretations.',
+         '\n  Try rsi(', ab2, ', ...) instead of rsi("', ab2, '", ...)', call. = FALSE)
+  }
+
+  interpretation <- paste(interpretation, collapse = "")
+
+  ab1 <- as.rsi(ab1)
+  ab2 <- as.rsi(ab2)
+
+  tbl <- tibble(rsi1 = ab1, rsi2 = ab2)
+  colnames(tbl) <- c(ab1.name, ab2.name)
+
+  if (length(ab2) == 1) {
+    r <- rsi_df(tbl = tbl,
+                ab = ab1.name,
+                interpretation = interpretation,
+                minimum = minimum,
+                as_percent = FALSE,
+                info = info,
+                warning = warning)
+  } else {
+    if (length(ab1) != length(ab2)) {
+      stop('`ab1` (n = ', length(ab1), ') and `ab2` (n = ', length(ab2), ') must be of same length.', call. = FALSE)
+    }
+    if (!interpretation %in% c('S', 'IS', 'SI')) {
+      warning('`interpretation` not set to S or I/S, albeit analysing a combination therapy.', call. = FALSE)
+    }
+    r <- rsi_df(tbl = tbl,
+                ab = c(ab1.name, ab2.name),
+                interpretation = interpretation,
+                minimum = minimum,
+                as_percent = FALSE,
+                info = info,
+                warning = warning)
+  }
+  if (as_percent == TRUE) {
+    percent(r, force_zero = TRUE)
+  } else {
+    r
+  }
+}
+
+#' @export
+#' @rdname rsi
 rsi_df <- function(tbl,
                    ab,
                    interpretation = 'IR',
                    minimum = 30,
-                   percent = FALSE,
+                   as_percent = FALSE,
                    info = TRUE,
                    warning = TRUE) {
 
@@ -103,6 +227,9 @@ rsi_df <- function(tbl,
       nrow()
 
   } else if (length(ab) == 2) {
+    if (interpretations_to_check != 'S') {
+      warning('`interpretation` not set to S or I/S, albeit analysing a combination therapy.', call. = FALSE)
+    }
     numerator <- tbl %>%
       filter_at(vars(ab[1], ab[2]),
                 any_vars(. == interpretations_to_check)) %>%
@@ -116,6 +243,9 @@ rsi_df <- function(tbl,
       nrow()
 
   } else if (length(ab) == 3) {
+    if (interpretations_to_check != 'S') {
+      warning('`interpretation` not set to S or I/S, albeit analysing a combination therapy.', call. = FALSE)
+    }
     numerator <- tbl %>%
       filter_at(vars(ab[1], ab[2], ab[3]),
                 any_vars(. == interpretations_to_check)) %>%
@@ -150,9 +280,10 @@ rsi_df <- function(tbl,
 
   # calculate and format
   y <- numerator / denominator
-  if (percent == TRUE) {
+  if (as_percent == TRUE) {
-    y <- percent(y)
+   y <- percent(y, force_zero = TRUE)
   }
+
   if (denominator < minimum) {
     if (warning == TRUE) {
       warning(paste0('TOO FEW ISOLATES OF ', toString(ab), ' (n = ', denominator, ', n < ', minimum, '); NO RESULT.'))
@@ -164,78 +295,29 @@ rsi_df <- function(tbl,
   y
 }
 
-#' Resistance of isolates
-#'
-#' This function can be used in \code{dplyr}s \code{\link[dplyr]{summarise}}, see \emph{Examples}. Calculate the percentage S, SI, I, IR or R of a vector of isolates.
-#' @param ab1,ab2 list with interpretations of an antibiotic
-#' @inheritParams rsi_df
-#' @details This function uses the \code{\link{rsi_df}} function internally.
-#' @keywords rsi antibiotics isolate isolates
-#' @return Double or, when \code{percent = TRUE}, a character.
 #' @export
-#' @examples
+#' @rdname rsi
-#' \dontrun{
+n_rsi <- function(ab1, ab2 = NA) {
-#' tbl %>%
-#'   group_by(hospital) %>%
-#'   summarise(cipr = rsi(cipr))
-#'
-#' tbl %>%
-#'   group_by(year, hospital) %>%
-#'   summarise(
-#'     isolates = n(),
-#'     cipro = rsi(cipr %>% as.rsi(), percent = TRUE),
-#'     amoxi = rsi(amox %>% as.rsi(), percent = TRUE))
-#'
-#' rsi(as.rsi(isolates$amox))
-#'
-#' rsi(as.rsi(isolates$amcl), interpretation = "S")
-#' }
-rsi <- function(ab1, ab2 = NA, interpretation = 'IR', minimum = 30, percent = FALSE, info = FALSE, warning = FALSE) {
-  ab1.name <- deparse(substitute(ab1))
-  if (ab1.name %like% '.[$].') {
-    ab1.name <- unlist(strsplit(ab1.name, "$", fixed = TRUE))
-    ab1.name <- ab1.name[length(ab1.name)]
-  }
-  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 = "")
+  if (length(ab1) == 1 & is.character(ab1)) {
+    stop('`ab1` must be a vector of antibiotic interpretations.',
+         '\n  Try n_rsi(', ab1, ', ...) instead of n_rsi("', ab1, '", ...)', call. = FALSE)
+  }
+  ab1 <- as.rsi(ab1)
 
-  tbl <- tibble(rsi1 = ab1, rsi2 = ab2)
+  if (length(ab2) == 1 & all(is.na(ab2))) {
-  colnames(tbl) <- c(ab1.name, ab2.name)
+    # only 1 antibiotic
-
+    length(ab1[!is.na(ab1)])
-  if (length(ab2) == 1) {
-    return(rsi_df(tbl = tbl,
-                  ab = ab1.name,
-                  interpretation = interpretation,
-                  minimum = minimum,
-                  percent = percent,
-                  info = info,
-                  warning = warning))
   } else {
-    if (length(ab1) != length(ab2)) {
+    if (length(ab2) == 1 & is.character(ab2)) {
-      stop('`ab1` (n = ', length(ab1), ') and `ab2` (n = ', length(ab2), ') must be of same length.', call. = FALSE)
+      stop('`ab2` must be a vector of antibiotic interpretations.',
+           '\n  Try n_rsi(', ab2, ', ...) instead of n_rsi("', ab2, '", ...)', call. = FALSE)
     }
-    if (interpretation != 'S') {
+    ab2 <- as.rsi(ab2)
-      warning('`interpretation` is not set to S, albeit analysing a combination therapy.')
+    tbl <- tibble(ab1, ab2)
-    }
+    tbl %>% filter(!is.na(ab1) & !is.na(ab2)) %>% nrow()
-    return(rsi_df(tbl = tbl,
-                  ab = c(ab1.name, ab2.name),
-                  interpretation = interpretation,
-                  minimum = minimum,
-                  percent = percent,
-                  info = info,
-                  warning = warning))
   }
+
 }
 
 #' Predict antimicrobial resistance

README.md

@@ -10,7 +10,7 @@ This R package contains functions to make **microbiological, epidemiological dat
 
 With `AMR` you can also:
 * Create frequency tables with the `freq` function
-* Conduct AMR analysis with the `rsi` function, that can also be used with the `dplyr` package (e.g. in conjunction with `summarise`) to calculate the resistance percentages of different antibiotic columns of a table
+* Conduct AMR analysis with the `rsi` function, that can also be used with the `dplyr` package (e.g. in conjunction with `summarise`) to calculate the resistance percentages (and even co-resistance) of different antibiotic columns of a table
 * Predict antimicrobial resistance for the nextcoming years with the `rsi_predict` function
 * Apply [EUCAST rules to isolates](http://www.eucast.org/expert_rules_and_intrinsic_resistance/) with the `EUCAST_rules` function
 * Identify first isolates of every patient [using guidelines from the CLSI](https://clsi.org/standards/products/microbiology/documents/m39/) (Clinical and Laboratory Standards Institute) with the `first_isolate` function
@@ -264,13 +264,16 @@ abname("J01CR02", from = "atc", to = "umcg") # "AMCL"
 ### Databases included in package
 Datasets to work with antibiotics and bacteria properties.
 ```r
-# Dataset with 2000 random blood culture isolates from anonymised septic patients between 2001 and 2017 in 5 Dutch hospitals
+# Dataset with 2000 random blood culture isolates from anonymised
+# septic patients between 2001 and 2017 in 5 Dutch hospitals
 septic_patients   # A tibble: 4,000 x 47
 
-# Dataset with ATC antibiotics codes, official names, trade names and DDD's (oral and parenteral)
+# Dataset with ATC antibiotics codes, official names, trade names 
+# and DDD's (oral and parenteral)
 antibiotics       # A tibble: 420 x 18
 
-# Dataset with bacteria codes and properties like gram stain and aerobic/anaerobic
+# Dataset with bacteria codes and properties like gram stain and 
+# aerobic/anaerobic
 microorganisms    # A tibble: 2,453 x 12
 ```
 

man/EUCAST.Rd

@@ -50,6 +50,7 @@ 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{
+a <- EUCAST_rules(septic_patients)
 a <- data.frame(bactid = c("STAAUR",  # Staphylococcus aureus
                            "ENCFAE",  # Enterococcus faecalis
                            "ESCCOL",  # Escherichia coli

man/rsi.Rd

@@ -2,49 +2,106 @@
 % Please edit documentation in R/rsi_analysis.R
 \name{rsi}
 \alias{rsi}
+\alias{rsi_df}
+\alias{n_rsi}
 \title{Resistance of isolates}
 \usage{
-rsi(ab1, ab2 = NA, interpretation = "IR", minimum = 30, percent = FALSE,
+rsi(ab1, ab2 = NA, interpretation = "IR", minimum = 30,
-  info = FALSE, warning = FALSE)
+  as_percent = FALSE, info = FALSE, warning = TRUE)
+
+rsi_df(tbl, ab, interpretation = "IR", minimum = 30, as_percent = FALSE,
+  info = TRUE, warning = TRUE)
+
+n_rsi(ab1, ab2 = NA)
 }
 \arguments{
-\item{ab1, ab2}{list with interpretations of an antibiotic}
+\item{ab1, ab2}{vector of antibiotic interpretations, they will be transformed internally with \code{\link{as.rsi}}}
 
 \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"}.}
 
 \item{minimum}{minimal amount of available isolates. Any number lower than \code{minimum} will return \code{NA} with a warning (when \code{warning = TRUE}).}
 
-\item{percent}{return output as percent (text), will else (at default) be a double}
+\item{as_percent}{return output as percent (text), will else (at default) be a double}
 
 \item{info}{calculate the amount of available isolates and print it, like \code{n = 423}}
 
 \item{warning}{show a warning when the available amount of isolates is below \code{minimum}}
+
+\item{tbl}{\code{data.frame} containing columns with antibiotic interpretations.}
+
+\item{ab}{character vector with 1, 2 or 3 antibiotics that occur as column names in \code{tbl}, like \code{ab = c("amox", "amcl")}}
 }
 \value{
-Double or, when \code{percent = TRUE}, a character.
+Double or, when \code{as_percent = TRUE}, a character.
 }
 \description{
-This function can be used in \code{dplyr}s \code{\link[dplyr]{summarise}}, see \emph{Examples}. Calculate the percentage S, SI, I, IR or R of a vector of isolates.
+This functions can be used to calculate the (co-)resistance of isolates (i.e. percentage S, SI, I, IR or R [of a vector] of isolates). The functions \code{rsi} and \code{n_rsi} can be used in \code{dplyr}s \code{\link[dplyr]{summarise}} and support grouped variables, see \emph{Examples}.
 }
 \details{
-This function uses the \code{\link{rsi_df}} function internally.
+Remember that you should filter your table to let it contain \strong{only first isolates}!
+
+To calculate the probability (\emph{p}) of susceptibility of one antibiotic, we use this formula:
+\if{html}{
+  \out{<div style="text-align: center">}\figure{mono_therapy.png}\out{</div>}
+}
+\if{latex}{
+  \deqn{p = \frac{\sum{ab1_S}}{\sum{ab1_{R|I|S}}}}
+}
+\cr
+To calculate the probability (\emph{p}) of susceptibility of more antibiotics a combination therapy, we need to check whether one of them has a susceptible result (as numerator) and count all cases where all antibiotics were tested (as denominator). \cr
+For two antibiotics:
+\if{html}{
+  \out{<div style="text-align: center">}\figure{combi_therapy_2.png}\out{</div>}
+}
+\if{latex}{
+  \deqn{p = \frac{\sum{ab1_S}\mid{ab2_S}}{\sum{ab1_{R|I|S},ab2_{R|I|S}}}}
+}
+\cr
+For three antibiotics:
+\if{html}{
+  \out{<div style="text-align: center">}\figure{combi_therapy_3.png}\out{</div>}
+}
+\if{latex}{
+  \deqn{p = \frac{\sum{ab1_S}\mid{ab2_S}\mid{ab3_S}}{\sum{ab1_{R|I|S},ab2_{R|I|S},ab3_{R|I|S}}}}
+}
 }
 \examples{
+library(dplyr)
+
+septic_patients \%>\%
+  group_by(hospital_id) \%>\%
+  summarise(cipro_susceptibility = rsi(cipr, interpretation = "S"),
+            n = n_rsi(cipr)) # n_rsi works like n_distinct in dplyr
+
+septic_patients \%>\%
+  group_by(hospital_id) \%>\%
+  summarise(cipro_S = rsi(cipr, interpretation = "S",
+                          as_percent = TRUE, warning = FALSE),
+            cipro_n = n_rsi(cipr),
+            genta_S = rsi(gent, interpretation = "S",
+                          as_percent = TRUE, warning = FALSE),
+            genta_n = n_rsi(gent),
+            combination_S = rsi(cipr, gent, interpretation = "S",
+                                as_percent = TRUE, warning = FALSE),
+            combination_n = n_rsi(cipr, gent))
+
+# calculate resistance
+rsi(septic_patients$amox)
+# or susceptibility
+rsi(septic_patients$amox, interpretation = "S")
+
+# calculate co-resistance between amoxicillin/clav acid and gentamicin,
+# so we can review that combination therapy does a lot more than mono therapy:
+septic_patients \%>\% rsi_df(ab = "amcl", interpretation = "S") # = 67.8\%
+septic_patients \%>\% rsi_df(ab = "gent", interpretation = "S") # = 69.1\%
+septic_patients \%>\% rsi_df(ab = c("amcl", "gent"), interpretation = "S") # = 90.6\%
+
 \dontrun{
-tbl \%>\%
+# calculate current empiric combination therapy of Helicobacter gastritis:
-  group_by(hospital) \%>\%
+my_table \%>\%
-  summarise(cipr = rsi(cipr))
+  filter(first_isolate == TRUE,
-
+         genus == "Helicobacter") \%>\%
-tbl \%>\%
+  rsi_df(ab = c("amox", "metr")) # amoxicillin with metronidazole
-  group_by(year, hospital) \%>\%
-  summarise(
-    isolates = n(),
-    cipro = rsi(cipr \%>\% as.rsi(), percent = TRUE),
-    amoxi = rsi(amox \%>\% as.rsi(), percent = TRUE))
-
-rsi(as.rsi(isolates$amox))
-
-rsi(as.rsi(isolates$amcl), interpretation = "S")
 }
 }
 \keyword{antibiotics}

man/rsi_df.Rd

@@ -1,54 +0,0 @@
-% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/rsi_analysis.R
-\name{rsi_df}
-\alias{rsi_df}
-\title{Resistance of isolates in data.frame}
-\usage{
-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{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"}.}
-
-\item{minimum}{minimal amount of available isolates. Any number lower than \code{minimum} will return \code{NA} with a warning (when \code{warning = TRUE}).}
-
-\item{percent}{return output as percent (text), will else (at default) be a double}
-
-\item{info}{calculate the amount of available isolates and print it, like \code{n = 423}}
-
-\item{warning}{show a warning when the available amount of isolates is below \code{minimum}}
-}
-\value{
-Double or, when \code{percent = TRUE}, a character.
-}
-\description{
-\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.
-}
-\details{
-Remember that you should filter your table to let it contain \strong{only first isolates}!
-}
-\examples{
-\dontrun{
-rsi_df(tbl_with_bloodcultures, 'amcl')
-
-rsi_df(tbl_with_bloodcultures, c('amcl', 'gent'), interpretation = 'IR')
-
-library(dplyr)
-# calculate current empiric therapy of Helicobacter gastritis:
-my_table \%>\%
-  filter(first_isolate == TRUE,
-         genus == "Helicobacter") \%>\%
-  rsi_df(ab = c("amox", "metr"))
-}
-}
-\seealso{
-\code{\link{rsi}} for the function that can be used with \code{\link[dplyr]{summarise}} directly.
-}
-\keyword{antibiotics}
-\keyword{isolate}
-\keyword{isolates}
-\keyword{rsi}

tests/testthat/test-eucast.R

@@ -1,6 +1,8 @@
 context("eucast.R")
 
 test_that("EUCAST rules work", {
+  a <- EUCAST_rules(septic_patients)
+
   a <- data.frame(bactid = c("KLEPNE",  # Klebsiella pneumoniae
                              "PSEAER",  # Pseudomonas aeruginosa
                              "ENTAER"), # Enterobacter aerogenes

tests/testthat/test-rsi_analysis.R

@@ -29,6 +29,21 @@ test_that("rsi works", {
                       info = FALSE),
                0.9858,
                tolerance = 0.0001)
+
+  # count of cases
+  expect_equal(septic_patients %>%
+                 group_by(hospital_id) %>%
+                 summarise(cipro_S = rsi(cipr, interpretation = "S",
+                                         as_percent = TRUE, warning = FALSE),
+                           cipro_n = n_rsi(cipr),
+                           genta_S = rsi(gent, interpretation = "S",
+                                         as_percent = TRUE, warning = FALSE),
+                           genta_n = n_rsi(gent),
+                           combination_S = rsi(cipr, gent, interpretation = "S",
+                                               as_percent = TRUE, warning = FALSE),
+                           combination_n = n_rsi(cipr, gent)) %>%
+                 pull(combination_n),
+               c(138, 474, 170, 464, 183))
 })
 
 test_that("prediction of rsi works", {