Browse Source

(v1.3.0.9020) fix for uncertainty in as.mo()

new-mo-algorithm
parent
commit
ab60f613aa
  1. 2
      DESCRIPTION
  2. 2
      NEWS.md
  3. 1
      R/eucast_rules.R
  4. 1
      R/first_isolate.R
  5. 1
      R/mdro.R
  6. 133
      R/mo.R
  7. 2
      R/translate.R
  8. 2
      docs/404.html
  9. 2
      docs/LICENSE-text.html
  10. 2
      docs/articles/index.html
  11. 2
      docs/authors.html
  12. 2
      docs/index.html
  13. 8
      docs/news/index.html
  14. 2
      docs/pkgdown.yml
  15. 2
      docs/reference/index.html
  16. 6
      docs/reference/translate.html
  17. 2
      docs/survey.html
  18. 2
      man/translate.Rd
  19. 10
      tests/testthat/test-mo.R

2
DESCRIPTION

@ -1,5 +1,5 @@ @@ -1,5 +1,5 @@
Package: AMR
Version: 1.3.0.9019
Version: 1.3.0.9020
Date: 2020-09-14
Title: Antimicrobial Resistance Analysis
Authors@R: c(

2
NEWS.md

@ -1,4 +1,4 @@ @@ -1,4 +1,4 @@
# AMR 1.3.0.9019
# AMR 1.3.0.9020
## <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!

1
R/eucast_rules.R

@ -221,6 +221,7 @@ eucast_rules <- function(x, @@ -221,6 +221,7 @@ eucast_rules <- function(x,
col_mo <- search_type_in_df(x = x, type = "mo")
}
stop_if(is.null(col_mo), "`col_mo` must be set")
stop_ifnot(col_mo %in% colnames(x), "column '", col_mo, "' (`col_mo`) not found")
stop_ifnot(all(rules %in% c("breakpoints", "expert", "other", "all")),
'`rules` must be one or more of: "breakpoints", "expert", "other", "all".')

1
R/first_isolate.R

@ -167,6 +167,7 @@ first_isolate <- function(x, @@ -167,6 +167,7 @@ first_isolate <- function(x,
if (is.null(col_mo)) {
col_mo <- search_type_in_df(x = x, type = "mo")
stop_if(is.null(col_mo), "`col_mo` must be set")
stop_ifnot(col_mo %in% colnames(x), "column '", col_mo, "' (`col_mo`) not found")
}
# -- date

1
R/mdro.R

@ -150,6 +150,7 @@ mdro <- function(x, @@ -150,6 +150,7 @@ mdro <- function(x,
col_mo <- "mo"
}
stop_if(is.null(col_mo), "`col_mo` must be set")
stop_ifnot(col_mo %in% colnames(x), "column '", col_mo, "' (`col_mo`) not found")
if (guideline$code == "cmi2012") {
guideline$name <- "Multidrug-resistant, extensively drug-resistant and pandrug-resistant bacteria: an international expert proposal for interim standard definitions for acquired resistance."

133
R/mo.R

@ -288,6 +288,7 @@ exec_as.mo <- function(x, @@ -288,6 +288,7 @@ exec_as.mo <- function(x,
actual_uncertainty = 1,
actual_input = NULL,
language = get_locale()) {
check_dataset_integrity()
lookup <- function(needle,
@ -298,7 +299,7 @@ exec_as.mo <- function(x, @@ -298,7 +299,7 @@ exec_as.mo <- function(x,
initial = initial_search,
uncertainty = actual_uncertainty,
input_actual = actual_input) {
if (!is.null(input_actual)) {
input <- input_actual
} else {
@ -312,7 +313,7 @@ exec_as.mo <- function(x, @@ -312,7 +313,7 @@ exec_as.mo <- function(x,
}
if (length(column) == 1) {
res_df <- haystack[which(eval(substitute(needle), envir = haystack, enclos = parent.frame())), , drop = FALSE]
if (NROW(res_df) > 1) {
if (NROW(res_df) > 1 & uncertainty != -1) {
# sort the findings on matching score
res_df <- res_df[order(mo_matching_score(input, res_df[, "fullname", drop = TRUE]), decreasing = TRUE), , drop = FALSE]
}
@ -326,8 +327,8 @@ exec_as.mo <- function(x, @@ -326,8 +327,8 @@ exec_as.mo <- function(x,
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
if ((length(res) > n | uncertainty > 1) & uncertainty != -1) {
# save the other possible results as well, but not for forced certain results (then uncertainty == -1)
uncertainties <<- rbind(uncertainties,
format_uncertainty_as_df(uncertainty_level = uncertainty,
input = input,
@ -437,7 +438,7 @@ exec_as.mo <- function(x, @@ -437,7 +438,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")
@ -702,18 +703,18 @@ exec_as.mo <- function(x, @@ -702,18 +703,18 @@ exec_as.mo <- function(x,
# translate known trivial abbreviations to genus + species ----
if (toupper(x_backup_without_spp[i]) %in% c("MRSA", "MSSA", "VISA", "VRSA", "BORSA")
| x_backup_without_spp[i] %like_case% " (mrsa|mssa|visa|vrsa) ") {
x[i] <- lookup(fullname == "Staphylococcus aureus")
x[i] <- lookup(fullname == "Staphylococcus aureus", uncertainty = -1)
next
}
if (toupper(x_backup_without_spp[i]) %in% c("MRSE", "MSSE")
| x_backup_without_spp[i] %like_case% " (mrse|msse) ") {
x[i] <- lookup(fullname == "Staphylococcus epidermidis")
x[i] <- lookup(fullname == "Staphylococcus epidermidis", uncertainty = -1)
next
}
if (toupper(x_backup_without_spp[i]) == "VRE"
| x_backup_without_spp[i] %like_case% " vre "
| x_backup_without_spp[i] %like_case% "(enterococci|enterokok|enterococo)[a-z]*?$") {
x[i] <- lookup(genus == "Enterococcus")
x[i] <- lookup(genus == "Enterococcus", uncertainty = -1)
next
}
# support for:
@ -731,50 +732,50 @@ exec_as.mo <- function(x, @@ -731,50 +732,50 @@ exec_as.mo <- function(x,
if (toupper(x_backup_without_spp[i]) %in% c("AIEC", "ATEC", "DAEC", "EAEC", "EHEC", "EIEC", "EPEC", "ETEC", "NMEC", "STEC", "UPEC")
# also support O-antigens of E. coli: O26, O103, O104, O111, O121, O145, O157
| x_backup_without_spp[i] %like_case% "o?(26|103|104|111|121|145|157)") {
x[i] <- lookup(fullname == "Escherichia coli")
x[i] <- lookup(fullname == "Escherichia coli", uncertainty = -1)
next
}
if (toupper(x_backup_without_spp[i]) == "MRPA"
| x_backup_without_spp[i] %like_case% " mrpa ") {
# multi resistant P. aeruginosa
x[i] <- lookup(fullname == "Pseudomonas aeruginosa")
x[i] <- lookup(fullname == "Pseudomonas aeruginosa", uncertainty = -1)
next
}
if (toupper(x_backup_without_spp[i]) == "CRSM") {
# co-trim resistant S. maltophilia
x[i] <- lookup(fullname == "Stenotrophomonas maltophilia")
x[i] <- lookup(fullname == "Stenotrophomonas maltophilia", uncertainty = -1)
next
}
if (toupper(x_backup_without_spp[i]) %in% c("PISP", "PRSP", "VISP", "VRSP")
| x_backup_without_spp[i] %like_case% " (pisp|prsp|visp|vrsp) ") {
# peni I, peni R, vanco I, vanco R: S. pneumoniae
x[i] <- lookup(fullname == "Streptococcus pneumoniae")
x[i] <- lookup(fullname == "Streptococcus pneumoniae", uncertainty = -1)
next
}
if (x_backup_without_spp[i] %like_case% "^g[abcdfghk]s$") {
# Streptococci, like GBS = Group B Streptococci (B_STRPT_GRPB)
x[i] <- lookup(mo == toupper(gsub("g([abcdfghk])s",
"B_STRPT_GRP\\1",
x_backup_without_spp[i])))
x_backup_without_spp[i])), uncertainty = -1)
next
}
if (x_backup_without_spp[i] %like_case% "(streptococ|streptokok).* [abcdfghk]$") {
# Streptococci in different languages, like "estreptococos grupo B"
x[i] <- lookup(mo == toupper(gsub(".*(streptococ|streptokok|estreptococ).* ([abcdfghk])$",
"B_STRPT_GRP\\2",
x_backup_without_spp[i])))
x_backup_without_spp[i])), uncertainty = -1)
next
}
if (x_backup_without_spp[i] %like_case% "group [abcdfghk] (streptococ|streptokok|estreptococ)") {
# Streptococci in different languages, like "Group A Streptococci"
x[i] <- lookup(mo == toupper(gsub(".*group ([abcdfghk]) (streptococ|streptokok|estreptococ).*",
"B_STRPT_GRP\\1",
x_backup_without_spp[i])))
x_backup_without_spp[i])), uncertainty = -1)
next
}
if (x_backup_without_spp[i] %like_case% "haemoly.*strept") {
# Haemolytic streptococci in different languages
x[i] <- lookup(mo == "B_STRPT_HAEM")
x[i] <- lookup(mo == "B_STRPT_HAEM", uncertainty = -1)
next
}
# CoNS/CoPS in different languages (support for German, Dutch, Spanish, Portuguese) ----
@ -782,14 +783,14 @@ exec_as.mo <- function(x, @@ -782,14 +783,14 @@ exec_as.mo <- function(x,
| x_trimmed[i] %like_case% "[ck]oagulas[ea] negatie?[vf]"
| x_backup_without_spp[i] %like_case% "[ck]o?ns[^a-z]?$") {
# coerce S. coagulase negative
x[i] <- lookup(mo == "B_STPHY_CONS")
x[i] <- lookup(mo == "B_STPHY_CONS", uncertainty = -1)
next
}
if (x_backup_without_spp[i] %like_case% "[ck]oagulas[ea] positie?[vf]"
| x_trimmed[i] %like_case% "[ck]oagulas[ea] positie?[vf]"
| x_backup_without_spp[i] %like_case% "[ck]o?ps[^a-z]?$") {
# coerce S. coagulase positive
x[i] <- lookup(mo == "B_STPHY_COPS")
x[i] <- lookup(mo == "B_STPHY_COPS", uncertainty = -1)
next
}
# streptococcal groups: milleri and viridans
@ -797,50 +798,50 @@ exec_as.mo <- function(x, @@ -797,50 +798,50 @@ exec_as.mo <- function(x,
| x_backup_without_spp[i] %like_case% "strepto.* mil+er+i"
| x_backup_without_spp[i] %like_case% "mgs[^a-z]?$") {
# Milleri Group Streptococcus (MGS)
x[i] <- lookup(mo == "B_STRPT_MILL")
x[i] <- lookup(mo == "B_STRPT_MILL", uncertainty = -1)
next
}
if (x_trimmed[i] %like_case% "strepto.* viridans"
| x_backup_without_spp[i] %like_case% "strepto.* viridans"
| x_backup_without_spp[i] %like_case% "vgs[^a-z]?$") {
# Viridans Group Streptococcus (VGS)
x[i] <- lookup(mo == "B_STRPT_VIRI")
x[i] <- lookup(mo == "B_STRPT_VIRI", uncertainty = -1)
next
}
if (x_backup_without_spp[i] %like_case% "gram[ -]?neg.*"
| x_backup_without_spp[i] %like_case% "negatie?[vf]"
| x_trimmed[i] %like_case% "gram[ -]?neg.*") {
# coerce Gram negatives
x[i] <- lookup(mo == "B_GRAMN")
x[i] <- lookup(mo == "B_GRAMN", uncertainty = -1)
next
}
if (x_backup_without_spp[i] %like_case% "gram[ -]?pos.*"
| x_backup_without_spp[i] %like_case% "positie?[vf]"
| x_trimmed[i] %like_case% "gram[ -]?pos.*") {
# coerce Gram positives
x[i] <- lookup(mo == "B_GRAMP")
x[i] <- lookup(mo == "B_GRAMP", uncertainty = -1)
next
}
if (x_backup_without_spp[i] %like_case% "mycoba[ck]teri.[nm]?$") {
# coerce mycobacteria in multiple languages
x[i] <- lookup(genus == "Mycobacterium")
x[i] <- lookup(genus == "Mycobacterium", uncertainty = -1)
next
}
if (x_backup_without_spp[i] %like_case% "salmonella [a-z]+ ?.*") {
if (x_backup_without_spp[i] %like_case% "salmonella group") {
# Salmonella Group A to Z, just return S. species for now
x[i] <- lookup(genus == "Salmonella")
x[i] <- lookup(genus == "Salmonella", uncertainty = -1)
next
} else if (grepl("[sS]almonella [A-Z][a-z]+ ?.*", x_backup[i], ignore.case = FALSE) &
!x_backup[i] %like% "t[iy](ph|f)[iy]") {
# Salmonella with capital letter species like "Salmonella Goettingen" - they're all S. enterica
# except for S. typhi, S. paratyphi, S. typhimurium
x[i] <- lookup(fullname == "Salmonella enterica")
x[i] <- lookup(fullname == "Salmonella enterica", uncertainty = -1)
uncertainties <- rbind(uncertainties,
format_uncertainty_as_df(uncertainty_level = 1,
input = x_backup[i],
result_mo = lookup(fullname == "Salmonella enterica", "mo")))
result_mo = lookup(fullname == "Salmonella enterica", "mo", uncertainty = -1)))
next
}
}
@ -848,17 +849,17 @@ exec_as.mo <- function(x, @@ -848,17 +849,17 @@ exec_as.mo <- function(x,
# trivial names known to the field:
if ("meningococcus" %like_case% x_trimmed[i]) {
# coerce Neisseria meningitidis
x[i] <- lookup(fullname == "Neisseria meningitidis")
x[i] <- lookup(fullname == "Neisseria meningitidis", uncertainty = -1)
next
}
if ("gonococcus" %like_case% x_trimmed[i]) {
# coerce Neisseria gonorrhoeae
x[i] <- lookup(fullname == "Neisseria gonorrhoeae")
x[i] <- lookup(fullname == "Neisseria gonorrhoeae", uncertainty = -1)
next
}
if ("pneumococcus" %like_case% x_trimmed[i]) {
# coerce Streptococcus penumoniae
x[i] <- lookup(fullname == "Streptococcus pneumoniae")
x[i] <- lookup(fullname == "Streptococcus pneumoniae", uncertainty = -1)
next
}
# }
@ -1246,13 +1247,11 @@ exec_as.mo <- function(x, @@ -1246,13 +1247,11 @@ exec_as.mo <- function(x,
}
if (!empty_result(found)) {
found_result <- found
found <- lookup(mo == found)
# uncertainty level 2 only if searched part contains a space (otherwise it will be found with lvl 3)
if (x_strip_collapsed %like_case% " ") {
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)
}
}
@ -1283,11 +1282,9 @@ exec_as.mo <- function(x, @@ -1283,11 +1282,9 @@ exec_as.mo <- function(x,
}
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)
}
}
@ -1311,11 +1308,9 @@ exec_as.mo <- function(x, @@ -1311,11 +1308,9 @@ exec_as.mo <- function(x,
}
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)
}
}
@ -1332,9 +1327,8 @@ exec_as.mo <- function(x, @@ -1332,9 +1327,8 @@ exec_as.mo <- function(x,
if (!is.na(found) & nchar(g.x_backup_without_spp) >= 6) {
found_result <- 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)
}
}
@ -1388,7 +1382,7 @@ exec_as.mo <- function(x, @@ -1388,7 +1382,7 @@ exec_as.mo <- function(x,
# no results found: make them UNKNOWN ----
x[i] <- lookup(mo == "UNKNOWN")
x[i] <- lookup(mo == "UNKNOWN", uncertainty = -1)
if (initial_search == TRUE) {
failures <- c(failures, x_backup[i])
}
@ -1478,33 +1472,33 @@ exec_as.mo <- function(x, @@ -1478,33 +1472,33 @@ exec_as.mo <- function(x,
immediate. = TRUE)
}
x[x %in% CoNS] <- lookup(mo == "B_STPHY_CONS")
x[x %in% CoPS] <- lookup(mo == "B_STPHY_COPS")
x[x %in% CoNS] <- lookup(mo == "B_STPHY_CONS", uncertainty = -1)
x[x %in% CoPS] <- lookup(mo == "B_STPHY_COPS", uncertainty = -1)
if (Becker == "all") {
x[x %in% lookup(fullname %like_case% "^Staphylococcus aureus", n = Inf)] <- lookup(mo == "B_STPHY_COPS")
x[x %in% lookup(fullname %like_case% "^Staphylococcus aureus", n = Inf)] <- lookup(mo == "B_STPHY_COPS", uncertainty = -1)
}
}
# Lancefield ----
if (Lancefield == TRUE | Lancefield == "all") {
# group A - S. pyogenes
x[x %in% lookup(genus == "Streptococcus" & species == "pyogenes", n = Inf)] <- lookup(fullname == "Streptococcus group A")
x[x %in% lookup(genus == "Streptococcus" & species == "pyogenes", n = Inf)] <- lookup(fullname == "Streptococcus group A", uncertainty = -1)
# group B - S. agalactiae
x[x %in% lookup(genus == "Streptococcus" & species == "agalactiae", n = Inf)] <- lookup(fullname == "Streptococcus group B")
x[x %in% lookup(genus == "Streptococcus" & species == "agalactiae", n = Inf)] <- lookup(fullname == "Streptococcus group B", uncertainty = -1)
# group C
x[x %in% lookup(genus == "Streptococcus" &
species %in% c("equisimilis", "equi", "zooepidemicus", "dysgalactiae"),
n = Inf)] <- lookup(fullname == "Streptococcus group C")
n = Inf)] <- lookup(fullname == "Streptococcus group C", uncertainty = -1)
if (Lancefield == "all") {
# all Enterococci
x[x %in% lookup(genus == "Enterococcus", n = Inf)] <- lookup(fullname == "Streptococcus group D")
x[x %in% lookup(genus == "Enterococcus", n = Inf)] <- lookup(fullname == "Streptococcus group D", uncertainty = -1)
}
# group F - S. anginosus
x[x %in% lookup(genus == "Streptococcus" & species == "anginosus", n = Inf)] <- lookup(fullname == "Streptococcus group F")
x[x %in% lookup(genus == "Streptococcus" & species == "anginosus", n = Inf)] <- lookup(fullname == "Streptococcus group F", uncertainty = -1)
# group H - S. sanguinis
x[x %in% lookup(genus == "Streptococcus" & species == "sanguinis", n = Inf)] <- lookup(fullname == "Streptococcus group H")
x[x %in% lookup(genus == "Streptococcus" & species == "sanguinis", n = Inf)] <- lookup(fullname == "Streptococcus group H", uncertainty = -1)
# group K - S. salivarius
x[x %in% lookup(genus == "Streptococcus" & species == "salivarius", n = Inf)] <- lookup(fullname == "Streptococcus group K")
x[x %in% lookup(genus == "Streptococcus" & species == "salivarius", n = Inf)] <- lookup(fullname == "Streptococcus group K", uncertainty = -1)
}
# Wrap up ----------------------------------------------------------------
@ -1533,10 +1527,20 @@ exec_as.mo <- function(x, @@ -1533,10 +1527,20 @@ exec_as.mo <- function(x,
print(mo_renamed())
}
if (NROW(uncertainties) > 0 & initial_search == FALSE) {
if (initial_search == FALSE) {
# we got here from uncertain_fn().
if (NROW(uncertainties) == 0) {
# the stripped/transformed version of x_backup is apparently a full hit, like with: as.mo("Escherichia (hello there) coli")
uncertainties <- rbind(uncertainties,
format_uncertainty_as_df(uncertainty_level = actual_uncertainty,
input = actual_input,
result_mo = x,
candidates = ""))
}
# 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)
@ -1748,7 +1752,8 @@ print.mo_uncertainties <- function(x, ...) { @@ -1748,7 +1752,8 @@ print.mo_uncertainties <- function(x, ...) {
if (NROW(x) == 0) {
return(NULL)
}
cat(font_blue("Scores are based on human pathogenic prevalence and the resemblance between the input and the full taxonomic name.\n"))
cat(font_blue(strwrap(c("Scores are based on human pathogenic prevalence and the resemblance between the input and the full taxonomic name. Furthermore, an indication is given about the likelihood of the match - the more transformations are needed for coercion, the more unlikely the result.")), collapse = "\n"))
cat("\n")
msg <- ""
for (i in seq_len(nrow(x))) {
@ -1763,17 +1768,25 @@ print.mo_uncertainties <- function(x, ...) { @@ -1763,17 +1768,25 @@ print.mo_uncertainties <- function(x, ...) {
candidates <- paste(candidates, collapse = ", ")
# align with input after arrow
candidates <- paste0("\n", strrep(" ", nchar(x[i, ]$input) + 6),
"Other", ifelse(n_candidates == 25, " (max 25)", ""), ": ", candidates)
"Less likely", ifelse(n_candidates == 25, " (max 25)", ""), ": ", candidates)
} else {
candidates <- ""
}
if (x[i, ]$uncertainty == 1) {
uncertainty_interpretation <- font_green("* VERY LIKELY *")
} else if (x[i, ]$uncertainty == 1) {
uncertainty_interpretation <- font_orange("* LIKELY *")
} else {
uncertainty_interpretation <- font_red("* UNLIKELY *")
}
msg <- paste(msg,
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)),
")"),
") "),
uncertainty_interpretation,
candidates),
sep = "\n")
}
@ -1877,7 +1890,7 @@ mo_matching_score <- function(input, fullname) { @@ -1877,7 +1890,7 @@ mo_matching_score <- function(input, fullname) {
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
(0.25 * dist) + (0.75 * index_in_MO_lookup)
}
trimws2 <- function(x) {

2
R/translate.R

@ -30,7 +30,7 @@ @@ -30,7 +30,7 @@
#' Please suggest your own translations [by creating a new issue on our repository](https://github.com/msberends/AMR/issues/new?title=Translations).
#'
#' ## 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:
#' 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

2
docs/404.html

@ -81,7 +81,7 @@ @@ -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.9019</span>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.3.0.9020</span>
</span>
</div>

2
docs/LICENSE-text.html

@ -81,7 +81,7 @@ @@ -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.9019</span>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.3.0.9020</span>
</span>
</div>

2
docs/articles/index.html

@ -81,7 +81,7 @@ @@ -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.9019</span>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.3.0.9020</span>
</span>
</div>

2
docs/authors.html

@ -81,7 +81,7 @@ @@ -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.9019</span>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.3.0.9020</span>
</span>
</div>

2
docs/index.html

@ -43,7 +43,7 @@ @@ -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.9019</span>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.3.0.9020</span>
</span>
</div>

8
docs/news/index.html

@ -81,7 +81,7 @@ @@ -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.9019</span>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.3.0.9020</span>
</span>
</div>
@ -236,9 +236,9 @@ @@ -236,9 +236,9 @@
<small>Source: <a href='https://github.com/msberends/AMR/blob/master/NEWS.md'><code>NEWS.md</code></a></small>
</div>
<div id="amr-1309019" class="section level1">
<h1 class="page-header" data-toc-text="1.3.0.9019">
<a href="#amr-1309019" class="anchor"></a>AMR 1.3.0.9019<small> Unreleased </small>
<div id="amr-1309020" class="section level1">
<h1 class="page-header" data-toc-text="1.3.0.9020">
<a href="#amr-1309020" class="anchor"></a>AMR 1.3.0.9020<small> Unreleased </small>
</h1>
<div id="last-updated-14-september-2020" class="section level2">
<h2 class="hasAnchor">

2
docs/pkgdown.yml

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

2
docs/reference/index.html

@ -81,7 +81,7 @@ @@ -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.9019</span>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.3.0.9020</span>
</span>
</div>

6
docs/reference/translate.html

@ -50,7 +50,7 @@ @@ -50,7 +50,7 @@
<meta property="og:title" content="Translate strings from AMR package — translate" />
<meta property="og:description" content="For language-dependent output of AMR functions, like mo_name(), mo_gramstain(), mo_type() and ab_name()." />
<meta property="og:image" content="https://msberends.github.io/AMR/logo.svg" />
<meta property="og:image" content="https://msberends.github.io/AMR/logo.png" />
@ -82,7 +82,7 @@ @@ -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.9018</span>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.3.0.9020</span>
</span>
</div>
@ -252,7 +252,7 @@ @@ -252,7 +252,7 @@
<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>
<p>The system language will be used at default (as returned by <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>), 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>

2
docs/survey.html

@ -81,7 +81,7 @@ @@ -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.9019</span>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.3.0.9020</span>
</span>
</div>

2
man/translate.Rd

@ -18,7 +18,7 @@ Currently supported languages are: Dutch, English, French, German, Italian, Port @@ -18,7 +18,7 @@ Currently supported languages are: Dutch, English, French, German, Italian, Port
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 \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:
The system language will be used at default (as returned by \code{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

10
tests/testthat/test-mo.R

@ -205,8 +205,8 @@ test_that("as.mo works", { @@ -205,8 +205,8 @@ test_that("as.mo works", {
expect_equal(suppressWarnings(as.character(as.mo("staaur extratest", allow_uncertain = FALSE))), "UNKNOWN")
expect_message(as.mo("e coli extra_text", allow_uncertain = TRUE))
expect_equal(suppressMessages(as.character(as.mo("unexisting aureus", allow_uncertain = 3))), "B_STPHY_AURS")
expect_equal(suppressMessages(as.character(as.mo("unexisting staphy", allow_uncertain = 3))), "B_STPHY")
expect_equal(suppressMessages(as.character(as.mo("Staphylococcus aureus unexisting", allow_uncertain = 3))), "B_STPHY_AURS")
expect_equal(suppressMessages(as.character(as.mo("unexisting staphy", allow_uncertain = 3))), "B_STPHY_COPS")
expect_equal(suppressMessages(as.character(as.mo("Staphylococcus aureus unexisting", allow_uncertain = 3))), "B_STPHY_AURS_ANRB")
# predefined reference_df
expect_equal(as.character(as.mo("TestingOwnID",
@ -228,15 +228,15 @@ test_that("as.mo works", { @@ -228,15 +228,15 @@ test_that("as.mo works", {
c("B_PROTS_MRBL", "B_BCLLS_CERS", "B_ESCHR_COLI"))
# hard to find
expect_equal(as.character(suppressWarnings(as.mo(
expect_equal(as.character(suppressMessages(as.mo(
c("Microbacterium paraoxidans",
"Streptococcus suis (bovis gr)",
"Raoultella (here some text) terrigena")))),
c("B_MCRBC_PRXY", "B_STRPT_SUIS", "B_RLTLL_TRRG"))
expect_output(print(mo_uncertainties()))
# Salmonella (City) are all actually Salmonella enterica spp (City)
expect_equal(suppressWarnings(mo_name(c("Salmonella Goettingen", "Salmonella Typhimurium", "Salmonella Group A"))),
expect_equal(suppressMessages(mo_name(c("Salmonella Goettingen", "Salmonella Typhimurium", "Salmonella Group A"))),
c("Salmonella enterica", "Salmonella enterica", "Salmonella"))
# no virusses

Loading…
Cancel
Save