Breaking up a flextable output into mini-tables-CodePudding

This might be unworkable but...

I am generating a simple flextable in Rmd for a Word output. The table contains only three columns with Column C used to colour fill the rows. Here is a short example

library(tidyverse)
library(flextable)

data_short <- tibble::tribble(
          ~Col.A,   ~Col.B, ~Col.C,
              1L, "Item A",    "A",
              2L, "Item B",    "A",
              3L, "Item C",    "D",
              4L, "Item D",    "C",
)

data_short %>% 
  flextable() %>%
  bg(i = ~ Col.C == "C", j = 1:3, bg = '#FF9999',  part = "body") %>% 
  bg(i = ~ Col.C == "D", j = 1:3, bg = '#FF0000',  part = "body")

The problem is that I'm likely to have much more than 5 rows. Now, I don't want the output to be just a page with one big long table such as this...

data_long <- tibble::tribble(
               ~Col.A,   ~Col.B, ~Col.C,
                   1L, "Item A",    "A",
                   2L, "Item B",    "A",
                   3L, "Item C",    "D",
                   4L, "Item D",    "C",
                   5L, "Item E",    "A",
                   6L, "Item F",    "A",
                   7L, "Item G",    "A",
                   8L, "Item H",    "B",
                   9L, "Item I",    "C",
                  10L, "Item J",    "B",
                  11L, "Item K",    "A",
                  12L, "Item L",    "A",
                  13L, "Item M",    "D",
                  14L, "Item N",    "C",
                  15L, "Item O",    "D"
               )

data_long %>% 
  flextable() %>%
  bg(i = ~ Col.C == "C", j = 1:3, bg = '#FF9999',  part = "body") %>% 
  bg(i = ~ Col.C == "D", j = 1:3, bg = '#FF0000',  part = "body")

Rather, I like to be able to break up the table somehow. Split it across three mini-tables and make the maximum use of the space on the page. Something like this...

Is this even possible or am I asking for too much here?

CodePudding user response：

Here is a solution using function tabulator().

library(dplyr)
#> 
#> Attachement du package : 'dplyr'
#> Les objets suivants sont masqués depuis 'package:stats':
#> 
#>     filter, lag
#> Les objets suivants sont masqués depuis 'package:base':
#> 
#>     intersect, setdiff, setequal, union
library(flextable)

data_long <- tibble::tribble(
  ~Col.A, ~Col.B, ~Col.C,
  1L, "Item A", "A",
  2L, "Item B", "A",
  3L, "Item C", "D",
  4L, "Item D", "C",
  5L, "Item E", "A",
  6L, "Item F", "A",
  7L, "Item G", "A",
  8L, "Item H", "B",
  9L, "Item I", "C",
  10L, "Item J", "B",
  11L, "Item K", "A",
  12L, "Item L", "A",
  13L, "Item M", "D",
  14L, "Item N", "C",
  15L, "Item O", "D") %>%
  mutate(
    group = cut(
      seq_len(n()), 3, labels = paste("Set", 1:3))
  ) %>%
  group_by(group) %>%
  mutate(row = seq_len(n()))
data_long
#> # A tibble: 15 × 5
#> # Groups:   group [3]
#>    Col.A Col.B  Col.C group   row
#>    <int> <chr>  <chr> <fct> <int>
#>  1     1 Item A A     Set 1     1
#>  2     2 Item B A     Set 1     2
#>  3     3 Item C D     Set 1     3
#>  4     4 Item D C     Set 1     4
#>  5     5 Item E A     Set 1     5
#>  6     6 Item F A     Set 2     1
#>  7     7 Item G A     Set 2     2
#>  8     8 Item H B     Set 2     3
#>  9     9 Item I C     Set 2     4
#> 10    10 Item J B     Set 2     5
#> 11    11 Item K A     Set 3     1
#> 12    12 Item L A     Set 3     2
#> 13    13 Item M D     Set 3     3
#> 14    14 Item N C     Set 3     4
#> 15    15 Item O D     Set 3     5

colfun <- function(z) {
  cols <- rep("transparent", length(z))
  cols[z %in% "C"] <- "#FF9999"
  cols[z %in% "D"] <- "#FF0000"
  cols
}


tab <- tabulator(
  x = data_long,
  rows = "row",
  columns = "group",
  `Col A` = as_paragraph(Col.A),
  `Col B` = as_paragraph(Col.B),
  `Col C` = as_paragraph(Col.C),
)

visibles_a <- tabulator_colnames(tab, columns = "Col A", type = "columns")
visibles_b <- tabulator_colnames(tab, columns = "Col B", type = "columns")
visibles_c <- tabulator_colnames(tab, columns = "Col C", type = "columns")

hidden_a <- tabulator_colnames(tab, columns = "Col.A", type = "hidden")
hidden_b <- tabulator_colnames(tab, columns = "Col.B", type = "hidden")
hidden_c <- tabulator_colnames(tab, columns = "Col.C", type = "hidden")

ft <- as_flextable(tab)
ft <- bg(
  x = ft,
  j = visibles_c,
  bg = colfun,
  source = hidden_c,
  part = "body"
) %>%
  bg(
    j = visibles_b,
    bg = colfun,
    source = hidden_c,
    part = "body"
  ) %>%
  bg(
    j = visibles_a,
    bg = colfun,
    source = hidden_c,
    part = "body"
  )

^{Created on 2022-09-13 with}