R devel - Jun 2008 - bug in barplot.default (graphics) (PR#11585)

There seems to be a minor bug in barplot.default when used with log scale where
one or more values is NA:

dat <- matrix(1:25, 5)
dat[2,3] <- NA
barplot(dat, beside =3D T)   #Plots and appropriate barplot with gaps for
missing data
barplot(dat, beside =3D T, log =3D "y")
#Error in if (min(height + offset) <=3D 0) stop("log scale error: at
least one 'height + offset' value <=3D 0") :
#  missing value where TRUE/FALSE needed

This is easily corrected by adding na.rm =3D TRUE to this logical test and to
the calculation of rectbase where min() is used, as per code below

Best wishes,

Colin

sessionInfo()
R version 2.7.0 (2008-04-22)=20
i386-pc-mingw32=20

locale:
LC_COLLATE=3DEnglish_United Kingdom.1252;LC_CTYPE=3DEnglish_United
Kingdom.1252;LC_MONETARY=3DEnglish_United
Kingdom.1252;LC_NUMERIC=3DC;LC_TIME=3DEnglish_United Kingdom.1252

attached base packages:
[1] stats     graphics  grDevices datasets  tcltk     utils     methods=20=20
[8] base=20=20=20=20=20

other attached packages:
[1] debug_1.1.0    mvbutils_1.1.1 svSocket_0.9-5 svIO_0.9-5    
R2HTML_1.58=20=20=20
[6] svMisc_0.9-5   svIDE_0.9-5=20=20=20

loaded via a namespace (and not attached):
[1] tools_2.7.0


barplot.default <- function (height, width =3D 1, space =3D NULL, names.arg
=3D NULL,
    legend.text =3D NULL, beside =3D FALSE, horiz =3D FALSE, density =3D NULL,
    angle =3D 45, col =3D NULL, border =3D par("fg"), main =3D NULL,
    sub =3D NULL, xlab =3D NULL, ylab =3D NULL, xlim =3D NULL, ylim =3D NULL,
    xpd =3D TRUE, log =3D "", axes =3D TRUE, axisnames =3D TRUE,
cex.axis =3D par("cex.axis"),
    cex.names =3D par("cex.axis"), inside =3D TRUE, plot =3D TRUE,
    axis.lty =3D 0, offset =3D 0, add =3D FALSE, ...)
{
    if (!missing(inside))
        .NotYetUsed("inside", error =3D FALSE)
    if (is.null(space))
        space <- if (is.matrix(height) && beside)
            c(0, 1)
        else 0.2
    space <- space * mean(width)
    if (plot && axisnames && is.null(names.arg))
        names.arg <- if (is.matrix(height))
            colnames(height)
        else names(height)
    if (is.vector(height) || (is.array(height) && (length(dim(height))
=3D=3D
        1))) {
        height <- cbind(height)
        beside <- TRUE
        if (is.null(col))
            col <- "grey"
    }
    else if (is.matrix(height)) {
        if (is.null(col))
            col <- grey.colors(nrow(height))
    }
    else stop("'height' must be a vector or a matrix")
    if (is.logical(legend.text))
        legend.text <- if (legend.text && is.matrix(height))
            rownames(height)
    stopifnot(is.character(log))
    logx <- logy <- FALSE
    if (log !=3D "") {
        logx <- length(grep("x", log)) > 0L
        logy <- length(grep("y", log)) > 0L
    }
    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) =3D=3D 2)
            space <- rep.int(c(space[2], rep.int(space[1], NR -
                1)), NC)
        width <- rep(width, length.out =3D NR)
    }
    else {
        width <- rep(width, length.out =3D NC)
    }
    offset <- rep(as.vector(offset), length.out =3D length(width))
    delta <- width/2
    w.r <- cumsum(space + width)
    w.m <- w.r - delta
    w.l <- w.m - delta
    log.dat <- (logx && horiz) || (logy && !horiz)
    if (log.dat) {
        if (min(height + offset, na.rm =3D T) <=3D 0)
            stop("log scale error: at least one 'height + offset'
value <=3D 0")
        if (logx && !is.null(xlim) && min(xlim) <=3D 0)
            stop("log scale error: 'xlim' <=3D 0")
        if (logy && !is.null(ylim) && min(ylim) <=3D 0)
            stop("log scale error: 'ylim' <=3D 0")
        rectbase <- if (logy && !horiz && !is.null(ylim))
            ylim[1]
        else if (logx && horiz && !is.null(xlim))
            xlim[1]
        else 0.9 * min(height, na.rm =3D T)
    }
    else rectbase <- 0
    if (!beside)
        height <- rbind(rectbase, apply(height, 2, cumsum))
    rAdj <- offset + (if (log.dat)
        0.9 * height
    else -0.01 * height)
    delta <- width/2
    w.r <- cumsum(space + width)
    w.m <- w.r - delta
    w.l <- w.m - delta
    if (horiz) {
        if (is.null(xlim))
            xlim <- range(rAdj, height + offset, na.rm =3D TRUE)
        if (is.null(ylim))
            ylim <- c(min(w.l), max(w.r))
    }
    else {
        if (is.null(xlim))
            xlim <- c(min(w.l), max(w.r))
        if (is.null(ylim))
            ylim <- range(rAdj, height + offset, na.rm =3D TRUE)
    }
    if (beside)
        w.m <- matrix(w.m, ncol =3D NC)
    if (plot) {
        opar <- if (horiz)
            par(xaxs =3D "i", xpd =3D xpd)
        else par(yaxs =3D "i", xpd =3D xpd)
        on.exit(par(opar))
        if (!add) {
            plot.new()
            plot.window(xlim, ylim, log =3D log, ...)
        }
        xyrect <- function(x1, y1, x2, y2, horizontal =3D TRUE,
            ...) {
            if (horizontal)
                rect(x1, y1, x2, y2, ...)
            else rect(y1, x1, y2, x2, ...)
        }
        if (beside)
            xyrect(rectbase + offset, w.l, c(height) + offset,
                w.r, horizontal =3D horiz, angle =3D angle, density =3D density,
                col =3D col, border =3D border)
        else {
            for (i in 1:NC) {
                xyrect(height[1:NR, i] + offset[i], w.l[i], height[-1,
                  i] + offset[i], w.r[i], horizontal =3D horiz,
                  angle =3D angle, density =3D density, col =3D col,
                  border =3D border)
            }
        }
        if (axisnames && !is.null(names.arg)) {
            at.l <- if (length(names.arg) !=3D length(w.m)) {
                if (length(names.arg) =3D=3D NC)
                  colMeans(w.m)
                else stop("incorrect number of names")
            }
            else w.m
            axis(if (horiz)
                2
            else 1, at =3D at.l, labels =3D names.arg, lty =3D axis.lty,
                cex.axis =3D cex.names, ...)
        }
        if (!is.null(legend.text)) {
            legend.col <- rep(col, length.out =3D 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 =3D
legend.text,
                angle =3D angle, density =3D density, fill =3D legend.col,
                xjust =3D 1, yjust =3D 1)
        }
        title(main =3D main, sub =3D sub, xlab =3D xlab, ylab =3D ylab,
            ...)
        if (axes)
            axis(if (horiz)
                1
            else 2, cex.axis =3D cex.axis, ...)
        invisible(w.m)
    }
    else w.m
}


Dr. Colin Beale
Spatial Ecologist
The Macaulay Institute
Craigiebuckler
Aberdeen
AB15 8QH
UK

Tel: 01224 498245 ext. 2427
Fax: 01224 311556
Email: c.beale at macaulay.ac.uk=20



--=20
Please note that the views expressed in this e-mail are those of the
sender and do not necessarily represent the views of the Macaulay
Institute. This email and any attachments are confidential and are
intended solely for the use of the recipient(s) to whom they are
addressed. If you are not the intended recipient, you should not read,
copy, disclose or rely on any information contained in this e-mail, and
we would ask you to contact the sender immediately and delete the email
from your system. Thank you.
Macaulay Institute and Associated Companies, Macaulay Drive,
Craigiebuckler, Aberdeen, AB15 8QH.