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

(v1.3.0.9018) language corrections

Browse Source
This commit is contained in:
dr. M.S. (Matthijs) Berends 2020-09-14 12:21:23 +02:00
parent 0f6760d427
commit 7b6dd676f7
30 changed files with 364 additions and 252 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
DESCRIPTION
View File

@ -1,6 +1,6 @@
Package: AMR
Version: 1.3.0.9017
Date: 2020-09-12
Version: 1.3.0.9018
Date: 2020-09-14
Title: Antimicrobial Resistance Analysis
Authors@R: c(
person(role = c("aut", "cre"),

8
NEWS.md
View File

@ -1,5 +1,5 @@
# AMR 1.3.0.9017
## <small>Last updated: 12 September 2020</small>
# AMR 1.3.0.9018
## <small>Last updated: 14 September 2020</small>
Note: some changes in this version were suggested by anonymous reviewers from the journal we submitted our manuscipt to. We are those reviewers very grateful for going through our code so thoroughly!
@ -39,10 +39,10 @@ Note: some changes in this version were suggested by anonymous reviewers from th
#> [1] 24 24
```
* Improvements for `as.mo()`:
* Any user input value that could mean more than one taxonomic entry is now considered 'uncertain'. Instead of a warning, a message will be thrown and the accompanying `mo_uncertainties()` has been changed completely; it now prints all possible candidates with their score.
* Any user input value that could mean more than one taxonomic entry is now considered 'uncertain'. Instead of a warning, a message will be thrown and the accompanying `mo_uncertainties()` has been changed completely; it now prints all possible candidates with their matching score.
* Big speed improvement for already valid microorganism ID. This also means an significant speed improvement for using `mo_*` functions like `mo_name()` on microoganism IDs.
* Added parameter `ignore_pattern` to `as.mo()` which can also be given to `mo_*` functions like `mo_name()`, to exclude known non-relevant input from analysing. This can also be set with the option `AMR_ignore_pattern`.
* `get_locale()` now uses `Sys.getlocale()` instead of `Sys.getlocale("LC_COLLATE")`
* `get_locale()` now uses at default `Sys.getenv("LANG")` or, if `LANG` is not set, `Sys.getlocale()`. This can be overwritten by setting the option `AMR_locale`.
* Speed improvement for `eucast_rules()`
* Overall speed improvement by tweaking joining functions
* Function `mo_shortname()` now returns the genus for input where the species is unknown

2
R/aa_helper_functions.R
View File

@ -644,7 +644,7 @@ file.mtime <- function(...) {
}
str2lang <- function(s) {
stopifnot(length(s) == 1L)
ex <- parse(text = s, keep.source=FALSE)
ex <- parse(text = s, keep.source = FALSE)
stopifnot(length(ex) == 1L)
ex[[1L]]
}

265
R/mo.R
View File

@ -33,6 +33,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, please 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 ... other parameters passed on to functions
#' @rdname as.mo
#' @aliases mo
@ -86,7 +87,7 @@
#' - `"Fluoroquinolone-resistant Neisseria gonorrhoeae"`. The first word will be stripped, after which the function will try to find a match. A warning will be thrown that the result *Neisseria gonorrhoeae* (``r as.mo("Neisseria gonorrhoeae")``) needs review.
#'
#' There are three helper functions that can be run after using the [as.mo()] function:
#' - Use [mo_uncertainties()] to get a [`data.frame`] that prints in a pretty format with all taxonomic names that were guessed. The output contains a score that is based on the human pathogenic prevalence and the [Levenshtein distance](https://en.wikipedia.org/wiki/Levenshtein_distance) between the full taxonomic name and the user input.
#' - Use [mo_uncertainties()] to get a [`data.frame`] that prints in a pretty format with all taxonomic names that were guessed. The output contains a score that is based on the human pathogenic prevalence and the [Levenshtein distance](https://en.wikipedia.org/wiki/Levenshtein_distance) between the user input and the full taxonomic name.
#' - Use [mo_failures()] to get a [`character`] [`vector`] with all values that could not be coerced to a valid value.
#' - Use [mo_renamed()] to get a [`data.frame`] with all values that could be coerced based on old, previously accepted taxonomic names.
#'
@ -175,6 +176,7 @@ as.mo <- function(x,
allow_uncertain = TRUE,
reference_df = get_mo_source(),
ignore_pattern = getOption("AMR_ignore_pattern"),
language = get_locale(),
...) {
check_dataset_integrity()
@ -186,7 +188,7 @@ as.mo <- function(x,
# is.mo() won't work - codes might change between package versions
return(to_class_mo(x))
}
if (tryCatch(all(tolower(x) %in% MO_lookup$fullname_lower, na.rm = TRUE)
& isFALSE(Becker)
& isFALSE(Lancefield), error = function(e) FALSE)) {
@ -203,10 +205,9 @@ as.mo <- function(x,
# WHONET: xxx = no growth
x[tolower(as.character(paste0(x, ""))) %in% c("", "xxx", "na", "nan")] <- NA_character_
# Laboratory systems: remove entries like "no growth", etc.
x[trimws2(x) %like% "(no .*growth|keine? .*wachtstum|geen .*groei|no .*crecimientonon|sem .*crescimento|pas .*croissance)"] <- NA_character_
x[trimws2(x) %like% "^(no|not|kein|geen|niet|non|sem) [a-z]+"] <- "UNKNOWN"
# Laboratory systems: remove (translated) entries like "no growth", etc.
x[trimws2(x) %like% translate_AMR("no .*growth", language = language)] <- NA_character_
x[trimws2(x) %like% paste0("^(", translate_AMR("no|not", language = language), ") [a-z]+")] <- "UNKNOWN"
uncertainty_level <- translate_allow_uncertain(allow_uncertain)
if (mo_source_isvalid(reference_df)
@ -244,8 +245,10 @@ as.mo <- function(x,
# will be checked for mo class in validation and uses exec_as.mo internally if necessary
y <- mo_validate(x = x, property = "mo",
Becker = Becker, Lancefield = Lancefield,
allow_uncertain = uncertainty_level, reference_df = reference_df,
allow_uncertain = uncertainty_level,
reference_df = reference_df,
ignore_pattern = ignore_pattern,
language = language,
...)
}
@ -268,6 +271,9 @@ is.mo <- function(x) {
# param dyslexia_mode logical - also check for characters that resemble others
# param debug logical - show different lookup texts while searching
# param reference_data_to_use data.frame - the data set to check for
# param actual_uncertainty - (only for initial_search = FALSE) the actual uncertainty level used in the function for score calculation (sometimes passed as 2 or 3 by uncertain_fn())
# param actual_input - (only for initial_search = FALSE) the actual, original input
# param language - used for translating "no growth", etc.
exec_as.mo <- function(x,
Becker = FALSE,
Lancefield = FALSE,
@ -278,33 +284,62 @@ exec_as.mo <- function(x,
dyslexia_mode = FALSE,
debug = FALSE,
ignore_pattern = getOption("AMR_ignore_pattern"),
reference_data_to_use = MO_lookup) {
reference_data_to_use = MO_lookup,
actual_uncertainty = 1,
actual_input = NULL,
language = get_locale()) {
check_dataset_integrity()
lookup <- function(needle, column = property, haystack = reference_data_to_use, n = 1, debug_mode = debug, input = "") {
lookup <- function(needle,
column = property,
haystack = reference_data_to_use,
n = 1,
debug_mode = debug,
initial = initial_search,
uncertainty = actual_uncertainty,
input_actual = actual_input) {
if (!is.null(input_actual)) {
input <- input_actual
} else {
input <- tryCatch(x_backup[i], error = function(e) "")
}
# `column` can be NULL for all columns, or a selection
# returns a character (vector) - if `column` > length 1 then with columns as names
if (isTRUE(debug_mode)) {
cat(font_silver("looking up: ", substitute(needle), "\n", collapse = ""))
cat(font_silver("looking up: ", substitute(needle), collapse = ""))
}
if (length(column) == 1) {
res_df <- haystack[which(eval(substitute(needle), envir = haystack, enclos = parent.frame())), , drop = FALSE]
if (NROW(res_df) > 1) {
# sort the findings on matching score
res_df <- res_df[order(mo_matching_score(x_backup[i], res_df[, "fullname", drop = TRUE]), decreasing = TRUE), , drop = FALSE]
}
res <- as.character(res_df[, column, drop = TRUE])
if (length(res) == 0) {
if (isTRUE(debug_mode)) {
cat(font_red(" (no match)\n"))
}
NA_character_
} else {
if (length(res) > n) {
if (isTRUE(debug_mode)) {
cat(font_green(paste0(" **MATCH** (", NROW(res_df), " results)\n")))
}
if (length(res) > n | uncertainty > 1) {
# save the other possible results as well
uncertainties <<- rbind(uncertainties,
format_uncertainty_as_df(uncertainty_level = 1,
input = x_backup[i],
format_uncertainty_as_df(uncertainty_level = uncertainty,
input = input,
result_mo = res_df[1, "mo", drop = TRUE],
candidates = as.character(res_df[, "fullname", drop = TRUE])))
}
res[seq_len(min(n, length(res)))]
}
} else {
if (isTRUE(debug_mode)) {
cat("\n")
}
if (is.null(column)) {
column <- names(haystack)
}
@ -318,7 +353,7 @@ exec_as.mo <- function(x,
res
}
}
# start off with replaced language-specific non-ASCII characters with ASCII characters
x <- parse_and_convert(x)
# replace mo codes used in older package versions
@ -328,9 +363,9 @@ exec_as.mo <- function(x,
# WHONET: xxx = no growth
x[tolower(as.character(paste0(x, ""))) %in% c("", "xxx", "na", "nan")] <- NA_character_
# Laboratory systems: remove entries like "no growth" etc
x[trimws2(x) %like% "(no .*growth|keine? .*wachtstum|geen .*groei|no .*crecimientonon|sem .*crescimento|pas .*croissance)"] <- NA_character_
x[trimws2(x) %like% "^(no|not|kein|geen|niet|non|sem) [a-z]+"] <- "UNKNOWN"
# Laboratory systems: remove (translated) entries like "no growth", etc.
x[trimws2(x) %like% translate_AMR("no .*growth", language = language)] <- NA_character_
x[trimws2(x) %like% paste0("^(", translate_AMR("no|not", language = language), ") [a-z]+")] <- "UNKNOWN"
if (initial_search == TRUE) {
options(mo_failures = NULL)
@ -402,7 +437,7 @@ exec_as.mo <- function(x,
# we need special treatment for very prevalent full names, they are likely!
# e.g. as.mo("Staphylococcus aureus")
x <- MO_lookup[match(tolower(x), MO_lookup$fullname_lower), property, drop = TRUE]
} else if (all(x %in% reference_data_to_use$fullname)) {
# we need special treatment for very prevalent full names, they are likely!
# e.g. as.mo("Staphylococcus aureus")
@ -981,7 +1016,7 @@ exec_as.mo <- function(x,
# (1) look again for old taxonomic names, now for G. species ----
if (isTRUE(debug)) {
cat("\n[ UNCERTAINTY LEVEL", now_checks_for_uncertainty_level, "] (1) look again for old taxonomic names, now for G. species\n")
cat(font_bold("\n[ UNCERTAINTY LEVEL", now_checks_for_uncertainty_level, "] (1) look again for old taxonomic names, now for G. species\n"))
}
if (isTRUE(debug)) {
message("Running '", d.x_withspaces_start_end, "' and '", e.x_withspaces_start_only, "'")
@ -1015,24 +1050,22 @@ exec_as.mo <- function(x,
# (2) Try with misspelled input ----
# just rerun with dyslexia_mode = TRUE will used the extensive regex part above
if (isTRUE(debug)) {
cat("\n[ UNCERTAINTY LEVEL", now_checks_for_uncertainty_level, "] (2) Try with misspelled input\n")
cat(font_bold("\n[ UNCERTAINTY LEVEL", now_checks_for_uncertainty_level, "] (2) Try with misspelled input\n"))
}
if (isTRUE(debug)) {
message("Running '", a.x_backup, "'")
}
# first try without dyslexia mode
found <- suppressMessages(suppressWarnings(exec_as.mo(a.x_backup, initial_search = FALSE, dyslexia_mode = FALSE, allow_uncertain = FALSE, debug = debug, reference_data_to_use = uncertain.reference_data_to_use)))
found <- suppressMessages(suppressWarnings(exec_as.mo(a.x_backup, initial_search = FALSE, dyslexia_mode = FALSE, allow_uncertain = FALSE, debug = debug, reference_data_to_use = uncertain.reference_data_to_use, actual_uncertainty = 1, actual_input = a.x_backup)))
if (empty_result(found)) {
# then with dyslexia mode
found <- suppressMessages(suppressWarnings(exec_as.mo(a.x_backup, initial_search = FALSE, dyslexia_mode = TRUE, allow_uncertain = FALSE, debug = debug, reference_data_to_use = uncertain.reference_data_to_use)))
found <- suppressMessages(suppressWarnings(exec_as.mo(a.x_backup, initial_search = FALSE, dyslexia_mode = TRUE, allow_uncertain = FALSE, debug = debug, reference_data_to_use = uncertain.reference_data_to_use, actual_uncertainty = 1, actual_input = a.x_backup)))
}
if (!empty_result(found)) {
found_result <- found
found <- lookup(mo == found)
uncertainties <<- rbind(uncertainties,
format_uncertainty_as_df(uncertainty_level = now_checks_for_uncertainty_level,
input = a.x_backup,
result_mo = found_result))
attr(found, which = "uncertainties", exact = TRUE))
found <- lookup(mo == found)
return(found)
}
}
@ -1043,7 +1076,7 @@ exec_as.mo <- function(x,
# (3) look for genus only, part of name ----
if (isTRUE(debug)) {
cat("\n[ UNCERTAINTY LEVEL", now_checks_for_uncertainty_level, "] (3) look for genus only, part of name\n")
cat(font_bold("\n[ UNCERTAINTY LEVEL", now_checks_for_uncertainty_level, "] (3) look for genus only, part of name\n"))
}
if (nchar(g.x_backup_without_spp) > 4 & !b.x_trimmed %like_case% " ") {
if (!grepl("^[A-Z][a-z]+", b.x_trimmed, ignore.case = FALSE)) {
@ -1067,7 +1100,7 @@ exec_as.mo <- function(x,
# (4) strip values between brackets ----
if (isTRUE(debug)) {
cat("\n[ UNCERTAINTY LEVEL", now_checks_for_uncertainty_level, "] (4) strip values between brackets\n")
cat(font_bold("\n[ UNCERTAINTY LEVEL", now_checks_for_uncertainty_level, "] (4) strip values between brackets\n"))
}
a.x_backup_stripped <- gsub("( *[(].*[)] *)", " ", a.x_backup)
a.x_backup_stripped <- trimws(gsub(" +", " ", a.x_backup_stripped))
@ -1075,48 +1108,45 @@ exec_as.mo <- function(x,
message("Running '", a.x_backup_stripped, "'")
}
# first try without dyslexia mode
found <- suppressMessages(suppressWarnings(exec_as.mo(a.x_backup_stripped, initial_search = FALSE, dyslexia_mode = FALSE, allow_uncertain = FALSE, debug = debug, reference_data_to_use = uncertain.reference_data_to_use)))
found <- suppressMessages(suppressWarnings(exec_as.mo(a.x_backup_stripped, initial_search = FALSE, dyslexia_mode = FALSE, allow_uncertain = FALSE, debug = debug, reference_data_to_use = uncertain.reference_data_to_use, actual_uncertainty = 2, actual_input = a.x_backup)))
if (empty_result(found)) {
# then with dyslexia mode
found <- suppressMessages(suppressWarnings(exec_as.mo(a.x_backup_stripped, initial_search = FALSE, dyslexia_mode = TRUE, allow_uncertain = FALSE, debug = debug, reference_data_to_use = uncertain.reference_data_to_use)))
found <- suppressMessages(suppressWarnings(exec_as.mo(a.x_backup_stripped, initial_search = FALSE, dyslexia_mode = TRUE, allow_uncertain = FALSE, debug = debug, reference_data_to_use = uncertain.reference_data_to_use, actual_uncertainty = 2, actual_input = a.x_backup)))
}
if (!empty_result(found) & nchar(g.x_backup_without_spp) >= 6) {
found_result <- found
found <- lookup(mo == found)
uncertainties <<- rbind(uncertainties,
format_uncertainty_as_df(uncertainty_level = now_checks_for_uncertainty_level,
input = a.x_backup,
result_mo = found_result))
attr(found, which = "uncertainties", exact = TRUE))
found <- lookup(mo == found)
return(found)
}
# (5) inverse input ----
if (isTRUE(debug)) {
cat("\n[ UNCERTAINTY LEVEL", now_checks_for_uncertainty_level, "] (5) inverse input\n")
cat(font_bold("\n[ UNCERTAINTY LEVEL", now_checks_for_uncertainty_level, "] (5) inverse input\n"))
}
a.x_backup_inversed <- paste(rev(unlist(strsplit(a.x_backup, split = " "))), collapse = " ")
if (isTRUE(debug)) {
message("Running '", a.x_backup_inversed, "'")
}
# first try without dyslexia mode
found <- suppressMessages(suppressWarnings(exec_as.mo(a.x_backup_inversed, initial_search = FALSE, dyslexia_mode = FALSE, allow_uncertain = FALSE, debug = debug, reference_data_to_use = uncertain.reference_data_to_use)))
found <- suppressMessages(suppressWarnings(exec_as.mo(a.x_backup_inversed, initial_search = FALSE, dyslexia_mode = FALSE, allow_uncertain = FALSE, debug = debug, reference_data_to_use = uncertain.reference_data_to_use, actual_uncertainty = 2, actual_input = a.x_backup)))
if (empty_result(found)) {
# then with dyslexia mode
found <- suppressMessages(suppressWarnings(exec_as.mo(a.x_backup_inversed, initial_search = FALSE, dyslexia_mode = TRUE, allow_uncertain = FALSE, debug = debug, reference_data_to_use = uncertain.reference_data_to_use)))
found <- suppressMessages(suppressWarnings(exec_as.mo(a.x_backup_inversed, initial_search = FALSE, dyslexia_mode = TRUE, allow_uncertain = FALSE, debug = debug, reference_data_to_use = uncertain.reference_data_to_use, actual_uncertainty = 2, actual_input = a.x_backup)))
}
if (!empty_result(found) & nchar(g.x_backup_without_spp) >= 6) {
found_result <- found
found <- lookup(mo == found)
uncertainties <<- rbind(uncertainties,
format_uncertainty_as_df(uncertainty_level = now_checks_for_uncertainty_level,
input = a.x_backup,
result_mo = found_result))
attr(found, which = "uncertainties", exact = TRUE))
found <- lookup(mo == found)
return(found)
}
# (6) try to strip off half an element from end and check the remains ----
if (isTRUE(debug)) {
cat("\n[ UNCERTAINTY LEVEL", now_checks_for_uncertainty_level, "] (6) try to strip off half an element from end and check the remains\n")
cat(font_bold("\n[ UNCERTAINTY LEVEL", now_checks_for_uncertainty_level, "] (6) try to strip off half an element from end and check the remains\n"))
}
x_strip <- a.x_backup %>% strsplit("[ .]") %>% unlist()
if (length(x_strip) > 1) {
@ -1130,18 +1160,16 @@ exec_as.mo <- function(x,
message("Running '", x_strip_collapsed, "'")
}
# first try without dyslexia mode
found <- suppressMessages(suppressWarnings(exec_as.mo(x_strip_collapsed, initial_search = FALSE, dyslexia_mode = FALSE, allow_uncertain = FALSE, debug = debug, reference_data_to_use = uncertain.reference_data_to_use)))
found <- suppressMessages(suppressWarnings(exec_as.mo(x_strip_collapsed, initial_search = FALSE, dyslexia_mode = FALSE, allow_uncertain = FALSE, debug = debug, reference_data_to_use = uncertain.reference_data_to_use, actual_uncertainty = 2, actual_input = a.x_backup)))
if (empty_result(found)) {
# then with dyslexia mode
found <- suppressMessages(suppressWarnings(exec_as.mo(x_strip_collapsed, initial_search = FALSE, dyslexia_mode = TRUE, allow_uncertain = FALSE, debug = debug, reference_data_to_use = uncertain.reference_data_to_use)))
found <- suppressMessages(suppressWarnings(exec_as.mo(x_strip_collapsed, initial_search = FALSE, dyslexia_mode = TRUE, allow_uncertain = FALSE, debug = debug, reference_data_to_use = uncertain.reference_data_to_use, actual_uncertainty = 2, actual_input = a.x_backup)))
}
if (!empty_result(found)) {
found_result <- found
found <- lookup(mo == found)
uncertainties <<- rbind(uncertainties,
format_uncertainty_as_df(uncertainty_level = now_checks_for_uncertainty_level,
input = a.x_backup,
result_mo = found_result))
attr(found, which = "uncertainties", exact = TRUE))
found <- lookup(mo == found)
return(found)
}
}
@ -1149,7 +1177,7 @@ exec_as.mo <- function(x,
}
# (7) try to strip off one element from end and check the remains ----
if (isTRUE(debug)) {
cat("\n[ UNCERTAINTY LEVEL", now_checks_for_uncertainty_level, "] (7) try to strip off one element from end and check the remains\n")
cat(font_bold("\n[ UNCERTAINTY LEVEL", now_checks_for_uncertainty_level, "] (7) try to strip off one element from end and check the remains\n"))
}
if (length(x_strip) > 1) {
for (i in seq_len(length(x_strip) - 1)) {
@ -1159,18 +1187,17 @@ exec_as.mo <- function(x,
message("Running '", x_strip_collapsed, "'")
}
# first try without dyslexia mode
found <- suppressMessages(suppressWarnings(exec_as.mo(x_strip_collapsed, initial_search = FALSE, dyslexia_mode = FALSE, allow_uncertain = FALSE, debug = debug, reference_data_to_use = uncertain.reference_data_to_use)))
found <- suppressMessages(suppressWarnings(exec_as.mo(x_strip_collapsed, initial_search = FALSE, dyslexia_mode = FALSE, allow_uncertain = FALSE, debug = debug, reference_data_to_use = uncertain.reference_data_to_use, actual_uncertainty = 2, actual_input = a.x_backup)))
if (empty_result(found)) {
# then with dyslexia mode
found <- suppressMessages(suppressWarnings(exec_as.mo(x_strip_collapsed, initial_search = FALSE, dyslexia_mode = TRUE, allow_uncertain = FALSE, debug = debug, reference_data_to_use = uncertain.reference_data_to_use)))
found <- suppressMessages(suppressWarnings(exec_as.mo(x_strip_collapsed, initial_search = FALSE, dyslexia_mode = TRUE, allow_uncertain = FALSE, debug = debug, reference_data_to_use = uncertain.reference_data_to_use, actual_uncertainty = 2, actual_input = a.x_backup)))
}
if (!empty_result(found)) {
found_result <- found
found <- lookup(mo == found)
uncertainties <<- rbind(uncertainties,
format_uncertainty_as_df(uncertainty_level = now_checks_for_uncertainty_level,
input = a.x_backup,
result_mo = found_result))
attr(found, which = "uncertainties", exact = TRUE))
found <- lookup(mo == found)
return(found)
}
}
@ -1178,7 +1205,7 @@ exec_as.mo <- function(x,
}
# (8) check for unknown yeasts/fungi ----
if (isTRUE(debug)) {
cat("\n[ UNCERTAINTY LEVEL", now_checks_for_uncertainty_level, "] (8) check for unknown yeasts/fungi\n")
cat(font_bold("\n[ UNCERTAINTY LEVEL", now_checks_for_uncertainty_level, "] (8) check for unknown yeasts/fungi\n"))
}
if (b.x_trimmed %like_case% "yeast") {
found <- "F_YEAST"
@ -1202,7 +1229,7 @@ exec_as.mo <- function(x,
}
# (9) try to strip off one element from start and check the remains (only allow >= 2-part name outcome) ----
if (isTRUE(debug)) {
cat("\n[ UNCERTAINTY LEVEL", now_checks_for_uncertainty_level, "] (9) try to strip off one element from start and check the remains (only allow >= 2-part name outcome)\n")
cat(font_bold("\n[ UNCERTAINTY LEVEL", now_checks_for_uncertainty_level, "] (9) try to strip off one element from start and check the remains (only allow >= 2-part name outcome)\n"))
}
x_strip <- a.x_backup %>% strsplit("[ .]") %>% unlist()
if (length(x_strip) > 1 & nchar(g.x_backup_without_spp) >= 6) {
@ -1212,10 +1239,10 @@ exec_as.mo <- function(x,
message("Running '", x_strip_collapsed, "'")
}
# first try without dyslexia mode
found <- suppressMessages(suppressWarnings(exec_as.mo(x_strip_collapsed, initial_search = FALSE, dyslexia_mode = FALSE, allow_uncertain = FALSE, debug = debug, reference_data_to_use = uncertain.reference_data_to_use)))
found <- suppressMessages(suppressWarnings(exec_as.mo(x_strip_collapsed, initial_search = FALSE, dyslexia_mode = FALSE, allow_uncertain = FALSE, debug = debug, reference_data_to_use = uncertain.reference_data_to_use, actual_uncertainty = 2, actual_input = a.x_backup)))
if (empty_result(found)) {
# then with dyslexia mode
found <- suppressMessages(suppressWarnings(exec_as.mo(x_strip_collapsed, initial_search = FALSE, dyslexia_mode = TRUE, allow_uncertain = FALSE, debug = debug, reference_data_to_use = uncertain.reference_data_to_use)))
found <- suppressMessages(suppressWarnings(exec_as.mo(x_strip_collapsed, initial_search = FALSE, dyslexia_mode = TRUE, allow_uncertain = FALSE, debug = debug, reference_data_to_use = uncertain.reference_data_to_use, actual_uncertainty = 2, actual_input = a.x_backup)))
}
if (!empty_result(found)) {
found_result <- found
@ -1239,7 +1266,7 @@ exec_as.mo <- function(x,
# (10) try to strip off one element from start and check the remains (any text size) ----
if (isTRUE(debug)) {
cat("\n[ UNCERTAINTY LEVEL", now_checks_for_uncertainty_level, "] (10) try to strip off one element from start and check the remains (any text size)\n")
cat(font_bold("\n[ UNCERTAINTY LEVEL", now_checks_for_uncertainty_level, "] (10) try to strip off one element from start and check the remains (any text size)\n"))
}
x_strip <- a.x_backup %>% strsplit("[ .]") %>% unlist()
if (length(x_strip) > 1 & nchar(g.x_backup_without_spp) >= 6) {
@ -1249,10 +1276,10 @@ exec_as.mo <- function(x,
message("Running '", x_strip_collapsed, "'")
}
# first try without dyslexia mode
found <- suppressMessages(suppressWarnings(exec_as.mo(x_strip_collapsed, initial_search = FALSE, dyslexia_mode = FALSE, allow_uncertain = FALSE, debug = debug, reference_data_to_use = uncertain.reference_data_to_use)))
found <- suppressMessages(suppressWarnings(exec_as.mo(x_strip_collapsed, initial_search = FALSE, dyslexia_mode = FALSE, allow_uncertain = FALSE, debug = debug, reference_data_to_use = uncertain.reference_data_to_use, actual_uncertainty = 3, actual_input = a.x_backup)))
if (empty_result(found)) {
# then with dyslexia mode
found <- suppressMessages(suppressWarnings(exec_as.mo(x_strip_collapsed, initial_search = FALSE, dyslexia_mode = TRUE, allow_uncertain = FALSE, debug = debug, reference_data_to_use = uncertain.reference_data_to_use)))
found <- suppressMessages(suppressWarnings(exec_as.mo(x_strip_collapsed, initial_search = FALSE, dyslexia_mode = TRUE, allow_uncertain = FALSE, debug = debug, reference_data_to_use = uncertain.reference_data_to_use, actual_uncertainty = 3, actual_input = a.x_backup)))
}
if (!empty_result(found)) {
found_result <- found
@ -1268,7 +1295,7 @@ exec_as.mo <- function(x,
# (11) try to strip off one element from end and check the remains (any text size) ----
# (this is in fact 7 but without nchar limit of >=6)
if (isTRUE(debug)) {
cat("\n[ UNCERTAINTY LEVEL", now_checks_for_uncertainty_level, "] (11) try to strip off one element from end and check the remains (any text size)\n")
cat(font_bold("\n[ UNCERTAINTY LEVEL", now_checks_for_uncertainty_level, "] (11) try to strip off one element from end and check the remains (any text size)\n"))
}
if (length(x_strip) > 1) {
for (i in seq_len(length(x_strip) - 1)) {
@ -1277,10 +1304,10 @@ exec_as.mo <- function(x,
message("Running '", x_strip_collapsed, "'")
}
# first try without dyslexia mode
found <- suppressMessages(suppressWarnings(exec_as.mo(x_strip_collapsed, initial_search = FALSE, dyslexia_mode = FALSE, allow_uncertain = FALSE, debug = debug, reference_data_to_use = uncertain.reference_data_to_use)))
found <- suppressMessages(suppressWarnings(exec_as.mo(x_strip_collapsed, initial_search = FALSE, dyslexia_mode = FALSE, allow_uncertain = FALSE, debug = debug, reference_data_to_use = uncertain.reference_data_to_use, actual_uncertainty = 3, actual_input = a.x_backup)))
if (empty_result(found)) {
# then with dyslexia mode
found <- suppressMessages(suppressWarnings(exec_as.mo(x_strip_collapsed, initial_search = FALSE, dyslexia_mode = TRUE, allow_uncertain = FALSE, debug = debug, reference_data_to_use = uncertain.reference_data_to_use)))
found <- suppressMessages(suppressWarnings(exec_as.mo(x_strip_collapsed, initial_search = FALSE, dyslexia_mode = TRUE, allow_uncertain = FALSE, debug = debug, reference_data_to_use = uncertain.reference_data_to_use, actual_uncertainty = 3, actual_input = a.x_backup)))
}
if (!empty_result(found)) {
found_result <- found
@ -1296,7 +1323,7 @@ exec_as.mo <- function(x,
# (12) part of a name (very unlikely match) ----
if (isTRUE(debug)) {
cat("\n[ UNCERTAINTY LEVEL", now_checks_for_uncertainty_level, "] (12) part of a name (very unlikely match)\n")
cat(font_bold("\n[ UNCERTAINTY LEVEL", now_checks_for_uncertainty_level, "] (12) part of a name (very unlikely match)\n"))
}
if (isTRUE(debug)) {
message("Running '", f.x_withspaces_end_only, "'")
@ -1324,20 +1351,20 @@ exec_as.mo <- function(x,
e.x_withspaces_start_only = e.x_withspaces_start_only,
f.x_withspaces_end_only = f.x_withspaces_end_only,
g.x_backup_without_spp = g.x_backup_without_spp,
uncertain.reference_data_to_use = MO_lookup[which(MO_lookup$prevalence %in% c(1, 2)), ])
if (!empty_result(x[i])) {
return(x[i])
}
x[i] <- uncertain_fn(a.x_backup = a.x_backup,
b.x_trimmed = b.x_trimmed,
d.x_withspaces_start_end = d.x_withspaces_start_end,
e.x_withspaces_start_only = e.x_withspaces_start_only,
f.x_withspaces_end_only = f.x_withspaces_end_only,
g.x_backup_without_spp = g.x_backup_without_spp,
uncertain.reference_data_to_use = MO_lookup[which(MO_lookup$prevalence == 3), ])
uncertain.reference_data_to_use = MO_lookup) # MO_lookup[which(MO_lookup$prevalence %in% c(1, 2)), ])
if (!empty_result(x[i])) {
return(x[i])
}
# x[i] <- uncertain_fn(a.x_backup = a.x_backup,
# b.x_trimmed = b.x_trimmed,
# d.x_withspaces_start_end = d.x_withspaces_start_end,
# e.x_withspaces_start_only = e.x_withspaces_start_only,
# f.x_withspaces_end_only = f.x_withspaces_end_only,
# g.x_backup_without_spp = g.x_backup_without_spp,
# uncertain.reference_data_to_use = MO_lookup[which(MO_lookup$prevalence == 3), ])
# if (!empty_result(x[i])) {
# return(x[i])
# }
# didn't found any
return(NA_character_)
@ -1389,20 +1416,25 @@ exec_as.mo <- function(x,
if (n_distinct(failures) <= 10) {
msg <- paste0(msg, ": ", paste('"', unique(failures), '"', sep = "", collapse = ", "))
}
msg <- paste0(msg, ".\nUse mo_failures() to review ", plural[2], ". Edit the `allow_uncertain` parameter if needed (see ?as.mo).")
msg <- paste0(msg,
".\nUse mo_failures() to review ", plural[2], ". Edit the `allow_uncertain` parameter if needed (see ?as.mo).\n",
"You can also use your own reference data, e.g.:\n",
' as.mo("mycode", reference_df = data.frame(own = "mycode", mo = "B_ESCHR_COLI"))\n',
' mo_name("mycode", reference_df = data.frame(own = "mycode", mo = "B_ESCHR_COLI"))\n')
warning(font_red(paste0("\n", msg)),
call. = FALSE,
immediate. = TRUE) # thus will always be shown, even if >= warnings
}
# handling uncertainties ----
if (NROW(uncertainties) > 0 & initial_search == TRUE) {
options(mo_uncertainties = as.list(distinct(uncertainties, input, .keep_all = TRUE)))
uncertainties <- as.list(distinct(uncertainties, input, .keep_all = TRUE))
options(mo_uncertainties = uncertainties)
plural <- c("", "it", "was")
if (NROW(uncertainties) > 1) {
if (length(uncertainties$input) > 1) {
plural <- c("s", "them", "were")
}
msg <- paste0("Result", plural[1], " of ", nr2char(NROW(uncertainties)), " value", plural[1],
msg <- paste0("Result", plural[1], " of ", nr2char(length(uncertainties$input)), " value", plural[1],
" ", plural[3], " guessed with uncertainty. Use mo_uncertainties() to review ", plural[2], ".")
message(font_blue(msg))
}
@ -1501,6 +1533,11 @@ exec_as.mo <- function(x,
print(mo_renamed())
}
if (NROW(uncertainties) > 0 & initial_search == FALSE) {
# this will save the uncertain items as attribute, so they can be bound to `uncertainties` in the uncertain_fn() function
x <- structure(x, uncertainties = uncertainties)
}
if (old_mo_warning == TRUE & property != "mo") {
warning("The input contained old microorganism IDs from previous versions of this package.\nPlease use `as.mo()` on these old IDs to transform them to the new format.\nSUPPORT FOR THIS WILL BE DROPPED IN A FUTURE VERSION.", call. = FALSE)
}
@ -1531,7 +1568,6 @@ format_uncertainty_as_df <- function(uncertainty_level,
input,
result_mo,
candidates = NULL) {
if (!is.null(getOption("mo_renamed_last_run", default = NULL))) {
fullname <- getOption("mo_renamed_last_run")
options(mo_renamed_last_run = NULL)
@ -1545,8 +1581,8 @@ format_uncertainty_as_df <- function(uncertainty_level,
fullname = fullname,
renamed_to = renamed_to,
mo = result_mo,
# save max 25 entries
candidates = if (length(candidates) > 1) paste(candidates[c(2:min(25, length(candidates)))], collapse = ", ") else "",
# save max 26 entries: the one to be chosen and 25 more
candidates = if (length(candidates) > 1) paste(candidates[c(2:min(26, length(candidates)))], collapse = ", ") else "",
stringsAsFactors = FALSE)
}
@ -1712,43 +1748,32 @@ print.mo_uncertainties <- function(x, ...) {
if (NROW(x) == 0) {
return(NULL)
}
cat(paste0(font_bold(nr2char(nrow(x)), paste0("unique result", ifelse(nrow(x) > 1, "s", ""), " guessed with uncertainty:")),
"\n(1 = ", font_green("renamed/misspelled"),
", 2 = ", font_yellow("uncertain"),
", 3 = ", font_red("very uncertain"), ")\n"))
cat(font_blue("Scores are based on human pathogenic prevalence and the resemblance between the input and the full taxonomic name.\n"))
msg <- ""
for (i in seq_len(nrow(x))) {
if (x[i, "uncertainty"] == 1) {
colour1 <- font_green
colour2 <- function(...) font_green_bg(font_white(...))
} else if (x[i, "uncertainty"] == 2) {
colour1 <- font_yellow
colour2 <- function(...) font_yellow_bg(font_black(...))
} else {
colour1 <- font_red
colour2 <- function(...) font_red_bg(font_white(...))
}
if (x[i, "candidates"] != "") {
candidates <- unlist(strsplit(x[i, "candidates"], ", ", fixed = TRUE))
scores <- finding_score(x[i, "input"], candidates)
if (x[i, ]$candidates != "") {
candidates <- unlist(strsplit(x[i, ]$candidates, ", ", fixed = TRUE))
scores <- mo_matching_score(x[i, ]$input, candidates) * (1 / x[i, ]$uncertainty)
# sort on descending scores
candidates <- candidates[order(1 - scores)]
n_candidates <- length(candidates)
candidates <- paste0(font_italic(candidates, collapse = NULL),
" (", trimws(percentage(scores[order(1 - scores)], digits = 1)), ")")
candidates <- paste(candidates, collapse = ", ")
# align with input after arrow
candidates <- paste0("\n", strrep(" ", nchar(x[i, "input"]) + 12), "Other: ", candidates)
candidates <- paste0("\n", strrep(" ", nchar(x[i, ]$input) + 6),
"Other", ifelse(n_candidates == 25, " (max 25)", ""), ": ", candidates)
} else {
candidates <- ""
}
msg <- paste(msg,
paste0(colour2(paste0(" [", x[i, "uncertainty"], "] ")), ' "', x[i, "input"], '" -> ',
colour1(paste0(font_italic(x[i, "fullname"]),
ifelse(!is.na(x[i, "renamed_to"]), paste(", renamed to", font_italic(x[i, "renamed_to"])), ""),
" (", x[i, "mo"],
", score: ", trimws(percentage(finding_score(x[i, "input"], x[i, "fullname"]), digits = 1)),
")")),
paste0('"', x[i, ]$input, '" -> ',
paste0(font_bold(font_italic(x[i, ]$fullname)),
ifelse(!is.na(x[i, ]$renamed_to), paste(", renamed to", font_italic(x[i, ]$renamed_to)), ""),
" (", x[i, ]$mo,
", score: ", trimws(percentage(mo_matching_score(x[i, ]$input, x[i, ]$fullname) * (1 / x[i, ]$uncertainty), digits = 1)),
")"),
candidates),
sep = "\n")
}
@ -1834,24 +1859,24 @@ load_mo_failures_uncertainties_renamed <- function(metadata) {
options("mo_renamed" = metadata$renamed)
}
finding_score <- function(input, output) {
# output is always a valid fullname
mo_matching_score <- function(input, fullname) {
# fullname is always a taxonomically valid full name
levenshtein <- double(length = length(input))
if (length(output) == 1) {
output <- rep(output, length(input))
if (length(fullname) == 1) {
fullname <- rep(fullname, length(input))
}
if (length(input) == 1) {
input <- rep(input, length(output))
input <- rep(input, length(fullname))
}
for (i in seq_len(length(input))) {
# determine Levenshtein distance, but maximise to nchar of output
levenshtein[i] <- min(as.double(utils::adist(input[i], output[i], ignore.case = TRUE)),
nchar(output[i]))
# determine Levenshtein distance, but maximise to nchar of fullname
levenshtein[i] <- min(as.double(utils::adist(input[i], fullname[i], ignore.case = FALSE)),
nchar(fullname[i]))
}
# self-made score between 0 and 1 (for % certainty, so 0 means huge distance, 1 means no distance)
dist <- (nchar(output) - 0.5 * levenshtein) / nchar(output)
index_in_MO_lookup <- tryCatch((nrow(MO_lookup) - match(output, MO_lookup$fullname)) / nrow(MO_lookup),
error = function(e) rep(1, length(output)))
dist <- (nchar(fullname) - 0.5 * levenshtein) / nchar(fullname)
index_in_MO_lookup <- tryCatch((nrow(MO_lookup) - match(fullname, MO_lookup$fullname)) / nrow(MO_lookup),
error = function(e) rep(1, length(fullname)))
dist * index_in_MO_lookup
}

64
R/mo_property.R
View File

@ -141,7 +141,7 @@
#' mo_info("E. coli")
#' }
mo_name <- function(x, language = get_locale(), ...) {
translate_AMR(mo_validate(x = x, property = "fullname", ...), language = language, only_unknown = FALSE)
translate_AMR(mo_validate(x = x, property = "fullname", language = language, ...), language = language, only_unknown = FALSE)
}
#' @rdname mo_property
@ -151,7 +151,7 @@ mo_fullname <- mo_name
#' @rdname mo_property
#' @export
mo_shortname <- function(x, language = get_locale(), ...) {
x.mo <- as.mo(x, ...)
x.mo <- as.mo(x, language = language, ...)
metadata <- get_mo_failures_uncertainties_renamed()
@ -181,49 +181,49 @@ mo_shortname <- function(x, language = get_locale(), ...) {
#' @rdname mo_property
#' @export
mo_subspecies <- function(x, language = get_locale(), ...) {
translate_AMR(mo_validate(x = x, property = "subspecies", ...), language = language, only_unknown = TRUE)
translate_AMR(mo_validate(x = x, property = "subspecies", language = language, ...), language = language, only_unknown = TRUE)
}
#' @rdname mo_property
#' @export
mo_species <- function(x, language = get_locale(), ...) {
translate_AMR(mo_validate(x = x, property = "species", ...), language = language, only_unknown = TRUE)
translate_AMR(mo_validate(x = x, property = "species", language = language, ...), language = language, only_unknown = TRUE)
}
#' @rdname mo_property
#' @export
mo_genus <- function(x, language = get_locale(), ...) {
translate_AMR(mo_validate(x = x, property = "genus", ...), language = language, only_unknown = TRUE)
translate_AMR(mo_validate(x = x, property = "genus", language = language, ...), language = language, only_unknown = TRUE)
}
#' @rdname mo_property
#' @export
mo_family <- function(x, language = get_locale(), ...) {
translate_AMR(mo_validate(x = x, property = "family", ...), language = language, only_unknown = TRUE)
translate_AMR(mo_validate(x = x, property = "family", language = language, ...), language = language, only_unknown = TRUE)
}
#' @rdname mo_property
#' @export
mo_order <- function(x, language = get_locale(), ...) {
translate_AMR(mo_validate(x = x, property = "order", ...), language = language, only_unknown = TRUE)
translate_AMR(mo_validate(x = x, property = "order", language = language, ...), language = language, only_unknown = TRUE)
}
#' @rdname mo_property
#' @export
mo_class <- function(x, language = get_locale(), ...) {
translate_AMR(mo_validate(x = x, property = "class", ...), language = language, only_unknown = TRUE)
translate_AMR(mo_validate(x = x, property = "class", language = language, ...), language = language, only_unknown = TRUE)
}
#' @rdname mo_property
#' @export
mo_phylum <- function(x, language = get_locale(), ...) {
translate_AMR(mo_validate(x = x, property = "phylum", ...), language = language, only_unknown = TRUE)
translate_AMR(mo_validate(x = x, property = "phylum", language = language, ...), language = language, only_unknown = TRUE)
}
#' @rdname mo_property
#' @export
mo_kingdom <- function(x, language = get_locale(), ...) {
translate_AMR(mo_validate(x = x, property = "kingdom", ...), language = language, only_unknown = TRUE)
translate_AMR(mo_validate(x = x, property = "kingdom", language = language, ...), language = language, only_unknown = TRUE)
}
#' @rdname mo_property
@ -233,13 +233,13 @@ mo_domain <- mo_kingdom
#' @rdname mo_property
#' @export
mo_type <- function(x, language = get_locale(), ...) {
translate_AMR(mo_validate(x = x, property = "kingdom", ...), language = language, only_unknown = FALSE)
translate_AMR(mo_validate(x = x, property = "kingdom", language = language, ...), language = language, only_unknown = FALSE)
}
#' @rdname mo_property
#' @export
mo_gramstain <- function(x, language = get_locale(), ...) {
x.mo <- as.mo(x, ...)
x.mo <- as.mo(x, language = language, ...)
metadata <- get_mo_failures_uncertainties_renamed()
x.phylum <- mo_phylum(x.mo)
@ -269,20 +269,20 @@ mo_gramstain <- function(x, language = get_locale(), ...) {
#' @rdname mo_property
#' @export
mo_snomed <- function(x, ...) {
mo_validate(x = x, property = "snomed", ...)
mo_snomed <- function(x, language = get_locale(), ...) {
mo_validate(x = x, property = "snomed", language = language, ...)
}
#' @rdname mo_property
#' @export
mo_ref <- function(x, ...) {
mo_validate(x = x, property = "ref", ...)
mo_ref <- function(x, language = get_locale(), ...) {
mo_validate(x = x, property = "ref", language = language, ...)
}
#' @rdname mo_property
#' @export
mo_authors <- function(x, ...) {
x <- mo_validate(x = x, property = "ref", ...)
mo_authors <- function(x, language = get_locale(), ...) {
x <- mo_validate(x = x, property = "ref", language = language, ...)
# remove last 4 digits and presumably the comma and space that preceed them
x[!is.na(x)] <- gsub(",? ?[0-9]{4}", "", x[!is.na(x)])
suppressWarnings(x)
@ -290,8 +290,8 @@ mo_authors <- function(x, ...) {
#' @rdname mo_property
#' @export
mo_year <- function(x, ...) {
x <- mo_validate(x = x, property = "ref", ...)
mo_year <- function(x, language = get_locale(), ...) {
x <- mo_validate(x = x, property = "ref", language = language, ...)
# get last 4 digits
x[!is.na(x)] <- gsub(".*([0-9]{4})$", "\\1", x[!is.na(x)])
suppressWarnings(as.integer(x))
@ -299,14 +299,14 @@ mo_year <- function(x, ...) {
#' @rdname mo_property
#' @export
mo_rank <- function(x, ...) {
mo_validate(x = x, property = "rank", ...)
mo_rank <- function(x, language = get_locale(), ...) {
mo_validate(x = x, property = "rank", language = language, ...)
}
#' @rdname mo_property
#' @export
mo_taxonomy <- function(x, language = get_locale(), ...) {
x <- as.mo(x, ...)
x <- as.mo(x, language = language, ...)
metadata <- get_mo_failures_uncertainties_renamed()
result <- list(kingdom = mo_kingdom(x, language = language),
@ -324,8 +324,8 @@ mo_taxonomy <- function(x, language = get_locale(), ...) {
#' @rdname mo_property
#' @export
mo_synonyms <- function(x, ...) {
x <- as.mo(x, ...)
mo_synonyms <- function(x, language = get_locale(), ...) {
x <- as.mo(x, language = language, ...)
metadata <- get_mo_failures_uncertainties_renamed()
IDs <- mo_name(x = x, language = NULL)
@ -351,7 +351,7 @@ mo_synonyms <- function(x, ...) {
#' @rdname mo_property
#' @export
mo_info <- function(x, language = get_locale(), ...) {
x <- as.mo(x, ...)
x <- as.mo(x, language = language, ...)
metadata <- get_mo_failures_uncertainties_renamed()
info <- lapply(x, function(y)
@ -373,8 +373,8 @@ mo_info <- function(x, language = get_locale(), ...) {
#' @rdname mo_property
#' @export
mo_url <- function(x, open = FALSE, ...) {
mo <- as.mo(x = x, ... = ...)
mo_url <- function(x, open = FALSE, language = get_locale(), ...) {
mo <- as.mo(x = x, language = language, ... = ...)
mo_names <- mo_name(mo)
metadata <- get_mo_failures_uncertainties_renamed()
@ -407,10 +407,10 @@ mo_property <- function(x, property = "fullname", language = get_locale(), ...)
stop_ifnot(property %in% colnames(microorganisms),
"invalid property: '", property, "' - use a column name of the `microorganisms` data set")
translate_AMR(mo_validate(x = x, property = property, ...), language = language, only_unknown = TRUE)
translate_AMR(mo_validate(x = x, property = property, language = language, ...), language = language, only_unknown = TRUE)
}
mo_validate <- function(x, property, ...) {
mo_validate <- function(x, property, language, ...) {
check_dataset_integrity()
@ -439,11 +439,11 @@ mo_validate <- function(x, property, ...) {
& !Lancefield %in% c(TRUE, "all")) {
# this will not reset mo_uncertainties and mo_failures
# because it's already a valid MO
x <- exec_as.mo(x, property = property, initial_search = FALSE, ...)
x <- exec_as.mo(x, property = property, initial_search = FALSE, language = language, ...)
} else if (!all(x %in% MO_lookup[, property, drop = TRUE])
| Becker %in% c(TRUE, "all")
| Lancefield %in% c(TRUE, "all")) {
x <- exec_as.mo(x, property = property, ...)
x <- exec_as.mo(x, property = property, language = language, ...)
}
if (property == "mo") {

BIN
R/sysdata.rda
View File

Binary file not shown.

29
R/translate.R
View File

@ -23,13 +23,19 @@
#'
#' For language-dependent output of AMR functions, like [mo_name()], [mo_gramstain()], [mo_type()] and [ab_name()].
#' @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/master/data-raw/translations.tsv>. This file will be read by all functions where a translated output can be desired, like all [mo_property()] functions ([mo_name()], [mo_gramstain()], [mo_type()], etc.).
#' @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/master/data-raw/translations.tsv>. This file will be read by all functions where a translated output can be desired, like all [mo_property()] functions ([mo_name()], [mo_gramstain()], [mo_type()], etc.) and [ab_property()] functions ([ab_name()], [ab_group()] etc.).
#'
#' Currently supported languages are: `r paste(sort(gsub(";.*", "", ISOcodes::ISO_639_2[which(ISOcodes::ISO_639_2$Alpha_2 %in% LANGUAGES_SUPPORTED), "Name"])), collapse = ", ")`. Please note that currently not 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).
#'
#' The system language will be used at default (as returned by [Sys.getlocale()]), if that language is supported. The language to be used can be overwritten by setting the option `AMR_locale`, e.g. `options(AMR_locale = "de")`.
#' ## Changing the default language
#' The system language will be used at default (as returned by [Sys.getenv("LANG")] or, if `LANG` is not set, [Sys.getlocale()]), if that language is supported. But the language to be used can be overwritten in two ways and will be checked in this order:
#'
#' 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.
#' @inheritSection AMR Read more on our website!
#' @rdname translate
#' @name translate
@ -73,17 +79,24 @@ get_locale <- function() {
if (lang %in% LANGUAGES_SUPPORTED) {
return(lang)
} else {
stop_("unsupported language: '", lang, "' - use one of: ",
stop_("unsupported language set as option 'AMR_locale': '", lang, "' - use one of: ",
paste0("'", LANGUAGES_SUPPORTED, "'", collapse = ", "))
}
} else {
# we now support the LANGUAGE system variable - return it if set
if (!identical("", Sys.getenv("LANGUAGE"))) {
return(coerce_language_setting(Sys.getenv("LANGUAGE")))
}
if (!identical("", Sys.getenv("LANG"))) {
return(coerce_language_setting(Sys.getenv("LANG")))
}
}
lang <- Sys.getlocale()
# Check the locale settings for a start with one of these languages:
coerce_language_setting(Sys.getlocale())
}
coerce_language_setting <- function(lang) {
# grepl() with ignore.case = FALSE is faster than %like%
if (grepl("^(English|en_|EN_)", lang, ignore.case = FALSE)) {
# as first option to optimise speed
"en"

1
data-raw/ab.md5 Normal file
View File

@ -0,0 +1 @@
37a7be09e34b5ec657a4bad94f45f355

1
data-raw/av.md5 Normal file
View File

@ -0,0 +1 @@
7b6649442069d3d121f61ca3ff01843a

123
data-raw/internals.R
View File

@ -25,19 +25,19 @@
# See 'data-raw/eucast_rules.tsv' for the EUCAST reference file
eucast_rules_file <- utils::read.delim(file = "data-raw/eucast_rules.tsv",
skip = 10,
sep = "\t",
stringsAsFactors = FALSE,
header = TRUE,
strip.white = TRUE,
na = c(NA, "", NULL))
skip = 10,
sep = "\t",
stringsAsFactors = FALSE,
header = TRUE,
strip.white = TRUE,
na = c(NA, "", NULL))
# take the order of the reference.rule_group column in the original data file
eucast_rules_file$reference.rule_group <- factor(eucast_rules_file$reference.rule_group,
levels = unique(eucast_rules_file$reference.rule_group),
ordered = TRUE)
eucast_rules_file <- dplyr::arrange(eucast_rules_file,
reference.rule_group,
reference.rule)
reference.rule_group,
reference.rule)
eucast_rules_file$reference.rule_group <- as.character(eucast_rules_file$reference.rule_group)
# Translations ----
@ -62,7 +62,8 @@ microorganisms.translation <- readRDS("data-raw/microorganisms.translation.rds")
usethis::use_data(eucast_rules_file, translations_file, microorganisms.translation,
internal = TRUE,
overwrite = TRUE,
version = 2)
version = 2,
compress = "xz")
# Remove from global environment ----
rm(eucast_rules_file)
@ -70,51 +71,83 @@ rm(translations_file)
rm(microorganisms.translation)
# Save to raw data to repository ----
write_md5 <- function(object) {
writeLines(digest::digest(object, "md5"), file(paste0("data-raw/", deparse(substitute(object)), ".md5")))
}
changed_md5 <- function(object) {
tryCatch({
conn <- file(paste0("data-raw/", deparse(substitute(object)), ".md5"))
compared <- digest::digest(object, "md5") != readLines(con = conn)
close(conn)
compared
}, error = function(e) TRUE)
}
usethis::ui_done(paste0("Saving raw data to {usethis::ui_value('/data-raw/')}"))
devtools::load_all(quiet = TRUE)
# give official names to ABs and MOs
rsi <- dplyr::mutate(rsi_translation, ab = ab_name(ab), mo = mo_name(mo))
try(saveRDS(rsi, "data-raw/rsi_translation.rds", version = 2), silent = TRUE)
try(write.table(rsi, "data-raw/rsi_translation.txt", sep = "\t", na = "", row.names = FALSE), silent = TRUE)
try(haven::write_sas(rsi, "data-raw/rsi_translation.sas"), silent = TRUE)
try(haven::write_sav(rsi, "data-raw/rsi_translation.sav"), silent = TRUE)
try(haven::write_dta(rsi, "data-raw/rsi_translation.dta"), silent = TRUE)
try(openxlsx::write.xlsx(rsi, "data-raw/rsi_translation.xlsx"), silent = TRUE)
if (changed_md5(rsi)) {
write_md5(rsi)
try(saveRDS(rsi, "data-raw/rsi_translation.rds", version = 2, compress = "xz"), silent = TRUE)
try(write.table(rsi, "data-raw/rsi_translation.txt", sep = "\t", na = "", row.names = FALSE), silent = TRUE)
try(haven::write_sas(rsi, "data-raw/rsi_translation.sas"), silent = TRUE)
try(haven::write_sav(rsi, "data-raw/rsi_translation.sav"), silent = TRUE)
try(haven::write_dta(rsi, "data-raw/rsi_translation.dta"), silent = TRUE)
try(openxlsx::write.xlsx(rsi, "data-raw/rsi_translation.xlsx"), silent = TRUE)
}
mo <- dplyr::mutate_if(microorganisms, ~!is.numeric(.), as.character)
try(saveRDS(mo, "data-raw/microorganisms.rds", version = 2), silent = TRUE)
try(write.table(mo, "data-raw/microorganisms.txt", sep = "\t", na = "", row.names = FALSE), silent = TRUE)
try(haven::write_sas(mo, "data-raw/microorganisms.sas"), silent = TRUE)
try(haven::write_sav(mo, "data-raw/microorganisms.sav"), silent = TRUE)
try(haven::write_dta(mo, "data-raw/microorganisms.dta"), silent = TRUE)
try(openxlsx::write.xlsx(mo, "data-raw/microorganisms.xlsx"), silent = TRUE)
if (changed_md5(mo)) {
write_md5(mo)
try(saveRDS(mo, "data-raw/microorganisms.rds", version = 2, compress = "xz"), silent = TRUE)
try(write.table(mo, "data-raw/microorganisms.txt", sep = "\t", na = "", row.names = FALSE), silent = TRUE)
try(haven::write_sas(mo, "data-raw/microorganisms.sas"), silent = TRUE)
try(haven::write_sav(mo, "data-raw/microorganisms.sav"), silent = TRUE)
try(haven::write_dta(mo, "data-raw/microorganisms.dta"), silent = TRUE)
try(openxlsx::write.xlsx(mo, "data-raw/microorganisms.xlsx"), silent = TRUE)
}
try(saveRDS(microorganisms.old, "data-raw/microorganisms.old.rds", version = 2), silent = TRUE)
try(write.table(microorganisms.old, "data-raw/microorganisms.old.txt", sep = "\t", na = "", row.names = FALSE), silent = TRUE)
try(haven::write_sas(microorganisms.old, "data-raw/microorganisms.old.sas"), silent = TRUE)
try(haven::write_sav(microorganisms.old, "data-raw/microorganisms.old.sav"), silent = TRUE)
try(haven::write_dta(microorganisms.old, "data-raw/microorganisms.old.dta"), silent = TRUE)
try(openxlsx::write.xlsx(microorganisms.old, "data-raw/microorganisms.old.xlsx"), silent = TRUE)
if (changed_md5(microorganisms.old)) {
write_md5(microorganisms.old)
try(saveRDS(microorganisms.old, "data-raw/microorganisms.old.rds", version = 2, compress = "xz"), silent = TRUE)
try(write.table(microorganisms.old, "data-raw/microorganisms.old.txt", sep = "\t", na = "", row.names = FALSE), silent = TRUE)
try(haven::write_sas(microorganisms.old, "data-raw/microorganisms.old.sas"), silent = TRUE)
try(haven::write_sav(microorganisms.old, "data-raw/microorganisms.old.sav"), silent = TRUE)
try(haven::write_dta(microorganisms.old, "data-raw/microorganisms.old.dta"), silent = TRUE)
try(openxlsx::write.xlsx(microorganisms.old, "data-raw/microorganisms.old.xlsx"), silent = TRUE)
}
ab <- dplyr::mutate_if(antibiotics, ~!is.numeric(.), as.character)
try(saveRDS(ab, "data-raw/antibiotics.rds", version = 2), silent = TRUE)
try(write.table(ab, "data-raw/antibiotics.txt", sep = "\t", na = "", row.names = FALSE), silent = TRUE)
try(haven::write_sas(ab, "data-raw/antibiotics.sas"), silent = TRUE)
try(haven::write_sav(ab, "data-raw/antibiotics.sav"), silent = TRUE)
try(haven::write_dta(ab, "data-raw/antibiotics.dta"), silent = TRUE)
try(openxlsx::write.xlsx(ab, "data-raw/antibiotics.xlsx"), silent = TRUE)
if (changed_md5(ab)) {
write_md5(ab)
try(saveRDS(ab, "data-raw/antibiotics.rds", version = 2, compress = "xz"), silent = TRUE)
try(write.table(ab, "data-raw/antibiotics.txt", sep = "\t", na = "", row.names = FALSE), silent = TRUE)
try(haven::write_sas(ab, "data-raw/antibiotics.sas"), silent = TRUE)
try(haven::write_sav(ab, "data-raw/antibiotics.sav"), silent = TRUE)
try(haven::write_dta(ab, "data-raw/antibiotics.dta"), silent = TRUE)
try(openxlsx::write.xlsx(ab, "data-raw/antibiotics.xlsx"), silent = TRUE)
}
av <- dplyr::mutate_if(antivirals, ~!is.numeric(.), as.character)
try(saveRDS(av, "data-raw/antivirals.rds", version = 2), silent = TRUE)
try(write.table(av, "data-raw/antivirals.txt", sep = "\t", na = "", row.names = FALSE), silent = TRUE)
try(haven::write_sas(av, "data-raw/antivirals.sas"), silent = TRUE)
try(haven::write_sav(av, "data-raw/antivirals.sav"), silent = TRUE)
try(haven::write_dta(av, "data-raw/antivirals.dta"), silent = TRUE)
try(openxlsx::write.xlsx(av, "data-raw/antivirals.xlsx"), silent = TRUE)
if (changed_md5(av)) {
write_md5(av)
try(saveRDS(av, "data-raw/antivirals.rds", version = 2, compress = "xz"), silent = TRUE)
try(write.table(av, "data-raw/antivirals.txt", sep = "\t", na = "", row.names = FALSE), silent = TRUE)
try(haven::write_sas(av, "data-raw/antivirals.sas"), silent = TRUE)
try(haven::write_sav(av, "data-raw/antivirals.sav"), silent = TRUE)
try(haven::write_dta(av, "data-raw/antivirals.dta"), silent = TRUE)
try(openxlsx::write.xlsx(av, "data-raw/antivirals.xlsx"), silent = TRUE)
}
try(saveRDS(intrinsic_resistant, "data-raw/intrinsic_resistant.rds", version = 2), silent = TRUE)
try(write.table(intrinsic_resistant, "data-raw/intrinsic_resistant.txt", sep = "\t", na = "", row.names = FALSE), silent = TRUE)
try(haven::write_sas(intrinsic_resistant, "data-raw/intrinsic_resistant.sas"), silent = TRUE)
try(haven::write_sav(intrinsic_resistant, "data-raw/intrinsic_resistant.sav"), silent = TRUE)
try(haven::write_dta(intrinsic_resistant, "data-raw/intrinsic_resistant.dta"), silent = TRUE)
try(openxlsx::write.xlsx(intrinsic_resistant, "data-raw/intrinsic_resistant.xlsx"), silent = TRUE)
if (changed_md5(intrinsic_resistant)) {
write_md5(intrinsic_resistant)
try(saveRDS(intrinsic_resistant, "data-raw/intrinsic_resistant.rds", version = 2, compress = "xz"), silent = TRUE)
try(write.table(intrinsic_resistant, "data-raw/intrinsic_resistant.txt", sep = "\t", na = "", row.names = FALSE), silent = TRUE)
try(haven::write_sas(intrinsic_resistant, "data-raw/intrinsic_resistant.sas"), silent = TRUE)
try(haven::write_sav(intrinsic_resistant, "data-raw/intrinsic_resistant.sav"), silent = TRUE)
try(haven::write_dta(intrinsic_resistant, "data-raw/intrinsic_resistant.dta"), silent = TRUE)
try(openxlsx::write.xlsx(intrinsic_resistant, "data-raw/intrinsic_resistant.xlsx"), silent = TRUE)
}
rm(write_md5)
rm(changed_md5)

1
data-raw/intrinsic_resistant.md5 Normal file
View File

@ -0,0 +1 @@
6915f562bd64e546e1d57741a2a5ad27

1
data-raw/microorganisms.old.md5 Normal file
View File

@ -0,0 +1 @@
617b59b8ac3bd1aad7847aafc328f0f3

1
data-raw/mo.md5 Normal file
View File

@ -0,0 +1 @@
a5b85c5b3d37d6330865dfe09ef9b354

1
data-raw/rsi.md5 Normal file
View File

@ -0,0 +1 @@
0ac715df4f94c8704ae1d9bf56913312

11
data-raw/translations.tsv
View File

@ -27,6 +27,7 @@ de vegetative vegetativ FALSE FALSE
de ([([ ]*?)group \\1Gruppe FALSE FALSE
de ([([ ]*?)Group \\1Gruppe FALSE FALSE
de no .*growth keine? .*wachstum FALSE TRUE
de no|not keine? FALSE TRUE
nl Coagulase-negative Staphylococcus Coagulase-negatieve Staphylococcus FALSE FALSE
nl Coagulase-positive Staphylococcus Coagulase-positieve Staphylococcus FALSE FALSE
@ -58,6 +59,8 @@ nl antibiotic antibioticum FALSE FALSE
nl Antibiotic Antibioticum FALSE FALSE
nl Drug Middel FALSE FALSE
nl drug middel FALSE FALSE
nl no .*growth geen .*groei FALSE TRUE
nl no|not geen|niet FALSE TRUE
es Coagulase-negative Staphylococcus Staphylococcus coagulasa negativo FALSE FALSE
es Coagulase-positive Staphylococcus Staphylococcus coagulasa positivo FALSE FALSE
@ -86,6 +89,8 @@ es biotype biotipo FALSE FALSE
es vegetative vegetativo FALSE FALSE
es ([([ ]*?)group \\1grupo FALSE FALSE
es ([([ ]*?)Group \\1Grupo FALSE FALSE
es no .*growth no .*crecimientonon FALSE TRUE
es no|not no|sin FALSE TRUE
it Coagulase-negative Staphylococcus Staphylococcus negativo coagulasi FALSE FALSE
it Coagulase-positive Staphylococcus Staphylococcus positivo coagulasi FALSE FALSE
@ -112,6 +117,8 @@ it biotype biotipo FALSE FALSE
it vegetative vegetativo FALSE FALSE
it ([([ ]*?)group \\1gruppo FALSE FALSE
it ([([ ]*?)Group \\1Gruppo FALSE FALSE
it no .*growth sem .*crescimento FALSE TRUE
it no|not sem FALSE TRUE
fr Coagulase-negative Staphylococcus Staphylococcus à coagulase négative FALSE FALSE
fr Coagulase-positive Staphylococcus Staphylococcus à coagulase positif FALSE FALSE
@ -137,6 +144,8 @@ fr biogroup biogroupe FALSE FALSE
fr vegetative végétatif FALSE FALSE
fr ([([ ]*?)group \\1groupe FALSE FALSE
fr ([([ ]*?)Group \\1Groupe FALSE FALSE
fr no .*growth pas .*croissance FALSE TRUE
fr no|not non FALSE TRUE
pt Coagulase-negative Staphylococcus Staphylococcus coagulase negativo FALSE FALSE
pt Coagulase-positive Staphylococcus Staphylococcus coagulase positivo FALSE FALSE
@ -163,6 +172,8 @@ pt biotype biótipo FALSE FALSE
pt vegetative vegetativo FALSE FALSE
pt ([([ ]*?)group \\1grupo FALSE FALSE
pt ([([ ]*?)Group \\1Grupo FALSE FALSE
pt no .*growth sem .*crescimento FALSE TRUE
pt no|not sem FALSE TRUE
de clavulanic acid Clavulansäure FALSE TRUE

Can't render this file because it has a wrong number of fields in line 60.

2
docs/404.html
View File

@ -81,7 +81,7 @@
</button>
<span class="navbar-brand">
<a class="navbar-link" href="https://msberends.github.io/AMR/index.html">AMR (for R)</a>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.3.0.9017</span>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.3.0.9018</span>
</span>
</div>

2
docs/LICENSE-text.html
View File

@ -81,7 +81,7 @@
</button>
<span class="navbar-brand">
<a class="navbar-link" href="index.html">AMR (for R)</a>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.3.0.9017</span>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.3.0.9018</span>
</span>
</div>

2
docs/articles/index.html
View File

@ -81,7 +81,7 @@
</button>
<span class="navbar-brand">
<a class="navbar-link" href="../index.html">AMR (for R)</a>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.3.0.9017</span>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.3.0.9018</span>
</span>
</div>

2
docs/authors.html
View File

@ -81,7 +81,7 @@
</button>
<span class="navbar-brand">
<a class="navbar-link" href="index.html">AMR (for R)</a>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.3.0.9017</span>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.3.0.9018</span>
</span>
</div>

2
docs/index.html
View File

@ -43,7 +43,7 @@
</button>
<span class="navbar-brand">
<a class="navbar-link" href="index.html">AMR (for R)</a>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.3.0.9017</span>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.3.0.9018</span>
</span>
</div>

16
docs/news/index.html
View File

@ -81,7 +81,7 @@
</button>
<span class="navbar-brand">
<a class="navbar-link" href="../index.html">AMR (for R)</a>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.3.0.9017</span>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.3.0.9018</span>
</span>
</div>
@ -236,13 +236,13 @@
<small>Source: <a href='https://github.com/msberends/AMR/blob/master/NEWS.md'><code>NEWS.md</code></a></small>
</div>
<div id="amr-1309017" class="section level1">
<h1 class="page-header" data-toc-text="1.3.0.9017">
<a href="#amr-1309017" class="anchor"></a>AMR 1.3.0.9017<small> Unreleased </small>
<div id="amr-1309018" class="section level1">
<h1 class="page-header" data-toc-text="1.3.0.9018">
<a href="#amr-1309018" class="anchor"></a>AMR 1.3.0.9018<small> Unreleased </small>
</h1>
<div id="last-updated-12-september-2020" class="section level2">
<div id="last-updated-14-september-2020" class="section level2">
<h2 class="hasAnchor">
<a href="#last-updated-12-september-2020" class="anchor"></a><small>Last updated: 12 September 2020</small>
<a href="#last-updated-14-september-2020" class="anchor"></a><small>Last updated: 14 September 2020</small>
</h2>
<p>Note: some changes in this version were suggested by anonymous reviewers from the journal we submitted our manuscipt to. We are those reviewers very grateful for going through our code so thoroughly!</p>
<div id="new" class="section level3">
@ -299,12 +299,12 @@
<li>
<p>Improvements for <code><a href="../reference/as.mo.html">as.mo()</a></code>:</p>
<ul>
<li>Any user input value that could mean more than one taxonomic entry is now considered ‘uncertain’. Instead of a warning, a message will be thrown and the accompanying <code><a href="../reference/as.mo.html">mo_uncertainties()</a></code> has been changed completely; it now prints all possible candidates with their score.</li>
<li>Any user input value that could mean more than one taxonomic entry is now considered ‘uncertain’. Instead of a warning, a message will be thrown and the accompanying <code><a href="../reference/as.mo.html">mo_uncertainties()</a></code> has been changed completely; it now prints all possible candidates with their matching score.</li>
<li>Big speed improvement for already valid microorganism ID. This also means an significant speed improvement for using <code>mo_*</code> functions like <code><a href="../reference/mo_property.html">mo_name()</a></code> on microoganism IDs.</li>
<li>Added parameter <code>ignore_pattern</code> to <code><a href="../reference/as.mo.html">as.mo()</a></code> which can also be given to <code>mo_*</code> functions like <code><a href="../reference/mo_property.html">mo_name()</a></code>, to exclude known non-relevant input from analysing. This can also be set with the option <code>AMR_ignore_pattern</code>.</li>
</ul>
</li>
<li><p><code><a href="../reference/translate.html">get_locale()</a></code> now uses <code><a href="https://rdrr.io/r/base/locales.html">Sys.getlocale()</a></code> instead of <code><a href="https://rdrr.io/r/base/locales.html">Sys.getlocale("LC_COLLATE")</a></code></p></li>
<li><p><code><a href="../reference/translate.html">get_locale()</a></code> now uses at default <code><a href="https://rdrr.io/r/base/Sys.getenv.html">Sys.getenv("LANG")</a></code> or, if <code>LANG</code> is not set, <code><a href="https://rdrr.io/r/base/locales.html">Sys.getlocale()</a></code>. This can be overwritten by setting the option <code>AMR_locale</code>.</p></li>
<li><p>Speed improvement for <code><a href="../reference/eucast_rules.html">eucast_rules()</a></code></p></li>
<li><p>Overall speed improvement by tweaking joining functions</p></li>
<li><p>Function <code><a href="../reference/mo_property.html">mo_shortname()</a></code> now returns the genus for input where the species is unknown</p></li>

2
docs/pkgdown.yml
View File

@ -2,7 +2,7 @@ pandoc: 2.7.3
pkgdown: 1.5.1.9000
pkgdown_sha: eae56f08694abebf93cdfc0dd8e9ede06d8c815f
articles: []
last_built: 2020-09-12T11:54Z
last_built: 2020-09-14T10:20Z
urls:
reference: https://msberends.github.io/AMR/reference
article: https://msberends.github.io/AMR/articles

9
docs/reference/as.mo.html
View File

@ -82,7 +82,7 @@
</button>
<span class="navbar-brand">
<a class="navbar-link" href="../index.html">AMR (for R)</a>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.3.0.9016</span>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.3.0.9018</span>
</span>
</div>
@ -249,6 +249,7 @@
allow_uncertain = <span class='fl'>TRUE</span>,
reference_df = <span class='fu'><a href='mo_source.html'>get_mo_source</a></span>(),
ignore_pattern = <span class='fu'><a href='https://rdrr.io/r/base/options.html'>getOption</a></span>(<span class='st'>"AMR_ignore_pattern"</span>),
language = <span class='fu'><a href='translate.html'>get_locale</a></span>(),
<span class='kw'>...</span>
)
@ -289,6 +290,10 @@
<th>ignore_pattern</th>
<td><p>a regular expression (case-insensitive) of which all matches in <code>x</code> must return <code>NA</code>. This can be convenient to exclude known non-relevant input and can also be set with the option <code>AMR_ignore_pattern</code>, e.g. <code><a href='https://rdrr.io/r/base/options.html'>options(AMR_ignore_pattern = "(not reported|contaminated flora)")</a></code>.</p></td>
</tr>
<tr>
<th>language</th>
<td><p>language to translate text like "no growth", which defaults to the system language (see <code><a href='translate.html'>get_locale()</a></code>)</p></td>
</tr>
<tr>
<th>...</th>
<td><p>other parameters passed on to functions</p></td>
@ -347,7 +352,7 @@
</ul>
<p>There are three helper functions that can be run after using the <code>as.mo()</code> function:</p><ul>
<li><p>Use <code>mo_uncertainties()</code> to get a <code><a href='https://rdrr.io/r/base/data.frame.html'>data.frame</a></code> that prints in a pretty format with all taxonomic names that were guessed. The output contains a score that is based on the human pathogenic prevalence and the <a href='https://en.wikipedia.org/wiki/Levenshtein_distance'>Levenshtein distance</a> between the full taxonomic name and the user input.</p></li>
<li><p>Use <code>mo_uncertainties()</code> to get a <code><a href='https://rdrr.io/r/base/data.frame.html'>data.frame</a></code> that prints in a pretty format with all taxonomic names that were guessed. The output contains a score that is based on the human pathogenic prevalence and the <a href='https://en.wikipedia.org/wiki/Levenshtein_distance'>Levenshtein distance</a> between the user input and the full taxonomic name.</p></li>
<li><p>Use <code>mo_failures()</code> to get a <code><a href='https://rdrr.io/r/base/character.html'>character</a></code> <code><a href='https://rdrr.io/r/base/vector.html'>vector</a></code> with all values that could not be coerced to a valid value.</p></li>
<li><p>Use <code>mo_renamed()</code> to get a <code><a href='https://rdrr.io/r/base/data.frame.html'>data.frame</a></code> with all values that could be coerced based on old, previously accepted taxonomic names.</p></li>
</ul>

2
docs/reference/index.html
View File

@ -81,7 +81,7 @@
</button>
<span class="navbar-brand">
<a class="navbar-link" href="../index.html">AMR (for R)</a>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.3.0.9017</span>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.3.0.9018</span>
</span>
</div>

16
docs/reference/mo_property.html
View File

@ -82,7 +82,7 @@
</button>
<span class="navbar-brand">
<a class="navbar-link" href="../index.html">AMR (for R)</a>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.3.0.9016</span>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.3.0.9018</span>
</span>
</div>
@ -270,23 +270,23 @@
<span class='fu'>mo_gramstain</span>(<span class='kw'>x</span>, language = <span class='fu'><a href='translate.html'>get_locale</a></span>(), <span class='kw'>...</span>)
<span class='fu'>mo_snomed</span>(<span class='kw'>x</span>, <span class='kw'>...</span>)
<span class='fu'>mo_snomed</span>(<span class='kw'>x</span>, language = <span class='fu'><a href='translate.html'>get_locale</a></span>(), <span class='kw'>...</span>)
<span class='fu'>mo_ref</span>(<span class='kw'>x</span>, <span class='kw'>...</span>)
<span class='fu'>mo_ref</span>(<span class='kw'>x</span>, language = <span class='fu'><a href='translate.html'>get_locale</a></span>(), <span class='kw'>...</span>)
<span class='fu'>mo_authors</span>(<span class='kw'>x</span>, <span class='kw'>...</span>)
<span class='fu'>mo_authors</span>(<span class='kw'>x</span>, language = <span class='fu'><a href='translate.html'>get_locale</a></span>(), <span class='kw'>...</span>)
<span class='fu'>mo_year</span>(<span class='kw'>x</span>, <span class='kw'>...</span>)
<span class='fu'>mo_year</span>(<span class='kw'>x</span>, language = <span class='fu'><a href='translate.html'>get_locale</a></span>(), <span class='kw'>...</span>)
<span class='fu'>mo_rank</span>(<span class='kw'>x</span>, <span class='kw'>...</span>)
<span class='fu'>mo_rank</span>(<span class='kw'>x</span>, language = <span class='fu'><a href='translate.html'>get_locale</a></span>(), <span class='kw'>...</span>)
<span class='fu'>mo_taxonomy</span>(<span class='kw'>x</span>, language = <span class='fu'><a href='translate.html'>get_locale</a></span>(), <span class='kw'>...</span>)
<span class='fu'>mo_synonyms</span>(<span class='kw'>x</span>, <span class='kw'>...</span>)
<span class='fu'>mo_synonyms</span>(<span class='kw'>x</span>, language = <span class='fu'><a href='translate.html'>get_locale</a></span>(), <span class='kw'>...</span>)
<span class='fu'>mo_info</span>(<span class='kw'>x</span>, language = <span class='fu'><a href='translate.html'>get_locale</a></span>(), <span class='kw'>...</span>)
<span class='fu'>mo_url</span>(<span class='kw'>x</span>, open = <span class='fl'>FALSE</span>, <span class='kw'>...</span>)
<span class='fu'>mo_url</span>(<span class='kw'>x</span>, open = <span class='fl'>FALSE</span>, language = <span class='fu'><a href='translate.html'>get_locale</a></span>(), <span class='kw'>...</span>)
<span class='fu'>mo_property</span>(<span class='kw'>x</span>, property = <span class='st'>"fullname"</span>, language = <span class='fu'><a href='translate.html'>get_locale</a></span>(), <span class='kw'>...</span>)</pre>

16
docs/reference/translate.html
View File

@ -82,7 +82,7 @@
</button>
<span class="navbar-brand">
<a class="navbar-link" href="../index.html">AMR (for R)</a>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.3.0.9016</span>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.3.0.9018</span>
</span>
</div>
@ -247,10 +247,18 @@
<h2 class="hasAnchor" id="details"><a class="anchor" href="#details"></a>Details</h2>
<p>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: <a href='https://github.com/msberends/AMR/blob/master/data-raw/translations.tsv'>https://github.com/msberends/AMR/blob/master/data-raw/translations.tsv</a>. This file will be read by all functions where a translated output can be desired, like all <code><a href='mo_property.html'>mo_property()</a></code> functions (<code><a href='mo_property.html'>mo_name()</a></code>, <code><a href='mo_property.html'>mo_gramstain()</a></code>, <code><a href='mo_property.html'>mo_type()</a></code>, etc.).</p>
<p>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: <a href='https://github.com/msberends/AMR/blob/master/data-raw/translations.tsv'>https://github.com/msberends/AMR/blob/master/data-raw/translations.tsv</a>. This file will be read by all functions where a translated output can be desired, like all <code><a href='mo_property.html'>mo_property()</a></code> functions (<code><a href='mo_property.html'>mo_name()</a></code>, <code><a href='mo_property.html'>mo_gramstain()</a></code>, <code><a href='mo_property.html'>mo_type()</a></code>, etc.) and <code><a href='ab_property.html'>ab_property()</a></code> functions (<code><a href='ab_property.html'>ab_name()</a></code>, <code><a href='ab_property.html'>ab_group()</a></code> etc.).</p>
<p>Currently supported languages are: Dutch, English, French, German, Italian, Portuguese, Spanish. Please note that currently not all these languages have translations available for all antimicrobial agents and colloquial microorganism names.</p>
<p>Please suggest your own translations <a href='https://github.com/msberends/AMR/issues/new?title=Translations'>by creating a new issue on our repository</a>.</p>
<p>The system language will be used at default (as returned by <code><a href='https://rdrr.io/r/base/locales.html'>Sys.getlocale()</a></code>), if that language is supported. The language to be used can be overwritten by setting the option <code>AMR_locale</code>, e.g. <code><a href='https://rdrr.io/r/base/options.html'>options(AMR_locale = "de")</a></code>.</p>
<p>Please suggest your own translations <a href='https://github.com/msberends/AMR/issues/new?title=Translations'>by creating a new issue on our repository</a>.</p><h3>Changing the default language</h3>
<p>The system language will be used at default (as returned by Sys.getenv("LANG") or, if <code>LANG</code> is not set, <code><a href='https://rdrr.io/r/base/locales.html'>Sys.getlocale()</a></code>), if that language is supported. But the language to be used can be overwritten in two ways and will be checked in this order:</p><ol>
<li><p>Setting the R option <code>AMR_locale</code>, e.g. by running <code><a href='https://rdrr.io/r/base/options.html'>options(AMR_locale = "de")</a></code></p></li>
<li><p>Setting the system variable <code>LANGUAGE</code> or <code>LANG</code>, e.g. by adding <code>LANGUAGE="de_DE.utf8"</code> to your <code>.Renviron</code> file in your home directory</p></li>
</ol>
<p>So if the R option <code>AMR_locale</code> is set, the system variables <code>LANGUAGE</code> and <code>LANG</code> will be ignored.</p>
<h2 class="hasAnchor" id="stable-lifecycle"><a class="anchor" href="#stable-lifecycle"></a>Stable lifecycle</h2>

2
docs/survey.html
View File

@ -81,7 +81,7 @@
</button>
<span class="navbar-brand">
<a class="navbar-link" href="index.html">AMR (for R)</a>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.3.0.9017</span>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.3.0.9018</span>
</span>
</div>

5
man/as.mo.Rd
View File

@ -16,6 +16,7 @@ as.mo(
allow_uncertain = TRUE,
reference_df = get_mo_source(),
ignore_pattern = getOption("AMR_ignore_pattern"),
language = get_locale(),
...
)
@ -44,6 +45,8 @@ This excludes \emph{Enterococci} at default (who are in group D), use \code{Lanc
\item{ignore_pattern}{a regular expression (case-insensitive) of which all matches in \code{x} must return \code{NA}. This can be convenient to exclude known non-relevant input and can also be set with the option \code{AMR_ignore_pattern}, e.g. \code{options(AMR_ignore_pattern = "(not reported|contaminated flora)")}.}
\item{language}{language to translate text like "no growth", which defaults to the system language (see \code{\link[=get_locale]{get_locale()}})}
\item{...}{other parameters passed on to functions}
}
\value{
@ -106,7 +109,7 @@ With the default setting (\code{allow_uncertain = TRUE}, level 2), below example
There are three helper functions that can be run after using the \code{\link[=as.mo]{as.mo()}} function:
\itemize{
\item Use \code{\link[=mo_uncertainties]{mo_uncertainties()}} to get a \code{\link{data.frame}} that prints in a pretty format with all taxonomic names that were guessed. The output contains a score that is based on the human pathogenic prevalence and the \href{https://en.wikipedia.org/wiki/Levenshtein_distance}{Levenshtein distance} between the full taxonomic name and the user input.
\item Use \code{\link[=mo_uncertainties]{mo_uncertainties()}} to get a \code{\link{data.frame}} that prints in a pretty format with all taxonomic names that were guessed. The output contains a score that is based on the human pathogenic prevalence and the \href{https://en.wikipedia.org/wiki/Levenshtein_distance}{Levenshtein distance} between the user input and the full taxonomic name.
\item Use \code{\link[=mo_failures]{mo_failures()}} to get a \code{\link{character}} \code{\link{vector}} with all values that could not be coerced to a valid value.
\item Use \code{\link[=mo_renamed]{mo_renamed()}} to get a \code{\link{data.frame}} with all values that could be coerced based on old, previously accepted taxonomic names.
}

14
man/mo_property.Rd
View File

@ -55,23 +55,23 @@ mo_type(x, language = get_locale(), ...)
mo_gramstain(x, language = get_locale(), ...)
mo_snomed(x, ...)
mo_snomed(x, language = get_locale(), ...)
mo_ref(x, ...)
mo_ref(x, language = get_locale(), ...)
mo_authors(x, ...)
mo_authors(x, language = get_locale(), ...)
mo_year(x, ...)
mo_year(x, language = get_locale(), ...)
mo_rank(x, ...)
mo_rank(x, language = get_locale(), ...)
mo_taxonomy(x, language = get_locale(), ...)
mo_synonyms(x, ...)
mo_synonyms(x, language = get_locale(), ...)
mo_info(x, language = get_locale(), ...)
mo_url(x, open = FALSE, ...)
mo_url(x, open = FALSE, language = get_locale(), ...)
mo_property(x, property = "fullname", language = get_locale(), ...)
}

12
man/translate.Rd
View File

@ -11,13 +11,21 @@ get_locale()
For language-dependent output of AMR functions, like \code{\link[=mo_name]{mo_name()}}, \code{\link[=mo_gramstain]{mo_gramstain()}}, \code{\link[=mo_type]{mo_type()}} and \code{\link[=ab_name]{ab_name()}}.
}
\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: \url{https://github.com/msberends/AMR/blob/master/data-raw/translations.tsv}. This file will be read by all functions where a translated output can be desired, like all \code{\link[=mo_property]{mo_property()}} functions (\code{\link[=mo_name]{mo_name()}}, \code{\link[=mo_gramstain]{mo_gramstain()}}, \code{\link[=mo_type]{mo_type()}}, etc.).
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: \url{https://github.com/msberends/AMR/blob/master/data-raw/translations.tsv}. This file will be read by all functions where a translated output can be desired, like all \code{\link[=mo_property]{mo_property()}} functions (\code{\link[=mo_name]{mo_name()}}, \code{\link[=mo_gramstain]{mo_gramstain()}}, \code{\link[=mo_type]{mo_type()}}, etc.) and \code{\link[=ab_property]{ab_property()}} functions (\code{\link[=ab_name]{ab_name()}}, \code{\link[=ab_group]{ab_group()}} etc.).
Currently supported languages are: Dutch, English, French, German, Italian, Portuguese, Spanish. Please note that currently not all these languages have translations available for all antimicrobial agents and colloquial microorganism names.
Please suggest your own translations \href{https://github.com/msberends/AMR/issues/new?title=Translations}{by creating a new issue on our repository}.
\subsection{Changing the default language}{
The system language will be used at default (as returned by \code{\link[=Sys.getlocale]{Sys.getlocale()}}), if that language is supported. The language to be used can be overwritten by setting the option \code{AMR_locale}, e.g. \code{options(AMR_locale = "de")}.
The system language will be used at default (as returned by \link{Sys.getenv("LANG")} or, if \code{LANG} is not set, \code{\link[=Sys.getlocale]{Sys.getlocale()}}), if that language is supported. But the language to be used can be overwritten in two ways and will be checked in this order:
\enumerate{
\item Setting the R option \code{AMR_locale}, e.g. by running \code{options(AMR_locale = "de")}
\item Setting the system variable \code{LANGUAGE} or \code{LANG}, e.g. by adding \code{LANGUAGE="de_DE.utf8"} to your \code{.Renviron} file in your home directory
}
So if the R option \code{AMR_locale} is set, the system variables \code{LANGUAGE} and \code{LANG} will be ignored.
}
}
\section{Stable lifecycle}{