Split perfs sp only

.gitignore

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

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,7 +28,6 @@ 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)

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/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,

R/sp_from_4_to_3.R

@@ -1,30 +1,41 @@
-# Small functions for use in from_4_to_3()
+# Small helper functions for variable selection in from_4_to_3()
 
-# Returns the hierarchical variable with the fewest nodes (= subtotals)
-smallest_hrc <- function(hrcfiles) {
+# Return the hierarchical variable with the fewest nodes/subtotals
+smallest_hrc <- function(hrcfiles, totcode) {
   v <- list()
-  for (i in 1:length(hrcfiles)) {
-    v <- append(v, nb_nodes(hrcfiles, names(hrcfiles[i])))
+  for (i in seq_along(hrcfiles)) {
+    v <- append(v, nb_nodes(hrcfiles, names(hrcfiles)[i], totcode = totcode))
   }
   index_smaller_hrc <- which.min(v)
   name_smaller_hrc <- names(hrcfiles)[index_smaller_hrc]
   return(name_smaller_hrc)
 }
 
-# Returns the variable with the fewest modalities
-smallest_mod <- function(dfs) {
+# Return the hierarchical variable with the most nodes/subtotals
+bigger_hrc <- function(hrcfiles, totcode) {
   v <- list()
-  for (colonne in dfs) {
-    v <- append(v,length(unique(colonne)))
+  for (i in seq_along(hrcfiles)) {
+    v <- append(v, nb_nodes(hrcfiles, names(hrcfiles)[i], totcode = totcode))
   }
-  index_smaller_mod <- which.min(v)
-  name_smaller_mod <- names(dfs)[index_smaller_mod]
-  return(name_smaller_mod)
+  index_bigger_hrc <- which.max(v)
+  name_bigger_hrc <- names(hrcfiles)[index_bigger_hrc]
+  return(name_bigger_hrc)
 }
 
-# Choose a categorical variable
-# Preferably the non-hierarchical one with the fewest modalities
-# If not available, the hierarchical variable with the fewest nodes
+# Return the categorical variable with the fewest unique modalities
+smallest_mod <- function(dfs) {
+  v <- sapply(dfs, function(col) length(unique(col)))
+  names(which.min(v))
+}
+
+# Return the categorical variable with the most unique modalities
+bigger_mod <- function(dfs) {
+  v <- sapply(dfs, function(col) length(unique(col)))
+  names(which.max(v))
+}
+
+# Priority 1: Pick non-hierarchical variable with fewest modalities (fewest tables created).
+# Priority 2: If no flat variable, pick hierarchical variable with fewest nodes.
 choose_var_priority_non_hierarchical <- function(dfs,totcode,hrcfiles){
   # The categorical variables without hierarchy
   cat_vars <- names(totcode)
@@ -49,35 +60,12 @@ choose_var_priority_non_hierarchical <- function(dfs,totcode,hrcfiles){
   }
   # Otherwise choose the hierarchical variable with the fewest subtotals
   else {
-    return (smallest_hrc(hrcfiles))
+    return (smallest_hrc(hrcfiles, totcode))
   }
 }
 
-# Returns the hierarchical variable with the most nodes
-bigger_hrc <- function(hrcfiles) {
-  v <- list()
-  for (i in 1:length(hrcfiles)) {
-    v <- append(v, nb_nodes(hrcfiles, names(hrcfiles[i])))
-  }
-  index_bigger_hrc <- which.max(v)
-  name_bigger_hrc <- names(hrcfiles)[index_bigger_hrc]
-  return(name_bigger_hrc)
-}
-
-# Returns the variable with the most modalities
-bigger_mod <- function(dfs) {
-  v <- list()
-  for (colonne in dfs) {
-    v <- append(v, length(unique(colonne)))
-  }
-  index_bigger_mod <- which.max(v)
-  name_bigger_mod <- names(dfs)[index_bigger_mod]
-  return(name_bigger_mod)
-}
-
-# Choose a categorical variable
-# Preferably the hierarchical one with the most nodes
-# If not available, the non-hierarchical variable with the most modalities
+# Priority 1: Pick hierarchical variable with most nodes (smaller sub-tables created).
+# Priority 2: If no hierarchical variable, pick flat variable with most modalities.
 choose_var_priority_hierarchical <- function(dfs, totcode, hrcfiles) {
   # Principle: preferably choose hierarchical variables
 
@@ -86,10 +74,11 @@ choose_var_priority_hierarchical <- function(dfs, totcode, hrcfiles) {
     return(bigger_mod(dfs[names(dfs) %in% names(totcode)]))
     # Otherwise, choose the hierarchical variable with the most subtotals
   } else {
-    return(bigger_hrc(hrcfiles))
+    return(bigger_hrc(hrcfiles, totcode))
   }
 }
 
+# Heuristic selector for merging variables according to 'maximize_nb_tabs'
 chose_var_to_merge <- function(dfs, totcode, hrcfiles, maximize_nb_tabs = FALSE) {
   if(maximize_nb_tabs){
     return(choose_var_priority_hierarchical(dfs, totcode, hrcfiles))
@@ -98,83 +87,23 @@ chose_var_to_merge <- function(dfs, totcode, hrcfiles, maximize_nb_tabs = FALSE)
   }
 }
 
-#' Function reducing from 4 to 3 categorical variables
+#' Transition from 4 to 3 categorical variables
 #'
-#' @param dfs data.frame with 4 categorical variables (n >= 2 in the general case)
-#' @param dfs_name name of the dataframe
+#' @param dfs data.frame with 4 categorical variables
+#' @param dfs_name name of the data.frame
 #' @param totcode named vector of totals for categorical variables
-#' @param hrcfiles named vector indicating the hrc files of hierarchical variables
-#' among the categorical variables of dfs
-#' @param sep_dir allows forcing the writing of hrc into a separate folder,
-#' default is FALSE
-#' @param hrc_dir folder to write hrc files if writing to a new folder is forced
-#' or if no folder is specified in hrcfiles
-#' @param v1 allows forcing the value of the first variable to merge,
-#' not specified by default (NULL)
-#' @param v2 allows forcing the value of the second variable to merge,
-#' not specified by default (NULL)
-#' @param sep separator used during concatenation of variables
-#' @param maximize_nb_tabs specifies whether to prefer selecting hierarchical variables with
-#' the most nodes in priority (TRUE), generating more tables but with smaller sizes,
-#' or non-hierarchical variables with the fewest modalities (FALSE) to create fewer tables
+#' @param hrcfiles named vector of hrc file paths
+#' @param sep_dir logical, if TRUE forces writing hrc files into hrc_dir
+#' @param hrc_dir folder to write hrc files
+#' @param v1 optional first variable to merge
+#' @param v2 optional second variable to merge
+#' @param sep separator used during variable concatenation
+#' @param maximize_nb_tabs logical, whether to prefer selecting hierarchical variables
 #'
-#' @return A list containing the following components:
-#' \itemize{
-#'   \item `tabs`: named list of 3-dimensional dataframes
-#'   (n-1 dimensions in the general case) with nested hierarchies
-#'   \item `hrc`: named list of hrc specific to the variable created
-#'   through merging
-#'   \item `alt_tot`: named list of totals
-#'   \item `vars`: named list of vectors representing the merged variables
-#'   during the two stages of dimension reduction
-#' }
+#' @return A list with `tabs`, `hrcs`, `alt_tot` and `vars`.
 #'
-#' @examples
-#' library(dplyr)
-#' data <- expand.grid(
-#'   ACT = c("Total", "A", "B", "A1", "A2", "B1", "B2"),
-#'   GEO = c("Total", "G1", "G2"),
-#'   SEX = c("Total", "F", "M"),
-#'   AGE = c("Total", "AGE1", "AGE2"),
-#'   stringsAsFactors = FALSE
-#' ) %>%
-#'   as.data.frame()
-#'
-#' data <- data %>% mutate(VALUE = 1)
-#'
-#' hrc_act <- "hrc_ACT.hrc"
-#'
-#' sdcHierarchies::hier_create(root = "Total", nodes = c("A","B")) %>%
-#'   sdcHierarchies::hier_add(root = "A", nodes = c("A1","A2")) %>%
-#'   sdcHierarchies::hier_add(root = "B", nodes = c("B1","B2")) %>%
-#'   sdcHierarchies::hier_convert(as = "argus") %>%
-#'   slice(-1) %>%
-#'   mutate(levels = substring(paste0(level,name),3)) %>%
-#'   select(levels) %>%
-#'   write.table(file = hrc_act, row.names = FALSE, col.names = FALSE, quote = FALSE)
-#'
-#' # Results of the function
-#' res1 <- from_4_to_3(
-#'   dfs = data,
-#'   dfs_name = "tab",
-#'   totcode = c(SEX = "Total", AGE = "Total", GEO = "Total", ACT = "Total"),
-#'   hrcfiles = c(ACT = hrc_act),
-#'   sep_dir = TRUE,
-#'   hrc_dir = "output"
-#' )
-#'
-#' # Maximize the number of tables
-#' res2 <- from_4_to_3(
-#'   dfs = data,
-#'   dfs_name = "tab",
-#'   totcode = c(SEX = "Total", AGE = "Total", GEO = "Total", ACT = "Total"),
-#'   hrcfiles = c(ACT = hrc_act),
-#'   sep_dir = TRUE,
-#'   hrc_dir = "output",
-#'   maximize_nb_tabs = TRUE
-#' )
 #' @keywords internal
-#' @export
+#' @noRd
 from_4_to_3 <- function(
   dfs,
   dfs_name,
@@ -187,6 +116,17 @@ from_4_to_3 <- function(
   sep = "_",
   maximize_nb_tabs = FALSE)
 {
+
+  # ----------------------------------------------------------------------------
+  # ROUTER: 4D -> 3D transition
+  # 1. Determine target directory for generated .hrc files.
+  # 2. Select / validate candidate variables v1 and v2 to merge.
+  # 3. Route execution to dedicated sub-method based on count of flat variables:
+  #      - 2 flat vars -> from_4_to_3_case_0_hr
+  #      - 1 flat + 1 HR var -> from_4_to_3_case_1_hr (forces v1=flat, v2=HR)
+  #      - 2 HR vars -> from_4_to_3_case_2_hr
+  # ----------------------------------------------------------------------------
+
   # Update the output directory containing the hierarchies
   if( (length(hrcfiles) != 0) & !sep_dir){
     dir_name <- dirname(hrcfiles[[1]])