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

(v1.2.0.9000) eucast_rules() fix for tibbles

Browse Source
This commit is contained in:
dr. M.S. (Matthijs) Berends
2020-06-02 16:05:56 +02:00
parent b44e2c9202
commit 02d07b9fb3
13 changed files with 284 additions and 253 deletions
Download Patch File Download Diff File Expand all files Collapse all files

19
R/ab.R
View File

@ -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])
}

4
R/eucast_rules.R
View File

@ -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
}
}

15
R/filter_ab_class.R
View File

@ -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