Is there a way to use a node as a link to an external website using the function forceNetwork() in the networkD3 package in r but incorporated into shiny app?
I've found this answer here
but it's not working when I am trying to run it as an shiny app. Here is my code:
library(shiny)
library(networkD3)
source =c(0,0,3,3,3,7,7,10,9,7,1,6,4,5,8,2)
target = c(1,2,4,5,6,8,9,11,12,10,9,10,8,9,11,8)
value = c(10,10,10,10,10,10,10,20,20,10,2,2,2,10,20,15)
MisLinks = data.frame(source,target,value)
name = c("[Category]Genre", "CCG", "Action", [Category]Art","Realistic Art", "Dark Art", "Cartoony", "[Category]Time demend", "Mid-Core", "Hard-Core", "Casual", "Install", "Not Install")
group = c(1,2,2,3,4,4,4,5,6,6,6,8,8)
size = c(50,20,20,50,20,20,20,50,20,20,20,250,250)
hyperlink = c("http://google.com", "http://yahoo.com", "http://google.com", "http://yahoo.com", "http://google.com", "http://yahoo.com", "http://google.com", "http://yahoo.com", "http://google.com", "http://yahoo.com", "http://google.com", "http://yahoo.com", "http://yahoo.com")
MisNodes = data.frame(name, group, size, hyperlink)
ui = fluidPage(
titlePanel("Testing app"),
sidebarLayout(
sidebarPanel(
sliderInput("opacity", "Test", 0.6, min = 0.1, max = 1, step = .1)
),
mainPanel(
tabsetPanel(
tabPanel("Force Network", forceNetworkOutput("force"))
)
)
)
)
Myclickaction = "window.open(d.name, '_blank')"
server = function(input,output) {
output$force = renderForceNetwork({
forceNetwork(Links = MisLinks, Nodes = MisNodes,
Source = "source", Target = "target", charge = -150,
legend = TRUE, opacityNoHover = 1, Nodesize = "size",
Value = "value", NodeID = "name",
Group = "group", linkWidth = 2, clickAction = Myclickaction,
opacity = 0.9, colourScale =JS("d3.scaleOrdinal(d3.schemeCategory20);"),
zoom=t)
})
}
shinyApp(ui = ui, server = server)
Desired outcome: When you click on a node, in a published shiny app you get a new window open in browser to the specific web page depending on the node clicked!
[Category]Art
on line 10zoom=t
instead of zoom=T
on line 44Myclickaction = "window.open(d.name, '_blank')"
should be Myclickaction = "window.open(d.hyperlink, '_blank')"
on line 33forceNetwork
to an object so that you can modify it later, like fn <- forceNetwork(Links = MisLinks, Nodes = MisNodes,
forceNetwork
call (line 45), add fn$x$nodes$hyperlink <- hyperlink
and then on the next line add fn
The problem is that the hyperlinks need to be added after the forceNetwork
function is run because this trick is not officially supported and the hyperlinks in your node object will be dropped by the forceNetwork
function.
So the full code with the stated changes plus some formatting fixes looks like...
library(shiny)
library(networkD3)
source =c(0,0,3,3,3,7,7,10,9,7,1,6,4,5,8,2)
target = c(1,2,4,5,6,8,9,11,12,10,9,10,8,9,11,8)
value = c(10,10,10,10,10,10,10,20,20,10,2,2,2,10,20,15)
MisLinks = data.frame(source,target,value)
name = c("[Category]Genre", "CCG", "Action", "[Category]Art","Realistic Art", "Dark Art", "Cartoony", "[Category]Time demend", "Mid-Core", "Hard-Core", "Casual", "Install", "Not Install")
group = c(1,2,2,3,4,4,4,5,6,6,6,8,8)
size = c(50,20,20,50,20,20,20,50,20,20,20,250,250)
hyperlink = c("http://google.com", "http://yahoo.com", "http://google.com", "http://yahoo.com", "http://google.com", "http://yahoo.com", "http://google.com", "http://yahoo.com", "http://google.com", "http://yahoo.com", "http://google.com", "http://yahoo.com", "http://yahoo.com")
MisNodes = data.frame(name, group, size, hyperlink)
ui = fluidPage(
titlePanel("Testing app"),
sidebarLayout(
sidebarPanel(
sliderInput("opacity", "Test", 0.6, min = 0.1, max = 1, step = .1)
),
mainPanel(
tabsetPanel(
tabPanel("Force Network", forceNetworkOutput("force"))
)
)
)
)
Myclickaction = "window.open(d.hyperlink, '_blank')"
server = function(input,output) {
output$force = renderForceNetwork({
fn <- forceNetwork(Links = MisLinks, Nodes = MisNodes,
Source = "source", Target = "target", charge = -150,
legend = TRUE, opacityNoHover = 1, Nodesize = "size",
Value = "value", NodeID = "name",
Group = "group", linkWidth = 2, clickAction = Myclickaction,
opacity = 0.9, colourScale =JS("d3.scaleOrdinal(d3.schemeCategory20);"),
zoom=TRUE)
fn$x$nodes$hyperlink <- hyperlink
fn
})
}
shinyApp(ui = ui, server = server)
Also, you will have to open the shiny app in a browser, because opening the links in a separate RStudio viewer window doesn't seem to work.