带有传单地图的R Shiny应用程序未以选定点为中心

Question

我在 R shiny 应用程序中有一张传单地图，该地图不会居中并重新聚焦到所选位置。令人沮丧的是，这适用于人口普查数据质心，但不适用于我的数据。

我有下面的代码，如果我使用一些来自人口普查的虚拟数据，它可以工作，但是当我使用我自己的数据（在 Github 上可用）时，它不会工作。我怀疑我的数据有问题，但我似乎无法理解它可能是什么。


#Load libraries
##########################################
library(shiny)    
library(shinyWidgets)
library(tigris)
library(leaflet)
library(rgeos)
library(rgdal)


#Get data from here - https://github.com/JoshRoll/ODOT-Projects/blob/master/Bend_Spatial_Data_2018.gdb.zip

#Count Location spatial information
##############
#Define the location where you unzipped the downloaded file
fgdb <-     "Bend_Spatial_Data_2018.gdb"
# Read the feature class
Count_Location_Info_Sp <-  readOGR(dsn=fgdb,layer= "MMCountLocations")

# Load data- Use census to use as proper spatial transformation from x/y to lat/long (Uses tigris package)
States_Sp <- states( year = "2010")
#Reproject
Count_Location_Info_Sp <-  spTransform(Count_Location_Info_Sp, CRS(proj4string( States_Sp)))  

#Create a data frame from spatial data
Data.. <- Count_Location_Info_Sp@data

#Set up User Interface
######################
ui <- fluidPage(
  titlePanel("LOcation Selector Test"),
  tabsetPanel(
    #Daily Counts Panel
    ##############
    #Hourly Counts Panel
    #######################
    tabPanel("Tab 1",
             #Call plot 
             fluidRow(
               column(3,
                      uiOutput("Location_Selector"))),
             #Location Details 
             fluidRow( 
               column(6,
                      #h4("Selected Location"),
                      leafletOutput("map_plot",height = 500))
               #Close row
             )
             #Close panel
    )
    #Close setPanel
  )
  #Page end   
)

#Set up Server
#---------------------------
server <- shinyServer(function(session,input,output){
  #Location selector
  observe({
    output$Location_Selector <- renderUI({
      selectInput(inputId = "Location_Selector",
                  label = "Select Location", multiple = FALSE,
                  choices = as.character(unique(Data..$Sub_Location_Id)),
                  selected =  unique(Data..$Sub_Location_Id)[1])
    })
  })
  #Set up starting leaflet
  ###############
  output$map_plot <- renderLeaflet({
    leaflet(Count_Location_Info_Sp) %>%
      addTiles() %>%
      addCircles(color = "black" )
    })
  #Set up proxy leaflet for updated selector
  ####################
  observe({
    dat <-  Count_Location_Info_Sp[Count_Location_Info_Sp@data$Sub_Location_Id%in%input$Location_Selector,]
    lat <-  coordinates( dat)[,1]
    long <-  coordinates(dat)[,2]
    leafletProxy("map_plot") %>% 
      clearShapes() %>%
      addTiles() %>%
      addCircles(data =dat ,color = "black" ) %>%
      setView(lng = long, lat = lat, zoom = 14)
   #Close leaflet proxy observe
  })


})
#Run App
shinyApp(ui,server)

Answer 1

简单功能 (sf) 包更易于使用（在我看来），并且比使用 sp 功能更丰富。这是我的做法，

我所做的只是更改使用 sf 包读取数据的方式。我们将其转换为标准坐标参考系 (crs)。数据集正在使用不同的坐标参考系。

最后，在 sf 中，您不需要索引到 @data。您可以将数据框 Count_Location_Info_Sp 视为常规的旧数据框（尽管具有一些附加功能）。

#Load libraries
##########################################
library(shiny)    
library(shinyWidgets)
library(tigris)
library(leaflet)
library(rgeos)
library(geosphere)
library(sf)


#Get data from here - https://github.com/JoshRoll/ODOT-Projects/blob/master/Bend_Spatial_Data_2018.gdb.zip

#Count Location spatial information
##############
#Define the location where you unzipped the downloaded file
fgdb <-     "~/Downloads/Bend_Spatial_Data_2018.gdb"
# Read the feature class
Count_Location_Info_Sp <-  st_read(dsn=fgdb,layer= "MMCountLocations",stringsAsFactors = FALSE)
Count_Location_Info_Sp <- st_transform(Count_Location_Info_Sp, crs = "+proj=longlat +datum=WGS84")


#Set up User Interface
######################
ui <- fluidPage(
  titlePanel("LOcation Selector Test"),
  tabsetPanel(
    #Daily Counts Panel
    ##############
    #Hourly Counts Panel
    #######################
    tabPanel("Tab 1",
             #Call plot 
             fluidRow(
               column(3,
                      uiOutput("Location_Selector"))),
             #Location Details 
             fluidRow( 
               column(6,
                      #h4("Selected Location"),
                      leafletOutput("map_plot",height = 500))
               #Close row
             )
             #Close panel
    )
    #Close setPanel
  )
  #Page end   
)

#Set up Server
#---------------------------
server <- shinyServer(function(session,input,output){
  #Location selector
  observe({
    output$Location_Selector <- renderUI({
      selectInput(inputId = "Location_Selector",
                  label = "Select Location", multiple = FALSE,
                  choices = as.character(unique(Data..$Sub_Location_Id)),
                  selected =  unique(Data..$Sub_Location_Id)[1])
    })
  })
  #Set up starting leaflet
  ###############
  output$map_plot <- renderLeaflet({
    leaflet(Count_Location_Info_Sp) %>%
      addTiles() %>%
      addCircles(color = "black" )
  })
  #Set up proxy leaflet for updated selector
  ####################
  observe({
    req(input$Location_Selector)

    dat <-  Count_Location_Info_Sp[Count_Location_Info_Sp$Sub_Location_Id %in% input$Location_Selector,]
    lat <-  st_coordinates(dat)[[2]]
    long <-  st_coordinates(dat)[[1]]
    leafletProxy("map_plot") %>%
      clearShapes() %>%
      addTiles() %>%
      addCircles(data =dat ,color = "black" ) %>%
      setView(lng = long, lat = lat, zoom = 14)
    #Close leaflet proxy observe
  })


})
#Run App
shinyApp(ui,server)

带有传单地图的R Shiny应用程序未以选定点为中心

R Shiny app with Leaflet map not centering on selected point

center

zooming

leaflet