addTooltip works intermittently with two inputs in

2019-07-17 14:37发布

问题:

I'm building a shiny app that draws a network. The user can select a node, click a toggle button to display the ego network of that node, then click the same button to go back to the main network. I'm trying to get a tooltip to hover over the button with text that changes depending on the state of the button itself and whether or not a node is selected. The problem is that the tooltip only displays every other time the conditions change.

Reproducible code:

ui:

# 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)
  )
)

server: (sorry for the lengthy code - not quite sure where I'm going wrong and I want to give enough context)

# 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")
    }
  })
})

When the app first loads, the tooltip works if I hover over the button before doing anything else. Click a node, the tooltip no longer works. Click the button, and the tooltip works again. Click the button again, tooltip works. If, when starting fresh, I don't hover over the button, but click a node first, then the tooltip works for that condition, but not after the button is clicked. Setting the priorities on the two observeEvent sections helped to keep the tooltip functional when returning to the full network, so I'm wondering if the first is interfering with the second, but I'm not sure what else to do.

I did try the renderText method that I used with the button label, but bsTooltip in the UI wasn't responsive to reactive text, which is why I went with addTooltip on the server side.

EDIT

I came back to this after about a month to try another method.

If I update the ui to tack on uiOutput("EgoTip") at the end, then go to the server and replace the second observeEvent with the following:

  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"))}
  })

I get the exact same behavior. This rules out this being a problem with the two observeEvent blocks interfering with each other and/or having two inputs in observeEvent. I quadruple-checked the if else if logic by using the same logic to send the text to an object in the global environment, and that all checks out. It must be something with cycling through the tooltips, which is where I run out of ideas.