Subversion Repositories bdplot

bdbiplot.default <- function (x, y, var.axes = TRUE, col, cex = rep(par("cex"), 2), 
                              xlabs = NULL, ylabs = NULL, expand = 1, xlim = NULL, ylim = NULL, 
                              arrow.len = 0.1, main = NULL, sub = NULL, xlab = NULL, ylab = NULL, 
                              ...) 
{
  n <- nrow(x)
  p <- nrow(y)
  if (missing(xlabs)) {
    xlabs <- dimnames(x)[[1]]
    if (is.null(xlabs)) 
      xlabs <- 1:n
  }
  xlabs <- as.character(xlabs)
  dimnames(x) <- list(xlabs, dimnames(x)[[2]])
  if (missing(ylabs)) {
    ylabs <- dimnames(y)[[1]]
    if (is.null(ylabs)) 
      ylabs <- paste("Var", 1:p)
    }
  ylabs <- as.character(ylabs)
  dimnames(y) <- list(ylabs, dimnames(y)[[2]])
  if (length(cex) == 1) 
    cex <- c(cex, cex)
  if (missing(col)) {
    col <- par("col")
    if (!is.numeric(col)) 
      col <- match(col, palette(), nomatch = 1)
    col <- c(col, col + 1)
  }
  else if (length(dim(col))>2){
    col1 <- col[,1]
    col.box <- 1
    col2 <- col[,2]
    col.traxis
  }
  else if (length(col) == 1) 
    col <- c(col, col)
  unsigned.range <- function(x) c(-abs(min(x, na.rm = TRUE)), 
                                  abs(max(x, na.rm = TRUE)))
  rangx1 <- unsigned.range(x[, 1])
  rangx2 <- unsigned.range(x[, 2])
  rangy1 <- unsigned.range(y[, 1])
  rangy2 <- unsigned.range(y[, 2])
  if (missing(xlim) && missing(ylim)) 
    xlim <- ylim <- rangx1 <- rangx2 <- range(rangx1, rangx2)
  else if (missing(xlim)) 
    xlim <- rangx1
  else if (missing(ylim)) 
    ylim <- rangx2
  ratio <- max(rangy1/rangx1, rangy2/rangx2)/expand
  on.exit(par(op))
  op <- par(pty = "s")
  if (!is.null(main)) 
    op <- c(op, par(mar = par("mar") + c(0, 0, 1, 0)))
  bdplot(x, type = "n", xlim = xlim, ylim = ylim, col = col1, 
         xlab = xlab, ylab = ylab, sub = sub, main = main, ...)
  text(x, xlabs, cex = cex[1], col = col1, ...)
  par(new = TRUE)
  bdplot(y, axes = FALSE, type = "n", xlim = xlim * ratio, ylim = ylim * 
         ratio, xlab = "", ylab = "", col = col1, ...)
  axis(3, col = col.traxis, ...)
  axis(4, col = col.traxis, ...)
  
  box(col = col.box)

  text(y, labels = ylabs, cex = cex[2], col = col2, ...)
  if (var.axes) 
    arrows(0, 0, y[, 1] * 0.8, y[, 2] * 0.8, col = col2, 
           length = arrow.len)

  invisible()
}