1
0
mirror of https://github.com/msberends/AMR.git synced 2024-12-24 18:46:14 +01:00
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

View File

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

View File

@ -8,6 +8,7 @@ S3method(barplot,rsi)
S3method(plot,mic) S3method(plot,mic)
S3method(plot,rsi) S3method(plot,rsi)
S3method(print,data.table) S3method(print,data.table)
S3method(print,frequency_tbl)
S3method(print,mic) S3method(print,mic)
S3method(print,rsi) S3method(print,rsi)
S3method(print,tbl) S3method(print,tbl)
@ -46,6 +47,7 @@ export(rsi)
export(rsi_df) export(rsi_df)
export(rsi_predict) export(rsi_predict)
export(semi_join_microorganisms) export(semi_join_microorganisms)
export(top_freq)
exportMethods(as.double.mic) exportMethods(as.double.mic)
exportMethods(as.integer.mic) exportMethods(as.integer.mic)
exportMethods(as.numeric.mic) exportMethods(as.numeric.mic)
@ -54,6 +56,7 @@ exportMethods(barplot.rsi)
exportMethods(plot.mic) exportMethods(plot.mic)
exportMethods(plot.rsi) exportMethods(plot.rsi)
exportMethods(print.data.table) exportMethods(print.data.table)
exportMethods(print.frequency_tbl)
exportMethods(print.mic) exportMethods(print.mic)
exportMethods(print.rsi) exportMethods(print.rsi)
exportMethods(print.tbl) exportMethods(print.tbl)
@ -88,6 +91,7 @@ importFrom(dplyr,select)
importFrom(dplyr,slice) importFrom(dplyr,slice)
importFrom(dplyr,summarise) importFrom(dplyr,summarise)
importFrom(dplyr,tibble) importFrom(dplyr,tibble)
importFrom(dplyr,top_n)
importFrom(dplyr,vars) importFrom(dplyr,vars)
importFrom(grDevices,boxplot.stats) importFrom(grDevices,boxplot.stats)
importFrom(graphics,axis) importFrom(graphics,axis)
@ -102,6 +106,7 @@ importFrom(rvest,html_table)
importFrom(stats,fivenum) importFrom(stats,fivenum)
importFrom(stats,quantile) importFrom(stats,quantile)
importFrom(stats,sd) importFrom(stats,sd)
importFrom(utils,browseVignettes)
importFrom(utils,object.size) importFrom(utils,object.size)
importFrom(utils,packageDescription) importFrom(utils,packageDescription)
importFrom(xml2,read_html) importFrom(xml2,read_html)

View File

@ -1,8 +1,12 @@
# 0.2.0.90xx (development version) # 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` * 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 * Small translational improvements to the `septic_patients` dataset
* Combined MIC/RSI values will now be coerced by the `rsi` and `mic` functions: * Combined MIC/RSI values will now be coerced by the `rsi` and `mic` functions:
* `as.rsi("<=0.002; S")` will return `S` * `as.rsi("<=0.002; S")` will return `S`

View File

