Adjusting sankey plot in tabbed section

Question

In the r-markdown document given below, I use tabbed sections to display sankey plots.

However, when a sankey plot is in a tab other than the first, adjusting (using htmlwidgets::onRender function) does not work. Does anybody know a way to overcome that problem?

Related question: How to control node labels in Sankey diagram

---
title: "Untitled"
output: html_document
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = FALSE)

library(networkD3)
library(htmlwidgets)

nodes <- data.frame('name' = 
c('Node0','Node1','Node2','Node3','Node4','Node5','Node6',                   
'Node7','Node8','Node9','Node10','Node11','Node12','Node13',
'Node14','Node15','Node16','Node17','Node18','Node19',
'Node20','Node21','Node22','Node23','Node24','Node25',
'Node26','Node27','Node28','Node29','Node30','Node31',
'Node32','Node33'))

links = as.data.frame(matrix(c(
  0, 3,140,
  0, 4,140,
  0, 5,140,
  0, 6,140,
  1, 3,140,
  1, 4,140,
  1, 5,140,
  1, 6,140,
  2, 3,140,
  2, 4,140,
  2, 5,140,
  2, 6,140,
  3, 7,130,
  3, 8,130,
  3, 9,50,
  3,10,50,
  3,11,50,
  4,12,140,
  4,13,100,
  4,14,100,
  4,15,80,
  5,16,150,
  5,17,150,
  5,18,60,
  5,19,60,
  6,20,180,
  6,21,80,
  6,22,80,
  6,23,80,
  7,24,13,
  7,33,13,
  7,31,104,
  8,24,13,
  8,33,13,
  8,26,52,
  8,27,52,
  9,24,10,
  9,33,10,
  9,29,30,
  9,30,30,
  10,24,10,
  10,33,10,
  10,29,30,
  10,30,30,
  11,24,10,
  11,33,10,
  11,29,30,
  11,30,30,
  12,24,16,
  12,33,16,
  12,26,36,
  12,27,36,
  12,28,36,
  13,24,10,
  13,33,10,
  13,26,30,
  13,27,30,
  13,28,30,
  14,24,10,
  14,33,10,
  14,26,30,
  14,27,30,
  14,28,30,
  15,24,10,
  15,33,10,
  15,31,60,
  16,24,30,
  16,33,30,
  16,32,90,
  17,24,30,
  17,33,30,
  17,32,90,
  18,24,10,
  18,33,10,
  18,25,40,
  19,24,30,
  19,33,30,
  20,24,90,
  20,33,90,
  21,33,80,
  22,24,10,
  22,33,10,
  22,29,30,
  22,30,30,
  23,24,40,
  23,33,40),
byrow = TRUE, ncol = 3))

names(links) = c("source", "target", "value")
```

## Sankey diagrams {.tabset .tabset-fade}

### Outturn


```{r }


sn <- sankeyNetwork(Links = links, Nodes = nodes,
                    Source = "source", Target = "target",
                    Value = "value", NodeID = "name",
                    fontSize= 15, nodeWidth = 20, margin = list(left = 100),
                    colourScale = JS("d3.scaleOrdinal(d3.schemeCategory20b);"))

onRender(
  sn,
  '
  function(el, x) {
    d3.selectAll(".node text").attr("text-anchor", "begin").attr("x", 20);
  }
  '
)
```

### Actual

```{r }


sn <- sankeyNetwork(Links = links, Nodes = nodes,
                    Source = "source", Target = "target",
                    Value = "value", NodeID = "name",
                    fontSize= 15, nodeWidth = 20, margin = list(left = 100),
                    colourScale = JS("d3.scaleOrdinal(d3.schemeCategory20b);"))

onRender(
  sn,
  '
  function(el, x) {
    d3.selectAll(".node text").attr("text-anchor", "begin").attr("x", 20);
  }
  '
)
```

Gravure

I think this happens because the onRender functions run once when the page is loaded, but the d3/svg elements of the sankey plot on the second tab don't get created until you manually switch to that tab, so they're unaffected. If you could figure out how to run the Javascript code in your onRender function when the tab is switched, it would probably work. I can think of a way to run the code when you click on something, but that would not be a very elegant solution. – Dustin

Answer 1

If you add the following code to the end of your example, the appropriate text-anchors will be set whenever a tab is clicked/activated, which should solve your specific problem...

```{js}
setTimeout(function () {
    $('.nav-tabs a').on('shown.bs.tab', function() { 
        d3.selectAll(".node text").attr("text-anchor", "begin").attr("x", 20);
      })
  }, 1)
