P281424/AMR
1
0
Fork 0
mirror of https://github.com/msberends/AMR.git synced 2024-12-26 19:26:12 +01:00
Code Releases Activity

param header for freq

Browse Source
This commit is contained in:
dr. M.S. (Matthijs) Berends 2018-10-19 21:52:08 +02:00
parent 86b03577a7
commit ec15b82fd6
3 changed files with 50 additions and 42 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
NEWS.md
View File

@ -19,7 +19,8 @@
* Using `portion_*` functions now throws a warning when total available isolate is below parameter `minimum` * Using `portion_*` functions now throws a warning when total available isolate is below parameter `minimum`
* Functions `as.mo`, `as.rsi` and `as.mic` will not set package name as attribute anymore * Functions `as.mo`, `as.rsi` and `as.mic` will not set package name as attribute anymore
* Data set `septic_patients` is now a `data.frame`, not a tibble anymore * Data set `septic_patients` is now a `data.frame`, not a tibble anymore
* Check for `hms::is.hms` in frequency tables * Check for `hms::is.hms` in frequency tables (`freq()`)
* New parameter `header` for frequency tables to turn them off (default when `markdown = TRUE`)
* Removed diacritics from all authors (columns `microorganisms$ref` and `microorganisms.old$ref`) to comply with CRAN policy to only allow ASCII characters * Removed diacritics from all authors (columns `microorganisms$ref` and `microorganisms.old$ref`) to comply with CRAN policy to only allow ASCII characters
* Fix for `mo_property` not working properly * Fix for `mo_property` not working properly
* Fix for `EUCAST_rules` where some Streptococci would become ceftazidime R in EUCAST rule 4.5 * Fix for `EUCAST_rules` where some Streptococci would become ceftazidime R in EUCAST rule 4.5

72
R/freq.R
View File

