Argumento opcional para grade H3

[baarthur]

O @rafapereirabr levantou a ideia de se retornar os hexágonos junto com as coordenadas. Acabei gostando da ideia, porque o pipeline para colocar a grade é um pouco inconveniente, então seria muito útil já tê-lo.

Rascunho de ideia que tive, a partir de uma função que estou usando em outro projeto e pode ser facilmente adaptada, posso fazer um PR posteriormente.

gc_with_hex <- function(data, fields, res = 9, precision = NULL, groups = NULL, na_remove = TRUE){
  
  # checks
  checkmate::assert_data_frame(data)
  checkmate::assert(!is.null(groups))
  checkmate::assert_character(groups)
  
  # geocode
  tictoc::tic()
  data <- data |> 
    geocodebr::geocode(fields, resolver_empates = T, resultado_sf = T)
  
  tt <- tictoc::toc(quiet = T)$callback_msg |> stringr::str_extract("^\\d+\\.\\d+")
  print(paste(nrow(data), "addresses geocoded in", tt, "seconds", "(", 
              round(nrow(data)/as.numeric(tt),2), "addr/sec)"))
  
  if(!is.null(precision)) {
    data <- data |> 
      filter(precisao %in% precision_geocodebr)
  }
  
  # get hex
  hex <- data |> 
    filter(!is.na(endereco_encontrado)) |>
    select(any_of(groups)) |> 
    h3jsr::point_to_cell(res = res, simple = F)
  
  # join and tidy
  data <- if(na_remove) {
    inner_join(data, hex)
  } else {
    left_join(data, hex)
  }
  
  data |> 
    mutate(h3_address = h3_resolution_9, lon = st_coordinates(geometry)[,1], 
           lat = st_coordinates(geometry)[,2], .keep = "unused") |>
    st_drop_geometry() |> 
    select(-c(endereco_encontrado, logradouro_encontrado))
}

[rafapereirabr]

tenho a impressão de que vai ser mais rapido usando a extensao h3 no duckdb. Soh que para isso dar certo, nos precisamos primeiro resolver os empates dentro do duckdb (#57).

Reprex

library(geocodebr)
library(duckdb)
library(dplyr)
library(arrow)
library(sfheaders)
library(glue)
library(DBI)

# cria db
con <- geocodebr:::create_geocodebr_db()

# ler amostra de dados
points_sf <- readRDS(
  system.file("extdata/pontos.rds", package = "geocodebr")
)

# adiciona tabela de pontos na db
points_df <- sfheaders::sf_to_df(points_sf, fill = T)
points_arrw <- arrow::as_arrow_table(points_df)
duckdb::duckdb_register_arrow(con, "points", points_arrw)

# instala extensao H3
get_h3_ext <- glue::glue(
  "INSTALL h3 FROM community;
  LOAD h3;"
  )

DBI::dbExecute(con, get_h3_ext)


# Add H3 id column directly in DuckDB
points_with_h3 <- DBI::dbGetQuery(
  con,
  "SELECT *,
         h3_latlng_to_cell(y, x, 9) AS h3_09
  FROM points"
)

head(points_with_h3)

[rafapereirabr]

obs. for the record. A solução com base no {h3jsr} parece beeem mais rapida. A comparacao nao ser super justa pq ignora o pipeline dos dados na funcao geocode(), mas a diferença é brutal

# ler amostra de dados
points_sf <- readRDS(
  system.file("extdata/pontos.rds", package = "geocodebr")
)
points_df <- sfheaders::sf_to_df(points_sf, fill = T)
points_arrw <- arrow::as_arrow_table(points_df)


h3_sf <- function(sf_obj = points_sf){
  
  hex <- sf_obj |> 
    h3jsr::point_to_cell(res = 9, simple = F)
  
  return(hex)
  }



h3_duck <- function(connn=con, points = points_arrw){
  
  connn <- geocodebr:::create_geocodebr_db()
  
  # instala extensao H3
  get_h3_ext <- glue::glue(
    "LOAD h3;"
  )
  
  DBI::dbExecute(connn, get_h3_ext)
  
  
  # adiciona tabela de pontos
  #duckdb::duckdb_unregister(connn, "points")
  duckdb::duckdb_register_arrow(connn, "points", points)
  
  # Add H3 id column directly in DuckDB
  hex <- DBI::dbGetQuery(
    connn,
    "SELECT *,
         h3_latlng_to_cell(y, x, 9) AS h3_09
  FROM points"
  )
  
  return(hex)
}


con <- geocodebr:::create_geocodebr_db()

bench::mark(
  sf = h3_sf,
  duck = h3_duck(), 
  iterations = 10, 
  check = F
  )

#' expression      min  median `itr/sec` mem_alloc `gc/sec` n_itr  n_gc
#'       1 sf        0     1ns    9.04e6        0B    0        10     0
#'     2 duck    229ms   277ms    3.66e0     342KB    0.407     9     1

[baarthur]

Imaginei que o {h3r} seria ainda melhor que o {h3jsr}, mas dessa vez eles empataram.

A função é um pouco mais verborrágica:

h3r_sf <- function(sf_obj = points_sf) {
  
  hex <- st_coordinates(sf_obj) 
  
  hex <- h3r::latLngToCell(hex[,2], hex[,1], 9)
  
  hex <- bind_cols(id = sf_obj$id, h3_res9 = hex)
  
  return(hex)
  
}

Eu ainda fiz points_sf <- geobr::read_municipal_seat() e aumentei as iterações do benchmark pra 100, eis o resultado: