Adding an interactive filter to a layered leaflet() map in R

问题

I have created a map that has different layers for different variables, but would like to also have a selector box that allows you to select which year you view, essentially filtering the data for that particular year.

The code below makes the map based on all years data. I'd like almost the same map, but with the ability to change what year you are viewing data for (i.e. 1990, 1991, 1992, or 1993)

# get shapefiles (download shapefiles: http://www2.census.gov/geo/tiger/GENZ2014/shp/cb_2014_us_county_5m.zip)
usgeo <- st_read("~/cb_2014_us_county_5m/cb_2014_us_county_5m.shp") %>%
  mutate(fips = as.numeric(paste0(STATEFP, COUNTYFP)))

### alternatively, tweak this code so you can download data directly ####
temp <- tempfile()
download.file("http://www2.census.gov/geo/tiger/GENZ2014/shp/cb_2014_us_county_5m.zip",temp)
data <- st_read(unz(temp, "cb_2014_us_county_5m.shp"))
unlink(temp)
########################################################


# create fake data
sample <- data.frame(fips = rep(as.numeric(c("37001", "37003", "37005", "37007", "37009", "37011", "37013", "37015", "37017", "37019"), 4)),
                      year = c(rep(1990, 10), rep(1991, 10), rep(1992, 10), rep(1993, 10)),
                      life = sample(1:100, 40, replace=TRUE),
                      income = sample(8000:1000000, 40, replace=TRUE),
                      pop = sample(80000:1000000, 40, replace=TRUE))

# join fake data with shapefiles
sample <- st_as_sf(sample %>% left_join(usgeo))

# drop layers (not sure why, but won't work without this)
sample$geometry <- st_zm(sample$geometry, drop = T, what = "ZM")

# change projection
sample <- sf::st_transform(sample, "+proj=longlat +datum=WGS84")

# create popups
incomepopup <- paste0("County: ", sample$NAME, ", avg income = $", sample$income)
poppopup <- paste0("County: ", sample$NAME, ", avg pop = ", sample$pop)
lifepopup <- paste0("County: ", sample$NAME, ", avg life expectancy = ", sample$life)

# create color palettes
lifePalette <- colorNumeric(palette = "Purples", domain=sample$life)
incomePalette <- colorNumeric(palette = "Reds", domain=sample$income)
popPalette <- colorNumeric(palette = "Oranges", domain=sample$pop)

# create map
leaflet(sample) %>%
  addProviderTiles("CartoDB.Positron") %>%
  addPolygons(stroke=FALSE,
              smoothFactor = 0.2,
              fillOpacity = .8,
              popup = poppopup,
              color = ~popPalette(sample$pop),
              group = "pop") %>% 
  addPolygons(stroke=FALSE,
              smoothFactor = 0.2,
              fillOpacity = .8,
              popup = lifepopup,
              color = ~lifePalette(sample$life),
              group = "life") %>%  
  addPolygons(stroke=FALSE,
              smoothFactor = 0.2,
              fillOpacity = .8,
              popup = incomepopup,
              color = ~incomePalette(sample$income),
              group = "income") %>%
  addLayersControl(
    baseGroups=c("income", "life", "pop"),
    position = "bottomleft",
    options = layersControlOptions(collapsed = FALSE)
  )

The first map here (and screenshotted below) shows the output of what I already have (except the data is filtered for only year == 1993). I'd like that, but without the "year" variable, and instead, an additional selector box that would allow you to select which year you want data for.

来源：https://stackoverflow.com/questions/58205579/adding-an-interactive-filter-to-a-layered-leaflet-map-in-r

标签

r-leaflet