From edd2dd09dc70633a8499b589211e1de4ba1e95d6 Mon Sep 17 00:00:00 2001 From: "Matthijs S. Berends" Date: Wed, 1 Aug 2018 22:37:28 +0200 Subject: [PATCH] rsi for freq --- DESCRIPTION | 4 ++-- NEWS.md | 5 ++-- R/classes.R | 44 ++++++----------------------------- R/freq.R | 13 ++++++++++- man/as.mic.Rd | 1 + man/as.rsi.Rd | 1 + tests/testthat/test-classes.R | 4 ++-- tests/testthat/test-freq.R | 2 ++ 8 files changed, 30 insertions(+), 44 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index df6100cc..f8366141 100755 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: AMR -Version: 0.2.0.9018 -Date: 2018-07-30 +Version: 0.2.0.9019 +Date: 2018-08-01 Title: Antimicrobial Resistance Analysis Authors@R: c( person( diff --git a/NEWS.md b/NEWS.md index 804d8d91..b3daa2a4 100755 --- a/NEWS.md +++ b/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** diff --git a/R/classes.R b/R/classes.R index 57a9187b..4e2f7dba 100755 --- a/R/classes.R +++ b/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 = "") - 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 = "") - } + print(as.character(x), quote = FALSE) } #' @exportMethod summary.rsi #' @export -#' @importFrom dplyr %>% #' @noRd summary.rsi <- function(object, ...) { x <- object - 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() - lst <- c('rsi', n_total - n, S, IR, R, I) - names(lst) <- c("Mode", "", "Sum S", "Sum IR", "Sum R", "Sum I") + lst <- c('rsi', sum(is.na(x)), sum(x == "S"), sum(x %in% c("I", "R")), sum(x == "R"), sum(x == "I")) + names(lst) <- c("Mode", "", "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 = "") - if (n > 0) { - cat('\n') - tibble(MIC = x, y = 1) %>% - group_by(MIC) %>% - summarise(n = sum(y)) %>% - base::print.data.frame(row.names = FALSE) - } + print(as.character(x), quote = 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) %>% diff --git a/R/freq.R b/R/freq.R index 6c37a6fe..ad832703 100755 --- a/R/freq.R +++ b/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')) { diff --git a/man/as.mic.Rd b/man/as.mic.Rd index 371ccccf..2031cedd 100755 --- a/man/as.mic.Rd +++ b/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}} diff --git a/man/as.rsi.Rd b/man/as.rsi.Rd index 24352463..0c6f4d76 100755 --- a/man/as.rsi.Rd +++ b/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}} diff --git a/tests/testthat/test-classes.R b/tests/testthat/test-classes.R index 6fb448c2..08eb2ba1 100755 --- a/tests/testthat/test-classes.R +++ b/tests/testthat/test-classes.R @@ -17,8 +17,8 @@ test_that("rsi works", { "" = "0", "Sum S" = "1", "Sum IR" = "1", - "Sum R" = "1", - "Sum I" = "0")) + "-Sum R" = "1", + "-Sum I" = "0")) }) test_that("mic works", { diff --git a/tests/testthat/test-freq.R b/tests/testthat/test-freq.R index fbb4f568..6972970f 100755 --- a/tests/testthat/test-freq.R +++ b/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())