主成分分析（PCA）は、高次元データを効果的に処理できる教師なし次元削減手法です。ただし、PCAは相関の少ない変数に敏感ではなく、PLS-DA（部分最小二乗判別分析）はこの問題を効果的に解決できます。一方、OPLS-DA（直交部分最小二乗判別分析）は、直交信号とPLS-DAを組み合わせて、微分変数をスクリーニングします。
「「この分析は、主にメタボロミクスにおける異なる代謝物のスクリーニングに使用されます。
データセット
成人183人の尿サンプルを液体クロマトグラフィー高分解能質量分析（LTQ Orbitrap）で分析しました。
sacurineリストには3つのデータマトリックスが含まれています。
dataMatrixサンプル-代謝物含有量マトリックス（log10変換）については、各サンプルのさまざまなタイプの代謝物の含有量情報が記録されました。合計183のサンプル（行）と109の代謝物（列）。
sampleMetadata183のサンプルが得られた個人のゼロ年、体重、性別、およびその他の情報が記録されました。
variableMetadata109代謝物、MSIレベルの注釈の詳細。
rm(list = ls())
# load packages
library(ropls)
# load data
data(sacurine)
#查看数据集
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 MOPLS-DA
# 分组以性别为例
# 通过orthoI指定正交组分数目
# orthoI = NA时，执行OPLS，并通过交叉验证自动计算适合的正交组分数
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
結果では、は、構築されたモデルのX行列R2XとR2YY行列の解釈率をそれぞれQ2表し、モデルの予測能力を表します。値が1に近いほど、モデルの適合度が高くなります。より正確には、トレーニングセットのサンプルを元の属性に分割できます。
慣性棒グラフ（左上）
3つの直交軸の
R2Y合計が表示されQ2Yます。累積解釈率を示すことにより、直交成分の妥当性を評価します。重要な診断（右上）
実際のモデルとシミュレーションされたモデルの
R2Y合計値の散布図はQ2Yランダムに配置されます。モデルのR2Y合計Q2Y（散布点）が真の値（水平線）よりも大きい場合、過剰適合2が発生していることを示します。右上、OPLS-DAモデルのR2YおよびQ2Yと、データをランダムに並べ替えた後に取得された対応する値との比較。外れ値表示（左下）
射影面と正射影面内の各サンプルの距離が表示され、値が高いサンプルには名前が付けられ、他のサンプルとの違いがより大きくなっていることを示します。色は性別のグループを表します。
xスコアプロット（右下）
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.6561281p <- 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) + #添加置信区间
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
示差的代謝物スクリーニング
#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#对差异代谢物进行棒棒糖图可视化
#代谢物名字太长进行转换
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
参考
R言語でのOPLS-DAの実装|LittleBlueのKnowledgeWasteland（blog4xiang.world）
Rパッケージroplの部分最小二乗判別分析（PLS-DA）および直交部分最小二乗判別分析（OPLS-DA）
PLSおよびOPLSを使用したメタボロミクスデータの分析
ropls：多変量解析およびオミクスデータの特徴選択のためのPCA、PLS（-DA）およびOPLS（-DA）（bioconductor.org）
過去
