子集空间多边形数据框

Question

我希望能够使用基于用户输入的数据和多边形来对我的空间多边形数据框进行子集化，然后根据过滤后的数据进行颜色映射。这是一个示例，尽管它输出：“警告：UseMethod 中的错误：没有适用于 'filter_' 的方法应用于“c('SpatialPolygonsDataFrame', 'SpatialPolygons', 'Spatial', 'SpatialVector')”类的对象

library(shiny)
library(shinydashboard)
library(leaflet)
library(rgdal)
library(sp)
library(sf)
library(RColorBrewer)
library(dplyr)


mp<-readOGR(
  dsn="./LIAs3",
  layer="m3",encoding = 'UTF-8')

ui<-fluidPage(
leafletOutput("leaf",height = 600),
 absolutePanel( fixed = TRUE,
                         draggable = TRUE, top = 100, left = "auto", right = 10,
                         width = 250, height = "auto",style="opacity:0.8;background:#ffffff;",

                         h2("MAP EXPLORER",style="color:#3474A7"),


                         #Specification of range within an interval 
                         sliderInput(inputId = "pop",
                                     label = "Population Per km2:",
                                     min = 1, max = 155000,
                                     value = c(1,15000))
)
)


server<-function(input,output){

#sliderinput reactive function for population per km2
  ppd<-reactive({
    dx<-mp
    dx %>% filter(PpDnsty==input$pop)
  })

#Base map(default)

  output$leaf<-renderLeaflet({



    leaflet(mp) %>%

      #Initializing the map
      # setView(lng=36.092245, lat=-00.292115,zoom=15)%>%

      #default map
      #Add default OpenStreetMap map tiles
      addTiles()%>%

      # addProviderTiles("Esri.NatGeoWorldMap",group = "default")%>%  
      #addProviderTiles("CartoDB.Positron",group = "custom")%>%

      #nakuru lias polygons
      addPolygons(
        data = mp,
        fillColor = "blue",
        weight = 1, smoothFactor = 0.5,
        opacity = 1.0, fillOpacity = 1.0,
        highlightOptions = highlightOptions(
          weight = 2,
          color = "red",
          fillOpacity = 0.7,
          bringToFront = TRUE
        ),
        label =~LIA,
        popup = ~paste("<strong>Area Type:</strong>",AreaTyp,
                       "<br>",
                       "<strong>Piped Water On Plot:</strong>",PpdWtrP,"%",
                       "<br>",
                       "<strong>Water Source On Plot:</strong>",WtrSrOP,"%",
                       "<br>",
                       "<strong>Flash Toilets:</strong>",FlshTlt,"%",
                       "<br>",
                       "<strong>Other Improved:</strong>",OthrImp,"%",
                       "<br>",
                       "<strong>Unimproved:</strong>",Unmprvd,"%",
                       "<br>",
                       "<strong>Open Defecation:</strong>",OpnDfct,"%",
                       "<br>",
                       "<strong>Population Per km2:</strong>",PpDnsty,
                       "<br>",
                       "<strong>Elevation:</strong>",elevation,"m"
        )

      )  

  })

#observe function for population per km2
  observe({

    #color mapping function
    #pal1<-colorNumeric(palette = "magma",mp$PpDnsty)
    #pal1 <- colorBin("plasma",mp$PpDnsty, 15, pretty = TRUE)
    pal1<- colorBin("Blues", mp$PpDnsty, 2, pretty = FALSE)


    leafletProxy("leaf",data=ppd()) %>%

      # clearMarkers() %>%
      clearControls() %>%
      clearShapes()%>%
      addPolygons(
        weight = 1, smoothFactor = 0.5,
        opacity = 1.0, fillOpacity = 1.0,
        fillColor = ~pal1(PpDnsty),
        highlightOptions = highlightOptions(
          weight = 2,
          color = "red",
          fillOpacity = 0.7,
          bringToFront = TRUE
        ),
        label =~LIA,
        popup = ~paste("<strong>Area Type:</strong>",AreaTyp,
                       "<br>",
                       "<strong>Piped Water On Plot:</strong>",PpdWtrP,"%",
                       "<br>",
                       "<strong>WaterSource On Plot:</strong>",WtrSrOP,"%",
                       "<br>",
                       "<strong>Flash Toilets:</strong>",FlshTlt,"%",
                       "<br>",
                       "<strong>Other Improved:</strong>",OthrImp,"%",
                       "<br>",
                       "<strong>Unimproved:</strong>",Unmprvd,"%",
                       "<br>",
                       "<strong>Open Defecation:</strong>",OpnDfct,"%",
                       "<br>",
                       "<strong>Population Per km2:</strong>",PpDnsty,
                       "<br>",
                       "<strong>Elevation:</strong>",elevation,"m"

        )

      )%>%
      addLegend(title = "Population Per km2", position = "topleft",
                pal = pal1, values = ~PpDnsty, opacity = 1)

  })

}
shinyApp(ui,server)

Answer 1

看来这个问题是由filter 引起的，特别是在这一行： dx %>% filter(PpDnsty==input$pop)

我会说在这种情况下，普通的旧 subset 在这种情况下会更好用，因为 dx 是 SpatialPolygonsDataFrame，这会导致：

dx <- subset(dx, PpDnsty==input$pop)