add script gera_correlacoes

.gitignore

+.Rproj.user
+.Rhistory
+.RData
+.Ruserdata

dados-rastreador.Rproj

+Version: 1.0
+
+RestoreWorkspace: Default
+SaveWorkspace: Default
+AlwaysSaveHistory: Default
+
+EnableCodeIndexing: Yes
+UseSpacesForTab: Yes
+NumSpacesForTab: 2
+Encoding: UTF-8
+
+RnwWeave: Sweave
+LaTeX: pdfLaTeX

scripts/gera_correlacoes.R

+library(dplyr)
+library(tidyselect)
+library(stringr)
+library(nanoparquet)
+library(tidyr)
+library(readxl)
+library(purrr)
+
+# carrega caminhos para dados
+
+path_ncm <- file.path(
+  Sys.getenv("general"),
+  "Bases",
+  "correlacoes",
+  "mercosul",
+  "output",
+  "correlacao_completa_ncm.Rda"
+)
+
+path_ncm_detalhada <- file.path(
+  Sys.getenv("general"),
+  "Bases",
+  "correlacoes",
+  "mercosul",
+  "output",
+  "correlacao_completa_ncm_detalhada.xlsx"
+)
+
+path_naladi_ncm <- file.path(
+  Sys.getenv("general"),
+  "Bases",
+  "correlacoes",
+  "aladi",
+  "naladi_ncm",
+  "output",
+  "correlacao_naladi_ncm.Rda"
+)
+
+path_naladi_ncm_manual <- file.path(
+  Sys.getenv("general"),
+  "Bases",
+  "correlacoes",
+  "aladi",
+  "naladi_ncm",
+  "correlacao_ncm_naladi_manual.xlsx"
+)
+
+path_naladi <- file.path(
+  Sys.getenv("general"),
+  "Bases",
+  "correlacoes",
+  "aladi",
+  "naladi_naladi",
+  "output",
+  "correlacao_completa_naladi_ncmtracker.Rda"
+)
+
+path_descricoes <- file.path(
+  Sys.getenv("general"),
+  "Bases",
+  "NCM_sh1996_a_sh2022",
+  "descricoes_ncm_sh.xlsx"
+) 
+
+
+# Obter códigos que mudaram nas revisões ----------------------------------
+
+correlacao_ncm_detalhada <- read_xlsx(path_ncm_detalhada, guess_max = 1e6)
+
+# funcao para obter linhas com mudancas de codigo em cada revisao NCM
+filtra_mudancas <- function(x, padrao) {
+  x |> 
+    select(matches(padrao)) |> 
+    filter(
+      # seleciona as linhas que tem algum valor diferente de NA com exceção
+      # de dados na primeira coluna
+      if_any(-1, ~ !is.na(.))
+    ) |> 
+    # cria uma coluna preenchendo-a com a primeira informação não NA da
+    # direita para a esquerda
+    mutate(!!padrao := do.call(coalesce, rev(as.list(across(-1))))) |> 
+    select(
+      ncm_original = 1,
+      last_col()
+    ) |> 
+    distinct()
+}
+
+# cria lista de nomes para usar como input em filtra_mudancas
+nomes_para_funcao <- names(correlacao_ncm_detalhada) |> 
+  str_extract("NCM_\\d{4}") |> 
+  unique()
+
+# obtem lista com as ncms originais das revisoes
+ncms_originais <- nomes_para_funcao |> 
+  map(~ filtra_mudancas(correlacao_ncm_detalhada, padrao = .x))
+
+names(ncms_originais) <- nomes_para_funcao |>
+  str_replace("_", " ")
+
+saveRDS(ncms_originais, "dados_gerados/ncms_originais.rds")
+
+# Organiza dados da correlação NCM ----------------------------------------
+
+
+load(path_ncm)
+
+correlacao_completa <- correlacao_completa_ncm_mercosul |> 
+  distinct() |> 
+  rename_with(~str_to_upper(.x))
+
+write_parquet(correlacao_completa, "dados_gerados/dataset_ncm.parquet")
+
+
+# Organiza dados da correlação NCM Naladi ---------------------------------
+
+load(path_naladi_ncm)
+
+naladi_ncm_manual <- read_xlsx(path_naladi_ncm_manual)
+
+correlacao_completa <- correlacao_naladi_ncm |> 
+  distinct() |> 
+  rename_with(~str_to_upper(.x))
+
+# obtem ultimo ano
+colunas <- names(correlacao_completa)
+
+ano_max <- colunas |> 
+  str_extract("[0-9]+") |> 
+  max() |> 
+  unique()
+
+naladi_ncm_auto <- correlacao_completa |> 
+  select(contains(ano_max)) |> 
+  distinct()
+
+if(nrow(naladi_ncm_manual) >= nrow(naladi_ncm_auto)) {
+  naladi_ncm <- naladi_ncm_manual
+} else {
+  naladi_ncm <- naladi_ncm_auto
+}
+
+naladi_ncm |> 
+  write_parquet("dados_gerados/dataset_naladi_ncm.parquet")
+
+
+# Organiza dados da correlação Naladi -------------------------------------
+
+load(path_naladi)
+
+correlacao_completa <- correlacao_completa_naladi_naladi_ncmtracker |> 
+  # naladi 1983 tem 7 ou 8 digitos. os 8 digitos da naladi 1983 surgiram em 1992.
+  # como logo em seguida veio a naladi_1993 com 8 digitos, vamos
+  # descartar os codigos de 8 dígitos da naladi_1983.
+  # filter(nchar(naladi_1983) == 9) |>  # 9 digitos equivale a 7 digitos se contarmos os pontos
+  distinct() |> 
+  rename_with(~str_to_upper(.x)) |> 
+  mutate(NALADI_1983 = str_remove_all(NALADI_1983, "\\.")) |> 
+  mutate(NALADI_1983 = str_c(
+    str_sub(NALADI_1983, 1, 2),
+    ".",
+    str_sub(NALADI_1983, 3, 4),
+    ".",
+    str_sub(NALADI_1983, 5, 5),
+    ".",
+    str_sub(NALADI_1983, 6, 7)
+  ))
+
+colunas <- names(correlacao_completa)
+
+write_parquet(correlacao_completa, "dados_gerados/dataset_naladi.parquet")
+
+
+# Processa e organiza descrições NCM --------------------------------------
+descricoes_por_sh <- read_excel(
+  path_descricoes,
+  guess_max = 1e5
+) %>% 
+  rename(
+    sh = grupo_sh
+  )
+
+ultimo_sh <- descricoes_por_sh %>% 
+  distinct(sh) %>% 
+  pull(sh) %>% 
+  max()
+
+descricoes_por_sh <- descricoes_por_sh %>% 
+  # remove o ultimo sh, pois ha ncms que ja deixaram de existir
+  filter(sh != ultimo_sh) %>% 
+  mutate(
+    ncm = paste0(
+      str_sub(ncm, 1, 4), ".",
+      str_sub(ncm, 5, 6), ".",
+      str_sub(ncm, 7, 8)
+    ),
+    sh = paste("NCM", sh)
+  )
+
+
+
+####################
+# # obtem abas disponíveis
+# abas <- readxl::excel_sheets(path_descricoes)
+# # obtem nome da ultima aba
+# ultimo_sh <- abas[length(abas)]
+# # remove ultima aba
+# abas <- abas[-length(abas)]
+
+# append_descricoes <- function(aba) {
+#   read_xlsx(path_descricoes, sheet = aba) %>% 
+#     mutate(
+#       across(
+#         everything(),
+#         ~if_else(is.na(.x), "", .x)
+#       ),
+#       across(
+#         everything(),
+#         ~str_replace(.x, "^- ", "-")
+#       ),
+#       across(
+#         everything(),
+#         ~str_replace(.x, "^-- ", "--")
+#       ),
+#     ) %>%
+#     transmute(
+#       codigoFormatado,
+#       sh,
+#       descricao = paste(
+#         desc_pos,
+#         desc_subpos5,
+#         desc_subpos6,
+#         desc_item,
+#         desc_subitem,
+#         sep = "\n"
+#       )
+#     ) %>% 
+#     mutate(
+#       descricao = str_replace_all(
+#         descricao,
+#         "\n\n\n\n\n|\n\n\n\n|\n\n\n|\n\n",
+#         "\n"
+#       )
+#     ) %>% 
+#     mutate(
+#       descricao = str_remove(descricao, "\n$")
+#     )
+# }
+
+
+# descricoes_por_sh <- purrr::map_dfr(
+#   abas,
+#   ~ append_descricoes(.x)
+# ) %>% 
+#   rename(ncm = codigoFormatado) %>% 
+#   mutate(sh = str_replace(sh, "SH", "NCM"))
+
+
+descricoes_atuais <- 
+  readRDS(
+    file.path(
+      Sys.getenv("general"),
+      "Bases",
+      "NCM_sh1996_a_sh2022",
+      "descricoes_atuais.rds"
+    )
+  ) %>% 
+  as_tibble() %>% 
+  mutate(
+    ncm = paste0(
+      str_sub(ncm, 1, 4),
+      ".",
+      str_sub(ncm, 5, 6),
+      ".",
+      str_sub(ncm, 7, 8)
+    ),
+    sh = paste("NCM", ultimo_sh)
+  ) %>% 
+  relocate(sh, .after = ncm)
+
+descricoes_por_sh <- descricoes_por_sh %>% 
+  bind_rows(descricoes_atuais) %>% 
+  distinct()
+
+# necessário escapar ' para não dar problema na geração dos tooltips dos
+# diagramas
+descricoes_por_sh <- descricoes_por_sh %>% 
+  mutate(
+    descricao = str_replace_all(
+      descricao,
+      "'",
+      "\\\\'"
+    )) %>% 
+  mutate(
+    descricao = str_replace_all(
+      descricao,
+      "\\r\\n",
+      " "
+    ),
+    descricao = str_trunc(
+      descricao,
+      1020,
+      'left'
+    )
+  )
+
+# #####################################################
+# # ATENÇÃO: Solução provisória para descrições NCM ##
+# # Quando houver descrições para todas as NCMs ######
+# # remover o código abaixo ##########################
+# ####################################################
+# 
+# descricoes_por_sh <- descricoes_por_sh %>% 
+#   mutate(descricao = if_else(
+#     sh != "NCM 2022",
+#     " ",
+#     descricao
+#     ))
+
+
+descricoes_por_sh %>% 
+  write_parquet(
+    "dados_gerados/descricoes_ncm.parquet"
+  )