R-alpha: barplot()

[Kurt Hornik]

I've created a hacked version of barplot() which is more compatible with
the S version, but currently ONLY FOR VECTORS.

Differences && new features:

* The `space' argument is interpreted as the fraction of the average bar
width.  (The current version has the width of the bar plus the space in
between constrained to sum to 1.)

* There is a new argument `width'.

* There is a new argument `horiz' for producing horizontal barplots.

Please have a look.  If the changes are ok'ed, I will also change the
matrix case accordingly.

I have a remark and a question.

* The printing of labels at the vertical axis seems to be different in R
and S when using axis(), the labels come out horizontal in S and
vertical in R.  Compare
	x <- 1:5
	plot(x, axes = F)
	axis(2, at = x, labels = LETTERS[x])

* I feel a bit stupid repeating most code for the horiz T and F cases.
Is there a smarter way to `swap' x and y when plotting?

-k

*************************************************************************
"barplot" <-
function(height, width = 1, space = 0.2, names.arg, legend.text,
	 beside = FALSE, horiz = FALSE, col = NULL, border = par("fg"),
	 main = NULL, xlab = NULL, ylab = NULL, xlim, ylim, axes = TRUE,
	 ...)
{
  opar <- par(yaxs="i", xpd=TRUE)
  on.exit(par(opar))
  if (is.matrix(height)) {
    if (beside) {
      delta <- 0.5 * (1 - space)
      if (missing(xlim))
	xlim <- c(0, ncol(height)) + 0.5
      if (missing(ylim))
	ylim <- range(-0.01, height)
      plot.new()
      plot.window(xlim, ylim, log = "")
      for (i in 1:ncol(height)) {
	xx <- seq(i-delta, i+delta, length=nrow(height)+1)
	xl <- xx[1:nrow(height)]
	xr <- xx[1:nrow(height)+1]
	rect(xl, 0, xr, height[,i], col=col, xpd=TRUE)
      }
    } else { #-- not 'beside' --
      delta <- 0.5 * (1 - space)
      nheight <- rbind(0, apply(height, 2, cumsum))
      if (missing(xlim)) 
	xlim <- c(0, ncol(height)) + 0.5
      if (missing(ylim)) 
	ylim <- range(-0.01, nheight)
      plot.new()
      plot.window(xlim, ylim, log = "")
      for (i in 1:ncol(height))
	rect(i - delta, nheight[-1, i],
	     i + delta, nheight[1:nrow(height), i],
	     col = col, xpd=TRUE)
    }
    if(missing(names.arg))
      names.arg <- dimnames(height)[[2]]
    if(!is.null(names.arg)) {
      if(length(names.arg) != ncol(height))
	stop("incorrect number of names")
      for(i in 1:length(names.arg))
	axis(1, at=1:length(names.arg), labels=names.arg, lty=0)
    }
  }
  else { ##---- height is vector ---------
    space <- space * mean(width)
    width <- rep(width, length = length(height))
    delta <- width / 2
    LRC <- cumsum(space + width)
    MID <- LRC - delta
    LLC <- MID - delta
    if (missing(xlim)) xlim <- c(0, max(LRC))
    if (missing(ylim)) ylim <- range(-0.01, height)
    plot.new()
    if (horiz) {
      plot.window(ylim, xlim, log = "")
      rect(0, LLC, height, LRC, col, xpd = TRUE)
    } else {
      plot.window(xlim, ylim, log = "")      
      rect(LLC, 0, LRC, height, col, xpd = TRUE)
    }
    if (missing(names.arg))
      names.arg <- names(height)
    if (!is.null(names.arg))
      for (i in 1:length(names.arg))
	if (horiz)
	  axis(2, at = MID, labels = names.arg, lty = 0)
	else
	  axis(1, at = MID, labels = names.arg, lty = 0)
  }
  if (!missing(legend.text) && !missing(col)) {
    xy <- par("usr")
    legend(xy[2] - xinch(0.1), xy[4] - yinch(0.1),
	   legend = rev(legend.text), fill = rev(col),
	   xjust = 1, yjust = 1)
  }
  title(main = main, xlab = xlab, ylab = ylab, ...)
  if (axes)
    if (horiz)
      axis(1)
    else
      axis(2)
}

=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
r-devel mailing list -- Read http://www.ci.tuwien.ac.at/~hornik/R/R-FAQ.html
Send "info", "help", or "[un]subscribe"
(in the "body", not the subject !)  To: r-devel-request@stat.math.ethz.ch
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-