R Shiny / Leaflet：选择最接近地图中心的点

时间：2016-12-06 15:27:56

标签： r shiny leaflet

这个简单闪亮的应用程序允许用户拖动地图，并显示其质心最接近地图中心的邮政编码。

问题在于，当应用初始化时，持有最接近地图中心的邮政编码的被动对象会加载邮政编码，并且永远不会更改。

另一方面，如果我选择在地图边框内显示所有邮政编码质心，它会按预期工作。这两个表达式都非常相似，但是一个表达式有效，而另一个表达式没有。

发生了什么？

可重复的代码：

library(shiny)
library(leaflet)

# List of ZIP code centroids as X/Y coordinates
zip_coord <- read.csv('https://www.dropbox.com/s/lz9gmrz5skvef53/zip_coord.csv?dl=1')

# Default view location
lat <- 42.361145
lng <-  -71.057083
zoom <- 11



ui <- shinyUI(fluidPage(fluidRow(
  column(
  7,
  offset = 1,
  leafletOutput("map", height = "700")),
  column(
  3,
  h5("This doesn't work: It always shows the same ZIP:"),
  tableOutput("centerZip"),
  br(),
  h5("This works: the ZIPs change as you move the map around:"),
  tableOutput("inBoundsZIPs")
  )
  )))


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

  output$map <- renderLeaflet({

    leaflet() %>%
      addProviderTiles("Stamen.TonerLite", group = "Stamen.TonerLite") %>%
      setView(lat = lat,
              lng = lng,
              zoom = zoom)
  })


  # A reactive expression that returns a single zip code, the one closest to the center 
  # of the current map view
  # THIS DOES NOT WORK AS EXPECTED

  centeredZip <- reactive({
    if (is.null(input$map_bounds))
      return(NULL)
    bounds <- input$map_bounds
    center <- c(mean(bounds$north, bounds$south),
                mean(bounds$east, bounds$west))

    nearest.zip <- zip_coord[which.min(colSums((t(zip_coord[-1]) - center)^2)),1]
    # Pick out the point
    subset(zip_coord, ZIP == nearest.zip)

  })

    output$centerZip <- renderTable({
      centeredZip()
    })

  # A reactive expression that returns the set of zips that are
  # within the current view bounds
  # THIS WORKS AS EXPECTED

  zipsInBounds <- reactive({
    if (is.null(input$map_bounds))
      return(zip_coord[FALSE,])
    bounds <- input$map_bounds
    latRng <- range(bounds$north, bounds$south)
    lngRng <- range(bounds$east, bounds$west)

    subset(zip_coord,
           lat >= latRng[1] & lat <= latRng[2] &
             long >= lngRng[1] & long <= lngRng[2], select = ZIP)
  })


  output$inBoundsZIPs <- renderTable({
    zipsInBounds()
  })


})

shinyApp(ui, server)

编辑：

原来我的经度和纬度定义为中心点向后。而不是

center <- c(mean(bounds$north, bounds$south), mean(bounds$east, bounds$west))

它应该是：

center <- c(mean(bounds$east, bounds$west), mean(bounds$north, bounds$south))

毕竟拉链码选择器功能是正确的：鉴于我的中心定义错误地放在另一个半球中，最接近它的邮政编码始终是相同的。

最终版和工作版是：

# List of ZIP code centroids as X/Y coordinates
zip_coord <- read.csv('https://www.dropbox.com/s/lz9gmrz5skvef53/zip_coord.csv?dl=1')

# Default view location
lat <- 42.361145
lng <-  -71.057083
zoom <- 11