@ -18,7 +18,7 @@
#' Frequency table #' 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 x data
#' @param sort.count sort on count. Use \code{FALSE} to sort alphabetically on item. #' @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. #' @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 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 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 #' @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{ #' \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}}}
@ -37,11 +41,25 @@
#' \item{Coefficient of variation (CV), the standard deviation divided by the mean} #' \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} #' \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 stats fivenum sd quantile
#' @importFrom grDevices boxplot.stats #' @importFrom grDevices boxplot.stats
#' @importFrom dplyr %>% select pull n_distinct group_by arrange desc mutate summarise #' @importFrom dplyr %>% select pull n_distinct group_by arrange desc mutate summarise
#' @importFrom utils browseVignettes
#' @keywords summary summarise frequency freq #' @keywords summary summarise frequency freq
#' @rdname 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 #' @export
#' @examples #' @examples
#' library(dplyr) #' library(dplyr)
@ -65,6 +83,13 @@
#' mutate(year = format(date, "%Y")) %>% #' mutate(year = format(date, "%Y")) %>%
#' select(year) %>% #' select(year) %>%
#' freq(as.data.frame = TRUE) #' 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, freq <- function(x,
sort.count = TRUE, sort.count = TRUE,
nmax = getOption("max.print.freq"), nmax = getOption("max.print.freq"),
@ -200,7 +225,6 @@ freq <- function(x,
' = ', (NAs %>% length() / (NAs %>% length() + x %>% length())) %>% percent(force_zero = TRUE), ')') ' = ', (NAs %>% length() / (NAs %>% length() + x %>% length())) %>% percent(force_zero = TRUE), ')')
header <- header %>% paste0(markdown_line, '\nUnique: ', x %>% n_distinct() %>% format()) 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'))) { if (any(class(x) %in% c('double', 'integer', 'numeric', 'raw', 'single'))) {
# right align number # right align number
x_align <- 'r' x_align <- 'r'
@ -226,11 +250,15 @@ freq <- function(x,
header <- header %>% paste0('\n') header <- header %>% 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()
mediandate <- x %>% median(na.rm = TRUE) 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, '\nOldest: ', mindate %>% format(formatdates) %>% trimws())
header <- header %>% paste0(markdown_line, '\nNewest: ', maxdate %>% format(formatdates) %>% trimws(), header <- header %>% paste0(markdown_line, '\nNewest: ', maxdate %>% format(formatdates) %>% trimws(),
' (+', difftime(maxdate, mindate, units = 'auto') %>% as.double() %>% format(), ')') ' (+', 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')) { if (any(class(x) == 'POSIXlt')) {
x <- x %>% format(formatdates) x <- x %>% format(formatdates)
@ -314,7 +342,9 @@ freq <- function(x,
df[, 4] <- cumsum(df[, 2]) df[, 4] <- cumsum(df[, 2])
df[, 5] <- df[, 4] / sum(df[, 2], na.rm = TRUE) df[, 5] <- df[, 4] / sum(df[, 2], na.rm = TRUE)
colnames(df) <- column_names_df 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) { if (markdown == TRUE) {
@ -376,3 +406,24 @@ freq <- function(x,
#' @rdname freq #' @rdname freq
#' @export #' @export
frequency_tbl <- freq 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
}

View File

@ -21,6 +21,7 @@ globalVariables(c('abname',
'bactid', 'bactid',
'cnt', 'cnt',
'Count', 'Count',
'count',
'Cum', 'Cum',
'CumTot', 'CumTot',
'date_lab', 'date_lab',
@ -31,9 +32,11 @@ globalVariables(c('abname',
'genus', 'genus',
'gramstain', 'gramstain',
'Item', 'Item',
'item',
'key_ab', 'key_ab',
'key_ab_lag', 'key_ab_lag',
'key_ab_other', 'key_ab_other',
'median',
'mic', 'mic',
'mocode', 'mocode',
'molis', 'molis',

View File

@ -74,6 +74,13 @@ print.tbl <- function(x, ...) {
prettyprint_df(x, ...) prettyprint_df(x, ...)
} }
#' @rdname print
#' @exportMethod print.frequency_tbl
#' @export
print.frequency_tbl <- function(x, ...) {
prettyprint_df(x, ...)
}
#' @rdname print #' @rdname print
#' @exportMethod print.data.table #' @exportMethod print.data.table
#' @export #' @export
@ -124,6 +131,8 @@ prettyprint_df <- function(x,
if ('tbl_df' %in% class(x)) { if ('tbl_df' %in% class(x)) {
type <- 'tibble' type <- 'tibble'
} else if ('frequency_tbl' %in% class(x)) {
type <- 'frequency table'
} else if ('data.table' %in% class(x)) { } else if ('data.table' %in% class(x)) {
type <- 'data.table' type <- 'data.table'
} else { } else {
@ -226,7 +235,7 @@ prettyprint_df <- function(x,
paste0(collapse = '/')) paste0(collapse = '/'))
} else { } else {
if (NCOL(.) > 1) { if (NCOL(.) > 1) {
.[1,] .[1, ]
} else { } else {
c[[1]] c[[1]]
} }

View File

@ -3,6 +3,7 @@
\name{freq} \name{freq}
\alias{freq} \alias{freq}
\alias{frequency_tbl} \alias{frequency_tbl}
\alias{top_freq}
\title{Frequency table} \title{Frequency table}
\usage{ \usage{
freq(x, sort.count = TRUE, nmax = getOption("max.print.freq"), 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"), frequency_tbl(x, sort.count = TRUE, nmax = getOption("max.print.freq"),
na.rm = TRUE, row.names = TRUE, markdown = FALSE, na.rm = TRUE, row.names = TRUE, markdown = FALSE,
as.data.frame = FALSE, digits = 2, sep = " ") as.data.frame = FALSE, digits = 2, sep = " ")
top_freq(f, n)
} }
\arguments{ \arguments{
\item{x}{data} \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{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{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{ \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{ \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{ \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,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 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} \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{ \examples{
library(dplyr) library(dplyr)
@ -68,6 +92,13 @@ years <- septic_patients \%>\%
mutate(year = format(date, "\%Y")) \%>\% mutate(year = format(date, "\%Y")) \%>\%
select(year) \%>\% select(year) \%>\%
freq(as.data.frame = TRUE) 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{freq}
\keyword{frequency} \keyword{frequency}

View File

@ -4,6 +4,7 @@
\alias{print} \alias{print}
\alias{print.tbl_df} \alias{print.tbl_df}
\alias{print.tbl} \alias{print.tbl}
\alias{print.frequency_tbl}
\alias{print.data.table} \alias{print.data.table}
\title{Printing Data Tables and Tibbles} \title{Printing Data Tables and Tibbles}
\usage{ \usage{
@ -12,6 +13,8 @@
\method{print}{tbl}(x, ...) \method{print}{tbl}(x, ...)
\method{print}{frequency_tbl}(x, ...)
\method{print}{data.table}(x, print.keys = FALSE, ...) \method{print}{data.table}(x, print.keys = FALSE, ...)
} }
\arguments{ \arguments{

View File

@ -9,8 +9,11 @@ test_that("frequency table works", {
expect_equal(nrow(freq(septic_patients$date, as.data.frame = TRUE)), expect_equal(nrow(freq(septic_patients$date, as.data.frame = TRUE)),
length(unique(septic_patients$date))) length(unique(septic_patients$date)))
# int
expect_output(freq(septic_patients$age)) expect_output(freq(septic_patients$age))
# date
expect_output(freq(septic_patients$date)) expect_output(freq(septic_patients$date))
# factor
expect_output(freq(septic_patients$hospital_id)) expect_output(freq(septic_patients$hospital_id))
library(dplyr) 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:7) %>% freq())
expect_output(septic_patients %>% select(1:8) %>% freq()) expect_output(septic_patients %>% select(1:8) %>% freq())
expect_output(septic_patients %>% select(1:9) %>% 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))
}) })

View File

@ -23,5 +23,9 @@ test_that("joins work", {
expect_true(nrow(unjoined) < nrow(right)) expect_true(nrow(unjoined) < nrow(right))
expect_true(nrow(unjoined) < nrow(full)) 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(left_join_microorganisms("ESCCOL")), 1)
expect_equal(nrow(semi_join_microorganisms("ESCCOL")), 1)
expect_equal(nrow(anti_join_microorganisms("ESCCOL")), 0)
}) })