It tabulates a data.frame representing an aggregation which is then transformed as a flextable. The function allows to define any display with the syntax of flextable in a table whose layout is showing dimensions of the aggregation across rows and columns.
Arguments
- x
an aggregated data.frame
- rows
column names to use in rows dimensions
- columns
column names to use in columns dimensions
- datasup_first
additional data that will be merged with table and placed after the columns presenting the row dimensions.
- datasup_last
additional data that will be merged with table and placed at the end of the table.
- hidden_data
additional data that will be merged with table, the columns are not presented but can be used with
compose()ormk_par()function.- row_compose
a list of call to
as_paragraph()- these calls will be applied to the row dimensions (the name is used to target the displayed column).- ...
named arguments calling function
as_paragraph(). The names are used as labels and the values are evaluated when the flextable is created.- object
an object returned by function
tabulator().
Value
an object of class tabulator.
Methods (by generic)
summary(tabulator): callsummary()to get a data.frame describing mappings between variables and their names in the flextable. This data.frame contains a column namedcol_keyswhere are stored the names that can be used for further selections.
Note
This is very first version of the function; be aware it can evolve or change.
Illustrations
ft_1 appears as:
ft_2 appears as:
Examples
n_format <- function(z){
x <- sprintf("%.0f", z)
x[is.na(z)] <- "-"
x
}
set_flextable_defaults(digits = 2, border.color = "gray")
if(require("stats")){
dat <- aggregate(breaks ~ wool + tension,
data = warpbreaks, mean)
cft_1 <- tabulator(
x = dat, rows = "wool",
columns = "tension",
`mean` = as_paragraph(as_chunk(breaks)),
`(N)` = as_paragraph(
as_chunk(length(breaks), formatter = n_format ))
)
ft_1 <- as_flextable(cft_1)
ft_1
}
#> a flextable object.
#> col_keys: `wool`, `dummy1`, `@L@mean`, `@L@(N)`, `dummy2`, `@M@mean`, `@M@(N)`, `dummy3`, `@H@mean`, `@H@(N)`
#> header has 2 row(s)
#> body has 2 row(s)
#> original dataset sample:
#> wool breaks@L breaks@M breaks@H mean@L mean@M mean@H (N)@L (N)@M (N)@H dummy1
#> 1 A 44.55556 24.00000 24.55556
#> 2 B 28.22222 28.77778 18.77778
#> @L@mean @L@(N) dummy2 @M@mean @M@(N) dummy3 @H@mean @H@(N)
#> 1
#> 2
if(require("data.table") && require("ggplot2")){
multi_fun <- function(x) {
list(mean = mean(x),
sd = sd(x))
}
myformat <- function(z){
x <- sprintf("%.1f", z)
x[is.na(z)] <- ""
x
}
grey_txt <- fp_text_default(color = "gray")
dat <- as.data.table(ggplot2::diamonds)
dat <- dat[cut %in% c("Fair", "Good", "Very Good")]
dat <- dat[clarity %in% c("I1", "SI1", "VS2")]
dat <- dat[, unlist(lapply(.SD, multi_fun),
recursive = FALSE),
.SDcols = c("z", "y"),
by = c("cut", "color", "clarity")]
tab_2 <- tabulator(
x = dat, rows = c("cut", "color"),
columns = "clarity",
`z stats` = as_paragraph(
as_chunk(z.mean, formatter = myformat)),
`y stats` = as_paragraph(
as_chunk(y.mean, formatter = myformat),
as_chunk(" (\u00B1 ", props = grey_txt),
as_chunk(y.sd, formatter = myformat, props = grey_txt),
as_chunk(")", props = grey_txt)
)
)
ft_2 <- as_flextable(tab_2)
ft_2 <- autofit(x = ft_2, add_w = .05)
ft_2
}
#> a flextable object.
#> col_keys: `cut`, `color`, `dummy1`, `@I1@z stats`, `@I1@y stats`, `dummy2`, `@SI1@z stats`, `@SI1@y stats`, `dummy3`, `@VS2@z stats`, `@VS2@y stats`
#> header has 2 row(s)
#> body has 21 row(s)
#> original dataset sample:
#> cut color z.mean@I1 z.mean@SI1 z.mean@VS2 z.sd@I1 z.sd@SI1 z.sd@VS2
#> 1 Fair D 4.905000 3.864828 3.704800 0.9796768 0.4383792 0.4685449
#> 2 Fair E 4.008889 3.739077 3.529286 0.3876030 0.5040763 0.5245551
#> 3 Fair F 4.000857 3.726506 3.593774 0.7043536 0.5419464 0.4990191
#> 4 Fair G 4.233962 3.852319 3.955556 0.7219374 0.4371907 0.4868617
#> 5 Fair H 4.549231 4.110533 3.975122 0.7059102 0.5221341 0.5877462
#> y.mean@I1 y.mean@SI1 y.mean@VS2 y.sd@I1 y.sd@SI1 y.sd@VS2 z stats@I1
#> 1 7.422500 5.957069 5.886800 1.4170009 0.6556823 0.7054828
#> 2 6.061111 5.903692 5.449524 0.4297221 0.8057694 0.7673392
#> 3 6.040571 5.871325 5.626226 1.0820350 0.8438367 0.6970742
#> 4 6.434906 5.922754 6.137333 1.0849683 0.6362248 0.7873442
#> 5 6.858462 6.355467 6.161220 1.0348428 0.8221269 0.9045750
#> z stats@SI1 z stats@VS2 y stats@I1 y stats@SI1 y stats@VS2 dummy1 @I1@z stats
#> 1
#> 2
#> 3
#> 4
#> 5
#> @I1@y stats dummy2 @SI1@z stats @SI1@y stats dummy3 @VS2@z stats @VS2@y stats
#> 1
#> 2
#> 3
#> 4
#> 5
if(require("data.table")){
#' # data.table version
dat <- melt(as.data.table(iris),
id.vars = "Species",
variable.name = "name",value.name = "value")[,
list(avg = mean(value, na.rm = TRUE),
sd = sd(value, na.rm = TRUE)),
by = c("Species", "name")
]
# dplyr version
# library(dplyr)
# dat <- iris %>%
# pivot_longer(cols = -c(Species)) %>%
# group_by(Species, name) %>%
# summarise(avg = mean(value, na.rm = TRUE),
# sd = sd(value, na.rm = TRUE),
# .groups = "drop")
tab_3 <- tabulator(
x = dat, rows = c("Species"),
columns = "name",
`mean (sd)` = as_paragraph( as_chunk(avg),
" (", as_chunk(sd), ")")
)
ft_3 <- as_flextable(tab_3, separate_with = character(0))
ft_3
}
#> a flextable object.
#> col_keys: `Species`, `dummy1`, `Sepal.Length@mean (sd)`, `dummy2`, `Sepal.Width@mean (sd)`, `dummy3`, `Petal.Length@mean (sd)`, `dummy4`, `Petal.Width@mean (sd)`
#> header has 1 row(s)
#> body has 3 row(s)
#> original dataset sample:
#> Species avg@Sepal.Length avg@Sepal.Width avg@Petal.Length avg@Petal.Width
#> 1 setosa 5.006 3.428 1.462 0.246
#> 2 versicolor 5.936 2.770 4.260 1.326
#> 3 virginica 6.588 2.974 5.552 2.026
#> sd@Sepal.Length sd@Sepal.Width sd@Petal.Length sd@Petal.Width
#> 1 0.3524897 0.3790644 0.1736640 0.1053856
#> 2 0.5161711 0.3137983 0.4699110 0.1977527
#> 3 0.6358796 0.3224966 0.5518947 0.2746501
#> mean (sd)@Sepal.Length mean (sd)@Sepal.Width mean (sd)@Petal.Length
#> 1
#> 2
#> 3
#> mean (sd)@Petal.Width dummy1 Sepal.Length@mean (sd) dummy2
#> 1
#> 2
#> 3
#> Sepal.Width@mean (sd) dummy3 Petal.Length@mean (sd) dummy4
#> 1
#> 2
#> 3
#> Petal.Width@mean (sd)
#> 1
#> 2
#> 3
init_flextable_defaults()