用ggplot2绘制偏最小二乘回归（plsr）双标图 [英] Plotting Partial Least Squares Regression (plsr) biplot with ggplot2
本文介绍了用ggplot2绘制偏最小二乘回归（plsr）双标图的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！
问题描述
使用下面的 data.frame （来源：
使用 ggplot2 来绘制 pls 双标图的任何帮助都将被赞赏？
解决方案
＃读取数据
df< - read.table（text = c（
柴油两室内运动型轴距长度宽度高度限制马力马力horse_per_weight conscity价格符号
0 1 0 97 172 66 56 2209 109 85 0.0385 8.7 7975 2
0 0 0 100 177 66 54 2337 109 102 0.0436 9.8 13950 2
0 0 0 116 203 72 57 3740 234 155 0.0414 14.7 34184 -1
0 1 1 103 184 68 52 3016 171 161 0.0534 12.4 15998 3
0 0 0 101 177 65 54 2765 164 121 0.0438 11.2 21105 0
0 1 0 90 169 65 52 2756 194 207 0.0751 13.8 34028 3
1 0 0 105 175 66 54 2700 134 72 0.0267 7.6 18344 0
0 0 0 108 187 68 57 3020 120 97 0.0321 12.4 11900 0
0 0 1 94 157 64 51 1967 90 68 0.0346 7.6 6229 1
0 1 0 95 169 64 53 2265 98 112 0.0494 9.0 9298 1
1 0 0 96 166 64 53 2275 110 56 0.0246 6.9 7898 0
0 1 0 100 177 66 53 2507 136 110 0.0439 12.4 15250 2
0 1 1 94 157 64 51 1876 90 68 0.0362 6.4 5572 1
0 0 0 95 170 64 54 2024 97 69 0.0341 7.6 7349 1
0 1 1 95 171 66 52 2823 152 154 0.0546 12.4 16500 1
0 0 0 103 175 65 60 2535 122 88 0.0347 9.8 8921 -1
0 0 0 113 200 70 53 4066 258 176 0.0433 15.7 32250 0
0 0 0 95 165 64 55 1938 97 69 0.0356 7.6 6849 1
1 0 0 97 172 66 56 2319 97 68 0.0293 6.4 9495 2
0 0 0 97 172 66 56 2275 109 85 0.0374 8.7 8495 2），header = T）
#Run OP代码
library（pls）
library（ ggplot2）
Y&l t; - as.matrix（df [，14]）
X < - as.matrix（df [，1：11]）$ b $ b df.pls < - mvr（Y〜X，ncomp = 3，method =oscorespls，scale = T）
＃从mvr对象提取信息
df2 <-df.pls $分数
comp1a <-df2 [，1 ]
comp2a< -df2 [，2]
df2< -as.data.frame（cbind（comp1a，comp2a））
df1< -df.pls $ loadings
comp1< -df1 [，1]
comp2< -df1 [，2]
名称< -df1 [，0]
df1< -as.data.frame（cbind（名称，comp1，comp2））
＃生成两个图和覆盖图
#Plot 1
p1 <-ggplot（data = df1，aes（comp1，comp2））+
ylab（）+ xlab（）+ ggtitle（X scores and X Loadings）+
theme_bw（）+ theme（panel.border = element_rect（color =black，fill = NA，size = 1），panel.grid.major = element_blank（），
panel.grid.minor = element_blank（），
axis.line = element_line（color =black））+
geom_text（aes（label = rownames（df1）），color =red）+
scale_x_continuous（breaks = c（-0.6，-0.4，-0.2,0,0 0.2,0.4,0.6））+
scale_y_continuous（breaks = c（-0.6，-0.4，-0.2,0,0.2,0.4,0.6））+
coord_fixed（ylim = c（-0.6 ，0.6），xlim = c（-0.6,0.6））+
theme（axis.ticks = element_line（color =red））+
theme（axis.text.y = element_text（angle = $ 90，hjust = 0.65））+
theme（axis.text.y = element_text（margin = margin（10,10,10,5，pt）））
＃ Plot 2
p2 <-ggplot（data = df2，aes（comp1a，comp2a））+
ylab（Comp 2）+ xlab（Comp 1）+ ggtitle（X scores and X加载）+
theme_bw（）+ theme（panel.border = element_rect（color =black，fill = NA，size = 1），
panel.grid.major = element_blank（），
panel.grid.minor = element_blank（），
axis.line = element_line（color =black））+
geom_text（aes（label = rownames（df2）））+
xlim（-4,4）+ ylim（-4,4）+
scale_y_continuous（breaks = c（-4，-2,0,2））+
coord_cartesian（ylim = c（ -4，4））+
scale_x_continuous（breaks = c（-4，-2,0,2））+
theme（plot.t itle = element_text（face =bold））+
theme（axis.text.y = element_text（angle = 90，hjust = 0.65））
＃函数按顺序叠加图在同一图上得到两个不同坐标轴的图
library（grid）
library（gtable）
ggplot_dual_axis = function（plot1，plot2，which.axis =x）{
＃使用透明面板更新绘图
plot2 = plot2 + theme（panel.background = element_rect（fill = NA））
grid.newpage（）
＃如果which.axis = =y
if（which.axis ==y）plot1 = plot1 + theme（plot.margin = unit（c（0.7,1.5,0.4,0.4），cm））
＃提取gtable
g1 = ggplot_gtable（ggplot_build（plot1））
g2 = ggplot_gtable（ggplot_build（plot2））
＃将第二个图的面板重叠在第一个$ b $的面板上（g2 $ layout $ name ==panel）（g1 $ layout，name ==panel，se = t：r））
g = gtable_add_grob（g1，g2 $ grobs [[which ）]]，pp $ t，pp $ l，pp $ b，pp $ l）
＃从第二幅图中偷取轴并修改
axis.lab = ifelse（which.axis ==x，axis-b，axis-l）
ia = which（g2 $ layout $ name == axis.lab）
ga = g2 $ grobs [[ia]]
ax = ga $ children [[2]]
＃切换ticks和labels的位置
if（which.axis ==x） ax $ heights = rev（ax $ heights）else ax $ widths = rev（ax $ widths）
ax $ grobs = rev（ax $ grobs）
if（which.axis ==x）
ax $ grobs [[2]] $ y = ax $ grobs [[2]] $ y - unit（1，npc）+ unit（0.15，cm）else
ax $ grobs [[1]] $ x = ax $ grobs [[1]] $ x - 单位（1，npc）+单位（0.15，cm）
＃将现有行修改为足够高axis（$。
）if（which.axis ==x）g $ heights [[2]] = g $ heights [g2 $ layout [ia，] $ t]
＃添加新行或列轴标签
if（which.axis ==x）{
g = gtable_add_grob（g，ax，2，4，2，4）
g = gtable_add_rows（g，g2 $ heights [ 1]，1）
g = gtable_add_grob（g，g2 $ grob [[6]]，2,4,2,4）
} else {
g = gtable_add_cols（g，g2 $ widths [g2 $ layout [ia，] $ l]，长度（g $ widths） - 1）
g = gtable_add_grob（g，ax，pp $ t，length（g $ widths） - 1，pp $ b）
g = gtable_add_grob（g，g2 $ grob [[7]]，pp $ t，length（g $ widths ），pp $ b - 1）
}
＃绘制
grid.draw（g）
}
＃对单个绘图运行函数$
$ b
Using the data.frame below (Source: http://eric.univ-lyon2.fr/~ricco/tanagra/fichiers/en_Tanagra_PLSR_Software_Comparison.pdf)
Data
df <- read.table(text = c("
diesel twodoors sportsstyle wheelbase length width height curbweight enginesize horsepower horse_per_weight conscity price symboling
0 1 0 97 172 66 56 2209 109 85 0.0385 8.7 7975 2
0 0 0 100 177 66 54 2337 109 102 0.0436 9.8 13950 2
0 0 0 116 203 72 57 3740 234 155 0.0414 14.7 34184 -1
0 1 1 103 184 68 52 3016 171 161 0.0534 12.4 15998 3
0 0 0 101 177 65 54 2765 164 121 0.0438 11.2 21105 0
0 1 0 90 169 65 52 2756 194 207 0.0751 13.8 34028 3
1 0 0 105 175 66 54 2700 134 72 0.0267 7.6 18344 0
0 0 0 108 187 68 57 3020 120 97 0.0321 12.4 11900 0
0 0 1 94 157 64 51 1967 90 68 0.0346 7.6 6229 1
0 1 0 95 169 64 53 2265 98 112 0.0494 9.0 9298 1
1 0 0 96 166 64 53 2275 110 56 0.0246 6.9 7898 0
0 1 0 100 177 66 53 2507 136 110 0.0439 12.4 15250 2
0 1 1 94 157 64 51 1876 90 68 0.0362 6.4 5572 1
0 0 0 95 170 64 54 2024 97 69 0.0341 7.6 7349 1
0 1 1 95 171 66 52 2823 152 154 0.0546 12.4 16500 1
0 0 0 103 175 65 60 2535 122 88 0.0347 9.8 8921 -1
0 0 0 113 200 70 53 4066 258 176 0.0433 15.7 32250 0
0 0 0 95 165 64 55 1938 97 69 0.0356 7.6 6849 1
1 0 0 97 172 66 56 2319 97 68 0.0293 6.4 9495 2
0 0 0 97 172 66 56 2275 109 85 0.0374 8.7 8495 2"), header = T)
and this
Code
library(pls)
Y <- as.matrix(df[,14])
X <- as.matrix(df[,1:11])
df.pls <- mvr(Y ~ X, ncomp = 3, method = "oscorespls", scale = T)
plot(df.pls, "biplot")
I got this
Biplot
Any help to plot the pls biplot using ggplot2 will be appreciated?
解决方案 #Read data
df <- read.table(text = c("
diesel twodoors sportsstyle wheelbase length width height curbweight enginesize horsepower horse_per_weight conscity price symboling
0 1 0 97 172 66 56 2209 109 85 0.0385 8.7 7975 2
0 0 0 100 177 66 54 2337 109 102 0.0436 9.8 13950 2
0 0 0 116 203 72 57 3740 234 155 0.0414 14.7 34184 -1
0 1 1 103 184 68 52 3016 171 161 0.0534 12.4 15998 3
0 0 0 101 177 65 54 2765 164 121 0.0438 11.2 21105 0
0 1 0 90 169 65 52 2756 194 207 0.0751 13.8 34028 3
1 0 0 105 175 66 54 2700 134 72 0.0267 7.6 18344 0
0 0 0 108 187 68 57 3020 120 97 0.0321 12.4 11900 0
0 0 1 94 157 64 51 1967 90 68 0.0346 7.6 6229 1
0 1 0 95 169 64 53 2265 98 112 0.0494 9.0 9298 1
1 0 0 96 166 64 53 2275 110 56 0.0246 6.9 7898 0
0 1 0 100 177 66 53 2507 136 110 0.0439 12.4 15250 2
0 1 1 94 157 64 51 1876 90 68 0.0362 6.4 5572 1
0 0 0 95 170 64 54 2024 97 69 0.0341 7.6 7349 1
0 1 1 95 171 66 52 2823 152 154 0.0546 12.4 16500 1
0 0 0 103 175 65 60 2535 122 88 0.0347 9.8 8921 -1
0 0 0 113 200 70 53 4066 258 176 0.0433 15.7 32250 0
0 0 0 95 165 64 55 1938 97 69 0.0356 7.6 6849 1
1 0 0 97 172 66 56 2319 97 68 0.0293 6.4 9495 2
0 0 0 97 172 66 56 2275 109 85 0.0374 8.7 8495 2"), header = T)
#Run OP's code
library(pls)
library(ggplot2)
Y <- as.matrix(df[,14])
X <- as.matrix(df[,1:11])
df.pls <- mvr(Y ~ X, ncomp = 3, method = "oscorespls", scale = T)
#Extract information from mvr object
df2<-df.pls$scores
comp1a<-df2[,1]
comp2a<-df2[,2]
df2<-as.data.frame(cbind(comp1a, comp2a))
df1<-df.pls$loadings
comp1<-df1[,1]
comp2<-df1[,2]
names<-df1[,0]
df1<-as.data.frame(cbind(names, comp1, comp2))
#Generate two plots and overlay
#Plot 1
p1<-ggplot(data=df1, aes(comp1,comp2))+
ylab("")+xlab("")+ggtitle("X scores and X Loadings")+
theme_bw() + theme(panel.border = element_rect(colour = "black", fill=NA, size=1),panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
axis.line = element_line(colour = "black"))+
geom_text(aes(label=rownames(df1)), color="red")+
scale_x_continuous(breaks = c(-0.6,-0.4,-0.2,0,0.2,0.4,0.6))+
scale_y_continuous(breaks = c(-0.6,-0.4,-0.2,0,0.2,0.4,0.6))+
coord_fixed(ylim=c(-0.6, 0.6),xlim=c(-0.6, 0.6))+
theme(axis.ticks = element_line(colour = "red")) +
theme(axis.text.y=element_text(angle = 90, hjust = 0.65)) +
theme(axis.text.y = element_text(margin=margin(10,10,10,5,"pt")))
#Plot 2
p2<-ggplot(data=df2, aes(comp1a,comp2a))+
ylab("Comp 2")+xlab("Comp 1")+ggtitle("X scores and X Loadings")+
theme_bw() + theme(panel.border = element_rect(colour = "black", fill=NA, size=1),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
axis.line = element_line(colour = "black"))+
geom_text(aes(label=rownames(df2)))+
xlim(-4,4)+ylim(-4,4)+
scale_y_continuous(breaks = c(-4,-2,0,2))+
coord_cartesian(ylim=c(-4, 4))+
scale_x_continuous(breaks = c(-4,-2,0,2)) +
theme(plot.title = element_text(face="bold"))+
theme(axis.text.y=element_text(angle = 90, hjust = 0.65))
#Function to overlay plots in order to get two graphs with different axes on same plot
library(grid)
library(gtable)
ggplot_dual_axis = function(plot1, plot2, which.axis = "x") {
# Update plot with transparent panel
plot2 = plot2 + theme(panel.background = element_rect(fill = NA))
grid.newpage()
# Increase right margin if which.axis == "y"
if(which.axis == "y") plot1 = plot1 + theme(plot.margin = unit(c(0.7, 1.5, 0.4, 0.4), "cm"))
# Extract gtable
g1 = ggplot_gtable(ggplot_build(plot1))
g2 = ggplot_gtable(ggplot_build(plot2))
# Overlap the panel of the second plot on that of the first
pp = c(subset(g1$layout, name == "panel", se = t:r))
g = gtable_add_grob(g1, g2$grobs[[which(g2$layout$name=="panel")]], pp$t, pp$l, pp$b, pp$l)
# Steal axis from second plot and modify
axis.lab = ifelse(which.axis == "x", "axis-b", "axis-l")
ia = which(g2$layout$name == axis.lab)
ga = g2$grobs[[ia]]
ax = ga$children[[2]]
# Switch position of ticks and labels
if(which.axis == "x") ax$heights = rev(ax$heights) else ax$widths = rev(ax$widths)
ax$grobs = rev(ax$grobs)
if(which.axis == "x")
ax$grobs[[2]]$y = ax$grobs[[2]]$y - unit(1, "npc") + unit(0.15, "cm") else
ax$grobs[[1]]$x = ax$grobs[[1]]$x - unit(1, "npc") + unit(0.15, "cm")
# Modify existing row to be tall enough for axis
if(which.axis == "x") g$heights[[2]] = g$heights[g2$layout[ia,]$t]
# Add new row or column for axis label
if(which.axis == "x") {
g = gtable_add_grob(g, ax, 2, 4, 2, 4)
g = gtable_add_rows(g, g2$heights[1], 1)
g = gtable_add_grob(g, g2$grob[[6]], 2, 4, 2, 4)
} else {
g = gtable_add_cols(g, g2$widths[g2$layout[ia, ]$l], length(g$widths) - 1)
g = gtable_add_grob(g, ax, pp$t, length(g$widths) - 1, pp$b)
g = gtable_add_grob(g, g2$grob[[7]], pp$t, length(g$widths), pp$b - 1)
}
# Draw it
grid.draw(g)
}
#Run function on individual plots
ggplot_dual_axis(p2, p1, "y")
这篇关于用ggplot2绘制偏最小二乘回归（plsr）双标图的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
查看全文
