在下面给出的R-MARKDOWN文档中，我使用选项卡的部分显示Sankey图。
但是，当Sankey图位于第一个选项卡以外的其他选项卡中时，调整(使用htmlwidgets::onRender函数(不起作用。有人知道一种克服这个问题的方法吗？
相关问题：如何控制Sankey图中的节点标签
---
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);
}
'
)
```
如果将以下代码添加到示例的末尾，只要单击/激活选项卡，就会设置适当的文本主持人，这应该解决您的特定问题...
```{js}
setTimeout(function () {
$('.nav-tabs a').on('shown.bs.tab', function() {
d3.selectAll(".node text").attr("text-anchor", "begin").attr("x", 20);
})
}, 1)
```
您也可以将所有电话删除到onRender，因为它们不再需要。
这是一个完整的例子，有一些重新格式化以使其更简洁...
---
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)
```
这可能会有所帮助(很大程度上是从这里启发的(。这个想法是从scratch(使用htmltools(重写tabsets的HTML代码，并为每个标签项目定义同一类：'tab-pane active'。这种方法的缺点是，在单击选项卡之前，它使两个图都可见。要解决此问题，我们可以将JS脚本添加为解决方法，该解决方案要等待1毫秒，然后自动切换到选项卡。
---
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);
```