@ -23,17 +23,18 @@
#' @param ... up to nine different columns of \code{x} when \code{x} is a \code{data.frame} or \code{tibble}, to calculate frequencies from - see Examples #' @param ... up to nine different columns of \code{x} when \code{x} is a \code{data.frame} or \code{tibble}, to calculate frequencies from - see Examples
#' @param sort.count sort on count, i.e. frequencies. This will be \code{TRUE} at default for everything except for factors. #' @param sort.count sort on count, i.e. frequencies. This will be \code{TRUE} at default for everything except for factors.
#' @param nmax number of row to print. The default, \code{15}, uses \code{\link{getOption}("max.print.freq")}. Use \code{nmax = 0}, \code{nmax = Inf}, \code{nmax = NULL} or \code{nmax = NA} to print all rows. #' @param nmax number of row to print. The default, \code{15}, uses \code{\link{getOption}("max.print.freq")}. Use \code{nmax = 0}, \code{nmax = Inf}, \code{nmax = NULL} or \code{nmax = NA} to print all rows.
#' @param na.rm a logical value indicating whether \code{NA} values should be removed from the frequency table. The header will always print the amount of \code{NA}s. #' @param na.rm a logical value indicating whether \code{NA} values should be removed from the frequency table. The header_txt will always print the amount of \code{NA}s.
#' @param row.names a logical value indicating whether row indices should be printed as \code{1:nrow(x)} #' @param row.names a logical value indicating whether row indices should be printed as \code{1:nrow(x)}
#' @param markdown print table in markdown format (this forces \code{nmax = NA}) #' @param markdown print table in markdown format (this forces \code{nmax = NA})
#' @param digits how many significant digits are to be used for numeric values in the header (not for the items themselves, that depends on \code{\link{getOption}("digits")}) #' @param digits how many significant digits are to be used for numeric values in the header_txt (not for the items themselves, that depends on \code{\link{getOption}("digits")})
#' @param quote a logical value indicating whether or not strings should be printed with surrounding quotes #' @param quote a logical value indicating whether or not strings should be printed with surrounding quotes
#' @param header a logical value indicating whether an informative header should be printed
#' @param sep a character string to separate the terms when selecting multiple columns #' @param sep a character string to separate the terms when selecting multiple columns
#' @param f a frequency table #' @param f a frequency table
#' @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. #' @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 Frequency tables (or frequency distributions) are summaries of the distribution of values in a sample. With the `freq` function, you can create univariate frequency tables. Multiple variables will be pasted into one variable, so it forces a univariate distribution. This package also has a vignette available to explain the use of this function further, run \code{browseVignettes("AMR")} to read it. #' @details Frequency tables (or frequency distributions) are summaries of the distribution of values in a sample. With the `freq` function, you can create univariate frequency tables. Multiple variables will be pasted into one variable, so it forces a univariate distribution. This package also has a vignette available to explain the use of this function further, run \code{browseVignettes("AMR")} to read it.
#' #'
#' For numeric values of any class, these additional values will all be calculated with \code{na.rm = TRUE} and shown into the header: #' For numeric values of any class, these additional values will all be calculated with \code{na.rm = TRUE} and shown into the header_txt:
#' \itemize{ #' \itemize{
#' \item{Mean, using \code{\link[base]{mean}}} #' \item{Mean, using \code{\link[base]{mean}}}
#' \item{Standard Deviation, using \code{\link[stats]{sd}}} #' \item{Standard Deviation, using \code{\link[stats]{sd}}}
@ -45,7 +46,7 @@
#' \item{Outliers (total count and unique count), using \code{\link[grDevices]{boxplot.stats}}} #' \item{Outliers (total count and unique count), using \code{\link[grDevices]{boxplot.stats}}}
#' } #' }
#' #'
#' For dates and times of any class, these additional values will be calculated with \code{na.rm = TRUE} and shown into the header: #' For dates and times of any class, these additional values will be calculated with \code{na.rm = TRUE} and shown into the header_txt:
#' \itemize{ #' \itemize{
#' \item{Oldest, using \code{\link{min}}} #' \item{Oldest, using \code{\link{min}}}
#' \item{Newest, using \code{\link{max}}, with difference between newest and oldest} #' \item{Newest, using \code{\link{max}}, with difference between newest and oldest}
@ -156,6 +157,7 @@ frequency_tbl <- function(x,
markdown = FALSE, markdown = FALSE,
digits = 2, digits = 2,
quote = FALSE, quote = FALSE,
header = !markdown,
sep = " ") { sep = " ") {
mult.columns <- 0 mult.columns <- 0
@ -309,7 +311,7 @@ frequency_tbl <- function(x,
sort.count <- FALSE sort.count <- FALSE
} }
header <- character(0) header_txt <- character(0)
markdown_line <- '' markdown_line <- ''
if (markdown == TRUE) { if (markdown == TRUE) {
@ -318,11 +320,11 @@ frequency_tbl <- function(x,
x_align <- 'l' x_align <- 'l'
if (mult.columns > 0) { if (mult.columns > 0) {
header <- header %>% paste0(markdown_line, 'Columns: ', mult.columns) header_txt <- header_txt %>% paste0(markdown_line, 'Columns: ', mult.columns)
} else { } else {
header <- header %>% paste0(markdown_line, 'Class: ', class(x) %>% rev() %>% paste(collapse = " > ")) header_txt <- header_txt %>% paste0(markdown_line, 'Class: ', class(x) %>% rev() %>% paste(collapse = " > "))
if (!mode(x) %in% class(x)) { if (!mode(x) %in% class(x)) {
header <- header %>% paste0(silver(paste0(" (", mode(x), ")"))) header_txt <- header_txt %>% paste0(silver(paste0(" (", mode(x), ")")))
} }
} }
@ -334,53 +336,53 @@ frequency_tbl <- function(x,
} }
} }
header <- header %>% paste0(markdown_line, '\nLength: ', (NAs %>% length() + x %>% length()) %>% format(), header_txt <- header_txt %>% paste0(markdown_line, '\nLength: ', (NAs %>% length() + x %>% length()) %>% format(),
' (of which NA: ', NAs %>% length() %>% format() %>% NAs_to_red(), ' (of which NA: ', NAs %>% length() %>% format() %>% NAs_to_red(),
' = ', (NAs %>% length() / (NAs %>% length() + x %>% length())) %>% ' = ', (NAs %>% length() / (NAs %>% length() + x %>% length())) %>%
percent(force_zero = TRUE, round = digits) %>% percent(force_zero = TRUE, round = digits) %>%
sub('NaN', '0', ., fixed = TRUE) %>% sub('NaN', '0', ., fixed = TRUE) %>%
NAs_to_red(), ')') NAs_to_red(), ')')
header <- header %>% paste0(markdown_line, '\nUnique: ', x %>% n_distinct() %>% format()) header_txt <- header_txt %>% paste0(markdown_line, '\nUnique: ', x %>% n_distinct() %>% format())
if (NROW(x) > 0 & any(class(x) == "character")) { if (NROW(x) > 0 & any(class(x) == "character")) {
header <- header %>% paste0('\n') header_txt <- header_txt %>% paste0('\n')
header <- header %>% paste0(markdown_line, '\nShortest: ', x %>% base::nchar() %>% base::min(na.rm = TRUE)) header_txt <- header_txt %>% paste0(markdown_line, '\nShortest: ', x %>% base::nchar() %>% base::min(na.rm = TRUE))
header <- header %>% paste0(markdown_line, '\nLongest: ', x %>% base::nchar() %>% base::max(na.rm = TRUE)) header_txt <- header_txt %>% paste0(markdown_line, '\nLongest: ', x %>% base::nchar() %>% base::max(na.rm = TRUE))
} }
if (NROW(x) > 0 & any(class(x) == "difftime")) { if (NROW(x) > 0 & any(class(x) == "difftime")) {
header <- header %>% paste0('\n') header_txt <- header_txt %>% paste0('\n')
header <- header %>% paste(markdown_line, '\nUnits: ', attributes(x)$units) header_txt <- header_txt %>% paste(markdown_line, '\nUnits: ', attributes(x)$units)
x <- as.double(x) x <- as.double(x)
# after this, the numeric header continues # after this, the numeric header_txt continues
} }
if (NROW(x) > 0 & any(class(x) %in% c('double', 'integer', 'numeric', 'raw', 'single'))) { if (NROW(x) > 0 & any(class(x) %in% c('double', 'integer', 'numeric', 'raw', 'single'))) {
# right align number # right align number
Tukey_five <- stats::fivenum(x, na.rm = TRUE) Tukey_five <- stats::fivenum(x, na.rm = TRUE)
x_align <- 'r' x_align <- 'r'
header <- header %>% paste0('\n') header_txt <- header_txt %>% paste0('\n')
header <- header %>% paste(markdown_line, '\nMean: ', x %>% base::mean(na.rm = TRUE) %>% format(digits = digits)) header_txt <- header_txt %>% paste(markdown_line, '\nMean: ', x %>% base::mean(na.rm = TRUE) %>% format(digits = digits))
header <- header %>% paste0(markdown_line, '\nStd. dev.: ', x %>% stats::sd(na.rm = TRUE) %>% format(digits = digits), header_txt <- header_txt %>% paste0(markdown_line, '\nStd. dev.: ', x %>% stats::sd(na.rm = TRUE) %>% format(digits = digits),
' (CV: ', x %>% cv(na.rm = TRUE) %>% format(digits = digits), ' (CV: ', x %>% cv(na.rm = TRUE) %>% format(digits = digits),
', MAD: ', x %>% stats::mad(na.rm = TRUE) %>% format(digits = digits), ')') ', MAD: ', x %>% stats::mad(na.rm = TRUE) %>% format(digits = digits), ')')
header <- header %>% paste0(markdown_line, '\nFive-Num: ', Tukey_five %>% format(digits = digits) %>% trimws() %>% paste(collapse = ' | '), header_txt <- header_txt %>% paste0(markdown_line, '\nFive-Num: ', Tukey_five %>% format(digits = digits) %>% trimws() %>% paste(collapse = ' | '),
' (IQR: ', (Tukey_five[4] - Tukey_five[2]) %>% format(digits = digits), ' (IQR: ', (Tukey_five[4] - Tukey_five[2]) %>% format(digits = digits),
', CQV: ', x %>% cqv(na.rm = TRUE) %>% format(digits = digits), ')') ', CQV: ', x %>% cqv(na.rm = TRUE) %>% format(digits = digits), ')')
outlier_length <- length(boxplot.stats(x)$out) outlier_length <- length(boxplot.stats(x)$out)
header <- header %>% paste0(markdown_line, '\nOutliers: ', outlier_length) header_txt <- header_txt %>% paste0(markdown_line, '\nOutliers: ', outlier_length)
if (outlier_length > 0) { if (outlier_length > 0) {
header <- header %>% paste0(' (unique count: ', boxplot.stats(x)$out %>% n_distinct(), ')') header_txt <- header_txt %>% paste0(' (unique count: ', boxplot.stats(x)$out %>% n_distinct(), ')')
} }
} }
if (NROW(x) > 0 & any(class(x) == "rsi")) { if (NROW(x) > 0 & any(class(x) == "rsi")) {
header <- header %>% paste0('\n') header_txt <- header_txt %>% paste0('\n')
cnt_S <- sum(x == "S") cnt_S <- sum(x == "S")
cnt_I <- sum(x == "I") cnt_I <- sum(x == "I")
cnt_R <- sum(x == "R") cnt_R <- sum(x == "R")
header <- header %>% paste(markdown_line, '\n%IR: ', header_txt <- header_txt %>% paste(markdown_line, '\n%IR: ',
((cnt_I + cnt_R) / sum(!is.na(x))) %>% percent(force_zero = TRUE, round = digits)) ((cnt_I + cnt_R) / sum(!is.na(x))) %>% percent(force_zero = TRUE, round = digits))
header <- header %>% paste0(markdown_line, '\nRatio SIR: 1.0 : ', header_txt <- header_txt %>% paste0(markdown_line, '\nRatio SIR: 1.0 : ',
(cnt_I / cnt_S) %>% format(digits = 1, nsmall = 1), " : ", (cnt_I / cnt_S) %>% format(digits = 1, nsmall = 1), " : ",
(cnt_R / cnt_S) %>% format(digits = 1, nsmall = 1)) (cnt_R / cnt_S) %>% format(digits = 1, nsmall = 1))
} }
@ -391,7 +393,7 @@ frequency_tbl <- function(x,
formatdates <- "%H:%M:%S" formatdates <- "%H:%M:%S"
} }
if (NROW(x) > 0 & any(class(x) %in% c('Date', 'POSIXct', 'POSIXlt'))) { if (NROW(x) > 0 & any(class(x) %in% c('Date', 'POSIXct', 'POSIXlt'))) {
header <- header %>% paste0('\n') header_txt <- header_txt %>% paste0('\n')
mindate <- x %>% min(na.rm = TRUE) mindate <- x %>% min(na.rm = TRUE)
maxdate <- x %>% max(na.rm = TRUE) maxdate <- x %>% max(na.rm = TRUE)
maxdate_days <- difftime(maxdate, mindate, units = 'auto') %>% as.double() maxdate_days <- difftime(maxdate, mindate, units = 'auto') %>% as.double()
@ -400,16 +402,16 @@ frequency_tbl <- function(x,
if (formatdates == "%H:%M:%S") { if (formatdates == "%H:%M:%S") {
# hms # hms
header <- header %>% paste0(markdown_line, '\nEarliest: ', mindate %>% format(formatdates) %>% trimws()) header_txt <- header_txt %>% paste0(markdown_line, '\nEarliest: ', mindate %>% format(formatdates) %>% trimws())
header <- header %>% paste0(markdown_line, '\nLatest: ', maxdate %>% format(formatdates) %>% trimws(), header_txt <- header_txt %>% paste0(markdown_line, '\nLatest: ', maxdate %>% format(formatdates) %>% trimws(),
' (+', difftime(maxdate, mindate, units = 'mins') %>% as.double() %>% format(digits = digits), ' min.)') ' (+', difftime(maxdate, mindate, units = 'mins') %>% as.double() %>% format(digits = digits), ' min.)')
} else { } else {
# other date formats # other date formats
header <- header %>% paste0(markdown_line, '\nOldest: ', mindate %>% format(formatdates) %>% trimws()) header_txt <- header_txt %>% paste0(markdown_line, '\nOldest: ', mindate %>% format(formatdates) %>% trimws())
header <- header %>% paste0(markdown_line, '\nNewest: ', maxdate %>% format(formatdates) %>% trimws(), header_txt <- header_txt %>% paste0(markdown_line, '\nNewest: ', maxdate %>% format(formatdates) %>% trimws(),
' (+', difftime(maxdate, mindate, units = 'auto') %>% as.double() %>% format(digits = digits), ')') ' (+', difftime(maxdate, mindate, units = 'auto') %>% as.double() %>% format(digits = digits), ')')
} }
header <- header %>% paste0(markdown_line, '\nMedian: ', mediandate %>% format(formatdates) %>% trimws(), header_txt <- header_txt %>% paste0(markdown_line, '\nMedian: ', mediandate %>% format(formatdates) %>% trimws(),
' (~', percent(median_days / maxdate_days, round = 0), ')') ' (~', percent(median_days / maxdate_days, round = 0), ')')
} }
if (any(class(x) == 'POSIXlt')) { if (any(class(x) == 'POSIXlt')) {
@ -493,6 +495,7 @@ frequency_tbl <- function(x,
attr(df, 'opt') <- list(data = x.name, attr(df, 'opt') <- list(data = x.name,
vars = cols, vars = cols,
header = header, header = header,
header_txt = header_txt,
row_names = row.names, row_names = row.names,
column_names = column_names, column_names = column_names,
column_align = column_align, column_align = column_align,
@ -621,10 +624,11 @@ print.frequency_tbl <- function(x, nmax = getOption("max.print.freq", default =
title <- bold(title) # only bold in regular printing title <- bold(title) # only bold in regular printing
} }
if (opt$header == TRUE) {
cat(title, "\n") cat(title, "\n")
if (!is.null(opt$header_txt)) {
if (!is.null(opt$header)) { cat(opt$header_txt)
cat(opt$header) }
} }
if (NROW(x) == 0) { if (NROW(x) == 0) {

15
man/freq.Rd
View File

@ -9,11 +9,12 @@
\usage{ \usage{
frequency_tbl(x, ..., sort.count = TRUE, frequency_tbl(x, ..., sort.count = TRUE,
nmax = getOption("max.print.freq"), na.rm = TRUE, row.names = TRUE, nmax = getOption("max.print.freq"), na.rm = TRUE, row.names = TRUE,
markdown = FALSE, digits = 2, quote = FALSE, sep = " ") markdown = FALSE, digits = 2, quote = FALSE, header = !markdown,
sep = " ")
freq(x, ..., sort.count = TRUE, nmax = getOption("max.print.freq"), freq(x, ..., sort.count = TRUE, nmax = getOption("max.print.freq"),
na.rm = TRUE, row.names = TRUE, markdown = FALSE, digits = 2, na.rm = TRUE, row.names = TRUE, markdown = FALSE, digits = 2,
quote = FALSE, sep = " ") quote = FALSE, header = !markdown, sep = " ")
top_freq(f, n) top_freq(f, n)
@ -29,16 +30,18 @@ top_freq(f, n)
\item{nmax}{number of row to print. The default, \code{15}, uses \code{\link{getOption}("max.print.freq")}. Use \code{nmax = 0}, \code{nmax = Inf}, \code{nmax = NULL} or \code{nmax = NA} to print all rows.} \item{nmax}{number of row to print. The default, \code{15}, uses \code{\link{getOption}("max.print.freq")}. Use \code{nmax = 0}, \code{nmax = Inf}, \code{nmax = NULL} or \code{nmax = NA} to print all rows.}
\item{na.rm}{a logical value indicating whether \code{NA} values should be removed from the frequency table. The header will always print the amount of \code{NA}s.} \item{na.rm}{a logical value indicating whether \code{NA} values should be removed from the frequency table. The header_txt will always print the amount of \code{NA}s.}
\item{row.names}{a logical value indicating whether row indices should be printed as \code{1:nrow(x)}} \item{row.names}{a logical value indicating whether row indices should be printed as \code{1:nrow(x)}}
\item{markdown}{print table in markdown format (this forces \code{nmax = NA})} \item{markdown}{print table in markdown format (this forces \code{nmax = NA})}
\item{digits}{how many significant digits are to be used for numeric values in the header (not for the items themselves, that depends on \code{\link{getOption}("digits")})} \item{digits}{how many significant digits are to be used for numeric values in the header_txt (not for the items themselves, that depends on \code{\link{getOption}("digits")})}
\item{quote}{a logical value indicating whether or not strings should be printed with surrounding quotes} \item{quote}{a logical value indicating whether or not strings should be printed with surrounding quotes}
\item{header}{a logical value indicating whether an informative header should be printed}
\item{sep}{a character string to separate the terms when selecting multiple columns} \item{sep}{a character string to separate the terms when selecting multiple columns}
\item{f}{a frequency table} \item{f}{a frequency table}
@ -54,7 +57,7 @@ Create a frequency table of a vector with items or a data frame. Supports quasiq
\details{ \details{
Frequency tables (or frequency distributions) are summaries of the distribution of values in a sample. With the `freq` function, you can create univariate frequency tables. Multiple variables will be pasted into one variable, so it forces a univariate distribution. This package also has a vignette available to explain the use of this function further, run \code{browseVignettes("AMR")} to read it. Frequency tables (or frequency distributions) are summaries of the distribution of values in a sample. With the `freq` function, you can create univariate frequency tables. Multiple variables will be pasted into one variable, so it forces a univariate distribution. This package also has a vignette available to explain the use of this function further, run \code{browseVignettes("AMR")} to read it.
For numeric values of any class, these additional values will all be calculated with \code{na.rm = TRUE} and shown into the header: For numeric values of any class, these additional values will all be calculated with \code{na.rm = TRUE} and shown into the header_txt:
\itemize{ \itemize{
\item{Mean, using \code{\link[base]{mean}}} \item{Mean, using \code{\link[base]{mean}}}
\item{Standard Deviation, using \code{\link[stats]{sd}}} \item{Standard Deviation, using \code{\link[stats]{sd}}}
@ -66,7 +69,7 @@ For numeric values of any class, these additional values will all be calculated
\item{Outliers (total count and unique count), using \code{\link[grDevices]{boxplot.stats}}} \item{Outliers (total count and unique count), using \code{\link[grDevices]{boxplot.stats}}}
} }
For dates and times of any class, these additional values will be calculated with \code{na.rm = TRUE} and shown into the header: For dates and times of any class, these additional values will be calculated with \code{na.rm = TRUE} and shown into the header_txt:
\itemize{ \itemize{
\item{Oldest, using \code{\link{min}}} \item{Oldest, using \code{\link{min}}}
\item{Newest, using \code{\link{max}}, with difference between newest and oldest} \item{Newest, using \code{\link{max}}, with difference between newest and oldest}