1
0
mirror of https://github.com/msberends/AMR.git synced 2024-12-25 18:06:12 +01:00

Added function n_rsi

This commit is contained in:
dr. M.S. (Matthijs) Berends 2018-05-02 14:56:25 +02:00
parent e5ae7b98ac
commit c0fc82c794
17 changed files with 292 additions and 171 deletions

View File

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

View File

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

View File

@ -2,6 +2,7 @@
#### New #### New
* Full support for Windows, Linux and macOS * 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) * 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_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 `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 * 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 * New print format for `tibble`s and `data.table`s
#### Changed #### Changed
* Fixed `rsi` class for vectors that contain only invalid antimicrobial interpretations
* Renamed dataset `ablist` to `antibiotics` * Renamed dataset `ablist` to `antibiotics`
* Renamed dataset `bactlist` to `microorganisms` * Renamed dataset `bactlist` to `microorganisms`
* Added common abbreviations and trade names to the `antibiotics` dataset * Added common abbreviations and trade names to the `antibiotics` dataset

View File

@ -93,12 +93,14 @@ print.rsi <- function(x, ...) {
R <- x[x == 'R'] %>% length() R <- x[x == 'R'] %>% length()
IR <- x[x %in% c('I', 'R')] %>% length() IR <- x[x %in% c('I', 'R')] %>% length()
cat("Class 'rsi'\n") 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 = "")
cat('\n') if (n > 0) {
cat('Sum of S: ', S, ' (', percent(S / n, force_zero = TRUE), ')\n', sep = "") cat('\n')
cat('Sum of IR: ', IR, ' (', percent(IR / n, force_zero = TRUE), ')\n', sep = "") cat('Sum of S: ', S, ' (', percent(S / n, force_zero = TRUE), ')\n', sep = "")
cat('- Sum of R: ', R, ' (', percent(R / n, force_zero = TRUE), ')\n', sep = "") cat('Sum of IR: ', IR, ' (', percent(IR / n, force_zero = TRUE), ')\n', sep = "")
cat('- Sum of I: ', I, ' (', percent(I / 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 #' @exportMethod summary.rsi

View File

@ -36,6 +36,7 @@
#' EUCAST Expert Rules Version 3.1 (Intrinsic Resistance and Exceptional Phenotypes Tables): \cr #' 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} #' \url{http://www.eucast.org/fileadmin/src/media/PDFs/EUCAST_files/Expert_Rules/Expert_rules_intrinsic_exceptional_V3.1.pdf}
#' @examples #' @examples
#' a <- EUCAST_rules(septic_patients)
#' a <- data.frame(bactid = c("STAAUR", # Staphylococcus aureus #' a <- data.frame(bactid = c("STAAUR", # Staphylococcus aureus
#' "ENCFAE", # Enterococcus faecalis #' "ENCFAE", # Enterococcus faecalis
#' "ESCCOL", # Escherichia coli #' "ESCCOL", # Escherichia coli

View File

@ -48,10 +48,12 @@
# No export, no Rd # No export, no Rd
percent <- function(x, round = 1, force_zero = FALSE, ...) { percent <- function(x, round = 1, force_zero = FALSE, ...) {
val <- base::round(x * 100, digits = round) 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)) 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) { check_available_columns <- function(tbl, col.list, info = TRUE) {

View File

@ -29,6 +29,7 @@
#' @name print #' @name print
#' @importFrom dplyr %>% n_groups group_vars group_size filter pull select #' @importFrom dplyr %>% n_groups group_vars group_size filter pull select
#' @importFrom data.table data.table #' @importFrom data.table data.table
#' @importFrom utils object.size
#' @exportMethod print.tbl_df #' @exportMethod print.tbl_df
#' @export #' @export
#' @examples #' @examples
@ -191,7 +192,8 @@ prettyprint_df <- function(x,
if (n + 1 < nrow(x)) { if (n + 1 < nrow(x)) {
# remove in between part, 1 extra for ~~~~ between first and last part # 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)) 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] rownames(x) <- rownames(x.bak)[rows_list]
# set inbetweener between parts # set inbetweener between parts
rownames(x)[n / 2 + 1] <- strrep("~", maxrowchars) rownames(x)[n / 2 + 1] <- strrep("~", maxrowchars)
@ -218,7 +220,11 @@ prettyprint_df <- function(x,
gsub('POSIX', '', .) %>% gsub('POSIX', '', .) %>%
paste0(collapse = '/')) paste0(collapse = '/'))
} else { } else {
c[[1]] if (NCOL(.) > 1) {
.[1,]
} else {
c[[1]]
}
} }
}) %>% }) %>%
unlist() %>% unlist() %>%

View File

@ -16,40 +16,164 @@
# GNU General Public License for more details. # # 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 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 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 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 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 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} #' @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}! #' @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 #' @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 #' @export
#' @importFrom dplyr %>% n_distinct filter filter_at pull vars all_vars any_vars #' @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 #' @examples
#' \dontrun{
#' rsi_df(tbl_with_bloodcultures, 'amcl')
#'
#' rsi_df(tbl_with_bloodcultures, c('amcl', 'gent'), interpretation = 'IR')
#'
#' library(dplyr) #' 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 %>% #' my_table %>%
#' filter(first_isolate == TRUE, #' filter(first_isolate == TRUE,
#' genus == "Helicobacter") %>% #' 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, rsi_df <- function(tbl,
ab, ab,
interpretation = 'IR', interpretation = 'IR',
minimum = 30, minimum = 30,
percent = FALSE, as_percent = FALSE,
info = TRUE, info = TRUE,
warning = TRUE) { warning = TRUE) {
@ -103,6 +227,9 @@ rsi_df <- function(tbl,
nrow() nrow()
} else if (length(ab) == 2) { } 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 %>% numerator <- tbl %>%
filter_at(vars(ab[1], ab[2]), filter_at(vars(ab[1], ab[2]),
any_vars(. == interpretations_to_check)) %>% any_vars(. == interpretations_to_check)) %>%
@ -116,6 +243,9 @@ rsi_df <- function(tbl,
nrow() nrow()
} else if (length(ab) == 3) { } 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 %>% numerator <- tbl %>%
filter_at(vars(ab[1], ab[2], ab[3]), filter_at(vars(ab[1], ab[2], ab[3]),
any_vars(. == interpretations_to_check)) %>% any_vars(. == interpretations_to_check)) %>%
@ -150,9 +280,10 @@ rsi_df <- function(tbl,
# calculate and format # calculate and format
y <- numerator / denominator y <- numerator / denominator
if (percent == TRUE) { if (as_percent == TRUE) {
y <- percent(y) y <- percent(y, force_zero = TRUE)
} }
if (denominator < minimum) { if (denominator < minimum) {
if (warning == TRUE) { if (warning == TRUE) {
warning(paste0('TOO FEW ISOLATES OF ', toString(ab), ' (n = ', denominator, ', n < ', minimum, '); NO RESULT.')) warning(paste0('TOO FEW ISOLATES OF ', toString(ab), ' (n = ', denominator, ', n < ', minimum, '); NO RESULT.'))
@ -164,78 +295,29 @@ rsi_df <- function(tbl,
y 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 #' @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 { } 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 #' Predict antimicrobial resistance

View File

@ -10,7 +10,7 @@ This R package contains functions to make **microbiological, epidemiological dat
With `AMR` you can also: With `AMR` you can also:
* Create frequency tables with the `freq` function * 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 * 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 * 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 * 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 ### Databases included in package
Datasets to work with antibiotics and bacteria properties. Datasets to work with antibiotics and bacteria properties.
```r ```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 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 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 microorganisms # A tibble: 2,453 x 12
``` ```

View File

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

Binary file not shown.

After

Width:  |  Height:  |  Size: 3.0 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 3.6 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.8 KiB

View File

@ -2,49 +2,106 @@
% Please edit documentation in R/rsi_analysis.R % Please edit documentation in R/rsi_analysis.R
\name{rsi} \name{rsi}
\alias{rsi} \alias{rsi}
\alias{rsi_df}
\alias{n_rsi}
\title{Resistance of isolates} \title{Resistance of isolates}
\usage{ \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{ \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{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{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{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{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{ \value{
Double or, when \code{percent = TRUE}, a character. Double or, when \code{as_percent = TRUE}, a character.
} }
\description{ \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{ \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{ \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{ \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} \keyword{antibiotics}

View File

@ -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}

View File

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

View File

@ -29,6 +29,21 @@ test_that("rsi works", {
info = FALSE), info = FALSE),
0.9858, 0.9858,
tolerance = 0.0001) 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", { test_that("prediction of rsi works", {