Leaflet marker click event not working after using addSearchMarker

leaflet

#1

I have a shinydashboard app with a leaflet map in a box, and an observeEvent function for marker clicks. When a marker is clicked, a data frame record for that marker is displayed in another box.

This all works, but the problem is that I also have a leaflet.extras addSearchMarker tool for searching the markers. When I search for a marker, the map nicely zooms to that marker, but the marker click event no longer works. It’s as if the leaflet map reference has been lost somehow. Or am I missing something obvious?

Thanks,

Rich Lent


#2

Can you please provide a reprex of your problem.

You can check out this article for help:


#3
# Shiny dashboard for the Center for Writing and
# The Northeast Writing Across the Curriculum Consortium.
# Plots school locations with an information box containing school information.

# Richard A. Lent, Jan 10 16:23:07 2018.

library(shiny)
library(shinydashboard)
#> 
#> Attaching package: 'shinydashboard'
#> The following object is masked from 'package:graphics':
#> 
#>     box
library(leaflet)
library(leaflet.extras)
library(maps)
library(googlesheets)
library(stringr)
library(htmltools)

fields <- c("instname", "lat", "lon", "url", "logoURL", "info")

# This performs authentication using a stored Google Sheets OAuth token obtained with gs_auth().
gs_auth(token = "googlesheets_token.rds")
#> Auto-refreshing stale OAuth token.

table <- "Schools for NEWACC project" # The name of the Google Sheet.
sheet <- gs_title(table)  # Register the Google Sheet.
#> Sheet successfully identified: "Schools for NEWACC project"

bounds <- map('state', 
   c('Massachusetts', 'Vermont', 'New Hampshire', 'Maine', 'Rhode Island', 'Connecticut',
     'New Jersey', 'New York', 'Pennsylvania'), 
   fill=TRUE, plot=FALSE)

theTitle <- HTML("Institutions of <a href='http://newacc.wac.colostate.edu' target='_blank'>The Northeast Writing Across the Curriculum Consortium</a>")

header <- dashboardHeader(title = theTitle, titleWidth = 650, disable = FALSE)

sidebar <- dashboardSidebar(disable = TRUE)

body <- dashboardBody(
  # Custom CSS to make the title background area the same color as the rest of the header.
  tags$head(tags$style(HTML('
      .skin-blue .main-header .logo {
      background-color: #3c8dbc;
      }
      .skin-blue .main-header .logo:hover {
      background-color: #3c8dbc;
      }
      '))),
  fluidRow(
  box(leafletOutput("theMap", height = 700), title = "Click a site for more information.", solidHeader = TRUE, status = "info"),
  box(htmlOutput("markerData"), title = "Site Data", solidHeader = TRUE, status = "info", width = 4)
),

fluidRow(
  box("Row 2, Box 1", title = "Placeholder 1", solidHeader = TRUE, status = "info"),
  box("Row 2, Box 2.", title = "Placeholder 2", solidHeader = TRUE, status = "info")
)
)

ui <- dashboardPage(header, sidebar, body, skin = "black")

server <- function(input, output, session) {
  
sheetData <- gs_read(sheet)

  # Build an HTML content string.
  sheetData$content <- paste0(
    "<center><img src='", sheetData$logoURL,  "'", " alt='logo'", " height='200' width='300'", "></center>",
    "<br><h3>", sheetData$info, "</h3><br><br>",
    "<a href='", sheetData$url, "' target='_blank'>", "website", "</a>"
  )
  
output$theMap <- renderLeaflet({
    leaflet(data = sheetData) %>%
    # Center map on the vicinity of Williamstown, Massachusetts.
    setView(-73.262695, 42.740128, zoom = 6) %>% 
    # The following line will restrict the map view to the given coordinates.
    # setMaxBounds( -76.14405,  47.64953, -64.432627, 36.207562) %>% 
    addProviderTiles("CartoDB.Positron", group = "Map") %>%
    addProviderTiles("Esri.WorldImagery", group = "Satellite") %>% 
    addProviderTiles("Esri.WorldShadedRelief", group = "Relief") %>%
    addMarkers(lng = ~lon, lat = ~lat, label = ~instname, group = "Sites", 
       layerId = ~instname, popup = ~content) %>%
    addPolygons(data=bounds, group="States", weight=2, fillOpacity = 0) %>%
    addScaleBar(position = "bottomleft") %>%
    addLayersControl(
      position = "bottomleft",
      baseGroups = c("Map", "Satellite", "Relief"),
      overlayGroups = c("States", "Sites"),
      options = layersControlOptions(collapsed = FALSE)
    ) %>% 
    addSearchFeatures(targetGroup = "Sites",
                    options = searchFeaturesOptions(position = "topleft",
                    textPlaceholder = "Search for a school...", textErr = "Location not found.")) %>%
    addEasyButton(easyButton(
      icon='fa-globe', title='Zoom to Full Extent',
      onClick=JS("function(btn, map){map.setView([42.740128, -73.262695], 6);}")))
  }) # renderLeaflet

# THIS DOES NOT WORK WHEN SEARCHING FOR A SCHOOL USING addSearchFeatures.
observeEvent(input$theMap_marker_click, {
  mdata <- input$theMap_marker_click$id
  print(mdata) # This is NOT printed following use of addSearchFeatures.
  siteInfo <- sheetData[which(sheetData$instname == mdata),] 
  output$markerData <- renderText(siteInfo$content)
}) 

} # server

shinyApp(ui, server)
#> Error in appshot.shiny.appobj(structure(list(httpHandler = function (req) : appshot of Shiny app objects is not yet supported.

#4

It looks like you're describing a bug that has been submitted to leaflet.extras https://github.com/bhaskarvk/leaflet.extras/issues/104 (I have a more minimal example there)