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

(v0.7.1.9100) bug_drug speed, MIC levels

Browse Source
This commit is contained in:
dr. M.S. (Matthijs) Berends
2019-10-08 22:21:33 +02:00
parent 683d226fd3
commit c8f6b97847
22 changed files with 117 additions and 70 deletions
Download Patch File Download Diff File Expand all files Collapse all files

6
R/ab_property.R
View File

@ -181,12 +181,12 @@ ab_validate <- function(x, property, ...) {
library("AMR")
# check onLoad() in R/zzz.R: data tables are created there.
}
# try to catch an error when inputting an invalid parameter
# so the 'call.' can be set to FALSE
tryCatch(x[1L] %in% AMR::antibiotics[1, property],
error = function(e) stop(e$message, call. = FALSE))
x_bak <- x
if (!all(x %in% AMR::antibiotics[, property])) {
x <- data.frame(ab = AMR::as.ab(x, ...), stringsAsFactors = FALSE) %>%
left_join(AMR::antibiotics, by = "ab") %>%
@ -199,6 +199,8 @@ ab_validate <- function(x, property, ...) {
} else if (property %like% "ddd") {
return(as.double(x))
} else {
# return "(input)" for NAs
x[is.na(x) & !is.na(x_bak)] <- paste0("(", x_bak[is.na(x) & !is.na(x_bak)], ")")
return(x)
}
}

23
R/bug_drug_combinations.R
View File