```

You could also then remove all of your calls to onRender further up since they're no longer needed.

Here's a full example with a bit of reformatting to make it more concise...

---
title: "Untitled"
output: html_document
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = FALSE)

library(networkD3)
library(htmlwidgets)

name <- c('Node0', 'Node1', 'Node2', 'Node3', 'Node4', 'Node5', 'Node6', 
          'Node7', 'Node8', 'Node9', 'Node10', 'Node11', 'Node12', 'Node13',
          'Node14', 'Node15', 'Node16', 'Node17', 'Node18', 'Node19', 'Node20',
          'Node21', 'Node22', 'Node23', 'Node24', 'Node25', 'Node26', 'Node27',
          'Node28', 'Node29', 'Node30', 'Node31', 'Node32', 'Node33')
nodes <- data.frame(name)

source <- c(0, 0, 0, 0, 1, 1, 1, 1, 2, 2, 2, 2, 3, 3, 3, 3, 3, 4, 4, 4, 4, 5, 5,
            5, 5, 6, 6, 6, 6, 7, 7, 7, 8, 8, 8, 8, 9, 9, 9, 9, 10, 10, 10, 10, 
            11, 11, 11, 11, 12, 12, 12, 12, 12, 13, 13, 13, 13, 13, 14, 14, 14, 
            14, 14, 15, 15, 15, 16, 16, 16, 17, 17, 17, 18, 18, 18, 19, 19, 20, 
            20, 21, 22, 22, 22, 22, 23, 23)
target <- c(3, 4, 5, 6, 3, 4, 5, 6, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15,
            16, 17, 18, 19, 20, 21, 22, 23, 24, 33, 31, 24, 33, 26, 27, 24, 33, 
            29, 30, 24, 33, 29, 30, 24, 33, 29, 30, 24, 33, 26, 27, 28, 24, 33, 
            26, 27, 28, 24, 33, 26, 27, 28, 24, 33, 31, 24, 33, 32, 24, 33, 32, 
            24, 33, 25, 24, 33, 24, 33, 33, 24, 33, 29, 30, 24, 33)
value <- c(140, 140, 140, 140, 140, 140, 140, 140, 140, 140, 140, 140, 130, 130,
           50, 50, 50, 140, 100, 100, 80, 150, 150, 60, 60, 180, 80, 80, 80, 13,
           13, 104, 13, 13, 52, 52, 10, 10, 30, 30, 10, 10, 30, 30, 10, 10, 30,
           30, 16, 16, 36, 36, 36, 10, 10, 30, 30, 30, 10, 10, 30, 30, 30, 10, 
           10, 60, 30, 30, 90, 30, 30, 90, 10, 10, 40, 30, 30, 90, 90, 80, 10, 
           10, 30, 30, 40, 40)
links <- data.frame(source, target, value)
```

## Sankey diagrams {.tabset .tabset-fade}

### Outturn

```{r }
sn <- sankeyNetwork(Links = links, Nodes = nodes, Source = "source", 
                    Target = "target", Value = "value", NodeID = "name", 
                    fontSize = 15, nodeWidth = 20, margin = list(left = 100),
                    colourScale = JS("d3.scaleOrdinal(d3.schemeCategory20b);"))

onRender(sn, jsCode = 
  'function(el, x) { 
      d3.selectAll(".node text").attr("text-anchor", "begin").attr("x", 20);
  }')
```

### Actual

```{r }
sankeyNetwork(Links = links, Nodes = nodes, Source = "source", 
              Target = "target", Value = "value", NodeID = "name", 
              fontSize = 15, nodeWidth = 20, margin = list(left = 100),
              colourScale = JS("d3.scaleOrdinal(d3.schemeCategory20b);"))
```

```{js}
setTimeout(function () {
    $('.nav-tabs a').on('shown.bs.tab', function() { 
        d3.selectAll(".node text").attr("text-anchor", "begin").attr("x", 20);
      })
  }, 10)
```

Dustin

Answer 2

This might help (largely inspired from here). The idea is to rewrite the HTML code of tabsets from scratch (using htmltools) and define the same class for each tab item: 'tab-pane active'. The drawback of this approach is that it makes both plots visible before clicking on a tab. To solve this issue, we can add a JS script as a workaround that waits 1 millisecond before automatically switching to a tab.

---
title: "Untitled"
output: html_document
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = FALSE)

library(networkD3)
library(htmlwidgets)

nodes <- data.frame('name' = 
c('Node0','Node1','Node2','Node3','Node4','Node5','Node6',                   
'Node7','Node8','Node9','Node10','Node11','Node12','Node13',
'Node14','Node15','Node16','Node17','Node18','Node19',
'Node20','Node21','Node22','Node23','Node24','Node25',
'Node26','Node27','Node28','Node29','Node30','Node31',
'Node32','Node33'))

