-
Notifications
You must be signed in to change notification settings - Fork 0
/
plotLDA.R
162 lines (146 loc) · 5.46 KB
/
plotLDA.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
#' Principle Component - Linear Discriminant Analysis plot
#' @rdname plotLDA
#' @description Plot linear discriminant analysis results of pre-treated data
#' @param analysis S4 object of class `AnalysisData` or `Analysis`
#' @param cls name of sample information column to use for class labels
#' @param label name of sample information column to use for sample labels. Set to NULL for no labels.
#' @param scale scale the data
#' @param center center the data
#' @param xAxis principle component to plot on the x-axis
#' @param yAxis principle component to plot on the y-axis
#' @param shape TRUE/FALSE use shape aesthetic for plot points.
#' Defaults to TRUE when the number of classes is greater than 12
#' @param ellipses TRUE/FALSE, plot multivariate normal distribution 95\%
#' confidence ellipses for each class
#' @param title plot title
#' @param legendPosition legend position to pass to legend.position argument
#' of `ggplot2::theme`. Set to "none" to remove legend.
#' @param labelSize label size. Ignored if `label` is `NULL`
#' @param type `raw` or `pre-treated` data to plot
#' @param ... arguments to pass to the appropriate method
#' @examples
#' library(metaboData)
#'
#' d <- analysisData(abr1$neg,abr1$fact) %>%
#' occupancyMaximum(cls = 'day')
#'
#' ## LDA plot
#' plotLDA(d,cls = 'day')
#' @export
setGeneric('plotLDA',
function(
analysis,
cls = 'class',
label = NULL,
scale = TRUE,
center = TRUE,
xAxis = 'DF1',
yAxis = 'DF2',
shape = FALSE,
ellipses = TRUE,
title = 'PC-LDA',
legendPosition = 'bottom',
labelSize = 2,
...)
standardGeneric('plotLDA'))
#' @rdname plotLDA
#' @importFrom ggplot2 stat_ellipse coord_fixed ylab scale_colour_manual
setMethod('plotLDA',
signature = 'AnalysisData',
function(analysis,
cls = 'class',
label = NULL,
scale = TRUE,
center = TRUE,
xAxis = 'DF1',
yAxis = 'DF2',
shape = FALSE,
ellipses = TRUE,
title = 'PC-LDA',
legendPosition = 'bottom',
labelSize = 2){
lda <- nlda(analysis,cls = cls,scale = scale,center = center)
tw <- lda@Tw %>%
round(2)
classLength <- clsLen(lda,cls = cls)
lda <- lda@x %>%
as_tibble() %>%
mutate(!!cls := lda@cl)
if (classLength > 2) {
lda <- lda %>%
select(all_of(c(cls,xAxis,yAxis)))
if (!is.null(label)) {
lda <- lda %>%
bind_cols(sinfo(analysis) %>%
select(all_of(label)))
}
pl <- scatterPlot(lda,
cls,
xAxis,
yAxis,
ellipses,
shape,
label,
labelSize,
legendPosition,
classLength,
title,
str_c(xAxis,' (Tw: ',tw[xAxis],')'),
str_c(yAxis,' (Tw: ',tw[yAxis],')'))
} else {
pl <- lda %>%
{
ggplot(.,aes(x = !!sym(cls),y = DF1)) +
geom_hline(yintercept = 0,linetype = 2,colour = 'grey')
} %>%
plotShape(cls,shape,classLength) %>%
plotColour(classLength) %>%
plotTheme(legendPosition = 'none',
title,xLabel = cls,
yLabel = str_c('DF1',' (Tw: ',tw['DF1'],')'))
}
return(pl)
}
)
#' @rdname plotLDA
setMethod('plotLDA',
signature = 'Analysis',
function(analysis,
cls = 'class',
label = NULL,
scale = TRUE,
center = TRUE,
xAxis = 'DF1',
yAxis = 'DF2',
shape = FALSE,
ellipses = TRUE,
title = 'PC-LDA',
legendPosition = 'bottom',
labelSize = 2,
type = 'raw'){
if (!(type %in% c('raw','pre-treated'))) {
stop(
'Argument "type" should be one of "raw" or "pre-treated".',
call. = FALSE)
}
if (type == 'pre-treated') {
d <- analysis %>%
preTreated()
} else {
d <- analysis %>%
raw()
}
plotLDA(d,
cls = cls,
label = label,
scale = scale,
center = center,
xAxis = xAxis,
yAxis = yAxis,
shape = shape,
ellipses = ellipses,
title = title,
legendPosition = legendPosition,
labelSize = labelSize)
}
)