OK, I did it , but it required a minor hack to panel.violin, since
in its native state panel.violin only passes a single vector the the
grid plotting functions.
On Mar 25, 2011, at 6:29 AM, JP wrote:
Hi there David,
Many thanks for your time and reply
I created a small test set, and ran your proposed solution... and
this is what I get http://i.imgur.com/vlsSQ.png
This is not what I want - I want separate grp_1 and grp_2 panels
and in each panel a red violin plot and a blue one. So like this --
> http://i.imgur.com/NnsE0.png but with red for condition_a and
blue for condition_b. You would think that something like this is
trivial to achieve... I just spent a whole day on this :(( Maybe I
am just thick
I included the test data I am using:
# some dummy data
p <- rep(c(rep("condition_a", 4), rep("condition_b", 4)), 2)
q <- c(rep("grp_1", 8), rep("grp_2", 8))
r <- rnorm(16)
test_data <- data.frame(p, q, r)
Way down at the end I anded an index to the color argument to gp()
panel.violin.hack <-
function (x, y, box.ratio = 1, box.width = box.ratio/(1 + box.ratio),
horizontal = TRUE, alpha = plot.polygon$alpha, border =
plot.polygon$border,
lty = plot.polygon$lty, lwd = plot.polygon$lwd, col = plot.polygon
$col,
varwidth = FALSE, bw = NULL, adjust = NULL, kernel = NULL,
window = NULL, width = NULL, n = 50, from = NULL, to = NULL,
cut = NULL, na.rm = TRUE, ...)
{
if (all(is.na(x) | is.na(y)))
return()
x <- as.numeric(x)
y <- as.numeric(y)
plot.polygon <- trellis.par.get("plot.polygon")
darg <- list()
darg$bw <- bw
darg$adjust <- adjust
darg$kernel <- kernel
darg$window <- window
darg$width <- width
darg$n <- n
darg$from <- from
darg$to <- to
darg$cut <- cut
darg$na.rm <- na.rm
my.density <- function(x) {
ans <- try(do.call("density", c(list(x = x), darg)),
silent = TRUE)
if (inherits(ans, "try-error"))
list(x = rep(x[1], 3), y = c(0, 1, 0))
else ans
}
numeric.list <- if (horizontal)
split(x, factor(y))
else split(y, factor(x))
levels.fos <- as.numeric(names(numeric.list))
d.list <- lapply(numeric.list, my.density)
dx.list <- lapply(d.list, "[[", "x")
dy.list <- lapply(d.list, "[[", "y")
max.d <- sapply(dy.list, max)
if (varwidth)
max.d[] <- max(max.d)
xscale <- current.panel.limits()$xlim
yscale <- current.panel.limits()$ylim
height <- box.width
if (horizontal) {
for (i in seq_along(levels.fos)) {
if (is.finite(max.d[i])) {
pushViewport(viewport(y = unit(levels.fos[i],
"native"), height = unit(height, "native"),
yscale = c(max.d[i] * c(-1, 1)), xscale = xscale))
grid.polygon(x = c(dx.list[[i]], rev(dx.list[[i]])),
y = c(dy.list[[i]], -rev(dy.list[[i]])),
default.units = "native",
# this is the point at which the index is added
gp = gpar(fill = col[i], col = border, lty = lty,
lwd = lwd, alpha = alpha))
popViewport()
}
}
}
else {
for (i in seq_along(levels.fos)) {
if (is.finite(max.d[i])) {
pushViewport(viewport(x = unit(levels.fos[i],
"native"), width = unit(height, "native"),
xscale = c(max.d[i] * c(-1, 1)), yscale = yscale))
grid.polygon(y = c(dx.list[[i]], rev(dx.list[[i]])),
x = c(dy.list[[i]], -rev(dy.list[[i]])),
default.units = "native",
# this is the point at which the index is added
gp = gpar(fill = col[i], col = border, lty = lty,
lwd = lwd, alpha = alpha))
popViewport()
}
}
}
invisible()
}
# Now set the color vector for plot.polygon
polyset <- trellis.par.get("plot.polygon")
polyset$col <- c("red","blue")
trellis.par.set("plot.polygon", polyset)
bwplot(r ~ p | q,
data=test_data,
panel = function(x,y, subscripts, ..., box.ratio){
panel.violin.hack(x,y, ..., cut = 1, varwidth = FALSE, box.ratio
= box.ratio)
panel.bwplot(x,y, ..., box.ratio = .1) },
par.settings = list(plot.symbol = list(pch = 21, col = "gray"),
box.rectangle = list(col = "black"), # not sure these are
working properly
box.umbrella = list(col = "black"))
)
# Voila!
# your solution
bwplot(r ~ p,
groups = q,
data=test_data,
col = c("red", "blue"),
panel=panel.superpose,
panel.groups = function(..., box.ratio){
panel.violin(..., cut = 1, varwidth = FALSE, box.ratio =
box.ratio)
panel.bwplot(..., box.ratio = .1)
},
par.settings = list(plot.symbol = list(pch = 21, col = "gray"),
box.rectangle = list(col = "black"), # not sure these
are working properly
box.umbrella = list(col =
"black"))
)
# my non working one for completeness
bwplot(r ~ p | q,
data=test_data,
col = c("red", "blue"),
panel = function(..., box.ratio){
panel.violin(..., cut = 1, varwidth = FALSE, box.ratio =
box.ratio)
panel.bwplot(..., box.ratio = .1)
},
par.settings = list(plot.symbol = list(pch = 21, col = "gray"),
box.rectangle = list(col = "black"), # not sure these are
working properly
box.umbrella = list(col = "black"))
)
On 24 March 2011 21:59, David Winsemius <dwinsem...@comcast.net>
wrote:
On Mar 24, 2011, at 1:37 PM, JP wrote:
Using Trellis, am successfully setting up a number of panels (25)
in which I
have two box and violin plots.
I would like to colour - one plot as RED and the other as BLUE (in
each
panel). I can do that with the box plots, but the violin density
areas just
take on one colour.
My basic call is as follows:
I took the suggestion of Sarkar's:
http://finzi.psych.upenn.edu/Rhelp10/2010-April/234191.html
Identified with a search on: " panel.violin color"
.... a bit of trial and error with a re-worked copy of the `singer`
data.frame meant I encountered errors and needed to throw out some
of your pch arguments, and suggest this reworking of your code:
bwplot(rmsd ~ file , groups= code,
data=spread_data.filtered, col = c("red", "blue"),
panel=panel.superpose,
panel.groups = function(..., box.ratio){
panel.violin(..., cut = 1, varwidth = FALSE,
box.ratio = box.ratio)
panel.bwplot(..., box.ratio = .1)
},
par.settings = list(plot.symbol = list(pch = 21, col = "gray"),
box.rectangle = list(col = "black"), # not sure these are
working properly
box.umbrella = list(col = "black"))
)
Obviously it cannot be tested without some data, but I did get
alternating colors to the violin plots. There is an modifyList
functionthat you might want to look up in the archives for changing
par.settings:
http://search.r-project.org/cgi-bin/namazu.cgi?query=par.settings+modifyList&max=100&result=normal&sort=score&idxname=functions&idxname=Rhelp08&idxname=Rhelp10&idxname=Rhelp02
--
David Winsemius, MD
West Hartford, CT
David Winsemius, MD
West Hartford, CT
______________________________________________
R-help@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.
