diff --git a/DESCRIPTION b/DESCRIPTION index 19612e20..ca6ad891 100755 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: AMR -Version: 0.2.0.9004 -Date: 2018-06-18 +Version: 0.2.0.9005 +Date: 2018-06-20 Title: Antimicrobial Resistance Analysis Authors@R: c( person( diff --git a/NAMESPACE b/NAMESPACE index 7b08ed4e..d9fe12d7 100755 --- a/NAMESPACE +++ b/NAMESPACE @@ -8,6 +8,7 @@ S3method(barplot,rsi) S3method(plot,mic) S3method(plot,rsi) S3method(print,data.table) +S3method(print,frequency_tbl) S3method(print,mic) S3method(print,rsi) S3method(print,tbl) @@ -46,6 +47,7 @@ export(rsi) export(rsi_df) export(rsi_predict) export(semi_join_microorganisms) +export(top_freq) exportMethods(as.double.mic) exportMethods(as.integer.mic) exportMethods(as.numeric.mic) @@ -54,6 +56,7 @@ exportMethods(barplot.rsi) exportMethods(plot.mic) exportMethods(plot.rsi) exportMethods(print.data.table) +exportMethods(print.frequency_tbl) exportMethods(print.mic) exportMethods(print.rsi) exportMethods(print.tbl) @@ -88,6 +91,7 @@ importFrom(dplyr,select) importFrom(dplyr,slice) importFrom(dplyr,summarise) importFrom(dplyr,tibble) +importFrom(dplyr,top_n) importFrom(dplyr,vars) importFrom(grDevices,boxplot.stats) importFrom(graphics,axis) @@ -102,6 +106,7 @@ importFrom(rvest,html_table) importFrom(stats,fivenum) importFrom(stats,quantile) importFrom(stats,sd) +importFrom(utils,browseVignettes) importFrom(utils,object.size) importFrom(utils,packageDescription) importFrom(xml2,read_html) diff --git a/NEWS.md b/NEWS.md index 5925d9a4..c41196fb 100755 --- a/NEWS.md +++ b/NEWS.md @@ -1,8 +1,12 @@ # 0.2.0.90xx (development version) +#### New +* Function `top_freq` function to get the top/below *n* items of frequency tables +* Vignette about frequency tables +* Possibility to globally set the default for the amount of items to print in frequency tables (`freq` function), with `options(max.print.freq = n)` -* New vignette about frequency tables -* Added possibility to globally set the default for the amount of items to print in frequency tables (`freq` function), with `options(max.print.freq = n)` +#### Changed * Renamed `toConsole` parameter of `freq` function to `as.data.frame` +* Added pretty printing for frequency tables when returned as `data.frame` * Small translational improvements to the `septic_patients` dataset * Combined MIC/RSI values will now be coerced by the `rsi` and `mic` functions: * `as.rsi("<=0.002; S")` will return `S` diff --git a/R/freq.R b/R/freq.R index 77e15f47..afcbbcc3 100755 --- a/R/freq.R +++ b/R/freq.R @@ -18,7 +18,7 @@ #' Frequency table #' -#' Create a frequency table of a vector of data, a single column or a maximum of 9 columns of a data frame. Supports markdown for reports. +#' Create a frequency table of a vector of data, a single column or a maximum of 9 columns of a data frame. Supports markdown for reports. \code{top_freq} can be used to get the top/bottom \emph{n} items of a frequency table, with counts as names. #' @param x data #' @param sort.count sort on count. Use \code{FALSE} to sort alphabetically on item. #' @param nmax number of row to print. The default, \code{15}, uses \code{\link{getOption}("max.print.freq")}. Use \code{nmax = 0} or \code{nmax = NA} to print all rows. @@ -28,7 +28,11 @@ #' @param as.data.frame return frequency table without header as a \code{data.frame} (e.g. to assign the table to an object) #' @param digits how many significant digits are to be used for numeric values (not for the items themselves, that depends on \code{\link{getOption}("digits")}) #' @param sep a character string to separate the terms when selecting multiple columns -#' @details For numeric values, the next values will be calculated and shown into the header: +#' @param f a frequency table as \code{data.frame}, used as \code{freq(..., as.data.frame = TRUE)} +#' @param n number of top \emph{n} items to return, use -n for the bottom \emph{n} items. It will include more than \code{n} rows if there are ties. +#' @details This package also has a vignette available about this function, run: \code{browseVignettes("AMR")} to read it. +#' +#' For numeric values of any class, these additional values will be calculated and shown into the header: #' \itemize{ #' \item{Mean, using \code{\link[base]{mean}}} #' \item{Standard deviation, using \code{\link[stats]{sd}}} @@ -37,11 +41,25 @@ #' \item{Coefficient of variation (CV), the standard deviation divided by the mean} #' \item{Coefficient of quartile variation (CQV, sometimes called coefficient of dispersion), calculated as \code{(Q3 - Q1) / (Q3 + Q1)} using \code{\link{quantile}} with \code{type = 6} as quantile algorithm to comply with SPSS standards} #' } +#' +#' For dates and times of any class, these additional values will be calculated and shown into the header: +#' \itemize{ +#' \item{Oldest, using \code{\link[base]{min}}} +#' \item{Newest, using \code{\link[base]{max}}, with difference between newest and oldest} +#' \item{Median, using \code{\link[stats]{median}}, with percentage since oldest} +#' } +#' +#' The function \code{top_freq} uses \code{\link[dplyr]{top_n}} internally and will include more than \code{n} rows if there are ties. #' @importFrom stats fivenum sd quantile #' @importFrom grDevices boxplot.stats #' @importFrom dplyr %>% select pull n_distinct group_by arrange desc mutate summarise +#' @importFrom utils browseVignettes #' @keywords summary summarise frequency freq #' @rdname freq +#' @return \itemize{ +#' \item{When using \code{as.data.frame = FALSE} (default): only printed text} +#' \item{When using \code{as.data.frame = TRUE}: a \code{data.frame} object with an additional class \code{"frequency_tbl"}} +#' } #' @export #' @examples #' library(dplyr) @@ -65,6 +83,13 @@ #' mutate(year = format(date, "%Y")) %>% #' select(year) %>% #' freq(as.data.frame = TRUE) +#' +#' # get top 10 bugs of hospital A as a vector +#' septic_patients %>% +#' filter(hospital_id == "A") %>% +#' select(bactid) %>% +#' freq(as.data.frame = TRUE) %>% +#' top_freq(10) freq <- function(x, sort.count = TRUE, nmax = getOption("max.print.freq"), @@ -200,7 +225,6 @@ freq <- function(x, ' = ', (NAs %>% length() / (NAs %>% length() + x %>% length())) %>% percent(force_zero = TRUE), ')') header <- header %>% paste0(markdown_line, '\nUnique: ', x %>% n_distinct() %>% format()) - header.numbers.done <- FALSE if (any(class(x) %in% c('double', 'integer', 'numeric', 'raw', 'single'))) { # right align number x_align <- 'r' @@ -226,11 +250,15 @@ freq <- function(x, header <- header %>% paste0('\n') mindate <- x %>% min(na.rm = TRUE) maxdate <- x %>% max(na.rm = TRUE) + maxdate_days <- difftime(maxdate, mindate, units = 'auto') %>% as.double() mediandate <- x %>% median(na.rm = TRUE) + median_days <- difftime(mediandate, mindate, units = 'auto') %>% as.double() + header <- header %>% paste0(markdown_line, '\nOldest: ', mindate %>% format(formatdates) %>% trimws()) header <- header %>% paste0(markdown_line, '\nNewest: ', maxdate %>% format(formatdates) %>% trimws(), ' (+', difftime(maxdate, mindate, units = 'auto') %>% as.double() %>% format(), ')') - header <- header %>% paste0(markdown_line, '\nMedian: ', mediandate %>% format(formatdates) %>% trimws()) + header <- header %>% paste0(markdown_line, '\nMedian: ', mediandate %>% format(formatdates) %>% trimws(), + ' (~', percent(median_days / maxdate_days, round = 0), ')') } if (any(class(x) == 'POSIXlt')) { x <- x %>% format(formatdates) @@ -314,7 +342,9 @@ freq <- function(x, df[, 4] <- cumsum(df[, 2]) df[, 5] <- df[, 4] / sum(df[, 2], na.rm = TRUE) colnames(df) <- column_names_df - return(as.data.frame(df, stringsAsFactors = FALSE)) + df <- as.data.frame(df, stringsAsFactors = FALSE) + class(df) <- c('frequency_tbl', class(df)) + return(df) } if (markdown == TRUE) { @@ -376,3 +406,24 @@ freq <- function(x, #' @rdname freq #' @export frequency_tbl <- freq + +#' @rdname freq +#' @export +#' @importFrom dplyr top_n pull +top_freq <- function(f, n) { + if (!'frequency_tbl' %in% class(f)) { + stop('top_freq can only be applied to frequency tables', call. = FALSE) + } + if (!is.numeric(n) | length(n) != 1L) { + stop('For top_freq, `nmax` must be a number of length 1', call. = FALSE) + } + top <- f %>% top_n(n, count) + vect <- top %>% pull(item) + names(vect) <- top %>% pull(count) + if (length(vect) > abs(n)) { + message("top_freq: selecting ", length(vect), " items instead of ", abs(n), ", because of ties") + } + vect +} + + diff --git a/R/globals.R b/R/globals.R index c9d7e9c6..19b0f2f8 100755 --- a/R/globals.R +++ b/R/globals.R @@ -21,6 +21,7 @@ globalVariables(c('abname', 'bactid', 'cnt', 'Count', + 'count', 'Cum', 'CumTot', 'date_lab', @@ -31,9 +32,11 @@ globalVariables(c('abname', 'genus', 'gramstain', 'Item', + 'item', 'key_ab', 'key_ab_lag', 'key_ab_other', + 'median', 'mic', 'mocode', 'molis', diff --git a/R/print.R b/R/print.R index 7cb3b4de..cee58061 100755 --- a/R/print.R +++ b/R/print.R @@ -74,6 +74,13 @@ print.tbl <- function(x, ...) { prettyprint_df(x, ...) } +#' @rdname print +#' @exportMethod print.frequency_tbl +#' @export +print.frequency_tbl <- function(x, ...) { + prettyprint_df(x, ...) +} + #' @rdname print #' @exportMethod print.data.table #' @export @@ -124,6 +131,8 @@ prettyprint_df <- function(x, if ('tbl_df' %in% class(x)) { type <- 'tibble' + } else if ('frequency_tbl' %in% class(x)) { + type <- 'frequency table' } else if ('data.table' %in% class(x)) { type <- 'data.table' } else { @@ -226,7 +235,7 @@ prettyprint_df <- function(x, paste0(collapse = '/')) } else { if (NCOL(.) > 1) { - .[1,] + .[1, ] } else { c[[1]] } diff --git a/man/freq.Rd b/man/freq.Rd index 4126b556..ccf1840e 100755 --- a/man/freq.Rd +++ b/man/freq.Rd @@ -3,6 +3,7 @@ \name{freq} \alias{freq} \alias{frequency_tbl} +\alias{top_freq} \title{Frequency table} \usage{ freq(x, sort.count = TRUE, nmax = getOption("max.print.freq"), @@ -12,6 +13,8 @@ freq(x, sort.count = TRUE, nmax = getOption("max.print.freq"), frequency_tbl(x, sort.count = TRUE, nmax = getOption("max.print.freq"), na.rm = TRUE, row.names = TRUE, markdown = FALSE, as.data.frame = FALSE, digits = 2, sep = " ") + +top_freq(f, n) } \arguments{ \item{x}{data} @@ -31,12 +34,24 @@ frequency_tbl(x, sort.count = TRUE, nmax = getOption("max.print.freq"), \item{digits}{how many significant digits are to be used for numeric values (not for the items themselves, that depends on \code{\link{getOption}("digits")})} \item{sep}{a character string to separate the terms when selecting multiple columns} + +\item{f}{a frequency table as \code{data.frame}, used as \code{freq(..., as.data.frame = TRUE)}} + +\item{n}{number of top \emph{n} items to return, use -n for the bottom \emph{n} items. It will include more than \code{n} rows if there are ties.} +} +\value{ +\itemize{ + \item{When using \code{as.data.frame = FALSE} (default): only printed text} + \item{When using \code{as.data.frame = TRUE}: a \code{data.frame} object with an additional class \code{"frequency_tbl"}} +} } \description{ -Create a frequency table of a vector of data, a single column or a maximum of 9 columns of a data frame. Supports markdown for reports. +Create a frequency table of a vector of data, a single column or a maximum of 9 columns of a data frame. Supports markdown for reports. \code{top_freq} can be used to get the top/bottom \emph{n} items of a frequency table, with counts as names. } \details{ -For numeric values, the next values will be calculated and shown into the header: +This package also has a vignette available about this function, run: \code{browseVignettes("AMR")} to read it. + +For numeric values of any class, these additional values will be calculated and shown into the header: \itemize{ \item{Mean, using \code{\link[base]{mean}}} \item{Standard deviation, using \code{\link[stats]{sd}}} @@ -45,6 +60,15 @@ For numeric values, the next values will be calculated and shown into the header \item{Coefficient of variation (CV), the standard deviation divided by the mean} \item{Coefficient of quartile variation (CQV, sometimes called coefficient of dispersion), calculated as \code{(Q3 - Q1) / (Q3 + Q1)} using \code{\link{quantile}} with \code{type = 6} as quantile algorithm to comply with SPSS standards} } + +For dates and times of any class, these additional values will be calculated and shown into the header: +\itemize{ + \item{Oldest, using \code{\link[base]{min}}} + \item{Newest, using \code{\link[base]{max}}, with difference between newest and oldest} + \item{Median, using \code{\link[stats]{median}}, with percentage since oldest} +} + +The function \code{top_freq} uses \code{\link[dplyr]{top_n}} internally and will include more than \code{n} rows if there are ties. } \examples{ library(dplyr) @@ -68,6 +92,13 @@ years <- septic_patients \%>\% mutate(year = format(date, "\%Y")) \%>\% select(year) \%>\% freq(as.data.frame = TRUE) + +# get top 10 bugs of hospital A as a vector +septic_patients \%>\% + filter(hospital_id == "A") \%>\% + select(bactid) \%>\% + freq(as.data.frame = TRUE) \%>\% + top_freq(10) } \keyword{freq} \keyword{frequency} diff --git a/man/print.Rd b/man/print.Rd index 13b993e2..b0e47a78 100755 --- a/man/print.Rd +++ b/man/print.Rd @@ -4,6 +4,7 @@ \alias{print} \alias{print.tbl_df} \alias{print.tbl} +\alias{print.frequency_tbl} \alias{print.data.table} \title{Printing Data Tables and Tibbles} \usage{ @@ -12,6 +13,8 @@ \method{print}{tbl}(x, ...) +\method{print}{frequency_tbl}(x, ...) + \method{print}{data.table}(x, print.keys = FALSE, ...) } \arguments{ diff --git a/tests/testthat/test-freq.R b/tests/testthat/test-freq.R index 02bf695d..c9fbf11c 100755 --- a/tests/testthat/test-freq.R +++ b/tests/testthat/test-freq.R @@ -9,8 +9,11 @@ test_that("frequency table works", { expect_equal(nrow(freq(septic_patients$date, as.data.frame = TRUE)), length(unique(septic_patients$date))) + # int expect_output(freq(septic_patients$age)) + # date expect_output(freq(septic_patients$date)) + # factor expect_output(freq(septic_patients$hospital_id)) library(dplyr) @@ -22,5 +25,32 @@ test_that("frequency table works", { expect_output(septic_patients %>% select(1:7) %>% freq()) expect_output(septic_patients %>% select(1:8) %>% freq()) expect_output(septic_patients %>% select(1:9) %>% freq()) + + # top 5 + expect_equal( + septic_patients %>% + select(bactid) %>% + freq(as.data.frame = TRUE) %>% + top_freq(5) %>% + length(), + 5) + # there're more than 5 lowest values + expect_gt( + septic_patients %>% + select(bactid) %>% + freq(as.data.frame = TRUE) %>% + top_freq(-5) %>% + length(), + 5) + # n has length > 1 + expect_error( + septic_patients %>% + select(bactid) %>% + freq(as.data.frame = TRUE) %>% + top_freq(n = c(1, 2)) + ) + # input must be freq tbl + expect_error(septic_patients %>% top_freq(1)) + }) diff --git a/tests/testthat/test-joins.R b/tests/testthat/test-joins.R index 9009705e..0ba877fe 100755 --- a/tests/testthat/test-joins.R +++ b/tests/testthat/test-joins.R @@ -23,5 +23,9 @@ test_that("joins work", { expect_true(nrow(unjoined) < nrow(right)) expect_true(nrow(unjoined) < nrow(full)) + expect_equal(nrow(inner_join_microorganisms("ESCCOL")), 1) expect_equal(nrow(left_join_microorganisms("ESCCOL")), 1) + expect_equal(nrow(semi_join_microorganisms("ESCCOL")), 1) + expect_equal(nrow(anti_join_microorganisms("ESCCOL")), 0) + })