P281424/AMR
1
0
Fork 0
mirror of https://github.com/msberends/AMR.git synced 2025-07-09 17:41:59 +02:00
Code Releases Activity

(v0.7.1.9091) percentage from clean pkg

Browse Source
This commit is contained in:
dr. M.S. (Matthijs) Berends
2019-09-30 16:45:36 +02:00
parent b39e7feae6
commit edb599ae0b
30 changed files with 419 additions and 435 deletions
Download Patch File Download Diff File Expand all files Collapse all files

1
R/amr.R
View File

@ -67,5 +67,4 @@
#' @rdname AMR
# # prevent NOTE on R >= 3.6
#' @importFrom microbenchmark microbenchmark
#' @importFrom scales percent
NULL

5
R/availability.R
View File

@ -27,6 +27,7 @@
#' @details The function returns a \code{data.frame} with columns \code{"resistant"} and \code{"visual_resistance"}. The values in that columns are calculated with \code{\link{portion_R}}.
#' @return \code{data.frame} with column names of \code{tbl} as row names
#' @inheritSection AMR Read more on our website!
#' @importFrom clean percentage
#' @export
#' @examples
#' availability(example_isolates)
@ -47,7 +48,7 @@ availability <- function(tbl, width = NULL) {
n <- base::sapply(tbl, function(x) base::length(x[!base::is.na(x)]))
R <- base::sapply(tbl, function(x) base::ifelse(is.rsi(x), portion_R(x, minimum = 0), NA))
R_print <- character(length(R))
R_print[!is.na(R)] <- percent(R[!is.na(R)], round = 1, force_zero = TRUE)
R_print[!is.na(R)] <- percentage(R[!is.na(R)])
R_print[is.na(R)] <- ""
if (is.null(width)) {
@ -77,7 +78,7 @@ availability <- function(tbl, width = NULL) {
x_chars_empty <- strrep("-", width - nchar(x_chars))
df <- data.frame(count = n,
available = percent(x, round = 1, force_zero = TRUE),
available = percentage(x),
visual_availabilty = paste0("|", x_chars, x_chars_empty, "|"),
resistant = R_print,
visual_resistance = vis_resistance)

4
R/bug_drug_combinations.R
View File

@ -33,7 +33,7 @@
#' @inheritParams base::formatC
#' @importFrom dplyr %>% rename group_by select mutate filter pull
#' @importFrom tidyr spread
#' @importFrom clean freq
#' @importFrom clean freq percentage
#' @details The function \code{format} calculates the resistance per bug-drug combination. Use \code{combine_IR = FALSE} (default) to test R vs. S+I and \code{combine_IR = TRUE} to test R+I vs. S.
#'
#' The language of the output can be overwritten with \code{options(AMR_locale)}, please see \link{translate}.
@ -140,7 +140,7 @@ format.bug_drug_combinations <- function(x,
summarise(isolates = sum(isolates, na.rm = TRUE),
total = sum(total, na.rm = TRUE)) %>%
ungroup() %>%
mutate(txt = paste0(percent(isolates / total, force_zero = TRUE, decimal.mark = decimal.mark, big.mark = big.mark),
mutate(txt = paste0(percentage(isolates / total, decimal.mark = decimal.mark, big.mark = big.mark),
" (", trimws(format(isolates, big.mark = big.mark)), "/",
trimws(format(total, big.mark = big.mark)), ")")) %>%
select(ab, ab_txt, mo, txt) %>%

5
R/first_isolate.R
View File

@ -75,6 +75,7 @@
#' @export
#' @importFrom dplyr arrange_at lag between row_number filter mutate arrange pull ungroup
#' @importFrom crayon blue bold silver
#' @importFrom clean percentage
#' @return Logical vector
#' @source Methodology of this function is based on: \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/}.
#' @inheritSection AMR Read more on our website!
@ -525,8 +526,8 @@ first_isolate <- function(x,
if (info == TRUE) {
n_found <- base::sum(all_first, na.rm = TRUE)
p_found_total <- percent(n_found / nrow(x), force_zero = TRUE)
p_found_scope <- percent(n_found / scope.size, force_zero = TRUE)
p_found_total <- percentage(n_found / nrow(x))
p_found_scope <- percentage(n_found / scope.size)
# mark up number of found
n_found <- base::format(n_found, big.mark = big.mark, decimal.mark = decimal.mark)
if (p_found_total != p_found_scope) {

10
R/freq.R
View File

@ -25,22 +25,26 @@ clean::freq
#' @exportMethod freq.mo
#' @importFrom dplyr n_distinct
#' @importFrom clean freq.default
#' @importFrom clean freq.default percentage
#' @export
#' @noRd
freq.mo <- function(x, ...) {
x_noNA <- as.mo(x[!is.na(x)]) # as.mo() to get the newest mo codes
grams <- mo_gramstain(x_noNA, language = NULL)
digits <- list(...)$digits
if (is.null(digits)) {
digits <- 2
}
freq.default(x = x, ...,
.add_header = list(`Gram-negative` = paste0(format(sum(grams == "Gram-negative", na.rm = TRUE),
big.mark = ",",
decimal.mark = "."),
" (", percent(sum(grams == "Gram-negative", na.rm = TRUE) / length(grams), force_zero = TRUE, round = 2),
" (", percentage(sum(grams == "Gram-negative", na.rm = TRUE) / length(grams), digits = digits),
")"),
`Gram-positive` = paste0(format(sum(grams == "Gram-positive", na.rm = TRUE),
big.mark = ",",
decimal.mark = "."),
" (", percent(sum(grams == "Gram-positive", na.rm = TRUE) / length(grams), force_zero = TRUE, round = 2),
" (", percentage(sum(grams == "Gram-positive", na.rm = TRUE) / length(grams), digits = digits),
")"),
`Nr of genera` = n_distinct(mo_genus(x_noNA, language = NULL)),
`Nr of species` = n_distinct(paste(mo_genus(x_noNA, language = NULL),

7
R/ggplot_rsi.R
View File

@ -58,7 +58,6 @@
#'
#' \code{ggplot_rsi} is a wrapper around all above functions that uses data as first input. This makes it possible to use this function after a pipe (\code{\%>\%}). See Examples.
#' @rdname ggplot_rsi
#' @importFrom utils installed.packages
#' @export
#' @inheritSection AMR Read more on our website!
#' @examples
@ -338,6 +337,7 @@ facet_rsi <- function(facet = c("interpretation", "antibiotic"), nrow = NULL) {
}
#' @rdname ggplot_rsi
#' @importFrom clean percentage
#' @export
scale_y_percent <- function(breaks = seq(0, 1, 0.1), limits = NULL) {
stopifnot_installed_package("ggplot2")
@ -346,7 +346,7 @@ scale_y_percent <- function(breaks = seq(0, 1, 0.1), limits = NULL) {
breaks <- breaks / 100
}
ggplot2::scale_y_continuous(breaks = breaks,
labels = percent(breaks),
labels = percentage(breaks),
limits = limits)
}
@ -387,6 +387,7 @@ theme_rsi <- function() {
#' @rdname ggplot_rsi
#' @importFrom dplyr mutate %>% group_by_at
#' @importFrom clean percentage
#' @export
labels_rsi_count <- function(position = NULL,
x = "antibiotic",
@ -417,7 +418,7 @@ labels_rsi_count <- function(position = NULL,
combine_SI = combine_SI,
combine_IR = combine_IR) %>%
group_by_at(x_name) %>%
mutate(lbl = paste0(percent(value / sum(value, na.rm = TRUE), force_zero = TRUE),
mutate(lbl = paste0(percentage(value / sum(value, na.rm = TRUE)),
"\n(n=", isolates, ")"))
})
}

16
R/misc.R
View File

@ -29,22 +29,6 @@ addin_insert_like <- function() {
rstudioapi::insertText(" %like% ")
}
percent_clean <- clean:::percent
# No export, no Rd
percent <- function(x, round = 1, force_zero = FALSE, decimal.mark = getOption("OutDec"), big.mark = ",", ...) {
if (decimal.mark == big.mark) {
if (decimal.mark == ",") {
big.mark <- "."
} else if (decimal.mark == ".") {
big.mark <- ","
} else {
big.mark <- " "
}
}
percent_clean(x = x, round = round, force_zero = force_zero,
decimal.mark = decimal.mark, big.mark = big.mark, ...)
}
#' @importFrom crayon blue bold red
#' @importFrom dplyr %>% pull
search_type_in_df <- function(x, type) {

3
R/mo.R
View File

@ -268,6 +268,7 @@ is.mo <- function(x) {
#' @importFrom dplyr %>% pull left_join n_distinct progress_estimated filter distinct
#' @importFrom data.table data.table as.data.table setkey
#' @importFrom crayon magenta red blue silver italic
#' @importFrom clean percentage
# param property a column name of AMR::microorganisms
# param initial_search logical - is FALSE when coming from uncertain tries, which uses exec_as.mo internally too
# param dyslexia_mode logical - also check for characters that resemble others
@ -1575,7 +1576,7 @@ exec_as.mo <- function(x,
total_failures <- length(x_input[as.character(x_input) %in% as.character(failures) & !x_input %in% c(NA, NULL, NaN)])
total_n <- length(x_input[!x_input %in% c(NA, NULL, NaN)])
msg <- paste0(nr2char(n_distinct(failures)), " unique ", plural[1],
" (covering ", percent(total_failures / total_n, round = 1, force_zero = TRUE),
" (covering ", percentage(total_failures / total_n),
") could not be coerced and ", plural[3], " considered 'unknown'")
if (n_distinct(failures) <= 10) {
msg <- paste0(msg, ": ", paste('"', unique(failures), '"', sep = "", collapse = ', '))

2
R/portion.R
View File

@ -26,7 +26,7 @@
#' \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 ... 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 the minimum allowed number of available (tested) isolates. Any isolate count lower than \code{minimum} will return \code{NA} with a warning. The default number of \code{30} isolates is advised by the Clinical and Laboratory Standards Institute (CLSI) as best practice, see Source.
#' @param as_percent a 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 a logical to indicate whether the output must be returned as a hundred fold with \% sign (a character) using\code{\link[clean]{percentage}}. A value of \code{0.123456} will then be returned as \code{"12.3\%"}.
#' @param only_all_tested (for combination therapies, i.e. using more than one variable for \code{...}) a logical to indicate that isolates must be tested for all antibiotics, see section \emph{Combination therapy} below
#' @param data a \code{data.frame} containing columns with class \code{rsi} (see \code{\link{as.rsi}})
#' @param translate_ab a column name of the \code{\link{antibiotics}} data set to translate the antibiotic abbreviations to, using \code{\link{ab_property}}

3
R/rsi_calc.R
View File

@ -39,6 +39,7 @@ dots2vars <- function(...) {
}
#' @importFrom dplyr %>% pull all_vars any_vars filter_all funs mutate_all
#' @importFrom clean percentage
rsi_calc <- function(...,
ab_result,
minimum = 0,
@ -162,7 +163,7 @@ rsi_calc <- function(...,
}
if (as_percent == TRUE) {
percent(fraction, force_zero = TRUE)
percentage(fraction, digits = 1)
} else {
fraction
}