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

quasiquotation, alpha for geom_rsi

This commit is contained in:
dr. M.S. (Matthijs) Berends 2018-08-23 00:40:36 +02:00
parent 43ba16f8ed
commit da5379c881
18 changed files with 304 additions and 235 deletions

View File

@ -1,6 +1,6 @@
Package: AMR Package: AMR
Version: 0.3.0.9001 Version: 0.3.0.9002
Date: 2018-08-21 Date: 2018-08-23
Title: Antimicrobial Resistance Analysis Title: Antimicrobial Resistance Analysis
Authors@R: c( Authors@R: c(
person( person(
@ -52,8 +52,8 @@ Imports:
xml2 (>= 1.0.0), xml2 (>= 1.0.0),
knitr (>= 1.0.0), knitr (>= 1.0.0),
readr, readr,
rvest (>= 0.3.2), rlang,
tibble rvest (>= 0.3.2)
Suggests: Suggests:
testthat (>= 1.0.2), testthat (>= 1.0.2),
covr (>= 3.0.1), covr (>= 3.0.1),

View File

@ -127,6 +127,7 @@ importFrom(dplyr,arrange)
importFrom(dplyr,arrange_at) importFrom(dplyr,arrange_at)
importFrom(dplyr,as_tibble) importFrom(dplyr,as_tibble)
importFrom(dplyr,between) importFrom(dplyr,between)
importFrom(dplyr,bind_cols)
importFrom(dplyr,bind_rows) importFrom(dplyr,bind_rows)
importFrom(dplyr,case_when) importFrom(dplyr,case_when)
importFrom(dplyr,desc) importFrom(dplyr,desc)
@ -171,7 +172,6 @@ importFrom(stats,mad)
importFrom(stats,pchisq) importFrom(stats,pchisq)
importFrom(stats,predict) importFrom(stats,predict)
importFrom(stats,sd) importFrom(stats,sd)
importFrom(tibble,tibble)
importFrom(utils,View) importFrom(utils,View)
importFrom(utils,browseVignettes) importFrom(utils,browseVignettes)
importFrom(utils,installed.packages) importFrom(utils,installed.packages)

10
NEWS.md
View File

@ -1,13 +1,19 @@
# 0.3.0.90xx (latest development version) # 0.3.0.90xx (latest development version)
#### New #### New
* Functions `count_R`, `count_IR`, `count_I`, `count_SI` and `count_S` to selectively count resistant or susceptibile isolates * Functions `count_R`, `count_IR`, `count_I`, `count_SI` and `count_S` to selectively count resistant or susceptible isolates
* Function `is.rsi.eligible` to check for columns that have valid antimicrobial results, but do not have the `rsi` class yet. Transform the columns of your raw data with: `data %>% mutate_if(is.rsi.eligible, as.rsi)` * Function `is.rsi.eligible` to check for columns that have valid antimicrobial results, but do not have the `rsi` class yet. Transform the columns of your raw data with: `data %>% mutate_if(is.rsi.eligible, as.rsi)`
#### Changed #### Changed
* Added parameters `minimum` and `as_percent` to `portion_df` * Added parameters `minimum` and `as_percent` to `portion_df`
* Support for quasiquotation in the functions series `count_*` and `portions_*`, and `n_rsi`. This allow to check for more than 2 vectors or columns.
* `septic_patients %>% select(amox, cipr) %>% count_R()`
* `septic_patients %>% portion_S(amcl)`
* `septic_patients %>% portion_S(amcl, gent)`
* `septic_patients %>% portion_S(amcl, gent, pita)`
* Edited `ggplot_rsi` and `geom_rsi` so they can cope with `count_df`. The new `fun` parameter has value `portion_df` at default, but can be set to `count_df`. * Edited `ggplot_rsi` and `geom_rsi` so they can cope with `count_df`. The new `fun` parameter has value `portion_df` at default, but can be set to `count_df`.
* Fix for `ggplot_rsi` when the `ggplot2` was not loaded * Fix for `ggplot_rsi` when the `ggplot2` package was not loaded
* Added parameter `alpha` to `ggplot_rsi` and `geom_rsi`
# 0.3.0 (latest stable version) # 0.3.0 (latest stable version)
**Published on CRAN: 2018-08-14** **Published on CRAN: 2018-08-14**

View File

@ -18,7 +18,7 @@
#' Count isolates #' Count isolates
#' #'
#' @description These functions can be used to count resistant/susceptible microbial isolates. All functions can be used in \code{dplyr}s \code{\link[dplyr]{summarise}} and support grouped variables, see \emph{Examples}. #' @description These functions can be used to count resistant/susceptible microbial isolates. All functions support quasiquotation with pipes, can be used in \code{dplyr}s \code{\link[dplyr]{summarise}} and support grouped variables, see \emph{Examples}.
#' #'
#' \code{count_R} and \code{count_IR} can be used to count resistant isolates, \code{count_S} and \code{count_SI} can be used to count susceptible isolates.\cr #' \code{count_R} and \code{count_IR} can be used to count resistant isolates, \code{count_S} and \code{count_SI} can be used to count susceptible isolates.\cr
#' @inheritParams portion #' @inheritParams portion
@ -87,11 +87,9 @@
#' group_by(hospital_id) %>% #' group_by(hospital_id) %>%
#' count_df(translate = FALSE) #' count_df(translate = FALSE)
#' #'
count_R <- function(ab1, count_R <- function(...) {
ab2 = NULL) { rsi_calc(...,
rsi_calc(type = "R", type = "R",
ab1 = ab1,
ab2 = ab2,
include_I = FALSE, include_I = FALSE,
minimum = 0, minimum = 0,
as_percent = FALSE, as_percent = FALSE,
@ -100,11 +98,9 @@ count_R <- function(ab1,
#' @rdname count #' @rdname count
#' @export #' @export
count_IR <- function(ab1, count_IR <- function(...) {
ab2 = NULL) { rsi_calc(...,
rsi_calc(type = "R", type = "R",
ab1 = ab1,
ab2 = ab2,
include_I = TRUE, include_I = TRUE,
minimum = 0, minimum = 0,
as_percent = FALSE, as_percent = FALSE,
@ -113,10 +109,9 @@ count_IR <- function(ab1,
#' @rdname count #' @rdname count
#' @export #' @export
count_I <- function(ab1) { count_I <- function(...) {
rsi_calc(type = "I", rsi_calc(...,
ab1 = ab1, type = "I",
ab2 = NULL,
include_I = FALSE, include_I = FALSE,
minimum = 0, minimum = 0,
as_percent = FALSE, as_percent = FALSE,
@ -125,11 +120,9 @@ count_I <- function(ab1) {
#' @rdname count #' @rdname count
#' @export #' @export
count_SI <- function(ab1, count_SI <- function(...) {
ab2 = NULL) { rsi_calc(...,
rsi_calc(type = "S", type = "S",
ab1 = ab1,
ab2 = ab2,
include_I = TRUE, include_I = TRUE,
minimum = 0, minimum = 0,
as_percent = FALSE, as_percent = FALSE,
@ -138,11 +131,9 @@ count_SI <- function(ab1,
#' @rdname count #' @rdname count
#' @export #' @export
count_S <- function(ab1, count_S <- function(...) {
ab2 = NULL) { rsi_calc(...,
rsi_calc(type = "S", type = "S",
ab1 = ab1,
ab2 = ab2,
include_I = FALSE, include_I = FALSE,
minimum = 0, minimum = 0,
as_percent = FALSE, as_percent = FALSE,

View File

@ -55,9 +55,8 @@
#' The function \code{top_freq} uses \code{\link[dplyr]{top_n}} internally and will include more than \code{n} rows if there are ties. #' The function \code{top_freq} uses \code{\link[dplyr]{top_n}} internally and will include more than \code{n} rows if there are ties.
#' @importFrom stats fivenum sd mad #' @importFrom stats fivenum sd mad
#' @importFrom grDevices boxplot.stats #' @importFrom grDevices boxplot.stats
#' @importFrom dplyr %>% select pull n_distinct group_by arrange desc mutate summarise n_distinct #' @importFrom dplyr %>% select pull n_distinct group_by arrange desc mutate summarise n_distinct tibble
#' @importFrom utils browseVignettes installed.packages #' @importFrom utils browseVignettes installed.packages
#' @importFrom tibble tibble
#' @keywords summary summarise frequency freq #' @keywords summary summarise frequency freq
#' @rdname freq #' @rdname freq
#' @name freq #' @name freq
@ -378,12 +377,12 @@ frequency_tbl <- function(x,
column_names_df <- c('item', 'count', 'percent', 'cum_count', 'cum_percent', 'factor_level') column_names_df <- c('item', 'count', 'percent', 'cum_count', 'cum_percent', 'factor_level')
if (any(class(x) == 'factor')) { if (any(class(x) == 'factor')) {
df <- tibble::tibble(item = x, df <- tibble(item = x,
fctlvl = x %>% as.integer()) %>% fctlvl = x %>% as.integer()) %>%
group_by(item, fctlvl) group_by(item, fctlvl)
column_align <- c('l', 'r', 'r', 'r', 'r', 'r') column_align <- c('l', 'r', 'r', 'r', 'r', 'r')
} else { } else {
df <- tibble::tibble(item = x) %>% df <- tibble(item = x) %>%
group_by(item) group_by(item)
# strip factor lvl from col names # strip factor lvl from col names
column_names <- column_names[1:length(column_names) - 1] column_names <- column_names[1:length(column_names) - 1]

View File

@ -25,6 +25,7 @@
#' @param fill variable to categorise using the plots legend, either \code{"Antibiotic"} (default) or \code{"Interpretation"} or a grouping variable #' @param fill variable to categorise using the plots legend, either \code{"Antibiotic"} (default) or \code{"Interpretation"} or a grouping variable
#' @param facet variable to split plots by, either \code{"Interpretation"} (default) or \code{"Antibiotic"} or a grouping variable #' @param facet variable to split plots by, either \code{"Interpretation"} (default) or \code{"Antibiotic"} or a grouping variable
#' @param translate_ab a column name of the \code{\link{antibiotics}} data set to translate the antibiotic abbreviations into, using \code{\link{abname}}. Default behaviour is to translate to official names according to the WHO. Use \code{translate_ab = FALSE} to disable translation. #' @param translate_ab a column name of the \code{\link{antibiotics}} data set to translate the antibiotic abbreviations into, using \code{\link{abname}}. Default behaviour is to translate to official names according to the WHO. Use \code{translate_ab = FALSE} to disable translation.
#' @param alpha opacity of the fill colours
#' @param fun function to transform \code{data}, either \code{\link{portion_df}} (default) or \code{\link{count_df}} #' @param fun function to transform \code{data}, either \code{\link{portion_df}} (default) or \code{\link{count_df}}
#' @param ... other parameters passed on to \code{\link[ggplot2]{facet_wrap}} #' @param ... other parameters passed on to \code{\link[ggplot2]{facet_wrap}}
#' @details At default, the names of antibiotics will be shown on the plots using \code{\link{abname}}. This can be set with the option \code{get_antibiotic_names} (a logical value), so change it e.g. to \code{FALSE} with \code{options(get_antibiotic_names = FALSE)}. #' @details At default, the names of antibiotics will be shown on the plots using \code{\link{abname}}. This can be set with the option \code{get_antibiotic_names} (a logical value), so change it e.g. to \code{FALSE} with \code{options(get_antibiotic_names = FALSE)}.
@ -113,6 +114,7 @@ ggplot_rsi <- function(data,
fill = "Interpretation", fill = "Interpretation",
facet = NULL, facet = NULL,
translate_ab = "official", translate_ab = "official",
alpha = 1,
fun = portion_df, fun = portion_df,
...) { ...) {
@ -126,7 +128,7 @@ ggplot_rsi <- function(data,
} }
p <- ggplot2::ggplot(data = data) + p <- ggplot2::ggplot(data = data) +
geom_rsi(position = position, x = x, fill = fill, translate_ab = translate_ab, fun = fun) + geom_rsi(position = position, x = x, fill = fill, translate_ab = translate_ab, alpha = alpha, fun = fun) +
theme_rsi() theme_rsi()
if (fill == "Interpretation") { if (fill == "Interpretation") {
@ -151,6 +153,7 @@ geom_rsi <- function(position = NULL,
x = c("Antibiotic", "Interpretation"), x = c("Antibiotic", "Interpretation"),
fill = "Interpretation", fill = "Interpretation",
translate_ab = "official", translate_ab = "official",
alpha = 1,
fun = portion_df) { fun = portion_df) {
fun_name <- deparse(substitute(fun)) fun_name <- deparse(substitute(fun))
@ -180,7 +183,7 @@ geom_rsi <- function(position = NULL,
ggplot2::layer(geom = "bar", stat = "identity", position = position, ggplot2::layer(geom = "bar", stat = "identity", position = position,
mapping = ggplot2::aes_string(x = x, y = y, fill = fill), mapping = ggplot2::aes_string(x = x, y = y, fill = fill),
data = fun, params = list()) data = fun, params = list(alpha = alpha))
} }

View File

@ -18,10 +18,11 @@
#' Count cases with antimicrobial results #' Count cases with antimicrobial results
#' #'
#' This counts all cases where antimicrobial interpretations are available. Its use is equal to \code{\link{n_distinct}}. #' This counts all cases where antimicrobial interpretations are available. The way it can be used is equal to \code{\link{n_distinct}}. Its function is equal to \code{count_S(...) + count_IR(...)}.
#' @param ab1,ab2 vector of antibiotic interpretations, they will be transformed internally with \code{\link{as.rsi}} if needed #' @inheritParams portion
#' @export #' @export
#' @seealso The \code{\link{portion}} functions to calculate resistance and susceptibility. #' @seealso \code{\link[AMR]{count}_*} to count resistant and susceptibile isolates per interpretation type.\cr
#' \code{\link{portion}_*} to calculate microbial resistance and susceptibility.
#' @examples #' @examples
#' library(dplyr) #' library(dplyr)
#' #'
@ -33,22 +34,7 @@
#' genta_n = n_rsi(gent), #' genta_n = n_rsi(gent),
#' combination_p = portion_S(cipr, gent, as_percent = TRUE), #' combination_p = portion_S(cipr, gent, as_percent = TRUE),
#' combination_n = n_rsi(cipr, gent)) #' combination_n = n_rsi(cipr, gent))
n_rsi <- function(ab1, ab2 = NULL) { n_rsi <- function(...) {
if (NCOL(ab1) > 1) { # only print warnings once, if needed
stop('`ab1` must be a vector of antimicrobial interpretations', call. = FALSE) count_S(...) + suppressWarnings(count_IR(...))
}
if (!is.rsi(ab1)) {
ab1 <- as.rsi(ab1)
}
if (!is.null(ab2)) {
if (NCOL(ab2) > 1) {
stop('`ab2` must be a vector of antimicrobial interpretations', call. = FALSE)
}
if (!is.rsi(ab2)) {
ab2 <- as.rsi(ab2)
}
sum(!is.na(ab1) & !is.na(ab2))
} else {
sum(!is.na(ab1))
}
} }

View File

@ -18,11 +18,10 @@
#' Calculate resistance of isolates #' Calculate resistance of isolates
#' #'
#' @description These functions can be used to calculate the (co-)resistance of microbial isolates (i.e. percentage S, SI, I, IR or R). All functions can be used in \code{dplyr}s \code{\link[dplyr]{summarise}} and support grouped variables, see \emph{Examples}. #' @description These functions can be used to calculate the (co-)resistance of microbial isolates (i.e. percentage S, SI, I, IR or R). All functions support quasiquotation with pipes, can be used in \code{dplyr}s \code{\link[dplyr]{summarise}} and support grouped variables, see \emph{Examples}.
#' #'
#' \code{portion_R} and \code{portion_IR} can be used to calculate resistance, \code{portion_S} and \code{portion_SI} can be used to calculate susceptibility.\cr #' \code{portion_R} and \code{portion_IR} can be used to calculate resistance, \code{portion_S} and \code{portion_SI} can be used to calculate susceptibility.\cr
#' @param ab1 vector of antibiotic interpretations, they will be transformed internally with \code{\link{as.rsi}} if needed #' @param ... one or more vectors (or columns) with antibiotic interpretations. They will be transformed internally with \code{\link{as.rsi}} if needed. Use multiple columns to calculate (the lack of) co-resistance: the probability where one of two drugs have a resistant or susceptible result. See Examples.
#' @param ab2 like \code{ab}, a vector of antibiotic interpretations. Use this to calculate (the lack of) co-resistance: the probability where one of two drugs have a resistant or susceptible result. See Examples.
#' @param minimum minimal amount of available isolates. Any number lower than \code{minimum} will return \code{NA}. The default number of \code{30} isolates is advised by the CLSI as best practice, see Source. #' @param minimum minimal amount of available isolates. Any number lower than \code{minimum} will return \code{NA}. The default number of \code{30} isolates is advised by the CLSI as best practice, see Source.
#' @param as_percent logical to indicate whether the output must be returned as a hundred fold with \% sign (a character). A value of \code{0.123456} will then be returned as \code{"12.3\%"}. #' @param as_percent logical to indicate whether the output must be returned as a hundred fold with \% sign (a character). A value of \code{0.123456} will then be returned as \code{"12.3\%"}.
#' @param data a \code{data.frame} containing columns with class \code{rsi} (see \code{\link{as.rsi}}) #' @param data a \code{data.frame} containing columns with class \code{rsi} (see \code{\link{as.rsi}})
@ -43,8 +42,10 @@
#' For two antibiotics: #' For two antibiotics:
#' \out{<div style="text-align: center">}\figure{combi_therapy_2.png}\out{</div>} #' \out{<div style="text-align: center">}\figure{combi_therapy_2.png}\out{</div>}
#' \cr #' \cr
#' Theoretically for three antibiotics: #' For three antibiotics:
#' \out{<div style="text-align: center">}\figure{combi_therapy_3.png}\out{</div>} #' \out{<div style="text-align: center">}\figure{combi_therapy_3.png}\out{</div>}
#' \cr
#' And so on.
#' } #' }
#' @source \strong{M39 Analysis and Presentation of Cumulative Antimicrobial Susceptibility Test Data, 4th Edition}, 2014, \emph{Clinical and Laboratory Standards Institute (CLSI)}. \url{https://clsi.org/standards/products/microbiology/documents/m39/}. #' @source \strong{M39 Analysis and Presentation of Cumulative Antimicrobial Susceptibility Test Data, 4th Edition}, 2014, \emph{Clinical and Laboratory Standards Institute (CLSI)}. \url{https://clsi.org/standards/products/microbiology/documents/m39/}.
#' #'
@ -68,11 +69,14 @@
#' portion_S(septic_patients$amox) #' portion_S(septic_patients$amox)
#' portion_SI(septic_patients$amox) #' portion_SI(septic_patients$amox)
#' #'
#' # Since n_rsi counts available isolates (and is used as denominator),
#' # you can calculate back to count e.g. non-susceptible isolates: #' # Do the above with pipes:
#' portion_IR(septic_patients$amox) * n_rsi(septic_patients$amox)
#'
#' library(dplyr) #' library(dplyr)
#' septic_patients %>% portion_R(amox)
#' septic_patients %>% portion_IR(amox)
#' septic_patients %>% portion_S(amox)
#' septic_patients %>% portion_SI(amox)
#'
#' septic_patients %>% #' septic_patients %>%
#' group_by(hospital_id) %>% #' group_by(hospital_id) %>%
#' summarise(p = portion_S(cipr), #' summarise(p = portion_S(cipr),
@ -88,16 +92,15 @@
#' #'
#' # Calculate co-resistance between amoxicillin/clav acid and gentamicin, #' # Calculate co-resistance between amoxicillin/clav acid and gentamicin,
#' # so we can see that combination therapy does a lot more than mono therapy: #' # so we can see that combination therapy does a lot more than mono therapy:
#' portion_S(septic_patients$amcl) # S = 67.3% #' septic_patients %>% portion_S(amcl) # S = 67.3%
#' n_rsi(septic_patients$amcl) # n = 1570 #' septic_patients %>% n_rsi(amcl) # n = 1570
#' #'
#' portion_S(septic_patients$gent) # S = 74.0% #' septic_patients %>% portion_S(gent) # S = 74.0%
#' n_rsi(septic_patients$gent) # n = 1842 #' septic_patients %>% n_rsi(gent) # n = 1842
#'
#' septic_patients %>% portion_S(amcl, gent) # S = 92.1%
#' septic_patients %>% n_rsi(amcl, gent) # n = 1504
#' #'
#' with(septic_patients,
#' portion_S(amcl, gent)) # S = 92.1%
#' with(septic_patients, # n = 1504
#' n_rsi(amcl, gent))
#' #'
#' septic_patients %>% #' septic_patients %>%
#' group_by(hospital_id) %>% #' group_by(hospital_id) %>%
@ -129,13 +132,11 @@
#' summarise(p = portion_S(amox, metr), # amoxicillin with metronidazole #' summarise(p = portion_S(amox, metr), # amoxicillin with metronidazole
#' n = n_rsi(amox, metr)) #' n = n_rsi(amox, metr))
#' } #' }
portion_R <- function(ab1, portion_R <- function(...,
ab2 = NULL,
minimum = 30, minimum = 30,
as_percent = FALSE) { as_percent = FALSE) {
rsi_calc(type = "R", rsi_calc(...,
ab1 = ab1, type = "R",
ab2 = ab2,
include_I = FALSE, include_I = FALSE,
minimum = minimum, minimum = minimum,
as_percent = as_percent, as_percent = as_percent,
@ -144,13 +145,11 @@ portion_R <- function(ab1,
#' @rdname portion #' @rdname portion
#' @export #' @export
portion_IR <- function(ab1, portion_IR <- function(...,
ab2 = NULL,
minimum = 30, minimum = 30,
as_percent = FALSE) { as_percent = FALSE) {
rsi_calc(type = "R", rsi_calc(...,
ab1 = ab1, type = "R",
ab2 = ab2,
include_I = TRUE, include_I = TRUE,
minimum = minimum, minimum = minimum,
as_percent = as_percent, as_percent = as_percent,
@ -159,12 +158,11 @@ portion_IR <- function(ab1,
#' @rdname portion #' @rdname portion
#' @export #' @export
portion_I <- function(ab1, portion_I <- function(...,
minimum = 30, minimum = 30,
as_percent = FALSE) { as_percent = FALSE) {
rsi_calc(type = "I", rsi_calc(...,
ab1 = ab1, type = "I",
ab2 = NULL,
include_I = FALSE, include_I = FALSE,
minimum = minimum, minimum = minimum,
as_percent = as_percent, as_percent = as_percent,
@ -173,13 +171,11 @@ portion_I <- function(ab1,
#' @rdname portion #' @rdname portion
#' @export #' @export
portion_SI <- function(ab1, portion_SI <- function(...,
ab2 = NULL,
minimum = 30, minimum = 30,
as_percent = FALSE) { as_percent = FALSE) {
rsi_calc(type = "S", rsi_calc(...,
ab1 = ab1, type = "S",
ab2 = ab2,
include_I = TRUE, include_I = TRUE,
minimum = minimum, minimum = minimum,
as_percent = as_percent, as_percent = as_percent,
@ -188,13 +184,11 @@ portion_SI <- function(ab1,
#' @rdname portion #' @rdname portion
#' @export #' @export
portion_S <- function(ab1, portion_S <- function(...,
ab2 = NULL,
minimum = 30, minimum = 30,
as_percent = FALSE) { as_percent = FALSE) {
rsi_calc(type = "S", rsi_calc(...,
ab1 = ab1, type = "S",
ab2 = ab2,
include_I = FALSE, include_I = FALSE,
minimum = minimum, minimum = minimum,
as_percent = as_percent, as_percent = as_percent,
@ -257,77 +251,3 @@ portion_df <- function(data,
res res
} }
rsi_calc <- function(type,
ab1,
ab2,
include_I,
minimum,
as_percent,
only_count) {
if (NCOL(ab1) > 1) {
stop('`ab1` must be a vector of antimicrobial interpretations', call. = FALSE)
}
if (!is.logical(include_I)) {
stop('`include_I` must be logical', call. = FALSE)
}
if (!is.numeric(minimum)) {
stop('`minimum` must be numeric', call. = FALSE)
}
if (!is.logical(as_percent)) {
stop('`as_percent` must be logical', call. = FALSE)
}
print_warning <- FALSE
if (!is.rsi(ab1)) {
ab1 <- as.rsi(ab1)
print_warning <- TRUE
}
if (!is.null(ab2)) {
# ab_name <- paste(deparse(substitute(ab1)), "and", deparse(substitute(ab2)))
if (NCOL(ab2) > 1) {
stop('`ab2` must be a vector of antimicrobial interpretations', call. = FALSE)
}
if (!is.rsi(ab2)) {
ab2 <- as.rsi(ab2)
print_warning <- TRUE
}
x <- apply(X = data.frame(ab1 = as.integer(ab1),
ab2 = as.integer(ab2)),
MARGIN = 1,
FUN = min)
} else {
x <- ab1
# ab_name <- deparse(substitute(ab1))
}
if (print_warning == TRUE) {
warning("Increase speed by transforming to class `rsi` on beforehand: df %>% mutate_at(vars(col10:col20), as.rsi)")
}
if (type == "S") {
found <- sum(as.integer(x) <= 1 + include_I, na.rm = TRUE)
} else if (type == "I") {
found <- sum(as.integer(x) == 2, na.rm = TRUE)
} else if (type == "R") {
found <- sum(as.integer(x) >= 3 - include_I, na.rm = TRUE)
} else {
stop("invalid type")
}
if (only_count == TRUE) {
return(found)
}
total <- length(x) - sum(is.na(x))
if (total < minimum) {
return(NA)
}
if (as_percent == TRUE) {
percent(found / total, force_zero = TRUE)
} else {
found / total
}
}

20
R/rsi.R
View File

@ -20,9 +20,10 @@
#' #'
#' This function is deprecated. Use the \code{\link{portion}} functions instead. #' This function is deprecated. Use the \code{\link{portion}} functions instead.
#' @inheritParams portion #' @inheritParams portion
#' @param ab1,ab2 vector (or column) with antibiotic interpretations. It will be transformed internally with \code{\link{as.rsi}} if needed.
#' @param interpretation antimicrobial interpretation to check for #' @param interpretation antimicrobial interpretation to check for
#' @param ... deprecated parameters to support usage on older versions #' @param ... deprecated parameters to support usage on older versions
#' @importFrom dplyr case_when #' @importFrom dplyr tibble case_when
#' @export #' @export
rsi <- function(ab1, rsi <- function(ab1,
ab2 = NULL, ab2 = NULL,
@ -31,12 +32,19 @@ rsi <- function(ab1,
as_percent = FALSE, as_percent = FALSE,
...) { ...) {
if (all(is.null(ab2))) {
df <- tibble(ab1 = ab1)
} else {
df <- tibble(ab1 = ab1,
ab2 = ab2)
}
result <- case_when( result <- case_when(
interpretation == "S" ~ portion_S(ab1 = ab1, ab2 = ab2, minimum = minimum, as_percent = FALSE), interpretation == "S" ~ portion_S(df, minimum = minimum, as_percent = FALSE),
interpretation %in% c("SI", "IS") ~ portion_SI(ab1 = ab1, ab2 = ab2, minimum = minimum, as_percent = FALSE), interpretation %in% c("SI", "IS") ~ portion_SI(df, minimum = minimum, as_percent = FALSE),
interpretation == "I" ~ portion_I(ab1 = ab1, minimum = minimum, as_percent = FALSE), interpretation == "I" ~ portion_I(df, minimum = minimum, as_percent = FALSE),
interpretation %in% c("RI", "IR") ~ portion_IR(ab1 = ab1, ab2 = ab2, minimum = minimum, as_percent = FALSE), interpretation %in% c("RI", "IR") ~ portion_IR(df, minimum = minimum, as_percent = FALSE),
interpretation == "R" ~ portion_R(ab1 = ab1, ab2 = ab2, minimum = minimum, as_percent = FALSE), interpretation == "R" ~ portion_R(df, minimum = minimum, as_percent = FALSE),
TRUE ~ -1 TRUE ~ -1
) )
if (result == -1) { if (result == -1) {

115
R/rsi_calc.R Normal file
View File

@ -0,0 +1,115 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Analysis #
# #
# AUTHORS #
# Berends MS (m.s.berends@umcg.nl), Luz CF (c.f.luz@umcg.nl) #
# #
# LICENCE #
# This program is free software; you can redistribute it and/or modify #
# it under the terms of the GNU General Public License version 2.0, #
# as published by the Free Software Foundation. #
# #
# This program is distributed in the hope that it will be useful, #
# but WITHOUT ANY WARRANTY; without even the implied warranty of #
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the #
# GNU General Public License for more details. #
# ==================================================================== #
#' @importFrom dplyr %>% bind_cols pull
rsi_calc <- function(...,
type,
include_I,
minimum,
as_percent,
only_count) {
if (!is.logical(include_I)) {
stop('`include_I` must be logical', call. = FALSE)
}
if (!is.numeric(minimum)) {
stop('`minimum` must be numeric', call. = FALSE)
}
if (!is.logical(as_percent)) {
stop('`as_percent` must be logical', call. = FALSE)
}
dots_length <- ...length()
dots <- ...elt(1) # it needs this evaluation
dots <- rlang::exprs(...) # or this will be a list without actual values
if ("data.frame" %in% class(dots[[1]]) & dots_length > 1) {
# data.frame passed with other columns, like:
# septic_patients %>% portion_S(amcl, gent)
df <- dots[[1]]
dots_df <- data.frame(col1 = df[,1])
for (i in 2:dots_length) {
dots_col <- as.character(dots[[i]])
if (!dots_col %in% colnames(df)) {
stop("variable not found: ", dots_col)
}
dots_df <- dots_df %>% bind_cols(data.frame(df %>% pull(dots_col)))
}
x <- dots_df[, -1]
} else if (dots_length == 1) {
# only 1 variable passed (count also be data.frame), like:
# portion_S(septic_patients$amcl)
# septic_patients$amcl %>% portion_S()
x <- dots[[1]]
} else {
# multiple variables passed without pipe, like:
# portion_S(septic_patients$amcl, septic_patients$gent)
# with(septic_patients, portion_S(amcl, gent))
x <- as.data.frame(rlang::list2(...))
}
print_warning <- FALSE
# check integrity of columns: force rsi class
if (is.data.frame(x)) {
for (i in 1:ncol(x)) {
if (!is.rsi(x %>% pull(i))) {
x[, i] <- as.rsi(x[, i])
print_warning <- TRUE
}
x[, i] <- x %>% pull(i) %>% as.integer()
}
x <- apply(X = x,
MARGIN = 1,
FUN = min)
} else {
if (!is.rsi(x)) {
x <- as.rsi(x)
print_warning <- TRUE
}
}
if (print_warning == TRUE) {
warning("Increase speed by transforming to class `rsi` on beforehand: df %>% mutate_if(is.rsi.eligible, as.rsi)",
call. = FALSE)
}
if (type == "S") {
found <- sum(as.integer(x) <= 1 + include_I, na.rm = TRUE)
} else if (type == "I") {
found <- sum(as.integer(x) == 2, na.rm = TRUE)
} else if (type == "R") {
found <- sum(as.integer(x) >= 3 - include_I, na.rm = TRUE)
} else {
stop("invalid type")
}
if (only_count == TRUE) {
return(found)
}
total <- length(x) - sum(is.na(x))
if (total < minimum) {
return(NA)
}
if (as_percent == TRUE) {
percent(found / total, force_zero = TRUE)
} else {
found / total
}
}

View File

@ -13,23 +13,21 @@
Wickham H. \strong{Tidy Data.} The Journal of Statistical Software, vol. 59, 2014. \url{http://vita.had.co.nz/papers/tidy-data.html} Wickham H. \strong{Tidy Data.} The Journal of Statistical Software, vol. 59, 2014. \url{http://vita.had.co.nz/papers/tidy-data.html}
} }
\usage{ \usage{
count_R(ab1, ab2 = NULL) count_R(...)
count_IR(ab1, ab2 = NULL) count_IR(...)
count_I(ab1) count_I(...)
count_SI(ab1, ab2 = NULL) count_SI(...)
count_S(ab1, ab2 = NULL) count_S(...)
count_df(data, translate_ab = getOption("get_antibiotic_names", count_df(data, translate_ab = getOption("get_antibiotic_names",
"official")) "official"))
} }
\arguments{ \arguments{
\item{ab1}{vector of antibiotic interpretations, they will be transformed internally with \code{\link{as.rsi}} if needed} \item{...}{one or more vectors (or columns) with antibiotic interpretations. They will be transformed internally with \code{\link{as.rsi}} if needed. Use multiple columns to calculate (the lack of) co-resistance: the probability where one of two drugs have a resistant or susceptible result. See Examples.}
\item{ab2}{like \code{ab}, a vector of antibiotic interpretations. Use this to calculate (the lack of) co-resistance: the probability where one of two drugs have a resistant or susceptible result. See Examples.}
\item{data}{a \code{data.frame} containing columns with class \code{rsi} (see \code{\link{as.rsi}})} \item{data}{a \code{data.frame} containing columns with class \code{rsi} (see \code{\link{as.rsi}})}
@ -39,7 +37,7 @@ count_df(data, translate_ab = getOption("get_antibiotic_names",
Integer Integer
} }
\description{ \description{
These functions can be used to count resistant/susceptible microbial isolates. All functions can be used in \code{dplyr}s \code{\link[dplyr]{summarise}} and support grouped variables, see \emph{Examples}. These functions can be used to count resistant/susceptible microbial isolates. All functions support quasiquotation with pipes, can be used in \code{dplyr}s \code{\link[dplyr]{summarise}} and support grouped variables, see \emph{Examples}.
\code{count_R} and \code{count_IR} can be used to count resistant isolates, \code{count_S} and \code{count_SI} can be used to count susceptible isolates.\cr \code{count_R} and \code{count_IR} can be used to count resistant isolates, \code{count_S} and \code{count_SI} can be used to count susceptible isolates.\cr
} }

View File

@ -11,10 +11,10 @@
\usage{ \usage{
ggplot_rsi(data, position = NULL, x = "Antibiotic", ggplot_rsi(data, position = NULL, x = "Antibiotic",
fill = "Interpretation", facet = NULL, translate_ab = "official", fill = "Interpretation", facet = NULL, translate_ab = "official",
fun = portion_df, ...) alpha = 1, fun = portion_df, ...)
geom_rsi(position = NULL, x = c("Antibiotic", "Interpretation"), geom_rsi(position = NULL, x = c("Antibiotic", "Interpretation"),
fill = "Interpretation", translate_ab = "official", fill = "Interpretation", translate_ab = "official", alpha = 1,
fun = portion_df) fun = portion_df)
facet_rsi(facet = c("Interpretation", "Antibiotic"), ...) facet_rsi(facet = c("Interpretation", "Antibiotic"), ...)
@ -38,6 +38,8 @@ theme_rsi()
\item{translate_ab}{a column name of the \code{\link{antibiotics}} data set to translate the antibiotic abbreviations into, using \code{\link{abname}}. Default behaviour is to translate to official names according to the WHO. Use \code{translate_ab = FALSE} to disable translation.} \item{translate_ab}{a column name of the \code{\link{antibiotics}} data set to translate the antibiotic abbreviations into, using \code{\link{abname}}. Default behaviour is to translate to official names according to the WHO. Use \code{translate_ab = FALSE} to disable translation.}
\item{alpha}{opacity of the fill colours}
\item{fun}{function to transform \code{data}, either \code{\link{portion_df}} (default) or \code{\link{count_df}}} \item{fun}{function to transform \code{data}, either \code{\link{portion_df}} (default) or \code{\link{count_df}}}
\item{...}{other parameters passed on to \code{\link[ggplot2]{facet_wrap}}} \item{...}{other parameters passed on to \code{\link[ggplot2]{facet_wrap}}}

View File

@ -4,13 +4,13 @@
\alias{n_rsi} \alias{n_rsi}
\title{Count cases with antimicrobial results} \title{Count cases with antimicrobial results}
\usage{ \usage{
n_rsi(ab1, ab2 = NULL) n_rsi(...)
} }
\arguments{ \arguments{
\item{ab1, ab2}{vector of antibiotic interpretations, they will be transformed internally with \code{\link{as.rsi}} if needed} \item{...}{one or more vectors (or columns) with antibiotic interpretations. They will be transformed internally with \code{\link{as.rsi}} if needed. Use multiple columns to calculate (the lack of) co-resistance: the probability where one of two drugs have a resistant or susceptible result. See Examples.}
} }
\description{ \description{
This counts all cases where antimicrobial interpretations are available. Its use is equal to \code{\link{n_distinct}}. This counts all cases where antimicrobial interpretations are available. The way it can be used is equal to \code{\link{n_distinct}}. Its function is equal to \code{count_S(...) + count_IR(...)}.
} }
\examples{ \examples{
library(dplyr) library(dplyr)
@ -25,5 +25,6 @@ septic_patients \%>\%
combination_n = n_rsi(cipr, gent)) combination_n = n_rsi(cipr, gent))
} }
\seealso{ \seealso{
The \code{\link{portion}} functions to calculate resistance and susceptibility. \code{\link[AMR]{count}_*} to count resistant and susceptibile isolates per interpretation type.\cr
\code{\link{portion}_*} to calculate microbial resistance and susceptibility.
} }

View File

@ -15,23 +15,21 @@
Wickham H. \strong{Tidy Data.} The Journal of Statistical Software, vol. 59, 2014. \url{http://vita.had.co.nz/papers/tidy-data.html} Wickham H. \strong{Tidy Data.} The Journal of Statistical Software, vol. 59, 2014. \url{http://vita.had.co.nz/papers/tidy-data.html}
} }
\usage{ \usage{
portion_R(ab1, ab2 = NULL, minimum = 30, as_percent = FALSE) portion_R(..., minimum = 30, as_percent = FALSE)
portion_IR(ab1, ab2 = NULL, minimum = 30, as_percent = FALSE) portion_IR(..., minimum = 30, as_percent = FALSE)
portion_I(ab1, minimum = 30, as_percent = FALSE) portion_I(..., minimum = 30, as_percent = FALSE)
portion_SI(ab1, ab2 = NULL, minimum = 30, as_percent = FALSE) portion_SI(..., minimum = 30, as_percent = FALSE)
portion_S(ab1, ab2 = NULL, minimum = 30, as_percent = FALSE) portion_S(..., minimum = 30, as_percent = FALSE)
portion_df(data, translate_ab = getOption("get_antibiotic_names", portion_df(data, translate_ab = getOption("get_antibiotic_names",
"official"), minimum = 30, as_percent = FALSE) "official"), minimum = 30, as_percent = FALSE)
} }
\arguments{ \arguments{
\item{ab1}{vector of antibiotic interpretations, they will be transformed internally with \code{\link{as.rsi}} if needed} \item{...}{one or more vectors (or columns) with antibiotic interpretations. They will be transformed internally with \code{\link{as.rsi}} if needed. Use multiple columns to calculate (the lack of) co-resistance: the probability where one of two drugs have a resistant or susceptible result. See Examples.}
\item{ab2}{like \code{ab}, a vector of antibiotic interpretations. Use this to calculate (the lack of) co-resistance: the probability where one of two drugs have a resistant or susceptible result. See Examples.}
\item{minimum}{minimal amount of available isolates. Any number lower than \code{minimum} will return \code{NA}. The default number of \code{30} isolates is advised by the CLSI as best practice, see Source.} \item{minimum}{minimal amount of available isolates. Any number lower than \code{minimum} will return \code{NA}. The default number of \code{30} isolates is advised by the CLSI as best practice, see Source.}
@ -45,7 +43,7 @@ portion_df(data, translate_ab = getOption("get_antibiotic_names",
Double or, when \code{as_percent = TRUE}, a character. Double or, when \code{as_percent = TRUE}, a character.
} }
\description{ \description{
These functions can be used to calculate the (co-)resistance of microbial isolates (i.e. percentage S, SI, I, IR or R). All functions can be used in \code{dplyr}s \code{\link[dplyr]{summarise}} and support grouped variables, see \emph{Examples}. These functions can be used to calculate the (co-)resistance of microbial isolates (i.e. percentage S, SI, I, IR or R). All functions support quasiquotation with pipes, can be used in \code{dplyr}s \code{\link[dplyr]{summarise}} and support grouped variables, see \emph{Examples}.
\code{portion_R} and \code{portion_IR} can be used to calculate resistance, \code{portion_S} and \code{portion_SI} can be used to calculate susceptibility.\cr \code{portion_R} and \code{portion_IR} can be used to calculate resistance, \code{portion_S} and \code{portion_SI} can be used to calculate susceptibility.\cr
} }
@ -66,8 +64,10 @@ The old \code{\link{rsi}} function is still available for backwards compatibilit
For two antibiotics: For two antibiotics:
\out{<div style="text-align: center">}\figure{combi_therapy_2.png}\out{</div>} \out{<div style="text-align: center">}\figure{combi_therapy_2.png}\out{</div>}
\cr \cr
Theoretically for three antibiotics: For three antibiotics:
\out{<div style="text-align: center">}\figure{combi_therapy_3.png}\out{</div>} \out{<div style="text-align: center">}\figure{combi_therapy_3.png}\out{</div>}
\cr
And so on.
} }
} }
\examples{ \examples{
@ -82,11 +82,13 @@ portion_IR(septic_patients$amox)
portion_S(septic_patients$amox) portion_S(septic_patients$amox)
portion_SI(septic_patients$amox) portion_SI(septic_patients$amox)
# Since n_rsi counts available isolates (and is used as denominator), # Do the above with pipes:
# you can calculate back to count e.g. non-susceptible isolates:
portion_IR(septic_patients$amox) * n_rsi(septic_patients$amox)
library(dplyr) library(dplyr)
septic_patients \%>\% portion_R(amox)
septic_patients \%>\% portion_IR(amox)
septic_patients \%>\% portion_S(amox)
septic_patients \%>\% portion_SI(amox)
septic_patients \%>\% septic_patients \%>\%
group_by(hospital_id) \%>\% group_by(hospital_id) \%>\%
summarise(p = portion_S(cipr), summarise(p = portion_S(cipr),
@ -102,16 +104,15 @@ septic_patients \%>\%
# Calculate co-resistance between amoxicillin/clav acid and gentamicin, # Calculate co-resistance between amoxicillin/clav acid and gentamicin,
# so we can see that combination therapy does a lot more than mono therapy: # so we can see that combination therapy does a lot more than mono therapy:
portion_S(septic_patients$amcl) # S = 67.3\% septic_patients \%>\% portion_S(amcl) # S = 67.3\%
n_rsi(septic_patients$amcl) # n = 1570 septic_patients \%>\% n_rsi(amcl) # n = 1570
portion_S(septic_patients$gent) # S = 74.0\% septic_patients \%>\% portion_S(gent) # S = 74.0\%
n_rsi(septic_patients$gent) # n = 1842 septic_patients \%>\% n_rsi(gent) # n = 1842
septic_patients \%>\% portion_S(amcl, gent) # S = 92.1\%
septic_patients \%>\% n_rsi(amcl, gent) # n = 1504
with(septic_patients,
portion_S(amcl, gent)) # S = 92.1\%
with(septic_patients, # n = 1504
n_rsi(amcl, gent))
septic_patients \%>\% septic_patients \%>\%
group_by(hospital_id) \%>\% group_by(hospital_id) \%>\%

View File

@ -8,9 +8,7 @@ rsi(ab1, ab2 = NULL, interpretation = "IR", minimum = 30,
as_percent = FALSE, ...) as_percent = FALSE, ...)
} }
\arguments{ \arguments{
\item{ab1}{vector of antibiotic interpretations, they will be transformed internally with \code{\link{as.rsi}} if needed} \item{ab1, ab2}{vector (or column) with antibiotic interpretations. It will be transformed internally with \code{\link{as.rsi}} if needed.}
\item{ab2}{like \code{ab}, a vector of antibiotic interpretations. Use this to calculate (the lack of) co-resistance: the probability where one of two drugs have a resistant or susceptible result. See Examples.}
\item{interpretation}{antimicrobial interpretation to check for} \item{interpretation}{antimicrobial interpretation to check for}

View File

@ -1,8 +1,7 @@
context("atc.R") context("atc.R")
test_that("atc_property works", { test_that("atc_property works", {
skip_on_travis() # relies on internet connection of server, don't test skip_on_cran() # relies on internet connection of server, don't test
skip_on_appveyor() # security error on AppVeyor skip_on_appveyor() # security error on AppVeyor
if (!is.null(curl::nslookup("www.whocc.no", error = FALSE))) { if (!is.null(curl::nslookup("www.whocc.no", error = FALSE))) {

View File

@ -0,0 +1,41 @@
context("count.R")
test_that("counts work", {
# amox resistance in `septic_patients`
expect_equal(count_R(septic_patients$amox), 659)
expect_equal(count_I(septic_patients$amox), 3)
expect_equal(count_S(septic_patients$amox), 336)
expect_equal(count_R(septic_patients$amox) + count_I(septic_patients$amox),
count_IR(septic_patients$amox))
expect_equal(count_S(septic_patients$amox) + count_I(septic_patients$amox),
count_SI(septic_patients$amox))
expect_equal(septic_patients %>% count_S(amcl), 1056)
expect_equal(septic_patients %>% count_S(amcl, gent), 1385)
# count of cases
expect_equal(septic_patients %>%
group_by(hospital_id) %>%
summarise(cipro = count_S(cipr),
genta = count_S(gent),
combination = count_S(cipr, gent)) %>%
pull(combination),
c(192, 440, 184, 474))
# warning for speed loss
expect_warning(count_R(as.character(septic_patients$amcl)))
expect_warning(count_I(as.character(septic_patients$amcl)))
expect_warning(count_S(as.character(septic_patients$amcl,
septic_patients$gent)))
expect_warning(count_S(septic_patients$amcl,
as.character(septic_patients$gent)))
# check for errors
expect_error(count_IR("test", minimum = "test"))
expect_error(count_IR("test", as_percent = "test"))
expect_error(count_I("test", minimum = "test"))
expect_error(count_I("test", as_percent = "test"))
expect_error(count_S("test", minimum = "test"))
expect_error(count_S("test", as_percent = "test"))
})

View File

@ -11,12 +11,19 @@ test_that("portions works", {
expect_equal(portion_S(septic_patients$amox) + portion_I(septic_patients$amox), expect_equal(portion_S(septic_patients$amox) + portion_I(septic_patients$amox),
portion_SI(septic_patients$amox)) portion_SI(septic_patients$amox))
# pita+genta susceptibility around 98.09% expect_equal(septic_patients %>% portion_S(amcl),
expect_equal(suppressWarnings(rsi(septic_patients$pita, 0.673,
tolerance = 0.001)
expect_equal(septic_patients %>% portion_S(amcl, gent),
0.921,
tolerance = 0.001)
# amcl+genta susceptibility around 92.1%
expect_equal(suppressWarnings(rsi(septic_patients$amcl,
septic_patients$gent, septic_patients$gent,
interpretation = "S")), interpretation = "S")),
0.9535, 0.9208777,
tolerance = 0.0001) tolerance = 0.000001)
# percentages # percentages
expect_equal(septic_patients %>% expect_equal(septic_patients %>%
@ -46,25 +53,19 @@ test_that("portions works", {
expect_warning(portion_S(as.character(septic_patients$amcl))) expect_warning(portion_S(as.character(septic_patients$amcl)))
expect_warning(portion_S(as.character(septic_patients$amcl, expect_warning(portion_S(as.character(septic_patients$amcl,
septic_patients$gent))) septic_patients$gent)))
expect_equal(n_rsi(as.character(septic_patients$amcl, expect_warning(n_rsi(as.character(septic_patients$amcl,
septic_patients$gent)), septic_patients$gent)))
expect_equal(suppressWarnings(n_rsi(as.character(septic_patients$amcl,
septic_patients$gent))),
1570) 1570)
# check for errors # check for errors
expect_error(portion_IR(septic_patients %>% select(amox, amcl)))
expect_error(portion_IR("test", minimum = "test")) expect_error(portion_IR("test", minimum = "test"))
expect_error(portion_IR("test", as_percent = "test")) expect_error(portion_IR("test", as_percent = "test"))
expect_error(portion_I(septic_patients %>% select(amox, amcl)))
expect_error(portion_I("test", minimum = "test")) expect_error(portion_I("test", minimum = "test"))
expect_error(portion_I("test", as_percent = "test")) expect_error(portion_I("test", as_percent = "test"))
expect_error(portion_S("test", minimum = "test")) expect_error(portion_S("test", minimum = "test"))
expect_error(portion_S("test", as_percent = "test")) expect_error(portion_S("test", as_percent = "test"))
expect_error(portion_S(septic_patients %>% select(amox, amcl)))
expect_error(portion_S("R", septic_patients %>% select(amox, amcl)))
expect_error(n_rsi(septic_patients %>% select(amox, amcl)))
expect_error(n_rsi(septic_patients$amox, septic_patients %>% select(amox, amcl)))
# check too low amount of isolates # check too low amount of isolates
expect_identical(portion_R(septic_patients$amox, minimum = nrow(septic_patients) + 1), expect_identical(portion_R(septic_patients$amox, minimum = nrow(septic_patients) + 1),