R Shiny 中的 networkD3 在 Chrome、Firefox 中无法正确显示，但在 Safari 中可以正常显示吗？

问题描述

这是应用程序代码：

require(shiny)
require(shinydashboard)
require(igraph)
require(networkD3)

ui = dashboardPage(
  dashboardHeader(title = "Test App"),dashboardSidebar(sidebarMenu(id = "tab",style = "position:fixed;",menuItem("Networks",tabName = "nets",icon=icon("project-diagram"))
  )),dashboardBody(
    tags$script(HTML("$('body').addClass('fixed');")),tabItems(
      tabItem(tabName="nets",width=12,h2("Networks",align="center"),fluidRow(
                Box(width = 12,title = "Network display",status="info",solidHeader = TRUE,align="left",height="930px",collapsible=FALSE,div(radioButtons(inputId = "RangeChoice",label = "Choose range of nodes:",choices = c("Few","Some","All"),selected = "Few"),style="display:center-align"),forceNetworkOutput(outputId = "ptNetwork",height = "600px")) # Box Network display
              ) # fluidRow
      ) # tabItem nets
    ) # tabItems
  ) # dashboardBody
) # dashboardPage

server = function(input,output,session) {
  observeEvent(input$tab,{
    print(sprintf("%s tab is selected.",input$tab))
    if (input$tab == "nets") {
      # draw network
      output$ptNetwork=renderForceNetwork({
        x = matrix(rnorm(100*100),nrow=100,ncol=100)
        colnames(x) = 1:100
        ig = graph.adjacency(adjmatrix = x,mode="undirected",weighted=TRUE,add.colnames = list(attr="name"))
        mets=sample(V(ig)$name,10)
        zmets=sample(V(ig)$name,50)
        if ( input$RangeChoice == "Few"){
          e = delete.vertices(ig,v=V(ig)$name[-which(V(ig)$name %in% mets)])
          e = delete.vertices(e,V(e)[degree(e) == 0] )
        }else if(input$RangeChoice == "Some"){
          e = delete.vertices(ig,v=V(ig)$name[-which(V(ig)$name %in% zmets)])
          e = delete.vertices(e,V(e)[degree(e) == 0] )
        }else if(input$RangeChoice == "All"){
          e = ig
        }else{
          print("No Range Selected")
        }
        # assign groups and make ColourScale
        node_first = V(e)$name  %in% mets
        node_second = V(e)$name  %in% zmets
        node_both = node_first & node_second
        group=rep("Neither",length(V(e)$name))
        for (l in 1:length(V(e)$name)) {
          if (node_both[l]) { group[l] = "Both" } else if (node_first[l]) { group[l] = "First" } else if (node_second[l]) { group[l] = "Second" } else { group[l] = "Neither" }
        }
        names(group)=V(e)$name
        ColourScale <- 'd3.scaleOrdinal().domain(["First","Second","Both","Neither"]).range(["7554A3","96C93C","ECB602","#d3d3d3"]);'
        borderColor = rep("#d3d3d3",length(V(e)$name))
        #generate networkd3
        net_p=igraph_to_networkD3(e)
        net_p$nodes$group=sapply(as.character(net_p$nodes$name),function(x) group[x])
        net_p$nodes$nodesize=rep(1,length(net_p$nodes$name))
        linkColor_first=net_p$nodes$name[net_p$links$source+1] %in% mets & net_p$nodes$name[net_p$links$target+1] %in% mets
        linkColor_second=net_p$nodes$name[net_p$links$source+1] %in% zmets & net_p$nodes$name[net_p$links$target+1] %in% zmets
        linkColor_both = linkColor_first & linkColor_second
        linkColor = rep("lightgrey",length(linkColor_first))
        for (l in 1:length(linkColor)) {
          if (linkColor_both[l]) {
            linkColor[l] = "ECB602"
          } else if (linkColor_first[l]) {
            linkColor[l] = "7554A3"
          } else if (linkColor_second[l]) {
            linkColor[l] = "96C93C"
          } else {
            linkColor[l] = "lightgrey"
          }
        }
        net_p$links$color=linkColor
        
        ptNetwork=forceNetwork(Nodes = net_p$nodes,charge = -90,fontSize = 20,colourScale = JS(ColourScale),Links = net_p$links,linkColour = net_p$links$color,Nodesize = 'nodesize',Source = 'source',Target = 'target',NodeID = 'name',Group = 'group',Value = "value",zoom = T,opacity = 0.9,legend = T)
        ptNetwork
      })
    }  else {
      print("No tab selected")
    }
  })
}

shinyApp(ui,server)

这是推送到shinyapps.io的应用程序的URL： https://lrthistlethwaite.shinyapps.io/Test-App/

如果您在 Chrome 或 Firefox 中查看，节点颜色、边缘无法正确显示。在 Safari 中，一切都很完美。请参阅下图了解它应该是什么样子。请注意，如果您在 R 控制台本身中运行代码，则网络在 R 查看器窗格中正确绘制，因此它很可能是一个闪亮的 / Javascript 或 CSS 错误，而不是代码错误？

非常感谢任何帮助！

解决方法

该错误最终导致为 ColourScale 和 linkColor 指定的所有十六进制都需要在十六进制代码之前具有哈希值：

ColourScale <- 'd3.scaleOrdinal().domain(["First","Second","Both","Neither"]).range(["#7554A3","#96C93C","#ECB602","#d3d3d3"]);'

...
...
...

if (linkColor_both[l]) {
  linkColor[l] = "#ECB602"
} else if (linkColor_first[l]) {
  linkColor[l] = "#7554A3"
} else if (linkColor_second[l]) {
  linkColor[l] = "#96C93C"
} else {
  linkColor[l] = "lightgrey"
}

不确定为什么 Safari 接受没有散列的颜色，但 Chrome 和 Firefox 现在接受包含散列的节点颜色和边缘颜色。