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.

tabulator(
  x,
  rows,
  columns,
  datasup_first = NULL,
  datasup_last = NULL,
  hidden_data = NULL,
  row_compose = list(),
  ...
)

# S3 method for tabulator
summary(object, ...)

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() or mk_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): call summary() to get a data.frame describing mappings between variables and their names in the flextable. This data.frame contains a column named col_keys where 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()