From mschwartz@medanalytics.com  Thu Sep 19 23:51:47 2002
From: mschwartz@medanalytics.com (Marc Schwartz)
Date: Thu, 19 Sep 2002 17:51:47 -0500
Subject: Barplot() with log axis scaling and other features
Message-ID: <3D8A5503.2060409@medanalytics.com>

This is a multi-part message in MIME format.
--------------090009040901000308090002
Content-Type: text/plain; charset=us-ascii; format=flowed
Content-Transfer-Encoding: 7bit


To all,

Recently I created a version of barplot() to include some new features 
as follows:

1. Plot confidence intervals for each bar: The user can pass lower 
(ci.l) and upper (ci.u) bounds in the same vector/matrix format as 
"height".  The CI boundary lines will vary in width per bar, if a 
varying "width" argument is specified. CI line width, type and color can 
be defined.  Defaults to 1, "solid" and black, respectively. Works with 
horizontal or vertical plot. Will work with beside = TRUE. Will not work 
if stacked bar plot results at this time. Argument plot.ci = c("TRUE", 
"FALSE") defines whether these are drawn.

2. Color plot region separately from the background area, if desired. 
Argument "prcol" defaults to NULL.

3. Draw "height" axis grid lines *behind* the bars.  Grid line width, 
type and color can be specified. Defaults to 1, "dotted" and black 
respectively. Argument plot.grid = c("TRUE", "FALSE") defines if the 
grid is plotted.

I have made these modifications with the intent to not "break" any 
existing code, so that identical calls to this version should work the 
same as the current implementation.

The current full function argument list is as follows:

barplot2 <- function(height, ...) UseMethod("barplot2")

barplot2.default <-
function(height, width = 1, space = NULL, names.arg = NULL,
      legend.text = NULL, beside = FALSE, horiz = FALSE,
      density = NULL, angle = 45,
      col = heat.colors(NR), prcol = NULL, border = par("fg"),
      main = NULL, sub = NULL, xlab = NULL, ylab = NULL,
      xlim = NULL, ylim = NULL, xpd = TRUE, log = "",
      axes = TRUE, axisnames = TRUE,
      cex.axis = par("cex.axis"), cex.names = par("cex.axis"),
      inside = TRUE, plot = TRUE,
      plot.ci = FALSE, ci.l = NULL, ci.u = NULL,
      ci.color = "black", ci.lty = "solid", ci.lwd = 1,
      plot.grid = FALSE, grid.inc = 5,
      grid.lty = "dotted", grid.lwd = 1, grid.col = "black",
      ...)


In late August, there was a post from Rengie Chan with a query on using 
log axis scaling with barplot(), which is presently precluded as coded 
as per my reply to his post.  I also noted that Paul Murrell has a note 
about this on his to-do page at: 
http://www.stat.auckland.ac.nz/~paul/R/graphicstodos.html

I have spent some time over the past couple of weeks or so (thinking 
that this was going to be easier than it turned out to be) working on 
this as time has permitted.

I now have barplot2() working with both x and/or y axis log scaling, for 
single bars, multiple bars ("beside = TRUE") and for stacked bars.

Some of the key issues are of course preventing log(<=0) related errors 
in the axis scaling, which I have done and incorporating the other 
features that I have added above to be compatible with log scaling. 
These include adjusting the par("usr") values as well as the bar 
baseline values when stacked for log scaling and so forth. Also, the 
"hatch" type bar shading does not work with a log scale, so an error 
check is included to catch this. 

I have attached the R code for this version, called barplot2(), for the 
time being.  I make this code available to R-Core if so desired, and to 
the community at large.  If anyone finds any bugs, let me know.

The areas that I am still a bit unsure of (and open to criticism on) are 
as follows:

1. When using log scaling, I have arbitrarily set the lower limit of the 
"height" related axis to 0.9 * min(height), to enable some of the 
smallest bar to actually be plotted. This figure is adjusted to include 
0.9 * min(ci.l) when plotting CI's.  This can be over-ridden by setting 
either ylim or xlim explicitly of course.  If anyone feels that this 
should be different, let me know.

