I am trying to have produce a shiny application in which a Sankey plot, produced using NetworkD3, dynamically produces x-node labels. I think this requires passing a reactive element to onRender, but I am not sure how to do this.
I see an answer here: How to add columnn titles in a Sankey chart networkD3, but this solves the dynamic naming by calling .text("Step " + (i + 1)); in the onRender function. My labels are not so generic that I can just iterate and paste (the example below uses simplified names).
Here is an example:
library('shiny')
library('tidyverse')
library('networkD3')
library(shinyWidgets)
library(htmlwidgets)
#Create the data
df <- data.frame('A' = c('a', 'b', 'b', 'c', 'a'),
'B' = c('1', '1', '1', '2', '3'),
'C' = c('red', 'blue', 'blue', 'green', 'green'))
#Create the UI
ui <- fluidPage(
#Sidebar to select x-nodes
sidebarLayout(
sidebarPanel(
pickerInput(inputId = 'var_select',
label = 'Variables',
choices = colnames(df),
selected = colnames(df),
multiple = TRUE,
pickerOptions(actionsBox = TRUE))
),
#Mainpanel to show sankey plot
mainPanel(
sankeyNetworkOutput('plot',
height = '800px')
)
)
)
#Create the server
server <- function(input, session, output) {
#create a reactive function that outputs the selected variables
df_sankey <- reactive({
df %>%
select(input$var_select)
})
#Prepare for plotting in NetworkD3
links1 <- reactive({
df_sankey() %>%
mutate(row = row_number()) %>% # add a row id
pivot_longer(-row, names_to = "col", values_to = "source") %>% # gather all columns
mutate(col = match(col, names(df_sankey()))) %>% # convert col names to col ids
mutate(source = paste0(source, '_', col)) %>% # add col id to node names
group_by(row) %>%
mutate(target = lead(source, order_by = col)) %>% # get target from following node in row
ungroup() %>%
filter(!is.na(target)) %>% # remove links from last column in original data
group_by(source, target) %>%
summarise(value = n(), .groups = "drop") # aggregate and count similar links
})
#Now create the nodes
nodes <- reactive({
data.frame(id = unique(c(links1()$source, links1()$target)),
stringsAsFactors = F) %>%
mutate(name = sub('_[0-9]*$', '', id))
})
#Mutate a soutrce id variable - have to create this as links2 to prevent endless recursion
links2 <- reactive({
mutate(links1(), source_id = match(links1()$source, nodes()$id) - 1)
})
#Do the same for target id
links <- reactive({
mutate(links2(), target_id = match(links2()$target, nodes()$id) - 1) %>%
data.frame()
})
#Build the sankey plot
plot1 <- reactive({
sankeyNetwork(Links = links(), Nodes = nodes(),
Source = 'source_id', Target = 'target_id', Value = 'value', NodeID = 'name',
fontSize = 14)
})
#Here is the problematic code
#under code starting var labels - i need that to be produced by a reactive element: colnames(df_sankey())
#Without this it just take the number of var labels as there are selected variables
output$plot <- renderSankeyNetwork({
onRender(plot1(), '
function(el) {
var cols_x = this.sankey.nodes().map(d => d.x).filter((v, i, a) => a.indexOf(v) === i).sort(function(a, b){return a - b});
var labels = ["A", "B", "C"];
cols_x.forEach((d, i) => {
d3.select(el).select("svg")
.append("text")
.attr("x", d)
.attr("y", 12)
.text(labels[i]);
})
}
')
})
}
#call the application
shinyApp(ui, server)
I call out the problem in the comments above the onRender function. Effectively I need var labels to take a reactive function generated by something like: colnames(df_sankey()). If i put that code in for var labels (which i appreciate is a wild guess), it just fails. Without the reactive function the code just loops through the var labels according to the number of variables selected. You can see the problem if you select var A and C - C gets labelled B. I also tried (another guess):
output$plot <- renderSankeyNetwork({
onRender(plot1(), '
function(el, node_labels) {
var cols_x = this.sankey.nodes().map(d => d.x).filter((v, i, a) => a.indexOf(v) === i).sort(function(a, b){return a - b});
var labels = [node_labels];
cols_x.forEach((d, i) => {
d3.select(el).select("svg")
.append("text")
.attr("x", d)
.attr("y", 12)
.text(labels[i]);
})
}
', node_labels = colnames(df_sankey()))
But that also fails. I can't seem to find an explanation for how to pass reactive functions to onRender.
How can I pass a reactive function to the onRender function so that i can dynamically name my x-nodes?
