rsi for freq

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: AMR
-Version: 0.2.0.9018
+Version: 0.2.0.9019
-Date: 2018-07-30
+Date: 2018-08-01
 Title: Antimicrobial Resistance Analysis
 Authors@R: c(
     person(

NEWS.md

@@ -17,6 +17,7 @@
 * Functions `clipboard_import` and `clipboard_export` as helper functions to quickly copy and paste from/to software like Excel and SPSS. These functions use the `clipr` package, but are a little altered to also support headless Linux servers (so you can use it in RStudio Server)
 * New for frequency tables (function `freq`):
   * A vignette to explain its usage
+  * Support for `rsi` (antimicrobial resistance) to use as input
   * Support for `table` to use as input: `freq(table(x, y))`
   * Support for existing functions `hist` and `plot` to use a frequency table as input: `hist(freq(df$age))`
   * Support for `as.vector`, `as.data.frame`, `as_tibble` and `format`
@@ -30,9 +31,9 @@
 * More antibiotics 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
-* Printing of class `mic` now shows all MIC values
 * `%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
@@ -52,7 +53,7 @@
 * Other small fixes
 
 #### Other
-* Unit testing for all Linux and macOS release of R 3.1 and higher: https://travis-ci.org/msberends/AMR
+* Unit testing for all Linux and macOS releases of R 3.1 and higher: https://travis-ci.org/msberends/AMR
 
 # 0.2.0 (latest stable version)
 **Published on CRAN: 2018-05-03**

R/classes.R

@@ -36,6 +36,7 @@
 #'
 #' plot(rsi_data)    # for percentages
 #' barplot(rsi_data) # for frequencies
+#' freq(rsi_data)    # frequency table with informative header
 as.rsi <- function(x) {
   if (is.rsi(x)) {
     x
@@ -92,39 +93,17 @@ is.rsi <- function(x) {
 #' @importFrom dplyr %>%
 #' @noRd
 print.rsi <- function(x, ...) {
-  n_total <- x %>% length()
-  x <- x[!is.na(x)]
-  n <- x %>% length()
-  S <- x[x == 'S'] %>% length()
-  I <- x[x == 'I'] %>% length()
-  R <- x[x == 'R'] %>% length()
-  IR <- x[x %in% c('I', 'R')] %>% length()
   cat("Class 'rsi'\n")
-  cat(n, " results (missing: ", n_total - n, ' = ', percent((n_total - n) / n_total, force_zero = TRUE), ')\n', sep = "")
+  print(as.character(x), quote = FALSE)
-  if (n > 0) {
-    cat('\n')
-    cat('Sum of S:   ', S, ' (', percent(S / n, force_zero = TRUE), ')\n', sep = "")
-    cat('Sum of IR:  ', IR, ' (', percent(IR / n, force_zero = TRUE), ')\n', sep = "")
-    cat('- Sum of R: ', R, ' (', percent(R / n, force_zero = TRUE), ')\n', sep = "")
-    cat('- Sum of I: ', I, ' (', percent(I / n, force_zero = TRUE), ')\n', sep = "")
-  }
 }
 
 #' @exportMethod summary.rsi
 #' @export
-#' @importFrom dplyr %>%
 #' @noRd
 summary.rsi <- function(object, ...) {
   x <- object
-  n_total <- x %>% length()
+  lst <- c('rsi', sum(is.na(x)), sum(x == "S"), sum(x %in% c("I", "R")), sum(x == "R"), sum(x == "I"))
-  x <- x[!is.na(x)]
+  names(lst) <- c("Mode", "<NA>", "Sum S", "Sum IR", "-Sum R", "-Sum I")
-  n <- x %>% length()
-  S <- x[x == 'S'] %>% length()
-  I <- x[x == 'I'] %>% length()
-  R <- x[x == 'R'] %>% length()
-  IR <- x[x %in% c('I', 'R')] %>% length()
-  lst <- c('rsi', n_total - n, S, IR, R, I)
-  names(lst) <- c("Mode", "<NA>", "Sum S", "Sum IR", "Sum R", "Sum I")
   lst
 }
 
@@ -213,6 +192,7 @@ barplot.rsi <- function(height, ...) {
 #'
 #' plot(mic_data)
 #' barplot(mic_data)
+#' freq(mic_data)
 as.mic <- function(x, na.rm = FALSE) {
   if (is.mic(x)) {
     x
@@ -363,18 +343,8 @@ as.numeric.mic <- function(x, ...) {
 #' @importFrom dplyr %>% tibble group_by summarise pull
 #' @noRd
 print.mic <- function(x, ...) {
-  n_total <- x %>% length()
-  x <- x[!is.na(x)]
-  n <- x %>% length()
   cat("Class 'mic'\n")
-  cat(n, " results (missing: ", n_total - n, ' = ', percent((n_total - n) / n_total, force_zero = TRUE), ')\n', sep = "")
+  print(as.character(x), quote = FALSE)
-  if (n > 0) {
-    cat('\n')
-    tibble(MIC = x, y = 1) %>%
-      group_by(MIC) %>%
-      summarise(n = sum(y)) %>%
-      base::print.data.frame(row.names = FALSE)
-  }
 }
 
 #' @exportMethod summary.mic
@@ -406,7 +376,6 @@ plot.mic <- function(x, ...) {
 
 #' @exportMethod barplot.mic
 #' @export
-#' @importFrom dplyr %>% group_by summarise
 #' @importFrom graphics barplot axis
 #' @noRd
 barplot.mic <- function(height, ...) {
@@ -415,6 +384,7 @@ barplot.mic <- function(height, ...) {
 }
 
 #' @importFrom graphics barplot axis
+#' @importFrom dplyr %>% group_by summarise
 create_barplot_mic <- function(x, x_name, ...) {
   data <- data.frame(mic = x, cnt = 1) %>%
     group_by(mic) %>%

R/freq.R

@@ -305,7 +305,7 @@ frequency_tbl <- function(x,
 
   header <- header %>% paste0(markdown_line, '\nLength:    ', (NAs %>% length() + x %>% length()) %>% format(),
                               ' (of which NA: ', NAs %>% length() %>% format(),
-                              ' = ', (NAs %>% length() / (NAs %>% length() + x %>% length())) %>% percent(force_zero = TRUE) %>% sub('NaN', '0', ., fixed = TRUE), ')')
+                              ' = ', (NAs %>% length() / (NAs %>% length() + x %>% length())) %>% percent(force_zero = TRUE, round = digits) %>% sub('NaN', '0', ., fixed = TRUE), ')')
   header <- header %>% paste0(markdown_line, '\nUnique:    ', x %>% n_distinct() %>% format())
 
   if (NROW(x) > 0 & any(class(x) %in% c('double', 'integer', 'numeric', 'raw', 'single'))) {
@@ -326,6 +326,17 @@ frequency_tbl <- function(x,
       header <- header %>% paste0(' (unique: ', boxplot.stats(x)$out %>% n_distinct(), ')')
     }
   }
+  if (any(class(x) == "rsi")) {
+    header <- header %>% paste0('\n')
+    cnt_S <- sum(x == "S")
+    cnt_I <- sum(x == "I")
+    cnt_R <- sum(x == "R")
+    header <- header %>% paste(markdown_line, '\n%IR:      ',
+                               ((cnt_I + cnt_R) / sum(!is.na(x))) %>% percent(force_zero = TRUE, round = digits))
+    header <- header %>% paste0(markdown_line, '\nRatio SIR: 1.0 : ',
+                                (cnt_I / cnt_S) %>% format(digits = 1, nsmall = 1), " : ",
+                                (cnt_R / cnt_S) %>% format(digits = 1, nsmall = 1))
+  }
 
   formatdates <- "%e %B %Y" # = d mmmm yyyy
   if (any(class(x) == 'hms')) {

man/as.mic.Rd

@@ -29,6 +29,7 @@ as.mic("<=0.002; S") # will return <=0.002
 
 plot(mic_data)
 barplot(mic_data)
+freq(mic_data)
 }
 \seealso{
 \code{\link{as.rsi}}

man/as.rsi.Rd

@@ -28,6 +28,7 @@ as.rsi("<= 0.002; S") # will return S
 
 plot(rsi_data)    # for percentages
 barplot(rsi_data) # for frequencies
+freq(rsi_data)    # frequency table with informative header
 }
 \seealso{
 \code{\link{as.mic}}

tests/testthat/test-classes.R

@@ -17,8 +17,8 @@ test_that("rsi works", {
                                                "<NA>" = "0",
                                                "Sum S" = "1",
                                                "Sum IR" = "1",
-                                               "Sum R" = "1",
+                                               "-Sum R" = "1",
-                                               "Sum I" = "0"))
+                                               "-Sum I" = "0"))
 })
 
 test_that("mic works", {

tests/testthat/test-freq.R

@@ -19,6 +19,8 @@ test_that("frequency table works", {
   expect_output(print(freq(septic_patients$hospital_id)))
   # table
   expect_output(print(freq(table(septic_patients$sex, septic_patients$age))))
+  # rsi
+  expect_output(print(freq(septic_patients$amcl)))
 
   library(dplyr)
   expect_output(septic_patients %>% select(1:2) %>% freq() %>% print())