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)

子集空间多边形数据框

1 个答案: