【绘图进阶】之六种带中心点的PCA 图和三维PCA图绘制（四）

上海天昊生物

前几期我们有介绍PCA的多种绘图方法，这里我们接着介绍几种新的绘图方法：ggpubr包进行二维绘图和scatterplot3d包绘制3D图。

加载ggpubr包

In [1]:
library(ggpubr）

一

数据准备

In [2]:
df = read.csv('3D.PCA.site.csv',header = T)
head(df)

Out[2]:

aggregate 计算中心点

In [3]:
df_mean = aggregate(cbind(PCA1, PCA2) ~ sub_group, data = df, FUN = mean)
df_mean$group = c('B','B','C','C')
df_mean

Out[3]:

合并数据

In [4]:
data = merge(df,setNames(df_mean,c('sub_group','PCA1_mean','PCA2_mean','group')))
data

Out[4]:

二

二维绘图

2.1 常规PCA图

In [5]:
p <- ggplot(df, aes(x = PCA1, y = PCA2, colour = sub_group)) + geom_point(size = 4)
p

Out[5]:

增加形状

In [6]:
p1 = ggplot(df, aes(x = PCA1, y = PCA2, colour = sub_group,shape = group)) + geom_point(size = 4)
p1

Out[6]:

2.2 带中心点的PCA图

In [7]:
q = p1 + geom_point(data = df_mean, size = 6)
q

Out[7]:

2.3 添加置信椭圆

In [8]:
r = q + stat_ellipse( linetype = 2,level = 0.65,aes(group = sub_group, colour = sub_group))
r

Out[8]:

2.4 指定杂志配色的绘图

In [9]:
# Add group ellipses and mean points
# Add stars
# +++++++++++++++++++
s = ggscatter(df, x = "PCA1", y = "PCA2",color = "sub_group", shape = "sub_group",
palette = 'jco',ellipse = TRUE, mean.point = TRUE,star.plot = TRUE)
s

Out[9]:

2.5 连线放射

In [10]:
t = r + geom_segment(data = data,mapping = aes(xend = PCA1_mean, yend = PCA2_mean))
t

Out[10]:

2.6 外点连线

In [11]:
library(ggalt)

In [12]:
u = p + geom_encircle(s_shape=1, expand=0)
u

Out[12]:

2.7 波普样式

In [13]:
v = q + geom_bkde2d()
v

Out[13]:

2.8 多个图形绘制在一起

In [14]:
ggarrange( p,p1,q , r ,s ,t ,u,v, ncol =2 , nrow =4,legend='top',common.legend = T)

Out[14]:

三

3D 绘图

In [15]:

# install.packages('scatterplot3d')
library(scatterplot3d)

In [16]:
attach(df)

In [17]:
color = c('red','black', 'blue','yellow')
colors=color[as.numeric(df$sub_group)]
colors

Out[17]:
'red' 'red' 'red' 'red' 'black' 'black' 'black' 'black' 'blue' 'blue' 'blue' 'blue' 'blue' 'blue' 'yellow' 'yellow' 'yellow' 'yellow'

由于PCA1和PCA2的贡献度更高，因此我们需要面向我们的X轴和Z轴对应PCA1和PCA2

In [18]:
scatterplot3d(x =PCA1, y = PCA3, z = PCA2,
main = "PCA", xlab='PCA1', ylab="", zlab='PCA2',
pch = 19, color = colors, cex.symbols = 1.2)
legend("right", col = unique(colors), pch = 19, xpd = T, cex = 1, ncol =1,
legend = unique(df$sub_group), bty = "n")

Out[18]: