2

我正在构建一个绘制网络的闪亮应用程序。用户可以选择一个节点，单击一个切换按钮以显示该节点的自我网络，然后单击相同的按钮返回主网络。我试图让一个工具提示将鼠标悬停在按钮上，其文本会根据按钮本身的状态以及是否选择节点而发生变化。问题是工具提示仅在条件更改时才显示。

可重现的代码：

用户界面：

# libraries
library(shiny)
library(shinyBS)
library(igraph)
library(visNetwork)

# UI
shinyUI(
  fluidPage(
    visNetworkOutput("NetPlot",width="auto",height=600),
    bsButton("Ego",label=textOutput("EgoText"),type="toggle",disabled=TRUE)
  )
)

服务器：（抱歉，代码冗长 - 不太确定我哪里出错了，我想提供足够的上下文）

# libraries
library(shiny)
library(shinyBS)
library(igraph)
library(visNetwork)

# create data
nodes <- data.frame(id=c("10","11","12","13","14"))
edges <- data.frame(rbind(c("10","12"),c("10","14"),c("11","12"),c("13","14"),c("14","12")))
colnames(edges) <- c("from","to")

shinyServer(function(input,output,session) {

  # Activate Ego Network button when a node is selected
  observeEvent(input$NetPlot_selected, {
    if (input$NetPlot_selected=="") disabled = TRUE 
    else disabled = FALSE
    updateButton(session,"Ego", disabled=disabled)
  }, priority=1)

  # Set Ego Button text
  # "Full Network" when TRUE, "Ego Network" when FALSE
  output$EgoText <- renderText({
    ifelse ((input$Ego), as.character("Full Network"), as.character("Ego Network"))
  })

  # Set tooltip text
  # Works intermittently
  observeEvent({
    input$Ego
    input$NetPlot_selected},
    {
      # No node is selected yet
      if (is.null(input$NetPlot_selected) || input$NetPlot_selected=="")
      {hovtx <- as.character("Select a node to extract ego network")} 
     # Node is selected
      else if (!input$Ego && input$NetPlot_selected!="")
      {hovtx <- as.character("Click to go to ego network")} 
     # Ego network is displayed
      else if (!(is.null(input$Ego)) && input$Ego)
      {hovtx <- as.character("Click to return to full network")}
      addTooltip(session,"Ego",hovtx,"right",trigger="hover", options=list(container="body"))
      },priority=2)

  # Create ego network dataframe when toggle button is on
  EgoNet <- reactive({
    req(input$Ego)
    # Convert main network to igraph
    ego1 <- graph_from_data_frame(edges, directed=FALSE, nodes)
    # Get ego network of the selected node
    ego2 <- make_ego_graph(ego1, nodes=input$NetPlot_selected)[[1]]
    # Convert back to visNetwork
    ego3 <- toVisNetworkData(ego2)
    ego3
  })

  # Plot the network
  output$NetPlot <- renderVisNetwork({
    if (input$Ego){ # Ego network is requested
      visNetwork(EgoNet()$nodes, EgoNet()$edges) %>%
        visIgraphLayout(physics=FALSE, type="full", layout="layout_with_kk")
    } else
    { # Ego network not requested
      visNetwork(nodes,edges) %>%
        visOptions(nodesIdSelection=TRUE,
                   highlightNearest=list(
                     enabled=TRUE, labelOnly=FALSE)
        ) %>%
        visIgraphLayout(physics=FALSE, type="full", layout="layout_with_kk")
    }
  })
})

当应用程序首次加载时，如果我在执行任何其他操作之前将鼠标悬停在按钮上，工具提示就会起作用。单击一个节点，工具提示不再起作用。单击该按钮，工具提示将再次起作用。再次单击按钮，工具提示有效。如果在重新开始时，我没有将鼠标悬停在按钮上，而是先单击一个节点，则工具提示适用于该条件，但在单击按钮后无效。设置这两个部分的优先级observeEvent有助于在返回完整网络时保持工具提示的功能，所以我想知道第一个是否会干扰第二个，但我不确定还能做什么。

我确实尝试了renderText与按钮标签一起使用的方法，但bsTooltip在 UI 中没有响应响应式文本，这就是我addTooltip在服务器端使用的原因。

编辑

大约一个月后，我回到了这个尝试另一种方法。

如果我更新 ui 以uiOutput("EgoTip")在最后添加，然后转到服务器并将第二个替换observeEvent为以下内容：

  output$EgoTip <- renderUI({ 
    if (is.null(input$NetPlot_selected) || input$NetPlot_selected=="")
    {bsTooltip("Ego", "Select a node to extract ego network", "right",
               options=list(container="body"))} 
    else if (!input$Ego && input$NetPlot_selected!="")
    {bsTooltip("Ego", "Click to go to ego network", "right", 
               options=list(container="body"))}
    else if (!(is.null(input$Ego)) && input$Ego)
    {bsTooltip("Ego", "Click to return to full network", "right", 
               options=list(container="body"))}
  })

我得到完全相同的行为。这排除了这是两个observeEvent块相互干扰和/或在 中具有两个输入的问题observeEvent。if else if我使用相同的逻辑将文本发送到全局环境中的对象，对逻辑进行了四次检查，并且全部检查出来。它一定是循环浏览工具提示的东西，这是我没有想法的地方。

4

0 回答 0