Handling image map clicks in a Shiny app

Question

I'm building a Shiny app where selectInput functionality is to be presented both as a traditional HTML select dropdown and as a clickable image map. My current strategy is to link the image map polygons back to the app with a URL parameter added, parse that URL, and update the select. This of course resets the app every time, which is ok but not great, and the UI flicker is not very graceful.

My questions are:

• Is there a better way to capture the image clicks and update the input?
• If I continue with my solution, can I delay the rendering on the selectInput so it is not shown until after the URL is parsed so that it doesn't show the default selection for a moment before flickering over to the parameterized selection?

Here's a demo:

library(shiny)
ui <- fluidPage(
   sidebarLayout(
      sidebarPanel(
         selectInput("letter_select",
                     "Pick a letter:",
                     choices = c('A' = 1, 'B' = 2, 'C' = 3, 'D' = 4))
      ),
      mainPanel(
         h3('Or click a letter'),
         img(src = 'testpattern.png', usemap = '#image-map'),
         HTML('
<map name="image-map">
<area target="_self" title="A" href="?letter=1" coords=0,0,50,0,50,50,0,50" shape="poly">
<area target="_self" title="B" href="?letter=2" coords=50,0,100,0,100,50,50,50" shape="poly">
<area target="_self" title="C" href="?letter=3" coords=0,50,50,50,50,100,0,100" shape="poly">
<area target="_self" title="D" href="?letter=4" coords=50,50,100,50,100,100,50,100" shape="poly">
</map>
              ')
      )
   )
)

server <- function(input, output, session) {
  observe({
    query <- parseQueryString(session$clientData$url_search)
    if (!is.null(query[['letter']])) {
      updateSelectInput(session, 'letter_select', selected = query[['letter']])
    }
  })
}

shinyApp(ui = ui, server = server)

With the image being at `www/testpattern.png', shown below.

Answer 1

It's going to be difficult to maintain state and prevent flashing with a full page reload. The best work around would probably be to capture the events in javascript and update the application state. What follows is a very rough proof of concept of how this might work. First, we abstract the idea of an image map

imageMap <- function(inputId, imgsrc, opts) {
  areas <- lapply(names(opts), function(n) 
    shiny::tags$area(title=n, coords=opts[[n]], 
                     href="#", shape="poly"))
  js <- paste0("$(document).on('click', 'map area', function(evt) {
  evt.preventDefault();
  var val = evt.target.title;
  Shiny.onInputChange('", inputId, "', val);})")
  list(
    shiny::tags$img(src=imgsrc, usemap=paste0("#", inputId),
    shiny::tags$head(tags$script(shiny::HTML(js)))),
    shiny::tags$map(name=inputId, areas))
}

This will render the image and the map data from a URL and option list we pass in. We add in a bit of javascript to capture the click events on the image map. For example

imgsrc <- "https://i.stack.imgur.com/C5aoV.png"
mapopts <- list(A="0,0,50,0,50,50,0,50",
  B="50,0,100,0,100,50,50,50",
  C="0,50,50,50,50,100,0,100",
  D ="50,50,100,50,100,100,50,100")
imageMap("map1", imgsrc, mapopts)

We can this use this in our UI

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      selectInput("letter_select",
                  "Pick a letter:",
                  choices = c('A', 'B', 'C', 'D'))
    ),
    mainPanel(
      h3('Or click a letter'),
      imageMap("map1", imgsrc , mapopts)
    )
  )
)

And now we can listen on the server for the events, and change the select input

server <- function(input, output, session) {
  observeEvent(input$map1,  {
    updateSelectInput(session, "letter_select", selected=input$map1)
  })  
}

Now you can just run

shinyApp(ui = ui, server = server)

and you'll see that when you click on the letters in the image, the value of the select input will change to match.