rd3.jssankey-diagramhtmlwidgetsnetworkd3

Export manually edited htmlwidget to SVG or similar


I often create Sankey-diagrams in R via {sankeyD3}, because it seems to be the package with the most options/features to do so. However, one feature that is missing is the ability to set the order of nodes on the y-axis (although this issue tried to fix that?).

Therefore, I must arrange the nodes manually afterwards. I can do this by setting dragY = TRUE when creating the diagram and then exporting it to an html file via htmlwidgets::saveWidget(). This allows me to manually drage the nodes when opening the html file.

reprex

# remotes::install_github("fbreitwieser/sankeyD3")
links <- data.frame(
  source = c(0, 0, 0, 1, 2, 3, 4, 4),
  target = c(1, 2, 3, 4, 4, 4, 5, 6),
  value = c(2, 3, 4, 2, 3 , 4, 4, 5)
)

nodes <- data.frame(
  label = c("A1", "B1", "B3", "B2", "C1", "D1", "D2"),
  yOrder = c(1, 1, 3, 2, 1, 1, 2)
)

out <- sankeyD3::sankeyNetwork(
  Links = links,
  Nodes = nodes,
  Source = "source",
  Target = "target",
  Value  = "value",
  NodeID = "label",
  fontFamily = "Arial",
  fontSize = 12,
  numberFormat = ",.1s",
  height = 500,
  width = 700,
  dragY = TRUE)

htmlwidgets::saveWidget(out,
                        file = here::here("out.html"),
                        selfcontained = TRUE)

and here is a screenshot showing the exported html on the left and the one where I manually rearranged the nodes on the right: enter image description here

Question

My goal is to insert the edited diagram into a word-document in the best possible quality. So I guess I want to know how to export the edited html-file to a SVG format or similar?


Solution

  • You can use a headless browser to do this - example below use chromote:

    Chromote is an R implementation of the Chrome DevTools Protocol. It works with Chrome, Chromium, Opera, Vivaldi, and other browsers based on Chromium. By default it uses Google Chrome (which must already be installed on the system). To use a different browser, see Specifying which browser to use.

    So, if you have Chrome this will code will open the output of saveWidget and run it in a headless Chrome session. The steps are: create a new session; navigate to the htmlWidgets::saveWidget output; wait till the load event has fired (async); then identify the svg element and get the outerHTML; then persist this:

    outFile <- 'C:\\Users\\robin\\Downloads\\out.html'
    svg1File <- 'C:\\Users\\robin\\Downloads\\out1.svg'
    svg2File <- 'C:\\Users\\robin\\Downloads\\out2.svg'
    
    b <- chromote::ChromoteSession$new()
    b$Page$navigate(outFile, wait_ = FALSE)
    b$Page$loadEventFired(wait_ = FALSE)$
      then(function(value) {
        svgList <- b$Runtime$evaluate('document.querySelector("svg").outerHTML')
      })$
      then(function (value) {
        writeLines(value$result$value, svg1File)
      })
    

    There is a little problem in this which you can see by double clicking on this out1.svg file and note it does not render the image. This is because the xmlns tag is missing from the svg element. You can add this with functions from the xml2 package like so:

    svg <- xml2::read_xml(svg1File)
    root <- xml2::xml_find_first(svg, xpath = '//svg')
    xml2::xml_set_attr(root, attr = 'xmlns', value = 'http://www.w3.org/2000/svg')
    xml2::write_xml(svg, svg2File)
    

    This adds the standard namespace attribute to the svg and this file will render in a browser. I have an old version of Word that does not import svg so cannot test that.

    Full code based on yours:

    outFile <- 'C:\\Users\\robin\\Downloads\\out.html'
    svg1File <- 'C:\\Users\\robin\\Downloads\\out1.svg'
    svg2File <- 'C:\\Users\\robin\\Downloads\\out2.svg'
    
    links <- data.frame(
      source = c(0, 0, 0, 1, 2, 3, 4, 4),
      target = c(1, 2, 3, 4, 4, 4, 5, 6),
      value = c(2, 3, 4, 2, 3 , 4, 4, 5)
    )
    
    nodes <- data.frame(
      label = c("A1", "B1", "B3", "B2", "C1", "D1", "D2"),
      yOrder = c(1, 1, 2, 3, 1, 1, 2)
    )
    
    out <- sankeyD3::sankeyNetwork(
      Links = links,
      Nodes = nodes,
      Source = "source",
      Target = "target",
      Value  = "value",
      NodeID = "label",
      fontFamily = "Arial",
      fontSize = 12,
      numberFormat = ",.1s",
      height = 500,
      width = 700,
      dragY = TRUE)
    
    
    htmlwidgets::saveWidget(out,
                            file = outFile,
                            selfcontained = TRUE)
    
    b <- chromote::ChromoteSession$new()
    b$Page$navigate(outFile, wait_ = FALSE)
    b$Page$loadEventFired(wait_ = FALSE)$
      then(function(value) {
        svgList <- b$Runtime$evaluate('document.querySelector("svg").outerHTML')
      })$
      then(function (value) {
        writeLines(value$result$value, svg1File)
      })
    
    svg <- xml2::read_xml(svg1File)
    root <- xml2::xml_find_first(svg, xpath = '//svg')
    xml2::xml_set_attr(root, attr = 'xmlns', value = 'http://www.w3.org/2000/svg')
    xml2::write_xml(svg, svg2File)