Skip to content

Commit

Permalink
otimizacao das funcoes
Browse files Browse the repository at this point in the history
  • Loading branch information
@dhersz
dhersz committed Mar 19, 2024
1 parent 2e0e9fe commit a63cd82
Show file tree
Hide file tree
Showing 8 changed files with 93 additions and 51 deletions.
21 changes: 15 additions & 6 deletions R/padronizar_bairros.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -25,18 +25,23 @@
padronizar_bairros <- function(bairros) {
checkmate::assert_character(bairros)

bairros_dedup <- unique(bairros)

# alguns bairros podem vir vazios e devem permanecer vazios ao final.
# identificamos o indice dos bairros vazios para "reesvazia-los" ao final,
# ja que a sequencia de operacoes abaixo acabaria atribuindo um valor a eles

indice_bairro_vazio <- which(is.na(bairros))
indice_bairro_vazio <- which(is.na(bairros) | bairros == "")

bairros_padrao <- stringr::str_squish(bairros)
bairros_padrao <- toupper(bairros_padrao)
bairros_padrao <- stringi::stri_trans_general(bairros_padrao, "Latin-ASCII")
bairros_padrao_dedup <- stringr::str_squish(bairros_dedup)
bairros_padrao_dedup <- toupper(bairros_padrao_dedup)
bairros_padrao_dedup <- stringi::stri_trans_general(
bairros_padrao_dedup,
"Latin-ASCII"
)

bairros_padrao <- stringr::str_replace_all(
bairros_padrao,
bairros_padrao_dedup <- stringr::str_replace_all(
bairros_padrao_dedup,
c(
# pontuacao
"\\.\\.+" = ".", # remover pontos repetidos
Expand Down Expand Up @@ -138,6 +143,10 @@ padronizar_bairros <- function(bairros) {
)
)

names(bairros_padrao_dedup) <- bairros_dedup
bairros_padrao <- bairros_padrao_dedup[bairros]
names(bairros_padrao) <- NULL

bairros_padrao[indice_bairro_vazio] <- ""

return(bairros_padrao)
Expand Down
18 changes: 12 additions & 6 deletions R/padronizar_ceps.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -31,6 +31,8 @@ padronizar_ceps <- function(ceps) {
combine = "or"
)

ceps_dedup <- unique(ceps)

# alguns ceps podem vir vazios e devem permanecer vazios ao final. nesse caso,
# a chamada da str_pad() abaixo faz com que esses ceps virem '00000000'. para
# evitar que o resultado contenha esses valores, identificamos o indice dos
Expand All @@ -39,20 +41,24 @@ padronizar_ceps <- function(ceps) {
indice_cep_vazio <- which(ceps == "" | is.na(ceps))

if (is.numeric(ceps)) {
ceps_padrao <- formatC(ceps, width = 8, format = "d", flag = 0)
ceps_padrao_dedup <- formatC(ceps_dedup, width = 8, format = "d", flag = 0)
} else {
erro_se_letra_presente(ceps)

ceps_padrao <- ceps
ceps_padrao_dedup <- ceps_dedup
}

ceps_padrao <- stringr::str_replace_all(ceps_padrao, c("\\.|,| " = ""))
ceps_padrao <- stringr::str_pad(ceps_padrao, width = 8, pad = "0")
ceps_padrao <- stringr::str_replace_all(
ceps_padrao,
ceps_padrao_dedup <- stringr::str_replace_all(ceps_padrao_dedup, c("\\.|,| " = ""))
ceps_padrao_dedup <- stringr::str_pad(ceps_padrao_dedup, width = 8, pad = "0")
ceps_padrao_dedup <- stringr::str_replace_all(
ceps_padrao_dedup,
c("(\\d{5})(\\d{3})" = "\\1-\\2")
)

names(ceps_padrao_dedup) <- ceps_dedup
ceps_padrao <- ceps_padrao_dedup[as.character(ceps)]
names(ceps_padrao) <- NULL

ceps_padrao[indice_cep_vazio] <- ""

erro_se_digitos_demais(ceps_padrao)
Expand Down
43 changes: 26 additions & 17 deletions R/padronizar_estados.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -39,19 +39,21 @@ padronizar_estados <- function(estados) {
combine = "or"
)

estados_dedup <- unique(estados)

# alguns estados podem vir vazios e devem permanecer vazios ao final.
# identificamos o indice dos estados vazios para "reesvazia-los" ao final, ja
# que a sequencia de operacoes abaixo acabaria atribuindo um valor a eles

indice_estado_vazio <- which(estados == "" | is.na(estados))

if (is.numeric(estados)) {
estados_padrao <- formatC(estados, format = "d")
if (is.numeric(estados_dedup)) {
estados_padrao_dedup <- formatC(estados_dedup, format = "d")
} else {
estados_padrao <- stringr::str_squish(estados)
estados_padrao <- toupper(estados_padrao)
estados_padrao <- stringr::str_replace_all(
estados_padrao,
estados_padrao_dedup <- stringr::str_squish(estados_dedup)
estados_padrao_dedup <- toupper(estados_padrao_dedup)
estados_padrao_dedup <- stringr::str_replace_all(
estados_padrao_dedup,
c("\\b0+(\\d+)\\b" = "\\1")
)
}
Expand All @@ -65,33 +67,40 @@ padronizar_estados <- function(estados) {
names(vetor_busca_com_cod) <- codigos_estados$codigo_estado
names(vetor_busca_com_abrev) <- codigos_estados$abrev_estado

result_busca_com_cod <- vetor_busca_com_cod[estados_padrao]
result_busca_com_abrev <- vetor_busca_com_abrev[estados_padrao]
result_busca_com_cod <- vetor_busca_com_cod[estados_padrao_dedup]
result_busca_com_abrev <- vetor_busca_com_abrev[estados_padrao_dedup]

estados_padrao <- ifelse(
estados_padrao_dedup <- ifelse(
is.na(result_busca_com_cod),
result_busca_com_abrev,
result_busca_com_cod
)
names(estados_padrao) <- NULL
names(estados_padrao_dedup) <- NULL

estados_padrao <- ifelse(
is.na(estados_padrao),
estados_padrao_dedup <- ifelse(
is.na(estados_padrao_dedup),
estados,
estados_padrao
estados_padrao_dedup
)

estados_padrao[indice_estado_vazio] <- ""

if (any(! estados_padrao %in% c(codigos_estados$nome_estado, ""))) {
if (any(! estados_padrao_dedup %in% c(codigos_estados$nome_estado, "", NA))) {
# aqui com certeza podem entrar outras manipulacoes, como substituir GDE por
# GRANDE (em RIO GDE DO SUL, por exemplo), corrigir registros com ortografia
# errada, etc. mas ainda nao encontrei nenhuma base com esse problemas,
# entao optei por deixar apenas o comando abaixo como exemplo de manipulacao
# a ser feita, e a medida que forem surgindo problemas vou atualizando aqui.

estados_padrao <- stringi::stri_trans_general(estados_padrao, "Latin-ASCII")
estados_padrao_dedup <- stringi::stri_trans_general(
estados_padrao_dedup,
"Latin-ASCII"
)
}

names(estados_padrao_dedup) <- estados_dedup
estados_padrao <- estados_padrao_dedup[as.character(estados)]
names(estados_padrao) <- NULL

estados_padrao[indice_estado_vazio] <- ""

return(estados_padrao)
}
21 changes: 15 additions & 6 deletions R/padronizar_logradouro.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -26,18 +26,23 @@
padronizar_logradouros <- function(logradouros) {
checkmate::assert_character(logradouros)

logradouros_dedup <- unique(logradouros)

# alguns logradouros podem vir vazios e devem permanecer vazios ao final.
# identificamos o indice dos logradouros vazios para "reesvazia-los" ao final,
# ja que a sequencia de operacoes abaixo acabaria atribuindo um valor a eles

indice_logradouro_vazio <- which(is.na(logradouros))
indice_logradouro_vazio <- which(is.na(logradouros) | logradouros == "")

logradouros_padrao <- stringr::str_squish(logradouros)
logradouros_padrao <- toupper(logradouros_padrao)
logradouros_padrao <- stringi::stri_trans_general(logradouros_padrao, "Latin-ASCII")
logradouros_padrao_dedup <- stringr::str_squish(logradouros_dedup)
logradouros_padrao_dedup <- toupper(logradouros_padrao_dedup)
logradouros_padrao_dedup <- stringi::stri_trans_general(
logradouros_padrao_dedup,
"Latin-ASCII"
)

logradouros_padrao <- stringr::str_replace_all(
logradouros_padrao,
logradouros_padrao_dedup <- stringr::str_replace_all(
logradouros_padrao_dedup,
c(
# pontuacao
"\\.\\.+" = ".", # ponto repetido
Expand Down Expand Up @@ -239,6 +244,10 @@ padronizar_logradouros <- function(logradouros) {
)
)

names(logradouros_padrao_dedup) <- logradouros_dedup
logradouros_padrao <- logradouros_padrao_dedup[logradouros]
names(logradouros_padrao) <- NULL

logradouros_padrao[indice_logradouro_vazio] <- ""

return(logradouros_padrao)
Expand Down
38 changes: 22 additions & 16 deletions R/padronizar_municipios.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -44,19 +44,21 @@ padronizar_municipios <- function(municipios) {
combine = "or"
)

municipios_dedup <- unique(municipios)

# alguns municipios podem vir vazios e devem permanecer vazios ao final.
# identificamos o indice dos municipios vazios para "reesvazia-los" ao final,
# ja que a sequencia de operacoes abaixo acabaria atribuindo um valor a eles

indice_municipio_vazio <- which(municipios == "" | is.na(municipios))

if (is.numeric(municipios)) {
municipios_padrao <- formatC(municipios, format = "d")
if (is.numeric(municipios_dedup)) {
municipios_padrao_dedup <- formatC(municipios_dedup, format = "d")
} else {
municipios_padrao <- stringr::str_squish(municipios)
municipios_padrao <- toupper(municipios_padrao)
municipios_padrao <- stringr::str_replace_all(
municipios_padrao,
municipios_padrao_dedup <- stringr::str_squish(municipios_dedup)
municipios_padrao_dedup <- toupper(municipios_padrao_dedup)
municipios_padrao_dedup <- stringr::str_replace_all(
municipios_padrao_dedup,
c("\\b0+(\\d+)\\b" = "\\1")
)
}
Expand All @@ -72,34 +74,38 @@ padronizar_municipios <- function(municipios) {
names(vetor_busca_com_cod7) <- codigos_municipios$codigo_muni
names(vetor_busca_com_cod6) <- substr(codigos_municipios$codigo_muni, 1, 6)

result_busca_com_cod7 <- vetor_busca_com_cod7[municipios_padrao]
result_busca_com_cod6 <- vetor_busca_com_cod6[municipios_padrao]
result_busca_com_cod7 <- vetor_busca_com_cod7[municipios_padrao_dedup]
result_busca_com_cod6 <- vetor_busca_com_cod6[municipios_padrao_dedup]

result_busca_com_cod <- ifelse(
is.na(result_busca_com_cod7),
result_busca_com_cod6,
result_busca_com_cod7
)

municipios_padrao <- ifelse(
municipios_padrao_dedup <- ifelse(
is.na(result_busca_com_cod),
municipios_padrao,
municipios_padrao_dedup,
result_busca_com_cod
)
names(municipios_padrao) <- NULL

municipios_padrao[indice_municipio_vazio] <- ""
names(municipios_padrao_dedup) <- NULL

municipio_nao_padrao <- !(
municipios_padrao %in% c(codigos_municipios$nome_muni, "")
municipios_padrao_dedup %in% c(codigos_municipios$nome_muni, "", NA)
)

if (any(municipio_nao_padrao)) {
municipios_padrao[municipio_nao_padrao] <- manipular_nome_muni(
municipios_padrao[municipio_nao_padrao]
municipios_padrao_dedup[municipio_nao_padrao] <- manipular_nome_muni(
municipios_padrao_dedup[municipio_nao_padrao]
)
}

names(municipios_padrao_dedup) <- municipios_dedup
municipios_padrao <- municipios_padrao_dedup[as.character(municipios)]
names(municipios_padrao) <- NULL

municipios_padrao[indice_municipio_vazio] <- ""

return(municipios_padrao)
}

Expand Down
1 change: 1 addition & 0 deletions tests/testthat/test-padronizar_bairros.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -11,6 +11,7 @@ test_that("padroniza corretamente", {
expect_equal(padronizar_bairros("jardim botanico"), "JARDIM BOTANICO")
expect_equal(padronizar_bairros("jd..botanico"), "JARDIM BOTANICO")
expect_equal(padronizar_bairros(NA_character_), "")
expect_equal(padronizar_bairros(""), "")
})

test_that("lida com vetores vazios corretamente", {
Expand Down
1 change: 1 addition & 0 deletions tests/testthat/test-padronizar_ceps.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -45,6 +45,7 @@ test_that("padroniza corretamente", {
expect_equal(padronizar_ceps(1000000), "01000-000")
expect_equal(padronizar_ceps(NA_character_), "")
expect_equal(padronizar_ceps(NA_integer_), "")
expect_equal(padronizar_ceps(""), "")

expect_equal(
padronizar_ceps(c(22290140, 1000000)),
Expand Down
1 change: 1 addition & 0 deletions tests/testthat/test-padronizar_logradouros.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -9,6 +9,7 @@ test_that("padroniza corretamente", {

expect_equal(padronizar_logradouros("r. gen.. glicério"), "RUA GENERAL GLICERIO")
expect_equal(padronizar_logradouros(NA_character_), "")
expect_equal(padronizar_logradouros(""), "")
})

test_that("lida com vetores vazios corretamente", {
Expand Down

2 comments on commit a63cd82

@lucasmation
Copy link

@lucasmation lucasmation commented on a63cd82 Mar 20, 2024 •
edited
Loading

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

@dhersz, voce chegou a vers esta forma de fazer o merge no final é mais rapida do que via data.table?

names(bairros_padrao_dedup) <- bairros_dedup
  bairros_padrao <- bairros_padrao_dedup[bairros]
  names(bairros_padrao) <- NULL

to vendo que é mais Base-R. pessoalmente eu acho pouco transparente esta estratégia de merge baseada no nome das posicoes do vetor. Se fo mais rapida tudo bem. Se nao for melhor criar um data.table interno e fazer o merge A[B,on='var']

@dhersz
Copy link
Member Author

@dhersz dhersz commented on a63cd82 Mar 20, 2024

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

É mais rápido sim, fiz uns testes na hora. Exemplo usando os logradouros da RAIS (3.1 milhões de registros totais, 2.4 mi únicos):

lookup_with_dt <- function(original, dedup, dedup_padrao) {
  dt_destino <- data.table::data.table(logradouro = original)
  dt_origem <- data.table::data.table(
    nao_padrao = dedup,
    padrao = dedup_padrao
  )
  dt_destino[
    dt_origem,
    on = c(logradouro = "nao_padrao"),
    logradouro_padrao := i.padrao
  ]
  dt_destino$logradouro_padrao
}

lookup_with_vec <- function(original, dedup, dedup_padrao) {
  names(dedup_padrao) <- dedup
  logradouros_padrao <- dedup_padrao[original]
  names(logradouros_padrao) <- NULL
  logradouros_padrao
}

identical(
  lookup_with_dt(logradouros, logradouros_dedup, logradouros_padrao_dedup),
  lookup_with_vec(logradouros, logradouros_dedup, logradouros_padrao_dedup)
)
#> TRUE

bench::mark(
  lookup_with_dt(logradouros, logradouros_dedup, logradouros_padrao_dedup),
  lookup_with_vec(logradouros, logradouros_dedup, logradouros_padrao_dedup),
  iterations = 10
)
#> # A tibble: 2 × 13
#>   expression                                 min median `itr/sec` mem_alloc `gc/sec` n_itr  n_gc total_time result memory     time       gc      
#>   <bch:expr>                             <bch:t> <bch:>     <dbl> <bch:byt>    <dbl> <int> <dbl>   <bch:tm> <list> <list>     <list>     <list>  
#> 1 lookup_with_dt(logradouros, logradour…   10.3s  10.4s    0.0958     191MB    0.319     3    10     31.32s <chr>  <Rprofmem> <bench_tm> <tibble>
#> 2 lookup_with_vec(logradouros, logradou… 949.2ms     1s    0.998      133MB    1.50      4     6      4.01s <chr>  <Rprofmem> <bench_tm> <tibble>

Usando a base de bairros, que tem mais valores repetidos (3.1 milhões totais, 166k únicos):

bench::mark(
  lookup_with_dt(bairros, bairros_dedup, bairros_padrao_dedup),
  lookup_with_vec(bairros, bairros_dedup, bairros_padrao_dedup),
  iterations = 20
)
#> # A tibble: 2 × 13
#>   expression                                 min median `itr/sec` mem_alloc `gc/sec` n_itr  n_gc total_time result memory     time       gc      
#>   <bch:expr>                               <bch> <bch:>     <dbl> <bch:byt>    <dbl> <int> <dbl>   <bch:tm> <list> <list>     <list>     <list>  
#> 1 lookup_with_dt(bairros, bairros_dedup, … 738ms  759ms      1.31     122MB     1.07    11     9      8.41s <NULL> <Rprofmem> <bench_tm> <tibble>
#> 2 lookup_with_vec(bairros, bairros_dedup,… 668ms  692ms      1.45     199MB     2.17     8    12      5.53s <NULL> <Rprofmem> <bench_tm> <tibble>

Quanto maior o número de valores únicos, maior o ganho de tempo de fazer o merge dessa forma.

Confesso que não pensei muito na questão da transparência na hora de implementar. Já é uma estratégia que uso há muito tempo quando preciso fazer o "look up" entre dois vetores, então veio naturalmente e já internalizei o bastante pra achar legível. Se achar que nesse caso é melhor priorizar a transparência, posso adaptar.

Please sign in to comment.