mirror of
https://github.com/msberends/AMR.git
synced 2025-07-09 19:01:51 +02:00
new algorithm key abs
This commit is contained in:
@ -40,13 +40,16 @@
|
||||
#' @param col_species (deprecated, use \code{col_bactid} instead) column name of the species of the microorganisms
|
||||
#' @details \strong{WHY THIS IS SO IMPORTANT} \cr
|
||||
#' To conduct an analysis of antimicrobial resistance, you should only include the first isolate of every patient per episode \href{https://www.ncbi.nlm.nih.gov/pubmed/17304462}{[1]}. 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 \emph{S. aureus} isolates would be overestimated, because you included this MRSA more than once. It would be \href{https://en.wikipedia.org/wiki/Selection_bias}{selection bias}.
|
||||
#' @section Key antibiotics:
|
||||
#' There are two ways to determine whether isolates can be included as first \emph{weighted} isolates: \cr
|
||||
#'
|
||||
#' \strong{DETERMINING WEIGHTED ISOLATES} \cr
|
||||
#' \strong{1. Using} \code{type = "keyantibiotics"} \strong{and parameter} \code{ignore_I} \cr
|
||||
#' To determine weighted isolates, the difference between key antibiotics will be checked. Any difference from S to R (or vice versa) will (re)select an isolate as a first weighted isolate. With \code{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. \cr
|
||||
#' Any difference from S to R (or vice versa) will (re)select an isolate as a first weighted isolate. With \code{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. \cr
|
||||
#'
|
||||
#' \strong{2. Using} \code{type = "points"} \strong{and parameter} \code{points_threshold} \cr
|
||||
#' To determine weighted isolates, difference between antimicrobial interpretations will be measured with points. 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 \code{points_threshold}, an isolate will be (re)selected as a first weighted isolate. This method is being used by the Infection Prevention department (Dr M. Lokate) of the University Medical Center Groningen (UMCG).
|
||||
#' 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 \code{points_threshold}, an isolate will be (re)selected as a first weighted isolate.
|
||||
#' @keywords isolate isolates first
|
||||
#' @seealso \code{\link{keyantibiotics}}
|
||||
#' @export
|
||||
#' @importFrom dplyr arrange_at lag between row_number filter mutate arrange
|
||||
#' @return A vector to add to table, see Examples.
|
||||
@ -401,205 +404,3 @@ first_isolate <- function(tbl,
|
||||
all_first
|
||||
|
||||
}
|
||||
|
||||
#' Key antibiotics based on bacteria ID
|
||||
#'
|
||||
#' @param tbl table with antibiotics coloms, like \code{amox} and \code{amcl}.
|
||||
#' @inheritParams first_isolate
|
||||
#' @param amcl,amox,cfot,cfta,cftr,cfur,cipr,clar,clin,clox,doxy,gent,line,mero,peni,pita,rifa,teic,trsu,vanc column names of antibiotics, case-insensitive
|
||||
#' @export
|
||||
#' @importFrom dplyr %>% mutate if_else
|
||||
#' @return Character of length 1.
|
||||
#' @seealso \code{\link{mo_property}} \code{\link{antibiotics}}
|
||||
#' @examples
|
||||
#' \donttest{
|
||||
#' #' # set key antibiotics to a new variable
|
||||
#' tbl$keyab <- key_antibiotics(tbl)
|
||||
#' }
|
||||
key_antibiotics <- function(tbl,
|
||||
col_bactid = 'bactid',
|
||||
info = TRUE,
|
||||
amcl = 'amcl',
|
||||
amox = 'amox',
|
||||
cfot = 'cfot',
|
||||
cfta = 'cfta',
|
||||
cftr = 'cftr',
|
||||
cfur = 'cfur',
|
||||
cipr = 'cipr',
|
||||
clar = 'clar',
|
||||
clin = 'clin',
|
||||
clox = 'clox',
|
||||
doxy = 'doxy',
|
||||
gent = 'gent',
|
||||
line = 'line',
|
||||
mero = 'mero',
|
||||
peni = 'peni',
|
||||
pita = 'pita',
|
||||
rifa = 'rifa',
|
||||
teic = 'teic',
|
||||
trsu = 'trsu',
|
||||
vanc = 'vanc') {
|
||||
|
||||
keylist <- character(length = nrow(tbl))
|
||||
|
||||
if (!col_bactid %in% colnames(tbl)) {
|
||||
stop('Column ', col_bactid, ' not found.', call. = FALSE)
|
||||
}
|
||||
|
||||
# check columns
|
||||
col.list <- c(amox, cfot, cfta, cftr, cfur, cipr, clar,
|
||||
clin, clox, doxy, gent, line, mero, peni,
|
||||
pita, rifa, teic, trsu, vanc)
|
||||
col.list <- check_available_columns(tbl = tbl, col.list = col.list, info = info)
|
||||
amox <- col.list[amox]
|
||||
cfot <- col.list[cfot]
|
||||
cfta <- col.list[cfta]
|
||||
cftr <- col.list[cftr]
|
||||
cfur <- col.list[cfur]
|
||||
cipr <- col.list[cipr]
|
||||
clar <- col.list[clar]
|
||||
clin <- col.list[clin]
|
||||
clox <- col.list[clox]
|
||||
doxy <- col.list[doxy]
|
||||
gent <- col.list[gent]
|
||||
line <- col.list[line]
|
||||
mero <- col.list[mero]
|
||||
peni <- col.list[peni]
|
||||
pita <- col.list[pita]
|
||||
rifa <- col.list[rifa]
|
||||
teic <- col.list[teic]
|
||||
trsu <- col.list[trsu]
|
||||
vanc <- col.list[vanc]
|
||||
|
||||
# join microorganisms
|
||||
tbl <- tbl %>% left_join_microorganisms(col_bactid)
|
||||
|
||||
tbl$key_ab <- NA_character_
|
||||
|
||||
# Staphylococcus
|
||||
list_ab <- c(clox, trsu, teic, vanc, doxy, line, clar, rifa)
|
||||
list_ab <- list_ab[list_ab %in% colnames(tbl)]
|
||||
tbl <- tbl %>% mutate(key_ab =
|
||||
if_else(genus == 'Staphylococcus',
|
||||
apply(X = tbl[, list_ab],
|
||||
MARGIN = 1,
|
||||
FUN = function(x) paste(x, collapse = "")),
|
||||
key_ab))
|
||||
|
||||
# Rest of Gram +
|
||||
list_ab <- c(peni, amox, teic, vanc, clin, line, clar, trsu)
|
||||
list_ab <- list_ab[list_ab %in% colnames(tbl)]
|
||||
tbl <- tbl %>% mutate(key_ab =
|
||||
if_else(gramstain %like% '^Positive ',
|
||||
apply(X = tbl[, list_ab],
|
||||
MARGIN = 1,
|
||||
FUN = function(x) paste(x, collapse = "")),
|
||||
key_ab))
|
||||
|
||||
# Gram -
|
||||
list_ab <- c(amox, amcl, pita, cfur, cfot, cfta, cftr, mero, cipr, trsu, gent)
|
||||
list_ab <- list_ab[list_ab %in% colnames(tbl)]
|
||||
tbl <- tbl %>% mutate(key_ab =
|
||||
if_else(gramstain %like% '^Negative ',
|
||||
apply(X = tbl[, list_ab],
|
||||
MARGIN = 1,
|
||||
FUN = function(x) paste(x, collapse = "")),
|
||||
key_ab))
|
||||
|
||||
# format
|
||||
tbl <- tbl %>%
|
||||
mutate(key_ab = gsub('(NA|NULL)', '-', key_ab) %>% toupper())
|
||||
|
||||
tbl$key_ab
|
||||
|
||||
}
|
||||
|
||||
#' @importFrom dplyr progress_estimated %>%
|
||||
#' @noRd
|
||||
key_antibiotics_equal <- function(x,
|
||||
y,
|
||||
type = c("keyantibiotics", "points"),
|
||||
ignore_I = TRUE,
|
||||
points_threshold = 2,
|
||||
info = FALSE) {
|
||||
# x is active row, y is lag
|
||||
type <- type[1]
|
||||
|
||||
if (length(x) != length(y)) {
|
||||
stop('Length of `x` and `y` must be equal.')
|
||||
}
|
||||
|
||||
result <- logical(length(x))
|
||||
|
||||
if (type == "keyantibiotics") {
|
||||
if (ignore_I == TRUE) {
|
||||
# evaluation using regular expression will treat '?' as any character
|
||||
# so I is actually ignored then
|
||||
x <- gsub('I', '?', x, ignore.case = TRUE)
|
||||
y <- gsub('I', '?', y, ignore.case = TRUE)
|
||||
}
|
||||
for (i in 1:length(x)) {
|
||||
result[i] <- grepl(x = x[i],
|
||||
pattern = y[i],
|
||||
ignore.case = TRUE) |
|
||||
grepl(x = y[i],
|
||||
pattern = x[i],
|
||||
ignore.case = TRUE)
|
||||
}
|
||||
return(result)
|
||||
} else {
|
||||
|
||||
if (info == TRUE) {
|
||||
p <- dplyr::progress_estimated(length(x))
|
||||
}
|
||||
|
||||
for (i in 1:length(x)) {
|
||||
|
||||
if (info == TRUE) {
|
||||
p$tick()$print()
|
||||
}
|
||||
|
||||
if (is.na(x[i])) {
|
||||
x[i] <- ''
|
||||
}
|
||||
if (is.na(y[i])) {
|
||||
y[i] <- ''
|
||||
}
|
||||
|
||||
if (nchar(x[i]) != nchar(y[i])) {
|
||||
|
||||
result[i] <- FALSE
|
||||
|
||||
} else if (x[i] == '' & y[i] == '') {
|
||||
|
||||
result[i] <- TRUE
|
||||
|
||||
} else {
|
||||
|
||||
x2 <- strsplit(x[i], "")[[1]]
|
||||
y2 <- strsplit(y[i], "")[[1]]
|
||||
|
||||
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)
|
||||
|
||||
suppressWarnings(x2 <- x2 %>% as.rsi() %>% as.double())
|
||||
suppressWarnings(y2 <- y2 %>% as.rsi() %>% as.double())
|
||||
|
||||
points <- (x2 - y2) %>% abs() %>% sum(na.rm = TRUE)
|
||||
result[i] <- ((points / 2) >= points_threshold)
|
||||
|
||||
} else {
|
||||
stop('`', type, '` is not a valid value for type, must be "points" or "keyantibiotics". See ?first_isolate.')
|
||||
}
|
||||
}
|
||||
}
|
||||
if (info == TRUE) {
|
||||
cat('\n')
|
||||
}
|
||||
result
|
||||
}
|
||||
}
|
||||
|
||||
233
R/key_antibiotics.R
Normal file
233
R/key_antibiotics.R
Normal file
@ -0,0 +1,233 @@
|
||||
# ==================================================================== #
|
||||
# TITLE #
|
||||
# Antimicrobial Resistance (AMR) Analysis #
|
||||
# #
|
||||
# AUTHORS #
|
||||
# Berends MS (m.s.berends@umcg.nl), Luz CF (c.f.luz@umcg.nl) #
|
||||
# #
|
||||
# LICENCE #
|
||||
# This program is free software; you can redistribute it and/or modify #
|
||||
# it under the terms of the GNU General Public License version 2.0, #
|
||||
# as published by the Free Software Foundation. #
|
||||
# #
|
||||
# This program is distributed in the hope that it will be useful, #
|
||||
# but WITHOUT ANY WARRANTY; without even the implied warranty of #
|
||||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the #
|
||||
# GNU General Public License for more details. #
|
||||
# ==================================================================== #
|
||||
|
||||
#' Key antibiotics for first \emph{weighted} isolates
|
||||
#'
|
||||
#' These function can be used to determine first isolates (see \code{\link{first_isolate}}). Using key antibiotics to determine first isolates is more reliable than without key antibiotics. These selected isolates will then be called first \emph{weighted} isolates.
|
||||
#' @param tbl table with antibiotics coloms, like \code{amox} and \code{amcl}.
|
||||
#' @inheritParams first_isolate
|
||||
#' @param amcl,amox,cfot,cfta,cfur,cipr,coli,eryt,gent,mero,oxac,pita,rifa,teic,tetr,tobr,trsu,vanc column names of antibiotics, case-insensitive
|
||||
#' @details The function \code{key_antibiotics} returns a character vector with antibiotic results.
|
||||
#'
|
||||
#' The antibiotics that are used for \strong{Gram positive bacteria} are (colum names): \cr
|
||||
#' amox, amcl, cfur, pita, cipr, trsu, vanc, teic, tetr, eryt, oxac, rifa.
|
||||
#'
|
||||
#' The antibiotics that are used for \strong{Gram negative bacteria} are (colum names): \cr
|
||||
#' amox, amcl, cfur, pita, cipr, trsu, gent, tobr, coli, cfot, cfta, mero.
|
||||
#'
|
||||
#'
|
||||
#' The function \code{key_antibiotics_equal} checks the characters returned by \code{key_antibiotics} for equality, and returns a logical value.
|
||||
#' @inheritSection first_isolate Key antibiotics
|
||||
#' @rdname key_antibiotics
|
||||
#' @export
|
||||
#' @importFrom dplyr %>% mutate if_else
|
||||
#' @seealso \code{\link{first_isolate}}
|
||||
#' @examples
|
||||
#' \dontrun{
|
||||
#' # set key antibiotics to a new variable
|
||||
#' tbl$keyab <- key_antibiotics(tbl)
|
||||
#'
|
||||
#' # add regular first isolates
|
||||
#' tbl$first_isolate <-
|
||||
#' first_isolate(tbl)
|
||||
#'
|
||||
#' # add first WEIGHTED isolates using key antibiotics
|
||||
#' tbl$first_isolate_weighed <-
|
||||
#' first_isolate(tbl,
|
||||
#' col_keyantibiotics = 'keyab')
|
||||
#' }
|
||||
key_antibiotics <- function(tbl,
|
||||
col_bactid = "bactid",
|
||||
amcl = "amcl",
|
||||
amox = "amox",
|
||||
cfot = "cfot",
|
||||
cfta = "cfta",
|
||||
cfur = "cfur",
|
||||
cipr = "cipr",
|
||||
coli = "coli",
|
||||
eryt = "eryt",
|
||||
gent = "gent",
|
||||
mero = "mero",
|
||||
oxac = "oxac",
|
||||
pita = "pita",
|
||||
rifa = "rifa",
|
||||
teic = "teic",
|
||||
tetr = "tetr",
|
||||
tobr = "tobr",
|
||||
trsu = "trsu",
|
||||
vanc = "vanc",
|
||||
info = TRUE) {
|
||||
|
||||
if (!col_bactid %in% colnames(tbl)) {
|
||||
stop('Column ', col_bactid, ' not found.', call. = FALSE)
|
||||
}
|
||||
|
||||
# check columns
|
||||
col.list <- c(amcl, amox, cfot, cfta, cfur, cipr,
|
||||
coli, eryt, gent, mero, oxac, pita,
|
||||
rifa, teic, tetr, tobr, trsu, vanc)
|
||||
col.list <- check_available_columns(tbl = tbl, col.list = col.list, info = info)
|
||||
amcl <- col.list[amcl]
|
||||
amox <- col.list[amox]
|
||||
cfot <- col.list[cfot]
|
||||
cfta <- col.list[cfta]
|
||||
cfur <- col.list[cfur]
|
||||
cipr <- col.list[cipr]
|
||||
coli <- col.list[coli]
|
||||
eryt <- col.list[eryt]
|
||||
gent <- col.list[gent]
|
||||
mero <- col.list[mero]
|
||||
oxac <- col.list[oxac]
|
||||
pita <- col.list[pita]
|
||||
rifa <- col.list[rifa]
|
||||
teic <- col.list[teic]
|
||||
tetr <- col.list[tetr]
|
||||
tobr <- col.list[tobr]
|
||||
trsu <- col.list[trsu]
|
||||
vanc <- col.list[vanc]
|
||||
|
||||
gram_positive = c(amox, amcl, cfur, pita, cipr, trsu,
|
||||
# specific for G+:
|
||||
vanc, teic, tetr, eryt, oxac, rifa)
|
||||
gram_positive <- gram_positive[!is.na(gram_positive)]
|
||||
|
||||
gram_negative = c(amox, amcl, cfur, pita, cipr, trsu,
|
||||
# specific for G-:
|
||||
gent, tobr, coli, cfot, cfta, mero)
|
||||
gram_negative <- gram_negative[!is.na(gram_negative)]
|
||||
|
||||
# join microorganisms
|
||||
tbl <- tbl %>% left_join_microorganisms(col_bactid)
|
||||
|
||||
tbl$key_ab <- NA_character_
|
||||
|
||||
# Gram +
|
||||
tbl <- tbl %>% mutate(key_ab =
|
||||
if_else(gramstain %like% '^Positive ',
|
||||
apply(X = tbl[, gram_positive],
|
||||
MARGIN = 1,
|
||||
FUN = function(x) paste(x, collapse = "")),
|
||||
key_ab))
|
||||
|
||||
# Gram -
|
||||
tbl <- tbl %>% mutate(key_ab =
|
||||
if_else(gramstain %like% '^Negative ',
|
||||
apply(X = tbl[, gram_negative],
|
||||
MARGIN = 1,
|
||||
FUN = function(x) paste(x, collapse = "")),
|
||||
key_ab))
|
||||
|
||||
# format
|
||||
key_abs <- tbl %>%
|
||||
pull(key_ab) %>%
|
||||
gsub('(NA|NULL)', '-', .)
|
||||
|
||||
key_abs
|
||||
|
||||
}
|
||||
|
||||
#' @importFrom dplyr progress_estimated %>%
|
||||
#' @rdname key_antibiotics
|
||||
#' @export
|
||||
key_antibiotics_equal <- function(x,
|
||||
y,
|
||||
type = c("keyantibiotics", "points"),
|
||||
ignore_I = TRUE,
|
||||
points_threshold = 2,
|
||||
info = FALSE) {
|
||||
# x is active row, y is lag
|
||||
type <- type[1]
|
||||
|
||||
if (length(x) != length(y)) {
|
||||
stop('Length of `x` and `y` must be equal.')
|
||||
}
|
||||
|
||||
result <- logical(length(x))
|
||||
|
||||
if (type == "keyantibiotics") {
|
||||
if (ignore_I == TRUE) {
|
||||
# evaluation using regular expression will treat '?' as any character
|
||||
# so I is actually ignored then
|
||||
x <- gsub('I', '?', x, ignore.case = TRUE)
|
||||
y <- gsub('I', '?', y, ignore.case = TRUE)
|
||||
}
|
||||
for (i in 1:length(x)) {
|
||||
result[i] <- grepl(x = x[i],
|
||||
pattern = y[i],
|
||||
ignore.case = TRUE) |
|
||||
grepl(x = y[i],
|
||||
pattern = x[i],
|
||||
ignore.case = TRUE)
|
||||
}
|
||||
return(result)
|
||||
} else {
|
||||
|
||||
if (info == TRUE) {
|
||||
p <- dplyr::progress_estimated(length(x))
|
||||
}
|
||||
|
||||
for (i in 1:length(x)) {
|
||||
|
||||
if (info == TRUE) {
|
||||
p$tick()$print()
|
||||
}
|
||||
|
||||
if (is.na(x[i])) {
|
||||
x[i] <- ''
|
||||
}
|
||||
if (is.na(y[i])) {
|
||||
y[i] <- ''
|
||||
}
|
||||
|
||||
if (nchar(x[i]) != nchar(y[i])) {
|
||||
|
||||
result[i] <- FALSE
|
||||
|
||||
} else if (x[i] == '' & y[i] == '') {
|
||||
|
||||
result[i] <- TRUE
|
||||
|
||||
} else {
|
||||
|
||||
x2 <- strsplit(x[i], "")[[1]]
|
||||
y2 <- strsplit(y[i], "")[[1]]
|
||||
|
||||
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)
|
||||
|
||||
suppressWarnings(x2 <- x2 %>% as.rsi() %>% as.double())
|
||||
suppressWarnings(y2 <- y2 %>% as.rsi() %>% as.double())
|
||||
|
||||
points <- (x2 - y2) %>% abs() %>% sum(na.rm = TRUE)
|
||||
result[i] <- ((points / 2) >= points_threshold)
|
||||
|
||||
} else {
|
||||
stop('`', type, '` is not a valid value for type, must be "points" or "keyantibiotics". See ?first_isolate.')
|
||||
}
|
||||
}
|
||||
}
|
||||
if (info == TRUE) {
|
||||
cat('\n')
|
||||
}
|
||||
result
|
||||
}
|
||||
}
|
||||
Reference in New Issue
Block a user