2. When plotting grid lines, I have resorted to using pretty() to define 
the axis tick marks, labels and grid lines by default.  This took some 
time, after I noted posts to R-Help on the issues with par("xaxp") and 
par("yaxp") when log scaling is used. I also noted Ross Ihaka's 
sci.axis() function. I wrestled with trying to be consistent in the 
behavior of the grid lines for both linear and log scaling and differing 
approaches.

However, given that both barplot() and more significantly the axis() C 
code in plot.c forces "lty = 0" as presently coded, I wanted to give the 
user the ability to visually "de-emphasize" the gridlines with 
alternative line types, widths and colors. Thus I am using abline() with 
intervals set by pretty(), with the user able to specify how many 
intervals using "grid.inc", with a default of 5 as in pretty(). If 
anyone has any better thoughts on how to approach this, I am open.

I was trying to figure out a way to call the C code in plot.c that 
generates the default axis intervals (CreateAtVector), but would get 
errors indicating that the function is not in the load table.  This 
would seem to be a cleaner approach at first glance, since it would 
result in consistent default axis interval behavior when not plotting 
grid lines.  I am open to pointers or other thoughts on this.

Finally, there are two .NotYetUsed arguments in barplot().

First is "border", which defaults to par("fg").  I presume that this is 
simply meant to be the "border" argument to rect()?  If so, I can make 
that change easily.

Second is the "inside" argument.  If I read the help file correctly, 
this will draw a line between adjacent bars.  However, I am unsure if 
this is intended to be a "grouping" line that runs the full height or 
width of the plotting region such that it divides a group of bars (ie. 
beside = TRUE) or if it is simply a heavier line between each bar.  If 
someone can clarify this, I can work on this as well.

I appreciate any feedback from the group and hope that this work is of 
value to users of barplot().

Best regards,

Marc Schwartz



--------------090009040901000308090002
Content-Type: text/plain;
 name="barplot2.r"
Content-Transfer-Encoding: 7bit
Content-Disposition: inline;
 filename="barplot2.r"

barplot2 <- function(height, ...) UseMethod("barplot2")

