I want to be able to addlegend feature on my interactive map app based on user input such that when he selects a range of input the color mapping changes based on the conditions selected.You can interact with the apphere specifically with the interactive mapping tab.I want to be able to apply the concept from the color mapping tab. Here is a snip of the code:
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)