mirror of
https://github.com/msberends/AMR.git
synced 2025-07-08 22:41:52 +02:00
Replace RSI with SIR
This commit is contained in:
Dr. Matthijs Berends
committed by
GitHub
GitHub
parent
24b12024ce
commit
98e62c9af2
248
R/mdro.R
248
R/mdro.R
@ -127,7 +127,7 @@
|
||||
#' ```
|
||||
#'
|
||||
#' The rules set (the `custom` object in this case) could be exported to a shared file location using [saveRDS()] if you collaborate with multiple users. The custom rules set could then be imported using [readRDS()].
|
||||
#' @inheritSection as.rsi Interpretation of R and S/I
|
||||
#' @inheritSection as.sir Interpretation of SIR
|
||||
#' @return
|
||||
#' - CMI 2012 paper - function [mdr_cmi2012()] or [mdro()]:\cr
|
||||
#' Ordered [factor] with levels `Negative` < `Multi-drug-resistant (MDR)` < `Extensively drug-resistant (XDR)` < `Pandrug-resistant (PDR)`
|
||||
@ -175,7 +175,7 @@ mdro <- function(x = NULL,
|
||||
pct_required_classes = 0.5,
|
||||
combine_SI = TRUE,
|
||||
verbose = FALSE,
|
||||
only_rsi_columns = FALSE,
|
||||
only_sir_columns = FALSE,
|
||||
...) {
|
||||
if (is_null_or_grouped_tbl(x)) {
|
||||
# when `x` is left blank, auto determine it (get_current_data() also contains dplyr::cur_data_all())
|
||||
@ -192,10 +192,10 @@ mdro <- function(x = NULL,
|
||||
meet_criteria(pct_required_classes, allow_class = "numeric", has_length = 1)
|
||||
meet_criteria(combine_SI, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(verbose, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(only_rsi_columns, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
|
||||
|
||||
if (!any(is.rsi.eligible(x))) {
|
||||
stop_("There were no possible R/SI columns found in the data set. Transform columns with `as.rsi()` for valid antimicrobial interpretations.")
|
||||
if (!any(is_sir_eligible(x))) {
|
||||
stop_("There were no possible SIR columns found in the data set. Transform columns with `as.sir()` for valid antimicrobial interpretations.")
|
||||
}
|
||||
|
||||
info.bak <- info
|
||||
@ -325,7 +325,7 @@ mdro <- function(x = NULL,
|
||||
"No column found as input for `col_mo`, ",
|
||||
font_bold(paste0("assuming all rows contain ", font_italic("Mycobacterium tuberculosis"), "."))
|
||||
)
|
||||
x$mo <- as.mo("Mycobacterium tuberculosis") # consider overkill at all times: AMR_env$MO_lookup[which(AMR_env$MO_lookup$fullname == "Mycobacterium tuberculosis"), "mo", drop = TRUE]
|
||||
x$mo <- as.mo("Mycobacterium tuberculosis", keep_synonyms = TRUE)
|
||||
col_mo <- "mo"
|
||||
}
|
||||
stop_if(is.null(col_mo), "`col_mo` must be set")
|
||||
@ -382,226 +382,60 @@ mdro <- function(x = NULL,
|
||||
cols_ab <- get_column_abx(
|
||||
x = x,
|
||||
soft_dependencies = c(
|
||||
# [table] 1 (S aureus):
|
||||
"GEN",
|
||||
"RIF",
|
||||
"CPT",
|
||||
"OXA",
|
||||
"CIP",
|
||||
"MFX",
|
||||
"SXT",
|
||||
"FUS",
|
||||
"VAN",
|
||||
"TEC",
|
||||
"TLV",
|
||||
"TGC",
|
||||
"CLI",
|
||||
"DAP",
|
||||
"ERY",
|
||||
"LNZ",
|
||||
"CHL",
|
||||
"FOS",
|
||||
"QDA",
|
||||
"TCY",
|
||||
"DOX",
|
||||
"MNO",
|
||||
# [table] 1 (S aureus)
|
||||
"GEN", "RIF", "CPT", "OXA", "CIP", "MFX", "SXT", "FUS", "VAN", "TEC", "TLV", "TGC", "CLI", "DAP", "ERY", "LNZ", "CHL", "FOS", "QDA", "TCY", "DOX", "MNO",
|
||||
# [table] 2 (Enterococcus)
|
||||
"GEH",
|
||||
"STH",
|
||||
"IPM",
|
||||
"MEM",
|
||||
"DOR",
|
||||
"CIP",
|
||||
"LVX",
|
||||
"MFX",
|
||||
"VAN",
|
||||
"TEC",
|
||||
"TGC",
|
||||
"DAP",
|
||||
"LNZ",
|
||||
"AMP",
|
||||
"QDA",
|
||||
"DOX",
|
||||
"MNO",
|
||||
"GEH", "STH", "IPM", "MEM", "DOR", "CIP", "LVX", "MFX", "VAN", "TEC", "TGC", "DAP", "LNZ", "AMP", "QDA", "DOX", "MNO",
|
||||
# [table] 3 (Enterobacteriaceae)
|
||||
"GEN",
|
||||
"TOB",
|
||||
"AMK",
|
||||
"NET",
|
||||
"CPT",
|
||||
"TCC",
|
||||
"TZP",
|
||||
"ETP",
|
||||
"IPM",
|
||||
"MEM",
|
||||
"DOR",
|
||||
"CZO",
|
||||
"CXM",
|
||||
"CTX",
|
||||
"CAZ",
|
||||
"FEP",
|
||||
"FOX",
|
||||
"CTT",
|
||||
"CIP",
|
||||
"SXT",
|
||||
"TGC",
|
||||
"ATM",
|
||||
"AMP",
|
||||
"AMC",
|
||||
"SAM",
|
||||
"CHL",
|
||||
"FOS",
|
||||
"COL",
|
||||
"TCY",
|
||||
"DOX",
|
||||
"MNO",
|
||||
"GEN", "TOB", "AMK", "NET", "CPT", "TCC", "TZP", "ETP", "IPM", "MEM", "DOR", "CZO", "CXM", "CTX", "CAZ", "FEP", "FOX", "CTT", "CIP", "SXT", "TGC", "ATM", "AMP", "AMC", "SAM", "CHL", "FOS", "COL", "TCY", "DOX", "MNO",
|
||||
# [table] 4 (Pseudomonas)
|
||||
"GEN",
|
||||
"TOB",
|
||||
"AMK",
|
||||
"NET",
|
||||
"IPM",
|
||||
"MEM",
|
||||
"DOR",
|
||||
"CAZ",
|
||||
"FEP",
|
||||
"CIP",
|
||||
"LVX",
|
||||
"TCC",
|
||||
"TZP",
|
||||
"ATM",
|
||||
"FOS",
|
||||
"COL",
|
||||
"PLB",
|
||||
"GEN", "TOB", "AMK", "NET", "IPM", "MEM", "DOR", "CAZ", "FEP", "CIP", "LVX", "TCC", "TZP", "ATM", "FOS", "COL", "PLB",
|
||||
# [table] 5 (Acinetobacter)
|
||||
"GEN",
|
||||
"TOB",
|
||||
"AMK",
|
||||
"NET",
|
||||
"IPM",
|
||||
"MEM",
|
||||
"DOR",
|
||||
"CIP",
|
||||
"LVX",
|
||||
"TZP",
|
||||
"TCC",
|
||||
"CTX",
|
||||
"CRO",
|
||||
"CAZ",
|
||||
"FEP",
|
||||
"SXT",
|
||||
"SAM",
|
||||
"COL",
|
||||
"PLB",
|
||||
"TCY",
|
||||
"DOX",
|
||||
"MNO"
|
||||
"GEN", "TOB", "AMK", "NET", "IPM", "MEM", "DOR", "CIP", "LVX", "TZP", "TCC", "CTX", "CRO", "CAZ", "FEP", "SXT", "SAM", "COL", "PLB", "TCY", "DOX", "MNO"
|
||||
),
|
||||
verbose = verbose,
|
||||
info = info,
|
||||
only_rsi_columns = only_rsi_columns,
|
||||
only_sir_columns = only_sir_columns,
|
||||
fn = "mdro",
|
||||
...
|
||||
)
|
||||
} else if (guideline$code == "eucast3.2") {
|
||||
cols_ab <- get_column_abx(
|
||||
x = x,
|
||||
soft_dependencies = c(
|
||||
"AMP",
|
||||
"AMX",
|
||||
"CIP",
|
||||
"DAL",
|
||||
"DAP",
|
||||
"ERV",
|
||||
"FDX",
|
||||
"GEN",
|
||||
"LNZ",
|
||||
"MEM",
|
||||
"MTR",
|
||||
"OMC",
|
||||
"ORI",
|
||||
"PEN",
|
||||
"QDA",
|
||||
"RIF",
|
||||
"TEC",
|
||||
"TGC",
|
||||
"TLV",
|
||||
"TOB",
|
||||
"TZD",
|
||||
"VAN"
|
||||
),
|
||||
soft_dependencies = c("AMP", "AMX", "CIP", "DAL", "DAP", "ERV", "FDX", "GEN", "LNZ", "MEM", "MTR", "OMC", "ORI", "PEN", "QDA", "RIF", "TEC", "TGC", "TLV", "TOB", "TZD", "VAN"),
|
||||
verbose = verbose,
|
||||
info = info,
|
||||
only_rsi_columns = only_rsi_columns,
|
||||
only_sir_columns = only_sir_columns,
|
||||
fn = "mdro",
|
||||
...
|
||||
)
|
||||
} else if (guideline$code == "eucast3.3") {
|
||||
cols_ab <- get_column_abx(
|
||||
x = x,
|
||||
soft_dependencies = c(
|
||||
"AMP",
|
||||
"AMX",
|
||||
"CIP",
|
||||
"DAL",
|
||||
"DAP",
|
||||
"ERV",
|
||||
"FDX",
|
||||
"GEN",
|
||||
"LNZ",
|
||||
"MEM",
|
||||
"MTR",
|
||||
"OMC",
|
||||
"ORI",
|
||||
"PEN",
|
||||
"QDA",
|
||||
"RIF",
|
||||
"TEC",
|
||||
"TGC",
|
||||
"TLV",
|
||||
"TOB",
|
||||
"TZD",
|
||||
"VAN"
|
||||
),
|
||||
soft_dependencies = c("AMP", "AMX", "CIP", "DAL", "DAP", "ERV", "FDX", "GEN", "LNZ", "MEM", "MTR", "OMC", "ORI", "PEN", "QDA", "RIF", "TEC", "TGC", "TLV", "TOB", "TZD", "VAN"),
|
||||
verbose = verbose,
|
||||
info = info,
|
||||
only_rsi_columns = only_rsi_columns,
|
||||
only_sir_columns = only_sir_columns,
|
||||
fn = "mdro",
|
||||
...
|
||||
)
|
||||
} else if (guideline$code == "tb") {
|
||||
cols_ab <- get_column_abx(
|
||||
x = x,
|
||||
soft_dependencies = c(
|
||||
"CAP",
|
||||
"ETH",
|
||||
"GAT",
|
||||
"INH",
|
||||
"PZA",
|
||||
"RIF",
|
||||
"RIB",
|
||||
"RFP"
|
||||
),
|
||||
soft_dependencies = c("CAP", "ETH", "GAT", "INH", "PZA", "RIF", "RIB", "RFP"),
|
||||
verbose = verbose,
|
||||
info = info,
|
||||
only_rsi_columns = only_rsi_columns,
|
||||
only_sir_columns = only_sir_columns,
|
||||
fn = "mdro",
|
||||
...
|
||||
)
|
||||
} else if (guideline$code == "mrgn") {
|
||||
cols_ab <- get_column_abx(
|
||||
x = x,
|
||||
soft_dependencies = c(
|
||||
"PIP",
|
||||
"CTX",
|
||||
"CAZ",
|
||||
"IPM",
|
||||
"MEM",
|
||||
"CIP"
|
||||
),
|
||||
soft_dependencies = c("PIP", "CTX", "CAZ", "IPM", "MEM", "CIP"),
|
||||
verbose = verbose,
|
||||
info = info,
|
||||
only_rsi_columns = only_rsi_columns,
|
||||
only_sir_columns = only_sir_columns,
|
||||
fn = "mdro",
|
||||
...
|
||||
)
|
||||
@ -610,7 +444,7 @@ mdro <- function(x = NULL,
|
||||
x = x,
|
||||
verbose = verbose,
|
||||
info = info,
|
||||
only_rsi_columns = only_rsi_columns,
|
||||
only_sir_columns = only_sir_columns,
|
||||
fn = "mdro",
|
||||
...
|
||||
)
|
||||
@ -823,7 +657,7 @@ mdro <- function(x = NULL,
|
||||
if (length(rows) > 0 && length(cols) > 0) {
|
||||
x[, cols] <- as.data.frame(lapply(
|
||||
x[, cols, drop = FALSE],
|
||||
function(col) as.rsi(col)
|
||||
function(col) as.sir(col)
|
||||
),
|
||||
stringsAsFactors = FALSE
|
||||
)
|
||||
@ -883,7 +717,7 @@ mdro <- function(x = NULL,
|
||||
|
||||
x[, lst_vector] <- as.data.frame(lapply(
|
||||
x[, lst_vector, drop = FALSE],
|
||||
function(col) as.rsi(col)
|
||||
function(col) as.sir(col)
|
||||
),
|
||||
stringsAsFactors = FALSE
|
||||
)
|
||||
@ -1675,7 +1509,7 @@ mdro <- function(x = NULL,
|
||||
ab <- x[, ab, drop = TRUE]
|
||||
}
|
||||
}
|
||||
ab <- as.character(as.rsi(ab))
|
||||
ab <- as.character(as.sir(ab))
|
||||
ab[is.na(ab)] <- ""
|
||||
ab
|
||||
}
|
||||
@ -1998,7 +1832,7 @@ run_custom_mdro_guideline <- function(df, guideline, info) {
|
||||
out <- factor(out, levels = attributes(guideline)$values, ordered = TRUE)
|
||||
}
|
||||
|
||||
columns_nonsusceptible <- as.data.frame(t(df[, is.rsi(df), drop = FALSE] == "R"))
|
||||
columns_nonsusceptible <- as.data.frame(t(df[, is.sir(df), drop = FALSE] == "R"))
|
||||
columns_nonsusceptible <- vapply(
|
||||
FUN.VALUE = character(1),
|
||||
columns_nonsusceptible,
|
||||
@ -2017,60 +1851,60 @@ run_custom_mdro_guideline <- function(df, guideline, info) {
|
||||
|
||||
#' @rdname mdro
|
||||
#' @export
|
||||
brmo <- function(x = NULL, only_rsi_columns = FALSE, ...) {
|
||||
brmo <- function(x = NULL, only_sir_columns = FALSE, ...) {
|
||||
meet_criteria(x, allow_class = "data.frame", allow_NULL = TRUE)
|
||||
meet_criteria(only_rsi_columns, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
|
||||
stop_if(
|
||||
"guideline" %in% names(list(...)),
|
||||
"argument `guideline` must not be set since this is a guideline-specific function"
|
||||
)
|
||||
mdro(x = x, only_rsi_columns = only_rsi_columns, guideline = "BRMO", ...)
|
||||
mdro(x = x, only_sir_columns = only_sir_columns, guideline = "BRMO", ...)
|
||||
}
|
||||
|
||||
#' @rdname mdro
|
||||
#' @export
|
||||
mrgn <- function(x = NULL, only_rsi_columns = FALSE, ...) {
|
||||
mrgn <- function(x = NULL, only_sir_columns = FALSE, ...) {
|
||||
meet_criteria(x, allow_class = "data.frame", allow_NULL = TRUE)
|
||||
meet_criteria(only_rsi_columns, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
|
||||
stop_if(
|
||||
"guideline" %in% names(list(...)),
|
||||
"argument `guideline` must not be set since this is a guideline-specific function"
|
||||
)
|
||||
mdro(x = x, only_rsi_columns = only_rsi_columns, guideline = "MRGN", ...)
|
||||
mdro(x = x, only_sir_columns = only_sir_columns, guideline = "MRGN", ...)
|
||||
}
|
||||
|
||||
#' @rdname mdro
|
||||
#' @export
|
||||
mdr_tb <- function(x = NULL, only_rsi_columns = FALSE, ...) {
|
||||
mdr_tb <- function(x = NULL, only_sir_columns = FALSE, ...) {
|
||||
meet_criteria(x, allow_class = "data.frame", allow_NULL = TRUE)
|
||||
meet_criteria(only_rsi_columns, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
|
||||
stop_if(
|
||||
"guideline" %in% names(list(...)),
|
||||
"argument `guideline` must not be set since this is a guideline-specific function"
|
||||
)
|
||||
mdro(x = x, only_rsi_columns = only_rsi_columns, guideline = "TB", ...)
|
||||
mdro(x = x, only_sir_columns = only_sir_columns, guideline = "TB", ...)
|
||||
}
|
||||
|
||||
#' @rdname mdro
|
||||
#' @export
|
||||
mdr_cmi2012 <- function(x = NULL, only_rsi_columns = FALSE, ...) {
|
||||
mdr_cmi2012 <- function(x = NULL, only_sir_columns = FALSE, ...) {
|
||||
meet_criteria(x, allow_class = "data.frame", allow_NULL = TRUE)
|
||||
meet_criteria(only_rsi_columns, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
|
||||
stop_if(
|
||||
"guideline" %in% names(list(...)),
|
||||
"argument `guideline` must not be set since this is a guideline-specific function"
|
||||
)
|
||||
mdro(x = x, only_rsi_columns = only_rsi_columns, guideline = "CMI2012", ...)
|
||||
mdro(x = x, only_sir_columns = only_sir_columns, guideline = "CMI2012", ...)
|
||||
}
|
||||
|
||||
#' @rdname mdro
|
||||
#' @export
|
||||
eucast_exceptional_phenotypes <- function(x = NULL, only_rsi_columns = FALSE, ...) {
|
||||
eucast_exceptional_phenotypes <- function(x = NULL, only_sir_columns = FALSE, ...) {
|
||||
meet_criteria(x, allow_class = "data.frame", allow_NULL = TRUE)
|
||||
meet_criteria(only_rsi_columns, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
|
||||
stop_if(
|
||||
"guideline" %in% names(list(...)),
|
||||
"argument `guideline` must not be set since this is a guideline-specific function"
|
||||
)
|
||||
mdro(x = x, only_rsi_columns = only_rsi_columns, guideline = "EUCAST", ...)
|
||||
mdro(x = x, only_sir_columns = only_sir_columns, guideline = "EUCAST", ...)
|
||||
}
|
||||
|
||||
Reference in New Issue
Block a user