2019-03-05 22:47:42 +01:00
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Analysis #
# #
# SOURCE #
# https://gitlab.com/msberends/AMR #
# #
# LICENCE #
# (c) 2019 Berends MS (m.s.berends@umcg.nl), Luz CF (c.f.luz@umcg.nl) #
# #
# 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. #
# #
# This R package was created for academic research and was publicly #
# released in the hope that it will be useful, but it comes WITHOUT #
# ANY WARRANTY OR LIABILITY. #
# Visit our website for more info: https://msberends.gitab.io/AMR. #
# ==================================================================== #
#' Filter on antibiotic class
#'
#' Filter on specific antibiotic variables based on their class (ATC groups).
#' @param tbl a data set
#' @param ab_class an antimicrobial class, like \code{"carbapenems"}
#' @param result an antibiotic result: S, I or R (or a combination of more of them)
#' @param scope the scope to check which variables to check, can be \code{"any"} (default) or \code{"all"}
#' @param ... parameters passed on to \code{\link[dplyr]{filter_at}}
2019-03-06 09:32:48 +01:00
#' @details The \code{\link{antibiotics}} data set will be searched for \code{ab_class} in the columns \code{atc_group1} and \code{atc_group2} (case-insensitive). Next, \code{tbl} will be checked for column names with a value in any abbreviations, codes or official names found in the \code{antibiotics} data set.
2019-03-05 22:47:42 +01:00
#' @rdname filter_ab_class
2019-03-06 09:32:48 +01:00
#' @keywords filter fillter_class
2019-03-05 22:47:42 +01:00
#' @importFrom dplyr filter_at %>% select vars any_vars all_vars
#' @importFrom crayon bold blue
#' @export
#' @examples
#' library(dplyr)
#'
#' # filter on isolates that have any result for any aminoglycoside
#' septic_patients %>% filter_aminoglycosides()
#'
#' # this is essentially the same as:
#' septic_patients %>%
#' filter_at(.vars = vars(c("gent", "tobr", "amik", "kana")),
#' .vars_predicate = any_vars(. %in% c("S", "I", "R")))
#'
#'
#' # filter on isolates that show resistance to ANY aminoglycoside
#' septic_patients %>% filter_aminoglycosides("R")
#'
#' # filter on isolates that show resistance to ALL aminoglycosides
#' septic_patients %>% filter_aminoglycosides("R", "all")
#'
#' # filter on isolates that show resistance to
#' # any aminoglycoside and any fluoroquinolone
#' septic_patients %>%
#' filter_aminoglycosides("R", "any") %>%
#' filter_fluoroquinolones("R", "any")
filter_ab_class <- function ( tbl ,
ab_class ,
result = NULL ,
scope = " any" ,
... ) {
scope <- scope [1L ]
if ( is.null ( result ) ) {
result <- c ( " S" , " I" , " R" )
}
if ( ! all ( result %in% c ( " S" , " I" , " R" ) ) ) {
stop ( " `result` must be one or more of: S, I, R" , call. = FALSE )
}
if ( ! all ( scope %in% c ( " any" , " all" ) ) ) {
stop ( " `scope` must be one of: any, all" , call. = FALSE )
}
vars_df <- colnames ( tbl ) [tolower ( colnames ( tbl ) ) %in% tolower ( ab_class_vars ( ab_class ) ) ]
atc_groups <- ab_class_atcgroups ( ab_class )
if ( length ( vars_df ) > 0 ) {
if ( length ( result ) == 1 ) {
operator <- " is "
} else {
operator <- " is one of "
}
if ( scope == " any" ) {
scope_txt <- " or "
scope_fn <- any_vars
} else {
scope_txt <- " and "
scope_fn <- all_vars
}
message ( blue ( paste0 ( " Filtering on " , atc_groups , " : " , scope , " of " ,
2019-03-06 09:32:48 +01:00
paste ( bold ( paste0 ( " `" , vars_df , " `" ) ) , collapse = scope_txt ) , operator , toString ( result ) ) ) )
2019-03-05 22:47:42 +01:00
tbl %>%
filter_at ( .vars = vars ( vars_df ) ,
.vars_predicate = scope_fn ( . %in% result ) ,
... )
} else {
warning ( paste0 ( " no antibiotics of class " , atc_groups , " found, leaving data unchanged" ) , call. = FALSE )
tbl
}
}
#' @rdname filter_ab_class
#' @export
filter_aminoglycosides <- function ( tbl ,
result = NULL ,
scope = " any" ,
... ) {
filter_ab_class ( tbl = tbl ,
ab_class = " aminoglycoside" ,
result = result ,
scope = scope ,
... )
}
#' @rdname filter_ab_class
#' @export
filter_carbapenems <- function ( tbl ,
result = NULL ,
scope = " any" ,
... ) {
filter_ab_class ( tbl = tbl ,
ab_class = " carbapenem" ,
result = result ,
scope = scope ,
... )
}
#' @rdname filter_ab_class
#' @export
filter_cephalosporins <- function ( tbl ,
result = NULL ,
scope = " any" ,
... ) {
filter_ab_class ( tbl = tbl ,
ab_class = " cephalosporin" ,
result = result ,
scope = scope ,
... )
}
#' @rdname filter_ab_class
#' @export
filter_1st_cephalosporins <- function ( tbl ,
result = NULL ,
scope = " any" ,
... ) {
filter_ab_class ( tbl = tbl ,
ab_class = " first-generation cephalosporin" ,
result = result ,
scope = scope ,
... )
}
#' @rdname filter_ab_class
#' @export
filter_2nd_cephalosporins <- function ( tbl ,
result = NULL ,
scope = " any" ,
... ) {
filter_ab_class ( tbl = tbl ,
ab_class = " second-generation cephalosporin" ,
result = result ,
scope = scope ,
... )
}
#' @rdname filter_ab_class
#' @export
filter_3rd_cephalosporins <- function ( tbl ,
result = NULL ,
scope = " any" ,
... ) {
filter_ab_class ( tbl = tbl ,
ab_class = " third-generation cephalosporin" ,
result = result ,
scope = scope ,
... )
}
#' @rdname filter_ab_class
#' @export
filter_4th_cephalosporins <- function ( tbl ,
result = NULL ,
scope = " any" ,
... ) {
filter_ab_class ( tbl = tbl ,
ab_class = " fourth-generation cephalosporin" ,
result = result ,
scope = scope ,
... )
}
#' @rdname filter_ab_class
#' @export
filter_fluoroquinolones <- function ( tbl ,
result = NULL ,
scope = " any" ,
... ) {
filter_ab_class ( tbl = tbl ,
ab_class = " fluoroquinolone" ,
result = result ,
scope = scope ,
... )
}
#' @rdname filter_ab_class
#' @export
filter_glycopeptides <- function ( tbl ,
result = NULL ,
scope = " any" ,
... ) {
filter_ab_class ( tbl = tbl ,
ab_class = " glycopeptide" ,
result = result ,
scope = scope ,
... )
}
#' @rdname filter_ab_class
#' @export
filter_macrolides <- function ( tbl ,
result = NULL ,
scope = " any" ,
... ) {
filter_ab_class ( tbl = tbl ,
ab_class = " macrolide" ,
result = result ,
scope = scope ,
... )
}
#' @rdname filter_ab_class
#' @export
filter_tetracyclines <- function ( tbl ,
result = NULL ,
scope = " any" ,
... ) {
filter_ab_class ( tbl = tbl ,
ab_class = " tetracycline" ,
result = result ,
scope = scope ,
... )
}
#' @importFrom dplyr %>% filter_at any_vars select
ab_class_vars <- function ( ab_class ) {
ab_vars <- AMR :: antibiotics %>%
filter_at ( vars ( c ( " atc_group1" , " atc_group2" ) ) , any_vars ( . %like% ab_class ) ) %>%
select ( atc : trade_name ) %>%
as.matrix ( ) %>%
as.character ( ) %>%
paste ( collapse = " |" ) %>%
strsplit ( " |" , fixed = TRUE ) %>%
unlist ( ) %>%
unique ( )
ab_vars [ ! is.na ( ab_vars ) ]
}
#' @importFrom dplyr %>% filter pull
ab_class_atcgroups <- function ( ab_class ) {
AMR :: antibiotics %>%
filter ( atc %in% ab_class_vars ( ab_class ) ) %>%
pull ( " atc_group2" ) %>%
unique ( ) %>%
tolower ( ) %>%
paste ( collapse = " /" )
}