Test

Testing, Testing, … 🎤

Set Environment

Load Packages

library(cli)
library(dplyr)
library(forcats)
library(geobr)
library(h3jsr)
library(here)
library(httr2)
library(magrittr)
library(mapgl)
library(orbis) # github.com/danielvartan/orbis
library(pmtiles) # github.com/danielvartan/pmtiles
library(purrr)
library(RColorBrewer)
library(sf)

Set Parameters

municipality_code <- 2507507

year <- 2022

h3_resolution <- 9

Set PMTiles

Set Sources

municipality_pmtiles_h3 <- file.path(
  "https://tiles.pmtiles.com.br",
  "geobr",
  "read_municipality",
  "h3jsr",
  paste("res", h3_resolution, sep = "-"),
  paste0(
    # fmt: skip
    paste(
      "code", municipality_code,
      "year", year |> closest_geobr_year(type = "municipality"),
      "simplified", FALSE,
      "min_zoom", 2,
      "max_zoom", 10,
      sep = "-"
    ),
    ".pmtiles"
  )
)

Get Metadata

municipality_pmtiles_layer <-
  municipality_pmtiles_h3 |>
  pm_show(tilejson = TRUE) |>
  pluck("vector_layers", 1, "id")

municipality_pmtiles_bounds <-
  municipality_pmtiles_h3 |>
  pm_show(tilejson = TRUE) |>
  pluck("bounds") |>
  unlist()

Get Data

Download Shape

data <-
  municipality_code |>
  read_municipality(
    year = year,
    simplified = FALSE
  )

Using year/date 2022

data |> glimpse()

Rows: 1
Columns: 8
$ code_muni    <dbl> 2507507
$ name_muni    <chr> "João Pessoa"
$ code_state   <dbl> 25
$ abbrev_state <chr> "PB"
$ name_state   <chr> "Paraíba"
$ code_region  <dbl> 2
$ name_region  <chr> "Nordeste"
$ geom         <MULTIPOLYGON [°]> MULTIPOLYGON (((-34.85565 -...

Transform to H3

data <-
  data |>
  st_transform(4326) |>
  polygon_to_cells(
    res = h3_resolution,
    simple = TRUE
  ) %>%
  as_tibble() |>
  set_names("h3_address")

Plot

Prepare Data

breaks <- c(-Inf, 0, 3, 5, 10, 15, Inf)

# fmt: skip
category_labels <- c(
  "0", "1 - 3", "4 - 5", "6 - 10", "11 - 15", "Above 15"
)

fill_scale <- brewer.pal(6, "PuRd") |> rev()

category_cut <- function(x) {
  x |>
    cut(
      breaks = breaks,
      labels = category_labels,
      include.lowest = TRUE,
      right = TRUE
    ) |>
    factor(
      ordered = TRUE,
      levels = category_labels
    )
}

plot_data <-
  data |>
  mutate(
    category = 0:19 |>
      sample(
        size = n(),
        replace = TRUE,
        prob = seq(20, 1)
      ) |>
      category_cut(),
    color = category |>
      as.character() |>
      recode_values(
        from = category |> levels(),
        to = fill_scale
      )
  )

plot_data

# A tibble: 1,710 × 3
   h3_address      category color  
   <chr>           <ord>    <chr>  
 1 8981836296bffff 6 - 10   #C994C7
 2 8981837528fffff 11 - 15  #D4B9DA
 3 89818375e9bffff 1 - 3    #DD1C77
 4 8981837506bffff 11 - 15  #D4B9DA
 5 8981837423bffff 0        #980043
 6 89818375c77ffff 0        #980043
 7 89818374e47ffff 6 - 10   #C994C7
 8 89818375a53ffff 4 - 5    #DF65B0
 9 89818374c23ffff 4 - 5    #DF65B0
10 898183671b3ffff 1 - 3    #DD1C77
# ℹ 1,700 more rows

Plot Map

fill_color <- match_expr(
  column = "h3_address",
  values = plot_data |> pull(h3_address),
  stops = plot_data |> pull(color),
  default = "transparent"
)

municipality_pmtiles_bounds |>
  maplibre(bounds = _) |>
  add_pmtiles_source(
    id = paste0("municipality_h3"),
    url = municipality_pmtiles_h3,
    source_type = "vector"
  ) |>
  add_fill_layer(
    id = "test",
    source = paste0("municipality_h3"),
    source_layer = municipality_pmtiles_layer,
    fill_color = fill_color,
    fill_opacity = 1
  ) |>
  add_legend(
    legend_title = NULL,
    values = category_labels,
    colors = fill_scale,
    type = "categorical",
    layer_id = "test",
    filter_column = "h3_address",
    interactive = TRUE
  ) |>
  add_screenshot_control()