Walmes Zeviani
2012-Apr-11 18:05 UTC
[R] Lattice densityplot with semitransparent filled regions
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@ufpr.br
twitter: @walmeszeviani
homepage: http://www.leg.ufpr.br/~walmes
linux user number: 531218
=========================================================================
[[alternative HTML version deleted]]
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
> twitter: @walmeszeviani
> 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
> PLEASE do read the posting guide
http://www.R-project.org/posting-guide.html
> and provide commented, minimal, self-contained, reproducible code.
>