[Rd] [R] Proposal: barchart() with bars beginning at zero.
Wolfram Fischer - Z/I/M
wolfram@fischer-zim.ch
Mon Dec 16 15:25:08 2002
Hello
I would like to propose to extend the functionality
of barchart() with a argument "orig.zero" which results
in bars beginning at zero.
I have added a possible code for this extension.
Wolfram Fischer
#^wf 16.12.02 based on R 1.6.1
panel.barchart <-
function (x, y, box.ratio = 1, horizontal = TRUE, col = bar.fill$col,
#--- NEW
orig.zero = F,
#---
...)
{
x <- as.numeric(x)
y <- as.numeric(y)
#--- NEW
xlim <- current.viewport()$xscale
ylim <- current.viewport()$yscale
#---
bar.fill <- trellis.par.get("bar.fill")
if (horizontal) {
#--- ORIG
# xmin <- current.viewport()$xscale[1]
#--- NEW
grid.lines( c(0,0), ylim, default.units = "native", gp = gpar(lty = 2) )
xmin <- ifelse( orig.zero, 0, xlim[1] )
#---
height <- box.ratio/(1 + box.ratio)
for (i in seq(along = x)) {
grid.rect(gp = gpar(fill = col), y = y[i],
#--- ORIG
# x = unit(0, "npc"),
#--- NEW
x = ifelse( orig.zero, 0, unit(0, "npc") ),
#---
height = height, width = x[i] - xmin,
just = c("left", "centre"), default.units = "native")
}
}
else {
#--- ORIG
# ymin <- current.viewport()$yscale[1]
#--- NEW
grid.lines( xlim, c(0,0), default.units = "native", gp = gpar(lty = 2) )
ymin <- ifelse( orig.zero, 0, ylim[1] )
#---
width <- box.ratio/(1 + box.ratio)
for (i in seq(along = y)) {
grid.rect(gp = gpar(fill = col), x = x[i],
#--- ORIG
# y = unit(0, "npc"),
#--- NEW
y = ifelse( orig.zero, 0, unit(0, "npc") ),
#---
height = y[i] - ymin, width = width,
just = c("centre", "bottom"), default.units = "native")
}
}
}
barchart <-
function (formula, data = parent.frame(), panel = "panel.barchart",
prepanel = NULL, strip = TRUE, box.ratio = 2, groups = NULL,
#--- NEW
orig.zero = F,
#---
horizontal = NULL, ..., subset = TRUE)
{
dots <- list(...)
groups <- eval(substitute(groups), data, parent.frame())
subset <- eval(substitute(subset), data, parent.frame())
if (!is.function(panel))
panel <- eval(panel)
if (!is.function(strip))
strip <- eval(strip)
prepanel <- if (is.function(prepanel))
prepanel
else if (is.character(prepanel))
get(prepanel)
else eval(prepanel)
do.call("bwplot", c(list(formula = formula, data = data,
horizontal = horizontal, groups = groups, subset = subset,
panel = panel, prepanel = prepanel, strip = strip, box.ratio = box.ratio),
#--- NEW
orig.zero = orig.zero,
#---
dots))
}
--
_______________
_______/___/___ Zentrum fuer Informatik und wirtschaftliche Medizin
____Z_/___/____
_____/_I_/_____ Steigstrasse 12, CH-9116 Wolfertswil, Schweiz
____/___/_M____ Tel: +41 71 3900 444, Fax: +41 71 3900 447
___/___/_______ mailto:wolfram@fischer-zim.ch http://www.fischer-zim.ch/