[Rd] [R] Proposal: barchart() with bars beginning at zero.

[Wolfram Fischer - Z/I/M]

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/