enable horizontal movement of nodes in networkD3's sankeyNetwork plots

问题

I found this image from the Internet (link) and I think it was draw in R. I tried to reproduce this Figure and make it more or less similar with one from the above link. The code I used is as following:

    ID <- 0:24
    NodeGroup <- c(rep(1,8),2,5,rep(4,7),3,5,6,6,7,7,8,9)
    name <- c("29581k","5279k","4218k","1917k","1356k","Ventas diversas: 116","Venta diversa: 97","Venta de: 141","Venta totales: 42705","Contribucion marginal: 18183", "17531k","1744k","1326k","1208k","526k","459k","14k","IIBB: 1714","Costo: 22808","Gastos directos: 6734","Gastos distribudos: 2958","Resultado: 8851","Total Gastos: 9332","Imp. Gcias: 3098","Resultado Netto: 5.753")      

    nodes <- data.frame(ID, name, NodeGroup)
    nodes$NodeGroup <- as.character(nodes$NodeGroup)
    source <- c(0:7, rep(8,9), 10:16, rep(9,3), 19, 20, 21, 21)
    target <- c(rep(8,8), 17, 10:16, 9, rep(18,7), 19:21, rep(22, 2), 23, 24)
    value <- c(29581,5279,4218,1917,1356,116,97,141,1714,17531,1744,1326,1208,526,459,14,18138,17531,1744,1326,1208,526,459,14,6374,2958,8851,6374,2958,3098,5753)
    group <- c(1:8, rep(9,8), 10, rep(19,7), rep(18,3), rep(23,2), rep(22,2))
    links <- data.frame(source, target, value, group)
    links$group <- as.character(links$group)
    sn <- sankeyNetwork(Links=links, Nodes=nodes, Source='source', Target='target',
                Value='value', NodeID='name', fontSize=18, 
                NodeGroup = "NodeGroup",
                sinksRight = FALSE, 
                LinkGroup = "group",
                #nodeWidth = 40,
                #width=1500, height=500,
                #margin = list("right"=250),
                iterations = FALSE)
     sn

From this links it is possible to change the position of a node not only vertically, but also horizontally. Can we implement it in R?

Update 1: I can solve issue in question 2 by changing the source code of sankeyNetwork.js by using the code provide at this links. I do not know how to implement it through htmlwidgets (I am not familiar with JS; hence, just do trial and error!). I just need to copy the following code to the end of sankeyNetwork.js.

function dragmove(d) {
    d3.select(this).attr("transform", 
        "translate(" + (
           d.x = Math.max(0, Math.min(width - d.dx, d3.event.x))
           ) + "," + (
           d.y = Math.max(0, Math.min(height - d.dy, d3.event.y))
           ) + ")");
    sankey.relayout();
    link.attr("d", path);
}

回答1:

To enable horizontal movement of the nodes, along with the vertical movement, you could adapt d3noob's code to work, but it's not as easy as dropping in just their dragmove function declaration.

It was written using D3v3, and networkD3 uses D3v4... and they're not entirely compatible.
That function refers to a bunch of objects that are defined elsewhere, so the function on its own cannot work without knowing what these are: width, height, sankey, link, and path.

Here is one way of adapting it to work...

library(networkD3)
library(htmlwidgets)

ID <- 0:24
NodeGroup <- c(rep(1,8),2,5,rep(4,7),3,5,6,6,7,7,8,9)
name <- c("29581k","5279k","4218k","1917k","1356k","Ventas diversas: 116",
          "Venta diversa: 97","Venta de: 141","Venta totales: 42705",
          "Contribucion marginal: 18183", "17531k","1744k","1326k","1208k",
          "526k","459k","14k","IIBB: 1714","Costo: 22808",
          "Gastos directos: 6734", "Gastos distribudos: 2958","Resultado: 8851",
          "Total Gastos: 9332","Imp. Gcias: 3098","Resultado Netto: 5.753")      

nodes <- data.frame(ID, name, NodeGroup)
nodes$NodeGroup <- as.character(nodes$NodeGroup)
source <- c(0:7, rep(8,9), 10:16, rep(9,3), 19, 20, 21, 21)
target <- c(rep(8,8), 17, 10:16, 9, rep(18,7), 19:21, rep(22, 2), 23, 24)
value <- c(29581,5279,4218,1917,1356,116,97,141,1714,17531,1744,1326,1208,526,
           459,14,18138,17531,1744,1326,1208,526,459,14,6374,2958,8851,6374,
           2958,3098,5753)
group <- c(1:8, rep(9,8), 10, rep(19,7), rep(18,3), rep(23,2), rep(22,2))
links <- data.frame(source, target, value, group)
links$group <- as.character(links$group)
sn <- sankeyNetwork(Links=links, Nodes=nodes, Source='source', Target='target',
                    Value='value', NodeID='name', fontSize=18, 
                    NodeGroup = "NodeGroup",
                    sinksRight = FALSE, 
                    LinkGroup = "group",
                    #nodeWidth = 40,
                    #width=1500, height=500,
                    #margin = list("right"=250),
                    iterations = FALSE)

onRender(sn,
         '
  function(el, x) {
    var sankey = this.sankey;
    var path = sankey.link();
    var nodes = d3.selectAll(".node");
    var link = d3.selectAll(".link")
    var width = el.getBoundingClientRect().width - 40;
    var height = el.getBoundingClientRect().height - 40;

    window.dragmove = function(d) {
      d3.select(this).attr("transform", 
        "translate(" + (
           d.x = Math.max(0, Math.min(width - d.dx, d3.event.x))
            ) + "," + (
            d.y = Math.max(0, Math.min(height - d.dy, d3.event.y))
          ) + ")");
      sankey.relayout();
      link.attr("d", path);
    };

    nodes.call(d3.drag()
      .subject(function(d) { return d; })
      .on("start", function() { this.parentNode.appendChild(this); })
      .on("drag", dragmove));
  }
  '
)

来源：https://stackoverflow.com/questions/52246111/enable-horizontal-movement-of-nodes-in-networkd3s-sankeynetwork-plots

标签

sankey-diagram

htmlwidgets

networkd3