[R] stacked histograms

Deepayan Sarkar deepayan.sarkar at gmail.com
Fri Apr 13 23:03:10 CEST 2007

```On 4/13/07, Deepayan Sarkar <deepayan.sarkar at gmail.com> wrote:

[...]

> Write your own panel function, it shouldn't be too hard.

And since this comes up every once in a while, here's a possible implementation:

library(lattice)

hist.constructor <-
function(x, breaks,
include.lowest = TRUE,
right = TRUE, ...)
{
if (is.numeric(breaks) && length(breaks) > 1)
hist(as.numeric(x), breaks = breaks, plot = FALSE,
include.lowest = include.lowest,
right = right)
else
hist(as.numeric(x), breaks = breaks, plot = FALSE)
}

panel.grouped.histogram <-
function(x,
groups = stop("groups must be specified"), subscripts,
breaks, equal.widths = TRUE, type = "density",
nint = round(log2(length(x)) + 1),
alpha = plot.polygon\$alpha,
col = plot.polygon\$col,
border = plot.polygon\$border,
lty = plot.polygon\$lty,
lwd = plot.polygon\$lwd, ...)
{
plot.polygon <- trellis.par.get("superpose.polygon")
if (length(x) < 1) return()
if (is.null(breaks)) {
breaks <- if (is.factor(x))
seq_len(1 + nlevels(x)) - 0.5
else if (equal.widths)
do.breaks(range(x, finite = TRUE), nint)
else quantile(x, 0:nint/nint, na.rm = TRUE)
}
h <- hist.constructor(x, breaks = breaks, ...)
y <-
switch(type,
count = h\$counts,
percent = 100 * h\$counts/length(x),
density = h\$intensities)
breaks <- h\$breaks
stopifnot((nb <- length(breaks)) > 1)

## support for groups
vals <-
if (is.factor(groups)) levels(groups)
else sort(unique(groups))
nvals <- length(vals)
subg <- groups[subscripts]
ok <- !is.na(subg)

alpha <- rep(alpha, nvals)
col <- rep(col, nvals)
border <- rep(border, nvals)
lty <- rep(lty, nvals)
lwd <- rep(lwd, nvals)

props.group <-
sapply(vals,
function(v) {
id <- subg == v
hv <- hist.constructor(x[id], breaks = breaks, ...)
if (type == "density") hv\$intensities
else hv\$counts
})
props.group <- prop.table(props.group, margin = 1)
y.group <-
sapply(seq_along(y),
function(i) y[i] * c(0, cumsum(props.group[i, ])))
for (i in seq_len(nvals))
{
panel.rect(x = breaks[-nb],
y = y.group[i, ],
height = y.group[i + 1, ] - y.group[i, ],
width = diff(breaks),
col = col[i], alpha = alpha[i],
border = border[i], lty = lty[i],
lwd = lwd[i],
just = c("left", "bottom"))
}
}

histogram(~height, singer)

histogram(~height, singer, groups = voice.part,
panel = panel.grouped.histogram,
auto.key =
list(space = "right", reverse.rows = TRUE,
points = FALSE, rectangles = TRUE))

-Deepayan

```