R shiny 中的 networkD3 在 Chrome、Firefox 中无法正确显示,但在 Safari 中可以吗?
networkD3 in R shiny not displaying properly in Chrome, Firefox, but does in 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 现在接受包含散列的节点颜色和边缘颜色。
这是应用程序代码:
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 现在接受包含散列的节点颜色和边缘颜色。