From dba06c3295ff48300bdc66bb0b18e91d427b5397 Mon Sep 17 00:00:00 2001 From: "Matthijs S. Berends" Date: Mon, 13 Aug 2018 11:00:53 +0200 Subject: [PATCH] abname improvement, small fixes --- DESCRIPTION | 8 +- NEWS.md | 5 +- R/abname.R | 163 +++++++++++++++++++++++++++++++++++ R/atc.R | 133 ---------------------------- R/ggplot_rsi.R | 2 +- man/abname.Rd | 17 ++-- man/ggplot_rsi.Rd | 2 +- tests/testthat/test-abname.R | 19 ++++ tests/testthat/test-atc.R | 17 ---- 9 files changed, 201 insertions(+), 165 deletions(-) create mode 100644 R/abname.R mode change 100755 => 100644 man/abname.Rd create mode 100644 tests/testthat/test-abname.R diff --git a/DESCRIPTION b/DESCRIPTION index 9dbc4f8b..ac6b45c2 100755 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: AMR Version: 0.2.0.9023 -Date: 2018-08-12 +Date: 2018-08-13 Title: Antimicrobial Resistance Analysis Authors@R: c( person( @@ -37,10 +37,7 @@ Authors@R: c( family = "Sinha", email = "b.sinha@umcg.nl", role = "ths", - comment = c(ORCID = "0000-0003-1634-0010")), - person( - family = "University of Groningen", - role = "uvp")) + comment = c(ORCID = "0000-0003-1634-0010"))) Description: Functions to simplify the analysis of Antimicrobial Resistance (AMR) of microbial isolates, by using new S3 classes and applying EUCAST expert rules on antibiograms according to Leclercq (2013) @@ -54,7 +51,6 @@ Imports: dplyr (>= 0.7.0), xml2 (>= 1.0.0), knitr (>= 1.0.0), - Rcpp (>= 0.12.14), readr, rvest (>= 0.3.2), tibble diff --git a/NEWS.md b/NEWS.md index 6ca03b69..f5c49e51 100755 --- a/NEWS.md +++ b/NEWS.md @@ -35,13 +35,14 @@ * Possibility to globally set the default for the amount of items to print, with `options(max.print.freq = n)` where *n* is your preset value #### Changed -* Improvements for forcasting with `resistance_predict` and added more examples -* More antibiotics for EUCAST rules +* Improvements for forecasting with `resistance_predict` and added more examples +* More antibiotics added as parameters for EUCAST rules * Updated version of the `septic_patients` data set to better reflect the reality * Pretty printing for tibbles removed as it is not really the scope of this package * Printing of `mic` and `rsi` classes now returns all values - use `freq` to check distributions * Improved speed of key antibiotics comparison for determining first isolates * Column names for the `key_antibiotics` function are now generic: 6 for broadspectrum ABs, 6 for Gram-positive specific and 6 for Gram-negative specific ABs +* Speed improvement for the `abname` function * `%like%` now supports multiple patterns * Frequency tables are now actual `data.frame`s with altered console printing to make it look like a frequency table. Because of this, the parameter `toConsole` is not longer needed. * Fix for `freq` where the class of an item would be lost diff --git a/R/abname.R b/R/abname.R new file mode 100644 index 00000000..4cc26125 --- /dev/null +++ b/R/abname.R @@ -0,0 +1,163 @@ +# ==================================================================== # +# TITLE # +# Antimicrobial Resistance (AMR) Analysis # +# # +# AUTHORS # +# Berends MS (m.s.berends@umcg.nl), Luz CF (c.f.luz@umcg.nl) # +# # +# LICENCE # +# This program is free software; you can redistribute it and/or modify # +# it under the terms of the GNU General Public License version 2.0, # +# as published by the Free Software Foundation. # +# # +# This program is distributed in the hope that it will be useful, # +# but WITHOUT ANY WARRANTY; without even the implied warranty of # +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # +# GNU General Public License for more details. # +# ==================================================================== # + +#' Name of an antibiotic +#' +#' Convert antibiotic codes (from a laboratory information system like MOLIS or GLIMS) to a (trivial) antibiotic name or ATC code, or vice versa. This uses the data from \code{\link{antibiotics}}. +#' @param abcode a code or name, like \code{"AMOX"}, \code{"AMCL"} or \code{"J01CA04"} +#' @param from,to type to transform from and to. See \code{\link{antibiotics}} for its column names. WIth \code{from = "guess"} the from will be guessed from \code{"atc"}, \code{"molis"} and \code{"umcg"}. When using \code{to = "atc"}, the ATC code will be searched using \code{\link{guess_atc}}. +#' @param textbetween text to put between multiple returned texts +#' @param tolower return output as lower case with function \code{\link{tolower}}. +#' @keywords ab antibiotics +#' @source \code{\link{antibiotics}} +#' @export +#' @importFrom dplyr %>% pull +#' @examples +#' abname("AMCL") +#' # "amoxicillin and enzyme inhibitor" +#' +#' # It is quite flexible at default (having `from = "guess"`) +#' abname(c("amox", "J01CA04", "Trimox", "dispermox", "Amoxil")) +#' # "Amoxicillin" "Amoxicillin" "Amoxicillin" "Amoxicillin" "Amoxicillin" +#' +#' # Multiple antibiotics can be combined with "+". +#' # The second antibiotic will be set to lower case when `tolower` was not set: +#' abname("AMCL+GENT", textbetween = "/") +#' # "amoxicillin and enzyme inhibitor/gentamicin" +#' +#' abname(c("AMCL", "GENT")) +#' # "Amoxicillin and beta-lactamase inhibitor" "Gentamicin" +#' +#' abname("AMCL", to = "trivial_nl") +#' # "Amoxicilline/clavulaanzuur" +#' +#' abname("AMCL", to = "atc") +#' # "J01CR02" +#' +#' # specific codes for University Medical Center Groningen (UMCG): +#' abname("J01CR02", from = "atc", to = "umcg") +#' # "AMCL" +abname <- function(abcode, + from = c("guess", "atc", "molis", "umcg"), + to = 'official', + textbetween = ' + ', + tolower = FALSE) { + + if (length(to) != 1L) { + stop('`to` must be of length 1', call. = FALSE) + } + + if (to == "atc") { + return(guess_atc(abcode)) + } + + #antibiotics <- AMR::antibiotics + abx <- AMR::antibiotics + + from <- from[1] + # if (from == "guess") { + # for (i in 1:3) { + # if (abcode[1] %in% (antibiotics %>% pull(i))) { + # from <- colnames(antibiotics)[i] + # } + # } + # if (from == "guess") { + # from <- "umcg" + # } + # } + + colnames(abx) <- colnames(abx) %>% tolower() + from <- from %>% tolower() + to <- to %>% tolower() + + if (!(from %in% colnames(abx) | from == "guess") | + !to %in% colnames(abx)) { + stop(paste0('Invalid `from` or `to`. Choose one of ', + colnames(abx) %>% paste(collapse = ", "), '.'), call. = FALSE) + } + + abcode <- as.character(abcode) + abcode.bak <- abcode + + for (i in 1:length(abcode)) { + if (abcode[i] %like% "[+]") { + # support for multiple ab's with + + parts <- trimws(strsplit(abcode[i], split = "+", fixed = TRUE)[[1]]) + ab1 <- abname(parts[1], from = from, to = to) + ab2 <- abname(parts[2], from = from, to = to) + if (missing(tolower)) { + ab2 <- tolower(ab2) + } + abcode[i] <- paste0(ab1, textbetween, ab2) + next + } + if (from %in% c("atc", "guess")) { + if (abcode[i] %in% abx$atc) { + abcode[i] <- abx[which(abx$atc == abcode[i]),] %>% pull(to) + next + } + } + if (from %in% c("molis", "guess")) { + if (abcode[i] %in% abx$molis) { + abcode[i] <- abx[which(abx$molis == abcode[i]),] %>% pull(to) + next + } + } + if (from %in% c("umcg", "guess")) { + if (abcode[i] %in% abx$umcg) { + abcode[i] <- abx[which(abx$umcg == abcode[i]),] %>% pull(to) + next + } + } + if (from %in% c("trade_name", "guess")) { + if (abcode[i] %in% abx$trade_name) { + abcode[i] <- abx[which(abx$trade_name == abcode[i]),] %>% pull(to) + next + } + if (sum(abx$trade_name %like% abcode[i]) > 0) { + abcode[i] <- abx[which(abx$trade_name %like% abcode[i]),] %>% pull(to) + next + } + } + + if (from != "guess") { + # when not found, try any `from` + abcode[i] <- abx[which(abx[,from] == abcode[i]),] %>% pull(to) %>% .[1] + } + + # when nothing found, try first chars of official name + # if (is.na(abcode[i])) { + # abcode[i] <- antibiotics %>% + # filter(official %like% paste0('^', abcode.bak[i])) %>% + # pull(to) %>% + # .[1] + # next + # } + + if (is.na(abcode[i]) | length(abcode[i] == 0)) { + abcode[i] <- abcode.bak[i] + warning('Code "', abcode.bak[i], '" not found in antibiotics list.', call. = FALSE) + } + } + + if (tolower == TRUE) { + abcode <- abcode %>% tolower() + } + + abcode +} diff --git a/R/atc.R b/R/atc.R index d223e8b7..bd440158 100755 --- a/R/atc.R +++ b/R/atc.R @@ -203,139 +203,6 @@ atc_ddd <- function(atc_code, ...) { atc_property(atc_code = atc_code, property = "ddd", ...) } -#' Name of an antibiotic -#' -#' Convert antibiotic codes (from a laboratory information system like MOLIS or GLIMS) to a (trivial) antibiotic name or ATC code, or vice versa. This uses the data from \code{\link{antibiotics}}. -#' @param abcode a code or name, like \code{"AMOX"}, \code{"AMCL"} or \code{"J01CA04"} -#' @param from,to type to transform from and to. See \code{\link{antibiotics}} for its column names. WIth \code{from = "guess"} the from will be guessed from \code{"atc"}, \code{"molis"} and \code{"umcg"}. When using \code{to = "atc"}, the ATC code will be search using \code{\link{guess_atc}}. -#' @param textbetween text to put between multiple returned texts -#' @param tolower return output as lower case with function \code{\link{tolower}}. -#' @keywords ab antibiotics -#' @source \code{\link{antibiotics}} -#' @export -#' @importFrom dplyr %>% filter select slice -#' @examples -#' abname("AMCL") -#' # "amoxicillin and enzyme inhibitor" -#' -#' abname("AMCL+GENT") -#' # "amoxicillin and enzyme inhibitor + gentamicin" -#' -#' abname(c("AMCL", "GENT")) -#' # "amoxicillin and enzyme inhibitor" "gentamicin" -#' -#' abname("AMCL", to = "trivial_nl") -#' # "Amoxicilline/clavulaanzuur" -#' -#' abname("AMCL", to = "atc") -#' # "J01CR02" -#' -#' abname("J01CR02", from = "atc", to = "umcg") -#' # "AMCL" -abname <- function(abcode, from = c("guess", "atc", "molis", "umcg"), to = 'official', textbetween = ' + ', tolower = FALSE) { - - if (length(to) != 1L) { - stop('`to` must be of length 1', call. = FALSE) - } - - if (to == "atc") { - return(guess_atc(abcode)) - } - - antibiotics <- AMR::antibiotics - - from <- from[1] - if (from == "guess") { - for (i in 1:3) { - if (abcode[1] %in% (antibiotics %>% pull(i))) { - from <- colnames(antibiotics)[i] - } - } - if (from == "guess") { - from <- "umcg" - } - } - - colnames(antibiotics) <- colnames(antibiotics) %>% tolower() - from <- from %>% tolower() - to <- to %>% tolower() - - if (!from %in% colnames(antibiotics) | - !to %in% colnames(antibiotics)) { - stop(paste0('Invalid `from` or `to`. Choose one of ', - colnames(antibiotics) %>% paste(collapse = ", "), '.'), call. = FALSE) - } - - abcode <- as.character(abcode) - abcode.bak <- abcode - - for (i in 1:length(abcode)) { - abcode[i] <- abcode[i] - if (!grepl('+', abcode[i], fixed = TRUE) & !grepl(' en ', abcode[i], fixed = TRUE)) { - # only 1 drug - if (abcode[i] %in% (antibiotics %>% pull(from))) { - abcode[i] <- - antibiotics %>% - filter(.[, from] == abcode[i]) %>% - select(to) %>% - slice(1) %>% - as.character() - } else { - # not found - abcode[i] <- NA - } - } else { - # more than 1 drug - if (grepl('+', abcode[i], fixed = TRUE)) { - abcode.group <- - strsplit(abcode[i], '+', fixed = TRUE) %>% - unlist() %>% - trimws('both') - } else if (grepl(' en ', abcode[i], fixed = TRUE)) { - abcode.group <- - strsplit(abcode[i], ' en ', fixed = TRUE) %>% - unlist() %>% - trimws('both') - } else { - warning('Invalid concat.') - abcode[i] <- NA - next - } - - for (j in 1:length(abcode.group)) { - abcode.group[j] <- - antibiotics %>% - filter(.[, from] == abcode.group[j]) %>% - select(to) %>% - slice(1) %>% - as.character() - if (j > 1 & to %in% c('official', 'trivial_nl')) { - abcode.group[j] <- abcode.group[j] %>% tolower() - } - } - abcode[i] <- paste(abcode.group, collapse = textbetween) - } - - # when nothing found, try first chars of official name - if (is.na(abcode[i])) { - abcode[i] <- antibiotics %>% - filter(official %like% paste0('^', abcode.bak[i])) %>% - pull(to) %>% - .[1] - } - if (is.na(abcode[i])) { - warning('Code "', abcode.bak[i], '" not found in antibiotics list.', call. = FALSE) - } - } - - if (tolower == TRUE) { - abcode <- abcode %>% tolower() - } - - abcode -} - - #' Find ATC code based on antibiotic property #' diff --git a/R/ggplot_rsi.R b/R/ggplot_rsi.R index 190bf601..b30b784d 100644 --- a/R/ggplot_rsi.R +++ b/R/ggplot_rsi.R @@ -71,7 +71,7 @@ #' select(hospital_id, amox, cipr) %>% #' group_by(hospital_id) %>% #' ggplot_rsi() + -#' facet_grid("hospital_id") + +#' facet_wrap("hospital_id", nrow = 1) + #' labs(title = "AMR of Amoxicillin And Ciprofloxacine Per Hospital") ggplot_rsi <- function(data, position = "stack", diff --git a/man/abname.Rd b/man/abname.Rd old mode 100755 new mode 100644 index 44e0a721..c74ccafb --- a/man/abname.Rd +++ b/man/abname.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/atc.R +% Please edit documentation in R/abname.R \name{abname} \alias{abname} \title{Name of an antibiotic} @@ -13,7 +13,7 @@ abname(abcode, from = c("guess", "atc", "molis", "umcg"), \arguments{ \item{abcode}{a code or name, like \code{"AMOX"}, \code{"AMCL"} or \code{"J01CA04"}} -\item{from, to}{type to transform from and to. See \code{\link{antibiotics}} for its column names. WIth \code{from = "guess"} the from will be guessed from \code{"atc"}, \code{"molis"} and \code{"umcg"}. When using \code{to = "atc"}, the ATC code will be search using \code{\link{guess_atc}}.} +\item{from, to}{type to transform from and to. See \code{\link{antibiotics}} for its column names. WIth \code{from = "guess"} the from will be guessed from \code{"atc"}, \code{"molis"} and \code{"umcg"}. When using \code{to = "atc"}, the ATC code will be searched using \code{\link{guess_atc}}.} \item{textbetween}{text to put between multiple returned texts} @@ -26,11 +26,17 @@ Convert antibiotic codes (from a laboratory information system like MOLIS or GLI abname("AMCL") # "amoxicillin and enzyme inhibitor" -abname("AMCL+GENT") -# "amoxicillin and enzyme inhibitor + gentamicin" +# 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 enzyme inhibitor" "gentamicin" +# "Amoxicillin and beta-lactamase inhibitor" "Gentamicin" abname("AMCL", to = "trivial_nl") # "Amoxicilline/clavulaanzuur" @@ -38,6 +44,7 @@ abname("AMCL", to = "trivial_nl") abname("AMCL", to = "atc") # "J01CR02" +# specific codes for University Medical Center Groningen (UMCG): abname("J01CR02", from = "atc", to = "umcg") # "AMCL" } diff --git a/man/ggplot_rsi.Rd b/man/ggplot_rsi.Rd index 5eb020e5..8c9629d7 100644 --- a/man/ggplot_rsi.Rd +++ b/man/ggplot_rsi.Rd @@ -84,6 +84,6 @@ septic_patients \%>\% select(hospital_id, amox, cipr) \%>\% group_by(hospital_id) \%>\% ggplot_rsi() + - facet_grid("hospital_id") + + facet_wrap("hospital_id", nrow = 1) + labs(title = "AMR of Amoxicillin And Ciprofloxacine Per Hospital") } diff --git a/tests/testthat/test-abname.R b/tests/testthat/test-abname.R new file mode 100644 index 00000000..44b4358f --- /dev/null +++ b/tests/testthat/test-abname.R @@ -0,0 +1,19 @@ +context("abname.R") + +test_that("abname works", { + expect_equal(abname("AMOX"), "Amoxicillin") + expect_equal(abname(c("AMOX", "GENT")), c("Amoxicillin", "Gentamicin")) + expect_equal(abname(c("AMOX+GENT")), "Amoxicillin + gentamicin") + expect_equal(abname("AMOX", from = 'umcg'), "Amoxicillin") + expect_equal(abname("amox", from = 'molis', tolower = TRUE), "amoxicillin") + expect_equal(abname("J01CA04", from = 'atc'), "Amoxicillin") + expect_equal(abname(c("amox", "J01CA04", "Trimox", "dispermox", "Amoxil")), + rep("Amoxicillin", 5)) + expect_equal(abname("AMOX", to = 'atc'), "J01CA04") + + expect_error(abname("AMOX", to = c(1:3))) + expect_error(abname("AMOX", to = "test")) + expect_warning(abname("TEST + ")) + expect_warning(abname("AMOX or GENT")) +}) diff --git a/tests/testthat/test-atc.R b/tests/testthat/test-atc.R index 1c894ac3..6c1240e9 100755 --- a/tests/testthat/test-atc.R +++ b/tests/testthat/test-atc.R @@ -4,7 +4,6 @@ test_that("atc_property works", { if (!is.null(curl::nslookup("www.whocc.no", error = FALSE))) { expect_equal(tolower(atc_property("J01CA04", property = "Name")), "amoxicillin") expect_equal(atc_property("J01CA04", property = "unit"), "g") - expect_equal(atc_property("J01CA04", property = "DDD"), atc_ddd("J01CA04")) @@ -19,22 +18,6 @@ test_that("atc_property works", { } }) -test_that("abname works", { - expect_equal(abname("AMOX"), "Amoxicillin") - expect_equal(abname(c("AMOX", "GENT")), c("Amoxicillin", "Gentamicin")) - expect_equal(abname(c("AMOX+GENT")), "Amoxicillin + gentamicin") - expect_equal(abname("AMOX", from = 'umcg'), "Amoxicillin") - expect_equal(abname("amox", from = 'molis', tolower = TRUE), "amoxicillin") - expect_equal(abname("J01CA04", from = 'atc'), "Amoxicillin") - expect_equal(abname("AMOX", to = 'atc'), "J01CA04") - expect_equal(abname("AMOX en GENT"), "Amoxicillin + gentamicin") - expect_error(abname("AMOX", to = c(1:3))) - expect_error(abname("AMOX", to = "test")) - expect_warning(abname("TEST - ")) - expect_warning(abname("AMOX or GENT")) -}) - test_that("guess_atc works", { expect_equal(guess_atc(c("J01FA01", "Erythromycin",