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 <- flextable(
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 % |
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 % |
library(htmltools)
ft <- flextable(head(iris))
tab_list <- list()
for(i in 1:3){
tab_list[[i]] <- tagList(
tags$h6(paste0("iteration ", i)),
htmltools_value(ft)
)
}
tagList(tab_list)
Sepal.Length | Sepal.Width | Petal.Length | Petal.Width | Species |
5.100 | 3.500 | 1.400 | 0.200 | setosa |
4.900 | 3.000 | 1.400 | 0.200 | setosa |
4.700 | 3.200 | 1.300 | 0.200 | setosa |
4.600 | 3.100 | 1.500 | 0.200 | setosa |
5.000 | 3.600 | 1.400 | 0.200 | setosa |
5.400 | 3.900 | 1.700 | 0.400 | setosa |
Sepal.Length | Sepal.Width | Petal.Length | Petal.Width | Species |
5.100 | 3.500 | 1.400 | 0.200 | setosa |
4.900 | 3.000 | 1.400 | 0.200 | setosa |
4.700 | 3.200 | 1.300 | 0.200 | setosa |
4.600 | 3.100 | 1.500 | 0.200 | setosa |
5.000 | 3.600 | 1.400 | 0.200 | setosa |
5.400 | 3.900 | 1.700 | 0.400 | setosa |
Sepal.Length | Sepal.Width | Petal.Length | Petal.Width | Species |
5.100 | 3.500 | 1.400 | 0.200 | setosa |
4.900 | 3.000 | 1.400 | 0.200 | setosa |
4.700 | 3.200 | 1.300 | 0.200 | setosa |
4.600 | 3.100 | 1.500 | 0.200 | setosa |
5.000 | 3.600 | 1.400 | 0.200 | setosa |
5.400 | 3.900 | 1.700 | 0.400 | setosa |
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 <- flextable(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 |
library(flextable)
library(magrittr)
col_palette <- c("#D73027", "#F46D43", "#FDAE61", "#FEE08B",
"#D9EF8B", "#A6D96A", "#66BD63", "#1A9850")
cor_matrix <- cor(mtcars)
mycut <- cut(
cor_matrix,
breaks = c(-1, -0.75, -0.5, -0.25, 0, 0.25, 0.5, 0.75, 1),
include.lowest = TRUE, label = FALSE)
mycolors <- col_palette[mycut]
data.frame(rowname = row.names(cor_matrix), stringsAsFactors = FALSE) %>%
cbind(cor_matrix) %T>%
print() %>%
flextable() %>%
bg(j = colnames(cor_matrix), bg = mycolors) %>%
align(align = "center", part = "all") %>%
compose(i = 1, j = 1, value = as_paragraph(""), part = "header")
#> rowname mpg cyl disp hp drat
#> mpg mpg 1.0000000 -0.8521620 -0.8475514 -0.7761684 0.68117191
#> cyl cyl -0.8521620 1.0000000 0.9020329 0.8324475 -0.69993811
#> disp disp -0.8475514 0.9020329 1.0000000 0.7909486 -0.71021393
#> hp hp -0.7761684 0.8324475 0.7909486 1.0000000 -0.44875912
#> drat drat 0.6811719 -0.6999381 -0.7102139 -0.4487591 1.00000000
#> wt wt -0.8676594 0.7824958 0.8879799 0.6587479 -0.71244065
#> qsec qsec 0.4186840 -0.5912421 -0.4336979 -0.7082234 0.09120476
#> vs vs 0.6640389 -0.8108118 -0.7104159 -0.7230967 0.44027846
#> am am 0.5998324 -0.5226070 -0.5912270 -0.2432043 0.71271113
#> gear gear 0.4802848 -0.4926866 -0.5555692 -0.1257043 0.69961013
#> carb carb -0.5509251 0.5269883 0.3949769 0.7498125 -0.09078980
#> wt qsec vs am gear carb
#> mpg -0.8676594 0.41868403 0.6640389 0.59983243 0.4802848 -0.55092507
#> cyl 0.7824958 -0.59124207 -0.8108118 -0.52260705 -0.4926866 0.52698829
#> disp 0.8879799 -0.43369788 -0.7104159 -0.59122704 -0.5555692 0.39497686
#> hp 0.6587479 -0.70822339 -0.7230967 -0.24320426 -0.1257043 0.74981247
#> drat -0.7124406 0.09120476 0.4402785 0.71271113 0.6996101 -0.09078980
#> wt 1.0000000 -0.17471588 -0.5549157 -0.69249526 -0.5832870 0.42760594
#> qsec -0.1747159 1.00000000 0.7445354 -0.22986086 -0.2126822 -0.65624923
#> vs -0.5549157 0.74453544 1.0000000 0.16834512 0.2060233 -0.56960714
#> am -0.6924953 -0.22986086 0.1683451 1.00000000 0.7940588 0.05753435
#> gear -0.5832870 -0.21268223 0.2060233 0.79405876 1.0000000 0.27407284
#> carb 0.4276059 -0.65624923 -0.5696071 0.05753435 0.2740728 1.00000000
mpg | cyl | disp | hp | drat | wt | qsec | vs | am | gear | carb | |
mpg | 1.000 | -0.852 | -0.848 | -0.776 | 0.681 | -0.868 | 0.419 | 0.664 | 0.600 | 0.480 | -0.551 |
cyl | -0.852 | 1.000 | 0.902 | 0.832 | -0.700 | 0.782 | -0.591 | -0.811 | -0.523 | -0.493 | 0.527 |
disp | -0.848 | 0.902 | 1.000 | 0.791 | -0.710 | 0.888 | -0.434 | -0.710 | -0.591 | -0.556 | 0.395 |
hp | -0.776 | 0.832 | 0.791 | 1.000 | -0.449 | 0.659 | -0.708 | -0.723 | -0.243 | -0.126 | 0.750 |
drat | 0.681 | -0.700 | -0.710 | -0.449 | 1.000 | -0.712 | 0.091 | 0.440 | 0.713 | 0.700 | -0.091 |
wt | -0.868 | 0.782 | 0.888 | 0.659 | -0.712 | 1.000 | -0.175 | -0.555 | -0.692 | -0.583 | 0.428 |
qsec | 0.419 | -0.591 | -0.434 | -0.708 | 0.091 | -0.175 | 1.000 | 0.745 | -0.230 | -0.213 | -0.656 |
vs | 0.664 | -0.811 | -0.710 | -0.723 | 0.440 | -0.555 | 0.745 | 1.000 | 0.168 | 0.206 | -0.570 |
am | 0.600 | -0.523 | -0.591 | -0.243 | 0.713 | -0.692 | -0.230 | 0.168 | 1.000 | 0.794 | 0.058 |
gear | 0.480 | -0.493 | -0.556 | -0.126 | 0.700 | -0.583 | -0.213 | 0.206 | 0.794 | 1.000 | 0.274 |
carb | -0.551 | 0.527 | 0.395 | 0.750 | -0.091 | 0.428 | -0.656 | -0.570 | 0.058 | 0.274 | 1.000 |
data.frame(rowname = row.names(cor_matrix), stringsAsFactors = FALSE) %>%
cbind(cor_matrix) %T>%
print() %>%
flextable() %>%
theme_box() %>%
compose(i = 1, j = 1, value = as_paragraph(""), part = "header") %>%
compose(j = colnames(cor_matrix), value = as_paragraph(""), part = "body") %>%
bg(j = colnames(cor_matrix), bg = mycolors) %>%
align(align = "center", part = "all") %>%
autofit()
#> rowname mpg cyl disp hp drat
#> mpg mpg 1.0000000 -0.8521620 -0.8475514 -0.7761684 0.68117191
#> cyl cyl -0.8521620 1.0000000 0.9020329 0.8324475 -0.69993811
#> disp disp -0.8475514 0.9020329 1.0000000 0.7909486 -0.71021393
#> hp hp -0.7761684 0.8324475 0.7909486 1.0000000 -0.44875912
#> drat drat 0.6811719 -0.6999381 -0.7102139 -0.4487591 1.00000000
#> wt wt -0.8676594 0.7824958 0.8879799 0.6587479 -0.71244065
#> qsec qsec 0.4186840 -0.5912421 -0.4336979 -0.7082234 0.09120476
#> vs vs 0.6640389 -0.8108118 -0.7104159 -0.7230967 0.44027846
#> am am 0.5998324 -0.5226070 -0.5912270 -0.2432043 0.71271113
#> gear gear 0.4802848 -0.4926866 -0.5555692 -0.1257043 0.69961013
#> carb carb -0.5509251 0.5269883 0.3949769 0.7498125 -0.09078980
#> wt qsec vs am gear carb
#> mpg -0.8676594 0.41868403 0.6640389 0.59983243 0.4802848 -0.55092507
#> cyl 0.7824958 -0.59124207 -0.8108118 -0.52260705 -0.4926866 0.52698829
#> disp 0.8879799 -0.43369788 -0.7104159 -0.59122704 -0.5555692 0.39497686
#> hp 0.6587479 -0.70822339 -0.7230967 -0.24320426 -0.1257043 0.74981247
#> drat -0.7124406 0.09120476 0.4402785 0.71271113 0.6996101 -0.09078980
#> wt 1.0000000 -0.17471588 -0.5549157 -0.69249526 -0.5832870 0.42760594
#> qsec -0.1747159 1.00000000 0.7445354 -0.22986086 -0.2126822 -0.65624923
#> vs -0.5549157 0.74453544 1.0000000 0.16834512 0.2060233 -0.56960714
#> am -0.6924953 -0.22986086 0.1683451 1.00000000 0.7940588 0.05753435
#> gear -0.5832870 -0.21268223 0.2060233 0.79405876 1.0000000 0.27407284
#> carb 0.4276059 -0.65624923 -0.5696071 0.05753435 0.2740728 1.00000000
mpg | cyl | disp | hp | drat | wt | qsec | vs | am | gear | carb | |
mpg | |||||||||||
cyl | |||||||||||
disp | |||||||||||
hp | |||||||||||
drat | |||||||||||
wt | |||||||||||
qsec | |||||||||||
vs | |||||||||||
am | |||||||||||
gear | |||||||||||
carb |
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.489 | ||
ethnicty | 3 | 47.241 | 96 | 82.248 |
grade | 1 | 1.730 | 95 | 80.518 |
ethnicty:grade | 3 | 7.201 | 92 | 73.317 |
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") ){
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)
superfp <- fp_text(vertical.align = "superscript", font.size = 8)
ft <- compose(ft, i = 1, j = "X1", part = "header",
value = as_paragraph("R", as_chunk("2", props = superfp)) )
ft <- compose(ft, i = 1, j = "X2", part = "header",
value = as_paragraph("\u03BC", as_chunk("x", props = superfp)))
ft <- compose(ft, i = 1, j = "rowname", part = "header",
value = as_paragraph("y", as_chunk("t-1", props = superfp)))
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 | |
1 | 0.900 | 0.890 | 200.000 | 0.045 | 2.000 |
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) %>%
flextable() %>%
theme_booktabs() %>%
htmltools_value()
})
}
# Run the application
shinyApp(ui = ui, server = server)