AMR/R/abname.R

163 lines
6.1 KiB
R
Raw Normal View History

2018-08-13 11:00:53 +02:00
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Analysis #
# #
2019-01-02 23:24:07 +01:00
# SOURCE #
# https://gitlab.com/msberends/AMR #
2018-08-13 11:00:53 +02:00
# #
# LICENCE #
2019-01-02 23:24:07 +01:00
# (c) 2019 Berends MS (m.s.berends@umcg.nl), Luz CF (c.f.luz@umcg.nl) #
2018-08-13 11:00:53 +02:00
# #
2019-01-02 23:24:07 +01: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. #
# #
# 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. #
2018-08-13 11:00:53 +02:00
# ==================================================================== #
#' Name of an antibiotic
#'
#' 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"}
#' @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}}.
#' @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}}
2019-01-25 13:18:41 +01:00
#' @inheritSection WHOCC WHOCC
2018-08-13 11:00:53 +02:00
#' @export
#' @importFrom dplyr %>% pull
2019-01-02 23:24:07 +01:00
#' @inheritSection AMR Read more on our website!
2018-08-13 11:00:53 +02:00
#' @examples
#' abname("AMCL")
#' # "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"
#'
#' # specific codes for Certe:
#' abname("J01CR02", from = "atc", to = "certe")
#' # "amcl"
2018-08-13 11:00:53 +02:00
abname <- function(abcode,
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") {
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) {
abcode[i] <- abx[which(abx$atc == abcode[i]),] %>% pull(to) %>% .[1]
2018-08-13 11:00:53 +02:00
next
}
}
if (from %in% c("certe", "guess")) {
if (abcode[i] %in% abx$certe) {
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) {
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) {
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) {
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)) {
# 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
}