diff --git a/DESCRIPTION b/DESCRIPTION index 6031ca8e6..35d7b86b4 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: rtables Title: Reporting Tables -Version: 0.1.0.6 +Version: 0.1.1 Authors@R: c( person("Adrian", "Waddell", email = "adrian.waddell@roche.com", role = c("aut", "cre")) ) @@ -18,7 +18,7 @@ Suggests: License: Apache License 2.0 | file LICENSE Encoding: UTF-8 LazyData: true -RoxygenNote: 6.1.0 +RoxygenNote: 6.1.1 VignetteBuilder: knitr URL: https://github.com/roche/rtables, https://roche.github.io/rtables/ BugReports: https://github.com/roche/rtables/issues diff --git a/NAMESPACE b/NAMESPACE index f5aeab82d..0d858e86a 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -10,6 +10,7 @@ S3method(as_html,rrow) S3method(as_html,rtable) S3method(dim,rheader) S3method(dim,rtable) +S3method(levels,no_by) S3method(names,rtable) S3method(print,rcell) S3method(print,rrow) @@ -23,6 +24,7 @@ S3method(rtabulate,factor) S3method(rtabulate,logical) S3method(rtabulate,numeric) S3method(toString,rtable) +S3method(unlist,rtable) export("header<-") export(Viewer) export(as.rtable) @@ -30,10 +32,14 @@ export(as_html) export(compare_rtables) export(format_rcell) export(header) +export(header_add_N) export(indented_row.names) export(is.no_by) export(list_rcell_format_labels) export(no_by) +export(order_rrows) +export(order_rtables) +export(rbindl_rtables) export(rcell) export(rheader) export(rrow) @@ -41,6 +47,8 @@ export(rrowl) export(rtable) export(rtablel) export(rtabulate) +export(sort_rrows) +export(sort_rtables) export(sprintf_format) importFrom(htmltools,tagList) importFrom(htmltools,tags) diff --git a/NEWS.md b/NEWS.md index 743bf8e59..12c1b61e9 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,16 +1,24 @@ -## rtable 0.1.0.6 + +## rtables 0.1.1 + +* `rtablulate` family of functions do not support the `row_*_data_args` arguments anymore. Instead, the `col_wise_args` argument is introduced. +* add functions `order_rrows`, `sort_rrows`, `order_rtables`, and `sort_rtables` are introduced. +* prevent `rtables` from being unlisted with `unlist.rtables` + + +## rtables 0.1.0.6 * `Viewer` now also accepts objects of class `shiny.tag` (defined in package `htmltools`) * `as.html` accepts `class.table`, `class.tr`, `class.th`, and `class.td` as an argument -## rtable 0.1.0.5 +## rtables 0.1.0.5 * added `sprintf_format` for formatting rcells (thanks to Doug Kelkhoff for the suggestion) * added `"(N=xx)"` and `">999.9"` format labels -* `rtabulate` has now an argument `col_total` and shows by default the numbers of elements associated with a column +* `rtabulate` has now an argument `col_N` and the function `col_N()` -## rtable 0.1.0 +## rtables 0.1.0 Version `0.1.0` is a major re-design with lots of internal refactoring and the following API changes: @@ -37,6 +45,6 @@ single `rrow` and by setting `row.name` to `NULL`. * `indented_row.names` function added -## rtable 0.0.1 +## rtables 0.0.1 * Initial public release \ No newline at end of file diff --git a/R/accessors_modifiers.R b/R/accessors_modifiers.R index b4db76762..5efefb0e9 100644 --- a/R/accessors_modifiers.R +++ b/R/accessors_modifiers.R @@ -243,62 +243,3 @@ set_rrow_attrs <- function(rrow, row.name, indent) { rrow } -#' stack rtable objects -#' -#' @param ... \code{\link{rtable}} objects -#' -#' @return an \code{\link{rtable}} object -#' -#' @export -#' -#' @examples -#' -#' mtbl <- rtable( -#' header = rheader( -#' rrow(row.name = NULL, rcell("Sepal.Length", colspan = 2), rcell("Petal.Length", colspan=2)), -#' rrow(NULL, "mean", "median", "mean", "median") -#' ), -#' rrow( -#' row.name = "All Species", -#' mean(iris$Sepal.Length), median(iris$Sepal.Length), -#' mean(iris$Petal.Length), median(iris$Petal.Length), -#' format = "xx.xx" -#' ) -#' ) -#' -#' mtbl2 <- with(subset(iris, Species == 'setosa'), rtable( -#' header = rheader( -#' rrow(row.name = NULL, rcell("Sepal.Length", colspan = 2), rcell("Petal.Length", colspan=2)), -#' rrow(NULL, "mean", "median", "mean", "median") -#' ), -#' rrow( -#' row.name = "Setosa", -#' mean(Sepal.Length), median(Sepal.Length), -#' mean(Petal.Length), median(Petal.Length), -#' format = "xx.xx" -#' ) -#' )) -#' -#' tbl <- rbind(mtbl, mtbl2) -#' -#' tbl -#' -rbind.rtable <- function(...) { - - dots <- Filter(Negate(is.null), list(...)) - - if (!are(dots, "rtable")) stop("not all elements are of type rtable") - - headers <- lapply(dots, header) - ref_header <- headers[[1]] - - same_headers <- vapply(headers[-1], function(h) { - identical(h, ref_header) - }, logical(1)) - - if (!all(same_headers)) stop("not all rtables have the same header") - - body <- unlist(dots, recursive = FALSE) - - rtablel(header = ref_header, body) -} diff --git a/R/as_html.R b/R/as_html.R index 9b0cdb1ce..a3be40262 100644 --- a/R/as_html.R +++ b/R/as_html.R @@ -44,14 +44,13 @@ as_html.default <- function(x, ...) { stop("no as_html method for class ", class(x)) } -# Convert an rtable object to html -# -# @param x an object of class \code{\link{rtable}} -# @param class.table class attributes for the table in html -# @param ... arguments passed on to methods -# -# @return an object of class \code{shinyTag} - +#' Convert an rtable object to html +#' +#' @inheritParams as_html +#' @param class.table class attributes for \code{} html object +#' +#' @return an object of class \code{shinyTag} +#' #' @export as_html.rtable <- function(x, class.table = "table table-condensed table-hover", ...) { diff --git a/R/header_add_N.R b/R/header_add_N.R new file mode 100644 index 000000000..049da7ad4 --- /dev/null +++ b/R/header_add_N.R @@ -0,0 +1,34 @@ + +#' Add N=xx to header +#' +#' Helper function used to add the population total (N) in the +#' column header of \code{\link{rtable}} object. +#' +#' @param x \code{rtable} +#' @param N vector with counts to be displayed in the header. The +#' length must match the number of columns in \code{x} +#' +#' @export +#' +#' @examples +#' +#' tbl <- rtable( +#' header = letters[1:3], +#' rrow("X", 1, 2, 3), +#' rrow("Y", 4, 5, 6) +#' ) +#' +#' tbl +#' +#' header_add_N(tbl, 1:3) +#' +header_add_N <- function(x, N) { + is(x, "rtable") || stop("x is expected to be an rtable") + length(N) == ncol(x) || stop("dimension missmatch") + + header(x) <- rheader( + header(x)[[1]], + rrowl("", N, format = "(N=xx)") + ) + x +} diff --git a/R/rbind.R b/R/rbind.R new file mode 100644 index 000000000..07a4672fd --- /dev/null +++ b/R/rbind.R @@ -0,0 +1,104 @@ +#' Stack rtable objects +#' +#' Note that the columns order are not mached by the header: the first table +#' header is taken as the reference. +#' +#' @param ... \code{\link{rtable}} objects +#' @param gap number of empty rows to add between tables +#' +#' @return an \code{\link{rtable}} object +#' +#' @export +#' +#' @examples +#' +#' mtbl <- rtable( +#' header = rheader( +#' rrow(row.name = NULL, rcell("Sepal.Length", colspan = 2), rcell("Petal.Length", colspan=2)), +#' rrow(NULL, "mean", "median", "mean", "median") +#' ), +#' rrow( +#' row.name = "All Species", +#' mean(iris$Sepal.Length), median(iris$Sepal.Length), +#' mean(iris$Petal.Length), median(iris$Petal.Length), +#' format = "xx.xx" +#' ) +#' ) +#' +#' mtbl2 <- with(subset(iris, Species == 'setosa'), rtable( +#' header = rheader( +#' rrow(row.name = NULL, rcell("Sepal.Length", colspan = 2), rcell("Petal.Length", colspan=2)), +#' rrow(NULL, "mean", "median", "mean", "median") +#' ), +#' rrow( +#' row.name = "Setosa", +#' mean(Sepal.Length), median(Sepal.Length), +#' mean(Petal.Length), median(Petal.Length), +#' format = "xx.xx" +#' ) +#' )) +#' +#' tbl <- rbind(mtbl, mtbl2) +#' tbl +#' +#' tbl <- rbind(mtbl, mtbl2, gap = 1) +#' tbl +#' +#' tbl <- rbind(mtbl, mtbl2, gap = 2) +#' tbl +#' +rbind.rtable <- function(..., gap = 0) { + dots <- Filter(Negate(is.null), list(...)) + rbindl_rtables(dots, gap = gap) +} + +#' Stack a list of rtables +#' +#' See \code{\link{rbind.rtable}} for details +#' +#' @param x a list of rtable objects +#' @inheritParams rbind.rtable +#' +#' @export +#' +rbindl_rtables <- function(x, gap = 0) { + + stopifnot(is.list(x)) + stopifnot(are(x, "rtable")) + stopifnot(length(x) > 0) + stopifnot(is.numeric(gap), gap >= 0) + + if (!num_all_equal(vapply(x, ncol, numeric(1)))) + stop("non-matching number of columns between tables") + + tbl <- if (gap != 0) { + gap_rows <- replicate(gap, rrow(), simplify = FALSE) + Reduce(function(tbl1, tbl2) c(tbl1, gap_rows, tbl2), x) + } else { + unlist(x, recursive = FALSE) + } + + ref_header <- header(x[[1]]) + class(tbl) <- "rtable" + attr(tbl, "header") <- ref_header + attr(tbl, "nrow") <- length(tbl) + attr(tbl, "ncol") <- ncol(ref_header) + + tbl +} + + +#' Unlist method for rtables +#' +#' rtable objects should not be unlisted. This allows us to create nested lists with rtables objects and then flatten +#' them to a list of rtable objects. +#' +#' @inheritParams base::unlist +#' +#' @return rtable object +#' +#' @method unlist rtable +#' @export +unlist.rtable <- function(x, recursive = TRUE, use.names = TRUE) { + x +} diff --git a/R/rtabulate.R b/R/rtabulate.R index 4e4b2c6c9..e320026d7 100644 --- a/R/rtabulate.R +++ b/R/rtabulate.R @@ -5,13 +5,13 @@ #' \code{\link{rtable}}s. Conceptually the \code{rtabulate} has it's origin in #' \code{\link{tapply}}. #' -#' The data is split into cell-data and a function can be specified that return +#' The data is split into cell-data and a function can be specified that returns #' a data structre (or \code{\link{rcell}}). #' #' @param x either a vector or \code{data.frame} #' @param ... arguments passed to methods #' -#' @return an \code{\link{rtable}} project +#' @return an \code{\link{rtable}} object #' #' @author Adrian Waddell #' @@ -22,20 +22,26 @@ rtabulate <- function(x, ...) { } -#' Do not split data into columns or row in \code{rtabulate} +#' Do not split data into columns in \code{rtabulate} #' -#' \code{\link{rtabulate}} has the arguments \code{col_by} and \code{row_by} +#' \code{\link{rtabulate}} has the argument \code{col_by} #' which can either take a vector or if no splitting is needed the return value -#' of \code{no_by}. +#' of \code{no_by}. Using \code{no_by} creates a table with a single +#' column. #' -#' @param name row name or column name +#' @param name character column name to display in the table header #' #' @export #' +#' @examples +#' +#' rtabulate(iris$Species, col_by = no_by("Total")) + no_by <- function(name) { structure(name, class = "no_by") } + #' Check if object inherits from the \code{no_by} Class #' #' Functions to test inheritance on \code{no_by} @@ -49,93 +55,90 @@ is.no_by <- function(x) { is(x, "no_by") } -rtabulate_header <- function(col_by, Ntot, N=NULL, format="(N=xx)") { - if (!is.factor(col_by) && !is.no_by(col_by)) stop("col_by is required to be a factor or no_by object") - - lvls <- if (is.no_by(col_by)) as.vector(col_by) else levels(col_by) - - if (is.null(format)) { - rheader(lvls) - } else { - if (is.null(N)) { - N <- if (is.no_by(col_by)) Ntot else table(col_by) - } - rheader( - rrowl("", lvls), - rrowl("", unname(N), format = format) - ) - } +#' Access levels attribute for an object of \code{no_by} Class +#' +#' @param x \code{no_by} class object +#' +#' @export +#' +levels.no_by <- function(x) { + as.vector(x) } # rtabulate default for vectors # -# this method is used for vectors of type \code{logical} and \code{numeric} +# This method is used for vectors of type \code{logical} and \code{numeric} # # see parameter descrition for rtabulate.numeric # -rtabulate_default <- function(x, col_by = no_by("col_1"), FUN = NULL, ..., row_data_arg=FALSE, - format = NULL, row.name = "", indent = 0, col_total = "(N=xx)") { - - if (is.null(FUN)) stop("FUN is required") - - stop_if_has_na(col_by) +rtabulate_default <- function(x, col_by = no_by("col_1"), FUN, ..., + format = NULL, row.name = "", indent = 0, + col_wise_args = NULL) { - tbl_header <- rtabulate_header(col_by, length(x), format=col_total) + force(FUN) + check_stop_col_by(col_by, col_wise_args) - xs <- if (is.no_by(col_by)) { + column_data <- if (is.no_by(col_by)) { setNames(list(x), col_by) } else { if (length(x) != length(col_by)) stop("dimension missmatch x and col_by") split(x, col_by, drop = FALSE) } - - col_data <- if (row_data_arg) { - lapply(xs, FUN, x, ...) + + cells <- if (is.null(col_wise_args)) { + + lapply(column_data, FUN, ...) + } else { - lapply(xs, FUN, ...) + + dots <- list(...) + args <- lapply(seq_len(nlevels(col_by)), function(i) c(dots, lapply(col_wise_args, `[[`, i))) + + Map(function(xi, argsi) { + do.call(FUN, c(list(xi), argsi)) + }, column_data, args) } - rr <- rrowl(row.name = row.name, col_data, format = format, indent = indent) - - rtable(header = tbl_header, rr) + rr <- rrowl(row.name = row.name, cells, format = format, indent = indent) + rtable(header = levels(col_by), rr) } -#' tabulate a numeric vector -#' -#' by default the \code{\link[stats]{fivenum}} function is applied to the -#' vectors associated to the cells -#' -#' + + +#' Tabulate a numeric vector +#' +#' By default each cell reports the mean based on the associated vector. +#' +#' #' @inheritParams rrow #' @param x a vecor #' @param col_by a \code{\link{factor}} of length \code{nrow(x)} that defines #' which levels in \code{col_by} define a column. If data should not be split #' into columns use the \code{\link{no_by}} function. -#' @param FUN a function that processes the cell data, if \code{row_data_arg} is -#' set to \code{TRUE} the a second argument with the row data is passed to -#' \code{FUN} +#' @param FUN a function that processes the cell data #' @param ... arguments passed to \code{FUN} -#' @param row_data_arg call \code{FUN} with the row data as the second argument #' @param format if \code{FUN} does not return a formatted \code{\link{rcell}} #' then the \code{format} is applied #' @param row.name if \code{NULL} then the \code{FUN} argument is deparsed and #' used as \code{row.name} of the \code{\link{rrow}} -#' @param col_total a format string for displaying the number of elements in the -#' column header. If \code{NULL} then no header row for the column is -#' displayed. -#' +#' @param col_wise_args a named list containing collections (e.g. vectors or +#' lists) with data elements for each column of the resulting table. The data +#' elements are then passed to the named argument \code{FUN} corresponding to +#' the element name of the outer list. Hence, the length and order of each +#' collection must match the levels in \code{col_by}. See examples. +#' #' @inherit rtabulate return -#' +#' #' @export -#' -#' @examples +#' +#' @examples #' #' rtabulate(iris$Sepal.Length) -#' +#' #' rtabulate(iris$Sepal.Length, col_by = no_by("Sepal.Length")) -#' -#' with(iris, rtabulate(x = Sepal.Length, col_by = Species, row.name = "fivenum")) +#' +#' with(iris, rtabulate(x = Sepal.Length, col_by = Species, row.name = "mean")) #' #' SL <- iris$Sepal.Length #' Sp <- iris$Species @@ -146,19 +149,31 @@ rtabulate_default <- function(x, col_by = no_by("col_1"), FUN = NULL, ..., row_d #' rtabulate(SL, Sp, range, format = "xx.xx - xx.xx", row.name = "Min - Max") #' ) #' +#' x <- 1:100 +#' cb <- factor(rep(LETTERS[1:3], c(20, 30, 50))) #' +#' rtabulate( +#' x = x, col_by = cb, FUN = function(x, N) list(mean(x), sd(x), N), +#' format = sprintf_format("%.2f (%.2f) and %i"), row.name = "Mean (SD) and N", +#' col_wise_args = list(N = table(cb)) +#' ) #' rtabulate.numeric <- function(x, col_by = no_by("col_1"), FUN = mean, ..., - row_data_arg = FALSE, format = NULL, row.name = NULL, - indent = 0, col_total = "(N=xx)") { - if (is.null(row.name)) row.name <- paste0(deparse(substitute(FUN))) - rtabulate_default(x = x, col_by = col_by, FUN = FUN, ..., - row_data_arg = row_data_arg, format = format, - row.name = row.name, indent = indent, - col_total = col_total) + format = NULL, row.name = NULL, + indent = 0, col_wise_args = NULL) { + + if (is.null(row.name)) row.name <- paste(deparse(substitute(FUN)), collapse = ";") + + rtabulate_default( + x = x, col_by = col_by, FUN = FUN, ..., + format = format, row.name = row.name, indent = indent, + col_wise_args = col_wise_args + ) } -#' tabulate a logical vector +#' Tabulate a logical vector +#' +#' By default each cell reports the number of \code{TRUE} observations from the associated vector. #' #' @inheritParams rtabulate.numeric #' @@ -169,43 +184,51 @@ rtabulate.numeric <- function(x, col_by = no_by("col_1"), FUN = mean, ..., #' @examples #' rtabulate(iris$Species == "setosa") #' -#' rtabulate(iris$Species == "setosa", no_by("Species"), row.name = "n (n/N)") +#' rtabulate(iris$Species == "setosa", no_by("Species"), +#' FUN = function(x, N) list(sum(x), sum(x)/N), +#' row.name = "n (n/N)", +#' col_wise_args = list(N = 150)) #' -#' # default: percentages equal \code{TRUE} +#' # default FUN is number of observations equal to TRUE #' with(iris, rtabulate(Sepal.Length < 5, Species, row.name = "Sepal.Length < 5")) #' -#' # precentages with proportion of cell number of \code{TRUE}s to overvall -#' # number of \code{TRUE}s -#' with(iris, rtabulate(Sepal.Length < 5, Species, row.name = "Sepal.Length < 5", -#' FUN = function(cell_data, row_data) sum(cell_data) * c(1, 1/sum(row_data)), -#' row_data_arg = TRUE +#' # Custom FUN: number of TRUE records in a cell and precentages based on number of records +#' # in each column +#' with(iris, rtabulate(Sepal.Length < 5, Species, +#' FUN = function(xi, N) sum(xi) * c(1, 1/N), +#' format = "xx.xx (xx.xx%)", +#' row.name = "Sepal.Length < 5", +#' col_wise_args = list(N = table(Species)) #' )) #' rtabulate.logical <- function(x, col_by = no_by("col_1"), - FUN = function(x) sum(x) * c(1, 1/length(x)), + FUN = sum, ..., - row_data_arg = FALSE, - format = "xx.xx (xx.xx%)", - row.name = "", + format = NULL, + row.name = NULL, indent = 0, - col_total = "(N=xx)" + col_wise_args = NULL ) { - if (is.null(row.name)) row.name <- paste0(deparse(substitute(FUN))) - rtabulate_default(x = x, col_by = col_by, FUN = FUN, ..., - row_data_arg = row_data_arg, format = format, - row.name = row.name, indent = indent, - col_total = col_total) + + if (is.null(row.name)) row.name <- paste(deparse(substitute(FUN)), collapse = ";") + + rtabulate_default( + x = x, col_by = col_by, FUN = FUN, ..., + format = format, row.name = row.name, indent = indent, + col_wise_args = col_wise_args + ) } #' Tabulate Factors #' +#' By default each cell reports the number of observations in +#' each level of \code{x}. +#' #' @inheritParams rtabulate.numeric -#' @param row_col_data_args boolean, if \code{TRUE} then \code{FUN} is called -#' with the first three arguments being the cell, row, and column data, -#' respectively -#' @param useNA boolean, if \code{TRUE} then \code{NA} values in \code{x} get -#' turned into a factor level \code{"NA"}, if \code{FALSE} then the \code{NA} -#' values in \code{x} get dropped. +#' @param useNA either one of ("no", "ifany", "always"). If \code{"no"} then \code{NA} values +#' in \code{x} get dropped. When \code{"ifany"} is used a row for \code{NA} values is +#' included in the summary if any \code{NA}s exist in \code{x}. For option \code{"always"} +#' \code{NA} values are always included in the summary even if none exist in \code{x}. #' #' @inherit rtabulate return #' @@ -221,40 +244,51 @@ rtabulate.logical <- function(x, col_by = no_by("col_1"), #' labels = c("S.L > 5", "S.L <= 5")) #' #' rtabulate(iris$Species, col_by=sl5) +#' rtabulate(sl5, iris$Species) #' #' rtabulate(iris$Species, col_by=sl5, -#' FUN = function(cell_data, row_data, col_data) { +#' FUN = function(cell_data, N) { #' if (length(cell_data) > 10) { -#' length(cell_data) * c(1, 1/length(col_data)) +#' length(cell_data) * c(1, 1/N) #' } else { #' rcell("-", format = "xx") #' } #' }, -#' row_col_data_args = TRUE, -#' format = "xx (xx.xx%)" +#' format = "xx (xx.xx%)", +#' col_wise_args = list(N = table(sl5)) +#' ) +#' +#' rtabulate(x = factor(c("X", "Y"), c("X", "Y")), +#' col_by = factor(c("a", "a"), c("a", "b")), FUN = length) +#' +#' rtabulate(factor(c("Y", "Y"), c("X", "Y")), +#' factor(c("b", "b"), c("a", "b")), length) +#' +#' rtabulate( +#' x = factor(c("Y", "Y"), c("X", "Y")), +#' col_by = factor(c("b", "b"), c("a", "b")), +#' FUN = function(x, N) list(length(x), N), +#' col_wise_args = list(N = c(1,2)) #' ) #' -#' rtabulate(sl5, iris$Species) #' rtabulate.factor <- function(x, col_by = no_by("col_1"), FUN = length, ..., - row_col_data_args = FALSE, useNA = c("no", "ifany", "always"), - format = "xx", + format = NULL, indent = 0, - col_total = "(N=xx)") { + col_wise_args = NULL) { - stop_if_has_na(col_by) + force(FUN) + check_stop_col_by(col_by, col_wise_args) useNA <- match.arg(useNA) - tbl_header <- rtabulate_header(col_by, length(x), format=col_total) + if (any("" %in% levels(x))) stop("factor with level '' is not valid in rtabulate.factor") if (useNA %in% c("ifany", "always")) { - if (any("" %in% levels(x))) stop("cannot use useNA='ifany' or 'always' if there any levels called ") - if (useNA == "always" || any(is.na(x))) { levels(x) <- c(levels(x), "") x[is.na(x)] <- "" @@ -267,48 +301,43 @@ rtabulate.factor <- function(x, levels(x) <- gsub("^$", "-", levels(x)) warning("'' levels were turned into level -") } - - row_data_list <- split(x, x, drop = FALSE) - cell_data <- if (is.no_by(col_by)) { - lapply(row_data_list, function(row_i) setNames(list(row_i), col_by)) + + # cell_data = list(row1 = list(col1, col2, ...), row2 = list(col1, col2, ...), ...) + cell_data_by_row <- if (is.no_by(col_by)) { + lapply(split(x, x, drop = FALSE), function(row_i) setNames(list(row_i), col_by)) } else { if (length(x) != length(col_by)) stop("dimension missmatch x and col_by") - df <- data.frame( x = x, - col_by = factor(col_by) + col_by = col_by ) lapply(split(df, df$x, drop = FALSE), function(row_i) { split(row_i$x, row_i$col_by, drop = FALSE) }) } - rrow_data <- if (!row_col_data_args) { - lapply(cell_data, function(row_i) lapply(row_i, FUN, ...)) + + cells_by_row <- if (is.null(col_wise_args)) { + + lapply(cell_data_by_row, function(row_i) lapply(row_i, FUN, ...)) + } else { - col_data_list <- if (is.no_by(col_by)) { - setNames(list(x), col_by) - } else { - split(x, col_by, drop = FALSE) - } - - rrow_data_tmp <- lapply(1:length(row_data_list), function(i) { - rrow_data_i <- lapply(1:length(col_data_list), function(j) { - FUN(cell_data[[i]][[j]], row_data_list[[i]], col_data_list[[j]], ...) - }) - names(rrow_data_i) <- names(col_data_list) - rrow_data_i + dots <- list(...) + args <- lapply(seq_len(nlevels(col_by)), function(i) c(dots, lapply(col_wise_args, `[[`, i))) + + lapply(cell_data_by_row, function(row_i) { + Map(function(xi, argsi) { + do.call(FUN, c(list(xi), argsi)) + }, row_i, args) }) - names(rrow_data_tmp) <- names(row_data_list) - rrow_data_tmp } rrows <- Map(function(row, rowname) rrowl(rowname, row, format = format, indent = indent), - rrow_data, names(rrow_data)) + cells_by_row, names(cells_by_row)) - rtablel(header = tbl_header, rrows) + rtablel(header = levels(col_by), rrows) } @@ -317,8 +346,9 @@ rtabulate.factor <- function(x, #' Split data.frame and apply functions #' #' @inheritParams rtabulate.factor -#' @param row_by_var name of factor variable in \code{x} -#' @param col_by_var name of factor variable in \code{x} +#' @param x data.frame +#' @param row_by name of factor variable in \code{x} +#' @param col_by name of factor variable in \code{x} #' #' #' @inherit rtabulate return @@ -333,8 +363,8 @@ rtabulate.factor <- function(x, #' #' rtabulate( #' x = df, -#' row_by_var = "aaa", -#' col_by_var = "bbb", +#' row_by = df$aaa, +#' col_by = df$bbb, #' FUN = function(x) { #' sum(x$val) #' } @@ -342,112 +372,120 @@ rtabulate.factor <- function(x, #' #' rtabulate( #' x = iris, -#' row_by_var = no_by("sum"), -#' col_by_var = "Species", +#' row_by = no_by("sum"), +#' col_by = iris$Species, #' FUN = function(x) sum(x$Sepal.Length) #' ) #' #' rtabulate( #' x = iris, -#' row_by_var = "Species", -#' col_by_var = no_by("sum"), +#' row_by = iris$Species, +#' col_by = no_by("sum"), #' FUN = function(x) sum(x$Sepal.Length) #' ) #' -#' tbl <- rtabulate( -#' x = iris, -#' FUN = function(cell_data) c(sum(cell_data$Sepal.Length), sd(cell_data$Sepal.Length)), -#' format = "xx.xx (xx.xx%)" -#' ) -#' -#' tbl -#' -#' row.names(tbl) -#' row.names(tbl) <- "Sum of Sepal Length" -#' -#' tbl -#' -#' iris2 <- iris -#' iris2$fsl5 <- factor(iris$Sepal.Length > 5, levels = c(TRUE, FALSE), +#' fsl5 <- factor(iris$Sepal.Length > 5, levels = c(TRUE, FALSE), #' labels = c("S.L > 5", "S.L <= 5")) #' #' tbl <- rtabulate( -#' x = iris2, -#' row_by_var = "fsl5", -#' col_by_var = "Species", -#' FUN = function(x_cell, x_row, x_col) { +#' x = iris, +#' row_by = fsl5, +#' col_by = iris$Species, +#' FUN = function(x_cell) { #' if (nrow(x_cell) < 10) { #' rcell("-") #' } else { #' fit <- lm(Sepal.Length ~ Petal.Width, data = x_cell) -#' m_col <- mean(x_col$Sepal.Length) -#' m_row <- mean(x_row$Sepal.Length) -#' -#' rcell(list(fit, m_col, m_row), format = function(x, output) { -#' paste("df:", x[[1]]$df.residual,", and", round(x[[2]],1), ", and", round(x[[3]],2)) +#' +#' rcell(list(fit), format = function(x, output) { +#' paste("df:", x[[1]]$df.residual) #' }) #' } -#' } , -#' row_col_data_args = TRUE +#' } #' ) #' tbl +#' +#' rtabulate( +#' x = iris, +#' row_by = fsl5, +#' col_by = iris$Species, +#' FUN = function(x_cell, N) { +#' N +#' }, +#' col_wise_args = list(N = c(10, 100, 200)) +#' ) +#' +#' +#' rtabulate.data.frame <- function(x, - row_by_var = no_by("row_1"), - col_by_var = no_by("col_1"), - FUN = nrow, + row_by, + col_by, + FUN, ..., - row_col_data_args = FALSE, - format = "xx", + format = NULL, indent = 0, - col_total = "(N=xx)") { + col_wise_args = NULL) { - if (!is.no_by(row_by_var) && !is.factor(x[[row_by_var]])) stop("x[[row_by_var]] currently needs to be a factor") - if (!is.no_by(col_by_var) && !is.factor(x[[col_by_var]])) stop("x[[col_by_var]] currently needs to be a factor") + force(FUN) + check_stop_col_by(col_by, col_wise_args) + check_stop_col_by(row_by) - tbl_header <- rtabulate_header(if (is.no_by(col_by_var)) col_by_var else x[[col_by_var]], nrow(x), format=col_total) - - row_data <- if (is.no_by(row_by_var)) { - setNames(list(x), row_by_var) - } else { - split(x, x[[row_by_var]], drop = FALSE) - } - - col_data <- if (is.no_by(col_by_var)) { - setNames(list(x), col_by_var) - } else { - split(x, x[[col_by_var]], drop = FALSE) - } - - cell_data <- if (is.no_by(col_by_var)) { - lapply(row_data, function(row_i) setNames(list(row_i), col_by_var)) + + # list(row1 = list(c1, c2, ...), row2 = list(c1, c2, ...), ...) + cell_data <- if (!is.no_by(row_by) && !is.no_by(col_by)) { + xs <- split(x, row_by, drop = FALSE) + cs <- split(col_by, row_by, drop = FALSE) + setNames(Map(function(xi, col_by_i) split(xi, col_by_i), xs, cs), levels(row_by)) + } else if (is.no_by(row_by) && !is.no_by(col_by)) { + setNames(list(split(x, col_by, drop = FALSE)), row_by) + } else if (!is.no_by(row_by) && is.no_by(col_by)) { + lapply(split(x, row_by, drop = FALSE), function(xi) list(xi)) + } else if (is.no_by(row_by) && is.no_by(col_by)) { + setNames(list(list(x)), row_by) } else { - lapply(row_data, function(row_i) split(row_i, row_i[[col_by_var]], drop = FALSE)) + stop("unexpected col_by & row_by combination") } + - rrow_data <- if (!row_col_data_args) { + cells_by_row <- if (is.null(col_wise_args)) { lapply(cell_data, function(row_i) lapply(row_i, FUN, ...)) } else { - rrow_data_tmp <- lapply(1:length(row_data), function(i) { - rrow_data_i <- lapply(1:length(col_data), function(j) { - FUN(cell_data[[i]][[j]], row_data[[i]], col_data[[j]], ...) - }) - names(rrow_data_i) <- names(col_data) - rrow_data_i + dots <- list(...) + args <- lapply(seq_len(nlevels(col_by)), function(i) c(dots, lapply(col_wise_args, `[[`, i))) + + lapply(cell_data, function(row_i) { + Map(function(xi, argsi) { + do.call(FUN, c(list(xi), argsi)) + }, row_i, args) }) - names(rrow_data_tmp) <- names(row_data) - rrow_data_tmp + } - rrows <- Map(function(row_dat, rowname) { - rrowl(row.name = rowname, row_dat, format = format, indent = indent) - }, rrow_data, names(rrow_data)) + rrows <- Map(function(cells_row, rowname) { + rrowl(row.name = rowname, cells_row, format = format, indent = indent) + }, cells_by_row, names(cells_by_row)) - rtablel(header = tbl_header, rrows) + rtablel(header = levels(col_by), rrows) } +check_stop_col_by <- function(col_by, col_wise_args = NULL) { + if (!is.factor(col_by) && !is.no_by(col_by)) stop("col_by is required to be a factor or no_by object") + if (any(is.na(col_by))) stop("col_by does currently not support any NAs") + + if (!is.null(col_wise_args)) { + if (!is.list(col_wise_args)) + stop("col_wise_args needs to be either a list or NULL") + + if (!all(vapply(col_wise_args, length, numeric(1)) == nlevels(col_by))) + stop("not all elements in col_wise_args have length ", nlevels(col_by)) + } + TRUE +} + + stop_if_has_na <- function(x) { if (any(is.na(x))) stop(paste0(deparse(substitute(x)), " does currently not support any NAs")) } diff --git a/R/sort.R b/R/sort.R new file mode 100644 index 000000000..9391a9ce7 --- /dev/null +++ b/R/sort.R @@ -0,0 +1,215 @@ + + +#' Sort rrows in rtable +#' +#' Return order of rows in rtable based on derived values within each row. +#' +#' @param x rtable object +#' @param indices of column and cell within a row to access value +#' used for sorting. If the column index is 0 then the sum of the cell +#' values across all columns is derived and used for sorting. +#' If \code{indices} is a function then the function argument is +#' rrow object and the user must specify how to extract the information +#' required to sort the rows. See examples. +#' @param ... arguments passed on to \code{\link{order}} +#' +#' @export +#' +#' @return order of rows +#' +#' @seealso \code{\link{sort_rrows}}, \code{\link{order_rtables}}, +#' \code{\link{sort_rtables}} +#' +#' @examples +#' tbl <- rtable( +#' header = c("A", "B"), +#' rrow("r1", c(3,1), c(9,8,19)), +#' rrow("r2", c(4,-1), c(8,9,21)), +#' rrow("r3", c(1,3), c(3,2,22)) +#' ) +#' +#' order_rrows(tbl, c(1,1)) +#' order_rrows(tbl, c(2, 3), decreasing = TRUE) +#' order_rrows(tbl, c(0,2)) +#' +#' order_rrows(tbl, function(row) row[[2]][3] - row[[1]][1]) + +order_rrows <- function(x, indices = c(1, 1), ...) { + + stopifnot(is(x, "rtable")) + + vals <- if (is.atomic(indices)) { + stopifnot(is.numeric(indices)) + stopifnot(length(indices) == 2) + + icol <- indices[1] + icell <- indices[2] + + stopifnot(icell > 0) + stopifnot(icol >= 0) + + if (icol == 0) { + vapply(x, function(row) {sum(vapply(row, `[[`, numeric(1), icell))} , numeric(1)) + } else { + vapply(x, function(row) row[[icol]][[icell]], numeric(1)) + } + } else if (is.function(indices)) { + vapply(x, indices, numeric(1)) + } else { + stop("index is either an atomic vector of a function") + } + order(vals, ...) +} + +#' Sort Rows in rtable +#' +#' Sort rows in rtable based on derived values within each row. +#' +#' @inheritParams order_rrows +#' +#' @return object of class rtable +#' +#' @export +#' +#' @seealso \code{\link{order_rrows}}, \code{\link{order_rtables}}, +#' \code{\link{sort_rtables}} +#' +#' @examples +#' tbl <- rtable( +#' header = c("A", "B"), +#' rrow("r1", c(3,1), c(9,8,19)), +#' rrow("r2", c(4,-1), c(8,9,21)), +#' rrow("r3", c(1,3), c(3,2,22)) +#' ) +#' +#' sort_rrows(tbl, c(1, 1)) +#' sort_rrows(tbl, c(0, 1)) +#' +#' sort_rrows(tbl, c(2, 3), decreasing = FALSE) +#' sort_rrows(tbl, c(2, 3), decreasing = TRUE) +#' +#' sort_rrows(tbl, function(row) row[[2]][3] - row[[1]][1]) +#' +sort_rrows <- function(x, indices = c(1, 1), ...) { + x[order_rrows(x, indices , ...), ] +} + + +#' Order of rtables in a list +#' +#' Return the order of rtables in a list based on values within the tables. +#' +#' @inheritParams sort_rrows +#' @param x a list of rtables +#' @param indices of row, column, and cell to access a value within each rtable that +#' is used for sorting the list \code{x}. If the column index is 0 then a sum of the +#' cell values across all columns within the specified row is taken. If \code{indices} +#' is a function then the function argument is rtable object and the user must +#' specify how to extract the information required to sort \code{x}. See examples. +#' +#' @return order of rtables +#' +#' @export +#' +#' @seealso \code{\link{sort_rtables}}, \code{\link{sort_rrows}}, +#' \code{\link{order_rrows}} +#' +#' @examples +#' +#' tbls <- list( +#' rtable( +#' header = c("A", "B"), +#' rrow("r1", c(4,1), c(9,1,19)), +#' rrow("r2", c(5,-1), c(8,3,21)), +#' rrow("r3", c(1,3), c(3,4,22)) +#' ), +#' rtable( +#' header = c("A", "B"), +#' rrow("r1", c(6,1), c(9,2,19)), +#' rrow("r2", c(5,-1), c(8,4,21)), +#' rrow("r3", c(1,3), c(3,5,22)) +#' ), +#' rtable( +#' header = c("A", "B"), +#' rrow("r1", c(1,1), c(100,0,19)), +#' rrow("r2", c(5,-1), c(8,1,21)), +#' rrow("r3", c(1,3), c(3,1,22)) +#' ) +#' ) +#' +#' order_rtables(tbls, c(1,1,1)) +#' order_rtables(tbls, c(1,1,1), decreasing = TRUE) +#' +#' order_rtables(tbls, c(1,0,1)) +#' +#' order_rtables(tbls, function(tbl) tbl[[1]][[2]][3] - tbl[[1]][[1]][1] ) + +order_rtables <- function(x, indices = c(1,0,1), ...) { + + stopifnot(is.list(x) && are(x, "rtable")) + + vals <- if (is.function(indices)) { + vapply(x, indices, numeric(1)) + } else if (is.atomic(indices) && length(indices) == 3) { + irow <- indices[1] + icol <- indices[2] + icell <- indices[3] + + if (icol == 0) { + vapply(x, function(tbl) {sum(vapply(tbl[[irow]], `[[`, numeric(1), icell))} , numeric(1)) + } else { + vapply(x, function(tbl) tbl[[irow]][[icol]][[icell]], numeric(1)) + } + + } else { + stop("indices needs to be a vector of length 3 or a function") + } + order(vals, ...) +} + +#' Sort rtables within a list +#' +#' Return a sorted list of rtables in a list based on values within the tables. +#' +#' @inheritParams order_rtables +#' +#' @return list of rtables +#' +#' @export +#' +#' @seealso \code{\link{order_rtables}}, \code{\link{sort_rrows}}, +#' \code{\link{order_rrows}} +#' +#' @examples +#' +#' tbls <- list( +#' "Table A" = rtable( +#' header = c("A", "B"), +#' rrow("r1", c(4,1), c(9,1,19)), +#' rrow("r2", c(5,-1), c(8,3,21)), +#' rrow("r3", c(1,3), c(3,4,22)) +#' ), +#' "Table B" = rtable( +#' header = c("A", "B"), +#' rrow("r1", c(6,1), c(9,2,19)), +#' rrow("r2", c(5,-1), c(8,4,21)), +#' rrow("r3", c(1,3), c(3,5,22)) +#' ), +#' "Table C" = rtable( +#' header = c("A", "B"), +#' rrow("r1", c(1,1), c(100,0,19)), +#' rrow("r2", c(5,-1), c(8,1,21)), +#' rrow("r3", c(1,3), c(3,1,22)) +#' ) +#' ) +#' +#' sort_rtables(tbls, c(1,1,1)) +#' sort_rtables(tbls, c(1,1,1), decreasing = TRUE) +#' +#' sort_rtables(tbls, c(1,0,1)) +#' +#' sort_rtables(tbls, function(tbl) tbl[[1]][[2]][3] - tbl[[1]][[1]][1] ) +#' +sort_rtables <- function(x, indices = c(1,0,1), ...) { + x[order_rtables(x, indices , ...)] +} diff --git a/R/utils.R b/R/utils.R index c82d65640..d77272dc0 100644 --- a/R/utils.R +++ b/R/utils.R @@ -3,4 +3,13 @@ ## is each object in a collection from a class are <- function(object_collection, class2) { all(vapply(object_collection, is, logical(1), class2)) -} \ No newline at end of file +} + +num_all_equal <- function(x, tol = .Machine$double.eps ^ 0.5) { + stopifnot(is.numeric(x)) + + if (length(x) == 1) return(TRUE) + + y <- range(x) / mean(x) + isTRUE(all.equal(y[1], y[2], tolerance = tol)) +} diff --git a/README.Rmd b/README.Rmd index ef4b6e1d3..616d67790 100644 --- a/README.Rmd +++ b/README.Rmd @@ -54,7 +54,7 @@ repository and to send us pull requests with the suggested improvements. To install the stable release of `rtables` package run the following command in `R`: ```{r, eval = FALSE} -devtools::install_github("roche/rtables", ref="v0.1.0") +devtools::install_github("roche/rtables", ref="v0.1.1") ``` To install the test version of `rtables` run diff --git a/_pkgdown.yml b/_pkgdown.yml index d50e040c2..d4996660f 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -8,7 +8,7 @@ navbar: href: https://github.com/roche/rtables development: - mode: devel + mode: release reference: - title: Core Table Create Functions @@ -22,27 +22,46 @@ reference: - rrowl - title: Cell Formatting related Functions contents: + - sprintf_format - format_rcell - list_rcell_format_labels - - title: Accessor Functions + - title: Accessor and Modification Functions desc: Access and Modify Functions contents: - starts_with("nam") - starts_with("row.name") - "[.rtable" + - "[.rheader" - dim.rtable - rbind.rtable + - rbindl_rtables + - header + - header<- + - dim.rheader + - header_add_N + - indented_row.names + - unlist.rtable - title: Tabulation Functions desc: rtabulate is a framework to derive rtables contents: - starts_with("rtabulate") - no_by - is.no_by + - levels.no_by + - title: Table sorting functions + desc: funtions to sort rows within tables and list of tables + contents: + - order_rrows + - sort_rrows + - order_rtables + - sort_rtables - title: Output Functions desc: These functions create ascii or html representations of the table contents: - toString.rtable - as_html + - as_html.default + - as_html.rtable - title: Coercion Functions contents: - as.rtable @@ -52,7 +71,4 @@ reference: - Viewer - compare_rtables -articles: - contents: - - rtabulate diff --git a/docs/ISSUE_TEMPLATE.html b/docs/ISSUE_TEMPLATE.html index 51742b506..0e65d1c1c 100644 --- a/docs/ISSUE_TEMPLATE.html +++ b/docs/ISSUE_TEMPLATE.html @@ -1,6 +1,6 @@ - + @@ -9,27 +9,34 @@ Reporting an Issue with rtables • rtables - + - - + + - + - + + + + - + + + + - + + @@ -102,7 +111,7 @@ -
+