barplot2.default <-
function(height, width = 1, space = NULL, names.arg = NULL,
       legend.text = NULL, beside = FALSE, horiz = FALSE,
       density = NULL, angle = 45,
       col = heat.colors(NR), prcol = NULL, border = par("fg"),
       main = NULL, sub = NULL, xlab = NULL, ylab = NULL,
       xlim = NULL, ylim = NULL, xpd = TRUE, log = "",
       axes = TRUE, axisnames = TRUE,
       cex.axis = par("cex.axis"), cex.names = par("cex.axis"),
       inside = TRUE, plot = TRUE,
       plot.ci = FALSE, ci.l = NULL, ci.u = NULL,
       ci.color = "black", ci.lty = "solid", ci.lwd = 1,
       plot.grid = FALSE, grid.inc = 5,
       grid.lty = "dotted", grid.lwd = 1, grid.col = "black",
       ...)
{
    if (!missing(inside)) .NotYetUsed("inside", error = FALSE)
    if (!missing(border)) .NotYetUsed("border", error = FALSE)

    if (missing(space))
      space <- if (is.matrix(height) && beside) c(0, 1) else 0.2

    space <- space * mean(width)

    if (plot && axisnames && missing(names.arg))
      names.arg <- if(is.matrix(height)) colnames(height) else names(height)

    if (is.vector(height))
    {
      height <- cbind(height)
      beside <- TRUE
    }
    else if (is.array(height) && (length(dim(height)) == 1))
    {
      height <- rbind(height)
      beside <- TRUE
    }
    else if (!is.matrix(height))
      stop("`height' must be a vector or a matrix")

    if(is.logical(legend.text))
    {
      if(legend.text && is.matrix(height))
        legend.text <- rownames(height)
      else
        legend.text <- NULL
    }

    # Check for log scales
    logx <- FALSE
    logy <- FALSE

    if (log != "")
    {
      if (any(grep("x", log)))
        logx <- TRUE

      if (any(grep("y", log)))
        logy <- TRUE
    }

    # Cannot "hatch" with rect() when log scales used
    if ((logx || logy) && !is.null(density))
      stop("Cannot use shading lines in bars when log scale is used")

    NR <- nrow(height)
    NC <- ncol(height)

    if (beside)
    {
      if (length(space) == 2)
        space <- rep(c(space[2], rep(space[1], NR - 1)), NC)

      width <- rep(width, length = NR * NC)
    }
    else
      width <- rep(width, length = NC)

    delta <- width / 2
    w.r <- cumsum(space + width)
    w.m <- w.r - delta
    w.l <- w.m - delta

    #if graphic will be stacked bars, do not plot ci
    if (!beside && (NR > 1) && plot.ci)
      plot.ci = FALSE

    # error check ci arguments
    if (plot && plot.ci)
    {
      if ((missing(ci.l)) || (missing(ci.u)))
        stop("confidence interval values are missing")

      if (is.vector(ci.l))
        ci.l <- cbind(ci.l)
      else if (is.array(ci.l) && (length(dim(ci.l)) == 1))
        ci.l <- rbind(ci.l)
      else if (!is.matrix(ci.l))
        stop("`ci.l' must be a vector or a matrix")

      if (is.vector(ci.u))
        ci.u <- cbind(ci.u)
      else if (is.array(ci.u) && (length(dim(ci.u)) == 1))
        ci.u <- rbind(ci.u)
      else if (!is.matrix(ci.u))
        stop("`ci.u' must be a vector or a matrix")

      if (dim(height) != dim(ci.u))
        stop("'height' and 'ci.u' must have the same dimensions.")

      if (dim(height) != dim(ci.l))
        stop("'height' and 'ci.l' must have the same dimensions.")
    }

    if (beside)
      w.m <- matrix(w.m, nc = NC)

    # check height/ci.l if using log scale to prevent log(<=0) error
    # adjust appropriate ranges and bar base values
    if ((logx && horiz) || (logy && !horiz))
    {
      if (min(height) <= 0)
        stop("log scale error: at least one 'height' value <= 0")

      if (plot.ci && (min(ci.l) <= 0))
        stop("log scale error: at least one lower c.i. value <= 0")

      if (logx && !is.null(xlim) && (xlim[1] <= 0))
        stop("log scale error: 'xlim[1]' <= 0")

      if (logy && !is.null(ylim) && (ylim[1] <= 0))
        stop("'log scale error: 'ylim[1]' <= 0")

      # arbitrary adjustment to display some of bar for min(height) or min(ci.l)
      if (plot.ci)
        rectbase <- rangeadj <- (0.9 * min(c(height, ci.l)))
      else
        rectbase <- rangeadj <- (0.9 * min(height))

      # if axis limit is set to < above, adjust bar base value
      # to draw a full bar
      if (logy && !is.null(ylim))
        rectbase <- ylim[1]
      else if (logx && !is.null(xlim))
        rectbase <- xlim[1]

      # if stacked bar, set up base/cumsum levels, adjusting for log scale
      if (!beside)
        height <- rbind(rectbase, apply(height, 2, cumsum))

      # if plot.ci, be sure that appropriate axis limits are set to include range(ci)
      lim <-
        if (plot.ci)
          c(height, ci.l, ci.u)
        else
          height
    }
    else
    {
      # Use original bar base value
      rectbase <- 0

      # if stacked bar, set up base/cumsum levels
      if (!beside)
        height <- rbind(rectbase, apply(height, 2, cumsum))

      # if plot.ci, be sure that appropriate axis limits are set to include range(ci)
      lim <-
        if (plot.ci)
          c(height, ci.l, ci.u)
        else
          height

      # use original range adjustment factor
      rangeadj <- (-0.01 * lim)
    }

    # define xlim and ylim, adjusting for log-scale if needed
    if (horiz)
    {
      if (missing(xlim)) xlim <- range(rangeadj, lim, na.rm=TRUE)
      if (missing(ylim)) ylim <- c(min(w.l), max(w.r))
    }
    else
    {
      if (missing(xlim)) xlim <- c(min(w.l), max(w.r))
      if (missing(ylim)) ylim <- range(rangeadj, lim, na.rm=TRUE)
    }

    if(plot) ##-------- Plotting :
    {
      opar <-
        if (horiz)
          par(xaxs = "i", xpd = xpd)
        else
          par(yaxs = "i", xpd = xpd)

      on.exit(par(opar))

      plot.new()
      plot.window(xlim, ylim, log = log, ...)

      # if prcol specified, set plot region color
      if (!missing(prcol))
      {
        usr <- par("usr")

        # adjust par("usr") values if log scale(s) used
        if (logx)
        {
          usr[1] <- 10 ^ usr[1]
          usr[2] <- 10 ^ usr[2]
        }

        if (logy)
        {
          usr[3] <- 10 ^ usr[3]
          usr[4] <- 10 ^ usr[4]
        }

        rect(usr[1], usr[3], usr[2], usr[4], col = prcol)
      }

      # if plot.grid, draw major y-axis lines if vertical or x axis if horizontal
      # Due to issues with xaxp and yaxp when using log scale, use pretty() to set
      # grid and axis increments for for both linear and log scales when plotting grid lines
      if (plot.grid)
      {
        par(xpd = FALSE)

        if (horiz)
        {
          grid = pretty(xlim, n = grid.inc)
          abline(v = grid, lty = grid.lty, lwd = grid.lwd, col = grid.col)
        }
        else
        {
          grid = pretty(ylim, n = grid.inc)
          abline(h = grid, lty = grid.lty, lwd = grid.lwd, col = grid.col)
        }

         par(xpd = xpd)
      }

      # Beware : angle and density are passed using R scoping rules
      xyrect <- function(x1,y1, x2,y2, horizontal = TRUE, ...)
      {
        if(horizontal)
          rect(x1,y1, x2,y2, angle = angle, density = density, ...)
        else
          rect(y1,x1, y2,x2, angle = angle, density = density, ...)
      }

      if (beside)
        xyrect(rectbase, w.l, c(height), w.r, horizontal=horiz, col = col)
      else
      {
        for (i in 1:NC)
          xyrect(height[1:NR, i], w.l[i], height[-1, i], w.r[i], horizontal=horiz, col = col)
      }

      if (plot.ci)
      {
        # CI plot width = barwidth / 2
        ci.width = width / 4

        if (horiz)
        {
          segments(ci.l, w.m, ci.u, w.m, col = ci.color, lty = ci.lty, lwd = ci.lwd)
          segments(ci.l, w.m - ci.width, ci.l, w.m + ci.width, col = ci.color, lty = ci.lty, lwd = ci.lwd)
          segments(ci.u, w.m - ci.width, ci.u, w.m + ci.width, col = ci.color, lty = ci.lty, lwd = ci.lwd)
        }
        else
        {
          segments(w.m, ci.l, w.m, ci.u, col = ci.color, lty = ci.lty, lwd = ci.lwd)
          segments(w.m - ci.width, ci.l, w.m + ci.width, ci.l, col = ci.color, lty = ci.lty, lwd = ci.lwd)
          segments(w.m - ci.width, ci.u, w.m + ci.width, ci.u, col = ci.color, lty = ci.lty, lwd = ci.lwd)
        }
      }

      if (axisnames && !is.null(names.arg)) # specified or from {col}names
      {
        at.l <-
        if (length(names.arg) != length(w.m))
        {
          if (length(names.arg) == NC) # i.e. beside (!)
            colMeans(w.m)
          else
            stop("incorrect number of names")
        }
        else w.m

        axis(if(horiz) 2 else 1, at = at.l, labels = names.arg, lty = 0, cex.axis = cex.names, ...)
      }

      if(!is.null(legend.text))
      {
        legend.col <- rep(col, length = length(legend.text))

        if((horiz & beside) || (!horiz & !beside))
        {
          legend.text <- rev(legend.text)
          legend.col <- rev(legend.col)
          density <- rev(density)
          angle <- rev(angle)
        }

	    xy <- par("usr")
	    legend(xy[2] - xinch(0.1), xy[4] - yinch(0.1),
             legend = legend.text, angle = angle, density = density,
             fill = legend.col, xjust = 1, yjust = 1)
      }

      title(main = main, sub = sub, xlab = xlab, ylab = ylab, ...)

      # if axis is to be plotted, adjust for grid "at" values
      if (axes)
      {
        if(plot.grid)
          axis(if(horiz) 1 else 2, at = grid, cex.axis = cex.axis, ...)
        else
          axis(if(horiz) 1 else 2, cex.axis = cex.axis, ...)
      }

      invisible(w.m)

    }

    else w.m
}

--------------090009040901000308090002--

-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-
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
_._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._


Barplot() with log axis scaling and other features
Marc Schwartz