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
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
