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.