Я хочу построить FactoMineR MFA с помеченными эллипсами и частичными векторами для групп

Question

Я следую учебному пособию для МИДа, размещенному здесь 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% доверительные интервалы для групп, как показано в этой публикации (см. Рисунок 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) Квадраты в конце векторов кажутся ненужными.

Answer 1

Я могу создать желаемый график, извлекая координаты для отдельных точек и групповых частей из объекта 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")