Reporting an Issue with rtables

@@ -110,12 +119,12 @@

Reporting an Issue with rtables

-

Please briefly describe your problem and, when relevant, the output you expect. Please also provide the output of utils::sessionInfo() or devtools::session_info() at the end of your post.

+

Please briefly describe your problem and, when relevant, the output you expect. Please also provide the output of utils::sessionInfo() or devtools::session_info() at the end of your post.

If at all possible, please include a minimal, reproducible example. The rtables team will be much more likely to resolve your issue if they are able to reproduce it themselves locally.

Please delete this preamble after you have read it.

your brief description of the problem

-
library(rtables)
+
library(rtables)
 
 # your reproducible example here
@@ -131,12 +140,13 @@

Reporting an Issue with rtables

-

Site built with pkgdown.

+

Site built with pkgdown 1.3.0.

-
+ + diff --git a/docs/LICENSE-text.html b/docs/LICENSE-text.html index 254016255..ba1767eb4 100644 --- a/docs/LICENSE-text.html +++ b/docs/LICENSE-text.html @@ -1,6 +1,6 @@ - + @@ -9,27 +9,34 @@ License • rtables - + - - + + - + - + + + + - + + + + - + +
@@ -102,7 +111,7 @@ -
+

License

@@ -362,12 +371,13 @@

License

-

Site built with pkgdown.

+

Site built with pkgdown 1.3.0.

-
+ + diff --git a/docs/articles/index.html b/docs/articles/index.html index 7e31007ee..c8eae4ff3 100644 --- a/docs/articles/index.html +++ b/docs/articles/index.html @@ -1,6 +1,6 @@ - + @@ -9,27 +9,34 @@ Articles • rtables - + - - + + - + - + + + + - + + + + - + +
@@ -102,12 +111,21 @@ -
-

Articles version 0.1.0

-
-
-
+
+
+

Articles

+
+ +
+

All vignettes

+

+ + +
@@ -117,12 +135,13 @@

Articles version 0.1.0

-

Site built with pkgdown.

+

Site built with pkgdown 1.3.0.

-
+ + diff --git a/docs/articles/rtables.html b/docs/articles/rtables.html index 91aa63584..54030e027 100644 --- a/docs/articles/rtables.html +++ b/docs/articles/rtables.html @@ -1,35 +1,36 @@ - + Introduction to rtables • rtables - - - - + + + + - -
+
-
+

Introduction to rtables

Adrian Waddell

-

2018-03-26

+

2019-02-25

- Source: vignettes/rtables.Rmd + Source: vignettes/rtables.Rmd +
-

Overview

@@ -113,16 +114,16 @@

Simple Example

-
library(rtables)
+
library(rtables)
tbl <- rtable(
-  header = c("Treatement\nN=100", "Comparison\nN=300"),
+  header = c("Treatement\nN=100", "Comparison\nN=300"),
   format = "xx (xx.xx%)",
-  rrow("A", c(104, .2), c(100, .4)),
-  rrow("B", c(23, .4), c(43, .5)),
+  rrow("A", c(104, .2), c(100, .4)),
+  rrow("B", c(23, .4), c(43, .5)),
   rrow(),
   rrow("this is a very long section header"),
   rrow("estimate", rcell(55.23, "xx.xx", colspan = 2)),
-  rrow("95% CI", indent = 1, rcell(c(44.8, 67.4), format = "(xx.x, xx.x)", colspan = 2))
+  rrow("95% CI", indent = 1, rcell(c(44.8, 67.4), format = "(xx.x, xx.x)", colspan = 2))
 )
 
 tbl
@@ -137,7 +138,7 @@

## 95% CI (44.8, 67.4)

Before we go into explaining the individual components used to create this table we continue with the html conversion of the rtable object:

as_html(tbl, width = "80%")
-

+
@@ -203,7 +204,7 @@ 

list_rcell_format_labels()
## $`1d`
 ##  [1] "xx"      "xx."     "xx.x"    "xx.xx"   "xx.xxx"  "xx.xxxx" "xx%"    
-##  [8] "xx.x%"   "xx.xx%"  "xx.xxx%"
+##  [8] "xx.x%"   "xx.xx%"  "xx.xxx%" "(N=xx)"  ">999.9" 
 ## 
 ## $`2d`
 ##  [1] "xx / xx"            "xx. / xx."          "xx.x / xx.x"       
@@ -219,12 +220,12 @@ 

 ## [1] "xx does not modify the element, and xx. rounds a number to 0 digits"

Here is an example of using functions for formatting cells:

my_format <- function(x, output) {
-   paste(x, collapse = "/")
+   paste(x, collapse = "/")
 }
 tbl3 <- rtable(
-  c("A", "B"),
+  c("A", "B"),
   format = my_format,
-  rrow("row1", c(1,2,3,4), letters[1:10])
+  rrow("row1", c(1,2,3,4), letters[1:10])
 )
 tbl3
##                      A                          B         
@@ -235,8 +236,8 @@ 

 

 Comparing two rtables

 
Because we have the original data for each cell accessible for the rtable data structure it is possible to programmatically compare two tables:

-
t1 <- rtable(header = c("A", "B"), format = "xx", rrow("row 1", 1, 2))
-t2 <- rtable(header = c("A", "B", "C"), format = "xx", rrow("row 1", 1, 2, 3))
+
t1 <- rtable(header = c("A", "B"), format = "xx", rrow("row 1", 1, 2))
+t2 <- rtable(header = c("A", "B", "C"), format = "xx", rrow("row 1", 1, 2, 3))
 
 compare_rtables(object = t1, expected = t2) 

 
##   1 2 3
@@ -248,18 +249,17 @@ 

 

 Converting table objects

 
You can also convert table objects to rtables:

-
as.rtable(table(iris$Species))

+
as.rtable(table(iris$Species))

 
##            setosa          versicolor        virginica 
 ## -------------------------------------------------------
 ## 1            50                50                50

 
or

-
print(as.rtable(with(mtcars, table(cyl, hp))), gap = 1)

+
print(as.rtable(with(mtcars, table(cyl, hp))), gap = 1)

 
##   52  62  65  66  91  93  95  97  105 109 110 113 123 150 175 180 205 215 230 245 264 335
 ## -----------------------------------------------------------------------------------------
 ## 4  1   1   1   2   1   1   1   1   0   1   0   1   0   0   0   0   0   0   0   0   0   0 
 ## 6  0   0   0   0   0   0   0   0   1   0   3   0   2   0   1   0   0   0   0   0   0   0 
 ## 8  0   0   0   0   0   0   0   0   0   0   0   0   0   2   2   3   1   1   1   2   1   1

-

 
   
 
@@ -286,11 +286,12 @@ 

 
 
 

-  
Site built with pkgdown.

+  
Site built with pkgdown 1.3.0.

 

-
       
 
 
+  
+
   
 
diff --git a/docs/articles/rtabulate.html b/docs/articles/rtabulate.html
index f062c4b36..ea6699c0d 100644
--- a/docs/articles/rtabulate.html
+++ b/docs/articles/rtabulate.html
@@ -1,35 +1,36 @@
 
-
+
 
 
 
 
 
 rtabulate • rtables
-
-
-
-
+
+
+
+
 
 
-
 
 
-    

+    

       

-  

+  

     

       
rtabulate

                         
Adrian Waddell

             
             
3/21/2018

       
-      Source: vignettes/rtabulate.Rmd
+      Source: vignettes/rtabulate.Rmd
+      
 
     

 
     
     
-

 

 

 Introduction

-
rtabulate provides a number of methods to compute rtable tables. The idea behind rtabulate is to have a similar function to tapply which returns rtables instead of lists. For example, for the iris data we might be interested in the average Sepal.Length for each Species which can be answered with tapply as follows:

-
attach(iris)
-tapply(X = Sepal.Length, INDEX = Species, FUN = mean)

+
rtabulate provides a number of methods to compute rtable tables. The idea behind rtabulate is to have a similar function to tapply which returns rtables instead of lists or vectors. For example, for the iris data we might be interested in the average Sepal.Length for each Species which can be answered with tapply as follows:

+
attach(iris)
+tapply(X = Sepal.Length, INDEX = Species, FUN = mean)

 
##     setosa versicolor  virginica 
 ##      5.006      5.936      6.588

 
and to get the same numbers with rtabulate we can run

@@ -122,7 +123,7 @@ 

 
  • split x by col_by
 
    • 
 
-
    x_s <- split(x, col_by)
    
+
    x_s <- split(x, col_by)
    
 
      
 
    1. apply the function FUN to each element, e.g. FUN(x_s[[1]]), FUN(x_s[[2]]), etc…, which either should return an rcell or a data structure that gets wrapped into an rcell
      2. 
 
    2. combine the rcells to an rrow and create an rtable with a header according to the levels of col_by
      3. 
@@ -148,12 +149,12 @@ 
      
 
      
 Tabulating Boolean Data
      
 
      Like rtabulate.numeric, rtabulate.logical returns an rtable with one row and columns according to the levels of col_by.
      
-
      is_SL_below_avg <- Sepal.Length < mean(Sepal.Length)
+
      is_SL_below_avg <- Sepal.Length < mean(Sepal.Length)
 
 rtabulate(x = is_SL_below_avg, col_by = Species, row.name = "count (percentage)")
      
 
      ##                             setosa          versicolor        virginica 
 ## ------------------------------------------------------------------------
-## count (percentage)        50 (100%)          24 (48%)          6 (12%)
      
+## count (percentage)            50                24                6
      
 
      By default FUN=function(x) sum(x) * c(1, 1/length(x)).
      
 
      
 
      
@@ -173,8 +174,8 @@ 
      
 
      
 
      
 Tabulation based on Data Frames
      
-
      rtabulate.data.frame has a data.frame as x argument and the col_by_var and row_by_var need to specify which factor variables with x should be used to split the data for the table rows and columns. By default the argument to FUN is then a subset of x that is associated with a particular table cell. Let’s look at the CO2 dataset:
      
-
      head(CO2)
      
+
      rtabulate.data.frame has a data.frame as x argument and the col_by and row_by need to specify how to split the data for the table rows and columns. The argument to FUN is then a subset of x that is associated with a particular table cell. Let’s look at the CO2 dataset:
      
+
      head(CO2)
      
 
      ##   Plant   Type  Treatment conc uptake
 ## 1   Qn1 Quebec nonchilled   95   16.0
 ## 2   Qn1 Quebec nonchilled  175   30.4
@@ -183,49 +184,44 @@ 
      
 ## 5   Qn1 Quebec nonchilled  500   35.3
 ## 6   Qn1 Quebec nonchilled  675   39.2
      
 
      Say we want to calculate the total uptake for each Type and Treatment
      
-
      rtabulate(x = CO2, row_by_var = "Type", col_by_var = "Treatment",
-          FUN = function(xi) sum(xi$uptake))
      
+
      rtabulate(x = CO2, row_by = CO2$Type, col_by = CO2$Treatment,
+          FUN = function(xi) sum(xi$uptake))
      
 
      ##                    nonchilled         chilled  
 ## -----------------------------------------------
 ## Quebec                742              666.8   
 ## Mississippi           545              332.1
      
 
      
 
      
-
      
+
      
 
      
-Cell Data, Row Data, Column Data based Tabulation
      
-
      rtabulate.numeric and rtabulate.logical have the argument row_data_arg which is by default set to FALSE. If set to TRUE then FUN receives a second argument with a copy of the x argument (as the row-associated data is the whole data for a numeric and logical vector).
      
-
      rtabulate(
-  Sepal.Length, Species,
-  FUN = function(x_cell, x_row) c(length(x_cell), length(x_row)),
-  row_data_arg = TRUE,
-  format = "xx / xx", 
-  row.name = "length of cell and row data"
-)
      
-
      ##                                      setosa          versicolor        virginica 
-## ---------------------------------------------------------------------------------
-## length of cell and row data         50 / 150          50 / 150          50 / 150
      
-
      Next, for rtabulate.factor and rtabulate.data.frame there is an row_col_data_args which when set to TRUE then the FUN function receives three arguments, the data that is associated with a table cell, row, column, respectively.
      
-
      mtcars2 <- mtcars
-mtcars2$gear <- factor(mtcars2$gear)
-mtcars2$carb <- factor(mtcars2$carb)
+Column Wise Arguments
    
+
    The arguments passed to the elipsis ... in rtabulate are optional arguments to FUN. This is the same behaviour as for the arguments passed to ... in lapply and tapply. This is useful, for example, when passing the na.rm argument to mean
    
+
    x <- c(1, 2, 3, NA, 3, 2)
+cb <- factor(c("A", "B", "A", "B", "B", "A"))
 
-rtabulate(
-  x = mtcars2, row_by_var = "carb", col_by_var = "gear",
-  FUN = function(x_cell, x_row, x_col) c(nrow(x_cell), nrow(x_row), nrow(x_col)),
-  row_col_data_args = TRUE,
-  format = NULL
-)
    
-
    ##              3                4                5    
-## ----------------------------------------------------
-## 1        3, 7, 15         4, 7, 12          0, 7, 5 
-## 2        4, 10, 15        4, 10, 12        2, 10, 5 
-## 3        3, 3, 15         0, 3, 12          0, 3, 5 
-## 4        5, 10, 15        4, 10, 12        1, 10, 5 
-## 6        0, 1, 15         0, 1, 12          1, 1, 5 
-## 8        0, 1, 15         0, 1, 12          1, 1, 5
    
-
    Note that format=NULL is equivalent to paste(x, collapse = ", ") on the cell data structure.
    
-
    
+rtabulate(x, cb, mean, na.rm = TRUE)
    +
    ##              A          B 
+## --------------------------
+## mean         2         2.5
    +

    Often, howewer, it is also useful to iterate over multiple collections as for example is the case with the ... in mapply and Map. That is, given a collection x and y with each p elements, then we would like to evaluate FUN(x[i], y[i]) for i in 1 to p. In rtabulate this can be achieved with the collections wrapped in a named list and passed to the col_wise_args. For example:

    +
    x <- c(1, 2, 3, NA, 3, 2)
+cb <- factor(c("A", "A", "A", "B", "B", "A"), levels = c("A", "B"))
+
+tbl <- rtabulate(x, cb, FUN = function(xi, na.rm, N) {
+  list(mean(xi, na.rm=na.rm), N)
+}, na.rm = TRUE, col_wise_args = list(N = table(cb)), row.name = "mean, N")
+
+tbl
    +
    ##                 A           B  
+## -------------------------------
+## mean, N        2, 4        3, 2
    +

    Note that format=NULL is equivalent to paste(x, collapse = ", ") on the cell data structure.

    +

    In order to add a (N=xx) type of row to the header we can add header_add_N function:

    +
    header_add_N(tbl, table(cb))
    +
    ##                  A            B  
+##                (N=4)        (N=2)
+## ---------------------------------
+## mean, N        2, 4         3, 2
    @@ -249,11 +245,12 @@

    -

    Site built with pkgdown.

    +

    Site built with pkgdown 1.3.0.

    - + + diff --git a/docs/authors.html b/docs/authors.html index 32d9515a4..eedc0911f 100644 --- a/docs/authors.html +++ b/docs/authors.html @@ -1,6 +1,6 @@ - + @@ -9,27 +9,34 @@ Authors • rtables - + - - + + - + - + + + + - + + + + - + + @@ -102,8 +111,8 @@ -
    -
    +
    +

    Authors

    @@ -126,12 +135,13 @@

    Authors

    -

    Site built with pkgdown.

    +

    Site built with pkgdown 1.3.0.

    -
    + + diff --git a/docs/dev/ISSUE_TEMPLATE.html b/docs/dev/ISSUE_TEMPLATE.html index 5a3c8edd6..6c493a19d 100644 --- a/docs/dev/ISSUE_TEMPLATE.html +++ b/docs/dev/ISSUE_TEMPLATE.html @@ -1,6 +1,6 @@ - + @@ -9,17 +9,17 @@ Reporting an Issue with rtables • rtables - + - - + + - + - + @@ -35,7 +35,8 @@ - + + - + @@ -9,17 +9,17 @@ License • rtables - + - - + + - + - + @@ -35,7 +35,8 @@ - + + - + @@ -9,17 +9,17 @@ Articles • rtables - + - - + + - + - + @@ -35,7 +35,8 @@ - + + + Introduction to rtables • rtables - - - + + + - @@ -23,14 +23,15 @@
    @@ -105,16 +114,19 @@ -
    +

    Check if object inherits from the no_by Class

    - Source: R/rtabulate.R + Source: R/rtabulate.R +
    +

    Functions to test inheritance on no_by

    + 
    is.no_by(x)
    @@ -150,12 +162,13 @@

    Contents

    -

    Site built with pkgdown.

    +

    Site built with pkgdown 1.3.0.

    -
    + + diff --git a/docs/reference/levels.no_by.html b/docs/reference/levels.no_by.html new file mode 100644 index 000000000..f1c22b587 --- /dev/null +++ b/docs/reference/levels.no_by.html @@ -0,0 +1,169 @@ + + + + + + + + +Access levels attribute for an object of <code>no_by</code> Class — levels.no_by • rtables + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    +
    + + + +
    + +
    +
    +
    +

    Access levels attribute for an object of no_by Class

    + Source: R/rtabulate.R + +
    + +
    + +

    Access levels attribute for an object of no_by Class

    + +
    + + 
    # S3 method for no_by
