geom_bar: color gradient and cross hatches (using gridSVG), transparency issue

Question

Using the awesome ggplot package, I want a barplot where the fill aesthetic is mapped to a continous variable, actually qvalues and on top of it a texture, actually stripes and cross hatches.

The colour gradient is important because it represents significance while the texture would show the category, "A", "B", and their overlap. So diagonals in one way, the opposite way and cross hatches respectively. I know a Venn diagram could do the job, but we 35 samples and the comparison will be easier to see I think.

The fill is trivial, however, the texture one is tricky. On SO, thanks to @baptise (see here and here) I managed to get this output with dummy data:

The issue is the transparency of the crosses's background. If it is possible get the alpha working on the background in the grid.patternFill() function that would be great. Unfortunately, in my hands it doesn't work.

Any help will be much appreciated.

dummy data can loaded here:

dfso <- structure(list(Sample = c("S1", "S2", "S1", "S2", "S1", "S2"), 
  qvalue = c(14.704287341, 8.1682824035, 13.5471896224, 6.71158432425, 
  12.3900919038, 5.254886245), type = structure(c(1L, 1L, 2L, 
  2L, 3L, 3L), .Label = c("A", "overlap", "B"), class = "factor"), 
  value = c(897L, 1082L, 503L, 219L, 388L, 165L)), class = c("tbl_df", 
  "tbl", "data.frame"), row.names = c(NA, -6L), .Names = c("Sample", 
  "qvalue", "type", "value"))

Code is here:

library("ggplot2")
library("gridSVG")
library("gridExtra")
library("dplyr")
library("RColorBrewer")

cols <- brewer.pal(7,"YlOrRd")
pso <- ggplot(dfso)+
  geom_bar(aes(x = Sample, y = value, fill = qvalue, linetype = type), width = .8, colour = "black", stat = "identity", position = "stack", alpha = 1)+
  theme_classic(18)+
  theme( panel.grid.major = element_line(colour = "grey80"),
     panel.grid.major.x = element_blank(),
     panel.grid.minor = element_blank(),
     legend.key = element_blank(),
     axis.text.x = element_text(angle = 90, vjust = 0.5))+
  guides(linetype = FALSE) +
  ylab("Count")+
  scale_fill_gradientn("-log10(qvalue)", colours = cols, limits = c(0, 20))+
  scale_linetype_manual(values = c("dotted", "solid", "dotted"))+
  scale_y_continuous(expand = c(0, 0), limits = c(0, 2000))

# gridSVG
pat1 <- pattern(linesGrob(gp = gpar(col="black", lwd = 1)),
                width = unit(5, "mm"), height = unit(5, "mm"),
                dev.width = 1, dev.height = 1)
pat2 <- pattern(linesGrob(x = unit(0:1, "npc"), y = unit(1:0, "npc"),
                          gp = gpar(col="black", lwd = 1)),
                width = unit(5, "mm"), height = unit(5, "mm"),
                dev.width = 1, dev.height = 1)
crossGrob <- gTree(children = gList(linesGrob(gp = gpar(col="black", lwd = 1)), linesGrob(x = unit(0:1, "npc"), y = unit(1:0, "npc"), gp = gpar(col="black", lwd = 1))))
registerPatternFill("hash1", pat1)
registerPatternFill("hash2", pat2)
registerPatternFill("cross", grob = crossGrob, dev.width = 1, dev.height = 1, width = unit(5, "mm"), height = unit(5, "mm"))
gridsvg("crossbars.svg", width = 10)
print(pso)
grid.force()
grid.patternFill("geom_rect.rect", alpha = 0.2, grep = TRUE, group = FALSE,
                 label = rep(c("hash1", "cross", "hash2"), 1))
dev.off()

In grid.patternFill the alpha parameter is suppose to give the transparency, as far as I understood it. But, it has no effect, and the colour is lost. I filled the patterns only for the first bar so you see the contrast.

Edit: the alpha is working fine, but it acts on the pattern itself, i.e the lines. That explains why the lines appear so pale. The issue is more that the background is assumed white and without transparency.

The linetype mapping was a attempt to highlight the overlap part, but it is not nice. If the transparency works for gridSVG I will discard this part and keep a solid line all the way.

Many thanks in advance,

Aurelien

If of any use, output of sessionInfo():

