1
0
mirror of https://github.com/msberends/AMR.git synced 2024-12-25 08:06:12 +01:00

no obligatory note on startup

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

View File

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

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! This version will eventually become v2.0! We're happy to reach a new major milestone soon!

View File

@ -90,6 +90,7 @@
#' reset_AMR_locale() #' reset_AMR_locale()
#' ab_name("amoxi/clav") #' ab_name("amoxi/clav")
get_AMR_locale <- function() { 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))) { if (!is.null(getOption("AMR_locale", default = NULL))) {
return(validate_language(getOption("AMR_locale"), extra_txt = "set with `options(AMR_locale = ...)`")) 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)) { 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") return("en")
} else if (language[1] %in% LANGUAGES_SUPPORTED) {
return(language[1])
} }
lang <- find_language(language[1], fallback = FALSE) lang <- find_language(language[1], fallback = FALSE)
stop_ifnot(length(lang) > 0 && lang %in% LANGUAGES_SUPPORTED, stop_ifnot(length(lang) > 0 && lang %in% LANGUAGES_SUPPORTED,
@ -189,7 +192,10 @@ translate_into_language <- function(from,
only_unknown = FALSE, only_unknown = FALSE,
only_affect_ab_names = FALSE, only_affect_ab_names = FALSE,
only_affect_mo_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) return(from)
} }
@ -198,8 +204,6 @@ translate_into_language <- function(from,
from_unique <- unique(from) from_unique <- unique(from)
from_unique_translated <- from_unique 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 # only keep lines where translation is available for this language
df_trans <- df_trans[which(!is.na(df_trans[, lang, drop = TRUE])), , drop = FALSE] 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 # 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 # force UTF-8 for diacritics
from_unique_translated <- enc2utf8(from_unique_translated) from_unique_translated <- enc2utf8(from_unique_translated)
# a kind of left join to get all results back # 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() 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 -------------------------------------------------------- # Helper functions --------------------------------------------------------
create_AB_lookup <- function() { create_AB_lookup <- function() {

View File

@ -66,7 +66,7 @@ if (AMR:::pkg_is_available("tibble", also_load = FALSE)) {
df <- AMR:::AMR_env$MO_lookup 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 == 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( expect_true(all(c(
"mo", "fullname", "status", "kingdom", "phylum", "class", "order", "mo", "fullname", "status", "kingdom", "phylum", "class", "order",
"family", "genus", "species", "subspecies", "rank", "ref", "source", "family", "genus", "species", "subspecies", "rank", "ref", "source",