r-将网络d3中的节点上的点击率链接到本地HTML文件

Question

嗨，我正在尝试在r。

我被clickaction陷入困境。ClickAction的目的是打开一个新窗口，以显示本地HTML文件的内容。但是现在，可以添加一个网站URL，例如http://www.google.com。但是我被打开本地HTML文件所困扰。

当我添加本地HTML文件的方向时，它不起作用并显示"找不到"。

我试图将所有HTML文件放在www文件中。但这行不起作用。

我想知道是否有任何方法可以在ClickAction中显示本地HTML文件？谢谢！

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("file:///C:/user/docname.html", "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)

Answer 1

在运行shinyApp之前，使用addResourcePath函数分配闪亮的访问目录，例如addResourcePath('sub_dir', 'www')

然后确保您的超链接到本地文件适合于此，例如hyperlink = c("sub_dir/docname.html", "http://yahoo.com")

并确保要链接到的文件位于您使用addResourcePath的第二个参数指定的目录中(您可以相对于R中的当前工作目录指定目录，或使用有效的绝对路径指定目录(

所以看起来像...

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("sub_dir/docname.html", "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
  })
}
addResourcePath('sub_dir', 'www')
shinyApp(ui = ui, server = server)