mirror of https://github.com/msberends/AMR
new antibiotics
parent
73f1ee1159
commit
68cc7ef0d0
@ -0,0 +1,242 @@
|
||||
# ==================================================================== #
|
||||
# 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.gitlab.io/AMR. #
|
||||
# ==================================================================== #
|
||||
|
||||
#' Transform to antibiotic ID
|
||||
#'
|
||||
#' Use this function to determine the antibiotic code of one or more antibiotics. The data set \code{\link{antibiotics}} will be searched for abbreviations, official names and synonyms (brand names).
|
||||
#' @param x character vector to determine to antibiotic ID
|
||||
#' @rdname as.ab
|
||||
#' @keywords atc
|
||||
#' @inheritSection WHOCC WHOCC
|
||||
#' @export
|
||||
#' @importFrom dplyr %>% filter slice pull
|
||||
#' @details Use the \code{\link{ab_property}} functions to get properties based on the returned ATC code, see Examples.
|
||||
#'
|
||||
#' In the ATC classification system, the active substances are classified in a hierarchy with five different levels. The system has fourteen main anatomical/pharmacological groups or 1st levels. Each ATC main group is divided into 2nd levels which could be either pharmacological or therapeutic groups. The 3rd and 4th levels are chemical, pharmacological or therapeutic subgroups and the 5th level is the chemical substance. The 2nd, 3rd and 4th levels are often used to identify pharmacological subgroups when that is considered more appropriate than therapeutic or chemical subgroups.
|
||||
#' Source: \url{https://www.whocc.no/atc/structure_and_principles/}
|
||||
#' @section Source:
|
||||
#' World Health Organization (WHO) Collaborating Centre for Drug Statistics Methodology: \url{https://www.whocc.no/atc_ddd_index/}
|
||||
#'
|
||||
#' WHONET 2019 software: \url{http://www.whonet.org/software.html}
|
||||
#'
|
||||
#' European Commission Public Health PHARMACEUTICALS - COMMUNITY REGISTER: \url{http://ec.europa.eu/health/documents/community-register/html/atc.htm}
|
||||
#' @return Character (vector) with class \code{"act"}. Unknown values will return \code{NA}.
|
||||
#' @seealso \code{\link{antibiotics}} for the dataframe that is being used to determine ATCs.
|
||||
#' @inheritSection AMR Read more on our website!
|
||||
#' @examples
|
||||
#' # These examples all return "ERY", the ID of Erythromycin:
|
||||
#' as.ab("J01FA01")
|
||||
#' as.ab("J 01 FA 01")
|
||||
#' as.ab("Erythromycin")
|
||||
#' as.ab("eryt")
|
||||
#' as.ab(" eryt 123")
|
||||
#' as.ab("ERYT")
|
||||
#' as.ab("ERY")
|
||||
#' as.ab("erytromicine") # spelled wrong
|
||||
#' as.ab("Erythrocin") # trade name
|
||||
#' as.ab("Romycin") # trade name
|
||||
#'
|
||||
#' # Use ab_* functions to get a specific properties (see ?ab_property);
|
||||
#' # they use as.ab() internally:
|
||||
#' ab_name("J01FA01") # "Erythromycin"
|
||||
#' ab_name("eryt") # "Erythromycin"
|
||||
as.ab <- function(x) {
|
||||
if (is.ab(x)) {
|
||||
return(x)
|
||||
}
|
||||
x_bak <- x
|
||||
# remove suffices
|
||||
x_bak_clean <- gsub("_(mic|rsi)$", "", x)
|
||||
# remove disk concentrations, like LVX_NM -> LVX
|
||||
x_bak_clean <- gsub("_[A-Z]{2}[0-9_]{0,3}$", "", x_bak_clean)
|
||||
# clean rest of it
|
||||
x_bak_clean <- gsub("[^a-zA-Z0-9/-]", "", x_bak_clean)
|
||||
# keep only a-z when it's not an ATC code or only numbers
|
||||
x_bak_clean[!x_bak_clean %like% "^([A-Z][0-9]{2}[A-Z]{2}[0-9]{2}|[0-9]+)$"] <- gsub("[^a-zA-Z]+",
|
||||
"",
|
||||
x_bak_clean[!x_bak_clean %like% "^([A-Z][0-9]{2}[A-Z]{2}[0-9]{2}|[0-9]+)$"])
|
||||
x <- unique(x_bak_clean)
|
||||
x_new <- rep(NA_character_, length(x))
|
||||
x_unknown <- character(0)
|
||||
|
||||
for (i in 1:length(x)) {
|
||||
if (is.na(x[i]) | is.null(x[i])) {
|
||||
next
|
||||
}
|
||||
if (identical(x[i], "")) {
|
||||
x_unknown <- c(x_unknown, x_bak[x[i] == x_bak_clean][1])
|
||||
next
|
||||
}
|
||||
|
||||
# exact AB code
|
||||
found <- AMR::antibiotics[which(AMR::antibiotics$ab == toupper(x[i])),]$ab
|
||||
if (length(found) > 0) {
|
||||
x_new[i] <- found[1L]
|
||||
next
|
||||
}
|
||||
|
||||
# exact ATC code
|
||||
found <- AMR::antibiotics[which(AMR::antibiotics$atc == toupper(x[i])),]$ab
|
||||
if (length(found) > 0) {
|
||||
x_new[i] <- found[1L]
|
||||
next
|
||||
}
|
||||
|
||||
# exact CID code
|
||||
found <- AMR::antibiotics[which(AMR::antibiotics$cid == x[i]),]$ab
|
||||
if (length(found) > 0) {
|
||||
x_new[i] <- found[1L]
|
||||
next
|
||||
}
|
||||
|
||||
# exact name
|
||||
found <- AMR::antibiotics[which(toupper(AMR::antibiotics$name) == toupper(x[i])),]$ab
|
||||
if (length(found) > 0) {
|
||||
x_new[i] <- found[1L]
|
||||
next
|
||||
}
|
||||
|
||||
# exact synonym
|
||||
synonym_found <- unlist(lapply(AMR::antibiotics$synonyms,
|
||||
function(s) if (toupper(x[i]) %in% toupper(s)) {
|
||||
TRUE
|
||||
} else {
|
||||
FALSE
|
||||
}))
|
||||
found <- AMR::antibiotics$ab[synonym_found == TRUE]
|
||||
if (length(found) > 0) {
|
||||
x_new[i] <- found[1L]
|
||||
next
|
||||
}
|
||||
|
||||
# exact abbreviation
|
||||
abbr_found <- unlist(lapply(AMR::antibiotics$abbreviations,
|
||||
function(a) if (toupper(x[i]) %in% toupper(a)) {
|
||||
TRUE
|
||||
} else {
|
||||
FALSE
|
||||
}))
|
||||
found <- AMR::antibiotics$ab[abbr_found == TRUE]
|
||||
if (length(found) > 0) {
|
||||
x_new[i] <- found[1L]
|
||||
next
|
||||
}
|
||||
|
||||
# first >=4 characters of name
|
||||
if (nchar(x[i]) >= 4) {
|
||||
found <- AMR::antibiotics[which(toupper(AMR::antibiotics$name) %like% paste0("^", x[i])),]$ab
|
||||
if (length(found) > 0) {
|
||||
x_new[i] <- found[1L]
|
||||
next
|
||||
}
|
||||
}
|
||||
|
||||
# allow characters that resemble others, but only continue when having more than 3 characters
|
||||
if (nchar(x[i]) <= 3) {
|
||||
x_unknown <- c(x_unknown, x_bak[x[i] == x_bak_clean][1])
|
||||
next
|
||||
}
|
||||
x_spelling <- x[i]
|
||||
x_spelling <- gsub("[iy]+", "[iy]+", x_spelling, ignore.case = TRUE)
|
||||
x_spelling <- gsub("[sz]+", "[sz]+", x_spelling, ignore.case = TRUE)
|
||||
x_spelling <- gsub("(c|k|q|qu)+", "(c|k|q|qu)+", x_spelling, ignore.case = TRUE)
|
||||
x_spelling <- gsub("(ph|f|v)+", "(ph|f|v)+", x_spelling, ignore.case = TRUE)
|
||||
x_spelling <- gsub("(th|t)+", "(th|t)+", x_spelling, ignore.case = TRUE)
|
||||
x_spelling <- gsub("a+", "a+", x_spelling, ignore.case = TRUE)
|
||||
x_spelling <- gsub("e+", "e+", x_spelling, ignore.case = TRUE)
|
||||
x_spelling <- gsub("o+", "o+", x_spelling, ignore.case = TRUE)
|
||||
# allow any ending of -in/-ine and -im/-ime
|
||||
x_spelling <- gsub("(\\[iy\\]\\+(n|m)|\\[iy\\]\\+(n|m)e\\+)$", "[iy]+(n|m)e*", x_spelling, ignore.case = TRUE)
|
||||
# allow any ending of -ol/-ole
|
||||
x_spelling <- gsub("(o\\+l|o\\+le\\+)$", "o+le*", x_spelling, ignore.case = TRUE)
|
||||
# try if name starts with it
|
||||
found <- AMR::antibiotics[which(AMR::antibiotics$name %like% paste0("^", x_spelling)),]$ab
|
||||
if (length(found) > 0) {
|
||||
x_new[i] <- found[1L]
|
||||
next
|
||||
}
|
||||
# and try if any synonym starts with it
|
||||
synonym_found <- unlist(lapply(AMR::antibiotics$synonyms,
|
||||
function(s) if (any(s %like% paste0("^", x_spelling))) {
|
||||
TRUE
|
||||
} else {
|
||||
FALSE
|
||||
}))
|
||||
found <- AMR::antibiotics$ab[synonym_found == TRUE]
|
||||
if (length(found) > 0) {
|
||||
x_new[i] <- found[1L]
|
||||
next
|
||||
}
|
||||
|
||||
# not found
|
||||
x_unknown <- c(x_unknown, x_bak[x[i] == x_bak_clean][1])
|
||||
}
|
||||
|
||||
if (length(x_unknown) > 0) {
|
||||
warning("These values could not be coerced to a valid antibiotic ID: ",
|
||||
paste('"', sort(unique(x_unknown)), '"', sep = "", collapse = ', '),
|
||||
".",
|
||||
call. = FALSE)
|
||||
}
|
||||
|
||||
x_result <- data.frame(x = x_bak_clean, stringsAsFactors = FALSE) %>%
|
||||
left_join(data.frame(x = x, x_new = x_new, stringsAsFactors = FALSE), by = "x") %>%
|
||||
pull(x_new)
|
||||
|
||||
structure(.Data = x_result,
|
||||
class = "ab")
|
||||
}
|
||||
|
||||
#' @rdname as.atc
|
||||
#' @export
|
||||
is.ab <- function(x) {
|
||||
identical(class(x), "ab")
|
||||
}
|
||||
|
||||
#' @exportMethod print.ab
|
||||
#' @export
|
||||
#' @noRd
|
||||
print.ab <- function(x, ...) {
|
||||
cat("Class 'ab'\n")
|
||||
print.default(as.character(x), quote = FALSE)
|
||||
}
|
||||
|
||||
#' @exportMethod as.data.frame.ab
|
||||
#' @export
|
||||
#' @noRd
|
||||
as.data.frame.ab <- function (x, ...) {
|
||||
# same as as.data.frame.character but with removed stringsAsFactors
|
||||
nm <- paste(deparse(substitute(x), width.cutoff = 500L),
|
||||
collapse = " ")
|
||||
if (!"nm" %in% names(list(...))) {
|
||||
as.data.frame.vector(x, ..., nm = nm)
|
||||
} else {
|
||||
as.data.frame.vector(x, ...)
|
||||
}
|
||||
}
|
||||
|
||||
#' @exportMethod pull.ab
|
||||
#' @export
|
||||
#' @importFrom dplyr pull
|
||||
#' @noRd
|
||||
pull.ab <- function(.data, ...) {
|
||||
pull(as.data.frame(.data), ...)
|
||||
}
|
||||
@ -0,0 +1,185 @@
|
||||
# ==================================================================== #
|
||||
# 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.gitlab.io/AMR. #
|
||||
# ==================================================================== #
|
||||
|
||||
#' Property of an antibiotic
|
||||
#'
|
||||
#' Use these functions to return a specific property of an antibiotic from the \code{\link{antibiotics}} data set. All input values will be evaluated internally with \code{\link{as.ab}}.
|
||||
#' @param x any (vector of) text that can be coerced to a valid microorganism code with \code{\link{as.ab}}
|
||||
#' @param tolower logical to indicate whether the first character of every output should be transformed to a lower case character. This will lead to e.g. "polymyxin B" and not "polymyxin b".
|
||||
#' @param property one of the column names of one of the \code{\link{antibiotics}} data set
|
||||
#' @param language language of the returned text, defaults to system language (see \code{\link{get_locale}}) and can also be set with \code{\link{getOption}("AMR_locale")}. Use \code{language = NULL} or \code{language = ""} to prevent translation.
|
||||
#' @param administration way of administration, either \code{"oral"} or \code{"iv"}
|
||||
#' @param units a logical to indicate whether the units instead of the DDDs itself must be returned, see Examples
|
||||
#' @param ... other parameters passed on to \code{\link{as.ab}}
|
||||
#' @details All output will be \link{translate}d where possible.
|
||||
#' @inheritSection as.ab Source
|
||||
#' @rdname ab_property
|
||||
#' @name ab_property
|
||||
#' @return \itemize{
|
||||
#' \item{An \code{integer} in case of \code{ab_cid}}
|
||||
#' \item{A named \code{list} in case of multiple \code{ab_synonyms}}
|
||||
#' \item{A \code{double} in case of \code{ab_ddd}}
|
||||
#' \item{A \code{character} in all other cases}
|
||||
#' }
|
||||
#' @export
|
||||
#' @seealso \code{\link{antibiotics}}
|
||||
#' @inheritSection AMR Read more on our website!
|
||||
#' @examples
|
||||
#' # all properties:
|
||||
#' ab_name("AMX") # "Amoxicillin"
|
||||
#' ab_atc("AMX") # J01CA04 (ATC code from the WHO)
|
||||
#' ab_cid("AMX") # 33613 (Compound ID from PubChem)
|
||||
#'
|
||||
#' ab_synonyms("AMX") # a list with brand names of amoxicillin
|
||||
#' ab_tradenames("AMX") # same
|
||||
#'
|
||||
#' ab_group("AMX") # "Beta-lactams/penicillins"
|
||||
#' ab_atc_group1("AMX") # "Beta-lactam antibacterials, penicillins"
|
||||
#' ab_atc_group2("AMX") # "Penicillins with extended spectrum"
|
||||
#'
|
||||
#' ab_name(x = c("AMC", "PLB")) # "Amoxicillin/clavulanic acid" "Polymyxin B"
|
||||
#' ab_name(x = c("AMC", "PLB"),
|
||||
#' tolower = TRUE) # "amoxicillin/clavulanic acid" "polymyxin B"
|
||||
#'
|
||||
#' ab_ddd("AMX", "oral") # 1
|
||||
#' ab_ddd("AMX", "oral", units = TRUE) # "g"
|
||||
#' ab_ddd("AMX", "iv") # 1
|
||||
#' ab_ddd("AMX", "iv", units = TRUE) # "g"
|
||||
#'
|
||||
#' # all ab_* functions use as.ab() internally:
|
||||
#' ab_name("Fluclox") # "Flucloxacillin"
|
||||
#' ab_name("fluklox") # "Flucloxacillin"
|
||||
#' ab_name("floxapen") # "Flucloxacillin"
|
||||
#' ab_name(21319) # "Flucloxacillin" (using CID)
|
||||
#' ab_name("J01CF05") # "Flucloxacillin" (using ATC)
|
||||
ab_name <- function(x, language = get_locale(), tolower = FALSE, ...) {
|
||||
x <- ab_validate(x = x, property = "name", ...)
|
||||
res <- t(x, language = language)
|
||||
if (tolower == TRUE) {
|
||||
# use perl to only transform the first character
|
||||
# as we want "polymyxin B", not "polymyxin b"
|
||||
res <- gsub("^([A-Z])", "\\L\\1", res, perl = TRUE)
|
||||
}
|
||||
res
|
||||
}
|
||||
|
||||
#' @rdname ab_property
|
||||
#' @export
|
||||
ab_atc <- function(x, ...) {
|
||||
ab_validate(x = x, property = "atc", ...)
|
||||
}
|
||||
|
||||
#' @rdname ab_property
|
||||
#' @export
|
||||
ab_cid <- function(x, ...) {
|
||||
ab_validate(x = x, property = "cid", ...)
|
||||
}
|
||||
|
||||
#' @rdname ab_property
|
||||
#' @export
|
||||
ab_synonyms <- function(x, ...) {
|
||||
syns <- ab_validate(x = x, property = "synonyms", ...)
|
||||
names(syns) <- x
|
||||
if (length(syns) == 1) {
|
||||
unname(unlist(syns))
|
||||
} else {
|
||||
syns
|
||||
}
|
||||
}
|
||||
|
||||
#' @rdname ab_property
|
||||
#' @export
|
||||
ab_tradenames <- function(x, ...) {
|
||||
ab_synonyms(x, ...)
|
||||
}
|
||||
|
||||
#' @rdname ab_property
|
||||
#' @export
|
||||
ab_group <- function(x, ...) {
|
||||
ab_validate(x = x, property = "group", ...)
|
||||
}
|
||||
|
||||
#' @rdname ab_property
|
||||
#' @export
|
||||
ab_atc_group1 <- function(x, ...) {
|
||||
ab_validate(x = x, property = "atc_group1", ...)
|
||||
}
|
||||
|
||||
#' @rdname ab_property
|
||||
#' @export
|
||||
ab_atc_group2 <- function(x, ...) {
|
||||
ab_validate(x = x, property = "atc_group2", ...)
|
||||
}
|
||||
|
||||
#' @rdname ab_property
|
||||
#' @export
|
||||
ab_ddd <- function(x, administration = "oral", units = FALSE, ...) {
|
||||
if (!administration %in% c("oral", "iv")) {
|
||||
stop("`administration` must be 'oral' or 'iv'", call. = FALSE)
|
||||
}
|
||||
ddd_prop <- administration
|
||||
if (units == TRUE) {
|
||||
ddd_prop <- paste0(ddd_prop, "_units")
|
||||
} else {
|
||||
ddd_prop <- paste0(ddd_prop, "_ddd")
|
||||
}
|
||||
ab_validate(x = x, property = ddd_prop, ...)
|
||||
}
|
||||
|
||||
#' @rdname ab_property
|
||||
#' @export
|
||||
ab_property <- function(x, property = 'name', language = get_locale(), ...) {
|
||||
if (length(property) != 1L) {
|
||||
stop("'property' must be of length 1.")
|
||||
}
|
||||
if (!property %in% colnames(AMR::antibiotics)) {
|
||||
stop("invalid property: '", property, "' - use a column name of the `antibiotics` data set")
|
||||
}
|
||||
|
||||
t(ab_validate(x = x, property = property, ...), language = language)
|
||||
}
|
||||
|
||||
ab_validate <- function(x, property, ...) {
|
||||
if (!"AMR" %in% base::.packages()) {
|
||||
library("AMR")
|
||||
# check onLoad() in R/zzz.R: data tables are created there.
|
||||
}
|
||||
|
||||
# try to catch an error when inputting an invalid parameter
|
||||
# so the 'call.' can be set to FALSE
|
||||
tryCatch(x[1L] %in% AMR::antibiotics[1, property],
|
||||
error = function(e) stop(e$message, call. = FALSE))
|
||||
|
||||
if (!all(x %in% AMR::antibiotics[, property])) {
|
||||
x <- data.frame(ab = as.ab(x), stringsAsFactors = FALSE) %>%
|
||||
left_join(antibiotics %>% select(c("ab", property)), by = "ab") %>%
|
||||
pull(property)
|
||||
}
|
||||
if (property %in% c("ab", "atc")) {
|
||||
return(structure(x, class = property))
|
||||
} else if (property == "cid") {
|
||||
return(as.integer(x))
|
||||
} else if (property %like% "ddd") {
|
||||
return(as.double(x))
|
||||
} else {
|
||||
return(x)
|
||||
}
|
||||
}
|
||||
@ -1,162 +0,0 @@
|
||||
# ==================================================================== #
|
||||
# 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.gitlab.io/AMR. #
|
||||
# ==================================================================== #
|
||||
|
||||
#' 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}}.
|
||||
#' @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}}.
|
||||
#' @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"}.
|
||||
#' @keywords ab antibiotics
|
||||
#' @source \code{\link{antibiotics}}
|
||||
#' @inheritSection WHOCC WHOCC
|
||||
#' @export
|
||||
#' @importFrom dplyr %>% pull
|
||||
#' @inheritSection AMR Read more on our website!
|
||||
#' @examples
|
||||
#' abname("AMCL")
|
||||
#' # "Amoxicillin and beta-lactamase 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"
|
||||
#'
|
||||
#' # specific codes for Certe:
|
||||
#' abname("J01CR02", from = "atc", to = "certe")
|
||||
#' # "amcl"
|
||||
abname <- function(abcode,
|
||||
from = c("guess", "atc", "certe", "umcg"),
|
||||
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)))
|
||||
}
|
||||
|
||||
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]
|
||||
next
|
||||
}
|
||||
}
|
||||
if (from %in% c("certe", "guess")) {
|
||||
if (abcode[i] %in% abx$certe) {
|
||||
abcode[i] <- abx[which(abx$certe == abcode[i]),] %>% pull(to) %>% .[1]
|
||||
next
|
||||
}
|
||||
}
|
||||
if (from %in% c("umcg", "guess")) {
|
||||
if (abcode[i] %in% abx$umcg) {
|
||||
abcode[i] <- abx[which(abx$umcg == abcode[i]),] %>% pull(to) %>% .[1]
|
||||
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]
|
||||
next
|
||||
}
|
||||
if (sum(abx$trade_name %like% abcode[i]) > 0) {
|
||||
abcode[i] <- abx[which(abx$trade_name %like% abcode[i]),] %>% pull(to) %>% .[1]
|
||||
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)
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
if (tolower == TRUE) {
|
||||
abcode <- abcode %>% tolower()
|
||||
}
|
||||
|
||||
abcode
|
||||
}
|
||||
@ -1,107 +0,0 @@
|
||||
# ==================================================================== #
|
||||
# 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.gitlab.io/AMR. #
|
||||
# ==================================================================== #
|
||||
|
||||
#' Property of an antibiotic
|
||||
#'
|
||||
#' Use these functions to return a specific property of an antibiotic from the \code{\link{antibiotics}} data set, based on their ATC code. Get such a code with \code{\link{as.atc}}.
|
||||
#' @param x a (vector of a) valid \code{\link{atc}} code or any text that can be coerced to a valid atc with \code{\link{as.atc}}
|
||||
#' @param property one of the column names of one of the \code{\link{antibiotics}} data set, like \code{"atc"} and \code{"official"}
|
||||
#' @param language language of the returned text, defaults to English (\code{"en"}) and can be set with \code{\link{getOption}("AMR_locale")}. Either one of \code{"en"} (English) or \code{"nl"} (Dutch).
|
||||
#' @rdname atc_property
|
||||
#' @return A vector of values. In case of \code{atc_tradenames}, if \code{x} is of length one, a vector will be returned. Otherwise a \code{\link{list}}, with \code{x} as names.
|
||||
#' @export
|
||||
#' @importFrom dplyr %>% left_join pull
|
||||
#' @seealso \code{\link{antibiotics}}
|
||||
#' @inheritSection AMR Read more on our website!
|
||||
#' @examples
|
||||
#' as.atc("amcl") # J01CR02
|
||||
#' atc_name("amcl") # Amoxicillin and beta-lactamase inhibitor
|
||||
#' atc_name("amcl", "nl") # Amoxicilline met enzymremmer
|
||||
#' atc_trivial_nl("amcl") # Amoxicilline/clavulaanzuur
|
||||
#' atc_certe("amcl") # amcl
|
||||
#' atc_umcg("amcl") # AMCL
|
||||
atc_property <- function(x, property = 'official') {
|
||||
property <- property[1]
|
||||
if (!property %in% colnames(AMR::antibiotics)) {
|
||||
stop("invalid property: ", property, " - use a column name of the `antibiotics` data set")
|
||||
}
|
||||
if (!is.atc(x)) {
|
||||
x <- as.atc(x) # this will give a warning if x cannot be coerced
|
||||
}
|
||||
suppressWarnings(
|
||||
data.frame(atc = x, stringsAsFactors = FALSE) %>%
|
||||
left_join(AMR::antibiotics, by = "atc") %>%
|
||||
pull(property)
|
||||
)
|
||||
}
|
||||
|
||||
#' @rdname atc_property
|
||||
#' @export
|
||||
atc_official <- function(x, language = NULL) {
|
||||
|
||||
if (is.null(language)) {
|
||||
language <- getOption("AMR_locale", default = "en")[1L]
|
||||
} else {
|
||||
language <- tolower(language[1])
|
||||
}
|
||||
if (language %in% c("en", "")) {
|
||||
atc_property(x, "official")
|
||||
} else if (language == "nl") {
|
||||
atc_property(x, "official_nl")
|
||||
} else {
|
||||
stop("Unsupported language: '", language, "' - use one of: 'en', 'nl'", call. = FALSE)
|
||||
}
|
||||
}
|
||||
|
||||
#' @rdname atc_property
|
||||
#' @export
|
||||
atc_name <- atc_official
|
||||
|
||||
#' @rdname atc_property
|
||||
#' @export
|
||||
atc_trivial_nl <- function(x) {
|
||||
atc_property(x, "trivial_nl")
|
||||
}
|
||||
|
||||
#' @rdname atc_property
|
||||
#' @export
|
||||
atc_certe <- function(x) {
|
||||
atc_property(x, "certe")
|
||||
}
|
||||
|
||||
#' @rdname atc_property
|
||||
#' @export
|
||||
atc_umcg <- function(x) {
|
||||
atc_property(x, "umcg")
|
||||
}
|
||||
|
||||
#' @rdname atc_property
|
||||
#' @export
|
||||
atc_tradenames <- function(x) {
|
||||
res <- atc_property(x, "trade_name")
|
||||
res <- strsplit(res, "|", fixed = TRUE)
|
||||
if (length(x) == 1) {
|
||||
res <- unlist(res)
|
||||
} else {
|
||||
names(res) <- x
|
||||
}
|
||||
res
|
||||
}
|
||||
@ -0,0 +1,92 @@
|
||||
# ==================================================================== #
|
||||
# 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.gitlab.io/AMR. #
|
||||
# ==================================================================== #
|
||||
|
||||
#' Class 'disk'
|
||||
#'
|
||||
#' This transforms a vector to a new class \code{disk}, which is a growth zone size (around an antibiotic disk) in millimeters between 6 and 99.
|
||||
#' @rdname as.disk
|
||||
#' @param x vector
|
||||
#' @param na.rm a logical indicating whether missing values should be removed
|
||||
#' @details Interpret disk values as RSI values with \code{\link{as.rsi}}. It supports guidelines from EUCAST and CLSI.
|
||||
#' @return Ordered integer factor with new class \code{disk}
|
||||
#' @keywords disk
|
||||
#' @export
|
||||
#' @seealso \code{\link{as.rsi}}
|
||||
#' @inheritSection AMR Read more on our website!
|
||||
#' @examples
|
||||
#' # interpret disk values
|
||||
#' as.rsi(x = 12,
|
||||
#' mo = as.mo("S. pneumoniae"),
|
||||
#' ab = "AMX",
|
||||
#' guideline = "EUCAST")
|
||||
#' as.rsi(x = 12,
|
||||
#' mo = as.mo("S. pneumoniae"),
|
||||
#' ab = "AMX",
|
||||
#' guideline = "CLSI")
|
||||
as.disk <- function(x, na.rm = FALSE) {
|
||||
if (is.disk(x)) {
|
||||
x
|
||||
} else {
|
||||
x <- x %>% unlist()
|
||||
if (na.rm == TRUE) {
|
||||
x <- x[!is.na(x)]
|
||||
}
|
||||
x.bak <- x
|
||||
|
||||
na_before <- length(x[is.na(x)])
|
||||
|
||||
# force it to be integer
|
||||
x <- suppressWarnings(as.integer(x))
|
||||
|
||||
# disks can never be less than 9 mm (size of a disk) or more than 50 mm
|
||||
x[x < 6 | x > 99] <- NA_integer_
|
||||
na_after <- length(x[is.na(x)])
|
||||
|
||||
if (na_before != na_after) {
|
||||
list_missing <- x.bak[is.na(x) & !is.na(x.bak)] %>%
|
||||
unique() %>%
|
||||
sort()
|
||||
list_missing <- paste0('"', list_missing , '"', collapse = ", ")
|
||||
warning(na_after - na_before, ' results truncated (',
|
||||
round(((na_after - na_before) / length(x)) * 100),
|
||||
'%) that were invalid disk zones: ',
|
||||
list_missing, call. = FALSE)
|
||||
}
|
||||
|
||||
class(x) <- c('disk', 'integer')
|
||||
x
|
||||
}
|
||||
}
|
||||
|
||||
#' @rdname as.disk
|
||||
#' @export
|
||||
#' @importFrom dplyr %>%
|
||||
is.disk <- function(x) {
|
||||
class(x) %>% identical(c('disk', 'integer'))
|
||||
}
|
||||
|
||||
#' @exportMethod print.disk
|
||||
#' @export
|
||||
#' @noRd
|
||||
print.disk <- function(x, ...) {
|
||||
cat("Class 'disk'\n")
|
||||
print(as.integer(x), quote = FALSE)
|
||||
}
|
||||