@ -39,6 +39,7 @@
#' The language of the output can be overwritten with \code{options(AMR_locale)}, please see \link{translate}.
#' @export
#' @rdname bug_drug_combinations
#' @return The function \code{bug_drug_combinations} returns a \code{data.frame} with columns "mo", "ab", "S", "I", "R" and "total".
#' @source \strong{M39 Analysis and Presentation of Cumulative Antimicrobial Susceptibility Test Data, 4th Edition}, 2014, \emph{Clinical and Laboratory Standards Institute (CLSI)}. \url{https://clsi.org/standards/products/microbiology/documents/m39/}.
#' @inheritSection AMR Read more on our website!
#' @examples
@ -58,7 +59,6 @@
#' }
bug_drug_combinations <- function(x,
col_mo = NULL,
minimum = 30,
FUN = mo_shortname,
...) {
if (!is.data.frame(x)) {
@ -77,17 +77,17 @@ bug_drug_combinations <- function(x,
x <- x %>%
as.data.frame(stringsAsFactors = FALSE) %>%
mutate(mo = x %>% pull(col_mo) %>% FUN(...)) %>%
filter(mo %in% (freq(mo) %>%
filter(count >= minimum) %>%
pull(item))) %>%
group_by(mo) %>%
AMR::rsi_df(translate_ab = FALSE, combine_SI = FALSE) %>%
select(-value) %>%
spread(interpretation, isolates) %>%
select_if(is.rsi) %>%
gather("ab", "value", -mo) %>%
group_by(mo, ab) %>%
summarise(S = sum(value == "S", na.rm = TRUE),
I = sum(value == "I", na.rm = TRUE),
R = sum(value == "R", na.rm = TRUE)) %>%
ungroup() %>%
mutate(total = S + I + R) %>%
filter(total >= minimum) %>%
rename(ab = antibiotic)
as.data.frame(stringsAsFactors = FALSE)
structure(.Data = x, class = c("bug_drug_combinations", class(x)))
}
@ -107,6 +107,8 @@ format.bug_drug_combinations <- function(x,
decimal.mark = getOption("OutDec"),
big.mark = ifelse(decimal.mark == ",", ".", ","),
...) {
x <- x %>% filter(total >= minimum)
if (remove_intrinsic_resistant == TRUE) {
x <- x %>% filter(R != total)
}
@ -133,7 +135,6 @@ format.bug_drug_combinations <- function(x,
}
y <- x %>%
filter(total >= minimum) %>%
mutate(ab = as.ab(ab),
ab_txt = give_ab_name(ab = ab, format = translate_ab, language = language)) %>%
group_by(ab, ab_txt, mo) %>%

2
R/eucast_rules.R
View File

@ -429,7 +429,7 @@ eucast_rules <- function(x,
x_original <<- x_original %>% mutate_at(vars(cols), ~factor(x = as.character(.), levels = c(to, levels(.))))
x <<- x %>% mutate_at(vars(cols), ~factor(x = as.character(.), levels = c(to, levels(.))))
x_original[rows, cols] <<- to
warning('Value "', to, '" added to the factor levels of column(s) `', paste(cols, collapse = '`, `'), '` because this value was not an existing factor level.\nA better way is to use as.rsi() on beforehand on antibiotic columns to guarantee the right structure.', call. = FALSE)
warning('Value "', to, '" added to the factor levels of column(s) `', paste(cols, collapse = '`, `'), '` because this value was not an existing factor level.\nA better way is to use as.rsi() on beforehand on antimicrobial columns to guarantee the right structure.', call. = FALSE)
txt_warning()
warned <<- FALSE
} else {

8
R/guess_ab_col.R
View File

@ -130,7 +130,7 @@ get_column_abx <- function(x,
# and that have no more than 50% invalid values
vectr_antibiotics <- unique(toupper(unlist(AMR::antibiotics[,c("ab", "atc", "name", "abbreviations", "synonyms")])))
vectr_antibiotics <- vectr_antibiotics[!is.na(vectr_antibiotics) & nchar(vectr_antibiotics) >= 3]
x_columns <- sapply(colnames(x), function(col = x, df = x_bak) {
x_columns <- sapply(colnames(x), function(col, df = x_bak) {
if (toupper(col) %in% vectr_antibiotics |
is.rsi(as.data.frame(df)[, col]) |
is.rsi.eligible(as.data.frame(df)[, col], threshold = 0.5)) {
@ -139,9 +139,9 @@ get_column_abx <- function(x,
return(NA_character_)
}
})
x_coluxmns <- x_columns[!is.na(x_columns)]
x <- x[,x_columns[!is.na(x_columns)]]
x_columns <- x_columns[!is.na(x_columns)]
x <- x[, x_columns, drop = FALSE] # without drop = TRUE, x will become a vector when x_columns is length 1
df_trans <- data.frame(colnames = colnames(x),
abcode = suppressWarnings(as.ab(colnames(x))))
df_trans <- df_trans[!is.na(df_trans$abcode),]

34
R/mic.R
View File

@ -68,6 +68,9 @@ as.mic <- function(x, na.rm = FALSE) {
x <- gsub(',', '.', x, fixed = TRUE)
# remove space between operator and number ("<= 0.002" -> "<=0.002")
x <- gsub('(<|=|>) +', '\\1', x)
# transform => to >= and =< to <=
x <- gsub('=>', '>=', x, fixed = TRUE)
x <- gsub('=<', '<=', x, fixed = TRUE)
# starting dots must start with 0
x <- gsub('^[.]+', '0.', x)
# <=0.2560.512 should be 0.512
@ -76,13 +79,19 @@ as.mic <- function(x, na.rm = FALSE) {
x <- gsub('[.]+0$', '', x)
# remove all after last digit
x <- gsub('[^0-9]+$', '', x)
# keep only one zero before dot
x <- gsub("0+[.]", "0.", x)
# starting 00 is probably 0.0 if there's no dot yet
x[!x %like% "[.]"] <- gsub("^00", "0.0", x[!x %like% "[.]"])
# remove last zeroes
x <- gsub('([.].?)0+$', '\\1', x)
x <- gsub('(.*[.])0+$', '\\10', x)
# remove ending .0 again
x <- gsub('[.]+0$', '', x)
x[x %like% "[.]"] <- gsub('0+$', '', x[x %like% "[.]"])
# force to be character
x <- as.character(x)
# trim it
x <- trimws(x)
## previously unempty values now empty - should return a warning later on
x[x.bak != "" & x == ""] <- "invalid"
@ -92,15 +101,25 @@ as.mic <- function(x, na.rm = FALSE) {
"<0.002", "<=0.002", "0.002", ">=0.002", ">0.002",
"<0.003", "<=0.003", "0.003", ">=0.003", ">0.003",
"<0.004", "<=0.004", "0.004", ">=0.004", ">0.004",
"<0.005", "<=0.005", "0.005", ">=0.005", ">0.005",
"<0.006", "<=0.006", "0.006", ">=0.006", ">0.006",
"<0.007", "<=0.007", "0.007", ">=0.007", ">0.007",
"<0.008", "<=0.008", "0.008", ">=0.008", ">0.008",
"<0.009", "<=0.009", "0.009", ">=0.009", ">0.009",
"<0.01", "<=0.01", "0.01", ">=0.01", ">0.01",
"<0.012", "<=0.012", "0.012", ">=0.012", ">0.012",
"<0.0125", "<=0.0125", "0.0125", ">=0.0125", ">0.0125",
"<0.016", "<=0.016", "0.016", ">=0.016", ">0.016",
"<0.019", "<=0.019", "0.019", ">=0.019", ">0.019",
"<0.02", "<=0.02", "0.02", ">=0.02", ">0.02",
"<0.023", "<=0.023", "0.023", ">=0.023", ">0.023",
"<0.025", "<=0.025", "0.025", ">=0.025", ">0.025",
"<0.028", "<=0.028", "0.028", ">=0.028", ">0.028",
"<0.03", "<=0.03", "0.03", ">=0.03", ">0.03",
"<0.031", "<=0.031", "0.031", ">=0.031", ">0.031",
"<0.032", "<=0.032", "0.032", ">=0.032", ">0.032",
"<0.038", "<=0.038", "0.038", ">=0.038", ">0.038",
"<0.04", "<=0.04", "0.04", ">=0.04", ">0.04",
"<0.047", "<=0.047", "0.047", ">=0.047", ">0.047",
"<0.05", "<=0.05", "0.05", ">=0.05", ">0.05",
"<0.054", "<=0.054", "0.054", ">=0.054", ">0.054",
@ -108,25 +127,38 @@ as.mic <- function(x, na.rm = FALSE) {
"<0.0625", "<=0.0625", "0.0625", ">=0.0625", ">0.0625",
"<0.063", "<=0.063", "0.063", ">=0.063", ">0.063",
"<0.064", "<=0.064", "0.064", ">=0.064", ">0.064",
"<0.075", "<=0.075", "0.075", ">=0.075", ">0.075",
"<0.08", "<=0.08", "0.08", ">=0.08", ">0.08",
"<0.09", "<=0.09", "0.09", ">=0.09", ">0.09",
"<0.094", "<=0.094", "0.094", ">=0.094", ">0.094",
"<0.095", "<=0.095", "0.095", ">=0.095", ">0.095",
"<0.1", "<=0.1", "0.1", ">=0.1", ">0.1",
"<0.12", "<=0.12", "0.12", ">=0.12", ">0.12",
"<0.125", "<=0.125", "0.125", ">=0.125", ">0.125",
"<0.128", "<=0.128", "0.128", ">=0.128", ">0.128",
"<0.15", "<=0.15", "0.15", ">=0.15", ">0.15",
"<0.16", "<=0.16", "0.16", ">=0.16", ">0.16",
"<0.17", "<=0.17", "0.17", ">=0.17", ">0.17",
"<0.18", "<=0.18", "0.18", ">=0.18", ">0.18",
"<0.19", "<=0.19", "0.19", ">=0.19", ">0.19",
"<0.2", "<=0.2", "0.2", ">=0.2", ">0.2",
"<0.23", "<=0.23", "0.23", ">=0.23", ">0.23",
"<0.25", "<=0.25", "0.25", ">=0.25", ">0.25",
"<0.256", "<=0.256", "0.256", ">=0.256", ">0.256",
"<0.28", "<=0.28", "0.28", ">=0.28", ">0.28",
"<0.3", "<=0.3", "0.3", ">=0.3", ">0.3",
"<0.32", "<=0.32", "0.32", ">=0.32", ">0.32",
"<0.35", "<=0.35", "0.35", ">=0.35", ">0.35",
"<0.36", "<=0.36", "0.36", ">=0.36", ">0.36",
"<0.38", "<=0.38", "0.38", ">=0.38", ">0.38",
"<0.47", "<=0.47", "0.47", ">=0.47", ">0.47",
"<0.5", "<=0.5", "0.5", ">=0.5", ">0.5",
"<0.512", "<=0.512", "0.512", ">=0.512", ">0.512",
"<0.64", "<=0.64", "0.64", ">=0.64", ">0.64",
"<0.73", "<=0.73", "0.73", ">=0.73", ">0.73",
"<0.75", "<=0.75", "0.75", ">=0.75", ">0.75",
"<0.8", "<=0.8", "0.8", ">=0.8", ">0.8",
"<0.94", "<=0.94", "0.94", ">=0.94", ">0.94",
"<1", "<=1", "1", ">=1", ">1",
"<1.5", "<=1.5", "1.5", ">=1.5", ">1.5",
"<2", "<=2", "2", ">=2", ">2",

46
R/mo.R
View File

@ -412,13 +412,13 @@ exec_as.mo <- function(x,
y <- reference_data_to_use[prevalence == 1][data.table(mo = x), on = "mo", ..property][[1]]
if (any(is.na(y))) {
y[is.na(y)] <- reference_data_to_use[prevalence == 2][data.table(mo = x[is.na(y)]),
on = "mo",
..property][[1]]
on = "mo",
..property][[1]]
}
if (any(is.na(y))) {
y[is.na(y)] <- reference_data_to_use[prevalence == 3][data.table(mo = x[is.na(y)]),
on = "mo",
..property][[1]]
on = "mo",
..property][[1]]
}
x <- y
@ -441,13 +441,13 @@ exec_as.mo <- function(x,
y <- reference_data_to_use[prevalence == 1][data.table(fullname_lower = tolower(x)), on = "fullname_lower", ..property][[1]]
if (any(is.na(y))) {
y[is.na(y)] <- reference_data_to_use[prevalence == 2][data.table(fullname_lower = tolower(x[is.na(y)])),
on = "fullname_lower",
..property][[1]]
on = "fullname_lower",
..property][[1]]
}
if (any(is.na(y))) {
y[is.na(y)] <- reference_data_to_use[prevalence == 3][data.table(fullname_lower = tolower(x[is.na(y)])),
on = "fullname_lower",
..property][[1]]
on = "fullname_lower",
..property][[1]]
}
x <- y
@ -548,7 +548,7 @@ exec_as.mo <- function(x,
x[nchar(x_backup_without_spp) > 10] <- gsub("[+]", paste0("+[", constants, "]?"), x[nchar(x_backup_without_spp) > 10])
}
x <- strip_whitespace(x, dyslexia_mode)
x_trimmed <- x
x_trimmed_species <- paste(x_trimmed, "species")
x_trimmed_without_group <- gsub(" gro.u.p$", "", x_trimmed)
@ -1067,9 +1067,9 @@ exec_as.mo <- function(x,
ref_old = found[1, ref],
ref_new = microorganismsDT[col_id == found[1, col_id_new], ref],
mo = microorganismsDT[col_id == found[1, col_id_new], mo])
if (initial_search == TRUE) {
set_mo_history(a.x_backup, get_mo_code(x[i], property), 0, force = force_mo_history, disable = disable_mo_history)
}
# if (initial_search == TRUE) {
# set_mo_history(a.x_backup, get_mo_code(x[i], property), 0, force = force_mo_history, disable = disable_mo_history)
# }
return(x[i])
}
@ -1099,7 +1099,7 @@ exec_as.mo <- function(x,
message("Running '", d.x_withspaces_start_end, "' and '", e.x_withspaces_start_only, "'")
}
found <- data.old_to_check[fullname_lower %like_case% d.x_withspaces_start_end
| fullname_lower %like_case% e.x_withspaces_start_only]
| fullname_lower %like_case% e.x_withspaces_start_only]
if (NROW(found) > 0 & nchar(g.x_backup_without_spp) >= 6) {
if (property == "ref") {
# when property is "ref" (which is the case in mo_ref, mo_authors and mo_year), return the old value, so:
@ -1119,9 +1119,9 @@ exec_as.mo <- function(x,
format_uncertainty_as_df(uncertainty_level = now_checks_for_uncertainty_level,
input = a.x_backup,
result_mo = microorganismsDT[col_id == found[1, col_id_new], mo]))
if (initial_search == TRUE) {
set_mo_history(a.x_backup, get_mo_code(x, property), 1, force = force_mo_history, disable = disable_mo_history)
}
# if (initial_search == TRUE) {
# set_mo_history(a.x_backup, get_mo_code(x, property), 1, force = force_mo_history, disable = disable_mo_history)
# }
return(x)
}
@ -1520,7 +1520,7 @@ exec_as.mo <- function(x,
# THEN TRY PREVALENT IN HUMAN INFECTIONS ----
x[i] <- check_per_prevalence(data_to_check = reference_data_to_use[prevalence == 2],
data.old_to_check = microorganisms.oldDT[prevalence %in% c(2, 3)], # run all other old MOs the second time,
# otherwise e.g. mo_ref("Chlamydia psittaci") doesn't work correctly
# otherwise e.g. mo_ref("Chlamydia psittaci") doesn't work correctly
a.x_backup = x_backup[i],
b.x_trimmed = x_trimmed[i],
c.x_trimmed_without_group = x_trimmed_without_group[i],
@ -1931,12 +1931,12 @@ print.mo_renamed <- function(x, ...) {
}
for (i in 1:nrow(x)) {
message(blue(paste0("NOTE: ",
italic(x$old_name[i]), ifelse(x$old_ref[i] %in% c("", NA), "",
paste0(" (", gsub("et al.", italic("et al."), x$old_ref[i]), ")")),
" was renamed ",
italic(x$new_name[i]), ifelse(x$new_ref[i] %in% c("", NA), "",
paste0(" (", gsub("et al.", italic("et al."), x$new_ref[i]), ")")),
" [", x$mo[i], "]")))
italic(x$old_name[i]), ifelse(x$old_ref[i] %in% c("", NA), "",
paste0(" (", gsub("et al.", italic("et al."), x$old_ref[i]), ")")),
" was renamed ",
italic(x$new_name[i]), ifelse(x$new_ref[i] %in% c("", NA), "",
paste0(" (", gsub("et al.", italic("et al."), x$new_ref[i]), ")")),
" [", x$mo[i], "]")))
}
}