P281424/AMR
1
0
Fork 0
mirror of https://github.com/msberends/AMR.git synced 2025-07-08 12:31:58 +02:00
Code Releases Activity

completely updated antibiotics

Browse Source
This commit is contained in:
dr. M.S. (Matthijs) Berends
2022-10-30 14:31:45 +01:00
parent 3d9faf89cf
commit d40e0ef20b
60 changed files with 102028 additions and 95116 deletions
Download Patch File Download Diff File Expand all files Collapse all files

5
R/aa_globals.R
View File

@ -79,6 +79,11 @@ TAXONOMY_VERSION <- list(
accessed_date = as.Date("2021-07-01"),
citation = "Public Health Information Network Vocabulary Access and Distribution System (PHIN VADS). US Edition of SNOMED CT from 1 September 2020. Value Set Name 'Microoganism', OID 2.16.840.1.114222.4.11.1009 (v12).",
url = "https://phinvads.cdc.gov"
),
LOINC = list(
accessed_date = as.Date("2022-10-30"),
citation = "Logical Observation Identifiers Names and Codes (LOINC), Version 2.73 (8 August, 2022).",
url = "https://loinc.org"
)
)

15
R/aa_helper_functions.R
View File

@ -350,9 +350,9 @@ stop_ifnot_installed <- function(package) {
stop("This function only works in RStudio when using R >= 3.2.", call. = FALSE)
} else if (any(!installed)) {
stop("This requires the ", vector_and(package[!installed]), " package.",
"\nTry to install with install.packages().",
call. = FALSE
)
"\nTry to install with install.packages().",
call. = FALSE
)
} else {
return(invisible())
}
@ -476,7 +476,7 @@ word_wrap <- function(...,
# remove extra space that was introduced (e.g. "Smith et al., 2022")
msg <- gsub(". ,", ".,", msg, fixed = TRUE)
msg <- gsub("[ ,", "[,", msg, fixed = TRUE)
msg
}
@ -864,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()`)
@ -881,14 +881,13 @@ 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", ".cols") %in% names(env), na.rm = TRUE) && valid_df(env$`.tbl`)) {
# an element `.tbl` will be in the environment when using scoped dplyr variants, with or without `dplyr::vars()`
# (e.g. `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))) {

24
R/ab.R
View File

@ -48,7 +48,7 @@
#' Use the [`ab_*`][ab_property()] functions to get properties based on the returned antibiotic ID, see *Examples*.
#'
#' Note: the [as.ab()] and [`ab_*`][ab_property()] functions may use very long regular expression to match brand names of antimicrobial agents. This may fail on some systems.
#'
#'
#' You can add your own manual codes to be considered by [as.ab()] and all [`ab_*`][ab_property()] functions, see [add_custom_antimicrobials()].
#' @section Source:
#' World Health Organization (WHO) Collaborating Centre for Drug Statistics Methodology: \url{https://www.whocc.no/atc_ddd_index/}
@ -84,7 +84,7 @@
#' # they use as.ab() internally:
#' ab_name("J01FA01") # "Erythromycin"
#' ab_name("eryt") # "Erythromycin"
#'
#'
#' \donttest{
#' if (require("dplyr")) {
#'
@ -170,16 +170,16 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) {
previously_coerced <- x %in% AMR_env$ab_previously_coerced$x
x_new[previously_coerced & is.na(x_new)] <- AMR_env$ab_previously_coerced$ab[match(x[is.na(x_new) & x %in% AMR_env$ab_previously_coerced$x], AMR_env$ab_previously_coerced$x)]
already_known <- known_names | known_codes_ab | known_codes_atc | known_codes_cid | previously_coerced
# fix for NAs
x_new[is.na(x)] <- NA
already_known[is.na(x)] <- FALSE
if (initial_search == TRUE && sum(already_known) < length(x)) {
progress <- progress_ticker(n = sum(!already_known), n_min = 25, print = info) # start if n >= 25
on.exit(close(progress))
}
for (i in which(!already_known)) {
if (initial_search == TRUE) {
progress$tick()
@ -490,15 +490,15 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) {
if (initial_search == TRUE && sum(already_known) < length(x)) {
close(progress)
}
# save to package env to save time for next time
AMR_env$ab_previously_coerced <- unique(rbind(AMR_env$ab_previously_coerced,
data.frame(
x = x,
ab = x_new,
stringsAsFactors = FALSE
),
stringsAsFactors = FALSE
data.frame(
x = x,
ab = x_new,
stringsAsFactors = FALSE
),
stringsAsFactors = FALSE
))
# take failed ATC codes apart from rest

2
R/ab_selectors.R
View File

@ -541,7 +541,7 @@ ab_select_exec <- function(function_name,
info = FALSE, only_rsi_columns = only_rsi_columns,
sort = FALSE, fn = function_name
)
# untreatable drugs
if (only_treatable == TRUE) {
untreatable <- AMR_env$AB_lookup[which(AMR_env$AB_lookup$name %like% "-high|EDTA|polysorbate|macromethod|screening|/nacubactam"), "ab", drop = TRUE]

66
R/add_custom_antimicrobials.R
View File

@ -28,11 +28,11 @@
# ==================================================================== #
#' Add Custom Antimicrobials to This Package
#'
#'
#' With [add_custom_antimicrobials()] you can add your own custom antimicrobial codes to the `AMR` package.
#' @param x a [data.frame] resembling the [antibiotics] data set, at least containing columns "ab" and "name"
#' @details Due to how \R works, the [add_custom_antimicrobials()] function has to be run in every \R session - added antimicrobials are not stored between sessions and are thus lost when \R is exited. It is possible to save the antimicrobial additions to your `.Rprofile` file to circumvent this, although this requires to load the `AMR` package at every start-up:
#'
#'
#' ```r
#' # Open .Rprofile file
#' utils::file.edit("~/.Rprofile")
@ -45,61 +45,71 @@
#' group = "Test Group")
#' )
#' ```
#'
#'
#' Use [clear_custom_antimicrobials()] to clear the previously added antimicrobials.
#' @rdname add_custom_antimicrobials
#' @export
#' @examples
#' @examples
#' \donttest{
#'
#' # returns NA and throws a warning (which is now suppressed):
#' suppressWarnings(
#' as.ab("test")
#' )
#'
#'
#' # now add a custom entry - it will be considered by as.ab() and
#' # all ab_*() functions
#' add_custom_antimicrobials(
#' data.frame(ab = "TEST",
#' name = "Test Antibiotic",
#' # you can add any property present in the
#' # 'antibiotics' data set, such as 'group':
#' group = "Test Group")
#' data.frame(
#' ab = "TEST",
#' name = "Test Antibiotic",
#' # you can add any property present in the
#' # 'antibiotics' data set, such as 'group':
#' group = "Test Group"
#' )
#' )
#'
#'
#' # "test" is now a new antibiotic:
#' as.ab("test")
#' ab_name("test")
#' ab_group("test")
#'
#'
#' ab_info("test")
#'
#'
#'
#'
#' # Add Co-fluampicil, which is one of the many J01CR50 codes, see
#' # https://www.whocc.no/ddd/list_of_ddds_combined_products/
#' add_custom_antimicrobials(
#' data.frame(ab = "COFLU",
#' name = "Co-fluampicil",
#' atc = "J01CR50",
#' group = "Beta-lactams/penicillines")
#' data.frame(
#' ab = "COFLU",
#' name = "Co-fluampicil",
#' atc = "J01CR50",
#' group = "Beta-lactams/penicillines"
#' )
#' )
#' ab_atc("Co-fluampicil")
#' ab_name("J01CR50")
#'
#'
#' # even antibiotic selectors work
#' x <- data.frame(random_column = "test",
#' coflu = as.rsi("S"),
#' ampicillin = as.rsi("R"))
#' x <- data.frame(
#' random_column = "test",
#' coflu = as.rsi("S"),
#' ampicillin = as.rsi("R")
#' )
#' x
#' x[, betalactams()]
#' }
add_custom_antimicrobials <- function(x) {
meet_criteria(x, allow_class = "data.frame")
stop_ifnot(all(c("ab", "name") %in% colnames(x)),
"`x` must contain columns \"ab\" and \"name\".")
stop_if(any(x$ab %in% AMR_env$AB_lookup$ab),
"Antimicrobial code(s) ", vector_and(x$ab[x$ab %in% AMR_env$AB_lookup$ab]), " already exist in the internal `antibiotics` data set.")
stop_ifnot(
all(c("ab", "name") %in% colnames(x)),
"`x` must contain columns \"ab\" and \"name\"."
)
stop_if(
any(x$ab %in% AMR_env$AB_lookup$ab),
"Antimicrobial code(s) ", vector_and(x$ab[x$ab %in% AMR_env$AB_lookup$ab]), " already exist in the internal `antibiotics` data set."
)
x <- x[, colnames(AMR_env$AB_lookup)[colnames(AMR_env$AB_lookup) %in% colnames(x)], drop = FALSE]
x$generalised_name <- generalise_antibiotic_name(x$name)
x$generalised_all <- as.list(x$generalised_name)
@ -111,7 +121,7 @@ add_custom_antimicrobials <- function(x) {
}
AMR_env$custom_ab_codes <- c(AMR_env$custom_ab_codes, x$ab)
class(AMR_env$AB_lookup$ab) <- "character"
new_df <- AMR_env$AB_lookup[0, , drop = FALSE][seq_len(NROW(x)), , drop = FALSE]
rownames(new_df) <- NULL
list_cols <- vapply(FUN.VALUE = logical(1), new_df, is.list)

10
R/data.R
View File

@ -59,13 +59,17 @@
#' - `iv_units`\cr Units of `iv_ddd`
#' @details Properties that are based on an ATC code are only available when an ATC is available. These properties are: `atc_group1`, `atc_group2`, `oral_ddd`, `oral_units`, `iv_ddd` and `iv_units`.
#'
#' Synonyms (i.e. trade names) were derived from the Compound ID (`cid`) and consequently only available where a CID is available.
#' Synonyms (i.e. trade names) were derived from the PubChem Compound ID (column `cid`) and consequently only available where a CID is available.
#'
#' ### Direct download
#' Like all data sets in this package, these data sets are publicly available for download in the following formats: R, MS Excel, Apache Feather, Apache Parquet, SPSS, SAS, and Stata. Please visit [our website for the download links](https://msberends.github.io/AMR/articles/datasets.html). The actual files are of course available on [our GitHub repository](https://github.com/msberends/AMR/tree/main/data-raw).
#' @source World Health Organization (WHO) Collaborating Centre for Drug Statistics Methodology (WHOCC): <https://www.whocc.no/atc_ddd_index/>
#' @source
#'
#' * World Health Organization (WHO) Collaborating Centre for Drug Statistics Methodology (WHOCC): <https://www.whocc.no/atc_ddd_index/>
#'
#' * `r TAXONOMY_VERSION$LOINC$citation` Accessed from <`r TAXONOMY_VERSION$LOINC$url`> on `r documentation_date(TAXONOMY_VERSION$LOINC$accessed_date)`.
#'
#' European Commission Public Health PHARMACEUTICALS - COMMUNITY REGISTER: <https://ec.europa.eu/health/documents/community-register/html/reg_hum_atc.htm>
#' * European Commission Public Health PHARMACEUTICALS - COMMUNITY REGISTER: <https://ec.europa.eu/health/documents/community-register/html/reg_hum_atc.htm>
#' @inheritSection WHOCC WHOCC
#' @seealso [microorganisms], [intrinsic_resistant]
#' @examples

2
R/disk.R
View File

@ -34,7 +34,7 @@
#' @param x vector
#' @param na.rm a [logical] indicating whether missing values should be removed
#' @details Interpret disk values as RSI values with [as.rsi()]. It supports guidelines from EUCAST and CLSI.
#'
#'
#' Disk diffusion growth zone sizes must be between 6 and 50 millimetres. Values higher than 50 but lower than 100 will be maximised to 50. All others input values outside the 6-50 range will return `NA`.
#' @return An [integer] with additional class [`disk`]
#' @aliases disk

20
R/mo.R
View File

@ -236,7 +236,7 @@ as.mo <- function(x,
# set up progress bar
progress <- progress_ticker(n = length(x_unique), n_min = 10, print = info)
on.exit(close(progress))
msg <- character(0)
# run it
@ -289,7 +289,7 @@ as.mo <- function(x,
} else {
mo_to_search <- AMR_env$MO_lookup$fullname[filtr]
}
AMR_env$mo_to_search <- mo_to_search
# determine the matching score on the original search value
m <- mo_matching_score(x = x_search_cleaned, n = mo_to_search)
@ -363,14 +363,14 @@ as.mo <- function(x,
"Microorganism translation was uncertain for ", examples,
". Run `mo_uncertainties()` to review ", plural[2], "."
))
for (m in msg) {
message_(m)
message_(m)
}
}
}
} # end of loop over all yet unknowns
# Keep or replace synonyms ----
gbif_matches <- AMR::microorganisms$gbif_renamed_to[match(out, AMR::microorganisms$mo)]
gbif_matches[!gbif_matches %in% AMR::microorganisms$gbif] <- NA
@ -565,7 +565,8 @@ pillar_shaft.mo <- function(x, ...) {
}
warning_(
col, " contains old MO codes (from a previous AMR package version). ",
"Please update your MO codes with `as.mo()`.", call = FALSE
"Please update your MO codes with `as.mo()`.",
call = FALSE
)
}
@ -652,7 +653,8 @@ print.mo <- function(x, print.shortnames = FALSE, ...) {
if (!all(x %in% c(AMR::microorganisms$mo, NA))) {
warning_(
"Some MO codes are from a previous AMR package version. ",
"Please update the MO codes with `as.mo()`.", call = FALSE
"Please update the MO codes with `as.mo()`.",
call = FALSE
)
}
print.default(x, quote = FALSE)
@ -918,12 +920,12 @@ convert_colloquial_input <- function(x) {
# CoNS/CoPS in different languages (support for German, Dutch, Spanish, Portuguese)
out[x %like_case% "([ck]oagulas[ea].negatie?[vf]|^[ck]o?ns[^a-z]*$)"] <- "B_STPHY_CONS"
out[x %like_case% "([ck]oagulas[ea].positie?[vf]|^[ck]o?ps[^a-z]*$)"] <- "B_STPHY_COPS"
# Gram stains
out[x %like_case% "gram[ -]?neg.*"] <- "B_GRAMN"
out[x %like_case% "gram[ -]?pos.*"] <- "B_GRAMP"
out[is.na(out) & x %like_case% "anaerob[a-z]+ (micro)?.*organism"] <- "B_ANAER"
# yeasts and fungi
out[x %like_case% "^yeast?"] <- "F_YEAST"
out[x %like_case% "^fung(us|i)"] <- "F_FUNGUS"

10
R/mo_property.R
View File

@ -56,7 +56,7 @@
#' The function [mo_url()] will return the direct URL to the online database entry, which also shows the scientific reference of the concerned species.
#'
#' SNOMED codes - [mo_snomed()] - are from the version of `r documentation_date(TAXONOMY_VERSION$SNOMED$accessed_date)`. See *Source* and the [microorganisms] data set for more info.
#'
#'
#' Old taxonomic names (so-called 'synonyms') can be retrieved with [mo_synonyms()], the current taxonomic name can be retrieved with [mo_current()]. Both functions return full names.
#' @inheritSection mo_matching_score Matching Score for Microorganisms
#' @inheritSection as.mo Source
@ -140,7 +140,7 @@
#' mo_kingdom("Klebsiella pneumoniae")
#' mo_type("Klebsiella pneumoniae")
#' mo_kingdom("Klebsiella pneumoniae", language = "zh") # Chinese, no effect
#' mo_type("Klebsiella pneumoniae", language = "zh") # Chinese, translated
#' mo_type("Klebsiella pneumoniae", language = "zh") # Chinese, translated
#'
#' mo_fullname("S. pyogenes", Lancefield = TRUE, language = "de")
#' mo_fullname("S. pyogenes", Lancefield = TRUE, language = "uk")
@ -153,12 +153,12 @@
#' # gram stains and intrinsic resistance can be used as a filter in dplyr verbs
#' if (require("dplyr")) {
#' example_isolates %>%
#' filter(mo_is_gram_positive()) %>%
#' filter(mo_is_gram_positive()) %>%
#' count(mo_genus(), sort = TRUE)
#' }
#' if (require("dplyr")) {
#' example_isolates %>%
#' filter(mo_is_intrinsic_resistant(ab = "vanco")) %>%
#' filter(mo_is_intrinsic_resistant(ab = "vanco")) %>%
#' count(mo_genus(), sort = TRUE)
#' }
#'
@ -225,7 +225,7 @@ mo_shortname <- function(x, language = get_AMR_locale(), keep_synonyms = getOpti
shortnames[shortnames %like% "unknown"] <- paste0("(", trimws2(gsub("[^a-zA-Z -]", "", shortnames[shortnames %like% "unknown"], perl = TRUE)), ")")
shortnames[mo_rank(x.mo) %in% c("kingdom", "phylum", "class", "order", "family")] <- mo_name(x.mo, language = NULL, keep_synonyms = keep_synonyms)
shortnames[is.na(x.mo)] <- NA_character_
load_mo_uncertainties(metadata)
translate_into_language(shortnames, language = language, only_unknown = FALSE, only_affect_mo_names = TRUE)

42
R/proportion.R
View File

@ -46,7 +46,7 @@
#' @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.
@ -104,12 +104,14 @@
#' resistance(example_isolates$AMX)
#' rsi_confidence_interval(example_isolates$AMX)
#' rsi_confidence_interval(example_isolates$AMX,
#' confidence_level = 0.975)
#'
#' confidence_level = 0.975
#' )
#'
#' # determines %S+I:
#' susceptibility(example_isolates$AMX)
#' rsi_confidence_interval(example_isolates$AMX,
#' ab_result = c("S", "I"))
#' ab_result = c("S", "I")
#' )
#'
#' # be more specific
#' proportion_S(example_isolates$AMX)
@ -121,17 +123,14 @@
#' # 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(
@ -139,10 +138,9 @@
#' ci_min = rsi_confidence_interval(CIP, side = "min"),
#' ci_max = rsi_confidence_interval(CIP, side = "max"),
#' )
#'
#' }
#' if (require("dplyr")) {
#'
#'
#' # scoped dplyr verbs with antibiotic selectors
#' # (you could also use across() of course)
#' example_isolates %>%
@ -151,10 +149,8 @@
#' c(aminoglycosides(), carbapenems()),
#' resistance
#' )
#'
#' }
#' if (require("dplyr")) {
#'
#' example_isolates %>%
#' group_by(ward) %>%
#' summarise(
@ -265,26 +261,26 @@ rsi_confidence_interval <- function(...,
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
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
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
ifelse(n == 0, "no", paste("only", n)),
" results available for `rsi_confidence_interval()` (`minimum` = ", minimum, ").",
call = FALSE
)
if (as_percent == TRUE) {
return(NA_character_)
@ -292,10 +288,10 @@ rsi_confidence_interval <- function(...,
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")) {

44
R/rsi.R
View File

@ -102,7 +102,7 @@
#' @seealso [as.mic()], [as.disk()], [as.mo()]
#' @source
#' For interpretations of minimum inhibitory concentration (MIC) values and disk diffusion diameters:
#'
#'
#' - **M39 Analysis and Presentation of Cumulative Antimicrobial Susceptibility Test Data**, `r min(as.integer(gsub("[^0-9]", "", subset(rsi_translation, guideline %like% "CLSI")$guideline)))`-`r max(as.integer(gsub("[^0-9]", "", subset(rsi_translation, guideline %like% "CLSI")$guideline)))`, *Clinical and Laboratory Standards Institute* (CLSI). <https://clsi.org/standards/products/microbiology/documents/m39/>.
#' - **M100 Performance Standard for Antimicrobial Susceptibility Testing**, `r min(as.integer(gsub("[^0-9]", "", subset(rsi_translation, guideline %like% "CLSI")$guideline)))`-`r max(as.integer(gsub("[^0-9]", "", subset(rsi_translation, guideline %like% "CLSI")$guideline)))`, *Clinical and Laboratory Standards Institute* (CLSI). <https://clsi.org/standards/products/microbiology/documents/m100/>.
#' - **Breakpoint tables for interpretation of MICs and zone diameters**, `r min(as.integer(gsub("[^0-9]", "", subset(rsi_translation, guideline %like% "EUCAST")$guideline)))`-`r max(as.integer(gsub("[^0-9]", "", subset(rsi_translation, guideline %like% "EUCAST")$guideline)))`, *European Committee on Antimicrobial Susceptibility Testing* (EUCAST). <https://www.eucast.org/clinical_breakpoints>.
@ -872,17 +872,19 @@ as_rsi_method <- function(method_short,
lookup_lancefield[i],
lookup_other[i]
))
if (NROW(get_record) == 0) {
warning_("No ", method_param, " breakpoints available for ",
font_italic(suppressMessages(suppressWarnings(mo_shortname(mo[i], language = NULL, keep_synonyms = FALSE)))),
paste0(" / "),
suppressMessages(suppressWarnings(ab_name(ab_param, language = NULL, tolower = TRUE))),
" (", ab_param, ")")
warning_(
"No ", method_param, " breakpoints available for ",
font_italic(suppressMessages(suppressWarnings(mo_shortname(mo[i], language = NULL, keep_synonyms = FALSE)))),
paste0(" / "),
suppressMessages(suppressWarnings(ab_name(ab_param, language = NULL, tolower = TRUE))),
" (", ab_param, ")"
)
rise_warning <- TRUE
next
}
if (isTRUE(uti[i])) {
get_record <- get_record %pm>%
# be as specific as possible (i.e. prefer species over genus):
@ -893,7 +895,7 @@ as_rsi_method <- function(method_short,
# sort UTI = FALSE first, then UTI = TRUE
pm_arrange(rank_index, uti)
}
# warning section
records_same_mo <- get_record[get_record$mo == get_record[1, "mo", drop = TRUE], , drop = FALSE]
if (nrow(get_record) == 1 && all(get_record$uti == TRUE) && uti[i] %in% c(FALSE, NA) && message_not_thrown_before("as.rsi", "uti", ab_param)) {
@ -903,11 +905,12 @@ as_rsi_method <- function(method_short,
} else if (nrow(records_same_mo) > 1 && length(unique(records_same_mo$site)) > 1 && is.na(uti[i]) && all(c(TRUE, FALSE) %in% records_same_mo$uti, na.rm = TRUE) && message_not_thrown_before("as.rsi", "siteUTI", records_same_mo$mo[1], ab_param)) {
# uti not set and both UTI and non-UTI breakpoints available, so throw warning
warning_("in `as.rsi()`: breakpoints for UTI ", font_underline("and"), " non-UTI available for ",
font_italic(suppressMessages(suppressWarnings(mo_shortname(records_same_mo$mo[1], language = NULL, keep_synonyms = FALSE)))),
" / ",
suppressMessages(suppressWarnings(ab_name(ab_param, language = NULL, tolower = TRUE))),
" (", ab_param, ") - assuming non-UTI. Use argument `uti` to set which isolates are from urine. See ?as.rsi.",
call = FALSE)
font_italic(suppressMessages(suppressWarnings(mo_shortname(records_same_mo$mo[1], language = NULL, keep_synonyms = FALSE)))),
" / ",
suppressMessages(suppressWarnings(ab_name(ab_param, language = NULL, tolower = TRUE))),
" (", ab_param, ") - assuming non-UTI. Use argument `uti` to set which isolates are from urine. See ?as.rsi.",
call = FALSE
)
get_record <- get_record %pm>%
pm_filter(uti == FALSE)
rise_warning <- TRUE
@ -920,14 +923,15 @@ as_rsi_method <- function(method_short,
site <- paste0("body site '", get_record[1L, "site", drop = FALSE], "'")
}
warning_("in `as.rsi()`: breakpoints available for ",
font_italic(suppressMessages(suppressWarnings(mo_shortname(records_same_mo$mo[1], language = NULL, keep_synonyms = FALSE)))),
paste0(" / "),
suppressMessages(suppressWarnings(ab_name(records_same_mo$ab[1], language = NULL, tolower = TRUE))),
paste0(" - assuming ", site),
call = FALSE)
font_italic(suppressMessages(suppressWarnings(mo_shortname(records_same_mo$mo[1], language = NULL, keep_synonyms = FALSE)))),
paste0(" / "),
suppressMessages(suppressWarnings(ab_name(records_same_mo$ab[1], language = NULL, tolower = TRUE))),
paste0(" - assuming ", site),
call = FALSE
)
rise_warning <- TRUE
}
if (NROW(get_record) > 0) {
# get the best hit: the top one
get_record <- get_record[1L, , drop = FALSE]

16
R/rsi_calc.R
View File

@ -253,7 +253,7 @@ rsi_calc_df <- function(type, # "proportion", "count" or "both"
}
}
}
sum_it <- function(.data) {
out <- data.frame(
antibiotic = character(0),
@ -282,10 +282,16 @@ rsi_calc_df <- function(type, # "proportion", "count" or "both"
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)
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 {

BIN
R/sysdata.rda
View File

Binary file not shown.

2
R/translate.R
View File

@ -43,7 +43,7 @@
#' # Add e.g. Italian support to that file using:
#' options(AMR_locale = "Italian")
#' ```
#'
#'
#' And then save the file.
#'
#' Please read about adding or updating a language in [our Wiki](https://github.com/msberends/AMR/wiki/).

3
R/zzz.R
View File

@ -161,7 +161,8 @@ if (utf8_supported && !is_latex) {
packageStartupMessage(word_wrap(
"Assuming the ", LANGUAGES_SUPPORTED_NAMES[[current_lang]]$exonym, " language (",
LANGUAGES_SUPPORTED_NAMES[[current_lang]]$endonym, ") for the AMR package. See `set_AMR_locale()` to change this or to silence this note.",
add_fn = list(font_blue), as_note = TRUE))
add_fn = list(font_blue), as_note = TRUE
))
}
}
}