2018-08-13 11:00:53 +02:00
# ==================================================================== #
# 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. #
# ==================================================================== #
#' Name of an antibiotic
#'
2018-08-25 22:01:14 +02:00
#' Convert antibiotic codes to a (trivial) antibiotic name or ATC code, or vice versa. This uses the data from \code{\link{antibiotics}}.
2018-08-13 11:00:53 +02:00
#' @param abcode a code or name, like \code{"AMOX"}, \code{"AMCL"} or \code{"J01CA04"}
2018-08-25 22:01:14 +02:00
#' @param from,to type to transform from and to. See \code{\link{antibiotics}} for its column names. WIth \code{from = "guess"} the from will be guessed from \code{"atc"}, \code{"certe"} and \code{"umcg"}. When using \code{to = "atc"}, the ATC code will be searched using \code{\link{as.atc}}.
2018-08-13 11:00:53 +02:00
#' @param textbetween text to put between multiple returned texts
#' @param tolower return output as lower case with function \code{\link{tolower}}.
2018-08-29 12:27:37 +02:00
#' @details \strong{The \code{\link{ab_property}} functions are faster and more concise}, but do not support concatenated strings, like \code{abname("AMCL+GENT"}.
2018-08-13 11:00:53 +02:00
#' @keywords ab antibiotics
#' @source \code{\link{antibiotics}}
#' @export
#' @importFrom dplyr %>% pull
#' @examples
#' abname("AMCL")
2018-08-25 22:01:14 +02:00
#' # "Amoxicillin and beta-lactamase inhibitor"
2018-08-13 11:00:53 +02:00
#'
#' # It is quite flexible at default (having `from = "guess"`)
#' abname(c("amox", "J01CA04", "Trimox", "dispermox", "Amoxil"))
#' # "Amoxicillin" "Amoxicillin" "Amoxicillin" "Amoxicillin" "Amoxicillin"
#'
#' # Multiple antibiotics can be combined with "+".
#' # The second antibiotic will be set to lower case when `tolower` was not set:
#' abname("AMCL+GENT", textbetween = "/")
#' # "amoxicillin and enzyme inhibitor/gentamicin"
#'
#' abname(c("AMCL", "GENT"))
#' # "Amoxicillin and beta-lactamase inhibitor" "Gentamicin"
#'
#' abname("AMCL", to = "trivial_nl")
#' # "Amoxicilline/clavulaanzuur"
#'
#' abname("AMCL", to = "atc")
#' # "J01CR02"
#'
#' # specific codes for University Medical Center Groningen (UMCG):
#' abname("J01CR02", from = "atc", to = "umcg")
#' # "AMCL"
2018-08-25 22:01:14 +02:00
#'
#' # specific codes for Certe:
#' abname("J01CR02", from = "atc", to = "certe")
#' # "amcl"
2018-08-13 11:00:53 +02:00
abname <- function ( abcode ,
2018-08-25 22:01:14 +02:00
from = c ( " guess" , " atc" , " certe" , " umcg" ) ,
2018-08-13 11:00:53 +02:00
to = ' official' ,
textbetween = ' + ' ,
tolower = FALSE ) {
if ( length ( to ) != 1L ) {
stop ( ' `to` must be of length 1' , call. = FALSE )
}
if ( to == " atc" ) {
2018-08-25 22:01:14 +02:00
return ( as.character ( as.atc ( abcode ) ) )
2018-08-13 11:00:53 +02:00
}
abx <- AMR :: antibiotics
from <- from [1 ]
colnames ( abx ) <- colnames ( abx ) %>% tolower ( )
from <- from %>% tolower ( )
to <- to %>% tolower ( )
if ( ! ( from %in% colnames ( abx ) | from == " guess" ) |
! to %in% colnames ( abx ) ) {
stop ( paste0 ( ' Invalid `from` or `to`. Choose one of ' ,
colnames ( abx ) %>% paste ( collapse = " , " ) , ' .' ) , call. = FALSE )
}
abcode <- as.character ( abcode )
abcode.bak <- abcode
for ( i in 1 : length ( abcode ) ) {
if ( abcode [i ] %like% " [+]" ) {
# support for multiple ab's with +
parts <- trimws ( strsplit ( abcode [i ] , split = " +" , fixed = TRUE ) [ [1 ] ] )
ab1 <- abname ( parts [1 ] , from = from , to = to )
ab2 <- abname ( parts [2 ] , from = from , to = to )
if ( missing ( tolower ) ) {
ab2 <- tolower ( ab2 )
}
abcode [i ] <- paste0 ( ab1 , textbetween , ab2 )
next
}
if ( from %in% c ( " atc" , " guess" ) ) {
if ( abcode [i ] %in% abx $ atc ) {
2018-08-29 12:27:37 +02:00
abcode [i ] <- abx [which ( abx $ atc == abcode [i ] ) , ] %>% pull ( to ) %>% .[1 ]
2018-08-13 11:00:53 +02:00
next
}
}
2018-08-25 22:01:14 +02:00
if ( from %in% c ( " certe" , " guess" ) ) {
if ( abcode [i ] %in% abx $ certe ) {
2018-08-29 12:27:37 +02:00
abcode [i ] <- abx [which ( abx $ certe == abcode [i ] ) , ] %>% pull ( to ) %>% .[1 ]
2018-08-13 11:00:53 +02:00
next
}
}
if ( from %in% c ( " umcg" , " guess" ) ) {
if ( abcode [i ] %in% abx $ umcg ) {
2018-08-29 12:27:37 +02:00
abcode [i ] <- abx [which ( abx $ umcg == abcode [i ] ) , ] %>% pull ( to ) %>% .[1 ]
2018-08-13 11:00:53 +02:00
next
}
}
if ( from %in% c ( " trade_name" , " guess" ) ) {
if ( abcode [i ] %in% abx $ trade_name ) {
2018-08-29 12:27:37 +02:00
abcode [i ] <- abx [which ( abx $ trade_name == abcode [i ] ) , ] %>% pull ( to ) %>% .[1 ]
2018-08-13 11:00:53 +02:00
next
}
if ( sum ( abx $ trade_name %like% abcode [i ] ) > 0 ) {
2018-08-29 12:27:37 +02:00
abcode [i ] <- abx [which ( abx $ trade_name %like% abcode [i ] ) , ] %>% pull ( to ) %>% .[1 ]
2018-08-13 11:00:53 +02:00
next
}
}
if ( from != " guess" ) {
# when not found, try any `from`
abcode [i ] <- abx [which ( abx [ , from ] == abcode [i ] ) , ] %>% pull ( to ) %>% .[1 ]
}
if ( is.na ( abcode [i ] ) | length ( abcode [i ] == 0 ) ) {
2018-10-22 12:32:59 +02:00
# try as.atc
try ( suppressWarnings (
abcode [i ] <- as.atc ( abcode [i ] )
) , silent = TRUE )
if ( is.na ( abcode [i ] ) ) {
# still not found
abcode [i ] <- abcode.bak [i ]
warning ( ' Code "' , abcode.bak [i ] , ' " not found in antibiotics list.' , call. = FALSE )
} else {
# fill in the found ATC code
abcode [i ] <- abname ( abcode [i ] , from = " atc" , to = to )
}
2018-08-13 11:00:53 +02:00
}
}
if ( tolower == TRUE ) {
abcode <- abcode %>% tolower ( )
}
abcode
}