R version 3.2.1 (2015-06-18)
Platform: x86_64-apple-darwin14.3.0 (64-bit)
Running under: OS X 10.10.4 (Yosemite)
locale:
[1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
attached base packages:
[1] grid      stats     graphics  grDevices utils     datasets  methods   base     
other attached packages:
[1] gridExtra_0.9.1    RColorBrewer_1.1-2 dplyr_0.4.1        gridSVG_1.4-3      ggplot2_1.0.1     
loaded via a namespace (and not attached):
 [1] Rcpp_0.11.6      XML_3.98-1.3     assertthat_0.1   digest_0.6.8     MASS_7.3-42      plyr_1.8.3       DBI_0.3.1       
 [8] gtable_0.1.2     magrittr_1.5     scales_0.2.5     stringi_0.5-5    reshape2_1.4.1   labeling_0.3     proto_0.3-10    
[15] RJSONIO_1.3-0    tools_3.2.1      stringr_1.0.0    munsell_0.4.2    parallel_3.2.1   colorspace_1.2-6

Answer 1

I am answering my own question, as there is a way to fill a specific color to the pattern thank to this link. On the first bar, for category "A", it could look like this:

replacing the pat1 pattern by the following code:

pat1 <- pattern(gTree(children=gList(
                      rectGrob(gp=gpar(col=NA, fill=cols[4])),
                      linesGrob(gp=gpar(col="black", lwd = 5)))),
                      width = unit(5, "mm"), height = unit(5, "mm"),
                      dev.width = 1, dev.height = 1)

For geom_bar with few colours, it would work but for my issue where the fill colour is mapped to a heatmap scale, it is going to be tedious.

Answer 2

This is not really an answer, but I will provide this following code as reference for someone who might like to see how we might accomplish this task. A live version is here. I almost think it would be easier to do entirely with d3 or library built on d3

library("ggplot2")
library("gridSVG")
library("gridExtra")
library("dplyr")
library("RColorBrewer")

dfso <- structure(list(Sample = c("S1", "S2", "S1", "S2", "S1", "S2"), 
                       qvalue = c(14.704287341, 8.1682824035, 13.5471896224, 6.71158432425, 
                                  12.3900919038, 5.254886245), type = structure(c(1L, 1L, 2L, 
                                                                                  2L, 3L, 3L), .Label = c("A", "overlap", "B"), class = "factor"), 
                       value = c(897L, 1082L, 503L, 219L, 388L, 165L)), class = c("tbl_df", 
                                                                                  "tbl", "data.frame"), row.names = c(NA, -6L), .Names = c("Sample", 
                                                                                                                                           "qvalue", "type", "value"))

cols <- brewer.pal(7,"YlOrRd")
pso <- ggplot(dfso)+
  geom_bar(aes(x = Sample, y = value, fill = qvalue), width = .8, colour = "black", stat = "identity", position = "stack", alpha = 1)+
  ylim(c(0,2000)) + 
  theme_classic(18)+
  theme( panel.grid.major = element_line(colour = "grey80"),
         panel.grid.major.x = element_blank(),
         panel.grid.minor = element_blank(),
         legend.key = element_blank(),
         axis.text.x = element_text(angle = 90, vjust = 0.5))+
  ylab("Count")+
  scale_fill_gradientn("-log10(qvalue)", colours = cols, limits = c(0, 20))

# use svglite and htmltools
library(svglite)
library(htmltools)

# get the svg as tag
pso_svg <- htmlSVG(print(pso),height=10,width = 14)

browsable(
  attachDependencies(
    tagList(
      pso_svg,
      tags$script(
        sprintf(
"
  var data = %s

  var svg = d3.select('svg');

  svg.select('style').remove();

  var bars = svg.selectAll('rect:not(:last-of-type):not(:first-of-type)')
     .data(d3.merge(d3.values(d3.nest().key(function(d){return d.Sample}).map(data))))

  bars.style('fill',function(d){
    var t = textures
              .lines()
              .background(d3.rgb(d3.select(this).style('fill')).toString());

    if(d.type === 'A') t.orientation('2/8');
    if(d.type === 'overlap') t.orientation('2/8','6/8');
    if(d.type === 'B') t.orientation('6/8');

    svg.call(t);
    return t.url();
  });
"    
          ,
          jsonlite::toJSON(dfso)
        )
      )
    ),
    list(
      htmlDependency(
        name = "d3",
        version = "3.5",
        src = c(href = "http://d3js.org"),
        script = "d3.v3.min.js"
      ),
      htmlDependency(
        name = "textures",
        version = "1.0.3",
        src = c(href = "https://rawgit.com/riccardoscalco/textures/master/"),
        script = "textures.min.js"
      )
    )
  )
)