# [R] Lattice densityplot with semitransparent filled regions

ilai keren at math.montana.edu
Wed Apr 11 20:52:35 CEST 2012

``` densityplot(~y|B, groups=A, data=dt,
plot.points="rug",
col=trellis.par.get("superpose.polygon")\$col, alpha=.5,
panel=panel.superpose,
panel.groups=my.panel.densityplot)

Worked for me (i.e. semi-transparent superpose.polygon colors). Is
that not what you are seeing ?

On Wed, Apr 11, 2012 at 12:05 PM, Walmes Zeviani
<walmeszeviani at gmail.com> wrote:
> Hello,
>
> I'm doing some graphics for a paper and a need customize such with filled
> region above the density curve. My attempts I get something very near what
> I need, but I don't solve the problem of use semitransparent filled. Below
> a minimal reproducible code. Someone has any idea?
>
> require(lattice)
>
> # toy data...
> dt <- expand.grid(A=1:2, B=1:3, y=1:50)
> dt\$y <- rnorm(nrow(dt), dt\$B, dt\$A)
>
> # regular plot...
> densityplot(~y|B, groups=A, data=dt, plot.points="rug")
>
> # the actual panel...
> panel.densityplot
>
> # so, I edit this...
> my.panel.densityplot <-
> function (x, darg = list(n = 30), plot.points = "jitter", ref = FALSE,
>    groups = NULL, weights = NULL, jitter.amount = 0.01 *
> diff(current.panel.limits()\$ylim),
>    type = "p", ..., identifier = "density")
> {
>    if (ref) {
>        reference.line <- trellis.par.get("reference.line")
>        panel.abline(h = 0, col = reference.line\$col, lty =
> reference.line\$lty,
>            lwd = reference.line\$lwd, identifier = paste(identifier,
>                "abline"))
>    }
>    if (!is.null(groups)) {
>        panel.superpose(x, darg = darg, plot.points = plot.points,
>            ref = FALSE, groups = groups, weights = weights,
>            panel.groups = panel.densityplot, jitter.amount =
> jitter.amount, # alterei para my.panel....
>            type = type, ...)
>    }
>    else {
>        switch(as.character(plot.points), `TRUE` = panel.xyplot(x = x,
>            y = rep(0, length(x)), type = type, ..., identifier =
> identifier),
>            rug = panel.rug(x = x, start = 0, end = 0, x.units = c("npc",
>                "native"), type = type, ..., identifier = paste(identifier,
>                "rug")), jitter = panel.xyplot(x = x, y = jitter(rep(0,
>                length(x)), amount = jitter.amount), type = type,
>                ..., identifier = identifier))
>        density.fun <- function(x, weights, subscripts = TRUE,
>            darg, ...) {
>            do.call("density", c(list(x = x, weights =
> weights[subscripts]),
>                darg))
>        }
>        if (sum(!is.na(x)) > 1) {
>            h <- density.fun(x = x, weights = weights, ..., darg = darg)
>            lim <- current.panel.limits()\$xlim
>            id <- h\$x > min(lim) & h\$x < max(lim)
>            panel.lines(x = h\$x[id], y = h\$y[id], ..., identifier =
> identifier)
> ## line above was added
>            panel.polygon(x=h\$x[id], y = h\$y[id], ..., identifier =
> identifier, alpha=0.2)
>        }
>    }
> }
>
> # my customized plot, I want semitransparent colors
> # and use the colors of trellis.par.set("superpose.polygon") to fill
> densityplot(~y|B, groups=A, data=dt,
>            plot.points="rug", col=2:3,
>            panel=panel.superpose,
>            panel.groups=my.panel.densityplot)
>
> Thanks!
> Walmes.
>
> ==========================================================================
> Walmes Marques Zeviani
> LEG (Laboratório de Estatística e Geoinformação, 25.450418 S, 49.231759 W)
> Departamento de Estatística - Universidade Federal do Paraná
> fone: (+55) 41 3361 3573
> VoIP: (3361 3600) 1053 1173
> e-mail: walmes at ufpr.br
> homepage: http://www.leg.ufpr.br/~walmes
> linux user number: 531218
> ==========================================================================
>
>        [[alternative HTML version deleted]]
>
>
> ______________________________________________
> R-help at r-project.org mailing list
> https://stat.ethz.ch/mailman/listinfo/r-help