+levels(x)
    + +

    Arguments

    + + + + + + +
    x

    no_by class object

    + + +
    + +
    + +
    +
    +

    Developed by Adrian Waddell.

    +
    + +
    +

    Site built with pkgdown 1.3.0.

    +
    +
    +
    + + + + + + diff --git a/docs/reference/list_rcell_format_labels.html b/docs/reference/list_rcell_format_labels.html index c25555c11..7d7674fdd 100644 --- a/docs/reference/list_rcell_format_labels.html +++ b/docs/reference/list_rcell_format_labels.html @@ -1,6 +1,6 @@ - + @@ -9,22 +9,27 @@ List with valid <code><a href='rcell.html'>rcell</a></code> formats labels grouped by 1d and 2d — list_rcell_format_labels • rtables - + - - + + - + - + + + + - + + + + - + +
    @@ -106,17 +115,20 @@ -
    +

    List with valid rcell formats labels grouped by 1d and 2d

    - Source: R/format_rcell.R + Source: R/format_rcell.R +
    +

    Currently valid format lables can not be added dynamically. Format functions must be used for special cases

    + 
    list_rcell_format_labels()
    @@ -125,7 +137,7 @@

    Examp 
    
 list_rcell_format_labels()
    #> $`1d`
 #>  [1] "xx"      "xx."     "xx.x"    "xx.xx"   "xx.xxx"  "xx.xxxx" "xx%"    
-#>  [8] "xx.x%"   "xx.xx%"  "xx.xxx%"
+#>  [8] "xx.x%"   "xx.xx%"  "xx.xxx%" "(N=xx)"  ">999.9" 
 #> 
 #> $`2d`
 #>  [1] "xx / xx"            "xx. / xx."          "xx.x / xx.x"       
@@ -157,12 +169,13 @@ 
    Contents
    
 
    
 
 
    
-  
    Site built with pkgdown.
    
+  
    Site built with pkgdown 1.3.0.
    
 
    
-

    + + diff --git a/docs/reference/names.rtable.html b/docs/reference/names.rtable.html index 40dddcb7f..bdca547e4 100644 --- a/docs/reference/names.rtable.html +++ b/docs/reference/names.rtable.html @@ -1,6 +1,6 @@ - + @@ -9,30 +9,37 @@ Get column names of an <code><a href='rtable.html'>rtable</a></code> object — names.rtable • rtables - + - - + + - + - + + + + - + + + + - + +
    @@ -105,19 +114,22 @@ -
    +

    Get column names of an rtable object

    - Source: R/accessors_modifiers.R + Source: R/accessors_modifiers.R +
    +

    Retrieve the column names of an rtable object

    + 
    # S3 method for rtable
-names(x)
    +names(x)

    Arguments

    @@ -151,12 +163,13 @@

    Contents

    -

    Site built with pkgdown.

    +

    Site built with pkgdown 1.3.0.

    - + + diff --git a/docs/reference/no_by.html b/docs/reference/no_by.html index c1182013e..4e4c8d72d 100644 --- a/docs/reference/no_by.html +++ b/docs/reference/no_by.html @@ -1,40 +1,48 @@ - + -Do not split data into columns or row in <code>rtabulate</code> — no_by • rtables +Do not split data into columns in <code>rtabulate</code> — no_by • rtables - + - - + + - + - + + + + - - - + + +of no_by. Using no_by creates a table with a single +column." /> + - + + @@ -107,18 +117,22 @@ -
    +
    -

    Do not split data into columns or row in rtabulate

    - Source: R/rtabulate.R +

    Do not split data into columns in rtabulate

    + Source: R/rtabulate.R +
    +
    -

    rtabulate has the arguments col_by and row_by +

    rtabulate has the argument col_by which can either take a vector or if no splitting is needed the return value -of no_by.

    +of no_by. Using no_by creates a table with a single +column.

    + 
    no_by(name)
    @@ -127,17 +141,26 @@

    Arg

    - +
    name

    row name or column name

    character column name to display in the table header
    +

    Examples

    + 
    
+rtabulate(iris$Species, col_by = no_by("Total"))
    #>                   Total
+#> -----------------------
+#> setosa             50  
+#> versicolor         50  
+#> virginica          50
    @@ -148,12 +171,13 @@

    Contents

    -

    Site built with pkgdown.

    +

    Site built with pkgdown 1.3.0.

    - + + diff --git a/docs/reference/order_rrows.html b/docs/reference/order_rrows.html new file mode 100644 index 000000000..04155469b --- /dev/null +++ b/docs/reference/order_rrows.html @@ -0,0 +1,206 @@ + + + + + + + + +Sort rrows in rtable — order_rrows • rtables + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    +
    + + + +
    + +
    +
    +
    +

    Sort rrows in rtable

    + Source: R/sort.R + +
    + +
    + +

    Return order of rows in rtable based on derived values within each row.

    + +
    + + 
    order_rrows(x, indices = c(1, 1), ...)
    + +

    Arguments

    + + + + + + + + + + + + + + +
    x

    rtable object

    indices

    of column and cell within a row to access value +used for sorting. If the column index is 0 then the sum of the cell +values across all columns is derived and used for sorting. +If indices is a function then the function argument is +rrow object and the user must specify how to extract the information +required to sort the rows. See examples.

    ...

    arguments passed on to order

    + +

    Value

    + +

    order of rows

    + +

    See also

    + +

    sort_rrows, order_rtables, + sort_rtables

    + + +

    Examples

    + 
    tbl <- rtable(
+  header = c("A", "B"),
+  rrow("r1", c(3,1), c(9,8,19)),
+  rrow("r2", c(4,-1), c(8,9,21)),
+  rrow("r3", c(1,3), c(3,2,22))
+)
+
+order_rrows(tbl, c(1,1))
    #> [1] 3 1 2
    order_rrows(tbl, c(2, 3), decreasing = TRUE)
    #> [1] 3 2 1
    order_rrows(tbl, c(0,2))
    #> [1] 3 2 1
    
+order_rrows(tbl, function(row) row[[2]][3] - row[[1]][1])
    #> [1] 1 2 3
    +
    + +
    + +
    +
    +

    Developed by Adrian Waddell.

    +
    + +
    +

    Site built with pkgdown 1.3.0.

    +
    +
    +
    + + + + + + diff --git a/docs/reference/order_rtables.html b/docs/reference/order_rtables.html new file mode 100644 index 000000000..b125a72b5 --- /dev/null +++ b/docs/reference/order_rtables.html @@ -0,0 +1,221 @@ + + + + + + + + +Order of rtables in a list — order_rtables • rtables + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    +
    + + + +
    + +
    +
    +
    +

    Order of rtables in a list

    + Source: R/sort.R + +
    + +
    + +

    Return the order of rtables in a list based on values within the tables.

    + +
    + + 
    order_rtables(x, indices = c(1, 0, 1), ...)
    + +

    Arguments

    + + + + + + + + + + + + + + +
    x

    a list of rtables

    indices

    of row, column, and cell to access a value within each rtable that +is used for sorting the list x. If the column index is 0 then a sum of the +cell values across all columns within the specified row is taken. If indices +is a function then the function argument is rtable object and the user must +specify how to extract the information required to sort x. See examples.

    ...

    arguments passed on to order

    + +

    Value

    + +

    order of rtables

    + +

    See also

    + +

    sort_rtables, sort_rrows, + order_rrows

    + + +

    Examples

    + 
    
+tbls <- list(
+   rtable(
+     header = c("A", "B"),
+     rrow("r1", c(4,1), c(9,1,19)),
+     rrow("r2", c(5,-1), c(8,3,21)),
+     rrow("r3", c(1,3), c(3,4,22))
+   ),
+   rtable(
+     header = c("A", "B"),
+     rrow("r1", c(6,1), c(9,2,19)),
+     rrow("r2", c(5,-1), c(8,4,21)),
+     rrow("r3", c(1,3), c(3,5,22))
+   ),
+   rtable(
+     header = c("A", "B"),
+     rrow("r1", c(1,1), c(100,0,19)),
+     rrow("r2", c(5,-1), c(8,1,21)),
+     rrow("r3", c(1,3), c(3,1,22))
+   )
+)
+
+order_rtables(tbls, c(1,1,1))
    #> [1] 3 1 2
    order_rtables(tbls, c(1,1,1), decreasing = TRUE)
    #> [1] 2 1 3
    
+order_rtables(tbls, c(1,0,1))
    #> [1] 1 2 3
    
+order_rtables(tbls, function(tbl) tbl[[1]][[2]][3] - tbl[[1]][[1]][1]  )
    #> [1] 2 1 3
    +
    + +
    + +
    +
    +

    Developed by Adrian Waddell.

    +
    + +
    +

    Site built with pkgdown 1.3.0.

    +
    +
    +
    + + + + + + diff --git a/docs/reference/rbind.rtable.html b/docs/reference/rbind.rtable.html index 1bc9d8b06..ab53d480f 100644 --- a/docs/reference/rbind.rtable.html +++ b/docs/reference/rbind.rtable.html @@ -1,38 +1,46 @@ - + -stack rtable objects — rbind.rtable • rtables +Stack rtable objects — rbind.rtable • rtables - + - - + + - + - + + + + - - - + + + + + + - + + @@ -105,19 +115,23 @@ -
    +
    -

    stack rtable objects

    - Source: R/accessors_modifiers.R +

    Stack rtable objects

    + Source: R/rbind.R +
    +
    -

    stack rtable objects

    +

    Note that the columns order are not mached by the header: the first table +header is taken as the reference.

    + 
    # S3 method for rtable
