P281424
/
AMR
mirror of https://github.com/msberends/AMR.git
1
0
Fork 0
Code Releases Activity

top_freq

This commit is contained in:
dr. M.S. (Matthijs) Berends 2018-06-20 14:47:37 +02:00
parent 4a027f3c34
commit a9bd5472d0
10 changed files with 152 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
DESCRIPTION
View File

@ -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(

5
NAMESPACE
View File

@ -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)

8
NEWS.md
View File

@ -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`

61
R/freq.R
View File

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

3
R/globals.R
View File

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

11
R/print.R
View File

@ -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]]
}

35
man/freq.Rd
View File

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

3
man/print.Rd
View File

@ -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{

30
tests/testthat/test-freq.R
View File

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

4
tests/testthat/test-joins.R
View File

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