如何在传单地图中的闪亮应用程序中停止反应？

Question

In my shiny app, I have a selectInput SITE to list all weather stations and a leaflet map. Following my previous question ( How to get the zoom level from the leaflet map in R/shiny? ), I can setView without changing zoom level.

Now I want to add a new feature to allow users to click markers in the map and update the selected values in the selectInput . In my current codes (see below for an example), the selected value of SITE is updated, but also call the setView to change the view point.

My expected features are 1) Selection of new site updates view, 2) Click of map doesn't update view.

How could I break linkage between two features? I guess I can use isolate to achieve it. To be honest, I am still confusing about isolate .

Thanks for any suggestions.

These are my example codes:

library(shiny)
library(leaflet)

df <- data.frame(
    site = c('S1', 'S2'),
    lng = c(140, 120),
    lat = c(-20, -30), 
    stringsAsFactors = FALSE)

# Define UI for application that draws a histogram
ui <- shinyUI(fluidPage(
    selectInput('site', 'Site', df$site),
    leafletOutput('map')

))

server <- shinyServer(function(input, output, session) {

    output$map <- renderLeaflet({
        leaflet() %>%
            addTiles() %>% 
            setView(lng = 133, lat = -25,  zoom = 4) %>% 
            addMarkers(lng = df$lng, lat = df$lat, popup = df$site)
    })


    observe({
        sel_site <- df[df$site == input$site,]
        isolate({
            new_zoom <- 4
            if (!is.null(input$map_zoom)) new_zoom <- input$map_zoom
            leafletProxy('map') %>%
                setView(lng = sel_site$lng, lat = sel_site$lat, zoom = new_zoom)
        })
    })

    observe({
        event <- input$map_marker_click

        if (is.null(event))
            return()
        click_site <- df %>% 
            filter(lng == event$lng, lat == event$lat)
        isolate({
            updateSelectInput(session, 'site', selected = click_site$site)
        })
    })


})

shinyApp(ui = ui, server = server)

Answer 1

This is not exactly what you asked for, because it uses a button, but maybe you can make a good use of it. I also fixed your filtering.

library(shiny)
library(leaflet)

df <- data.frame(
  site = c('S1', 'S2'),
  lng = c(140, 120),
  lat = c(-20, -30), 
  stringsAsFactors = FALSE)

ui <- shinyUI(fluidPage(
  selectInput('site', 'Site', df$site),
  actionButton("center","Center map on site"),
  leafletOutput('map')

))

server <- shinyServer(function(input, output, session) {

  output$map <- renderLeaflet({
    leaflet() %>%
      addTiles() %>% 
      setView(lng = 133, lat = -25,  zoom = 4) %>% 
      addMarkers(lng = df$lng, lat = df$lat, popup = df$site)
  })
observeEvent(input$center,{
    sel_site <- df[df$site == input$site,]
    isolate({
      new_zoom <- 4
      if (!is.null(input$map_zoom)) new_zoom <- input$map_zoom
      leafletProxy('map') %>%
        setView(lng = sel_site$lng, lat = sel_site$lat, zoom = new_zoom)
    })
  })

  observe({
    event <- input$map_marker_click

    if (is.null(event))
      return()
    else{
    latdist<- unlist(lapply((event$lat - df$lat), FUN=abs))

      if (min(latdist)<4){ 
      match <- 
        df[with(df, {which(lat[latdist==min(latdist)] == lat ) 
      }), ]
      if(abs(match$lng-event$lng)<4)
      {
        click_site <- df[with(df,{ which(lng == match$lng & lat == match$lat) }),]  
      }
      updateSelectInput(session, 'site', selected = click_site$site)

     }# first if
    } # end else
  })
})

shinyApp(ui = ui, server = server)