mirror of
https://github.com/msberends/AMR.git
synced 2025-07-10 00:23:03 +02:00
abname improvement, small fixes
This commit is contained in:
163
R/abname.R
Normal file
163
R/abname.R
Normal file
@ -0,0 +1,163 @@
|
||||
# ==================================================================== #
|
||||
# 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
|
||||
#'
|
||||
#' Convert antibiotic codes (from a laboratory information system like MOLIS or GLIMS) to a (trivial) antibiotic name or ATC code, or vice versa. This uses the data from \code{\link{antibiotics}}.
|
||||
#' @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{"molis"} and \code{"umcg"}. When using \code{to = "atc"}, the ATC code will be searched using \code{\link{guess_atc}}.
|
||||
#' @param textbetween text to put between multiple returned texts
|
||||
#' @param tolower return output as lower case with function \code{\link{tolower}}.
|
||||
#' @keywords ab antibiotics
|
||||
#' @source \code{\link{antibiotics}}
|
||||
#' @export
|
||||
#' @importFrom dplyr %>% pull
|
||||
#' @examples
|
||||
#' abname("AMCL")
|
||||
#' # "amoxicillin and enzyme inhibitor"
|
||||
#'
|
||||
#' # 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"
|
||||
abname <- function(abcode,
|
||||
from = c("guess", "atc", "molis", "umcg"),
|
||||
to = 'official',
|
||||
textbetween = ' + ',
|
||||
tolower = FALSE) {
|
||||
|
||||
if (length(to) != 1L) {
|
||||
stop('`to` must be of length 1', call. = FALSE)
|
||||
}
|
||||
|
||||
if (to == "atc") {
|
||||
return(guess_atc(abcode))
|
||||
}
|
||||
|
||||
#antibiotics <- AMR::antibiotics
|
||||
abx <- AMR::antibiotics
|
||||
|
||||
from <- from[1]
|
||||
# if (from == "guess") {
|
||||
# for (i in 1:3) {
|
||||
# if (abcode[1] %in% (antibiotics %>% pull(i))) {
|
||||
# from <- colnames(antibiotics)[i]
|
||||
# }
|
||||
# }
|
||||
# if (from == "guess") {
|
||||
# from <- "umcg"
|
||||
# }
|
||||
# }
|
||||
|
||||
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)
|
||||
next
|
||||
}
|
||||
}
|
||||
if (from %in% c("molis", "guess")) {
|
||||
if (abcode[i] %in% abx$molis) {
|
||||
abcode[i] <- abx[which(abx$molis == abcode[i]),] %>% pull(to)
|
||||
next
|
||||
}
|
||||
}
|
||||
if (from %in% c("umcg", "guess")) {
|
||||
if (abcode[i] %in% abx$umcg) {
|
||||
abcode[i] <- abx[which(abx$umcg == abcode[i]),] %>% pull(to)
|
||||
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)
|
||||
next
|
||||
}
|
||||
if (sum(abx$trade_name %like% abcode[i]) > 0) {
|
||||
abcode[i] <- abx[which(abx$trade_name %like% abcode[i]),] %>% pull(to)
|
||||
next
|
||||
}
|
||||
}
|
||||
|
||||
if (from != "guess") {
|
||||
# when not found, try any `from`
|
||||
abcode[i] <- abx[which(abx[,from] == abcode[i]),] %>% pull(to) %>% .[1]
|
||||
}
|
||||
|
||||
# when nothing found, try first chars of official name
|
||||
# if (is.na(abcode[i])) {
|
||||
# abcode[i] <- antibiotics %>%
|
||||
# filter(official %like% paste0('^', abcode.bak[i])) %>%
|
||||
# pull(to) %>%
|
||||
# .[1]
|
||||
# next
|
||||
# }
|
||||
|
||||
if (is.na(abcode[i]) | length(abcode[i] == 0)) {
|
||||
abcode[i] <- abcode.bak[i]
|
||||
warning('Code "', abcode.bak[i], '" not found in antibiotics list.', call. = FALSE)
|
||||
}
|
||||
}
|
||||
|
||||
if (tolower == TRUE) {
|
||||
abcode <- abcode %>% tolower()
|
||||
}
|
||||
|
||||
abcode
|
||||
}
|
||||
133
R/atc.R
133
R/atc.R
@ -203,139 +203,6 @@ atc_ddd <- function(atc_code, ...) {
|
||||
atc_property(atc_code = atc_code, property = "ddd", ...)
|
||||
}
|
||||
|
||||
#' Name of an antibiotic
|
||||
#'
|
||||
#' Convert antibiotic codes (from a laboratory information system like MOLIS or GLIMS) to a (trivial) antibiotic name or ATC code, or vice versa. This uses the data from \code{\link{antibiotics}}.
|
||||
#' @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{"molis"} and \code{"umcg"}. When using \code{to = "atc"}, the ATC code will be search using \code{\link{guess_atc}}.
|
||||
#' @param textbetween text to put between multiple returned texts
|
||||
#' @param tolower return output as lower case with function \code{\link{tolower}}.
|
||||
#' @keywords ab antibiotics
|
||||
#' @source \code{\link{antibiotics}}
|
||||
#' @export
|
||||
#' @importFrom dplyr %>% filter select slice
|
||||
#' @examples
|
||||
#' abname("AMCL")
|
||||
#' # "amoxicillin and enzyme inhibitor"
|
||||
#'
|
||||
#' abname("AMCL+GENT")
|
||||
#' # "amoxicillin and enzyme inhibitor + gentamicin"
|
||||
#'
|
||||
#' abname(c("AMCL", "GENT"))
|
||||
#' # "amoxicillin and enzyme inhibitor" "gentamicin"
|
||||
#'
|
||||
#' abname("AMCL", to = "trivial_nl")
|
||||
#' # "Amoxicilline/clavulaanzuur"
|
||||
#'
|
||||
#' abname("AMCL", to = "atc")
|
||||
#' # "J01CR02"
|
||||
#'
|
||||
#' abname("J01CR02", from = "atc", to = "umcg")
|
||||
#' # "AMCL"
|
||||
abname <- function(abcode, from = c("guess", "atc", "molis", "umcg"), to = 'official', textbetween = ' + ', tolower = FALSE) {
|
||||
|
||||
if (length(to) != 1L) {
|
||||
stop('`to` must be of length 1', call. = FALSE)
|
||||
}
|
||||
|
||||
if (to == "atc") {
|
||||
return(guess_atc(abcode))
|
||||
}
|
||||
|
||||
antibiotics <- AMR::antibiotics
|
||||
|
||||
from <- from[1]
|
||||
if (from == "guess") {
|
||||
for (i in 1:3) {
|
||||
if (abcode[1] %in% (antibiotics %>% pull(i))) {
|
||||
from <- colnames(antibiotics)[i]
|
||||
}
|
||||
}
|
||||
if (from == "guess") {
|
||||
from <- "umcg"
|
||||
}
|
||||
}
|
||||
|
||||
colnames(antibiotics) <- colnames(antibiotics) %>% tolower()
|
||||
from <- from %>% tolower()
|
||||
to <- to %>% tolower()
|
||||
|
||||
if (!from %in% colnames(antibiotics) |
|
||||
!to %in% colnames(antibiotics)) {
|
||||
stop(paste0('Invalid `from` or `to`. Choose one of ',
|
||||
colnames(antibiotics) %>% paste(collapse = ", "), '.'), call. = FALSE)
|
||||
}
|
||||
|
||||
abcode <- as.character(abcode)
|
||||
abcode.bak <- abcode
|
||||
|
||||
for (i in 1:length(abcode)) {
|
||||
abcode[i] <- abcode[i]
|
||||
if (!grepl('+', abcode[i], fixed = TRUE) & !grepl(' en ', abcode[i], fixed = TRUE)) {
|
||||
# only 1 drug
|
||||
if (abcode[i] %in% (antibiotics %>% pull(from))) {
|
||||
abcode[i] <-
|
||||
antibiotics %>%
|
||||
filter(.[, from] == abcode[i]) %>%
|
||||
select(to) %>%
|
||||
slice(1) %>%
|
||||
as.character()
|
||||
} else {
|
||||
# not found
|
||||
abcode[i] <- NA
|
||||
}
|
||||
} else {
|
||||
# more than 1 drug
|
||||
if (grepl('+', abcode[i], fixed = TRUE)) {
|
||||
abcode.group <-
|
||||
strsplit(abcode[i], '+', fixed = TRUE) %>%
|
||||
unlist() %>%
|
||||
trimws('both')
|
||||
} else if (grepl(' en ', abcode[i], fixed = TRUE)) {
|
||||
abcode.group <-
|
||||
strsplit(abcode[i], ' en ', fixed = TRUE) %>%
|
||||
unlist() %>%
|
||||
trimws('both')
|
||||
} else {
|
||||
warning('Invalid concat.')
|
||||
abcode[i] <- NA
|
||||
next
|
||||
}
|
||||
|
||||
for (j in 1:length(abcode.group)) {
|
||||
abcode.group[j] <-
|
||||
antibiotics %>%
|
||||
filter(.[, from] == abcode.group[j]) %>%
|
||||
select(to) %>%
|
||||
slice(1) %>%
|
||||
as.character()
|
||||
if (j > 1 & to %in% c('official', 'trivial_nl')) {
|
||||
abcode.group[j] <- abcode.group[j] %>% tolower()
|
||||
}
|
||||
}
|
||||
abcode[i] <- paste(abcode.group, collapse = textbetween)
|
||||
}
|
||||
|
||||
# when nothing found, try first chars of official name
|
||||
if (is.na(abcode[i])) {
|
||||
abcode[i] <- antibiotics %>%
|
||||
filter(official %like% paste0('^', abcode.bak[i])) %>%
|
||||
pull(to) %>%
|
||||
.[1]
|
||||
}
|
||||
if (is.na(abcode[i])) {
|
||||
warning('Code "', abcode.bak[i], '" not found in antibiotics list.', call. = FALSE)
|
||||
}
|
||||
}
|
||||
|
||||
if (tolower == TRUE) {
|
||||
abcode <- abcode %>% tolower()
|
||||
}
|
||||
|
||||
abcode
|
||||
}
|
||||
|
||||
|
||||
|
||||
#' Find ATC code based on antibiotic property
|
||||
#'
|
||||
|
||||
@ -71,7 +71,7 @@
|
||||
#' select(hospital_id, amox, cipr) %>%
|
||||
#' group_by(hospital_id) %>%
|
||||
#' ggplot_rsi() +
|
||||
#' facet_grid("hospital_id") +
|
||||
#' facet_wrap("hospital_id", nrow = 1) +
|
||||
#' labs(title = "AMR of Amoxicillin And Ciprofloxacine Per Hospital")
|
||||
ggplot_rsi <- function(data,
|
||||
position = "stack",
|
||||
|
||||
Reference in New Issue
Block a user