1
0
mirror of https://github.com/msberends/AMR.git synced 2025-07-08 11:11:54 +02:00

small improvement for is.rsi.eligible, more unit tests

This commit is contained in:
2018-09-14 11:54:01 +02:00
parent cf5711fb0b
commit b0ca49d68d
6 changed files with 31 additions and 29 deletions

21
R/mo.R
View File

@ -138,8 +138,6 @@ as.mo <- function(x, Becker = FALSE, Lancefield = FALSE) {
# replace space by regex sign
x_withspaces <- gsub(" ", ".* ", x, fixed = TRUE)
x <- gsub(" ", ".*", x, fixed = TRUE)
# for species
x_species <- paste(x, 'species')
# add start en stop regex
x <- paste0('^', x, '$')
x_withspaces_all <- x_withspaces
@ -228,12 +226,14 @@ as.mo <- function(x, Becker = FALSE, Lancefield = FALSE) {
x[i] <- found[1L]
next
}
# try the same, now based on genus + species ----
found <- MOs[which(paste(MOs$genus, MOs$species) %like% x_withspaces[i]),]$mo
if (length(found) > 0) {
x[i] <- found[1L]
next
}
# try any match keeping spaces, not ending with $ ----
found <- MOs[which(MOs$fullname %like% x_withspaces_start[i]),]$mo
if (length(found) > 0) {
@ -248,21 +248,6 @@ as.mo <- function(x, Becker = FALSE, Lancefield = FALSE) {
next
}
# try exact match of only genus, with 'species' attached ----
# (this prevents Streptococcus from becoming Peptostreptococcus, since "p" < "s")
found <- MOs[which(MOs$fullname == x_species[i]),]$mo
if (length(found) > 0) {
x[i] <- found[1L]
next
}
# try any match of only genus, with 'species' attached ----
found <- MOs[which(MOs$fullname %like% x_species[i]),]$mo
if (length(found) > 0) {
x[i] <- found[1L]
next
}
# try fullname without start and stop regex, to also find subspecies ----
# like "K. pneu rhino" -> "Klebsiella pneumoniae (rhinoscleromatis)" = KLEPNERH
found <- MOs[which(gsub("[\\(\\)]", "", MOs$fullname) %like% x_withspaces_all[i]),]$mo
@ -322,6 +307,8 @@ as.mo <- function(x, Becker = FALSE, Lancefield = FALSE) {
x[x == "PASAER" & toupper(x_backup) != "PASAER" & !(x_backup %like% '^pas?' | x_backup %like% 'aero')] <- "PSEAER"
# avoid detection of Legionella non pneumophila in case of Legionella pneumophila ----
x[x == "LEGNON" & toupper(x_backup) != "LEGNON" & !x_backup %like% 'non'] <- "LEGPNE"
# avoid detection of Streptobacillus in case of Streptococcus ----
x[x == "STB" & toupper(x_backup) != "STB" & !x_backup %like% 'streptob'] <- "STC"
failures <- failures[!failures %in% c(NA, NULL, NaN)]
if (length(failures) > 0) {

View File

@ -99,10 +99,14 @@ is.rsi <- function(x) {
#' @export
#' @importFrom dplyr %>%
is.rsi.eligible <- function(x) {
distinct_val <- x %>% unique() %>% sort() %>% as.character()
# remove all but a-z
distinct_val <- x %>% unique() %>% sort() %>% as.character() %>% gsub("(\\W|\\d)+", "", .)
# remove NAs and empty values
distinct_val <- distinct_val[!is.na(distinct_val) & trimws(distinct_val) != ""]
# get RSI class
distinct_val_rsi <- as.character(suppressWarnings(as.rsi(distinct_val)))
# is not empty and identical to new class
length(distinct_val) > 0 &
identical(distinct_val, distinct_val_rsi)
}