P281424/AMR
1
0
Fork 0
mirror of https://github.com/msberends/AMR.git synced 2025-07-12 13:41:49 +02:00
Code Releases Activity

(v0.7.0.9013) mo_synonym fix

Browse Source
This commit is contained in:
dr. M.S. (Matthijs) Berends
2019-06-22 14:49:12 +02:00
parent 409397a337
commit c9156c004a
75 changed files with 465 additions and 507 deletions
Download Patch File Download Diff File Expand all files Collapse all files

45
R/mo.R
View File

@ -148,9 +148,10 @@
#' as.mo("Staphylococcus aureus")
#' as.mo("Staphylococcus aureus (MRSA)")
#' as.mo("Sthafilokkockus aaureuz") # handles incorrect spelling
#' as.mo("MRSA") # Methicillin Resistant S. aureus
#' as.mo("VISA") # Vancomycin Intermediate S. aureus
#' as.mo("VRSA") # Vancomycin Resistant S. aureus
#' as.mo("MRSA") # Methicillin Resistant S. aureus
#' as.mo("VISA") # Vancomycin Intermediate S. aureus
#' as.mo("VRSA") # Vancomycin Resistant S. aureus
#' as.mo(22242419) # Catalogue of Life ID
#'
#' # Dyslexia is no problem - these all work:
#' as.mo("Ureaplasma urealyticum")
@ -232,11 +233,11 @@ as.mo <- function(x, Becker = FALSE, Lancefield = FALSE, allow_uncertain = TRUE,
& isFALSE(Lancefield)) {
y <- x
# } else if (!any(is.na(mo_hist))
# & isFALSE(Becker)
# & isFALSE(Lancefield)) {
# # check previously found results
# y <- mo_hist
# } else if (!any(is.na(mo_hist))
# & isFALSE(Becker)
# & isFALSE(Lancefield)) {
# # check previously found results
# y <- mo_hist
} else if (all(tolower(x) %in% microorganismsDT$fullname_lower)
& isFALSE(Becker)
@ -564,6 +565,17 @@ exec_as.mo <- function(x,
next
}
found <- microorganismsDT[col_id == x_backup[i], ..property][[1]]
# is a valid Catalogue of Life ID
if (NROW(found) > 0) {
x[i] <- found[1L]
if (initial_search == TRUE) {
set_mo_history(x_backup[i], get_mo_code(x[i], property), 0, force = force_mo_history)
}
next
}
# WHONET: xxx = no growth
if (tolower(as.character(paste0(x_backup_without_spp[i], ""))) %in% c("", "xxx", "na", "nan")) {
x[i] <- NA_character_
@ -642,6 +654,18 @@ exec_as.mo <- function(x,
}
next
}
# support for:
# - AIEC (Adherent-Invasive E. coli)
# - ATEC (Atypical Entero-pathogenic E. coli)
# - DAEC (Diffusely Adhering E. coli)
# - EAEC (Entero-Aggresive E. coli)
# - EHEC (Entero-Haemorrhagic E. coli)
# - EIEC (Entero-Invasive E. coli)
# - EPEC (Entero-Pathogenic E. coli)
# - ETEC (Entero-Toxigenic E. coli)
# - NMEC (Neonatal Meningitis‐causing E. coli)
# - STEC (Shiga-toxin producing E. coli)
# - UPEC (Uropathogenic E. coli)
if (toupper(x_backup_without_spp[i]) %in% c("AIEC", "ATEC", "DAEC", "EAEC", "EHEC", "EIEC", "EPEC", "ETEC", "NMEC", "STEC", "UPEC")
| x_backup_without_spp[i] %like% "O?(26|103|104|104|111|121|145|157)") {
x[i] <- microorganismsDT[mo == 'B_ESCHR_COL', ..property][[1]][1L]
@ -770,7 +794,7 @@ exec_as.mo <- function(x,
}
}
# FIRST TRY FULLNAMES AND CODES
# FIRST TRY FULLNAMES AND CODES ----
# if only genus is available, return only genus
if (all(!c(x[i], x_trimmed[i]) %like% " ")) {
found <- microorganismsDT[fullname_lower %in% tolower(c(x_species[i], x_trimmed_species[i])), ..property][[1]]
@ -1465,6 +1489,9 @@ unregex <- function(x) {
}
get_mo_code <- function(x, property) {
# don't use right now
return(NULL)
if (property == "mo") {
unique(x)
} else {

72
R/mo_property.R
View File

@ -279,7 +279,7 @@ mo_ref <- function(x, ...) {
#' @export
mo_authors <- function(x, ...) {
x <- mo_validate(x = x, property = "ref", ...)
# remove last 4 digits and presumably the comma and space that preceeds them
# 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)
}
@ -303,35 +303,52 @@ mo_rank <- function(x, ...) {
#' @export
mo_taxonomy <- function(x, language = get_locale(), ...) {
x <- AMR::as.mo(x, ...)
base::list(kingdom = mo_kingdom(x, language = language),
phylum = mo_phylum(x, language = language),
class = mo_class(x, language = language),
order = mo_order(x, language = language),
family = mo_family(x, language = language),
genus = mo_genus(x, language = language),
species = mo_species(x, language = language),
subspecies = mo_subspecies(x, language = language))
base::list(kingdom = AMR::mo_kingdom(x, language = language),
phylum = AMR::mo_phylum(x, language = language),
class = AMR::mo_class(x, language = language),
order = AMR::mo_order(x, language = language),
family = AMR::mo_family(x, language = language),
genus = AMR::mo_genus(x, language = language),
species = AMR::mo_species(x, language = language),
subspecies = AMR::mo_subspecies(x, language = language))
}
#' @rdname mo_property
#' @export
mo_synonyms <- function(x, ...) {
x <- AMR::as.mo(x, ...)
col_id <- AMR::microorganisms[which(AMR::microorganisms$mo == x), "col_id"]
if (is.na(col_id) | !col_id %in% AMR::microorganisms.old$col_id_new) {
return(NULL)
x <- as.mo(x, ...)
IDs <- AMR::mo_property(x = x, property = "col_id", language = NULL)
syns <- lapply(IDs, function(col_id) {
res <- sort(AMR::microorganisms.old[which(AMR::microorganisms.old$col_id_new == col_id), "fullname"])
if (length(res) == 0) {
NULL
} else {
res
}
})
if (length(syns) > 1) {
names(syns) <- mo_fullname(x)
syns
} else {
unlist(syns)
}
sort(AMR::microorganisms.old[which(AMR::microorganisms.old$col_id_new == col_id), "fullname"])
}
#' @rdname mo_property
#' @export
mo_info <- function(x, language = get_locale(), ...) {
x <- AMR::as.mo(x, ...)
c(mo_taxonomy(x, language = language),
list(synonyms = mo_synonyms(x),
url = unname(mo_url(x, open = FALSE)),
ref = mo_ref(x)))
info <- lapply(x, function(y)
c(mo_taxonomy(y, language = language),
list(synonyms = mo_synonyms(y),
url = unname(mo_url(y, open = FALSE)),
ref = mo_ref(y))))
if (length(info) > 1) {
names(info) <- mo_fullname(x)
info
} else {
info[[1L]]
}
}
#' @rdname mo_property
@ -350,7 +367,7 @@ mo_url <- function(x, open = FALSE, ...) {
NA_character_))
u <- df$url
names(u) <- mo_fullname(mo)
names(u) <- AMR::mo_fullname(mo)
if (open == TRUE) {
if (length(u) > 1) {
warning("only the first URL will be opened, as `browseURL()` only suports one string.")
@ -400,12 +417,15 @@ mo_validate <- function(x, property, ...) {
if (!all(x %in% pull(AMR::microorganisms, property))
| Becker %in% c(TRUE, "all")
| Lancefield %in% c(TRUE, "all")) {
exec_as.mo(x, property = property, ...)
} else {
if (property == "mo") {
return(structure(x, class = "mo"))
} else {
return(x)
}
x <- exec_as.mo(x, property = property, ...)
}
if (property == "mo") {
return(structure(x, class = "mo"))
} else if (property == "col_id") {
return(as.integer(x))
} else {
return(x)
}
}