[R] Colour makes my life; but not my bwplot (panel.violin)
David Winsemius
dwinsemius at comcast.net
Fri Mar 25 17:14:13 CET 2011
Using that hack you can also skip the trellis.par.set step with an
internal assignment of color:
bwplot(r ~ p | q, col=c("yellow", "green"),
data=test_data,
panel = function(x,y, subscripts, col=col, ..., box.ratio){
panel.violin.hack(x,y, col=col, ..., cut = 1,
varwidth = FALSE, box.ratio = box.ratio)
panel.bwplot(x,y, ..., box.ratio = .1) },
# Still not sure you are getting these used properly..
par.settings = list(plot.symbol = list(pch = 21, col = "gray"),
box.rectangle = list(col = "black"),
box.umbrella = list(col = "black"))
)
--
David.
On Mar 25, 2011, at 12:06 PM, David Winsemius wrote:
> 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 <dwinsemius at 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 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.
David Winsemius, MD
West Hartford, CT
More information about the R-help
mailing list