From da5379c881c2d498f51fdfb108f1fcd12a7697e3 Mon Sep 17 00:00:00 2001 From: "Matthijs S. Berends" Date: Thu, 23 Aug 2018 00:40:36 +0200 Subject: [PATCH] quasiquotation, alpha for geom_rsi --- DESCRIPTION | 8 +- NAMESPACE | 2 +- NEWS.md | 10 ++- R/count.R | 41 ++++------ R/freq.R | 7 +- R/ggplot_rsi.R | 7 +- R/n_rsi.R | 28 ++----- R/portion.R | 148 ++++++++-------------------------- R/rsi.R | 20 +++-- R/rsi_calc.R | 115 ++++++++++++++++++++++++++ man/count.Rd | 16 ++-- man/ggplot_rsi.Rd | 6 +- man/n_rsi.Rd | 9 ++- man/portion.Rd | 45 ++++++----- man/rsi.Rd | 4 +- tests/testthat/test-atc.R | 3 +- tests/testthat/test-count.R | 41 ++++++++++ tests/testthat/test-portion.R | 29 +++---- 18 files changed, 304 insertions(+), 235 deletions(-) create mode 100644 R/rsi_calc.R create mode 100644 tests/testthat/test-count.R diff --git a/DESCRIPTION b/DESCRIPTION index 109c4b93..b9823397 100755 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: AMR -Version: 0.3.0.9001 -Date: 2018-08-21 +Version: 0.3.0.9002 +Date: 2018-08-23 Title: Antimicrobial Resistance Analysis Authors@R: c( person( @@ -52,8 +52,8 @@ Imports: xml2 (>= 1.0.0), knitr (>= 1.0.0), readr, - rvest (>= 0.3.2), - tibble + rlang, + rvest (>= 0.3.2) Suggests: testthat (>= 1.0.2), covr (>= 3.0.1), diff --git a/NAMESPACE b/NAMESPACE index 749b2bd9..89462f30 100755 --- a/NAMESPACE +++ b/NAMESPACE @@ -127,6 +127,7 @@ importFrom(dplyr,arrange) importFrom(dplyr,arrange_at) importFrom(dplyr,as_tibble) importFrom(dplyr,between) +importFrom(dplyr,bind_cols) importFrom(dplyr,bind_rows) importFrom(dplyr,case_when) importFrom(dplyr,desc) @@ -171,7 +172,6 @@ importFrom(stats,mad) importFrom(stats,pchisq) importFrom(stats,predict) importFrom(stats,sd) -importFrom(tibble,tibble) importFrom(utils,View) importFrom(utils,browseVignettes) importFrom(utils,installed.packages) diff --git a/NEWS.md b/NEWS.md index a8f4e1e4..7e5db04c 100755 --- a/NEWS.md +++ b/NEWS.md @@ -1,13 +1,19 @@ # 0.3.0.90xx (latest development version) #### 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)` #### Changed * 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`. -* 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) **Published on CRAN: 2018-08-14** diff --git a/R/count.R b/R/count.R index d78cadf8..50c39b3d 100644 --- a/R/count.R +++ b/R/count.R @@ -18,7 +18,7 @@ #' 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 #' @inheritParams portion @@ -87,11 +87,9 @@ #' group_by(hospital_id) %>% #' count_df(translate = FALSE) #' -count_R <- function(ab1, - ab2 = NULL) { - rsi_calc(type = "R", - ab1 = ab1, - ab2 = ab2, +count_R <- function(...) { + rsi_calc(..., + type = "R", include_I = FALSE, minimum = 0, as_percent = FALSE, @@ -100,11 +98,9 @@ count_R <- function(ab1, #' @rdname count #' @export -count_IR <- function(ab1, - ab2 = NULL) { - rsi_calc(type = "R", - ab1 = ab1, - ab2 = ab2, +count_IR <- function(...) { + rsi_calc(..., + type = "R", include_I = TRUE, minimum = 0, as_percent = FALSE, @@ -113,10 +109,9 @@ count_IR <- function(ab1, #' @rdname count #' @export -count_I <- function(ab1) { - rsi_calc(type = "I", - ab1 = ab1, - ab2 = NULL, +count_I <- function(...) { + rsi_calc(..., + type = "I", include_I = FALSE, minimum = 0, as_percent = FALSE, @@ -125,11 +120,9 @@ count_I <- function(ab1) { #' @rdname count #' @export -count_SI <- function(ab1, - ab2 = NULL) { - rsi_calc(type = "S", - ab1 = ab1, - ab2 = ab2, +count_SI <- function(...) { + rsi_calc(..., + type = "S", include_I = TRUE, minimum = 0, as_percent = FALSE, @@ -138,11 +131,9 @@ count_SI <- function(ab1, #' @rdname count #' @export -count_S <- function(ab1, - ab2 = NULL) { - rsi_calc(type = "S", - ab1 = ab1, - ab2 = ab2, +count_S <- function(...) { + rsi_calc(..., + type = "S", include_I = FALSE, minimum = 0, as_percent = FALSE, diff --git a/R/freq.R b/R/freq.R index 9346a233..e1dc7c88 100755 --- a/R/freq.R +++ b/R/freq.R @@ -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. #' @importFrom stats fivenum sd mad #' @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 tibble tibble #' @keywords summary summarise frequency freq #' @rdname freq #' @name freq @@ -378,12 +377,12 @@ frequency_tbl <- function(x, column_names_df <- c('item', 'count', 'percent', 'cum_count', 'cum_percent', 'factor_level') if (any(class(x) == 'factor')) { - df <- tibble::tibble(item = x, + df <- tibble(item = x, fctlvl = x %>% as.integer()) %>% group_by(item, fctlvl) column_align <- c('l', 'r', 'r', 'r', 'r', 'r') } else { - df <- tibble::tibble(item = x) %>% + df <- tibble(item = x) %>% group_by(item) # strip factor lvl from col names column_names <- column_names[1:length(column_names) - 1] diff --git a/R/ggplot_rsi.R b/R/ggplot_rsi.R index fea5588b..f4de1267 100644 --- a/R/ggplot_rsi.R +++ b/R/ggplot_rsi.R @@ -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 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 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 ... 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)}. @@ -113,6 +114,7 @@ ggplot_rsi <- function(data, fill = "Interpretation", facet = NULL, translate_ab = "official", + alpha = 1, fun = portion_df, ...) { @@ -126,7 +128,7 @@ ggplot_rsi <- function(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() if (fill == "Interpretation") { @@ -151,6 +153,7 @@ geom_rsi <- function(position = NULL, x = c("Antibiotic", "Interpretation"), fill = "Interpretation", translate_ab = "official", + alpha = 1, fun = portion_df) { fun_name <- deparse(substitute(fun)) @@ -180,7 +183,7 @@ geom_rsi <- function(position = NULL, ggplot2::layer(geom = "bar", stat = "identity", position = position, mapping = ggplot2::aes_string(x = x, y = y, fill = fill), - data = fun, params = list()) + data = fun, params = list(alpha = alpha)) } diff --git a/R/n_rsi.R b/R/n_rsi.R index cac652cd..eeffcdfa 100644 --- a/R/n_rsi.R +++ b/R/n_rsi.R @@ -18,10 +18,11 @@ #' Count cases with antimicrobial results #' -#' This counts all cases where antimicrobial interpretations are available. Its use is equal to \code{\link{n_distinct}}. -#' @param ab1,ab2 vector of antibiotic interpretations, they will be transformed internally with \code{\link{as.rsi}} if needed +#' 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(...)}. +#' @inheritParams portion #' @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 #' library(dplyr) #' @@ -33,22 +34,7 @@ #' genta_n = n_rsi(gent), #' combination_p = portion_S(cipr, gent, as_percent = TRUE), #' combination_n = n_rsi(cipr, gent)) -n_rsi <- function(ab1, ab2 = NULL) { - if (NCOL(ab1) > 1) { - stop('`ab1` must be a vector of antimicrobial interpretations', call. = FALSE) - } - 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)) - } +n_rsi <- function(...) { + # only print warnings once, if needed + count_S(...) + suppressWarnings(count_IR(...)) } diff --git a/R/portion.R b/R/portion.R index c4636b6e..17d9a7d8 100755 --- a/R/portion.R +++ b/R/portion.R @@ -18,11 +18,10 @@ #' 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 -#' @param ab1 vector of antibiotic interpretations, they will be transformed internally with \code{\link{as.rsi}} if needed -#' @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 ... 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 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 data a \code{data.frame} containing columns with class \code{rsi} (see \code{\link{as.rsi}}) @@ -43,8 +42,10 @@ #' For two antibiotics: #' \out{
}\figure{combi_therapy_2.png}\out{
} #' \cr -#' Theoretically for three antibiotics: +#' For three antibiotics: #' \out{
}\figure{combi_therapy_3.png}\out{
} +#' \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/}. #' @@ -68,11 +69,14 @@ #' portion_S(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: -#' portion_IR(septic_patients$amox) * n_rsi(septic_patients$amox) -#' + +#' # Do the above with pipes: #' library(dplyr) +#' septic_patients %>% portion_R(amox) +#' septic_patients %>% portion_IR(amox) +#' septic_patients %>% portion_S(amox) +#' septic_patients %>% portion_SI(amox) +#' #' septic_patients %>% #' group_by(hospital_id) %>% #' summarise(p = portion_S(cipr), @@ -88,16 +92,15 @@ #' #' # Calculate co-resistance between amoxicillin/clav acid and gentamicin, #' # so we can see that combination therapy does a lot more than mono therapy: -#' portion_S(septic_patients$amcl) # S = 67.3% -#' n_rsi(septic_patients$amcl) # n = 1570 +#' septic_patients %>% portion_S(amcl) # S = 67.3% +#' septic_patients %>% n_rsi(amcl) # n = 1570 #' -#' portion_S(septic_patients$gent) # S = 74.0% -#' n_rsi(septic_patients$gent) # n = 1842 +#' septic_patients %>% portion_S(gent) # S = 74.0% +#' 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 %>% #' group_by(hospital_id) %>% @@ -129,13 +132,11 @@ #' summarise(p = portion_S(amox, metr), # amoxicillin with metronidazole #' n = n_rsi(amox, metr)) #' } -portion_R <- function(ab1, - ab2 = NULL, +portion_R <- function(..., minimum = 30, as_percent = FALSE) { - rsi_calc(type = "R", - ab1 = ab1, - ab2 = ab2, + rsi_calc(..., + type = "R", include_I = FALSE, minimum = minimum, as_percent = as_percent, @@ -144,13 +145,11 @@ portion_R <- function(ab1, #' @rdname portion #' @export -portion_IR <- function(ab1, - ab2 = NULL, +portion_IR <- function(..., minimum = 30, as_percent = FALSE) { - rsi_calc(type = "R", - ab1 = ab1, - ab2 = ab2, + rsi_calc(..., + type = "R", include_I = TRUE, minimum = minimum, as_percent = as_percent, @@ -159,12 +158,11 @@ portion_IR <- function(ab1, #' @rdname portion #' @export -portion_I <- function(ab1, +portion_I <- function(..., minimum = 30, as_percent = FALSE) { - rsi_calc(type = "I", - ab1 = ab1, - ab2 = NULL, + rsi_calc(..., + type = "I", include_I = FALSE, minimum = minimum, as_percent = as_percent, @@ -173,13 +171,11 @@ portion_I <- function(ab1, #' @rdname portion #' @export -portion_SI <- function(ab1, - ab2 = NULL, +portion_SI <- function(..., minimum = 30, as_percent = FALSE) { - rsi_calc(type = "S", - ab1 = ab1, - ab2 = ab2, + rsi_calc(..., + type = "S", include_I = TRUE, minimum = minimum, as_percent = as_percent, @@ -188,13 +184,11 @@ portion_SI <- function(ab1, #' @rdname portion #' @export -portion_S <- function(ab1, - ab2 = NULL, +portion_S <- function(..., minimum = 30, as_percent = FALSE) { - rsi_calc(type = "S", - ab1 = ab1, - ab2 = ab2, + rsi_calc(..., + type = "S", include_I = FALSE, minimum = minimum, as_percent = as_percent, @@ -257,77 +251,3 @@ portion_df <- function(data, 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 - } -} diff --git a/R/rsi.R b/R/rsi.R index 0ab618ad..cef5cfa1 100644 --- a/R/rsi.R +++ b/R/rsi.R @@ -20,9 +20,10 @@ #' #' This function is deprecated. Use the \code{\link{portion}} functions instead. #' @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 ... deprecated parameters to support usage on older versions -#' @importFrom dplyr case_when +#' @importFrom dplyr tibble case_when #' @export rsi <- function(ab1, ab2 = NULL, @@ -31,12 +32,19 @@ rsi <- function(ab1, as_percent = FALSE, ...) { + if (all(is.null(ab2))) { + df <- tibble(ab1 = ab1) + } else { + df <- tibble(ab1 = ab1, + ab2 = ab2) + } + result <- case_when( - interpretation == "S" ~ portion_S(ab1 = ab1, ab2 = ab2, minimum = minimum, as_percent = FALSE), - interpretation %in% c("SI", "IS") ~ portion_SI(ab1 = ab1, ab2 = ab2, minimum = minimum, as_percent = FALSE), - interpretation == "I" ~ portion_I(ab1 = ab1, minimum = minimum, as_percent = FALSE), - interpretation %in% c("RI", "IR") ~ portion_IR(ab1 = ab1, ab2 = ab2, minimum = minimum, as_percent = FALSE), - interpretation == "R" ~ portion_R(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(df, minimum = minimum, as_percent = FALSE), + interpretation == "I" ~ portion_I(df, minimum = minimum, as_percent = FALSE), + interpretation %in% c("RI", "IR") ~ portion_IR(df, minimum = minimum, as_percent = FALSE), + interpretation == "R" ~ portion_R(df, minimum = minimum, as_percent = FALSE), TRUE ~ -1 ) if (result == -1) { diff --git a/R/rsi_calc.R b/R/rsi_calc.R new file mode 100644 index 00000000..ff6d79db --- /dev/null +++ b/R/rsi_calc.R @@ -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 + } +} diff --git a/man/count.Rd b/man/count.Rd index 68b9c12d..38507440 100644 --- a/man/count.Rd +++ b/man/count.Rd @@ -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} } \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", "official")) } \arguments{ -\item{ab1}{vector of antibiotic interpretations, they 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{...}{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{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 } \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 } diff --git a/man/ggplot_rsi.Rd b/man/ggplot_rsi.Rd index af6d23be..38e620ee 100644 --- a/man/ggplot_rsi.Rd +++ b/man/ggplot_rsi.Rd @@ -11,10 +11,10 @@ \usage{ ggplot_rsi(data, position = NULL, x = "Antibiotic", fill = "Interpretation", facet = NULL, translate_ab = "official", - fun = portion_df, ...) + alpha = 1, fun = portion_df, ...) geom_rsi(position = NULL, x = c("Antibiotic", "Interpretation"), - fill = "Interpretation", translate_ab = "official", + fill = "Interpretation", translate_ab = "official", alpha = 1, fun = portion_df) 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{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{...}{other parameters passed on to \code{\link[ggplot2]{facet_wrap}}} diff --git a/man/n_rsi.Rd b/man/n_rsi.Rd index f581e7fa..ab5fc099 100644 --- a/man/n_rsi.Rd +++ b/man/n_rsi.Rd @@ -4,13 +4,13 @@ \alias{n_rsi} \title{Count cases with antimicrobial results} \usage{ -n_rsi(ab1, ab2 = NULL) +n_rsi(...) } \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{ -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{ library(dplyr) @@ -25,5 +25,6 @@ septic_patients \%>\% combination_n = n_rsi(cipr, gent)) } \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. } diff --git a/man/portion.Rd b/man/portion.Rd index 80477540..a2cb59cd 100644 --- a/man/portion.Rd +++ b/man/portion.Rd @@ -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} } \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", "official"), minimum = 30, as_percent = FALSE) } \arguments{ -\item{ab1}{vector of antibiotic interpretations, they 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{...}{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{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. } \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 } @@ -66,8 +64,10 @@ The old \code{\link{rsi}} function is still available for backwards compatibilit For two antibiotics: \out{
}\figure{combi_therapy_2.png}\out{
} \cr - Theoretically for three antibiotics: + For three antibiotics: \out{
}\figure{combi_therapy_3.png}\out{
} + \cr + And so on. } } \examples{ @@ -82,11 +82,13 @@ portion_IR(septic_patients$amox) portion_S(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: -portion_IR(septic_patients$amox) * n_rsi(septic_patients$amox) - +# Do the above with pipes: library(dplyr) +septic_patients \%>\% portion_R(amox) +septic_patients \%>\% portion_IR(amox) +septic_patients \%>\% portion_S(amox) +septic_patients \%>\% portion_SI(amox) + septic_patients \%>\% group_by(hospital_id) \%>\% summarise(p = portion_S(cipr), @@ -102,16 +104,15 @@ septic_patients \%>\% # Calculate co-resistance between amoxicillin/clav acid and gentamicin, # so we can see that combination therapy does a lot more than mono therapy: -portion_S(septic_patients$amcl) # S = 67.3\% -n_rsi(septic_patients$amcl) # n = 1570 +septic_patients \%>\% portion_S(amcl) # S = 67.3\% +septic_patients \%>\% n_rsi(amcl) # n = 1570 -portion_S(septic_patients$gent) # S = 74.0\% -n_rsi(septic_patients$gent) # n = 1842 +septic_patients \%>\% portion_S(gent) # S = 74.0\% +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 \%>\% group_by(hospital_id) \%>\% diff --git a/man/rsi.Rd b/man/rsi.Rd index 41de4bb1..60430bc0 100644 --- a/man/rsi.Rd +++ b/man/rsi.Rd @@ -8,9 +8,7 @@ rsi(ab1, ab2 = NULL, interpretation = "IR", minimum = 30, as_percent = FALSE, ...) } \arguments{ -\item{ab1}{vector of antibiotic interpretations, they 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{ab1, ab2}{vector (or column) with antibiotic interpretations. It will be transformed internally with \code{\link{as.rsi}} if needed.} \item{interpretation}{antimicrobial interpretation to check for} diff --git a/tests/testthat/test-atc.R b/tests/testthat/test-atc.R index b1a0395d..180d8176 100755 --- a/tests/testthat/test-atc.R +++ b/tests/testthat/test-atc.R @@ -1,8 +1,7 @@ context("atc.R") 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 if (!is.null(curl::nslookup("www.whocc.no", error = FALSE))) { diff --git a/tests/testthat/test-count.R b/tests/testthat/test-count.R new file mode 100644 index 00000000..67d48a5c --- /dev/null +++ b/tests/testthat/test-count.R @@ -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")) + +}) diff --git a/tests/testthat/test-portion.R b/tests/testthat/test-portion.R index c577e627..d5edcd72 100755 --- a/tests/testthat/test-portion.R +++ b/tests/testthat/test-portion.R @@ -11,12 +11,19 @@ test_that("portions works", { expect_equal(portion_S(septic_patients$amox) + portion_I(septic_patients$amox), portion_SI(septic_patients$amox)) - # pita+genta susceptibility around 98.09% - expect_equal(suppressWarnings(rsi(septic_patients$pita, + expect_equal(septic_patients %>% portion_S(amcl), + 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, interpretation = "S")), - 0.9535, - tolerance = 0.0001) + 0.9208777, + tolerance = 0.000001) # percentages 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, septic_patients$gent))) - expect_equal(n_rsi(as.character(septic_patients$amcl, - septic_patients$gent)), + expect_warning(n_rsi(as.character(septic_patients$amcl, + septic_patients$gent))) + expect_equal(suppressWarnings(n_rsi(as.character(septic_patients$amcl, + septic_patients$gent))), 1570) - # check for errors - expect_error(portion_IR(septic_patients %>% select(amox, amcl))) expect_error(portion_IR("test", minimum = "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", as_percent = "test")) expect_error(portion_S("test", minimum = "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 expect_identical(portion_R(septic_patients$amox, minimum = nrow(septic_patients) + 1),