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?
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)
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:
- 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
)