mirror of
https://github.com/msberends/AMR.git
synced 2025-07-10 19:41:55 +02:00
(v1.7.0.9001) CLSI 2020 guideline
This commit is contained in:
4
R/amr.R
4
R/amr.R
@ -54,14 +54,14 @@
|
||||
#' @section Reference Data Publicly Available:
|
||||
#' All reference data sets (about microorganisms, antibiotics, R/SI interpretation, EUCAST rules, etc.) in this `AMR` package are publicly and freely available. We continually export our data sets to formats for use in R, SPSS, SAS, Stata and Excel. We also supply flat files that are machine-readable and suitable for input in any software program, such as laboratory information systems. Please find [all download links on our website](https://msberends.github.io/AMR/articles/datasets.html), which is automatically updated with every code change.
|
||||
#' @section Read more on Our Website!:
|
||||
#' On our website <https://msberends.github.io/AMR/> you can find [a comprehensive tutorial](https://msberends.github.io/AMR/articles/AMR.html) about how to conduct AMR data analysis, the [complete documentation of all functions](https://msberends.github.io/AMR/reference/) and [an example analysis using WHONET data](https://msberends.github.io/AMR/articles/WHONET.html). As we would like to better understand the backgrounds and needs of our users, please [participate in our survey](https://msberends.github.io/AMR/survey.html)!
|
||||
#' On our website <https://msberends.github.io/AMR/> you can find [a comprehensive tutorial](https://msberends.github.io/AMR/articles/AMR.html) about how to conduct AMR data analysis, the [complete documentation of all functions](https://msberends.github.io/AMR/reference/) and [an example analysis using WHONET data](https://msberends.github.io/AMR/articles/WHONET.html).
|
||||
#' @section Contact Us:
|
||||
#' For suggestions, comments or questions, please contact us at:
|
||||
#'
|
||||
#' Matthijs S. Berends \cr
|
||||
#' m.s.berends \[at\] umcg \[dot\] nl \cr
|
||||
#' University of Groningen
|
||||
#' Department of Medical Microbiology
|
||||
#' Department of Medical Microbiology and Infection Prevention
|
||||
#' University Medical Center Groningen \cr
|
||||
#' Post Office Box 30001 \cr
|
||||
#' 9700 RB Groningen \cr
|
||||
|
||||
@ -31,7 +31,7 @@
|
||||
#' @param combine_IR a [logical] to indicate whether values R and I should be summed
|
||||
#' @param add_ab_group a [logical] to indicate where the group of the antimicrobials must be included as a first column
|
||||
#' @param remove_intrinsic_resistant [logical] to indicate that rows and columns with 100% resistance for all tested antimicrobials must be removed from the table
|
||||
#' @param FUN the function to call on the `mo` column to transform the microorganism IDs, defaults to [mo_shortname()]
|
||||
#' @param FUN the function to call on the `mo` column to transform the microorganism codes, defaults to [mo_shortname()]
|
||||
#' @param translate_ab a [character] of length 1 containing column names of the [antibiotics] data set
|
||||
#' @param ... arguments passed on to `FUN`
|
||||
#' @inheritParams rsi_df
|
||||
@ -74,42 +74,87 @@ bug_drug_combinations <- function(x,
|
||||
stop_ifnot(col_mo %in% colnames(x), "column '", col_mo, "' (`col_mo`) not found")
|
||||
}
|
||||
|
||||
x_class <- class(x)
|
||||
x.bak <- x
|
||||
x <- as.data.frame(x, stringsAsFactors = FALSE)
|
||||
x[, col_mo] <- FUN(x[, col_mo, drop = TRUE], ...)
|
||||
x <- x[, c(col_mo, names(which(vapply(FUN.VALUE = logical(1), x, is.rsi)))), drop = FALSE]
|
||||
|
||||
unique_mo <- sort(unique(x[, col_mo, drop = TRUE]))
|
||||
|
||||
out <- data.frame(mo = character(0),
|
||||
ab = character(0),
|
||||
S = integer(0),
|
||||
I = integer(0),
|
||||
R = integer(0),
|
||||
total = integer(0),
|
||||
stringsAsFactors = FALSE)
|
||||
|
||||
for (i in seq_len(length(unique_mo))) {
|
||||
# filter on MO group and only select R/SI columns
|
||||
x_mo_filter <- x[which(x[, col_mo, drop = TRUE] == unique_mo[i]), names(which(vapply(FUN.VALUE = logical(1), x, is.rsi))), drop = FALSE]
|
||||
# turn and merge everything
|
||||
pivot <- lapply(x_mo_filter, function(x) {
|
||||
m <- as.matrix(table(x))
|
||||
data.frame(S = m["S", ], I = m["I", ], R = m["R", ], stringsAsFactors = FALSE)
|
||||
})
|
||||
merged <- do.call(rbind, pivot)
|
||||
out_group <- data.frame(mo = unique_mo[i],
|
||||
ab = rownames(merged),
|
||||
S = merged$S,
|
||||
I = merged$I,
|
||||
R = merged$R,
|
||||
total = merged$S + merged$I + merged$R,
|
||||
stringsAsFactors = FALSE)
|
||||
out <- rbind(out, out_group, stringsAsFactors = FALSE)
|
||||
# select only groups and antibiotics
|
||||
if (inherits(x.bak, "grouped_df")) {
|
||||
data_has_groups <- TRUE
|
||||
groups <- setdiff(names(attributes(x.bak)$groups), ".rows")
|
||||
x <- x[, c(groups, col_mo, colnames(x)[vapply(FUN.VALUE = logical(1), x, is.rsi)]), drop = FALSE]
|
||||
} else {
|
||||
data_has_groups <- FALSE
|
||||
x <- x[, c(col_mo, names(which(vapply(FUN.VALUE = logical(1), x, is.rsi)))), drop = FALSE]
|
||||
}
|
||||
|
||||
set_clean_class(out,
|
||||
new_class = c("bug_drug_combinations", x_class))
|
||||
run_it <- function(x) {
|
||||
out <- data.frame(mo = character(0),
|
||||
ab = character(0),
|
||||
S = integer(0),
|
||||
I = integer(0),
|
||||
R = integer(0),
|
||||
total = integer(0),
|
||||
stringsAsFactors = FALSE)
|
||||
if (data_has_groups) {
|
||||
group_values <- unique(x[, which(colnames(x) %in% groups), drop = FALSE])
|
||||
rownames(group_values) <- NULL
|
||||
x <- x[, which(!colnames(x) %in% groups), drop = FALSE]
|
||||
}
|
||||
|
||||
for (i in seq_len(length(unique_mo))) {
|
||||
# filter on MO group and only select R/SI columns
|
||||
x_mo_filter <- x[which(x[, col_mo, drop = TRUE] == unique_mo[i]), names(which(vapply(FUN.VALUE = logical(1), x, is.rsi))), drop = FALSE]
|
||||
# turn and merge everything
|
||||
pivot <- lapply(x_mo_filter, function(x) {
|
||||
m <- as.matrix(table(x))
|
||||
data.frame(S = m["S", ], I = m["I", ], R = m["R", ], stringsAsFactors = FALSE)
|
||||
})
|
||||
merged <- do.call(rbind, pivot)
|
||||
out_group <- data.frame(mo = unique_mo[i],
|
||||
ab = rownames(merged),
|
||||
S = merged$S,
|
||||
I = merged$I,
|
||||
R = merged$R,
|
||||
total = merged$S + merged$I + merged$R,
|
||||
stringsAsFactors = FALSE)
|
||||
if (data_has_groups) {
|
||||
if (nrow(group_values) < nrow(out_group)) {
|
||||
# repeat group_values for the number of rows in out_group
|
||||
repeated <- rep(seq_len(nrow(group_values)),
|
||||
each = nrow(out_group) / nrow(group_values))
|
||||
group_values <- group_values[repeated, , drop = FALSE]
|
||||
}
|
||||
out_group <- cbind(group_values, out_group)
|
||||
}
|
||||
out <- rbind(out, out_group, stringsAsFactors = FALSE)
|
||||
}
|
||||
out
|
||||
}
|
||||
# based on pm_apply_grouped_function
|
||||
apply_group <- function(.data, fn, groups, drop = FALSE, ...) {
|
||||
grouped <- pm_split_into_groups(.data, groups, drop)
|
||||
res <- do.call(rbind, unname(lapply(grouped, fn, ...)))
|
||||
if (any(groups %in% colnames(res))) {
|
||||
class(res) <- c("grouped_data", class(res))
|
||||
res <- pm_set_groups(res, groups[groups %in% colnames(res)])
|
||||
}
|
||||
res
|
||||
}
|
||||
|
||||
if (data_has_groups) {
|
||||
out <- apply_group(x, "run_it", groups)
|
||||
rownames(out) <- NULL
|
||||
set_clean_class(out,
|
||||
new_class = c("grouped", "bug_drug_combinations", "data.frame"))
|
||||
} else {
|
||||
out <- run_it(x)
|
||||
rownames(out) <- NULL
|
||||
set_clean_class(out,
|
||||
new_class = c("bug_drug_combinations", "data.frame"))
|
||||
}
|
||||
}
|
||||
|
||||
#' @method format bug_drug_combinations
|
||||
@ -137,6 +182,21 @@ format.bug_drug_combinations <- function(x,
|
||||
meet_criteria(decimal.mark, allow_class = "character", has_length = 1)
|
||||
meet_criteria(big.mark, allow_class = "character", has_length = 1)
|
||||
|
||||
if (inherits(x, "grouped")) {
|
||||
# bug_drug_combinations() has been run on groups, so de-group here
|
||||
warning_("formatting the output of `bug_drug_combinations()` does not support grouped variables, they are ignored", call = FALSE)
|
||||
idx <- split(seq_len(nrow(x)), paste0(x$mo, "%%", x$ab))
|
||||
x <- data.frame(mo = gsub("(.*)%%(.*)", "\\1", names(idx)),
|
||||
ab = gsub("(.*)%%(.*)", "\\2", names(idx)),
|
||||
S = sapply(idx, function(i) sum(y$S[i], na.rm = TRUE)),
|
||||
I = sapply(idx, function(i) sum(y$I[i], na.rm = TRUE)),
|
||||
R = sapply(idx, function(i) sum(y$R[i], na.rm = TRUE)),
|
||||
total = sapply(idx, function(i) sum(y$S[i], na.rm = TRUE) +
|
||||
sum(y$I[i], na.rm = TRUE) +
|
||||
sum(y$R[i], na.rm = TRUE)),
|
||||
stringsAsFactors = FALSE)
|
||||
}
|
||||
|
||||
x <- as.data.frame(x, stringsAsFactors = FALSE)
|
||||
x <- subset(x, total >= minimum)
|
||||
|
||||
@ -249,7 +309,9 @@ format.bug_drug_combinations <- function(x,
|
||||
print.bug_drug_combinations <- function(x, ...) {
|
||||
x_class <- class(x)
|
||||
print(set_clean_class(x,
|
||||
new_class = x_class[x_class != "bug_drug_combinations"]),
|
||||
new_class = x_class[!x_class %in% c("bug_drug_combinations", "grouped")]),
|
||||
...)
|
||||
message_("Use 'format()' on this result to get a publishable/printable format.", as_note = FALSE)
|
||||
message_("Use 'format()' on this result to get a publishable/printable format.",
|
||||
ifelse(inherits(x, "grouped"), " Note: The grouping variable(s) will be ignored.", ""),
|
||||
as_note = FALSE)
|
||||
}
|
||||
|
||||
2
R/data.R
2
R/data.R
@ -239,7 +239,7 @@
|
||||
|
||||
#' Data Set for R/SI Interpretation
|
||||
#'
|
||||
#' Data set to interpret MIC and disk diffusion to R/SI values. Included guidelines are CLSI (`r min(as.integer(gsub("[^0-9]", "", subset(rsi_translation, guideline %like% "CLSI")$guideline)))`-`r max(as.integer(gsub("[^0-9]", "", subset(rsi_translation, guideline %like% "CLSI")$guideline)))`) and EUCAST (`r min(as.integer(gsub("[^0-9]", "", subset(rsi_translation, guideline %like% "EUCAST")$guideline)))`-`r max(as.integer(gsub("[^0-9]", "", subset(rsi_translation, guideline %like% "EUCAST")$guideline)))`). Use [as.rsi()] to transform MICs or disks measurements to R/SI values.
|
||||
#' Data set containing reference data to interpret MIC and disk diffusion to R/SI values, according to international guidelines. Currently implemented guidelines are EUCAST (`r min(as.integer(gsub("[^0-9]", "", subset(rsi_translation, guideline %like% "EUCAST")$guideline)))`-`r max(as.integer(gsub("[^0-9]", "", subset(rsi_translation, guideline %like% "EUCAST")$guideline)))`) and CLSI (`r min(as.integer(gsub("[^0-9]", "", subset(rsi_translation, guideline %like% "CLSI")$guideline)))`-`r max(as.integer(gsub("[^0-9]", "", subset(rsi_translation, guideline %like% "CLSI")$guideline)))`). Use [as.rsi()] to transform MICs or disks measurements to R/SI values.
|
||||
#' @format A [data.frame] with `r format(nrow(rsi_translation), big.mark = ",")` observations and `r ncol(rsi_translation)` variables:
|
||||
#' - `guideline`\cr Name of the guideline
|
||||
#' - `method`\cr Either `r vector_or(rsi_translation$method)`
|
||||
|
||||
52
R/mo.R
52
R/mo.R
@ -23,9 +23,9 @@
|
||||
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
|
||||
# ==================================================================== #
|
||||
|
||||
#' Transform Input to a Microorganism ID
|
||||
#' Transform Input to a Microorganism Code
|
||||
#'
|
||||
#' Use this function to determine a valid microorganism ID ([`mo`]). Determination is done using intelligent rules and the complete taxonomic kingdoms Bacteria, Chromista, Protozoa, Archaea and most microbial species from the kingdom Fungi (see *Source*). The input can be almost anything: a full name (like `"Staphylococcus aureus"`), an abbreviated name (such as `"S. aureus"`), an abbreviation known in the field (such as `"MRSA"`), or just a genus. See *Examples*.
|
||||
#' Use this function to determine a valid microorganism code ([`mo`]). Determination is done using intelligent rules and the complete taxonomic kingdoms Bacteria, Chromista, Protozoa, Archaea and most microbial species from the kingdom Fungi (see *Source*). The input can be almost anything: a full name (like `"Staphylococcus aureus"`), an abbreviated name (such as `"S. aureus"`), an abbreviation known in the field (such as `"MRSA"`), or just a genus. See *Examples*.
|
||||
#' @inheritSection lifecycle Stable Lifecycle
|
||||
#' @param x a [character] vector or a [data.frame] with one or two columns
|
||||
#' @param Becker a [logical] to indicate whether staphylococci should be categorised into coagulase-negative staphylococci ("CoNS") and coagulase-positive staphylococci ("CoPS") instead of their own species, according to Karsten Becker *et al.* (1,2,3).
|
||||
@ -46,7 +46,7 @@
|
||||
#' @details
|
||||
#' ## General Info
|
||||
#'
|
||||
#' A microorganism ID from this package (class: [`mo`]) is human readable and typically looks like these examples:
|
||||
#' A microorganism (MO) code from this package (class: [`mo`]) is human readable and typically looks like these examples:
|
||||
#' ```
|
||||
#' Code Full name
|
||||
#' --------------- --------------------------------------
|
||||
@ -2050,7 +2050,7 @@ parse_and_convert <- function(x) {
|
||||
}
|
||||
|
||||
replace_old_mo_codes <- function(x, property) {
|
||||
ind <- x %like% "[A-Z_]" & !x %in% MO_lookup$mo
|
||||
ind <- x %like_case% "^[A-Z]_[A-Z_]+$" & !x %in% MO_lookup$mo
|
||||
if (any(ind)) {
|
||||
# get the ones that match
|
||||
affected <- x[ind]
|
||||
@ -2059,31 +2059,43 @@ replace_old_mo_codes <- function(x, property) {
|
||||
# find their new codes, once per code
|
||||
solved_unique <- unlist(lapply(strsplit(affected_unique, ""),
|
||||
function(m) {
|
||||
m <- m[3:length(m)]
|
||||
m <- m[m != "_"]
|
||||
m <- tolower(paste0(m, ".*", collapse = ""))
|
||||
out <- MO_lookup$mo[MO_lookup$fullname_lower %like_case% m]
|
||||
if (length(out) > 1) {
|
||||
kingdom <- paste0("^", m[1])
|
||||
name <- m[3:length(m)]
|
||||
name[name == "_"] <- " "
|
||||
name <- tolower(paste0(name, ".*", collapse = ""))
|
||||
name <- gsub(" .*", " ", name, fixed = TRUE)
|
||||
name <- paste0("^", name)
|
||||
results <- MO_lookup$mo[MO_lookup$kingdom %like_case% kingdom &
|
||||
MO_lookup$fullname_lower %like_case% name]
|
||||
if (length(results) > 1) {
|
||||
all_direct_matches <<- FALSE
|
||||
}
|
||||
out[1L]
|
||||
results[1L]
|
||||
}), use.names = FALSE)
|
||||
solved <- solved_unique[match(affected, affected_unique)]
|
||||
# assign on places where a match was found
|
||||
x[ind] <- solved
|
||||
n_matched <- length(affected[!is.na(affected)])
|
||||
n_unique <- length(affected_unique[!is.na(affected_unique)])
|
||||
if (property != "mo") {
|
||||
message_(font_blue(paste0("The input contained ", n_matched,
|
||||
" old MO code", ifelse(n_matched == 1, "", "s"),
|
||||
" (", n_unique, " unique, from a previous AMR package version). Please update your MO codes with `as.mo()` to increase speed.")))
|
||||
if (n_unique < n_matched) {
|
||||
n_unique <- paste0(n_unique, " unique, ")
|
||||
} else {
|
||||
message_(font_blue(paste0(n_matched, " old MO code", ifelse(n_matched == 1, "", "s"),
|
||||
" (", n_unique, " unique, from a previous AMR package version) ",
|
||||
ifelse(n_matched == 1, "was", "were"),
|
||||
ifelse(all_direct_matches, " updated ", font_bold(" guessed ")),
|
||||
"to ", ifelse(n_matched == 1, "a ", ""),
|
||||
"currently used MO code", ifelse(n_matched == 1, "", "s"), ".")))
|
||||
n_unique <- ""
|
||||
}
|
||||
if (property != "mo") {
|
||||
warning_(paste0("The input contained ", n_matched,
|
||||
" old MO code", ifelse(n_matched == 1, "", "s"),
|
||||
" (", n_unique, "from a previous AMR package version). ",
|
||||
"Please update your MO codes with `as.mo()` to increase speed."),
|
||||
call = FALSE)
|
||||
} else {
|
||||
warning_(paste0(n_matched, " old MO code", ifelse(n_matched == 1, "", "s"),
|
||||
" (", n_unique, "from a previous AMR package version) ",
|
||||
ifelse(n_matched == 1, "was", "were"),
|
||||
ifelse(all_direct_matches, " updated ", font_bold(" guessed ")),
|
||||
"to ", ifelse(n_matched == 1, "a ", ""),
|
||||
"currently used MO code", ifelse(n_matched == 1, "", "s"), "."),
|
||||
call = FALSE)
|
||||
}
|
||||
}
|
||||
x
|
||||
|
||||
6
R/rsi.R
6
R/rsi.R
@ -65,9 +65,9 @@
|
||||
#'
|
||||
#' ## Supported Guidelines
|
||||
#'
|
||||
#' For interpreting MIC values as well as disk diffusion diameters, currently supported guidelines to be used as input for the `guideline` argument are: `r vector_and(AMR::rsi_translation$guideline, quotes = TRUE, reverse = TRUE)`.
|
||||
#' For interpreting MIC values as well as disk diffusion diameters, currently implemented guidelines are EUCAST (`r min(as.integer(gsub("[^0-9]", "", subset(rsi_translation, guideline %like% "EUCAST")$guideline)))`-`r max(as.integer(gsub("[^0-9]", "", subset(rsi_translation, guideline %like% "EUCAST")$guideline)))`) and CLSI (`r min(as.integer(gsub("[^0-9]", "", subset(rsi_translation, guideline %like% "CLSI")$guideline)))`-`r max(as.integer(gsub("[^0-9]", "", subset(rsi_translation, guideline %like% "CLSI")$guideline)))`).
|
||||
#'
|
||||
#' Simply using `"CLSI"` or `"EUCAST"` as input will automatically select the latest version of that guideline. You can set your own data set using the `reference_data` argument. The `guideline` argument will then be ignored.
|
||||
#' Thus, the `guideline` argument must be set to e.g., ``r paste0('"', subset(rsi_translation, guideline %like% "EUCAST")$guideline[1], '"')`` or ``r paste0('"', subset(rsi_translation, guideline %like% "CLSI")$guideline[1], '"')``. By simply using `"EUCAST"` (the default) or `"CLSI"` as input, the latest version of that guideline will automatically be selected. You can set your own data set using the `reference_data` argument. The `guideline` argument will then be ignored.
|
||||
#'
|
||||
#' ## After Interpretation
|
||||
#'
|
||||
@ -92,7 +92,7 @@
|
||||
#' - **I = Increased exposure, but still susceptible**\cr
|
||||
#' A microorganism is categorised as *Susceptible, Increased exposure* when there is a high likelihood of therapeutic success because exposure to the agent is increased by adjusting the dosing regimen or by its concentration at the site of infection.
|
||||
#'
|
||||
#' This AMR package honours this new insight. Use [susceptibility()] (equal to [proportion_SI()]) to determine antimicrobial susceptibility and [count_susceptible()] (equal to [count_SI()]) to count susceptible isolates.
|
||||
#' This AMR package honours this (new) insight. Use [susceptibility()] (equal to [proportion_SI()]) to determine antimicrobial susceptibility and [count_susceptible()] (equal to [count_SI()]) to count susceptible isolates.
|
||||
#' @return Ordered [factor] with new class `<rsi>`
|
||||
#' @aliases rsi
|
||||
#' @export
|
||||
|
||||
Reference in New Issue
Block a user