diminuer les rectangles et la police dans un graphique

[Sylvain_Ard]

Bonjour,
je voulais savoir comment choisir la taille des rectangles des étiquettes et la police des étiquettes dans le code ci-dessous SVP ?
Merci d'avance

Code : Tout sélectionner

groups <- as.factor(data_Rosa$Sections)
s.class(res.pca2$li,
        fac = groups,  # colorer par groupes
        col = c("#00AFBB",  "#FC4E07","#543005","#8c510a","#bf812d","#dfc27d","#f6e8c3","#f5f5f5","#c7eae5","#80cdc1","#35978f","#01665e","#003c30")
)

[Serge Rapenne]

Bonjour,

Il est difficile de répondre à votre question.
D'ou vient cette fonction s.class, ce n'est pas une fonction de R de base et comme il existe plusieurs dizaine de milliers de package rien que sur le CRAN, est un genie qui les connait tous.
un peu de lecture : viewtopic.php?f=1&t=7638
Serge

[Logez Maxime]

Bonjour,

De telles options ne sont pas disponibles dans les fonctions de base d'ade4.
Les tailles des étiquettes sont définies par la fonction scatterutil.eti qui est appelée par s.class.
Cette fonction calcule d'abord la largeur et la hauteur des étiquettes en fonction du texte à afficher et d'une marge pour la hauteur. Tu ne peux pas jouer dessus.
La seule façon de pouvoir faire ça c'est de créer de nouvelles fonctions en se copiant le code des fonctions de originelles et de les adapter en ajoutant des arguments à ta convenance.
Le plus simple généralement est de retoucher les sorties graphiques vectorielles (pdf, svg...) de ces fonctions avec des logiciels, de sélectionner tout le texte et de choisir la police de ton choix, de sélectionner toutes les boîtes et de leur appliquer une transformation.

Bien cordialement,
Maxime

[Gabriel Terraz]

Salut,

Il y a un moyen pas très propre qui est de modifier le corps de la fonction s.class() pour choisir les arguments passés à scatterutil.eti() :

Code : Tout sélectionner

# ACP
pca <- dudi.pca(mtcars, scannf = FALSE, nf = 2)

# Exemple de modification du corps de la fonction :
body(s.class)[[20]] <- substitute(if (clabel > 0) scatterutil.eti(coox, cooy, label, clabel = 3, coul = rep("blue", 3), boxes = FALSE))

# Graphe
s.class(pca$li, fac = factor(mtcars$cyl))

Cela devrait dépanner...

[Logez Maxime]

Bonjour,

L'autre option s'est de partir sur d'autres librairies graphiques comme ggplot2 qui associé à d'autres packages permet d'utiliser toutes les polices disponibles sur ton ordi (https://www.youtube.com/watch?v=hPTBZelmAh4).

Code : Tout sélectionner

xy <- cbind.data.frame(x = runif(200, -1, 1), y = runif(200, -1, 1))
posi <- factor(xy$x > 0) : factor(xy$y > 0)
posi <- factor(posi, labels = c("F:F", "F:T", "T:F", "T:T"))

library(showtext)
library(ggplot2)

font_add("Symbol", "symbol.ttf") # pour l'exemple
showtext_auto()

StatBary <-  ggproto("StatBary", Stat,
                      compute_group = function(data, scales) {
                        tab <- data[c("x", "y")]
                        mns <- colMeans(tab)
                        res <- as.data.frame(as.list(mns))
                        colnames(res) <- c("x", "y")
                        res
                      }
                      , required_aes = c("x", "y")
)

StatStar <-  ggproto("StatBary", Stat,
                      compute_group = function(data, cstar, scales) {
                        tab <- data[c("x", "y")]
                        mns <- colMeans(tab)
                  tabn <- t(tab)-mns
                  tabn <- tabn*cstar
                  tabn <- tabn + mns
                  tabn <- t(tabn)
                  tabn <- as.data.frame(tabn)
                        res <- as.data.frame(as.list(mns))
                  res <- cbind(res, tabn)
                        colnames(res) <- c("x", "y", "xend", "yend")
                        res
                      }
                      , required_aes = c("x", "y")
)

stat_class <- function (mapping = NULL, data = NULL,
    position = "identity", cstar = 1, cellipse = 1.5, clabel = 1, ...,
   show.legend = NA, inherit.aes = TRUE)
{
    l1 <- list()
    if (cellipse > 0) {
      level <- 1-exp(-0.5*(cellipse)^2)
     l1 <- c(l1, layer(data = data, mapping = mapping, stat = StatEllipse, geom = "path",
           position = position, show.legend = show.legend, inherit.aes = inherit.aes,
         params = rlang:::list2(type = "t", level = level, segments = 51, na.rm = FALSE)))
    }
   if (cstar > 0) {
     l1 <- c(l1, layer(data = data, mapping = mapping, stat = StatStar, geom = "segment",
           position = position, show.legend = show.legend & (!cellipse > 0), inherit.aes = inherit.aes,
         params =  rlang:::list2(cstar = cstar)))
   }
    if (clabel) {
     l1 <- c(l1, layer(data = data, mapping = mapping, stat = StatIdentity,
        geom = "label", position = position, show.legend = show.legend & (!(cellipse > 0 | cstar > 0)),
        inherit.aes = inherit.aes, params = rlang:::list2(...)))
   }
   l1
}

