R/plotCI.R

In musto101/wilcox_R: What the package does (short line)

plotCI <-
function (x, y = NULL, uiw=NULL, liw = uiw, aui=NULL, ali=aui,
                    err="y", ylim=NULL, sfrac = 0.01, gap=0, add=FALSE,
                    col=par("col"), lwd=par("lwd"), slty=par("lty"), xlab=NULL,
                    ylab=NULL, ...) {
## originally from Bill Venables, R-list
  if (is.list(x)) {
    y <- x$y
    x <- x$x
  }
  if (is.null(y)) {
    if (is.null(x))
      stop("both x and y NULL")
    y <- as.numeric(x)
    x <- seq(along = x)
  }
  if (missing(xlab)) xlab <- deparse(substitute(x))
  if (missing(ylab)) ylab <- deparse(substitute(y))
  if (missing(uiw)) { ## absolute limits
    ui <- aui
    li <- ali
  }
  else { ## relative limits
    if (err=="y") z <- y else z <- x
    if(is.null(uiw))stop("Argument uiw, the width of the interval, must be specified")
    ui <- z + uiw
    li <- z - liw
  }
  if (is.null(ylim)) ylim <- range(c(y, ui, li), na.rm=TRUE)
  if (add) {
    points(x, y, col=col, lwd=lwd, ...)
  } else {
    plot(x, y, ylim = ylim, col=col, lwd=lwd, xlab=xlab, ylab=ylab, ...)
  }
  if (gap==TRUE) gap <- 0.01 ## default gap size
  ul <- c(li, ui)
  if (err=="y") {
    gap <- rep(gap,length(x))*diff(par("usr")[3:4]) # smidge <- diff(par("usr")[1:2]) * sfrac
    smidge <- par("fin")[1] * sfrac
# segments(x , li, x, pmax(y-gap,li), col=col, lwd=lwd, lty=slty)
# segments(x , ui, x, pmin(y+gap,ui), col=col, lwd=lwd, lty=slty)
    arrows(x , li, x, pmax(y-gap,li), col=col, lwd=lwd, lty=slty, angle=90, length=smidge, code=1)
    arrows(x , ui, x, pmin(y+gap,ui), col=col, lwd=lwd, lty=slty, angle=90, length=smidge, code=1)
    ## horizontal segments
# x2 <- c(x, x)
# segments(x2 - smidge, ul, x2 + smidge, ul, col=col, lwd=lwd)
  }
  else if (err=="x") {
    gap <- rep(gap,length(x))*diff(par("usr")[1:2])
    smidge <- par("fin")[2] * sfrac
# smidge <- diff(par("usr")[3:4]) * sfrac
    arrows(li, y, pmax(x-gap,li), y, col=col, lwd=lwd, lty=slty, angle=90, length=smidge, code=1)
    arrows(ui, y, pmin(x+gap,ui), y, col=col, lwd=lwd, lty=slty, angle=90, length=smidge, code=1)
    ## vertical segments
# y2 <- c(y, y)
# segments(ul, y2 - smidge, ul, y2 + smidge, col=col, lwd=lwd)
  }
  invisible(list(x = x, y = y))
}