r语言 - 子集空间面数据帧



我希望能够根据用户输入使用数据和多边形对空间多边形数据帧进行子集化,然后根据过滤后的数据进行颜色映射。下面是一个示例,尽管它输出:"警告:UseMethod中的错误:没有适用于filter_类"c('空间多边形数据帧','空间多边形','空间','空间矢量'(的对象

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)

此问题似乎是由filter在此行中特别引起的:dx %>% filter(PpDnsty==input$pop)

我会说在这种情况下,普通的旧subset在这种情况下会更好使用dx因为它是一个SpatialPolygonsDataFrame,反而会导致这种情况:

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

最新更新