oplsda.jpg
主成分分析（PCA）是一種無監(jiān)督降維方法，能夠有效對高維數(shù)據(jù)進行處理。但PCA對相關(guān)性較小的變量不敏感，而PLS-DA（偏最小二乘判別分析）能夠有效解決這個問題。而OPLS-DA（正交偏最小二乘判別分析）結(jié)合了正交信號和PLS-DA來篩選差異變量。
本分析主要用于代謝組學(xué)中差異代謝物的篩選。
22
數(shù)據(jù)集
液相色譜高分辨質(zhì)譜法（LTQ Orbitrap）分析了來自183位成人的尿液樣品。
sacurine list 包含了三個數(shù)據(jù)矩陣：
dataMatrix為樣本-代謝物含量矩陣(log10轉(zhuǎn)換過)，記錄了各種類型的代謝物在各樣本中的含量信息。共計183個樣本（行）以及109種代謝物（列）。
sampleMetadata中記錄了183個樣本所來源個體的年零、體重、性別等信息。
variableMetadata為109種代謝物的注釋詳情，MSI level水平。
rm(list = ls())
# load packages
library(ropls)
# load data
data(sacurine)
#查看數(shù)據(jù)集
head(sacurine$dataMatrix[ ,1:2])
head(sacurine$sampleMetadata)
head(sacurine$variableMetadata)
#提取性別分類
genderFc = sampleMetadata[, "gender"]
> head(sacurine$dataMatrix[ ,1:2])
(2-methoxyethoxy)propanoic acid isomer (gamma)Glu-Leu/Ile
HU_011 3.019766 3.888479
HU_014 3.814339 4.277149
HU_015 3.519691 4.195649
HU_017 2.562183 4.323760
HU_018 3.781922 4.629329
HU_019 4.161074 4.412266
> head(sacurine$sampleMetadata)
age bmi gender
HU_011 29 19.75 M
HU_014 59 22.64 F
HU_015 42 22.72 M
HU_017 41 23.03 M
HU_018 34 20.96 M
HU_019 35 23.41 M
OPLS-DA
# 分組以性別為例
# 通過orthoI指定正交組分數(shù)目
# orthoI = NA時，執(zhí)行OPLS，并通過交叉驗證自動計算適合的正交組分數(shù)
oplsda = opls(dataMatrix, genderFc, predI = 1, orthoI = NA)
OPLS-DA
183 samples x 109 variables and 1 response
standard scaling of predictors and response(s)
R2X(cum) R2Y(cum) Q2(cum) RMSEE pre ort pR2Y pQ2
Total 0.275 0.73 0.602 0.262 1 2 0.05 0.05
Snipaste_2021-10-28_21-32-57
結(jié)果中，R2X和R2Y分別表示所建模型對X和Y矩陣的解釋率，Q2表示模型的預(yù)測能力，它們的值越接近于1表明模型的擬合度越好，訓(xùn)練集的樣本越能夠被準確劃分到其原始歸屬中。
-
Inertia(慣量)柱形圖(左上)
展示了3個正交軸的
R2Y和Q2Y。通過展示累計解釋率評估正交組分是否足夠。 -
顯著性診斷(右上)
實際和模擬模型的
R2Y和Q2Y值經(jīng)隨機排列后的散點圖，模型R2Y和Q2Y(散點)大于真實值時(橫線)，表明產(chǎn)生過擬合2。右上圖，OPLS-DA模型的R2Y和Q2Y與隨機置換數(shù)據(jù)后獲得的相應(yīng)值進行比較。 -
離群點展示(左下)
展示了各樣本在投影平面內(nèi)以及正交投影面的距離，具有高值的樣本標注出名稱，表明它們與其它樣本間的差異較大。顏色代表性別分組。
-
x-score plot(右下)
各樣本在OPLS-DA軸中的坐標，顏色代表性別分組。
可視化
library(ggplot2)
library(ggsci)
library(tidyverse)
#提取樣本在 OPLS-DA 軸上的位置
sample.score = oplsda@scoreMN %>% #得分矩陣
as.data.frame() %>%
mutate(gender = sacurine[["sampleMetadata"]][["gender"]],
o1 = oplsda@orthoScoreMN[,1]) #正交矩陣
head(sample.score)#查看
> head(sample.score)
p1 gender o1
HU_011 -1.582933 M -4.9806037
HU_014 1.372806 F -1.7443382
HU_015 -3.341370 M -3.4372771
HU_017 -3.590063 M -0.9794960
HU_018 -1.662716 M 0.3155845
HU_019 -2.312923 M 0.6561281
p <- ggplot(sample.score, aes(p1, o1, color = gender)) +
geom_hline(yintercept = 0, linetype = 'dashed', size = 0.5) + #橫向虛線
geom_vline(xintercept = 0, linetype = 'dashed', size = 0.5) +
geom_point() +
#geom_point(aes(-10,-10), color = 'white') +
labs(x = 'P1(5.0%)',y = 'to1') +
stat_ellipse(level = 0.95, linetype = 'solid',
size = 1, show.legend = FALSE) + #添加置信區(qū)間
scale_color_manual(values = c('#008000','#FFA74F')) +
theme_bw() +
theme(legend.position = c(0.1,0.85),
legend.title = element_blank(),
legend.text = element_text(color = 'black',size = 12, family = 'Arial', face = 'plain'),
panel.background = element_blank(),
panel.grid = element_blank(),
axis.text = element_text(color = 'black',size = 15, family = 'Arial', face = 'plain'),
axis.title = element_text(color = 'black',size = 15, family = 'Arial', face = 'plain'),
axis.ticks = element_line(color = 'black'))
p
Snipaste_2021-10-28_22-49-44
差異代謝物篩選
#VIP 值幫助尋找重要的代謝物
vip <- getVipVn(oplsda)
vip_select <- vip[vip > 1] #通常以VIP值>1作為篩選標準
head(vip_select)
vip_select <- cbind(sacurine$variableMetadata[names(vip_select), ], vip_select)
names(vip_select)[4] <- 'VIP'
vip_select <- vip_select[order(vip_select$VIP, decreasing = TRUE), ]
head(vip_select) #帶注釋的代謝物，VIP>1 篩選后，并按 VIP 降序排序
> head(vip_select)
msiLevel hmdb chemicalClass
p-Anisic acid 1 HMDB01101 AroHoM
Malic acid 1 HMDB00156 Organi
Testosterone glucuronide 2 HMDB03193 Lipids:Steroi
Pantothenic acid 1 HMDB00210 AliAcy
Acetylphenylalanine 1 HMDB00512 AA-pep
alpha-N-Phenylacetyl-glutamine 1 HMDB06344 AA-pep
VIP
p-Anisic acid 2.533220
Malic acid 2.479289
Testosterone glucuronide 2.421591
Pantothenic acid 2.165296
Acetylphenylalanine 1.988311
alpha-N-Phenylacetyl-glutamine 1.965807
#對差異代謝物進行棒棒糖圖可視化
#代謝物名字太長進行轉(zhuǎn)換
vip_select$cat = paste('A',1:nrow(vip_select), sep = '')
p2 <- ggplot(vip_select, aes(cat, VIP)) +
geom_segment(aes(x = cat, xend = cat,
y = 0, yend = VIP)) +
geom_point(shape = 21, size = 5, color = '#008000' ,fill = '#008000') +
geom_point(aes(1,2.5), color = 'white') +
geom_hline(yintercept = 1, linetype = 'dashed') +
scale_y_continuous(expand = c(0,0)) +
labs(x = '', y = 'VIP value') +
theme_bw() +
theme(legend.position = 'none',
legend.text = element_text(color = 'black',size = 12, family = 'Arial', face = 'plain'),
panel.background = element_blank(),
panel.grid = element_blank(),
axis.text = element_text(color = 'black',size = 15, family = 'Arial', face = 'plain'),
axis.text.x = element_text(angle = 90),
axis.title = element_text(color = 'black',size = 15, family = 'Arial', face = 'plain'),
axis.ticks = element_line(color = 'black'),
axis.ticks.x = element_blank())
p2
Snipaste_2021-10-28_23-35-09
參考
- OPLS-DA在R語言中的實現(xiàn) | 小藍哥的知識荒原 (blog4xiang.world)
- R包ropls的偏最小二乘判別分析（PLS-DA）和正交偏最小二乘判別分析（OPLS-DA） (qq.com)
- 用PLS和OPLS分析代謝組數(shù)據(jù) - 簡書 (jianshu.com)
- ropls: PCA, PLS(-DA) and OPLS(-DA) for multivariate analysis and feature selection of omics data (bioconductor.org)
往期
推廣.jpg
