Search code examples
rshinyggiraphggimage

Interactive point is not clickable when plot updates


Problem Description

In a shiny app, I have a ggiraph scatter plot where points are clickable. Clicking a point launches a modal where you enter a value, which is stored in a database. Using a reactivePoll the app checks if there is an update in the database and subsequently updates the plot.
The problem is that when I click on the same point as before on the updated plot, the modal dialog does not launch. I have to click on the same point several times at different locations to try to launch the modal and sometimes I am successful in launching it.
However, if I click on any other point first, dismiss the launched modal and then click on the updated point then the corresponding modal launches easily.
I don't know the exact cause but I know that this is happening due to using ggimage::geom_icon along with ggiraph::geom_point_interactive. How can I fix this issue?

Reproducible Example

library(shiny)
library(ggiraph)
library(ggplot2)
library(DBI)
library(RSQLite)
library(bslib)
library(ggimage)

# Initialize SQLite database
db <- dbConnect(SQLite(), "points.db")
dbExecute(db, "CREATE TABLE IF NOT EXISTS points (
  id INTEGER PRIMARY KEY,
  value TEXT
)")
dbDisconnect(db)

ui <- page_fluid(
  card(
    card_body(
      girafeOutput("plot")
    )
  )
)

server <- function(input, output, session) {
  # Function to get database values
  get_db_values <- function() {
    db <- dbConnect(SQLite(), "points.db")
    values <- dbGetQuery(db, "SELECT * FROM points")
    dbDisconnect(db)
    return(values)
  }
  
  # Reactive poll to check database changes
  db_values <- reactivePoll(
    intervalMillis = 10000,  # 10 seconds
    session = session,
    checkFun = function() {
      db <- dbConnect(SQLite(), "points.db")
      result <- dbGetQuery(db, "SELECT COUNT(*) as count FROM points")
      dbDisconnect(db)
      return(result$count)
    },
    valueFunc = function() {
      return(get_db_values())
    }
  )
  
  # Create the interactive plot
  output$plot <- renderGirafe({
    values <- db_values()
    completed_points <- values$id
    
    df <- data.frame(
      x = c(1, 2, 3),
      y = c(1, 1, 1),
      id = 1:3,
      tooltip = paste("Point", 1:3),
      icon = ifelse(1:3 %in% completed_points, "checkmark-circle", "ellipse")
    )
    
    p <- ggplot(df, aes(x = x, y = y)) +
      geom_icon(aes(image = icon), size = 0.08) +
      geom_point_interactive(
        aes(tooltip = tooltip,
            data_id = id,
            onclick = sprintf('Shiny.setInputValue("selected_point", %d)', id)),
        size = 20,
        alpha = 0.0001  # Not completely transparent to maintain SVG presence
      ) +
      theme_minimal() +
      xlim(0, 4) +
      ylim(0, 2) +
      theme(axis.text = element_blank(),
            axis.title = element_blank())
    
    girafe(ggobj = p, 
           width_svg = 8, 
           height_svg = 4,
           options = list(
             opts_hover(css = "cursor:pointer;"),
             opts_selection(type = "single", only_shiny = FALSE)
           ))
  })
  
  # Handle point clicks
  observeEvent(input$selected_point, {
    showModal(modalDialog(
      title = paste("Enter value for Point", input$selected_point),
      textInput("point_value", "Value:"),
      footer = tagList(
        modalButton("Cancel"),
        actionButton("submit", "Submit")
      )
    ))
  })
  
  # Handle form submission
  observeEvent(input$submit, {
    req(input$point_value, input$selected_point)
    
    # Store in database
    db <- dbConnect(SQLite(), "points.db")
    dbExecute(db, 
              "INSERT OR REPLACE INTO points (id, value) VALUES (?, ?)",
              params = list(input$selected_point, input$point_value))
    dbDisconnect(db)
    
    removeModal()
  })
}

shinyApp(ui, server)

Solution

  • This is because Shiny.setInputValue() is lazy by default. From the linked article:

    By default, Shiny assumes that your app only cares about the latest value of a reactive input. Shiny.setInputValue uses this assumption to perform two optimizations by default:

    1. Setting an input to the same value it already has, is a no-op.

    ...

    This causes the reactive invalidation of input$selected_point to be not triggered when the same point is clicked again and the modal is not opened again before clicking on another point.

    You can use the priority: "event" option, then invalidation is always triggered:

    onclick = sprintf(
      'Shiny.setInputValue("selected_point", %d, {priority: "event"})', id
    )