top_freq

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: AMR
-Version: 0.2.0.9004
+Version: 0.2.0.9005
-Date: 2018-06-18
+Date: 2018-06-20
 Title: Antimicrobial Resistance Analysis
 Authors@R: c(
     person(

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)

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
+#### Changed
-* 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)`
 * 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`

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

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

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 {

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}

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{

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

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