R 在闪亮的应用程序中处理图像地图点击

我正在构建一个闪亮的应用程序，

selectInput

功能将以传统的HTML选择下拉列表和可点击图像地图的形式呈现。我目前的策略是将图像映射多边形链接回添加了URL参数的应用程序，解析该URL，并更新选择。当然，每次都会重置应用程序，这很正常，但不是很好，UI闪烁也不是很优雅

我的问题是：

• 是否有更好的方法捕获图像点击并更新输入
• 如果我继续使用我的解决方案，我是否可以延迟

  selectInput

  上的渲染，使其在解析URL之后才会显示，以便在闪烁到参数化选择之前不会显示默认选择

下面是一个演示：

库（闪亮）
ui在重新加载整个页面时，很难保持状态并防止闪烁。最好的解决方法可能是在javascript中捕获事件并更新应用程序状态。下面是一个非常粗略的概念证明。首先，我们抽象出图像地图的概念

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

您会看到，当您单击图像中的字母时，选择输入的值将更改为匹配。
！这个答案启发我去寻找更多关于如何做这类事情的信息，我发现了这篇文章：打开了一个充满可能性的世界，谢谢。
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))
}

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)

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

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

shinyApp(ui = ui, server = server)