我正在使用反应式和观察功能显示/隐藏图层，但是颜色功能似乎覆盖了反应式功能中的if语句。我想将我的图层分组（WatersourceOnPlot和PipedWateronPlot作为WaterAccess，然后将FlushToilets，OtherImproved，Unimproved和Open Defecation作为卫生），并能够使用颜色功能隐藏/显示图层。代码存在的问题是，我必须为每个图层创建一个selectInput才能使颜色映射起作用。当我将两个项目放在一个selectInput上时，第一个项目在进行颜色映射时会覆盖另一个项目。DOWNLOAD SHAPE FILE HERE
可复制的示例：
#loading libraries
library(shiny)
library(leaflet)
library(rgdal)
#loading shape file
mp<-readOGR(
dsn="merge",
layer="m1")
#Remove NAs from AreaType col
mp<-mp[!is.na(mp$AreaTyp),]
#ui
ui<-fluidPage(
leafletOutput("map"),
selectInput(inputId = "pop",
label = " POPULATION:",
choices = list(
"All"=1,
"Population Per Km2"=4
#"< 15,000"=2
# "15,001 - 30,000"=3 ,
# ">30,001"=1
)
),
selectInput(inputId = "area1",
label = " AreaType:",
choices = c(
"All",
unique(as.character(mp$AreaTyp))
)
),
selectInput(
inputId = "pw",
label = "Water Type:",
choices = c(
"All"=1,
"Piped Water On Plot"=2,
"Water source On Plot"=3
)
),
selectInput(
inputId = "ws",
label = "Water Type2:",
choices = c(
"All"=1,
"Water source On Plot"=2
)
),
selectInput(
inputId = "ft",
label = "Sanitation1:",
choices = c(
"All"=1,
"Flush Toilets"=2
)
),
selectInput(
inputId = "oi",
label = "Sanitation2:",
choices = c(
"All"=1,
"Other Improved"=2
)
),
selectInput(
inputId = "ui",
label = "Sanitation3:",
choices = c(
"All"=1,
"UnImproved"=2
)
),
selectInput(
inputId = "od",
label = "Sanitation4:",
choices = c(
"All"=1,
"Open Defecation"=2
)
)
)
#server
server<-function(input,output){
#INTERACTIVE MAPPING
#colormapping
pal<-colorFactor(rainbow(7),mp$AreaTyp)
#reactive function for flush toilets
fts<-reactive({
dm<-mp
if(input$ft==1){
dm[dm$FlshTlt<=25,]
}
else if(input$ws==2)
{
dm[dm$FlshTlt>25&dm$FlshTlt<=50,]
}
return(dm)
})
#reactive function for water source on plot
wsp<-reactive({
dm<-mp
if(input$ws==1){
dm[dm$WtrSrOP<=25,]
}
else if(input$ws==2)
{
dm[dm$WtrSrOP>25&dm$WtrSrOP<=50,]
}
else if(input$ws==3)
{
dm[dm$WtrSrOP>50&dm$WtrSrOP<=75,]
}
else if(input$ws==4)
{
dm[dm$WtrSrOP>75,]
}
return(dm)
})
#reactive function for piped water on plot
pwp<-reactive({
dm<-mp
if(input$pw==2){
dm[dm$PpdWtrP<=25,]
}
else if(input$pw==3)
{dm[dm$WtrSrOP<=25,]}
return(dm)
})
#reactive function for population per km2
ppd<-reactive({
dt<-mp
if(input$pop==1){
dt[dt$PpDnsty<=15000,]
} else if(input$pop==3){
dt[dt$PpDnsty>15000&dt$PpDnsty<=30000,]
} else if(input$pop==4){
dt[dt$PpDnsty>30000,]
}
return(dt)
})
#reactive function for areatype
fdata<-reactive({
data<-mp
if(input$area1!="All"){
data<-subset(data,AreaTyp %in% input$area1)
}
return(data)
})
output$map<-renderLeaflet({
leaflet(mp) %>%
#Initializing the map
setView(lng=36.092245, lat=-00.292115,zoom=15)%>%
#Base map
#Add default OpenStreetMap map tiles
addTiles(group = "default")%>%
#Overlay map
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
)
)
})
observe({
pal<-colorFactor(rainbow(7),mp$AreaTyp)
leafletProxy("map",data=fdata()) %>%
clearMarkers() %>%
clearControls() %>%
clearShapes()%>%
addPolygons(
weight = 1, smoothFactor = 0.5,
opacity = 1.0, fillOpacity = 1.0,
fillColor = ~pal(AreaTyp),
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
)
)%>%
addLegend(title = "AreaType", position = "topleft",
pal = pal, values = ~AreaTyp, opacity = 1)
})
observe({
pal1 <- colorBin("plasma", mp$PpDnsty, 15, pretty = TRUE)
leafletProxy("map",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
)
)%>%
addLegend(title = "Population Per km2", position = "topleft",
pal = pal1, values = ~PpDnsty, opacity = 1)
})
observe({
pal1 <- colorBin("plasma", mp$PpdWtrP, 5, pretty = TRUE)
leafletProxy("map",data=pwp()) %>%
# clearMarkers() %>%
clearControls() %>%
clearShapes()%>%
addPolygons(
weight = 1, smoothFactor = 0.5,
opacity = 1.0, fillOpacity = 1.0,
fillColor = ~pal1(PpdWtrP),
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
)
)%>%
addLegend(title = "Piped Water On Plot(%)", position = "topleft",
pal = pal1, values = ~PpdWtrP, opacity = 1)
})
observe({
pal1 <- colorBin("plasma", mp$WtrSrOP, 5, pretty = TRUE)
leafletProxy("map",data=wsp()) %>%
# clearMarkers() %>%
clearControls() %>%
clearShapes()%>%
addPolygons(
weight = 1, smoothFactor = 0.5,
opacity = 1.0, fillOpacity = 1.0,
fillColor = ~pal1(WtrSrOP),
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
)
)%>%
addLegend(title = " Water source On Plot(%)", position = "topleft",
pal = pal1, values = ~WtrSrOP, opacity = 1)
})
observe({
pal1 <- colorBin("plasma", mp$FlshTlt, 5, pretty = TRUE)
leafletProxy("leaf",data=fts()) %>%
# clearMarkers() %>%
clearControls() %>%
clearShapes()%>%
addPolygons(
weight = 1, smoothFactor = 0.5,
opacity = 1.0, fillOpacity = 1.0,
fillColor = ~pal1(FlshTlt),
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
)
)%>%
addLegend(title = "Flush Toilets(%)", position = "topleft",
pal = pal1, values = ~FlshTlt, opacity = 1)
})
}
#runApp
shinyApp(ui,server)