mirror of
https://github.com/msberends/AMR.git
synced 2025-07-09 01:22:25 +02:00
(v0.8.0.9030) depend on tidyr >= 1.0.0
This commit is contained in:
@ -32,7 +32,7 @@
|
||||
#' @inheritParams rsi_df
|
||||
#' @inheritParams base::formatC
|
||||
#' @importFrom dplyr %>% rename group_by select mutate filter summarise ungroup
|
||||
#' @importFrom tidyr spread
|
||||
#' @importFrom tidyr pivot_longer
|
||||
#' @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}.
|
||||
@ -80,7 +80,7 @@ bug_drug_combinations <- function(x,
|
||||
FUN(...)) %>%
|
||||
group_by(mo) %>%
|
||||
select_if(is.rsi) %>%
|
||||
gather("ab", "value", -mo) %>%
|
||||
pivot_longer(-mo, names_to = "ab") %>%
|
||||
group_by(mo, ab) %>%
|
||||
summarise(S = sum(value == "S", na.rm = TRUE),
|
||||
I = sum(value == "I", na.rm = TRUE),
|
||||
@ -93,7 +93,7 @@ bug_drug_combinations <- function(x,
|
||||
}
|
||||
|
||||
#' @importFrom dplyr everything rename %>% ungroup group_by summarise mutate_all arrange everything lag
|
||||
#' @importFrom tidyr spread
|
||||
#' @importFrom tidyr pivot_wider
|
||||
#' @importFrom cleaner percentage
|
||||
#' @exportMethod format.bug_drug_combinations
|
||||
#' @export
|
||||
@ -135,7 +135,7 @@ format.bug_drug_combinations <- function(x,
|
||||
}
|
||||
ab_txt
|
||||
}
|
||||
|
||||
|
||||
y <- x %>%
|
||||
mutate(ab = as.ab(ab),
|
||||
ab_txt = give_ab_name(ab = ab, format = translate_ab, language = language)) %>%
|
||||
@ -146,8 +146,9 @@ format.bug_drug_combinations <- function(x,
|
||||
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) %>%
|
||||
spread(mo, txt) %>%
|
||||
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) %>%
|
||||
|
@ -29,12 +29,13 @@
|
||||
#' @param year_every unit of sequence between lowest year found in the data and \code{year_max}
|
||||
#' @param minimum minimal amount of available isolates per year to include. Years containing less observations will be estimated by the model.
|
||||
#' @param model the statistical model of choice. This could be a generalised linear regression model with binomial distribution (i.e. using \code{\link{glm}(..., family = \link{binomial})}), assuming that a period of zero resistance was followed by a period of increasing resistance leading slowly to more and more resistance. See Details for all valid options.
|
||||
#' @param I_as_S a logical to indicate whether values \code{I} should be treated as \code{S} (will otherwise be treated as \code{R})
|
||||
#' @param I_as_S a logical to indicate whether values \code{I} should be treated as \code{S} (will otherwise be treated as \code{R}). The default, \code{TRUE}, follows the redefinition by EUCAST about the interpretion of I (increased exposure) in 2019, see section 'Interpretation of S, I and R' below.
|
||||
#' @param preserve_measurements a logical to indicate whether predictions of years that are actually available in the data should be overwritten by the original data. The standard errors of those years will be \code{NA}.
|
||||
#' @param info a logical to indicate whether textual analysis should be printed with the name and \code{\link{summary}} of the statistical model.
|
||||
#' @param main title of the plot
|
||||
#' @param ribbon a logical to indicate whether a ribbon should be shown (default) or error bars
|
||||
#' @param ... parameters passed on to functions
|
||||
#' @inheritSection as.rsi Interpretation of S, I and R
|
||||
#' @inheritParams first_isolate
|
||||
#' @inheritParams graphics::plot
|
||||
#' @details Valid options for the statistical model are:
|
||||
@ -59,6 +60,7 @@
|
||||
#' @export
|
||||
#' @importFrom stats predict glm lm
|
||||
#' @importFrom dplyr %>% pull mutate mutate_at n group_by_at summarise filter filter_at all_vars n_distinct arrange case_when n_groups transmute ungroup
|
||||
#' @importFrom tidyr pivot_wider
|
||||
#' @inheritSection AMR Read more on our website!
|
||||
#' @examples
|
||||
#' x <- resistance_predict(example_isolates, col_ab = "AMX", year_min = 2010, model = "binomial")
|
||||
@ -161,6 +163,7 @@ resistance_predict <- function(x,
|
||||
}
|
||||
|
||||
year <- function(x) {
|
||||
# don't depend on lubridate or so, would be overkill for only this function
|
||||
if (all(grepl("^[0-9]{4}$", x))) {
|
||||
x
|
||||
} else {
|
||||
@ -192,9 +195,12 @@ resistance_predict <- function(x,
|
||||
}
|
||||
|
||||
colnames(df) <- c("year", "antibiotic", "observations")
|
||||
|
||||
df <- df %>%
|
||||
filter(!is.na(antibiotic)) %>%
|
||||
tidyr::spread(antibiotic, observations, fill = 0) %>%
|
||||
pivot_wider(names_from = antibiotic,
|
||||
values_from = observations,
|
||||
values_fill = list(observations = 0)) %>%
|
||||
filter((R + S) >= minimum)
|
||||
df_matrix <- df %>%
|
||||
ungroup() %>%
|
||||
|
11
R/rsi_calc.R
11
R/rsi_calc.R
@ -167,8 +167,8 @@ rsi_calc <- function(...,
|
||||
}
|
||||
}
|
||||
|
||||
#' @importFrom dplyr %>% summarise_if mutate select everything bind_rows
|
||||
#' @importFrom tidyr gather
|
||||
#' @importFrom dplyr %>% summarise_if mutate select everything bind_rows arrange
|
||||
#' @importFrom tidyr pivot_longer
|
||||
rsi_calc_df <- function(type, # "proportion" or "count"
|
||||
data,
|
||||
translate_ab = "name",
|
||||
@ -247,12 +247,13 @@ rsi_calc_df <- function(type, # "proportion" or "count"
|
||||
}
|
||||
|
||||
res <- res %>%
|
||||
gather(antibiotic, value, -interpretation, -data.groups) %>%
|
||||
select(antibiotic, everything())
|
||||
pivot_longer(-c(interpretation, data.groups), names_to = "antibiotic") %>%
|
||||
select(antibiotic, everything()) %>%
|
||||
arrange(antibiotic, interpretation)
|
||||
|
||||
if (!translate_ab == FALSE) {
|
||||
res <- res %>% mutate(antibiotic = AMR::ab_property(antibiotic, property = translate_ab, language = language))
|
||||
}
|
||||
|
||||
res
|
||||
as.data.frame(res, stringsAsFactors = FALSE)
|
||||
}
|
||||
|
Reference in New Issue
Block a user