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

(v1.6.0.9010) big first_isolate() update

Browse Source
This commit is contained in:
dr. M.S. (Matthijs) Berends
2021-04-26 23:57:37 +02:00
parent 5f9e7bd3ee
commit 93683a4ae2
38 changed files with 1134 additions and 933 deletions
Download Patch File Download Diff File Expand all files Collapse all files

12
R/aa_helper_functions.R
View File

@ -190,8 +190,8 @@ search_type_in_df <- function(x, type, info = TRUE) {
}
# -- key antibiotics
if (type == "keyantibiotics") {
if (any(colnames(x) %like% "^key.*(ab|antibiotics)")) {
found <- sort(colnames(x)[colnames(x) %like% "^key.*(ab|antibiotics)"])[1]
if (any(colnames(x) %like% "^key.*(ab|antibiotics|antimicrobials)")) {
found <- sort(colnames(x)[colnames(x) %like% "^key.*(ab|antibiotics|antimicrobials)"])[1]
}
}
# -- date
@ -318,7 +318,9 @@ word_wrap <- function(...,
msg <- paste0(c(...), collapse = "")
if (isTRUE(as_note)) {
msg <- paste0("NOTE: ", gsub("^note:? ?", "", msg, ignore.case = TRUE))
# \u2139 is a symbol officially named 'information source'
# \ufe0f can add the blue square around it: \u2139\ufe0f
msg <- paste0("\u2139 ", gsub("^note:? ?", "", msg, ignore.case = TRUE))
}
if (msg %like% "\n") {
@ -352,8 +354,8 @@ word_wrap <- function(...,
msg <- paste0(msg, collapse = " ")
msg <- gsub("\n ", "\n", msg, fixed = TRUE)
if (msg_stripped %like% "^NOTE: ") {
indentation <- 6 + extra_indent
if (msg_stripped %like% "\u2139 ") {
indentation <- 2 + extra_indent
} else if (msg_stripped %like% "^=> ") {
indentation <- 3 + extra_indent
} else {

68
R/deprecated.R
View File

@ -45,3 +45,71 @@ p_symbol <- function(p, emptychar = " ") {
s
}
#' @name AMR-deprecated
#' @export
key_antibiotics <- function(x = NULL,
col_mo = NULL,
universal_1 = guess_ab_col(x, "amoxicillin"),
universal_2 = guess_ab_col(x, "amoxicillin/clavulanic acid"),
universal_3 = guess_ab_col(x, "cefuroxime"),
universal_4 = guess_ab_col(x, "piperacillin/tazobactam"),
universal_5 = guess_ab_col(x, "ciprofloxacin"),
universal_6 = guess_ab_col(x, "trimethoprim/sulfamethoxazole"),
GramPos_1 = guess_ab_col(x, "vancomycin"),
GramPos_2 = guess_ab_col(x, "teicoplanin"),
GramPos_3 = guess_ab_col(x, "tetracycline"),
GramPos_4 = guess_ab_col(x, "erythromycin"),
GramPos_5 = guess_ab_col(x, "oxacillin"),
GramPos_6 = guess_ab_col(x, "rifampin"),
GramNeg_1 = guess_ab_col(x, "gentamicin"),
GramNeg_2 = guess_ab_col(x, "tobramycin"),
GramNeg_3 = guess_ab_col(x, "colistin"),
GramNeg_4 = guess_ab_col(x, "cefotaxime"),
GramNeg_5 = guess_ab_col(x, "ceftazidime"),
GramNeg_6 = guess_ab_col(x, "meropenem"),
warnings = TRUE,
...) {
.Deprecated(old = "key_antibiotics()",
new = "key_antimicrobials()",
package = "AMR")
if (is_null_or_grouped_tbl(x)) {
# when `x` is left blank, auto determine it (get_current_data() also contains dplyr::cur_data_all())
# is also fix for using a grouped df as input (a dot as first argument)
x <- tryCatch(get_current_data(arg_name = "x", call = -2), error = function(e) x)
}
key_antimicrobials(x = x,
col_mo = col_mo,
universal = c(universal_1, universal_2, universal_3, universal_4, universal_5, universal_6),
gram_negative = c(GramNeg_1, GramNeg_2, GramNeg_3, GramNeg_4, GramNeg_5, GramNeg_6),
gram_positive = c(GramPos_1, GramPos_2, GramPos_3, GramPos_4, GramPos_5, GramPos_6),
antifungal = NULL,
only_rsi_columns = FALSE,
...)
}
#' @name AMR-deprecated
#' @export
key_antibiotics_equal <- function(y,
z,
type = "keyantimicrobials",
ignore_I = TRUE,
points_threshold = 2,
info = FALSE,
na.rm = TRUE,
...) {
.Deprecated(old = "key_antibiotics_equal()",
new = "antimicrobials_equal()",
package = "AMR")
antimicrobials_equal(y = y,
z = z,
type = type,
ignore_I = ignore_I,
points_threshold = points_threshold,
info = info)
}

278
R/first_isolate.R
View File

@ -34,62 +34,91 @@
#' @param col_testcode column name of the test codes. Use `col_testcode = NULL` to **not** exclude certain test codes (such as test codes for screening). In that case `testcodes_exclude` will be ignored.
#' @param col_specimen column name of the specimen type or group
#' @param col_icu column name of the logicals (`TRUE`/`FALSE`) whether a ward or department is an Intensive Care Unit (ICU)
#' @param col_keyantibiotics column name of the key antibiotics to determine first (weighted) isolates, see [key_antibiotics()]. Defaults to the first column that starts with 'key' followed by 'ab' or 'antibiotics' (case insensitive). Use `col_keyantibiotics = FALSE` to prevent this. Can also be the output of [key_antibiotics()].
#' @param col_keyantimicrobials (only useful when `method = "phenotype-based"`) column name of the key antimicrobials to determine first (weighted) isolates, see [key_antimicrobials()]. Defaults to the first column that starts with 'key' followed by 'ab' or 'antibiotics' or 'antimicrobials' (case insensitive). Use `col_keyantimicrobials = FALSE` to prevent this. Can also be the output of [key_antimicrobials()].
#' @param episode_days episode in days after which a genus/species combination will be determined as 'first isolate' again. The default of 365 days is based on the guideline by CLSI, see *Source*.
#' @param testcodes_exclude character vector with test codes that should be excluded (case-insensitive)
#' @param icu_exclude logical to indicate whether ICU isolates should be excluded (rows with value `TRUE` in the column set with `col_icu`)
#' @param specimen_group value in the column set with `col_specimen` to filter on
#' @param type type to determine weighed isolates; can be `"keyantibiotics"` or `"points"`, see *Details*
#' @param ignore_I logical to indicate whether antibiotic interpretations with `"I"` will be ignored when `type = "keyantibiotics"`, see *Details*
#' @param points_threshold points until the comparison of key antibiotics will lead to inclusion of an isolate when `type = "points"`, see *Details*
#' @param type type to determine weighed isolates; can be `"keyantimicrobials"` or `"points"`, see *Details*
#' @param method the algorithm to apply, either `"phenotype-based"`, `"episode-based"`, `"patient-based"` or `"isolate-based"` (can be abbreviated), see *Details*
#' @param ignore_I logical to indicate whether antibiotic interpretations with `"I"` will be ignored when `type = "keyantimicrobials"`, see *Details*
#' @param points_threshold minimum number of points to require before differences in the antibiogram will lead to inclusion of an isolate when `type = "points"`, see *Details*
#' @param info a [logical] to indicate info should be printed, defaults to `TRUE` only in interactive mode
#' @param include_unknown logical to indicate whether 'unknown' microorganisms should be included too, i.e. microbial code `"UNKNOWN"`, which defaults to `FALSE`. For WHONET users, this means that all records with organism code `"con"` (*contamination*) will be excluded at default. Isolates with a microbial ID of `NA` will always be excluded as first isolate.
#' @param include_untested_rsi logical to indicate whether also rows without antibiotic results are still eligible for becoming a first isolate. Use `include_untested_rsi = FALSE` to always return `FALSE` for such rows. This checks the data set for columns of class `<rsi>` and consequently requires transforming columns with antibiotic results using [as.rsi()] first.
#' @param ... arguments passed on to [first_isolate()] when using [filter_first_isolate()], or arguments passed on to [key_antibiotics()] when using [filter_first_weighted_isolate()]
#' @param ... arguments passed on to [first_isolate()] when using [filter_first_isolate()], or arguments passed on to [key_antimicrobials()] otherwise (such as `universal`, `gram_negative`, `gram_positive`)
#' @details
#' To conduct epidemiological analyses on antimicrobial resistance data, only so-called first isolates should be included to prevent overestimation and underestimation of antimicrobial resistance. Different algorithms can be used to do so, see below.
#'
#' These functions are context-aware. This means that then the `x` argument can be left blank, see *Examples*.
#'
#' The [first_isolate()] function is a wrapper around the [is_new_episode()] function, but more efficient for data sets containing microorganism codes or names.
#'
#' All isolates with a microbial ID of `NA` will be excluded as first isolate.
#'
#' ## Why this is so Important
#' To conduct an analysis of antimicrobial resistance, you should only include the first isolate of every patient per episode [(Hindler *et al.* 2007)](https://pubmed.ncbi.nlm.nih.gov/17304462/). If you would not do this, you could easily get an overestimate or underestimate of the resistance of an antibiotic. Imagine that a patient was admitted with an MRSA and that it was found in 5 different blood cultures the following week. The resistance percentage of oxacillin of all *S. aureus* isolates would be overestimated, because you included this MRSA more than once. It would be [selection bias](https://en.wikipedia.org/wiki/Selection_bias).
#'
#' ## `filter_*()` Shortcuts
#'
#' The functions [filter_first_isolate()] and [filter_first_weighted_isolate()] are helper functions to quickly filter on first isolates.
#' ## Different algorithms
#'
#' The function [filter_first_isolate()] is essentially equal to either:
#' According to Hindler *et al.* (2007, \doi{10.1086/511864}), there are different algorithms to select first isolates with increasing reliability: isolate-based, patient-based, episode-based and phenotype-based. All algorithms select on a combination of the taxonomic genus and species (not subspecies).
#'
#' ```
#' x[first_isolate(x, ...), ]
#'
#' x %>% filter(first_isolate(...))
#' ```
#' All mentioned algorithms are covered in the [first_isolate()] function:
#'
#' The function [filter_first_weighted_isolate()] is essentially equal to:
#'
#' ```
#' x %>%
#' mutate(keyab = key_antibiotics(.)) %>%
#' mutate(only_weighted_firsts = first_isolate(x,
#' col_keyantibiotics = "keyab", ...)) %>%
#' filter(only_weighted_firsts == TRUE) %>%
#' select(-only_weighted_firsts, -keyab)
#' ```
#' @section Key Antibiotics:
#' There are two ways to determine whether isolates can be included as first weighted isolates which will give generally the same results:
#'
#' 1. Using `type = "keyantibiotics"` and argument `ignore_I`
#' | **Algorithm** | **Function to apply** |
#' |--------------------------------------------------|-------------------------------------------------------|
#' | Isolate-based | `first_isolate(x, method = "isolate-based")` |
#' | *(= all isolates)* | |
#' | | |
#' | | |
#' | Patient-based | `first_isolate(x, method = "patient-based")` |
#' | *(= first isolate per patient)* | |
#' | | |
#' | | |
#' | Episode-based | `first_isolate(x, method = "episode-based")`, or: |
#' | *(= first isolate per episode)* | |
#' | - 7-Day interval from initial isolate | - `first_isolate(x, method = "e", episode_days = 7)` |
#' | - 30-Day interval from initial isolate | - `first_isolate(x, method = "e", episode_days = 30)` |
#' | | |
#' | | |
#' | Phenotype-based | `first_isolate(x, method = "phenotype-based")`, or: |
#' | *(= first isolate per phenotype)* | |
#' | - Major difference in any antimicrobial result | - `first_isolate(x, type = "points")` |
#' | - Any difference in key antimicrobial results | - `first_isolate(x, type = "keyantimicrobials")` |
#'
#' Any difference from S to R (or vice versa) will (re)select an isolate as a first weighted isolate. With `ignore_I = FALSE`, also differences from I to S|R (or vice versa) will lead to this. This is a reliable method and 30-35 times faster than method 2. Read more about this in the [key_antibiotics()] function.
#' ### Isolate-based
#'
#' This algorithm does not require any selection, as all isolates should be included. It does, however, respect all arguments set in the [first_isolate()] function. For example, the default setting for `include_unknown` (`FALSE`) will omit selection of rows without a microbial ID.
#'
#' ### Patient-based
#'
#' To include every genus-species combination per patient once, set the `episode_days` to `Inf`. Although often inappropriate, this algorithm makes sure that no duplicate isolates are selected from the same patient.
#'
#' ### Episode-based
#'
#' To include every genus-species combination per patient episode once, set the `episode_days` to a sensible number of days. Depending on the type of analysis, this could be 14, 30, 60 or 365. Short episodes are common for analysing specific hospital or ward data, long episodes are common for analysing regional and national data.
#'
#' This is the most common algorithm to correct for duplicate isolates. Patients are categorised into episodes based on their ID and dates (e.g., the date of specimen receipt or laboratory result). While this is a common algorithm, it does not take into account antimicrobial test results. This means that e.g. a methicillin-resistant *Staphylococcus aureus* (MRSA) isolate cannot be differentiated from a wildtype *Staphylococcus aureus* isolate.
#'
#' ### Phenotype-based
#'
#' This is a more reliable algorithm, since it also *weighs* the antibiogram (antimicrobial test results) yielding so-called 'first weighted isolates'. There are two different methods to weigh the antibiogram:
#'
#' 1. Using `type = "points"` and argument `points_threshold`
#'
#' This method weighs *all* antimicrobial agents available in the data set. Any difference from I to S or R (or vice versa) counts as 0.5 points, a difference from S to R (or vice versa) counts as 1 point. When the sum of points exceeds `points_threshold`, which defaults to `2`, an isolate will be selected as a first weighted isolate.
#'
#' 2. Using `type = "points"` and argument `points_threshold`
#' All antimicrobials are internally selected using the [all_antimicrobials()] function. The output of this function does not need to be passed to the [first_isolate()] function.
#'
#' A difference from I to S|R (or vice versa) means 0.5 points, a difference from S to R (or vice versa) means 1 point. When the sum of points exceeds `points_threshold`, which defaults to `2`, an isolate will be (re)selected as a first weighted isolate.
#'
#' 2. Using `type = "keyantimicrobials"` and argument `ignore_I`
#'
#' This method only weighs specific antimicrobial agents, called *key antimicrobials*. Any difference from S to R (or vice versa) in these key antimicrobials will select an isolate as a first weighted isolate. With `ignore_I = FALSE`, also differences from I to S or R (or vice versa) will lead to this.
#'
#' Key antimicrobials are internally selected using the [key_antimicrobials()] function, but can also be added manually as a variable to the data and set in the `col_keyantimicrobials` argument. Another option is to pass the output of the [key_antimicrobials()] function directly to the `col_keyantimicrobials` argument.
#'
#'
#' The default algorithm is phenotype-based (using `type = "points"`) and episode-based (using `episode_days = 365`). This makes sure that every genus-species combination is selected per patient once per year, while taking into account all antimicrobial test results.
#' @rdname first_isolate
#' @seealso [key_antibiotics()]
#' @seealso [key_antimicrobials()]
#' @export
#' @return A [`logical`] vector
#' @source Methodology of this function is strictly based on:
@ -101,7 +130,6 @@
#' # See ?example_isolates.
#'
#' example_isolates[first_isolate(example_isolates), ]
#'
#' \donttest{
#' # faster way, only works in R 3.2 and later:
#' example_isolates[first_isolate(), ]
@ -139,7 +167,7 @@
#'
#' # Have a look at A and B.
#' # B is more reliable because every isolate is counted only once.
#' # Gentamicin resistance in hospital D appears to be 3.7% higher than
#' # Gentamicin resistance in hospital D appears to be 4.2% higher than
#' # when you (erroneously) would have used all isolates for analysis.
#' }
#' }
@ -150,18 +178,32 @@ first_isolate <- function(x = NULL,
col_testcode = NULL,
col_specimen = NULL,
col_icu = NULL,
col_keyantibiotics = NULL,
col_keyantimicrobials = NULL,
episode_days = 365,
testcodes_exclude = NULL,
icu_exclude = FALSE,
specimen_group = NULL,
type = "keyantibiotics",
type = "points",
method = c("phenotype-based", "episode-based", "patient-based", "isolate-based"),
ignore_I = TRUE,
points_threshold = 2,
info = interactive(),
include_unknown = FALSE,
include_untested_rsi = TRUE,
...) {
dots <- unlist(list(...))
if (length(dots) != 0) {
# backwards compatibility with old arguments
dots.names <- names(dots)
if ("filter_specimen" %in% dots.names) {
specimen_group <- dots[which(dots.names == "filter_specimen")]
}
if ("col_keyantibiotics" %in% dots.names) {
col_keyantimicrobials <- dots[which(dots.names == "col_keyantibiotics")]
}
}
if (is_null_or_grouped_tbl(x)) {
# when `x` is left blank, auto determine it (get_current_data() also contains dplyr::cur_data_all())
# is also fix for using a grouped df as input (a dot as first argument)
@ -177,15 +219,25 @@ first_isolate <- function(x = NULL,
}
meet_criteria(col_specimen, allow_class = "character", has_length = 1, allow_NULL = TRUE, is_in = colnames(x))
meet_criteria(col_icu, allow_class = "character", has_length = 1, allow_NULL = TRUE, is_in = colnames(x))
if (length(col_keyantibiotics) > 1) {
meet_criteria(col_keyantibiotics, allow_class = "character", has_length = nrow(x))
x$keyabcol <- col_keyantibiotics
col_keyantibiotics <- "keyabcol"
# method
if (missing(method)) {
method <- method[1L]
}
meet_criteria(method, allow_class = "character", has_length = 1, is_in = c("phenotype-based", "episode-based", "patient-based", "isolate-based", "p", "e", "i"))
# key antimicrobials
if (length(col_keyantimicrobials) > 1) {
meet_criteria(col_keyantimicrobials, allow_class = "character", has_length = nrow(x))
x$keyabcol <- col_keyantimicrobials
col_keyantimicrobials <- "keyabcol"
} else {
if (isFALSE(col_keyantibiotics)) {
col_keyantibiotics <- NULL
if (isFALSE(col_keyantimicrobials)) {
col_keyantimicrobials <- NULL
# method cannot be phenotype-based anymore
if (method %in% c("phenotype-based", "p")) {
method <- "episode-based"
}
}
meet_criteria(col_keyantibiotics, allow_class = "character", has_length = 1, allow_NULL = TRUE, is_in = colnames(x))
meet_criteria(col_keyantimicrobials, allow_class = "character", has_length = 1, allow_NULL = TRUE, is_in = colnames(x))
}
meet_criteria(episode_days, allow_class = c("numeric", "integer"), has_length = 1, is_positive = TRUE, is_finite = FALSE)
meet_criteria(testcodes_exclude, allow_class = "character", allow_NULL = TRUE)
@ -198,21 +250,23 @@ first_isolate <- function(x = NULL,
meet_criteria(include_unknown, allow_class = "logical", has_length = 1)
meet_criteria(include_untested_rsi, allow_class = "logical", has_length = 1)
method[method == "p"] <- "phenotype-based"
method[method == "e"] <- "episode-based"
method[method == "i"] <- "isolate-based"
if (info == TRUE) {
message_(paste0("Determining first isolates using the '", font_bold(method), "' method",
ifelse(method %in% c("episode-based", "phenotype-based"),
ifelse(is.infinite(episode_days),
" without a specified episode length",
paste(" and an episode length of", episode_days, "days")),
"")),
as_note = FALSE,
add_fn = font_black)
}
# remove data.table, grouping from tibbles, etc.
x <- as.data.frame(x, stringsAsFactors = FALSE)
dots <- unlist(list(...))
if (length(dots) != 0) {
# backwards compatibility with old arguments
dots.names <- names(dots)
if ("filter_specimen" %in% dots.names) {
specimen_group <- dots[which(dots.names == "filter_specimen")]
}
if ("tbl" %in% dots.names) {
x <- dots[which(dots.names == "tbl")]
}
}
# try to find columns based on type
# -- mo
if (is.null(col_mo)) {
@ -220,6 +274,37 @@ first_isolate <- function(x = NULL,
stop_if(is.null(col_mo), "`col_mo` must be set")
}
# methods ----
if (method == "isolate-based") {
episode_days <- Inf
col_keyantimicrobials <- NULL
x$dummy_dates <- Sys.Date()
col_date <- "dummy_dates"
x$dummy_patients <- paste("dummy", seq_len(nrow(x))) # all 'patients' must be unique
col_patient_id <- "dummy_patients"
} else if (method == "patient-based") {
episode_days <- Inf
col_keyantimicrobials <- NULL
} else if (method == "episode-based") {
col_keyantimicrobials <- NULL
} else if (method == "phenotype-based") {
if (missing(type) & !is.null(col_keyantimicrobials)) {
# type = "points" is default, but not set explicitly, while col_keyantimicrobials is
type <- "keyantimicrobials"
}
if (type == "points") {
x$keyantimicrobials <- all_antimicrobials(x, only_rsi_columns = FALSE)
col_keyantimicrobials <- "keyantimicrobials"
} else if (type == "keyantimicrobials" & is.null(col_keyantimicrobials)) {
col_keyantimicrobials <- search_type_in_df(x = x, type = "keyantibiotics")
if (is.null(col_keyantimicrobials)) {
# still not found as a column, create it ourselves
x$keyantimicrobials <- key_antimicrobials(x, only_rsi_columns = FALSE, col_mo = col_mo, ...)
col_keyantimicrobials <- "keyantimicrobials"
}
}
}
# -- date
if (is.null(col_date)) {
col_date <- search_type_in_df(x = x, type = "date")
@ -238,11 +323,6 @@ first_isolate <- function(x = NULL,
}
stop_if(is.null(col_patient_id), "`col_patient_id` must be set")
}
# -- key antibiotics
if (is.null(col_keyantibiotics)) {
col_keyantibiotics <- search_type_in_df(x = x, type = "keyantibiotics")
}
# -- specimen
if (is.null(col_specimen) & !is.null(specimen_group)) {
@ -262,7 +342,7 @@ first_isolate <- function(x = NULL,
check_columns_existance(col_mo)
check_columns_existance(col_testcode)
check_columns_existance(col_icu)
check_columns_existance(col_keyantibiotics)
check_columns_existance(col_keyantimicrobials)
# convert dates to Date
dates <- as.Date(x[, col_date, drop = TRUE])
@ -281,7 +361,7 @@ first_isolate <- function(x = NULL,
}
# remove testcodes
if (!is.null(testcodes_exclude) & info == TRUE) {
message_("[Criterion] Exclude test codes: ", toString(paste0("'", testcodes_exclude, "'")),
message_("Excluding test codes: ", toString(paste0("'", testcodes_exclude, "'")),
add_fn = font_black,
as_note = FALSE)
}
@ -294,13 +374,13 @@ first_isolate <- function(x = NULL,
if (!is.null(specimen_group)) {
check_columns_existance(col_specimen, x)
if (info == TRUE) {
message_("[Criterion] Exclude other than specimen group '", specimen_group, "'",
message_("Excluding other than specimen group '", specimen_group, "'",
add_fn = font_black,
as_note = FALSE)
}
}
if (!is.null(col_keyantibiotics)) {
x$newvar_key_ab <- x[, col_keyantibiotics, drop = TRUE]
if (!is.null(col_keyantimicrobials)) {
x$newvar_key_ab <- x[, col_keyantimicrobials, drop = TRUE]
}
if (is.null(testcodes_exclude)) {
@ -341,7 +421,7 @@ first_isolate <- function(x = NULL,
}
if (row.start == row.end) {
if (info == TRUE) {
message_("=> Found ", font_bold("1 isolate"), ", as the data only contained 1 row",
message_("=> Found ", font_bold("1 first isolate"), ", as the data only contained 1 row",
add_fn = font_black,
as_note = FALSE)
}
@ -349,7 +429,7 @@ first_isolate <- function(x = NULL,
}
if (length(c(row.start:row.end)) == pm_n_distinct(x[c(row.start:row.end), col_mo, drop = TRUE])) {
if (info == TRUE) {
message_("=> Found ", font_bold(paste(length(c(row.start:row.end)), "isolates")),
message_("=> Found ", font_bold(paste(length(c(row.start:row.end)), "first isolates")),
", as all isolates were different microorganisms",
add_fn = font_black,
as_note = FALSE)
@ -378,18 +458,18 @@ first_isolate <- function(x = NULL,
}))
weighted.notice <- ""
if (!is.null(col_keyantibiotics)) {
if (!is.null(col_keyantimicrobials)) {
weighted.notice <- "weighted "
if (info == TRUE) {
if (type == "keyantibiotics") {
message_("[Criterion] Base inclusion on key antibiotics, ",
if (type == "keyantimicrobials") {
message_("Basing inclusion on key antimicrobials, ",
ifelse(ignore_I == FALSE, "not ", ""),
"ignoring I",
add_fn = font_black,
as_note = FALSE)
}
if (type == "points") {
message_("[Criterion] Base inclusion on key antibiotics, using points threshold of "
message_("Basing inclusion on all antimicrobial results, using a points threshold of "
, points_threshold,
add_fn = font_black,
as_note = FALSE)
@ -397,12 +477,12 @@ first_isolate <- function(x = NULL,
}
type_param <- type
x$other_key_ab <- !key_antibiotics_equal(y = x$newvar_key_ab,
z = pm_lag(x$newvar_key_ab),
type = type_param,
ignore_I = ignore_I,
points_threshold = points_threshold,
na.rm = TRUE)
x$other_key_ab <- !antimicrobials_equal(y = x$newvar_key_ab,
z = pm_lag(x$newvar_key_ab),
type = type_param,
ignore_I = ignore_I,
points_threshold = points_threshold,
na.rm = TRUE)
# with key antibiotics
x$newvar_first_isolate <- pm_if_else(x$newvar_row_index_sorted >= row.start &
x$newvar_row_index_sorted <= row.end &
@ -429,12 +509,12 @@ first_isolate <- function(x = NULL,
}
if (!is.null(col_icu)) {
if (icu_exclude == TRUE) {
message_("[Criterion] Exclude isolates from ICU.",
message_("Excluding isolates from ICU.",
add_fn = font_black,
as_note = FALSE)
x[which(as.logical(x[, col_icu, drop = TRUE])), "newvar_first_isolate"] <- FALSE
} else {
message_("[Criterion] Include isolates from ICU.",
message_("Including isolates from ICU.",
add_fn = font_black,
as_note = FALSE)
}
@ -459,7 +539,8 @@ first_isolate <- function(x = NULL,
paste0('"', x, '"')
}
})
cat("\nGroup: ", paste0(names(group), " = ", group, collapse = ", "), "\n", sep = "")
message_("\nGroup: ", paste0(names(group), " = ", group, collapse = ", "), "\n",
as_note = FALSE)
}
}
}
@ -508,11 +589,11 @@ first_isolate <- function(x = NULL,
if (p_found_total != p_found_scope) {
msg_txt <- paste0("=> Found ",
font_bold(paste0(n_found, " first ", weighted.notice, "isolates")),
" (", p_found_scope, " within scope and ", p_found_total, " of total where a microbial ID was available)")
" (", method, ", ", p_found_scope, " within scope and ", p_found_total, " of total where a microbial ID was available)")
} else {
msg_txt <- paste0("=> Found ",
font_bold(paste0(n_found, " first ", weighted.notice, "isolates")),
" (", p_found_total, " of total where a microbial ID was available)")
" (", method, ", ", p_found_total, " of total where a microbial ID was available)")
}
message_(msg_txt, add_fn = font_black, as_note = FALSE)
}
@ -527,6 +608,7 @@ filter_first_isolate <- function(x = NULL,
col_date = NULL,
col_patient_id = NULL,
col_mo = NULL,
method = "episode-based",
...) {
if (is_null_or_grouped_tbl(x)) {
# when `x` is left blank, auto determine it (get_current_data() also contains dplyr::cur_data_all())
@ -537,11 +619,13 @@ filter_first_isolate <- function(x = NULL,
meet_criteria(col_date, allow_class = "character", has_length = 1, allow_NULL = TRUE, is_in = colnames(x))
meet_criteria(col_patient_id, allow_class = "character", has_length = 1, allow_NULL = TRUE, is_in = colnames(x))
meet_criteria(col_mo, allow_class = "character", has_length = 1, allow_NULL = TRUE, is_in = colnames(x))
meet_criteria(method, allow_class = "character", has_length = 1, is_in = c("phenotype-based", "episode-based", "patient-based", "isolate-based"))
subset(x, first_isolate(x = x,
col_date = col_date,
col_patient_id = col_patient_id,
col_mo = col_mo,
method = method,
...))
}
@ -551,7 +635,7 @@ filter_first_weighted_isolate <- function(x = NULL,
col_date = NULL,
col_patient_id = NULL,
col_mo = NULL,
col_keyantibiotics = NULL,
method = "phenotype-based",
...) {
if (is_null_or_grouped_tbl(x)) {
# when `x` is left blank, auto determine it (get_current_data() also contains dplyr::cur_data_all())
@ -562,22 +646,12 @@ filter_first_weighted_isolate <- function(x = NULL,
meet_criteria(col_date, allow_class = "character", has_length = 1, allow_NULL = TRUE, is_in = colnames(x))
meet_criteria(col_patient_id, allow_class = "character", has_length = 1, allow_NULL = TRUE, is_in = colnames(x))
meet_criteria(col_mo, allow_class = "character", has_length = 1, allow_NULL = TRUE, is_in = colnames(x))
meet_criteria(col_keyantibiotics, allow_class = "character", has_length = 1, allow_NULL = TRUE, is_in = colnames(x))
y <- x
if (is.null(col_keyantibiotics)) {
# first try to look for it
col_keyantibiotics <- search_type_in_df(x = x, type = "keyantibiotics")
# still NULL? Then create it since we are calling filter_first_WEIGHTED_isolate()
if (is.null(col_keyantibiotics)) {
y$keyab <- suppressMessages(key_antibiotics(x,
col_mo = col_mo,
...))
col_keyantibiotics <- "keyab"
}
}
meet_criteria(method, allow_class = "character", has_length = 1, is_in = c("phenotype-based", "episode-based", "patient-based", "isolate-based"))
subset(x, first_isolate(x = y,
subset(x, first_isolate(x = x,
col_date = col_date,
col_patient_id = col_patient_id))
col_patient_id = col_patient_id,
col_mo = col_mo,
method = method,
...))
}

10
R/guess_ab_col.R
View File

@ -102,6 +102,7 @@ get_column_abx <- function(x,
verbose = FALSE,
info = TRUE,
only_rsi_columns = FALSE,
sort = TRUE,
...) {
meet_criteria(x, allow_class = "data.frame")
meet_criteria(soft_dependencies, allow_class = "character", allow_NULL = TRUE)
@ -109,6 +110,7 @@ get_column_abx <- function(x,
meet_criteria(verbose, allow_class = "logical", has_length = 1)
meet_criteria(info, allow_class = "logical", has_length = 1)
meet_criteria(only_rsi_columns, allow_class = "logical", has_length = 1)
meet_criteria(sort, allow_class = "logical", has_length = 1)
if (info == TRUE) {
message_("Auto-guessing columns suitable for analysis", appendLF = FALSE, as_note = FALSE)
@ -186,11 +188,15 @@ get_column_abx <- function(x,
}
# sort on name
x <- x[order(names(x), x)]
if (sort == TRUE) {
x <- x[order(names(x), x)]
}
duplicates <- c(x[duplicated(x)], x[duplicated(names(x))])
duplicates <- duplicates[unique(names(duplicates))]
x <- c(x[!names(x) %in% names(duplicates)], duplicates)
x <- x[order(names(x), x)]
if (sort == TRUE) {
x <- x[order(names(x), x)]
}
# succeeded with auto-guessing
if (info == TRUE) {

360
R/key_antibiotics.R
View File

@ -1,360 +0,0 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2021 Berends MS, Luz CF et al. #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #
# #
# This R package is free software; you can freely use and distribute #
# it for both personal and commercial purposes under the terms of the #
# GNU General Public License version 2.0 (GNU GPL-2), as published by #
# the Free Software Foundation. #
# We created this package for both routine data analysis and academic #
# research and it was publicly released in the hope that it will be #
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
# #
# Visit our website for the full manual and a complete tutorial about #
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== #
#' Key Antibiotics for First (Weighted) Isolates
#'
#' These function can be used to determine first isolates (see [first_isolate()]). Using key antibiotics to determine first isolates is more reliable than without key antibiotics. These selected isolates can then be called first 'weighted' isolates.
#' @inheritSection lifecycle Stable Lifecycle
#' @param x a [data.frame] with antibiotics columns, like `AMX` or `amox`. Can be left blank to determine automatically
#' @param y,z character vectors to compare
#' @inheritParams first_isolate
#' @param universal_1,universal_2,universal_3,universal_4,universal_5,universal_6 column names of **broad-spectrum** antibiotics, case-insensitive. See details for which antibiotics will be used at default (which are guessed with [guess_ab_col()]).
#' @param GramPos_1,GramPos_2,GramPos_3,GramPos_4,GramPos_5,GramPos_6 column names of antibiotics for **Gram-positives**, case-insensitive. See details for which antibiotics will be used at default (which are guessed with [guess_ab_col()]).
#' @param GramNeg_1,GramNeg_2,GramNeg_3,GramNeg_4,GramNeg_5,GramNeg_6 column names of antibiotics for **Gram-negatives**, case-insensitive. See details for which antibiotics will be used at default (which are guessed with [guess_ab_col()]).
#' @param warnings give a warning about missing antibiotic columns (they will be ignored)
#' @param ... other arguments passed on to functions
#' @details
#' The [key_antibiotics()] function is context-aware. This means that then the `x` argument can be left blank, see *Examples*.
#'
#' The function [key_antibiotics()] returns a character vector with 12 antibiotic results for every isolate. These isolates can then be compared using [key_antibiotics_equal()], to check if two isolates have generally the same antibiogram. Missing and invalid values are replaced with a dot (`"."`) by [key_antibiotics()] and ignored by [key_antibiotics_equal()].
#'
#' The [first_isolate()] function only uses this function on the same microbial species from the same patient. Using this, e.g. an MRSA will be included after a susceptible *S. aureus* (MSSA) is found within the same patient episode. Without key antibiotic comparison it would not. See [first_isolate()] for more info.
#'
#' At default, the antibiotics that are used for **Gram-positive bacteria** are:
#' - Amoxicillin
#' - Amoxicillin/clavulanic acid
#' - Cefuroxime
#' - Piperacillin/tazobactam
#' - Ciprofloxacin
#' - Trimethoprim/sulfamethoxazole
#' - Vancomycin
#' - Teicoplanin
#' - Tetracycline
#' - Erythromycin
#' - Oxacillin
#' - Rifampin
#'
#' At default the antibiotics that are used for **Gram-negative bacteria** are:
#' - Amoxicillin
#' - Amoxicillin/clavulanic acid
#' - Cefuroxime
#' - Piperacillin/tazobactam
#' - Ciprofloxacin
#' - Trimethoprim/sulfamethoxazole
#' - Gentamicin
#' - Tobramycin
#' - Colistin
#' - Cefotaxime
#' - Ceftazidime
#' - Meropenem
#'
#' The function [key_antibiotics_equal()] checks the characters returned by [key_antibiotics()] for equality, and returns a [`logical`] vector.
#' @inheritSection first_isolate Key Antibiotics
#' @rdname key_antibiotics
#' @export
#' @seealso [first_isolate()]
#' @inheritSection AMR Read more on Our Website!
#' @examples
#' # `example_isolates` is a data set available in the AMR package.
#' # See ?example_isolates.
#'
#' # output of the `key_antibiotics()` function could be like this:
#' strainA <- "SSSRR.S.R..S"
#' strainB <- "SSSIRSSSRSSS"
#'
#' # those strings can be compared with:
#' key_antibiotics_equal(strainA, strainB)
#' # TRUE, because I is ignored (as well as missing values)
#'
#' key_antibiotics_equal(strainA, strainB, ignore_I = FALSE)
#' # FALSE, because I is not ignored and so the 4th character differs
#'
#' \donttest{
#' if (require("dplyr")) {
#' # set key antibiotics to a new variable
#' my_patients <- example_isolates %>%
#' mutate(keyab = key_antibiotics()) %>% # no need to define `x`
#' mutate(
#' # now calculate first isolates
#' first_regular = first_isolate(col_keyantibiotics = FALSE),
#' # and first WEIGHTED isolates
#' first_weighted = first_isolate(col_keyantibiotics = "keyab")
#' )
#'
#' # Check the difference, in this data set it results in a lot more isolates:
#' sum(my_patients$first_regular, na.rm = TRUE)
#' sum(my_patients$first_weighted, na.rm = TRUE)
#' }
#' }
key_antibiotics <- function(x = NULL,
col_mo = NULL,
universal_1 = guess_ab_col(x, "amoxicillin"),
universal_2 = guess_ab_col(x, "amoxicillin/clavulanic acid"),
universal_3 = guess_ab_col(x, "cefuroxime"),
universal_4 = guess_ab_col(x, "piperacillin/tazobactam"),
universal_5 = guess_ab_col(x, "ciprofloxacin"),
universal_6 = guess_ab_col(x, "trimethoprim/sulfamethoxazole"),
GramPos_1 = guess_ab_col(x, "vancomycin"),
GramPos_2 = guess_ab_col(x, "teicoplanin"),
GramPos_3 = guess_ab_col(x, "tetracycline"),
GramPos_4 = guess_ab_col(x, "erythromycin"),
GramPos_5 = guess_ab_col(x, "oxacillin"),
GramPos_6 = guess_ab_col(x, "rifampin"),
GramNeg_1 = guess_ab_col(x, "gentamicin"),
GramNeg_2 = guess_ab_col(x, "tobramycin"),
GramNeg_3 = guess_ab_col(x, "colistin"),
GramNeg_4 = guess_ab_col(x, "cefotaxime"),
GramNeg_5 = guess_ab_col(x, "ceftazidime"),
GramNeg_6 = guess_ab_col(x, "meropenem"),
warnings = TRUE,
...) {
if (is_null_or_grouped_tbl(x)) {
# when `x` is left blank, auto determine it (get_current_data() also contains dplyr::cur_data_all())
# is also fix for using a grouped df as input (a dot as first argument)
x <- tryCatch(get_current_data(arg_name = "x", call = -2), error = function(e) x)
}
meet_criteria(x, allow_class = "data.frame") # also checks dimensions to be >0
meet_criteria(col_mo, allow_class = "character", has_length = 1, allow_NULL = TRUE, allow_NA = TRUE, is_in = colnames(x))
meet_criteria(universal_1, allow_class = "character", has_length = 1, allow_NULL = TRUE, allow_NA = TRUE)
meet_criteria(universal_2, allow_class = "character", has_length = 1, allow_NULL = TRUE, allow_NA = TRUE)
meet_criteria(universal_3, allow_class = "character", has_length = 1, allow_NULL = TRUE, allow_NA = TRUE)
meet_criteria(universal_4, allow_class = "character", has_length = 1, allow_NULL = TRUE, allow_NA = TRUE)
meet_criteria(universal_5, allow_class = "character", has_length = 1, allow_NULL = TRUE, allow_NA = TRUE)
meet_criteria(universal_6, allow_class = "character", has_length = 1, allow_NULL = TRUE, allow_NA = TRUE)
meet_criteria(GramPos_1, allow_class = "character", has_length = 1, allow_NULL = TRUE, allow_NA = TRUE)
meet_criteria(GramPos_2, allow_class = "character", has_length = 1, allow_NULL = TRUE, allow_NA = TRUE)
meet_criteria(GramPos_3, allow_class = "character", has_length = 1, allow_NULL = TRUE, allow_NA = TRUE)
meet_criteria(GramPos_4, allow_class = "character", has_length = 1, allow_NULL = TRUE, allow_NA = TRUE)
meet_criteria(GramPos_5, allow_class = "character", has_length = 1, allow_NULL = TRUE, allow_NA = TRUE)
meet_criteria(GramPos_6, allow_class = "character", has_length = 1, allow_NULL = TRUE, allow_NA = TRUE)
meet_criteria(GramNeg_1, allow_class = "character", has_length = 1, allow_NULL = TRUE, allow_NA = TRUE)
meet_criteria(GramNeg_2, allow_class = "character", has_length = 1, allow_NULL = TRUE, allow_NA = TRUE)
meet_criteria(GramNeg_3, allow_class = "character", has_length = 1, allow_NULL = TRUE, allow_NA = TRUE)
meet_criteria(GramNeg_4, allow_class = "character", has_length = 1, allow_NULL = TRUE, allow_NA = TRUE)
meet_criteria(GramNeg_5, allow_class = "character", has_length = 1, allow_NULL = TRUE, allow_NA = TRUE)
meet_criteria(GramNeg_6, allow_class = "character", has_length = 1, allow_NULL = TRUE, allow_NA = TRUE)
meet_criteria(warnings, allow_class = "logical", has_length = 1)
# force regular data.frame, not a tibble or data.table
x <- as.data.frame(x, stringsAsFactors = FALSE)
dots <- unlist(list(...))
if (length(dots) != 0) {
# backwards compatibility with old arguments
dots.names <- names(dots)
if ("info" %in% dots.names) {
warnings <- dots[which(dots.names == "info")]
}
}
# try to find columns based on type
# -- mo
if (is.null(col_mo)) {
col_mo <- search_type_in_df(x = x, type = "mo")
}
if (is.null(col_mo)) {
warning_("No column found for `col_mo`, ignoring antimicrobial agents set for Gram-negative and Gram-positive bacteria", call = FALSE)
x$gramstain <- NA_character_
} else {
x$gramstain <- mo_gramstain(as.mo(x[, col_mo, drop = TRUE]), language = NULL)
}
x$key_ab <- NA_character_
# check columns
col.list <- c(universal_1, universal_2, universal_3, universal_4, universal_5, universal_6,
GramPos_1, GramPos_2, GramPos_3, GramPos_4, GramPos_5, GramPos_6,
GramNeg_1, GramNeg_2, GramNeg_3, GramNeg_4, GramNeg_5, GramNeg_6)
check_available_columns <- function(x, col.list, warnings = TRUE) {
# check columns
col.list <- col.list[!is.na(col.list) & !is.null(col.list)]
names(col.list) <- col.list
col.list.bak <- col.list
# are they available as upper case or lower case then?
for (i in seq_len(length(col.list))) {
if (is.null(col.list[i]) | isTRUE(is.na(col.list[i]))) {
col.list[i] <- NA
} else if (toupper(col.list[i]) %in% colnames(x)) {
col.list[i] <- toupper(col.list[i])
} else if (tolower(col.list[i]) %in% colnames(x)) {
col.list[i] <- tolower(col.list[i])
} else if (!col.list[i] %in% colnames(x)) {
col.list[i] <- NA
}
}
if (!all(col.list %in% colnames(x))) {
if (warnings == TRUE) {
warning_("Some columns do not exist and will be ignored: ",
col.list.bak[!(col.list %in% colnames(x))] %pm>% toString(),
".\nTHIS MAY STRONGLY INFLUENCE THE OUTCOME.",
immediate = TRUE,
call = FALSE)
}
}
col.list
}
col.list <- check_available_columns(x = x, col.list = col.list, warnings = warnings)
universal_1 <- col.list[universal_1]
universal_2 <- col.list[universal_2]
universal_3 <- col.list[universal_3]
universal_4 <- col.list[universal_4]
universal_5 <- col.list[universal_5]
universal_6 <- col.list[universal_6]
GramPos_1 <- col.list[GramPos_1]
GramPos_2 <- col.list[GramPos_2]
GramPos_3 <- col.list[GramPos_3]
GramPos_4 <- col.list[GramPos_4]
GramPos_5 <- col.list[GramPos_5]
GramPos_6 <- col.list[GramPos_6]
GramNeg_1 <- col.list[GramNeg_1]
GramNeg_2 <- col.list[GramNeg_2]
GramNeg_3 <- col.list[GramNeg_3]
GramNeg_4 <- col.list[GramNeg_4]
GramNeg_5 <- col.list[GramNeg_5]
GramNeg_6 <- col.list[GramNeg_6]
universal <- c(universal_1, universal_2, universal_3,
universal_4, universal_5, universal_6)
gram_positive <- c(universal,
GramPos_1, GramPos_2, GramPos_3,
GramPos_4, GramPos_5, GramPos_6)
gram_positive <- gram_positive[!is.null(gram_positive)]
gram_positive <- gram_positive[!is.na(gram_positive)]
if (length(gram_positive) < 12 & !all(is.na(x$gramstain)) & message_not_thrown_before("key_antibiotics.grampos")) {
warning_("Only using ", length(gram_positive), " different antibiotics as key antibiotics for Gram-positives. See ?key_antibiotics.", call = FALSE)
remember_thrown_message("key_antibiotics.grampos")
}
gram_negative <- c(universal,
GramNeg_1, GramNeg_2, GramNeg_3,
GramNeg_4, GramNeg_5, GramNeg_6)
gram_negative <- gram_negative[!is.null(gram_negative)]
gram_negative <- gram_negative[!is.na(gram_negative)]
if (length(gram_negative) < 12 & !all(is.na(x$gramstain)) & message_not_thrown_before("key_antibiotics.gramneg")) {
warning_("Only using ", length(gram_negative), " different antibiotics as key antibiotics for Gram-negatives. See ?key_antibiotics.", call = FALSE)
remember_thrown_message("key_antibiotics.gramneg")
}
# Gram +
x$key_ab <- pm_if_else(x$gramstain == "Gram-positive",
tryCatch(apply(X = x[, gram_positive],
MARGIN = 1,
FUN = function(x) paste(x, collapse = "")),
error = function(e) paste0(rep(".", 12), collapse = "")),
as.character(x$key_ab))
# Gram -
x$key_ab <- pm_if_else(x$gramstain == "Gram-negative",
tryCatch(apply(X = x[, gram_negative],
MARGIN = 1,
FUN = function(x) paste(x, collapse = "")),
error = function(e) paste0(rep(".", 12), collapse = "")),
as.character(x$key_ab))
# format
key_abs <- toupper(gsub("(NA|NULL|[^RSIrsi])", ".", x$key_ab))
if (pm_n_distinct(key_abs) == 1) {
warning_("No distinct key antibiotics determined.", call = FALSE)
}
key_abs
}
#' @rdname key_antibiotics
#' @param info unused - previously used to indicate whether a progress bar should print
#' @param na.rm a [logical] to indicate whether comparison with `NA` should return `FALSE` (defaults to `TRUE` for backwards compatibility)
#' @export
key_antibiotics_equal <- function(y,
z,
type = c("keyantibiotics", "points"),
ignore_I = TRUE,
points_threshold = 2,
info = FALSE,
na.rm = TRUE,
...) {
meet_criteria(y, allow_class = "character")
meet_criteria(z, allow_class = "character")
if (length(type) == 2) {
type <- type[1L]
}
meet_criteria(type, allow_class = "character", has_length = 1, is_in = c("keyantibiotics", "points"))
meet_criteria(ignore_I, allow_class = "logical", has_length = 1)
meet_criteria(points_threshold, allow_class = c("numeric", "integer"), has_length = 1, is_positive = TRUE, is_finite = TRUE)
meet_criteria(info, allow_class = "logical", has_length = 1)
meet_criteria(na.rm, allow_class = "logical", has_length = 1)
stop_ifnot(length(y) == length(z), "length of `y` and `z` must be equal")
key2rsi <- function(val) {
as.double(as.rsi(gsub(".", NA_character_, unlist(strsplit(val, "")), fixed = TRUE)))
}
y <- lapply(y, key2rsi)
z <- lapply(z, key2rsi)
determine_equality <- function(a, b, type, points_threshold, ignore_I) {
if (length(a) != length(b)) {
# incomparable, so not equal
return(FALSE)
}
# ignore NAs on both sides
NA_ind <- which(is.na(a) | is.na(b))
a[NA_ind] <- NA_real_
b[NA_ind] <- NA_real_
if (type == "points") {
# count points for every single character:
# - no change is 0 points
# - I <-> S|R is 0.5 point
# - S|R <-> R|S is 1 point
# use the levels of as.rsi (S = 1, I = 2, R = 3)
(sum(abs(a - b), na.rm = TRUE) / 2) < points_threshold
} else {
if (ignore_I == TRUE) {
ind <- which(a == 2 | b == 2) # since as.double(as.rsi("I")) == 2
a[ind] <- NA_real_
b[ind] <- NA_real_
}
all(a == b, na.rm = TRUE)
}
}
out <- unlist(mapply(FUN = determine_equality,
y,
z,
MoreArgs = list(type = type,
points_threshold = points_threshold,
ignore_I = ignore_I),
SIMPLIFY = FALSE,
USE.NAMES = FALSE))
if (na.rm == FALSE) {
out[is.na(y) | is.na(z)] <- NA
} else {
# NA means not equal if `na.rm == TRUE`, as per the manual
out[is.na(y) | is.na(z)] <- FALSE
}
out
}

327
R/key_antimicrobials.R Executable file
View File

@ -0,0 +1,327 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2021 Berends MS, Luz CF et al. #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #
# #
# This R package is free software; you can freely use and distribute #
# it for both personal and commercial purposes under the terms of the #
# GNU General Public License version 2.0 (GNU GPL-2), as published by #
# the Free Software Foundation. #
# We created this package for both routine data analysis and academic #
# research and it was publicly released in the hope that it will be #
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
# #
# Visit our website for the full manual and a complete tutorial about #
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== #
#' (Key) Antimicrobials for First Weighted Isolates
#'
#' These functions can be used to determine first weighted isolates by considering the phenotype for isolate selection (see [first_isolate()]). Using a phenotype-based method to determine first isolates is more reliable than methods that disregard phenotypes.
#' @inheritSection lifecycle Stable Lifecycle
#' @param x a [data.frame] with antibiotics columns, like `AMX` or `amox`. Can be left blank to determine automatically
#' @param y,z character vectors to compare
#' @inheritParams first_isolate
#' @param universal names of **broad-spectrum** antimicrobial agents, case-insensitive. Set to `NULL` to ignore. See *Details* for the default agents.
#' @param gram_negative names of antibiotic agents for **Gram-positives**, case-insensitive. Set to `NULL` to ignore. See *Details* for the default agents.
#' @param gram_positive names of antibiotic agents for **Gram-negatives**, case-insensitive. Set to `NULL` to ignore. See *Details* for the default agents.
#' @param antifungal names of antifungal agents for **fungi**, case-insensitive. Set to `NULL` to ignore. See *Details* for the default agents.
#' @param ... ignored, allows for future extensions
#' @details
#' The [key_antimicrobials()] and [all_antimicrobials()] functions are context-aware. This means that then the `x` argument can be left blank, see *Examples*.
#'
#' The function [key_antimicrobials()] returns a character vector with 12 antimicrobial results for every isolate. The function [all_antimicrobials()] returns a character vector with all antimicrobial results for every isolate. These vectors can then be compared using [antimicrobials_equal()], to check if two isolates have generally the same antibiogram. Missing and invalid values are replaced with a dot (`"."`) by [key_antimicrobials()] and ignored by [antimicrobials_equal()].
#'
#' Please see the [first_isolate()] function how these important functions enable the 'phenotype-based' method for determination of first isolates.
#'
#' The default antimicrobial agents used for **all rows** (set in `universal`) are:
#'
#' - Ampicillin
#' - Amoxicillin/clavulanic acid
#' - Cefuroxime
#' - Ciprofloxacin
#' - Piperacillin/tazobactam
#' - Trimethoprim/sulfamethoxazole
#'
#' The default antimicrobial agents used for **Gram-negative bacteria** (set in `gram_negative`) are:
#'
#' - Cefotaxime
#' - Ceftazidime
#' - Colistin
#' - Gentamicin
#' - Meropenem
#' - Tobramycin
#'
#' The default antimicrobial agents used for **Gram-positive bacteria** (set in `gram_positive`) are:
#'
#' - Erythromycin
#' - Oxacillin
#' - Rifampin
#' - Teicoplanin
#' - Tetracycline
#' - Vancomycin
#'
#'
#' The default antimicrobial agents used for **fungi** (set in `antifungal`) are:
#'
#' - Anidulafungin
#' - Caspofungin
#' - Fluconazole
#' - Miconazole
#' - Nystatin
#' - Voriconazole
#' @rdname key_antimicrobials
#' @export
#' @seealso [first_isolate()]
#' @inheritSection AMR Read more on Our Website!
#' @examples
#' # `example_isolates` is a data set available in the AMR package.
#' # See ?example_isolates.
#'
#' # output of the `key_antimicrobials()` function could be like this:
#' strainA <- "SSSRR.S.R..S"
#' strainB <- "SSSIRSSSRSSS"
#'
#' # those strings can be compared with:
#' antimicrobials_equal(strainA, strainB, type = "keyantimicrobials")
#' # TRUE, because I is ignored (as well as missing values)
#'
#' antimicrobials_equal(strainA, strainB, type = "keyantimicrobials", ignore_I = FALSE)
#' # FALSE, because I is not ignored and so the 4th character differs
#'
#' \donttest{
#' if (require("dplyr")) {
#' # set key antibiotics to a new variable
#' my_patients <- example_isolates %>%
#' mutate(keyab = key_antimicrobials(antifungal = NULL)) %>% # no need to define `x`
#' mutate(
#' # now calculate first isolates
#' first_regular = first_isolate(col_keyantimicrobials = FALSE),
#' # and first WEIGHTED isolates
#' first_weighted = first_isolate(col_keyantimicrobials = "keyab")
#' )
#'
#' # Check the difference, in this data set it results in more isolates:
#' sum(my_patients$first_regular, na.rm = TRUE)
#' sum(my_patients$first_weighted, na.rm = TRUE)
#' }
#' }
key_antimicrobials <- function(x = NULL,
col_mo = NULL,
universal = c("ampicillin", "amoxicillin/clavulanic acid", "cefuroxime",
"piperacillin/tazobactam", "ciprofloxacin", "trimethoprim/sulfamethoxazole"),
gram_negative = c("gentamicin", "tobramycin", "colistin",
"cefotaxime", "ceftazidime", "meropenem"),
gram_positive = c("vancomycin", "teicoplanin", "tetracycline",
"erythromycin", "oxacillin", "rifampin"),
antifungal = c("anidulafungin", "caspofungin", "fluconazole",
"miconazole", "nystatin", "voriconazole"),
only_rsi_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())
# is also fix for using a grouped df as input (a dot as first argument)
x <- tryCatch(get_current_data(arg_name = "x", call = -2), error = function(e) x)
}
meet_criteria(x, allow_class = "data.frame") # also checks dimensions to be >0
meet_criteria(col_mo, allow_class = "character", has_length = 1, allow_NULL = TRUE, allow_NA = TRUE, is_in = colnames(x))
meet_criteria(universal, allow_class = "character", allow_NULL = TRUE)
meet_criteria(gram_negative, allow_class = "character", allow_NULL = TRUE)
meet_criteria(gram_positive, allow_class = "character", allow_NULL = TRUE)
meet_criteria(antifungal, allow_class = "character", allow_NULL = TRUE)
meet_criteria(only_rsi_columns, allow_class = "logical", has_length = 1)
# force regular data.frame, not a tibble or data.table
x <- as.data.frame(x, stringsAsFactors = FALSE)
cols <- get_column_abx(x, info = FALSE, only_rsi_columns = only_rsi_columns)
# try to find columns based on type
# -- mo
if (is.null(col_mo)) {
col_mo <- search_type_in_df(x = x, type = "mo", info = FALSE)
}
if (is.null(col_mo)) {
warning_("No column found for `col_mo`, ignoring antibiotics set in `gram_negative` and `gram_positive`, and antimycotics set in `antifungal`", call = FALSE)
gramstain <- NA_character_
kingdom <- NA_character_
} else {
x.mo <- as.mo(x[, col_mo, drop = TRUE])
gramstain <- mo_gramstain(x.mo, language = NULL)
kingdom <- mo_kingdom(x.mo, language = NULL)
}
AMR_string <- function(x, values, name, filter, cols = cols) {
if (is.null(values)) {
return(rep(NA_character_, length(which(filter))))
}
values_old_length <- length(values)
values <- as.ab(values, flag_multiple_results = FALSE, info = FALSE)
values <- cols[names(cols) %in% values]
values_new_length <- length(values)
if (values_new_length < values_old_length &
any(filter, na.rm = TRUE) &
message_not_thrown_before(paste0("key_antimicrobials.", name))) {
warning_(ifelse(values_new_length == 0,
"No columns available ",
paste0("Only using ", values_new_length, " out of ", values_old_length, " defined columns ")),
"as key antimicrobials for ", name, "s. See ?key_antimicrobials.",
call = FALSE)
remember_thrown_message(paste0("key_antimicrobials.", name))
}
generate_antimcrobials_string(x[which(filter), c(universal, values), drop = FALSE])
}
if (is.null(universal)) {
universal <- character(0)
} else {
universal <- as.ab(universal, flag_multiple_results = FALSE, info = FALSE)
universal <- cols[names(cols) %in% universal]
}
key_ab <- rep(NA_character_, nrow(x))
key_ab[which(gramstain == "Gram-negative")] <- AMR_string(x = x,
values = gram_negative,
name = "Gram-negative",
filter = gramstain == "Gram-negative",
cols = cols)
key_ab[which(gramstain == "Gram-positive")] <- AMR_string(x = x,
values = gram_positive,
name = "Gram-positive",
filter = gramstain == "Gram-positive",
cols = cols)
key_ab[which(kingdom == "Fungi")] <- AMR_string(x = x,
values = antifungal,
name = "antifungal",
filter = kingdom == "Fungi",
cols = cols)
# back-up - only use `universal`
key_ab[which(is.na(key_ab))] <- AMR_string(x = x,
values = character(0),
name = "",
filter = is.na(key_ab),
cols = cols)
if (length(unique(key_ab)) == 1) {
warning_("No distinct key antibiotics determined.", call = FALSE)
}
key_ab
}
#' @rdname key_antimicrobials
#' @export
all_antimicrobials <- function(x = NULL,
only_rsi_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())
# is also fix for using a grouped df as input (a dot as first argument)
x <- tryCatch(get_current_data(arg_name = "x", call = -2), error = function(e) x)
}
meet_criteria(x, allow_class = "data.frame") # also checks dimensions to be >0
meet_criteria(only_rsi_columns, allow_class = "logical", has_length = 1)
# force regular data.frame, not a tibble or data.table
x <- as.data.frame(x, stringsAsFactors = FALSE)
cols <- get_column_abx(x, only_rsi_columns = only_rsi_columns, info = FALSE, sort = FALSE)
generate_antimcrobials_string(x[ , cols, drop = FALSE])
}
generate_antimcrobials_string <- function(df) {
if (NCOL(df) == 0) {
return(rep("", NROW(df)))
}
if (NROW(df) == 0) {
return(character(0))
}
out <- tryCatch(
do.call(paste0,
lapply(as.list(df),
function(x) {
x <- toupper(as.character(x))
x[!x %in% c("R", "S", "I")] <- "."
paste(x)
})),
error = function(e) rep(strrep(".", NCOL(df)), NROW(df)))
out
}
#' @rdname key_antimicrobials
#' @param info unused - previously used to indicate whether a progress bar should print
#' @export
antimicrobials_equal <- function(y,
z,
type = c("points", "keyantimicrobials"),
ignore_I = TRUE,
points_threshold = 2,
info = FALSE,
...) {
meet_criteria(y, allow_class = "character")
meet_criteria(z, allow_class = "character")
stop_if(missing(type), "argument \"type\" is missing, with no default")
meet_criteria(type, allow_class = "character", has_length = 1, is_in = c("points", "keyantimicrobials"))
meet_criteria(ignore_I, allow_class = "logical", has_length = 1)
meet_criteria(points_threshold, allow_class = c("numeric", "integer"), has_length = 1, is_positive = TRUE, is_finite = TRUE)
meet_criteria(info, allow_class = "logical", has_length = 1)
stop_ifnot(length(y) == length(z), "length of `y` and `z` must be equal")
key2rsi <- function(val) {
as.double(as.rsi(gsub(".", NA_character_, unlist(strsplit(val, "")), fixed = TRUE)))
}
y <- lapply(y, key2rsi)
z <- lapply(z, key2rsi)
determine_equality <- function(a, b, type, points_threshold, ignore_I) {
if (length(a) != length(b)) {
# incomparable, so not equal
return(FALSE)
}
# ignore NAs on both sides
NA_ind <- which(is.na(a) | is.na(b))
a[NA_ind] <- NA_real_
b[NA_ind] <- NA_real_
if (type == "points") {
# count points for every single character:
# - no change is 0 points
# - I <-> S|R is 0.5 point
# - S|R <-> R|S is 1 point
# use the levels of as.rsi (S = 1, I = 2, R = 3)
# and divide by 2 (S = 0.5, I = 1, R = 1.5)
(sum(abs(a - b), na.rm = TRUE) / 2) < points_threshold
} else {
if (ignore_I == TRUE) {
ind <- which(a == 2 | b == 2) # since as.double(as.rsi("I")) == 2
a[ind] <- NA_real_
b[ind] <- NA_real_
}
all(a == b, na.rm = TRUE)
}
}
out <- unlist(mapply(FUN = determine_equality,
y,
z,
MoreArgs = list(type = type,
points_threshold = points_threshold,
ignore_I = ignore_I),
SIMPLIFY = FALSE,
USE.NAMES = FALSE))
out[is.na(y) | is.na(z)] <- NA
out
}

6
R/rsi.R
View File

@ -1027,10 +1027,8 @@ summary.rsi <- function(object, ...) {
#' @method c rsi
#' @export
#' @noRd
c.rsi <- function(x, ...) {
y <- unlist(lapply(list(...), as.character))
x <- as.character(x)
as.rsi(c(x, y))
c.rsi <- function(...) {
as.rsi(unlist(lapply(list(...), as.character)))
}
#' @method unique rsi