mirror of
https://github.com/msberends/AMR.git
synced 2025-07-08 18:01:50 +02:00
added boxplot for (grouped) freq()
This commit is contained in:
@ -45,16 +45,18 @@ EUCAST_VERSION_EXPERT_RULES <- "3.1, 2016"
|
||||
#' @section Antibiotics:
|
||||
#' To define antibiotics column names, leave as it is to determine it automatically with \code{\link{guess_ab_col}} or input a text (case-insensitive), or use \code{NULL} to skip a column (e.g. \code{TIC = NULL} to skip ticarcillin). Manually defined but non-existing columns will be skipped with a warning.
|
||||
#'
|
||||
#' Available abbrevations of the column containing antibiotics in the form '\strong{antimicrobial ID}: name (\emph{ATC code})':
|
||||
#' The following antibiotics are used for the functions \code{\link{eucast_rules}} and \code{\link{mdro}}. These are shown in the format '\strong{antimicrobial ID}: name (\emph{ATC code})', sorted by name:
|
||||
#'
|
||||
#' \strong{AMC}: amoxicillin/clavulanic acid (\href{https://www.whocc.no/atc_ddd_index/?code=J01CR02}{J01CR02}),
|
||||
#' \strong{AMK}: amikacin (\href{https://www.whocc.no/atc_ddd_index/?code=J01GB06}{J01GB06}),
|
||||
#' \strong{AMX}: amoxicillin (\href{https://www.whocc.no/atc_ddd_index/?code=J01CA04}{J01CA04}),
|
||||
#' \strong{AMC}: amoxicillin/clavulanic acid (\href{https://www.whocc.no/atc_ddd_index/?code=J01CR02}{J01CR02}),
|
||||
#' \strong{AMP}: ampicillin (\href{https://www.whocc.no/atc_ddd_index/?code=J01CA01}{J01CA01}),
|
||||
#' \strong{AZM}: azithromycin (\href{https://www.whocc.no/atc_ddd_index/?code=J01FA10}{J01FA10}),
|
||||
#' \strong{AZL}: azlocillin (\href{https://www.whocc.no/atc_ddd_index/?code=J01CA09}{J01CA09}),
|
||||
#' \strong{ATM}: aztreonam (\href{https://www.whocc.no/atc_ddd_index/?code=J01DF01}{J01DF01}),
|
||||
#' \strong{CAP}: capreomycin (\href{https://www.whocc.no/atc_ddd_index/?code=J04AB30}{J04AB30}),
|
||||
#' \strong{RID}: cefaloridine (\href{https://www.whocc.no/atc_ddd_index/?code=J01DB02}{J01DB02}),
|
||||
#' \strong{CZO}: cefazolin (\href{https://www.whocc.no/atc_ddd_index/?code=J01DB04}{J01DB04}),
|
||||
#' \strong{FEP}: cefepime (\href{https://www.whocc.no/atc_ddd_index/?code=J01DE01}{J01DE01}),
|
||||
#' \strong{CTX}: cefotaxime (\href{https://www.whocc.no/atc_ddd_index/?code=J01DD01}{J01DD01}),
|
||||
#' \strong{FOX}: cefoxitin (\href{https://www.whocc.no/atc_ddd_index/?code=J01DC01}{J01DC01}),
|
||||
@ -66,26 +68,28 @@ EUCAST_VERSION_EXPERT_RULES <- "3.1, 2016"
|
||||
#' \strong{CIP}: ciprofloxacin (\href{https://www.whocc.no/atc_ddd_index/?code=J01MA02}{J01MA02}),
|
||||
#' \strong{CLR}: clarithromycin (\href{https://www.whocc.no/atc_ddd_index/?code=J01FA09}{J01FA09}),
|
||||
#' \strong{CLI}: clindamycin (\href{https://www.whocc.no/atc_ddd_index/?code=J01FF01}{J01FF01}),
|
||||
#' \strong{FLC}: flucloxacillin (\href{https://www.whocc.no/atc_ddd_index/?code=J01CF05}{J01CF05}),
|
||||
#' \strong{COL}: colistin (\href{https://www.whocc.no/atc_ddd_index/?code=J01XB01}{J01XB01}),
|
||||
#' \strong{CZO}: cefazolin (\href{https://www.whocc.no/atc_ddd_index/?code=J01DB04}{J01DB04}),
|
||||
#' \strong{DAP}: daptomycin (\href{https://www.whocc.no/atc_ddd_index/?code=J01XX09}{J01XX09}),
|
||||
#' \strong{DOX}: doxycycline (\href{https://www.whocc.no/atc_ddd_index/?code=J01AA02}{J01AA02}),
|
||||
#' \strong{ETP}: ertapenem (\href{https://www.whocc.no/atc_ddd_index/?code=J01DH03}{J01DH03}),
|
||||
#' \strong{ERY}: erythromycin (\href{https://www.whocc.no/atc_ddd_index/?code=J01FA01}{J01FA01}),
|
||||
#' \strong{ETH}: ethambutol (\href{https://www.whocc.no/atc_ddd_index/?code=J04AK02}{J04AK02}),
|
||||
#' \strong{FLC}: flucloxacillin (\href{https://www.whocc.no/atc_ddd_index/?code=J01CF05}{J01CF05}),
|
||||
#' \strong{FOS}: fosfomycin (\href{https://www.whocc.no/atc_ddd_index/?code=J01XX01}{J01XX01}),
|
||||
#' \strong{FUS}: fusidic acid (\href{https://www.whocc.no/atc_ddd_index/?code=J01XC01}{J01XC01}),
|
||||
#' \strong{GAT}: gatifloxacin (\href{https://www.whocc.no/atc_ddd_index/?code=J01MA16}{J01MA16}),
|
||||
#' \strong{GEN}: gentamicin (\href{https://www.whocc.no/atc_ddd_index/?code=J01GB03}{J01GB03}),
|
||||
#' \strong{IPM}: imipenem (\href{https://www.whocc.no/atc_ddd_index/?code=J01DH51}{J01DH51}),
|
||||
#' \strong{INH}: isoniazid (\href{https://www.whocc.no/atc_ddd_index/?code=J04AC01}{J04AC01}),
|
||||
#' \strong{KAN}: kanamycin (\href{https://www.whocc.no/atc_ddd_index/?code=J01GB04}{J01GB04}),
|
||||
#' \strong{LVX}: levofloxacin (\href{https://www.whocc.no/atc_ddd_index/?code=J01MA12}{J01MA12}),
|
||||
#' \strong{LIN}: lincomycin (\href{https://www.whocc.no/atc_ddd_index/?code=J01FF02}{J01FF02}),
|
||||
#' \strong{LNZ}: linezolid (\href{https://www.whocc.no/atc_ddd_index/?code=J01XX08}{J01XX08}),
|
||||
#' \strong{MEM}: meropenem (\href{https://www.whocc.no/atc_ddd_index/?code=J01DH02}{J01DH02}),
|
||||
#' \strong{MTR}: metronidazole (\href{https://www.whocc.no/atc_ddd_index/?code=J01XD01}{J01XD01}),
|
||||
#' \strong{MEZ}: mezlocillin (\href{https://www.whocc.no/atc_ddd_index/?code=J01CA10}{J01CA10}),
|
||||
#' \strong{MNO}: minocycline (\href{https://www.whocc.no/atc_ddd_index/?code=J01AA08}{J01AA08}),
|
||||
#' \strong{MFX}: moxifloxacin (\href{https://www.whocc.no/atc_ddd_index/?code=J01MA14}{J01MA14}),
|
||||
#' \strong{MTR}: metronidazole (\href{https://www.whocc.no/atc_ddd_index/?code=J01MA14}{J01XD01}),
|
||||
#' \strong{NAL}: nalidixic acid (\href{https://www.whocc.no/atc_ddd_index/?code=J01MB02}{J01MB02}),
|
||||
#' \strong{NEO}: neomycin (\href{https://www.whocc.no/atc_ddd_index/?code=J01GB05}{J01GB05}),
|
||||
#' \strong{NET}: netilmicin (\href{https://www.whocc.no/atc_ddd_index/?code=J01GB07}{J01GB07}),
|
||||
@ -93,14 +97,18 @@ EUCAST_VERSION_EXPERT_RULES <- "3.1, 2016"
|
||||
#' \strong{NOR}: norfloxacin (\href{https://www.whocc.no/atc_ddd_index/?code=J01MA06}{J01MA06}),
|
||||
#' \strong{NOV}: novobiocin (an ATCvet code: \href{https://www.whocc.no/atc_ddd_index/?code=QJ01XX95}{QJ01XX95}),
|
||||
#' \strong{OFX}: ofloxacin (\href{https://www.whocc.no/atc_ddd_index/?code=J01MA01}{J01MA01}),
|
||||
#' \strong{OXA}: oxacillin (\href{https://www.whocc.no/atc_ddd_index/?code=J01MA01}{J01CF04}),
|
||||
#' \strong{OXA}: oxacillin (\href{https://www.whocc.no/atc_ddd_index/?code=J01CF04}{J01CF04}),
|
||||
#' \strong{PEN}: penicillin G (\href{https://www.whocc.no/atc_ddd_index/?code=J01CE01}{J01CE01}),
|
||||
#' \strong{PIP}: piperacillin (\href{https://www.whocc.no/atc_ddd_index/?code=J01CA12}{J01CA12}),
|
||||
#' \strong{TZP}: piperacillin/tazobactam (\href{https://www.whocc.no/atc_ddd_index/?code=J01CR05}{J01CR05}),
|
||||
#' \strong{PLB}: polymyxin B (\href{https://www.whocc.no/atc_ddd_index/?code=J01XB02}{J01XB02}),
|
||||
#' \strong{PRI}: pristinamycin (\href{https://www.whocc.no/atc_ddd_index/?code=J01FG01}{J01FG01}),
|
||||
#' \strong{PZA}: pyrazinamide (\href{https://www.whocc.no/atc_ddd_index/?code=J04AK01}{J04AK01}),
|
||||
#' \strong{QDA}: quinupristin/dalfopristin (\href{https://www.whocc.no/atc_ddd_index/?code=J01FG02}{J01FG02}),
|
||||
#' \strong{RIB}: rifabutin (\href{https://www.whocc.no/atc_ddd_index/?code=J04AB04}{J04AB04}),
|
||||
#' \strong{RIF}: rifampicin (\href{https://www.whocc.no/atc_ddd_index/?code=J04AB02}{J04AB02}),
|
||||
#' \strong{RIF}: rifampin (\href{https://www.whocc.no/atc_ddd_index/?code=J04AB02}{J04AB02}),
|
||||
#' \strong{RFP}: rifapentine (\href{https://www.whocc.no/atc_ddd_index/?code=J04AB05}{J04AB05}),
|
||||
#' \strong{RXT}: roxithromycin (\href{https://www.whocc.no/atc_ddd_index/?code=J01FA06}{J01FA06}),
|
||||
#' \strong{SIS}: sisomicin (\href{https://www.whocc.no/atc_ddd_index/?code=J01GB08}{J01GB08}),
|
||||
#' \strong{TEC}: teicoplanin (\href{https://www.whocc.no/atc_ddd_index/?code=J01XA02}{J01XA02}),
|
||||
|
||||
212
R/freq.R
212
R/freq.R
@ -75,7 +75,7 @@
|
||||
#' @keywords summary summarise frequency freq
|
||||
#' @rdname freq
|
||||
#' @name freq
|
||||
#' @return A \code{data.frame} (with an additional class \code{"frequency_tbl"}) with five columns: \code{item}, \code{count}, \code{percent}, \code{cum_count} and \code{cum_percent}.
|
||||
#' @return A \code{data.frame} (with an additional class \code{"freq"}) with five columns: \code{item}, \code{count}, \code{percent}, \code{cum_count} and \code{cum_percent}.
|
||||
#' @export
|
||||
#' @inheritSection AMR Read more on our website!
|
||||
#' @examples
|
||||
@ -139,6 +139,16 @@
|
||||
#' freq(age) %>%
|
||||
#' hist()
|
||||
#'
|
||||
#' # or a boxplot of numeric values
|
||||
#' septic_patients %>%
|
||||
#' freq(age) %>%
|
||||
#' boxplot()
|
||||
#'
|
||||
#' # or even a boxplot per group
|
||||
#' septic_patients %>%
|
||||
#' group_by(hospital_id) %>%
|
||||
#' freq(age) %>%
|
||||
#' boxplot()
|
||||
#'
|
||||
#' # or print all points to a regular plot
|
||||
#' septic_patients %>%
|
||||
@ -183,22 +193,22 @@
|
||||
#' # check differences between frequency tables
|
||||
#' diff(freq(septic_patients$TMP),
|
||||
#' freq(septic_patients$SXT))
|
||||
frequency_tbl <- function(x,
|
||||
...,
|
||||
sort.count = TRUE,
|
||||
nmax = getOption("max.print.freq"),
|
||||
na.rm = TRUE,
|
||||
row.names = TRUE,
|
||||
markdown = !interactive(),
|
||||
digits = 2,
|
||||
quote = FALSE,
|
||||
header = TRUE,
|
||||
title = NULL,
|
||||
na = "<NA>",
|
||||
droplevels = TRUE,
|
||||
sep = " ",
|
||||
decimal.mark = getOption("OutDec"),
|
||||
big.mark = ifelse(decimal.mark != ",", ",", ".")) {
|
||||
freq <- function(x,
|
||||
...,
|
||||
sort.count = TRUE,
|
||||
nmax = getOption("max.print.freq"),
|
||||
na.rm = TRUE,
|
||||
row.names = TRUE,
|
||||
markdown = !interactive(),
|
||||
digits = 2,
|
||||
quote = FALSE,
|
||||
header = TRUE,
|
||||
title = NULL,
|
||||
na = "<NA>",
|
||||
droplevels = TRUE,
|
||||
sep = " ",
|
||||
decimal.mark = getOption("OutDec"),
|
||||
big.mark = ifelse(decimal.mark != ",", ",", ".")) {
|
||||
|
||||
mult.columns <- 0
|
||||
x.group = character(0)
|
||||
@ -544,7 +554,7 @@ frequency_tbl <- function(x,
|
||||
# }
|
||||
|
||||
structure(.Data = df,
|
||||
class = c("frequency_tbl", class(df)),
|
||||
class = unique(c("freq", class(df))),
|
||||
header = header_list,
|
||||
opt = list(title = title,
|
||||
data = x.name,
|
||||
@ -565,7 +575,11 @@ frequency_tbl <- function(x,
|
||||
|
||||
#' @rdname freq
|
||||
#' @export
|
||||
freq <- frequency_tbl
|
||||
frequency_tbl <- freq
|
||||
|
||||
is.freq <- function(f) {
|
||||
any(c("freq", "frequency_tbl") %in% class(f))
|
||||
}
|
||||
|
||||
#' @importFrom crayon silver green red
|
||||
#' @importFrom dplyr %>%
|
||||
@ -639,13 +653,7 @@ format_header <- function(x, markdown = FALSE, decimal.mark = ".", big.mark = ",
|
||||
|
||||
# class and mode
|
||||
if (is.null(header$columns)) {
|
||||
# if (markdown == TRUE) {
|
||||
# header$class <- paste0("`", header$class, "`")
|
||||
# }
|
||||
if (!header$mode %in% header$class) {
|
||||
# if (markdown == TRUE) {
|
||||
# header$mode <- paste0("`", header$mode, "`")
|
||||
# }
|
||||
header$class <- header$class %>% rev() %>% paste(collapse = " > ") %>% paste0(silver(paste0(" (", header$mode, ")")))
|
||||
} else {
|
||||
header$class <- header$class %>% rev() %>% paste(collapse = " > ")
|
||||
@ -654,9 +662,6 @@ format_header <- function(x, markdown = FALSE, decimal.mark = ".", big.mark = ",
|
||||
}
|
||||
# levels
|
||||
if (!is.null(header$levels)) {
|
||||
# if (markdown == TRUE) {
|
||||
# header$levels <- paste0("`", header$levels, "`")
|
||||
# }
|
||||
if (header$ordered == TRUE) {
|
||||
levels_text <- paste0(header$levels, collapse = " < ")
|
||||
} else {
|
||||
@ -733,7 +738,7 @@ format_header <- function(x, markdown = FALSE, decimal.mark = ".", big.mark = ",
|
||||
#' @export
|
||||
#' @importFrom dplyr top_n pull
|
||||
top_freq <- function(f, n) {
|
||||
if (!"frequency_tbl" %in% class(f)) {
|
||||
if (!is.freq(f)) {
|
||||
stop("`top_freq` can only be applied to frequency tables", call. = FALSE)
|
||||
}
|
||||
if (!is.numeric(n) | length(n) != 1L) {
|
||||
@ -751,7 +756,7 @@ top_freq <- function(f, n) {
|
||||
#' @rdname freq
|
||||
#' @export
|
||||
header <- function(f, property = NULL) {
|
||||
if (!"frequency_tbl" %in% class(f)) {
|
||||
if (!is.freq(f)) {
|
||||
stop("`header` can only be applied to frequency tables", call. = FALSE)
|
||||
}
|
||||
if (is.null(property)) {
|
||||
@ -765,13 +770,12 @@ header <- function(f, property = NULL) {
|
||||
}
|
||||
|
||||
#' @noRd
|
||||
#' @exportMethod diff.frequency_tbl
|
||||
#' @exportMethod diff.freq
|
||||
#' @importFrom dplyr %>% full_join mutate
|
||||
#' @export
|
||||
diff.frequency_tbl <- function(x, y, ...) {
|
||||
diff.freq <- function(x, y, ...) {
|
||||
# check classes
|
||||
if (!"frequency_tbl" %in% class(x)
|
||||
| !"frequency_tbl" %in% class(y)) {
|
||||
if (!is.freq(x) | !is.freq(y)) {
|
||||
stop("Both x and y must be a frequency table.")
|
||||
}
|
||||
|
||||
@ -817,21 +821,34 @@ diff.frequency_tbl <- function(x, y, ...) {
|
||||
}
|
||||
|
||||
#' @rdname freq
|
||||
#' @exportMethod print.frequency_tbl
|
||||
#' @exportMethod print.freq
|
||||
#' @importFrom knitr kable
|
||||
#' @importFrom dplyr n_distinct
|
||||
#' @importFrom crayon bold silver
|
||||
#' @export
|
||||
print.frequency_tbl <- function(x,
|
||||
nmax = getOption("max.print.freq", default = 15),
|
||||
markdown = !interactive(),
|
||||
header = TRUE,
|
||||
decimal.mark = getOption("OutDec"),
|
||||
big.mark = ifelse(decimal.mark != ",", ",", "."),
|
||||
...) {
|
||||
print.freq <- function(x,
|
||||
nmax = getOption("max.print.freq", default = 15),
|
||||
markdown = !interactive(),
|
||||
header = TRUE,
|
||||
decimal.mark = getOption("OutDec"),
|
||||
big.mark = ifelse(decimal.mark != ",", ",", "."),
|
||||
...) {
|
||||
|
||||
opt <- attr(x, "opt")
|
||||
if (is.null(opt)) {
|
||||
# selection of frequency table, return original class
|
||||
class(x) <- class(x)[!class(x) %in% c("freq", "frequency_tbl")]
|
||||
print(x)
|
||||
return(invisible())
|
||||
}
|
||||
|
||||
opt$header_txt <- header(x)
|
||||
if (is.null(opt$nmax)) {
|
||||
opt$nmax <- 0
|
||||
}
|
||||
if (is.null(opt$tbl_format)) {
|
||||
opt$tbl_format <- "pandoc"
|
||||
}
|
||||
|
||||
dots <- list(...)
|
||||
if ("markdown" %in% names(dots)) {
|
||||
@ -854,7 +871,7 @@ print.frequency_tbl <- function(x,
|
||||
}
|
||||
|
||||
if (is.null(opt$title)) {
|
||||
if (isTRUE(opt$data %like% "^a data.frame") & opt$tbl_format == "markdown") {
|
||||
if (isTRUE(opt$data %like% "^a data.frame") & isTRUE(opt$tbl_format == "markdown")) {
|
||||
opt$data <- gsub("data.frame", "`data.frame`", opt$data, fixed = TRUE)
|
||||
}
|
||||
if (!is.null(opt$data) & !is.null(opt$vars)) {
|
||||
@ -883,21 +900,21 @@ print.frequency_tbl <- function(x,
|
||||
title <- opt$title
|
||||
}
|
||||
|
||||
if (!missing(nmax)) {
|
||||
if (!missing(nmax) | is.null(opt$nmax)) {
|
||||
opt$nmax <- nmax
|
||||
opt$nmax.set <- TRUE
|
||||
}
|
||||
if (opt$nmax %in% c(0, Inf, NA, NULL)) {
|
||||
if (isTRUE(opt$nmax %in% c(0, Inf, NA, NULL))) {
|
||||
opt$nmax <- NROW(x)
|
||||
opt$nmax.set <- FALSE
|
||||
} else if (opt$nmax >= NROW(x)) {
|
||||
} else if (isTRUE(opt$nmax >= NROW(x))) {
|
||||
opt$nmax.set <- FALSE
|
||||
}
|
||||
|
||||
if (!missing(decimal.mark)) {
|
||||
if (!missing(decimal.mark) | is.null(opt$decimal.mark)) {
|
||||
opt$decimal.mark <- decimal.mark
|
||||
}
|
||||
if (!missing(big.mark)) {
|
||||
if (!missing(big.mark) | is.null(opt$big.mark)) {
|
||||
opt$big.mark <- big.mark
|
||||
}
|
||||
if (!missing(header)) {
|
||||
@ -905,9 +922,9 @@ print.frequency_tbl <- function(x,
|
||||
}
|
||||
|
||||
# bold title
|
||||
if (opt$tbl_format == "pandoc") {
|
||||
if (isTRUE(opt$tbl_format == "pandoc")) {
|
||||
title <- bold(title)
|
||||
} else if (opt$tbl_format == "markdown") {
|
||||
} else if (isTRUE(opt$tbl_format == "markdown")) {
|
||||
title <- paste0("\n\n**", title, "** ") # two space for newline
|
||||
}
|
||||
|
||||
@ -915,7 +932,7 @@ print.frequency_tbl <- function(x,
|
||||
|
||||
if (NROW(x) == 0 | isTRUE(all(is.na(x$item)))) {
|
||||
cat("No observations")
|
||||
if (isTRUE(all(is.na(x$item)))) {
|
||||
if (isTRUE(all(is.na(x$item) | identical(x$item, "<NA>") | identical(x$item, "(NA)")))) {
|
||||
cat(" - all values are missing (<NA>)")
|
||||
}
|
||||
cat(".\n")
|
||||
@ -925,7 +942,7 @@ print.frequency_tbl <- function(x,
|
||||
return(invisible())
|
||||
}
|
||||
|
||||
if (opt$header == TRUE) {
|
||||
if (isTRUE(opt$header == TRUE)) {
|
||||
if (!is.null(opt$header_txt)) {
|
||||
if (is.null(opt$digits)) {
|
||||
opt$digits <- 2
|
||||
@ -940,7 +957,7 @@ print.frequency_tbl <- function(x,
|
||||
if (is.null(opt$na)) {
|
||||
opt$na <- "<NA>"
|
||||
}
|
||||
if (opt$tbl_format == "markdown") {
|
||||
if (isTRUE(opt$tbl_format == "markdown")) {
|
||||
# no HTML tags
|
||||
opt$na <- gsub("<", "(", opt$na, fixed = TRUE)
|
||||
opt$na <- gsub(">", ")", opt$na, fixed = TRUE)
|
||||
@ -951,7 +968,7 @@ print.frequency_tbl <- function(x,
|
||||
x.unprinted <- base::sum(x[(opt$nmax + 1):nrow(x), "count"], na.rm = TRUE)
|
||||
x.printed <- base::sum(x$count) - x.unprinted
|
||||
|
||||
if (nrow(x) > opt$nmax & opt$tbl_format != "markdown") {
|
||||
if (nrow(x) > opt$nmax & isTRUE(opt$tbl_format != "markdown")) {
|
||||
|
||||
if (opt$nmax.set == TRUE) {
|
||||
nmax <- opt$nmax
|
||||
@ -1029,6 +1046,13 @@ print.frequency_tbl <- function(x,
|
||||
cat("\n")
|
||||
}
|
||||
|
||||
if (is.null(opt$row_names)) {
|
||||
opt$row_names <- TRUE
|
||||
}
|
||||
if (is.null(opt$column_names)) {
|
||||
opt$column_names <- colnames(x)
|
||||
}
|
||||
|
||||
print(
|
||||
knitr::kable(x,
|
||||
format = opt$tbl_format,
|
||||
@ -1055,37 +1079,42 @@ print.frequency_tbl <- function(x,
|
||||
}
|
||||
|
||||
#' @noRd
|
||||
#' @exportMethod as.data.frame.frequency_tbl
|
||||
#' @exportMethod print.frequency_tbl
|
||||
#' @export
|
||||
as.data.frame.frequency_tbl <- function(x, ...) {
|
||||
print.frequency_tbl <- print.freq
|
||||
|
||||
#' @noRd
|
||||
#' @exportMethod as.data.frame.freq
|
||||
#' @export
|
||||
as.data.frame.freq <- function(x, ...) {
|
||||
attr(x, "package") <- NULL
|
||||
attr(x, "opt") <- NULL
|
||||
as.data.frame.data.frame(x, ...)
|
||||
}
|
||||
|
||||
#' @exportMethod select.frequency_tbl
|
||||
#' @exportMethod select.freq
|
||||
#' @export
|
||||
#' @importFrom dplyr select
|
||||
#' @noRd
|
||||
select.frequency_tbl <- function(.data, ...) {
|
||||
select.freq <- function(.data, ...) {
|
||||
select(as.data.frame(.data), ...)
|
||||
}
|
||||
|
||||
#' @noRd
|
||||
#' @exportMethod as_tibble.frequency_tbl
|
||||
#' @exportMethod as_tibble.freq
|
||||
#' @export
|
||||
#' @importFrom dplyr as_tibble
|
||||
as_tibble.frequency_tbl <- function(x, validate = TRUE, ..., rownames = NA) {
|
||||
as_tibble.freq <- function(x, validate = TRUE, ..., rownames = NA) {
|
||||
attr(x, "package") <- NULL
|
||||
attr(x, "opt") <- NULL
|
||||
as_tibble(x = as.data.frame(x), validate = validate, ..., rownames = rownames)
|
||||
}
|
||||
|
||||
#' @noRd
|
||||
#' @exportMethod hist.frequency_tbl
|
||||
#' @exportMethod hist.freq
|
||||
#' @export
|
||||
#' @importFrom graphics hist
|
||||
hist.frequency_tbl <- function(x, breaks = "Sturges", main = NULL, xlab = NULL, ...) {
|
||||
hist.freq <- function(x, breaks = "Sturges", main = NULL, xlab = NULL, ...) {
|
||||
opt <- attr(x, "opt")
|
||||
if (!class(x$item) %in% c("numeric", "double", "integer", "Date")) {
|
||||
stop("`x` must be numeric or Date.", call. = FALSE)
|
||||
@ -1112,9 +1141,56 @@ hist.frequency_tbl <- function(x, breaks = "Sturges", main = NULL, xlab = NULL,
|
||||
}
|
||||
|
||||
#' @noRd
|
||||
#' @exportMethod plot.frequency_tbl
|
||||
#' @exportMethod boxplot.freq
|
||||
#' @export
|
||||
plot.frequency_tbl <- function(x, y, ...) {
|
||||
#' @importFrom graphics boxplot
|
||||
boxplot.freq <- function(x, main = NULL, xlab = NULL, ...) {
|
||||
opt <- attr(x, "opt")
|
||||
x.bak <- x
|
||||
if (!class(x$item) %in% c("numeric", "double", "integer", "Date")) {
|
||||
stop("`x` must be numeric or Date.", call. = FALSE)
|
||||
}
|
||||
if (!is.null(opt$vars)) {
|
||||
title <- opt$vars
|
||||
} else if (!is.null(opt$data)) {
|
||||
title <- opt$data
|
||||
} else {
|
||||
title <- "frequency table"
|
||||
}
|
||||
if (class(x$item) == "Date") {
|
||||
x <- as.Date(as.vector(x), origin = "1970-01-01")
|
||||
} else {
|
||||
x <- as.vector(x)
|
||||
}
|
||||
if (is.null(main)) {
|
||||
main <- paste("Boxplot of", title)
|
||||
}
|
||||
if (is.null(xlab)) {
|
||||
xlab <- title
|
||||
}
|
||||
if (!is.null(opt$group_var) & isTRUE(length(opt$group_var) > 0)) {
|
||||
# support for grouped frequency table
|
||||
x.new <- data.frame(group = character(0), item = character(0))
|
||||
for (i in 1:nrow(x.bak)) {
|
||||
if (x.bak[i, "group"] == "") {
|
||||
x.bak[i, "group"] <- x.bak[i - 1, "group"]
|
||||
}
|
||||
for (j in 1:x.bak[i, "count"]) {
|
||||
x.new <- rbind(x.new,
|
||||
data.frame(group = x.bak[i, "group"],
|
||||
item = x.bak[i, "item"]))
|
||||
}
|
||||
}
|
||||
boxplot(item ~ group, data = x.bak, main = main, ylab = xlab, xlab = opt$group_var, ...)
|
||||
} else {
|
||||
boxplot(x, main = main, xlab = xlab, ...)
|
||||
}
|
||||
}
|
||||
|
||||
#' @noRd
|
||||
#' @exportMethod plot.freq
|
||||
#' @export
|
||||
plot.freq <- function(x, y, ...) {
|
||||
opt <- attr(x, "opt")
|
||||
if (!is.null(opt$vars)) {
|
||||
title <- opt$vars
|
||||
@ -1125,16 +1201,16 @@ plot.frequency_tbl <- function(x, y, ...) {
|
||||
}
|
||||
|
||||
#' @noRd
|
||||
#' @exportMethod as.vector.frequency_tbl
|
||||
#' @exportMethod as.vector.freq
|
||||
#' @export
|
||||
as.vector.frequency_tbl <- function(x, mode = "any") {
|
||||
as.vector.freq <- function(x, mode = "any") {
|
||||
as.vector(rep(x$item, x$count), mode = mode)
|
||||
}
|
||||
|
||||
#' @noRd
|
||||
#' @exportMethod format.frequency_tbl
|
||||
#' @exportMethod format.freq
|
||||
#' @export
|
||||
format.frequency_tbl <- function(x, digits = 1, ...) {
|
||||
format.freq <- function(x, digits = 1, ...) {
|
||||
opt <- attr(x, "opt")
|
||||
if (opt$nmax.set == TRUE) {
|
||||
nmax <- opt$nmax
|
||||
|
||||
Reference in New Issue
Block a user