demo of d3 tree in shiny for discussion

Readme.md

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)

code.R

# requires these so please install
# devtools::install_github("timelyportfolio/d3r")
# devtools::install_github("timelyportfolio/sankeytree")

library(d3r)
library(sankeytreeR)
library(shiny)
library(treemap)

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)

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)

i added a global variable a<-list() and change the server to this

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

i cant get it to return the df to the global object for some reason

clicking on the tree has no effect on the console

> options(shiny.trace=TRUE)
> shinyApp(ui,server)

Listening on http://127.0.0.1:7352
ERROR: [on_request_read] connection reset by peer
SEND {"config":{"workerId":"","sessionId":"879b727600fd50caec50c98ee6581e99"}}
RECV {"method":"init","data":{".clientdata_pixelratio":1,".clientdata_url_protocol":"http:",".clientdata_url_hostname":"127.0.0.1",".clientdata_url_port":"7352",".clientdata_url_pathname":"/",".clientdata_url_search":"",".clientdata_url_hash_initial":"",".clientdata_singletons":"",".clientdata_allowDataUriScheme":true}}
SEND {"busy":"busy"}
SEND {"busy":"idle"}
SEND {"errors":[],"values":[],"inputMessages":[]}

Uncaught TypeError: this.on is not a function
    at Object.eval (eval at <anonymous> (http://127.0.0.1:3858/htmlwidgets-0.8/htmlwidgets.js:236:24), <anonymous>:3:10)
    at http://127.0.0.1:3858/htmlwidgets-0.8/htmlwidgets.js:240:18
    at Array.forEach (native)
    at forEach (http://127.0.0.1:3858/htmlwidgets-0.8/htmlwidgets.js:55:14)
    at evalAndRun (http://127.0.0.1:3858/htmlwidgets-0.8/htmlwidgets.js:230:7)
    at http://127.0.0.1:3858/htmlwidgets-0.8/htmlwidgets.js:626:11
    at Array.forEach (native)
    at forEach (http://127.0.0.1:3858/htmlwidgets-0.8/htmlwidgets.js:55:14)
    at http://127.0.0.1:3858/htmlwidgets-0.8/htmlwidgets.js:551:7
    at Array.forEach (native)