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 text

Answer 1

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"
      )
    )
  )
)

Answer 2

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.