Matrice de corrélation

Les données

# correlations ----
library(dplyr)
## 
## Attachement du package : 'dplyr'
## Les objets suivants sont masqués depuis 'package:stats':
## 
##     filter, lag
## Les objets suivants sont masqués depuis 'package:base':
## 
##     intersect, setdiff, setequal, union
library(tibble)
correlations <- cor(mtcars) |> 
  as.data.frame() |> 
  rownames_to_column(var = "rowname")
correlations
##    rowname        mpg        cyl       disp         hp        drat         wt
## 1      mpg  1.0000000 -0.8521620 -0.8475514 -0.7761684  0.68117191 -0.8676594
## 2      cyl -0.8521620  1.0000000  0.9020329  0.8324475 -0.69993811  0.7824958
## 3     disp -0.8475514  0.9020329  1.0000000  0.7909486 -0.71021393  0.8879799
## 4       hp -0.7761684  0.8324475  0.7909486  1.0000000 -0.44875912  0.6587479
## 5     drat  0.6811719 -0.6999381 -0.7102139 -0.4487591  1.00000000 -0.7124406
## 6       wt -0.8676594  0.7824958  0.8879799  0.6587479 -0.71244065  1.0000000
## 7     qsec  0.4186840 -0.5912421 -0.4336979 -0.7082234  0.09120476 -0.1747159
## 8       vs  0.6640389 -0.8108118 -0.7104159 -0.7230967  0.44027846 -0.5549157
## 9       am  0.5998324 -0.5226070 -0.5912270 -0.2432043  0.71271113 -0.6924953
## 10    gear  0.4802848 -0.4926866 -0.5555692 -0.1257043  0.69961013 -0.5832870
## 11    carb -0.5509251  0.5269883  0.3949769  0.7498125 -0.09078980  0.4276059
##           qsec         vs          am       gear        carb
## 1   0.41868403  0.6640389  0.59983243  0.4802848 -0.55092507
## 2  -0.59124207 -0.8108118 -0.52260705 -0.4926866  0.52698829
## 3  -0.43369788 -0.7104159 -0.59122704 -0.5555692  0.39497686
## 4  -0.70822339 -0.7230967 -0.24320426 -0.1257043  0.74981247
## 5   0.09120476  0.4402785  0.71271113  0.6996101 -0.09078980
## 6  -0.17471588 -0.5549157 -0.69249526 -0.5832870  0.42760594
## 7   1.00000000  0.7445354 -0.22986086 -0.2126822 -0.65624923
## 8   0.74453544  1.0000000  0.16834512  0.2060233 -0.56960714
## 9  -0.22986086  0.1683451  1.00000000  0.7940588  0.05753435
## 10 -0.21268223  0.2060233  0.79405876  1.0000000  0.27407284
## 11 -0.65624923 -0.5696071  0.05753435  0.2740728  1.00000000

La fonction de coloriage

Il faut créer une fonction qui va permettre d’associer une couleur de fond aux cellules en fonction de la valeur de la corrélation correspondante.

Nous aurions pu le faire avec les fonctions disponibles dans le package ‘scales’ mais préférons coder nous même la fonction pour montrer comment créer une fonction de coloriage correspondante à un besoin spécifique.

La fonction va associer une couleur en découpant les valeurs de corrélations par tranches.

cor_color <- function(x){
  col_palette <- c("#D73027", "#F46D43", "#FDAE61", "#FEE08B", 
                   "#D9EF8B", "#A6D96A", "#66BD63", "#1A9850")
  mycut <- cut(x, 
    breaks = c(-1, -0.75, -0.5, -0.25, 0, 0.25, 0.5, 0.75, 1), 
    include.lowest = TRUE, label = FALSE)
  col_palette[mycut]
}

std_border <- fp_border_default(color = "white")

Création du flextable

On va appliquer la fonction cor_color() aux couleurs de fonds des cellules et on va aussi fixer la largeur et la hauteur des cellules pour reproduire un effet comme le font les graphiques heatmap.

ft <- flextable(correlations) %>%
  border_outer(part = "all", border = std_border) %>%
  border_inner(border = std_border, part = "all") %>%
  compose(i = 1, j = 1, value = as_paragraph(""), part = "header") %>%
  compose(j = ~ . - rowname, value = as_paragraph(""), part = "body") %>%
  bg(j = ~ . - rowname, bg = cor_color) %>%
  height(height = .5) %>%
  hrule(rule = "exact", part = "body") %>%
  width(width = .5)

ft