(v0.7.0.9010) mo_synonyms, plot/barplot fixes

R/count.R

@@ -33,7 +33,7 @@
 #'
 #' The function \code{count_df} takes any variable from \code{data} that has an \code{"rsi"} class (created with \code{\link{as.rsi}}) and counts the amounts of S, I and R. The resulting \emph{tidy data} (see Source) \code{data.frame} will have three rows (S/I/R) and a column for each variable with class \code{"rsi"}.
 #'
-#' The function \code{rsi_df} works exactly like \code{count_df}, but add the percentage of S, I and R.
+#' The function \code{rsi_df} works exactly like \code{count_df}, but adds the percentage of S, I and R.
 #' @source Wickham H. \strong{Tidy Data.} The Journal of Statistical Software, vol. 59, 2014. \url{http://vita.had.co.nz/papers/tidy-data.html}
 #' @seealso \code{\link{portion}_*} to calculate microbial resistance and susceptibility.
 #' @keywords resistance susceptibility rsi antibiotics isolate isolates

R/mic.R

@@ -242,34 +242,38 @@ summary.mic <- function(object, ...) {
 
 #' @exportMethod plot.mic
 #' @export
-#' @importFrom dplyr %>% group_by summarise
-#' @importFrom graphics plot text
+#' @importFrom graphics barplot axis
 #' @noRd
-plot.mic <- function(x, ...) {
-  x_name <- deparse(substitute(x))
-  create_barplot_mic(x, x_name, ...)
+plot.mic <- function(x,
+                     main = paste('MIC values of', deparse(substitute(x))),
+                     ylab = 'Frequency',
+                     xlab = 'MIC value',
+                     axes = FALSE,
+                     ...) {
+  barplot(table(droplevels.factor(x)),
+          ylab = ylab,
+          xlab = xlab,
+          axes = axes,
+          main = main,
+          ...)
+  axis(2, seq(0, max(table(droplevels.factor(x)))))
 }
 
 #' @exportMethod barplot.mic
 #' @export
 #' @importFrom graphics barplot axis
 #' @noRd
-barplot.mic <- function(height, ...) {
-  x_name <- deparse(substitute(height))
-  create_barplot_mic(height, x_name, ...)
-}
-
-#' @importFrom graphics barplot axis
-#' @importFrom dplyr %>% group_by summarise
-create_barplot_mic <- function(x, x_name, ...) {
-  data <- data.frame(mic = droplevels(x), cnt = 1) %>%
-    group_by(mic) %>%
-    summarise(cnt = sum(cnt))
-  barplot(table(droplevels.factor(x)),
-          ylab = 'Frequency',
-          xlab = 'MIC value',
-          main = paste('MIC values of', x_name),
-          axes = FALSE,
+barplot.mic <- function(height,
+                        main = paste('MIC values of', deparse(substitute(height))),
+                        ylab = 'Frequency',
+                        xlab = 'MIC value',
+                        axes = FALSE,
+                        ...) {
+  barplot(table(droplevels.factor(height)),
+          ylab = ylab,
+          xlab = xlab,
+          axes = axes,
+          main = main,
           ...)
-  axis(2, seq(0, max(data$cnt)))
+  axis(2, seq(0, max(table(droplevels.factor(height)))))
 }

R/misc.R

@@ -307,5 +307,14 @@ translate_AMR <- function(from, language = get_locale(), only_unknown = FALSE) {
 }
 
 "%or%" <- function(x, y) {
-  ifelse(!is.na(x), x, ifelse(!is.na(y), y, NA))
+  if (is.null(x) | is.null(y)) {
+    if (is.null(x)) {
+      return(y)
+    } else {
+      return(x)
+    }
+  }
+  ifelse(!is.na(x),
+         x,
+         ifelse(!is.na(y), y, NA))
 }

R/mo_property.R

@@ -73,6 +73,7 @@
 #' mo_type("E. coli")            # "Bacteria" (equal to kingdom, but may be translated)
 #' mo_rank("E. coli")            # "species"
 #' mo_url("E. coli")             # get the direct url to the online database entry
+#' mo_synonyms("E. coli")        # get previously accepted taxonomic names
 #'
 #' ## scientific reference
 #' mo_ref("E. coli")             # "Castellani et al., 1919"
@@ -312,12 +313,24 @@ mo_taxonomy <- function(x, language = get_locale(),  ...) {
              subspecies = mo_subspecies(x, language = language))
 }
 
+#' @rdname mo_property
+#' @export
+mo_synonyms <- function(x, ...) {
+  x <- AMR::as.mo(x, ...)
+  col_id <- AMR::microorganisms[which(AMR::microorganisms$mo == x), "col_id"]
+  if (is.na(col_id) | !col_id %in% AMR::microorganisms.old$col_id_new) {
+    return(NULL)
+  }
+  sort(AMR::microorganisms.old[which(AMR::microorganisms.old$col_id_new == col_id), "fullname"])
+}
+
 #' @rdname mo_property
 #' @export
 mo_info <- function(x, language = get_locale(),  ...) {
   x <- AMR::as.mo(x, ...)
   c(mo_taxonomy(x, language = language),
-    list(url = unname(mo_url(x, open = FALSE)),
+    list(synonyms = mo_synonyms(x),
+         url = unname(mo_url(x, open = FALSE)),
          ref = mo_ref(x)))
 }
 

R/portion.R

@@ -40,7 +40,7 @@
 #'
 #' The function \code{portion_df} takes any variable from \code{data} that has an \code{"rsi"} class (created with \code{\link{as.rsi}}) and calculates the portions R, I and S. The resulting \emph{tidy data} (see Source) \code{data.frame} will have three rows (S/I/R) and a column for each group and each variable with class \code{"rsi"}.
 #'
-#' The function \code{rsi_df} works exactly like \code{portion_df}, but add the number of isolates.
+#' The function \code{rsi_df} works exactly like \code{portion_df}, but adds the number of isolates.
 #' \if{html}{
 #    (created with https://www.latex4technics.com/)
 #'   \cr\cr

R/rsi.R

@@ -387,9 +387,14 @@ summary.rsi <- function(object, ...) {
 #' @importFrom dplyr %>% group_by summarise filter mutate if_else n_distinct
 #' @importFrom graphics plot text
 #' @noRd
-plot.rsi <- function(x, ...) {
-  x_name <- deparse(substitute(x))
-
+plot.rsi <- function(x,
+                     lwd = 2,
+                     ylim = NULL,
+                     ylab = 'Percentage',
+                     xlab = 'Antimicrobial Interpretation',
+                     main = paste('Susceptibility Analysis of', deparse(substitute(x))),
+                     axes = FALSE,
+                     ...) {
   suppressWarnings(
     data <- data.frame(x = x,
                        y = 1,
@@ -415,13 +420,12 @@ plot.rsi <- function(x, ...) {
 
   plot(x = data$x,
        y = data$s,
-       lwd = 2,
-       col = c('green', 'orange', 'red'),
+       lwd = lwd,
        ylim = c(0, ymax),
-       ylab = 'Percentage',
-       xlab = 'Antimicrobial Interpretation',
-       main = paste('Susceptibility Analysis of', x_name),
-       axes = FALSE,
+       ylab = ylab,
+       xlab = xlab,
+       main = main,
+       axes = axes,
        ...)
   # x axis
   axis(side = 1, at = 1:n_distinct(data$x), labels = levels(data$x), lwd = 0)
@@ -439,24 +443,32 @@ plot.rsi <- function(x, ...) {
 #' @importFrom dplyr %>% group_by summarise
 #' @importFrom graphics barplot axis
 #' @noRd
-barplot.rsi <- function(height, ...) {
-  x <- height
-  x_name <- deparse(substitute(height))
+barplot.rsi <- function(height,
+                        col = c('green3', 'orange2', 'red3'),
+                        xlab = ifelse(beside, 'Antimicrobial Interpretation', ''),
+                        main = paste('Susceptibility Analysis of', deparse(substitute(height))),
+                        ylab = 'Frequency',
+                        beside = TRUE,
+                        axes = beside,
+                        ...) {
 
-  suppressWarnings(
-    data <- data.frame(rsi = x, cnt = 1) %>%
-      group_by(rsi) %>%
-      summarise(cnt = sum(cnt)) %>%
-      droplevels()
-  )
+  if (axes == TRUE) {
+    par(mar =  c(5, 4, 4, 2) + 0.1)
+  } else {
+    par(mar =  c(2, 4, 4, 2) + 0.1)
+  }
 
-  barplot(table(x),
-          col = c('green3', 'orange2', 'red3'),
-          xlab = 'Antimicrobial Interpretation',
-          main = paste('Susceptibility Analysis of', x_name),
-          ylab = 'Frequency',
+  barplot(as.matrix(table(height)),
+          col = col,
+          xlab = xlab,
+          main = main,
+          ylab = ylab,
+          beside = beside,
           axes = FALSE,
           ...)
   # y axis, 0-100%
-  axis(side = 2, at = seq(0, max(data$cnt) + max(data$cnt) * 1.1, by = 25))
+  axis(side = 2, at = seq(0, max(table(height)) + max(table(height)) * 1.1, by = 25))
+  if (axes == TRUE && beside == TRUE) {
+    axis(side = 1, labels = levels(height), at = c(1, 2, 3) + 0.5, lwd = 0)
+  }
 }