Get all dev summer 2026

.gitignore

@@ -24,3 +24,4 @@ output/
 vignettes/tauargus_files/
 vignettes/hrc/
 vignettes/example_1/
+bench/

DESCRIPTION

@@ -2,7 +2,7 @@ Package: rtauargus
 Type: Package
 Title: Using Tau-Argus from R
 Language: fr
-Version: 1.3.5
+Version: 1.3.6
 Depends: R (>= 4.1.0)
 Imports:
     purrr (>= 0.2),

NAMESPACE

@@ -3,29 +3,20 @@
 export(analyse_metadata)
 export(create_edges)
 export(dataframe_result)
+export(explore_reduce_dims)
 export(format_template)
-export(from_4_to_3)
-export(from_4_to_3_case_0_hr)
-export(from_4_to_3_case_1_hr)
-export(from_4_to_3_case_2_hr)
-export(from_5_to_3)
 export(grp_tab_in_cluster)
 export(grp_tab_names)
 export(identify_hrc)
 export(identify_hrc_with_eq)
 export(import)
-export(length_tabs)
 export(micro_arb)
 export(micro_asc_rda)
 export(micro_rtauargus)
-export(nb_tab_generated)
-export(reduce_dims)
 export(reset_rtauargus_options)
-export(restore_format)
 export(rtauargus_options)
 export(rtauargus_plus)
 export(run_arb)
-export(sp_format)
 export(split_dataframe)
 export(split_in_clusters)
 export(summarize_secret)
@@ -37,56 +28,66 @@ export(tab_rtauargus2)
 export(tab_rtauargus4)
 export(tab_to_treat)
 export(tabulate_micro_data)
-export(var_to_merge)
 export(write_hrc)
 export(write_hrc2)
 import(data.table, except = transpose)
 import(utils)
-importFrom(dplyr,"%>%")
-importFrom(dplyr,across)
-importFrom(dplyr,all_of)
-importFrom(dplyr,arrange)
-importFrom(dplyr,bind_rows)
-importFrom(dplyr,case_when)
-importFrom(dplyr,distinct)
-importFrom(dplyr,everything)
-importFrom(dplyr,filter)
-importFrom(dplyr,group_by)
-importFrom(dplyr,last_col)
-importFrom(dplyr,left_join)
-importFrom(dplyr,mutate)
-importFrom(dplyr,n)
-importFrom(dplyr,n_distinct)
-importFrom(dplyr,pull)
-importFrom(dplyr,rename)
-importFrom(dplyr,rename_with)
-importFrom(dplyr,row_number)
-importFrom(dplyr,rowwise)
-importFrom(dplyr,select)
-importFrom(dplyr,summarise)
-importFrom(dplyr,tibble)
-importFrom(dplyr,ungroup)
-importFrom(dplyr,where)
-importFrom(igraph,graph_from_data_frame)
-importFrom(igraph,which_mutual)
-importFrom(lifecycle,badge)
-importFrom(lifecycle,deprecated)
-importFrom(purrr,compact)
-importFrom(purrr,discard)
-importFrom(purrr,imap_dfr)
-importFrom(purrr,list_c)
-importFrom(purrr,map)
-importFrom(purrr,map2)
-importFrom(purrr,map_at)
-importFrom(purrr,transpose)
+importFrom(dplyr,
+  "%>%",
+  across,
+  all_of,
+  arrange,
+  bind_rows,
+  case_when,
+  distinct,
+  everything,
+  filter,
+  group_by,
+  last_col,
+  left_join,
+  mutate,
+  n,
+  n_distinct,
+  pull,
+  rename,
+  rename_with,
+  row_number,
+  rowwise,
+  select,
+  summarise,
+  tibble,
+  ungroup,
+  where
+)
+importFrom(igraph,
+  graph_from_data_frame,
+  which_mutual
+)
+importFrom(lifecycle,
+  badge,
+  deprecated
+)
+importFrom(purrr,
+  compact,
+  discard,
+  imap_dfr,
+  list_c,
+  map,
+  map2,
+  map_at,
+  transpose
+)
 importFrom(rlang,.data)
-importFrom(sdcHierarchies,hier_convert)
-importFrom(sdcHierarchies,hier_import)
+importFrom(sdcHierarchies,
+  hier_convert,
+  hier_import
+)
 importFrom(stats,setNames)
