Introduction
Plusieurs packages permettent de mettre en forme les tables, dont kable, formattable, DT et reactable.
library("dplyr")
library("knitr")
library("kableExtra")
library("DT")
library("formattable")
library("reactable")
library("htmltools")
library("sparkline")
# une table avec des rownames et pas mal de colonnes
mtcars2 = mtcars %>% tibble::rownames_to_column(var = "modeles") %>%
tidyr::separate(modeles, into = c("marque", "modeles"), sep = " ", extra = "merge") %>%
filter(!is.na(modeles)) %>% tibble::column_to_rownames(var = "modeles") %>%
select(marque, mpg, cyl, disp, hp, drat)
# une table a 3 lignes
lignes_gardees = c(15, 131, 140)
ma_table = cbind(iris[lignes_gardees,-5]-1.5, Species = iris[lignes_gardees, "Species"])
ma_table$Petal.Width = abs(ma_table$Petal.Width)
rownames(ma_table) = NULLMises en forme simples avec
kable
kable(ma_table)| Sepal.Length | Sepal.Width | Petal.Length | Petal.Width | Species |
|---|---|---|---|---|
| 4.3 | 2.5 | -0.3 | 1.3 | setosa |
| 5.9 | 1.3 | 4.6 | 0.4 | virginica |
| 5.4 | 1.6 | 3.9 | 0.6 | virginica |
DT
datatable(ma_table)reactable
reactable(ma_table)Mises en forme complexes avec
kable et kableExtra
kable(ma_table, format = "html") %>% kable_styling(c("striped", "bordered")) %>%
add_header_above(c("Sepal" = 2, "Petal" = 2, "Species" = 1)) %>%
add_header_above(c("numeric" = 4, "character" = 1)) %>% add_header_above(c( "all" = 5))| Sepal.Length | Sepal.Width | Petal.Length | Petal.Width | Species |
|---|---|---|---|---|
| 4.3 | 2.5 | -0.3 | 1.3 | setosa |
| 5.9 | 1.3 | 4.6 | 0.4 | virginica |
| 5.4 | 1.6 | 3.9 | 0.6 | virginica |
DT
Script R base sur la documentation Javascript :
- configuration pour certaines colonnes https://rstudio.github.io/DT/options.html
- pour ajouter un bouton
datatable(data = mtcars2,
# on enleve les rownames et on ajoute un bouton
rownames = FALSE,
extensions = 'Buttons',
### parametrage des options
options = list(pageLength = 5,
# texte a afficher en francais plutot qu'en anglais
language = list(
info = 'Extrait des enregistrements de _START_ a _END_',
paginate = list(previous = 'Precedent', `next` = 'Suivant'),
sLengthMenu = "Afficher _MENU_ elements"),
# on masque les colonnes 4 et 5
columnDefs = list(list(visible = FALSE,
targets = c(4,5))),
# elements a afficher parmi les 5 "lftip " qui constituent le
# Document Object Model :
# l = Length menu, f = Filtering box, t = Table, i = Information summary,
# p = Pagination control. On peut mettre un B pour ajouter un bouton
dom = 'Btip',
# extend pour le type du bouton qui va masquer certaines des 5 1eres colonnes
buttons = list(list(extend = 'colvis',
className = "btn btn-default",
text = "Afficher / cacher des colonnes",
columns = c(0:4))),
# echappement du code HTML pour eviter pb de securite
escape = TRUE,
# jolies couleurs pr l'entete, avec du javascript,
# mais ca ne marche pas dans ce markdown qui impose son vert cayman :-)
initComplete = DT::JS(
"function(settings, json) {",
"$(this.api().table().header()).css({'background-color': '#428bca',
'color': '#fff'});","}")))reactable
reactable(
mtcars2,
filterable = TRUE,
searchable = TRUE,
highlight = TRUE,
bordered = TRUE,
striped = TRUE,
fullWidth = FALSE,
defaultColDef = colDef(minWidth = 140),
defaultSorted = list(marque = "asc", cyl = "desc"),
columnGroups = list(
colGroup(name = "groupe 1", columns = c("marque", "mpg")),
colGroup(name = "groupe 2", columns = c("disp", "hp", "drat"))))Lignes regroupees / agregees avec
reactable
resume = mtcars2 %>% count(marque, cyl) %>% filter(n > 1) %>% mutate(n = NULL) %>% as.data.frame
reactable(resume, details = function(index) {
subset <- mtcars2[mtcars2$marque == resume[index, "marque"] &
mtcars2$cyl == resume[index, "cyl"], c("marque", "cyl", "mpg", "disp", "hp", "drat")]
htmltools::div(style = "padding: 16px",
reactable(subset, outlined = TRUE))})reactable et le package sparkline
On etudie le champ Sepal.Length, les mini-graphiques affichent des infobulles au passage de la souris.
set.seed(2018)
lignes_gardees = sample(1:150,30)
iris_liste <- iris[lignes_gardees,] %>% group_by(Species) %>%
summarise(moyenne = scales::number(mean(Sepal.Width), accuracy = 0.1),
barplot = list(Sepal.Length)) %>%
mutate(sparkline = NA, boxplot = NA)
reactable(iris_liste, columns = list(
sparkline = colDef(cell = function(value, index) {
sparkline(iris_liste$barplot[[index]])
}),
barplot = colDef(cell = function(values) {
sparkline(values, type = "bar")
}),
boxplot = colDef(cell = function(value, index) {
sparkline(iris_liste$barplot[[index]], type = "box")
})
))Mises en forme en couleur : le script avec
formattable
tb_formattable = formattable(ma_table,
list(Sepal.Length = color_bar("cornflowerblue"),
Sepal.Width = color_bar("gold"),
Petal.Length = formatter("span",
style = x ~ ifelse(x <= 0, "color:green", "color:orange")),
Petal.Width = color_tile("transparent", "pink")))DT
tb_DT = datatable(ma_table,
class = 'cell-border stripe',
filter = 'top',
# pour deplacer les colonnes en faisant glisser leur nom
extensions = 'ColReorder',
# 5 lignes par page affichee
options = list(colReorder = TRUE, pageLength = 5)) %>%
formatStyle('Petal.Length',
color = styleInterval(0, c('green', 'orange'))) %>%
formatStyle('Sepal.Length',
background = styleColorBar(iris$Petal.Length, 'cornflowerblue')) %>%
formatStyle('Sepal.Width',
background = styleColorBar(iris$Petal.Length, 'gold')) %>%
formatStyle('Petal.Width',
backgroundColor = styleInterval(seq(min(ma_table$Petal.Width),
max(ma_table$Petal.Width),
length.out = 9),
colorRampPalette(c("white", "pink"))(10)))reactable
bar_chart <- function(value, max_value, height = "16px", fill = "#00bfc4", background = NULL) {
width = paste0(value / max_value * 100, "%")
bar <- div(style = list(background = fill, width = width, height = height))
chart <- div(style = list(flexGrow = 1, marginLeft = "8px", background = background), bar)
div(style = list(display = "flex", alignItems = "center"),
scales::number(value, accuracy = 0.1), chart)
}
tb_reactable = reactable(
ma_table,
columns = list(
Sepal.Length = colDef(name = "Sepal.Length", align = "left", cell = function(value) {
bar_chart(value, max_value = max(ma_table$Sepal.Length),
fill = "cornflowerblue", background = "lightblue")
}),
Sepal.Width = colDef(name = "Sepal.Width", align = "left", cell = function(value) {
bar_chart(value, max_value = max(ma_table$Sepal.Width), fill = "gold", background = "yellow")
}),
Petal.Length = colDef(style = function(value) {
if (value < 0) {
color <- "green"
} else {color <- "orange"}
list(color = color, fontWeight = "bold")
}
),
Petal.Width = colDef(style = function(value) {
normalized <- (value - min(ma_table$Petal.Width)) /
(max(ma_table$Petal.Width) - min(ma_table$Petal.Width))
orange_pal <- function(x) rgb(colorRamp(c("white", "pink"))(x), maxColorValue = 255)
color <- orange_pal(normalized)
list(background = color)
}
),
Species = colDef(cell = function(value) {
# balise avec les classes "tag" (pour la forme) et "status-species" pour les couleurs
class <- paste0("tag status-", tolower(value))
htmltools::div(class = class, value)})
)
)C’est dans un chunck “css” et non pas “r” qu’on donne la definition des differentes classes utilisees par reactable pour la mise en forme de la colonne Species.
.tag {
display: inline-block;
padding: 2px 12px;
border-radius: 15px;
font-weight: 600;
font-size: 12px;
}
.status-setosa {
background: aquamarine;
color: forestgreen;
}
.status-virginica {
background: hotpink;
color: purple;
}
.status-versicolor {
background: cornflowerblue;
color: blue;
}Mise en forme en couleur : les resultats
tb_formattable| Sepal.Length | Sepal.Width | Petal.Length | Petal.Width | Species |
|---|---|---|---|---|
| 4.3 | 2.5 | -0.3 | 1.3 | setosa |
| 5.9 | 1.3 | 4.6 | 0.4 | virginica |
| 5.4 | 1.6 | 3.9 | 0.6 | virginica |
tb_DTtb_reactable