.packageName <- "ellipse"
"ellipse" <-function (x, ...) 
  UseMethod("ellipse")
ellipse.arima0<-
  function(x, which = c(1, 2), level = 0.95, t = sqrt(qchisq(level, 2)), ...)
{
        ellipse.default(x$var.coef[which, which], centre = x$coef[which], t = t)
}

"ellipse.default" <-
  function (x, scale = c(1, 1), centre = c(0, 0), level = 0.95, 
            t = sqrt(qchisq(level, 2)), which = c(1, 2), npoints = 100, ...) 
{
  names <- c("x", "y")
  if (is.matrix(x)) {
    xind <- which[1]
    yind <- which[2]
    r <- x[xind, yind]
    if (missing(scale)) {
      scale <- sqrt(c(x[xind, xind], x[yind, yind]))
      if (scale[1] > 0) r <- r/scale[1]
      if (scale[2] > 0) r <- r/scale[2]
    }
    if (!is.null(dimnames(x)[[1]])) 
      names <- dimnames(x)[[1]][c(xind, yind)]
  }
  else r <- x
  r <- min(max(r,-1),1)  # clamp to -1..1, in case of rounding errors
  d <- acos(r)
  a <- seq(0, 2 * pi, len = npoints)
  matrix(c(t * scale[1] * cos(a + d/2) + centre[1], t * scale[2] * 
           cos(a - d/2) + centre[2]), npoints, 2, dimnames = list(NULL, 
                                                    names))
}
"ellipse.glm" <-
  function (x, which = c(1, 2), level = 0.95, t, npoints = 100, dispersion, ...) 
{
  s <- summary(x)
  est.disp <- missing(dispersion) & !(x$family$family %in% c('poisson','binomial'))
  if (missing(dispersion)) dispersion <- s$dispersion
  if (missing(t)) t <- ifelse(est.disp,sqrt(2 * qf(level, 2, s$df[2])),
			                           sqrt(qchisq(level, 2)))
  ellipse.default(dispersion * s$cov.unscaled[which, which], 
                  centre = x$coefficients[which], t = t, npoints = npoints)
}
"ellipse.lm" <-
  function (x, which = c(1, 2), level = 0.95, t = sqrt(2 * qf(level, 
                                                2, x$df.residual)), ...) 
{
  s <- summary(x)
  ellipse.default(s$sigma^2 * s$cov.unscaled[which, which], 
                  centre = x$coefficients[which], t = t)
}
"ellipse.nls" <-
  function (x, which = c(1, 2), level = 0.95, t = sqrt(2 * qf(level, 
                                                2, s$df[2])), ...) 
{
  s <- summary(x)
  ellipse.default(s$sigma^2 * s$cov.unscaled[which, which], 
                  centre = x$m$getPars()[which], t = t)
}
"ellipse.profile" <-
  function (x, which = c(1, 2), level = 0.95, t = sqrt(qchisq(level, 
                                                2)), npoints = 100, ...) 
{
  aa <- x[[which[1]]][[2]][, which[1]]
  ar <- x[[which[1]]][[2]][, which[2]]
  ra <- x[[which[2]]][[2]][, which[1]]
  rr <- x[[which[2]]][[2]][, which[2]]
  atau <- x[[which[1]]][[1]]
  rtau <- x[[which[2]]][[1]]
  arange <- range(c(aa, ra))
  rrange <- range(c(ar, rr))
  atau <- atau/t
  rtau <- rtau/t
  getad <- function(tau1, tau2) {
    if (abs(tau1) > 1) 
      tau1 <- tau1/abs(tau1)
    if (abs(tau2) > 1) 
      tau2 <- tau2/abs(tau2)
    acos1 <- acos(tau1)
    acos2 <- acos(tau2)
    d <- abs(acos1 - acos2)
    a <- (acos1 + acos2)/2
    if (acos1 < acos2) 
      a <- -a
    c(a, d)
  }
  myapprox <- function(x, y, where) {
    good <- is.finite(x) & is.finite(y)
    x <- x[good]
    y <- y[good]
    if (length(x) > 1) {
      result <- approx(x[good], y[good], where)$y
      bad <- is.na(result)
      if (any(bad)) {
        for (i in 1:length(result)) {
          if (bad[i]) {
            if (where[i] > x[length(x)]) {
              x1 <- x[length(x) - 1]
              y1 <- y[length(x) - 1]
              x2 <- x[length(x)]
              y2 <- y[length(x)]
            }
            else if (where[i] < x[1]) {
              x1 <- x[1]
              y1 <- y[1]
              x2 <- x[2]
              y2 <- y[2]
            }
            else stop("Unexpected NA")
            result[i] <- y1 + (where[i] - x1)/(x2 - x1) * 
              (y2 - y1)
          }
        }
      }
    }
    else result <- rep(y, length(where))
    result
  }
  ad <- matrix(NA, nrow = 5, ncol = 2)
  ad[1, ] <- getad(1, myapprox(rr, rtau, myapprox(aa, ar, myapprox(atau, aa, 1))))
  ad[2, ] <- getad(myapprox(aa, atau, myapprox(rr, ra, myapprox(rtau, rr, 1))), 1)
  ad[3, ] <- getad(-1, myapprox(rr, rtau, myapprox(aa, ar, myapprox(atau, aa, -1))))
  ad[4, ] <- getad(myapprox(aa, atau, myapprox(rr, ra, myapprox(rtau, rr, -1))), -1)
  i <- order(ad[1:4, 1])
  ad[1:4, ] <- ad[i, ]
  ad[5, 1] <- ad[1, 1] + 2 * pi
  ad[5, 2] <- ad[1, 2]
  ad <- ad[!duplicated(ad[, 1]), ]
  adv <- spline(ad, n = npoints, method= "periodic")
  avals <- adv$x
  dvals <- adv$y
  matrix(c(myapprox(atau, aa, cos(avals + dvals/2)), myapprox(rtau,  rr, cos(avals - dvals/2))), length(avals), 2, dimnames = list(NULL, names(x[which])))
}
"ellipse.profile.glm" <-
  function (x, which = c(1, 2), level = 0.95, t, npoints = 100, dispersion, ...) 
{
  if (missing(dispersion)) dispersion <- ifelse(attr(x,"original.fit")$family$family %in% c('poisson','binomial'),
			                                      1, NA)
  if (missing(t)) t <- ifelse(is.na(dispersion),sqrt(2 * qf(level, 2, attr(x,"summary")$df[2])),
			                                    sqrt(qchisq(level, 2)*dispersion/attr(x,"summary")$dispersion))
  ellipse.profile(x, which = which, level = level, t = t, npoints = npoints)
}
"ellipse.profile.nls" <-
  function (x, which = c(1, 2), level = 0.95, t = sqrt(2 * qf(level, 2, attr(x, 
                               "summary")$df[2])), npoints = 100, ...) 
{
  ellipse.profile(x, which = which, level = level, t = t, npoints = npoints)
}
"pairs.profile" <-
  function (x, labels = c(names(x), "Profile tau"), panel = lines, 
            invert = TRUE, plot.tau = TRUE, plot.trace = TRUE, plot.sketch = TRUE, 
            plot.ellipse = FALSE, level = 0.95, ...) 
{
  doaxis <- function(which, dolabel = TRUE) axis(which, labels = dolabel) # outer = TRUE, line = -0.5, labels = dolabel)
  setup <- function(x, y, ...) plot(range(x[!is.na(x)]), 
                                       range(y[!is.na(y)]), type = "n", axes = FALSE, ...)
  if (is.character(panel)) 
    panel <- get(panel, mode = "function")
  n <- length(x)
  if (plot.tau) 
    n <- n + 1
  oldpar <- par("oma", "mar", "cex", "tck", "mgp", "mex", 
                "mfrow")
  oldcex <- par("cex")
  CEX <- oldcex * max(7.7/(2 * n + 3), 0.6)
  par(mfrow = c(n, n), mgp = c(2, 0.8, 0), oma = rep(3, 4), 
      mar = rep(0.5, 4), tck = -0.03/n)
  on.exit({
    par(oldpar)
  })
  par(cex = CEX)
  if (length(labels) < n) 
    labels <- paste(deparse(substitute(x)), "[,", 1:n, "]", 
                    sep = "")
  if (par("pty") == "s") {
    dif <- diff(par("fin"))/2
    if (dif > 0) 
      par(omi = c(dif * n, 0, dif * n, 0) + par("omi"))
    else par(omi = c(0, (-dif) * n, 0, (-dif) * n) + par("omi"))
  }
  alltau <- unlist(lapply(x, function(x) x[[1]]), use.names = FALSE)
  order <- if (invert) 
    1:n
  else n:1
  for (i in order) {
    for (j in 1:n) {
      if (i <= length(x)) {
          icomp <- x[[i]]
	  ipars <- as.matrix(icomp[[2]])
      }
      if (j <= length(x)) {
          jcomp <- x[[j]]
	  jpars <- as.matrix(jcomp[[2]])
      }
      xx1 <- NA
      xx2 <- NA
      yy1 <- NA
      yy2 <- NA
      if (i <= length(x)) {
        yy1 <- ipars[, i]
        if (j <= length(x)) {
          xx1 <- ipars[, j]
          xx2 <- jpars[, j]
          yy2 <- jpars[, i]
        }
        else {
          xx1 <- icomp[[1]]
        }
      }
      else {
        yy1 <- jcomp[[1]]
        if (j <= length(x)) {
          xx1 <- jpars[, j]
        }
      }
      xx <- c(xx1, NA, xx2)
      yy <- c(yy1, NA, yy2)
      if (i <= length(x)) {
        if (j <= length(x)) 
          setup(xx, yy, ...)
        else setup(alltau, yy, ...)
      }
      else {
        if (j <= length(x)) 
          setup(xx, alltau, ...)
        else setup(alltau, alltau)
      }
      box()
      if (i == 1) 
        doaxis(3, j%%2 == 0)
      if (i == n) 
        doaxis(1, j%%2 == 1)
      if (j == 1) 
        doaxis(2, i%%2 == 0)
      if (j == n) 
        doaxis(4, i%%2 == 1)
      if (i != j) {
        if ((i <= length(x)) && (j <= length(x))) {
          if (plot.trace) 
            panel(xx, yy, ...)
          if (plot.sketch) 
            for (l in level) panel(ellipse(x, which = c(j, 
                                                i), level = l), ...)
          if (plot.ellipse && !is.null(fit <- attr(x, 
                                                   "original.fit"))) 
            for (l in level) panel(ellipse(fit, which = c(j, 
                                                  i), level = l), ...)
        }
        else if (plot.tau) 
          panel(xx, yy, ...)
      }
      else {
        par(usr = c(0, 1, 0, 1))
        text(0.5, 0.5, labels[i], cex = 1.5 * CEX)
      }
    }
  }
  invisible()
}
"plotcorr" <-
  function (corr, outline = TRUE, col = 'grey', numbers = FALSE, bty = "n", axes = FALSE,
            xlab = "", ylab = "", asp = 1, cex.lab = par("cex.lab"), cex = 0.75*par("cex"),
			mar = 0.1 + c(2,2,4,2), ...) 
{
    savepar <- par(pty = "s", mar = mar)
    on.exit(par(savepar))

    if (is.null(corr)) return(invisible())
    if ((!is.matrix(corr)) || (round(min(corr, na.rm = TRUE), 6) < -1) 
			   || (round(max(corr, na.rm = TRUE), 6) > 1)) 
	stop("Need a correlation matrix")

    plot.new()
    par(new = TRUE)

    rowdim <- dim(corr)[1]
    coldim <- dim(corr)[2]
    maxdim <- max(rowdim, coldim)

    rowlabs <- dimnames(corr)[[1]]
    collabs <- dimnames(corr)[[2]]
    if (is.null(rowlabs)) rowlabs <- 1:rowdim
    if (is.null(collabs)) collabs <- 1:coldim
    rowlabs <- as.character(rowlabs)
    collabs <- as.character(collabs)

    plt <- par('plt')
    xlabwidth <- max(strwidth(rowlabs,units='figure',cex=cex.lab))/(plt[2]-plt[1])
    xlabwidth <- xlabwidth*maxdim/(1-xlabwidth)
    ylabwidth <- max(strwidth(collabs,units='figure',cex=cex.lab))/(plt[4]-plt[3])
    ylabwidth <- ylabwidth*maxdim/(1-ylabwidth)

    plot(c(-xlabwidth-0.5, maxdim + 0.5), c(0.5, maxdim + 1 + ylabwidth), 
	 type = "n", bty = bty, axes = axes, xlab = "", ylab = "", asp = asp, 
	 cex.lab = cex.lab, ...)
    text(rep(0, rowdim), rowdim:1, labels = rowlabs, adj = 1, cex = cex.lab)
    text(1:coldim, rep(rowdim + 1, coldim), labels = collabs, 
	 srt = 90, adj = 0, cex = cex.lab)
    mtext(xlab,1,0)
    mtext(ylab,2,0) 
    cols <- rep(1:coldim, rep(rowdim, coldim))
    rows <- rep(1:rowdim, coldim)
    if (!numbers) {
	mat <- diag(c(1, 1))
	for (i in 1:length(cols)) {
	    mat[1, 2] <- as.vector(corr)[i]
	    mat[2, 1] <- mat[1, 2]
	    ell <- ellipse(mat, t = 0.43)
	    ell[, 1] <- ell[, 1] + cols[i]
	    ell[, 2] <- ell[, 2] + rowdim + 1 - rows[i]
	    polygon(ell, col = col)
	    if (outline) lines(ell)
	}
    }
    else text(cols + 0.3, rowdim + 1 - rows, round(10 * as.vector(corr), 
						   0), adj = 1, cex = cex)
    invisible()
}







