Подмножество пространственного полигона данных - PullRequest
Новая
       17

Подмножество пространственного полигона данных

0 голосов
/ 18 сентября 2018

Я хочу иметь возможность задавать для моего фрейма данных пространственного многоугольника как данные, так и полигоны на основе пользовательского ввода, а затем выполнять цветовое сопоставление на основе отфильтрованных данных. Вот пример, который выводит: «Предупреждение: Ошибка в 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)

1 Ответ

0 голосов
/ 20 февраля 2019

Похоже, что эта проблема вызвана filter именно в этой строке: dx %>% filter(PpDnsty==input$pop)

Я бы сказал, что в этом случае простой старый subset будет лучше использовать в этой ситуации, потому что dx является SpatialPolygonsDataFrame, что вместо этого привело бы к этому:

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

...