2020-06-17 01:39:30 +02:00
# ==================================================================== #
# TITLE #
2020-10-08 11:16:03 +02:00
# Antimicrobial Resistance (AMR) Analysis for R #
2020-06-17 01:39:30 +02:00
# #
# SOURCE #
2020-07-08 14:48:06 +02:00
# https://github.com/msberends/AMR #
2020-06-17 01:39:30 +02:00
# #
# LICENCE #
# (c) 2018-2020 Berends MS, Luz CF et al. #
2020-10-08 11:16:03 +02:00
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #
2020-06-17 01:39:30 +02:00
# #
# 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. #
2020-10-08 11:16:03 +02:00
# #
# Visit our website for the full manual and a complete tutorial about #
# how to conduct AMR analysis: https://msberends.github.io/AMR/ #
2020-06-17 01:39:30 +02:00
# ==================================================================== #
#' Antibiotic class selectors
#'
2020-08-26 16:13:40 +02:00
#' Use these selection helpers inside any function that allows [Tidyverse selection helpers](https://tidyselect.r-lib.org/reference/language.html), like `dplyr::select()` or `tidyr::pivot_longer()`. They help to select the columns of antibiotics that are of a specific antibiotic class, without the need to define the columns or antibiotic abbreviations.
2020-06-17 15:14:37 +02:00
#' @inheritParams filter_ab_class
2020-08-26 16:13:40 +02:00
#' @details All columns will be searched for known antibiotic names, abbreviations, brand names and codes (ATC, EARS-Net, WHO, etc.) in the [antibiotics] data set. This means that a selector like e.g. [aminoglycosides()] will pick up column names like 'gen', 'genta', 'J01GB03', 'tobra', 'Tobracin', etc.
2020-06-17 01:39:30 +02:00
#'
2020-08-26 16:13:40 +02:00
#' **N.B. These functions only work if the `tidyselect` package is installed**, that comes with the `dplyr` package. An error will be thrown if the `tidyselect` package is not installed, or if the functions are used outside a function that allows Tidyverse selections like `select()` or `pivot_longer()`.
2020-06-17 01:39:30 +02:00
#' @rdname antibiotic_class_selectors
#' @seealso [filter_ab_class()] for the `filter()` equivalent.
#' @name antibiotic_class_selectors
#' @export
2020-08-26 16:13:40 +02:00
#' @inheritSection AMR Reference data publicly available
2020-08-21 11:40:13 +02:00
#' @inheritSection AMR Read more on our website!
2020-06-17 01:39:30 +02:00
#' @examples
2020-09-29 23:35:46 +02:00
#' if (require("dplyr")) {
2020-06-17 01:39:30 +02:00
#'
#' # this will select columns 'IPM' (imipenem) and 'MEM' (meropenem):
#' example_isolates %>%
#' select(carbapenems())
#'
#' # this will select columns 'mo', 'AMK', 'GEN', 'KAN' and 'TOB':
#' example_isolates %>%
#' select(mo, aminoglycosides())
#'
2020-06-17 15:14:37 +02:00
#' # this will select columns 'mo' and all antimycobacterial drugs ('RIF'):
#' example_isolates %>%
#' select(mo, ab_class("mycobact"))
#'
#'
#' # get bug/drug combinations for only macrolides in Gram-positives:
#' example_isolates %>%
2020-11-16 11:03:24 +01:00
#' filter(mo_is_gram_positive()) %>%
2020-06-17 15:14:37 +02:00
#' select(mo, macrolides()) %>%
#' bug_drug_combinations() %>%
#' format()
#'
2020-06-17 01:39:30 +02:00
#'
2020-09-29 23:35:46 +02:00
#' data.frame(some_column = "some_value",
2020-06-17 01:39:30 +02:00
#' J01CA01 = "S") %>% # ATC code of ampicillin
2020-09-29 23:35:46 +02:00
#' select(penicillins()) # only the 'J01CA01' column will be selected
2020-06-17 15:14:37 +02:00
#'
2020-06-17 01:39:30 +02:00
#' }
2020-06-17 15:14:37 +02:00
ab_class <- function ( ab_class ) {
ab_selector ( ab_class , function_name = " ab_class" )
}
#' @rdname antibiotic_class_selectors
#' @export
2020-06-17 01:39:30 +02:00
aminoglycosides <- function ( ) {
2020-06-17 15:14:37 +02:00
ab_selector ( " aminoglycoside" , function_name = " aminoglycosides" )
2020-06-17 01:39:30 +02:00
}
#' @rdname antibiotic_class_selectors
#' @export
carbapenems <- function ( ) {
2020-06-17 15:14:37 +02:00
ab_selector ( " carbapenem" , function_name = " carbapenems" )
2020-06-17 01:39:30 +02:00
}
#' @rdname antibiotic_class_selectors
#' @export
cephalosporins <- function ( ) {
2020-06-17 15:14:37 +02:00
ab_selector ( " cephalosporin" , function_name = " cephalosporins" )
2020-06-17 01:39:30 +02:00
}
#' @rdname antibiotic_class_selectors
#' @export
cephalosporins_1st <- function ( ) {
2020-06-17 15:14:37 +02:00
ab_selector ( " cephalosporins.*1" , function_name = " cephalosporins_1st" )
2020-06-17 01:39:30 +02:00
}
#' @rdname antibiotic_class_selectors
#' @export
cephalosporins_2nd <- function ( ) {
2020-06-17 15:14:37 +02:00
ab_selector ( " cephalosporins.*2" , function_name = " cephalosporins_2nd" )
2020-06-17 01:39:30 +02:00
}
#' @rdname antibiotic_class_selectors
#' @export
cephalosporins_3rd <- function ( ) {
2020-06-17 15:14:37 +02:00
ab_selector ( " cephalosporins.*3" , function_name = " cephalosporins_3rd" )
2020-06-17 01:39:30 +02:00
}
#' @rdname antibiotic_class_selectors
#' @export
cephalosporins_4th <- function ( ) {
2020-06-17 15:14:37 +02:00
ab_selector ( " cephalosporins.*4" , function_name = " cephalosporins_4th" )
2020-06-17 01:39:30 +02:00
}
#' @rdname antibiotic_class_selectors
#' @export
cephalosporins_5th <- function ( ) {
2020-06-17 15:14:37 +02:00
ab_selector ( " cephalosporins.*5" , function_name = " cephalosporins_5th" )
2020-06-17 01:39:30 +02:00
}
#' @rdname antibiotic_class_selectors
#' @export
fluoroquinolones <- function ( ) {
2020-06-17 15:14:37 +02:00
ab_selector ( " fluoroquinolone" , function_name = " fluoroquinolones" )
2020-06-17 01:39:30 +02:00
}
#' @rdname antibiotic_class_selectors
#' @export
glycopeptides <- function ( ) {
2020-06-17 15:14:37 +02:00
ab_selector ( " glycopeptide" , function_name = " glycopeptides" )
2020-06-17 01:39:30 +02:00
}
#' @rdname antibiotic_class_selectors
#' @export
macrolides <- function ( ) {
2020-06-17 15:14:37 +02:00
ab_selector ( " macrolide" , function_name = " macrolides" )
2020-06-17 01:39:30 +02:00
}
#' @rdname antibiotic_class_selectors
#' @export
penicillins <- function ( ) {
2020-06-17 15:14:37 +02:00
ab_selector ( " penicillin" , function_name = " penicillins" )
2020-06-17 01:39:30 +02:00
}
#' @rdname antibiotic_class_selectors
#' @export
tetracyclines <- function ( ) {
2020-06-17 15:14:37 +02:00
ab_selector ( " tetracycline" , function_name = " tetracyclines" )
2020-06-17 01:39:30 +02:00
}
2020-06-17 15:14:37 +02:00
ab_selector <- function ( ab_class , function_name ) {
2020-10-19 17:09:19 +02:00
meet_criteria ( ab_class , allow_class = " character" , has_length = 1 , .call_depth = 1 )
meet_criteria ( function_name , allow_class = " character" , has_length = 1 , .call_depth = 1 )
2020-06-17 15:14:37 +02:00
peek_vars_tidyselect <- import_fn ( " peek_vars" , " tidyselect" )
vars_vct <- peek_vars_tidyselect ( fn = function_name )
2020-11-11 16:49:27 +01:00
vars_df <- data.frame ( as.list ( vars_vct ) , stringsAsFactors = FALSE ) [1 , , drop = FALSE ]
2020-06-17 01:39:30 +02:00
colnames ( vars_df ) <- vars_vct
2020-09-24 00:30:11 +02:00
ab_in_data <- get_column_abx ( vars_df , info = FALSE )
2020-06-17 15:14:37 +02:00
2020-06-17 01:39:30 +02:00
if ( length ( ab_in_data ) == 0 ) {
2020-10-27 15:56:51 +01:00
message_ ( " No antimicrobial agents found." )
2020-06-17 01:39:30 +02:00
return ( NULL )
}
2020-06-17 15:14:37 +02:00
2020-06-17 01:39:30 +02:00
ab_reference <- subset ( antibiotics ,
group %like% ab_class |
atc_group1 %like% ab_class |
atc_group2 %like% ab_class )
ab_group <- find_ab_group ( ab_class )
2020-06-17 15:14:37 +02:00
if ( ab_group == " " ) {
ab_group <- paste0 ( " '" , ab_class , " '" )
examples <- " "
} else {
examples <- paste0 ( " (such as " , find_ab_names ( ab_class , 2 ) , " )" )
}
2020-06-17 01:39:30 +02:00
# get the columns with a group names in the chosen ab class
agents <- ab_in_data [names ( ab_in_data ) %in% ab_reference $ ab ]
if ( length ( agents ) == 0 ) {
2020-10-27 15:56:51 +01:00
message_ ( " No antimicrobial agents of class " , ab_group , " found" , examples , " ." )
2020-06-17 01:39:30 +02:00
} else {
2020-10-27 15:56:51 +01:00
message_ ( " Selecting " , ab_group , " : " ,
paste ( paste0 ( " `" , font_bold ( agents , collapse = NULL ) ,
" ` (" , ab_name ( names ( agents ) , tolower = TRUE , language = NULL ) , " )" ) ,
collapse = " , " ) ,
as_note = FALSE )
2020-06-17 01:39:30 +02:00
}
unname ( agents )
}