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
#> 9 chain_ladder_lr Chain Ladder Ultimate LR (%\n)
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) | ( %) | (% ) | |||
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) | ( %) | (% ) | ||||||
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) | ( %) | (% ) | ||||||
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) | ( %) | (% ) | ||||||
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 % |
Cape Cod |
| Chain Ladder | ||||||
Year | Premium | Latest Eval |
| Ultimate Loss | Ultimate LR |
| Ultimate Loss | Ultimate LR |
| (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 % |
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 |
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 |
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 |
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 |
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 |
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 | 2 | 3 | 3 | 4 |
1955 | 5 | 5 | 6 | 5 | 7 | 8 | 8 | 9 | 10 | 13 | 12 | 11 |
1956 | 11 | 14 | 14 | 14 | 13 | 14 | 15 | 15 | 14 | 15 | 15 | 17 |
1957 | 18 | 21 | 22 | 23 | 24 | 26 | 26 | 27 | 26 | 28 | 30 | 31 |
1958 | 33 | 32 | 32 | 32 | 35 | 34 | 34 | 33 | 36 | 37 | 37 | 37 |
1959 | 38 | 40 | 43 | 45 | 46 | 48 | 49 | 51 | 53 | 54 | 55 | 57 |
1960 | 60 | 60 | 60 | 63 | 64 | 64 | 65 | 67 | 69 | 69 | 72 | 71 |
1961 | 72 | 73 | 75 | 77 | 78 | 78 | 81 | 82 | 84 | 86 | 87 | 89 |
1962 | 90 | 91 | 91 | 92 | 92 | 94 | 97 | 98 | 99 | 101 | - | - |
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 |
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)