P281424/AMR
1
0
Fork 0
mirror of https://github.com/msberends/AMR.git synced 2024-12-24 18:46:14 +01:00
Code Releases Activity

no obligatory note on startup

Browse Source
This commit is contained in:
dr. M.S. (Matthijs) Berends 2022-12-09 15:10:49 +01:00
parent 56dad34e68
commit e7d7b94b3e
5 changed files with 23 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
DESCRIPTION
View File

@ -1,5 +1,5 @@
Package: AMR
Version: 1.8.2.9058
Version: 1.8.2.9059
Date: 2022-12-09
Title: Antimicrobial Resistance Data Analysis
Description: Functions to simplify and standardise antimicrobial resistance (AMR)

2
NEWS.md
View File

@ -1,4 +1,4 @@
# AMR 1.8.2.9058
# AMR 1.8.2.9059
This version will eventually become v2.0! We're happy to reach a new major milestone soon!

26
R/translate.R
View File

@ -90,6 +90,7 @@
#' reset_AMR_locale()
#' ab_name("amoxi/clav")
get_AMR_locale <- function() {
# a message for this will be thrown in translate_into_language() if outcome is non-English
if (!is.null(getOption("AMR_locale", default = NULL))) {
return(validate_language(getOption("AMR_locale"), extra_txt = "set with `options(AMR_locale = ...)`"))
}
@ -144,8 +145,10 @@ translate_AMR <- function(x, language = get_AMR_locale()) {
validate_language <- function(language, extra_txt = character(0)) {
if (isTRUE(trimws2(tolower(language[1])) %in% c("en", "english", "", "false", NA)) || length(language) == 0) {
if (length(language) == 0 || isTRUE(trimws2(tolower(language[1])) %in% c("en", "english", "", "false", NA))) {
return("en")
} else if (language[1] %in% LANGUAGES_SUPPORTED) {
return(language[1])
}
lang <- find_language(language[1], fallback = FALSE)
stop_ifnot(length(lang) > 0 && lang %in% LANGUAGES_SUPPORTED,
@ -189,7 +192,10 @@ translate_into_language <- function(from,
only_unknown = FALSE,
only_affect_ab_names = FALSE,
only_affect_mo_names = FALSE) {
if (is.null(language) || language[1] %in% c("en", "", NA)) {
# get ISO-639-1 of language
lang <- validate_language(language)
if (lang == "en") {
# don' translate
return(from)
}
@ -198,8 +204,6 @@ translate_into_language <- function(from,
from_unique <- unique(from)
from_unique_translated <- from_unique
# get ISO-639-1 of language
lang <- validate_language(language)
# only keep lines where translation is available for this language
df_trans <- df_trans[which(!is.na(df_trans[, lang, drop = TRUE])), , drop = FALSE]
# and where the original string is not equal to the string in the target language
@ -251,7 +255,17 @@ translate_into_language <- function(from,
# force UTF-8 for diacritics
from_unique_translated <- enc2utf8(from_unique_translated)
# a kind of left join to get all results back
from_unique_translated[match(from.bak, from_unique)]
out <- from_unique_translated[match(from.bak, from_unique)]
if (!identical(from.bak, out) && message_not_thrown_before("translation", entire_session = TRUE) && interactive()) {
message(word_wrap(
"Assuming the ", LANGUAGES_SUPPORTED_NAMES[[lang]]$exonym, " language (",
LANGUAGES_SUPPORTED_NAMES[[lang]]$endonym, ") for the AMR package. See `set_AMR_locale()` to change this or to silence this once-per-session note.",
add_fn = list(font_blue), as_note = TRUE
))
}
out
}

13
R/zzz.R
View File

@ -186,19 +186,6 @@ if (utf8_supported && !is_latex) {
AMR_env$MO_lookup <- create_MO_lookup()
}
.onAttach <- function(lib, pkg) {
if (interactive() && is.null(getOption("AMR_locale", default = NULL))) {
current_lang <- get_AMR_locale()
if (current_lang != "en") {
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
))
}
}
}
# Helper functions --------------------------------------------------------
create_AB_lookup <- function() {

2
inst/tinytest/test-data.R
View File

@ -66,7 +66,7 @@ if (AMR:::pkg_is_available("tibble", also_load = FALSE)) {
df <- AMR:::AMR_env$MO_lookup
expect_true(nrow(df[which(df$prevalence == 1), , drop = FALSE]) < nrow(df[which(df$prevalence == 2), , drop = FALSE]))
expect_true(nrow(df[which(df$prevalence == 2), , drop = FALSE]) < nrow(df[which(df$prevalence == 3), , drop = FALSE]))
expect_true(nrow(df[which(df$prevalence == 1), , drop = FALSE]) < nrow(df[which(df$prevalence == 3), , drop = FALSE]))
expect_true(all(c(
"mo", "fullname", "status", "kingdom", "phylum", "class", "order",
"family", "genus", "species", "subspecies", "rank", "ref", "source",