mirror of
https://github.com/msberends/AMR.git
synced 2025-07-09 13:42:04 +02:00
(v1.1.0.9004) lose dependencies
This commit is contained in:
@ -32,7 +32,6 @@
|
||||
#' @param ... arguments passed on to `FUN`
|
||||
#' @inheritParams rsi_df
|
||||
#' @inheritParams base::formatC
|
||||
#' @importFrom dplyr %>% rename group_by select mutate filter summarise ungroup
|
||||
#' @importFrom tidyr pivot_longer
|
||||
#' @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.
|
||||
#'
|
||||
@ -74,13 +73,15 @@ bug_drug_combinations <- function(x,
|
||||
stop("`col_mo` must be set.", call. = FALSE)
|
||||
}
|
||||
|
||||
x <- x %>%
|
||||
as.data.frame(stringsAsFactors = FALSE) %>%
|
||||
mutate(mo = x %>%
|
||||
pull(col_mo) %>%
|
||||
FUN(...)) %>%
|
||||
group_by(mo) %>%
|
||||
select_if(is.rsi) %>%
|
||||
select_rsi <- function(.data) {
|
||||
.data[, c(col_mo, names(which(sapply(.data, is.rsi))))]
|
||||
}
|
||||
|
||||
x <- x %>% as.data.frame(stringsAsFactors = FALSE)
|
||||
x$mo <- FUN(x[, col_mo, drop = TRUE])
|
||||
|
||||
x <- x %>%
|
||||
select_rsi() %>%
|
||||
pivot_longer(-mo, names_to = "ab") %>%
|
||||
group_by(mo, ab) %>%
|
||||
summarise(S = sum(value == "S", na.rm = TRUE),
|
||||
@ -93,9 +94,7 @@ bug_drug_combinations <- function(x,
|
||||
structure(.Data = x, class = c("bug_drug_combinations", class(x)))
|
||||
}
|
||||
|
||||
#' @importFrom dplyr everything rename %>% ungroup group_by summarise mutate_all arrange everything lag
|
||||
#' @importFrom tidyr pivot_wider
|
||||
#' @importFrom cleaner percentage
|
||||
#' @exportMethod format.bug_drug_combinations
|
||||
#' @export
|
||||
#' @rdname bug_drug_combinations
|
||||
@ -110,10 +109,10 @@ format.bug_drug_combinations <- function(x,
|
||||
decimal.mark = getOption("OutDec"),
|
||||
big.mark = ifelse(decimal.mark == ",", ".", ","),
|
||||
...) {
|
||||
x <- x %>% filter(total >= minimum)
|
||||
x <- x %>% subset(total >= minimum)
|
||||
|
||||
if (remove_intrinsic_resistant == TRUE) {
|
||||
x <- x %>% filter(R != total)
|
||||
x <- x %>% subset(R != total)
|
||||
}
|
||||
if (combine_SI == TRUE | combine_IR == FALSE) {
|
||||
x$isolates <- x$R
|
||||
@ -137,26 +136,46 @@ format.bug_drug_combinations <- function(x,
|
||||
ab_txt
|
||||
}
|
||||
|
||||
remove_NAs <- function(.data) {
|
||||
as.data.frame(sapply(.data, function(x) ifelse(is.na(x), "", x), simplify = FALSE))
|
||||
}
|
||||
|
||||
create_var <- function(.data, ...) {
|
||||
dots <- list(...)
|
||||
for (i in seq_len(length(dots))) {
|
||||
.data[, names(dots)[i]] <- dots[[i]]
|
||||
}
|
||||
.data
|
||||
}
|
||||
|
||||
y <- x %>%
|
||||
mutate(ab = as.ab(ab),
|
||||
ab_txt = give_ab_name(ab = ab, format = translate_ab, language = language)) %>%
|
||||
create_var(ab = as.ab(x$ab),
|
||||
ab_txt = give_ab_name(ab = x$ab, format = translate_ab, language = language)) %>%
|
||||
group_by(ab, ab_txt, mo) %>%
|
||||
summarise(isolates = sum(isolates, na.rm = TRUE),
|
||||
total = sum(total, na.rm = TRUE)) %>%
|
||||
ungroup() %>%
|
||||
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)), ")")) %>%
|
||||
ungroup()
|
||||
|
||||
y <- y %>%
|
||||
create_var(txt = paste0(percentage(y$isolates / y$total, decimal.mark = decimal.mark, big.mark = big.mark),
|
||||
" (", trimws(format(y$isolates, big.mark = big.mark)), "/",
|
||||
trimws(format(y$total, big.mark = big.mark)), ")")) %>%
|
||||
select(ab, ab_txt, mo, txt) %>%
|
||||
arrange(mo) %>%
|
||||
pivot_wider(names_from = mo, values_from = txt) %>%
|
||||
mutate_all(~ifelse(is.na(.), "", .)) %>%
|
||||
mutate(ab_group = ab_group(ab, language = language),
|
||||
ab_txt) %>%
|
||||
select(ab_group, ab_txt, everything(), -ab) %>%
|
||||
arrange(ab_group, ab_txt) %>%
|
||||
mutate(ab_group = ifelse(ab_group != lag(ab_group) | is.na(lag(ab_group)), ab_group, ""))
|
||||
remove_NAs()
|
||||
|
||||
select_ab_vars <- function(.data) {
|
||||
.data[, c("ab_group", "ab_txt", colnames(.data)[!colnames(.data) %in% c("ab_group", "ab_txt", "ab")])]
|
||||
}
|
||||
|
||||
y <- y %>%
|
||||
create_var(ab_group = ab_group(y$ab, language = language)) %>%
|
||||
select_ab_vars() %>%
|
||||
arrange(ab_group, ab_txt)
|
||||
y <- y %>%
|
||||
create_var(ab_group = ifelse(y$ab_group != lag(y$ab_group) | is.na(lag(y$ab_group)), y$ab_group, ""))
|
||||
|
||||
if (add_ab_group == FALSE) {
|
||||
y <- y %>% select(-ab_group) %>% rename("Drug" = ab_txt)
|
||||
colnames(y)[1] <- translate_AMR(colnames(y)[1], language = get_locale(), only_unknown = FALSE)
|
||||
@ -170,8 +189,7 @@ format.bug_drug_combinations <- function(x,
|
||||
|
||||
#' @exportMethod print.bug_drug_combinations
|
||||
#' @export
|
||||
#' @importFrom crayon blue
|
||||
print.bug_drug_combinations <- function(x, ...) {
|
||||
print(as.data.frame(x, stringsAsFactors = FALSE))
|
||||
message(blue("NOTE: Use 'format()' on this result to get a publicable/printable format."))
|
||||
message(font_blue("NOTE: Use 'format()' on this result to get a publicable/printable format."))
|
||||
}
|
||||
|
Reference in New Issue
Block a user