This example courtesy of Displayr who have generously offered to sponsor a series of independently authored posts about interactive visualization with R and JavaScript. Thank you so much Displayr for this opportunity.

---

Code in R

Below is the R source code for creating this visualization. You might notice that much of this is actually JavaScript. To see the JavaScript, please inspect index.html.

(function() {
  library(htmltools)
  library(d3r)
  library(dplyr)
  
  titan_nest <<- as.data.frame(Titanic) %>%
    select(-Age) %>%
    group_by(Class, Sex, Survived) %>%
    summarise(Freq = sum(Freq)) %>%
    d3_nest(value_cols="Freq", root="Titanic")
})()


scr_part <- function() {
  tags$script(HTML(
    sprintf(
      "
      function initialize(hier) {
      d3.partition().size([height,width])(hier);
      
      var nodes = svg.selectAll('g.node')
      .data(hier.descendants());
      
      nodes = nodes.merge(
      nodes.enter().append('g')
      .attr('class','node')
      );
      
      nodes.attr('transform', function(d) {
      return 'translate(' + d.y0  + ',' + d.x0 + ')'
      });
      
      nodes.append('rect')
      .classed('rect-part', true);
      
      nodes.append('rect')
      .classed('rect-outline', true)
      .attr('width', function(d) { return d.y1 - d.y0; })
      .attr('height', function(d) { return d.x1 - d.x0; })
      .style('fill', 'none')
      .style('stroke', 'none');
      
      nodes.append('text')
      //.style('text-anchor','end')
      .attr('dy','1em')
      .text(function(d) { return d.data.name});
      
      return nodes;
      }
      
      function drawPart(hier, nodes, duration, delay) {
      d3.partition().size([height,width])(hier);
      
      svg.selectAll('.link')
      .transition()
      .duration(100)
      .style('opacity', 0.00001)
      .remove();
      
      nodes.selectAll('rect.rect-part')
      .transition()
      .duration(duration)
      .delay(delay)
      .attr('width', function(d) { return d.y1 - d.y0; })
      .attr('height', function(d) { return d.x1 - d.x0; })
      .attr('x', 0)
      .attr('y', 0)
      .style('fill', function(d) { return color(d.data.name) || 'gray'; })
      .style('stroke', 'white');
      
      nodes.selectAll('rect.rect-outline')
      .transition()
      .duration(duration)
      .delay(delay)
      .style('stroke', 'white')
      .style('fill', 'none')
      .style('stroke-dasharray', null);
      }
      
      var tm = %s;
      
      var tm_h = d3.hierarchy(tm)
      .sum(function(d){
      return d.Freq || 0;
      });
      
      var width = 400;
      var height = 400;
      
      var svg = d3.select('body').append('svg')
      .style('width',width + 20 + 20)
      .style('height',height + 20 + 20)
      .append('g')
      .attr('transform','translate(20,20)');
      
      var color = d3.scaleOrdinal(d3.schemeCategory10);
      
      var nodes = initialize(tm_h);
      
      drawPart(tm_h, nodes, 0, 0);
      ",
      titan_nest
    )
  ))
  }


### create partition ####
browsable(
  tagList(
    d3_dep_v4(offline=FALSE),
    scr_part()
  )
)