我想用标记的椭圆和组的部分向量绘制 FactoMineR MFA

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

我正在按照此处发布的 MFA 教程进行操作: http://www.sthda.com/english/articles/31-principal-component-methods-in-r-practical-guide/116-mfa-multiple-factor-analysis-in-r-essentials/

我一直在使用这些R库:

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

本教程提供了生成 95% 置信度椭圆的代码,椭圆按组标记:

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

本教程还提供了标记所有个体或个体子集的部分向量的代码,但没有提供仅绘制组部分向量的明显方法。

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

如何绘制组的部分向量和 95% 置信区间,如 this publication 所示(参见图 1C),而不是个人?

第一次更新

我能够通过这种方式为组而不是个人绘制椭圆和部分,但它为所有定性变量(2 列)绘制部分,而不仅仅是用于生成椭圆的组(1 列),并且完全删除单个数据点(否则为组和个人绘制部分图)。这还是不尽如人意:

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"))

第二次更新

我首先用矢量和标签绘制椭圆,使标签变小,然​​后叠加第二个相同尺寸的图,其中个人按组进行颜色编码:

  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"))

这仍然存在几个问题:(1)对组使用颜色数组和对部分使用颜色数组令人困惑(2)仍然绘制没有椭圆的组的部分向量。 (3) 我们不知道哪些人用了哪些省略号。(4) 向量末尾的方块似乎是不必要的。

我可以通过从 MFA() 生成的 MFA 对象中提取单个点和组部分的坐标来制作所需的图,res.mfa,并使用这些片段和 ggplot2 来制作我正在寻找的东西对于:

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")