我希望能够根据用户输入在我的交互式地图应用程序上添加图例功能，以便当他选择输入范围时，颜色映射会根据所选条件而变化。您可以与该应用程序here进行交互特别是使用交互式映射选项卡。我希望能够从颜色映射选项卡中应用该概念。 这是代码片段：
ui<-fluidPage(
tabItem(
tabName = "map2",
h3("INTERACTIVE MAP"),
fluidPage(
title = "MAP DISPLAY",status = "primary",solidHeader = TRUE,
leafletOutput("leaf2",height = 500),
#h2("USER EXPLORER",style="color:#3474A7"),
fluidRow(
column(6,
#slider input for population per km2
sliderInput(inputId = "pop2",
label = "Population Per km2:",
min = min(mp@data$PpDnsty,na.rm =T),
max = max(mp@data$PpDnsty,na.rm =T),
value = c(min(mp@data$PpDnsty,na.rm =T),
max(mp@data$PpDnsty,na.rm =T))
),
#slider input for piped water on plot
sliderInput(inputId = "pw2",
label = "Piped Water On Plot:",
min = min(mp@data$PpdWtrP,na.rm =T),
max = max(mp@data$PpdWtrP,na.rm =T),
value = c(min(mp@data$PpdWtrP,na.rm =T),
max(mp@data$PpdWtrP,na.rm =T))
)),
column(6,
#slider input for water source on plot
sliderInput(inputId = "ws",
label = "Water Source On Plot:",
min = min(mp@data$WtrSrOP,na.rm =T),
max = max(mp@data$WtrSrOP,na.rm =T),
value = c(min(mp@data$WtrSrOP,na.rm =T),
max(mp@data$WtrSrOP,na.rm =T))
),
#slider input for flush toilets
sliderInput(inputId = "ft",
label = "Flush Toilets:",
min = min(mp@data$FlshTlt,na.rm =T),
max = max(mp@data$FlshTlt,na.rm =T),
value = c(min(mp@data$FlshTlt,na.rm =T),
max(mp@data$FlshTlt,na.rm =T))
))),
fluidRow(
column(6,
#slider input for Other Improved
sliderInput(inputId = "om",
label = "Other Improved:",
min = min(mp@data$OthrImp,na.rm =T),
max = max(mp@data$OthrImp,na.rm =T),
value = c(min(mp@data$OthrImp,na.rm =T),
max(mp@data$OthrImp,na.rm =T))
),
#slider input for unimproved
sliderInput(inputId = "um",
label = "Unimproved:",
min = min(mp@data$Unmprvd,na.rm =T),
max = max(mp@data$Unmprvd,na.rm =T),
value = c(min(mp@data$Unmprvd,na.rm =T),
max(mp@data$Unmprvd,na.rm =T))
)
),
column(6,
#slider input for open defecation
sliderInput(inputId = "od",
label = "Open Defecation:",
min = min(mp@data$OpnDfct,na.rm =T),
max = max(mp@data$OpnDfct,na.rm =T),
value = c(min(mp@data$OpnDfct,na.rm =T),
max(mp@data$OpnDfct,na.rm =T))
),
#slider input for elevation
sliderInput(inputId = "el",
label = "Elevation:",
min = min(mp@data$elevation,na.rm =T),
max = max(mp@data$elevation,na.rm =T),
value = c(min(mp@data$elevation,na.rm =T),
max(mp@data$elevation,na.rm =T))
)
)
)
)
)
)
server<-function(input,output){
#sliderinput reactive function for all numeric input options
sld<-reactive({
subset(mp,mp@data$PpDnsty>=input$pop2[1]&
mp@data$PpDnsty<=input$pop2[2]&
mp@data$PpdWtrP>=input$pw2[1]&
mp@data$PpdWtrP<=input$pw2[2]&
mp@data$WtrSrOP>=input$ws[1]&
mp@data$WtrSrOP<=input$ws[2]&
mp@data$FlshTlt>=input$ft[1]&
mp@data$FlshTlt<=input$ft[2]&
mp@data$OthrImp>=input$om[1]&
mp@data$OthrImp<=input$om[2]&
mp@data$Unmprvd>=input$um[1]&
mp@data$Unmprvd<=input$um[2]&
mp@data$OpnDfct>=input$od[1]&
mp@data$OpnDfct<=input$od[2]&
mp@data$elevation>=input$el[1]&
mp@data$elevation<=input$el[2]
)
})
#Base map(default)
output$leaf2<-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 slider input numeric options
observe({
#color mapping function
#pal1<-colorNumeric(palette = "magma",mp$PpDnsty)
#pal1 <- colorBin("plasma",lias$PpDnsty, 15, pretty = TRUE)
#pal1<- colorBin("Blues", lias$PpDnsty, 2, pretty = FALSE)
leafletProxy("leaf2",data=sld()) %>%
#Initializing the map
#setView(lng=36.092245 , lat=-00.292115,zoom=10)%>%
# clearMarkers() %>%
clearControls() %>%
clearShapes()%>%
addPolygons(
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>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"
)
)
})
}
shinyApp(ui,server)