Adding a color legend with JavaScript to a networkD3 sankeyNetwork() in R

I am currently working on an Shiny-App which displays Sankey-Plots. In order to create the Network I use the networkD3::sankeyNetwork() function which has no attribute to show a legend of the colorScale for the LinkGroup in general. Now I am wondering since networkD3 is based on JS is there a way to simply "add" an legend to the network.

I somehow came up with the htmlwidgets::onRender(SankeyNetwork,JavaScript) function and tried to add an Legend to my Network but it won't work, and to be fair I don't really know JS.

Maybe someone can help me?

I tried something like this:

library(networkD3)
library(data.table)
library(dplyr)
library(tidyverse)
library(ggplot2)

# Just creating a sample Network

MakeSankey <- function(){
  links <- data.frame(
  source=c("group_A","group_A", "group_B", "group_C", "group_C", "group_E"), 
  target=c("group_C","group_D", "group_E", "group_F", "group_G", "group_H"), 
  value=c(2,3, 2, 3, 1, 3),
  group=c("M","W","M","W","M","W")
  )
 
  nodes <- data.frame(
    name=c(as.character(links$source), 
    as.character(links$target)) %>% unique(),
    group = as.factor(c("sources"))
  )
   
  links$IDsource <- match(links$source, nodes$name)-1 
  links$IDtarget <- match(links$target, nodes$name)-1
  
  myColors <- 'd3.scaleOrdinal().domain(["M", "W", "sources"]) .range(["#5485AB", "#BA4682", "#646363"])'
  
  # Make the Network
  p <- sankeyNetwork(Links = links, Nodes = nodes,
                Source = "IDsource", Target = "IDtarget",
                Value = "value", NodeID = "name", 
               colourScale= myColors, LinkGroup="group", NodeGroup="group", 
               sinksRight=FALSE, fontSize=14, nodeWidth = 20)

#Here I tried the Java-Script Part

JS <- 'd3.selectAll(".sankeyNetwork html-widget html-widget-output shiny-bound-output").append(
  var svg = d3.select("svg")

  // Handmade legend
  svg.append("circle").attr("cx",200).attr("cy",130).attr("r", 6).style("fill", "#5485AB")
  svg.append("circle").attr("cx",200).attr("cy",160).attr("r", 6).style("fill", "#BA4682")
  svg.append("text").attr("x", 220).attr("y", 130).text("variable M").style("font-size", "15px").attr("alignment-baseline","middle")
  svg.append("text").attr("x", 220).attr("y", 160).text("variable W").style("font-size", "15px").attr("alignment-baseline","middle")
  );'
      
     p <- htmlwidgets::onRender(p,JS)

      return(p)
    }

MakeSankey()

This would work:

library(networkD3)
library(data.table)
library(dplyr)
library(tidyverse)
library(ggplot2)

# Just creating a sample Network

MakeSankey <- function(){
    links <- data.frame(
        source=c("group_A","group_A", "group_B", "group_C", "group_C", "group_E"), 
        target=c("group_C","group_D", "group_E", "group_F", "group_G", "group_H"), 
        value=c(2,3, 2, 3, 1, 3),
        group=c("M","W","M","W","M","W")
    )
    
    nodes <- data.frame(
        name=c(as.character(links$source), 
               as.character(links$target)) %>% unique(),
        group = as.factor(c("sources"))
    )
    
    links$IDsource <- match(links$source, nodes$name)-1 
    links$IDtarget <- match(links$target, nodes$name)-1
    
    myColors <- 'd3.scaleOrdinal().domain(["M", "W", "sources"]) .range(["#5485AB", "#BA4682", "#646363"])'
    
    # Make the Network
    p <- sankeyNetwork(Links = links, Nodes = nodes,
                       Source = "IDsource", Target = "IDtarget",
                       Value = "value", NodeID = "name", 
                       colourScale= myColors, LinkGroup="group", NodeGroup="group", 
                       sinksRight=FALSE, fontSize=14, nodeWidth = 20)
    
    #Here I tried the Java-Script Part
    
    JS <- 
    '
    function(el, x, data){
      var svg = d3.select("svg")
      // Handmade legend
      svg.append("circle").attr("cx",25).attr("cy",10).attr("r", 6).style("fill", "#5485AB")
      svg.append("circle").attr("cx",25).attr("cy",30).attr("r", 6).style("fill", "#BA4682")
      svg.append("text").attr("x", 35).attr("y", 10).text("variable M").style("font-size", "15px").attr("alignment-baseline","middle")
      svg.append("text").attr("x", 35).attr("y", 30).text("variable W").style("font-size", "15px").attr("alignment-baseline","middle")
    } 
    '
    
    p <- htmlwidgets::onRender(p,JS)
    
    return(p)
}

MakeSankey()

• onRender needs a JS function, not plain lines of JS code.
• Your JS code is incorrect, fixed some syntax issues.
• Your coordinates are off, here is just an example, change x and y to your desired number.