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 <dwinsem...@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 <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.
>>
>
> 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 confide...{{dropped:22}}
______________________________________________
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.