-rbind(...)
    +rbind(..., gap = 0)

    Arguments

    @@ -126,6 +140,10 @@

    Arg

    + + + +
    ...

    rtable objects
    gap

    number of empty rows to add between tables

    Value

    @@ -142,31 +160,45 @@

    Examp ), rrow( row.name = "All Species", - mean(iris$Sepal.Length), median(iris$Sepal.Length), - mean(iris$Petal.Length), median(iris$Petal.Length), + mean(iris$Sepal.Length), median(iris$Sepal.Length), + mean(iris$Petal.Length), median(iris$Petal.Length), format = "xx.xx" ) ) -mtbl2 <- with(subset(iris, Species == 'setosa'), rtable( +mtbl2 <- with(subset(iris, Species == 'setosa'), rtable( header = rheader( rrow(row.name = NULL, rcell("Sepal.Length", colspan = 2), rcell("Petal.Length", colspan=2)), rrow(NULL, "mean", "median", "mean", "median") ), rrow( row.name = "Setosa", - mean(Sepal.Length), median(Sepal.Length), - mean(Petal.Length), median(Petal.Length), + mean(Sepal.Length), median(Sepal.Length), + mean(Petal.Length), median(Petal.Length), format = "xx.xx" ) )) -tbl <- rbind(mtbl, mtbl2) - +tbl <- rbind(mtbl, mtbl2) +tbl

    #> Sepal.Length Petal.Length +#> mean median mean median +#> ------------------------------------------------------------------- +#> All Species 5.84 5.8 3.76 4.35 +#> Setosa 5.01 5 1.46 1.5
    +tbl <- rbind(mtbl, mtbl2, gap = 1) tbl
    #> Sepal.Length Petal.Length #> mean median mean median #> ------------------------------------------------------------------- #> All Species 5.84 5.8 3.76 4.35 +#> +#> Setosa 5.01 5 1.46 1.5
    +tbl <- rbind(mtbl, mtbl2, gap = 2) +tbl
    #> Sepal.Length Petal.Length +#> mean median mean median +#> ------------------------------------------------------------------- +#> All Species 5.84 5.8 3.76 4.35 +#> +#> #> Setosa 5.01 5 1.46 1.5
    @@ -189,12 +221,13 @@

    Contents

    -

    Site built with pkgdown.

    +

    Site built with pkgdown 1.3.0.

    - + + diff --git a/docs/reference/rbindl_rtables.html b/docs/reference/rbindl_rtables.html new file mode 100644 index 000000000..a4221e07d --- /dev/null +++ b/docs/reference/rbindl_rtables.html @@ -0,0 +1,172 @@ + + + + + + + + +Stack a list of rtables — rbindl_rtables • rtables + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    +
    + + + +
    + +
    +
    +
    +

    Stack a list of rtables

    + Source: R/rbind.R + +
    + +
    + +

    See rbind.rtable for details

    + +
    + + 
    rbindl_rtables(x, gap = 0)
    + +

    Arguments

    + + + + + + + + + + +
    x

    a list of rtable objects

    gap

    number of empty rows to add between tables

    + + +
    + +
    + +
    +
    +

    Developed by Adrian Waddell.

    +
    + +
    +

    Site built with pkgdown 1.3.0.

    +
    +
    +
    + + + + + + diff --git a/docs/reference/rcell.html b/docs/reference/rcell.html index 543c78c8d..54e332e11 100644 --- a/docs/reference/rcell.html +++ b/docs/reference/rcell.html @@ -1,6 +1,6 @@ - + @@ -9,22 +9,27 @@ Reporting Table Cell — rcell • rtables - + - - + + - + - + + + + - + + + + - + + @@ -106,17 +115,20 @@ -
    +

    Reporting Table Cell

    - Source: R/rtable.R + Source: R/rtable.R +
    +

    rcells compose an rtable. An rcell contains the encapsulated data object, a format and column span attributes.

    + 
    rcell(x, format = NULL, colspan = 1)
    @@ -165,12 +177,13 @@

    Contents

    -

    Site built with pkgdown.

    +

    Site built with pkgdown 1.3.0.

    -
    + + diff --git a/docs/reference/rheader.html b/docs/reference/rheader.html index 77e47d757..36c04041a 100644 --- a/docs/reference/rheader.html +++ b/docs/reference/rheader.html @@ -1,6 +1,6 @@ - + @@ -9,30 +9,37 @@ Create a rheader object — rheader • rtables - + - - + + - + - + + + + - + + + + - + +
    @@ -105,16 +114,19 @@ -
    +

    Create a rheader object

    - Source: R/rtable.R + Source: R/rtable.R +
    +

    Create a rheader object

    + 
    rheader(..., format = "xx")
    @@ -133,7 +145,7 @@

    Arg

    Examples

    - 
    h1 <- rheader(c("A", "B", "C"))
+    
    h1 <- rheader(c("A", "B", "C"))
 h2 <- rheader(
   rrow(NULL, rcell("group 1", colspan = 2), rcell("group 2", colspan = 2)),
   rrow(NULL, "A", "B", "A", "B")
@@ -156,12 +168,13 @@ 
    Contents
    
 
    
 
 
    
-  
    Site built with pkgdown.
    
+  
    Site built with pkgdown 1.3.0.
    
 
    
-
       
    
    
 
+  
+
   
 
 
diff --git a/docs/reference/row.names-set-.rtable.html b/docs/reference/row.names-set-.rtable.html
index b20fb2779..62363781c 100644
--- a/docs/reference/row.names-set-.rtable.html
+++ b/docs/reference/row.names-set-.rtable.html
@@ -1,6 +1,6 @@
 
 
-
+
   
   
 
@@ -9,30 +9,37 @@
 change row names of rtable — row.names<-.rtable • rtables
 
 
-
+
 
 
-
-
+
+
 
 
-
+
 
 
-
+
+
+
+
 
 
 
-
 
+
+
+
 
 
 
 
 
 
+
 
-
+
+
    @@ -105,19 +114,22 @@ -
    +

    change row names of rtable

    - Source: R/accessors_modifiers.R + Source: R/accessors_modifiers.R +
    +

    change row names of rtable

    + 
    # S3 method for rtable
-row.names(x) <- value
    +row.names(x) <- value

    Arguments

    @@ -135,10 +147,10 @@

    Arg

    Examples

    
-tbl <- rtable(header = c("A", "B"), rrow("row 1", 1, 2))
+tbl <- rtable(header = c("A", "B"), rrow("row 1", 1, 2))
 tbl
    #>              A        B
 #> -----------------------
-#> row 1        1        2
    row.names(tbl) <- "Changed Row Name"
+#> row 1        1        2
    row.names(tbl) <- "Changed Row Name"
 tbl
    #>                         A        B
 #> ----------------------------------
 #> Changed Row Name        1        2
    @@ -160,12 +172,13 @@

    Contents

    -

    Site built with pkgdown.

    +

    Site built with pkgdown 1.3.0.

    - + + diff --git a/docs/reference/row.names.rheader.html b/docs/reference/row.names.rheader.html index 538cfa7c4..0811113c2 100644 --- a/docs/reference/row.names.rheader.html +++ b/docs/reference/row.names.rheader.html @@ -1,6 +1,6 @@ - + @@ -9,30 +9,37 @@ Row names of an <code><a href='rheader.html'>rheader</a></code> object — row.names.rheader • rtables - + - - + + - + - + + + + - + + + + - + + @@ -105,19 +114,22 @@ -
    +

    Row names of an rheader object

    - Source: R/accessors_modifiers.R + Source: R/accessors_modifiers.R +
    +

    Retrieve the row names of an rheader object

    + 
    # S3 method for rheader
-row.names(x)
    +row.names(x)

    Arguments

    @@ -151,12 +163,13 @@

    Contents

    -

    Site built with pkgdown.

    +

    Site built with pkgdown 1.3.0.

    - + + diff --git a/docs/reference/row.names.rtable.html b/docs/reference/row.names.rtable.html index ee7219e2b..d943369df 100644 --- a/docs/reference/row.names.rtable.html +++ b/docs/reference/row.names.rtable.html @@ -1,6 +1,6 @@ - + @@ -9,30 +9,37 @@ Row names of an <code><a href='rtable.html'>rtable</a></code> object — row.names.rtable • rtables - + - - + + - + - + + + + - + + + + - + + @@ -105,19 +114,22 @@ -
    +

    Row names of an rtable object

    - Source: R/accessors_modifiers.R + Source: R/accessors_modifiers.R +
    +

    Retrieve the row names of an rtable object

    + 
    # S3 method for rtable
-row.names(x)
    +row.names(x)

    Arguments

    @@ -151,12 +163,13 @@

    Contents

    -

    Site built with pkgdown.

    +

    Site built with pkgdown 1.3.0.

    - + + diff --git a/docs/reference/rrow.html b/docs/reference/rrow.html index fe2b88bea..ff3309d31 100644 --- a/docs/reference/rrow.html +++ b/docs/reference/rrow.html @@ -1,6 +1,6 @@ - + @@ -9,30 +9,37 @@ Reporting Table Row — rrow • rtables - + - - + + - + - + + + + - + + + + - + + @@ -105,16 +114,19 @@ -
    +

    Reporting Table Row

    - Source: R/rtable.R + Source: R/rtable.R +
    +

    Defines a row for an rtable

    + 
    rrow(row.name, ..., format = NULL, indent = 0)
    @@ -151,7 +163,7 @@

    Details

    Examples

    
-rrow("ABC", c(1,2), c(3,2), format = "xx (xx.%)")
    #> ABC        1 (200%)        3 (200%)
    
+rrow("ABC", c(1,2), c(3,2), format = "xx (xx.%)")
    #> ABC        1 (200%)        3 (200%)
    -

    Site built with pkgdown.

    +

    Site built with pkgdown 1.3.0.

    -
    + + diff --git a/docs/reference/rrowl.html b/docs/reference/rrowl.html index 2ee012c2f..b3c879ab9 100644 --- a/docs/reference/rrowl.html +++ b/docs/reference/rrowl.html @@ -1,6 +1,6 @@ - + @@ -9,22 +9,27 @@ Create an rrow with cell-data stored within lists — rrowl • rtables - + - - + + - + - + + + + - + + + + - + +
    @@ -106,19 +115,22 @@ -
    +

    Create an rrow with cell-data stored within lists

    - Source: R/rtable.R + Source: R/rtable.R +
    +

    The apply function family returns lists whose elements can be used as cell data with the lrow function.

    +
    - 
    rrowl(row.name, ...)
    + 
    rrowl(row.name, ..., format = NULL, indent = 0)

    Arguments

    @@ -131,16 +143,31 @@

    Arg

    + + + + + + + +
    ...

    lists that get concatenated and then flattened by one level of depth. If one elemenet is not a list then it gets placed into a list.

    format

    a valid format string or a format function for +rcells. To get a list of all valid format strings use +list_rcell_format_labels. If format is NULL then the elements +of a cell get pasted separated by a comma.

    indent

    non-negative integer where 0 means that the row should not be +indented

    Examples

    
-x <- tapply(iris$Sepal.Length, iris$Species, mean, simplify = FALSE)
+rrowl("a", c(1,2,3), format = "xx")
    #> a        1        2        3
    rrowl("a", c(1,2,3), c(4,5,6), format = "xx")
    #> a        1        2        3        4        5        6
    
+
+rrowl("N", table(iris$Species))
    #> N        50        50        50
    rrowl("N", table(iris$Species), format = "xx")
    #> N        50        50        50
    
+x <- tapply(iris$Sepal.Length, iris$Species, mean, simplify = FALSE)
 
 rrow(row.name = "row 1", x)
    #> row 1        5.006, 5.936, 6.588
    rrow("ABC", 2, 3)
    #> ABC        2        3
    
-rrowl(row.name = "row 1", c(1, 2), c(3,4))
    #> row 1        1        2        3        4
    rrow(row.name = "row 2", c(1, 2), c(3,4))
    #> row 2        1, 2        3, 4
    
+rrowl(row.name = "row 1", c(1, 2), c(3,4))
    #> row 1        1        2        3        4
    rrow(row.name = "row 2", c(1, 2), c(3,4))
    #> row 2        1, 2        3, 4
    -

    Site built with pkgdown.

    +

    Site built with pkgdown 1.3.0.

    -
    + + diff --git a/docs/reference/rtable.html b/docs/reference/rtable.html index de297dcef..ef821b755 100644 --- a/docs/reference/rtable.html +++ b/docs/reference/rtable.html @@ -1,6 +1,6 @@ - + @@ -9,22 +9,27 @@ Create a Reporting Table — rtable • rtables - + - - + + - + - + + + + - + + + + - + +
    @@ -106,17 +115,20 @@ -
    +

    Create a Reporting Table

    - Source: R/rtable.R + Source: R/rtable.R +
    +

    Reporting tables allow multiple values per cell, cell formatting and merging cells. Currently an rtable can be converted to html and ascii.

    + 
    rtable(header, ..., format = NULL)
    @@ -149,7 +161,7 @@

    Value

    Details

    Rtable objects can be currently exported to text with -toString and to html with as_html. In +toString and to html with as_html. In future we would plan to add the as_latex and as_gridGrob outputting function.

    Note that the formats propagate to the rrow and @@ -157,7 +169,7 @@

    Details

    See also

    -

    rrow, rcell

    +

    rrow, rcell

    Examples

    @@ -170,8 +182,8 @@

    Examp ), rrow( row.name = "All Species", - mean(iris$Sepal.Length), median(iris$Sepal.Length), - mean(iris$Petal.Length), median(iris$Petal.Length), + mean(iris$Sepal.Length), median(iris$Sepal.Length), + mean(iris$Petal.Length), median(iris$Petal.Length), format = "xx.xx" ) ) @@ -180,18 +192,18 @@

    Examp #> mean median mean median #> ------------------------------------------------------------------- #> All Species 5.84 5.8 3.76 4.35

    -names(mtbl) # always first row of header
    #> [1] "Sepal.Length" "Sepal.Length" "Petal.Length" "Petal.Length"
    +names(mtbl) # always first row of header
    #> [1] "Sepal.Length" "Sepal.Length" "Petal.Length" "Petal.Length"
    # Single row header tbl <- rtable( - header = c("Treatement\nN=100", "Comparison\nN=300"), + header = c("Treatement\nN=100", "Comparison\nN=300"), format = "xx (xx.xx%)", - rrow("A", c(104, .2), c(100, .4)), - rrow("B", c(23, .4), c(43, .5)), + rrow("A", c(104, .2), c(100, .4)), + rrow("B", c(23, .4), c(43, .5)), rrow(), rrow("this is a very long section header"), rrow("estimate", rcell(55.23, "xx.xx", colspan = 2)), - rrow("95% CI", indent = 1, rcell(c(44.8, 67.4), format = "(xx.x, xx.x)", colspan = 2)) + rrow("95% CI", indent = 1, rcell(c(44.8, 67.4), format = "(xx.x, xx.x)", colspan = 2)) ) tbl
    #> Treatement Comparison @@ -203,9 +215,9 @@

    Examp #> this is a very long section header #> estimate 55.23 #> 95% CI (44.8, 67.4)

    -row.names(tbl)
    #> [1] "A" "B" +row.names(tbl)
    #> [1] "A" "B" #> [3] "" "this is a very long section header" -#> [5] "estimate" "95% CI"
    names(tbl)
    #> [1] "Treatement\nN=100" "Comparison\nN=300"
    +#> [5] "estimate" "95% CI"
    names(tbl)
    #> [1] "Treatement\nN=100" "Comparison\nN=300"
    # Subsetting tbl[1,2]
    #> 100 (40%)
    tbl[3,2]
    #> NULL
    tbl[5,1]
    #> 55.23
    tbl[5,2]
    #> 55.23
    tbl[1:3]
    #> Treatement Comparison @@ -216,7 +228,7 @@

    Examp #>

    # Data Structure methods -dim(tbl)
    #> [1] 6 2
    nrow(tbl)
    #> [1] 6
    ncol(tbl)
    #> [1] 2
    names(tbl)
    #> [1] "Treatement\nN=100" "Comparison\nN=300"
    +dim(tbl)
    #> [1] 6 2
    nrow(tbl)
    #> [1] 6
    ncol(tbl)
    #> [1] 2
    names(tbl)
    #> [1] "Treatement\nN=100" "Comparison\nN=300"
    # Output: html as_html(tbl)
    #> <table class="table table-condensed table-hover"> @@ -264,7 +276,7 @@

    Examp # Colspans tbl2 <- rtable( - c("A", "B", "C", "D", "E"), + c("A", "B", "C", "D", "E"), format = "xx", rrow("r1", 1, 2, 3, 4, 5), rrow("r2", rcell("sp2", colspan = 2), "sp1", rcell("sp2-2", colspan = 2)) @@ -277,12 +289,12 @@

    Examp # Custom format with functions (might be deprecated soon) my_format <- function(x, output) { - paste(x, collapse = "/") + paste(x, collapse = "/") } tbl3 <- rtable( - c("A", "B"), + c("A", "B"), format = my_format, - rrow("row1", c(1,2,3,4), letters[1:10]) + rrow("row1", c(1,2,3,4), letters[1:10]) ) tbl3

    #> A B #> ---------------------------------------------------------- @@ -304,9 +316,7 @@

    Contents

    Author

    - -Adrian Waddell adrian.waddell@roche.com - +

    Adrian Waddell adrian.waddell@roche.com

    @@ -316,12 +326,13 @@

    Author

    -

    Site built with pkgdown.

    +

    Site built with pkgdown 1.3.0.

    - + + diff --git a/docs/reference/rtablel.html b/docs/reference/rtablel.html index a1203e395..561f4eaa5 100644 --- a/docs/reference/rtablel.html +++ b/docs/reference/rtablel.html @@ -1,6 +1,6 @@ - + @@ -9,22 +9,27 @@ Create an rtable from rrows stored in a list — rtablel • rtables - + - - + + - + - + + + + - + + + + - + + @@ -106,19 +115,22 @@ -
    +

    Create an rtable from rrows stored in a list

    - Source: R/rtable.R + Source: R/rtable.R +
    +

    This function is useful to create rtable objects with lists of rrows that are returned by the apply function family.

    +
    - 
    rtablel(header, ...)
    + 
    rtablel(header, ..., format = NULL)

    Arguments

    @@ -133,6 +145,13 @@

    Arg

    + + + +
    ...

    lists with rrow objects
    format

    a valid format string or a format function for +rcells. To get a list of all valid format strings use +list_rcell_format_labels. If format is NULL then the elements +of a cell get pasted separated by a comma.

    Value

    @@ -158,12 +177,13 @@

    Contents

    -

    Site built with pkgdown.

    +

    Site built with pkgdown 1.3.0.

    -
    + + diff --git a/docs/reference/rtabulate.data.frame.html b/docs/reference/rtabulate.data.frame.html index 1934b1e98..126ac4c07 100644 --- a/docs/reference/rtabulate.data.frame.html +++ b/docs/reference/rtabulate.data.frame.html @@ -1,6 +1,6 @@ - + @@ -9,30 +9,37 @@ Split data.frame and apply functions — rtabulate.data.frame • rtables - + - - + + - + - + + + + - + + + + - + +
    @@ -105,53 +114,47 @@ -
    +

    Split data.frame and apply functions

    - Source: R/rtabulate.R + Source: R/rtabulate.R +
    +

    Split data.frame and apply functions

    + 
    # S3 method for data.frame
-rtabulate(x, row_by_var = no_by("row_1"),
-  col_by_var = no_by("col_1"), FUN = nrow, ..., row_col_data_args = FALSE,
-  format = "xx", indent = 0)
    +rtabulate(x, row_by, col_by, FUN, ..., + format = NULL, indent = 0, col_wise_args = NULL)

    Arguments

    - + - + - + - + - - - - + + + +
    x

    a vecor

    data.frame
    row_by_varrow_by

    name of factor variable in x
    col_by_varcol_by

    name of factor variable in x
    FUN

    a function that processes the cell data, if row_data_arg is -set to TRUE the a second argument with the row data is passed to -FUN

    a function that processes the cell data
    ...

    arguments passed to FUN
    row_col_data_args

    boolean, if TRUE then FUN is called -with the first three arguments being the cell, row, and column data, -respectively

    format

    if FUN does not return a formatted rcell @@ -161,25 +164,33 @@

    Arg

    		indent

    non-negative integer where 0 means that the row should not be indented

    col_wise_args

    a named list containing collections (e.g. vectors or +lists) with data elements for each column of the resulting table. The data +elements are then passed to the named argument FUN corresponding to +the element name of the outer list. Hence, the length and order of each +collection must match the levels in col_by. See examples.

    Value

    -

    an rtable project

    +

    an rtable object

    Examples

    - 
    df <- expand.grid(aaa = factor(c("A", "B")), bbb = factor(c("X", "Y", "Z")))
-df <- rbind(df, df)
-df$val <- 1:nrow(df)
+    
    df <- expand.grid(aaa = factor(c("A", "B")), bbb = factor(c("X", "Y", "Z")))
+df <- rbind(df, df)
+df$val <- 1:nrow(df)
 
 rtabulate(
   x = df,
-  row_by_var = "aaa",
-  col_by_var = "bbb",
+  row_by = df$aaa,
+  col_by = df$bbb,
   FUN = function(x) {
-     sum(x$val)
+     sum(x$val)
   }
 )
    #>          X         Y         Z 
 #> -------------------------------
@@ -187,64 +198,60 @@ 
    Examp
 #> B        10        14        18
    
 rtabulate(
   x = iris,
-  row_by_var = no_by("sum"),
-  col_by_var = "Species",
-  FUN = function(x) sum(x$Sepal.Length)
+  row_by = no_by("sum"),
+  col_by = iris$Species,
+  FUN = function(x) sum(x$Sepal.Length)
 )
    #>              setosa          versicolor        virginica 
 #> ---------------------------------------------------------
 #> sum          250.3             296.8             329.4   
    
 rtabulate(
   x = iris,
-  row_by_var = "Species",
-  col_by_var = no_by("sum"),
-  FUN = function(x) sum(x$Sepal.Length)
+  row_by = iris$Species,
+  col_by = no_by("sum"),
+  FUN = function(x) sum(x$Sepal.Length)
 )
    #>                    sum 
 #> -----------------------
 #> setosa            250.3
 #> versicolor        296.8
 #> virginica         329.4
    
-tbl <- rtabulate(
-  x = iris,
-  FUN = function(cell_data) c(sum(cell_data$Sepal.Length), sd(cell_data$Sepal.Length)),
-  format = "xx.xx (xx.xx%)"
-)
-
-tbl
    #>                  col_1     
-#> ---------------------------
-#> row_1        876.5 (82.81%)
    
-row.names(tbl)
    #>   row_1 
-#> "row_1" 
    row.names(tbl) <- "Sum of Sepal Length"
-
-tbl
    #>                                col_1     
-#> -----------------------------------------
-#> Sum of Sepal Length        876.5 (82.81%)
    
-iris2 <- iris
-iris2$fsl5 <- factor(iris$Sepal.Length > 5, levels = c(TRUE, FALSE),
-    labels = c("S.L > 5", "S.L <= 5"))
+fsl5 <- factor(iris$Sepal.Length > 5, levels = c(TRUE, FALSE),
+    labels = c("S.L > 5", "S.L <= 5"))
 
 tbl <- rtabulate(
-  x = iris2,
-  row_by_var = "fsl5",
-  col_by_var = "Species",
-  FUN = function(x_cell, x_row, x_col) {
-    if (nrow(x_cell) < 10) {
+  x = iris,
+  row_by = fsl5,
+  col_by = iris$Species,
+  FUN = function(x_cell) {
+    if (nrow(x_cell) < 10) {
       rcell("-")
     } else {
-      fit <- lm(Sepal.Length ~ Petal.Width, data = x_cell)
-      m_col <- mean(x_col$Sepal.Length)
-      m_row <- mean(x_row$Sepal.Length)
+      fit <- lm(Sepal.Length ~ Petal.Width, data = x_cell)
 
-      rcell(list(fit, m_col, m_row), format = function(x, output) {
-        paste("df:", x[[1]]$df.residual,", and", round(x[[2]],1), ", and", round(x[[3]],2))
+      rcell(list(fit), format = function(x, output) {
+        paste("df:", x[[1]]$df.residual)
       })
     }
-  } ,
-  row_col_data_args = TRUE
+  }
 )
-tbl
    #>                           setosa                           versicolor                          virginica         
-#> -----------------------------------------------------------------------------------------------------------------
-#> S.L > 5          df: 20 , and 5 , and 6.13         df: 45 , and 5.9 , and 6.13        df: 47 , and 6.6 , and 6.13
-#> S.L <= 5         df: 26 , and 5 , and 4.79                      -                                  -             
    
+tbl
    #>                   setosa          versicolor        virginica 
+#> --------------------------------------------------------------
+#> S.L > 5           df: 20            df: 45            df: 47  
+#> S.L <= 5          df: 26              -                 -     
    
+rtabulate(
+  x = iris,
+  row_by = fsl5,
+  col_by = iris$Species,
+  FUN = function(x_cell, N) {
+     N
+  },
+  col_wise_args = list(N = c(10, 100, 200))
+)
    #>                   setosa          versicolor        virginica 
+#> --------------------------------------------------------------
+#> S.L > 5             10               100               200    
+#> S.L <= 5            10               100               200    
    
+ 
+
+
    -

    Site built with pkgdown.

    +

    Site built with pkgdown 1.3.0.

    -
    + + diff --git a/docs/reference/rtabulate.factor.html b/docs/reference/rtabulate.factor.html index 8e9bb504d..5bf745621 100644 --- a/docs/reference/rtabulate.factor.html +++ b/docs/reference/rtabulate.factor.html @@ -1,6 +1,6 @@ - + @@ -9,30 +9,38 @@ Tabulate Factors — rtabulate.factor • rtables - + - - + + - + - + + + + - + + + - + + - + +
    @@ -105,21 +115,25 @@ -
    +

    Tabulate Factors

    - Source: R/rtabulate.R + Source: R/rtabulate.R +
    +
    -

    Tabulate Factors

    +

    By default each cell reports the number of observations in +each level of x.

    + 
    # S3 method for factor
-rtabulate(x, col_by = no_by("col_1"), FUN = length, ...,
-  row_col_data_args = FALSE, useNA = c("no", "ifany", "always"),
-  format = "xx", indent = 0)
    +rtabulate(x, col_by = no_by("col_1"), FUN = length, + ..., useNA = c("no", "ifany", "always"), format = NULL, indent = 0, + col_wise_args = NULL)

    Arguments

    @@ -130,31 +144,24 @@

    Arg

    - - + - - - - - + @@ -165,12 +172,20 @@

    Arg

    + + + +
    col_by

    a factor of length nrow(x) that defines +

    a factor of length nrow(x) that defines which levels in col_by define a column. If data should not be split into columns use the no_by function.
    FUN

    a function that processes the cell data, if row_data_arg is -set to TRUE the a second argument with the row data is passed to -FUN

    a function that processes the cell data
    ...

    arguments passed to FUN
    row_col_data_args

    boolean, if TRUE then FUN is called -with the first three arguments being the cell, row, and column data, -respectively

    useNA

    boolean, if TRUE then NA values in x get -turned into a factor level "NA", if FALSE then the NA -values in x get dropped.

    either one of ("no", "ifany", "always"). If "no" then NA values +in x get dropped. When "ifany" is used a row for NA values is +included in the summary if any NAs exist in x. For option "always" +NA values are always included in the summary even if none exist in x.
    formatindent

    non-negative integer where 0 means that the row should not be indented

    col_wise_args

    a named list containing collections (e.g. vectors or +lists) with data elements for each column of the resulting table. The data +elements are then passed to the named argument FUN corresponding to +the element name of the outer list. Hence, the length and order of each +collection must match the levels in col_by. See examples.

    Value

    -

    an rtable project

    +

    an rtable object

    Examples

    @@ -185,33 +200,52 @@

    Examp #> setosa 50 #> versicolor 50 #> virginica 50

    -sl5 <- factor(iris$Sepal.Length > 5, levels = c(TRUE, FALSE), - labels = c("S.L > 5", "S.L <= 5")) +sl5 <- factor(iris$Sepal.Length > 5, levels = c(TRUE, FALSE), + labels = c("S.L > 5", "S.L <= 5")) rtabulate(iris$Species, col_by=sl5)
    #> S.L > 5 S.L <= 5 #> ------------------------------------------ #> setosa 22 28 #> versicolor 47 3 -#> virginica 49 1
    +#> virginica 49 1
    rtabulate(sl5, iris$Species)
    #> setosa versicolor virginica +#> -------------------------------------------------------------- +#> S.L > 5 22 47 49 +#> S.L <= 5 28 3 1
    rtabulate(iris$Species, col_by=sl5, - FUN = function(cell_data, row_data, col_data) { - if (length(cell_data) > 10) { - length(cell_data) * c(1, 1/length(col_data)) + FUN = function(cell_data, N) { + if (length(cell_data) > 10) { + length(cell_data) * c(1, 1/N) } else { rcell("-", format = "xx") } }, - row_col_data_args = TRUE, - format = "xx (xx.xx%)" + format = "xx (xx.xx%)", + col_wise_args = list(N = table(sl5)) )
    #> S.L > 5 S.L <= 5 #> ------------------------------------------------ #> setosa 22 (18.64%) 28 (87.5%) #> versicolor 47 (39.83%) - #> virginica 49 (41.53%) -
    -rtabulate(sl5, iris$Species)
    #> setosa versicolor virginica -#> -------------------------------------------------------------- -#> S.L > 5 22 47 49 -#> S.L <= 5 28 3 1
    +rtabulate(x = factor(c("X", "Y"), c("X", "Y")), + col_by = factor(c("a", "a"), c("a", "b")), FUN = length)
    #> a b +#> ------------------- +#> X 1 0 +#> Y 1 0
    +rtabulate(factor(c("Y", "Y"), c("X", "Y")), + factor(c("b", "b"), c("a", "b")), length)
    #> a b +#> ------------------- +#> X 0 0 +#> Y 0 2
    +rtabulate( + x = factor(c("Y", "Y"), c("X", "Y")), + col_by = factor(c("b", "b"), c("a", "b")), + FUN = function(x, N) list(length(x), N), + col_wise_args = list(N = c(1,2)) +)
    #> a b +#> ------------------------- +#> X 0, 1 0, 2 +#> Y 0, 1 2, 2
    +
    -

    Site built with pkgdown.

    +

    Site built with pkgdown 1.3.0.

    -
    + + diff --git a/docs/reference/rtabulate.html b/docs/reference/rtabulate.html index 91939e5cf..77767fcfd 100644 --- a/docs/reference/rtabulate.html +++ b/docs/reference/rtabulate.html @@ -1,6 +1,6 @@ - + @@ -9,22 +9,27 @@ Tabulation Methods — rtabulate • rtables - + - - + + - + - + + + + - + + + + - + + @@ -107,18 +116,21 @@ -
    +

    Tabulation Methods

    - Source: R/rtabulate.R + Source: R/rtabulate.R +
    +

    rtablulate provides a number of methods to derive rtables. Conceptually the rtabulate has it's origin in -tapply.

    +tapply.

    + 
    rtabulate(x, ...)
    @@ -137,11 +149,11 @@

    Arg

    Value

    -

    an rtable project

    +

    an rtable object

    Details

    -

    The data is split into cell-data and a function can be specified that return +

    The data is split into cell-data and a function can be specified that returns a data structre (or rcell).

    @@ -157,9 +169,7 @@

    Contents

    Author

    - -Adrian Waddell - +

    Adrian Waddell

    @@ -169,12 +179,13 @@

    Author

    -

    Site built with pkgdown.

    +

    Site built with pkgdown 1.3.0.

    - + + diff --git a/docs/reference/rtabulate.logical.html b/docs/reference/rtabulate.logical.html index 910db4d34..0ffbac3a6 100644 --- a/docs/reference/rtabulate.logical.html +++ b/docs/reference/rtabulate.logical.html @@ -1,38 +1,45 @@ - + -tabulate a logical vector — rtabulate.logical • rtables +Tabulate a logical vector — rtabulate.logical • rtables - + - - + + - + - + + + + - - - + + + + + + - + + @@ -105,21 +114,23 @@ -
    +
    -

    tabulate a logical vector

    - Source: R/rtabulate.R +

    Tabulate a logical vector

    + Source: R/rtabulate.R +
    +
    -

    tabulate a logical vector

    +

    By default each cell reports the number of TRUE observations from the associated vector.

    + 
    # S3 method for logical
-rtabulate(x, col_by = no_by("col_1"), FUN = function(x)
-  sum(x) * c(1, 1/length(x)), ..., row_data_arg = FALSE,
-  format = "xx.xx (xx.xx%)", row.name = "", indent = 0)
    +rtabulate(x, col_by = no_by("col_1"), FUN = sum, ..., + format = NULL, row.name = NULL, indent = 0, col_wise_args = NULL)

    Arguments

    @@ -130,24 +141,18 @@

    Arg

    - - + - - - - + + + +
    col_by

    a factor of length nrow(x) that defines +

    a factor of length nrow(x) that defines which levels in col_by define a column. If data should not be split into columns use the no_by function.
    FUN

    a function that processes the cell data, if row_data_arg is -set to TRUE the a second argument with the row data is passed to -FUN

    a function that processes the cell data
    ...

    arguments passed to FUN
    row_data_arg

    call FUN with the row data as the second argument

    format

    if FUN does not return a formatted rcell @@ -162,33 +167,46 @@

    Arg

    		indent

    non-negative integer where 0 means that the row should not be indented

    col_wise_args

    a named list containing collections (e.g. vectors or +lists) with data elements for each column of the resulting table. The data +elements are then passed to the named argument FUN corresponding to +the element name of the outer list. Hence, the length and order of each +collection must match the levels in col_by. See examples.

    Value

    -

    an rtable project

    +

    an rtable object

    Examples

    - 
    rtabulate(iris$Species == "setosa")
    #>            col_1   
-#> -------------------
-#>         50 (33.33%)
    
-rtabulate(iris$Species == "setosa", no_by("Species"), row.name = "n (n/N)")
    #>                  Species  
-#> --------------------------
-#> n (n/N)        50 (33.33%)
    
-# default: percentages equal \code{TRUE}
-with(iris, rtabulate(Sepal.Length < 5, Species, row.name = "Sepal.Length < 5"))
    #>                           setosa          versicolor        virginica 
+    
    rtabulate(iris$Species == "setosa")
    #>            col_1
+#> ----------------
+#> sum         50  
    
+rtabulate(iris$Species == "setosa", no_by("Species"),
+   FUN = function(x, N) list(sum(x), sum(x)/N),
+   row.name = "n (n/N)",
+   col_wise_args = list(N = 150))
    #>                       Species       
+#> ------------------------------------
+#> n (n/N)        50, 0.333333333333333
    
+# default FUN is number of observations equal to TRUE
+with(iris, rtabulate(Sepal.Length < 5, Species, row.name = "Sepal.Length < 5"))
    #>                           setosa          versicolor        virginica 
+#> ----------------------------------------------------------------------
+#> Sepal.Length < 5            20                1                 1     
    
+# Custom FUN: number of TRUE records in a cell and precentages based on number of records
+# in each column
+with(iris, rtabulate(Sepal.Length < 5, Species,
+  FUN = function(xi, N) sum(xi) * c(1, 1/N),
+  format = "xx.xx (xx.xx%)",
+  row.name = "Sepal.Length < 5",
+  col_wise_args = list(N = table(Species))
+))
    #>                           setosa          versicolor        virginica 
 #> ----------------------------------------------------------------------
 #> Sepal.Length < 5         20 (40%)           1 (2%)            1 (2%)  
    
-# precentages with proportion of cell number of \code{TRUE}s to overvall
-# number of \code{TRUE}s
-with(iris, rtabulate(Sepal.Length < 5, Species, row.name = "Sepal.Length < 5",
-  FUN = function(cell_data, row_data) sum(cell_data) * c(1, 1/sum(row_data)),
-  row_data_arg = TRUE
-))
    #>                           setosa           versicolor          virginica 
-#> -------------------------------------------------------------------------
-#> Sepal.Length < 5        20 (90.91%)         1 (4.55%)          1 (4.55%) 
    
 
    
   
    
   
 
 
    
-  
    Site built with pkgdown.
    
+  
    Site built with pkgdown 1.3.0.
    
 
    
-
    + + diff --git a/docs/reference/rtabulate.numeric.html b/docs/reference/rtabulate.numeric.html index 9e8fe00fb..62d62cbc1 100644 --- a/docs/reference/rtabulate.numeric.html +++ b/docs/reference/rtabulate.numeric.html @@ -1,39 +1,45 @@ - + -tabulate a numeric vector — rtabulate.numeric • rtables +Tabulate a numeric vector — rtabulate.numeric • rtables - + - - + + - + - + + + + - - - + + + + + + - + +
    @@ -106,21 +114,24 @@ -
    +
    -

    tabulate a numeric vector

    - Source: R/rtabulate.R +

    Tabulate a numeric vector

    + Source: R/rtabulate.R +
    +
    -

    by default the fivenum function is applied to the -vectors associated to the cells

    +

    By default each cell reports the mean based on the associated vector.

    + 
    # S3 method for numeric
-rtabulate(x, col_by = no_by("col_1"), FUN = mean, ...,
-  row_data_arg = FALSE, format = NULL, row.name = NULL, indent = 0)
    +rtabulate(x, col_by = no_by("col_1"), FUN = mean, + ..., format = NULL, row.name = NULL, indent = 0, + col_wise_args = NULL)

    Arguments

    @@ -131,24 +142,18 @@

    Arg

    - - + - - - - + + + +
    col_by

    a factor of length nrow(x) that defines +

    a factor of length nrow(x) that defines which levels in col_by define a column. If data should not be split into columns use the no_by function.
    FUN

    a function that processes the cell data, if row_data_arg is -set to TRUE the a second argument with the row data is passed to -FUN

    a function that processes the cell data
    ...

    arguments passed to FUN
    row_data_arg

    call FUN with the row data as the second argument

    format

    if FUN does not return a formatted rcell @@ -163,12 +168,20 @@

    Arg

    		indent

    non-negative integer where 0 means that the row should not be indented

    col_wise_args

    a named list containing collections (e.g. vectors or +lists) with data elements for each column of the resulting table. The data +elements are then passed to the named argument FUN corresponding to +the element name of the outer list. Hence, the length and order of each +collection must match the levels in col_by. See examples.

    Value

    -

    an rtable project

    +

    an rtable object

    Examples

    @@ -179,14 +192,14 @@

    Examp rtabulate(iris$Sepal.Length, col_by = no_by("Sepal.Length"))

    #> Sepal.Length #> ---------------------------- #> mean 5.84333333333333
    -with(iris, rtabulate(x = Sepal.Length, col_by = Species, row.name = "fivenum"))
    #> setosa versicolor virginica -#> ------------------------------------------------------------- -#> fivenum 5.006 5.936 6.588
    +with(iris, rtabulate(x = Sepal.Length, col_by = Species, row.name = "mean"))
    #> setosa versicolor virginica +#> ---------------------------------------------------------- +#> mean 5.006 5.936 6.588
    SL <- iris$Sepal.Length Sp <- iris$Species -rbind( +rbind( rtabulate(SL, Sp, length, row.name = "n"), - rtabulate(SL, Sp, function(x)c(mean(x), sd(x)), format = "xx.xx (xx.xx)", row.name = "Mean (SD)"), + rtabulate(SL, Sp, function(x)c(mean(x), sd(x)), format = "xx.xx (xx.xx)", row.name = "Mean (SD)"), rtabulate(SL, Sp, median, row.name = "Median"), rtabulate(SL, Sp, range, format = "xx.xx - xx.xx", row.name = "Min - Max") )
    #> setosa versicolor virginica @@ -195,8 +208,16 @@

    Examp #> Mean (SD) 5.01 (0.35) 5.94 (0.52) 6.59 (0.64) #> Median 5 5.9 6.5 #> Min - Max 4.3 - 5.8 4.9 - 7 4.9 - 7.9

    - - +x <- 1:100 +cb <- factor(rep(LETTERS[1:3], c(20, 30, 50))) + +rtabulate( + x = x, col_by = cb, FUN = function(x, N) list(mean(x), sd(x), N), + format = sprintf_format("%.2f (%.2f) and %i"), row.name = "Mean (SD) and N", + col_wise_args = list(N = table(cb)) +)
    #> A B C +#> --------------------------------------------------------------------------------------------------- +#> Mean (SD) and N 10.50 (5.92) and 20 35.50 (8.80) and 30 75.50 (14.58) and 50
    -

    Site built with pkgdown.

    +

    Site built with pkgdown 1.3.0.

    -
    + + diff --git a/docs/reference/sort_rrows.html b/docs/reference/sort_rrows.html new file mode 100644 index 000000000..ea5cae850 --- /dev/null +++ b/docs/reference/sort_rrows.html @@ -0,0 +1,228 @@ + + + + + + + + +Sort Rows in rtable — sort_rrows • rtables + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    +
    + + + +
    + +
    +
    +
    +

    Sort Rows in rtable

    + Source: R/sort.R + +
    + +
    + +

    Sort rows in rtable based on derived values within each row.

    + +
    + + 
    sort_rrows(x, indices = c(1, 1), ...)
    + +

    Arguments

    + + + + + + + + + + + + + + +
    x

    rtable object

    indices

    of column and cell within a row to access value +used for sorting. If the column index is 0 then the sum of the cell +values across all columns is derived and used for sorting. +If indices is a function then the function argument is +rrow object and the user must specify how to extract the information +required to sort the rows. See examples.

    ...

    arguments passed on to order

    + +

    Value

    + +

    object of class rtable

    + +

    See also

    + +

    order_rrows, order_rtables, + sort_rtables

    + + +

    Examples

    + 
    tbl <- rtable(
+  header = c("A", "B"),
+  rrow("r1", c(3,1), c(9,8,19)),
+  rrow("r2", c(4,-1), c(8,9,21)),
+  rrow("r3", c(1,3), c(3,2,22))
+)
+
+sort_rrows(tbl, c(1, 1))
    #>              A               B    
+#> ----------------------------------
+#> r3          1, 3          3, 2, 22
+#> r1          3, 1          9, 8, 19
+#> r2         4, -1          8, 9, 21
    sort_rrows(tbl, c(0, 1))
    #>              A               B    
+#> ----------------------------------
+#> r3          1, 3          3, 2, 22
+#> r1          3, 1          9, 8, 19
+#> r2         4, -1          8, 9, 21
    
+sort_rrows(tbl, c(2, 3), decreasing = FALSE)
    #>              A               B    
+#> ----------------------------------
+#> r1          3, 1          9, 8, 19
+#> r2         4, -1          8, 9, 21
+#> r3          1, 3          3, 2, 22
    sort_rrows(tbl, c(2, 3), decreasing = TRUE)
    #>              A               B    
+#> ----------------------------------
+#> r3          1, 3          3, 2, 22
+#> r2         4, -1          8, 9, 21
+#> r1          3, 1          9, 8, 19
    
+sort_rrows(tbl, function(row) row[[2]][3] - row[[1]][1])
    #>              A               B    
+#> ----------------------------------
+#> r1          3, 1          9, 8, 19
+#> r2         4, -1          8, 9, 21
+#> r3          1, 3          3, 2, 22
    
+
    +
    + +
    + +
    +
    +

    Developed by Adrian Waddell.

    +
    + +
    +

    Site built with pkgdown 1.3.0.

    +
    +
    +
    + + + + + + diff --git a/docs/reference/sort_rtables.html b/docs/reference/sort_rtables.html new file mode 100644 index 000000000..ac93eb8b8 --- /dev/null +++ b/docs/reference/sort_rtables.html @@ -0,0 +1,302 @@ + + + + + + + + +Sort rtables within a list — sort_rtables • rtables + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    +
    + + + +
    + +
    +
    +
    +

    Sort rtables within a list

    + Source: R/sort.R + +
    + +
    + +

    Return a sorted list of rtables in a list based on values within the tables.

    + +
    + + 
    sort_rtables(x, indices = c(1, 0, 1), ...)
    + +

    Arguments

    + + + + + + + + + + + + + + +
    x

    a list of rtables

    indices

    of row, column, and cell to access a value within each rtable that +is used for sorting the list x. If the column index is 0 then a sum of the +cell values across all columns within the specified row is taken. If indices +is a function then the function argument is rtable object and the user must +specify how to extract the information required to sort x. See examples.

    ...

    arguments passed on to order

    + +

    Value

    + +

    list of rtables

    + +

    See also

    + +

    order_rtables, sort_rrows, + order_rrows

    + + +

    Examples

    + 
    
+tbls <- list(
+   "Table A"  = rtable(
+     header = c("A", "B"),
+     rrow("r1", c(4,1), c(9,1,19)),
+     rrow("r2", c(5,-1), c(8,3,21)),
+     rrow("r3", c(1,3), c(3,4,22))
+   ),
+   "Table B" = rtable(
+     header = c("A", "B"),
+     rrow("r1", c(6,1), c(9,2,19)),
+     rrow("r2", c(5,-1), c(8,4,21)),
+     rrow("r3", c(1,3), c(3,5,22))
+   ),
+   "Table C" = rtable(
+     header = c("A", "B"),
+     rrow("r1", c(1,1), c(100,0,19)),
+     rrow("r2", c(5,-1), c(8,1,21)),
+     rrow("r3", c(1,3), c(3,1,22))
+   )
+)
+
+sort_rtables(tbls, c(1,1,1))
    #> $`Table C`
+#>               A                 B     
+#> --------------------------------------
+#> r1           1, 1           100, 0, 19
+#> r2          5, -1            8, 1, 21 
+#> r3           1, 3            3, 1, 22 
+#> 
+#> $`Table A`
+#>              A               B    
+#> ----------------------------------
+#> r1          4, 1          9, 1, 19
+#> r2         5, -1          8, 3, 21
+#> r3          1, 3          3, 4, 22
+#> 
+#> $`Table B`
+#>              A               B    
+#> ----------------------------------
+#> r1          6, 1          9, 2, 19
+#> r2         5, -1          8, 4, 21
+#> r3          1, 3          3, 5, 22
+#> 
    sort_rtables(tbls, c(1,1,1), decreasing = TRUE)
    #> $`Table B`
+#>              A               B    
+#> ----------------------------------
+#> r1          6, 1          9, 2, 19
+#> r2         5, -1          8, 4, 21
+#> r3          1, 3          3, 5, 22
+#> 
+#> $`Table A`
+#>              A               B    
+#> ----------------------------------
+#> r1          4, 1          9, 1, 19
+#> r2         5, -1          8, 3, 21
+#> r3          1, 3          3, 4, 22
+#> 
+#> $`Table C`
+#>               A                 B     
+#> --------------------------------------
+#> r1           1, 1           100, 0, 19
+#> r2          5, -1            8, 1, 21 
+#> r3           1, 3            3, 1, 22 
+#> 
    
+sort_rtables(tbls, c(1,0,1))
    #> $`Table A`
+#>              A               B    
+#> ----------------------------------
+#> r1          4, 1          9, 1, 19
+#> r2         5, -1          8, 3, 21
+#> r3          1, 3          3, 4, 22
+#> 
+#> $`Table B`
+#>              A               B    
+#> ----------------------------------
+#> r1          6, 1          9, 2, 19
+#> r2         5, -1          8, 4, 21
+#> r3          1, 3          3, 5, 22
+#> 
+#> $`Table C`
+#>               A                 B     
+#> --------------------------------------
+#> r1           1, 1           100, 0, 19
+#> r2          5, -1            8, 1, 21 
+#> r3           1, 3            3, 1, 22 
+#> 
    
+sort_rtables(tbls, function(tbl) tbl[[1]][[2]][3] - tbl[[1]][[1]][1]  )
    #> $`Table B`
+#>              A               B    
+#> ----------------------------------
+#> r1          6, 1          9, 2, 19
+#> r2         5, -1          8, 4, 21
+#> r3          1, 3          3, 5, 22
+#> 
+#> $`Table A`
+#>              A               B    
+#> ----------------------------------
+#> r1          4, 1          9, 1, 19
+#> r2         5, -1          8, 3, 21
+#> r3          1, 3          3, 4, 22
+#> 
+#> $`Table C`
+#>               A                 B     
+#> --------------------------------------
+#> r1           1, 1           100, 0, 19
+#> r2          5, -1            8, 1, 21 
+#> r3           1, 3            3, 1, 22 
+#> 
    
+
    +
    + +
    + +
    +
    +

    Developed by Adrian Waddell.

    +
    + +
    +

    Site built with pkgdown 1.3.0.

    +
    +
    +
    + + + + + + diff --git a/docs/reference/sprintf_format.html b/docs/reference/sprintf_format.html new file mode 100644 index 000000000..44ad3ab31 --- /dev/null +++ b/docs/reference/sprintf_format.html @@ -0,0 +1,184 @@ + + + + + + + + +Specify a rcell format based on sprintf formattig rules — sprintf_format • rtables + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    +
    + + + +
    + +
    +
    +
    +

    Specify a rcell format based on sprintf formattig rules

    + Source: R/format_rcell.R + +
    + +
    + +

    Format the rcell data with sprintf formatting strings

    + +
    + + 
    sprintf_format(fmt)
    + +

    Arguments

    + + + + + + +
    fmt

    a character vector of format strings, each of up to 8192 bytes.

    + +

    See also

    + +

    sprintf

    + + +

    Examples

    + 
    
+rcell(100, format = sprintf_format("(N=%i)"))
    #> (N=100)
    
+rcell(c(4,9999999999), format = sprintf_format("(%.2f, >999.9)"))
    #> (4.00, >999.9)
    
+rtable(LETTERS[1:2], rrow("", 1 ,2), format = sprintf_format("%.2f"))
    #>          A           B  
+#> ------------------------
+#>         1.00        2.00
    
+
    +
    + +
    + +
    +
    +

    Developed by Adrian Waddell.

    +
    + +
    +

    Site built with pkgdown 1.3.0.

    +
    +
    +
    + + + + + + diff --git a/docs/reference/sub-.rheader.html b/docs/reference/sub-.rheader.html index aca31931d..c42ffd030 100644 --- a/docs/reference/sub-.rheader.html +++ b/docs/reference/sub-.rheader.html @@ -1,6 +1,6 @@ - + @@ -9,30 +9,37 @@ access cell in rheader — [.rheader • rtables - + - - + + - + - + + + + - + + + + - + + @@ -105,16 +114,19 @@ -
    +

    access cell in rheader

    - Source: R/accessors_modifiers.R + Source: R/accessors_modifiers.R +
    +

    access cell in rheader

    + 
    # S3 method for rheader
 [(x, i, j, ...)
    @@ -157,12 +169,13 @@

    Contents

    -

    Site built with pkgdown.

    +

    Site built with pkgdown 1.3.0.

    -
    + + diff --git a/docs/reference/sub-.rtable.html b/docs/reference/sub-.rtable.html index 79a2a477e..a3bdb6728 100644 --- a/docs/reference/sub-.rtable.html +++ b/docs/reference/sub-.rtable.html @@ -1,6 +1,6 @@ - + @@ -9,30 +9,37 @@ Access rcells in an <code><a href='rtable.html'>rtable</a></code> — [.rtable • rtables - + - - + + - + - + + + + - + + + + - + +
    @@ -105,16 +114,19 @@ -
    +

    Access rcells in an rtable

    - Source: R/accessors_modifiers.R + Source: R/accessors_modifiers.R +
    +

    Accessor function

    + 
    # S3 method for rtable
 [(x, i, j, ...)
    @@ -166,12 +178,13 @@

    Contents

    -

    Site built with pkgdown.

    +

    Site built with pkgdown 1.3.0.

    -
    + + diff --git a/docs/reference/toString.rtable.html b/docs/reference/toString.rtable.html index d6c245b14..094900d34 100644 --- a/docs/reference/toString.rtable.html +++ b/docs/reference/toString.rtable.html @@ -1,6 +1,6 @@ - + @@ -9,30 +9,37 @@ Convert an rtable to ascii — toString.rtable • rtables - + - - + + - + - + + + + - + + + + - + +
    @@ -105,19 +114,22 @@ -
    +

    Convert an rtable to ascii

    - Source: R/toString.R + Source: R/toString.R +
    +

    Convert an rtable to ascii

    + 
    # S3 method for rtable
-toString(x, gap = 8, indent.unit = 2, ...)
    +toString(x, gap = 8, indent.unit = 2, ...)

    Arguments

    @@ -157,12 +169,13 @@

    Contents

    -

    Site built with pkgdown.

    +

    Site built with pkgdown 1.3.0.

    - + + diff --git a/docs/reference/unlist.rtable.html b/docs/reference/unlist.rtable.html new file mode 100644 index 000000000..c5dcf971f --- /dev/null +++ b/docs/reference/unlist.rtable.html @@ -0,0 +1,186 @@ + + + + + + + + +Unlist method for rtables — unlist.rtable • rtables + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    +
    + + + +
    + +
    +
    +
    +

    Unlist method for rtables

    + Source: R/rbind.R + +
    + +
    + +

    rtable objects should not be unlisted. This allows us to create nested lists with rtables objects and then flatten +them to a list of rtable objects.

    + +
    + + 
    # S3 method for rtable
+unlist(x, recursive = TRUE, use.names = TRUE)
    + +

    Arguments

    +
    + + + + + + + + + + + + + +
    x

    an R object, typically a list or vector.

    recursive

    logical. Should unlisting be applied to list + components of x?

    use.names

    logical. Should names be preserved?

    + +

    Value

    + +

    rtable object

    + + +
    + +
    + +
    +
    +

    Developed by Adrian Waddell.

    +
    + +
    +

    Site built with pkgdown 1.3.0.

    +
    +
    +
    + + + + + + diff --git a/man/as_html.rtable.Rd b/man/as_html.rtable.Rd new file mode 100644 index 000000000..5595b565f --- /dev/null +++ b/man/as_html.rtable.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/as_html.R +\name{as_html.rtable} +\alias{as_html.rtable} +\title{Convert an rtable object to html} +\usage{ +\method{as_html}{rtable}(x, + class.table = "table table-condensed table-hover", ...) +} +\arguments{ +\item{x}{an \code{\link{rtable}} object} + +\item{class.table}{class attributes for \code{} html object} + +\item{...}{arguments passed as attributes to the table html objet} +} +\value{ +an object of class \code{shinyTag} +} +\description{ +Convert an rtable object to html +} diff --git a/man/header_add_N.Rd b/man/header_add_N.Rd new file mode 100644 index 000000000..36134f57b --- /dev/null +++ b/man/header_add_N.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/header_add_N.R +\name{header_add_N} +\alias{header_add_N} +\title{Add N=xx to header} +\usage{ +header_add_N(x, N) +} +\arguments{ +\item{x}{\code{rtable}} + +\item{N}{vector with counts to be displayed in the header. The +length must match the number of columns in \code{x}} +} +\description{ +Helper function used to add the population total (N) in the +column header of \code{\link{rtable}} object. +} +\examples{ + +tbl <- rtable( + header = letters[1:3], + rrow("X", 1, 2, 3), + rrow("Y", 4, 5, 6) +) + +tbl + +header_add_N(tbl, 1:3) + +} diff --git a/man/levels.no_by.Rd b/man/levels.no_by.Rd new file mode 100644 index 000000000..1094d5cf0 --- /dev/null +++ b/man/levels.no_by.Rd @@ -0,0 +1,14 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/rtabulate.R +\name{levels.no_by} +\alias{levels.no_by} +\title{Access levels attribute for an object of \code{no_by} Class} +\usage{ +\method{levels}{no_by}(x) +} +\arguments{ +\item{x}{\code{no_by} class object} +} +\description{ +Access levels attribute for an object of \code{no_by} Class +} diff --git a/man/no_by.Rd b/man/no_by.Rd index ca0eb016f..47396f508 100644 --- a/man/no_by.Rd +++ b/man/no_by.Rd @@ -2,15 +2,20 @@ % Please edit documentation in R/rtabulate.R \name{no_by} \alias{no_by} -\title{Do not split data into columns or row in \code{rtabulate}} +\title{Do not split data into columns in \code{rtabulate}} \usage{ no_by(name) } \arguments{ -\item{name}{row name or column name} +\item{name}{character column name to display in the table header} } \description{ -\code{\link{rtabulate}} has the arguments \code{col_by} and \code{row_by} +\code{\link{rtabulate}} has the argument \code{col_by} which can either take a vector or if no splitting is needed the return value -of \code{no_by}. +of \code{no_by}. Using \code{no_by} creates a table with a single +column. +} +\examples{ + +rtabulate(iris$Species, col_by = no_by("Total")) } diff --git a/man/order_rrows.Rd b/man/order_rrows.Rd new file mode 100644 index 000000000..ab0fc19bc --- /dev/null +++ b/man/order_rrows.Rd @@ -0,0 +1,44 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/sort.R +\name{order_rrows} +\alias{order_rrows} +\title{Sort rrows in rtable} +\usage{ +order_rrows(x, indices = c(1, 1), ...) +} +\arguments{ +\item{x}{rtable object} + +\item{indices}{of column and cell within a row to access value +used for sorting. If the column index is 0 then the sum of the cell +values across all columns is derived and used for sorting. +If \code{indices} is a function then the function argument is +rrow object and the user must specify how to extract the information +required to sort the rows. See examples.} + +\item{...}{arguments passed on to \code{\link{order}}} +} +\value{ +order of rows +} +\description{ +Return order of rows in rtable based on derived values within each row. +} +\examples{ +tbl <- rtable( + header = c("A", "B"), + rrow("r1", c(3,1), c(9,8,19)), + rrow("r2", c(4,-1), c(8,9,21)), + rrow("r3", c(1,3), c(3,2,22)) +) + +order_rrows(tbl, c(1,1)) +order_rrows(tbl, c(2, 3), decreasing = TRUE) +order_rrows(tbl, c(0,2)) + +order_rrows(tbl, function(row) row[[2]][3] - row[[1]][1]) +} +\seealso{ +\code{\link{sort_rrows}}, \code{\link{order_rtables}}, + \code{\link{sort_rtables}} +} diff --git a/man/order_rtables.Rd b/man/order_rtables.Rd new file mode 100644 index 000000000..6139eca54 --- /dev/null +++ b/man/order_rtables.Rd @@ -0,0 +1,59 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/sort.R +\name{order_rtables} +\alias{order_rtables} +\title{Order of rtables in a list} +\usage{ +order_rtables(x, indices = c(1, 0, 1), ...) +} +\arguments{ +\item{x}{a list of rtables} + +\item{indices}{of row, column, and cell to access a value within each rtable that +is used for sorting the list \code{x}. If the column index is 0 then a sum of the +cell values across all columns within the specified row is taken. If \code{indices} +is a function then the function argument is rtable object and the user must +specify how to extract the information required to sort \code{x}. See examples.} + +\item{...}{arguments passed on to \code{\link{order}}} +} +\value{ +order of rtables +} +\description{ +Return the order of rtables in a list based on values within the tables. +} +\examples{ + +tbls <- list( + rtable( + header = c("A", "B"), + rrow("r1", c(4,1), c(9,1,19)), + rrow("r2", c(5,-1), c(8,3,21)), + rrow("r3", c(1,3), c(3,4,22)) + ), + rtable( + header = c("A", "B"), + rrow("r1", c(6,1), c(9,2,19)), + rrow("r2", c(5,-1), c(8,4,21)), + rrow("r3", c(1,3), c(3,5,22)) + ), + rtable( + header = c("A", "B"), + rrow("r1", c(1,1), c(100,0,19)), + rrow("r2", c(5,-1), c(8,1,21)), + rrow("r3", c(1,3), c(3,1,22)) + ) +) + +order_rtables(tbls, c(1,1,1)) +order_rtables(tbls, c(1,1,1), decreasing = TRUE) + +order_rtables(tbls, c(1,0,1)) + +order_rtables(tbls, function(tbl) tbl[[1]][[2]][3] - tbl[[1]][[1]][1] ) +} +\seealso{ +\code{\link{sort_rtables}}, \code{\link{sort_rrows}}, + \code{\link{order_rrows}} +} diff --git a/man/rbind.rtable.Rd b/man/rbind.rtable.Rd index f9b4c11e4..568e0adeb 100644 --- a/man/rbind.rtable.Rd +++ b/man/rbind.rtable.Rd @@ -1,19 +1,22 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/accessors_modifiers.R +% Please edit documentation in R/rbind.R \name{rbind.rtable} \alias{rbind.rtable} -\title{stack rtable objects} +\title{Stack rtable objects} \usage{ -\method{rbind}{rtable}(...) +\method{rbind}{rtable}(..., gap = 0) } \arguments{ \item{...}{\code{\link{rtable}} objects} + +\item{gap}{number of empty rows to add between tables} } \value{ an \code{\link{rtable}} object } \description{ -stack rtable objects +Note that the columns order are not mached by the header: the first table +header is taken as the reference. } \examples{ @@ -44,7 +47,12 @@ mtbl2 <- with(subset(iris, Species == 'setosa'), rtable( )) tbl <- rbind(mtbl, mtbl2) - tbl +tbl <- rbind(mtbl, mtbl2, gap = 1) +tbl + +tbl <- rbind(mtbl, mtbl2, gap = 2) +tbl + } diff --git a/man/rbindl_rtables.Rd b/man/rbindl_rtables.Rd new file mode 100644 index 000000000..3351c9a7c --- /dev/null +++ b/man/rbindl_rtables.Rd @@ -0,0 +1,16 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/rbind.R +\name{rbindl_rtables} +\alias{rbindl_rtables} +\title{Stack a list of rtables} +\usage{ +rbindl_rtables(x, gap = 0) +} +\arguments{ +\item{x}{a list of rtable objects} + +\item{gap}{number of empty rows to add between tables} +} +\description{ +See \code{\link{rbind.rtable}} for details +} diff --git a/man/rtabulate.Rd b/man/rtabulate.Rd index 9d447c3d7..45893ea8f 100644 --- a/man/rtabulate.Rd +++ b/man/rtabulate.Rd @@ -12,7 +12,7 @@ rtabulate(x, ...) \item{...}{arguments passed to methods} } \value{ -an \code{\link{rtable}} project +an \code{\link{rtable}} object } \description{ \code{rtablulate} provides a number of methods to derive @@ -20,7 +20,7 @@ an \code{\link{rtable}} project \code{\link{tapply}}. } \details{ -The data is split into cell-data and a function can be specified that return +The data is split into cell-data and a function can be specified that returns a data structre (or \code{\link{rcell}}). } \author{ diff --git a/man/rtabulate.data.frame.Rd b/man/rtabulate.data.frame.Rd index 9528d0657..4192f135c 100644 --- a/man/rtabulate.data.frame.Rd +++ b/man/rtabulate.data.frame.Rd @@ -4,40 +4,34 @@ \alias{rtabulate.data.frame} \title{Split data.frame and apply functions} \usage{ -\method{rtabulate}{data.frame}(x, row_by_var = no_by("row_1"), - col_by_var = no_by("col_1"), FUN = nrow, ..., - row_col_data_args = FALSE, format = "xx", indent = 0, - col_total = "(N=xx)") +\method{rtabulate}{data.frame}(x, row_by, col_by, FUN, ..., + format = NULL, indent = 0, col_wise_args = NULL) } \arguments{ -\item{x}{a vecor} +\item{x}{data.frame} -\item{row_by_var}{name of factor variable in \code{x}} +\item{row_by}{name of factor variable in \code{x}} -\item{col_by_var}{name of factor variable in \code{x}} +\item{col_by}{name of factor variable in \code{x}} -\item{FUN}{a function that processes the cell data, if \code{row_data_arg} is -set to \code{TRUE} the a second argument with the row data is passed to -\code{FUN}} +\item{FUN}{a function that processes the cell data} \item{...}{arguments passed to \code{FUN}} -\item{row_col_data_args}{boolean, if \code{TRUE} then \code{FUN} is called -with the first three arguments being the cell, row, and column data, -respectively} - \item{format}{if \code{FUN} does not return a formatted \code{\link{rcell}} then the \code{format} is applied} \item{indent}{non-negative integer where 0 means that the row should not be indented} -\item{col_total}{a format string for displaying the number of elements in the -column header. If \code{NULL} then no header row for the column is -displayed.} +\item{col_wise_args}{a named list containing collections (e.g. vectors or +lists) with data elements for each column of the resulting table. The data +elements are then passed to the named argument \code{FUN} corresponding to +the element name of the outer list. Hence, the length and order of each +collection must match the levels in \code{col_by}. See examples.} } \value{ -an \code{\link{rtable}} project +an \code{\link{rtable}} object } \description{ Split data.frame and apply functions @@ -49,8 +43,8 @@ df$val <- 1:nrow(df) rtabulate( x = df, - row_by_var = "aaa", - col_by_var = "bbb", + row_by = df$aaa, + col_by = df$bbb, FUN = function(x) { sum(x$val) } @@ -58,53 +52,49 @@ rtabulate( rtabulate( x = iris, - row_by_var = no_by("sum"), - col_by_var = "Species", + row_by = no_by("sum"), + col_by = iris$Species, FUN = function(x) sum(x$Sepal.Length) ) rtabulate( x = iris, - row_by_var = "Species", - col_by_var = no_by("sum"), + row_by = iris$Species, + col_by = no_by("sum"), FUN = function(x) sum(x$Sepal.Length) ) -tbl <- rtabulate( - x = iris, - FUN = function(cell_data) c(sum(cell_data$Sepal.Length), sd(cell_data$Sepal.Length)), - format = "xx.xx (xx.xx\%)" -) - -tbl - -row.names(tbl) -row.names(tbl) <- "Sum of Sepal Length" - -tbl - -iris2 <- iris -iris2$fsl5 <- factor(iris$Sepal.Length > 5, levels = c(TRUE, FALSE), +fsl5 <- factor(iris$Sepal.Length > 5, levels = c(TRUE, FALSE), labels = c("S.L > 5", "S.L <= 5")) tbl <- rtabulate( - x = iris2, - row_by_var = "fsl5", - col_by_var = "Species", - FUN = function(x_cell, x_row, x_col) { + x = iris, + row_by = fsl5, + col_by = iris$Species, + FUN = function(x_cell) { if (nrow(x_cell) < 10) { rcell("-") } else { fit <- lm(Sepal.Length ~ Petal.Width, data = x_cell) - m_col <- mean(x_col$Sepal.Length) - m_row <- mean(x_row$Sepal.Length) - - rcell(list(fit, m_col, m_row), format = function(x, output) { - paste("df:", x[[1]]$df.residual,", and", round(x[[2]],1), ", and", round(x[[3]],2)) + + rcell(list(fit), format = function(x, output) { + paste("df:", x[[1]]$df.residual) }) } - } , - row_col_data_args = TRUE + } ) tbl + +rtabulate( + x = iris, + row_by = fsl5, + col_by = iris$Species, + FUN = function(x_cell, N) { + N + }, + col_wise_args = list(N = c(10, 100, 200)) +) + + + } diff --git a/man/rtabulate.factor.Rd b/man/rtabulate.factor.Rd index dce879198..34a2da1e2 100644 --- a/man/rtabulate.factor.Rd +++ b/man/rtabulate.factor.Rd @@ -5,8 +5,8 @@ \title{Tabulate Factors} \usage{ \method{rtabulate}{factor}(x, col_by = no_by("col_1"), FUN = length, - ..., row_col_data_args = FALSE, useNA = c("no", "ifany", "always"), - format = "xx", indent = 0, col_total = "(N=xx)") + ..., useNA = c("no", "ifany", "always"), format = NULL, indent = 0, + col_wise_args = NULL) } \arguments{ \item{x}{a vecor} @@ -15,19 +15,14 @@ which levels in \code{col_by} define a column. If data should not be split into columns use the \code{\link{no_by}} function.} -\item{FUN}{a function that processes the cell data, if \code{row_data_arg} is -set to \code{TRUE} the a second argument with the row data is passed to -\code{FUN}} +\item{FUN}{a function that processes the cell data} \item{...}{arguments passed to \code{FUN}} -\item{row_col_data_args}{boolean, if \code{TRUE} then \code{FUN} is called -with the first three arguments being the cell, row, and column data, -respectively} - -\item{useNA}{boolean, if \code{TRUE} then \code{NA} values in \code{x} get -turned into a factor level \code{"NA"}, if \code{FALSE} then the \code{NA} -values in \code{x} get dropped.} +\item{useNA}{either one of ("no", "ifany", "always"). If \code{"no"} then \code{NA} values +in \code{x} get dropped. When \code{"ifany"} is used a row for \code{NA} values is +included in the summary if any \code{NA}s exist in \code{x}. For option \code{"always"} +\code{NA} values are always included in the summary even if none exist in \code{x}.} \item{format}{if \code{FUN} does not return a formatted \code{\link{rcell}} then the \code{format} is applied} @@ -35,15 +30,18 @@ then the \code{format} is applied} \item{indent}{non-negative integer where 0 means that the row should not be indented} -\item{col_total}{a format string for displaying the number of elements in the -column header. If \code{NULL} then no header row for the column is -displayed.} +\item{col_wise_args}{a named list containing collections (e.g. vectors or +lists) with data elements for each column of the resulting table. The data +elements are then passed to the named argument \code{FUN} corresponding to +the element name of the outer list. Hence, the length and order of each +collection must match the levels in \code{col_by}. See examples.} } \value{ -an \code{\link{rtable}} project +an \code{\link{rtable}} object } \description{ -Tabulate Factors +By default each cell reports the number of observations in +each level of \code{x}. } \examples{ @@ -55,19 +53,32 @@ sl5 <- factor(iris$Sepal.Length > 5, levels = c(TRUE, FALSE), labels = c("S.L > 5", "S.L <= 5")) rtabulate(iris$Species, col_by=sl5) +rtabulate(sl5, iris$Species) rtabulate(iris$Species, col_by=sl5, - FUN = function(cell_data, row_data, col_data) { + FUN = function(cell_data, N) { if (length(cell_data) > 10) { - length(cell_data) * c(1, 1/length(col_data)) + length(cell_data) * c(1, 1/N) } else { rcell("-", format = "xx") } }, - row_col_data_args = TRUE, - format = "xx (xx.xx\%)" + format = "xx (xx.xx\%)", + col_wise_args = list(N = table(sl5)) +) + +rtabulate(x = factor(c("X", "Y"), c("X", "Y")), + col_by = factor(c("a", "a"), c("a", "b")), FUN = length) + +rtabulate(factor(c("Y", "Y"), c("X", "Y")), + factor(c("b", "b"), c("a", "b")), length) + +rtabulate( + x = factor(c("Y", "Y"), c("X", "Y")), + col_by = factor(c("b", "b"), c("a", "b")), + FUN = function(x, N) list(length(x), N), + col_wise_args = list(N = c(1,2)) ) -rtabulate(sl5, iris$Species) } diff --git a/man/rtabulate.logical.Rd b/man/rtabulate.logical.Rd index 4d6534cbd..966a581f3 100644 --- a/man/rtabulate.logical.Rd +++ b/man/rtabulate.logical.Rd @@ -2,12 +2,10 @@ % Please edit documentation in R/rtabulate.R \name{rtabulate.logical} \alias{rtabulate.logical} -\title{tabulate a logical vector} +\title{Tabulate a logical vector} \usage{ -\method{rtabulate}{logical}(x, col_by = no_by("col_1"), - FUN = function(x) sum(x) * c(1, 1/length(x)), ..., - row_data_arg = FALSE, format = "xx.xx (xx.xx\%)", row.name = "", - indent = 0, col_total = "(N=xx)") +\method{rtabulate}{logical}(x, col_by = no_by("col_1"), FUN = sum, ..., + format = NULL, row.name = NULL, indent = 0, col_wise_args = NULL) } \arguments{ \item{x}{a vecor} @@ -16,14 +14,10 @@ which levels in \code{col_by} define a column. If data should not be split into columns use the \code{\link{no_by}} function.} -\item{FUN}{a function that processes the cell data, if \code{row_data_arg} is -set to \code{TRUE} the a second argument with the row data is passed to -\code{FUN}} +\item{FUN}{a function that processes the cell data} \item{...}{arguments passed to \code{FUN}} -\item{row_data_arg}{call \code{FUN} with the row data as the second argument} - \item{format}{if \code{FUN} does not return a formatted \code{\link{rcell}} then the \code{format} is applied} @@ -33,29 +27,36 @@ used as \code{row.name} of the \code{\link{rrow}}} \item{indent}{non-negative integer where 0 means that the row should not be indented} -\item{col_total}{a format string for displaying the number of elements in the -column header. If \code{NULL} then no header row for the column is -displayed.} +\item{col_wise_args}{a named list containing collections (e.g. vectors or +lists) with data elements for each column of the resulting table. The data +elements are then passed to the named argument \code{FUN} corresponding to +the element name of the outer list. Hence, the length and order of each +collection must match the levels in \code{col_by}. See examples.} } \value{ -an \code{\link{rtable}} project +an \code{\link{rtable}} object } \description{ -tabulate a logical vector +By default each cell reports the number of \code{TRUE} observations from the associated vector. } \examples{ rtabulate(iris$Species == "setosa") -rtabulate(iris$Species == "setosa", no_by("Species"), row.name = "n (n/N)") +rtabulate(iris$Species == "setosa", no_by("Species"), + FUN = function(x, N) list(sum(x), sum(x)/N), + row.name = "n (n/N)", + col_wise_args = list(N = 150)) -# default: percentages equal \\code{TRUE} +# default FUN is number of observations equal to TRUE with(iris, rtabulate(Sepal.Length < 5, Species, row.name = "Sepal.Length < 5")) -# precentages with proportion of cell number of \\code{TRUE}s to overvall -# number of \\code{TRUE}s -with(iris, rtabulate(Sepal.Length < 5, Species, row.name = "Sepal.Length < 5", - FUN = function(cell_data, row_data) sum(cell_data) * c(1, 1/sum(row_data)), - row_data_arg = TRUE +# Custom FUN: number of TRUE records in a cell and precentages based on number of records +# in each column +with(iris, rtabulate(Sepal.Length < 5, Species, + FUN = function(xi, N) sum(xi) * c(1, 1/N), + format = "xx.xx (xx.xx\%)", + row.name = "Sepal.Length < 5", + col_wise_args = list(N = table(Species)) )) } diff --git a/man/rtabulate.numeric.Rd b/man/rtabulate.numeric.Rd index d740f1cde..046bb1441 100644 --- a/man/rtabulate.numeric.Rd +++ b/man/rtabulate.numeric.Rd @@ -2,11 +2,11 @@ % Please edit documentation in R/rtabulate.R \name{rtabulate.numeric} \alias{rtabulate.numeric} -\title{tabulate a numeric vector} +\title{Tabulate a numeric vector} \usage{ \method{rtabulate}{numeric}(x, col_by = no_by("col_1"), FUN = mean, - ..., row_data_arg = FALSE, format = NULL, row.name = NULL, - indent = 0, col_total = "(N=xx)") + ..., format = NULL, row.name = NULL, indent = 0, + col_wise_args = NULL) } \arguments{ \item{x}{a vecor} @@ -15,14 +15,10 @@ which levels in \code{col_by} define a column. If data should not be split into columns use the \code{\link{no_by}} function.} -\item{FUN}{a function that processes the cell data, if \code{row_data_arg} is -set to \code{TRUE} the a second argument with the row data is passed to -\code{FUN}} +\item{FUN}{a function that processes the cell data} \item{...}{arguments passed to \code{FUN}} -\item{row_data_arg}{call \code{FUN} with the row data as the second argument} - \item{format}{if \code{FUN} does not return a formatted \code{\link{rcell}} then the \code{format} is applied} @@ -32,24 +28,25 @@ used as \code{row.name} of the \code{\link{rrow}}} \item{indent}{non-negative integer where 0 means that the row should not be indented} -\item{col_total}{a format string for displaying the number of elements in the -column header. If \code{NULL} then no header row for the column is -displayed.} +\item{col_wise_args}{a named list containing collections (e.g. vectors or +lists) with data elements for each column of the resulting table. The data +elements are then passed to the named argument \code{FUN} corresponding to +the element name of the outer list. Hence, the length and order of each +collection must match the levels in \code{col_by}. See examples.} } \value{ -an \code{\link{rtable}} project +an \code{\link{rtable}} object } \description{ -by default the \code{\link[stats]{fivenum}} function is applied to the -vectors associated to the cells +By default each cell reports the mean based on the associated vector. } \examples{ rtabulate(iris$Sepal.Length) - + rtabulate(iris$Sepal.Length, col_by = no_by("Sepal.Length")) - -with(iris, rtabulate(x = Sepal.Length, col_by = Species, row.name = "fivenum")) + +with(iris, rtabulate(x = Sepal.Length, col_by = Species, row.name = "mean")) SL <- iris$Sepal.Length Sp <- iris$Species @@ -60,6 +57,13 @@ rbind( rtabulate(SL, Sp, range, format = "xx.xx - xx.xx", row.name = "Min - Max") ) +x <- 1:100 +cb <- factor(rep(LETTERS[1:3], c(20, 30, 50))) +rtabulate( + x = x, col_by = cb, FUN = function(x, N) list(mean(x), sd(x), N), + format = sprintf_format("\%.2f (\%.2f) and \%i"), row.name = "Mean (SD) and N", + col_wise_args = list(N = table(cb)) +) } diff --git a/man/sort_rrows.Rd b/man/sort_rrows.Rd new file mode 100644 index 000000000..92bd66be5 --- /dev/null +++ b/man/sort_rrows.Rd @@ -0,0 +1,47 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/sort.R +\name{sort_rrows} +\alias{sort_rrows} +\title{Sort Rows in rtable} +\usage{ +sort_rrows(x, indices = c(1, 1), ...) +} +\arguments{ +\item{x}{rtable object} + +\item{indices}{of column and cell within a row to access value +used for sorting. If the column index is 0 then the sum of the cell +values across all columns is derived and used for sorting. +If \code{indices} is a function then the function argument is +rrow object and the user must specify how to extract the information +required to sort the rows. See examples.} + +\item{...}{arguments passed on to \code{\link{order}}} +} +\value{ +object of class rtable +} +\description{ +Sort rows in rtable based on derived values within each row. +} +\examples{ +tbl <- rtable( + header = c("A", "B"), + rrow("r1", c(3,1), c(9,8,19)), + rrow("r2", c(4,-1), c(8,9,21)), + rrow("r3", c(1,3), c(3,2,22)) +) + +sort_rrows(tbl, c(1, 1)) +sort_rrows(tbl, c(0, 1)) + +sort_rrows(tbl, c(2, 3), decreasing = FALSE) +sort_rrows(tbl, c(2, 3), decreasing = TRUE) + +sort_rrows(tbl, function(row) row[[2]][3] - row[[1]][1]) + +} +\seealso{ +\code{\link{order_rrows}}, \code{\link{order_rtables}}, + \code{\link{sort_rtables}} +} diff --git a/man/sort_rtables.Rd b/man/sort_rtables.Rd new file mode 100644 index 000000000..9c88a1c71 --- /dev/null +++ b/man/sort_rtables.Rd @@ -0,0 +1,60 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/sort.R +\name{sort_rtables} +\alias{sort_rtables} +\title{Sort rtables within a list} +\usage{ +sort_rtables(x, indices = c(1, 0, 1), ...) +} +\arguments{ +\item{x}{a list of rtables} + +\item{indices}{of row, column, and cell to access a value within each rtable that +is used for sorting the list \code{x}. If the column index is 0 then a sum of the +cell values across all columns within the specified row is taken. If \code{indices} +is a function then the function argument is rtable object and the user must +specify how to extract the information required to sort \code{x}. See examples.} + +\item{...}{arguments passed on to \code{\link{order}}} +} +\value{ +list of rtables +} +\description{ +Return a sorted list of rtables in a list based on values within the tables. +} +\examples{ + +tbls <- list( + "Table A" = rtable( + header = c("A", "B"), + rrow("r1", c(4,1), c(9,1,19)), + rrow("r2", c(5,-1), c(8,3,21)), + rrow("r3", c(1,3), c(3,4,22)) + ), + "Table B" = rtable( + header = c("A", "B"), + rrow("r1", c(6,1), c(9,2,19)), + rrow("r2", c(5,-1), c(8,4,21)), + rrow("r3", c(1,3), c(3,5,22)) + ), + "Table C" = rtable( + header = c("A", "B"), + rrow("r1", c(1,1), c(100,0,19)), + rrow("r2", c(5,-1), c(8,1,21)), + rrow("r3", c(1,3), c(3,1,22)) + ) +) + +sort_rtables(tbls, c(1,1,1)) +sort_rtables(tbls, c(1,1,1), decreasing = TRUE) + +sort_rtables(tbls, c(1,0,1)) + +sort_rtables(tbls, function(tbl) tbl[[1]][[2]][3] - tbl[[1]][[1]][1] ) + +} +\seealso{ +\code{\link{order_rtables}}, \code{\link{sort_rrows}}, + \code{\link{order_rrows}} +} diff --git a/man/unlist.rtable.Rd b/man/unlist.rtable.Rd new file mode 100644 index 000000000..027e4aaf0 --- /dev/null +++ b/man/unlist.rtable.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/rbind.R +\name{unlist.rtable} +\alias{unlist.rtable} +\title{Unlist method for rtables} +\usage{ +\method{unlist}{rtable}(x, recursive = TRUE, use.names = TRUE) +} +\arguments{ +\item{x}{an \R object, typically a list or vector.} + +\item{recursive}{logical. Should unlisting be applied to list + components of \code{x}?} + +\item{use.names}{logical. Should names be preserved?} +} +\value{ +rtable object +} +\description{ +rtable objects should not be unlisted. This allows us to create nested lists with rtables objects and then flatten +them to a list of rtable objects. +} diff --git a/tests/testthat/test-rtables.R b/tests/testthat/test-rtables.R index e63d12ff1..251030710 100644 --- a/tests/testthat/test-rtables.R +++ b/tests/testthat/test-rtables.R @@ -96,4 +96,11 @@ test_that("test sprintf based format", { expect_equal(format_rcell(rcell(c(12.21, 7.321), sprintf_format("%.1f and %.2f"))), "12.2 and 7.32") -}) \ No newline at end of file +}) + +test_that("unlisting rtables has no effect on them", { + + t1 <- rtable(header = c("A", "B"), format = "xx", rrow("row 1", 1, 2)) + + expect_identical(t1, unlist(t1)) +}) diff --git a/tests/testthat/test-rtabulate.R b/tests/testthat/test-rtabulate.R new file mode 100644 index 000000000..efa08a676 --- /dev/null +++ b/tests/testthat/test-rtabulate.R @@ -0,0 +1,89 @@ +context("rtabulate") + +test_that("rtabulate length tests", { + + cells <- function(x) as.vector(unlist(unclass(x))) # current implementation + + cb <- letters[1:2] + cbf <- factor(cb, levels = cb) + + rt_test <- function(x) { + tbl <- rtabulate(x, cbf, length) + expect_true(all(cells(tbl) == 1), "subset fail") + + tbl <- rtabulate(x[1], cbf[1], length) + expect_identical(cells(tbl), c(1L, 0L), "0 count") + + tbl <- rtabulate(numeric(0), cbf[c(FALSE, FALSE)], length) + expect_identical(cells(tbl), c(0L, 0L), "0 count 2") + } + + + rt_test(seq_along(cb)) # numeric + rt_test(rep(TRUE, length(cb))) # logical + + # factor + + tbl <- rtabulate(cbf, cbf) + expect_identical(cells(tbl), c(1L, 0L, 0L, 1L), "factor") + + tbl <- rtabulate(factor(c("X", "X"), c("X", "Y")), cbf, length) + expect_identical(cells(tbl), c(1L, 1L, 0L, 0L), "factor") + + tbl <- rtabulate(factor(c("X", "Y"), c("X", "Y")), factor(c("a", "a"), c("a", "b")), length) + expect_identical(cells(tbl), c(1L, 0L, 1L, 0L), "factor") + + tbl <- rtabulate(factor(c("Y", "Y"), c("X", "Y")), factor(c("b", "b"), c("a", "b")), length) + expect_identical(cells(tbl), c(0L, 0L, 0L, 2L), "factor") + + +}) + + +test_that("rtabulate: col_wise_args argument", { + + get_elmts <- function(x, i) { + stopifnot(is(x, "rtable") && nrow(x) == 1) + as.vector(sapply(x[[1]], `[[`, i)) + } + + check_row1 <- function(x) { + expect_identical(get_elmts(x, 2), c(3, 2, 1)) + expect_identical(get_elmts(x, 3), LETTERS[1:3]) + } + + tbl1 <- rtabulate(1:3, factor(letters[1:3]), function(xi, a, b) { + list(xi, a, b) + }, col_wise_args = list(a = c(3, 2, 1), b = LETTERS[1:3]), row.name = "-") + + check_row1(tbl1) + + + tbl2 <- rtabulate((1:3)>2, factor(letters[1:3]), function(xi, a, b) { + list(xi, a, b) + }, col_wise_args = list(a = c(3, 2, 1), b = LETTERS[1:3]), row.name = "-") + + check_row1(tbl2) + + check_all_rows <- function(x) { + for (i in 1:nrow(x)) { + check_row1(x[i, ]) + } + } + + tbl3 <- rtabulate(factor(letters[1:3]), factor(letters[1:3]), function(xi, a, b) { + list(if (length(xi) == 0) "-" else xi, a, b) + }, col_wise_args = list(a = c(3, 2, 1), b = LETTERS[1:3])) + + check_all_rows(tbl3) + + df <- data.frame( + v1 = 1:3, v2 = 3:5 + ) + tbl4 <- rtabulate(df, factor(letters[1:3]), factor(LETTERS[1:3]), function(xi, a, b) { + list(nrow(xi), a, b) + }, col_wise_args = list(a = c(3, 2, 1), b = LETTERS[1:3])) + + check_all_rows(tbl4) + +}) diff --git a/vignettes/rtables.Rmd b/vignettes/rtables.Rmd index 1ae7f8884..7b39aaecc 100644 --- a/vignettes/rtables.Rmd +++ b/vignettes/rtables.Rmd @@ -4,11 +4,9 @@ author: "Adrian Waddell" date: "`r Sys.Date()`" output: rmarkdown::html_vignette vignette: > - %\VignetteIndexEntry{Vignette Title} + %\VignetteIndexEntry{Introduction to rtables} %\VignetteEncoding{UTF-8} %\VignetteEngine{knitr::rmarkdown} -editor_options: - chunk_output_type: console --- # Overview diff --git a/vignettes/rtabulate.Rmd b/vignettes/rtabulate.Rmd index 496fb8fb3..50d64e87b 100644 --- a/vignettes/rtabulate.Rmd +++ b/vignettes/rtabulate.Rmd @@ -2,11 +2,11 @@ title: "rtabulate" author: "Adrian Waddell" date: "3/21/2018" -output: - pdf_document: default - html_document: default -editor_options: - chunk_output_type: console +output: rmarkdown::html_vignette +vignette: > + %\VignetteIndexEntry{rtabulate} + %\VignetteEngine{knitr::rmarkdown} + \usepackage[utf8]{inputenc} --- ```{r setup, include=FALSE} @@ -22,9 +22,9 @@ library(rtables) `rtabulate` provides a number of methods to compute `rtable` tables. The idea behind `rtabulate` is to have a similar function to `tapply` which returns -rtables instead of lists. For example, for the iris data we might be interested -in the average `Sepal.Length` for each `Species` which can be answered with -`tapply` as follows: +rtables instead of lists or vectors. For example, for the iris data we might be +interested in the average `Sepal.Length` for each `Species` which can be +answered with `tapply` as follows: ```{r} attach(iris) @@ -109,11 +109,10 @@ rtabulate(x = esoph$agegp, col_by = esoph$alcgp) #### Tabulation based on Data Frames -`rtabulate.data.frame` has a `data.frame` as `x` argument and the `col_by_var` -and `row_by_var` need to specify which factor variables with `x` should be used -to split the data for the table rows and columns. By default the argument to -`FUN` is then a subset of `x` that is associated with a particular table cell. -Let's look at the `CO2` dataset: +`rtabulate.data.frame` has a `data.frame` as `x` argument and the `col_by` and +`row_by` need to specify how to split the data for the table rows and columns. +The argument to `FUN` is then a subset of `x` that is associated with a +particular table cell. Let's look at the `CO2` dataset: ```{r} head(CO2) @@ -122,48 +121,49 @@ head(CO2) Say we want to calculate the total `uptake` for each `Type` and `Treatment` ```{r} -rtabulate(x = CO2, row_by_var = "Type", col_by_var = "Treatment", +rtabulate(x = CO2, row_by = CO2$Type, col_by = CO2$Treatment, FUN = function(xi) sum(xi$uptake)) ``` -### Cell Data, Row Data, Column Data based Tabulation - -`rtabulate.numeric` and `rtabulate.logical` have the argument `row_data_arg` -which is by default set to `FALSE`. If set to `TRUE` then `FUN` receives a -second argument with a copy of the `x` argument (as the row-associated data is -the whole data for a `numeric` and `logical` vector). +### Column Wise Arguments +The arguments passed to the elipsis `...` in `rtabulate` are optional arguments +to `FUN`. This is the same behaviour as for the arguments passed to `...` in +`lapply` and `tapply`. This is useful, for example, when passing the `na.rm` +argument to `mean` ```{r} -rtabulate( - Sepal.Length, Species, - FUN = function(x_cell, x_row) c(length(x_cell), length(x_row)), - row_data_arg = TRUE, - format = "xx / xx", - row.name = "length of cell and row data" -) +x <- c(1, 2, 3, NA, 3, 2) +cb <- factor(c("A", "B", "A", "B", "B", "A")) + +rtabulate(x, cb, mean, na.rm = TRUE) ``` -Next, for `rtabulate.factor` and `rtabulate.data.frame` there is an -`row_col_data_args` which when set to `TRUE` then the `FUN` function receives -three arguments, the data that is associated with a table cell, row, column, -respectively. +Often, howewer, it is also useful to iterate over multiple collections as for +example is the case with the `...` in `mapply` and `Map`. That is, given a +collection `x` and `y` with each `p` elements, then we would like to evaluate +`FUN(x[i], y[i])` for `i` in `1` to `p`. In `rtabulate` this can be achieved +with the collections wrapped in a named list and passed to the `col_wise_args`. +For example: ```{r} -mtcars2 <- mtcars -mtcars2$gear <- factor(mtcars2$gear) -mtcars2$carb <- factor(mtcars2$carb) - -rtabulate( - x = mtcars2, row_by_var = "carb", col_by_var = "gear", - FUN = function(x_cell, x_row, x_col) c(nrow(x_cell), nrow(x_row), nrow(x_col)), - row_col_data_args = TRUE, - format = NULL -) +x <- c(1, 2, 3, NA, 3, 2) +cb <- factor(c("A", "A", "A", "B", "B", "A"), levels = c("A", "B")) + +tbl <- rtabulate(x, cb, FUN = function(xi, na.rm, N) { + list(mean(xi, na.rm=na.rm), N) +}, na.rm = TRUE, col_wise_args = list(N = table(cb)), row.name = "mean, N") + +tbl ``` Note that `format=NULL` is equivalent to `paste(x, collapse = ", ")` on the cell data structure. +In order to add a `(N=xx)` type of row to the header we can add `header_add_N` function: + +```{r} +header_add_N(tbl, table(cb)) +```