mirror of
https://github.com/msberends/AMR.git
synced 2025-07-09 11:01:57 +02:00
(v1.2.0.9000) eucast_rules() fix for tibbles
This commit is contained in:
19
R/ab.R
19
R/ab.R
@ -103,21 +103,20 @@ as.ab <- function(x, ...) {
|
||||
x <- unique(x_bak_clean)
|
||||
x_new <- rep(NA_character_, length(x))
|
||||
x_unknown <- character(0)
|
||||
|
||||
|
||||
for (i in seq_len(length(x))) {
|
||||
if (is.na(x[i]) | is.null(x[i])) {
|
||||
next
|
||||
}
|
||||
if (identical(x[i], "")) {
|
||||
if (identical(x[i], "") |
|
||||
# no short names:
|
||||
nchar(x[i]) <= 2 |
|
||||
# prevent "bacteria" from coercing to TMP, since Bacterial is a brand name of it:
|
||||
identical(tolower(x[i]), "bacteria")) {
|
||||
x_unknown <- c(x_unknown, x_bak[x[i] == x_bak_clean][1])
|
||||
next
|
||||
}
|
||||
# prevent "bacteria" from coercing to TMP, since Bacterial is a brand name of it
|
||||
if (identical(tolower(x[i]), "bacteria")) {
|
||||
x_unknown <- c(x_unknown, x_bak[x[i] == x_bak_clean][1])
|
||||
next
|
||||
}
|
||||
|
||||
|
||||
# exact AB code
|
||||
found <- antibiotics[which(antibiotics$ab == toupper(x[i])), ]$ab
|
||||
if (length(found) > 0) {
|
||||
@ -217,7 +216,7 @@ as.ab <- function(x, ...) {
|
||||
x_spelling <- gsub("(.)\\1+", "\\1+", x_spelling)
|
||||
# replace spaces and slashes with a possibility on both
|
||||
x_spelling <- gsub("[ /]", "( .*|.*/)", x_spelling)
|
||||
|
||||
|
||||
# try if name starts with it
|
||||
found <- antibiotics[which(antibiotics$name %like% paste0("^", x_spelling)), ]$ab
|
||||
if (length(found) > 0) {
|
||||
@ -303,7 +302,7 @@ as.ab <- function(x, ...) {
|
||||
next
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
# not found
|
||||
x_unknown <- c(x_unknown, x_bak[x[i] == x_bak_clean][1])
|
||||
}
|
||||
|
@ -518,6 +518,8 @@ eucast_rules <- function(x,
|
||||
|
||||
# save original table
|
||||
x_original <- x
|
||||
x_original_attr <- attributes(x)
|
||||
x_original <- as.data.frame(x_original, stringsAsFactors = FALSE) # no tibbles, data.tables, etc.
|
||||
|
||||
# join to microorganisms data set
|
||||
x <- as.data.frame(x, stringsAsFactors = FALSE)
|
||||
@ -922,6 +924,8 @@ eucast_rules <- function(x,
|
||||
rownames(verbose_info) <- NULL
|
||||
verbose_info
|
||||
} else {
|
||||
# reset original attributes
|
||||
attributes(x_original) <- x_original_attr
|
||||
x_original
|
||||
}
|
||||
}
|
||||
|
@ -70,6 +70,14 @@ filter_ab_class <- function(x,
|
||||
|
||||
check_dataset_integrity()
|
||||
|
||||
if (!is.data.frame(x)) {
|
||||
stop("`x` must be a data frame.", call. = FALSE)
|
||||
}
|
||||
|
||||
# save to return later
|
||||
x_class <- class(x)
|
||||
x <- as.data.frame(x, stringsAsFactors = FALSE)
|
||||
|
||||
scope <- scope[1L]
|
||||
if (is.null(result)) {
|
||||
result <- c("S", "I", "R")
|
||||
@ -116,13 +124,16 @@ filter_ab_class <- function(x,
|
||||
}
|
||||
message(font_blue(paste0("Filtering on ", ab_group, ": ", scope,
|
||||
paste0(font_bold(paste0("`", vars_df, "`"), collapse = NULL), collapse = scope_txt), operator, toString(result))))
|
||||
x[as.logical(by(x, seq_len(nrow(x)), function(row) scope_fn(unlist(row[, vars_df]) %in% result, na.rm = TRUE))), , drop = FALSE]
|
||||
filtered <<- as.logical(by(x, seq_len(nrow(x)),
|
||||
function(row) scope_fn(unlist(row[, vars_df]) %in% result, na.rm = TRUE)))
|
||||
x <- x[which(filtered), , drop = FALSE]
|
||||
} else {
|
||||
message(font_blue(paste0("NOTE: no antimicrobial agents of class ", ab_group,
|
||||
" (such as ", find_ab_names(ab_group),
|
||||
") found, data left unchanged.")))
|
||||
x
|
||||
}
|
||||
class(x) <- x_class
|
||||
x
|
||||
}
|
||||
|
||||
#' @rdname filter_ab_class
|
||||
|
Reference in New Issue
Block a user