1
0
mirror of https://github.com/msberends/AMR.git synced 2025-07-08 14:01:55 +02:00

Implement extensive support for antiviral agents support (#77)

This commit is contained in:
Dr. Matthijs Berends
2022-11-13 08:46:10 +01:00
committed by GitHub
parent d2edcf51ad
commit 496c08d851
46 changed files with 1966 additions and 1563 deletions

21
R/ab.R
View File

@ -82,8 +82,8 @@
#'
#' # use ab_* functions to get a specific properties (see ?ab_property);
#' # they use as.ab() internally:
#' ab_name("J01FA01") # "Erythromycin"
#' ab_name("eryt") # "Erythromycin"
#' ab_name("J01FA01")
#' ab_name("eryt")
#'
#' \donttest{
#' if (require("dplyr")) {
@ -650,3 +650,20 @@ generalise_antibiotic_name <- function(x) {
x <- gsub("(/| AND | WITH | W/|[+]|[-])+", " ", x, perl = TRUE)
x
}
get_translate_ab <- function(translate_ab) {
translate_ab <- as.character(translate_ab)[1L]
if (translate_ab %in% c("TRUE", "official")) {
return("name")
} else if (translate_ab %in% c(NA_character_, "FALSE")) {
return(FALSE)
} else {
translate_ab <- tolower(translate_ab)
stop_ifnot(translate_ab %in% colnames(AMR::antibiotics),
"invalid value for 'translate_ab', this must be a column name of the antibiotics data set\n",
"or TRUE (equals 'name') or FALSE to not translate at all.",
call = FALSE
)
translate_ab
}
}

View File

@ -59,7 +59,7 @@
#' @examples
#' # mind the bad spelling of amoxicillin in this line,
#' # straight from a true health care record:
#' ab_from_text("28/03/2020 regular amoxicilliin 500mg po tds")
#' ab_from_text("28/03/2020 regular amoxicilliin 500mg po tid")
#'
#' ab_from_text("500 mg amoxi po and 400mg cipro iv")
#' ab_from_text("500 mg amoxi po and 400mg cipro iv", type = "dose")

View File

@ -59,38 +59,35 @@
#' @inheritSection AMR Reference Data Publicly Available
#' @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_url("AMX") # link to the official WHO page
#' ab_name("AMX")
#' ab_atc("AMX")
#' ab_cid("AMX")
#' ab_synonyms("AMX")
#' ab_tradenames("AMX")
#' ab_group("AMX")
#' ab_atc_group1("AMX")
#' ab_atc_group2("AMX")
#' ab_url("AMX")
#'
#' # smart lowercase tranformation
#' 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_name(x = c("AMC", "PLB"))
#' ab_name(x = c("AMC", "PLB"), tolower = TRUE)
#'
#' # defined daily doses (DDD)
#' ab_ddd("AMX", "oral") # 1.5
#' ab_ddd_units("AMX", "oral") # "g"
#' ab_ddd("AMX", "iv") # 3
#' ab_ddd_units("AMX", "iv") # "g"
#' ab_ddd("AMX", "oral")
#' ab_ddd_units("AMX", "oral")
#' ab_ddd("AMX", "iv")
#' ab_ddd_units("AMX", "iv")
#'
#' ab_info("AMX") # all properties as a list
#'
#' # all ab_* functions use as.ab() internally, so you can go from 'any' to 'any':
#' ab_atc("AMP") # ATC code of AMP (ampicillin)
#' ab_group("J01CA01") # Drug group of ampicillins ATC code
#' ab_loinc("ampicillin") # LOINC codes of ampicillin
#' ab_name("21066-6") # "Ampicillin" (using LOINC)
#' ab_name(6249) # "Ampicillin" (using CID)
#' ab_name("J01CA01") # "Ampicillin" (using ATC)
#' ab_atc("AMP")
#' ab_group("J01CA01")
#' ab_loinc("ampicillin")
#' ab_name("21066-6")
#' ab_name(6249)
#' ab_name("J01CA01")
#'
#' # spelling from different languages and dyslexia are no problem
#' ab_atc("ceftriaxon")
@ -244,20 +241,7 @@ ab_ddd <- function(x, administration = "oral", ...) {
meet_criteria(administration, is_in = c("oral", "iv"), has_length = 1)
x <- as.ab(x, ...)
ddd_prop <- administration
# old behaviour
units <- list(...)$units
if (!is.null(units) && isTRUE(units)) {
if (message_not_thrown_before("ab_ddd", entire_session = TRUE)) {
warning_(
"in `ab_ddd()`: using `ab_ddd(..., units = TRUE)` is deprecated, use `ab_ddd_units()` to retrieve units instead.",
"This warning will be shown once per session."
)
}
ddd_prop <- paste0(ddd_prop, "_units")
} else {
ddd_prop <- paste0(ddd_prop, "_ddd")
}
ddd_prop <- paste0(administration, "_ddd")
out <- ab_validate(x = x, property = ddd_prop)
if (any(ab_name(x, language = NULL) %like% "/" & is.na(out))) {
@ -277,16 +261,17 @@ ab_ddd_units <- function(x, administration = "oral", ...) {
meet_criteria(administration, is_in = c("oral", "iv"), has_length = 1)
x <- as.ab(x, ...)
if (any(ab_name(x, language = NULL) %like% "/")) {
ddd_prop <- paste0(administration, "_units")
out <- ab_validate(x = x, property = ddd_prop)
if (any(ab_name(x, language = NULL) %like% "/" & is.na(out))) {
warning_(
"in `ab_ddd_units()`: DDDs of combined products are available for different dose combinations and not (yet) part of the AMR package.",
"in `ab_ddd_units()`: DDDs of some combined products are available for different dose combinations and not (yet) part of the AMR package.",
"Please refer to the WHOCC website:\n",
"www.whocc.no/ddd/list_of_ddds_combined_products/"
)
}
ddd_prop <- paste0(administration, "_units")
ab_validate(x = x, property = ddd_prop)
out
}
#' @rdname ab_property

View File

@ -36,7 +36,7 @@
#'
#' This work was published in the Journal of Statistical Software (Volume 104(3); \doi{10.18637/jss.v104.i03}) and formed the basis of two PhD theses (\doi{10.33612/diss.177417131} and \doi{10.33612/diss.192486375}).
#'
#' After installing this package, \R knows `r format_included_data_number(microorganisms)` distinct microbial species and all `r format_included_data_number(rbind(antibiotics[, "atc", drop = FALSE], antivirals[, "atc", drop = FALSE]))` antibiotic, antimycotic and antiviral drugs by name and code (including ATC, EARS-NET, LOINC and SNOMED CT), and knows all about valid R/SI and MIC values. It supports any data format, including WHONET/EARS-Net data.
#' After installing this package, \R knows `r format_included_data_number(microorganisms)` distinct microbial species and all `r format_included_data_number(rbind(antibiotics[, "name", drop = FALSE], antivirals[, "name", drop = FALSE]))` antibiotic, antimycotic and antiviral drugs by name and code (including ATC, EARS-NET, LOINC and SNOMED CT), and knows all about valid R/SI and MIC values. It supports any data format, including WHONET/EARS-Net data.
#'
#' This package is fully independent of any other \R package and works on Windows, macOS and Linux with all versions of \R since R-3.0.0 (April 2013). It was designed to work in any setting, including those with very limited resources. It was created for both routine data analysis and academic research at the Faculty of Medical Sciences of the University of Groningen, in collaboration with non-profit organisations Certe Medical Diagnostics and Advice and University Medical Center Groningen. This \R package is actively maintained and free software; you can freely use and distribute it for both personal and commercial (but not patent) purposes under the terms of the GNU General Public License version 2.0 (GPL-2), as published by the Free Software Foundation.
#'

613
R/av.R Executable file
View File

@ -0,0 +1,613 @@
# ==================================================================== #
# TITLE #
# AMR: An R Package for Working with Antimicrobial Resistance Data #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# CITE AS #
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
# Data. Journal of Statistical Software, 104(3), 1-31. #
# doi:10.18637/jss.v104.i03 #
# #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #
# #
# 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. #
# #
# Visit our website for the full manual and a complete tutorial about #
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== #
#' Transform Input to an Antiviral Agent ID
#'
#' Use this function to determine the antiviral agent code of one or more antiviral agents. The data set [antivirals] will be searched for abbreviations, official names and synonyms (brand names).
#' @param x a [character] vector to determine to antiviral agent ID
#' @param flag_multiple_results a [logical] to indicate whether a note should be printed to the console that probably more than one antiviral agent code or name can be retrieved from a single input value.
#' @param info a [logical] to indicate whether a progress bar should be printed, defaults to `TRUE` only in interactive mode
#' @param ... arguments passed on to internal functions
#' @rdname as.av
#' @inheritSection WHOCC WHOCC
#' @details All entries in the [antivirals] data set have three different identifiers: a human readable EARS-Net code (column `ab`, used by ECDC and WHONET), an ATC code (column `atc`, used by WHO), and a CID code (column `cid`, Compound ID, used by PubChem). The data set contains more than 5,000 official brand names from many different countries, as found in PubChem. Not that some drugs contain multiple ATC codes.
#'
#' All these properties will be searched for the user input. The [as.av()] can correct for different forms of misspelling:
#'
#' * Wrong spelling of drug names (such as "acyclovir"), which corrects for most audible similarities such as f/ph, x/ks, c/z/s, t/th, etc.
#' * Too few or too many vowels or consonants
#' * Switching two characters (such as "aycclovir", often the case in clinical data, when doctors typed too fast)
#' * Digitalised paper records, leaving artefacts like 0/o/O (zero and O's), B/8, n/r, etc.
#'
#' Use the [`av_*`][av_property()] functions to get properties based on the returned antiviral agent ID, see *Examples*.
#'
#' Note: the [as.av()] and [`av_*`][av_property()] functions may use very long regular expression to match brand names of antimicrobial agents. This may fail on some systems.
#' @section Source:
#' World Health Organization (WHO) Collaborating Centre for Drug Statistics Methodology: \url{https://www.whocc.no/atc_ddd_index/}
#'
#' European Commission Public Health PHARMACEUTICALS - COMMUNITY REGISTER: \url{https://ec.europa.eu/health/documents/community-register/html/reg_hum_atc.htm}
#' @aliases av
#' @return A [character] [vector] with additional class [`ab`]
#' @seealso
#' * [antivirals] for the [data.frame] that is being used to determine ATCs
#' * [av_from_text()] for a function to retrieve antimicrobial drugs from clinical text (from health care records)
#' @inheritSection AMR Reference Data Publicly Available
#' @export
#' @examples
#' # these examples all return "ACI", the ID of aciclovir:
#' as.av("J05AB01")
#' as.av("J 05 AB 01")
#' as.av("Aciclovir")
#' as.av("aciclo")
#' as.av(" aciclo 123")
#' as.av("ACICL")
#' as.av("ACI")
#' as.av("Virorax") # trade name
#' as.av("Zovirax") # trade name
#'
#' as.av("acyklofir") # severe spelling error, yet works
#'
#' # use av_* functions to get a specific properties (see ?av_property);
#' # they use as.av() internally:
#' av_name("J05AB01")
#' av_name("acicl")
as.av <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) {
meet_criteria(x, allow_class = c("character", "numeric", "integer", "factor"), allow_NA = TRUE)
meet_criteria(flag_multiple_results, allow_class = "logical", has_length = 1)
meet_criteria(info, allow_class = "logical", has_length = 1)
if (is.av(x)) {
return(x)
}
if (all(x %in% c(AMR_env$AV_lookup$av, NA))) {
# all valid AB codes, but not yet right class
return(set_clean_class(x,
new_class = c("av", "character")
))
}
initial_search <- is.null(list(...)$initial_search)
already_regex <- isTRUE(list(...)$already_regex)
fast_mode <- isTRUE(list(...)$fast_mode)
x_bak <- x
x <- toupper(x)
# remove diacritics
x <- iconv(x, from = "UTF-8", to = "ASCII//TRANSLIT")
x <- gsub('"', "", x, fixed = TRUE)
x <- gsub("(specimen|specimen date|specimen_date|spec_date|gender|^dates?$)", "", x, ignore.case = TRUE, perl = TRUE)
x_bak_clean <- x
if (already_regex == FALSE) {
x_bak_clean <- generalise_antibiotic_name(x_bak_clean)
}
x <- unique(x_bak_clean) # this means that every x is in fact generalise_antibiotic_name(x)
x_new <- rep(NA_character_, length(x))
x_unknown <- character(0)
x_unknown_ATCs <- character(0)
note_if_more_than_one_found <- function(found, index, from_text) {
if (initial_search == TRUE && isTRUE(length(from_text) > 1)) {
avnames <- av_name(from_text, tolower = TRUE, initial_search = FALSE)
if (av_name(found[1L], language = NULL) %like% "(clavulanic acid|avibactam)") {
avnames <- avnames[!avnames %in% c("clavulanic acid", "avibactam")]
}
if (length(avnames) > 1) {
warning_(
"More than one result was found for item ", index, ": ",
vector_and(avnames, quotes = FALSE)
)
}
}
found[1L]
}
# Fill in names, AB codes, CID codes and ATC codes directly (`x` is already clean and uppercase)
known_names <- x %in% AMR_env$AV_lookup$generalised_name
x_new[known_names] <- AMR_env$AV_lookup$av[match(x[known_names], AMR_env$AV_lookup$generalised_name)]
known_codes_av <- x %in% AMR_env$AV_lookup$av
known_codes_atc <- vapply(FUN.VALUE = logical(1), x, function(x_) x_ %in% unlist(AMR_env$AV_lookup$atc), USE.NAMES = FALSE)
known_codes_cid <- x %in% AMR_env$AV_lookup$cid
x_new[known_codes_av] <- AMR_env$AV_lookup$av[match(x[known_codes_av], AMR_env$AV_lookup$av)]
x_new[known_codes_atc] <- AMR_env$AV_lookup$av[vapply(
FUN.VALUE = integer(1),
x[known_codes_atc],
function(x_) {
which(vapply(
FUN.VALUE = logical(1),
AMR_env$AV_lookup$atc,
function(atc) x_ %in% atc
))[1L]
},
USE.NAMES = FALSE
)]
x_new[known_codes_cid] <- AMR_env$AV_lookup$av[match(x[known_codes_cid], AMR_env$AV_lookup$cid)]
previously_coerced <- x %in% AMR_env$av_previously_coerced$x
x_new[previously_coerced & is.na(x_new)] <- AMR_env$av_previously_coerced$av[match(x[is.na(x_new) & x %in% AMR_env$av_previously_coerced$x], AMR_env$av_previously_coerced$x)]
already_known <- known_names | known_codes_av | known_codes_atc | known_codes_cid | previously_coerced
# fix for NAs
x_new[is.na(x)] <- NA
already_known[is.na(x)] <- FALSE
if (initial_search == TRUE && sum(already_known) < length(x)) {
progress <- progress_ticker(n = sum(!already_known), n_min = 25, print = info) # start if n >= 25
on.exit(close(progress))
}
for (i in which(!already_known)) {
if (initial_search == TRUE) {
progress$tick()
}
if (is.na(x[i]) || is.null(x[i])) {
next
}
if (identical(x[i], "") ||
# prevent "bacteria" from coercing to TMP, since Bacterial is a brand name of it:
identical(tolower(x[i]), "bacteria")) {
x_unknown <- c(x_unknown, x_bak[x[i] == x_bak_clean][1])
next
}
if (x[i] %like_case% "[A-Z][0-9][0-9][A-Z][A-Z][0-9][0-9]") {
# seems an ATC code, but the available ones are in `already_known`, so:
x_unknown <- c(x_unknown, x[i])
x_unknown_ATCs <- c(x_unknown_ATCs, x[i])
x_new[i] <- NA_character_
next
}
if (fast_mode == FALSE && flag_multiple_results == TRUE && x[i] %like% "[ ]") {
from_text <- tryCatch(suppressWarnings(av_from_text(x[i], initial_search = FALSE, translate_av = FALSE)[[1]]),
error = function(e) character(0)
)
} else {
from_text <- character(0)
}
# old code for phenoxymethylpenicillin (Peni V)
if (x[i] == "PNV") {
x_new[i] <- "PHN"
next
}
# exact LOINC code
loinc_found <- unlist(lapply(
AMR_env$AV_lookup$generalised_loinc,
function(s) x[i] %in% s
))
found <- AMR_env$AV_lookup$av[loinc_found == TRUE]
if (length(found) > 0) {
x_new[i] <- note_if_more_than_one_found(found, i, from_text)
next
}
# exact synonym
synonym_found <- unlist(lapply(
AMR_env$AV_lookup$generalised_synonyms,
function(s) x[i] %in% s
))
found <- AMR_env$AV_lookup$av[synonym_found == TRUE]
if (length(found) > 0) {
x_new[i] <- note_if_more_than_one_found(found, i, from_text)
next
}
# length of input is quite long, and Levenshtein distance is only max 2
if (nchar(x[i]) >= 10) {
levenshtein <- as.double(utils::adist(x[i], AMR_env$AV_lookup$generalised_name))
if (any(levenshtein <= 2)) {
found <- AMR_env$AV_lookup$av[which(levenshtein <= 2)]
x_new[i] <- note_if_more_than_one_found(found, i, from_text)
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]
if (already_regex == FALSE) {
x_spelling <- gsub("[IY]+", "[IY]+", x_spelling, perl = TRUE)
x_spelling <- gsub("(C|K|Q|QU|S|Z|X|KS)+", "(C|K|Q|QU|S|Z|X|KS)+", x_spelling, perl = TRUE)
x_spelling <- gsub("(PH|F|V)+", "(PH|F|V)+", x_spelling, perl = TRUE)
x_spelling <- gsub("(TH|T)+", "(TH|T)+", x_spelling, perl = TRUE)
x_spelling <- gsub("A+", "A+", x_spelling, perl = TRUE)
x_spelling <- gsub("E+", "E+", x_spelling, perl = TRUE)
x_spelling <- gsub("O+", "O+", x_spelling, perl = 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, perl = TRUE)
# allow any ending of -ol/-ole
x_spelling <- gsub("(O\\+L|O\\+LE\\+)$", "O+LE*", x_spelling, perl = TRUE)
# allow any ending of -on/-one
x_spelling <- gsub("(O\\+N|O\\+NE\\+)$", "O+NE*", x_spelling, perl = TRUE)
# replace multiple same characters to single one with '+', like "ll" -> "l+"
x_spelling <- gsub("(.)\\1+", "\\1+", x_spelling, perl = TRUE)
# replace spaces and slashes with a possibility on both
x_spelling <- gsub("[ /]", "( .*|.*/)", x_spelling, perl = TRUE)
# correct for digital reading text (OCR)
x_spelling <- gsub("[NRD8B]", "[NRD8B]", x_spelling, perl = TRUE)
x_spelling <- gsub("(O|0)", "(O|0)+", x_spelling, perl = TRUE)
x_spelling <- gsub("++", "+", x_spelling, fixed = TRUE)
}
# try if name starts with it
found <- AMR_env$AV_lookup[which(AMR_env$AV_lookup$generalised_name %like% paste0("^", x_spelling)), "av", drop = TRUE]
if (length(found) > 0) {
x_new[i] <- note_if_more_than_one_found(found, i, from_text)
next
}
# try if name ends with it
found <- AMR_env$AV_lookup[which(AMR_env$AV_lookup$generalised_name %like% paste0(x_spelling, "$")), "av", drop = TRUE]
if (nchar(x[i]) >= 4 && length(found) > 0) {
x_new[i] <- note_if_more_than_one_found(found, i, from_text)
next
}
# and try if any synonym starts with it
synonym_found <- unlist(lapply(
AMR_env$AV_lookup$generalised_synonyms,
function(s) any(s %like% paste0("^", x_spelling))
))
found <- AMR_env$AV_lookup$av[synonym_found == TRUE]
if (length(found) > 0) {
x_new[i] <- note_if_more_than_one_found(found, i, from_text)
next
}
# INITIAL SEARCH - More uncertain results ----
if (initial_search == TRUE && fast_mode == FALSE) {
# only run on first try
# try by removing all spaces
if (x[i] %like% " ") {
found <- suppressWarnings(as.av(gsub(" +", "", x[i], perl = TRUE), initial_search = FALSE))
if (length(found) > 0 && !is.na(found)) {
x_new[i] <- note_if_more_than_one_found(found, i, from_text)
next
}
}
# try by removing all spaces and numbers
if (x[i] %like% " " || x[i] %like% "[0-9]") {
found <- suppressWarnings(as.av(gsub("[ 0-9]", "", x[i], perl = TRUE), initial_search = FALSE))
if (length(found) > 0 && !is.na(found)) {
x_new[i] <- note_if_more_than_one_found(found, i, from_text)
next
}
}
# transform back from other languages and try again
x_translated <- paste(lapply(
strsplit(x[i], "[^A-Z0-9]"),
function(y) {
for (i in seq_len(length(y))) {
for (lang in LANGUAGES_SUPPORTED[LANGUAGES_SUPPORTED != "en"]) {
y[i] <- ifelse(tolower(y[i]) %in% tolower(TRANSLATIONS[, lang, drop = TRUE]),
TRANSLATIONS[which(tolower(TRANSLATIONS[, lang, drop = TRUE]) == tolower(y[i]) &
!isFALSE(TRANSLATIONS$fixed)), "pattern"],
y[i]
)
}
}
generalise_antibiotic_name(y)
}
)[[1]],
collapse = "/"
)
x_translated_guess <- suppressWarnings(as.av(x_translated, initial_search = FALSE))
if (!is.na(x_translated_guess)) {
x_new[i] <- x_translated_guess
next
}
# now also try to coerce brandname combinations like "Amoxy/clavulanic acid"
x_translated <- paste(lapply(
strsplit(x_translated, "[^A-Z0-9 ]"),
function(y) {
for (i in seq_len(length(y))) {
y_name <- suppressWarnings(av_name(y[i], language = NULL, initial_search = FALSE))
y[i] <- ifelse(!is.na(y_name),
y_name,
y[i]
)
}
generalise_antibiotic_name(y)
}
)[[1]],
collapse = "/"
)
x_translated_guess <- suppressWarnings(as.av(x_translated, initial_search = FALSE))
if (!is.na(x_translated_guess)) {
x_new[i] <- x_translated_guess
next
}
# try by removing all trailing capitals
if (x[i] %like_case% "[a-z]+[A-Z]+$") {
found <- suppressWarnings(as.av(gsub("[A-Z]+$", "", x[i], perl = TRUE), initial_search = FALSE))
if (!is.na(found)) {
x_new[i] <- note_if_more_than_one_found(found, i, from_text)
next
}
}
# keep only letters
found <- suppressWarnings(as.av(gsub("[^A-Z]", "", x[i], perl = TRUE), initial_search = FALSE))
if (!is.na(found)) {
x_new[i] <- note_if_more_than_one_found(found, i, from_text)
next
}
# try from a bigger text, like from a health care record, see ?av_from_text
# already calculated above if flag_multiple_results = TRUE
if (flag_multiple_results == TRUE) {
found <- from_text[1L]
} else {
found <- tryCatch(suppressWarnings(av_from_text(x[i], initial_search = FALSE, translate_av = FALSE)[[1]][1L]),
error = function(e) NA_character_
)
}
if (!is.na(found)) {
x_new[i] <- note_if_more_than_one_found(found, i, from_text)
next
}
# first 5
found <- suppressWarnings(as.av(substr(x[i], 1, 5), initial_search = FALSE))
if (!is.na(found)) {
x_new[i] <- note_if_more_than_one_found(found, i, from_text)
next
}
# make all consonants facultative
search_str <- gsub("([BCDFGHJKLMNPQRSTVWXZ])", "\\1*", x[i], perl = TRUE)
found <- suppressWarnings(as.av(search_str, initial_search = FALSE, already_regex = TRUE))
# keep at least 4 normal characters
if (nchar(gsub(".\\*", "", search_str, perl = TRUE)) < 4) {
found <- NA
}
if (!is.na(found)) {
x_new[i] <- note_if_more_than_one_found(found, i, from_text)
next
}
# make all vowels facultative
search_str <- gsub("([AEIOUY])", "\\1*", x[i], perl = TRUE)
found <- suppressWarnings(as.av(search_str, initial_search = FALSE, already_regex = TRUE))
# keep at least 5 normal characters
if (nchar(gsub(".\\*", "", search_str, perl = TRUE)) < 5) {
found <- NA
}
if (!is.na(found)) {
x_new[i] <- note_if_more_than_one_found(found, i, from_text)
next
}
# allow misspelling of vowels
x_spelling <- gsub("A+", "[AEIOU]+", x_spelling, fixed = TRUE)
x_spelling <- gsub("E+", "[AEIOU]+", x_spelling, fixed = TRUE)
x_spelling <- gsub("I+", "[AEIOU]+", x_spelling, fixed = TRUE)
x_spelling <- gsub("O+", "[AEIOU]+", x_spelling, fixed = TRUE)
x_spelling <- gsub("U+", "[AEIOU]+", x_spelling, fixed = TRUE)
found <- suppressWarnings(as.av(x_spelling, initial_search = FALSE, already_regex = TRUE))
if (!is.na(found)) {
x_new[i] <- note_if_more_than_one_found(found, i, from_text)
next
}
# try with switched character, like "mreopenem"
for (j in seq_len(nchar(x[i]))) {
x_switched <- paste0(
# beginning part:
substr(x[i], 1, j - 1),
# here is the switching of 2 characters:
substr(x[i], j + 1, j + 1),
substr(x[i], j, j),
# ending part:
substr(x[i], j + 2, nchar(x[i]))
)
found <- suppressWarnings(as.av(x_switched, initial_search = FALSE))
if (!is.na(found)) {
break
}
}
if (!is.na(found)) {
x_new[i] <- found[1L]
next
}
} # end of initial_search = TRUE
# not found
x_unknown <- c(x_unknown, x_bak[x[i] == x_bak_clean][1])
}
if (initial_search == TRUE && sum(already_known) < length(x)) {
close(progress)
}
# save to package env to save time for next time
if (initial_search == TRUE) {
AMR_env$av_previously_coerced <- AMR_env$av_previously_coerced[which(!AMR_env$av_previously_coerced$x %in% x), , drop = FALSE]
AMR_env$av_previously_coerced <- unique(rbind(AMR_env$av_previously_coerced,
data.frame(
x = x,
av = x_new,
x_bak = x_bak[match(x, x_bak_clean)],
stringsAsFactors = FALSE
),
stringsAsFactors = FALSE
))
}
# take failed ATC codes apart from rest
if (length(x_unknown_ATCs) > 0 && fast_mode == FALSE) {
warning_(
"in `as.av()`: these ATC codes are not (yet) in the antivirals data set: ",
vector_and(x_unknown_ATCs), "."
)
}
x_unknown <- x_unknown[!x_unknown %in% x_unknown_ATCs]
x_unknown <- c(x_unknown,
AMR_env$av_previously_coerced$x_bak[which(AMR_env$av_previously_coerced$x %in% x & is.na(AMR_env$av_previously_coerced$av))])
if (length(x_unknown) > 0 && fast_mode == FALSE) {
warning_(
"in `as.av()`: these values could not be coerced to a valid antiviral agent ID: ",
vector_and(x_unknown), "."
)
}
x_result <- x_new[match(x_bak_clean, x)]
if (length(x_result) == 0) {
x_result <- NA_character_
}
set_clean_class(x_result,
new_class = c("av", "character")
)
}
#' @rdname as.av
#' @export
is.av <- function(x) {
inherits(x, "av")
}
# will be exported using s3_register() in R/zzz.R
pillar_shaft.av <- function(x, ...) {
out <- trimws(format(x))
out[!is.na(x)] <- gsub("+", font_subtle("+"), out[!is.na(x)], fixed = TRUE)
out[is.na(x)] <- font_na(NA)
create_pillar_column(out, align = "left", min_width = 4)
}
# will be exported using s3_register() in R/zzz.R
type_sum.av <- function(x, ...) {
"av"
}
#' @method print av
#' @export
#' @noRd
print.av <- function(x, ...) {
cat("Class 'av'\n")
print(as.character(x), quote = FALSE)
}
#' @method as.data.frame av
#' @export
#' @noRd
as.data.frame.av <- function(x, ...) {
nm <- deparse1(substitute(x))
if (!"nm" %in% names(list(...))) {
as.data.frame.vector(as.av(x), ..., nm = nm)
} else {
as.data.frame.vector(as.av(x), ...)
}
}
#' @method [ av
#' @export
#' @noRd
"[.av" <- function(x, ...) {
y <- NextMethod()
attributes(y) <- attributes(x)
y
}
#' @method [[ av
#' @export
#' @noRd
"[[.av" <- function(x, ...) {
y <- NextMethod()
attributes(y) <- attributes(x)
y
}
#' @method [<- av
#' @export
#' @noRd
"[<-.av" <- function(i, j, ..., value) {
y <- NextMethod()
attributes(y) <- attributes(i)
return_after_integrity_check(y, "antiviral agent code", AMR_env$AV_lookup$av)
}
#' @method [[<- av
#' @export
#' @noRd
"[[<-.av" <- function(i, j, ..., value) {
y <- NextMethod()
attributes(y) <- attributes(i)
return_after_integrity_check(y, "antiviral agent code", AMR_env$AV_lookup$av)
}
#' @method c av
#' @export
#' @noRd
c.av <- function(...) {
x <- list(...)[[1L]]
y <- NextMethod()
attributes(y) <- attributes(x)
return_after_integrity_check(y, "antiviral agent code", AMR_env$AV_lookup$av)
}
#' @method unique av
#' @export
#' @noRd
unique.av <- function(x, incomparables = FALSE, ...) {
y <- NextMethod()
attributes(y) <- attributes(x)
y
}
#' @method rep av
#' @export
#' @noRd
rep.av <- function(x, ...) {
y <- NextMethod()
attributes(y) <- attributes(x)
y
}
get_translate_av <- function(translate_av) {
translate_av <- as.character(translate_av)[1L]
if (translate_av %in% c("TRUE", "official")) {
return("name")
} else if (translate_av %in% c(NA_character_, "FALSE")) {
return(FALSE)
} else {
translate_av <- tolower(translate_av)
stop_ifnot(translate_av %in% colnames(AMR::antivirals),
"invalid value for 'translate_av', this must be a column name of the antivirals data set\n",
"or TRUE (equals 'name') or FALSE to not translate at all.",
call = FALSE
)
translate_av
}
}

186
R/av_from_text.R Normal file
View File

@ -0,0 +1,186 @@
# ==================================================================== #
# TITLE #
# AMR: An R Package for Working with Antimicrobial Resistance Data #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# CITE AS #
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
# Data. Journal of Statistical Software, 104(3), 1-31. #
# doi:10.18637/jss.v104.i03 #
# #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #
# #
# 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. #
# #
# Visit our website for the full manual and a complete tutorial about #
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== #
#' Retrieve Antiviral Drug Names and Doses from Clinical Text
#'
#' Use this function on e.g. clinical texts from health care records. It returns a [list] with all antiviral drugs, doses and forms of administration found in the texts.
#' @param text text to analyse
#' @param type type of property to search for, either `"drug"`, `"dose"` or `"administration"`, see *Examples*
#' @param collapse a [character] to pass on to `paste(, collapse = ...)` to only return one [character] per element of `text`, see *Examples*
#' @param translate_av if `type = "drug"`: a column name of the [antivirals] data set to translate the antibiotic abbreviations to, using [av_property()]. Defaults to `FALSE`. Using `TRUE` is equal to using "name".
#' @param thorough_search a [logical] to indicate whether the input must be extensively searched for misspelling and other faulty input values. Setting this to `TRUE` will take considerably more time than when using `FALSE`. At default, it will turn `TRUE` when all input elements contain a maximum of three words.
#' @param info a [logical] to indicate whether a progress bar should be printed, defaults to `TRUE` only in interactive mode
#' @param ... arguments passed on to [as.av()]
#' @details This function is also internally used by [as.av()], although it then only searches for the first drug name and will throw a note if more drug names could have been returned. Note: the [as.av()] function may use very long regular expression to match brand names of antiviral agents. This may fail on some systems.
#'
#' ### Argument `type`
#' At default, the function will search for antiviral drug names. All text elements will be searched for official names, ATC codes and brand names. As it uses [as.av()] internally, it will correct for misspelling.
#'
#' With `type = "dose"` (or similar, like "dosing", "doses"), all text elements will be searched for [numeric] values that are higher than 100 and do not resemble years. The output will be [numeric]. It supports any unit (g, mg, IE, etc.) and multiple values in one clinical text, see *Examples*.
#'
#' With `type = "administration"` (or abbreviations, like "admin", "adm"), all text elements will be searched for a form of drug administration. It supports the following forms (including common abbreviations): buccal, implant, inhalation, instillation, intravenous, nasal, oral, parenteral, rectal, sublingual, transdermal and vaginal. Abbreviations for oral (such as 'po', 'per os') will become "oral", all values for intravenous (such as 'iv', 'intraven') will become "iv". It supports multiple values in one clinical text, see *Examples*.
#'
#' ### Argument `collapse`
#' Without using `collapse`, this function will return a [list]. This can be convenient to use e.g. inside a `mutate()`):\cr
#' `df %>% mutate(avx = av_from_text(clinical_text))`
#'
#' The returned AV codes can be transformed to official names, groups, etc. with all [`av_*`][av_property()] functions such as [av_name()] and [av_group()], or by using the `translate_av` argument.
#'
#' With using `collapse`, this function will return a [character]:\cr
#' `df %>% mutate(avx = av_from_text(clinical_text, collapse = "|"))`
#' @export
#' @return A [list], or a [character] if `collapse` is not `NULL`
#' @examples
#' av_from_text("28/03/2020 valaciclovir po tid")
#' av_from_text("28/03/2020 valaciclovir po tid", type = "admin")
av_from_text <- function(text,
type = c("drug", "dose", "administration"),
collapse = NULL,
translate_av = FALSE,
thorough_search = NULL,
info = interactive(),
...) {
if (missing(type)) {
type <- type[1L]
}
meet_criteria(text)
meet_criteria(type, allow_class = "character", has_length = 1)
meet_criteria(collapse, has_length = 1, allow_NULL = TRUE)
meet_criteria(translate_av, allow_NULL = FALSE) # get_translate_av() will be more informative about what's allowed
meet_criteria(thorough_search, allow_class = "logical", has_length = 1, allow_NULL = TRUE)
meet_criteria(info, allow_class = "logical", has_length = 1)
type <- tolower(trimws2(type))
text <- tolower(as.character(text))
text_split_all <- strsplit(text, "[ ;.,:\\|]")
progress <- progress_ticker(n = length(text_split_all), n_min = 5, print = info)
on.exit(close(progress))
if (type %like% "(drug|ab|anti)") {
translate_av <- get_translate_av(translate_av)
if (isTRUE(thorough_search) ||
(isTRUE(is.null(thorough_search)) && max(vapply(FUN.VALUE = double(1), text_split_all, length), na.rm = TRUE) <= 3)) {
text_split_all <- text_split_all[nchar(text_split_all) >= 4 & grepl("[a-z]+", text_split_all)]
result <- lapply(text_split_all, function(text_split) {
progress$tick()
suppressWarnings(
as.av(text_split, ...)
)
})
} else {
# no thorough search
names_atc <- substr(c(AMR::antivirals$name, AMR::antivirals$atc), 1, 5)
synonyms <- unlist(AMR::antivirals$synonyms)
synonyms <- synonyms[nchar(synonyms) >= 4]
# regular expression must not be too long, so split synonyms in two:
synonyms_part1 <- synonyms[seq_len(0.5 * length(synonyms))]
synonyms_part2 <- synonyms[!synonyms %in% synonyms_part1]
to_regex <- function(x) {
paste0(
"^(",
paste0(unique(gsub("[^a-z0-9]+", "", sort(tolower(x)))), collapse = "|"),
").*"
)
}
result <- lapply(text_split_all, function(text_split) {
progress$tick()
suppressWarnings(
as.av(
unique(c(
text_split[text_split %like_case% to_regex(names_atc)],
text_split[text_split %like_case% to_regex(synonyms_part1)],
text_split[text_split %like_case% to_regex(synonyms_part2)]
)),
...
)
)
})
}
close(progress)
result <- lapply(result, function(out) {
out <- out[!is.na(out)]
if (length(out) == 0) {
as.av(NA)
} else {
if (!isFALSE(translate_av)) {
out <- av_property(out, property = translate_av, initial_search = FALSE)
}
out
}
})
} else if (type %like% "dos") {
text_split_all <- strsplit(text, " ", fixed = TRUE)
result <- lapply(text_split_all, function(text_split) {
text_split <- text_split[text_split %like% "^[0-9]{2,}(/[0-9]+)?[a-z]*$"]
# only left part of "/", like 500 in "500/125"
text_split <- gsub("/.*", "", text_split)
text_split <- gsub(",", ".", text_split, fixed = TRUE) # foreign system using comma as decimal sep
text_split <- as.double(gsub("[^0-9.]", "", text_split))
# minimal 100 units/mg and no years that unlikely doses
text_split <- text_split[text_split >= 100 & !text_split %in% c(1951:1999, 2001:2049)]
if (length(text_split) > 0) {
text_split
} else {
NA_real_
}
})
} else if (type %like% "adm") {
result <- lapply(text_split_all, function(text_split) {
text_split <- text_split[text_split %like% "(^iv$|intraven|^po$|per os|oral|implant|inhal|instill|nasal|paren|rectal|sublingual|buccal|trans.*dermal|vaginal)"]
if (length(text_split) > 0) {
text_split <- gsub("(^po$|.*per os.*)", "oral", text_split)
text_split <- gsub("(^iv$|.*intraven.*)", "iv", text_split)
text_split
} else {
NA_character_
}
})
} else {
stop_("`type` must be either 'drug', 'dose' or 'administration'")
}
# collapse text if needed
if (!is.null(collapse)) {
result <- vapply(FUN.VALUE = character(1), result, function(x) {
if (length(x) == 1 & all(is.na(x))) {
NA_character_
} else {
paste0(x, collapse = collapse)
}
})
}
result
}

290
R/av_property.R Normal file
View File

@ -0,0 +1,290 @@
# ==================================================================== #
# TITLE #
# AMR: An R Package for Working with Antimicrobial Resistance Data #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# CITE AS #
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
# Data. Journal of Statistical Software, 104(3), 1-31. #
# doi:10.18637/jss.v104.i03 #
# #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #
# #
# 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. #
# #
# Visit our website for the full manual and a complete tutorial about #
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== #
#' Get Properties of an Antiviral Agent
#'
#' Use these functions to return a specific property of an antiviral agent from the [antivirals] data set. All input values will be evaluated internally with [as.av()].
#' @param x any (vector of) text that can be coerced to a valid antiviral agent code with [as.av()]
#' @param tolower a [logical] to indicate whether the first [character] of every output should be transformed to a lower case [character].
#' @param property one of the column names of one of the [antivirals] data set: `vector_or(colnames(antivirals), sort = FALSE)`.
#' @param language language of the returned text, defaults to system language (see [get_AMR_locale()]) and can also be set with `getOption("AMR_locale")`. Use `language = NULL` or `language = ""` to prevent translation.
#' @param administration way of administration, either `"oral"` or `"iv"`
#' @param open browse the URL using [utils::browseURL()]
#' @param ... other arguments passed on to [as.av()]
#' @details All output [will be translated][translate] where possible.
#'
#' The function [av_url()] will return the direct URL to the official WHO website. A warning will be returned if the required ATC code is not available.
#' @inheritSection as.av Source
#' @rdname av_property
#' @name av_property
#' @return
#' - An [integer] in case of [av_cid()]
#' - A named [list] in case of [av_info()] and multiple [av_atc()]/[av_synonyms()]/[av_tradenames()]
#' - A [double] in case of [av_ddd()]
#' - A [character] in all other cases
#' @export
#' @seealso [antivirals]
#' @inheritSection AMR Reference Data Publicly Available
#' @examples
#' # all properties:
#' av_name("ACI")
#' av_atc("ACI")
#' av_cid("ACI")
#' av_synonyms("ACI")
#' av_tradenames("ACI")
#' av_group("ACI")
#' av_url("ACI")
#'
#' # smart lowercase tranformation
#' av_name(x = c("ACI", "VALA"))
#' av_name(x = c("ACI", "VALA"), tolower = TRUE)
#'
#' # defined daily doses (DDD)
#' av_ddd("ACI", "oral")
#' av_ddd_units("ACI", "oral")
#' av_ddd("ACI", "iv")
#' av_ddd_units("ACI", "iv")
#'
#' av_info("ACI") # all properties as a list
#'
#' # all av_* functions use as.av() internally, so you can go from 'any' to 'any':
#' av_atc("ACI")
#' av_group("J05AB01")
#' av_loinc("abacavir")
#' av_name("29113-8")
#' av_name(135398513)
#' av_name("J05AB01")
av_name <- function(x, language = get_AMR_locale(), tolower = FALSE, ...) {
meet_criteria(x, allow_NA = TRUE)
language <- validate_language(language)
meet_criteria(tolower, allow_class = "logical", has_length = 1)
x <- translate_into_language(av_validate(x = x, property = "name", ...), language = language, only_affect_ab_names = TRUE)
if (tolower == TRUE) {
# use perl to only transform the first character
# as we want "polymyxin B", not "polymyxin b"
x <- gsub("^([A-Z])", "\\L\\1", x, perl = TRUE)
}
x
}
#' @rdname av_property
#' @export
av_cid <- function(x, ...) {
meet_criteria(x, allow_NA = TRUE)
av_validate(x = x, property = "cid", ...)
}
#' @rdname av_property
#' @export
av_synonyms <- function(x, ...) {
meet_criteria(x, allow_NA = TRUE)
syns <- av_validate(x = x, property = "synonyms", ...)
names(syns) <- x
if (length(syns) == 1) {
unname(unlist(syns))
} else {
syns
}
}
#' @rdname av_property
#' @export
av_tradenames <- function(x, ...) {
meet_criteria(x, allow_NA = TRUE)
av_synonyms(x, ...)
}
#' @rdname av_property
#' @export
av_group <- function(x, language = get_AMR_locale(), ...) {
meet_criteria(x, allow_NA = TRUE)
language <- validate_language(language)
translate_into_language(av_validate(x = x, property = "atc_group", ...), language = language, only_affect_ab_names = TRUE)
}
#' @rdname av_property
#' @export
av_atc <- function(x, ...) {
meet_criteria(x, allow_NA = TRUE)
# ATCs in the antivirals data set are not a list
av_validate(x = x, property = "atc", ...)
}
#' @rdname av_property
#' @export
av_loinc <- function(x, ...) {
meet_criteria(x, allow_NA = TRUE)
loincs <- av_validate(x = x, property = "loinc", ...)
names(loincs) <- x
if (length(loincs) == 1) {
unname(unlist(loincs))
} else {
loincs
}
}
#' @rdname av_property
#' @export
av_ddd <- function(x, administration = "oral", ...) {
meet_criteria(x, allow_NA = TRUE)
meet_criteria(administration, is_in = c("oral", "iv"), has_length = 1)
x <- as.av(x, ...)
ddd_prop <- paste0(administration, "_ddd")
out <- av_validate(x = x, property = ddd_prop)
if (any(av_name(x, language = NULL) %like% "/" & is.na(out))) {
warning_(
"in `av_ddd()`: DDDs of some combined products are available for different dose combinations and not (yet) part of the AMR package.",
"Please refer to the WHOCC website:\n",
"www.whocc.no/ddd/list_of_ddds_combined_products/"
)
}
out
}
#' @rdname av_property
#' @export
av_ddd_units <- function(x, administration = "oral", ...) {
meet_criteria(x, allow_NA = TRUE)
meet_criteria(administration, is_in = c("oral", "iv"), has_length = 1)
x <- as.av(x, ...)
ddd_prop <- paste0(administration, "_units")
out <- av_validate(x = x, property = ddd_prop)
if (any(av_name(x, language = NULL) %like% "/" & is.na(out))) {
warning_(
"in `av_ddd_units()`: DDDs of some combined products are available for different dose combinations and not (yet) part of the AMR package.",
"Please refer to the WHOCC website:\n",
"www.whocc.no/ddd/list_of_ddds_combined_products/"
)
}
out
}
#' @rdname av_property
#' @export
av_info <- function(x, language = get_AMR_locale(), ...) {
meet_criteria(x, allow_NA = TRUE)
language <- validate_language(language)
x <- as.av(x, ...)
list(
av = as.character(x),
cid = av_cid(x),
name = av_name(x, language = language),
group = av_group(x, language = language),
atc = av_atc(x),
tradenames = av_tradenames(x),
loinc = av_loinc(x),
ddd = list(
oral = list(
amount = av_ddd(x, administration = "oral"),
units = av_ddd_units(x, administration = "oral")
),
iv = list(
amount = av_ddd(x, administration = "iv"),
units = av_ddd_units(x, administration = "iv")
)
)
)
}
#' @rdname av_property
#' @export
av_url <- function(x, open = FALSE, ...) {
meet_criteria(x, allow_NA = TRUE)
meet_criteria(open, allow_class = "logical", has_length = 1)
av <- as.av(x = x, ...)
atcs <- av_atc(av, only_first = TRUE)
u <- paste0("https://www.whocc.no/atc_ddd_index/?code=", atcs, "&showdescription=no")
u[is.na(atcs)] <- NA_character_
names(u) <- av_name(av)
NAs <- av_name(av, tolower = TRUE, language = NULL)[!is.na(av) & is.na(atcs)]
if (length(NAs) > 0) {
warning_("in `av_url()`: no ATC code available for ", vector_and(NAs, quotes = FALSE), ".")
}
if (open == TRUE) {
if (length(u) > 1 && !is.na(u[1L])) {
warning_("in `av_url()`: only the first URL will be opened, as `browseURL()` only suports one string.")
}
if (!is.na(u[1L])) {
utils::browseURL(u[1L])
}
}
u
}
#' @rdname av_property
#' @export
av_property <- function(x, property = "name", language = get_AMR_locale(), ...) {
meet_criteria(x, allow_NA = TRUE)
meet_criteria(property, is_in = colnames(AMR::antivirals), has_length = 1)
meet_criteria(language, is_in = c(LANGUAGES_SUPPORTED, ""), has_length = 1, allow_NULL = TRUE, allow_NA = TRUE)
translate_into_language(av_validate(x = x, property = property, ...), language = language)
}
av_validate <- function(x, property, ...) {
if (tryCatch(all(x[!is.na(x)] %in% AMR_env$AV_lookup$av), error = function(e) FALSE)) {
# special case for av_* functions where class is already 'av'
x <- AMR_env$AV_lookup[match(x, AMR_env$AV_lookup$av), property, drop = TRUE]
} else {
# try to catch an error when inputting an invalid argument
# so the 'call.' can be set to FALSE
tryCatch(x[1L] %in% AMR_env$AV_lookup[1, property, drop = TRUE],
error = function(e) stop(e$message, call. = FALSE)
)
if (!all(x %in% AMR_env$AV_lookup[, property, drop = TRUE])) {
x <- as.av(x, ...)
if (all(is.na(x)) && is.list(AMR_env$AV_lookup[, property, drop = TRUE])) {
x <- rep(NA_character_, length(x))
} else {
x <- AMR_env$AV_lookup[match(x, AMR_env$AV_lookup$av), property, drop = TRUE]
}
}
}
if (property == "av") {
return(set_clean_class(x, new_class = c("av", "character")))
} else if (property == "cid") {
return(as.integer(x))
} else if (property %like% "ddd") {
return(as.double(x))
} else {
x[is.na(x)] <- NA
return(x)
}
}

View File

@ -48,15 +48,17 @@
#' - `loinc`\cr All LOINC codes (Logical Observation Identifiers Names and Codes) associated with the name of the antimicrobial agent. Use [ab_loinc()] to retrieve them quickly, see [ab_property()].
#'
#' ### For the [antivirals] data set: a [tibble][tibble::tibble] with `r nrow(antivirals)` observations and `r ncol(antivirals)` variables:
#' - `av`\cr Antibiotic ID as used in this package (such as `AMC`), using the official EARS-Net (European Antimicrobial Resistance Surveillance Network) codes where available
#' - `name`\cr Official name as used by WHONET/EARS-Net or the WHO
#' - `atc`\cr ATC codes (Anatomical Therapeutic Chemical) as defined by the WHOCC
#' - `cid`\cr Compound ID as found in PubChem
#' - `name`\cr Official name as used by WHONET/EARS-Net or the WHO
#' - `atc_group`\cr Official pharmacological subgroup (3rd level ATC code) as defined by the WHOCC
#' - `synonyms`\cr Synonyms (often trade names) of a drug, as found in PubChem based on their compound ID
#' - `oral_ddd`\cr Defined Daily Dose (DDD), oral treatment
#' - `oral_units`\cr Units of `oral_ddd`
#' - `iv_ddd`\cr Defined Daily Dose (DDD), parenteral treatment
#' - `iv_units`\cr Units of `iv_ddd`
#' - `loinc`\cr All LOINC codes (Logical Observation Identifiers Names and Codes) associated with the name of the antimicrobial agent.
#' @details Properties that are based on an ATC code are only available when an ATC is available. These properties are: `atc_group1`, `atc_group2`, `oral_ddd`, `oral_units`, `iv_ddd` and `iv_units`.
#'
#' Synonyms (i.e. trade names) were derived from the PubChem Compound ID (column `cid`) and consequently only available where a CID is available.

View File

@ -248,11 +248,6 @@ mdro <- function(x = NULL,
pct_required_classes <- pct_required_classes / 100
}
if (!is.null(list(...)$country)) {
warning_("in `mdro()`: using `country` is deprecated, use `guideline` instead. See ?mdro")
guideline <- list(...)$country
}
guideline.bak <- guideline
if (is.list(guideline)) {
# Custom MDRO guideline ---------------------------------------------------

View File

@ -375,20 +375,3 @@ rsi_calc_df <- function(type, # "proportion", "count" or "both"
out <- as_original_data_class(out, class(data.bak))
structure(out, class = c("rsi_df", class(out)))
}
get_translate_ab <- function(translate_ab) {
translate_ab <- as.character(translate_ab)[1L]
if (translate_ab %in% c("TRUE", "official")) {
return("name")
} else if (translate_ab %in% c(NA_character_, "FALSE")) {
return(FALSE)
} else {
translate_ab <- tolower(translate_ab)
stop_ifnot(translate_ab %in% colnames(AMR::antibiotics),
"invalid value for 'translate_ab', this must be a column name of the antibiotics data set\n",
"or TRUE (equals 'name') or FALSE to not translate at all.",
call = FALSE
)
translate_ab
}
}

Binary file not shown.

View File

@ -70,6 +70,20 @@ vec_cast.ab.character <- function(x, to, ...) {
return_after_integrity_check(x, "antimicrobial code", as.character(AMR_env$AB_lookup$ab))
}
# S3: av
vec_ptype2.character.av <- function(x, y, ...) {
x
}
vec_ptype2.av.character <- function(x, y, ...) {
y
}
vec_cast.character.av <- function(x, to, ...) {
as.character(x)
}
vec_cast.av.character <- function(x, to, ...) {
return_after_integrity_check(x, "antiviral agent code", as.character(AMR_env$AV_lookup$av))
}
# S3: mo
vec_ptype2.character.mo <- function(x, y, ...) {
x

17
R/zzz.R
View File

@ -50,6 +50,11 @@ AMR_env$ab_previously_coerced <- data.frame(
ab = character(0),
stringsAsFactors = FALSE
)
AMR_env$av_previously_coerced <- data.frame(
x = character(0),
av = character(0),
stringsAsFactors = FALSE
)
AMR_env$rsi_interpretation_history <- data.frame(
datetime = Sys.time()[0],
index = integer(0),
@ -87,11 +92,13 @@ if (utf8_supported && !is_latex) {
# developers of the vctrs package:
# https://github.com/r-lib/vctrs/blob/05968ce8e669f73213e3e894b5f4424af4f46316/R/register-s3.R
s3_register("pillar::pillar_shaft", "ab")
s3_register("pillar::pillar_shaft", "av")
s3_register("pillar::pillar_shaft", "mo")
s3_register("pillar::pillar_shaft", "rsi")
s3_register("pillar::pillar_shaft", "mic")
s3_register("pillar::pillar_shaft", "disk")
s3_register("tibble::type_sum", "ab")
s3_register("tibble::type_sum", "av")
s3_register("tibble::type_sum", "mo")
s3_register("tibble::type_sum", "rsi")
s3_register("tibble::type_sum", "mic")
@ -129,6 +136,11 @@ if (utf8_supported && !is_latex) {
s3_register("vctrs::vec_ptype2", "ab.character")
s3_register("vctrs::vec_cast", "character.ab")
s3_register("vctrs::vec_cast", "ab.character")
# S3: av
s3_register("vctrs::vec_ptype2", "character.av")
s3_register("vctrs::vec_ptype2", "av.character")
s3_register("vctrs::vec_cast", "character.av")
s3_register("vctrs::vec_cast", "av.character")
# S3: mo
s3_register("vctrs::vec_ptype2", "character.mo")
s3_register("vctrs::vec_ptype2", "mo.character")
@ -168,6 +180,7 @@ if (utf8_supported && !is_latex) {
# reference data - they have additional columns compared to `antibiotics` and `microorganisms` to improve speed
# they cannot be part of R/sysdata.rda since CRAN thinks it would make the package too large (+3 MB)
AMR_env$AB_lookup <- create_AB_lookup()
AMR_env$AV_lookup <- create_AV_lookup()
AMR_env$MO_lookup <- create_MO_lookup()
}
@ -190,6 +203,10 @@ create_AB_lookup <- function() {
cbind(AMR::antibiotics, AB_LOOKUP)
}
create_AV_lookup <- function() {
cbind(AMR::antivirals, AV_LOOKUP)
}
create_MO_lookup <- function() {
MO_lookup <- AMR::microorganisms