[R] hacking lattice::panel.violin was Re: Colour makes my life; but not my bwplot (panel.violin)
David Winsemius
dwinsemius at comcast.net
Fri Mar 25 19:43:35 CET 2011
I don't really know. I'm not at Deepayan's level by any stretch of
the imagination. When I was reading the help pages and reading archive
postings regarding bwplot/violin it seemed that Deepayan thought the
groups arguments for those functions were not as he would have
desired. I noted early that the code for coloring in panel.violin
didn't have an index. I thought I might get a working solution
running when I was in his Lattice book in the themes section, but
eventually returned again to the code and resorted to the hack of
adding indexing to the gp(col) argument. I'm not skilled enough to
know whether it will break other code or introduce unwanted side-
effects.
--
David.
On Mar 25, 2011, at 1:55 PM, JP wrote:
> Are you going to include this in the main source? Surely this is
> something people must need/ask for...
>
>
> On 25 March 2011 16:14, David Winsemius <dwinsemius at comcast.net>
> wrote:
> 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
>
>
>
>
> --
>
> Jean-Paul Ebejer
> Early Stage Researcher
>
> InhibOx Ltd
> Pembroke House
> 36-37 Pembroke Street
> Oxford
> OX1 1BP
> UK
>
> (+44 / 0) 1865 262 034
>
>
>
> This email and any files transmitted with it are confi...{{dropped:27}}
More information about the R-help
mailing list