使用addSearchMarker后,R shinydashboard Leaflet标记点击事件无法正常工作

时间:2018-02-22 15:44:41

标签: r shiny shinydashboard r-leaflet

我有一个shinydashboard app在框中有一个传单地图,还有一个observeEvent函数用于标记点击。单击标记时,该标记的数据框变量将显示在另一个框中。

这一切都有效,但问题是我还有一个leaflet.extras addSearchMarker工具用于搜索标记。当我搜索标记时,地图会很好地缩放到该标记,但标记点击事件不再有效。就好像传单地图参考已经以某种方式丢失了。或者我错过了一些明显的东西?

shinydashboard app的完整代码:

library(shiny)
library(shinydashboard)
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")

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

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) %>%
    addPolygons(data=bounds, group="States", weight=2, fillOpacity = 0) %>%
    addScaleBar(position = "bottomleft") %>%
    addLayersControl(
      position = "bottomleft",
      baseGroups = c("Map", "Satellite", "Relief"),
      overlayGroups = c("Sites", "States"),
      options = layersControlOptions(collapsed = FALSE)
    ) %>% 
    addSearchMarker(targetLayerId = NULL, targetGroup = "Sites",
                    options = searchMarkersOptions(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 STOPS WORKING AFTER SEARCHING FOR A SCHOOL WITH addSearchMarker. 
observeEvent(input$theMap_marker_click, {
  id <- input$theMap_marker_click$id
  siteInfo <- sheetData[which(sheetData$instname == id),] 
  output$markerData <- renderText(siteInfo$content)
}) 

} # server

shinyApp(ui, server)

0 个答案:

没有答案