update gera_correlacoes

scripts/gera_correlacoes.R

@@ -60,7 +60,8 @@ path_descricoes <- file.path(
   Sys.getenv("general"),
   "Bases",
   "NCM_sh1996_a_sh2022",
-  "descricoes_ncm_sh.xlsx"
+  "raw",
+  "tabela_nomenclatura.parquet"
 ) 
 
 
@@ -117,7 +118,9 @@ write_parquet(correlacao_completa, "dados_gerados/dataset_ncm.parquet")
 
 # load(path_naladi_ncm)
 
-naladi_ncm_manual <- read_xlsx(path_naladi_ncm_manual)
+naladi_ncm_manual <- read_xlsx(
+  path_naladi_ncm_manual,
+  guess_max = 1e6)
 
 colunas <- names(naladi_ncm_manual)
 
@@ -130,21 +133,6 @@ naladi_ncm_manual <- naladi_ncm_manual |>
   select(contains(ano_max)) |> 
   distinct()
 
-# 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()
 
 naladi_ncm_manual |> 
   write_parquet("dados_gerados/dataset_naladi_ncm.parquet")
@@ -178,115 +166,127 @@ 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
-  )
+cria_padrao <- function(x) {
+  paste0(x, "$", collapse = "|")
+}
 
-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) %>% 
+descricoes_raw <- arrow::read_parquet(path_descricoes) |> 
+  select(
+    codigo,
+    nomeExtenso,
+    inicioVigencia,
+    inicioVigenciaStr,
+    fimVigencia,
+    fimVigenciaStr
+    ) |> 
   mutate(
-    ncm = paste0(
-      str_sub(ncm, 1, 4), ".",
-      str_sub(ncm, 5, 6), ".",
-      str_sub(ncm, 7, 8)
-    ),
-    sh = paste("NCM", sh)
-  )
+    grupo_sh = case_when(
+      str_detect(fimVigenciaStr, cria_padrao(1996:2001)) ~ "1996",
+      str_detect(fimVigenciaStr, cria_padrao(2002:2006)) ~ "2002",
+      str_detect(fimVigenciaStr, cria_padrao(2007:2011)) ~ "2007",
+      str_detect(fimVigenciaStr, cria_padrao(2012:2016)) ~ "2012",
+      fimVigencia == 1648695600000 ~ "2017",
+      TRUE ~ "2022",
+    )
+  ) |> 
+  group_by(grupo_sh, codigo) |> 
+  slice_max(order_by = fimVigencia, n = 1) |> 
+  ungroup()
 
 
+x <- descricoes_raw |> 
+  filter(nchar(codigo) != 2) |> 
+  select(codigo, nomeExtenso, grupo_sh) |> 
+  mutate(
+    n = nchar(codigo)
+  )
 
-####################
-# # 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"
+sh4 <- x |> 
+  filter(n == 4) |> 
+  select(-n) |>  
+  rename(sh4 = codigo) |> 
+  rename(desc_sh4 = nomeExtenso) |> 
+  mutate(desc_sh4 = str_squish(desc_sh4))
+
+sh5 <- x |> 
+  filter(
+    n == 5
+  ) |> 
+  select(-n) |> 
+  rename(sh5 = codigo) |> 
+  rename(desc_sh5 = nomeExtenso) |> 
+  mutate(desc_sh5 = str_squish(desc_sh5))
+  
+sh6 <- x |> 
+  filter(n == 6) |> 
+  select(-n) |>  
+  rename(sh6 = codigo) |> 
+  rename(desc_sh6 = nomeExtenso) |> 
+  mutate(desc_sh6 = str_squish(desc_sh6))
+
+sh7 <- x |> 
+  filter(n == 7) |> 
+  select(-n) |>  
+  rename(sh7 = codigo) |> 
+  rename(desc_sh7 = nomeExtenso) |> 
+  mutate(desc_sh7 = str_squish(desc_sh7))
+
+descricoes_por_sh <- x |> 
+  filter(n == 8) |> 
+  select(-n) |> 
+  mutate(
+    sh4 = str_sub(codigo, 1, 4),
+    sh5 = str_sub(codigo, 1, 5),
+    sh6 = str_sub(codigo, 1, 6),
+    sh7 = str_sub(codigo, 1, 7),
+    nomeExtenso = str_replace(
+      nomeExtenso,
+      "^- ",
+      "-"
+    )
+  ) |> 
+  mutate(
+    nomeExtenso = str_replace(
+      nomeExtenso,
+      "^-- ",
+      "--"
     )
-  ) %>% 
-  as_tibble() %>% 
+  ) |> 
+  left_join(sh4, by = c("sh4", "grupo_sh")) |> 
+  left_join(sh5, by = c("sh5", "grupo_sh")) |> 
+  left_join(sh6, by = c("sh6", "grupo_sh")) |> 
+  left_join(sh7, by = c("sh7", "grupo_sh")) |> 
+  select(-matches("^sh")) |> 
   mutate(
+    across(
+      starts_with("desc_sh"),
+      ~str_replace(.x, "^- ", "-")
+    ),
+    across(
+      starts_with("desc_sh"),
+      ~str_replace(.x, "^-- ", "--")
+    )
+  ) |> 
+  unite(
+    col = descricao,
+    starts_with("desc_sh"), nomeExtenso,
+    sep = "\n",
+    na.rm = TRUE
+  ) |> 
+  select(
+    ncm = codigo,
+    sh = grupo_sh,
+    descricao
+  ) |> 
+  mutate(
+    sh = paste("NCM", sh),
     ncm = paste0(
-      str_sub(ncm, 1, 4),
-      ".",
-      str_sub(ncm, 5, 6),
-      ".",
+      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
@@ -310,21 +310,7 @@ descricoes_por_sh <- descricoes_por_sh %>%
     )
   )
 
-# #####################################################
-# # 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(
+  arrow::write_parquet(
     "dados_gerados/descricoes_ncm.parquet"
   )