[R] Colour makes my life; but not my bwplot (panel.violin)

[David Winsemius]

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