使用闪亮的clickAction将networkD3中的节点链接到网站

时间:2017-03-28 09:09:49

标签: javascript r shiny rstudio networkd3

有没有办法在r中的networkD3包中使用函数forceNetwork()将节点用作外部网站的链接但是并入闪亮的应用程序?

我找到了这个答案here

但是当我尝试将其作为一个闪亮的应用程序运行时,它不起作用。 这是我的代码:

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)

期望的结果:当您点击某个节点时,在已发布的闪亮应用中 根据所点击的节点,您将在浏览器中打开一个新窗口到特定网页!

1 个答案:

答案 0 :(得分:1)

  1. 您在第10行[Category]Art之前错过了引用
  2. 您在第44行传递zoom=t而不是zoom=T
  3. Myclickaction = "window.open(d.name, '_blank')"应该是第33行Myclickaction = "window.open(d.hyperlink, '_blank')"
  4. 在第38行,将forceNetwork的输出保存到对象,以便稍后修改,例如fn <- forceNetwork(Links = MisLinks, Nodes = MisNodes,
  5. forceNetwork电话后(第45行),添加fn$x$nodes$hyperlink <- hyperlink,然后在下一行添加fn
  6. 问题是在forceNetwork函数运行后需要添加超链接,因为这个技巧不受官方支持,节点对象中的超链接将被forceNetwork函数删除。 / p>

    所以带有所述更改的完整代码加上一些格式修复看起来像......

    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)
    

    此外,您必须在浏览器中打开闪亮的应用程序,因为在单独的RStudio查看器窗口中打开链接似乎无法正常工作。