mirror of
https://github.com/msberends/AMR.git
synced 2024-12-25 18:46:11 +01:00
freq - decimals
This commit is contained in:
parent
8e8a9cd190
commit
9478ab71be
@ -5,6 +5,7 @@
|
|||||||
# how the Docker+R images work: https://hub.docker.com/r/rocker/r-ver/
|
# how the Docker+R images work: https://hub.docker.com/r/rocker/r-ver/
|
||||||
R 3:
|
R 3:
|
||||||
image: rocker/r-ver:3 # test on R v3.*.*
|
image: rocker/r-ver:3 # test on R v3.*.*
|
||||||
|
allow_failure: true
|
||||||
script:
|
script:
|
||||||
- apt-get update
|
- apt-get update
|
||||||
# install dependencies for package
|
# install dependencies for package
|
||||||
@ -14,13 +15,15 @@ R 3:
|
|||||||
# remove vignettes folder and get VignetteBuilder field out of DESCRIPTION file
|
# remove vignettes folder and get VignetteBuilder field out of DESCRIPTION file
|
||||||
- rm -rf vignettes
|
- rm -rf vignettes
|
||||||
- Rscript -e 'd <- read.dcf("DESCRIPTION"); d[, colnames(d) == "VignetteBuilder"] <- NA; write.dcf(d, "DESCRIPTION")'
|
- Rscript -e 'd <- read.dcf("DESCRIPTION"); d[, colnames(d) == "VignetteBuilder"] <- NA; write.dcf(d, "DESCRIPTION")'
|
||||||
|
# set environmental variable
|
||||||
|
- Rscript -e 'Sys.setenv(NOT_CRAN = "true")'
|
||||||
# build package
|
# build package
|
||||||
- R CMD build . --no-build-vignettes --no-manual
|
- R CMD build . --no-build-vignettes --no-manual
|
||||||
- PKG_FILE_NAME=$(ls -1t *.tar.gz | head -n 1)
|
- PKG_FILE_NAME=$(ls -1t *.tar.gz | head -n 1)
|
||||||
- R CMD check "${PKG_FILE_NAME}" --no-build-vignettes --no-manual --as-cran
|
- R CMD check "${PKG_FILE_NAME}" --no-build-vignettes --no-manual --as-cran
|
||||||
# code coverage
|
# code coverage
|
||||||
- apt-get install --yes git
|
- apt-get install --yes git
|
||||||
- Rscript -e "cc <- covr::package_coverage(); covr::codecov(coverage = cc, token = '50ffa0aa-fee0-4f8b-a11d-8c7edc6d32ca'); cat('Code coverage:', covr::percent_coverage(cc))"
|
- Rscript -e 'cc <- covr::package_coverage(); covr::codecov(coverage = cc, token = "50ffa0aa-fee0-4f8b-a11d-8c7edc6d32ca"); cat("Code coverage:", covr::percent_coverage(cc))'
|
||||||
coverage: '/Code coverage: \d+\.\d+/'
|
coverage: '/Code coverage: \d+\.\d+/'
|
||||||
artifacts:
|
artifacts:
|
||||||
paths:
|
paths:
|
||||||
|
@ -1,6 +1,6 @@
|
|||||||
Package: AMR
|
Package: AMR
|
||||||
Version: 0.5.0.9002
|
Version: 0.5.0.9003
|
||||||
Date: 2018-12-07
|
Date: 2018-12-10
|
||||||
Title: Antimicrobial Resistance Analysis
|
Title: Antimicrobial Resistance Analysis
|
||||||
Authors@R: c(
|
Authors@R: c(
|
||||||
person(
|
person(
|
||||||
|
10
NEWS.md
10
NEWS.md
@ -9,13 +9,17 @@
|
|||||||
* Finds better results when input is in other languages
|
* Finds better results when input is in other languages
|
||||||
* Better handling for subspecies
|
* Better handling for subspecies
|
||||||
* Better handling for *Salmonellae*
|
* Better handling for *Salmonellae*
|
||||||
* There will be looked for uncertain results at default - these results will be returned with a informative warning
|
* There will be looked for uncertain results at default - these results will be returned with an informative warning
|
||||||
* Extended manual text about algorithms
|
* Manual now contains more info about the algorithms
|
||||||
|
* Progress bar will be shown when it takes more than 3 seconds to get results
|
||||||
* Function `first_isolate` will now use a column named like "patid" for the patient ID, when this parameter was left blank
|
* Function `first_isolate` will now use a column named like "patid" for the patient ID, when this parameter was left blank
|
||||||
* Reduce false positives for `is.rsi.eligible`
|
* Reduce false positives for `is.rsi.eligible`
|
||||||
* Summaries of class `mo` will now return the top 3 and the unique count, e.g. using `summary(mo)`
|
* Summaries of class `mo` will now return the top 3 and the unique count, e.g. using `summary(mo)`
|
||||||
* Small text updates to summaries of class `rsi` and `mic`
|
* Small text updates to summaries of class `rsi` and `mic`
|
||||||
* Function `as.mo` now prints a progress bar when it takes more than 3 seconds the get results
|
* Frequency tables (`freq` function):
|
||||||
|
* Added header info for class `mo` to show unique count of families, genera and species
|
||||||
|
* Now honours the `decimal.mark` setting, which just like `format` defaults to `getOption("OutDec")`
|
||||||
|
* The new `big.mark` parameter will at default be `","` when `decimal.mark = "."` and `"."` otherwise
|
||||||
|
|
||||||
|
|
||||||
# 0.5.0 (latest stable release)
|
# 0.5.0 (latest stable release)
|
||||||
|
77
R/freq.R
77
R/freq.R
@ -32,6 +32,7 @@
|
|||||||
#' @param title text to show above frequency table, at default to tries to coerce from the variables passed to \code{x}
|
#' @param title text to show above frequency table, at default to tries to coerce from the variables passed to \code{x}
|
||||||
#' @param na a character string to should be used to show empty (\code{NA}) values (only useful when \code{na.rm = FALSE})
|
#' @param na a character string to should be used to show empty (\code{NA}) values (only useful when \code{na.rm = FALSE})
|
||||||
#' @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
|
||||||
|
#' @inheritParams base::format
|
||||||
#' @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.
|
||||||
@ -182,7 +183,9 @@ frequency_tbl <- function(x,
|
|||||||
header = !markdown,
|
header = !markdown,
|
||||||
title = NULL,
|
title = NULL,
|
||||||
na = "<NA>",
|
na = "<NA>",
|
||||||
sep = " ") {
|
sep = " ",
|
||||||
|
decimal.mark = getOption("OutDec"),
|
||||||
|
big.mark = ifelse(decimal.mark != ",", ",", ".")) {
|
||||||
|
|
||||||
mult.columns <- 0
|
mult.columns <- 0
|
||||||
x.group = character(0)
|
x.group = character(0)
|
||||||
@ -314,8 +317,8 @@ frequency_tbl <- function(x,
|
|||||||
}
|
}
|
||||||
|
|
||||||
if (NROW(x) > 0) {
|
if (NROW(x) > 0) {
|
||||||
na_txt <- paste0(NAs %>% length() %>% format(), ' = ',
|
na_txt <- paste0(NAs %>% length() %>% format(decimal.mark = decimal.mark, big.mark = big.mark), ' = ',
|
||||||
(NAs %>% length() / (NAs %>% length() + x %>% length())) %>% percent(force_zero = TRUE, round = digits) %>%
|
(NAs %>% length() / (NAs %>% length() + x %>% length())) %>% percent(force_zero = TRUE, round = digits, decimal.mark = decimal.mark) %>%
|
||||||
sub('NaN', '0', ., fixed = TRUE))
|
sub('NaN', '0', ., fixed = TRUE))
|
||||||
if (!na_txt %like% "^0 =") {
|
if (!na_txt %like% "^0 =") {
|
||||||
na_txt <- red(na_txt)
|
na_txt <- red(na_txt)
|
||||||
@ -327,14 +330,21 @@ frequency_tbl <- function(x,
|
|||||||
na_txt <- ""
|
na_txt <- ""
|
||||||
}
|
}
|
||||||
|
|
||||||
header_txt <- header_txt %>% paste0(markdown_line, '\nLength: ', (NAs %>% length() + x %>% length()) %>% format(),
|
header_txt <- header_txt %>% paste0(markdown_line, '\nLength: ', (NAs %>% length() + x %>% length()) %>% format(decimal.mark = decimal.mark, big.mark = big.mark),
|
||||||
' ', na_txt)
|
' ', na_txt)
|
||||||
header_txt <- header_txt %>% paste0(markdown_line, '\nUnique: ', x %>% n_distinct() %>% format())
|
header_txt <- header_txt %>% paste0(markdown_line, '\nUnique: ', x %>% n_distinct() %>% format(decimal.mark = decimal.mark, big.mark = big.mark))
|
||||||
|
|
||||||
if (NROW(x) > 0 & any(class(x) == "character")) {
|
if (NROW(x) > 0 & any(class(x) == "character")) {
|
||||||
header_txt <- header_txt %>% paste0('\n')
|
header_txt <- header_txt %>% paste0('\n')
|
||||||
header_txt <- header_txt %>% 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) %>% format(decimal.mark = decimal.mark, big.mark = big.mark))
|
||||||
header_txt <- header_txt %>% 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) %>% format(decimal.mark = decimal.mark, big.mark = big.mark))
|
||||||
|
}
|
||||||
|
|
||||||
|
if (NROW(x) > 0 & any(class(x) == "mo")) {
|
||||||
|
header_txt <- header_txt %>% paste0('\n')
|
||||||
|
header_txt <- header_txt %>% paste0(markdown_line, '\nFamilies: ', x %>% mo_family() %>% n_distinct() %>% format(decimal.mark = decimal.mark, big.mark = big.mark))
|
||||||
|
header_txt <- header_txt %>% paste0(markdown_line, '\nGenera: ', x %>% mo_genus() %>% n_distinct() %>% format(decimal.mark = decimal.mark, big.mark = big.mark))
|
||||||
|
header_txt <- header_txt %>% paste0(markdown_line, '\nSpecies: ', x %>% mo_species() %>% n_distinct() %>% format(decimal.mark = decimal.mark, big.mark = big.mark))
|
||||||
}
|
}
|
||||||
|
|
||||||
if (NROW(x) > 0 & any(class(x) == "difftime") & !is.hms(x)) {
|
if (NROW(x) > 0 & any(class(x) == "difftime") & !is.hms(x)) {
|
||||||
@ -349,13 +359,13 @@ frequency_tbl <- function(x,
|
|||||||
Tukey_five <- stats::fivenum(x, na.rm = TRUE)
|
Tukey_five <- stats::fivenum(x, na.rm = TRUE)
|
||||||
x_align <- 'r'
|
x_align <- 'r'
|
||||||
header_txt <- header_txt %>% paste0('\n')
|
header_txt <- header_txt %>% paste0('\n')
|
||||||
header_txt <- header_txt %>% 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, decimal.mark = decimal.mark, big.mark = big.mark))
|
||||||
header_txt <- header_txt %>% 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, decimal.mark = decimal.mark, big.mark = big.mark),
|
||||||
' (CV: ', x %>% cv(na.rm = TRUE) %>% format(digits = digits),
|
' (CV: ', x %>% cv(na.rm = TRUE) %>% format(digits = digits, decimal.mark = decimal.mark, big.mark = big.mark),
|
||||||
', MAD: ', x %>% stats::mad(na.rm = TRUE) %>% format(digits = digits), ')')
|
', MAD: ', x %>% stats::mad(na.rm = TRUE) %>% format(digits = digits, decimal.mark = decimal.mark, big.mark = big.mark), ')')
|
||||||
header_txt <- header_txt %>% 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, decimal.mark = decimal.mark, big.mark = big.mark) %>% trimws() %>% paste(collapse = ' | '),
|
||||||
' (IQR: ', (Tukey_five[4] - Tukey_five[2]) %>% format(digits = digits),
|
' (IQR: ', (Tukey_five[4] - Tukey_five[2]) %>% format(digits = digits, decimal.mark = decimal.mark, big.mark = big.mark),
|
||||||
', CQV: ', x %>% cqv(na.rm = TRUE) %>% format(digits = digits), ')')
|
', CQV: ', x %>% cqv(na.rm = TRUE) %>% format(digits = digits, decimal.mark = decimal.mark, big.mark = big.mark), ')')
|
||||||
outlier_length <- length(boxplot.stats(x)$out)
|
outlier_length <- length(boxplot.stats(x)$out)
|
||||||
header_txt <- header_txt %>% paste0(markdown_line, '\nOutliers: ', outlier_length)
|
header_txt <- header_txt %>% paste0(markdown_line, '\nOutliers: ', outlier_length)
|
||||||
if (outlier_length > 0) {
|
if (outlier_length > 0) {
|
||||||
@ -367,8 +377,8 @@ frequency_tbl <- function(x,
|
|||||||
cnt_S <- sum(x == "S", na.rm = TRUE)
|
cnt_S <- sum(x == "S", na.rm = TRUE)
|
||||||
cnt_IR <- sum(x %in% c("I", "R"), na.rm = TRUE)
|
cnt_IR <- sum(x %in% c("I", "R"), na.rm = TRUE)
|
||||||
header_txt <- header_txt %>% paste(markdown_line, '\n%IR: ',
|
header_txt <- header_txt %>% paste(markdown_line, '\n%IR: ',
|
||||||
(cnt_IR / sum(!is.na(x), na.rm = TRUE)) %>% percent(force_zero = TRUE, round = digits),
|
(cnt_IR / sum(!is.na(x), na.rm = TRUE)) %>% percent(force_zero = TRUE, round = digits, decimal.mark = decimal.mark),
|
||||||
paste0('(ratio S : IR = 1.0 : ', (cnt_IR / cnt_S) %>% format(digits = 1, nsmall = 1), ")"))
|
paste0('(ratio S : IR = 1.0 : ', (cnt_IR / cnt_S) %>% format(digits = 1, nsmall = 1, decimal.mark = decimal.mark, big.mark = big.mark), ")"))
|
||||||
if (NROW(x) < 30) {
|
if (NROW(x) < 30) {
|
||||||
header_txt <- header_txt %>% paste(markdown_line, red('\nToo few isolates for reliable resistance interpretation.'))
|
header_txt <- header_txt %>% paste(markdown_line, red('\nToo few isolates for reliable resistance interpretation.'))
|
||||||
}
|
}
|
||||||
@ -391,15 +401,15 @@ frequency_tbl <- function(x,
|
|||||||
# hms
|
# hms
|
||||||
header_txt <- header_txt %>% paste0(markdown_line, '\nEarliest: ', mindate %>% format(formatdates) %>% trimws())
|
header_txt <- header_txt %>% paste0(markdown_line, '\nEarliest: ', mindate %>% format(formatdates) %>% trimws())
|
||||||
header_txt <- header_txt %>% 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, decimal.mark = decimal.mark, big.mark = big.mark), ' min.)')
|
||||||
} else {
|
} else {
|
||||||
# other date formats
|
# other date formats
|
||||||
header_txt <- header_txt %>% paste0(markdown_line, '\nOldest: ', mindate %>% format(formatdates) %>% trimws())
|
header_txt <- header_txt %>% paste0(markdown_line, '\nOldest: ', mindate %>% format(formatdates) %>% trimws())
|
||||||
header_txt <- header_txt %>% 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, decimal.mark = decimal.mark, big.mark = big.mark), ')')
|
||||||
}
|
}
|
||||||
header_txt <- header_txt %>% 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, decimal.mark = decimal.mark), ')')
|
||||||
}
|
}
|
||||||
if (any(class(x) == 'POSIXlt')) {
|
if (any(class(x) == 'POSIXlt')) {
|
||||||
x <- x %>% format(formatdates)
|
x <- x %>% format(formatdates)
|
||||||
@ -485,6 +495,8 @@ frequency_tbl <- function(x,
|
|||||||
row_names = row.names,
|
row_names = row.names,
|
||||||
column_names = column_names,
|
column_names = column_names,
|
||||||
column_align = column_align,
|
column_align = column_align,
|
||||||
|
decimal.mark = decimal.mark,
|
||||||
|
big.mark = big.mark,
|
||||||
tbl_format = tbl_format,
|
tbl_format = tbl_format,
|
||||||
na = na,
|
na = na,
|
||||||
nmax = nmax,
|
nmax = nmax,
|
||||||
@ -573,7 +585,10 @@ diff.frequency_tbl <- function(x, y, ...) {
|
|||||||
#' @importFrom crayon bold silver
|
#' @importFrom crayon bold silver
|
||||||
#' @export
|
#' @export
|
||||||
print.frequency_tbl <- function(x, nmax = getOption("max.print.freq", default = 15),
|
print.frequency_tbl <- function(x, nmax = getOption("max.print.freq", default = 15),
|
||||||
markdown = !interactive(), header = !markdown, ...) {
|
markdown = !interactive(), header = !markdown,
|
||||||
|
decimal.mark = getOption("OutDec"),
|
||||||
|
big.mark = ifelse(decimal.mark != ",", ",", "."),
|
||||||
|
...) {
|
||||||
|
|
||||||
opt <- attr(x, 'opt')
|
opt <- attr(x, 'opt')
|
||||||
|
|
||||||
@ -612,6 +627,12 @@ print.frequency_tbl <- function(x, nmax = getOption("max.print.freq", default =
|
|||||||
opt$nmax <- nmax
|
opt$nmax <- nmax
|
||||||
opt$nmax.set <- TRUE
|
opt$nmax.set <- TRUE
|
||||||
}
|
}
|
||||||
|
if (!missing(decimal.mark)) {
|
||||||
|
opt$decimal.mark <- decimal.mark
|
||||||
|
}
|
||||||
|
if (!missing(big.mark)) {
|
||||||
|
opt$big.mark <- big.mark
|
||||||
|
}
|
||||||
dots <- list(...)
|
dots <- list(...)
|
||||||
if ("markdown" %in% names(dots)) {
|
if ("markdown" %in% names(dots)) {
|
||||||
if (dots$markdown == TRUE) {
|
if (dots$markdown == TRUE) {
|
||||||
@ -677,11 +698,11 @@ print.frequency_tbl <- function(x, nmax = getOption("max.print.freq", default =
|
|||||||
}
|
}
|
||||||
footer <- paste(footer,
|
footer <- paste(footer,
|
||||||
' -- omitted ',
|
' -- omitted ',
|
||||||
format(x.rows - opt$nmax),
|
format(x.rows - opt$nmax, big.mark = opt$big.mark),
|
||||||
' entries, n = ',
|
' entries, n = ',
|
||||||
format(x.unprinted),
|
format(x.unprinted, big.mark = opt$big.mark),
|
||||||
' (',
|
' (',
|
||||||
(x.unprinted / (x.unprinted + x.printed)) %>% percent(force_zero = TRUE),
|
(x.unprinted / (x.unprinted + x.printed)) %>% percent(force_zero = TRUE, decimal.mark = opt$decimal.mark),
|
||||||
') ]\n', sep = '')
|
') ]\n', sep = '')
|
||||||
if (opt$tbl_format == "pandoc") {
|
if (opt$tbl_format == "pandoc") {
|
||||||
footer <- silver(footer) # only silver in regular printing
|
footer <- silver(footer) # only silver in regular printing
|
||||||
@ -692,7 +713,7 @@ print.frequency_tbl <- function(x, nmax = getOption("max.print.freq", default =
|
|||||||
|
|
||||||
if ("item" %in% colnames(x)) {
|
if ("item" %in% colnames(x)) {
|
||||||
if (any(class(x$item) %in% c('double', 'integer', 'numeric', 'raw', 'single'))) {
|
if (any(class(x$item) %in% c('double', 'integer', 'numeric', 'raw', 'single'))) {
|
||||||
x$item <- format(x$item)
|
x$item <- format(x$item, decimal.mark = opt$decimal.mark, big.mark = opt$big.mark)
|
||||||
}
|
}
|
||||||
} else {
|
} else {
|
||||||
opt$column_names <- opt$column_names[!opt$column_names == "Item"]
|
opt$column_names <- opt$column_names[!opt$column_names == "Item"]
|
||||||
@ -701,22 +722,22 @@ print.frequency_tbl <- function(x, nmax = getOption("max.print.freq", default =
|
|||||||
if (all(x$count == 1)) {
|
if (all(x$count == 1)) {
|
||||||
warning('All observations are unique.', call. = FALSE)
|
warning('All observations are unique.', call. = FALSE)
|
||||||
}
|
}
|
||||||
x$count <- format(x$count)
|
x$count <- format(x$count, decimal.mark = opt$decimal.mark, big.mark = opt$big.mark)
|
||||||
} else {
|
} else {
|
||||||
opt$column_names <- opt$column_names[!opt$column_names == "Count"]
|
opt$column_names <- opt$column_names[!opt$column_names == "Count"]
|
||||||
}
|
}
|
||||||
if ("percent" %in% colnames(x)) {
|
if ("percent" %in% colnames(x)) {
|
||||||
x$percent <- percent(x$percent, force_zero = TRUE)
|
x$percent <- percent(x$percent, force_zero = TRUE, decimal.mark = opt$decimal.mark)
|
||||||
} else {
|
} else {
|
||||||
opt$column_names <- opt$column_names[!opt$column_names == "Percent"]
|
opt$column_names <- opt$column_names[!opt$column_names == "Percent"]
|
||||||
}
|
}
|
||||||
if ("cum_count" %in% colnames(x)) {
|
if ("cum_count" %in% colnames(x)) {
|
||||||
x$cum_count <- format(x$cum_count)
|
x$cum_count <- format(x$cum_count, decimal.mark = opt$decimal.mark, big.mark = opt$big.mark)
|
||||||
} else {
|
} else {
|
||||||
opt$column_names <- opt$column_names[!opt$column_names == "Cum. Count"]
|
opt$column_names <- opt$column_names[!opt$column_names == "Cum. Count"]
|
||||||
}
|
}
|
||||||
if ("cum_percent" %in% colnames(x)) {
|
if ("cum_percent" %in% colnames(x)) {
|
||||||
x$cum_percent <- percent(x$cum_percent, force_zero = TRUE)
|
x$cum_percent <- percent(x$cum_percent, force_zero = TRUE, decimal.mark = opt$decimal.mark)
|
||||||
} else {
|
} else {
|
||||||
opt$column_names <- opt$column_names[!opt$column_names == "Cum. Percent"]
|
opt$column_names <- opt$column_names[!opt$column_names == "Cum. Percent"]
|
||||||
}
|
}
|
||||||
|
9
R/misc.R
9
R/misc.R
@ -27,7 +27,10 @@ addin_insert_like <- function() {
|
|||||||
}
|
}
|
||||||
|
|
||||||
# No export, no Rd
|
# No export, no Rd
|
||||||
percent <- function(x, round = 1, force_zero = FALSE, ...) {
|
percent <- function(x, round = 1, force_zero = FALSE, decimal.mark = getOption("OutDec"), ...) {
|
||||||
|
|
||||||
|
decimal.mark.options <- getOption("OutDec")
|
||||||
|
options(OutDec = ".")
|
||||||
|
|
||||||
# https://stackoverflow.com/a/12688836/4575331
|
# https://stackoverflow.com/a/12688836/4575331
|
||||||
round2 <- function(x, n) (trunc((abs(x) * 10 ^ n) + 0.5) / 10 ^ n) * sign(x)
|
round2 <- function(x, n) (trunc((abs(x) * 10 ^ n) + 0.5) / 10 ^ n) * sign(x)
|
||||||
@ -46,6 +49,10 @@ percent <- function(x, round = 1, force_zero = FALSE, ...) {
|
|||||||
}
|
}
|
||||||
pct <- base::paste0(val, "%")
|
pct <- base::paste0(val, "%")
|
||||||
pct[pct %in% c("NA%", "NaN%")] <- NA_character_
|
pct[pct %in% c("NA%", "NaN%")] <- NA_character_
|
||||||
|
if (decimal.mark != ".") {
|
||||||
|
pct <- gsub(".", decimal.mark, pct, fixed = TRUE)
|
||||||
|
}
|
||||||
|
options(OutDec = decimal.mark.options)
|
||||||
pct
|
pct
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -16,10 +16,11 @@ cache:
|
|||||||
# Adapt as necessary starting from here
|
# Adapt as necessary starting from here
|
||||||
|
|
||||||
environment:
|
environment:
|
||||||
global:
|
R_ARCH: x64
|
||||||
R_ARCH: x64
|
GCC_PATH: mingw_64
|
||||||
GCC_PATH: mingw_64
|
WARNINGS_ARE_ERRORS: 1
|
||||||
WARNINGS_ARE_ERRORS: 1
|
PKGTYPE: win.binary
|
||||||
|
# USE_RTOOLS: true
|
||||||
|
|
||||||
matrix:
|
matrix:
|
||||||
- R_VERSION: release
|
- R_VERSION: release
|
||||||
|
19
man/freq.Rd
19
man/freq.Rd
@ -10,17 +10,22 @@
|
|||||||
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 = !interactive(), digits = 2, quote = FALSE,
|
markdown = !interactive(), digits = 2, quote = FALSE,
|
||||||
header = !markdown, title = NULL, na = "<NA>", sep = " ")
|
header = !markdown, title = NULL, na = "<NA>", sep = " ",
|
||||||
|
decimal.mark = getOption("OutDec"), big.mark = ifelse(decimal.mark !=
|
||||||
|
",", ",", "."))
|
||||||
|
|
||||||
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 = !interactive(),
|
na.rm = TRUE, row.names = TRUE, markdown = !interactive(),
|
||||||
digits = 2, quote = FALSE, header = !markdown, title = NULL,
|
digits = 2, quote = FALSE, header = !markdown, title = NULL,
|
||||||
na = "<NA>", sep = " ")
|
na = "<NA>", sep = " ", decimal.mark = getOption("OutDec"),
|
||||||
|
big.mark = ifelse(decimal.mark != ",", ",", "."))
|
||||||
|
|
||||||
top_freq(f, n)
|
top_freq(f, n)
|
||||||
|
|
||||||
\method{print}{frequency_tbl}(x, nmax = getOption("max.print.freq",
|
\method{print}{frequency_tbl}(x, nmax = getOption("max.print.freq",
|
||||||
default = 15), markdown = !interactive(), header = !markdown, ...)
|
default = 15), markdown = !interactive(), header = !markdown,
|
||||||
|
decimal.mark = getOption("OutDec"), big.mark = ifelse(decimal.mark !=
|
||||||
|
",", ",", "."), ...)
|
||||||
}
|
}
|
||||||
\arguments{
|
\arguments{
|
||||||
\item{x}{vector of any class or a \code{\link{data.frame}}, \code{\link{tibble}} (may contain a grouping variable) or \code{\link{table}}}
|
\item{x}{vector of any class or a \code{\link{data.frame}}, \code{\link{tibble}} (may contain a grouping variable) or \code{\link{table}}}
|
||||||
@ -49,6 +54,14 @@ top_freq(f, n)
|
|||||||
|
|
||||||
\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{decimal.mark}{%
|
||||||
|
used for prettying (longish) numerical and complex sequences.
|
||||||
|
Passed to \code{\link{prettyNum}}: that help page explains the details.}
|
||||||
|
|
||||||
|
\item{big.mark}{%
|
||||||
|
used for prettying (longish) numerical and complex sequences.
|
||||||
|
Passed to \code{\link{prettyNum}}: that help page explains the details.}
|
||||||
|
|
||||||
\item{f}{a frequency table}
|
\item{f}{a frequency table}
|
||||||
|
|
||||||
\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.}
|
\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.}
|
||||||
|
@ -26,8 +26,9 @@ test_that("frequency table works", {
|
|||||||
expect_output(print(freq(septic_patients$age, markdown = TRUE, title = "TITLE")))
|
expect_output(print(freq(septic_patients$age, markdown = TRUE, title = "TITLE")))
|
||||||
|
|
||||||
# character
|
# character
|
||||||
expect_output(print(freq(septic_patients$mo)))
|
|
||||||
expect_output(suppressWarnings(print(freq(microorganisms$fullname))))
|
expect_output(suppressWarnings(print(freq(microorganisms$fullname))))
|
||||||
|
# mo
|
||||||
|
expect_output(print(freq(septic_patients$mo)))
|
||||||
# integer
|
# integer
|
||||||
expect_output(print(freq(septic_patients$age)))
|
expect_output(print(freq(septic_patients$age)))
|
||||||
# date
|
# date
|
||||||
|
Loading…
Reference in New Issue
Block a user