# 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

|  |  |  | Cape Cod | Cape Cod |  | Chain Ladder | Chain Ladder
Year | Premium | Latest Eval |  | Ultimate Loss | Ultimate LR |  | Ultimate Loss | Ultimate LR
Year | Premium | Latest Eval |  | (000) | (%) |  | (000) | (%)
2001 | 8.920 | 4.492 |  | 6998 | 60 |  | 4.970 | 69.34 %
2002 | 12.661 | 5.166 |  | 7058 | 69 |  | 5.980 | 69.06 %
2003 | 8.758 | 6.222 |  | 6923 | 69 |  | 6.393 | 71.40 %
2004 | 9.853 | 5.334 |  | 6916 | 83 |  | 4.401 | 70.24 %

    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

| Cape Cod |  | Chain Ladder
Year | Premium | Latest Eval |  | Ultimate Loss | Ultimate LR |  | Ultimate Loss | Ultimate LR
| (000) | (%) |  | (000) | (%)
2001 | 8.920 | 4.492 |  | 6998 | 60 |  | 4.970 | 69.34 %
2002 | 12.661 | 5.166 |  | 7058 | 69 |  | 5.980 | 69.06 %
2003 | 8.758 | 6.222 |  | 6923 | 69 |  | 6.393 | 71.40 %
2004 | 9.853 | 5.334 |  | 6916 | 83 |  | 4.401 | 70.24 %

    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

| Cape Cod |  | Chain Ladder
Year | Premium | Latest Eval |  | Ultimate Loss | Ultimate LR |  | Ultimate Loss | Ultimate LR
| (000) | (%) |  | (000) | (%)
2001 | 8.920 | 4.492 |  | 6998 | 60 |  | 4.970 | 69.34 %
2002 | 12.661 | 5.166 |  | 7058 | 69 |  | 5.980 | 69.06 %
2003 | 8.758 | 6.222 |  | 6923 | 69 |  | 6.393 | 71.40 %
2004 | 9.853 | 5.334 |  | 6916 | 83 |  | 4.401 | 70.24 %

    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

| Cape Cod |  | Chain Ladder
Year | Premium | Latest Eval |  | Ultimate Loss | Ultimate LR |  | Ultimate Loss | Ultimate LR
| (000) | (%) |  | (000) | (%)
2001 | 8.920 | 4.492 |  | 6998 | 60 |  | 4.970 | 69.34 %
2002 | 12.661 | 5.166 |  | 7058 | 69 |  | 5.980 | 69.06 %
2003 | 8.758 | 6.222 |  | 6923 | 69 |  | 6.393 | 71.40 %
2004 | 9.853 | 5.334 |  | 6916 | 83 |  | 4.401 | 70.24 %

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

| Cape Cod |  | Chain Ladder
Year | Premium | Latest Eval |  | Ultimate Loss | Ultimate LR |  | Ultimate Loss | Ultimate LR
| (000) | (%) |  | (000) | (%)
2001 | 8.920 | 4.492 |  | 6998 | 60 |  | 4.970 | 69.34 %
2002 | 12.661 | 5.166 |  | 7058 | 69 |  | 5.980 | 69.06 %
2003 | 8.758 | 6.222 |  | 6923 | 69 |  | 6.393 | 71.40 %
2004 | 9.853 | 5.334 |  | 6916 | 83 |  | 4.401 | 70.24 %

## 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

mpg | cyl | disp | hp | drat | wt | qsec | vs | am | gear | carb
21.000 | 6.000 | 160.000 | 110.000 | 3.900 | 2.620 | 16.460 | 0.000 | 1.000 | 4.000 | 4.000
21.000 | 6.000 | 160.000 | 110.000 | 3.900 | 2.875 | 17.020 | 0.000 | 1.000 | 4.000 | 4.000
22.800 | 4.000 | 108.000 | 93.000 | 3.850 | 2.320 | 18.610 | 1.000 | 1.000 | 4.000 | 1.000
21.400 | 6.000 | 258.000 | 110.000 | 3.080 | 3.215 | 19.440 | 1.000 | 0.000 | 3.000 | 1.000
18.700 | 8.000 | 360.000 | 175.000 | 3.150 | 3.440 | 17.020 | 0.000 | 0.000 | 3.000 | 2.000
18.100 | 6.000 | 225.000 | 105.000 | 2.760 | 3.460 | 20.220 | 1.000 | 0.000 | 3.000 | 1.000

## xtable objects

### anova

    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
    }

| Df | Deviance | Resid. Df | Resid. Dev
NULL |  |  | 99 | 129.49
ethnicty | 3 | 47.24 | 96 | 82.25
grade | 1 | 1.73 | 95 | 80.52
ethnicty:grade | 3 | 7.20 | 92 | 73.32

### adding horizontal lines

    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
    }

| 1 | 2
1 | 1 | 6
2 | 2 | 7
3 | 3 | 8
4 | 4 | 9
5 | 5 | 10

### rotate columns

    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
    }

grade | sex | disadvg | ethnicty | tlimth
6 | M | YES | HISPANIC | 43
7 | M | NO | BLACK | 88
5 | F | YES | HISPANIC | 34
3 | M | YES | HISPANIC | 65
8 | M | YES | WHITE | 75
5 | M | NO | BLACK | 74
8 | F | YES | HISPANIC | 72
4 | M | YES | BLACK | 79
6 | M | NO | WHITE | 88
7 | M | YES | HISPANIC | 87

### tables

    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
    }

| Grade 6
Grade 3 | A | B | C | D
A | 1 | 1 | 1 | 0
B | 2 | 1 | 1 | 2
C | 1 | 2 | 2 | 2
D | 0 | 1 | 1 | 2

### time series

    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
    }

| Jan | Feb | Mar | Apr | May | Jun | Jul | Aug | Sep | Oct | Nov | Dec
1954 | - | - | - | - | - | - | 0 | 1 | 3 | 4 | 6 | 7
1955 | 9 | 9 | 11 | 12 | 11 | 13 | 15 | 17 | 17 | 17 | 18 | 19
1956 | 20 | 22 | 23 | 24 | 24 | 27 | 27 | 27 | 26 | 27 | 28 | 30
1957 | 31 | 31 | 32 | 33 | 33 | 33 | 33 | 33 | 33 | 34 | 34 | 37
1958 | 36 | 36 | 37 | 38 | 38 | 40 | 43 | 45 | 48 | 51 | 49 | 50
1959 | 54 | 53 | 54 | 55 | 58 | 61 | 62 | 63 | 64 | 66 | 64 | 65
1960 | 67 | 69 | 71 | 72 | 75 | 75 | 76 | 78 | 78 | 79 | 82 | 84
1961 | 84 | 83 | 83 | 83 | 83 | 85 | 86 | 86 | 87 | 88 | 89 | 89
1962 | 88 | 90 | 89 | 89 | 91 | 90 | 91 | 91 | 90 | 92 | - | -

### from scratch

    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"

| R2 | μx | F-stat | S.E.E | DW
yt-1 | 0.90 | 0.89 | 200.00 | 0.04 | 2.00

## 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)