首页 > 解决方案 > 将交互式过滤器添加到 R 中的分层传单()地图

问题描述

我已经创建了一个地图,它为不同的变量具有不同的图层,但还希望有一个选择框,允许您选择查看的年份,实质上是过滤该特定年份的数据。

下面的代码根据所有年份的数据制作地图。我想要几乎相同的地图,但能够更改您查看数据的年份(即 1990、1991、1992 或 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)
  )

这里的第一张地图(以及下面的截图)显示了我已经拥有的输出(除了数据仅过滤了年份 == 1993)。我想要这样,但没有“年份”变量,而是有一个额外的选择框,可以让您选择您想要数据的年份。

上面链接的截图

标签: rr-leaflet

解决方案


推荐阅读