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