Search code examples
rggplot2visualizationpcamulti-factor-authentication

I want to plot FactoMineR MFA with labeled ellipses and partial vectors for groups


I'm following the tutorial for MFA posted here: http://www.sthda.com/english/articles/31-principal-component-methods-in-r-practical-guide/116-mfa-multiple-factor-analysis-in-r-essentials/

I have been using these R libraries in the process:

library(FactoMineR, factoextra, gridExtra, ggplot2, ggpubr, wesanderson)

The tutorial provides code to generate 95% confidence ellipses, with ellipses labeled by group:

fviz_ellipses(res.mfa, c("Label", "Soil"), repel = TRUE) 

The tutorial also provides code to label partial vectors on all or subsets of individuals, but does not provide an obvious way to plot only partials for groups.

fviz_mfa_ind(res.mfa, partial = c("1DAM", "1VAU", "2ING")) 

How can I plot the partial vectors and 95% confidence intervals for groups as shown in this publication (See Figure 1C), rather than for individuals?

First Update

I was able to plot ellipses and partials for groups instead of individuals this way, but it plots partials for all qualitative variables (2 columns) rather than only for the groups used to generate the ellipses (1 column), and entirely removes individual datapoints (otherwise plots partials for both groups and individuals). This is still unsatisfactory:

Label <- wine[,1:2]
a <- merge(Label, res.mfa$ind$coord, by=0, all=TRUE) 
row.names(a) <- a$Row.names
a <- a[,-c(1,2)]
b <- coord.ellipse(a, bary=TRUE)
plot.MFA(res.mfa, ellipse=b,  partial="all", 
         habillage = "Label",  lab.ind = FALSE, 
         invisible = c("ind","ind.sup"))

Second Update

I plotted ellipses with vectors and labels first, made labels tiny, then superimposed a second plot of identical dimensions with individuals color-coded by group:

  plot.MFA(res.mfa,  
         partial="all", ellipse=b,choix = "ind",
         lab.ind = FALSE, lab.grpe = FALSE, lab.col = FALSE,
         xlim=c(-4,4), ylim=c(-2,7), cex=0.01,invisible = c("ind"), 
         col.hab=wes_palette(4, name = "Zissou1", type = "continuous"),
         legend = list(col=wes_palette(4, name = "Zissou1", type = "continuous"), text.col=wes_palette(4, name = "Zissou1", type ="continuous"))) 

par(new=TRUE)

plot.MFA(res.mfa,  choix = "ind", habillage = "Soil", 
         lab.ind = FALSE, lab.grpe = FALSE, lab.col = FALSE,
         xlim=c(-4,4), ylim=c(-2,7), cex=0.8,  
         legend=list(plot=FALSE),
         col.hab=wes_palette(4, name = "Zissou1", type = "continuous"))

Almost what I want...

There are still several problems with this: (1) Using an array of colors for groups and an array of colors for partials is confusing (2) Partial vectors for groups without ellipses are still plotted. (3) We don't know which individuals go with which ellipses.(4) The squares at the end of vectors seem unnecessary.


Solution

  • I can make the desired plot by extracting the coordinates for individual points and group partials from the MFA object produced by MFA(), res.mfa, and use these pieces and ggplot2 to make exactly what I was looking for:

    library("FactoMineR"); library("factoextra");library(wesanderson);library(ggplot2); library(ggpubr)
    data(wine)
    colnames(wine)
    res.mfa <- MFA(wine, group = c(2, 5, 3, 10, 9, 2), type = c("n", "s", "s", "s", "s", "s"),name.group = c("origin","odor","visual", "odor.after.shaking", "taste","overall"), num.group.sup = c(1, 6),graph = FALSE)
    
    row.names(res.mfa$ind$coord);  row.names(wine)
    Label <- wine[,1:2] 
    a <- merge(Label, res.mfa$ind$coord, by=0, all=TRUE) 
    row.names(a) <- a$Row.names
    a <- a[,-c(1,3,6:8)]
    a$Label <- as.factor(a$Label)
    
    group.partials <- data.frame(res.mfa$quali.var$coord.partiel); group.partials <- group.partials[,1:2]
    group.center <- data.frame((res.mfa$quali.var$coord)); group.center <- group.center[,1:2]
    group.partials.and.center <- rbind(group.center, group.partials)
    group.partials.and.center <- group.partials.and.center[ order(row.names(group.partials.and.center)), ]
    rm(group.partials, group.center)
    row.names(group.partials.and.center)
    Labelrows <- c(1:10, 31:35) # The rows for groups I want to plot with ellipses and partials.
    group.partials.and.center <- group.partials.and.center[Labelrows,]
    
    pal<- wes_palette(3, name = "Zissou1", type = "continuous")
    
    ggplot(a, aes(Dim.1, Dim.2, group=Label)) + 
        geom_point(size=5, aes(color=Label))+ 
        scale_color_manual(values=wes_palette(3, name = "Zissou1", type = "continuous")) + 
        stat_conf_ellipse(aes(color = Label), bary = TRUE, size=1.2) + 
        theme(legend.position="top", legend.text=element_text(size=12),
            legend.title = element_blank(), 
            panel.grid.major = element_blank(),
            panel.grid.minor = element_blank(),
            panel.border = element_blank(),
            panel.background = element_blank(), 
            line = element_blank(), 
            axis.line= element_blank()) +
    
    #Plot partials for each desired "Label" group
    
    # Saumur, group.partials.and.center[11:15,] 
    # To plot the partials for the other groups,
    #Bourgueuil (group.partials.and.center[1:5,])
    #Chinon ((group.partials.and.center[6:10,])
    # Repeat the code below for each, adjusting for appropriate rows:
        geom_point(aes(x=group.partials.and.center[11,1],y=group.partials.and.center[11,2]))+ # Centers of ellipses
    
    geom_segment(aes(x=group.partials.and.center[11,1],y=group.partials.and.center[11,2], # Center of ellipses
        xend=group.partials.and.center[12,1],yend=group.partials.and.center[12,2]), 
        arrow=arrow(length = unit(0.2,"cm"),angle=90), lineend = "butt", linetype=1)+
    
    geom_segment(aes(x=group.partials.and.center[11,1],y=group.partials.and.center[11,2], # Center of ellipses
        xend=group.partials.and.center[13,1],yend=group.partials.and.center[13,2]),
        arrow=arrow(length = unit(0.2,"cm"),angle=90),lineend = "butt", linetype=2)+
    
    geom_segment(aes(x=group.partials.and.center[11,1],y=group.partials.and.center[11,2], # Center of ellipses
        xend=group.partials.and.center[14,1],yend=group.partials.and.center[14,2]),
        arrow=arrow(length = unit(0.2,"cm"),angle=90), lineend = "butt", linetype=3)+
    
    geom_segment(aes(x=group.partials.and.center[11,1],y=group.partials.and.center[11,2], # Center of ellipses
        xend=group.partials.and.center[15,1],yend=group.partials.and.center[15,2]),
        arrow=arrow(length = unit(0.2,"cm"),angle=90), lineend = "butt", linetype=4, linejoin = "round")
    

    enter image description here