ggplot(dta2, aes(x, y, color = f, label = f)) + stat_class()

ggplot(xy, aes(x, y, label = posi, color = posi)) +
  geom_vline(xintercept = 0) +
  geom_hline(yintercept = 0) +
  stat_class(family = "Symbol") +
  coord_fixed() +
  theme_bw()

Cordialement,
Maxime

[Gabriel Terraz]

J'avais pas remarqué la question sur la police !
Tant qu'à partir sur ggplot2, tu pourrais utiliser le package factoextra pour les graphes d'analyses multivariées :

Code : Tout sélectionner

library(factoextra)
library(ade4)
library(showtext)

pca <- dudi.pca(iris[,-5], scannf = FALSE, nf = 2)

font_add("Symbol", "symbol.ttf") # pour l'exemple
showtext_auto()

fviz_pca_ind(pca,
             label = "none", # hide individual labels
             habillage = iris$Species, # color by groups
             palette = c("#00AFBB", "#E7B800", "#FC4E07"),
             addEllipses = TRUE # Concentration ellipses
) + theme(text = element_text(size = 16, family = "Symbol"))

[Logez Maxime]

re,

Attention les ellipses de factoextra et de s.class ne sont pas directement comparables parce que pas définies pour le même niveau de confiance.
Je trouve les fonctions de factoextra très bien faits, mais il y a toujours un truc qui me gène avec la représentation de factoextra, c'est que le ratio entre les axes n'est pas de 1. Dans ton exemple on a l'impression que la "plus grande dimension" du nuage de point général (et pas les sous nuages) est la deuxième (ordonnées) alors qu'en fait ça devrait être la première (abcisse).
Je rajouterai à chaque fois coord_fixed() par exemple.

De plus ce code ne permet pas de modifier les boîtes et le texte uniquement des labels représentés au barycentre des points d'un groupe.
Pour mimer la fonction s.class :

Code : Tout sélectionner

xy <- cbind.data.frame(x = runif(200, -1, 1), y = runif(200, -1, 1))
posi <- factor(xy$x > 0) : factor(xy$y > 0)
posi <- factor(posi, labels = c("F:F", "F:T", "T:F", "T:T"))

library(showtext)
library(ggplot2)

font_add("Symbol", "symbol.ttf") # pour l'exemple
showtext_auto()

StatBary <-  ggproto("StatBary", Stat,
                      compute_group = function(data, scales) {
                        tab <- data[c("x", "y")]
                        mns <- colMeans(tab)
                        res <- as.data.frame(as.list(mns))
                        colnames(res) <- c("x", "y")
                        res
                      }
                      , required_aes = c("x", "y")
)

StatStar <-  ggproto("StatStar", Stat,
                      compute_group = function(data, cstar, scales) {
                        tab <- data[c("x", "y")]
                        mns <- colMeans(tab)
                  tabn <- t(tab)-mns
                  tabn <- tabn*cstar
                  tabn <- tabn + mns
                  tabn <- t(tabn)
                  tabn <- as.data.frame(tabn)
                        res <- as.data.frame(as.list(mns))
                  res <- cbind(res, tabn)
                        colnames(res) <- c("x", "y", "xend", "yend")
                        res
                      }
                      , required_aes = c("x", "y")
)

stat_class <- function (mapping = NULL, data = NULL,
    position = "identity", cstar = 1, cellipse = 1.5, clabel = 1, cpoint = 1,  ...,
   show.legend = FALSE, inherit.aes = TRUE)
{
    l1 <- list()
    if (cellipse > 0) {
      level <- 1-exp(-0.5*(cellipse)^2)
     l1 <- c(l1, layer(data = data, mapping = mapping, stat = StatEllipse, geom = "path",
           position = position, show.legend = show.legend, inherit.aes = inherit.aes,
         params = rlang:::list2(type = "t", level = level, segments = 51, na.rm = FALSE)))
    }
   if (cstar > 0) {
     l1 <- c(l1, layer(data = data, mapping = mapping, stat = StatStar, geom = "segment",
           position = position, show.legend = show.legend & (!cellipse > 0), inherit.aes = inherit.aes,
         params =  rlang:::list2(cstar = cstar)))
   }
    if (clabel) {
     l1 <- c(l1, layer(data = data, mapping = mapping, stat = StatBary,
        geom = "label", position = position, show.legend = show.legend & (!(cellipse > 0 | cstar > 0)),
        inherit.aes = inherit.aes, params = rlang:::list2(...)))
   }
   if (cpoint > 0 ) {
     l1 <- c(l1, layer(data = data, mapping = mapping, stat = StatIdentity,
        geom = "point", position = position, show.legend = show.legend & (!(cellipse > 0 | cstar > 0 | clabel > 0)),
        inherit.aes = inherit.aes, params = rlang:::list2()))   
   }
   l1
}

ggplot(xy, aes(x, y, label = posi, color = posi)) +
  geom_vline(xintercept = 0) +
  geom_hline(yintercept = 0) +
  stat_class(family = "Symbol") +
  coord_fixed() +
  theme_bw()

Cordialement,
Maxime