ggplot + crosshatching

Built with blockbuilder.org and R

In response to this StackOverflow question geom_bar: color gradient and cross hatches (using gridSVG), transparency issue, I did this. I wanted to see if combining svglite, htmltools, d3.js, and textures.js might achieve the desired result.

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

forked from timelyportfolio's block: ggplot and textures.js

forked from anonymous's block: ggplot + crosshatching