links = as.data.frame(matrix(c(
  0, 3,140,
  0, 4,140,
  0, 5,140,
  0, 6,140,
  1, 3,140,
  1, 4,140,
  1, 5,140,
  1, 6,140,
  2, 3,140,
  2, 4,140,
  2, 5,140,
  2, 6,140,
  3, 7,130,
  3, 8,130,
  3, 9,50,
  3,10,50,
  3,11,50,
  4,12,140,
  4,13,100,
  4,14,100,
  4,15,80,
  5,16,150,
  5,17,150,
  5,18,60,
  5,19,60,
  6,20,180,
  6,21,80,
  6,22,80,
  6,23,80,
  7,24,13,
  7,33,13,
  7,31,104,
  8,24,13,
  8,33,13,
  8,26,52,
  8,27,52,
  9,24,10,
  9,33,10,
  9,29,30,
  9,30,30,
  10,24,10,
  10,33,10,
  10,29,30,
  10,30,30,
  11,24,10,
  11,33,10,
  11,29,30,
  11,30,30,
  12,24,16,
  12,33,16,
  12,26,36,
  12,27,36,
  12,28,36,
  13,24,10,
  13,33,10,
  13,26,30,
  13,27,30,
  13,28,30,
  14,24,10,
  14,33,10,
  14,26,30,
  14,27,30,
  14,28,30,
  15,24,10,
  15,33,10,
  15,31,60,
  16,24,30,
  16,33,30,
  16,32,90,
  17,24,30,
  17,33,30,
  17,32,90,
  18,24,10,
  18,33,10,
  18,25,40,
  19,24,30,
  19,33,30,
  20,24,90,
  20,33,90,
  21,33,80,
  22,24,10,
  22,33,10,
  22,29,30,
  22,30,30,
  23,24,40,
  23,33,40),
byrow = TRUE, ncol = 3))

names(links) = c("source", "target", "value")
```

```{r echo=FALSE, message=FALSE, warning=FALSE}
library(htmltools)

sn1 <- sankeyNetwork(Links = links, Nodes = nodes,
                    Source = "source", Target = "target",
                    Value = "value", NodeID = "name",
                    fontSize= 15, nodeWidth = 20, margin = list(left = 100),
                    colourScale = JS("d3.scaleOrdinal(d3.schemeCategory20b);"))

# Change font size of fig.2 to have visible change. 
sn2 <- sankeyNetwork(Links = links, Nodes = nodes,
                    Source = "source", Target = "target",
                    Value = "value", NodeID = "name",
                    fontSize= 20, nodeWidth = 20, margin = list(left = 100),
                    colourScale = JS("d3.scaleOrdinal(d3.schemeCategory20b);"))

# make a named list of plots for demonstration
#  the names will be the titles of the tabs
plots <- list(
  "outturn" = sn1,
  "actual" = sn2
)

# create our top-level div for the tabs
tags$div(
  # create the tabs with titles as a ul with li/a
  tags$ul(
    class="nav nav-tabs",
    role="tablist",
    lapply(
      names(plots),
      function(p){
        tags$li(
          tags$a(
            "data-toggle"="tab",
            href=paste0("#tab-",p),
            p
          )
        )
      }
    )
  ),
  # fill the tabs with the plots
  tags$div(
    class="tab-content",
    lapply(
      names(plots),
      function(p){
         tags$div(
          #  here is the trick
          class=("tab-pane active"),
          #  id will need to match the id provided to the a href above
          id=paste0("tab-",p),
            onRender(plots[[p]],'
                    function(el, x) {
                    d3.selectAll(".node text").attr("text-anchor", "begin").attr("x", 20);
                    }')
        )
      }
    )
  )
) 
```

```{js}
setTimeout(function (){

$('.nav-tabs a[href="#tab-outturn"]').tab('show')

}, 1);
```

Nympholepsy

The resulting plots should both look like the one in "outturn" (OP). Using your code they both look like the "actual" version. – Gravure

Indeed, my mistake. When you replace 'tab-pane fade' by 'tab-pane active' it gives the correct output but with the issue of the double plots. I guess it is not really helpful, sorry. – Nympholepsy

Seems better now. Why are the fonts different in the second tab? I would like to get two identical plots. – Gravure

I have just changed the font size of figure 2 to have a visible change between plots for the example. You can either set fontSize=15 for sn2 or remove sn2 and set "actual" = sn1 to have two identical plots. – Nympholepsy

Thank you. I believe it's working. I hoped it didn't have to be so complicated. So I will wait a little longer before accepting the answer. – Gravure