flextable examples

Complex header

The following dataset is typology, a dataset containing data for table headers.

#>           col_keys         colC          colB        colA
#> 1            sep_1                                       
#> 2            sep_2                                       
#> 3             year                       Year        Year
#> 4          premium                    Premium     Premium
#> 5      latest_eval                Latest Eval Latest Eval
#> 6     cape_cod_u_l     Cape Cod Ultimate Loss       (000)
#> 7      cape_cod_lr     Cape Cod   Ultimate LR         (%)
#> 8 chain_ladder_u_l Chain Ladder Ultimate Loss       (000)
#> 9  chain_ladder_lr Chain Ladder   Ultimate LR         (%)

The following dataset is x, it will be displayed in the table body.

#>   year   premium latest_eval cape_cod_u_l cape_cod_lr chain_ladder_u_l
#> 1 2001  8.920428    4.492365         6998          60         4.970296
#> 2 2002 12.660827    5.165556         7058          69         5.980417
#> 3 2003  8.757757    6.221537         6923          69         6.392572
#> 4 2004  9.852580    5.334078         6916          83         4.400530
#>   chain_ladder_lr
#> 1        69.33936
#> 2        69.06072
#> 3        71.40414
#> 4        70.23848

double_format <- function(x){
  sprintf("%.3f", x)
}
percent_format <- function(x){
  sprintf("%.2f %%", x)
}
ft <- regulartable(
  x, col_keys = c("year", "premium", "latest_eval",
                  "sep_1", "cape_cod_u_l", "cape_cod_lr",
                  "sep_2", "chain_ladder_u_l", "chain_ladder_lr") )
ft <- set_formatter(ft, premium = double_format, latest_eval = double_format,
                    chain_ladder_lr = percent_format )
ft <- set_header_df(ft, mapping = typology, key = "col_keys" )
ft <- theme_box(ft)
ft

ft <- merge_h(ft, part = "header")
ft <- merge_v(ft, part = "header", j = 1:3)
ft <- theme_zebra(ft, odd_header = "transparent", even_header = "transparent")
ft

ft <- fontsize(ft, size = 11, part = "all")
ft <- fontsize(ft, i = 1:2, size = 12, part = "header")
ft <- color(ft, i = 1:2, color = "#007FA6", part = "header")
ft <- fontsize(ft, i = 3, size = 9, part = "header")
ft <- color(ft, i = 3, color = "gray", part = "header")
ft

ft <- hline(ft, border = fp_border(width = .75, color = "#007FA6"), part = "body" )

ft <- hline(ft, border = fp_border(width = 2, color = "#007FA6"), part = "header" )
ft

ft <- empty_blanks(ft)
ft <- autofit(ft)
ft

Conditional formatting

Formatting functions accept arguments i and j to select rows and columns to format. These arguments support formulas, index, logical (and character for columns’ names).

ft <- regulartable(head(mtcars))
ft <- color(ft, i = ~ drat > 3, j = ~ vs + am, color = "red")
ft <- bg(ft, i = ~ wt < 3, j = ~ mpg, bg = "#EFEF99")
ft <- bold(ft, i = 2:4, j = "cyl", bold = TRUE)
ft

xtable objects

if( require("xtable") ){
  data(tli)
  fm3 <- glm(disadvg ~ ethnicty*grade, data = tli, family = binomial)
  ft <- xtable_to_flextable(xtable(anova(fm3)), hline.after = c(1))
  ft
}

if( require("xtable") ){
  bktbs <- xtable(matrix(1:10, ncol = 2))
  hlines <- c(-1, 0, 1, nrow(bktbs))
  ft <- xtable_to_flextable(bktbs, hline.after = hlines)
  ft
}

if( require("xtable") ){

  data(tli)
  tli.table <- xtable(tli[1:10, ])
  xtable::align(tli.table) <- "|r|r|clr|r|"
  ft <- xtable_to_flextable(
    tli.table, 
    rotate.colnames = TRUE, 
    include.rownames = FALSE)
  
  ft <- height(ft, i = 1, part = "header", height = 1)
  ft
}

if( require("xtable") ){

  Grade3 <- c("A","B","B","A","B","C","C","D","A","B",
    "C","C","C","D","B","B","D","C","C","D")
  Grade6 <- c("A","A","A","B","B","B","B","B","C","C",
    "A","C","C","C","D","D","D","D","D","D")
  Cohort <- table(Grade3, Grade6)
  ft <- xtable_to_flextable(xtable(Cohort))
  ft <- set_header_labels(ft, rowname = "Grade 3")
  ft <- autofit(ft)
  ft <- add_header(ft, A = "Grade 6") 
  ft <- merge_at(ft, i = 1, j = seq_len( ncol(Cohort) ) + 1, 
    part = "header" ) 
  ft <- bold(ft, j = 1, bold = TRUE, part = "body")
  ft <- height_all(ft, part = "header", height = .4)
  ft
}

if( require("xtable") ){
  temp.ts <- ts(cumsum(1 + round(rnorm(100), 0)),
    start = c(1954, 7), frequency = 12)
  ft <- xtable_to_flextable(x = xtable(temp.ts, digits = 0),
    NA.string = "-")
  ft
}

if( require("xtable") ){
  mat <- round(matrix(c(0.9, 0.89, 200, 0.045, 2.0), c(1, 5)), 4)
  mat <- xtable(mat)
  ft <- xtable_to_flextable(x = mat, NA.string = "-")
  print(ft$col_keys)
  ft <- flextable::display(ft, i = 1, col_key = "X1", 
    pattern = "{{val}}{{pow}}", part = "header",
    formatters = list(val ~ as.character("R"), pow ~ as.character("2") ),
    fprops = list(pow = fp_text(vertical.align = "superscript", font.size = 8))
    )
  ft <- flextable::display(ft, i = 1, col_key = "X2", 
    pattern = "{{val}}{{pow}}", part = "header",
    formatters = list(val ~ as.character("\u03BC"), pow ~ as.character("x") ),
    fprops = list(pow = fp_text(vertical.align = "superscript", font.size = 8))
    )
  ft <- flextable::display(ft, i = 1, col_key = "rowname", 
    pattern = "{{val}}{{pow}}", part = "body",
    formatters = list(val ~ as.character("y"), pow ~ as.character("t-1") ),
    fprops = list(pow = fp_text(vertical.align = "subscript", font.size = 8))
    )
  ft <- set_header_labels(ft, X3 = "F-stat", X4 = "S.E.E", X5 = "DW", rowname = "")
  ft <- autofit(ft)
  ft
}
#> [1] "rowname" "X1"      "X2"      "X3"      "X4"      "X5"

Using within shiny applications

Use function htmltools_value() to get the html value of the flextable (suitable for an uiOutput).

library(shiny)
library(flextable)

ui <- fluidPage(
  
  titlePanel("mtcars"),
  sidebarLayout(
    sidebarPanel(
      sliderInput("mpg", "mpg Limit", min = 11, max = 33, value = 20)
    ),
    mainPanel(
      uiOutput("mtcars_ft")
    )
  )
)

server <- function(input, output) {
  library(dplyr)
  output$mtcars_ft <- renderUI({
    req(input$mpg)
    mtcars %>%
      mutate(car = rownames(.)) %>%
      select(car, everything()) %>%
      filter(mpg <= input$mpg) %>%
      regulartable() %>%
      theme_booktabs() %>% 
      htmltools_value()
  })
}

# Run the application
shinyApp(ui = ui, server = server)