-
Notifications
You must be signed in to change notification settings - Fork 55
/
Copy pathplotIndiv.pls.R
185 lines (162 loc) · 7.97 KB
/
plotIndiv.pls.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
#----------------------------------------------------------------------------------------------------------#
#-- Includes plotIndiv for PLS, sPLS, PLS-DA, SPLS-DA, --#
#----------------------------------------------------------------------------------------------------------#
#' @rdname plotIndiv
#' @method plotIndiv mixo_pls
#' @export
plotIndiv.mixo_pls <-
function(object,
comp = NULL,
rep.space = NULL,
ind.names = TRUE,
group,
col.per.group,
style = "ggplot2",
ellipse = FALSE,
ellipse.level = 0.95,
centroid = FALSE,
star = FALSE,
title = NULL,
subtitle,
legend = FALSE,
X.label = NULL,
Y.label = NULL,
Z.label = NULL,
abline = FALSE,
xlim = NULL,
ylim = NULL,
col,
cex,
pch,
pch.levels,
alpha = 0.2,
axes.box = "box",
layout = NULL,
size.title = rel(2),
size.subtitle = rel(1.5),
size.xlabel = rel(1),
size.ylabel = rel(1),
size.axis = rel(0.8),
size.legend = rel(1),
size.legend.title = rel(1.1),
legend.title = "Legend",
legend.title.pch = "Legend",
legend.position = "right",
point.lwd = 1,
background = NULL,
...
)
{
plot_parameters = list(size.title = size.title, size.subtitle = size.subtitle, size.xlabel = size.xlabel, size.ylabel = size.ylabel,
size.axis = size.axis, size.legend = size.legend, size.legend.title = size.legend.title, legend.title = legend.title,
legend.title.pch = legend.title.pch, legend.position = legend.position, point.lwd = point.lwd)
if (inherits(object, c("mint.block.pls", "mint.block.spls", "mint.block.plsda", "mint.block.splsda")))
stop("No plotIndiv for the following functions at this stage: mint.block.pls, mint.block.spls, mint.block.plsda, mint.block.splsda.")
#-- choose rep.space
if (is.null(rep.space) && inherits(object, "DA"))#"splsda", "plsda", "mlsplsda")))
{
rep.space = "X-variate"
} else if (is.null(rep.space)) {
rep.space = "multi"
}
rep.space = match.arg(rep.space, c("XY-variate", "X-variate", "Y-variate", "multi"))
#c("XY-variate", "X-variate", "Y-variate", "multi")[pmatch(rep.space, c("XY-variate", "X-variate", "Y-variate", "multi"))]
if (rep.space == "multi")
{
blocks = c("X", "Y")
object$variates = object$variates[names(object$variates) %in% blocks]
}
if (rep.space == "X-variate")
{
object$variates = object$variates["X"]
blocks = "X"
}
if (rep.space == "Y-variate")
{
object$variates = object$variates["Y"]
blocks = "Y"
}
if (rep.space == "XY-variate")
{
object$variates$XYvariates = (object$variates$X + object$variates$Y)/2
object$variates = object$variates["XYvariates"]
blocks = "XY combined"
}
if (length(blocks)!= length(unique(blocks)))
stop("Duplicate in 'blocks' not allowed")
if (!missing(subtitle))
{
if (length(subtitle)!= length(blocks) | length(subtitle)!= length(unique(subtitle)))
stop("'subtitle' indicates the subtitle of the plot for each 'blocks'; it needs to be the same length as 'blocks' and duplicate are not allowed.")
}
if(!is.null(background) && !is(background, "background.predict"))
stop("'background' must have been obtained with the 'background.predict' function")
#-- check inputs
check = check.input.plotIndiv(object = object, comp = comp , blocks = blocks, ind.names = ind.names,
style = style, ellipse = ellipse, ellipse.level = ellipse.level, centroid = centroid,
star = star, legend = legend, X.label = X.label, Y.label = Y.label, Z.label = Z.label, abline = abline,
xlim = xlim, ylim = ylim, alpha = alpha, axes.box = axes.box, plot_parameters = plot_parameters)
#-- retrieve outputs from the checks
axes.box = check$axes.box
comp = check$comp
xlim = check$xlim
ylim = check$ylim
ind.names = check$ind.names
display.names = check$display.names
#-- get the variates
variate = internal_getVariatesAndLabels(object, comp, blocks = blocks, rep.space = rep.space, style = style, X.label = X.label,
Y.label = Y.label, Z.label = Z.label)
#-- retrieve outputs
x = variate$x
y = variate$y
z = variate$z
X.label = variate$X.label
Y.label = variate$Y.label
Z.label = variate$Z.label
n = nrow(object$X)
# create data frame df that contains (almost) all the ploting information
out = shape.input.plotIndiv(object = object, n = n, blocks = blocks, x = x, y = y, z = z, ind.names = ind.names, group = group,
col.per.group = col.per.group, style = style, study = "global", ellipse = ellipse, ellipse.level = ellipse.level,
centroid = centroid, star = star, title = title, xlim = xlim, ylim = ylim,
col = col, cex = cex, pch = pch, pch.levels = pch.levels, display.names = display.names, plot_parameters = plot_parameters)
#-- retrieve outputs
df = out$df
df.ellipse = out$df.ellipse
col.per.group = out$col.per.group
title = out$title
display.names = out$display.names
xlim = out$xlim
ylim = out$ylim
#missing.col = out$missing.col
ellipse = out$ellipse
centroid = out$centroid
star = out$star
plot_parameters = out$plot_parameters
# change the levels of df$Block to "subtitle"
if (!missing(subtitle) & nlevels(df$Block)>1)#& !is.null(title)) # commented so that subtitle can be change without changing the title
{
df$Block = factor(df$Block, labels = subtitle)
if (ellipse)
df.ellipse$Block = factor(df.ellipse$Block, labels = subtitle)
}
# match background color to col.per.group, the color of the groups
if(!is.null(background))
{
ind.match = match(names(background), levels(df$group))
names(background) = adjustcolor(col.per.group[ind.match],alpha.f=0.1)
}
#save(list = ls(), file = "temp.Rdata")
#call plot module (ggplot2, lattice, graphics, 3d)
res = internal_graphicModule(df = df, centroid = centroid, col.per.group = col.per.group, title = title,
X.label = X.label, Y.label = Y.label, Z.label = Z.label, xlim = xlim, ylim = ylim, class.object = class(object),
display.names = display.names, legend = legend, abline = abline, star = star,
ellipse = ellipse, df.ellipse = df.ellipse, style = style, layout = layout, #missing.col = missing.col,
axes.box = axes.box, plot_parameters = plot_parameters, alpha = alpha, background = background)
return(invisible(list(df = df, df.ellipse = df.ellipse, graph = res)))
}
#' @method plotIndiv mixo_spls
#' @export
plotIndiv.mixo_spls <- plotIndiv.mixo_pls
#' @method plotIndiv rcc
#' @export
plotIndiv.rcc <- plotIndiv.mixo_pls