Controler la largeur des barres

La largeur des barres de la 1ere colonne ci-dessous est un % de la largeur de la colonne, qui est elle-meme proportionnelle a la longueur du nom de la colonne, ce qui peut donner un resultat assez laid.

# pour la manip de donnees
library("dplyr")

# pour les widgets javascript (notamment leur export en html)
library("htmlwidgets")

# pour faire de jolies tables
library("formattable")

set.seed(2018)
ma_table = iris[sample(1:150,3),-5]-2
names(ma_table) = c("un_nom_de_champ_tres_long", colnames(ma_table)[-1])
rownames(ma_table) = NULL

formattable(ma_table,
            list(un_nom_de_champ_tres_long = 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("pink", "transparent")))
un_nom_de_champ_tres_long Sepal.Width Petal.Length Petal.Width
3.8 2.0 -0.8 -1.8
5.4 0.8 4.1 -0.1
4.9 1.1 3.4 0.1

Solution : on redefinit la fonction formattable::color_bar en modifiant un peu son code : on remplace width = percent(fun(as.numeric(x), …)) par width = paste0(fixedWidth * fun(as.numeric(x), …),“px”). La largeur des barres des deux 1eres colonnes devient proportionnelle a une largeur fixe exprimee en pixels.

my_color_bar <- function (color = "lightgray", fun = "proportion", fixedWidth=100,...) {
  fun <- match.fun(fun)
  formatter("span", 
            style = function(x) style(display = "inline-block", 
                                      direction = "rtl", `border-radius` = "4px", `padding-right` = "2px", 
                                      `background-color` = csscolor(color), 
                                      width = paste0(fixedWidth * fun(as.numeric(x), ...),"px")))
}

(widget = formattable(ma_table,
                     list(un_nom_de_champ_tres_long = my_color_bar("cornflowerblue"),
                          Sepal.Width = my_color_bar("gold"),
                          Petal.Length = formatter("span", style = x ~ ifelse(x <= 0, "color:green", "color:orange")),
                          Petal.Width = color_tile("pink", "transparent"))))
un_nom_de_champ_tres_long Sepal.Width Petal.Length Petal.Width
3.8 2.0 -0.8 -1.8
5.4 0.8 4.1 -0.1
4.9 1.1 3.4 0.1

Exporter le tableau en html

Appliquer la fonction saveWidget marche avec les htmlwidgets mais avec formattable on a une erreur.

# pour exporter le message d'erreur dans le html plutot que dans la console de Rstudio
options(try.outFile = stdout())

# try : pour intercepter le message d'erreur en empechant le plantage du script
try(saveWidget(widget, file = file.path(getwd(), "ma_table.html")))
Error in .getNamespace(pkg) : 
  type / longueur incorrect (symbol / 0) dans l'allocation de vecteur

Si on convertit en htmlwidget plus de probleme, ma_table.html est cree dans le repertoire de travail.

saveWidget(as.htmlwidget(widget, width = '40%'), file = file.path(getwd(), "ma_table.html"))

retour au debut du document