ui <- shinyUI(fluidPage(fluidRow(
  column(
    7,
    offset = 1,
    leafletOutput("map", height = "700")),
  column(
    3,
    h5("This doesn't work: It always shows the same ZIP:"),
    tableOutput("centerZip"),
    br(),
    h5("This works: the ZIPs change as you move the map around:"),
    tableOutput("inBoundsZIPs")
  )
)))


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

  output$map <- renderLeaflet({

    leaflet() %>%
      addProviderTiles("Stamen.TonerLite", group = "Stamen.TonerLite") %>%
      setView(lat = lat,
              lng = lng,
              zoom = zoom)
  })


  # A reactive expression that returns a single zip code, the one closest to the center 
  # of the current map view
  # NOW THIS WORKS TOO!

  centeredZip <- reactive({
    if (is.null(input$map_bounds))
      return(NULL)
    bounds <- input$map_bounds
    center <- c(mean(bounds$east, bounds$west),
                mean(bounds$north, bounds$south)
                )

    nearest.zip <- zip_coord[which.min(colSums((t(zip_coord[-1]) - center)^2)),1]
    # Pick out the point
    subset(zip_coord, ZIP == nearest.zip)

  })

  output$centerZip <- renderTable({
    centeredZip()
  })

  # A reactive expression that returns the set of zips that are
  # within the current view bounds
  # THIS WORKS AS EXPECTED

  zipsInBounds <- reactive({
    if (is.null(input$map_bounds))
      return(zip_coord[FALSE,])
    bounds <- input$map_bounds
    latRng <- range(bounds$north, bounds$south)
    lngRng <- range(bounds$east, bounds$west)

    subset(zip_coord,
           lat >= latRng[1] & lat <= latRng[2] &
             long >= lngRng[1] & long <= lngRng[2], select = ZIP)
  })


  output$inBoundsZIPs <- renderTable({
    zipsInBounds()
  })


})

shinyApp(ui, server)

2 个答案:

答案 0 :(得分：1)

我发现了这个问题，试试这个

library(shiny)
library(leaflet)

# List of ZIP code centroids as X/Y coordinates
zip_coord <- read.csv('http://www.dropbox.com/s/lz9gmrz5skvef53/zip_coord.csv?dl=1')

# Default view location
lat <- 42.361145
lng <-  -71.057083
zoom <- 11

ui <- shinyUI(fluidPage(fluidRow(
  column(
    7,
    offset = 1,
    leafletOutput("map", height = "700")),
  column(
    3,
    h5("This doesn't work: It always shows the same ZIP:"),
    tableOutput("centerZip"),
    br(),
    h5("This works: the ZIPs change as you move the map around:"),
    tableOutput("inBoundsZIPs")
  )
)))


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

  output$map <- renderLeaflet({

    leaflet() %>%
      addProviderTiles("Stamen.TonerLite", group = "Stamen.TonerLite") %>%
      setView(lat = lat,
              lng = lng,
              zoom = zoom)
  })


  # A reactive expression that returns a single zip code, the one closest to the center 
  # of the current map view
  # THIS DOES NOT WORK AS EXPECTED

  centeredZip <- eventReactive(input$map_bounds,{
    if (is.null(input$map_bounds))
      return(NULL)
    bounds <- input$map_bounds
    center <- c(mean(bounds$north, bounds$south),mean(bounds$east, bounds$west))
    #center <- c( 42.65214,-71.43929)
    nearest.zip <- zip_coord[which.min(colSums(t(zip_coord[-1]) - center)^2),1]    
    # Pick out the point
    subset(zip_coord, ZIP == nearest.zip)
  })

  output$centerZip <- renderTable({
    centeredZip()
  })

  # A reactive expression that returns the set of zips that are
  # within the current view bounds
  # THIS WORKS AS EXPECTED

  zipsInBounds <- reactive({
    if (is.null(input$map_bounds))
      return(zip_coord[FALSE,])
    bounds <- input$map_bounds
    latRng <- range(bounds$north, bounds$south)
    lngRng <- range(bounds$east, bounds$west)

    subset(zip_coord,
           lat >= latRng[1] & lat <= latRng[2] &
             long >= lngRng[1] & long <= lngRng[2], select = ZIP)
  })


  output$inBoundsZIPs <- renderTable({
    zipsInBounds()
  })


})

shinyApp(ui, server)

答案 1 :(得分：0)

原来我的经度和纬度定义为中心点向后。 代替 center <- c(mean(bounds$north, bounds$south), mean(bounds$east, bounds$west)) 它应该是： center <- c(mean(bounds$east, bounds$west), mean(bounds$north, bounds$south))。 邮编码选择器功能毕竟是正确的：鉴于我的中心定义错误地放置在另一个半球中，最接近它的邮政编码始终是相同的。

相关问题
最新问题