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

(v1.7.1.9067) Support for Swedish and Russian

Browse Source
This commit is contained in:
dr. M.S. (Matthijs) Berends
2021-12-12 09:42:03 +01:00
parent 5b5f70a103
commit 56f1ce328a
81 changed files with 1588 additions and 530 deletions
Download Patch File Download Diff File Expand all files Collapse all files

16
R/ab_property.R
View File

@ -30,7 +30,7 @@
#' @param x any (vector of) text that can be coerced to a valid antibiotic code with [as.ab()]
#' @param tolower a [logical] to indicate whether the first [character] of every output should be transformed to a lower case [character]. This will lead to e.g. "polymyxin B" and not "polymyxin b".
#' @param property one of the column names of one of the [antibiotics] data set: `vector_or(colnames(antibiotics), sort = FALSE)`.
#' @param language language of the returned text, defaults to system language (see [get_locale()]) and can also be set with `getOption("AMR_locale")`. Use `language = NULL` or `language = ""` to prevent translation.
#' @param language language of the returned text, defaults to system language (see [get_AMR_locale()]) and can also be set with `getOption("AMR_locale")`. Use `language = NULL` or `language = ""` to prevent translation.
#' @param administration way of administration, either `"oral"` or `"iv"`
#' @param open browse the URL using [utils::browseURL()]
#' @param ... in case of [set_ab_names()] and `data` is a [data.frame]: variables to select (supports tidy selection such as `column1:column4`), otherwise other arguments passed on to [as.ab()]
@ -120,7 +120,7 @@
#' colnames()
#' }
#' }
ab_name <- function(x, language = get_locale(), tolower = FALSE, ...) {
ab_name <- function(x, language = get_AMR_locale(), tolower = FALSE, ...) {
meet_criteria(x, allow_NA = TRUE)
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
meet_criteria(tolower, allow_class = "logical", has_length = 1)
@ -163,7 +163,7 @@ ab_tradenames <- function(x, ...) {
#' @rdname ab_property
#' @export
ab_group <- function(x, language = get_locale(), ...) {
ab_group <- function(x, language = get_AMR_locale(), ...) {
meet_criteria(x, allow_NA = TRUE)
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
translate_AMR(ab_validate(x = x, property = "group", ...), language = language, only_affect_ab_names = TRUE)
@ -201,7 +201,7 @@ ab_atc <- function(x, only_first = FALSE, ...) {
#' @rdname ab_property
#' @export
ab_atc_group1 <- function(x, language = get_locale(), ...) {
ab_atc_group1 <- function(x, language = get_AMR_locale(), ...) {
meet_criteria(x, allow_NA = TRUE)
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
translate_AMR(ab_validate(x = x, property = "atc_group1", ...), language = language, only_affect_ab_names = TRUE)
@ -209,7 +209,7 @@ ab_atc_group1 <- function(x, language = get_locale(), ...) {
#' @rdname ab_property
#' @export
ab_atc_group2 <- function(x, language = get_locale(), ...) {
ab_atc_group2 <- function(x, language = get_AMR_locale(), ...) {
meet_criteria(x, allow_NA = TRUE)
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
translate_AMR(ab_validate(x = x, property = "atc_group2", ...), language = language, only_affect_ab_names = TRUE)
@ -276,7 +276,7 @@ ab_ddd_units <- function(x, administration = "oral", ...) {
#' @rdname ab_property
#' @export
ab_info <- function(x, language = get_locale(), ...) {
ab_info <- function(x, language = get_AMR_locale(), ...) {
meet_criteria(x, allow_NA = TRUE)
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
@ -327,7 +327,7 @@ ab_url <- function(x, open = FALSE, ...) {
#' @rdname ab_property
#' @export
ab_property <- function(x, property = "name", language = get_locale(), ...) {
ab_property <- function(x, property = "name", language = get_AMR_locale(), ...) {
meet_criteria(x, allow_NA = TRUE)
meet_criteria(property, is_in = colnames(antibiotics), has_length = 1)
meet_criteria(language, is_in = c(LANGUAGES_SUPPORTED, ""), has_length = 1, allow_NULL = TRUE, allow_NA = TRUE)
@ -337,7 +337,7 @@ ab_property <- function(x, property = "name", language = get_locale(), ...) {
#' @rdname ab_property
#' @aliases ATC
#' @export
set_ab_names <- function(data, ..., property = "name", language = get_locale(), snake_case = NULL) {
set_ab_names <- function(data, ..., property = "name", language = get_AMR_locale(), snake_case = NULL) {
meet_criteria(data, allow_class = c("data.frame", "character"))
meet_criteria(property, is_in = colnames(antibiotics), has_length = 1, ignore.case = TRUE)
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)

2
R/bug_drug_combinations.R
View File

@ -162,7 +162,7 @@ bug_drug_combinations <- function(x,
#' @rdname bug_drug_combinations
format.bug_drug_combinations <- function(x,
translate_ab = "name (ab, atc)",
language = get_locale(),
language = get_AMR_locale(),
minimum = 30,
combine_SI = TRUE,
combine_IR = FALSE,

2
R/count.R
View File

@ -213,7 +213,7 @@ n_rsi <- count_all
#' @export
count_df <- function(data,
translate_ab = "name",
language = get_locale(),
language = get_AMR_locale(),
combine_SI = TRUE,
combine_IR = FALSE) {
tryCatch(

6
R/ggplot_rsi.R
View File

@ -158,7 +158,7 @@ ggplot_rsi <- function(data,
combine_SI = TRUE,
combine_IR = FALSE,
minimum = 30,
language = get_locale(),
language = get_AMR_locale(),
nrow = NULL,
colours = c(S = "#3CAEA3",
SI = "#3CAEA3",
@ -269,7 +269,7 @@ geom_rsi <- function(position = NULL,
fill = "interpretation",
translate_ab = "name",
minimum = 30,
language = get_locale(),
language = get_AMR_locale(),
combine_SI = TRUE,
combine_IR = FALSE,
...) {
@ -438,7 +438,7 @@ labels_rsi_count <- function(position = NULL,
x = "antibiotic",
translate_ab = "name",
minimum = 30,
language = get_locale(),
language = get_AMR_locale(),
combine_SI = TRUE,
combine_IR = FALSE,
datalabels.size = 3,

8
R/like.R
View File

@ -124,31 +124,23 @@ like <- function(x, pattern, ignore.case = TRUE) {
#' @rdname like
#' @export
"%like%" <- function(x, pattern) {
meet_criteria(x, allow_NA = TRUE)
meet_criteria(pattern, allow_NA = FALSE)
like(x, pattern, ignore.case = TRUE)
}
#' @rdname like
#' @export
"%unlike%" <- function(x, pattern) {
meet_criteria(x, allow_NA = TRUE)
meet_criteria(pattern, allow_NA = FALSE)
!like(x, pattern, ignore.case = TRUE)
}
#' @rdname like
#' @export
"%like_case%" <- function(x, pattern) {
meet_criteria(x, allow_NA = TRUE)
meet_criteria(pattern, allow_NA = FALSE)
like(x, pattern, ignore.case = FALSE)
}
#' @rdname like
#' @export
"%unlike_case%" <- function(x, pattern) {
meet_criteria(x, allow_NA = TRUE)
meet_criteria(pattern, allow_NA = FALSE)
!like(x, pattern, ignore.case = FALSE)
}

6
R/mo.R
View File

@ -37,7 +37,7 @@
#' @param allow_uncertain a number between `0` (or `"none"`) and `3` (or `"all"`), or `TRUE` (= `2`) or `FALSE` (= `0`) to indicate whether the input should be checked for less probable results, see *Details*
#' @param reference_df a [data.frame] to be used for extra reference when translating `x` to a valid [`mo`]. See [set_mo_source()] and [get_mo_source()] to automate the usage of your own codes (e.g. used in your analysis or organisation).
#' @param ignore_pattern a regular expression (case-insensitive) of which all matches in `x` must return `NA`. This can be convenient to exclude known non-relevant input and can also be set with the option `AMR_ignore_pattern`, e.g. `options(AMR_ignore_pattern = "(not reported|contaminated flora)")`.
#' @param language language to translate text like "no growth", which defaults to the system language (see [get_locale()])
#' @param language language to translate text like "no growth", which defaults to the system language (see [get_AMR_locale()])
#' @param info a [logical] to indicate if a progress bar should be printed if more than 25 items are to be coerced, defaults to `TRUE` only in interactive mode
#' @param ... other arguments passed on to functions
#' @rdname as.mo
@ -161,7 +161,7 @@ as.mo <- function(x,
allow_uncertain = TRUE,
reference_df = get_mo_source(),
ignore_pattern = getOption("AMR_ignore_pattern"),
language = get_locale(),
language = get_AMR_locale(),
info = interactive(),
...) {
meet_criteria(x, allow_class = c("mo", "data.frame", "list", "character", "numeric", "integer", "factor"), allow_NA = TRUE)
@ -267,7 +267,7 @@ exec_as.mo <- function(x,
reference_data_to_use = MO_lookup,
actual_uncertainty = 1,
actual_input = NULL,
language = get_locale()) {
language = get_AMR_locale()) {
meet_criteria(x, allow_class = c("mo", "data.frame", "list", "character", "numeric", "integer", "factor"), allow_NA = TRUE)
meet_criteria(Becker, allow_class = c("logical", "character"), has_length = 1)
meet_criteria(Lancefield, allow_class = c("logical", "character"), has_length = 1)

56
R/mo_property.R
View File

@ -29,7 +29,7 @@
#' @inheritSection lifecycle Stable Lifecycle
#' @param x any [character] (vector) that can be coerced to a valid microorganism code with [as.mo()]. Can be left blank for auto-guessing the column containing microorganism codes if used in a data set, see *Examples*.
#' @param property one of the column names of the [microorganisms] data set: `r vector_or(colnames(microorganisms), sort = FALSE, quotes = TRUE)`, or must be `"shortname"`
#' @param language language of the returned text, defaults to system language (see [get_locale()]) and can be overwritten by setting the option `AMR_locale`, e.g. `options(AMR_locale = "de")`, see [translate]. Also used to translate text like "no growth". Use `language = NULL` or `language = ""` to prevent translation.
#' @param language language of the returned text, defaults to system language (see [get_AMR_locale()]) and can be overwritten by setting the option `AMR_locale`, e.g. `options(AMR_locale = "de")`, see [translate]. Also used to translate text like "no growth". Use `language = NULL` or `language = ""` to prevent translation.
#' @param ... other arguments passed on to [as.mo()], such as 'allow_uncertain' and 'ignore_pattern'
#' @param ab any (vector of) text that can be coerced to a valid antibiotic code with [as.ab()]
#' @param open browse the URL using [`browseURL()`][utils::browseURL()]
@ -170,7 +170,7 @@
#' mo_info("E. coli")
#' }
#' }
mo_name <- function(x, language = get_locale(), ...) {
mo_name <- function(x, language = get_AMR_locale(), ...) {
if (missing(x)) {
# this tries to find the data and an <mo> column
x <- find_mo_col(fn = "mo_name")
@ -190,7 +190,7 @@ mo_fullname <- mo_name
#' @rdname mo_property
#' @export
mo_shortname <- function(x, language = get_locale(), ...) {
mo_shortname <- function(x, language = get_AMR_locale(), ...) {
if (missing(x)) {
# this tries to find the data and an <mo> column
x <- find_mo_col(fn = "mo_shortname")
@ -230,7 +230,7 @@ mo_shortname <- function(x, language = get_locale(), ...) {
#' @rdname mo_property
#' @export
mo_subspecies <- function(x, language = get_locale(), ...) {
mo_subspecies <- function(x, language = get_AMR_locale(), ...) {
if (missing(x)) {
# this tries to find the data and an <mo> column
x <- find_mo_col(fn = "mo_subspecies")
@ -243,7 +243,7 @@ mo_subspecies <- function(x, language = get_locale(), ...) {
#' @rdname mo_property
#' @export
mo_species <- function(x, language = get_locale(), ...) {
mo_species <- function(x, language = get_AMR_locale(), ...) {
if (missing(x)) {
# this tries to find the data and an <mo> column
x <- find_mo_col(fn = "mo_species")
@ -256,7 +256,7 @@ mo_species <- function(x, language = get_locale(), ...) {
#' @rdname mo_property
#' @export
mo_genus <- function(x, language = get_locale(), ...) {
mo_genus <- function(x, language = get_AMR_locale(), ...) {
if (missing(x)) {
# this tries to find the data and an <mo> column
x <- find_mo_col(fn = "mo_genus")
@ -269,7 +269,7 @@ mo_genus <- function(x, language = get_locale(), ...) {
#' @rdname mo_property
#' @export
mo_family <- function(x, language = get_locale(), ...) {
mo_family <- function(x, language = get_AMR_locale(), ...) {
if (missing(x)) {
# this tries to find the data and an <mo> column
x <- find_mo_col(fn = "mo_family")
@ -282,7 +282,7 @@ mo_family <- function(x, language = get_locale(), ...) {
#' @rdname mo_property
#' @export
mo_order <- function(x, language = get_locale(), ...) {
mo_order <- function(x, language = get_AMR_locale(), ...) {
if (missing(x)) {
# this tries to find the data and an <mo> column
x <- find_mo_col(fn = "mo_order")
@ -295,7 +295,7 @@ mo_order <- function(x, language = get_locale(), ...) {
#' @rdname mo_property
#' @export
mo_class <- function(x, language = get_locale(), ...) {
mo_class <- function(x, language = get_AMR_locale(), ...) {
if (missing(x)) {
# this tries to find the data and an <mo> column
x <- find_mo_col(fn = "mo_class")
@ -308,7 +308,7 @@ mo_class <- function(x, language = get_locale(), ...) {
#' @rdname mo_property
#' @export
mo_phylum <- function(x, language = get_locale(), ...) {
mo_phylum <- function(x, language = get_AMR_locale(), ...) {
if (missing(x)) {
# this tries to find the data and an <mo> column
x <- find_mo_col(fn = "mo_phylum")
@ -321,7 +321,7 @@ mo_phylum <- function(x, language = get_locale(), ...) {
#' @rdname mo_property
#' @export
mo_kingdom <- function(x, language = get_locale(), ...) {
mo_kingdom <- function(x, language = get_AMR_locale(), ...) {
if (missing(x)) {
# this tries to find the data and an <mo> column
x <- find_mo_col(fn = "mo_kingdom")
@ -338,7 +338,7 @@ mo_domain <- mo_kingdom
#' @rdname mo_property
#' @export
mo_type <- function(x, language = get_locale(), ...) {
mo_type <- function(x, language = get_AMR_locale(), ...) {
if (missing(x)) {
# this tries to find the data and an <mo> column
x <- find_mo_col(fn = "mo_type")
@ -354,7 +354,7 @@ mo_type <- function(x, language = get_locale(), ...) {
#' @rdname mo_property
#' @export
mo_gramstain <- function(x, language = get_locale(), ...) {
mo_gramstain <- function(x, language = get_AMR_locale(), ...) {
if (missing(x)) {
# this tries to find the data and an <mo> column
x <- find_mo_col(fn = "mo_gramstain")
@ -385,7 +385,7 @@ mo_gramstain <- function(x, language = get_locale(), ...) {
#' @rdname mo_property
#' @export
mo_is_gram_negative <- function(x, language = get_locale(), ...) {
mo_is_gram_negative <- function(x, language = get_AMR_locale(), ...) {
if (missing(x)) {
# this tries to find the data and an <mo> column
x <- find_mo_col(fn = "mo_is_gram_negative")
@ -404,7 +404,7 @@ mo_is_gram_negative <- function(x, language = get_locale(), ...) {
#' @rdname mo_property
#' @export
mo_is_gram_positive <- function(x, language = get_locale(), ...) {
mo_is_gram_positive <- function(x, language = get_AMR_locale(), ...) {
if (missing(x)) {
# this tries to find the data and an <mo> column
x <- find_mo_col(fn = "mo_is_gram_positive")
@ -423,7 +423,7 @@ mo_is_gram_positive <- function(x, language = get_locale(), ...) {
#' @rdname mo_property
#' @export
mo_is_yeast <- function(x, language = get_locale(), ...) {
mo_is_yeast <- function(x, language = get_AMR_locale(), ...) {
if (missing(x)) {
# this tries to find the data and an <mo> column
x <- find_mo_col(fn = "mo_is_yeast")
@ -449,7 +449,7 @@ mo_is_yeast <- function(x, language = get_locale(), ...) {
#' @rdname mo_property
#' @export
mo_is_intrinsic_resistant <- function(x, ab, language = get_locale(), ...) {
mo_is_intrinsic_resistant <- function(x, ab, language = get_AMR_locale(), ...) {
if (missing(x)) {
# this tries to find the data and an <mo> column
x <- find_mo_col(fn = "mo_is_intrinsic_resistant")
@ -483,7 +483,7 @@ mo_is_intrinsic_resistant <- function(x, ab, language = get_locale(), ...) {
#' @rdname mo_property
#' @export
mo_snomed <- function(x, language = get_locale(), ...) {
mo_snomed <- function(x, language = get_AMR_locale(), ...) {
if (missing(x)) {
# this tries to find the data and an <mo> column
x <- find_mo_col(fn = "mo_snomed")
@ -496,7 +496,7 @@ mo_snomed <- function(x, language = get_locale(), ...) {
#' @rdname mo_property
#' @export
mo_ref <- function(x, language = get_locale(), ...) {
mo_ref <- function(x, language = get_AMR_locale(), ...) {
if (missing(x)) {
# this tries to find the data and an <mo> column
x <- find_mo_col(fn = "mo_ref")
@ -509,7 +509,7 @@ mo_ref <- function(x, language = get_locale(), ...) {
#' @rdname mo_property
#' @export
mo_authors <- function(x, language = get_locale(), ...) {
mo_authors <- function(x, language = get_AMR_locale(), ...) {
if (missing(x)) {
# this tries to find the data and an <mo> column
x <- find_mo_col(fn = "mo_authors")
@ -525,7 +525,7 @@ mo_authors <- function(x, language = get_locale(), ...) {
#' @rdname mo_property
#' @export
mo_year <- function(x, language = get_locale(), ...) {
mo_year <- function(x, language = get_AMR_locale(), ...) {
if (missing(x)) {
# this tries to find the data and an <mo> column
x <- find_mo_col(fn = "mo_year")
@ -541,7 +541,7 @@ mo_year <- function(x, language = get_locale(), ...) {
#' @rdname mo_property
#' @export
mo_lpsn <- function(x, language = get_locale(), ...) {
mo_lpsn <- function(x, language = get_AMR_locale(), ...) {
if (missing(x)) {
# this tries to find the data and an <mo> column
x <- find_mo_col(fn = "mo_rank")
@ -554,7 +554,7 @@ mo_lpsn <- function(x, language = get_locale(), ...) {
#' @rdname mo_property
#' @export
mo_rank <- function(x, language = get_locale(), ...) {
mo_rank <- function(x, language = get_AMR_locale(), ...) {
if (missing(x)) {
# this tries to find the data and an <mo> column
x <- find_mo_col(fn = "mo_rank")
@ -567,7 +567,7 @@ mo_rank <- function(x, language = get_locale(), ...) {
#' @rdname mo_property
#' @export
mo_taxonomy <- function(x, language = get_locale(), ...) {
mo_taxonomy <- function(x, language = get_AMR_locale(), ...) {
if (missing(x)) {
# this tries to find the data and an <mo> column
x <- find_mo_col(fn = "mo_taxonomy")
@ -593,7 +593,7 @@ mo_taxonomy <- function(x, language = get_locale(), ...) {
#' @rdname mo_property
#' @export
mo_synonyms <- function(x, language = get_locale(), ...) {
mo_synonyms <- function(x, language = get_AMR_locale(), ...) {
if (missing(x)) {
# this tries to find the data and an <mo> column
x <- find_mo_col(fn = "mo_synonyms")
@ -626,7 +626,7 @@ mo_synonyms <- function(x, language = get_locale(), ...) {
#' @rdname mo_property
#' @export
mo_info <- function(x, language = get_locale(), ...) {
mo_info <- function(x, language = get_AMR_locale(), ...) {
if (missing(x)) {
# this tries to find the data and an <mo> column
x <- find_mo_col(fn = "mo_info")
@ -657,7 +657,7 @@ mo_info <- function(x, language = get_locale(), ...) {
#' @rdname mo_property
#' @export
mo_url <- function(x, open = FALSE, language = get_locale(), ...) {
mo_url <- function(x, open = FALSE, language = get_AMR_locale(), ...) {
if (missing(x)) {
# this tries to find the data and an <mo> column
x <- find_mo_col(fn = "mo_url")
@ -696,7 +696,7 @@ mo_url <- function(x, open = FALSE, language = get_locale(), ...) {
#' @rdname mo_property
#' @export
mo_property <- function(x, property = "fullname", language = get_locale(), ...) {
mo_property <- function(x, property = "fullname", language = get_AMR_locale(), ...) {
if (missing(x)) {
# this tries to find the data and an <mo> column
x <- find_mo_col(fn = "mo_property")

18
R/plot.R
View File

@ -35,7 +35,7 @@
#' @param main,title title of the plot
#' @param xlab,ylab axis title
#' @param colours_RSI colours to use for filling in the bars, must be a vector of three values (in the order R, S and I). The default colours are colour-blind friendly.
#' @param language language to be used to translate 'Susceptible', 'Increased exposure'/'Intermediate' and 'Resistant', defaults to system language (see [get_locale()]) and can be overwritten by setting the option `AMR_locale`, e.g. `options(AMR_locale = "de")`, see [translate]. Use `language = NULL` or `language = ""` to prevent translation.
#' @param language language to be used to translate 'Susceptible', 'Increased exposure'/'Intermediate' and 'Resistant', defaults to system language (see [get_AMR_locale()]) and can be overwritten by setting the option `AMR_locale`, e.g. `options(AMR_locale = "de")`, see [translate]. Use `language = NULL` or `language = ""` to prevent translation.
#' @param expand a [logical] to indicate whether the range on the x axis should be expanded between the lowest and highest value. For MIC values, intermediate values will be factors of 2 starting from the highest MIC value. For disk diameters, the whole diameter range will be filled.
#' @details
#' The interpretation of "I" will be named "Increased exposure" for all EUCAST guidelines since 2019, and will be named "Intermediate" in all other cases.
@ -83,7 +83,7 @@ plot.mic <- function(x,
ylab = "Frequency",
xlab = "Minimum Inhibitory Concentration (mg/L)",
colours_RSI = c("#ED553B", "#3CAEA3", "#F6D55C"),
language = get_locale(),
language = get_AMR_locale(),
expand = TRUE,
...) {
meet_criteria(mo, allow_class = c("mo", "character"), allow_NULL = TRUE)
@ -169,7 +169,7 @@ barplot.mic <- function(height,
ylab = "Frequency",
xlab = "Minimum Inhibitory Concentration (mg/L)",
colours_RSI = c("#ED553B", "#3CAEA3", "#F6D55C"),
language = get_locale(),
language = get_AMR_locale(),
expand = TRUE,
...) {
meet_criteria(main, allow_class = "character", has_length = 1, allow_NULL = TRUE)
@ -214,7 +214,7 @@ autoplot.mic <- function(object,
ylab = "Frequency",
xlab = "Minimum Inhibitory Concentration (mg/L)",
colours_RSI = c("#ED553B", "#3CAEA3", "#F6D55C"),
language = get_locale(),
language = get_AMR_locale(),
expand = TRUE,
...) {
stop_ifnot_installed("ggplot2")
@ -305,7 +305,7 @@ plot.disk <- function(x,
ab = NULL,
guideline = "EUCAST",
colours_RSI = c("#ED553B", "#3CAEA3", "#F6D55C"),
language = get_locale(),
language = get_AMR_locale(),
expand = TRUE,
...) {
meet_criteria(main, allow_class = "character", has_length = 1, allow_NULL = TRUE)
@ -392,7 +392,7 @@ barplot.disk <- function(height,
ab = NULL,
guideline = "EUCAST",
colours_RSI = c("#ED553B", "#3CAEA3", "#F6D55C"),
language = get_locale(),
language = get_AMR_locale(),
expand = TRUE,
...) {
meet_criteria(main, allow_class = "character", has_length = 1, allow_NULL = TRUE)
@ -437,7 +437,7 @@ autoplot.disk <- function(object,
xlab = "Disk diffusion diameter (mm)",
guideline = "EUCAST",
colours_RSI = c("#ED553B", "#3CAEA3", "#F6D55C"),
language = get_locale(),
language = get_AMR_locale(),
expand = TRUE,
...) {
stop_ifnot_installed("ggplot2")
@ -579,7 +579,7 @@ barplot.rsi <- function(height,
xlab = "Antimicrobial Interpretation",
ylab = "Frequency",
colours_RSI = c("#ED553B", "#3CAEA3", "#F6D55C"),
language = get_locale(),
language = get_AMR_locale(),
expand = TRUE,
...) {
meet_criteria(xlab, allow_class = "character", has_length = 1)
@ -623,7 +623,7 @@ autoplot.rsi <- function(object,
xlab = "Antimicrobial Interpretation",
ylab = "Frequency",
colours_RSI = c("#ED553B", "#3CAEA3", "#F6D55C"),
language = get_locale(),
language = get_AMR_locale(),
...) {
stop_ifnot_installed("ggplot2")
meet_criteria(title, allow_class = "character", allow_NULL = TRUE)

2
R/proportion.R
View File

@ -277,7 +277,7 @@ proportion_S <- function(...,
#' @export
proportion_df <- function(data,
translate_ab = "name",
language = get_locale(),
language = get_AMR_locale(),
minimum = 30,
as_percent = FALSE,
combine_SI = TRUE,

2
R/rsi_calc.R
View File

@ -202,7 +202,7 @@ rsi_calc <- function(...,
rsi_calc_df <- function(type, # "proportion", "count" or "both"
data,
translate_ab = "name",
language = get_locale(),
language = get_AMR_locale(),
minimum = 30,
as_percent = FALSE,
combine_SI = TRUE,

2
R/rsi_df.R
View File

@ -27,7 +27,7 @@
#' @export
rsi_df <- function(data,
translate_ab = "name",
language = get_locale(),
language = get_AMR_locale(),
minimum = 30,
as_percent = FALSE,
combine_SI = TRUE,

BIN
R/sysdata.rda
View File

Binary file not shown.

35
R/translate.R
View File

@ -29,7 +29,7 @@
#' @inheritSection lifecycle Stable Lifecycle
#' @details Strings will be translated to foreign languages if they are defined in a local translation file. Additions to this file can be suggested at our repository. The file can be found here: <https://github.com/msberends/AMR/blob/main/data-raw/translations.tsv>. This file will be read by all functions where a translated output can be desired, like all [`mo_*`][mo_property()] functions (such as [mo_name()], [mo_gramstain()], [mo_type()], etc.) and [`ab_*`][ab_property()] functions (such as [ab_name()], [ab_group()], etc.).
#'
#' Currently supported languages are: `r vector_and(gsub(";.*", "", ISOcodes::ISO_639_2[which(ISOcodes::ISO_639_2$Alpha_2 %in% LANGUAGES_SUPPORTED), "Name"]), quotes = FALSE)`. All these languages have translations available for all antimicrobial agents and colloquial microorganism names.
#' Currently supported languages are: `r vector_and(names(LANGUAGES_SUPPORTED), quotes = FALSE)`. All these languages have translations available for all antimicrobial agents and colloquial microorganism names.
#'
#' Please suggest your own translations [by creating a new issue on our repository](https://github.com/msberends/AMR/issues/new?title=Translations).
#'
@ -39,7 +39,7 @@
#' 1. Setting the R option `AMR_locale`, e.g. by running `options(AMR_locale = "de")`
#' 2. Setting the system variable `LANGUAGE` or `LANG`, e.g. by adding `LANGUAGE="de_DE.utf8"` to your `.Renviron` file in your home directory
#'
#' So if the R option `AMR_locale` is set, the system variables `LANGUAGE` and `LANG` will be ignored.
#' Thus, if the R option `AMR_locale` is set, the system variables `LANGUAGE` and `LANG` will be ignored.
#' @inheritSection AMR Read more on Our Website!
#' @rdname translate
#' @name translate
@ -47,15 +47,15 @@
#' @examples
#' # The 'language' argument of below functions
#' # will be set automatically to your system language
#' # with get_locale()
#' # with get_AMR_locale()
#'
#' # English
#' mo_name("CoNS", language = "en")
#' #> "Coagulase-negative Staphylococcus (CoNS)"
#'
#' # Danish
#' mo_name("CoNS", language = "nl")
#' #> "Koagulase-negative stafylokokker (CoNS)"
#' mo_name("CoNS", language = "da")
#' #> "Koagulase-negative stafylokokker (KNS)"
#'
#' # Dutch
#' mo_name("CoNS", language = "nl")
@ -76,7 +76,7 @@
#' # Spanish
#' mo_name("CoNS", language = "es")
#' #> "Staphylococcus coagulasa negativo (SCN)"
get_locale <- function() {
get_AMR_locale <- function() {
# AMR versions 1.3.0 and prior used the environmental variable:
if (!identical("", Sys.getenv("AMR_locale"))) {
options(AMR_locale = Sys.getenv("AMR_locale"))
@ -88,10 +88,10 @@ get_locale <- function() {
return(lang)
} else {
stop_("unsupported language set as option 'AMR_locale': \"", lang, "\" - use either ",
vector_or(LANGUAGES_SUPPORTED, quotes = TRUE))
vector_or(paste0('"', LANGUAGES_SUPPORTED, '" (', names(LANGUAGES_SUPPORTED), ")"), quotes = FALSE))
}
} else {
# we now support the LANGUAGE system variable - return it if set
# now check the LANGUAGE system variable - return it if set
if (!identical("", Sys.getenv("LANGUAGE"))) {
return(coerce_language_setting(Sys.getenv("LANGUAGE")))
}
@ -100,11 +100,22 @@ get_locale <- function() {
}
}
# fallback - automatic determination based on LC_COLLATE
if (interactive() && message_not_thrown_before("get_AMR_locale", entire_session = TRUE)) {
lang <- coerce_language_setting(Sys.getlocale("LC_COLLATE"))
if (lang != "en") {
message_("Assuming the ", names(LANGUAGES_SUPPORTED)[LANGUAGES_SUPPORTED == lang],
" language for the AMR package. Change this with `options(AMR_locale = \"...\")` or see `?get_AMR_locale()`. ",
"Supported languages are ", vector_and(names(LANGUAGES_SUPPORTED), quotes = FALSE),
". This note will be shown once per session.")
}
return(lang)
}
coerce_language_setting(Sys.getlocale("LC_COLLATE"))
}
coerce_language_setting <- function(lang) {
# grepl() with ignore.case = FALSE is faster than %like%
# grepl() with ignore.case = FALSE is 8x faster than %like_case%
if (grepl("^(English|en_|EN_)", lang, ignore.case = FALSE, perl = TRUE)) {
# as first option to optimise speed
"en"
@ -122,6 +133,10 @@ coerce_language_setting <- function(lang) {
"fr"
} else if (grepl("^(Portuguese|Portugu.+s|pt_|PT_)", lang, ignore.case = FALSE, perl = TRUE)) {
"pt"
} else if (grepl("^(Russian|русс|ru_|RU_)", lang, ignore.case = FALSE, perl = TRUE)) {
"ru"
} else if (grepl("^(Swedish|Svenskt|sv_|SV_)", lang, ignore.case = FALSE, perl = TRUE)) {
"sv"
} else {
# other language -> set to English
"en"
@ -130,7 +145,7 @@ coerce_language_setting <- function(lang) {
# translate strings based on inst/translations.tsv
translate_AMR <- function(from,
language = get_locale(),
language = get_AMR_locale(),
only_unknown = FALSE,
only_affect_ab_names = FALSE,
only_affect_mo_names = FALSE) {