我想用标记的椭圆和组的部分向量绘制 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")
我正在按照此处发布的 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")