mirror of https://github.com/msberends/AMR.git
Added function `n_rsi`
This commit is contained in:
parent
e5ae7b98ac
commit
c0fc82c794
|
|
@ -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(
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
2
NEWS.md
2
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
|
||||
|
|
|
|||
14
R/classes.R
14
R/classes.R
|
|
@ -93,12 +93,14 @@ 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')
|
||||
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 = "")
|
||||
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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
6
R/misc.R
6
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) {
|
||||
|
|
|
|||
10
R/print.R
10
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)
|
||||
|
|
@ -218,7 +220,11 @@ prettyprint_df <- function(x,
|
|||
gsub('POSIX', '', .) %>%
|
||||
paste0(collapse = '/'))
|
||||
} else {
|
||||
c[[1]]
|
||||
if (NCOL(.) > 1) {
|
||||
.[1,]
|
||||
} else {
|
||||
c[[1]]
|
||||
}
|
||||
}
|
||||
}) %>%
|
||||
unlist() %>%
|
||||
|
|
|
|||
244
R/rsi_analysis.R
244
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) {
|
||||
y <- percent(y)
|
||||
if (as_percent == TRUE) {
|
||||
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
|
||||
#' \dontrun{
|
||||
#' 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'
|
||||
}
|
||||
#' @rdname rsi
|
||||
n_rsi <- function(ab1, ab2 = NA) {
|
||||
|
||||
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)
|
||||
colnames(tbl) <- c(ab1.name, ab2.name)
|
||||
|
||||
if (length(ab2) == 1) {
|
||||
return(rsi_df(tbl = tbl,
|
||||
ab = ab1.name,
|
||||
interpretation = interpretation,
|
||||
minimum = minimum,
|
||||
percent = percent,
|
||||
info = info,
|
||||
warning = warning))
|
||||
if (length(ab2) == 1 & all(is.na(ab2))) {
|
||||
# only 1 antibiotic
|
||||
length(ab1[!is.na(ab1)])
|
||||
} else {
|
||||
if (length(ab1) != length(ab2)) {
|
||||
stop('`ab1` (n = ', length(ab1), ') and `ab2` (n = ', length(ab2), ') must be of same length.', call. = FALSE)
|
||||
if (length(ab2) == 1 & is.character(ab2)) {
|
||||
stop('`ab2` must be a vector of antibiotic interpretations.',
|
||||
'\n Try n_rsi(', ab2, ', ...) instead of n_rsi("', ab2, '", ...)', call. = FALSE)
|
||||
}
|
||||
if (interpretation != 'S') {
|
||||
warning('`interpretation` is not set to S, albeit analysing a combination therapy.')
|
||||
}
|
||||
return(rsi_df(tbl = tbl,
|
||||
ab = c(ab1.name, ab2.name),
|
||||
interpretation = interpretation,
|
||||
minimum = minimum,
|
||||
percent = percent,
|
||||
info = info,
|
||||
warning = warning))
|
||||
ab2 <- as.rsi(ab2)
|
||||
tbl <- tibble(ab1, ab2)
|
||||
tbl %>% filter(!is.na(ab1) & !is.na(ab2)) %>% nrow()
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
#' Predict antimicrobial resistance
|
||||
|
|
|
|||
11
README.md
11
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
|
||||
```
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
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 |
99
man/rsi.Rd
99
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,
|
||||
info = FALSE, warning = FALSE)
|
||||
rsi(ab1, ab2 = NA, interpretation = "IR", minimum = 30,
|
||||
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 \%>\%
|
||||
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")
|
||||
# calculate current empiric combination therapy of Helicobacter gastritis:
|
||||
my_table \%>\%
|
||||
filter(first_isolate == TRUE,
|
||||
genus == "Helicobacter") \%>\%
|
||||
rsi_df(ab = c("amox", "metr")) # amoxicillin with metronidazole
|
||||
}
|
||||
}
|
||||
\keyword{antibiotics}
|
||||
|
|
|
|||
|
|
@ -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}
|
||||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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", {
|
||||
|
|
|
|||
Loading…
Reference in New Issue