I have the following R codes within the shiny framework. Everything looks good, but the legend (Plese see this screenshot).
I want the legend to be updated on the basis of the users' selection of age group (60+, 65+, 85+), sex, or year. But it is not the case. That is, the legend's values remain unchanged, no matter what is selected from the left menu (Please see this screenshot). This makes the map useless if the 85+ is selected. Following is my entire codes.
I appreciate your help.
Nader
load("/Users/nadermehri/Desktop/map codes/nhmap.RData")
library(shiny)
library(leaflet)
ui <- fluidPage(
tabPanel(
"Interactive Maps",
tags$h5 (
)),
br(),
sidebarLayout(
sidebarPanel(
selectInput(
inputId = "Age_Group_map",
label = "Select the Age Group:",
selected = "60+",
selectize = F,
multiple = F,
choices = sort(unique(nhmap$Age_Group))
),
radioButtons(
inputId = "sex_map",
label = strong("Select Sex:"),
selected = "Both Sexes",
choices = sort(unique(nhmap$Sex))
),
sliderInput(
inputId = "Year_map",
label = "Year",
min = 2010,
max = 2050,
value = 2010,
step = 10,
sep = "",
pre = "",
animate = animationOptions(
interval = 1000,
loop = F,
playButton = tags$button("Play", style =
"background-color: #B61E2E ; color:white; margin-top: 10px; border:solid"),
pauseButton = tags$button("Pause", style =
"background-color: #B61E2E !important; color:white; margin-top: 10px; border:solid")
),
round = T,
width = "150%",
ticks = T
)),
mainPanel("Interactive", leafletOutput("int_map", height=500))))
server <- function(input, output) {
mapdata_ <- reactive ({
nhmap$Per <- round(nhmap$Per, 1)
out_map <- nhmap %>%
filter (
Age_Group %in% input$Age_Group_map,
Sex %in% input$sex_map,
Year %in% input$Year_map)
return(out_map)
})
output$int_map <- renderLeaflet ({
leaflet (mapdata_(),
pal8 <- c("#FFFFE5", "#D9F0A3", "#78C679", "#006837") ,
pal <- colorBin(palette = pal8, domain = NULL, bins=quantile(nhmap$Per), na.color = "#808080", alpha = FALSE, reverse = F)) %>%
addProviderTiles("CartoDB.Positron") %>%
clearControls() %>%
clearShapes()%>%
addPolygons(fillColor = ~pal(Per),
stroke=T,
weight=1,
smoothFactor=0.2,
fillOpacity = 1,
color="black",
popup=~paste(NAME,"<br>",input$sex_map,
input$Age_Group_map,"=",Per,"%"),
highlightOptions = highlightOptions(color = "red",
weight = T,
bringToFront = T),
label=~NAME) %>%
addTiles() %>%
setView(-82.706838, 40.358615, zoom=7) %>%
addLegend(position = "bottomright",
values = ~Per,
pal = pal,
title = (paste("%",input$Age_Group_map, input$sex_map, "in", input$Year_map)) ,
labFormat = labelFormat(
))
})
}
shinyApp(ui = ui, server = server)
You have to define the bins in colorBin, at which you want to cut the data in the different color sections. Something like:
pal <- colorBin(palette = pal8, domain = NULL, bins=quantile(mapdata_()$Per),
na.color = "#808080", alpha = FALSE, reverse = F)
And you also have to remove bins= 4 from the addLegend call, as it will get the information from the color palette.
I created some random data for nhmap and it is working for me with this code:
library(shiny)
library(leaflet)
library(sf)
library(sp)
## Random Data #############
data(meuse, package = "sp")
nhmap <- st_as_sf(meuse, coords = c("x", "y"))
st_crs(nhmap) <- "+init=epsg:28992"
nhmap <- st_buffer(nhmap, 100)
n = length(nhmap$cadmium)
nhmap$Age_Group <- sample(c(15,19,25), size = n, T)
nhmap$Sex <- sample(c("m","f"), size = n, T)
nhmap$Per <- runif(n, 1, 150)
nhmap$NAME <- sample(c("a","b","c"), size = n, T)
nhmap$Age_Group <- sample(c(15,19,25), size = n, T)
nhmap$Year <- sample(c(2010,2020,2030, 2040, 2050), size = n, T)
nhmap <- st_transform(nhmap, 4326)
## UI ###########
ui <- {fluidPage(
tabPanel(
"Interactive Maps",
tags$h5 ()),
br(),
sidebarLayout(
sidebarPanel(
selectInput(
inputId = "Age_Group_map",
label = "Select the Age Group:",
# selected = "60+",
selectize = F,
multiple = F,
choices = sort(unique(nhmap$Age_Group))
),
radioButtons(
inputId = "sex_map",
label = strong("Select Sex:"),
# selected = "Both Sexes",
choices = sort(unique(nhmap$Sex))
),
sliderInput(
inputId = "Year_map",
label = "Year",
min = 2010,
max = 2050,
value = 2010,
step = 10,
sep = "",
pre = "",
animate = animationOptions(
interval = 1000,
loop = F,
playButton = tags$button("Play", style =
"background-color: #B61E2E ; color:white; margin-top: 10px; border:solid"),
pauseButton = tags$button("Pause", style =
"background-color: #B61E2E !important; color:white; margin-top: 10px; border:solid")
),
round = T,
width = "150%",
ticks = T
)),
mainPanel("Interactive", leafletOutput("int_map", height=500)))
)}
## SERVER ###########
server <- function(input, output) {
mapdata_ <- reactive ({
nhmap$Per <- round(nhmap$Per, 1)
# nhmap
nhmap %>%
filter (
Age_Group %in% input$Age_Group_map,
Sex %in% input$sex_map,
Year %in% input$Year_map)
})
output$int_map <- renderLeaflet ({
req(mapdata_())
pal8 <- c("#FFFFE5", "#D9F0A3", "#78C679", "#006837")
# pal <- colorBin(palette = pal8, domain = NULL, bins=quantile(mapdata_()$Per),
pal <- colorBin(palette = pal8, domain = NULL, bins=quantile(nhmap$Per),
na.color = "#808080", alpha = FALSE, reverse = F)
leaflet(data = mapdata_()) %>%
# leaflet(data = nhmap) %>%
clearControls() %>%
clearShapes()%>%
addProviderTiles("CartoDB.Positron") %>%
addTiles() %>%
addPolygons(fillColor = ~pal(Per),
stroke=T,
weight=1,
smoothFactor=0.2,
fillOpacity = 1,
color="black",
label=~NAME,
popup=~paste(NAME,"<br>",input$sex_map,
input$Age_Group_map,"=",Per,"%"),
highlightOptions = highlightOptions(color = "red",
weight = T,
bringToFront = T)) %>%
# setView(-82.706838, 40.358615, zoom=7) %>%
addLegend(position = "bottomright",
values = ~Per,
title = (paste("%",input$Age_Group_map, input$sex_map, "in", input$Year_map)),
pal = pal
)
})
}
shinyApp(ui = ui, server = server)