Adjusting sankey plot in tabbed section

前端 未结 2 707
鱼传尺愫
鱼传尺愫 2021-02-14 02:39

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

相关标签:
2条回答
  • 2021-02-14 03:28

    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);
    ```
    
    0 讨论(0)
  • 2021-02-14 03:32

    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)
    ```
    
    0 讨论(0)
提交回复
热议问题