/
viz_ellipse.R
85 lines (77 loc) · 2.59 KB
/
viz_ellipse.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
# PLOT ELLIPSE
#' @include AllGenerics.R
NULL
#' @export
#' @rdname viz_wrap
#' @aliases viz_tolerance,MultivariateAnalysis-method
setMethod(
f = "viz_tolerance",
signature = c(x = "MultivariateAnalysis"),
definition = function(x, ..., margin = 1, axes = c(1, 2), group = NULL, level = 0.95) {
.viz_ellipse(x, ..., type = "tolerance", level = level,
margin = margin, axes = axes, group = group)
}
)
#' @export
#' @rdname viz_wrap
#' @aliases viz_tolerance,BootstrapCA-method
setMethod(
f = "viz_tolerance",
signature = c(x = "BootstrapCA"),
definition = function(x, ..., margin = 1, axes = c(1, 2), level = 0.95) {
group <- get_groups(x, margin = margin)
methods::callNextMethod(x, margin = margin, axes = axes, group = group,
level = level, ...)
invisible(x)
}
)
#' @export
#' @rdname viz_wrap
#' @aliases viz_confidence,MultivariateAnalysis-method
setMethod(
f = "viz_confidence",
signature = c(x = "MultivariateAnalysis"),
definition = function(x, ..., margin = 1, axes = c(1, 2), group = NULL, level = 0.95) {
.viz_ellipse(x, ..., type = "confidence", level = level,
margin = margin, axes = axes, group = group)
}
)
#' @export
#' @rdname viz_wrap
#' @aliases viz_confidence,BootstrapCA-method
setMethod(
f = "viz_confidence",
signature = c(x = "BootstrapCA"),
definition = function(x, ..., margin = 1, axes = c(1, 2), level = 0.95) {
group <- get_groups(x, margin = margin)
methods::callNextMethod(x, margin = margin, axes = axes, group = group,
level = level, ...)
invisible(x)
}
)
.viz_ellipse <- function(x, ..., type = c("tolerance", "confidence"),
level = 0.95, margin = 1, axes = c(1, 2),
group = NULL, border = graphics::par("col"),
col = NA, lty = graphics::par("lty"),
lwd = graphics::par("lwd")) {
fun <- switch(
type,
tolerance = wrap_tolerance,
confidence = wrap_confidence
)
ell <- fun(x, margin = margin, axes = axes, group = group, level = level)
n <- length(ell)
## Graphical parameters
if (length(border) == 1) border <- rep(border, length.out = n)
if (length(col) == 1) col <- rep(col, length.out = n)
if (length(lty) == 1) lty <- rep(lty, length.out = n)
if (length(lwd) == 1) lwd <- rep(lwd, length.out = n)
for (i in seq_along(ell)) {
lvl <- ell[[i]]
for (j in seq_along(lvl)) {
graphics::polygon(x = lvl[[j]], border = border[i],
col = col[i], lty = lty[i], lwd = lwd[i])
}
}
invisible(x)
}