This repository has been archived by the owner on Apr 10, 2022. It is now read-only.
-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathpcatools.R
219 lines (206 loc) · 7.45 KB
/
pcatools.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
#######################################################
# Copyright (C) 2020 by Hiplot Team #
# All rights reserved. #
#######################################################
pacman::p_load(PCAtools)
# https://hiplot.com.cn/basic/pcatools
# @hiplot start
# @appname pcatools
# @apptitle
# PCAtools
# 主成分分析 (PCAtools)
# @target basic
# @tag correlation dimension
# @author Hiplot Team | Jianfeng Li
# @email [email protected]
# @url https://github.com/kevinblighe/PCAtools
# @version 0.1.0
# @release 2021-01-31
# @description
# en: Dimension reduction methods
# zh: 常规降维
#
# @main call_pcatools
# @library PCAtools
#
# @param datTable export::data::hiplot-textarea::{"default": {"value":"public/demo/pcatools/data.txt", "link":""}, "required": true}
# en: Data Table
# zh: 数据表
# @param sampleInfo export::data::hiplot-textarea::{"default": {"value":"public/demo/pcatools/data2.txt", "link":""}, "required": true}
# en: Sample Info
# zh: 样本信息
# @param screeplotComponents export::extra::slider::{"default":30, "min":1, "max":999, "step":1, "class":"col-12 col-md-6"}
# en: Screeplot Components
# zh: 崖低碎石图主成分数目
# @param pairsplotComponents export::extra::slider::{"default":3, "min":1, "max":999, "step":1, "class":"col-12 col-md-6"}
# en: Pairsplot Components
# zh: 散点矩阵图主成分数目
# @param plotloadingsComponents export::extra::slider::{"default":5, "min":1, "max":999, "step":1, "class":"col-12 col-md-6"}
# en: Plotloadings Components
# zh: 载荷图主成分数目
# @param eigencorplotComponents export::extra::slider::{"default":10, "min":1, "max":999, "step":1, "class":"col-12 col-md-6"}
# en: Eigencorplot Components
# zh: 关联热图主成分数目
# @param top_var export::extra::slider::{"default":90, "min":1, "max":100, "step":1, "class":"col-12"}
# en: Top Variance
# zh: Top 方差
# @param biplotColBy export::dataArg::sampleInfo::{"default": "ER", "index":1, "individual": true, "class":"col-12 col-md-6"}
# en: Biplot Color By
# zh: 双标图颜色列
# @param biplotShapeBy export::dataArg::sampleInfo::{"default": "Grade", "index":2, "individual": true, "class":"col-12 col-md-6"}
# en: Biplot Shape By
# zh: 双标图形状列
# @param eigencorplotMetavars export::dataArg::sampleInfo::{"default": ["Study", "Age", "Distant.RFS", "ER", "GGI", "Grade", "Size", "Time.RFS"], "index":3, "individual": true, "class":"col-12", "multiple":true}
# en: Eigencorplot Phenotype
# zh: 关联热图表型列
# @param screeplotColBar export::extra::color-picker::{"default": "#0085FF", "class": "col-12 col-md-3"}
# en: Screeplot Bar
# zh: 崖低碎石图颜色
# @param plotloadingsLowCol export::extra::color-picker::{"default": "#0085FF", "class": "col-12 col-md-3"}
# en: Loadings Low
# zh: 载荷图低颜色
# @param plotloadingsMidCol export::extra::color-picker::{"default": "#FFFFFF", "class": "col-12 col-md-3"}
# en: Loadings Mid
# zh: 载荷图中颜色
# @param plotloadingsHighCol export::extra::color-picker::{"default": "#FF0000", "class": "col-12 col-md-3"}
# en: Loadings High
# zh: 载荷图高颜色
#
# @return ggplot::["pdf", "png"]::{"title": "", "width": 19, "height": 14, "palette": "lancet"}
# @hiplot end
call_pcatools <- function(datTable, sampleInfo,
top_var,
screeplotComponents, screeplotColBar,
pairsplotComponents,
biplotShapeBy, biplotColBy,
plotloadingsComponents,
plotloadingsLowCol,
plotloadingsMidCol,
plotloadingsHighCol,
eigencorplotMetavars,
eigencorplotComponents) {
row.names(datTable) <- datTable[, 1]
datTable <- datTable[, -1]
row.names(sampleInfo) <- sampleInfo[, 1]
sampleInfo <- sampleInfo[, -1]
data3 <- pca(datTable, metadata = sampleInfo, removeVar = (100 - top_var) / 100)
p1 <- PCAtools::screeplot(
data3,
components = getComponents(data3, 1:screeplotComponents),
axisLabSize = 14, titleLabSize = 20,
colBar = screeplotColBar,
gridlines.major = FALSE, gridlines.minor = FALSE,
returnPlot = TRUE
)
p2 <- PCAtools::pairsplot(
data3,
components = getComponents(data3, c(1:pairsplotComponents)),
triangle = TRUE, trianglelabSize = 12,
hline = 0, vline = 0,
pointSize = 0.8, gridlines.major = FALSE, gridlines.minor = FALSE,
colby = "Grade",
title = "", plotaxes = FALSE,
margingaps = unit(c(0.01, 0.01, 0.01, 0.01), "cm"),
returnPlot = TRUE,
colkey = get_hiplot_color(
conf$general$palette, -1,
conf$general$palette_custom
)
) # !!
params_biplot <- list(data3,
showLoadings = TRUE,
lengthLoadingsArrowsFactor = 1.5,
sizeLoadingsNames = 4,
colLoadingsNames = "red4",
# other parameters
lab = NULL,
hline = 0, vline = c(-25, 0, 25),
vlineType = c("dotdash", "solid", "dashed"),
gridlines.major = FALSE, gridlines.minor = FALSE,
pointSize = 5,
legendPosition = "none", legendLabSize = 16, legendIconSize = 8.0,
drawConnectors = FALSE,
title = "PCA bi-plot",
subtitle = "PC1 versus PC2",
caption = "27 PCs ≈ 80%",
returnPlot = TRUE
)
if (!is.null(biplotShapeBy) && biplotShapeBy != "") {
params_biplot$shape <- biplotShapeBy
}
if (!is.null(biplotColBy) && biplotColBy != "") {
params_biplot$colby <- biplotColBy
params_biplot$colkey <- get_hiplot_color(
conf$general$palette, -1,
conf$general$palette_custom
) # !!
}
p3 <- do.call(PCAtools::biplot, params_biplot)
p4 <- PCAtools::plotloadings(
data3,
rangeRetain = 0.01, labSize = 4,
components = getComponents(data3, c(1:plotloadingsComponents)),
title = "Loadings plot", axisLabSize = 12,
subtitle = "PC1, PC2, PC3, PC4, PC5",
caption = "Top 1% variables",
gridlines.major = FALSE, gridlines.minor = FALSE,
shape = 24, shapeSizeRange = c(4, 8),
col = c(plotloadingsLowCol, plotloadingsMidCol, plotloadingsHighCol),
legendPosition = "none",
drawConnectors = FALSE,
returnPlot = TRUE
)
eigencorplotMetavars <- unlist(eigencorplotMetavars)
if (length(eigencorplotMetavars) > 0) {
metavars <- eigencorplotMetavars
} else {
metavars <- colnames(sampleInfo)[2:ncol(sampleInfo)]
}
p5 <- PCAtools::eigencorplot(
data3,
components = getComponents(data3, 1:eigencorplotComponents),
metavars = metavars,
cexCorval = 1.0,
fontCorval = 2,
posLab = "all",
rotLabX = 45,
scale = TRUE,
main = "PC clinical correlates",
cexMain = 1.5,
plotRsquared = FALSE,
corFUN = "pearson",
corUSE = "pairwise.complete.obs",
signifSymbols = c("****", "***", "**", "*", ""),
signifCutpoints = c(0, 0.0001, 0.001, 0.01, 0.05, 1),
returnPlot = TRUE
)
p6 <- plot_grid(
p1, p2, p3,
ncol = 3,
labels = c("A", "B Pairs plot", "C"),
label_fontfamily = "serif",
label_fontface = "bold",
label_size = 22,
align = "h",
rel_widths = c(1.10, 0.80, 1.10)
)
p7 <- plot_grid(
p4,
as.grob(p5),
ncol = 2,
labels = c("D", "E"),
label_fontfamily = "serif",
label_fontface = "bold",
label_size = 22,
align = "h",
rel_widths = c(0.8, 1.2)
)
p <- plot_grid(
p6, p7,
ncol = 1,
rel_heights = c(1.1, 0.9)
)
out_xlsx <- paste(opt$outputFilePrefix, ".xlsx", sep = "")
write.xlsx(as.data.frame(data3$rotated), out_xlsx, row.names = TRUE)
return(p)
}