| 32 |
pdel |
1 |
bdbiplot.default <- function (x, y, var.axes = TRUE, col, cex = rep(par("cex"), 2),
|
|
|
2 |
xlabs = NULL, ylabs = NULL, expand = 1, xlim = NULL, ylim = NULL,
|
|
|
3 |
arrow.len = 0.1, main = NULL, sub = NULL, xlab = NULL, ylab = NULL,
|
|
|
4 |
...)
|
|
|
5 |
{
|
|
|
6 |
n <- nrow(x)
|
|
|
7 |
p <- nrow(y)
|
|
|
8 |
if (missing(xlabs)) {
|
|
|
9 |
xlabs <- dimnames(x)[[1]]
|
|
|
10 |
if (is.null(xlabs))
|
|
|
11 |
xlabs <- 1:n
|
|
|
12 |
}
|
|
|
13 |
xlabs <- as.character(xlabs)
|
|
|
14 |
dimnames(x) <- list(xlabs, dimnames(x)[[2]])
|
|
|
15 |
if (missing(ylabs)) {
|
|
|
16 |
ylabs <- dimnames(y)[[1]]
|
|
|
17 |
if (is.null(ylabs))
|
|
|
18 |
ylabs <- paste("Var", 1:p)
|
|
|
19 |
}
|
|
|
20 |
ylabs <- as.character(ylabs)
|
|
|
21 |
dimnames(y) <- list(ylabs, dimnames(y)[[2]])
|
|
|
22 |
if (length(cex) == 1)
|
|
|
23 |
cex <- c(cex, cex)
|
|
|
24 |
if (missing(col)) {
|
|
|
25 |
col <- par("col")
|
|
|
26 |
if (!is.numeric(col))
|
|
|
27 |
col <- match(col, palette(), nomatch = 1)
|
|
|
28 |
col <- c(col, col + 1)
|
|
|
29 |
}
|
|
|
30 |
else if (length(dim(col))>2){
|
|
|
31 |
col1 <- col[,1]
|
|
|
32 |
col.box <- 1
|
|
|
33 |
col2 <- col[,2]
|
|
|
34 |
col.traxis
|
|
|
35 |
}
|
|
|
36 |
else if (length(col) == 1)
|
|
|
37 |
col <- c(col, col)
|
|
|
38 |
unsigned.range <- function(x) c(-abs(min(x, na.rm = TRUE)),
|
|
|
39 |
abs(max(x, na.rm = TRUE)))
|
|
|
40 |
rangx1 <- unsigned.range(x[, 1])
|
|
|
41 |
rangx2 <- unsigned.range(x[, 2])
|
|
|
42 |
rangy1 <- unsigned.range(y[, 1])
|
|
|
43 |
rangy2 <- unsigned.range(y[, 2])
|
|
|
44 |
if (missing(xlim) && missing(ylim))
|
|
|
45 |
xlim <- ylim <- rangx1 <- rangx2 <- range(rangx1, rangx2)
|
|
|
46 |
else if (missing(xlim))
|
|
|
47 |
xlim <- rangx1
|
|
|
48 |
else if (missing(ylim))
|
|
|
49 |
ylim <- rangx2
|
|
|
50 |
ratio <- max(rangy1/rangx1, rangy2/rangx2)/expand
|
|
|
51 |
on.exit(par(op))
|
|
|
52 |
op <- par(pty = "s")
|
|
|
53 |
if (!is.null(main))
|
|
|
54 |
op <- c(op, par(mar = par("mar") + c(0, 0, 1, 0)))
|
|
|
55 |
bdplot(x, type = "n", xlim = xlim, ylim = ylim, col = col1,
|
|
|
56 |
xlab = xlab, ylab = ylab, sub = sub, main = main, ...)
|
|
|
57 |
text(x, xlabs, cex = cex[1], col = col1, ...)
|
|
|
58 |
par(new = TRUE)
|
|
|
59 |
bdplot(y, axes = FALSE, type = "n", xlim = xlim * ratio, ylim = ylim *
|
|
|
60 |
ratio, xlab = "", ylab = "", col = col1, ...)
|
|
|
61 |
axis(3, col = col.traxis, ...)
|
|
|
62 |
axis(4, col = col.traxis, ...)
|
|
|
63 |
|
|
|
64 |
box(col = col.box)
|
|
|
65 |
|
|
|
66 |
text(y, labels = ylabs, cex = cex[2], col = col2, ...)
|
|
|
67 |
if (var.axes)
|
|
|
68 |
arrows(0, 0, y[, 1] * 0.8, y[, 2] * 0.8, col = col2,
|
|
|
69 |
length = arrow.len)
|
|
|
70 |
|
|
|
71 |
invisible()
|
|
|
72 |
}
|