library(sf)
library(dplyr)
library(tidyr)
library(leaflet)
brasil = geobr::read_country(showProgress = FALSE)
center = st_coordinates(st_centroid(brasil))
state_border = geobr::read_state(showProgress = FALSE)
dim_state = as_tibble(st_drop_geometry(state_border))
codes = c(93070, 93084:93098, 49108, 49109, 60040, 60041, 6653)
tab_population = sidrar::get_sidra(
9514,
variable = 93,
geo = "State",
classific = "c287",
category = list(codes)
)
tab_pop <- tab_population |>
janitor::clean_names() |>
as_tibble() |>
filter(sexo == "Total", forma_de_declaracao_da_idade == "Total") |>
select(
code_state = unidade_da_federacao_codigo,
age_group = idade,
count = valor
)
tab_pop <- tab_pop |>
mutate(
code_state = as.numeric(code_state),
age_min = as.numeric(stringr::str_extract(age_group, "\\d+")),
age_group = factor(age_group),
age_group = forcats::fct_reorder(age_group, age_min),
age_ibge = case_when(
age_min < 15 ~ "young",
age_min >= 15 & age_min < 65 ~ "adult",
age_min >= 65 ~ "elder"
),
factor(age_ibge, levels = c("young", "adult", "elder"))
)
pop_state <- tab_pop %>%
summarise(
total = sum(count), .by = c("age_ibge", "code_state")
) %>%
pivot_wider(
id_cols = "code_state",
names_from = "age_ibge",
values_from = "total"
) %>%
mutate(
dre = elder / adult * 100,
dry = young / adult * 100,
tdr = dre + dry
)
tab_pop_state <- left_join(dim_state, pop_state, by = "code_state")
pop <- left_join(state_border, pop_state, by = "code_state")
pal_tdr <- colorBin(
palette = as.character(MetBrewer::met.brewer("Hokusai2", 5)),
domain = pop$tdr,
bins = BAMMtools::getJenksBreaks(pop$tdr, k = 6)
)
pal_rdi <- colorBin(
palette = as.character(MetBrewer::met.brewer("Hokusai2", 5)),
domain = pop$dre,
bins = BAMMtools::getJenksBreaks(pop$dre, k = 6)
)
pal_rdj <- colorBin(
palette = as.character(MetBrewer::met.brewer("Hokusai2", 5)),
domain = pop$dry,
bins = BAMMtools::getJenksBreaks(pop$dry, k = 6)
)
labels <- sprintf(
"<b>RDT<b/>: %s <br>
<b>RDJ<b/>: %s <br>
<b>RDI<b/>: %s <br>",
format(round(pop$tdr, 1), decimal.mark = ","),
format(round(pop$dry, 1), decimal.mark = ","),
format(round(pop$dre, 1), decimal.mark = ",")
)
labels <- lapply(labels, htmltools::HTML)
map <- leaflet(pop) |>
addTiles() |>
addPolygons(
group = "RDT (Total)",
fillColor = ~ pal_tdr(tdr),
weight = 2,
color = "white",
fillOpacity = 0.9,
highlightOptions = highlightOptions(
color = "#e09351",
weight = 10,
fillOpacity = 0.8,
bringToFront = TRUE
),
label = labels,
labelOptions = labelOptions(
style = list("font-weight" = "normal", "font-family" = "Fira Code")
)
) %>%
addPolygons(
group = "RDJ (Jovem)",
fillColor = ~ pal_rdj(dry),
weight = 2,
color = "white",
fillOpacity = 0.9,
highlightOptions = highlightOptions(
color = "#e09351",
weight = 10,
fillOpacity = 0.8,
bringToFront = TRUE
),
label = labels,
labelOptions = labelOptions(
style = list("font-weight" = "normal", "font-family" = "Fira Code")
)
) %>%
addPolygons(
group = "RDI (Idoso)",
fillColor = ~ pal_rdi(dre),
weight = 2,
color = "white",
fillOpacity = 0.9,
highlightOptions = highlightOptions(
color = "#e09351",
weight = 10,
fillOpacity = 0.8,
bringToFront = TRUE
),
label = labels,
labelOptions = labelOptions(
style = list("font-weight" = "normal", "font-family" = "Fira Code")
)
) %>%
addLegend(
pal = pal_tdr,
values = ~tdr,
labFormat = labelFormat(digits = 1),
title = "RDT (2022)",
position = "bottomright",
group = "RDT (Total)"
) %>%
addLegend(
pal = pal_rdj,
values = ~dry,
labFormat = labelFormat(digits = 1),
title = "RDJ (2022)",
position = "bottomright",
group = "RDJ (Jovem)"
) %>%
addLegend(
pal = pal_rdi,
values = ~dre,
labFormat = labelFormat(digits = 1),
title = "RDI (2022)",
position = "bottomright",
group = "RDI (Idoso)"
) %>%
addLayersControl(
overlayGroups = c("RDT (Total)", "RDJ (Jovem)", "RDI (Idoso)"),
options = layersControlOptions(collapsed = FALSE)
) %>%
addProviderTiles(providers$CartoDB) |>
setView(lng = -53.1873, lat = -15.58913, zoom = 4) %>%
groupOptions(group = "RDT (Total)", zoomLevels = 4) %>%
groupOptions(group = "RDJ (Jovem)", zoomLevels = c(1, 18)) %>%
groupOptions(group = "RDI (Idoso)", zoomLevels = c(1, 18))