P281424/AMR
1
0
Fork 0
mirror of https://github.com/msberends/AMR.git synced 2025-07-08 14:01:55 +02:00
Code Releases Activity

WHONET fix

Browse Source
This commit is contained in:
dr. M.S. (Matthijs) Berends
2019-03-09 08:21:00 +01:00
parent 0c0c6e289b
commit b319b89750
10 changed files with 80 additions and 68 deletions
Download Patch File Download Diff File Expand all files Collapse all files

10
R/mo.R
View File

@ -122,6 +122,7 @@
#' @importFrom dplyr %>% pull left_join
#' @examples
#' # These examples all return "B_STPHY_AUR", the ID of S. aureus:
#' as.mo("sau") # WHONET code
#' as.mo("stau")
#' as.mo("STAU")
#' as.mo("staaur")
@ -598,6 +599,7 @@ exec_as.mo <- function(x, Becker = FALSE, Lancefield = FALSE,
}
# TRY OTHER SOURCES ----
# WHONET and other common LIS codes
if (toupper(x_backup[i]) %in% AMR::microorganisms.codes[, 1]) {
mo_found <- AMR::microorganisms.codes[toupper(x_backup[i]) == AMR::microorganisms.codes[, 1], "mo"][1L]
if (length(mo_found) > 0) {
@ -606,6 +608,7 @@ exec_as.mo <- function(x, Becker = FALSE, Lancefield = FALSE,
}
}
if (!is.null(reference_df)) {
# self-defined reference
if (x_backup[i] %in% reference_df[, 1]) {
ref_mo <- reference_df[reference_df[, 1] == x_backup[i], "mo"]
if (ref_mo %in% microorganismsDT[, mo]) {
@ -617,6 +620,13 @@ exec_as.mo <- function(x, Becker = FALSE, Lancefield = FALSE,
}
}
# allow no codes less than 4 characters long, was already checked for WHONET above
if (nchar(x_trimmed[i]) < 4) {
x[i] <- microorganismsDT[mo == "UNKNOWN", ..property][[1]]
failures <- c(failures, x_backup[i])
next
}
check_per_prevalence <- function(data_to_check,
a.x_backup,
b.x_trimmed,

38
R/mo_property.R
View File

@ -222,32 +222,32 @@ mo_genus <- function(x, language = get_locale(), ...) {
#' @rdname mo_property
#' @export
mo_family <- function(x, ...) {
mo_validate(x = x, property = "family", ...)
mo_family <- function(x, language = get_locale(), ...) {
mo_translate(mo_validate(x = x, property = "family", ...), language = language)
}
#' @rdname mo_property
#' @export
mo_order <- function(x, ...) {
mo_validate(x = x, property = "order", ...)
mo_order <- function(x, language = get_locale(), ...) {
mo_translate(mo_validate(x = x, property = "order", ...), language = language)
}
#' @rdname mo_property
#' @export
mo_class <- function(x, ...) {
mo_validate(x = x, property = "class", ...)
mo_class <- function(x, language = get_locale(), ...) {
mo_translate(mo_validate(x = x, property = "class", ...), language = language)
}
#' @rdname mo_property
#' @export
mo_phylum <- function(x, ...) {
mo_validate(x = x, property = "phylum", ...)
mo_phylum <- function(x, language = get_locale(), ...) {
mo_translate(mo_validate(x = x, property = "phylum", ...), language = language)
}
#' @rdname mo_property
#' @export
mo_kingdom <- function(x, ...) {
mo_validate(x = x, property = "kingdom", ...)
mo_kingdom <- function(x, language = get_locale(), ...) {
mo_translate(mo_validate(x = x, property = "kingdom", ...), language = language)
}
#' @rdname mo_property
@ -306,16 +306,16 @@ mo_rank <- function(x, ...) {
#' @rdname mo_property
#' @export
mo_taxonomy <- function(x, ...) {
mo_taxonomy <- function(x, language = get_locale(), ...) {
x <- AMR::as.mo(x, ...)
base::list(kingdom = mo_kingdom(x),
phylum = mo_phylum(x),
class = mo_class(x),
order = mo_order(x),
family = mo_family(x),
genus = mo_genus(x),
species = mo_species(x),
subspecies = mo_subspecies(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))
}
#' @rdname mo_property