P281424/AMR
1
0
Fork 0
mirror of https://github.com/msberends/AMR.git synced 2025-07-08 23:21:56 +02:00
Code Releases Activity

(v0.7.1.9092) as.ab() improvements

Browse Source
This commit is contained in:
dr. M.S. (Matthijs) Berends
2019-10-04 15:36:12 +02:00
parent edb599ae0b
commit 8bc4081b03
28 changed files with 176 additions and 71 deletions
Download Patch File Download Diff File Expand all files Collapse all files

54
R/ab.R
View File

@ -23,6 +23,7 @@
#'
#' 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
#' @param ... arguments passed on to internal functions
#' @rdname as.ab
#' @keywords atc
#' @inheritSection WHOCC WHOCC
@ -57,7 +58,7 @@
#' # they use as.ab() internally:
#' ab_name("J01FA01") # "Erythromycin"
#' ab_name("eryt") # "Erythromycin"
as.ab <- function(x) {
as.ab <- function(x, ...) {
if (is.ab(x)) {
return(x)
}
@ -69,6 +70,9 @@ as.ab <- function(x) {
}
x_bak <- x
# remove diacritics
x <- iconv(x, from = "UTF-8", to = "ASCII//TRANSLIT")
x <- gsub('"', "", x, fixed = TRUE)
# remove suffices
x_bak_clean <- gsub("_(mic|rsi|dis[ck])$", "", x, ignore.case = TRUE)
# remove disk concentrations, like LVX_NM -> LVX
@ -76,9 +80,15 @@ as.ab <- function(x) {
# remove part between brackets if that's followed by another string
x_bak_clean <- gsub("(.*)+ [(].*[)]", "\\1", x_bak_clean)
# keep only a-Z, 0-9, space, slash and dash
x_bak_clean <- gsub("[^A-Z0-9 /-]", "", x_bak_clean, ignore.case = TRUE)
# x_bak_clean <- gsub("[^A-Z0-9 /-]", "", x_bak_clean, ignore.case = TRUE)
# keep only max 1 space
x_bak_clean <- trimws(gsub(" +", " ", x_bak_clean, ignore.case = TRUE))
# non-character, space or number should be a slash
x_bak_clean <- gsub("[^A-Za-z0-9 ]", "/", x_bak_clean)
# spaces around non-characters must be removed: amox + clav -> amox/clav
x_bak_clean <- gsub("(.*[a-zA-Z0-9]) ([^a-zA-Z0-9].*)", "\\1\\2", x_bak_clean)
x_bak_clean <- gsub("(.*[^a-zA-Z0-9]) ([a-zA-Z0-9].*)", "\\1\\2", x_bak_clean)
x <- unique(x_bak_clean)
x_new <- rep(NA_character_, length(x))
x_unknown <- character(0)
@ -181,6 +191,7 @@ as.ab <- function(x) {
x_spelling <- gsub("(o\\+n|o\\+ne\\+)$", "o+ne*", x_spelling)
# replace multiple same characters to single one with '+', like "ll" -> "l+"
x_spelling <- gsub("(.)\\1+", "\\1+", x_spelling)
# try if name starts with it
found <- AMR::antibiotics[which(AMR::antibiotics$name %like% paste0("^", x_spelling)),]$ab
if (length(found) > 0) {
@ -217,7 +228,44 @@ as.ab <- function(x) {
next
}
}
if (!isFALSE(list(...)$initial_search)) {
# transform back from other languages and try again
x_translated <- paste(lapply(strsplit(x[i], "[^a-zA-Z0-9 ]"),
function(y) {
for (i in 1:length(y)) {
y[i] <- ifelse(tolower(y[i]) %in% tolower(translations_file$replacement),
translations_file[which(tolower(translations_file$replacement) == tolower(y[i]) &
!isFALSE(translations_file$fixed)), "pattern"],
y[i])
}
y
})[[1]],
collapse = "/")
x_translated_guess <- suppressWarnings(as.ab(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-zA-Z0-9 ]"),
function(y) {
for (i in 1:length(y)) {
y_name <- suppressWarnings(ab_name(y[i], language = NULL, initial_search = FALSE))
y[i] <- ifelse(!is.na(y_name),
y_name,
y[i])
}
y
})[[1]],
collapse = "/")
x_translated_guess <- suppressWarnings(as.ab(x_translated, initial_search = FALSE))
if (!is.na(x_translated_guess)) {
x_new[i] <- x_translated_guess
next
}
}
# not found
x_unknown <- c(x_unknown, x_bak[x[i] == x_bak_clean][1])
}

2
R/ab_property.R
View File

@ -188,7 +188,7 @@ ab_validate <- function(x, property, ...) {
error = function(e) stop(e$message, call. = FALSE))
if (!all(x %in% AMR::antibiotics[, property])) {
x <- data.frame(ab = AMR::as.ab(x), stringsAsFactors = FALSE) %>%
x <- data.frame(ab = AMR::as.ab(x, ...), stringsAsFactors = FALSE) %>%
left_join(AMR::antibiotics, by = "ab") %>%
pull(property)
}

2
R/availability.R
View File

@ -27,7 +27,7 @@
#' @details The function returns a \code{data.frame} with columns \code{"resistant"} and \code{"visual_resistance"}. The values in that columns are calculated with \code{\link{portion_R}}.
#' @return \code{data.frame} with column names of \code{tbl} as row names
#' @inheritSection AMR Read more on our website!
#' @importFrom clean percentage
# @importFrom clean percentage
#' @export
#' @examples
#' availability(example_isolates)

2
R/bug_drug_combinations.R
View File

@ -33,7 +33,7 @@
#' @inheritParams base::formatC
#' @importFrom dplyr %>% rename group_by select mutate filter pull
#' @importFrom tidyr spread
#' @importFrom clean freq percentage
# @importFrom clean freq percentage
#' @details The function \code{format} calculates the resistance per bug-drug combination. Use \code{combine_IR = FALSE} (default) to test R vs. S+I and \code{combine_IR = TRUE} to test R+I vs. S.
#'
#' The language of the output can be overwritten with \code{options(AMR_locale)}, please see \link{translate}.

2
R/first_isolate.R
View File

@ -75,7 +75,7 @@
#' @export
#' @importFrom dplyr arrange_at lag between row_number filter mutate arrange pull ungroup
#' @importFrom crayon blue bold silver
#' @importFrom clean percentage
# @importFrom clean percentage
#' @return Logical vector
#' @source Methodology of this function is based on: \strong{M39 Analysis and Presentation of Cumulative Antimicrobial Susceptibility Test Data, 4th Edition}, 2014, \emph{Clinical and Laboratory Standards Institute (CLSI)}. \url{https://clsi.org/standards/products/microbiology/documents/m39/}.
#' @inheritSection AMR Read more on our website!

3
R/freq.R
View File

@ -25,7 +25,8 @@ clean::freq
#' @exportMethod freq.mo
#' @importFrom dplyr n_distinct
#' @importFrom clean freq.default percentage
#' @importFrom clean freq.default
# @importFrom clean percentage
#' @export
#' @noRd
freq.mo <- function(x, ...) {

4
R/ggplot_rsi.R
View File

@ -337,7 +337,7 @@ facet_rsi <- function(facet = c("interpretation", "antibiotic"), nrow = NULL) {
}
#' @rdname ggplot_rsi
#' @importFrom clean percentage
# @importFrom clean percentage
#' @export
scale_y_percent <- function(breaks = seq(0, 1, 0.1), limits = NULL) {
stopifnot_installed_package("ggplot2")
@ -387,7 +387,7 @@ theme_rsi <- function() {
#' @rdname ggplot_rsi
#' @importFrom dplyr mutate %>% group_by_at
#' @importFrom clean percentage
# @importFrom clean percentage
#' @export
labels_rsi_count <- function(position = NULL,
x = "antibiotic",

42
R/misc.R
View File

@ -127,3 +127,45 @@ class_integrity_check <- function(value, type, check_vector) {
}
value
}
# Percentages -------------------------------------------------------------
# Can all be removed when clean 1.2.0 is on CRAN
getdecimalplaces <- function(x, minimum = 0, maximum = 3) {
if (maximum < minimum) {
maximum <- minimum
}
if (minimum > maximum) {
minimum <- maximum
}
max_places <- max(unlist(lapply(strsplit(sub('0+$', '',
as.character(x * 100)), ".", fixed = TRUE),
function(y) ifelse(length(y) == 2, nchar(y[2]), 0))), na.rm = TRUE)
max(min(max_places,
maximum, na.rm = TRUE),
minimum, na.rm = TRUE)
}
round2 <- function(x, digits = 0, force_zero = TRUE) {
# https://stackoverflow.com/a/12688836/4575331
val <- (trunc((abs(x) * 10 ^ digits) + 0.5) / 10 ^ digits) * sign(x)
if (digits > 0 & force_zero == TRUE) {
val[val != as.integer(val)] <- paste0(val[val != as.integer(val)],
strrep("0", max(0, digits - nchar(gsub(".*[.](.*)$", "\\1", val[val != as.integer(val)])))))
}
val
}
percentage <- function(x, digits = NULL, ...) {
if (is.null(digits)) {
digits <- getdecimalplaces(x, minimum = 0, maximum = 1)
}
# round right: percentage(0.4455) should return "44.6%", not "44.5%"
x <- as.numeric(round2(x, digits = digits + 2))
x_formatted <- format(as.double(x) * 100, scientific = FALSE, digits = digits, nsmall = digits, ...)
x_formatted[!is.na(x)] <- paste0(x_formatted[!is.na(x)], "%")
x_formatted
}

2
R/mo.R
View File

@ -268,7 +268,7 @@ is.mo <- function(x) {
#' @importFrom dplyr %>% pull left_join n_distinct progress_estimated filter distinct
#' @importFrom data.table data.table as.data.table setkey
#' @importFrom crayon magenta red blue silver italic
#' @importFrom clean percentage
# @importFrom clean percentage
# param property a column name of AMR::microorganisms
# param initial_search logical - is FALSE when coming from uncertain tries, which uses exec_as.mo internally too
# param dyslexia_mode logical - also check for characters that resemble others

2
R/portion.R
View File

@ -26,7 +26,7 @@
#' \code{portion_R} and \code{portion_IR} can be used to calculate resistance, \code{portion_S} and \code{portion_SI} can be used to calculate susceptibility.\cr
#' @param ... one or more vectors (or columns) with antibiotic interpretations. They will be transformed internally with \code{\link{as.rsi}} if needed. Use multiple columns to calculate (the lack of) co-resistance: the probability where one of two drugs have a resistant or susceptible result. See Examples.
#' @param minimum the minimum allowed number of available (tested) isolates. Any isolate count lower than \code{minimum} will return \code{NA} with a warning. The default number of \code{30} isolates is advised by the Clinical and Laboratory Standards Institute (CLSI) as best practice, see Source.
#' @param as_percent a logical to indicate whether the output must be returned as a hundred fold with \% sign (a character) using\code{\link[clean]{percentage}}. A value of \code{0.123456} will then be returned as \code{"12.3\%"}.
#' @param as_percent a logical to indicate whether the output must be returned as a hundred fold with \% sign (a character). A value of \code{0.123456} will then be returned as \code{"12.3\%"}.
#' @param only_all_tested (for combination therapies, i.e. using more than one variable for \code{...}) a logical to indicate that isolates must be tested for all antibiotics, see section \emph{Combination therapy} below
#' @param data a \code{data.frame} containing columns with class \code{rsi} (see \code{\link{as.rsi}})
#' @param translate_ab a column name of the \code{\link{antibiotics}} data set to translate the antibiotic abbreviations to, using \code{\link{ab_property}}

2
R/rsi_calc.R
View File

@ -39,7 +39,7 @@ dots2vars <- function(...) {
}
#' @importFrom dplyr %>% pull all_vars any_vars filter_all funs mutate_all
#' @importFrom clean percentage
# @importFrom clean percentage
rsi_calc <- function(...,
ab_result,
minimum = 0,