Question

我正在关注此处发布的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"))

如何为this publication（见图1C）中所示的组而不是针对个人绘制局部矢量和95％置信区间？

首次更新

我能够以这种方式为组而不是个人绘制椭圆和局部，但是它为所有定性变量（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）向量结尾处的正方形似乎是不必要的。

Answer 1

我可以通过从MFA（）res.mfa生成的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")

我想绘制带有标签的椭圆和组的局部向量的FactoMineR MFA

1 个答案: