demo of d3 tree in shiny for discussion

Discussion Piece for SearchTree

sankeytreeR is very experimental and a little fragile, but it will give us a good testbed for this discussion. This little bit of code requires dplyr, tibble, treemap, sankeytreeR, shiny, d3r. All are on CRAN except for sankeytreeR.

#devtools::install_github("timelyportfolio/sankeytree")
library(d3r)
library(sankeytreeR)
library(shiny)
library(treemap)

Data

sankeytree’s fragility requires a little prep work to prep the data. We can use treemap::random.hierarchical.data with d3r for the nested JSON and treemap for the summing over nodes/levels to generate the data in proper form for sankeytree. Most of this portion of the code can be ignored for the purposes of discussion.

rhd <- random.hierarchical.data(depth=2)

tm <- treemap(
  rhd,
  vSize="x",
  index=c("index1","index2")
)$tm

rhd_d3 <- d3_nest(
  tm,
  value_cols = colnames(tm)[-c(1:2)],
  json = FALSE
)
rhd_d3$vSize = sum(rhd$x)

rhd_json <- d3_json(rhd_d3)

sankeytree

We can now plot rhd_json as a sankeytree.

st <- sankeytree(rhd_json, name="id", value="vSize")
st$elementId <- "sankeytree"
st

shiny

# add a update handler on sankeytree
ui <- htmlwidgets::onRender(
  st,
  htmlwidgets::JS(
'
function(el,x) {
  this.on("update", function(x){
    console.log(x);
    // here we could have it return as much
    //  information as we would like
    Shiny.onInputChange(
      el.id + "_update",
      {
        nodes:d3.layout.tree().nodes(x.root).map(function(node){
          var flatnode = {};
          Object.keys(node).map(function(key){
            if(["children","_children","parent"].indexOf(key)<0){
              flatnode[key] = node[key];
            }
          });
          return flatnode;
        })
      }
    );
  });
}
'    
  )
)

server <- function(input, output, session) {
  observeEvent(input$sankeytree_update, {
    print(
      dplyr::bind_rows(
        lapply(input$sankeytree_update$nodes,tibble::as_tibble)
      )
    )
  })
}

# turn on trace logging of shiny websocket messages
#options(shiny.trace=TRUE)

shinyApp(ui,server)