Initial commit

Changelog:
 - ported to D3 v4
 - based on https://github.com/d3/d3-sankey
     - added several modifications from networkD3 sankey.js
     - included fixes and features from unmerged pull requests:
       - d3/d3-plugins#124: Fix nodesByBreadth to have proper ordering
       - d3/d3-plugins#120: Added 'l-bezier' link type
       - d3/d3-plugins#74: Sort sankey target links by descending slope
       - d3/d3-sankey#4: Add horizontal alignment option to Sankey layout
 - added option numberFormat, default being ",.5g" (see , fixesristophergandrud/networkD3#147)
 - added option NodePosX, fixes christophergandrud/networkD3#108
 - added option to force node ordering to be alphabetical along a path (only works well with trees with one parent for each node, but might fix christophergandrud/networkD3#153)

R/data-definitions.R

@@ -0,0 +1,24 @@
+
+#' Les Miserables character nodes
+#'
+#' A data file of nodes from Knuth's Les Miserables characters data base.
+#'
+#' @format A data set with 77 observations of 2 variables, plus made up
+#' node size variable.
+#' @source See Mike Bostock \url{http://bl.ocks.org/mbostock/4062045}.
+"MisNodes"
+
+#' Les Miserables character links
+#'
+#' A data file of links from Knuth's Les Miserables characters data base.
+#'
+#' @format A data set with 254 observations of 3 variables.
+#' @source See Mike Bostock \url{http://bl.ocks.org/mbostock/4062045}.
+"MisLinks"
+
+#' Edge list of REF (2014) journal submissions for Politics and International
+#' Relations
+#' 
+#' @format A data set with 2732 rows and 3 variables.
+#' @source See REF 2014 \url{http://results.ref.ac.uk/DownloadSubmissions/ByUoa/21}.
+"SchoolsJournals"

R/sankeyNetwork.R

@@ -20,7 +20,7 @@
 #' \code{Nodes}. Used to color the nodes in the network.
 #' @param LinkGroup character string specifying the groups in the
 #' \code{Links}. Used to color the links in the network.
-#' @param NodeDepth character specifying a column in the \code{Nodes} data
+#' @param NodePosX character specifying a column in the \code{Nodes} data
 #' frame that specifies the 0-based ordering of the nodes along the x-axis.
 #' @param NodeValue character specifying a column in the \code{Nodes} data
 #' frame with the value/size of each node. If \code{NULL}, the value is 
@@ -35,6 +35,7 @@
 #' @param nodeWidth numeric width of each node.
 #' @param nodePadding numeric essentially influences the width height.
 #' @param nodeStrokeWidth numeric width of the stroke around nodes.
+#' @param numberFormat number format in toolstips - see https://github.com/d3/d3-format for options
 #' @param margin an integer or a named \code{list}/\code{vector} of integers
 #' for the plot margins. If using a named \code{list}/\code{vector},
 #' the positions \code{top}, \code{right}, \code{bottom}, \code{left}
@@ -46,8 +47,7 @@
 #' @param iterations numeric. Number of iterations in the diagramm layout for 
 #' computation of the depth (y-position) of each node. Note: this runs in the 
 #' browser on the client so don't push it too high.
-#' @param sinksRight boolean. If \code{TRUE}, the last nodes are moved to the 
-#' right border of the plot.
+#' @param align character. TODO.
 #' @param zoom logical value to enable (\code{TRUE}) or disable (\code{FALSE})
 #' zooming
 #' @param bezierLink logical values if the links should be rendered by 
@@ -84,12 +84,12 @@
 #' @export
 
 sankeyNetwork <- function(Links, Nodes, Source, Target, Value, 
-    NodeID, NodeGroup = NodeID, LinkGroup = NULL, NodeDepth = NULL, NodeValue = NULL,
-    units = "", 
-    colourScale = JS("d3.scale.category20()"), fontSize = 7,  fontFamily = NULL, 
+    NodeID, NodeGroup = NodeID, LinkGroup = NULL, NodePosX = NULL, NodeValue = NULL,
+    units = "", colourScale = JS("d3.scaleOrdinal().range(d3.schemeCategory20)"), fontSize = 7,  fontFamily = NULL, 
     nodeWidth = 15, nodePadding = 10, nodeStrokeWidth = 1, margin = NULL, 
-    height = NULL, width = NULL, iterations = 32, sinksRight = TRUE, zoom = FALSE,
-    bezierLink = TRUE) 
+    numberFormat = ",.5g", orderByPath = FALSE, highlightChildLinks  = FALSE,
+    height = NULL, width = NULL, iterations = 32, zoom = FALSE, align = "center",
+    linkType = "bezier", curvature = .5, scaleNodeBreadthsByString = FALSE) 
 {
     # Check if data is zero indexed
     check_zero(Links[, Source], Links[, Target])
@@ -134,8 +134,8 @@ sankeyNetwork <- function(Links, Nodes, Source, Target, Value,
         NodesDF$group <- Nodes[, NodeGroup]
     }
 
-    if (is.character(NodeDepth)) {
-        NodesDF$depth <- Nodes[, NodeDepth]
+    if (is.character(NodePosX)) {
+        NodesDF$depth <- Nodes[, NodePosX]
     }
 
     if (is.character(NodeValue)) {
@@ -148,22 +148,27 @@ sankeyNetwork <- function(Links, Nodes, Source, Target, Value,
 
     margin <- margin_handler(margin)
 
+    message(align)
+
     # create options
     options = list(NodeID = NodeID, NodeGroup = NodeGroup, LinkGroup = LinkGroup, 
         colourScale = colourScale, fontSize = fontSize, fontFamily = fontFamily, 
         nodeWidth = nodeWidth, nodePadding = nodePadding, nodeStrokeWidth = nodeStrokeWidth,
-        units = units, margin = margin, iterations = iterations, sinksRight = sinksRight, 
-        zoom = zoom, bezierLink = bezierLink)
+        numberFormat = numberFormat, orderByPath = orderByPath,
+        units = units, margin = margin, iterations = iterations, 
+        zoom = zoom, linkType = linkType, curvature = curvature,
+        highlightChildLinks = highlightChildLinks,
+        align = align, scaleNodeBreadthsByString = scaleNodeBreadthsByString)
 
     # create widget
     htmlwidgets::createWidget(name = "sankeyNetwork", x = list(links = LinksDF, 
         nodes = NodesDF, options = options), width = width, height = height, 
         htmlwidgets::sizingPolicy(padding = 10, browser.fill = TRUE), 
-        package = "networkD3")
+        package = "sankeyD3")
 }
 
 #' Title
-#' @rdname networkD3-shiny
+#' @rdname sankeyD3-shiny
 #'
 #' @param outputId 
 #' @param width 
@@ -174,16 +179,16 @@ sankeyNetwork <- function(Links, Nodes, Source, Target, Value,
 #'
 #' @examples
 sankeyNetworkOutput <- function(outputId, width = "100%", height = "500px") {
-    shinyWidgetOutput(outputId, "sankeyNetwork", width, height, 
-        package = "networkD3")
+    htmlwidgets::shinyWidgetOutput(outputId, "sankeyNetwork", width, height, 
+        package = "sankeyD3")
 }
 
-#' @rdname networkD3-shiny
+#' @rdname sankeyD3-shiny
 #' @export
 renderSankeyNetwork <- function(expr, env = parent.frame(), quoted = FALSE) {
     if (!quoted) 
         {
             expr <- substitute(expr)
         }  # force quoted
-    shinyRenderWidget(expr, sankeyNetworkOutput, env, quoted = TRUE)
+  htmlwidgets::shinyRenderWidget(expr, sankeyNetworkOutput, env, quoted = TRUE)
 }

README.md

@@ -4,13 +4,22 @@ Version 0.1
 
 This project is based on the Sankey implementation in [networkD3](https://github.com/christophergandrud/networkD3) and [d3-sankey](https://github.com/d3/d3-sankey).  
 
-Differences to sankeyNetwork in networkD3:
- - Based on d3 v4
+Changelog:
+ - ported to D3 v4
+ - based on https://github.com/d3/d3-sankey 
+     - added several modifications from networkD3 sankey.js 
+     - included fixes and features from unmerged pull requests:
+       - d3/d3-plugins#124: Fix nodesByBreadth to have proper ordering
+       - d3/d3-plugins#120: Added 'l-bezier' link type
+       - d3/d3-plugins#74: Sort sankey target links by descending slope
+       - d3/d3-sankey#4: Add horizontal alignment option to Sankey layout
+ - added option numberFormat, default being ",.5g" (see , fixes #147)
+ - added option NodePosX, fixes #108 
+ - added option to force node ordering to be alphabetical along a path (only works well with trees with one parent for each node, but might fix #153)
+
 
 ## Usage
 
-Here's `sankeyNetwork` using a downloaded JSON data file:
-
 ```R
 # Recreate Bostock Sankey diagram: http://bost.ocks.org/mike/sankey/
 # Load energy projection data
@@ -32,4 +41,4 @@ Use `saveNetwork` to save a network to stand alone HTML file:
 library(magrittr)
 
 simpleNetwork(networkData) %>% saveNetwork(file = 'Net1.html')
-```
+```

inst/examples/examples.Rmd

@@ -10,11 +10,9 @@ output:
 ```{r}
 library(sankeyD3)
 URL <- "https://raw.githubusercontent.com/christophergandrud/d3Network/sankey/JSONdata/energy.json"
-Energy <- RCurl::getURL(URL, ssl.verifypeer = FALSE)
-EngLinks <- JSONtoDF(jsonStr = Energy, array = "links")
-EngNodes <- JSONtoDF(jsonStr = Energy, array = "nodes")
+Energy <- jsonlite::fromJSON(URL)
 
-sankeyNetwork(Links = EngLinks, Nodes = EngNodes, Source = "source",
+sankeyNetwork(Links = Energy$links, Nodes = Energy$nodes, Source = "source",
               Target = "target", Value = "value", NodeID = "name",
-              fontSize = 12, nodeWidth = 30)
+              fontSize = 12, nodeWidth = 30, width = 300, height = 300)
 ```

inst/examples/shiny/server.R

@@ -6,41 +6,25 @@ data(MisNodes)
 
 shinyServer(function(input, output) {
 
-  output$simple <- renderSimpleNetwork({
-    src <- c("A", "A", "A", "A", "B", "B", "C", "C", "D")
-    target <- c("B", "C", "D", "J", "E", "F", "G", "H", "I")
-    networkData <- data.frame(src, target)
-    simpleNetwork(networkData, opacity = input$opacity)
-  })
-
-  output$force <- renderForceNetwork({
-    forceNetwork(Links = MisLinks, Nodes = MisNodes, Source = "source",
-                 Target = "target", Value = "value", NodeID = "name",
-                 Group = "group", opacity = input$opacity)
-  })
-
-  output$forceRadius <- renderForceNetwork({
-          forceNetwork(Links = MisLinks, Nodes = MisNodes, Source = "source",
-                       Target = "target", Value = "value", NodeID = "name",
-                       Nodesize = 'size', radiusCalculation = " Math.sqrt(d.nodesize)+6",
-                       Group = "group", opacity = input$opacity, legend = T) 
-  })
-
   output$sankey <- renderSankeyNetwork({
     URL <- "https://cdn.rawgit.com/christophergandrud/networkD3/master/JSONdata/energy.json"
     Energy <- jsonlite::fromJSON(URL)
+    Energy$links$source_name <- Energy$nodes[Energy$links$source+1, "name"]
+    Energy$links$target_name <- Energy$nodes[Energy$links$target+1, "name"]
     sankeyNetwork(Links = Energy$links, Nodes = Energy$nodes, Source = "source",
                   Target = "target", Value = "value", NodeID = "name",
-                  fontSize = 12, nodeWidth = 30, sinksRight = input$sinksRight,
-                  zoom = input$zoom)
-  })
-
-  output$rt <- renderRadialNetwork({
-    Flare <- jsonlite::fromJSON(
-      "https://gist.githubusercontent.com/mbostock/4063550/raw/a05a94858375bd0ae023f6950a2b13fac5127637/flare.json",
-      simplifyDataFrame = FALSE
-    )
-    radialNetwork(List = Flare, fontSize = 10, opacity = 0.9, margin=0)
+                  fontSize = 12, nodeWidth = 30, 
+                  zoom = input$zoom, align = input$align,
+                  scaleNodeBreadthsByString = input$scaleNodeBreadthsByString,
+                  nodeStrokeWidth = input$nodeStrokeWidth,
+                  LinkGroup = ifelse(input$LinkGroup == "none", NA, input$LinkGroup),
+                  NodeGroup = ifelse(input$NodeGroup == "none", NA, input$NodeGroup),
+                  linkType = input$linkType,
+                  curvature = input$curvature,
+                  numberFormat = input$numberFormat,
+                  highlightChildLinks = input$highlightChildLinks,
+                  orderByPath = input$orderByPath,
+                  units = "kWh")
   })
 
 })

inst/examples/shiny/ui.R

@@ -4,15 +4,25 @@ library(sankeyD3)
 shinyUI(fluidPage(
 
   titlePanel("Shiny sankeyD3 network"),
-
-  sidebarLayout(
-    sidebarPanel(
-      numericInput("opacity", "Opacity", 0.6, min = 0.1, max = 1, step = .1)
-    ),
-    mainPanel(
-      checkboxInput("sinksRight", "sinksRight", value = TRUE),
-      checkboxInput("zoom", "zoom", value = FALSE),
+
+  fluidRow(    
+      column(4,radioButtons("LinkGroup", "LinkGroup", choices = c("source_name", "target_name", "none"), selected = "none", inline = TRUE)),
+      column(4,radioButtons("NodeGroup", "NodeGroup", choices = c("name", "none"), selected = "name", inline = TRUE)),
+      column(4,radioButtons("linkType", "linkType", selected = "bezier", choices = c("bezier", "l-bezier", "trapez"), inline = TRUE))
+  ),
+  fluidRow(    
+    column(4,radioButtons("align", "align", choices = c("left", "right", "center", "justify", "none"), selected = "justify", inline = TRUE)),
+    column(4,checkboxInput("scaleNodeBreadthsByString", "scaleNodeBreadthsByString", value = FALSE),
+           checkboxInput("zoom", "zoom", value = FALSE)),
+    column(4,checkboxInput("highlightChildLinks", "highlightChildLinks", value = FALSE),
+            checkboxInput("orderByPath", "orderByPath", value = FALSE))
+  ),
+  fluidRow(    
+      column(4,sliderInput("nodeStrokeWidth","nodeStrokeWidth", value = 1, min = 0, max = 15)),
+      column(4,sliderInput("curvature","curvature", value = .5, min = 0, max = 1, step=.1)),
+      column(4,textInput("numberFormat", "numberFormat", value = ",.5g"))
+  ),
+  fluidRow(
       sankeyNetworkOutput("sankey")
     )
-  )
 ))