mirror of
https://github.com/msberends/AMR.git
synced 2025-07-08 15:21:58 +02:00
add confidence intervals (fixed #70), remove combine_IR
This commit is contained in:
@ -473,9 +473,10 @@ word_wrap <- function(...,
|
||||
|
||||
# clean introduced whitespace between fullstops
|
||||
msg <- gsub("[.] +[.]", "..", msg)
|
||||
# remove extra space that was introduced (case: "Smith et al., 2022")
|
||||
# remove extra space that was introduced (e.g. "Smith et al., 2022")
|
||||
msg <- gsub(". ,", ".,", msg, fixed = TRUE)
|
||||
|
||||
msg <- gsub("[ ,", "[,", msg, fixed = TRUE)
|
||||
|
||||
msg
|
||||
}
|
||||
|
||||
@ -854,7 +855,8 @@ get_current_data <- function(arg_name, call) {
|
||||
}
|
||||
# try dplyr::cur_data_all() first to support dplyr groups
|
||||
# only useful for e.g. dplyr::filter(), dplyr::mutate() and dplyr::summarise()
|
||||
# not useful (throws error) with e.g. dplyr::select() - but that will be caught later in this function
|
||||
# not useful (throws error) with e.g. dplyr::select(), dplyr::across(), or dplyr::vars(),
|
||||
# but that will be caught later on in this function
|
||||
cur_data_all <- import_fn("cur_data_all", "dplyr", error_on_fail = FALSE)
|
||||
if (!is.null(cur_data_all)) {
|
||||
out <- tryCatch(cur_data_all(), error = function(e) NULL)
|
||||
@ -862,12 +864,12 @@ get_current_data <- function(arg_name, call) {
|
||||
return(out)
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
# try a manual (base R) method, by going over all underlying environments with sys.frames()
|
||||
for (env in sys.frames()) {
|
||||
if (!is.null(env$`.Generic`)) {
|
||||
# don't check `".Generic" %in% names(env)`, because in R < 3.2, `names(env)` is always NULL
|
||||
|
||||
|
||||
if (valid_df(env$`.data`)) {
|
||||
# an element `.data` will be in the environment when using `dplyr::select()`
|
||||
# (but not when using `dplyr::filter()`, `dplyr::mutate()` or `dplyr::summarise()`)
|
||||
@ -879,9 +881,14 @@ get_current_data <- function(arg_name, call) {
|
||||
# an element `x` will be in the environment for only cols, e.g. `example_isolates[, carbapenems()]`
|
||||
return(env$x)
|
||||
}
|
||||
|
||||
} else if (!is.null(names(env)) && all(c(".tbl", ".vars", ".env") %in% names(env), na.rm = TRUE) && valid_df(env$`.tbl`)) {
|
||||
# an element `.tbl` will be in the environment when using `dplyr::vars()`
|
||||
# (e.g. in `dplyr::summarise_at()` or `dplyr::mutate_at()`)
|
||||
return(env$`.tbl`)
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
# no data.frame found, so an error must be returned:
|
||||
if (is.na(arg_name)) {
|
||||
if (isTRUE(is.numeric(call))) {
|
||||
|
||||
@ -31,7 +31,7 @@
|
||||
#'
|
||||
#' Determine antimicrobial resistance (AMR) of all bug-drug combinations in your data set where at least 30 (default) isolates are available per species. Use [format()] on the result to prettify it to a publishable/printable format, see *Examples*.
|
||||
#' @inheritParams eucast_rules
|
||||
#' @param combine_IR a [logical] to indicate whether values R and I should be summed
|
||||
#' @param combine_SI a [logical] to indicate whether values S and I should be summed, so resistance will be based on only R, defaults to `TRUE`
|
||||
#' @param add_ab_group a [logical] to indicate where the group of the antimicrobials must be included as a first column
|
||||
#' @param remove_intrinsic_resistant [logical] to indicate that rows and columns with 100% resistance for all tested antimicrobials must be removed from the table
|
||||
#' @param FUN the function to call on the `mo` column to transform the microorganism codes, defaults to [mo_shortname()]
|
||||
@ -39,11 +39,11 @@
|
||||
#' @param ... arguments passed on to `FUN`
|
||||
#' @inheritParams rsi_df
|
||||
#' @inheritParams base::formatC
|
||||
#' @details The function [format()] calculates the resistance per bug-drug combination. Use `combine_IR = FALSE` (default) to test R vs. S+I and `combine_IR = TRUE` to test R+I vs. S.
|
||||
#' @details The function [format()] calculates the resistance per bug-drug combination. Use `combine_SI = TRUE` (default) to test R vs. S+I and `combine_SI = FALSE` to test R+I vs. S.
|
||||
#' @export
|
||||
#' @rdname bug_drug_combinations
|
||||
#' @return The function [bug_drug_combinations()] returns a [data.frame] with columns "mo", "ab", "S", "I", "R" and "total".
|
||||
#' @source \strong{M39 Analysis and Presentation of Cumulative Antimicrobial Susceptibility Test Data, 4th Edition}, 2014, *Clinical and Laboratory Standards Institute (CLSI)*. <https://clsi.org/standards/products/microbiology/documents/m39/>.
|
||||
#' @source \strong{M39 Analysis and Presentation of Cumulative Antimicrobial Susceptibility Test Data, 5th Edition}, 2022, *Clinical and Laboratory Standards Institute (CLSI)*. <https://clsi.org/standards/products/microbiology/documents/m39/>.
|
||||
#' @examples
|
||||
#' \donttest{
|
||||
#' x <- bug_drug_combinations(example_isolates)
|
||||
@ -174,7 +174,6 @@ format.bug_drug_combinations <- function(x,
|
||||
language = get_AMR_locale(),
|
||||
minimum = 30,
|
||||
combine_SI = TRUE,
|
||||
combine_IR = FALSE,
|
||||
add_ab_group = TRUE,
|
||||
remove_intrinsic_resistant = FALSE,
|
||||
decimal.mark = getOption("OutDec"),
|
||||
@ -185,7 +184,6 @@ format.bug_drug_combinations <- function(x,
|
||||
language <- validate_language(language)
|
||||
meet_criteria(minimum, allow_class = c("numeric", "integer"), has_length = 1, is_positive = TRUE, is_finite = TRUE)
|
||||
meet_criteria(combine_SI, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(combine_IR, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(add_ab_group, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(remove_intrinsic_resistant, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(decimal.mark, allow_class = "character", has_length = 1)
|
||||
@ -218,7 +216,7 @@ format.bug_drug_combinations <- function(x,
|
||||
if (remove_intrinsic_resistant == TRUE) {
|
||||
x <- subset(x, R != total)
|
||||
}
|
||||
if (combine_SI == TRUE || combine_IR == FALSE) {
|
||||
if (combine_SI == TRUE) {
|
||||
x$isolates <- x$R
|
||||
} else {
|
||||
x$isolates <- x$R + x$I
|
||||
|
||||
24
R/count.R
24
R/count.R
@ -126,7 +126,7 @@ count_resistant <- function(..., only_all_tested = FALSE) {
|
||||
only_all_tested = only_all_tested,
|
||||
only_count = TRUE
|
||||
),
|
||||
error = function(e) stop_(e$message, call = -5)
|
||||
error = function(e) stop_(gsub("in rsi_calc(): ", "", e$message, fixed = TRUE), call = -5)
|
||||
)
|
||||
}
|
||||
|
||||
@ -139,7 +139,7 @@ count_susceptible <- function(..., only_all_tested = FALSE) {
|
||||
only_all_tested = only_all_tested,
|
||||
only_count = TRUE
|
||||
),
|
||||
error = function(e) stop_(e$message, call = -5)
|
||||
error = function(e) stop_(gsub("in rsi_calc(): ", "", e$message, fixed = TRUE), call = -5)
|
||||
)
|
||||
}
|
||||
|
||||
@ -152,7 +152,7 @@ count_R <- function(..., only_all_tested = FALSE) {
|
||||
only_all_tested = only_all_tested,
|
||||
only_count = TRUE
|
||||
),
|
||||
error = function(e) stop_(e$message, call = -5)
|
||||
error = function(e) stop_(gsub("in rsi_calc(): ", "", e$message, fixed = TRUE), call = -5)
|
||||
)
|
||||
}
|
||||
|
||||
@ -168,7 +168,7 @@ count_IR <- function(..., only_all_tested = FALSE) {
|
||||
only_all_tested = only_all_tested,
|
||||
only_count = TRUE
|
||||
),
|
||||
error = function(e) stop_(e$message, call = -5)
|
||||
error = function(e) stop_(gsub("in rsi_calc(): ", "", e$message, fixed = TRUE), call = -5)
|
||||
)
|
||||
}
|
||||
|
||||
@ -181,7 +181,7 @@ count_I <- function(..., only_all_tested = FALSE) {
|
||||
only_all_tested = only_all_tested,
|
||||
only_count = TRUE
|
||||
),
|
||||
error = function(e) stop_(e$message, call = -5)
|
||||
error = function(e) stop_(gsub("in rsi_calc(): ", "", e$message, fixed = TRUE), call = -5)
|
||||
)
|
||||
}
|
||||
|
||||
@ -194,7 +194,7 @@ count_SI <- function(..., only_all_tested = FALSE) {
|
||||
only_all_tested = only_all_tested,
|
||||
only_count = TRUE
|
||||
),
|
||||
error = function(e) stop_(e$message, call = -5)
|
||||
error = function(e) stop_(gsub("in rsi_calc(): ", "", e$message, fixed = TRUE), call = -5)
|
||||
)
|
||||
}
|
||||
|
||||
@ -210,7 +210,7 @@ count_S <- function(..., only_all_tested = FALSE) {
|
||||
only_all_tested = only_all_tested,
|
||||
only_count = TRUE
|
||||
),
|
||||
error = function(e) stop_(e$message, call = -5)
|
||||
error = function(e) stop_(gsub("in rsi_calc(): ", "", e$message, fixed = TRUE), call = -5)
|
||||
)
|
||||
}
|
||||
|
||||
@ -223,7 +223,7 @@ count_all <- function(..., only_all_tested = FALSE) {
|
||||
only_all_tested = only_all_tested,
|
||||
only_count = TRUE
|
||||
),
|
||||
error = function(e) stop_(e$message, call = -5)
|
||||
error = function(e) stop_(gsub("in rsi_calc(): ", "", e$message, fixed = TRUE), call = -5)
|
||||
)
|
||||
}
|
||||
|
||||
@ -236,8 +236,7 @@ n_rsi <- count_all
|
||||
count_df <- function(data,
|
||||
translate_ab = "name",
|
||||
language = get_AMR_locale(),
|
||||
combine_SI = TRUE,
|
||||
combine_IR = FALSE) {
|
||||
combine_SI = TRUE) {
|
||||
tryCatch(
|
||||
rsi_calc_df(
|
||||
type = "count",
|
||||
@ -245,9 +244,8 @@ count_df <- function(data,
|
||||
translate_ab = translate_ab,
|
||||
language = language,
|
||||
combine_SI = combine_SI,
|
||||
combine_IR = combine_IR,
|
||||
combine_SI_missing = missing(combine_SI)
|
||||
confidence_level = 0.95 # doesn't matter, will be removed
|
||||
),
|
||||
error = function(e) stop_(e$message, call = -5)
|
||||
error = function(e) stop_(gsub("in rsi_calc_df(): ", "", e$message, fixed = TRUE), call = -5)
|
||||
)
|
||||
}
|
||||
|
||||
@ -126,7 +126,7 @@
|
||||
#' @return A [logical] vector
|
||||
#' @source Methodology of this function is strictly based on:
|
||||
#'
|
||||
#' - **M39 Analysis and Presentation of Cumulative Antimicrobial Susceptibility Test Data, 4th Edition**, 2014, *Clinical and Laboratory Standards Institute (CLSI)*. <https://clsi.org/standards/products/microbiology/documents/m39/>.
|
||||
#' - **M39 Analysis and Presentation of Cumulative Antimicrobial Susceptibility Test Data, 5th Edition**, 2022, *Clinical and Laboratory Standards Institute (CLSI)*. <https://clsi.org/standards/products/microbiology/documents/m39/>.
|
||||
#'
|
||||
#' - Hindler JF and Stelling J (2007). **Analysis and Presentation of Cumulative Antibiograms: A New Consensus Guideline from the Clinical and Laboratory Standards Institute.** Clinical Infectious Diseases, 44(6), 867-873. \doi{10.1086/511864}
|
||||
#' @examples
|
||||
|
||||
@ -183,7 +183,6 @@ ggplot_rsi <- function(data,
|
||||
limits = NULL,
|
||||
translate_ab = "name",
|
||||
combine_SI = TRUE,
|
||||
combine_IR = FALSE,
|
||||
minimum = 30,
|
||||
language = get_AMR_locale(),
|
||||
nrow = NULL,
|
||||
@ -213,7 +212,6 @@ ggplot_rsi <- function(data,
|
||||
meet_criteria(limits, allow_class = c("numeric", "integer"), has_length = 2, allow_NULL = TRUE, allow_NA = TRUE)
|
||||
meet_criteria(translate_ab, allow_class = c("character", "logical"), has_length = 1, allow_NA = TRUE)
|
||||
meet_criteria(combine_SI, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(combine_IR, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(minimum, allow_class = c("numeric", "integer"), has_length = 1, is_finite = TRUE)
|
||||
language <- validate_language(language)
|
||||
meet_criteria(nrow, allow_class = c("numeric", "integer"), has_length = 1, allow_NULL = TRUE, is_positive = TRUE, is_finite = TRUE)
|
||||
@ -254,7 +252,7 @@ ggplot_rsi <- function(data,
|
||||
geom_rsi(
|
||||
position = position, x = x, fill = fill, translate_ab = translate_ab,
|
||||
minimum = minimum, language = language,
|
||||
combine_SI = combine_SI, combine_IR = combine_IR, ...
|
||||
combine_SI = combine_SI, ...
|
||||
) +
|
||||
theme_rsi()
|
||||
|
||||
@ -275,7 +273,6 @@ ggplot_rsi <- function(data,
|
||||
minimum = minimum,
|
||||
language = language,
|
||||
combine_SI = combine_SI,
|
||||
combine_IR = combine_IR,
|
||||
datalabels.size = datalabels.size,
|
||||
datalabels.colour = datalabels.colour
|
||||
)
|
||||
@ -305,7 +302,6 @@ geom_rsi <- function(position = NULL,
|
||||
minimum = 30,
|
||||
language = get_AMR_locale(),
|
||||
combine_SI = TRUE,
|
||||
combine_IR = FALSE,
|
||||
...) {
|
||||
x <- x[1]
|
||||
stop_ifnot_installed("ggplot2")
|
||||
@ -317,7 +313,6 @@ geom_rsi <- function(position = NULL,
|
||||
meet_criteria(minimum, allow_class = c("numeric", "integer"), has_length = 1, is_finite = TRUE)
|
||||
language <- validate_language(language)
|
||||
meet_criteria(combine_SI, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(combine_IR, allow_class = "logical", has_length = 1)
|
||||
|
||||
y <- "value"
|
||||
if (missing(position) || is.null(position)) {
|
||||
@ -350,8 +345,7 @@ geom_rsi <- function(position = NULL,
|
||||
translate_ab = translate_ab,
|
||||
language = language,
|
||||
minimum = minimum,
|
||||
combine_SI = combine_SI,
|
||||
combine_IR = combine_IR
|
||||
combine_SI = combine_SI
|
||||
)
|
||||
},
|
||||
mapping = ggplot2::aes_string(x = x, y = y, fill = fill),
|
||||
@ -496,7 +490,6 @@ labels_rsi_count <- function(position = NULL,
|
||||
minimum = 30,
|
||||
language = get_AMR_locale(),
|
||||
combine_SI = TRUE,
|
||||
combine_IR = FALSE,
|
||||
datalabels.size = 3,
|
||||
datalabels.colour = "grey15") {
|
||||
stop_ifnot_installed("ggplot2")
|
||||
@ -506,7 +499,6 @@ labels_rsi_count <- function(position = NULL,
|
||||
meet_criteria(minimum, allow_class = c("numeric", "integer"), has_length = 1, is_finite = TRUE)
|
||||
language <- validate_language(language)
|
||||
meet_criteria(combine_SI, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(combine_IR, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(datalabels.size, allow_class = c("numeric", "integer"), has_length = 1, is_positive = TRUE, is_finite = TRUE)
|
||||
meet_criteria(datalabels.colour, allow_class = "character", has_length = 1)
|
||||
|
||||
@ -533,7 +525,6 @@ labels_rsi_count <- function(position = NULL,
|
||||
data = x,
|
||||
translate_ab = translate_ab,
|
||||
combine_SI = combine_SI,
|
||||
combine_IR = combine_IR,
|
||||
minimum = minimum,
|
||||
language = language
|
||||
)
|
||||
|
||||
117
R/proportion.R
117
R/proportion.R
@ -39,11 +39,15 @@
|
||||
#' @param data a [data.frame] containing columns with class [`rsi`] (see [as.rsi()])
|
||||
#' @param translate_ab a column name of the [antibiotics] data set to translate the antibiotic abbreviations to, using [ab_property()]
|
||||
#' @inheritParams ab_property
|
||||
#' @param combine_SI a [logical] to indicate whether all values of S and I must be merged into one, so the output only consists of S+I vs. R (susceptible vs. resistant). This used to be the argument `combine_IR`, but this now follows the redefinition by EUCAST about the interpretation of I (increased exposure) in 2019, see section 'Interpretation of S, I and R' below. Default is `TRUE`.
|
||||
#' @param combine_IR a [logical] to indicate whether all values of I and R must be merged into one, so the output only consists of S vs. I+R (susceptible vs. non-susceptible). This is outdated, see argument `combine_SI`.
|
||||
#' @param combine_SI a [logical] to indicate whether all values of S and I must be merged into one, so the output only consists of S+I vs. R (susceptible vs. resistant), defaults to `TRUE`
|
||||
#' @param ab_result antibiotic results to test against, must be one of more values of "R", "S", "I"
|
||||
#' @param confidence_level the confidence level for the returned confidence interval. For the calculation, the number of S or SI isolates, and R isolates are compared with the total number of available isolates with R, S, or I by using [binom.test()], i.e., the Clopper-Pearson method.
|
||||
#' @param side the side of the confidence interval to return. Defaults to `"both"` for a length 2 vector, but can also be (abbreviated as) `"min"`/`"left"`/`"lower"`/`"less"` or `"max"`/`"right"`/`"higher"`/`"greater"`.
|
||||
#' @inheritSection as.rsi Interpretation of R and S/I
|
||||
#' @details
|
||||
#' The function [resistance()] is equal to the function [proportion_R()]. The function [susceptibility()] is equal to the function [proportion_SI()].
|
||||
#'
|
||||
#' Use [rsi_confidence_interval()] to calculate the confidence interval, which relies on [binom.test()], i.e., the Clopper-Pearson method. This function returns a vector of length 2 at default for antimicrobial *resistance*. Change the `side` argument to "left"/"min" or "right"/"max" to return a single value, and change the `ab_result` argument to e.g. `c("S", "I")` to test for antimicrobial *susceptibility*, see Examples.
|
||||
#'
|
||||
#' **Remember that you should filter your data to let it contain only first isolates!** This is needed to exclude duplicates and to reduce selection bias. Use [first_isolate()] to determine them in your data set.
|
||||
#'
|
||||
@ -84,7 +88,7 @@
|
||||
#' ```
|
||||
#'
|
||||
#' Using `only_all_tested` has no impact when only using one antibiotic as input.
|
||||
#' @source **M39 Analysis and Presentation of Cumulative Antimicrobial Susceptibility Test Data, 4th Edition**, 2014, *Clinical and Laboratory Standards Institute (CLSI)*. <https://clsi.org/standards/products/microbiology/documents/m39/>.
|
||||
#' @source **M39 Analysis and Presentation of Cumulative Antimicrobial Susceptibility Test Data, 5th Edition**, 2022, *Clinical and Laboratory Standards Institute (CLSI)*. <https://clsi.org/standards/products/microbiology/documents/m39/>.
|
||||
#' @seealso [AMR::count()] to count resistant and susceptible isolates.
|
||||
#' @return A [double] or, when `as_percent = TRUE`, a [character].
|
||||
#' @rdname proportion
|
||||
@ -96,8 +100,16 @@
|
||||
#' # run ?example_isolates for more info.
|
||||
#'
|
||||
#' # base R ------------------------------------------------------------
|
||||
#' resistance(example_isolates$AMX) # determines %R
|
||||
#' susceptibility(example_isolates$AMX) # determines %S+I
|
||||
#' # determines %R
|
||||
#' resistance(example_isolates$AMX)
|
||||
#' rsi_confidence_interval(example_isolates$AMX)
|
||||
#' rsi_confidence_interval(example_isolates$AMX,
|
||||
#' confidence_level = 0.975)
|
||||
#'
|
||||
#' # determines %S+I:
|
||||
#' susceptibility(example_isolates$AMX)
|
||||
#' rsi_confidence_interval(example_isolates$AMX,
|
||||
#' ab_result = c("S", "I"))
|
||||
#'
|
||||
#' # be more specific
|
||||
#' proportion_S(example_isolates$AMX)
|
||||
@ -109,13 +121,28 @@
|
||||
#' # dplyr -------------------------------------------------------------
|
||||
#' \donttest{
|
||||
#' if (require("dplyr")) {
|
||||
#'
|
||||
#' example_isolates %>%
|
||||
#' group_by(ward) %>%
|
||||
#' summarise(
|
||||
#' r = resistance(CIP),
|
||||
#' n = n_rsi(CIP)
|
||||
#' ) # n_rsi works like n_distinct in dplyr, see ?n_rsi
|
||||
#'
|
||||
#'
|
||||
#' }
|
||||
#' if (require("dplyr")) {
|
||||
#'
|
||||
#' example_isolates %>%
|
||||
#' group_by(ward) %>%
|
||||
#' summarise(
|
||||
#' cipro_R = resistance(CIP),
|
||||
#' ci_min = rsi_confidence_interval(CIP, side = "min"),
|
||||
#' ci_max = rsi_confidence_interval(CIP, side = "max"),
|
||||
#' )
|
||||
#'
|
||||
#' }
|
||||
#' if (require("dplyr")) {
|
||||
#'
|
||||
#' example_isolates %>%
|
||||
#' group_by(ward) %>%
|
||||
#' summarise(
|
||||
@ -190,7 +217,7 @@ resistance <- function(...,
|
||||
only_all_tested = only_all_tested,
|
||||
only_count = FALSE
|
||||
),
|
||||
error = function(e) stop_(e$message, call = -5)
|
||||
error = function(e) stop_(gsub("in rsi_calc(): ", "", e$message, fixed = TRUE), call = -5)
|
||||
)
|
||||
}
|
||||
|
||||
@ -208,10 +235,67 @@ susceptibility <- function(...,
|
||||
only_all_tested = only_all_tested,
|
||||
only_count = FALSE
|
||||
),
|
||||
error = function(e) stop_(e$message, call = -5)
|
||||
error = function(e) stop_(gsub("in rsi_calc(): ", "", e$message, fixed = TRUE), call = -5)
|
||||
)
|
||||
}
|
||||
|
||||
#' @rdname proportion
|
||||
#' @export
|
||||
rsi_confidence_interval <- function(...,
|
||||
ab_result = "R",
|
||||
minimum = 30,
|
||||
as_percent = FALSE,
|
||||
only_all_tested = FALSE,
|
||||
confidence_level = 0.95,
|
||||
side = "both") {
|
||||
meet_criteria(ab_result, allow_class = c("character", "rsi"), has_length = c(1, 2, 3), is_in = c("R", "S", "I"))
|
||||
meet_criteria(confidence_level, allow_class = "numeric", is_positive = TRUE, has_length = 1)
|
||||
meet_criteria(side, allow_class = "character", has_length = 1, is_in = c("both", "b", "left", "l", "lower", "lowest", "less", "min", "right", "r", "higher", "highest", "greater", "g", "max"))
|
||||
x <- tryCatch(
|
||||
rsi_calc(...,
|
||||
ab_result = ab_result,
|
||||
only_all_tested = only_all_tested,
|
||||
only_count = TRUE
|
||||
),
|
||||
error = function(e) stop_(gsub("in rsi_calc(): ", "", e$message, fixed = TRUE), call = -5)
|
||||
)
|
||||
n <- tryCatch(
|
||||
rsi_calc(...,
|
||||
ab_result = c("S", "I", "R"),
|
||||
only_all_tested = only_all_tested,
|
||||
only_count = TRUE
|
||||
),
|
||||
error = function(e) stop_(gsub("in rsi_calc(): ", "", e$message, fixed = TRUE), call = -5)
|
||||
)
|
||||
|
||||
if (n < minimum) {
|
||||
warning_("Introducing NA: ",
|
||||
ifelse(n == 0, "no", paste("only", n)),
|
||||
" results available for `rsi_confidence_interval()` (`minimum` = ", minimum, ").",
|
||||
call = FALSE
|
||||
)
|
||||
if (as_percent == TRUE) {
|
||||
return(NA_character_)
|
||||
} else {
|
||||
return(NA_real_)
|
||||
}
|
||||
}
|
||||
|
||||
out <- stats::binom.test(x = x, n = n, conf.level = confidence_level)$conf.int
|
||||
out <- set_clean_class(out, "double")
|
||||
|
||||
if (side %in% c("left", "l", "lower", "lowest", "less", "min")) {
|
||||
out <- out[1]
|
||||
} else if (side %in% c("right", "r", "higher", "highest", "greater", "g", "max")) {
|
||||
out <- out[2]
|
||||
}
|
||||
if (as_percent == TRUE) {
|
||||
percentage(out, digits = 1)
|
||||
} else {
|
||||
out
|
||||
}
|
||||
}
|
||||
|
||||
#' @rdname proportion
|
||||
#' @export
|
||||
proportion_R <- function(...,
|
||||
@ -226,7 +310,7 @@ proportion_R <- function(...,
|
||||
only_all_tested = only_all_tested,
|
||||
only_count = FALSE
|
||||
),
|
||||
error = function(e) stop_(e$message, call = -5)
|
||||
error = function(e) stop_(gsub("in rsi_calc(): ", "", e$message, fixed = TRUE), call = -5)
|
||||
)
|
||||
}
|
||||
|
||||
@ -244,7 +328,7 @@ proportion_IR <- function(...,
|
||||
only_all_tested = only_all_tested,
|
||||
only_count = FALSE
|
||||
),
|
||||
error = function(e) stop_(e$message, call = -5)
|
||||
error = function(e) stop_(gsub("in rsi_calc(): ", "", e$message, fixed = TRUE), call = -5)
|
||||
)
|
||||
}
|
||||
|
||||
@ -262,7 +346,7 @@ proportion_I <- function(...,
|
||||
only_all_tested = only_all_tested,
|
||||
only_count = FALSE
|
||||
),
|
||||
error = function(e) stop_(e$message, call = -5)
|
||||
error = function(e) stop_(gsub("in rsi_calc(): ", "", e$message, fixed = TRUE), call = -5)
|
||||
)
|
||||
}
|
||||
|
||||
@ -280,7 +364,7 @@ proportion_SI <- function(...,
|
||||
only_all_tested = only_all_tested,
|
||||
only_count = FALSE
|
||||
),
|
||||
error = function(e) stop_(e$message, call = -5)
|
||||
error = function(e) stop_(gsub("in rsi_calc(): ", "", e$message, fixed = TRUE), call = -5)
|
||||
)
|
||||
}
|
||||
|
||||
@ -298,7 +382,7 @@ proportion_S <- function(...,
|
||||
only_all_tested = only_all_tested,
|
||||
only_count = FALSE
|
||||
),
|
||||
error = function(e) stop_(e$message, call = -5)
|
||||
error = function(e) stop_(gsub("in rsi_calc(): ", "", e$message, fixed = TRUE), call = -5)
|
||||
)
|
||||
}
|
||||
|
||||
@ -310,7 +394,7 @@ proportion_df <- function(data,
|
||||
minimum = 30,
|
||||
as_percent = FALSE,
|
||||
combine_SI = TRUE,
|
||||
combine_IR = FALSE) {
|
||||
confidence_level = 0.95) {
|
||||
tryCatch(
|
||||
rsi_calc_df(
|
||||
type = "proportion",
|
||||
@ -320,9 +404,8 @@ proportion_df <- function(data,
|
||||
minimum = minimum,
|
||||
as_percent = as_percent,
|
||||
combine_SI = combine_SI,
|
||||
combine_IR = combine_IR,
|
||||
combine_SI_missing = missing(combine_SI)
|
||||
confidence_level = confidence_level
|
||||
),
|
||||
error = function(e) stop_(e$message, call = -5)
|
||||
error = function(e) stop_(gsub("in rsi_calc_df(): ", "", e$message, fixed = TRUE), call = -5)
|
||||
)
|
||||
}
|
||||
|
||||
67
R/rsi_calc.R
67
R/rsi_calc.R
@ -40,11 +40,11 @@ rsi_calc <- function(...,
|
||||
as_percent = FALSE,
|
||||
only_all_tested = FALSE,
|
||||
only_count = FALSE) {
|
||||
meet_criteria(ab_result, allow_class = c("character", "numeric", "integer"), has_length = c(1, 2, 3), .call_depth = 1)
|
||||
meet_criteria(minimum, allow_class = c("numeric", "integer"), has_length = 1, is_finite = TRUE, .call_depth = 1)
|
||||
meet_criteria(as_percent, allow_class = "logical", has_length = 1, .call_depth = 1)
|
||||
meet_criteria(only_all_tested, allow_class = "logical", has_length = 1, .call_depth = 1)
|
||||
meet_criteria(only_count, allow_class = "logical", has_length = 1, .call_depth = 1)
|
||||
meet_criteria(ab_result, allow_class = c("character", "numeric", "integer"), has_length = c(1, 2, 3))
|
||||
meet_criteria(minimum, allow_class = c("numeric", "integer"), has_length = 1, is_finite = TRUE)
|
||||
meet_criteria(as_percent, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(only_all_tested, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(only_count, allow_class = "logical", has_length = 1)
|
||||
|
||||
data_vars <- dots2vars(...)
|
||||
|
||||
@ -221,21 +221,15 @@ rsi_calc_df <- function(type, # "proportion", "count" or "both"
|
||||
minimum = 30,
|
||||
as_percent = FALSE,
|
||||
combine_SI = TRUE,
|
||||
combine_IR = FALSE,
|
||||
combine_SI_missing = FALSE) {
|
||||
meet_criteria(type, is_in = c("proportion", "count", "both"), has_length = 1, .call_depth = 1)
|
||||
meet_criteria(data, allow_class = "data.frame", contains_column_class = "rsi", .call_depth = 1)
|
||||
meet_criteria(translate_ab, allow_class = c("character", "logical"), has_length = 1, allow_NA = TRUE, .call_depth = 1)
|
||||
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE, .call_depth = 1)
|
||||
meet_criteria(minimum, allow_class = c("numeric", "integer"), has_length = 1, is_finite = TRUE, .call_depth = 1)
|
||||
meet_criteria(as_percent, allow_class = "logical", has_length = 1, .call_depth = 1)
|
||||
meet_criteria(combine_SI, allow_class = "logical", has_length = 1, .call_depth = 1)
|
||||
meet_criteria(combine_SI_missing, allow_class = "logical", has_length = 1, .call_depth = 1)
|
||||
|
||||
if (isTRUE(combine_IR) && isTRUE(combine_SI_missing)) {
|
||||
combine_SI <- FALSE
|
||||
}
|
||||
stop_if(isTRUE(combine_SI) & isTRUE(combine_IR), "either `combine_SI` or `combine_IR` can be TRUE, not both", call = -2)
|
||||
confidence_level = 0.95) {
|
||||
meet_criteria(type, is_in = c("proportion", "count", "both"), has_length = 1)
|
||||
meet_criteria(data, allow_class = "data.frame", contains_column_class = "rsi")
|
||||
meet_criteria(translate_ab, allow_class = c("character", "logical"), has_length = 1, allow_NA = TRUE)
|
||||
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
|
||||
meet_criteria(minimum, allow_class = c("numeric", "integer"), has_length = 1, is_finite = TRUE)
|
||||
meet_criteria(as_percent, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(combine_SI, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(confidence_level, allow_class = "numeric", has_length = 1)
|
||||
|
||||
translate_ab <- get_translate_ab(translate_ab)
|
||||
|
||||
@ -251,24 +245,22 @@ rsi_calc_df <- function(type, # "proportion", "count" or "both"
|
||||
}
|
||||
|
||||
data <- as.data.frame(data, stringsAsFactors = FALSE)
|
||||
if (isTRUE(combine_SI) || isTRUE(combine_IR)) {
|
||||
if (isTRUE(combine_SI)) {
|
||||
for (i in seq_len(ncol(data))) {
|
||||
if (is.rsi(data[, i, drop = TRUE])) {
|
||||
data[, i] <- as.character(data[, i, drop = TRUE])
|
||||
if (isTRUE(combine_SI)) {
|
||||
data[, i] <- gsub("(I|S)", "SI", data[, i, drop = TRUE])
|
||||
} else if (isTRUE(combine_IR)) {
|
||||
data[, i] <- gsub("(I|R)", "IR", data[, i, drop = TRUE])
|
||||
}
|
||||
data[, i] <- gsub("(I|S)", "SI", data[, i, drop = TRUE])
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
sum_it <- function(.data) {
|
||||
out <- data.frame(
|
||||
antibiotic = character(0),
|
||||
interpretation = character(0),
|
||||
value = double(0),
|
||||
ci_min = double(0),
|
||||
ci_max = double(0),
|
||||
isolates = integer(0),
|
||||
stringsAsFactors = FALSE
|
||||
)
|
||||
@ -281,19 +273,27 @@ rsi_calc_df <- function(type, # "proportion", "count" or "both"
|
||||
values <- .data[, i, drop = TRUE]
|
||||
if (isTRUE(combine_SI)) {
|
||||
values <- factor(values, levels = c("SI", "R"), ordered = TRUE)
|
||||
} else if (isTRUE(combine_IR)) {
|
||||
values <- factor(values, levels = c("S", "IR"), ordered = TRUE)
|
||||
} else {
|
||||
values <- factor(values, levels = c("S", "I", "R"), ordered = TRUE)
|
||||
}
|
||||
col_results <- as.data.frame(as.matrix(table(values)), stringsAsFactors = FALSE)
|
||||
col_results$interpretation <- rownames(col_results)
|
||||
col_results$isolates <- col_results[, 1, drop = TRUE]
|
||||
ddf <<- col_results
|
||||
if (NROW(col_results) > 0 && sum(col_results$isolates, na.rm = TRUE) > 0) {
|
||||
if (sum(col_results$isolates, na.rm = TRUE) >= minimum) {
|
||||
col_results$value <- col_results$isolates / sum(col_results$isolates, na.rm = TRUE)
|
||||
ci <- lapply(col_results$isolates,
|
||||
function(x) stats::binom.test(x = x,
|
||||
n = sum(col_results$isolates, na.rm = TRUE),
|
||||
conf.level = confidence_level)$conf.int)
|
||||
col_results$ci_min <- vapply(FUN.VALUE = double(1), ci, `[`, 1)
|
||||
col_results$ci_max <- vapply(FUN.VALUE = double(1), ci, `[`, 2)
|
||||
} else {
|
||||
col_results$value <- rep(NA_real_, NROW(col_results))
|
||||
# confidence intervals also to NA
|
||||
col_results$ci_min <- col_results$value
|
||||
col_results$ci_max <- col_results$value
|
||||
}
|
||||
out_new <- data.frame(
|
||||
antibiotic = ifelse(isFALSE(translate_ab),
|
||||
@ -302,6 +302,8 @@ rsi_calc_df <- function(type, # "proportion", "count" or "both"
|
||||
),
|
||||
interpretation = col_results$interpretation,
|
||||
value = col_results$value,
|
||||
ci_min = col_results$ci_min,
|
||||
ci_max = col_results$ci_max,
|
||||
isolates = col_results$isolates,
|
||||
stringsAsFactors = FALSE
|
||||
)
|
||||
@ -341,8 +343,6 @@ rsi_calc_df <- function(type, # "proportion", "count" or "both"
|
||||
# apply factors for right sorting in interpretation
|
||||
if (isTRUE(combine_SI)) {
|
||||
out$interpretation <- factor(out$interpretation, levels = c("SI", "R"), ordered = TRUE)
|
||||
} else if (isTRUE(combine_IR)) {
|
||||
out$interpretation <- factor(out$interpretation, levels = c("S", "IR"), ordered = TRUE)
|
||||
} else {
|
||||
# don't use as.rsi() here, as it would add the class 'rsi' and we would like
|
||||
# the same data structure as output, regardless of input
|
||||
@ -357,10 +357,13 @@ rsi_calc_df <- function(type, # "proportion", "count" or "both"
|
||||
}
|
||||
|
||||
if (type == "proportion") {
|
||||
# remove number of isolates
|
||||
out <- subset(out, select = -c(isolates))
|
||||
} else if (type == "count") {
|
||||
# set value to be number of isolates
|
||||
out$value <- out$isolates
|
||||
out <- subset(out, select = -c(isolates))
|
||||
# remove redundant columns
|
||||
out <- subset(out, select = -c(ci_min, ci_max, isolates))
|
||||
}
|
||||
|
||||
rownames(out) <- NULL
|
||||
|
||||
24
R/rsi_df.R
24
R/rsi_df.R
@ -35,16 +35,18 @@ rsi_df <- function(data,
|
||||
minimum = 30,
|
||||
as_percent = FALSE,
|
||||
combine_SI = TRUE,
|
||||
combine_IR = FALSE) {
|
||||
rsi_calc_df(
|
||||
type = "both",
|
||||
data = data,
|
||||
translate_ab = translate_ab,
|
||||
language = language,
|
||||
minimum = minimum,
|
||||
as_percent = as_percent,
|
||||
combine_SI = combine_SI,
|
||||
combine_IR = combine_IR,
|
||||
combine_SI_missing = missing(combine_SI)
|
||||
confidence_level = 0.95) {
|
||||
tryCatch(
|
||||
rsi_calc_df(
|
||||
type = "both",
|
||||
data = data,
|
||||
translate_ab = translate_ab,
|
||||
language = language,
|
||||
minimum = minimum,
|
||||
as_percent = as_percent,
|
||||
combine_SI = combine_SI,
|
||||
confidence_level = confidence_level
|
||||
),
|
||||
error = function(e) stop_(gsub("in rsi_calc_df(): ", "", e$message, fixed = TRUE), call = -5)
|
||||
)
|
||||
}
|
||||
|
||||
Reference in New Issue
Block a user