-importFrom(stringr,str_detect)
-importFrom(tidyr,nest)
-importFrom(tidyr,pivot_longer)
-importFrom(tidyr,unnest)
-importFrom(tidyr,unnest_wider)
+importFrom(tidyr,
+  nest,
+  pivot_longer,
+  unnest,
+  unnest_wider
+)
 importFrom(utils,combn)
 importFrom(zoo,na.locf)

R/format_template.R

@@ -215,6 +215,7 @@ format_template <- function(data,indicator_column,spanning_var_tot,field_columns
           FALSE
         }
       })
+
       spanning_description <- purrr::imap_dfr(
         tables_crossing_variables,
         ~ {
@@ -223,12 +224,13 @@ format_template <- function(data,indicator_column,spanning_var_tot,field_columns
             paste0("hrc_", tolower(names(.x)), "_", sapply(.x, function(col) length(unique(col)))),
             names(.x)
           )
-          # Extract variable names and formatted counts
-          variable_names <- names(formatted_counts) # Spanning variables
-          hrc_values <- formatted_counts            # Corresponding hrc values
+
+          nb_modalities <- sapply(.x, function(col) length(unique(col)))
+          variable_names <- paste0(names(nb_modalities),"_",nb_modalities) # Spanning variables
+          hrc_values <- paste0("hrc_", tolower(names(.x))) # Corresponding hrc values
           unique_modalities <- setNames(
             sapply(.x, function(col) unique(col), simplify = FALSE),
-            formatted_counts
+            hrc_values
           )
           # Create a dynamic data frame
           data.frame(

R/globals.R

@@ -7,5 +7,5 @@ utils::globalVariables(
     "eq_name","unit","var","n_total","total_alt","group","initial_indicator","spanning_new",
     "spanning_key","all_sides","side","sides_manquants","table_name_combined","var_mapped",
     "totcode","all_combinations","covered_sides","VALUE", "status", "nb_cells",
-    "value",".")
+    "value",".", "nb_tab", "max_size", "min_size")
 )

R/identify_hrc.R

@@ -48,24 +48,43 @@ identify_hrc <- function(df_metadata_long){
     table_name = df_spannings$table_name
   ) %>% unique()
   df_spannings <- df_spannings %>% select(-spanning_old)
-  if(all(is.na(df_spannings$hrc_indicator))){ # condition for hierarchies on indicators
-    df_indicators <- df_spannings
-    return(list(df_indicators,df_variable_info))
-  } else {
-    df_indicators <- df_spannings %>%
+
+  # Hierachies on indicators
+  if (any(!is.na(df_spannings$hrc_indicator))) {
+    df_hrc_indicator <- df_spannings %>%
       filter(!is.na(hrc_indicator)) %>%
-      dplyr::group_by(table_name) %>%
+      group_by(table_name) %>%
       summarise(
         field = last(field),
         hrc_field = last(hrc_field),
-        spanning = paste0(toupper(last(hrc_indicator)),"^h"),
+        spanning = paste0(toupper(last(hrc_indicator)), "^h"),
         hrc_spanning = last(hrc_indicator),
         indicator = last(indicator),
         hrc_indicator = last(hrc_indicator)
       ) %>%
       bind_rows(df_spannings, .) %>%
       arrange(table_name)
-    list_hrc_identified = list(df_indicators,df_variable_info)
-    return(list_hrc_identified)
+  } else {
+    df_hrc_indicator <- df_spannings
+  }
+  # Hierarchies on fields
+  if (any(!is.na(df_spannings$hrc_field))) {
+    df_hrc_field <- df_hrc_indicator %>%
+      filter(!is.na(hrc_field)) %>%
+      group_by(table_name) %>%
+      summarise(
+        field = last(hrc_field),
+        hrc_field = last(hrc_field),
+        spanning = paste0(toupper(last(hrc_field)), "^h"),
+        hrc_spanning = last(hrc_field),
+        indicator = last(indicator),
+        hrc_indicator = last(hrc_indicator)
+      ) %>%
+      bind_rows(df_hrc_indicator, .) %>%
+      arrange(table_name)
+  } else {
+    df_hrc_field <- df_hrc_indicator
   }
+
+  list(df_hrc_field,df_variable_info)
 }

R/identify_hrc_with_eq.R

@@ -100,7 +100,7 @@ identify_hrc_with_eq <- function(df_metadata_long,df_eq_indicator){
     dplyr::filter(!is.na(rhs)) %>%
     dplyr::mutate(
       total = trimws(as.character(total)),
-      rhs   = trimws(as.character(rhs))
+      rhs = trimws(as.character(rhs))
     ) %>%
     dplyr::distinct() %>%
     left_join(alt_map, by = c("eq_name", "total")) %>%
@@ -152,6 +152,27 @@ identify_hrc_with_eq <- function(df_metadata_long,df_eq_indicator){
       hrc_indicator = ifelse(indicator %in% unique(equations_long$var), NA, hrc_indicator)
     )
 
+  if (any(!is.na(df_spannings$hrc_field))) {
+    df_spannings <- df_spannings %>%
+      mutate(
+        field = ifelse(is.na(hrc_field), field, toupper(hrc_field)))
+
+    spanning_field_rows <- df_spannings %>%
+      filter(!is.na(hrc_field)) %>%
+      group_by(table_name) %>%
+      summarise(
+        field = last(hrc_field),
+        hrc_field = last(hrc_field),
+        spanning = paste0(toupper(last(hrc_field)), "^h"),
+        hrc_spanning = last(hrc_spanning),
+        indicator = last(indicator),
+        hrc_indicator = last(hrc_indicator)
+      )
+
+    df_spannings <- bind_rows(df_spannings, spanning_field_rows) %>%
+      arrange(table_name)
+  }
+
   df_spannings_eq <- df_spannings %>%
     mutate(across(dplyr::where(is.character), ~ gsub("[^[:alnum:]_]", "", .))) %>%
     left_join(equations_long_full, by = c("indicator" = "var"))
@@ -399,7 +420,7 @@ regroup_tables <- function(df_group, spanning_combination_group) {
     df_group |>
       filter(table_name %in% tables_complete) |>
       left_join(spanning_by_table |> select(table_name, spanning_key), by = "table_name") |>
-      group_by(across(-c(table_name, side, var_mapped, indicator))) |>
+      group_by(across(-c(table_name, side, var_mapped, indicator, eq_name))) |>
       summarise(
         table_name = paste(sort(unique(table_name)), collapse = "."),
         indicator = last(unit),

R/multitable.R

@@ -124,8 +124,7 @@ tab_multi_manager <- function(
     num_iter_max = 10,
     summary_secret = FALSE,
     split_tab = FALSE,
-    nb_tab_option = "smart",
-    limit = 14700,
+    split_limit = NULL,
     ...
 ){
   start_time <- Sys.time()
@@ -143,8 +142,11 @@ tab_multi_manager <- function(
   params$suppress = suppress
   params$suppress = suppress
   params$split_tab = split_tab
-  params$nb_tab_option = nb_tab_option
-  params$limit = limit
+
+  params$nb_tab_option = if (!is.null(.dots$nb_tab_option)) .dots$nb_tab_option else "smart"
+  params$split_limit = split_limit
+  # Enabled by default for multi-table manager calls
+  params$compact_verbose <- if (!is.null(.dots[["compact_verbose"]])) .dots[["compact_verbose"]] else TRUE
 
   n_tbx = length(list_tables) # nombre de tableaux
 
@@ -368,7 +370,11 @@ tab_multi_manager <- function(
     num_iter_all <- num_iter_all + 1
     num_tableau <- todolist[1]
     num_iter_par_tab[num_tableau] <- num_iter_par_tab[num_tableau] + 1
-    cat("--- Current table to treat: ", num_tableau, "---\n")
+
+    # cat("--- Current table to treat: ", num_tableau, "---\n")
+    cat(sprintf("\r--- Current table to treat: %s | loop iter : %d ---            ",
+                num_tableau, num_iter_all))
+    flush.console()
 
     nom_col_identifiante <- paste0("T_", num_tableau)
     tableau_a_traiter <- which(table_majeure[[nom_col_identifiante]])
@@ -492,6 +498,8 @@ tab_multi_manager <- function(
 
   }
 
+  cat("\n")
+
   # Reconstruire la liste des tableaux d'entrée
   liste_tbx_res <- purrr::imap(
     list_tables,