Tiny plot output from sankeyNetwork (NetworkD3) in Firefox
This seems to be the result of Firefox reacting to the viewbox
svg property differently than other browsers. It might be worthwhile to submit this as an issue here https://github.com/christophergandrud/networkD3/issues
In the meantime, you could work around this by resetting the viewbox
attribute using some JavaScript and htmlwidgets::onRender()
. Here's an example using a minimized version of your example. (Resetting the viewbox
attribute may have other consequences)
library(htmlwidgets)
library(networkD3)
library(magrittr)
nodes = data.frame("name" = factor(as.character(1:9)),
"group" = as.character(c(1,2,2,3,3,4,4,4,4)))
links = as.data.frame(matrix(byrow = T, ncol = 3, c(
0, 1, 1400,
0, 2, 18600,
1, 3, 400,
1, 4, 1000,
3, 5, 100,
3, 6, 40,
3, 7, 20,
3, 8, 4
)))
names(links) = c("source","target","value")
sn <- sankeyNetwork(Links = links, Nodes = nodes, Source = "source",
Target = "target", Value = "value", NodeID = "name",
NodeGroup = "group", fontSize = 12, sinksRight = FALSE)
htmlwidgets::onRender(sn, 'document.getElementsByTagName("svg")[0].setAttribute("viewBox", "")')
UPDATE (2019.10.26)
This is probably a safer implementation of removing the viewBox...
htmlwidgets::onRender(sn, 'function(el) { el.getElementsByTagName("svg")[0].removeAttribute("viewBox") }')
UPDATE 2020.04.02
My currently preferred method to do this is to use htmlwidgets::onRender
to target specifically the SVG contained by the passed htmlwidget, like this...
onRender(sn, 'function(el) { el.querySelector("svg").removeAttribute("viewBox") }')
That can then be done specifically to as many htmlwidgets
on your page as necessary, for instance...
onRender(sn, 'function(el) { el.querySelector("svg").removeAttribute("viewBox") }')
onRender(sn2, 'function(el) { el.querySelector("svg").removeAttribute("viewBox") }')
controlling plot size in Firefox when knitting a markdown with multiple sankeyNetwork (NetworkD3)
1) Only use the htmlwidgets::onRender()
function once, otherwise it's less clear when the JavaScript will run and what other elements will or will not exist when they run.
2) In the htmlwidgets::onRender()
function (ideally run when the last sankeyNetwork is rendered) remove the viewbox from each of the rendered sankeyNetworks.
3) In order to run multiple JavaScript commands using the htmlwidgets::onRender()
function, wrap all of the commands in a (JavaScript) function
---
title: "test"
author: "CS"
date: "02/08/2018"
output:
html_document: default
pdf_document: default
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
```
```{r}
library(htmlwidgets)
library(networkD3)
library(magrittr)
nodes = data.frame("name" = factor(as.character(1:9)),
"group" = as.character(c(1,2,2,3,3,4,4,4,4)))
links = as.data.frame(matrix(byrow = T, ncol = 3, c(
0, 1, 1400,
0, 2, 18600,
1, 3, 400,
1, 4, 1000,
3, 5, 100,
3, 6, 40,
3, 7, 20,
3, 8, 4
)))
names(links) = c("source","target","value")
links
```
this chart works fine in firefox:
```{r}
sn1 <- sankeyNetwork(Links = links, Nodes = nodes, Source = "source",
Target = "target", Value = "value", NodeID = "name",
NodeGroup = "group", fontSize = 12)
sn1
```
but this one doesn't display at all when knitted:
```{r}
sn2 <- sankeyNetwork(Links = links, Nodes = nodes, Source = "source",
Target = "target", Value = "value", NodeID = "name",
NodeGroup = "group", fontSize = 12, sinksRight = FALSE)
sn2
```
and neither does this one:
```{r}
sn3 <- sankeyNetwork(Links = links, Nodes = nodes, Source = "source",
Target = "target", Value = "value", NodeID = "name",
NodeGroup = "group", fontSize = 12, sinksRight = FALSE)
htmlwidgets::onRender(sn3, jsCode =
'function(){
document.getElementsByTagName("svg")[0].setAttribute("viewBox", "");
document.getElementsByTagName("svg")[1].setAttribute("viewBox", "");
document.getElementsByTagName("svg")[2].setAttribute("viewBox", "");
}')
```
UPDATE 2020.04.02
My currently preferred method to do this is to use htmlwidgets::onRender
to target specifically the SVG contained by the passed htmlwidget, like this...
onRender(sn, 'function(el) { el.querySelector("svg").removeAttribute("viewBox") }')
That can then be done specifically to as many htmlwidgets
on your page as necessary, for instance...
onRender(sn, 'function(el) { el.querySelector("svg").removeAttribute("viewBox") }')
onRender(sn2, 'function(el) { el.querySelector("svg").removeAttribute("viewBox") }')
plot from sankeyNetwork in networkD3 does not show output neither generates any warning/error in R
You refer to 15 unique nodes in your links2
data frame, but you only have 14 unique nodes in your nodes
data frame.
length(unique(c(links2$source, links2$target)))
# [1] 15
length(nodes$area)
# [1] 14
If you add another node, it will work...
library(networkD3)
nodes <- data.frame(area = c("a", "b", "c", "d", "e", "f", "g",
"h", "i", "j", "k", "l", "m", "n", "o"))
links2 <- data.frame(source = c(1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4,
5, 5, 5, 5, 6, 6, 6, 6, 7, 7, 7, 7, 7, 7, 8, 8, 8, 9, 9, 9, 9, 10, 10, 11, 11, 11, 12, 13, 13),
target = c(2, 8, 10, 11, 13, 0, 4, 5, 6, 7, 10, 11, 13, 0, 4, 9, 10, 12, 13, 0, 5, 6, 7, 10, 11, 13, 7, 10, 12,
0, 10, 11, 12, 13, 8, 9, 10, 11, 12, 13, 9, 10, 13, 10, 12, 13, 0, 11, 12, 13, 0, 14, 0, 0),
value = c(14, 4, 6, 23, 3, 6, 36, 3, 4, 4, 3, 12, 3, 24, 3, 6, 19, 3, 9, 3, 6, 3, 11, 9, 3, 22, 3, 3, 10, 3, 4,
3, 3, 9, 12, 5, 16, 13, 3, 10, 3, 4, 9, 7, 4, 4, 77, 4, 6, 6, 27, 3, 3, 3))
sankeyNetwork(Links = links2, Nodes = nodes,
Source = "source", Target = "target",
Value = "value", NodeID = "area",
fontSize= 12, nodeWidth = 30)
Sankey Network (within R blogdown) won't render properly on Firefox
Based on the discussion in the Github issue, it seems the solution was to set the proper index number of the sankey plot in the htmlwidgets::onRender
command.
So if the sankey plot is the first SVG on the page, the command should be:
htmlwidgets::onRender(sn, 'document.getElementsByTagName("svg")[0].setAttribute("viewBox", "")')
If the sankey plot is the second SVG on the page, the command should be:
htmlwidgets::onRender(sn, 'document.getElementsByTagName("svg")[1].setAttribute("viewBox", "")')
and so forth
UPDATE 2020.04.02
My currently preferred method to do this is to use htmlwidgets::onRender
to target specifically the SVG contained by the passed htmlwidget, like this...
onRender(sn, 'function(el) { el.querySelector("svg").removeAttribute("viewBox") }')
That can then be done specifically to as many htmlwidgets
on your page as necessary, for instance...
onRender(sn, 'function(el) { el.querySelector("svg").removeAttribute("viewBox") }')
onRender(sn2, 'function(el) { el.querySelector("svg").removeAttribute("viewBox") }')
modalDialog doesn`t appear if sankeyNetwork (networkD3) is used
This issue has been resolved with the dev version of shiny
and should be released on CRAN soon as shiny v1.3.3
.
Multi-layer SankeyNetwork (NetworkD3) does not plot in R
I believe the answer should be in the cross-posted Github issue https://github.com/christophergandrud/networkD3/issues/134. I will copy and paste the code here also. unique
is in the wrong place and needs to run after the concatenate of source and target.
library(networkD3)
library(dplyr)
# The function used to create the plots
sanktify <- function(x) {
# Create nodes DF with the unique sources & targets from input
# ***** changing this is the key***********************************************************
nodes <- data.frame(unique(c(x$source,x$target)),stringsAsFactors=FALSE)
# ************************************************************************************************
nodes$ID <- as.numeric(rownames(nodes)) - 1 # sankeyNetwork requires IDs to be zero-indexed
names(nodes) <- c("name", "ID")
# use dplyr join over merge since much better; in this case not big enough to matter
# Replace source & target in links DF with IDs
links <- inner_join(x, nodes, by = c("source"="name")) %>%
rename(source_ID = ID) %>%
inner_join(nodes, by = c("target"="name")) %>%
rename(target_ID = ID)
# Create Sankey Plot
sank <- sankeyNetwork(
Links = links,
Nodes = nodes,
Source = "source_ID",
Target = "target_ID",
Value = "value",
NodeID = "name",
units = "USD",
fontSize = 12,
nodeWidth = 30
)
return(sank)
}
# use data_frame to avoid tbl_df(data.frame(
z1 <- data_frame(
source = c("A", "A", "B", "B"),
target = c("Cardiovascular", "Neurological", "Cardiovascular", "Neurological"),
value = c(5, 8, 2, 10)
)
z2 <- data_frame(
source = c("Cardiovascular", "Cardiovascular", "Neurological", "Neurological"),
target = c("IP Surg", "IP Med", "IP Surg", "IP Med"),
value = c(3, 7, 6, 1)
)
z3 <- bind_rows(z1,z2)
sanktify(z3)
sankeyNetwork through renderUI disappears when applying JScode to remove viewbox with htmlwidgets::onRender()
Try using this...
htmlwidgets::onRender('function(el) { el.getElementsByTagName("svg")[0].removeAttribute("viewBox") }')
Technically, the JS you pass to htmlwidgets::onRender
"must be a valid JavaScript expression that returns a function" according to its documentation (though the JS code runs either way, so you see the effect), and that seems to trigger the "Duplicate binding for ID diagram" error from Shiny which seems to be what causes the disappearing plots. You can demonstrate the same error/problem with htmlwidgets::onRender('console.log("test")')
I also changed it to only get elements within the widget’s node so that it's more likely to get the proper SVG (e.g. if you have more than one SVG on the page), and I used removeAttribute("viewBox")
instead of setAttribute("viewBox", "")
, which seems a bit more direct of an approach.
UPDATE 2020.04.02
and/or use querySelector
to avoid needing to use [0]
to select the first element in the list (which seems to cause a bunch of confusion)...
htmlwidgets::onRender('function(el) { el.querySelector("svg").removeAttribute("viewBox") }')
also not that the above syntax is possible because the htmlwidget
is the output of the previous command in the dplyr
chain, but usually one would need to specify the htmlwidgets
object as the first argument, for instance...
sn <- sankeyNetwork(Links = links, Nodes = nodes, Source = "source",
Target = "target", Value = "value", NodeID = "name",
NodeGroup = "group", fontSize = 12, sinksRight = FALSE)
htmlwidgets::onRender(sn, 'function(el) { el.querySelector("svg").removeAttribute("viewBox") }')
Related Topics
How to Convert a Hex String to Text in R
Prevent Knitr/Rmarkdown from Interleaving Chunk Output with Code
Running an R Script Using a Windows Shortcut
How to Make Shinyapp to Use Environmental Variables When Deployed on the Web
Rmarkdown Table with Cells That Have Two Values
Extract Time (Hms) from Lubridate Date Time Object
Combine Result from Top_N with an "Other" Category in Dplyr
Incorrect Number of Subscripts on Matrix in R
Finding Unique Combinations Irrespective of Position
How to Write Data from R to Postgresql Tables with an Autoincrementing Primary Key
Expanding Factor Interactions Within a Formula
How to Control the Canvas Size in Ggplot
Data.Table Join and J-Expression Unexpected Behavior
Error: X Must Be Atomic for 'Sort.List'
Get(X) Does Not Work in R Data.Table When X Is Also a Column in the Data Table
R - How to One Hot Encoding a Single Column While Keep Other Columns Still