Sankey Network（在R Blogdown中）无法在Firefox上正确呈现

Question

我的Blogdown网站（包括地块，降价等）通常在Chrome和Firefox上都能正常显示。顺便说一句，尽管我不太在乎该浏览器，但它们通常也可以在IE上正常工作。为了完整性，我将其包含在讨论中。

当我使用networkD3 R软件包在Blogdown中包含 Sankey Network 时，东西会在Chrome和IE中“正确地”呈现，但在Firefox中不会。 Firefox会人为地缩小 Sankey Network 的大小，如下所示：

这是我正在使用的代码。将 Sankey Networks 与Blogdown一起使用时，我可以做些什么来使 Sankey Network 在Firefox上正确呈现？

我确实弄错了{r, fig.width=x, fig.height=y}。增加x和y会增加整体图像的大小，同时将整体图像保留在相同的“小”博客框中，从而有效地减小了 Sankey Network 的尺寸，甚至超过了上图所示的尺寸。减小x和y只会减小图像尺寸，也使 Sankey Network 小于上面显示的大小。我认为我需要解决渲染问题（在Firefox中存在，在Chrome中不存在）。

---
title: "Data Analysis"
date: "2019-01-01T18:00:00-09:00"
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
library(tidyverse)
library(blogdown)
library(networkD3)
```

Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt ut labore et dolore magna aliqua. Ut enim ad minim veniam, quis nostrud exercitation ullamco laboris nisi ut aliquip ex ea commodo consequat. Duis aute irure dolor in reprehenderit in voluptate velit esse cillum dolore eu fugiat nulla pariatur. Excepteur sint occaecat cupidatat non proident, sunt in culpa qui officia deserunt mollit anim id est laborum.

```{r sankey, echo=FALSE, error=FALSE, message=FALSE, warning=FALSE}
source <- c("A", "A", "B", "C", "D", "D", "E", "E")
target <- c("D", "E", "E", "D", "H", "I", "I", "H")
values <- c(1, 22, 5, 5, 5, 10, 10, 10)
nodes <- data.frame(name = unique(c(source, target)))
links <- data.frame(source = match(source, nodes$name) - 1,
                    target = match(target, nodes$name) - 1,
                    value = values)
sankeyNetwork(Links = links, Nodes = nodes, Source = "source", 
              Target = "target", Value = "value", NodeID = "name", 
              units = "unitX", fontSize = 12, nodeWidth = 20)
```

---

[EDIT]我已经更新了我的代码，如下所示，based on this previous SO question.但是，它仍然呈现“ small”，没有明显变化：（

---
title: "Data Analysis"
date: "2019-01-01T18:00:00-09:00"
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
library(tidyverse)
library(blogdown)
library(networkD3)
```

Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt ut labore et dolore magna aliqua. Ut enim ad minim veniam, quis nostrud exercitation ullamco laboris nisi ut aliquip ex ea commodo consequat. Duis aute irure dolor in reprehenderit in voluptate velit esse cillum dolore eu fugiat nulla pariatur. Excepteur sint occaecat cupidatat non proident, sunt in culpa qui officia deserunt mollit anim id est laborum.

```{r sankey, echo=FALSE, error=FALSE, message=FALSE, warning=FALSE}
source <- c("A", "A", "B", "C", "D", "D", "E", "E")
target <- c("D", "E", "E", "D", "H", "I", "I", "H")
values <- c(1, 22, 5, 5, 5, 10, 10, 10)
nodes <- data.frame(name = unique(c(source, target)))
links <- data.frame(source = match(source, nodes$name) - 1,
                    target = match(target, nodes$name) - 1,
                    value = values)

sn <- sankeyNetwork(Links = links, Nodes = nodes, Source = "source", 
                    Target = "target", Value = "value", NodeID = "name", 
                    units = "unitX", fontSize = 12, nodeWidth = 20)

htmlwidgets::onRender(sn, 'document.getElementsByTagName("svg")[0].setAttribute("viewBox", "")')

# also tried this to no avail
# htmlwidgets::onRender(sn, 'document.getElementById().getElementsByTagName("svg")[0].setAttribute()')            
```

Answer 1

根据Github issue中的讨论，解决方案似乎是在htmlwidgets::onRender命令中设置sankey图的适当索引号。

因此，如果sankey图是页面上的第一个SVG，则命令应为：

htmlwidgets::onRender(sn, 'document.getElementsByTagName("svg")[0].setAttribute("viewBox", "")')

如果sankey图是页面上的第二个SVG，则命令应为：

htmlwidgets::onRender(sn, 'document.getElementsByTagName("svg")[1].setAttribute("viewBox", "")')

等等

Answer 2

以CJ Yetman's answer为基础，这是一个对我有用的黑客程序，它可以获取多个Sankey图以在Firefox中正确呈现。

将此代码放在您的Rmd中：

htmlwidgets::onStaticRenderComplete('$.each( document.getElementsByTagName("svg"), function( index, value ){value.setAttribute("viewBox", null);});')

渲染完所有sankey后，它将循环播放，并将svg对象的所有viewBox属性设置为null，以便所有sankey都填充其边界框。