R visNetwork siny：单击1次即可更改边缘的常规颜色和突出显示颜色

问题描述

我有一个交互式网络，我喜欢从运行的闪亮会话更改边缘（和节点）的颜色。理想情况下，此更改符合当前选择状态（未选择的变灰边缘保持变灰）。为了测试此功能，我添加了一个按钮来触发颜色更改。

当我用代码更新网络时，它几乎可以正常工作。在更新网络对象时，仅在通过鼠标单击选择节点并再次取消选择该节点后，边缘的颜色更改才可见。（所选部分从视觉更新中排除，因此我们需要单击第二个节点，然后再次取消选择它）。显然，我希望避免手动选择和取消选择节点的额外步骤，而通过单击按钮直接更改颜色。

对于节点，颜色更改可以通过visNetworkProxy("network") %>% visGroups(...)直接进行。对于边缘，我尝试使用visNetworkProxy("network") %>% visEdges(color=list(color=...,highlight=...)（后来也使用visUpdateEdges()或visSetoptions()）。

添加visRedraw()的尝试也未成功。

然后，我想如果手动选择技巧可行，那么我可以-拼凑解决-复制此代码，并通过代码（或visUnselectAll后跟visSelectEdges）翻转选择两次。我只能想到一种两步方法来获得所选边缘的边缘ID。我添加了一个反应性值来触发第二次访问网络（第一次：将ID重新添加到输入中，然后第二次可用。）如果有更简单的方法来获取这些ID，我就耳朵。

尽管如此，这也不起作用。每只鼠标单击和选择功能似乎并不相同。（我在RStudio的查看器和Firefox中测试了代码）

再次，要明确我的目标：在我的代码示例中，我想单击按钮，然后将正方形的颜色从蓝色更改为绿色（有效），将边缘颜色从dodgerblue更改为（酒红色）变黑（chartreuse）（这是无法正常工作的。）

有人可以帮忙吗？预先感谢您的帮助！

library(shiny)
library(visNetwork)

nodes <- tibble::tibble(
    id = c(592,981,859,820,635,932,827,860,848,878,208,609),label = paste0("node_",1:12),group = rep(c("A","B"),times=c(4,8)))

edges <- tibble::tibble(
    from = c(592,592,820),to = c(635,gr1 = c("node1","node1","node2","node3","node4","node4"),gr2 = c("N_101","N_101","N_102","N_103","N_104","N_105","N_106","N_107","N_108"),value = c(1,3,1,2,3),id = 1:14
)

ui <- fluidPage(
    column(4,actionButton("updateNetwork","change color in network"),verbatimtextoutput("slider")
    ),column(8,visNetworkOutput("network")
    )
)

server <- function(input,output,session) {
    ReactVal <- reactiveValues(updateFlag=F)
    output$network <- renderVisNetwork({
        visNetwork(nodes,edges) %>%
            visInteraction(hover = TRUE) %>%
            visOptions(highlightNearest = list(enabled = TRUE,degree = list(from = 1,to = 1),algorithm = "hierarchical")) %>%
            visEdges(arrows = list(to = FALSE,from = FALSE)) %>%
            visIgraphLayout(layout = "layout_nicely") %>%
            visGroups(
                groupname = "A",color = list(
                    background = "#0085AF",border = "#013848",highlight = "#FF8000"),shape = "square") %>% 
            visGroups(groupname = "B",color = list(
                          background = "#FF0000",border = "#5b3a29",highlight = "#5e2028"),shape = "triangle") %>%
            visEdges(
                color = list(color = "dodgerblue",highlight = "#C62F4B")
            )
    })
    observeEvent(input$updateNetwork,{
        ReactVal$updateFlag <- !ReactVal$updateFlag
        visNetworkProxy("network") %>% 
            visGroups(
                groupname = "A",color = list(
                    background = 'forestgreen',highlight = 'cyan')) %>%
            visEdges(
                color = list(color = '#000000',highlight = 'chartreuse')) %>%
            visGetSelectedEdges() %>%
            visGetEdges()
    })
    observe({
        triggerMe <- ReactVal$updateFlag
        if (!is.null(input$network_edges)) {
            selectedEdgeIds <- input$network_selection$edges
            EdgeIds <- names(input$network_edges)
            inverseSelection  <- EdgeIds[!(EdgeIds %in% selectedEdgeIds)]
            visNetworkProxy("network") %>%
                visSetoptions(
                    options=list(
                        edges=list(
                            color=list(
                                color="#000000",highlight = 'chartreuse')))) %>%
                visSelectEdges(id=inverseSelection) %>%
                visRedraw()
        }
    })

}

shinyApp(ui,server)

解决方法

暂无找到可以解决该程序问题的有效方法，小编努力寻找整理中！

如果你已经找到好的解决方法，欢迎将解决方案带上本链接一起发送给小编。

小编邮箱:dio#foxmail.com (将#修改为@）

r r shiny visnetwork