abname improvement, small fixes

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")),
+        comment = c(ORCID = "0000-0003-1634-0010")))
-    person(
-        family = "University of Groningen",
-        role = "uvp"))
 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

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
+* Improvements for forecasting with `resistance_predict` and added more examples
-* More antibiotics for EUCAST rules
+* 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

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
+}

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
 #'

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",

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")
+# It is quite flexible at default (having `from = "guess"`)
-# "amoxicillin and enzyme inhibitor + gentamicin"
+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"
 }

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")
 }

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"))
+})

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",