A versão v0.1.0 do {geocodebr} faz um tratamento muito simplicado para solucionar empates. O que o pacote faz atualmente:
contagem_cnefe.O {geocodebr} atualmente tem uma posicao mais conservadora de apontar como empate qualquer caso suspeito. Por exemplo, quando "tipo_resultado" é igual "dl03", a gente encontra só logradouro e bairro. MAS {geocodebr} aponta empate quando o resultado traz pontos com o mesmo logradouro e bairro com ceps diferentes. A questão é que é normal uma rua ter diferentes CEPS. Exemplo nesse caso aqui de uma rua com dois ceps
Entao o comportamento atual inflaciona muito o número de empates e faz uma correção 'grosseira' nivelando por baixo.
SoluçãoReescrevi a função de trata_empates_geocode() abaixo que busca lidar com 3 casos distintos:
a. Resultados não empatados
b. Casos de empate perdidos, i.e. que nao tem muito bem como recuperar.
"contagem_cnefe" (a solucao que atualmente ja eh adotada para todos os casos)c) Casos de empate que dá pra salvar
"contagem_cnefe", mas fica com o "endereco_encontrado" do caso com maior "contagem_cnefe"A função abaixo resolves os casos tipo (c) apenas se o usurio passar o parametro resolver_empates = TRUE. No entanto, uma alternativa seria nós resolvermos logo de cara os casos (c) e bem contabilizar como empate, que é o que ja fazemos com pontos localizamos a menos de 200 metros de distancia.
trata_empates_geocode <- function(output_df = parent.frame()$output_df,
resolver_empates = parent.frame()$resolver_empates,
verboso = parent.frame()$verboso) {
# encontra casos de empate
output_df[, empate := ifelse(.N > 1, TRUE, FALSE), by = tempidgeocodebr]
# calcula distancias entre casos empatados
output_df[empate == TRUE,
dist_geocodebr := dt_haversine(
lat, lon,
data.table::shift(lat), data.table::shift(lon)
),
by = tempidgeocodebr
]
# coloca distancia 0 p/ primeiro caso
output_df[empate == TRUE,
dist_geocodebr := ifelse(is.na(dist_geocodebr), 0, dist_geocodebr)
]
# ignora casos com dist menor do q 300 metros
output_df2 <- output_df[ empate==FALSE |
empate==TRUE & dist_geocodebr == 0 |
dist_geocodebr > 300
]
# update casos de empate
output_df2[, empate := ifelse(.N > 1, TRUE, FALSE), by = tempidgeocodebr]
# conta numero de casos empatados
ids_empate <- output_df2[empate == TRUE, ]$tempidgeocodebr
n_casos_empate <- unique(ids_empate) |> length()
# se nao for para resolver empates:
# - gera warning
# - retorna resultado assim mesmo
if (isFALSE(resolver_empates)) {
cli::cli_warn(
"Foram encontrados {n_casos_empate} casos de empate. Estes casos foram marcados com valor igual `TRUE` na coluna 'empate',
e podem ser inspecionados na coluna 'endereco_encontrado'. Alternativamente, use `resolver_empates==TRUE` para que o pacote
lide com os empates automaticamente."
)
}
# se for para resolver empates, trata de 3 casos separados
# a) nao empatados
# b) empatados perdidos (dis > 1Km e lograoduros ambiguos)
# solucao: usa caso com maior contagem_cnefe
# c) empatados mas que da pra salvar (dist < 1km e logradouros nao ambiguos)
# solucao: agrega casos provaveis de serem na mesma rua com media ponderada
# das coordenadas, mas retorna endereco_encontrado do caso com maior
# contagem_cnefe
if (isTRUE(resolver_empates)) {
# a) casos sem empate
df_sem_empate <- output_df2[empate == FALSE]
ids_sem_empate <- df_sem_empate$tempidgeocodebr
# b) empatados perdidos (dis > 1Km e lograoduros ambiguos) ---------------------------
# identifica lograoduros ambiguos (e.g. RUA A)
num_ext <- c(
'UM',
'DOIS',
'TRES',
'QUATRO',
'CINCO',
'SEIS',
'SETE',
'OITO',
'NOVE',
'DEZ',
'ONZE',
'DOZE',
'TREZE',
'QUATORZE',
'QUINZE',
'DEZESSEIS',
'DEZESSETE',
'DEZOITO' ,
'DEZENOVE',
'VINTE',
'TRINTA',
'QUARENTA',
'CINQUENTA',
'SESSENTA',
'SETENTA',
'OITENTA',
'NOVENTA'
)
ruas_letras <- paste(paste("RUA", LETTERS), collapse = " |")
ruas_numerais <- paste(paste("RUA", 1:30), collapse = " |")
ruas_num_ext <- paste(paste("RUA", num_ext), collapse = " |")
ruas_letras <- paste0(ruas_letras, " ")
ruas_numerais <- paste0(ruas_numerais, " ")
ruas_num_ext <- paste0(ruas_num_ext, " ")
# casos empatados muito distantes
ids_empate_too_distant <- output_df2[empate == TRUE & dist_geocodebr>1000]$tempidgeocodebr
empates_perdidos <- output_df2[
empate == TRUE &
(
tempidgeocodebr %in% ids_empate_too_distant |
endereco_encontrado %like% ruas_letras |
endereco_encontrado %like% ruas_numerais |
endereco_encontrado %like% ruas_num_ext |
endereco_encontrado %like% 'ESTRADA|RODOVIA'
)
]
# ainda dah pra salvar enderecos com datas (e.g. 'RUA 15 DE NOVEMBRO')
meses_pattern <- "\\b\\DE (JANEIRO|FEVEREIRO|MARÇO|ABRIL|MAIO|JUNHO|JULHO|AGOSTO|SETEMBRO|OUTUBRO|NOVEMBRO|DEZEMBRO)\\b"
empates_perdidos <- empates_perdidos[ ! grepl(meses_pattern, logradouro_encontrado) ]
# selecting the row with max 'contagem_cnefe'
empates_perdidos <- empates_perdidos[empates_perdidos[, .I[contagem_cnefe == max(contagem_cnefe)], by = tempidgeocodebr]$V1]
empates_perdidos <- empates_perdidos[empates_perdidos[, .I[1], by = tempidgeocodebr]$V1]
# c) casos de empate que podem ser salvos ---------------------------------
ids_empate_salve <- output_df2[!tempidgeocodebr %in% c(ids_sem_empate, empates_perdidos$tempidgeocodebr)]$tempidgeocodebr
empates_salve <- output_df2[ tempidgeocodebr %in% ids_empate_salve ]
# check if we left anyone behind
length(unique(output_df2$tempidgeocodebr)) == sum(
length(ids_sem_empate),
length(unique(empates_perdidos$tempidgeocodebr)) ,
length(unique(ids_empate_salve))
)
# calcula media ponderada das coordenadas
# fica com caso que tem max 'contagem_cnefe'
empates_salve[, c('lat', 'lon') := list(weighted.mean(lat, w = contagem_cnefe),
weighted.mean(lon, w = contagem_cnefe)
),
by = tempidgeocodebr]
# selecting the row with max 'contagem_cnefe'
empates_salve <- empates_salve[empates_salve[, .I[contagem_cnefe == max(contagem_cnefe)], by = tempidgeocodebr]$V1]
empates_salve <- empates_salve[empates_salve[, .I[1], by = tempidgeocodebr]$V1]
# junta tudo
output_df2 <- data.table::rbindlist(list(df_sem_empate, empates_salve, empates_perdidos))
output_df2[, 'contagem_cnefe' := NULL]
if (verboso) {
plural <- ifelse(n_casos_empate==1, 'caso', 'casos')
message(glue::glue(
"Foram encontrados e resolvidos {n_casos_empate} {plural} de empate."
))
}
}
# drop geocodebr dist columns
output_df2[, dist_geocodebr := NULL]
return(output_df2)
}
RetroSearch is an open source project built by @garambo | Open a GitHub Issue
Search and Browse the WWW like it's 1997 | Search results from DuckDuckGo
HTML:
3.2
| Encoding:
UTF-8
| Version:
0.7.4