From 20e71aea0c0c248b59f4551c929ed278bb3dbe2d Mon Sep 17 00:00:00 2001 From: Pierre-Yves Berrard Date: Sat, 16 Apr 2022 12:04:44 +0200 Subject: [PATCH 001/107] Developpement tabular --- DESCRIPTION | 3 +- NAMESPACE | 3 + R/hrc.R | 3 +- R/micro_asc_rda.R | 7 +- R/options.R | 2 +- R/run_arb.R | 142 ++++++++++++++++- R/tab_arb.R | 384 ++++++++++++++++++++++++++++++++++++++++++++++ R/tab_rda.R | 342 +++++++++++++++++++++++++++++++++++++++++ man/run_arb.Rd | 3 + man/tab_arb.Rd | 160 +++++++++++++++++++ man/tab_rda.Rd | 174 +++++++++++++++++++++ 11 files changed, 1209 insertions(+), 14 deletions(-) create mode 100644 R/tab_arb.R create mode 100644 R/tab_rda.R create mode 100644 man/tab_arb.Rd create mode 100644 man/tab_rda.Rd diff --git a/DESCRIPTION b/DESCRIPTION index 11ba271..5b4377f 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -8,7 +8,8 @@ Imports: purrr (>= 0.2), dplyr (>= 0.7), gdata, - stringr + stringr, + rlang Suggests: testthat, knitr, diff --git a/NAMESPACE b/NAMESPACE index 4cb9fd2..ead62cf 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -8,6 +8,8 @@ export(rtauargus) export(rtauargus_options) export(rtauargus_plus) export(run_arb) +export(tab_arb) +export(tab_rda) export(tauargus_info) export(write_hrc) importFrom(dplyr,"%>%") @@ -16,3 +18,4 @@ importFrom(dplyr,mutate) importFrom(purrr,map) importFrom(purrr,map_at) importFrom(purrr,transpose) +importFrom(rlang,.data) diff --git a/R/hrc.R b/R/hrc.R index 7f46d2c..7e2694c 100644 --- a/R/hrc.R +++ b/R/hrc.R @@ -195,6 +195,7 @@ fill_na_hrc <- function(microdata, vars) { # Fonctions créant une liste hiérarchique --------------------------------- #' @importFrom dplyr %>% +#' @importFrom rlang .data sublevels <- function(fin, agr) { @@ -217,7 +218,7 @@ sublevels <- function(fin, agr) { compt <- compt %>% as.data.frame(stringsAsFactors = FALSE) %>% - subset(Freq > 0) + dplyr::filter(.data$Freq > 0) tapply( compt$fin, diff --git a/R/micro_asc_rda.R b/R/micro_asc_rda.R index 5ddffe6..a3fe64d 100644 --- a/R/micro_asc_rda.R +++ b/R/micro_asc_rda.R @@ -197,6 +197,7 @@ write_rda <- function(info_vars) { #' @importFrom dplyr mutate #' @importFrom dplyr arrange #' @importFrom purrr transpose +#' @importFrom rlang .data #' #' @export @@ -260,7 +261,7 @@ micro_asc_rda <- function(microdata, fwf_info %>% mutate( type_var = ifelse(num, "NUMERIC", "RECODEABLE"), - ordre_init = seq(nrow(.)) + ordre_init = dplyr::row_number() ) # weight_var et holding_var .......................................... @@ -313,8 +314,8 @@ micro_asc_rda <- function(microdata, fwf_info <- fwf_info %>% - arrange(ordre_init) %>% - dplyr::select(-ordre_init, -nlevels, -exp) + arrange(.data$ordre_init) %>% + dplyr::select(-dplyr::all_of(c("ordre_init", "nlevels", "exp"))) # reorganise en une liste de variables ............................. fwf_info <- transpose(fwf_info) diff --git a/R/options.R b/R/options.R index af5cfaf..f1e262b 100644 --- a/R/options.R +++ b/R/options.R @@ -16,7 +16,7 @@ op.rtauargus <- list( rtauargus.output_options = "AS+", # run_arb ----------------------------------------------------- # rtauargus.missing_dir = "stop", - rtauargus.tauargus_exe = "Y:/Logiciels/Tau/TauArgus.exe", + rtauargus.tauargus_exe = "Y:/Logiciels/TauArgus/TauArgus.exe", rtauargus.show_batch_console = TRUE, rtauargus.import = TRUE ) diff --git a/R/run_arb.R b/R/run_arb.R index 4a9f3b1..41ede55 100644 --- a/R/run_arb.R +++ b/R/run_arb.R @@ -1,3 +1,125 @@ +# Fonction extrayant les informations contenues dans un fichier batch (arb) +# Structure de la liste en sortie (tous les items pas forcément présents) +# $ openmicrodata [chr] +# $ openmetadata [chr] +# $ specifytable [list] +# ..$ explanatory [list] +# ..$ response [chr] +# ..$ shadow [chr] +# ..$ cost [chr] +# $ apriori [list] +# ..$ file [chr] +# ..$ sep [chr] +# ..$ ignore_err [chr] +# ..$ exp_triv [chr] +# $ safetyrule [chr] +# $ suppress [chr] +# $ writetable [list] +# ..$ output_types [chr] +# ..$ output_options [chr] +# ..$ output_names [chr] +# $ gointeractive [logi] +# $ tab_id [chr] + +#' @importFrom purrr map_at +#' @importFrom dplyr %>% + +# Décompose commandes avec plusieurs arguments ---------------------------- + +#' @importFrom purrr map +#' @importFrom purrr map_at +#' @importFrom purrr transpose +#' @importFrom dplyr %>% + +specif_decompose <- function(specif) { + + ## extrait les infos contenus dans instructions d'un batch + ## pour par exemple les utiliser dans reimport des données + ## param specif : un vecteur de commandes + + # menage debut fin + specif <- sub("^ +", "", trimws(specif)) + + # variable comptage + specif <- sub("", "Freq", specif) + + # separe differentes parties + specif <- paste0(specif, "|") # pour dernière valeur vide (cf. ?strsplit) + specif_split <- strsplit(specif, "|", fixed = TRUE) + + # reclasse par type de variable + type_var <- c("explanatory", "response", "shadow", "cost") + res <- transpose(specif_split, type_var) + + # supprime guillements et espaces (sauf dans explanatory) + res <- + res %>% + map_at( + c("response", "shadow", "cost"), + ~ gsub("(\"| )", "", .x) + ) + + # separe variables dans explanatory + res %>% + map_at( + "explanatory", + ~ .x %>% + stringr::str_match_all('[^" ]+') %>% + map(~ .[ , 1]) + ) + +} + +write_decompose <- function(write_cmd) { + + ## extrait les infos contenus dans instructions d'un batch + ## pour par exemple les utiliser dans reimport des données + ## param write_cmd : un vecteur de commandes + + res <- NULL + + infos_writetable <- + stringr::str_match( + write_cmd, + "\\((\\d+),([1-6]+),(.*),\"(.+)\"\\)" + ) + + res$output_types <- infos_writetable[ , 3] + res$output_options <- infos_writetable[ , 4] + res$output_names <- infos_writetable[ , 5] + + res + +} + +apriori_decompose <- function(apriori_cmd) { + + res <- NULL + + infos_apriori <- + stringr::str_match( + apriori_cmd, + "(.+),\\d{1,2},\"(.+)\",(\\d),(\\d)" + ) + + if (!length(infos_apriori)) return(NULL) + + res$file <- infos_apriori[ , 2] %>% rm_cmd() %>% unquote() + res$sep <- infos_apriori[ , 3] + res$ignore_err <- infos_apriori[ , 4] + res$exp_triv <- infos_apriori[ , 5] + + res + +} + + +# Autres fonctions utiles ------------------------------------------------- + +rm_cmd <- function(cmd) sub("^ *<.+> *", "", cmd) + +unquote <- function(s) sub("^[\"'](.+)[\"']$", "\\1", s) + #' Exécute un batch Tau-Argus #' #' Exécute les instructions contenues dans un fichier .arb pour Tau-Argus. @@ -19,6 +141,7 @@ #' réponse) dans les métadonnées (fichier rda). #' #' @param arb_filename nom du fichier batch à exécuter. +#' @param is_tabular booléen, si les données sont déja tabulées ou non #' @param missing_dir action si les dossiers où seront écrits les #' résultats n'existent pas ("stop" pour déclencher une erreur, "create" pour #' créer les dossiers manquants). @@ -52,11 +175,13 @@ #' @export run_arb <- function(arb_filename, + is_tabular=NULL, missing_dir = getOption("rtauargus.missing_dir"), tauargus_exe = getOption("rtauargus.tauargus_exe"), logbook = NULL, show_batch_console = getOption("rtauargus.show_batch_console"), import = getOption("rtauargus.import"), + ...) { # valeur par défaut du package si option vide ................ @@ -72,8 +197,8 @@ run_arb <- function(arb_filename, if (!file.exists(tauargus_exe)) { stop( - "Tau-Argus introuvable (", tauargus_exe, ")\n ", - "renseigner le parametre tauargus_exe ou l'option rtauargus.tauargus_exe" + "Tau-Argus introuvable (", tauargus_exe, ")\n ", + "renseigner le parametre tauargus_exe ou l'option rtauargus.tauargus_exe" ) } @@ -88,12 +213,13 @@ run_arb <- function(arb_filename, infos_arb <- arb_contents(arb_filename) # présence des fichiers (input) .............................. - - if (!file.exists(infos_arb$openmicrodata)) { - stop( - "Fichier asc introuvable : ", infos_arb$openmicrodata, "\n", - "(utiliser `micro_asc_rda` pour creer un fichier asc)" - ) + if (is_tabular!= TRUE){ + if (!file.exists(infos_arb$openmicrodata)) { + stop( + "Fichier asc introuvable : ", infos_arb$openmicrodata, "\n", + "(utiliser `micro_asc_rda` pour creer un fichier asc)" + ) + } } if (!file.exists(infos_arb$openmetadata)) { stop( diff --git a/R/tab_arb.R b/R/tab_arb.R new file mode 100644 index 0000000..fd3f4bd --- /dev/null +++ b/R/tab_arb.R @@ -0,0 +1,384 @@ +specify_tables_one_tab <- function(expl, resp, shad, cost) { + paste0( + paste(cite(expl), collapse = ""), '|', + cite(resp), '|', + cite(shad), '|', + cite(cost) + ) +} + +# Genere partie SPECIFYTABLE et SAFETYRULE +specif_safety_tab <- function(explanatory_vars, + response_var, + shadow_var, + cost_var, + safety_rules + ) { + + specify_tables <- + mapply( + specify_tables_one_tab, + explanatory_vars, + response_var, + shadow_var, + cost_var + ) + + specify_tables <- paste("", specify_tables) + + if (!is.null(names(explanatory_vars))) { + table_ids <- sprintf('// "%s"', names(explanatory_vars)) + specify_tables <- paste(table_ids, specify_tables, sep = "\n") + } + + safety_rules <- paste("", safety_rules) + + mapply(paste, specify_tables,safety_rules, sep = "\n", USE.NAMES = FALSE) + +} + +# Genere partie SUPPRESS et WRITETABLE +suppr_writetable_tab <- function(suppress, + linked, + output_names, + output_type, + output_options) { + + # numero table + num_table <- seq_along(output_names) + + if (linked & length(suppress) > 1) { + stop("un seul suppress permis quand linked = TRUE") + } + + # methode suppr + if (length(suppress) == 1) { + if (linked) suppr_n <- 0 else suppr_n <- num_table + suppress <- gsub(" ", "", suppress) # supprime tout espace + suppress_fmt <- sub("\\([^),]+(,*.*)\\)", "(%i\\1)", suppress) + suppress <- sprintf(suppress_fmt, suppr_n) + } + + # chemin complet sorties + output_names <- normPath2(output_names) + + # commandes batch + suppr_cmd <- paste("", suppress) + write_cmd <- + paste0( + ' (', + num_table, ',', + output_type, ',', + output_options, ',"', + output_names, '")' + ) + + if (linked) { + c( + suppr_cmd, + mapply(paste, write_cmd, sep = "\n", USE.NAMES = FALSE) + ) + } else { + mapply(paste, suppr_cmd, write_cmd, sep = "\n", USE.NAMES = FALSE) + } + + +} + + +# Paramètre a priori ------------------------------------------------------ + +# Normalise parametre "apriori" pour le faire passer dans la +# fonction apriori_batch + +norm_apriori_params_tab <- function(params) { + + if (is.character(params)) { + + # forme simple : vecteur des noms de fichiers + list(params, sep = ',', ignore_err = 0 , exp_triv = 0) + + } else if (is.list(params)) { + + # options supplémentaires (valeurs par défaut si absents) + if (is.null(params$sep)) params$sep <- "," + if (is.null(params$ignore_err)) params$ignore_err <- 0 + if (is.null(params$exp_triv)) params$exp_triv <- 0 + + params + + } + +} + +# Génère s + +apriori_batch <- function(ntab, hst_names, sep = ',', ignore_err = 0 , exp_triv = 0) { + + # verif pour éviter recyclage qd longueurs args > 1 ne correspondent pas + n <- lengths(list(hst_names, sep, ignore_err, exp_triv)) + if (any(ntab > 1 & n > 1 & n != ntab)) stop("longueur arguments") + if (any(ntab == 1 & n != 1)) stop("longueur arguments") + + paste0( + ' "', + normPath2(hst_names), '",', + seq(ntab), ',"', + sep, '",', + ignore_err, ',', + exp_triv + ) + +} + + +# Exportée ---------------------------------------------------------------- + +#' Crée un fichier batch (.arb) pour données tabulées +#' +#' Crée un fichier batch pour données tabulées, exécutable par Tau-Argus en ligne de +#' commande. +#' +#' La fonction ne vérifie pas si les fichiers asc et rda existent. +#' +#' @section Syntaxe: +#' Tau-Argus peut traiter plusieurs tabulations pour un même jeu de +#' données. Passer une seule valeur pour une option appliquera le même +#' traitement à chaque tabulation. Pour des options différenciées, passer un +#' vecteur contenant autant de valeurs que de tabulations. Si les longueurs ne +#' correspondent pas (déconseillé), un recyclage est effectué. +#' +#' Sauf mention contraire, utiliser la syntaxe mentionnée dans la documentation +#' de Tau-Argus. +#' +#' Syntaxe spéciale pour \code{suppress} : le premier paramètre dans la +#' syntaxe Tau-Argus est le numéro de la tabulation. Si la méthode est identique +#' pour toutes les tabulations, ce premier paramètre sera ignoré et les numéros +#' recalculés automatiquement pour le batch. Dans l'écriture +#' \code{suppress = "GH(n,100)"}, n sera ainsi transformé en 1 pour la première +#' tabulation, en 2 pour la deuxième tabulation, etc. +#' +#' @section Identifiants des tableaux: +#' Si la liste \code{explanatory_vars} comporte des noms, ceux-ci seront +#' utilisés dans le batch pour donner un identifiant au tableau, sous la forme +#' d'une ligne de commentaire (\code{// "..."}). Ils seront +#' réutilisés par la fonction \code{import} pour nommer les tableaux formats R +#' en sortie. +#' +#' @section Informations \emph{a priori}: +#' Il est possible de fournir un fichier a priori (.hst) pour chaque tabulation. +#' +#' La manière la plus simple est de passer un vecteur contenant autant de noms de +#' fichiers hst que de tabulations. Si le fichier est le même pour toutes les +#' tabulations, spécifier le nom de ce fichier (il sera utilisé pour toutes les +#' tabulations). +#' +#' Les options supplémentaires sont facultatives. Pour modifier les valeurs par +#' défaut, passer une liste ayant comme premier élément le(s) fichier(s) hst et +#' compléter avec les éléments portant les noms \code{sep} pour le séparateur, +#' \code{ignore_err} pour IgnoreError et \code{exp_triv} pour ExpandTrivial. +#' Comme pour les noms de fichiers, spécifier une seule valeur par paramètre ou +#' autant de valeurs que de tabulations. +#' +#' @param arb_filename nom du fichier arb généré (avec +#' extension). Si non renseigné, un fichier temporaire. +#' @param tab_filename [\strong{obligatoire}] nom du fichier .tab (avec extension). +#' @inheritParams tab_rda +#' @param explanatory_vars [\strong{obligatoire}] variables catégorielles, sous +#' forme de liste de vecteurs. Chaque élément de la liste est un vecteur des +#' noms des variables formant une tabulation. +#' Exemple : \code{list(c("CJ", "A21"), c("SEXE", "REGION"))} pour le premier +#' tableau croisant \code{CJ} x \code{A21} et le deuxième tableau croisant +#' \code{SEXE} x \code{REGION}. +#' Si une seule tabulation, un simple vecteur des variables à croiser est +#' accepté (pas besoin de \code{list(...)}). +#' @param response_var variable de réponse à sommer, ou comptage si +#' \code{""}. Une seule valeur ou autant de valeurs que de tabulations. +#' @param shadow_var variable(s) pour l'application du secret primaire. Si non +#' renseigné, \code{response_var} sera utilisé par Tau-Argus. +#' @param cost_var variable(s) de coût pour le secret secondaire. +#' @param safety_rules [\strong{obligatoire}] règle(s) de secret primaire. +#' Chaîne de caractères en syntaxe batch Tau-Argus. La pondération est traitée +#' dans un paramètre à part (ne pas spécifier WGT ici, utiliser le paramètre +#' \code{weighted}). +#' @param suppress [\strong{obligatoire}] méthode(s) de gestion du secret +#' secondaire (syntaxe batch de Tau-Argus). Si la méthode est la même pour +#' chaque tabulation, le premier paramètre (numéro du tableau) sera ignoré et +#' renuméroté automatiquement (voir la section 'Syntaxe'). +#' @param linked pour traiter le secret secondaire conjointement sur toutes les +#' tabulations. Une seule commande suppress autorisée dans ce cas (appliquée à +#' tous les tableaux). +#' @param output_names noms des fichiers en sortie. Si renseigné, +#' obligatoirement autant de noms de fichiers que de tabulations. Si laissé +#' vide, autant de noms de fichiers temporaires que de tabulations seront +#' générés. +#' @param output_type format des fichiers en sortie (codification Tau-Argus). +#' Valeur par défaut du package : \code{"2"} (csv for pivot-table). +#' @param output_options options supplémentaires des fichiers en sortie. Valeur +#' par défaut du package : \code{"AS+"} (affichage du statut). Pour ne +#' spécifier aucune option, \code{""}. +#' @param apriori fichier(s) d'informations \emph{a priori}. Voir ci-dessous +#' pour la syntaxe. +#' @param gointeractive pour avoir la possibilité de lancer le batch depuis le +#' menu de Tau-Argus (\code{FALSE} par défaut). +#' +#' @return Une liste de deux éléments : le nom du fichier arb, les noms des +#' fichiers en sortie (utile pour récupérer les noms générés aléatoirement). +#' +#' @inheritSection tab_rda Voir aussi +#' +#' @examples +#' \dontrun{ +#' # creation fichier arb +#' infos_arb <- tab_arb( +#' tab_filename = "donnees.tab", +#' explanatory_vars = list(c("REGION", "CJ"), c("REGION")), +#' response_var = c("CA", ""), +#' safety_rules = c("NK(1,85)|FREQ(3,10)", "FREQ(3,10)"), +#' suppress = "GH(.,100)", +#' output_names = c("tab1.csv", "~/tab2.csv"), +#' output_options = c("AS+SE+", "SE+"), +#' output_type = "2" +#' ) +#' +#' # visualisation du contenu du fichier dans la console +#' file.show(infos_arb$arb_filename, pager = "console") +#' } +#' @export + +tab_arb <- function(arb_filename = NULL, + tab_filename, + rda_filename = NULL, + explanatory_vars, + response_var = getOption("rtauargus.response_var"), + shadow_var = NULL, + cost_var = NULL, + safety_rules, + suppress, + linked = getOption("rtauargus.linked"), + output_names = NULL, + output_type = getOption("rtauargus.output_type"), + output_options = getOption("rtauargus.output_options"), + apriori = NULL, + gointeractive = FALSE) { + + # valeur par défaut du package si option vide + if (is.null(response_var)) response_var <- op.rtauargus$rtauargus.response_var + if (is.null(linked)) linked <- op.rtauargus$rtauargus.linked + if (is.null(output_type)) output_type <- op.rtauargus$rtauargus.output_type + if (is.null(output_options)) { + output_options <- op.rtauargus$rtauargus.output_options + } + + # si une seule tabulation, vecteur autorisé + if (is.atomic(explanatory_vars)) explanatory_vars <- list(explanatory_vars) + nb_tabul <- length(explanatory_vars) + + # parametres non renseignés + if (is.null(arb_filename)) arb_filename <- tempfile("RTA_", fileext = ".arb") + if (is.null(rda_filename)) rda_filename <- sub("tab$", "rda", tab_filename) + if (is.null(shadow_var)) shadow_var <- "" + if (is.null(cost_var)) cost_var <- "" + if (is.null(output_names)) { + if (length(output_type) == 1) { + ext <- rep(output_extensions[output_type], nb_tabul) + } else { + stopifnot(length(output_type) == nb_tabul) + ext <- output_extensions[output_type] + } + output_names <- tempfile("RTA_", fileext = ext) + } + if (is.null(output_options)) output_options <- "" + + # correspondance nombre tab et nombre fichiers sortie + if (length(explanatory_vars) != length(output_names)) { + stop("renseigner autant de noms de fichiers que de tabulations") + } + + # interdit 'WGT' dans safety_rules + if (length(grep("WGT", safety_rules, ignore.case = TRUE))) { + stop( + "Le poids est applique a la creation de la table', " + ) + } + + # output_names doivent comporter une extension de fichier + # (sinon Tau-Argus plante) + if (!all(grepl("\\.", basename(output_names)))) { + stop("output_names doivent comporter une extension de fichier") + } + + # chemins absolus + tab_full <- normPath2(tab_filename) + rda_full <- normPath2(rda_filename) + + res <- character(0) + + # commentaire + res[1] <- "// Batch generated by package *rtauargus*" + res[2] <- paste0("// (", format(Sys.time(), "%Y-%m-%d %X %Z)")) + + # open... + res[3] <- sprintf(' "%s"', tab_full) + res[4] <- sprintf(' "%s"', rda_full) + + # tabulations + secret primaire + tab_sp <- + specif_safety_tab( + explanatory_vars = explanatory_vars, + response_var = response_var, + shadow_var = shadow_var, + cost_var = cost_var, + safety_rules = safety_rules + ) + res <- c(res, tab_sp) + + # read... + res <- c(res, " 1") + + # apriori (doit figurer avant suppress) + if (!is.null(apriori)) { + + std_apriori <- norm_apriori_params_tab(apriori) + ap_batch <- + apriori_batch( + ntab = length(explanatory_vars), + hst_names = std_apriori[[1]], + sep = std_apriori$sep, + ignore_err = std_apriori$ignore_err, + exp_triv = std_apriori$exp_triv + ) + + res <- c(res, ap_batch) + + } + + # suppress + writetable + sw <- + suppr_writetable_tab( + suppress, + linked, + output_names, + output_type, + output_options + ) + res <- c(res, sw) + + # gointeractive + if (gointeractive) res <- c(res, "") + + # ligne vide finale + res <- c(res, "") + + # ecriture + writeLines(res, arb_filename) + + # valeurs en sortie + invisible( + list( + arb_filename = normPath2(arb_filename), + output_names = normPath2(output_names) + ) + ) + +} diff --git a/R/tab_rda.R b/R/tab_rda.R new file mode 100644 index 0000000..142eade --- /dev/null +++ b/R/tab_rda.R @@ -0,0 +1,342 @@ + +write_rda_1var_tab <- function(info_var) { + + # écrit partie du .rda à partir des infos (une liste) pour une seule variable + + ligne1 <- with(info_var, + paste( + colname, + if (!is.na(missing) & missing != "") missing + ) + ) + + with( + info_var, + paste( + sep = "\n", + trimws(ligne1), + paste0(" <", type_var, ">"), + if (!is.na(totcode)) + paste0(" \"", totcode, "\""), + if (!is.na(codelist)) + paste0(" \"", codelist, "\""), + if (!is.na(hierarchical)) + " ", + if (!is.na(hierarchical) && grepl("\\.hrc$", hierarchical)) + paste0(" \"", hierarchical, "\""), + if (!is.na(hierarchical) && grepl("\\.hrc$", hierarchical)) + paste0(" \"", hierleadstring, "\""), + if (!is.na(hierarchical) && grepl("^(\\d+ +)+\\d+$", hierarchical)) + paste0(" ", hierarchical), + if (type_var %in% c("NUMERIC", "WEIGHT","MAXSCORE")) + paste0(" ", digits) + ) + ) + +} + +#' @importFrom dplyr %>% +write_rda_tab <- function(info_vars) { + + + # écrit les infos format .rda pour toutes les variables + # (info_vars est une liste contenant les infos pour chaque variable) + + chemin_complet <- function(x) { + if (!is.na(x$codelist)) x$codelist <- normPath2(x$codelist) + return(x) + } + info_vars <- lapply(info_vars, chemin_complet) + + vapply(info_vars, write_rda_1var_tab, character(1)) %>% + gsub("(\n)+", "\n", .) %>% # plusieurs sauts de lignes par un seul + sub("\n$", "", .) # supprime dernier saut de ligne + +} + +#' Crée les fichiers rda à partir de données tabulées +#' +#' Crée un fichier tabular (tab) et de métadonnées +#' (rda) à partir de données tabulées et d'informations additionnelles. +#' +#' @param tabular [\strong{obligatoire}] data.frame contenant les +#' données tabulées +#' @param tab_filename nom du fichier tab (avec extension) +#' @param rda_filename nom du fichier rda (avec extension). +#' @param decimals nombre minimal de décimales à afficher (voir section 'Nombre +#' de décimales'). +#' @param hrc informations sur les variables hiérarchiques (voir section +#' 'Variables hiérarchiques'). +#' @param hierleadstring caractère qui, répété n fois, indique que la valeur est +#' à n niveaux de profondeur dans la hiérarchie. +#' @param totcode code(s) pour le total d'une variable catégorielle (voir +#' section 'Paramètres spécifiques' pour la syntaxe de ce paramètre). Les +#' variables non spécifiées (ni par défaut, ni explicitement) se verront +#' attribuer la valeur de \code{rtauargus.totcode}. +#' @param missing code(s) pour une valeur manquante (voir section +#' 'Paramètres spécifiques' pour la syntaxe de ce paramètre). +#' @param codelist fichier(s) contenant les libellés des variables catégorielles +#' (voir section 'Paramètres spécifiques' pour la syntaxe de ce paramètre). +#' @param value nom de la colonne contenant la valeur des cellules +#' @param freq nom de la colonne contenant les effectifs pour une cellule +#' @param maxscore nom de la colonne contenant la valeur du plus gros contributeur +#' d'une cellule +#' @param separator charactere utilisé en tant que separateur dans le fichier .tab +#' @return Renvoie le nom du fichier rda sous forme de liste (de +#' manière invisible). +#' +#' @section Paramètres spécifiques: +#' +#' Les paramètres \code{totcode}, \code{missing} et \code{codelist} +#' sont à renseigner sous la forme d'un vecteur indiquant la valeur à prendre +#' pour chaque variable. +#' +#' Les noms des éléments du vecteur donnent la variable concernée, les éléments +#' du vecteur donnent la valeur du paramètre pour Tau-Argus. Un élément non +#' nommé constituera la valeur par défaut, qui sera attribuée à toutes les +#' variables pouvant prendre ce paramètre. +#' +#' Par exemple : +#' \itemize{ +#' \item{\code{totcode = "Ensemble"} : écrit \code{ "Ensemble"} pour +#' toutes les variables catégorielles} +#' \item{\code{totcode = c("Ensemble", GEO = "France")} : idem, sauf pour la +#' variable \code{GEO}} +#' } +#' +#' @section Variables hiérarchiques: +#' +#' Le paramètre \code{hrc} obéit aux mêmes règles de syntaxe que \code{totcode}, +#' \code{missing} et \code{codelist} (vecteur nommé contenant autant d'éléments +#' que de variables à décrire). Il présente de plus la particularité +#' d'accepter plusieurs façons de spécifier les valeurs associées aux variables +#' hiérarchiques. +#' +#' Pour définir une hiérarchie basée sur les positions des caractères +#' (\strong{hierlevels}), passer une suite de nombre entiers séparés par des +#' espaces. +#' +#' \emph{Exemple :} \code{c(CODECOM = "2 3 0 0 0")} +#' +#' Si la hiérarchie est définie dans un fichier hrc à part +#' (\strong{hiercodelist}), la fonction attend l'emplacement de ce fichier (et +#' un éventuel \code{hierleadstring} s'il diffère de l'option par défaut du +#' package). Dans ce cas, on peut écrire explicitement le chemin vers un fichier +#' existant (\code{c(A38 = "a38.hrc")}), mais aussi passer un appel à +#' \code{\link{write_hrc}} qui génèrera un fichier hrc à partir de données tabulées. +#' +#' \emph{Exemple :} \code{c(A38 = write_hrc(tabular, c("A38", "A21", "A10")))} +#' +#' +#' Les deux dernières méthodes passent par la création d'un fichier temporaire. +#' Pour un fichier hrc réutilisable, il est nécessaire de le créer au préalable +#' à l'aide de \code{write_hrc}. +#' +#' Les trois méthodes nécessitent que les éléments du vecteur en paramètre +#' soient nommés (avec le nom de la variable), même s'il n'y a qu'un seul +#' élément. +#' +#' @section Nombre de décimales: +#' +#' Le paramètre \code{decimals} indique le nombre minimal de décimales à faire +#' figurer dans le fichier en sortie (quel que soit le nombre de décimales +#' effectivement présent dans \code{tabular}). Il s'applique à toutes les +#' variables réelles (double) mais pas aux variables entières (integer). Pour +#' ajouter des zéros à une variable entière, la convertir avec \code{as.double} +#' au préalable. +#' +#' +#' @section Voir aussi: La fonction \code{\link{rtauargus}}, qui utilise cette +#' fonction et hérite de ses paramètres. +#' +#' @examples +#' \dontrun{ +#' # donnees fictives +#' tab_df <- +#' data.frame( +#' GEO = c("443", "541", "543"), +#' A10 = c( "AZ", "BE", "BE"), +#' A21 = c( "A", "B", "C"), +#' DIPL = c( "01", "??", "02"), +#' CA = c( 100, 0, 7), +#' effectif = c( 3, 6, 8), +#' max_CA = c( 57, 0, 1), +#' ) +#' +#' # creation rda +#' res <- +#' tab_rda( +#' tabular = tab_df, +#' decimals = 1, +#' hrc = c(A21 = "A21>A10", GEO = "2 1 0", DIPL = "dipl.hrc"), +#' totcode = c(GEO = "France"), +#' missing = c(DIPL = "??"), +#' value = "CA", +#' freq = "effectif", +#' maxscore = "max_CA", +#' separator = "," +#' ) +#' +#' # visualisation des fichiers produits +#' file.show( +#' res$rda_filename, +#' header = unlist(res), +#' pager = "internal" +#' ) +#' } +#' @importFrom dplyr %>% +#' @importFrom dplyr mutate +#' @importFrom dplyr arrange +#' @importFrom purrr transpose +#' @importFrom rlang .data +#' +#' @export + +tab_rda <- function( + tabular, + tab_filename = NULL, + rda_filename = NULL, + decimals = getOption("rtauargus.decimals"), + hrc = NULL, + hierleadstring = getOption("rtauargus.hierleadstring"), + totcode = getOption("rtauargus.totcode"), + missing = getOption("rtauargus.missing"), + codelist = NULL, + value = NULL, + freq = NULL, + maxscore = NULL, + separator = "," +) { + + tabular <- as.data.frame(tabular) # (probleme avec tibble notamment) + + # valeur par défaut du package si option vide ........................... + + if (is.null(decimals)) decimals <- op.rtauargus$rtauargus.decimals + if (is.null(hierleadstring)) { + hierleadstring <- op.rtauargus$rtauargus.hierleadstring + } + if (is.null(totcode)) totcode <- op.rtauargus$rtauargus.totcode + if (is.null(missing)) missing <- op.rtauargus$rtauargus.missing + + # ignore colonnes de longueurs nulles .................................. + + colvides <- sapply(tabular, function(x) all(is.na(x)) | all(x == "")) + if (any(colvides)) { + warning( + "Colonnes vides : ", + paste(names(tabular)[colvides], collapse = ", ") + ) + tabular <- tabular[!colvides] + } + + # parametres non renseignés ........................................... + + if (is.null(rda_filename)) rda_filename <- tempfile("RTA_", fileext = ".rda") + + # genere fichier longueur fixe et infos associees ..................... + + fwf_info_tabular <- + gdata::write.fwf( + tabular, + file = tab_filename, + formatInfo = TRUE, + colnames = FALSE, + justify = "right", # pour les variables caractères uniquement + digits = 15, # max ? voir aide de format + nsmall = decimals, + scientific = FALSE, + sep=separator + ) + + num <- vapply(tabular, is.numeric, logical(1)) + + fwf_info_tabular <- + fwf_info_tabular %>% + mutate( + type_var = ifelse(num, "NUMERIC", "RECODEABLE"), + ordre_init = dplyr::row_number() + ) + + # weight_var et holding_var .......................................... + + if (!is.null(freq)) { + fwf_info_tabular$type_var[fwf_info_tabular$colname == freq] <- "FREQUENCY" + } + + if (!is.null(maxscore)) { + fwf_info_tabular$type_var[fwf_info_tabular$colname == maxscore] <- "MAXSCORE" + } + + # missing, totcode, codelist ........................................ + + var_quanti <- names(tabular)[!num] + + missing_df <- df_param_defaut(names(tabular), "missing", missing) + codelist_df <- df_param_defaut(var_quanti, "codelist", codelist) + totcode_df <- + df_param_defaut(var_quanti, "totcode", totcode) %>% + mutate(totcode = dplyr::coalesce(totcode, getOption("rtauargus.totcode"))) + + # hierachical ...................................................... + + if (!is.null(hrc) & (is.null(names(hrc)) | any(names(hrc) == ""))) { + stop("noms manquants pour hrc. Exemple : hrc = c(VAR = \"var.hrc\")") + } + + norm_hrc <- + normalise_hrc( + hrc, + tabular, + hierleadstring = hierleadstring + ) + + hrc_df <- df_param_defaut(var_quanti, "hierarchical", norm_hrc) + hrc_df$hierleadstring <- NA_character_ + need_leadstring <- grepl("\\.hrc$", hrc_df$hierarchical) + hrc_df$hierleadstring[need_leadstring] <- hierleadstring + + fwf_info_tabular <- + purrr::reduce( + list(fwf_info_tabular, missing_df, totcode_df, codelist_df, hrc_df), + merge, + by = "colname", + all.x = TRUE + ) + + # reordonne (car tri par merge) ................................... + + fwf_info_tabular <- + fwf_info_tabular %>% + arrange(.data$ordre_init) %>% + dplyr::select( + -dplyr::all_of(c("ordre_init", "nlevels", "exp","position","width")) + ) + + # reorganise en une liste de variables ............................. + fwf_info_tabular <-transpose(fwf_info_tabular) + + # genere vecteur format .rda ....................................... + res <- character(0) + # instructions + res[1] <- sprintf(' "%s"',separator) + res[2] <- sprintf(' "s"') + res[3] <- sprintf(' "u"') + res[4] <- sprintf(' "p"') + + res <- c(res,write_rda_tab(fwf_info_tabular)) + + # écrit fichier texte .............................................. + writeLines(res, rda_filename) + + # renvoie noms des fichiers tab et rda de manière invisible ....... + invisible( + list( + tab_filename = normPath2(tab_filename), + rda_filename = normPath2(rda_filename) + ) + ) + + +} + diff --git a/man/run_arb.Rd b/man/run_arb.Rd index 5e0d43e..466deb9 100644 --- a/man/run_arb.Rd +++ b/man/run_arb.Rd @@ -7,6 +7,7 @@ \usage{ run_arb( arb_filename, + is_tabular = NULL, missing_dir = getOption("rtauargus.missing_dir"), tauargus_exe = getOption("rtauargus.tauargus_exe"), logbook = NULL, @@ -18,6 +19,8 @@ run_arb( \arguments{ \item{arb_filename}{nom du fichier batch à exécuter.} +\item{is_tabular}{booléen, si les données sont déja tabulées ou non} + \item{missing_dir}{action si les dossiers où seront écrits les résultats n'existent pas ("stop" pour déclencher une erreur, "create" pour créer les dossiers manquants).} diff --git a/man/tab_arb.Rd b/man/tab_arb.Rd new file mode 100644 index 0000000..4da875b --- /dev/null +++ b/man/tab_arb.Rd @@ -0,0 +1,160 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/tab_arb.R +\name{tab_arb} +\alias{tab_arb} +\title{Crée un fichier batch (.arb) pour données tabulées} +\usage{ +tab_arb( + arb_filename = NULL, + tab_filename, + rda_filename = NULL, + explanatory_vars, + response_var = getOption("rtauargus.response_var"), + shadow_var = NULL, + cost_var = NULL, + safety_rules, + suppress, + linked = getOption("rtauargus.linked"), + output_names = NULL, + output_type = getOption("rtauargus.output_type"), + output_options = getOption("rtauargus.output_options"), + apriori = NULL, + gointeractive = FALSE +) +} +\arguments{ +\item{arb_filename}{nom du fichier arb généré (avec +extension). Si non renseigné, un fichier temporaire.} + +\item{tab_filename}{[\strong{obligatoire}] nom du fichier .tab (avec extension).} + +\item{rda_filename}{nom du fichier rda (avec extension).} + +\item{explanatory_vars}{[\strong{obligatoire}] variables catégorielles, sous +forme de liste de vecteurs. Chaque élément de la liste est un vecteur des +noms des variables formant une tabulation. +Exemple : \code{list(c("CJ", "A21"), c("SEXE", "REGION"))} pour le premier +tableau croisant \code{CJ} x \code{A21} et le deuxième tableau croisant +\code{SEXE} x \code{REGION}. +Si une seule tabulation, un simple vecteur des variables à croiser est +accepté (pas besoin de \code{list(...)}).} + +\item{response_var}{variable de réponse à sommer, ou comptage si +\code{""}. Une seule valeur ou autant de valeurs que de tabulations.} + +\item{shadow_var}{variable(s) pour l'application du secret primaire. Si non +renseigné, \code{response_var} sera utilisé par Tau-Argus.} + +\item{cost_var}{variable(s) de coût pour le secret secondaire.} + +\item{safety_rules}{[\strong{obligatoire}] règle(s) de secret primaire. +Chaîne de caractères en syntaxe batch Tau-Argus. La pondération est traitée +dans un paramètre à part (ne pas spécifier WGT ici, utiliser le paramètre +\code{weighted}).} + +\item{suppress}{[\strong{obligatoire}] méthode(s) de gestion du secret +secondaire (syntaxe batch de Tau-Argus). Si la méthode est la même pour +chaque tabulation, le premier paramètre (numéro du tableau) sera ignoré et +renuméroté automatiquement (voir la section 'Syntaxe').} + +\item{linked}{pour traiter le secret secondaire conjointement sur toutes les +tabulations. Une seule commande suppress autorisée dans ce cas (appliquée à +tous les tableaux).} + +\item{output_names}{noms des fichiers en sortie. Si renseigné, +obligatoirement autant de noms de fichiers que de tabulations. Si laissé +vide, autant de noms de fichiers temporaires que de tabulations seront +générés.} + +\item{output_type}{format des fichiers en sortie (codification Tau-Argus). +Valeur par défaut du package : \code{"2"} (csv for pivot-table).} + +\item{output_options}{options supplémentaires des fichiers en sortie. Valeur +par défaut du package : \code{"AS+"} (affichage du statut). Pour ne +spécifier aucune option, \code{""}.} + +\item{apriori}{fichier(s) d'informations \emph{a priori}. Voir ci-dessous +pour la syntaxe.} + +\item{gointeractive}{pour avoir la possibilité de lancer le batch depuis le +menu de Tau-Argus (\code{FALSE} par défaut).} +} +\value{ +Une liste de deux éléments : le nom du fichier arb, les noms des + fichiers en sortie (utile pour récupérer les noms générés aléatoirement). +} +\description{ +Crée un fichier batch pour données tabulées, exécutable par Tau-Argus en ligne de +commande. +} +\details{ +La fonction ne vérifie pas si les fichiers asc et rda existent. +} +\section{Syntaxe}{ + +Tau-Argus peut traiter plusieurs tabulations pour un même jeu de +données. Passer une seule valeur pour une option appliquera le même +traitement à chaque tabulation. Pour des options différenciées, passer un +vecteur contenant autant de valeurs que de tabulations. Si les longueurs ne +correspondent pas (déconseillé), un recyclage est effectué. + +Sauf mention contraire, utiliser la syntaxe mentionnée dans la documentation +de Tau-Argus. + +Syntaxe spéciale pour \code{suppress} : le premier paramètre dans la +syntaxe Tau-Argus est le numéro de la tabulation. Si la méthode est identique +pour toutes les tabulations, ce premier paramètre sera ignoré et les numéros +recalculés automatiquement pour le batch. Dans l'écriture +\code{suppress = "GH(n,100)"}, n sera ainsi transformé en 1 pour la première +tabulation, en 2 pour la deuxième tabulation, etc. +} + +\section{Identifiants des tableaux}{ + +Si la liste \code{explanatory_vars} comporte des noms, ceux-ci seront +utilisés dans le batch pour donner un identifiant au tableau, sous la forme +d'une ligne de commentaire (\code{// "..."}). Ils seront +réutilisés par la fonction \code{import} pour nommer les tableaux formats R +en sortie. +} + +\section{Informations \emph{a priori}}{ + +Il est possible de fournir un fichier a priori (.hst) pour chaque tabulation. + +La manière la plus simple est de passer un vecteur contenant autant de noms de +fichiers hst que de tabulations. Si le fichier est le même pour toutes les +tabulations, spécifier le nom de ce fichier (il sera utilisé pour toutes les +tabulations). + +Les options supplémentaires sont facultatives. Pour modifier les valeurs par +défaut, passer une liste ayant comme premier élément le(s) fichier(s) hst et +compléter avec les éléments portant les noms \code{sep} pour le séparateur, +\code{ignore_err} pour IgnoreError et \code{exp_triv} pour ExpandTrivial. +Comme pour les noms de fichiers, spécifier une seule valeur par paramètre ou +autant de valeurs que de tabulations. +} + +\section{Voir aussi}{ + La fonction \code{\link{rtauargus}}, qui utilise cette +fonction et hérite de ses paramètres. +} + +\examples{ +\dontrun{ +# creation fichier arb +infos_arb <- tab_arb( + tab_filename = "donnees.tab", + explanatory_vars = list(c("REGION", "CJ"), c("REGION")), + response_var = c("CA", ""), + safety_rules = c("NK(1,85)|FREQ(3,10)", "FREQ(3,10)"), + suppress = "GH(.,100)", + output_names = c("tab1.csv", "~/tab2.csv"), + output_options = c("AS+SE+", "SE+"), + output_type = "2" +) + +# visualisation du contenu du fichier dans la console +file.show(infos_arb$arb_filename, pager = "console") +} +} diff --git a/man/tab_rda.Rd b/man/tab_rda.Rd new file mode 100644 index 0000000..6e72baf --- /dev/null +++ b/man/tab_rda.Rd @@ -0,0 +1,174 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/tab_rda.R +\name{tab_rda} +\alias{tab_rda} +\title{Crée les fichiers rda à partir de données tabulées} +\usage{ +tab_rda( + tabular, + tab_filename = NULL, + rda_filename = NULL, + decimals = getOption("rtauargus.decimals"), + hrc = NULL, + hierleadstring = getOption("rtauargus.hierleadstring"), + totcode = getOption("rtauargus.totcode"), + missing = getOption("rtauargus.missing"), + codelist = NULL, + value = NULL, + freq = NULL, + maxscore = NULL, + separator = "," +) +} +\arguments{ +\item{tabular}{[\strong{obligatoire}] data.frame contenant les +données tabulées} + +\item{tab_filename}{nom du fichier tab (avec extension)} + +\item{rda_filename}{nom du fichier rda (avec extension).} + +\item{decimals}{nombre minimal de décimales à afficher (voir section 'Nombre +de décimales').} + +\item{hrc}{informations sur les variables hiérarchiques (voir section +'Variables hiérarchiques').} + +\item{hierleadstring}{caractère qui, répété n fois, indique que la valeur est +à n niveaux de profondeur dans la hiérarchie.} + +\item{totcode}{code(s) pour le total d'une variable catégorielle (voir +section 'Paramètres spécifiques' pour la syntaxe de ce paramètre). Les +variables non spécifiées (ni par défaut, ni explicitement) se verront +attribuer la valeur de \code{rtauargus.totcode}.} + +\item{missing}{code(s) pour une valeur manquante (voir section +'Paramètres spécifiques' pour la syntaxe de ce paramètre).} + +\item{codelist}{fichier(s) contenant les libellés des variables catégorielles +(voir section 'Paramètres spécifiques' pour la syntaxe de ce paramètre).} + +\item{value}{nom de la colonne contenant la valeur des cellules} + +\item{freq}{nom de la colonne contenant les effectifs pour une cellule} + +\item{maxscore}{nom de la colonne contenant la valeur du plus gros contributeur +d'une cellule} + +\item{separator}{charactere utilisé en tant que separateur dans le fichier .tab} +} +\value{ +Renvoie le nom du fichier rda sous forme de liste (de + manière invisible). +} +\description{ +Crée un fichier tabular (tab) et de métadonnées +(rda) à partir de données tabulées et d'informations additionnelles. +} +\section{Paramètres spécifiques}{ + + +Les paramètres \code{totcode}, \code{missing} et \code{codelist} +sont à renseigner sous la forme d'un vecteur indiquant la valeur à prendre +pour chaque variable. + +Les noms des éléments du vecteur donnent la variable concernée, les éléments +du vecteur donnent la valeur du paramètre pour Tau-Argus. Un élément non +nommé constituera la valeur par défaut, qui sera attribuée à toutes les +variables pouvant prendre ce paramètre. + +Par exemple : +\itemize{ + \item{\code{totcode = "Ensemble"} : écrit \code{ "Ensemble"} pour + toutes les variables catégorielles} + \item{\code{totcode = c("Ensemble", GEO = "France")} : idem, sauf pour la + variable \code{GEO}} +} +} + +\section{Variables hiérarchiques}{ + + +Le paramètre \code{hrc} obéit aux mêmes règles de syntaxe que \code{totcode}, +\code{missing} et \code{codelist} (vecteur nommé contenant autant d'éléments +que de variables à décrire). Il présente de plus la particularité +d'accepter plusieurs façons de spécifier les valeurs associées aux variables +hiérarchiques. + +Pour définir une hiérarchie basée sur les positions des caractères +(\strong{hierlevels}), passer une suite de nombre entiers séparés par des +espaces. + +\emph{Exemple :} \code{c(CODECOM = "2 3 0 0 0")} + +Si la hiérarchie est définie dans un fichier hrc à part +(\strong{hiercodelist}), la fonction attend l'emplacement de ce fichier (et +un éventuel \code{hierleadstring} s'il diffère de l'option par défaut du +package). Dans ce cas, on peut écrire explicitement le chemin vers un fichier +existant (\code{c(A38 = "a38.hrc")}), mais aussi passer un appel à +\code{\link{write_hrc}} qui génèrera un fichier hrc à partir de données tabulées. + +\emph{Exemple :} \code{c(A38 = write_hrc(tabular, c("A38", "A21", "A10")))} + + +Les deux dernières méthodes passent par la création d'un fichier temporaire. +Pour un fichier hrc réutilisable, il est nécessaire de le créer au préalable +à l'aide de \code{write_hrc}. + +Les trois méthodes nécessitent que les éléments du vecteur en paramètre +soient nommés (avec le nom de la variable), même s'il n'y a qu'un seul +élément. +} + +\section{Nombre de décimales}{ + + +Le paramètre \code{decimals} indique le nombre minimal de décimales à faire +figurer dans le fichier en sortie (quel que soit le nombre de décimales +effectivement présent dans \code{tabular}). Il s'applique à toutes les +variables réelles (double) mais pas aux variables entières (integer). Pour +ajouter des zéros à une variable entière, la convertir avec \code{as.double} +au préalable. +} + +\section{Voir aussi}{ + La fonction \code{\link{rtauargus}}, qui utilise cette +fonction et hérite de ses paramètres. +} + +\examples{ +\dontrun{ +# donnees fictives +tab_df <- + data.frame( + GEO = c("443", "541", "543"), + A10 = c( "AZ", "BE", "BE"), + A21 = c( "A", "B", "C"), + DIPL = c( "01", "??", "02"), + CA = c( 100, 0, 7), + effectif = c( 3, 6, 8), + max_CA = c( 57, 0, 1), + ) + +# creation rda +res <- + tab_rda( + tabular = tab_df, + decimals = 1, + hrc = c(A21 = "A21>A10", GEO = "2 1 0", DIPL = "dipl.hrc"), + totcode = c(GEO = "France"), + missing = c(DIPL = "??"), + value = "CA", + freq = "effectif", + maxscore = "max_CA", + separator = "," + ) + +# visualisation des fichiers produits +file.show( + res$rda_filename, + header = unlist(res), + pager = "internal" +) +} +} From fbbb8261a6cefb9b976b427117390bdd7969b541 Mon Sep 17 00:00:00 2001 From: Julien Jamme Date: Mon, 18 Apr 2022 22:09:57 +0200 Subject: [PATCH 002/107] ajout auteurs dans le fichier description --- DESCRIPTION | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/DESCRIPTION b/DESCRIPTION index 5b4377f..3e8f35b 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -20,6 +20,16 @@ Authors@R: c( email = "pierre-yves.berrard@insee.fr", role = c("aut", "cre") ), + person( + "Julien", "Jamme", + email = "julien.jamme@insee.fr", + role = c("aut") + ), + person( + "Nathanaël", "Rastout", + email = "nathanael.rastout@insee.fr", + role = c("aut") + ), person( family = "Institut National de la Statistique et des Études Économiques", role = "cph" From b4203961a4d1f0697f8219e49f3a17384ee4a822 Mon Sep 17 00:00:00 2001 From: Julien Jamme Date: Mon, 18 Apr 2022 22:16:23 +0200 Subject: [PATCH 003/107] increment version to 0.5.0 --- DESCRIPTION | 10 +++++----- NEWS.md | 7 +++++++ 2 files changed, 12 insertions(+), 5 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 3e8f35b..55aba1f 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -2,7 +2,7 @@ Package: rtauargus Type: Package Title: Tau-Argus depuis R Language: fr -Version: 0.4.3.9000 +Version: 0.5.0 Depends: R (>= 3.3) Imports: purrr (>= 0.2), @@ -22,13 +22,13 @@ Authors@R: c( ), person( "Julien", "Jamme", - email = "julien.jamme@insee.fr", - role = c("aut") + email = "julien.jamme@insee.fr", + role = c("aut") ), person( "Nathanaël", "Rastout", - email = "nathanael.rastout@insee.fr", - role = c("aut") + email = "nathanael.rastout@insee.fr", + role = c("aut") ), person( family = "Institut National de la Statistique et des Études Économiques", diff --git a/NEWS.md b/NEWS.md index af3440e..f307d14 100644 --- a/NEWS.md +++ b/NEWS.md @@ -4,6 +4,13 @@ subtitle: Historique des modifications output: rmarkdown::html_vignette --- +## rtauargus 0.5.0 + +[18/04/2022] + +* Ajout de fonctions pour gérer le secret directement sur des données tabulées. +Addition of functions to manage confidentiality directly on tabular data. + ## rtauargus 0.4.3 [13/10/2021] From b12b976bc5a1c387f9d9d57d440dbb3fafba9d1a Mon Sep 17 00:00:00 2001 From: Pierre-Yves Berrard Date: Wed, 4 May 2022 10:01:12 +0200 Subject: [PATCH 004/107] =?UTF-8?q?version=20de=20d=C3=A9veloppement?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 55aba1f..9ef040d 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -2,7 +2,7 @@ Package: rtauargus Type: Package Title: Tau-Argus depuis R Language: fr -Version: 0.5.0 +Version: 0.5.0.9000 Depends: R (>= 3.3) Imports: purrr (>= 0.2), From c9f142b5d7488a61a99bd3635e23685fbfd28300 Mon Sep 17 00:00:00 2001 From: Julien Jamme Date: Mon, 25 Jul 2022 10:55:12 +0200 Subject: [PATCH 005/107] Creates write_hrc2 function to build hrc files from correspondence table --- R/writehrc.R | 428 +++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 428 insertions(+) create mode 100644 R/writehrc.R diff --git a/R/writehrc.R b/R/writehrc.R new file mode 100644 index 0000000..fc1a64d --- /dev/null +++ b/R/writehrc.R @@ -0,0 +1,428 @@ +#' .hrc writing +#' +#' Creates a .hrc hierarchy from a correspondence table. \cr +#' Ecrit une hiérarchie .hrc à partir d'une table de correspondance. +#' +#' @param corr_table Data frame. Correspondence table, from most aggregated to most detailed +#' \cr +#' Table de correspondance, du plus agrégé au plus fin +#' @param output_name character string. Name for the output file (with no +#' extension) ; default is set to the same name as the correspondence table +#' \cr +#' Nom du fichier en sortie (sans extension) ; par défaut, +#' identique au nom de la table de correspondance +#' @param dir_name character string. Directory name for the hrc file +#' \cr +#' Nom du répertoire dans lequel écrire le fichier hrc +#' @param sort_table boolean. If TRUE, table will be sorted beforehand. +#' Recommended.\cr +#' Si TRUE, la table sera triée avant traitement. Recommandé. +#' @param rev boolean. If TRUE, column order is reversed.\cr +#' Si TRUE, inverse l'ordre des colonnes. +#' @param hier_lead_string character. (Single) character indicating the +#' hierarchy depth in the .hrc file +#' \cr +#' Caractère unique repérant le niveau de profondeur dans le .hrc +#' +#' @details Creates a .hrc hierarchy file adapted to tau-Argus from a +#' correspondence table fully describing it. By default, lines are sorted +#' alphabetically so as to regroup identical levels. +#' +#' Ecrit un fichier de hiérarchie .hrc lisible par tau-Argus à +#' partir d'une table de corrrespondance la décrivant complètement. Par défaut, +#' les lignes du tableau seront triées afin de regrouper les niveaux de +#' hiérarchie identiques. +#' +#' @section Details about correspondence table & .hrc: +#' Hierarchy files read by tau-Argus are expected to follow a strict pattern. +#' This function mimicks some of its rigidities. +#' \cr +#' +#' 1 \strong{Ideal case} +#' +#' Here is how a correspondence table is assumed to look like: +#' +#' | (**type**) | (**details**) | +#' |--------|------------| +#' | planet | telluric | +#' | planet | gasgiant | +#' | star | bluestar | +#' | star | whitedwarf | +#' | star | browndwarf | +#' | other | blackhole | +#' | other | pulsar | +#' +#' +#' Columns must be ordered from most aggregated to most detailed. +#' If they are in reverse order, you may want to use rev = TRUE. In any other +#' case, please reorder columns by hand.\cr +#' +#' Hierarchy must be well-nested : fine levels must systematically be nested +#' into unique higher levels. If this is not compatible with your situation, +#' you will have to split it in different hierarchies and insure common cells +#' are correctly protected (seek further documentation or help if needed). +#' \cr +#' +#' 2 \strong{Dealing with NAs} +#' +#' All levels must be filled in for the write_hrc2 function to work properly. +#' This ensures that the alphabetical sorting purposely regroups equal levels +#' together. NAs would be sorted together and, thus, be separated from their +#' expected place in the hierarchy. Other problems may also arise if NAs are +#' mixed with regular values in the table : comparisons between a line and its +#' precedessor are made, that may fail if NAs are inputed.\cr +#' There are, however, a few cases when NAs can be left relevantly. Please +#' be careful with the following possibilities and check thoroughly the +#' resulting .hrc file, or consider filling in NAs beforehand. +#' +#' 2.1 \emph{Sparse hierarchies} \cr +#' Hierarchy is sparse when NAs are inserted instead of repeating under a given +#' level. +#' +#' | (**type**) | (**details**) | +#' |--------|------------| +#' | planet | telluric | +#' | | gasgiant | +#' | star | bluestar | +#' | | whitedwarf | +#' | | reddwarf | +#' | other | blackhole | +#' | | pulsar | +#' +#' Processing such a file will result in wrongly written .hrc, since NAs will be +#' sorted together. It is still possible to deactivate sorting ; see sexample +#' below. This crucially requires that the table has already been sorted by the +#' user. +#' +#' 2.2 \emph{Non-uniform hierarchies}\cr +#' Hierarchies with non-uniform depth happen when some levels are not detailed +#' to the lowest detail, creating NAs. +#' +#' | (**type**) | (**details**) | +#' |--------|------------| +#' | planet | telluric | +#' | planet | gasgiant | +#' | star | | +#' | other | blackhole | +#' | other | pulsar | +#' +#' Such cases still issue a warning for the presence of NAs, but do not pose +#' any problem. +#' @md +#' +#' +#' @section Détails sur les tables de correspondance et le .hrc: +#' Tau-Argus attend des fichiers écrits avec précision. Certaines de ses +#' rigidités sont reproduites par cette fonction. +#' \cr +#' +#' 1 \strong{Cas idéal} +#' +#' Voici l'aspect général que devrait avoir une table de correspondance : +#' +#' | (**type**) | (**details**) | +#' |--------|------------| +#' | planet | telluric | +#' | planet | gasgiant | +#' | star | bluestar | +#' | star | whitedwarf | +#' | star | browndwarf | +#' | other | blackhole | +#' | other | pulsar | +#' +#' Les colonnes doivent être ordonnées du niveau le plus agrégé au plus fin. +#' Si elles sont en sens inverse, l'option rev = TRUE permet de les mettre en +#' ordre. Dans toute autre situation, vous devrez d'abord les ordonner à la +#' main. +#'\cr +#' +#' La hiérarchie doit être bien emboîtée : un niveau fin doit systématiquement +#' correspondre à un unique niveau agrégé. Si cette exigence n'est pas remplie, +#' il faudra créer plusieurs hiérarchies et faire en sorte que les cellules +#' communes soient correctement protégées (au besoin, consultez la documentation +#' ou chercher de l'aide). +#' \cr +#' +#' 2 \strong{Valeurs manquantes} +#' +#' Tous les niveaux doivent être remplis pour que write_hrc2 marche correctement. +#' Cela assure que lors du tri de la table, les niveaux identiques soient +#' regroupés. Les NAS risquent d'être triés ensemble et donc d'être séparés de +#' leur position normale. D'autres problèmes peuvent également émerger s'il +#' reste des valeurs manquantes dans la table : des comparaisons entre une ligne +#' et sa prédécesseuse peuvent échouer.\cr +#' +#' Il y a toutefois quelques cas où les valeurs manquantes peuvent rester +#' pertinentes. Si c'est ce que vous envisagez, faites bien attention à être +#' effectivement dans l'un des cas suivants, et prenez le temps de vérifier +#' prudemment la table .hrc ainsi créée. +#' +#' 2.1 \emph{Hiérarchies creuses} \cr +#' Une hiérarchie est creuse si des NAs sont insérées au lieu de répéter un +#' niveau donné verticalement. +#' +#' | (**type**) | (**details**) | +#' |--------|------------| +#' | planet | telluric | +#' | | gasgiant | +#' | star | bluestar | +#' | | whitedwarf | +#' | | reddwarf | +#' | other | blackhole | +#' | | pulsar | +#' +#' Utiliser un tel fichier va conduire à un mauvais .hrc, car les NAs vont être +#' regroupées par l'étape de tri des lignes . Il est cependant possible de +#' désactiver le tri (cf. exemples plus bas). Il est alors absolument nécessaire +#' que la table ait déjà été bien triée, comme ci-dessus. +#' +#' 2.2 \emph{Hiérarchies non-uniformes}\cr +#' Les hiérarchies à profondeur non-uniforme correspondent aux cas où certains +#' niveaux ne sont pas détaillés jusqu'au bout, la fin de certaines lignes étant +#' manquante. +#' +#' | (**type**) | (**details**) | +#' |--------|------------| +#' | planet | telluric | +#' | planet | gasgiant | +#' | star | | +#' | other | blackhole | +#' | other | pulsar | +#' +#' De tels cas génèrent toujours un warning à cause des NAs, mais ne posent pas +#' de problème particulier. +#' @md +#' +#' @return Invisible. Path to the written .hrc file. +#' \cr +#' Chemin vers le fichier .hrc. +#' +#' @export +#' +#' @examples +#' # 1. Standard example. Table will be written on your working directory. +#' # Exemple standard. La table sera écrite dans votre répertoire de travail. +#' astral <- data.frame( +#' type = c("planet", "planet", "star", "star", "star", "other", "other"), +#' details = c("telluric", "gasgiant", "bluestar", "whitedwarf", "reddwarf", "blackhole", "pulsar") +#' ) +#' path <- write_hrc2(astral, hier_lead_string = "@") +#' read.table(path) +#' # Note that line order was changed ('other' comes before 'planet'), to no +#' # consequence whatsoever for Tau-Argus. +#' # Remarque : l'ordre des lignes a été modifié ('other' arrive avant 'planet'), +#' # ce qui n'a aucune conséquence pour Tau-Argus. +#' +#' # Wrong column order: +#' # Mauvais ordonnement des colonnes : +#' astral_inv <- data.frame( +#' details = c("telluric", "gasgiant", "bluestar", "whitedwarf", "reddwarf", "blackhole", "pulsar"), +#' type = c("planet", "planet", "star", "star", "star", "other", "other") +#' ) +#' path <- write_hrc2(astral_inv, hier_lead_string = "@") +#' read.table(path) +#' # Because of the inverted order, everything is written backwards : planet is a +#' # subtype of gasgiant, etc. +#' # À cause de l'inversion des colonnes, tout est écrit à l'envers : planet est +#' # devenu une sous-catégorie de gasgiant, par exemple. +#' +#' # Correction : +#' path <- write_hrc2(astral_inv, rev = TRUE, hier_lead_string = "@") +#' read.table(path) +#' +#' # 2.1 Sparse case +#' # Cas creux +#' astral_sparse <- data.frame( +#' type = c("planet", NA, "star", NA, NA, "other", NA), +#' details = c("telluric", "gasgiant", "bluestar", "whitedwarf", "reddwarf", "blackhole", "pulsar") +#' ) +#' # NAs in general are risky : as is, the alphabetical sorting scrambles it all. +#' # Les valeurs manquantes causent un risque, de manière générale, à cause du +#' # tri alphabétique. +#' path <- write_hrc2(astral_sparse, hier_lead_string = "@") +#' read.table(path) +#' # Here, gasgiant and pulsar were misread as sublevels of 'star'. +#' # In order to correctly ignore NAs, sorting must be disabled. +#' # Ici, on voit que gasgiant et pulsar se retrouvent considérés comme des +#' # sous-types de planètes. Pour corriger, il faut désactiver le tri. +#' path2 <- write_hrc2(astral_sparse, sort_table = FALSE, hier_lead_string = "@") +#' read.table(path2) +#' +#' # 2.2 Non-uniform depth +#' # Hiérarchie non-uniforme +#' astral_nu <- data.frame( +#' type = c("planet", "planet", "star", "other", "other"), +#' details = c("telluric", "gasgiant", NA, "blackhole", "pulsar") +#' ) +#' path <- write_hrc2(astral_nu, hier_lead_string = "@") +#' read.table(path) +#' # In this case, everything is alright. +#' # Cette fois, tout se passe bien. +#' +#' # In some cases, non-uniform depth hierarchies are filled in to the last +#' # level with placeholder repetition. Such repetitions should not be written +#' # in the .hrc file, and are correctly erased. +#' # Dans certains cas, des hiérarchies à profondeur non-uniformes sont remplies +#' # à tous les niveaux en répétant les niveaux les plus hauts. De telles +#' # répétitions ne doivent pas être transmises dans le .hrc, et sont +#' # correctement effacées par la fonction. +#' astral_repeat <- data.frame( +#' type = c("planet", "planet", "star", "other"), +#' details = c("telluric", "gasgiant", "star", "other") +#' ) +#' path <- write_hrc2(astral_repeat, hier_lead_string = "@") +#' read.table(path) + + +write_hrc2 <- function(corr_table, + output_name = NULL, + dir_name = NULL, + sort_table = TRUE, + rev = FALSE, + hier_lead_string = getOption("rtauargus.hierleadstring") +){ + + # Set default filename / directory + if (is.null(output_name)) { + givenfilename <- deparse(substitute(corr_table)) + output_name <- givenfilename + } + + dir_name <- if(is.null(dir_name) | dir_name == "") getwd() else dir_name + + d = dim.data.frame(corr_table) + + #### Basic verifications & formatting + + # Reverse column order if asked + if (rev) corr_table <- rev(corr_table) + + # Make corr_table a data frame, or raise error + corr_table <- tryCatch( + { + as.data.frame(corr_table) + }, + error = function(msg){ + stop("Cannot coerce corr_table to a data frame") + print(msg) + } + ) + + # Check hier_lead_string + if(nchar(hier_lead_string) != 1){ + stop("hier_lead_string should be 1 single character") + } + + # Warn about presence of NAs + if (sum(is.na(corr_table))>0){ + warning("Missing values in correspondence table will be ignored (see documentation). + If unintended, this can cause errors when using the .hrc file with tau-Argus.") + } + # (Todo : lister cas de NA non gênantes et bloquer les autres) + + # Try to detect a problem with detailed column + if (sum(duplicated(corr_table[,d[2]]))>0) { + warning("There are duplicates in the expectedly most detailed level + (last column). Please be sure columns are rightfully ordered.") + } + + # Check if all columns are character + suspects <- NULL + for (col in 1:d[2]){ + if (!is.character(corr_table[,col])) { + suspects <- c(suspects, col) + } + } + if (!is.null(suspects)) message("Note : the following columns are not of character type : ", colnames(corr_table)[suspects], ". There may be an issue reading the table.") + + #### Creating the hrc file + + # 0. Sort the correspondence table + if (sort_table){ + for (j in 1:d[2]){ + corr_table <- corr_table[ + order(corr_table[,d[2]-j+1]) + ,] + } + } + + # 1. Compare cell values in order to erase duplicates (vertically / horizontally) + + corr_table_decale <- rbind( + rep("line1"), + corr_table[1:(d[1]-1),] + ) + corr_table_dec_left <- cbind( + w = rep("col1"), + corr_table[,1:d[2]-1] + ) + + compare <- corr_table == corr_table_decale #<-- cells identical to their upper + # neighbour + compare_left <- corr_table == corr_table_dec_left + missing <- is.na(corr_table) + + # 2. Add a fitting number of hier_lead_string to all + + depth_table <- as.data.frame(matrix( + nrow = d[1], ncol = d[2] + )) + for (colonne in 1:d[2]) { + depth_table[,colonne] <- colonne-1 + } + # the numeric values (from 0 to d2 -1) correspond to the depth in the + # hierarchy, which will govern how many hier_lead_string are added when + # writing the hrc. + # One adjustment has to be done for cases when a same level is repeated + # in a line : + + compare_col <- t(apply( + compare_left, + MARGIN = 1, + cumsum + )) + depth_table <- depth_table - compare_col + + for (col in 1:d[2]){ + corr_table[,col] <- vect_aro(string = corr_table[,col], + number = depth_table[,col], + hier_lead_string) + } + + + # for (colonne in 1:d[2]) { + # corr_table[,colonne] <- paste0( + # paste0(rep(hier_lead_string, colonne-1), collapse = ""), + # corr_table[,colonne], + # "\n") + # } + + corr_table[compare] <- "" + corr_table[compare_left] <- "" + corr_table[missing] <- "" + + # 3. Write corresponding table + # Note that columns & cells are not separated by anything, but cells that have + # not been erased still hold a line break ("\n") so that there will be line + # breaks only after non-void characters. + + loc_file <- paste0(c(dir_name, "/", output_name, ".hrc"), collapse = "") + + write.table(x = corr_table, + file = loc_file, + quote = FALSE, + row.names = FALSE, + col.names = FALSE, + sep="", + eol = "") + + invisible(loc_file) +} + +arobase <- function(string, number, hier_lead_string){ + paste0(paste0(rep(hier_lead_string, number), collapse = "") + , string, "\n", collapse = "") +} +vect_aro <- Vectorize(arobase, vectorize.args = c("string", "number")) + +# vect_aro(string = c("ab", "abb"), number = 1:2, hier_lead_string = "!") From c7b36d48ee39282270b0d9d36738a5e59d1a6252 Mon Sep 17 00:00:00 2001 From: Julien Jamme Date: Mon, 25 Jul 2022 11:49:14 +0200 Subject: [PATCH 006/107] Modify tab_rda with apriori file management and english documentation --- R/tab_rda.R | 399 +++++++++++++++++++++++++++++++++++-------------- man/tab_arb.Rd | 6 +- man/tab_rda.Rd | 246 ++++++++++++++++++++---------- 3 files changed, 454 insertions(+), 197 deletions(-) diff --git a/R/tab_rda.R b/R/tab_rda.R index 142eade..b65af4b 100644 --- a/R/tab_rda.R +++ b/R/tab_rda.R @@ -54,38 +54,126 @@ write_rda_tab <- function(info_vars) { } +#' Create rda files from tabulated data \cr #' Crée les fichiers rda à partir de données tabulées #' -#' Crée un fichier tabular (tab) et de métadonnées +#' Create an apriori file for the primary secret, +#' a tabular file (tab) and a metadata file (rda) +#' from tabulated data and additional information.\cr +#' +#' Crée un fichier d'apriori pour le secret primaire, +#' un fichier tabular (tab) et un fichier de métadonnées #' (rda) à partir de données tabulées et d'informations additionnelles. #' -#' @param tabular [\strong{obligatoire}] data.frame contenant les -#' données tabulées -#' @param tab_filename nom du fichier tab (avec extension) -#' @param rda_filename nom du fichier rda (avec extension). -#' @param decimals nombre minimal de décimales à afficher (voir section 'Nombre -#' de décimales'). -#' @param hrc informations sur les variables hiérarchiques (voir section -#' 'Variables hiérarchiques'). -#' @param hierleadstring caractère qui, répété n fois, indique que la valeur est -#' à n niveaux de profondeur dans la hiérarchie. -#' @param totcode code(s) pour le total d'une variable catégorielle (voir -#' section 'Paramètres spécifiques' pour la syntaxe de ce paramètre). Les -#' variables non spécifiées (ni par défaut, ni explicitement) se verront -#' attribuer la valeur de \code{rtauargus.totcode}. -#' @param missing code(s) pour une valeur manquante (voir section -#' 'Paramètres spécifiques' pour la syntaxe de ce paramètre). -#' @param codelist fichier(s) contenant les libellés des variables catégorielles -#' (voir section 'Paramètres spécifiques' pour la syntaxe de ce paramètre). -#' @param value nom de la colonne contenant la valeur des cellules -#' @param freq nom de la colonne contenant les effectifs pour une cellule -#' @param maxscore nom de la colonne contenant la valeur du plus gros contributeur +#' @param tabular [\strong{obligatoire}] +#' data.frame which contains the tabulated data and +#' an additional boolean variable that indicates the primary secret of type boolean \cr +#' data.frame contenant les données tabulées et +#' une variable supplémentaire indiquant le secret primaire de type booléen +#' +#' @param tab_filename tab file name (with .tab extension) \cr +#' nom du fichier tab (avec extension .tab) +#' @param rda_filename rda file name (with .rda extension) \cr +#' nom du fichier rda (avec extension) +#' @param hst_filename hst file name (with .hst extension) \cr +#' nom du fichier hst (avec extension) +#' +#' @param explanatory_vars [\strong{obligatoire}] Vector of categorical variables +#' \cr +#' Variables catégorielles, sous forme de liste de vecteurs +#' +#' Example : \code{list(c("A21", "TREFF", "REG")} +#' table crossing \code{A21} x \code{TREFF} x \code{REG} +#' +#' @param secret_var Boolean variable which give the primary secret : equal to +#' "TRUE" if a cell is concerned by the primary secret,"FALSE" otherwise. +#' \cr +#' variable indiquant le secret primaire de type booléen: +#' prend la valeur "TRUE" quand les cellules du tableau doivent être masquées +#' par le secret primaire, "FALSE" sinon. +#' +#' @param decimals Minimum number of decimals to be displayed +#' (see section 'Number of decimals') \cr +#' nombre minimal de décimales à afficher (voir section 'Nombre +#' de décimales'). +#' +#' @param hrc Informations on hierarchical variables (see section 'hierarchical +#' variable'). \cr +#' informations sur les variables hiérarchiques (voir section +#' 'Variables hiérarchiques'). +#' +#' @param hierleadstring Character which, repeated n times, +#' indicates that the value is at n levels of depth in the hierarchy. \cr +#' caractère qui, répété n fois, indique que la valeur est +#' à n niveaux de profondeur dans la hiérarchie. +#' +#' @param totcode Code(s) which represent the total of a categorical variable +#' (see section 'Specific parameters' for the syntax of this parameter). +#' Variables not specified (neither by default nor explicitly) +#' will be assigned the value of \code{rtauargus.totcode}.\cr +#' code(s) pour le total d'une variable catégorielle (voir +#' section 'Paramètres spécifiques' pour la syntaxe de ce paramètre). Les +#' variables non spécifiées (ni par défaut, ni explicitement) se verront +#' attribuer la valeur de \code{rtauargus.totcode}. +#' +#' @param missing Code(s) for a missing value (see section 'Specific parameters' +#' for the syntax of this parameter). \cr +#' code(s) pour une valeur manquante (voir section +#' 'Paramètres spécifiques' pour la syntaxe de ce paramètre). +#' +#' @param codelist file(s) containing labels of the categorical variables +#' (see section 'Specific parameters' for the syntax of this parameter).\cr +#' fichier(s) contenant les libellés des variables catégorielles +#' (voir section 'Paramètres spécifiques' pour la syntaxe de ce paramètre). +#' +#' @param value Name of the column containing the value of the cells. \cr +#' nom de la colonne contenant la valeur des cellules +#' +#' @param freq Name of the column containing the the numbers for a cell. \cr +#' Nom de la colonne contenant les effectifs pour une cellule +#' +#' @param maxscore Name of the column containing +#' the value of the largest contributor of a cell. \cr +#' +#' Nom de la colonne contenant la valeur du plus gros contributeur #' d'une cellule -#' @param separator charactere utilisé en tant que separateur dans le fichier .tab -#' @return Renvoie le nom du fichier rda sous forme de liste (de -#' manière invisible). #' -#' @section Paramètres spécifiques: +#' @param separator character used as separator in the .tab file. \cr +#' caractère utilisé en tant que separateur dans le fichier .tab +#' +#' @return Return the rda file name as a list (invisible).\cr +#' Renvoie le nom du fichier rda sous forme de liste (de +#' manière invisible). +#' +#' +#' @section Apriori file : +#' +#' The apriori file (.hst) summarizes for each value of the table +#' if they are concerned by the primary secret or not. +#' With this file tauargus will not need to set the primary secret itself. +#' The parameter \code{secret_var} indicates the name of the primary secret variable. +#' If there is the additional boolean variable which indicates the primary secret +#' in the table (of tabulated data), the function tab_rda will create +#' an apriori file in a format conforming to tauargus.\cr +#' +#' +#' Le fichier d'apriori (.hst) récapitule pour chaque valeurs +#' du tableau si elles sont concernées par le secret primaire ou non. +#' Avec ce fichier tauargus n'aura plus besoin de poser le secret primaire lui même, +#' il se basera sur le fichier d'apriori pour le faire. +#' Le paramètre \code{secret_var} indique le nom de la variable du secret primaire. +#' Si l'on rajoute cette variable supplémentaire indiquant +#' le secret primaire (de type booléen) au tableau de données tabulées, la fonction +#' tab_rda permet de créer un fichier d'apriori au format conforme pour tauargus. +#' +#' +#' @section Specific parameters: +#' +#' The parameters \code{totcode}, \code{missing} and \code{codelist} +#' must be given in the form of a vector indicating the value to take for each variable. +#' The names of the elements of the vector give the variable concerned and +#' the elements of the vector give the value of the parameter for Tau-Argus. +#' An unnamed element will be the default value.\cr #' #' Les paramètres \code{totcode}, \code{missing} et \code{codelist} #' sont à renseigner sous la forme d'un vecteur indiquant la valeur à prendre @@ -96,47 +184,48 @@ write_rda_tab <- function(info_vars) { #' nommé constituera la valeur par défaut, qui sera attribuée à toutes les #' variables pouvant prendre ce paramètre. #' -#' Par exemple : +#' For example : #' \itemize{ -#' \item{\code{totcode = "Ensemble"} : écrit \code{ "Ensemble"} pour +#' \item{\code{totcode = "global"} : écrit \code{ "global"} pour #' toutes les variables catégorielles} -#' \item{\code{totcode = c("Ensemble", GEO = "France")} : idem, sauf pour la -#' variable \code{GEO}} +#' \item{\code{totcode = c("global", size="total", income="total")} : +#' idem, sauf pour les variables \code{size}et \code{income}} #' } #' -#' @section Variables hiérarchiques: +#' @section Hierarchical variables: +#' +#' Parameter \code{hrc} has the same syntax as \code{totcode},\code{missing} and +#' \code{codelist} (named vector containing as many elements as variables to describe). +#' Hierarchy is defined in an separate hrc file (\strong{hiercodelist}). +#' which can be written with the function \code{link{write_hrc2}}. +#' The function expects the location of this file (and a possible \code{hierleadstring} +#' if it differs from the default option of the package). +#' The path to the existing file is explicitly given. +#' The elements of the vector in parameter must be named (with the name of the variable), +#' even if there is only one element +#' emph{Example :}\code{c(category="category.hrc")} #' #' Le paramètre \code{hrc} obéit aux mêmes règles de syntaxe que \code{totcode}, #' \code{missing} et \code{codelist} (vecteur nommé contenant autant d'éléments -#' que de variables à décrire). Il présente de plus la particularité -#' d'accepter plusieurs façons de spécifier les valeurs associées aux variables -#' hiérarchiques. -#' -#' Pour définir une hiérarchie basée sur les positions des caractères -#' (\strong{hierlevels}), passer une suite de nombre entiers séparés par des -#' espaces. -#' -#' \emph{Exemple :} \code{c(CODECOM = "2 3 0 0 0")} +#' que de variables à décrire). #' -#' Si la hiérarchie est définie dans un fichier hrc à part -#' (\strong{hiercodelist}), la fonction attend l'emplacement de ce fichier (et -#' un éventuel \code{hierleadstring} s'il diffère de l'option par défaut du -#' package). Dans ce cas, on peut écrire explicitement le chemin vers un fichier -#' existant (\code{c(A38 = "a38.hrc")}), mais aussi passer un appel à -#' \code{\link{write_hrc}} qui génèrera un fichier hrc à partir de données tabulées. +#' La hiérarchie est définie dans un fichier hrc à part (\strong{hiercodelist}) +#' qui peut être écrit à l'aide de la fonction \code{\link{write_hrc2}}. #' -#' \emph{Exemple :} \code{c(A38 = write_hrc(tabular, c("A38", "A21", "A10")))} -#' -#' -#' Les deux dernières méthodes passent par la création d'un fichier temporaire. -#' Pour un fichier hrc réutilisable, il est nécessaire de le créer au préalable -#' à l'aide de \code{write_hrc}. -#' -#' Les trois méthodes nécessitent que les éléments du vecteur en paramètre -#' soient nommés (avec le nom de la variable), même s'il n'y a qu'un seul +#' La fonction attend l'emplacement de ce fichier (et un éventuel \code{hierleadstring} +#' s'il diffère de l'option par défaut du package). +#' Le chemin vers le fichier existant est explicitement donné. +#' Les éléments du vecteur en paramètre doivent nommés (avec le nom de la variable), +#' même s'il n'y a qu'un seul #' élément. +#'\emph{Exemple :}\code{c(category="category.hrc")} #' -#' @section Nombre de décimales: +#' @section Number of decimals: +#' Parameter \code{decimals} indicates the minimum number of decimal places to +#' include in the output file +#' (whatever the number of decimals actually present in \code{tabular}). +#' It applies to all real variables (double) but not to integer variables. +#' To add zeros to an integer variable, convert it with \code{as.double} beforehand.\cr #' #' Le paramètre \code{decimals} indique le nombre minimal de décimales à faire #' figurer dans le fichier en sortie (quel que soit le nombre de décimales @@ -145,39 +234,44 @@ write_rda_tab <- function(info_vars) { #' ajouter des zéros à une variable entière, la convertir avec \code{as.double} #' au préalable. #' -#' -#' @section Voir aussi: La fonction \code{\link{rtauargus}}, qui utilise cette -#' fonction et hérite de ses paramètres. +#' @section Voir aussi: #' #' @examples #' \dontrun{ #' # donnees fictives -#' tab_df <- -#' data.frame( -#' GEO = c("443", "541", "543"), -#' A10 = c( "AZ", "BE", "BE"), -#' A21 = c( "A", "B", "C"), -#' DIPL = c( "01", "??", "02"), -#' CA = c( 100, 0, 7), -#' effectif = c( 3, 6, 8), -#' max_CA = c( 57, 0, 1), -#' ) -#' -#' # creation rda -#' res <- -#' tab_rda( -#' tabular = tab_df, -#' decimals = 1, -#' hrc = c(A21 = "A21>A10", GEO = "2 1 0", DIPL = "dipl.hrc"), -#' totcode = c(GEO = "France"), -#' missing = c(DIPL = "??"), -#' value = "CA", -#' freq = "effectif", -#' maxscore = "max_CA", -#' separator = "," -#' ) -#' -#' # visualisation des fichiers produits +#' +#' tab <-data.frame( +#' category = c( "A" , "B", "C", "D", "E", "F"), +#' size = c("tr1", "tr3", "tr2", "tr1", "tr1", "tr2"), +#' area = c( "07", "01", "04", "06", "02", "06"), +#' income = c( 100, 4, 7, 14, 42, 85), +#' freq = c( 2, 6, 8, 45, 100, 1), +#' max = c( 54, 2, 1, 13, 19, 85), +#' primary_secret = c( TRUE, FALSE, FALSE, TRUE, FALSE, TRUE) +#' ) +#' +#' # rda creation +#' +#' files_names <- +#' tab_rda( +#' tabular = tab, +#' tab_filename = "tauargus_files/file.tab", +#' rda_filename = "tauargus_files/file.rda", +#' hst_filename = "tauargus_files/file.hst", +#' hrc = c(category = "category.hrc"), +#' explanatory_vars = c("category" , "size", "area"), +#' secret_var = "primary_secret", +#' totcode = c( +#' category = "global", +#' size = "total", +#' area = "global", +#' income = "total" +#' ), +#' value = "income", +#' freq = "freq" +#' ) +#' +#' # Viewing product files #' file.show( #' res$rda_filename, #' header = unlist(res), @@ -193,23 +287,28 @@ write_rda_tab <- function(info_vars) { #' @export tab_rda <- function( - tabular, - tab_filename = NULL, - rda_filename = NULL, - decimals = getOption("rtauargus.decimals"), - hrc = NULL, - hierleadstring = getOption("rtauargus.hierleadstring"), - totcode = getOption("rtauargus.totcode"), - missing = getOption("rtauargus.missing"), - codelist = NULL, - value = NULL, - freq = NULL, - maxscore = NULL, - separator = "," + tabular, + tab_filename = NULL, + rda_filename = NULL, + hst_filename = NULL, + explanatory_vars=NULL, + secret_var=NULL, + decimals = getOption("rtauargus.decimals"), + hrc = NULL, + hierleadstring = getOption("rtauargus.hierleadstring"), + totcode = getOption("rtauargus.totcode"), + missing = getOption("rtauargus.missing"), + codelist = NULL, + value = NULL, + freq = NULL, + maxscore = NULL, + separator = "," ) { + tabular <- as.data.frame(tabular) # (probleme avec tibble notamment) + # valeur par défaut du package si option vide ........................... if (is.null(decimals)) decimals <- op.rtauargus$rtauargus.decimals @@ -219,38 +318,103 @@ tab_rda <- function( if (is.null(totcode)) totcode <- op.rtauargus$rtauargus.totcode if (is.null(missing)) missing <- op.rtauargus$rtauargus.missing - # ignore colonnes de longueurs nulles .................................. - colvides <- sapply(tabular, function(x) all(is.na(x)) | all(x == "")) - if (any(colvides)) { + if (!is.null(secret_var)){ + colvides <- sapply(tabular[,!names(tabular)==secret_var], function(x) all(is.na(x)) | all(x == "")) + } else { + colvides <- sapply(tabular, function(x) all(is.na(x)) | all(x == "")) + } + + if (any(colvides) ) { + name_colvides<-paste(names(tabular)[colvides], collapse = ", ") warning( - "Colonnes vides : ", - paste(names(tabular)[colvides], collapse = ", ") + "empty columns : ", + name_colvides ) tabular <- tabular[!colvides] } # parametres non renseignés ........................................... - if (is.null(rda_filename)) rda_filename <- tempfile("RTA_", fileext = ".rda") + if (is.null(tab_filename)) tab_filename <- "tabular.tab" + if (is.null(hst_filename)) hst_filename <- "apriori.hst" + + #Gestion du chemin des fichiers + name_rda<-basename(rda_filename) + directory_rda<-stringr::str_replace(rda_filename, pattern = name_rda, replacement="") + if(!(dir.exists(directory_rda))) + {dir.create(directory_rda, recursive = TRUE)} + + name_tab<-basename(tab_filename) + directory_tab<-stringr::str_replace(tab_filename, pattern = name_tab, replacement="") + if(!(dir.exists(directory_tab))) + {dir.create(directory_tab, recursive = TRUE)} + + name_hst<-basename(hst_filename) + directory_hst<-stringr::str_replace(hst_filename, pattern = name_hst, replacement="") + if(!(dir.exists(directory_hst))) + {dir.create(directory_hst, recursive = TRUE)} + + + #Controles sur secret_var + + if (is.null(secret_var)) message("secret_var is NULL : no apriori file will be used") + + if ((!is.null(secret_var)) && (!secret_var %in% colnames(tabular))) + {stop("secret_var does not exist in tabular")} + + if((!is.null(secret_var)) && (any(!is.na(tabular[[secret_var]]))) && (!is.logical(tabular[[secret_var]]))) + {stop("unexpected type : secret_var must be a boolean variable")} + + if((!is.null(secret_var)) && any(is.na(tabular[[secret_var]]))) + {stop("NAs in secret_var are not allowed")} + - # genere fichier longueur fixe et infos associees ..................... + #Genere le fichier hst + + if((!is.null(secret_var)) && (is.logical(tabular[[secret_var]]))) { + + tabular[secret_var]<-ifelse(tabular[[secret_var]],"u","s") + hst=tabular[ + tabular[secret_var]=="u", + c(explanatory_vars[(explanatory_vars %in% colnames(tabular))], secret_var) + ] + + if (nrow(hst)==0) message("no values are concerned by the primary secret : hst file is empty") + + write.table( + hst, + hst_filename, + row.names=FALSE, + col.names = FALSE, + sep=",", + quote=FALSE + ) + } + + + + # genere fichier longueur fixe (le fichier .tab) dans le dossier indiqué et infos associees ..................... + + if (!is.null(secret_var)) tabular<-tabular[,!names(tabular)==secret_var] fwf_info_tabular <- gdata::write.fwf( tabular, - file = tab_filename, + file= tab_filename, formatInfo = TRUE, colnames = FALSE, justify = "right", # pour les variables caractères uniquement - digits = 15, # max ? voir aide de format + digits = 15, nsmall = decimals, scientific = FALSE, - sep=separator + sep=separator ) num <- vapply(tabular, is.numeric, logical(1)) + + fwf_info_tabular <- fwf_info_tabular %>% mutate( @@ -278,10 +442,12 @@ tab_rda <- function( df_param_defaut(var_quanti, "totcode", totcode) %>% mutate(totcode = dplyr::coalesce(totcode, getOption("rtauargus.totcode"))) - # hierachical ...................................................... + + + # hierarchical ...................................................... if (!is.null(hrc) & (is.null(names(hrc)) | any(names(hrc) == ""))) { - stop("noms manquants pour hrc. Exemple : hrc = c(VAR = \"var.hrc\")") + stop("missing name for hrc. Example : hrc = c(VAR = \"var.hrc\")") } norm_hrc <- @@ -294,6 +460,7 @@ tab_rda <- function( hrc_df <- df_param_defaut(var_quanti, "hierarchical", norm_hrc) hrc_df$hierleadstring <- NA_character_ need_leadstring <- grepl("\\.hrc$", hrc_df$hierarchical) + hrc_df$hierleadstring[need_leadstring] <- hierleadstring fwf_info_tabular <- @@ -314,7 +481,7 @@ tab_rda <- function( ) # reorganise en une liste de variables ............................. - fwf_info_tabular <-transpose(fwf_info_tabular) + fwf_info_tabular <-purrr::transpose(fwf_info_tabular) # genere vecteur format .rda ....................................... res <- character(0) @@ -329,14 +496,16 @@ tab_rda <- function( # écrit fichier texte .............................................. writeLines(res, rda_filename) - # renvoie noms des fichiers tab et rda de manière invisible ....... + # renvoie noms des fichiers hst, tab et rda de manière invisible ....... invisible( list( - tab_filename = normPath2(tab_filename), - rda_filename = normPath2(rda_filename) - ) + tab_filename = normPath2(tab_filename), + rda_filename = normPath2(rda_filename), + hst_filename = normPath2(hst_filename) + ) ) + } diff --git a/man/tab_arb.Rd b/man/tab_arb.Rd index 4da875b..899f48a 100644 --- a/man/tab_arb.Rd +++ b/man/tab_arb.Rd @@ -28,7 +28,8 @@ extension). Si non renseigné, un fichier temporaire.} \item{tab_filename}{[\strong{obligatoire}] nom du fichier .tab (avec extension).} -\item{rda_filename}{nom du fichier rda (avec extension).} +\item{rda_filename}{rda file name (with .rda extension) \cr +nom du fichier rda (avec extension)} \item{explanatory_vars}{[\strong{obligatoire}] variables catégorielles, sous forme de liste de vecteurs. Chaque élément de la liste est un vecteur des @@ -136,8 +137,7 @@ autant de valeurs que de tabulations. } \section{Voir aussi}{ - La fonction \code{\link{rtauargus}}, qui utilise cette -fonction et hérite de ses paramètres. + } \examples{ diff --git a/man/tab_rda.Rd b/man/tab_rda.Rd index 6e72baf..50fc025 100644 --- a/man/tab_rda.Rd +++ b/man/tab_rda.Rd @@ -2,12 +2,16 @@ % Please edit documentation in R/tab_rda.R \name{tab_rda} \alias{tab_rda} -\title{Crée les fichiers rda à partir de données tabulées} +\title{Create rda files from tabulated data \cr +Crée les fichiers rda à partir de données tabulées} \usage{ tab_rda( tabular, tab_filename = NULL, rda_filename = NULL, + hst_filename = NULL, + explanatory_vars = NULL, + secret_var = NULL, decimals = getOption("rtauargus.decimals"), hrc = NULL, hierleadstring = getOption("rtauargus.hierleadstring"), @@ -21,52 +25,129 @@ tab_rda( ) } \arguments{ -\item{tabular}{[\strong{obligatoire}] data.frame contenant les -données tabulées} - -\item{tab_filename}{nom du fichier tab (avec extension)} - -\item{rda_filename}{nom du fichier rda (avec extension).} - -\item{decimals}{nombre minimal de décimales à afficher (voir section 'Nombre +\item{tabular}{[\strong{obligatoire}] +data.frame which contains the tabulated data and +an additional boolean variable that indicates the primary secret of type boolean \cr +data.frame contenant les données tabulées et +une variable supplémentaire indiquant le secret primaire de type booléen} + +\item{tab_filename}{tab file name (with .tab extension) \cr +nom du fichier tab (avec extension .tab)} + +\item{rda_filename}{rda file name (with .rda extension) \cr +nom du fichier rda (avec extension)} + +\item{hst_filename}{hst file name (with .hst extension) \cr +nom du fichier hst (avec extension)} + +\item{explanatory_vars}{[\strong{obligatoire}] Vector of categorical variables +\cr +Variables catégorielles, sous forme de liste de vecteurs + +Example : \code{list(c("A21", "TREFF", "REG")} +table crossing \code{A21} x \code{TREFF} x \code{REG}} + +\item{secret_var}{Boolean variable which give the primary secret : equal to +"TRUE" if a cell is concerned by the primary secret,"FALSE" otherwise. +\cr +variable indiquant le secret primaire de type booléen: +prend la valeur "TRUE" quand les cellules du tableau doivent être masquées +par le secret primaire, "FALSE" sinon.} + +\item{decimals}{Minimum number of decimals to be displayed +(see section 'Number of decimals') \cr +nombre minimal de décimales à afficher (voir section 'Nombre de décimales').} -\item{hrc}{informations sur les variables hiérarchiques (voir section +\item{hrc}{Informations on hierarchical variables (see section 'hierarchical +variable'). \cr +informations sur les variables hiérarchiques (voir section 'Variables hiérarchiques').} -\item{hierleadstring}{caractère qui, répété n fois, indique que la valeur est +\item{hierleadstring}{Character which, repeated n times, +indicates that the value is at n levels of depth in the hierarchy. \cr +caractère qui, répété n fois, indique que la valeur est à n niveaux de profondeur dans la hiérarchie.} -\item{totcode}{code(s) pour le total d'une variable catégorielle (voir +\item{totcode}{Code(s) which represent the total of a categorical variable +(see section 'Specific parameters' for the syntax of this parameter). +Variables not specified (neither by default nor explicitly) +will be assigned the value of \code{rtauargus.totcode}.\cr +code(s) pour le total d'une variable catégorielle (voir section 'Paramètres spécifiques' pour la syntaxe de ce paramètre). Les variables non spécifiées (ni par défaut, ni explicitement) se verront attribuer la valeur de \code{rtauargus.totcode}.} -\item{missing}{code(s) pour une valeur manquante (voir section +\item{missing}{Code(s) for a missing value (see section 'Specific parameters' +for the syntax of this parameter). \cr +code(s) pour une valeur manquante (voir section 'Paramètres spécifiques' pour la syntaxe de ce paramètre).} -\item{codelist}{fichier(s) contenant les libellés des variables catégorielles +\item{codelist}{file(s) containing labels of the categorical variables +(see section 'Specific parameters' for the syntax of this parameter).\cr +fichier(s) contenant les libellés des variables catégorielles (voir section 'Paramètres spécifiques' pour la syntaxe de ce paramètre).} -\item{value}{nom de la colonne contenant la valeur des cellules} +\item{value}{Name of the column containing the value of the cells. \cr +nom de la colonne contenant la valeur des cellules} -\item{freq}{nom de la colonne contenant les effectifs pour une cellule} +\item{freq}{Name of the column containing the the numbers for a cell. \cr +Nom de la colonne contenant les effectifs pour une cellule} -\item{maxscore}{nom de la colonne contenant la valeur du plus gros contributeur +\item{maxscore}{Name of the column containing +the value of the largest contributor of a cell. \cr + +Nom de la colonne contenant la valeur du plus gros contributeur d'une cellule} -\item{separator}{charactere utilisé en tant que separateur dans le fichier .tab} +\item{separator}{character used as separator in the .tab file. \cr +caractère utilisé en tant que separateur dans le fichier .tab} } \value{ +Return the rda file name as a list (invisible).\cr Renvoie le nom du fichier rda sous forme de liste (de - manière invisible). +manière invisible). } \description{ -Crée un fichier tabular (tab) et de métadonnées +Create an apriori file for the primary secret, +a tabular file (tab) and a metadata file (rda) +from tabulated data and additional information.\cr +} +\details{ +Crée un fichier d'apriori pour le secret primaire, +un fichier tabular (tab) et un fichier de métadonnées (rda) à partir de données tabulées et d'informations additionnelles. } -\section{Paramètres spécifiques}{ +\section{Apriori file }{ + + +The apriori file (.hst) summarizes for each value of the table +if they are concerned by the primary secret or not. +With this file tauargus will not need to set the primary secret itself. +The parameter \code{secret_var} indicates the name of the primary secret variable. +If there is the additional boolean variable which indicates the primary secret +in the table (of tabulated data), the function tab_rda will create +an apriori file in a format conforming to tauargus.\cr + + +Le fichier d'apriori (.hst) récapitule pour chaque valeurs +du tableau si elles sont concernées par le secret primaire ou non. +Avec ce fichier tauargus n'aura plus besoin de poser le secret primaire lui même, +il se basera sur le fichier d'apriori pour le faire. +Le paramètre \code{secret_var} indique le nom de la variable du secret primaire. +Si l'on rajoute cette variable supplémentaire indiquant +le secret primaire (de type booléen) au tableau de données tabulées, la fonction +tab_rda permet de créer un fichier d'apriori au format conforme pour tauargus. +} + +\section{Specific parameters}{ + +The parameters \code{totcode}, \code{missing} and \code{codelist} +must be given in the form of a vector indicating the value to take for each variable. +The names of the elements of the vector give the variable concerned and +the elements of the vector give the value of the parameter for Tau-Argus. +An unnamed element will be the default value.\cr Les paramètres \code{totcode}, \code{missing} et \code{codelist} sont à renseigner sous la forme d'un vecteur indiquant la valeur à prendre @@ -77,51 +158,52 @@ du vecteur donnent la valeur du paramètre pour Tau-Argus. Un élément non nommé constituera la valeur par défaut, qui sera attribuée à toutes les variables pouvant prendre ce paramètre. -Par exemple : +For example : \itemize{ - \item{\code{totcode = "Ensemble"} : écrit \code{ "Ensemble"} pour + \item{\code{totcode = "global"} : écrit \code{ "global"} pour toutes les variables catégorielles} - \item{\code{totcode = c("Ensemble", GEO = "France")} : idem, sauf pour la - variable \code{GEO}} + \item{\code{totcode = c("global", size="total", income="total")} : + idem, sauf pour les variables \code{size}et \code{income}} } } -\section{Variables hiérarchiques}{ +\section{Hierarchical variables}{ +Parameter \code{hrc} has the same syntax as \code{totcode},\code{missing} and +\code{codelist} (named vector containing as many elements as variables to describe). +Hierarchy is defined in an separate hrc file (\strong{hiercodelist}). +which can be written with the function \code{link{write_hrc2}}. +The function expects the location of this file (and a possible \code{hierleadstring} +if it differs from the default option of the package). +The path to the existing file is explicitly given. +The elements of the vector in parameter must be named (with the name of the variable), +even if there is only one element +emph{Example :}\code{c(category="category.hrc")} + Le paramètre \code{hrc} obéit aux mêmes règles de syntaxe que \code{totcode}, \code{missing} et \code{codelist} (vecteur nommé contenant autant d'éléments -que de variables à décrire). Il présente de plus la particularité -d'accepter plusieurs façons de spécifier les valeurs associées aux variables -hiérarchiques. - -Pour définir une hiérarchie basée sur les positions des caractères -(\strong{hierlevels}), passer une suite de nombre entiers séparés par des -espaces. +que de variables à décrire). -\emph{Exemple :} \code{c(CODECOM = "2 3 0 0 0")} +La hiérarchie est définie dans un fichier hrc à part (\strong{hiercodelist}) +qui peut être écrit à l'aide de la fonction \code{\link{write_hrc2}}. -Si la hiérarchie est définie dans un fichier hrc à part -(\strong{hiercodelist}), la fonction attend l'emplacement de ce fichier (et -un éventuel \code{hierleadstring} s'il diffère de l'option par défaut du -package). Dans ce cas, on peut écrire explicitement le chemin vers un fichier -existant (\code{c(A38 = "a38.hrc")}), mais aussi passer un appel à -\code{\link{write_hrc}} qui génèrera un fichier hrc à partir de données tabulées. - -\emph{Exemple :} \code{c(A38 = write_hrc(tabular, c("A38", "A21", "A10")))} - - -Les deux dernières méthodes passent par la création d'un fichier temporaire. -Pour un fichier hrc réutilisable, il est nécessaire de le créer au préalable -à l'aide de \code{write_hrc}. - -Les trois méthodes nécessitent que les éléments du vecteur en paramètre -soient nommés (avec le nom de la variable), même s'il n'y a qu'un seul +La fonction attend l'emplacement de ce fichier (et un éventuel \code{hierleadstring} +s'il diffère de l'option par défaut du package). +Le chemin vers le fichier existant est explicitement donné. +Les éléments du vecteur en paramètre doivent nommés (avec le nom de la variable), +même s'il n'y a qu'un seul élément. +\emph{Exemple :}\code{c(category="category.hrc")} } -\section{Nombre de décimales}{ +\section{Number of decimals}{ +Parameter \code{decimals} indicates the minimum number of decimal places to +include in the output file +(whatever the number of decimals actually present in \code{tabular}). +It applies to all real variables (double) but not to integer variables. +To add zeros to an integer variable, convert it with \code{as.double} beforehand.\cr Le paramètre \code{decimals} indique le nombre minimal de décimales à faire figurer dans le fichier en sortie (quel que soit le nombre de décimales @@ -132,39 +214,45 @@ au préalable. } \section{Voir aussi}{ - La fonction \code{\link{rtauargus}}, qui utilise cette -fonction et hérite de ses paramètres. + } \examples{ \dontrun{ # donnees fictives -tab_df <- - data.frame( - GEO = c("443", "541", "543"), - A10 = c( "AZ", "BE", "BE"), - A21 = c( "A", "B", "C"), - DIPL = c( "01", "??", "02"), - CA = c( 100, 0, 7), - effectif = c( 3, 6, 8), - max_CA = c( 57, 0, 1), - ) - -# creation rda -res <- - tab_rda( - tabular = tab_df, - decimals = 1, - hrc = c(A21 = "A21>A10", GEO = "2 1 0", DIPL = "dipl.hrc"), - totcode = c(GEO = "France"), - missing = c(DIPL = "??"), - value = "CA", - freq = "effectif", - maxscore = "max_CA", - separator = "," - ) - -# visualisation des fichiers produits + +tab <-data.frame( +category = c( "A" , "B", "C", "D", "E", "F"), +size = c("tr1", "tr3", "tr2", "tr1", "tr1", "tr2"), +area = c( "07", "01", "04", "06", "02", "06"), +income = c( 100, 4, 7, 14, 42, 85), +freq = c( 2, 6, 8, 45, 100, 1), +max = c( 54, 2, 1, 13, 19, 85), +primary_secret = c( TRUE, FALSE, FALSE, TRUE, FALSE, TRUE) +) + +# rda creation + +files_names <- + tab_rda( + tabular = tab, + tab_filename = "tauargus_files/file.tab", + rda_filename = "tauargus_files/file.rda", + hst_filename = "tauargus_files/file.hst", + hrc = c(category = "category.hrc"), + explanatory_vars = c("category" , "size", "area"), + secret_var = "primary_secret", + totcode = c( + category = "global", + size = "total", + area = "global", + income = "total" + ), + value = "income", + freq = "freq" +) + +# Viewing product files file.show( res$rda_filename, header = unlist(res), From 3c27929e73b48ba31779f2d4022a566861122240 Mon Sep 17 00:00:00 2001 From: Julien Jamme Date: Mon, 25 Jul 2022 12:00:29 +0200 Subject: [PATCH 007/107] tab_rda improvements with apriori file management and english documentation --- R/tab_rda.R | 399 +++++++++++++++++++++++++++++++++++-------------- man/tab_arb.Rd | 6 +- man/tab_rda.Rd | 246 ++++++++++++++++++++---------- 3 files changed, 454 insertions(+), 197 deletions(-) diff --git a/R/tab_rda.R b/R/tab_rda.R index 142eade..b65af4b 100644 --- a/R/tab_rda.R +++ b/R/tab_rda.R @@ -54,38 +54,126 @@ write_rda_tab <- function(info_vars) { } +#' Create rda files from tabulated data \cr #' Crée les fichiers rda à partir de données tabulées #' -#' Crée un fichier tabular (tab) et de métadonnées +#' Create an apriori file for the primary secret, +#' a tabular file (tab) and a metadata file (rda) +#' from tabulated data and additional information.\cr +#' +#' Crée un fichier d'apriori pour le secret primaire, +#' un fichier tabular (tab) et un fichier de métadonnées #' (rda) à partir de données tabulées et d'informations additionnelles. #' -#' @param tabular [\strong{obligatoire}] data.frame contenant les -#' données tabulées -#' @param tab_filename nom du fichier tab (avec extension) -#' @param rda_filename nom du fichier rda (avec extension). -#' @param decimals nombre minimal de décimales à afficher (voir section 'Nombre -#' de décimales'). -#' @param hrc informations sur les variables hiérarchiques (voir section -#' 'Variables hiérarchiques'). -#' @param hierleadstring caractère qui, répété n fois, indique que la valeur est -#' à n niveaux de profondeur dans la hiérarchie. -#' @param totcode code(s) pour le total d'une variable catégorielle (voir -#' section 'Paramètres spécifiques' pour la syntaxe de ce paramètre). Les -#' variables non spécifiées (ni par défaut, ni explicitement) se verront -#' attribuer la valeur de \code{rtauargus.totcode}. -#' @param missing code(s) pour une valeur manquante (voir section -#' 'Paramètres spécifiques' pour la syntaxe de ce paramètre). -#' @param codelist fichier(s) contenant les libellés des variables catégorielles -#' (voir section 'Paramètres spécifiques' pour la syntaxe de ce paramètre). -#' @param value nom de la colonne contenant la valeur des cellules -#' @param freq nom de la colonne contenant les effectifs pour une cellule -#' @param maxscore nom de la colonne contenant la valeur du plus gros contributeur +#' @param tabular [\strong{obligatoire}] +#' data.frame which contains the tabulated data and +#' an additional boolean variable that indicates the primary secret of type boolean \cr +#' data.frame contenant les données tabulées et +#' une variable supplémentaire indiquant le secret primaire de type booléen +#' +#' @param tab_filename tab file name (with .tab extension) \cr +#' nom du fichier tab (avec extension .tab) +#' @param rda_filename rda file name (with .rda extension) \cr +#' nom du fichier rda (avec extension) +#' @param hst_filename hst file name (with .hst extension) \cr +#' nom du fichier hst (avec extension) +#' +#' @param explanatory_vars [\strong{obligatoire}] Vector of categorical variables +#' \cr +#' Variables catégorielles, sous forme de liste de vecteurs +#' +#' Example : \code{list(c("A21", "TREFF", "REG")} +#' table crossing \code{A21} x \code{TREFF} x \code{REG} +#' +#' @param secret_var Boolean variable which give the primary secret : equal to +#' "TRUE" if a cell is concerned by the primary secret,"FALSE" otherwise. +#' \cr +#' variable indiquant le secret primaire de type booléen: +#' prend la valeur "TRUE" quand les cellules du tableau doivent être masquées +#' par le secret primaire, "FALSE" sinon. +#' +#' @param decimals Minimum number of decimals to be displayed +#' (see section 'Number of decimals') \cr +#' nombre minimal de décimales à afficher (voir section 'Nombre +#' de décimales'). +#' +#' @param hrc Informations on hierarchical variables (see section 'hierarchical +#' variable'). \cr +#' informations sur les variables hiérarchiques (voir section +#' 'Variables hiérarchiques'). +#' +#' @param hierleadstring Character which, repeated n times, +#' indicates that the value is at n levels of depth in the hierarchy. \cr +#' caractère qui, répété n fois, indique que la valeur est +#' à n niveaux de profondeur dans la hiérarchie. +#' +#' @param totcode Code(s) which represent the total of a categorical variable +#' (see section 'Specific parameters' for the syntax of this parameter). +#' Variables not specified (neither by default nor explicitly) +#' will be assigned the value of \code{rtauargus.totcode}.\cr +#' code(s) pour le total d'une variable catégorielle (voir +#' section 'Paramètres spécifiques' pour la syntaxe de ce paramètre). Les +#' variables non spécifiées (ni par défaut, ni explicitement) se verront +#' attribuer la valeur de \code{rtauargus.totcode}. +#' +#' @param missing Code(s) for a missing value (see section 'Specific parameters' +#' for the syntax of this parameter). \cr +#' code(s) pour une valeur manquante (voir section +#' 'Paramètres spécifiques' pour la syntaxe de ce paramètre). +#' +#' @param codelist file(s) containing labels of the categorical variables +#' (see section 'Specific parameters' for the syntax of this parameter).\cr +#' fichier(s) contenant les libellés des variables catégorielles +#' (voir section 'Paramètres spécifiques' pour la syntaxe de ce paramètre). +#' +#' @param value Name of the column containing the value of the cells. \cr +#' nom de la colonne contenant la valeur des cellules +#' +#' @param freq Name of the column containing the the numbers for a cell. \cr +#' Nom de la colonne contenant les effectifs pour une cellule +#' +#' @param maxscore Name of the column containing +#' the value of the largest contributor of a cell. \cr +#' +#' Nom de la colonne contenant la valeur du plus gros contributeur #' d'une cellule -#' @param separator charactere utilisé en tant que separateur dans le fichier .tab -#' @return Renvoie le nom du fichier rda sous forme de liste (de -#' manière invisible). #' -#' @section Paramètres spécifiques: +#' @param separator character used as separator in the .tab file. \cr +#' caractère utilisé en tant que separateur dans le fichier .tab +#' +#' @return Return the rda file name as a list (invisible).\cr +#' Renvoie le nom du fichier rda sous forme de liste (de +#' manière invisible). +#' +#' +#' @section Apriori file : +#' +#' The apriori file (.hst) summarizes for each value of the table +#' if they are concerned by the primary secret or not. +#' With this file tauargus will not need to set the primary secret itself. +#' The parameter \code{secret_var} indicates the name of the primary secret variable. +#' If there is the additional boolean variable which indicates the primary secret +#' in the table (of tabulated data), the function tab_rda will create +#' an apriori file in a format conforming to tauargus.\cr +#' +#' +#' Le fichier d'apriori (.hst) récapitule pour chaque valeurs +#' du tableau si elles sont concernées par le secret primaire ou non. +#' Avec ce fichier tauargus n'aura plus besoin de poser le secret primaire lui même, +#' il se basera sur le fichier d'apriori pour le faire. +#' Le paramètre \code{secret_var} indique le nom de la variable du secret primaire. +#' Si l'on rajoute cette variable supplémentaire indiquant +#' le secret primaire (de type booléen) au tableau de données tabulées, la fonction +#' tab_rda permet de créer un fichier d'apriori au format conforme pour tauargus. +#' +#' +#' @section Specific parameters: +#' +#' The parameters \code{totcode}, \code{missing} and \code{codelist} +#' must be given in the form of a vector indicating the value to take for each variable. +#' The names of the elements of the vector give the variable concerned and +#' the elements of the vector give the value of the parameter for Tau-Argus. +#' An unnamed element will be the default value.\cr #' #' Les paramètres \code{totcode}, \code{missing} et \code{codelist} #' sont à renseigner sous la forme d'un vecteur indiquant la valeur à prendre @@ -96,47 +184,48 @@ write_rda_tab <- function(info_vars) { #' nommé constituera la valeur par défaut, qui sera attribuée à toutes les #' variables pouvant prendre ce paramètre. #' -#' Par exemple : +#' For example : #' \itemize{ -#' \item{\code{totcode = "Ensemble"} : écrit \code{ "Ensemble"} pour +#' \item{\code{totcode = "global"} : écrit \code{ "global"} pour #' toutes les variables catégorielles} -#' \item{\code{totcode = c("Ensemble", GEO = "France")} : idem, sauf pour la -#' variable \code{GEO}} +#' \item{\code{totcode = c("global", size="total", income="total")} : +#' idem, sauf pour les variables \code{size}et \code{income}} #' } #' -#' @section Variables hiérarchiques: +#' @section Hierarchical variables: +#' +#' Parameter \code{hrc} has the same syntax as \code{totcode},\code{missing} and +#' \code{codelist} (named vector containing as many elements as variables to describe). +#' Hierarchy is defined in an separate hrc file (\strong{hiercodelist}). +#' which can be written with the function \code{link{write_hrc2}}. +#' The function expects the location of this file (and a possible \code{hierleadstring} +#' if it differs from the default option of the package). +#' The path to the existing file is explicitly given. +#' The elements of the vector in parameter must be named (with the name of the variable), +#' even if there is only one element +#' emph{Example :}\code{c(category="category.hrc")} #' #' Le paramètre \code{hrc} obéit aux mêmes règles de syntaxe que \code{totcode}, #' \code{missing} et \code{codelist} (vecteur nommé contenant autant d'éléments -#' que de variables à décrire). Il présente de plus la particularité -#' d'accepter plusieurs façons de spécifier les valeurs associées aux variables -#' hiérarchiques. -#' -#' Pour définir une hiérarchie basée sur les positions des caractères -#' (\strong{hierlevels}), passer une suite de nombre entiers séparés par des -#' espaces. -#' -#' \emph{Exemple :} \code{c(CODECOM = "2 3 0 0 0")} +#' que de variables à décrire). #' -#' Si la hiérarchie est définie dans un fichier hrc à part -#' (\strong{hiercodelist}), la fonction attend l'emplacement de ce fichier (et -#' un éventuel \code{hierleadstring} s'il diffère de l'option par défaut du -#' package). Dans ce cas, on peut écrire explicitement le chemin vers un fichier -#' existant (\code{c(A38 = "a38.hrc")}), mais aussi passer un appel à -#' \code{\link{write_hrc}} qui génèrera un fichier hrc à partir de données tabulées. +#' La hiérarchie est définie dans un fichier hrc à part (\strong{hiercodelist}) +#' qui peut être écrit à l'aide de la fonction \code{\link{write_hrc2}}. #' -#' \emph{Exemple :} \code{c(A38 = write_hrc(tabular, c("A38", "A21", "A10")))} -#' -#' -#' Les deux dernières méthodes passent par la création d'un fichier temporaire. -#' Pour un fichier hrc réutilisable, il est nécessaire de le créer au préalable -#' à l'aide de \code{write_hrc}. -#' -#' Les trois méthodes nécessitent que les éléments du vecteur en paramètre -#' soient nommés (avec le nom de la variable), même s'il n'y a qu'un seul +#' La fonction attend l'emplacement de ce fichier (et un éventuel \code{hierleadstring} +#' s'il diffère de l'option par défaut du package). +#' Le chemin vers le fichier existant est explicitement donné. +#' Les éléments du vecteur en paramètre doivent nommés (avec le nom de la variable), +#' même s'il n'y a qu'un seul #' élément. +#'\emph{Exemple :}\code{c(category="category.hrc")} #' -#' @section Nombre de décimales: +#' @section Number of decimals: +#' Parameter \code{decimals} indicates the minimum number of decimal places to +#' include in the output file +#' (whatever the number of decimals actually present in \code{tabular}). +#' It applies to all real variables (double) but not to integer variables. +#' To add zeros to an integer variable, convert it with \code{as.double} beforehand.\cr #' #' Le paramètre \code{decimals} indique le nombre minimal de décimales à faire #' figurer dans le fichier en sortie (quel que soit le nombre de décimales @@ -145,39 +234,44 @@ write_rda_tab <- function(info_vars) { #' ajouter des zéros à une variable entière, la convertir avec \code{as.double} #' au préalable. #' -#' -#' @section Voir aussi: La fonction \code{\link{rtauargus}}, qui utilise cette -#' fonction et hérite de ses paramètres. +#' @section Voir aussi: #' #' @examples #' \dontrun{ #' # donnees fictives -#' tab_df <- -#' data.frame( -#' GEO = c("443", "541", "543"), -#' A10 = c( "AZ", "BE", "BE"), -#' A21 = c( "A", "B", "C"), -#' DIPL = c( "01", "??", "02"), -#' CA = c( 100, 0, 7), -#' effectif = c( 3, 6, 8), -#' max_CA = c( 57, 0, 1), -#' ) -#' -#' # creation rda -#' res <- -#' tab_rda( -#' tabular = tab_df, -#' decimals = 1, -#' hrc = c(A21 = "A21>A10", GEO = "2 1 0", DIPL = "dipl.hrc"), -#' totcode = c(GEO = "France"), -#' missing = c(DIPL = "??"), -#' value = "CA", -#' freq = "effectif", -#' maxscore = "max_CA", -#' separator = "," -#' ) -#' -#' # visualisation des fichiers produits +#' +#' tab <-data.frame( +#' category = c( "A" , "B", "C", "D", "E", "F"), +#' size = c("tr1", "tr3", "tr2", "tr1", "tr1", "tr2"), +#' area = c( "07", "01", "04", "06", "02", "06"), +#' income = c( 100, 4, 7, 14, 42, 85), +#' freq = c( 2, 6, 8, 45, 100, 1), +#' max = c( 54, 2, 1, 13, 19, 85), +#' primary_secret = c( TRUE, FALSE, FALSE, TRUE, FALSE, TRUE) +#' ) +#' +#' # rda creation +#' +#' files_names <- +#' tab_rda( +#' tabular = tab, +#' tab_filename = "tauargus_files/file.tab", +#' rda_filename = "tauargus_files/file.rda", +#' hst_filename = "tauargus_files/file.hst", +#' hrc = c(category = "category.hrc"), +#' explanatory_vars = c("category" , "size", "area"), +#' secret_var = "primary_secret", +#' totcode = c( +#' category = "global", +#' size = "total", +#' area = "global", +#' income = "total" +#' ), +#' value = "income", +#' freq = "freq" +#' ) +#' +#' # Viewing product files #' file.show( #' res$rda_filename, #' header = unlist(res), @@ -193,23 +287,28 @@ write_rda_tab <- function(info_vars) { #' @export tab_rda <- function( - tabular, - tab_filename = NULL, - rda_filename = NULL, - decimals = getOption("rtauargus.decimals"), - hrc = NULL, - hierleadstring = getOption("rtauargus.hierleadstring"), - totcode = getOption("rtauargus.totcode"), - missing = getOption("rtauargus.missing"), - codelist = NULL, - value = NULL, - freq = NULL, - maxscore = NULL, - separator = "," + tabular, + tab_filename = NULL, + rda_filename = NULL, + hst_filename = NULL, + explanatory_vars=NULL, + secret_var=NULL, + decimals = getOption("rtauargus.decimals"), + hrc = NULL, + hierleadstring = getOption("rtauargus.hierleadstring"), + totcode = getOption("rtauargus.totcode"), + missing = getOption("rtauargus.missing"), + codelist = NULL, + value = NULL, + freq = NULL, + maxscore = NULL, + separator = "," ) { + tabular <- as.data.frame(tabular) # (probleme avec tibble notamment) + # valeur par défaut du package si option vide ........................... if (is.null(decimals)) decimals <- op.rtauargus$rtauargus.decimals @@ -219,38 +318,103 @@ tab_rda <- function( if (is.null(totcode)) totcode <- op.rtauargus$rtauargus.totcode if (is.null(missing)) missing <- op.rtauargus$rtauargus.missing - # ignore colonnes de longueurs nulles .................................. - colvides <- sapply(tabular, function(x) all(is.na(x)) | all(x == "")) - if (any(colvides)) { + if (!is.null(secret_var)){ + colvides <- sapply(tabular[,!names(tabular)==secret_var], function(x) all(is.na(x)) | all(x == "")) + } else { + colvides <- sapply(tabular, function(x) all(is.na(x)) | all(x == "")) + } + + if (any(colvides) ) { + name_colvides<-paste(names(tabular)[colvides], collapse = ", ") warning( - "Colonnes vides : ", - paste(names(tabular)[colvides], collapse = ", ") + "empty columns : ", + name_colvides ) tabular <- tabular[!colvides] } # parametres non renseignés ........................................... - if (is.null(rda_filename)) rda_filename <- tempfile("RTA_", fileext = ".rda") + if (is.null(tab_filename)) tab_filename <- "tabular.tab" + if (is.null(hst_filename)) hst_filename <- "apriori.hst" + + #Gestion du chemin des fichiers + name_rda<-basename(rda_filename) + directory_rda<-stringr::str_replace(rda_filename, pattern = name_rda, replacement="") + if(!(dir.exists(directory_rda))) + {dir.create(directory_rda, recursive = TRUE)} + + name_tab<-basename(tab_filename) + directory_tab<-stringr::str_replace(tab_filename, pattern = name_tab, replacement="") + if(!(dir.exists(directory_tab))) + {dir.create(directory_tab, recursive = TRUE)} + + name_hst<-basename(hst_filename) + directory_hst<-stringr::str_replace(hst_filename, pattern = name_hst, replacement="") + if(!(dir.exists(directory_hst))) + {dir.create(directory_hst, recursive = TRUE)} + + + #Controles sur secret_var + + if (is.null(secret_var)) message("secret_var is NULL : no apriori file will be used") + + if ((!is.null(secret_var)) && (!secret_var %in% colnames(tabular))) + {stop("secret_var does not exist in tabular")} + + if((!is.null(secret_var)) && (any(!is.na(tabular[[secret_var]]))) && (!is.logical(tabular[[secret_var]]))) + {stop("unexpected type : secret_var must be a boolean variable")} + + if((!is.null(secret_var)) && any(is.na(tabular[[secret_var]]))) + {stop("NAs in secret_var are not allowed")} + - # genere fichier longueur fixe et infos associees ..................... + #Genere le fichier hst + + if((!is.null(secret_var)) && (is.logical(tabular[[secret_var]]))) { + + tabular[secret_var]<-ifelse(tabular[[secret_var]],"u","s") + hst=tabular[ + tabular[secret_var]=="u", + c(explanatory_vars[(explanatory_vars %in% colnames(tabular))], secret_var) + ] + + if (nrow(hst)==0) message("no values are concerned by the primary secret : hst file is empty") + + write.table( + hst, + hst_filename, + row.names=FALSE, + col.names = FALSE, + sep=",", + quote=FALSE + ) + } + + + + # genere fichier longueur fixe (le fichier .tab) dans le dossier indiqué et infos associees ..................... + + if (!is.null(secret_var)) tabular<-tabular[,!names(tabular)==secret_var] fwf_info_tabular <- gdata::write.fwf( tabular, - file = tab_filename, + file= tab_filename, formatInfo = TRUE, colnames = FALSE, justify = "right", # pour les variables caractères uniquement - digits = 15, # max ? voir aide de format + digits = 15, nsmall = decimals, scientific = FALSE, - sep=separator + sep=separator ) num <- vapply(tabular, is.numeric, logical(1)) + + fwf_info_tabular <- fwf_info_tabular %>% mutate( @@ -278,10 +442,12 @@ tab_rda <- function( df_param_defaut(var_quanti, "totcode", totcode) %>% mutate(totcode = dplyr::coalesce(totcode, getOption("rtauargus.totcode"))) - # hierachical ...................................................... + + + # hierarchical ...................................................... if (!is.null(hrc) & (is.null(names(hrc)) | any(names(hrc) == ""))) { - stop("noms manquants pour hrc. Exemple : hrc = c(VAR = \"var.hrc\")") + stop("missing name for hrc. Example : hrc = c(VAR = \"var.hrc\")") } norm_hrc <- @@ -294,6 +460,7 @@ tab_rda <- function( hrc_df <- df_param_defaut(var_quanti, "hierarchical", norm_hrc) hrc_df$hierleadstring <- NA_character_ need_leadstring <- grepl("\\.hrc$", hrc_df$hierarchical) + hrc_df$hierleadstring[need_leadstring] <- hierleadstring fwf_info_tabular <- @@ -314,7 +481,7 @@ tab_rda <- function( ) # reorganise en une liste de variables ............................. - fwf_info_tabular <-transpose(fwf_info_tabular) + fwf_info_tabular <-purrr::transpose(fwf_info_tabular) # genere vecteur format .rda ....................................... res <- character(0) @@ -329,14 +496,16 @@ tab_rda <- function( # écrit fichier texte .............................................. writeLines(res, rda_filename) - # renvoie noms des fichiers tab et rda de manière invisible ....... + # renvoie noms des fichiers hst, tab et rda de manière invisible ....... invisible( list( - tab_filename = normPath2(tab_filename), - rda_filename = normPath2(rda_filename) - ) + tab_filename = normPath2(tab_filename), + rda_filename = normPath2(rda_filename), + hst_filename = normPath2(hst_filename) + ) ) + } diff --git a/man/tab_arb.Rd b/man/tab_arb.Rd index 4da875b..899f48a 100644 --- a/man/tab_arb.Rd +++ b/man/tab_arb.Rd @@ -28,7 +28,8 @@ extension). Si non renseigné, un fichier temporaire.} \item{tab_filename}{[\strong{obligatoire}] nom du fichier .tab (avec extension).} -\item{rda_filename}{nom du fichier rda (avec extension).} +\item{rda_filename}{rda file name (with .rda extension) \cr +nom du fichier rda (avec extension)} \item{explanatory_vars}{[\strong{obligatoire}] variables catégorielles, sous forme de liste de vecteurs. Chaque élément de la liste est un vecteur des @@ -136,8 +137,7 @@ autant de valeurs que de tabulations. } \section{Voir aussi}{ - La fonction \code{\link{rtauargus}}, qui utilise cette -fonction et hérite de ses paramètres. + } \examples{ diff --git a/man/tab_rda.Rd b/man/tab_rda.Rd index 6e72baf..50fc025 100644 --- a/man/tab_rda.Rd +++ b/man/tab_rda.Rd @@ -2,12 +2,16 @@ % Please edit documentation in R/tab_rda.R \name{tab_rda} \alias{tab_rda} -\title{Crée les fichiers rda à partir de données tabulées} +\title{Create rda files from tabulated data \cr +Crée les fichiers rda à partir de données tabulées} \usage{ tab_rda( tabular, tab_filename = NULL, rda_filename = NULL, + hst_filename = NULL, + explanatory_vars = NULL, + secret_var = NULL, decimals = getOption("rtauargus.decimals"), hrc = NULL, hierleadstring = getOption("rtauargus.hierleadstring"), @@ -21,52 +25,129 @@ tab_rda( ) } \arguments{ -\item{tabular}{[\strong{obligatoire}] data.frame contenant les -données tabulées} - -\item{tab_filename}{nom du fichier tab (avec extension)} - -\item{rda_filename}{nom du fichier rda (avec extension).} - -\item{decimals}{nombre minimal de décimales à afficher (voir section 'Nombre +\item{tabular}{[\strong{obligatoire}] +data.frame which contains the tabulated data and +an additional boolean variable that indicates the primary secret of type boolean \cr +data.frame contenant les données tabulées et +une variable supplémentaire indiquant le secret primaire de type booléen} + +\item{tab_filename}{tab file name (with .tab extension) \cr +nom du fichier tab (avec extension .tab)} + +\item{rda_filename}{rda file name (with .rda extension) \cr +nom du fichier rda (avec extension)} + +\item{hst_filename}{hst file name (with .hst extension) \cr +nom du fichier hst (avec extension)} + +\item{explanatory_vars}{[\strong{obligatoire}] Vector of categorical variables +\cr +Variables catégorielles, sous forme de liste de vecteurs + +Example : \code{list(c("A21", "TREFF", "REG")} +table crossing \code{A21} x \code{TREFF} x \code{REG}} + +\item{secret_var}{Boolean variable which give the primary secret : equal to +"TRUE" if a cell is concerned by the primary secret,"FALSE" otherwise. +\cr +variable indiquant le secret primaire de type booléen: +prend la valeur "TRUE" quand les cellules du tableau doivent être masquées +par le secret primaire, "FALSE" sinon.} + +\item{decimals}{Minimum number of decimals to be displayed +(see section 'Number of decimals') \cr +nombre minimal de décimales à afficher (voir section 'Nombre de décimales').} -\item{hrc}{informations sur les variables hiérarchiques (voir section +\item{hrc}{Informations on hierarchical variables (see section 'hierarchical +variable'). \cr +informations sur les variables hiérarchiques (voir section 'Variables hiérarchiques').} -\item{hierleadstring}{caractère qui, répété n fois, indique que la valeur est +\item{hierleadstring}{Character which, repeated n times, +indicates that the value is at n levels of depth in the hierarchy. \cr +caractère qui, répété n fois, indique que la valeur est à n niveaux de profondeur dans la hiérarchie.} -\item{totcode}{code(s) pour le total d'une variable catégorielle (voir +\item{totcode}{Code(s) which represent the total of a categorical variable +(see section 'Specific parameters' for the syntax of this parameter). +Variables not specified (neither by default nor explicitly) +will be assigned the value of \code{rtauargus.totcode}.\cr +code(s) pour le total d'une variable catégorielle (voir section 'Paramètres spécifiques' pour la syntaxe de ce paramètre). Les variables non spécifiées (ni par défaut, ni explicitement) se verront attribuer la valeur de \code{rtauargus.totcode}.} -\item{missing}{code(s) pour une valeur manquante (voir section +\item{missing}{Code(s) for a missing value (see section 'Specific parameters' +for the syntax of this parameter). \cr +code(s) pour une valeur manquante (voir section 'Paramètres spécifiques' pour la syntaxe de ce paramètre).} -\item{codelist}{fichier(s) contenant les libellés des variables catégorielles +\item{codelist}{file(s) containing labels of the categorical variables +(see section 'Specific parameters' for the syntax of this parameter).\cr +fichier(s) contenant les libellés des variables catégorielles (voir section 'Paramètres spécifiques' pour la syntaxe de ce paramètre).} -\item{value}{nom de la colonne contenant la valeur des cellules} +\item{value}{Name of the column containing the value of the cells. \cr +nom de la colonne contenant la valeur des cellules} -\item{freq}{nom de la colonne contenant les effectifs pour une cellule} +\item{freq}{Name of the column containing the the numbers for a cell. \cr +Nom de la colonne contenant les effectifs pour une cellule} -\item{maxscore}{nom de la colonne contenant la valeur du plus gros contributeur +\item{maxscore}{Name of the column containing +the value of the largest contributor of a cell. \cr + +Nom de la colonne contenant la valeur du plus gros contributeur d'une cellule} -\item{separator}{charactere utilisé en tant que separateur dans le fichier .tab} +\item{separator}{character used as separator in the .tab file. \cr +caractère utilisé en tant que separateur dans le fichier .tab} } \value{ +Return the rda file name as a list (invisible).\cr Renvoie le nom du fichier rda sous forme de liste (de - manière invisible). +manière invisible). } \description{ -Crée un fichier tabular (tab) et de métadonnées +Create an apriori file for the primary secret, +a tabular file (tab) and a metadata file (rda) +from tabulated data and additional information.\cr +} +\details{ +Crée un fichier d'apriori pour le secret primaire, +un fichier tabular (tab) et un fichier de métadonnées (rda) à partir de données tabulées et d'informations additionnelles. } -\section{Paramètres spécifiques}{ +\section{Apriori file }{ + + +The apriori file (.hst) summarizes for each value of the table +if they are concerned by the primary secret or not. +With this file tauargus will not need to set the primary secret itself. +The parameter \code{secret_var} indicates the name of the primary secret variable. +If there is the additional boolean variable which indicates the primary secret +in the table (of tabulated data), the function tab_rda will create +an apriori file in a format conforming to tauargus.\cr + + +Le fichier d'apriori (.hst) récapitule pour chaque valeurs +du tableau si elles sont concernées par le secret primaire ou non. +Avec ce fichier tauargus n'aura plus besoin de poser le secret primaire lui même, +il se basera sur le fichier d'apriori pour le faire. +Le paramètre \code{secret_var} indique le nom de la variable du secret primaire. +Si l'on rajoute cette variable supplémentaire indiquant +le secret primaire (de type booléen) au tableau de données tabulées, la fonction +tab_rda permet de créer un fichier d'apriori au format conforme pour tauargus. +} + +\section{Specific parameters}{ + +The parameters \code{totcode}, \code{missing} and \code{codelist} +must be given in the form of a vector indicating the value to take for each variable. +The names of the elements of the vector give the variable concerned and +the elements of the vector give the value of the parameter for Tau-Argus. +An unnamed element will be the default value.\cr Les paramètres \code{totcode}, \code{missing} et \code{codelist} sont à renseigner sous la forme d'un vecteur indiquant la valeur à prendre @@ -77,51 +158,52 @@ du vecteur donnent la valeur du paramètre pour Tau-Argus. Un élément non nommé constituera la valeur par défaut, qui sera attribuée à toutes les variables pouvant prendre ce paramètre. -Par exemple : +For example : \itemize{ - \item{\code{totcode = "Ensemble"} : écrit \code{ "Ensemble"} pour + \item{\code{totcode = "global"} : écrit \code{ "global"} pour toutes les variables catégorielles} - \item{\code{totcode = c("Ensemble", GEO = "France")} : idem, sauf pour la - variable \code{GEO}} + \item{\code{totcode = c("global", size="total", income="total")} : + idem, sauf pour les variables \code{size}et \code{income}} } } -\section{Variables hiérarchiques}{ +\section{Hierarchical variables}{ +Parameter \code{hrc} has the same syntax as \code{totcode},\code{missing} and +\code{codelist} (named vector containing as many elements as variables to describe). +Hierarchy is defined in an separate hrc file (\strong{hiercodelist}). +which can be written with the function \code{link{write_hrc2}}. +The function expects the location of this file (and a possible \code{hierleadstring} +if it differs from the default option of the package). +The path to the existing file is explicitly given. +The elements of the vector in parameter must be named (with the name of the variable), +even if there is only one element +emph{Example :}\code{c(category="category.hrc")} + Le paramètre \code{hrc} obéit aux mêmes règles de syntaxe que \code{totcode}, \code{missing} et \code{codelist} (vecteur nommé contenant autant d'éléments -que de variables à décrire). Il présente de plus la particularité -d'accepter plusieurs façons de spécifier les valeurs associées aux variables -hiérarchiques. - -Pour définir une hiérarchie basée sur les positions des caractères -(\strong{hierlevels}), passer une suite de nombre entiers séparés par des -espaces. +que de variables à décrire). -\emph{Exemple :} \code{c(CODECOM = "2 3 0 0 0")} +La hiérarchie est définie dans un fichier hrc à part (\strong{hiercodelist}) +qui peut être écrit à l'aide de la fonction \code{\link{write_hrc2}}. -Si la hiérarchie est définie dans un fichier hrc à part -(\strong{hiercodelist}), la fonction attend l'emplacement de ce fichier (et -un éventuel \code{hierleadstring} s'il diffère de l'option par défaut du -package). Dans ce cas, on peut écrire explicitement le chemin vers un fichier -existant (\code{c(A38 = "a38.hrc")}), mais aussi passer un appel à -\code{\link{write_hrc}} qui génèrera un fichier hrc à partir de données tabulées. - -\emph{Exemple :} \code{c(A38 = write_hrc(tabular, c("A38", "A21", "A10")))} - - -Les deux dernières méthodes passent par la création d'un fichier temporaire. -Pour un fichier hrc réutilisable, il est nécessaire de le créer au préalable -à l'aide de \code{write_hrc}. - -Les trois méthodes nécessitent que les éléments du vecteur en paramètre -soient nommés (avec le nom de la variable), même s'il n'y a qu'un seul +La fonction attend l'emplacement de ce fichier (et un éventuel \code{hierleadstring} +s'il diffère de l'option par défaut du package). +Le chemin vers le fichier existant est explicitement donné. +Les éléments du vecteur en paramètre doivent nommés (avec le nom de la variable), +même s'il n'y a qu'un seul élément. +\emph{Exemple :}\code{c(category="category.hrc")} } -\section{Nombre de décimales}{ +\section{Number of decimals}{ +Parameter \code{decimals} indicates the minimum number of decimal places to +include in the output file +(whatever the number of decimals actually present in \code{tabular}). +It applies to all real variables (double) but not to integer variables. +To add zeros to an integer variable, convert it with \code{as.double} beforehand.\cr Le paramètre \code{decimals} indique le nombre minimal de décimales à faire figurer dans le fichier en sortie (quel que soit le nombre de décimales @@ -132,39 +214,45 @@ au préalable. } \section{Voir aussi}{ - La fonction \code{\link{rtauargus}}, qui utilise cette -fonction et hérite de ses paramètres. + } \examples{ \dontrun{ # donnees fictives -tab_df <- - data.frame( - GEO = c("443", "541", "543"), - A10 = c( "AZ", "BE", "BE"), - A21 = c( "A", "B", "C"), - DIPL = c( "01", "??", "02"), - CA = c( 100, 0, 7), - effectif = c( 3, 6, 8), - max_CA = c( 57, 0, 1), - ) - -# creation rda -res <- - tab_rda( - tabular = tab_df, - decimals = 1, - hrc = c(A21 = "A21>A10", GEO = "2 1 0", DIPL = "dipl.hrc"), - totcode = c(GEO = "France"), - missing = c(DIPL = "??"), - value = "CA", - freq = "effectif", - maxscore = "max_CA", - separator = "," - ) - -# visualisation des fichiers produits + +tab <-data.frame( +category = c( "A" , "B", "C", "D", "E", "F"), +size = c("tr1", "tr3", "tr2", "tr1", "tr1", "tr2"), +area = c( "07", "01", "04", "06", "02", "06"), +income = c( 100, 4, 7, 14, 42, 85), +freq = c( 2, 6, 8, 45, 100, 1), +max = c( 54, 2, 1, 13, 19, 85), +primary_secret = c( TRUE, FALSE, FALSE, TRUE, FALSE, TRUE) +) + +# rda creation + +files_names <- + tab_rda( + tabular = tab, + tab_filename = "tauargus_files/file.tab", + rda_filename = "tauargus_files/file.rda", + hst_filename = "tauargus_files/file.hst", + hrc = c(category = "category.hrc"), + explanatory_vars = c("category" , "size", "area"), + secret_var = "primary_secret", + totcode = c( + category = "global", + size = "total", + area = "global", + income = "total" + ), + value = "income", + freq = "freq" +) + +# Viewing product files file.show( res$rda_filename, header = unlist(res), From 1e138d24fe285de5d8d1b2d80416c02a9cf54adf Mon Sep 17 00:00:00 2001 From: Julien Jamme Date: Tue, 26 Jul 2022 18:22:03 +0200 Subject: [PATCH 008/107] Documentation of micro functions in english --- R/import.R | 53 +++++++--- R/micro_arb.R | 205 ++++++++++++++++++++++++++----------- R/micro_asc_rda.R | 187 +++++++++++++++++++++++++--------- R/options.R | 49 +++++++-- R/rtauargus.R | 84 +++++++++++---- R/rtauargus_plus.R | 78 +++++++++++--- R/run_arb.R | 71 +++++++++---- man/import.Rd | 61 ++++++++--- man/micro_arb.Rd | 214 +++++++++++++++++++++++++++------------ man/micro_asc_rda.Rd | 198 ++++++++++++++++++++++++++---------- man/rtauargus.Rd | 142 +++++++++++++++++++------- man/rtauargus_options.Rd | 52 +++++++--- man/rtauargus_plus.Rd | 118 ++++++++++++++++----- man/run_arb.Rd | 81 ++++++++++----- man/write_hrc.Rd | 10 +- 15 files changed, 1178 insertions(+), 425 deletions(-) diff --git a/R/import.R b/R/import.R index 6b3a0a4..45ca94c 100644 --- a/R/import.R +++ b/R/import.R @@ -115,12 +115,24 @@ meta_import <- function(data, # Fonction exportée ----------------------------------------------------------- -#' Importe les résultats de Tau-Argus +#' Imports results from Tau-Argus #' -#' Importe dans R les résultats générés par Tau-Argus à partir des informations -#' contenues dans un fichier arb. +#' Imports into R the results generated by Tau-Argus from the information +#' contained in an arb file. \cr +#' (Importe dans R les résultats générés par Tau-Argus à partir des informations +#' contenues dans un fichier arb.) #' -#' Nécessite que le batch ait été exécuté et se soit terminé sans erreur. Afin +#' Requires that the batch has been executed and finished without error. In order +#' to import immediately after the batch has been executed, this function will be +#' most often called via \code{link{run_arb}} (by setting +#' \code{import = TRUE}). +#' +#' It is only possible (for the moment) to import results of type "2" +#' (csv for pivot-table) and "4" (sbs). If it is not possible to import for +#' a given tabulation, an empty data.frame is returned (with a +#' message). \cr +#' +#' (Nécessite que le batch ait été exécuté et se soit terminé sans erreur. Afin #' d'importer immédiatement après exécution du batch, cette fonction sera ainsi #' le plus souvent appelée via \code{\link{run_arb}} (en paramétrant #' \code{import = TRUE}). @@ -128,18 +140,33 @@ meta_import <- function(data, #' Il n'est possible (pour l'instant) que d'importer les résultats de type "2" #' (csv for pivot-table) et "4" (sbs). En cas d'impossibilité de l'import pour #' une tabulation donnée, un data.frame vide est retourné (avec un message -#' d'avertissement). +#' d'avertissement).) #' -#' @param arb_filename nom du fichier arb (avec extension) contenant les -#' informations nécessaires à l'import. +#' @param arb_filename name of the arb file (with extension) containing the +#' information needed for the import. \cr +#' (nom du fichier arb (avec extension) contenant les +#' informations nécessaires à l'import.) #' -#' @return Une liste d'un ou plusieurs data.frames. Chaque data.frame correspond +#' @return A list of one or more data.frames. Each data.frame corresponds to +#' to the result of a tabulation. The names of the tables filled in the +#' lines of the batch of the form \code{// "..."} are recovered. \cr +#' (Une liste d'un ou plusieurs data.frames. Chaque data.frame correspond #' au résultat d'une tabulation. Les noms des tableaux renseignés dans les -#' lignes du batch de la forme \code{// "..."} sont récupérés. +#' lignes du batch de la forme \code{// "..."} sont récupérés.) +#' +#' @section Attributes: +#' +#' Each data.frame is associated with a set of attributes (metadata) +#' allowing to keep a trace of the specifications passed to Tau-Argus. +#' +#' Attributes systematically present : +#' \code{explanatory_vars}, \code{response_var}, \code{safetyrule}, +#' \code{suppress}, \code{linked}, \code{output_type}. #' -#' @section Attributs: +#' Attributes present only if the corresponding option has been filled in by +#' the user: \code{shadow_var}, \code{cost_var}, \code{output_options}. \cr #' -#' À chaque data.frame est associé un ensemble d'attributs (métadonnées) +#' (À chaque data.frame est associé un ensemble d'attributs (métadonnées) #' permettant de conserver une trace des spécifications passées à Tau-Argus. #' #' Attributs systématiquement présents : @@ -147,9 +174,9 @@ meta_import <- function(data, #' \code{suppress}, \code{linked}, \code{output_type}. #' #' Attributs présents uniquement si l'option correspondante a été renseignée par -#' l'utilisateur : \code{shadow_var}, \code{cost_var}, \code{output_options}. +#' l'utilisateur : \code{shadow_var}, \code{cost_var}, \code{output_options}.) #' -#' @inheritSection micro_asc_rda Voir aussi +#' @inheritSection micro_asc_rda See also #' #' @importFrom dplyr %>% #' @importFrom purrr map_at diff --git a/R/micro_arb.R b/R/micro_arb.R index 3fa0205..0360764 100644 --- a/R/micro_arb.R +++ b/R/micro_arb.R @@ -139,15 +139,34 @@ apriori_batch <- function(ntab, hst_names, sep = ',', ignore_err = 0 , exp_triv # Exportée ---------------------------------------------------------------- -#' Crée un fichier batch (.arb) pour microdonnées +#' Creates a batch file (.arb) for microdata #' -#' Crée un fichier batch pour microdonnées, exécutable par Tau-Argus en ligne de -#' commande. +#' Creates a batch file for microdata, executable by Tau-Argus in +#' command line. \cr +#' (Crée un fichier batch pour microdonnées, exécutable par Tau-Argus en ligne +#' de commande.) #' -#' La fonction ne vérifie pas si les fichiers asc et rda existent. +#' The function does not check if asc and rda files exist. \cr +#' (La fonction ne vérifie pas si les fichiers asc et rda existent.) #' -#' @section Syntaxe: -#' Tau-Argus peut traiter plusieurs tabulations pour un même jeu de +#' @section Syntax: +#' Tau-Argus can handle multiple tabs for the same set of +#' microdata. Passing a single value for an option will apply the same +#' processing to each tab. For differentiated options, passing a +#' vector containing as many values as there are tabs. If the lengths do not +#' match (not recommended), a recycling is performed. +#' +#' Unless otherwise stated, use the syntax mentioned in the documentation +#' of Tau-Argus. +#' +#' Special syntax for \code{suppress} : the first parameter in the +#' Tau-Argus syntax is the tab number. If the method is identical +#' for all tabs, this first parameter will be ignored and the numbers +#' are automatically recalculated for the batch. In the writing +#' \code{suppress = "GH(n,100)"}, n will thus be transformed into 1 for the +#' first tab, into 2 for the second tab, etc. +#' +#' (Tau-Argus peut traiter plusieurs tabulations pour un même jeu de #' microdonnées. Passer une seule valeur pour une option appliquera le même #' traitement à chaque tabulation. Pour des options différenciées, passer un #' vecteur contenant autant de valeurs que de tabulations. Si les longueurs ne @@ -161,20 +180,40 @@ apriori_batch <- function(ntab, hst_names, sep = ',', ignore_err = 0 , exp_triv #' pour toutes les tabulations, ce premier paramètre sera ignoré et les numéros #' recalculés automatiquement pour le batch. Dans l'écriture #' \code{suppress = "GH(n,100)"}, n sera ainsi transformé en 1 pour la première -#' tabulation, en 2 pour la deuxième tabulation, etc. +#' tabulation, en 2 pour la deuxième tabulation, etc.) #' -#' @section Identifiants des tableaux: -#' Si la liste \code{explanatory_vars} comporte des noms, ceux-ci seront +#' @section Table identifiers: +#' If the list \code{explanatory_vars} has names, these will be +#' used in the batch to give an identifier to the table, in the form of +#' of a comment line (\code{// "..."}). They will be +#' reused by the \code{import} function to name the R format arrays +#' tables in output. +#' +#' (Si la liste \code{explanatory_vars} comporte des noms, ceux-ci seront #' utilisés dans le batch pour donner un identifiant au tableau, sous la forme #' d'une ligne de commentaire (\code{// "..."}). Ils seront #' réutilisés par la fonction \code{import} pour nommer les tableaux formats R -#' en sortie. +#' en sortie.) +#' +#' @section Use an apriori file: +#' It is possible to provide an apriori file (.hst) for each tabulation. +#' +#' The easiest way is to pass a vector containing as many +#' hst files as there are tabs. If the file is the same for all +#' tabs, specify the name of this file (it will be used for all +#' tabs). #' -#' @section Informations \emph{a priori}: -#' Il est possible de fournir un fichier a priori (.hst) pour chaque tabulation. +#' The additional options are optional. To change the default values, +#' pass a list with the hst file(s) as the first item and +#' complete with the elements having the names \code{sep} for the separator, +#' \code{ignore_err} for IgnoreError and \code{exp_triv} for ExpandTrivial. +#' As for filenames, specify only one value per parameter or +#' as many values as there are tabs. + +#' (Il est possible de fournir un fichier apriori (.hst) pour chaque tabulation. #' -#' La manière la plus simple est de passer un vecteur contenant autant de noms de -#' fichiers hst que de tabulations. Si le fichier est le même pour toutes les +#' La manière la plus simple est de passer un vecteur contenant autant de noms +#' de fichiers hst que de tabulations. Si le fichier est le même pour toutes les #' tabulations, spécifier le nom de ce fichier (il sera utilisé pour toutes les #' tabulations). #' @@ -183,58 +222,101 @@ apriori_batch <- function(ntab, hst_names, sep = ',', ignore_err = 0 , exp_triv #' compléter avec les éléments portant les noms \code{sep} pour le séparateur, #' \code{ignore_err} pour IgnoreError et \code{exp_triv} pour ExpandTrivial. #' Comme pour les noms de fichiers, spécifier une seule valeur par paramètre ou -#' autant de valeurs que de tabulations. +#' autant de valeurs que de tabulations.) #' -#' @param arb_filename nom du fichier arb généré (avec -#' extension). Si non renseigné, un fichier temporaire. -#' @param asc_filename [\strong{obligatoire}] nom du fichier asc (avec extension). +#' @param arb_filename name of the generated arb file (with +#' extension). If not specified, a temporary file. \cr +#' (nom du fichier arb généré (avec extension). Si non renseigné, un fichier +#' temporaire.) +#' @param asc_filename [\strong{required}] name of the asc file +#' (with extension). \cr +#' ([\strong{obligatoire}] nom du fichier asc (avec extension).) #' @inheritParams micro_asc_rda -#' @param explanatory_vars [\strong{obligatoire}] variables catégorielles, sous -#' forme de liste de vecteurs. Chaque élément de la liste est un vecteur des -#' noms des variables formant une tabulation. -#' Exemple : \code{list(c("CJ", "A21"), c("SEXE", "REGION"))} pour le premier -#' tableau croisant \code{CJ} x \code{A21} et le deuxième tableau croisant -#' \code{SEXE} x \code{REGION}. -#' Si une seule tabulation, un simple vecteur des variables à croiser est -#' accepté (pas besoin de \code{list(...)}). -#' @param response_var variable de réponse à sommer, ou comptage si -#' \code{""}. Une seule valeur ou autant de valeurs que de tabulations. -#' @param shadow_var variable(s) pour l'application du secret primaire. Si non -#' renseigné, \code{response_var} sera utilisé par Tau-Argus. -#' @param cost_var variable(s) de coût pour le secret secondaire. -#' @param safety_rules [\strong{obligatoire}] règle(s) de secret primaire. -#' Chaîne de caractères en syntaxe batch Tau-Argus. La pondération est traitée -#' dans un paramètre à part (ne pas spécifier WGT ici, utiliser le paramètre -#' \code{weighted}). -#' @param weighted indicatrice(s) de pondération (booléen). -#' @param suppress [\strong{obligatoire}] méthode(s) de gestion du secret -#' secondaire (syntaxe batch de Tau-Argus). Si la méthode est la même pour -#' chaque tabulation, le premier paramètre (numéro du tableau) sera ignoré et -#' renuméroté automatiquement (voir la section 'Syntaxe'). -#' @param linked pour traiter le secret secondaire conjointement sur toutes les -#' tabulations. Une seule commande suppress autorisée dans ce cas (appliquée à -#' tous les tableaux). -#' @param output_names noms des fichiers en sortie. Si renseigné, -#' obligatoirement autant de noms de fichiers que de tabulations. Si laissé -#' vide, autant de noms de fichiers temporaires que de tabulations seront -#' générés. -#' @param output_type format des fichiers en sortie (codification Tau-Argus). -#' Valeur par défaut du package : \code{"2"} (csv for pivot-table). -#' @param output_options options supplémentaires des fichiers en sortie. Valeur -#' par défaut du package : \code{"AS+"} (affichage du statut). Pour ne -#' spécifier aucune option, \code{""}. -#' @param apriori fichier(s) d'informations \emph{a priori}. Voir ci-dessous -#' pour la syntaxe. -#' @param gointeractive pour avoir la possibilité de lancer le batch depuis le -#' menu de Tau-Argus (\code{FALSE} par défaut). +#' @param explanatory_vars [\strong{required}] categorical variables, in +#' form of a list of vectors. Each element of the list is a vector of +#' variable names forming a tab. +#' Example: \code{list(c("CJ", "A21"), c("SEX", "REGION"))} for the first +#' table crossing \code{CJ} x \code{A21} and the second table crossing +#' \code{SEXE} x \code{REGION}. +#' If a single tabulation, a simple vector of the variables to be crossed is +#' accepted (no need for \code{list(...)}). \cr +#' ([\strong{obligatoire}] variables catégorielles, sous +#' forme de liste de vecteurs. Chaque élément de la liste est un vecteur des +#' noms des variables formant une tabulation. +#' Exemple: \code{list(c("CJ", "A21"), c("SEX", "REGION"))} pour la première +#' table croisant \code{CJ} x \code{A21} et la seconde croisant +#' \code{SEXE} x \code{REGION} +#' Si une seule tabulation, un simple vecteur des variables à croiser est +#' accepté (pas besoin de \code{list(...)}).) +#' @param response_var response variable to be summed, or counted if +#' \code{""}. A single value or as many values as there are tabs. \cr +#' (variable de réponse à sommer, ou comptage si \code{""}. +#' Une seule valeur ou autant de valeurs que de tabulations.) +#' @param shadow_var variable(s) for applying the primary secret. If not +#' filled in, \code{response_var} will be used by Tau-Argus. \cr +#' (variable(s) pour l'application du secret primaire. Si non +#' renseigné, \code{response_var} sera utilisé par Tau-Argus.) +#' @param cost_var cost variable(s) for the secondary secret. \cr +#' (variable(s) de coût pour le secret secondaire.) +#' @param safety_rules [\strong{required}] primary secret rule(s). +#' String in Tau-Argus batch syntax. The weighting is treated +#' in a separate parameter (do not specify WGT here, use the +#' \code{weighted}). \cr +#' ([\strong{obligatoire}] règle(s) de secret primaire. +#' Chaîne de caractères en syntaxe batch Tau-Argus. La pondération est traitée +#' dans un paramètre à part (ne pas spécifier WGT ici, utiliser le paramètre +#' \code{weighted}).) +#' @param weighted indicator(s) (boolean). \cr +#' (indicatrice(s) de pondération (booléen).) +#' @param suppress [\strong{required}] secret management method(s) +#' secondary (Tau-Argus batch syntax). If the method is the same for +#' each tabulation, the first parameter (table number) will be ignored and +#' renumbered automatically (see section 'Syntax'). \cr +#' ([\strong{obligatoire}] méthode(s) de gestion du secret +#' secondaire (syntaxe batch de Tau-Argus). Si la méthode est la même pour +#' chaque tabulation, le premier paramètre (numéro du tableau) sera ignoré et +#' renuméroté automatiquement (voir la section 'Syntax').) +#' @param linked to process the secondary secret jointly on all +#' tabs. Only one delete command is allowed in this case (applied to all +#' all tables). \cr +#' (pour traiter le secret secondaire conjointement sur toutes les +#' tabulations. Une seule commande suppress autorisée dans ce cas (appliquée à +#' tous les tableaux).) +#' @param output_names names of output files. If filled in, +#' the number of file names must be the same as the number of tabs. If left +#' empty, as many temporary file names as there are tabs will be +#' generated. \cr +#' (noms des fichiers en sortie. Si renseigné, obligatoirement autant de noms +#' de fichiers que de tabulations. Si laissé +#' vide, autant de noms de fichiers temporaires que de tabulations seront +#' générés.) +#' @param output_type format of output files (Tau-Argus codification). +#' Default value of the package: \code{"2"} (csv for pivot-table). \cr +#' (format des fichiers en sortie (codification Tau-Argus). +#' Valeur par défaut du package : \code{"2"} (csv for pivot-table).) +#' @param output_options additional options for output files. default value of +#' the package: \code{"AS+"} (status display). To specify no option, \code{""}. \cr +#' (options supplémentaires des fichiers en sortie. Valeur +#' par défaut du package : \code{"AS+"} (affichage du statut). Pour ne +#' spécifier aucune option, \code{""}.) +#' @param apriori information file(s) \emph{a priori}. See below +#' for the syntax. \cr +#' (fichier(s) d'informations \emph{a priori}. Voir ci-dessous +#' pour la syntaxe.) +#' @param gointeractive to have the possibility to launch the batch from the +#' menu of Tau-Argus. \cr +#' (pour avoir la possibilité de lancer le batch depuis le +#' menu de Tau-Argus (\code{FALSE} par défaut).) #' -#' @return Une liste de deux éléments : le nom du fichier arb, les noms des -#' fichiers en sortie (utile pour récupérer les noms générés aléatoirement). +#' @return A list of two elements: arb filename and names of output files +#' (useful to get back the randomly generated names) \cr +#' (Une liste de deux éléments : le nom du fichier arb, les noms des +#' fichiers en sortie (utile pour récupérer les noms générés aléatoirement).) #' -#' @inheritSection micro_asc_rda Voir aussi +#' @inheritSection micro_asc_rda See also #' #' @examples -#' # creation fichier arb +#' # creation of the .arb file #' infos_arb <- micro_arb( #' asc_filename = "donnees.asc", #' explanatory_vars = list(c("REGION", "CJ"), c("REGION")), @@ -246,7 +328,8 @@ apriori_batch <- function(ntab, hst_names, sep = ',', ignore_err = 0 , exp_triv #' output_type = "2" #' ) #' -#' # visualisation du contenu du fichier dans la console +#' # Content of the created file visible in the R console +#' # (Visualisation du contenu du fichier dans la console) #' file.show(infos_arb$arb_filename, pager = "console") #' @export diff --git a/R/micro_asc_rda.R b/R/micro_asc_rda.R index a3fe64d..3150072 100644 --- a/R/micro_asc_rda.R +++ b/R/micro_asc_rda.R @@ -55,43 +55,87 @@ write_rda <- function(info_vars) { } -#' Crée les fichiers asc et rda à partir de microdonnées -#' -#' Crée un fichier texte de longueur fixe (asc) et un fichier de métadonnées -#' (rda) à partir de microdonnées et d'informations additionnelles. -#' -#' @param microdata [\strong{obligatoire}] data.frame contenant les -#' microdonnées. -#' @param asc_filename nom du fichier asc (avec extension). Si non renseigné, un -#' fichier temporaire. -#' @param rda_filename nom du fichier rda (avec extension). Si non renseigné, -#' \code{asc_filename} avec l'extension "rda" à la place de "asc". -#' @param weight_var nom de la variable de poids. +#' Creates asc and rda files from microdata +#' +#' Creates a fixed length text file (asc) and a metadata file +#' (rda) from microdata and additional information. \cr +#' (Crée un fichier texte de longueur fixe (asc) et un fichier de métadonnées +#' (rda) à partir de microdonnées et d'informations additionnelles.) +#' +#' @param microdata [\strong{required}] data.frame containing the microdata. \cr +#' ([\strong{obligatoire}] data.frame contenant les microdonnées.) +#' @param asc_filename name of the asc file (with extension). If not filled in, +#' a temporary file. \cr +#' (nom du fichier asc (avec extension). Si non renseigné, +#' un fichier temporaire.) +#' @param rda_filename name of the rda file (with extension). If not filled in, +#' \code{asc_filename} with the extension "rda" instead of "asc". \cr +#' (nom du fichier rda (avec extension). Si non renseigné, +#' \code{asc_filename} avec l'extension "rda" à la place de "asc".) +#' @param weight_var name of the weight variable. \cr +#' (nom de la variable de poids.) #' @param holding_var nom de la variable de holding. -#' @param decimals nombre minimal de décimales à afficher (voir section 'Nombre -#' de décimales'). -#' @param hrc informations sur les variables hiérarchiques (voir section -#' 'Variables hiérarchiques'). -#' @param hierleadstring caractère qui, répété n fois, indique que la valeur est -#' à n niveaux de profondeur dans la hiérarchie. -#' @param totcode code(s) pour le total d'une variable catégorielle (voir -#' section 'Paramètres spécifiques' pour la syntaxe de ce paramètre). Les -#' variables non spécifiées (ni par défaut, ni explicitement) se verront -#' attribuer la valeur de \code{rtauargus.totcode}. -#' @param missing code(s) pour une valeur manquante (voir section -#' 'Paramètres spécifiques' pour la syntaxe de ce paramètre). -#' @param codelist fichier(s) contenant les libellés des variables catégorielles -#' (voir section 'Paramètres spécifiques' pour la syntaxe de ce paramètre). -#' @param request (pas encore implémenté) -#' -#' @return Renvoie les noms des fichiers asc et rda sous forme de liste (de +#' (name of the holding variable.) \cr +#' @param decimals minimum number of decimals to display (see section 'Number of +#' of decimals'). +#' (nombre minimal de décimales à afficher (voir section 'Number of +#' of decimals').) +#' @param hrc information about the hierarchical variables (see section +#' section 'Hierarchical variables'). \cr +#' (informations sur les variables hiérarchiques (voir section +#' 'Hierarchical variables').) +#' @param hierleadstring character which, repeated n times, indicates that the value is +#' at n levels deep in the hierarchy. \cr +#' (caractère qui, répété n fois, indique que la valeur est +#' à n niveaux de profondeur dans la hiérarchie.) +#' @param totcode code(s) for the total of a categorical variable (see +#' section 'Specific parameters' for the syntax of this parameter). The +#' variables not specified (neither by default nor explicitly) will be +#' assigned the value of \code{rtauargus.totcode}. \cr +#' (code(s) pour le total d'une variable catégorielle (voir +#' section 'Specific parameters' pour la syntaxe de ce paramètre). Les +#' variables non spécifiées (ni par défaut, ni explicitement) se verront +#' attribuer la valeur de \code{rtauargus.totcode}.) +#' @param missing code(s) for a missing value (see section +#' 'Specific parameters' for the syntax of this parameter). \cr +#' (code(s) pour une valeur manquante (voir section +#' 'Specific parameters' pour la syntaxe de ce paramètre).) +#' @param codelist file(s) containing labels for categorical variables +#' (see section 'Specific parameters' for the syntax of this parameter). \cr +#' (fichier(s) contenant les libellés des variables catégorielles +#' (voir section 'Specific parameters' pour la syntaxe de ce paramètre).) +#' @param request (not yet implemented - pas encore implémenté) +#' +#' @return +#' Returns the names of the asc and rda files as a list (invisibly). +#' invisibly). Empty columns (filled with \code{NA} or empty strings) are not +#' strings) will not be exported to the asc file. A +#' warning message will list the affected columns. \cr +#' (Renvoie les noms des fichiers asc et rda sous forme de liste (de #' manière invisible). Les colonnes vides (remplies de \code{NA} ou de chaînes #' de caractères vides) ne seront pas exportées dans le fichier asc. Un -#' message d'avertissement listera les colonnes concernées. +#' message d'avertissement listera les colonnes concernées.) +#' +#' @section Specific parameters: +#' +#' The parameters \code{totcode}, \code{missing} and \code{codelist} +#' are to be filled in as a vector indicating the value to take +#' for each variable. +#' +#' The names of the elements of the vector give the variable concerned, the elements +#' of the vector give the value of the parameter for Tau-Argus. An unnamed element +#' element will be the default value, which will be assigned to all +#' variables that can take this parameter. #' -#' @section Paramètres spécifiques: +#' For example : +#' \itemize{ +#' \item{\code{totcode = "All"} : écrit \code{ "All"} for all +#' categorical variables} +#' \item{\code{totcode = c("All", GEO = "France")} : idem, except for the +#' \code{GEO} variable } +#' } #' -#' Les paramètres \code{totcode}, \code{missing} et \code{codelist} +#' (Les paramètres \code{totcode}, \code{missing} et \code{codelist} #' sont à renseigner sous la forme d'un vecteur indiquant la valeur à prendre #' pour chaque variable. #' @@ -106,11 +150,48 @@ write_rda <- function(info_vars) { #' toutes les variables catégorielles} #' \item{\code{totcode = c("Ensemble", GEO = "France")} : idem, sauf pour la #' variable \code{GEO}} -#' } +#' }) +#' +#' @section Hierarchical variables: +#' +#' The parameter \code{hrc} follows the same syntax rules as \code{totcode}, +#' \code{missing} and \code{codelist} (named vector containing as many elements +#' as there are variables to describe). It also has the particularity +#' to accept several ways of specifying the values associated with the +#' hierarchical variables. +#' +#' To define a hierarchy based on the positions of characters +#' (\strong{hierierlevels}), pass a sequence of integers separated by +#' spaces. #' -#' @section Variables hiérarchiques: +#' \emph{Example :} \code{c(CODECOM = "2 3 0 0 0")} #' -#' Le paramètre \code{hrc} obéit aux mêmes règles de syntaxe que \code{totcode}, +#' If the hierarchy is defined in a separate hrc file +#' (\strong{hiercodelist}), the function expects the location of this file (and +#' a possible \code{hiercodelist} if it differs from the default option of the +#' package). In this case, you can write explicitly the path to an existing file +#' file (\code{c(A38 = "a38.hrc")}), but also make a call to +#' \code{\link{write_hrc}} which will generate an hrc file from microdata. +#' +#' \emph{Example :} \code{c(A38 = write_hrc(microdata, c("A38", "A21", "A10")))} +#' +#' A shortcut for this call is to write the variables constituting the +#' hierarchy separated by ">". In this case, the microdata and +#' hierleadstring that \code{write_hrc} uses are those declared in +#' \code{micro_asc_rda}. +#' +#' \emph{Example :} \code{c(A38 = "A38 > A21 > A10")} \emph{(number of spaces +#' any before and after the ">")} +#' +#' The last two methods require the creation of a temporary file. +#' For a reusable hrc file, it is necessary to create it beforehand +#' using \code{write_hrc}. +#' +#' The three methods require that the elements of the vector in parameter +#' be named (with the name of the variable), even if there is only one +#' element. +#' +#' (Le paramètre \code{hrc} obéit aux mêmes règles de syntaxe que \code{totcode}, #' \code{missing} et \code{codelist} (vecteur nommé contenant autant d'éléments #' que de variables à décrire). Il présente de plus la particularité #' d'accepter plusieurs façons de spécifier les valeurs associées aux variables @@ -120,8 +201,6 @@ write_rda <- function(info_vars) { #' (\strong{hierlevels}), passer une suite de nombre entiers séparés par des #' espaces. #' -#' \emph{Exemple :} \code{c(CODECOM = "2 3 0 0 0")} -#' #' Si la hiérarchie est définie dans un fichier hrc à part #' (\strong{hiercodelist}), la fonction attend l'emplacement de ce fichier (et #' un éventuel \code{hierleadstring} s'il diffère de l'option par défaut du @@ -129,8 +208,6 @@ write_rda <- function(info_vars) { #' existant (\code{c(A38 = "a38.hrc")}), mais aussi passer un appel à #' \code{\link{write_hrc}} qui génèrera un fichier hrc à partir de microdonnées. #' -#' \emph{Exemple :} \code{c(A38 = write_hrc(microdata, c("A38", "A21", "A10")))} -#' #' Un raccourci pour cet appel est d'écrire les variables constituant la #' hiérarchie séparées par des ">". Dans ce cas, les microdonnées et #' hierleadstring qu'utilise \code{write_hrc} sont ceux déclarés dans @@ -145,11 +222,23 @@ write_rda <- function(info_vars) { #' #' Les trois méthodes nécessitent que les éléments du vecteur en paramètre #' soient nommés (avec le nom de la variable), même s'il n'y a qu'un seul -#' élément. +#' élément.) #' -#' @section Nombre de décimales: +#' @section Number of decimals: #' -#' Le paramètre \code{decimals} indique le nombre minimal de décimales à faire +#' The parameter \code{decimals} indicates the minimum number of decimals to be +#' appear in the output file (whatever the number of decimals +#' actually present in \code{microdata}). It applies to all +#' real variables (double) but not to integer variables (integer). For +#' add zeros to an integer variable, convert it with \code{as.double} +#' beforehand. +#' +#' The digits after the decimal point may be incorrect in the asc file if +#' the total number of digits (before or after the decimal separator) is +#' greater than 15. See \code{\link[gdata]{write.fwf}} (function used to +#' writing the asc file) for more details. \cr +#' +#' (Le paramètre \code{decimals} indique le nombre minimal de décimales à faire #' figurer dans le fichier en sortie (quel que soit le nombre de décimales #' effectivement présent dans \code{microdata}). Il s'applique à toutes les #' variables réelles (double) mais pas aux variables entières (integer). Pour @@ -159,13 +248,17 @@ write_rda <- function(info_vars) { #' Les chiffres après la virgule peuvent être incorrects dans le fichier asc si #' le nombre total de chiffres (avant ou après le séparateur décimal) est #' supérieur à 15. Voir \code{\link[gdata]{write.fwf}} (fonction utilisée pour -#' écrire le fichier asc) pour plus de détails. +#' écrire le fichier asc) pour plus de détails.) +#' +#' @section See also: #' -#' @section Voir aussi: La fonction \code{\link{rtauargus}}, qui utilise cette -#' fonction et hérite de ses paramètres. +#' The function \code{\link{rtauargus}}, which uses this +#' function and inherits its parameters. \cr +#' (La fonction \code{\link{rtauargus}}, qui utilise cette +#' fonction et hérite de ses paramètres.) #' #' @examples -#' # donnees fictives +#' # dummy data/donnees fictives #' micro_df <- #' data.frame( #' GEO = c("443", "541", "543"), @@ -187,7 +280,7 @@ write_rda <- function(info_vars) { #' missing = c(DIPL = "??") #' ) #' -#' # visualisation des fichiers produits +#' # Content of output files/visualisation des fichiers produits #' file.show( #' res$asc_filename, res$rda_filename, #' header = unlist(res), diff --git a/R/options.R b/R/options.R index f1e262b..58ebaad 100644 --- a/R/options.R +++ b/R/options.R @@ -65,8 +65,9 @@ df_op.rtauargus <- function(html = FALSE) { } -#' Options du package rtauargus +#' Manages options of rtauargus package #' +#' Manages (displays, modifies, resets) the options of rtauargus package. \cr #' Gère les options du package (affiche, modifie, réinitialise). #' #' @usage @@ -75,10 +76,33 @@ df_op.rtauargus <- function(html = FALSE) { #' # options(rtauargus. = ) #' #' @details +#' +#' The options of the package define the default behaviour of the functions. +#' +#' These options are used if a mandatory argument of a function is not set +#' by the user. They let not to systematically repeat the same parameter +#' for each call of a function. The name of the option is the same as the +#' name of the function prefixed by \code{rtauargus.} : +#' +#' \emph{For example, \code{rtauargus.decimals} will be used if the argument +#' \code{decimals} in the \code{micro_asc_rda} function is not set by the +#' user.} +#' +#' On loading the package, all the rtauargus options, that are not already +#' been set by the user, are set with their default values (see table below). +#' The already defined options keep the values set by the user. +#' +#' The options can be set during a session with the following instruction +#' \code{options(rtauargus.}...\code{ = }...\code{)}, or with a configuration +#' file where the user have written its own options with such instructions, +#' but this latter is not a proper way if reproducibility is sought. #' Les options du package définissent les comportements par défaut des #' fonctions. #' -#' Ces options sont utilisées si un argument obligatoire d’une fonction n’est +#' If the user inadvertently removes some options, the functions will use +#' the default values of the package. \cr +#' +#' (Ces options sont utilisées si un argument obligatoire d’une fonction n’est #' pas renseigné. Elles permettent de ne pas répéter systématiquement le même #' paramètre à chaque appel d'une fonction. Le nom de l’option est le nom de #' l’argument d’une fonction précédé de \code{rtauargus.} : @@ -98,15 +122,18 @@ df_op.rtauargus <- function(html = FALSE) { #' reproductible). #' #' En cas d'effacement accidentel d'une option par l'utilisateur, les fonctions -#' utiliseront les valeurs par défaut du package. +#' utiliseront les valeurs par défaut du package.) #' -#' @param ... noms des options à réinitialiser, séparés par des virgules. Si +#' @param ... names of the options to reset, separated by commas. If no name is +#' specified, all the options will be reset. The prefix \code{"rtauargus."} +#' is not required. \cr +#' noms des options à réinitialiser, séparés par des virgules. Si #' aucun nom n'est spécifié, toutes les options du package seront #' réinitialisées. Le préfixe \code{"rtauargus."} est facultatif. #' -#' @section Liste des options: +#' @section List of options: #' \tabular{lll}{ -#' \strong{Option} \tab \strong{Valeur par défaut} \tab \strong{Fonction} \cr +#' \strong{Option} \tab \strong{Default Value} \tab \strong{Function} \cr #' \code{------------------------} \tab \code{---------------------------------} \tab \code{-------------}\cr #' rtauargus.decimals \tab \Sexpr{rtauargus:::op.rtauargus$rtauargus.decimals} \tab \link{micro_asc_rda}\cr #' rtauargus.totcode \tab "\Sexpr{rtauargus:::op.rtauargus$rtauargus.totcode}" \tab \cr @@ -128,7 +155,7 @@ df_op.rtauargus <- function(html = FALSE) { #' @examples #' rtauargus_options() #' -#' # modifie certaines options +#' # modifies some options #' options( #' rtauargus.tauargus_exe = "Z:/tmp/TauArgus.exe", #' rtauargus.output_type = "4", @@ -136,15 +163,15 @@ df_op.rtauargus <- function(html = FALSE) { #' ) #' str(rtauargus_options()) #' -#' # reinitialise une partie des options (prefixe "rtauargus." facultatif) +#' # resets some options (prefix "rtauargus." facultatif) #' reset_rtauargus_options("output_type", "rtauargus.tauargus_exe") #' str(rtauargus_options()) #' -#' # reinitialise tout +#' # resets everything #' reset_rtauargus_options() #' str(rtauargus_options()) -#' @seealso \link{options}, le système d'options de R dans lequel s'insèrent les -#' options de ce package. +#' @seealso \link{options}, R options system \cr +#' le système d'options de R dans lequel s'insèrent les options de ce package. #' @export #' @rdname rtauargus_options diff --git a/R/rtauargus.R b/R/rtauargus.R index 1d1006a..6e4d1c0 100644 --- a/R/rtauargus.R +++ b/R/rtauargus.R @@ -1,12 +1,30 @@ -#' Secrétise des tableaux à partir de microdonnées +#' Protects tables from microdata #' -#' Secrétise des tableaux construits à partir de microdonnées et des +#' Protects tables built from microdata and specifications of the crossings. +#' The function allows to perform the complete process, namely the creation of +#' the asc and rda files, the construction of the arb file, the effective +#' launching of Tau-Argus and the eventual recovery of the results in R. \cr +#' (Secrétise des tableaux construits à partir de microdonnées et des #' spécifications des croisements. La fonction permet d'effectuer le processus #' complet, à savoir la création des fichiers asc et rda, la construction #' du fichier arb, le lancement effectif de Tau-Argus et la récupération -#' éventuelle des résultats dans R. +#' éventuelle des résultats dans R.) #' -#' La fonction exécute séquentiellement les fonctions : \itemize{ +#' The function executes sequentially the functions: \itemize{ +#' \item{ +#' \code{\link{micro_asc_rda}} \code{->} +#' \code{\link{micro_arb}} \code{->} +#' \code{\link{run_arb}} +#' } +#' } +#' +#' Intermediate files without a name entered (\code{asc_filename}...) +#' will be created in a temporary folder, with randomly generated names. +#' This mechanism allows the user to abstract from the preparation of +#' preparation of the data and to maintain the entire chain of +#' processing in R. \cr +#' +#' (La fonction exécute séquentiellement les fonctions : \itemize{ #' \item{ #' \code{\link{micro_asc_rda}} \code{->} #' \code{\link{micro_arb}} \code{->} @@ -18,34 +36,56 @@ #' seront créés dans un dossier temporaire, avec des noms générés aléatoirement. #' Ce mécanisme permet à l'utilisateur de s'abstraire de la préparation des #' données propre à Tau-Argus et de maintenir l'intégralité de la chaîne de -#' traitements dans R. +#' traitements dans R.) #' #' @inheritParams micro_arb -#' @param microdata [\strong{obligatoire}] data.frame contenant les microdonnées +#' @param microdata [\strong{required}] data.frame containing the microdata +#' (or path to text files already present: see section +#' \emph{Microdata already as text files}). \cr +#' ([\strong{obligatoire}] data.frame contenant les microdonnées #' (ou chemin vers des fichiers texte déjà présents : voir section -#' \emph{Microdonnées déjà sous forme de fichiers texte}). -#' @param ... paramètres optionnels pour \code{micro_asc_rda}, \code{micro_arb} -#' et \code{run_arb}. Voir l'aide de ces fonctions. +#' \emph{Microdata already as text files}).) +#' @param ... optional parameters for \code{micro_asc_rda}, \code{micro_arb} +#' and \code{run_arb}. See the help for these functions. \cr +#' (paramètres optionnels pour \code{micro_asc_rda}, \code{micro_arb} +#' et \code{run_arb}. Voir l'aide de ces fonctions.) +#' +#' @inheritSection micro_arb Syntax #' -#' @inheritSection micro_arb Syntaxe +#' @section Microdata already as text files: +#' To use existing asc and rda files already existing, it is possible to +#' provide, instead of the data.frame, a character vector indicating +#' the path of these files. The first element of this vector is the asc file, +#' the second element the rda file. The rda file can be omitted if it has the +#' same name as the asc file (except for the extension). +#' Use this option to start the whole process without the generation +#' of the text data. Do not specify \code{asc_filename} or +#' \code{rda_filename} (used to name the text files to be created, which is +#' irrelevant here). \cr #' -#' @section Microdonnées déjà sous forme de fichiers texte: Pour utiliser des -#' fichiers asc et rda existant déjà, il est possible de fournir à la place du -#' data.frame un vecteur caractère indiquant le chemin de ces fichiers. Le -#' premier élément de ce vecteur est le fichier asc, le deuxième élément le -#' fichier rda. Le fichier rda peut être omis s'il porte le même nom que le -#' fichier asc (à l'extension près). +#' Pour utiliser des fichiers asc et rda existant déjà, il est possible de +#' fournir à la place du data.frame un vecteur caractère indiquant le chemin +#' de ces fichiers. Le premier élément de ce vecteur est le fichier asc, +#' le deuxième élément le fichier rda. Le fichier rda peut être omis s'il +#' porte le même nom que le fichier asc (à l'extension près). #' -#' Utiliser cette option pour lancer le processus complet sans la génération +#' Utiliser cette option pour lancer le processus complet sans la génération #' des données en texte. Ne pas spécifier \code{asc_filename} ou #' \code{rda_filename} (sert à nommer les fichiers texte à créer, ce qui est #' sans objet ici). #' -#' @return Si \code{import = TRUE}, une liste de data.frames (tableaux -#' secrétisés), \code{NULL} sinon. +#' @return +#' If \code{import = TRUE}, a list of data.frames (protected tables), +#' \code{NULL} otherwise. \cr +#' +#'(Si \code{import = TRUE}, une liste de data.frames (tableaux +#' secrétisés), \code{NULL} sinon.) #' -#' @seealso \code{\link{rtauargus_plus}}, une version optimisée pour un grand -#' nombre de tableaux (au prix de quelques restrictions d'usage). +#' @seealso +#' \code{link{rtauargus_plus}}, a version optimized for a large +#' number of tables (at the cost of some usage restrictions). \cr +#' (\code{\link{rtauargus_plus}}, une version optimisée pour un grand +#' nombre de tableaux (au prix de quelques restrictions d'usage).) #' #' @examples #' \dontrun{ @@ -54,7 +94,7 @@ #' explanatory_vars = c("V1", "V2"), #' safety_rules = "FREQ(3,10)", #' suppress = "GH(.,100)", -#' output_options = "AS+" # (exemple de parametre optionnel pour micro_arb) +#' output_options = "AS+" # (example of optional parameter for micro_arb) #' )} #' @export diff --git a/R/rtauargus_plus.R b/R/rtauargus_plus.R index 18eef63..d6558a7 100644 --- a/R/rtauargus_plus.R +++ b/R/rtauargus_plus.R @@ -1,9 +1,32 @@ -#' Secrétisation en masse +#' Mass protection #' -#' Optimisation de la fonction \code{\link{rtauargus}} pour un grand nombre de -#' croisements (ayant tous les mêmes paramètres). +#' Optimization of the function \code{link{rtauargus}} for a large number of +#' crossovers (all having the same parameters). \cr +#' (Optimisation de la fonction \code{\link{rtauargus}} pour un grand nombre de +#' croisements (ayant tous les mêmes paramètres).) #' -#' En mode interactif, Tau-Argus peut traiter jusqu'à 10 tabulations +#' In interactive mode, Tau-Argus can process up to 10 tabs +#' simultaneously for the same microdata set. In batch mode, a larger number of +#' of crossings can be specified. However, doing so +#' can be particularly time consuming, as Tau-Argus takes a lot of time +#' to read large text files of microdata. +#' +#' \code{rtauargus_plus} helps to improve the speed of execution. The function +#' splits the list of tabs into groups of size \code{grp_size} and +#' makes a call to \code{rtauargus} for each group. It writes an +#' asc file restricted to the only variables actually used within a +#' of a group. +#' +#' The results are then aggregated into a single list, as if Tau-Argus +#' had been called only once. +#' +#' Modifying \code{grp_size} will not change the result, only the time +#' execution time. A value around 5 (default) seems to be a good compromise +#' between reading too large asc files and calling Tau-Argus too often. +#' Tau-Argus too much. It can be adjusted according to the number of +#' common variables within each tab group. +# +#' (En mode interactif, Tau-Argus peut traiter jusqu'à 10 tabulations #' simultanément pour un même jeu de microdonnées. En mode batch, un nombre plus #' important de croisements peut être spécifié. Cependant, procéder de la sorte #' peut être particulièrement long, car Tau-Argus prend beaucoup de temps @@ -22,11 +45,29 @@ #' d'exécution. Une valeur autour de 5 (défaut) semble être un bon compromis #' entre une lecture de fichiers asc trop volumineux et un nombre d'appels à #' Tau-Argus trop important. Elle peut être ajustée en fonction du nombre de -#' variables communes à l'intérieur de chaque groupe de tabulations. +#' variables communes à l'intérieur de chaque groupe de tabulations.) +#' +#' +#' @section Limits in relation to the function \code{rtauargus}: +#' +#' In return for the speed of execution, the crossings must have the +#' same characteristics (same primary secret rules, same secondary secret method, +#' same secondary secret, same weighting variable, etc.). The parameters +#' \code{safety_rules}, \code{supress}, ..., must therefore contain a +#' unique value. +#' +#' Moreover, it is not possible to specify \code{asc_filename}, +#' \code{rda_filename}, \code{arb_filename} or \code{output_names} to +#' retrieve the intermediate files. These files will be written to a +#' temporary folder (and overwritten with each new group). Therefore, +#' specifying \code{import = FALSE} is irrelevant and will be ignored. +#' +#' The data must be a data.frame (asc and rda files not allowed). #' -#' @section Limites par rapport à la fonction \code{rtauargus}: +#' If the \code{linked} option is used, the link will only be effective at +#' within each group of tabs. \cr #' -#' En contrepartie de la vitesse d'exécution, les croisements doivent avoir les +#' (En contrepartie de la vitesse d'exécution, les croisements doivent avoir les #' mêmes caractéristiques (mêmes règles de secret primaire, même méthode de #' secret secondaire, même variable de pondération, etc.). Les paramètres #' \code{safety_rules}, \code{supress}, ..., doivent donc contenir une valeur @@ -42,26 +83,35 @@ #' pas autorisés). #' #' Si l'option \code{linked} est utilisée, la liaison ne sera effective qu'à -#' l'intérieur de chaque groupe de tabulations. +#' l'intérieur de chaque groupe de tabulations.) #' -#' @param grp_size nombre de tableaux par appel de Tau-Argus (un entier compris -#' entre 1 et 10). +#' @param grp_size number of tables per Tau-Argus call (an integer between +#' between 1 and 10). \cr +#' (nombre de tableaux par appel de Tau-Argus (un entier compris +#' entre 1 et 10).) #' @inheritParams micro_asc_rda #' @inheritParams micro_arb #' @inheritParams rtauargus -#' @param suppress [\strong{obligatoire}] méthode de gestion du secret +#' @param suppress [\strong{required}] secondary secret management method +#' (Tau-Argus batch syntax). Only one method allowed for +#' all tables. Example : \code{"GH(.,100)"} (the dot playing the role of the +#' tabulation number). \cr +#' [\strong{obligatoire}] méthode de gestion du secret #' secondaire (syntaxe batch de Tau-Argus). Une seule méthode autorisée pour #' tous les tableaux. Exemple \code{"GH(.,100)"} (le point jouant le rôle du #' numéro de tabulation). #' -#' @return Une liste de data.frames (tableaux secrétisés). +#' @return A list of data.frames (secret arrays). \cr +#' (Une liste de data.frames (tableaux secrétisés).) #' -#' @seealso \code{\link{rtauargus}}, fonction appelée de manière répétée par +#' @seealso \code{\link{rtauargus}}, a function called repeatedly by +#' \code{rtauargus_plus}. \cr +#' fonction appelée de manière répétée par #' \code{rtauargus_plus}. #' #' @examples #' \dontrun{ -#' # exemple de ?rtauargus, avec une repetition (artificielle) des croisements +#' # example of ?rtauargus, with an (artificial) repetition of the crossings #' rtauargus_plus( #' grp_size = 6, # (pour lancer les 12 croisements en 2 appels) #' microdata = data.frame(V1 = c("A", "A", "B", "C", "A"), V2 = "Z"), diff --git a/R/run_arb.R b/R/run_arb.R index 41ede55..23784a1 100644 --- a/R/run_arb.R +++ b/R/run_arb.R @@ -120,13 +120,29 @@ rm_cmd <- function(cmd) sub("^ *<.+> *", "", cmd) unquote <- function(s) sub("^[\"'](.+)[\"']$", "\\1", s) -#' Exécute un batch Tau-Argus +#' Runs a Tau-Argus batch #' -#' Exécute les instructions contenues dans un fichier .arb pour Tau-Argus. +#' Executes the instructions contained in an .arb file for Tau-Argus. +#' (Exécute les instructions contenues dans un fichier .arb pour Tau-Argus.) #' -#' Seul l’argument \code{arb_filename} est obligatoire, car toutes les -#' informations nécessaires sont présentes dans ce fichier. +#' Only the argument \code{arb_filename} is required, because all +#' necessary information is present in this file. +#' +#' This is the only function in the package that runs Tau-Argus. It +#' therefore requires the software to be accessible from the workstation. +#' +#' The location of the TauArgus.exe program is defined globally when the +#' loading the package. In fact, the argument \code{tauargus_exe} will not +#' normally not have to be specified (except to override the global option the +#' time of the execution of the function). #' +#' Checks are made before the actual launching of Tau-Argus: +#' existence of the software on the computer, of the asc and rda files, of the folders where +#' write the results, the variables to be used (crossings, response variable) in the +#' response variable) in the metadata (rda file). +#' +#' (Seul l’argument \code{arb_filename} est obligatoire, car toutes les +#' informations nécessaires sont présentes dans ce fichier. #' Il s'agit de la seule fonction du package qui exécute Tau-Argus. Elle #' nécessite donc que le logiciel soit accessible depuis le poste de travail. #' @@ -138,29 +154,42 @@ unquote <- function(s) sub("^[\"'](.+)[\"']$", "\\1", s) #' Des vérifications sont effectuées avant le lancement effectif de Tau-Argus : #' existence du logiciel sur le poste, des fichiers asc et rda, des dossiers où #' écrire les résultats, des variables à utiliser (croisements, variable de -#' réponse) dans les métadonnées (fichier rda). +#' réponse) dans les métadonnées (fichier rda).) #' -#' @param arb_filename nom du fichier batch à exécuter. -#' @param is_tabular booléen, si les données sont déja tabulées ou non -#' @param missing_dir action si les dossiers où seront écrits les +#' @param arb_filename name of the batch file to execute. +#' (nom du fichier batch à exécuter.) +#' @param is_tabular boolean, if the data is already tabulated or not +#' (booléen, si les données sont déja tabulées ou non) +#' @param missing_dir what to do if the folders where the results will be written +#' results do not exist ("stop" to trigger an error, "create" to +#' create the missing folders). +#' (action si les dossiers où seront écrits les #' résultats n'existent pas ("stop" pour déclencher une erreur, "create" pour -#' créer les dossiers manquants). -#' @param tauargus_exe répertoire et nom du logiciel Tau-Argus. -#' @param logbook nom du fichier où est enregistré le journal d'erreurs -#' (optionnel). -#' @param show_batch_console pour afficher le déroulement du batch dans la -#' console. -#' @param import pour importer dans R les fichiers produits, \code{TRUE} par -#' défaut. -#' @param ... paramètres supplémentaires pour \code{system()}. +#' créer les dossiers manquants).) +#' @param tauargus_exe directory and name of the Tau-Argus software. +#' (répertoire et nom du logiciel Tau-Argus.) +#' @param logbook name of the file where the error log is saved +#' (optional). +#' (nom du fichier où est enregistré le journal d'erreurs +#' (optionnel).) +#' @param show_batch_console to display the batch progress in the +#' console. +#' (pour afficher le déroulement du batch dans la +#' console.) +#' @param import to import in R the files produced, \code{TRUE} by +#' default. +#' (pour importer dans R les fichiers produits, \code{TRUE} par +#' défaut.) +#' @param ... additional parameters for \code{system()}. +#' (paramètres supplémentaires pour \code{system()}.) #' #' @return \itemize{ -#' \item{une liste de data.frame contenant les résultats si -#' \code{import = TRUE} (via la fonction \code{\link{import}})} ; -#' \item{\code{NULL} sinon}. +#' \item{a list of data.frame containing the results if +#' \code{import = TRUE} (via the \code{link{import}} function)} ; +#' \item{\code{NULL} otherwise}. #' } #' -#' @inheritSection micro_asc_rda Voir aussi +#' @inheritSection micro_asc_rda See also #' #' @examples #' \dontrun{ diff --git a/man/import.Rd b/man/import.Rd index 9dc866d..d973a5c 100644 --- a/man/import.Rd +++ b/man/import.Rd @@ -2,25 +2,42 @@ % Please edit documentation in R/import.R \name{import} \alias{import} -\title{Importe les résultats de Tau-Argus} +\title{Imports results from Tau-Argus} \usage{ import(arb_filename) } \arguments{ -\item{arb_filename}{nom du fichier arb (avec extension) contenant les -informations nécessaires à l'import.} +\item{arb_filename}{name of the arb file (with extension) containing the +information needed for the import. \cr +(nom du fichier arb (avec extension) contenant les + informations nécessaires à l'import.)} } \value{ -Une liste d'un ou plusieurs data.frames. Chaque data.frame correspond +A list of one or more data.frames. Each data.frame corresponds to +to the result of a tabulation. The names of the tables filled in the +lines of the batch of the form \code{// "..."} are recovered. \cr +(Une liste d'un ou plusieurs data.frames. Chaque data.frame correspond au résultat d'une tabulation. Les noms des tableaux renseignés dans les - lignes du batch de la forme \code{// "..."} sont récupérés. + lignes du batch de la forme \code{// "..."} sont récupérés.) } \description{ -Importe dans R les résultats générés par Tau-Argus à partir des informations -contenues dans un fichier arb. +Imports into R the results generated by Tau-Argus from the information +contained in an arb file. \cr +(Importe dans R les résultats générés par Tau-Argus à partir des informations +contenues dans un fichier arb.) } \details{ -Nécessite que le batch ait été exécuté et se soit terminé sans erreur. Afin +Requires that the batch has been executed and finished without error. In order +to import immediately after the batch has been executed, this function will be +most often called via \code{link{run_arb}} (by setting +\code{import = TRUE}). + +It is only possible (for the moment) to import results of type "2" +(csv for pivot-table) and "4" (sbs). If it is not possible to import for +a given tabulation, an empty data.frame is returned (with a +message). \cr + +(Nécessite que le batch ait été exécuté et se soit terminé sans erreur. Afin d'importer immédiatement après exécution du batch, cette fonction sera ainsi le plus souvent appelée via \code{\link{run_arb}} (en paramétrant \code{import = TRUE}). @@ -28,12 +45,22 @@ le plus souvent appelée via \code{\link{run_arb}} (en paramétrant Il n'est possible (pour l'instant) que d'importer les résultats de type "2" (csv for pivot-table) et "4" (sbs). En cas d'impossibilité de l'import pour une tabulation donnée, un data.frame vide est retourné (avec un message -d'avertissement). +d'avertissement).) } -\section{Attributs}{ +\section{Attributes}{ + + +Each data.frame is associated with a set of attributes (metadata) +allowing to keep a trace of the specifications passed to Tau-Argus. +Attributes systematically present : +\code{explanatory_vars}, \code{response_var}, \code{safetyrule}, +\code{suppress}, \code{linked}, \code{output_type}. + +Attributes present only if the corresponding option has been filled in by +the user: \code{shadow_var}, \code{cost_var}, \code{output_options}. \cr -À chaque data.frame est associé un ensemble d'attributs (métadonnées) +(À chaque data.frame est associé un ensemble d'attributs (métadonnées) permettant de conserver une trace des spécifications passées à Tau-Argus. Attributs systématiquement présents : @@ -41,11 +68,15 @@ Attributs systématiquement présents : \code{suppress}, \code{linked}, \code{output_type}. Attributs présents uniquement si l'option correspondante a été renseignée par -l'utilisateur : \code{shadow_var}, \code{cost_var}, \code{output_options}. +l'utilisateur : \code{shadow_var}, \code{cost_var}, \code{output_options}.) } -\section{Voir aussi}{ - La fonction \code{\link{rtauargus}}, qui utilise cette -fonction et hérite de ses paramètres. +\section{See also}{ + + +The function \code{\link{rtauargus}}, which uses this +function and inherits its parameters. \cr +(La fonction \code{\link{rtauargus}}, qui utilise cette +fonction et hérite de ses paramètres.) } diff --git a/man/micro_arb.Rd b/man/micro_arb.Rd index 1a96324..54554d7 100644 --- a/man/micro_arb.Rd +++ b/man/micro_arb.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/micro_arb.R \name{micro_arb} \alias{micro_arb} -\title{Crée un fichier batch (.arb) pour microdonnées} +\title{Creates a batch file (.arb) for microdata} \usage{ micro_arb( arb_filename = NULL, @@ -24,79 +24,143 @@ micro_arb( ) } \arguments{ -\item{arb_filename}{nom du fichier arb généré (avec -extension). Si non renseigné, un fichier temporaire.} - -\item{asc_filename}{[\strong{obligatoire}] nom du fichier asc (avec extension).} - -\item{rda_filename}{nom du fichier rda (avec extension). Si non renseigné, -\code{asc_filename} avec l'extension "rda" à la place de "asc".} - -\item{explanatory_vars}{[\strong{obligatoire}] variables catégorielles, sous +\item{arb_filename}{name of the generated arb file (with +extension). If not specified, a temporary file. \cr +(nom du fichier arb généré (avec extension). Si non renseigné, un fichier +temporaire.)} + +\item{asc_filename}{[\strong{required}] name of the asc file +(with extension). \cr +([\strong{obligatoire}] nom du fichier asc (avec extension).)} + +\item{rda_filename}{name of the rda file (with extension). If not filled in, +\code{asc_filename} with the extension "rda" instead of "asc". \cr +(nom du fichier rda (avec extension). Si non renseigné, +\code{asc_filename} avec l'extension "rda" à la place de "asc".)} + +\item{explanatory_vars}{[\strong{required}] categorical variables, in +form of a list of vectors. Each element of the list is a vector of +variable names forming a tab. +Example: \code{list(c("CJ", "A21"), c("SEX", "REGION"))} for the first +table crossing \code{CJ} x \code{A21} and the second table crossing +\code{SEXE} x \code{REGION}. +If a single tabulation, a simple vector of the variables to be crossed is +accepted (no need for \code{list(...)}). \cr +([\strong{obligatoire}] variables catégorielles, sous forme de liste de vecteurs. Chaque élément de la liste est un vecteur des noms des variables formant une tabulation. -Exemple : \code{list(c("CJ", "A21"), c("SEXE", "REGION"))} pour le premier -tableau croisant \code{CJ} x \code{A21} et le deuxième tableau croisant -\code{SEXE} x \code{REGION}. +Exemple: \code{list(c("CJ", "A21"), c("SEX", "REGION"))} pour la première +table croisant \code{CJ} x \code{A21} et la seconde croisant +\code{SEXE} x \code{REGION} Si une seule tabulation, un simple vecteur des variables à croiser est -accepté (pas besoin de \code{list(...)}).} - -\item{response_var}{variable de réponse à sommer, ou comptage si -\code{""}. Une seule valeur ou autant de valeurs que de tabulations.} - -\item{shadow_var}{variable(s) pour l'application du secret primaire. Si non -renseigné, \code{response_var} sera utilisé par Tau-Argus.} - -\item{cost_var}{variable(s) de coût pour le secret secondaire.} - -\item{safety_rules}{[\strong{obligatoire}] règle(s) de secret primaire. +accepté (pas besoin de \code{list(...)}).)} + +\item{response_var}{response variable to be summed, or counted if +\code{""}. A single value or as many values as there are tabs. \cr +(variable de réponse à sommer, ou comptage si \code{""}. +Une seule valeur ou autant de valeurs que de tabulations.)} + +\item{shadow_var}{variable(s) for applying the primary secret. If not +filled in, \code{response_var} will be used by Tau-Argus. \cr +(variable(s) pour l'application du secret primaire. Si non +renseigné, \code{response_var} sera utilisé par Tau-Argus.)} + +\item{cost_var}{cost variable(s) for the secondary secret. \cr +(variable(s) de coût pour le secret secondaire.)} + +\item{safety_rules}{[\strong{required}] primary secret rule(s). +String in Tau-Argus batch syntax. The weighting is treated +in a separate parameter (do not specify WGT here, use the +\code{weighted}). \cr +([\strong{obligatoire}] règle(s) de secret primaire. Chaîne de caractères en syntaxe batch Tau-Argus. La pondération est traitée dans un paramètre à part (ne pas spécifier WGT ici, utiliser le paramètre -\code{weighted}).} +\code{weighted}).)} -\item{weighted}{indicatrice(s) de pondération (booléen).} +\item{weighted}{indicator(s) (boolean). \cr +(indicatrice(s) de pondération (booléen).)} -\item{suppress}{[\strong{obligatoire}] méthode(s) de gestion du secret +\item{suppress}{[\strong{required}] secret management method(s) +secondary (Tau-Argus batch syntax). If the method is the same for +each tabulation, the first parameter (table number) will be ignored and +renumbered automatically (see section 'Syntax'). \cr +([\strong{obligatoire}] méthode(s) de gestion du secret secondaire (syntaxe batch de Tau-Argus). Si la méthode est la même pour chaque tabulation, le premier paramètre (numéro du tableau) sera ignoré et -renuméroté automatiquement (voir la section 'Syntaxe').} +renuméroté automatiquement (voir la section 'Syntax').)} -\item{linked}{pour traiter le secret secondaire conjointement sur toutes les +\item{linked}{to process the secondary secret jointly on all +tabs. Only one delete command is allowed in this case (applied to all +all tables). \cr +(pour traiter le secret secondaire conjointement sur toutes les tabulations. Une seule commande suppress autorisée dans ce cas (appliquée à -tous les tableaux).} - -\item{output_names}{noms des fichiers en sortie. Si renseigné, -obligatoirement autant de noms de fichiers que de tabulations. Si laissé +tous les tableaux).)} + +\item{output_names}{names of output files. If filled in, +the number of file names must be the same as the number of tabs. If left +empty, as many temporary file names as there are tabs will be +generated. \cr +(noms des fichiers en sortie. Si renseigné, obligatoirement autant de noms +de fichiers que de tabulations. Si laissé vide, autant de noms de fichiers temporaires que de tabulations seront -générés.} +générés.)} -\item{output_type}{format des fichiers en sortie (codification Tau-Argus). -Valeur par défaut du package : \code{"2"} (csv for pivot-table).} +\item{output_type}{format of output files (Tau-Argus codification). +Default value of the package: \code{"2"} (csv for pivot-table). \cr +(format des fichiers en sortie (codification Tau-Argus). +Valeur par défaut du package : \code{"2"} (csv for pivot-table).)} -\item{output_options}{options supplémentaires des fichiers en sortie. Valeur +\item{output_options}{additional options for output files. default value of +the package: \code{"AS+"} (status display). To specify no option, \code{""}. \cr +(options supplémentaires des fichiers en sortie. Valeur par défaut du package : \code{"AS+"} (affichage du statut). Pour ne -spécifier aucune option, \code{""}.} +spécifier aucune option, \code{""}.)} -\item{apriori}{fichier(s) d'informations \emph{a priori}. Voir ci-dessous -pour la syntaxe.} +\item{apriori}{information file(s) \emph{a priori}. See below +for the syntax. \cr +(fichier(s) d'informations \emph{a priori}. Voir ci-dessous +pour la syntaxe.)} -\item{gointeractive}{pour avoir la possibilité de lancer le batch depuis le -menu de Tau-Argus (\code{FALSE} par défaut).} +\item{gointeractive}{to have the possibility to launch the batch from the +menu of Tau-Argus. \cr +(pour avoir la possibilité de lancer le batch depuis le +menu de Tau-Argus (\code{FALSE} par défaut).)} } \value{ -Une liste de deux éléments : le nom du fichier arb, les noms des - fichiers en sortie (utile pour récupérer les noms générés aléatoirement). +A list of two elements: arb filename and names of output files +(useful to get back the randomly generated names) \cr +(Une liste de deux éléments : le nom du fichier arb, les noms des +fichiers en sortie (utile pour récupérer les noms générés aléatoirement).) } \description{ -Crée un fichier batch pour microdonnées, exécutable par Tau-Argus en ligne de -commande. +Creates a batch file for microdata, executable by Tau-Argus in +command line. \cr +(Crée un fichier batch pour microdonnées, exécutable par Tau-Argus en ligne +de commande.) } \details{ -La fonction ne vérifie pas si les fichiers asc et rda existent. +The function does not check if asc and rda files exist. \cr +(La fonction ne vérifie pas si les fichiers asc et rda existent.) } -\section{Syntaxe}{ +\section{Syntax}{ + +Tau-Argus can handle multiple tabs for the same set of +microdata. Passing a single value for an option will apply the same +processing to each tab. For differentiated options, passing a +vector containing as many values as there are tabs. If the lengths do not +match (not recommended), a recycling is performed. + +Unless otherwise stated, use the syntax mentioned in the documentation +of Tau-Argus. -Tau-Argus peut traiter plusieurs tabulations pour un même jeu de +Special syntax for \code{suppress} : the first parameter in the +Tau-Argus syntax is the tab number. If the method is identical +for all tabs, this first parameter will be ignored and the numbers +are automatically recalculated for the batch. In the writing +\code{suppress = "GH(n,100)"}, n will thus be transformed into 1 for the +first tab, into 2 for the second tab, etc. + +(Tau-Argus peut traiter plusieurs tabulations pour un même jeu de microdonnées. Passer une seule valeur pour une option appliquera le même traitement à chaque tabulation. Pour des options différenciées, passer un vecteur contenant autant de valeurs que de tabulations. Si les longueurs ne @@ -110,24 +174,43 @@ syntaxe Tau-Argus est le numéro de la tabulation. Si la méthode est identique pour toutes les tabulations, ce premier paramètre sera ignoré et les numéros recalculés automatiquement pour le batch. Dans l'écriture \code{suppress = "GH(n,100)"}, n sera ainsi transformé en 1 pour la première -tabulation, en 2 pour la deuxième tabulation, etc. +tabulation, en 2 pour la deuxième tabulation, etc.) } -\section{Identifiants des tableaux}{ +\section{Table identifiers}{ + +If the list \code{explanatory_vars} has names, these will be +used in the batch to give an identifier to the table, in the form of +of a comment line (\code{// "..."}). They will be +reused by the \code{import} function to name the R format arrays +tables in output. -Si la liste \code{explanatory_vars} comporte des noms, ceux-ci seront +(Si la liste \code{explanatory_vars} comporte des noms, ceux-ci seront utilisés dans le batch pour donner un identifiant au tableau, sous la forme d'une ligne de commentaire (\code{// "..."}). Ils seront réutilisés par la fonction \code{import} pour nommer les tableaux formats R -en sortie. +en sortie.) } -\section{Informations \emph{a priori}}{ +\section{Use an apriori file}{ -Il est possible de fournir un fichier a priori (.hst) pour chaque tabulation. +It is possible to provide an apriori file (.hst) for each tabulation. -La manière la plus simple est de passer un vecteur contenant autant de noms de -fichiers hst que de tabulations. Si le fichier est le même pour toutes les +The easiest way is to pass a vector containing as many +hst files as there are tabs. If the file is the same for all +tabs, specify the name of this file (it will be used for all +tabs). + +The additional options are optional. To change the default values, +pass a list with the hst file(s) as the first item and +complete with the elements having the names \code{sep} for the separator, +\code{ignore_err} for IgnoreError and \code{exp_triv} for ExpandTrivial. +As for filenames, specify only one value per parameter or +as many values as there are tabs. +(Il est possible de fournir un fichier apriori (.hst) pour chaque tabulation. + +La manière la plus simple est de passer un vecteur contenant autant de noms +de fichiers hst que de tabulations. Si le fichier est le même pour toutes les tabulations, spécifier le nom de ce fichier (il sera utilisé pour toutes les tabulations). @@ -136,16 +219,20 @@ défaut, passer une liste ayant comme premier élément le(s) fichier(s) hst et compléter avec les éléments portant les noms \code{sep} pour le séparateur, \code{ignore_err} pour IgnoreError et \code{exp_triv} pour ExpandTrivial. Comme pour les noms de fichiers, spécifier une seule valeur par paramètre ou -autant de valeurs que de tabulations. +autant de valeurs que de tabulations.) } -\section{Voir aussi}{ - La fonction \code{\link{rtauargus}}, qui utilise cette -fonction et hérite de ses paramètres. +\section{See also}{ + + +The function \code{\link{rtauargus}}, which uses this +function and inherits its parameters. \cr +(La fonction \code{\link{rtauargus}}, qui utilise cette +fonction et hérite de ses paramètres.) } \examples{ -# creation fichier arb +# creation of the .arb file infos_arb <- micro_arb( asc_filename = "donnees.asc", explanatory_vars = list(c("REGION", "CJ"), c("REGION")), @@ -157,6 +244,7 @@ infos_arb <- micro_arb( output_type = "2" ) -# visualisation du contenu du fichier dans la console +# Content of the created file visible in the R console +# (Visualisation du contenu du fichier dans la console) file.show(infos_arb$arb_filename, pager = "console") } diff --git a/man/micro_asc_rda.Rd b/man/micro_asc_rda.Rd index 4e812b8..b04c71a 100644 --- a/man/micro_asc_rda.Rd +++ b/man/micro_asc_rda.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/micro_asc_rda.R \name{micro_asc_rda} \alias{micro_asc_rda} -\title{Crée les fichiers asc et rda à partir de microdonnées} +\title{Creates asc and rda files from microdata} \usage{ micro_asc_rda( microdata, @@ -20,55 +20,98 @@ micro_asc_rda( ) } \arguments{ -\item{microdata}{[\strong{obligatoire}] data.frame contenant les -microdonnées.} - -\item{asc_filename}{nom du fichier asc (avec extension). Si non renseigné, un -fichier temporaire.} - -\item{rda_filename}{nom du fichier rda (avec extension). Si non renseigné, -\code{asc_filename} avec l'extension "rda" à la place de "asc".} - -\item{weight_var}{nom de la variable de poids.} - -\item{holding_var}{nom de la variable de holding.} - -\item{decimals}{nombre minimal de décimales à afficher (voir section 'Nombre -de décimales').} - -\item{hrc}{informations sur les variables hiérarchiques (voir section -'Variables hiérarchiques').} - -\item{hierleadstring}{caractère qui, répété n fois, indique que la valeur est -à n niveaux de profondeur dans la hiérarchie.} - -\item{totcode}{code(s) pour le total d'une variable catégorielle (voir -section 'Paramètres spécifiques' pour la syntaxe de ce paramètre). Les +\item{microdata}{[\strong{required}] data.frame containing the microdata. \cr +([\strong{obligatoire}] data.frame contenant les microdonnées.)} + +\item{asc_filename}{name of the asc file (with extension). If not filled in, +a temporary file. \cr +(nom du fichier asc (avec extension). Si non renseigné, +un fichier temporaire.)} + +\item{rda_filename}{name of the rda file (with extension). If not filled in, +\code{asc_filename} with the extension "rda" instead of "asc". \cr +(nom du fichier rda (avec extension). Si non renseigné, +\code{asc_filename} avec l'extension "rda" à la place de "asc".)} + +\item{weight_var}{name of the weight variable. \cr +(nom de la variable de poids.)} + +\item{holding_var}{nom de la variable de holding. +(name of the holding variable.) \cr} + +\item{decimals}{minimum number of decimals to display (see section 'Number of +of decimals'). +(nombre minimal de décimales à afficher (voir section 'Number of +of decimals').)} + +\item{hrc}{information about the hierarchical variables (see section +section 'Hierarchical variables'). \cr +(informations sur les variables hiérarchiques (voir section +'Hierarchical variables').)} + +\item{hierleadstring}{character which, repeated n times, indicates that the value is +at n levels deep in the hierarchy. \cr +(caractère qui, répété n fois, indique que la valeur est +à n niveaux de profondeur dans la hiérarchie.)} + +\item{totcode}{code(s) for the total of a categorical variable (see +section 'Specific parameters' for the syntax of this parameter). The +variables not specified (neither by default nor explicitly) will be +assigned the value of \code{rtauargus.totcode}. \cr +(code(s) pour le total d'une variable catégorielle (voir +section 'Specific parameters' pour la syntaxe de ce paramètre). Les variables non spécifiées (ni par défaut, ni explicitement) se verront -attribuer la valeur de \code{rtauargus.totcode}.} +attribuer la valeur de \code{rtauargus.totcode}.)} -\item{missing}{code(s) pour une valeur manquante (voir section -'Paramètres spécifiques' pour la syntaxe de ce paramètre).} +\item{missing}{code(s) for a missing value (see section +'Specific parameters' for the syntax of this parameter). \cr +(code(s) pour une valeur manquante (voir section + 'Specific parameters' pour la syntaxe de ce paramètre).)} -\item{codelist}{fichier(s) contenant les libellés des variables catégorielles -(voir section 'Paramètres spécifiques' pour la syntaxe de ce paramètre).} +\item{codelist}{file(s) containing labels for categorical variables +(see section 'Specific parameters' for the syntax of this parameter). \cr +(fichier(s) contenant les libellés des variables catégorielles + (voir section 'Specific parameters' pour la syntaxe de ce paramètre).)} -\item{request}{(pas encore implémenté)} +\item{request}{(not yet implemented - pas encore implémenté)} } \value{ -Renvoie les noms des fichiers asc et rda sous forme de liste (de +Returns the names of the asc and rda files as a list (invisibly). +invisibly). Empty columns (filled with \code{NA} or empty strings) are not +strings) will not be exported to the asc file. A +warning message will list the affected columns. \cr +(Renvoie les noms des fichiers asc et rda sous forme de liste (de manière invisible). Les colonnes vides (remplies de \code{NA} ou de chaînes de caractères vides) ne seront pas exportées dans le fichier asc. Un - message d'avertissement listera les colonnes concernées. + message d'avertissement listera les colonnes concernées.) } \description{ -Crée un fichier texte de longueur fixe (asc) et un fichier de métadonnées -(rda) à partir de microdonnées et d'informations additionnelles. +Creates a fixed length text file (asc) and a metadata file +(rda) from microdata and additional information. \cr +(Crée un fichier texte de longueur fixe (asc) et un fichier de métadonnées +(rda) à partir de microdonnées et d'informations additionnelles.) } -\section{Paramètres spécifiques}{ +\section{Specific parameters}{ -Les paramètres \code{totcode}, \code{missing} et \code{codelist} +The parameters \code{totcode}, \code{missing} and \code{codelist} +are to be filled in as a vector indicating the value to take +for each variable. + +The names of the elements of the vector give the variable concerned, the elements +of the vector give the value of the parameter for Tau-Argus. An unnamed element +element will be the default value, which will be assigned to all +variables that can take this parameter. + +For example : +\itemize{ + \item{\code{totcode = "All"} : écrit \code{ "All"} for all + categorical variables} + \item{\code{totcode = c("All", GEO = "France")} : idem, except for the + \code{GEO} variable } +} + +(Les paramètres \code{totcode}, \code{missing} et \code{codelist} sont à renseigner sous la forme d'un vecteur indiquant la valeur à prendre pour chaque variable. @@ -83,13 +126,50 @@ Par exemple : toutes les variables catégorielles} \item{\code{totcode = c("Ensemble", GEO = "France")} : idem, sauf pour la variable \code{GEO}} +}) } -} -\section{Variables hiérarchiques}{ +\section{Hierarchical variables}{ + +The parameter \code{hrc} follows the same syntax rules as \code{totcode}, +\code{missing} and \code{codelist} (named vector containing as many elements +as there are variables to describe). It also has the particularity +to accept several ways of specifying the values associated with the +hierarchical variables. -Le paramètre \code{hrc} obéit aux mêmes règles de syntaxe que \code{totcode}, +To define a hierarchy based on the positions of characters +(\strong{hierierlevels}), pass a sequence of integers separated by +spaces. + +\emph{Example :} \code{c(CODECOM = "2 3 0 0 0")} + +If the hierarchy is defined in a separate hrc file +(\strong{hiercodelist}), the function expects the location of this file (and +a possible \code{hiercodelist} if it differs from the default option of the +package). In this case, you can write explicitly the path to an existing file +file (\code{c(A38 = "a38.hrc")}), but also make a call to +\code{\link{write_hrc}} which will generate an hrc file from microdata. + +\emph{Example :} \code{c(A38 = write_hrc(microdata, c("A38", "A21", "A10")))} + +A shortcut for this call is to write the variables constituting the +hierarchy separated by ">". In this case, the microdata and +hierleadstring that \code{write_hrc} uses are those declared in +\code{micro_asc_rda}. + +\emph{Example :} \code{c(A38 = "A38 > A21 > A10")} \emph{(number of spaces +any before and after the ">")} + +The last two methods require the creation of a temporary file. +For a reusable hrc file, it is necessary to create it beforehand +using \code{write_hrc}. + +The three methods require that the elements of the vector in parameter +be named (with the name of the variable), even if there is only one +element. + +(Le paramètre \code{hrc} obéit aux mêmes règles de syntaxe que \code{totcode}, \code{missing} et \code{codelist} (vecteur nommé contenant autant d'éléments que de variables à décrire). Il présente de plus la particularité d'accepter plusieurs façons de spécifier les valeurs associées aux variables @@ -99,8 +179,6 @@ Pour définir une hiérarchie basée sur les positions des caractères (\strong{hierlevels}), passer une suite de nombre entiers séparés par des espaces. -\emph{Exemple :} \code{c(CODECOM = "2 3 0 0 0")} - Si la hiérarchie est définie dans un fichier hrc à part (\strong{hiercodelist}), la fonction attend l'emplacement de ce fichier (et un éventuel \code{hierleadstring} s'il diffère de l'option par défaut du @@ -108,8 +186,6 @@ package). Dans ce cas, on peut écrire explicitement le chemin vers un fichier existant (\code{c(A38 = "a38.hrc")}), mais aussi passer un appel à \code{\link{write_hrc}} qui génèrera un fichier hrc à partir de microdonnées. -\emph{Exemple :} \code{c(A38 = write_hrc(microdata, c("A38", "A21", "A10")))} - Un raccourci pour cet appel est d'écrire les variables constituant la hiérarchie séparées par des ">". Dans ce cas, les microdonnées et hierleadstring qu'utilise \code{write_hrc} sont ceux déclarés dans @@ -124,13 +200,25 @@ Pour un fichier hrc réutilisable, il est nécessaire de le créer au préalable Les trois méthodes nécessitent que les éléments du vecteur en paramètre soient nommés (avec le nom de la variable), même s'il n'y a qu'un seul -élément. +élément.) } -\section{Nombre de décimales}{ +\section{Number of decimals}{ + +The parameter \code{decimals} indicates the minimum number of decimals to be +appear in the output file (whatever the number of decimals +actually present in \code{microdata}). It applies to all +real variables (double) but not to integer variables (integer). For +add zeros to an integer variable, convert it with \code{as.double} +beforehand. -Le paramètre \code{decimals} indique le nombre minimal de décimales à faire +The digits after the decimal point may be incorrect in the asc file if +the total number of digits (before or after the decimal separator) is +greater than 15. See \code{\link[gdata]{write.fwf}} (function used to +writing the asc file) for more details. \cr + +(Le paramètre \code{decimals} indique le nombre minimal de décimales à faire figurer dans le fichier en sortie (quel que soit le nombre de décimales effectivement présent dans \code{microdata}). Il s'applique à toutes les variables réelles (double) mais pas aux variables entières (integer). Pour @@ -140,16 +228,20 @@ au préalable. Les chiffres après la virgule peuvent être incorrects dans le fichier asc si le nombre total de chiffres (avant ou après le séparateur décimal) est supérieur à 15. Voir \code{\link[gdata]{write.fwf}} (fonction utilisée pour -écrire le fichier asc) pour plus de détails. +écrire le fichier asc) pour plus de détails.) } -\section{Voir aussi}{ - La fonction \code{\link{rtauargus}}, qui utilise cette -fonction et hérite de ses paramètres. +\section{See also}{ + + +The function \code{\link{rtauargus}}, which uses this +function and inherits its parameters. \cr +(La fonction \code{\link{rtauargus}}, qui utilise cette +fonction et hérite de ses paramètres.) } \examples{ -# donnees fictives +# dummy data/donnees fictives micro_df <- data.frame( GEO = c("443", "541", "543"), @@ -171,7 +263,7 @@ res <- missing = c(DIPL = "??") ) -# visualisation des fichiers produits +# Content of output files/visualisation des fichiers produits file.show( res$asc_filename, res$rda_filename, header = unlist(res), diff --git a/man/rtauargus.Rd b/man/rtauargus.Rd index f0e1238..d2cad2a 100644 --- a/man/rtauargus.Rd +++ b/man/rtauargus.Rd @@ -2,50 +2,92 @@ % Please edit documentation in R/rtauargus.R \name{rtauargus} \alias{rtauargus} -\title{Secrétise des tableaux à partir de microdonnées} +\title{Protects tables from microdata} \usage{ rtauargus(microdata, explanatory_vars, safety_rules, suppress, ...) } \arguments{ -\item{microdata}{[\strong{obligatoire}] data.frame contenant les microdonnées -(ou chemin vers des fichiers texte déjà présents : voir section -\emph{Microdonnées déjà sous forme de fichiers texte}).} +\item{microdata}{[\strong{required}] data.frame containing the microdata +(or path to text files already present: see section +\emph{Microdata already as text files}). \cr +([\strong{obligatoire}] data.frame contenant les microdonnées + (ou chemin vers des fichiers texte déjà présents : voir section + \emph{Microdata already as text files}).)} -\item{explanatory_vars}{[\strong{obligatoire}] variables catégorielles, sous +\item{explanatory_vars}{[\strong{required}] categorical variables, in +form of a list of vectors. Each element of the list is a vector of +variable names forming a tab. +Example: \code{list(c("CJ", "A21"), c("SEX", "REGION"))} for the first +table crossing \code{CJ} x \code{A21} and the second table crossing +\code{SEXE} x \code{REGION}. +If a single tabulation, a simple vector of the variables to be crossed is +accepted (no need for \code{list(...)}). \cr +([\strong{obligatoire}] variables catégorielles, sous forme de liste de vecteurs. Chaque élément de la liste est un vecteur des noms des variables formant une tabulation. -Exemple : \code{list(c("CJ", "A21"), c("SEXE", "REGION"))} pour le premier -tableau croisant \code{CJ} x \code{A21} et le deuxième tableau croisant -\code{SEXE} x \code{REGION}. +Exemple: \code{list(c("CJ", "A21"), c("SEX", "REGION"))} pour la première +table croisant \code{CJ} x \code{A21} et la seconde croisant +\code{SEXE} x \code{REGION} Si une seule tabulation, un simple vecteur des variables à croiser est -accepté (pas besoin de \code{list(...)}).} +accepté (pas besoin de \code{list(...)}).)} -\item{safety_rules}{[\strong{obligatoire}] règle(s) de secret primaire. +\item{safety_rules}{[\strong{required}] primary secret rule(s). +String in Tau-Argus batch syntax. The weighting is treated +in a separate parameter (do not specify WGT here, use the +\code{weighted}). \cr +([\strong{obligatoire}] règle(s) de secret primaire. Chaîne de caractères en syntaxe batch Tau-Argus. La pondération est traitée dans un paramètre à part (ne pas spécifier WGT ici, utiliser le paramètre -\code{weighted}).} +\code{weighted}).)} -\item{suppress}{[\strong{obligatoire}] méthode(s) de gestion du secret +\item{suppress}{[\strong{required}] secret management method(s) +secondary (Tau-Argus batch syntax). If the method is the same for +each tabulation, the first parameter (table number) will be ignored and +renumbered automatically (see section 'Syntax'). \cr +([\strong{obligatoire}] méthode(s) de gestion du secret secondaire (syntaxe batch de Tau-Argus). Si la méthode est la même pour chaque tabulation, le premier paramètre (numéro du tableau) sera ignoré et -renuméroté automatiquement (voir la section 'Syntaxe').} +renuméroté automatiquement (voir la section 'Syntax').)} -\item{...}{paramètres optionnels pour \code{micro_asc_rda}, \code{micro_arb} -et \code{run_arb}. Voir l'aide de ces fonctions.} +\item{...}{optional parameters for \code{micro_asc_rda}, \code{micro_arb} +and \code{run_arb}. See the help for these functions. \cr +(paramètres optionnels pour \code{micro_asc_rda}, \code{micro_arb} + et \code{run_arb}. Voir l'aide de ces fonctions.)} } \value{ -Si \code{import = TRUE}, une liste de data.frames (tableaux - secrétisés), \code{NULL} sinon. +If \code{import = TRUE}, a list of data.frames (protected tables), +\code{NULL} otherwise. \cr + +(Si \code{import = TRUE}, une liste de data.frames (tableaux + secrétisés), \code{NULL} sinon.) } \description{ -Secrétise des tableaux construits à partir de microdonnées et des +Protects tables built from microdata and specifications of the crossings. +The function allows to perform the complete process, namely the creation of +the asc and rda files, the construction of the arb file, the effective +launching of Tau-Argus and the eventual recovery of the results in R. \cr +(Secrétise des tableaux construits à partir de microdonnées et des spécifications des croisements. La fonction permet d'effectuer le processus complet, à savoir la création des fichiers asc et rda, la construction du fichier arb, le lancement effectif de Tau-Argus et la récupération -éventuelle des résultats dans R. +éventuelle des résultats dans R.) } \details{ -La fonction exécute séquentiellement les fonctions : \itemize{ +The function executes sequentially the functions: \itemize{ +\item{ +\code{\link{micro_asc_rda}} \code{->} +\code{\link{micro_arb}} \code{->} +\code{\link{run_arb}} +} +} + +Intermediate files without a name entered (\code{asc_filename}...) +will be created in a temporary folder, with randomly generated names. +This mechanism allows the user to abstract from the preparation of +preparation of the data and to maintain the entire chain of +processing in R. \cr + +(La fonction exécute séquentiellement les fonctions : \itemize{ \item{ \code{\link{micro_asc_rda}} \code{->} \code{\link{micro_arb}} \code{->} @@ -57,25 +99,51 @@ Les fichiers intermédiaires sans nom renseigné (\code{asc_filename}...) seront créés dans un dossier temporaire, avec des noms générés aléatoirement. Ce mécanisme permet à l'utilisateur de s'abstraire de la préparation des données propre à Tau-Argus et de maintenir l'intégralité de la chaîne de -traitements dans R. +traitements dans R.) } -\section{Microdonnées déjà sous forme de fichiers texte}{ - Pour utiliser des - fichiers asc et rda existant déjà, il est possible de fournir à la place du - data.frame un vecteur caractère indiquant le chemin de ces fichiers. Le - premier élément de ce vecteur est le fichier asc, le deuxième élément le - fichier rda. Le fichier rda peut être omis s'il porte le même nom que le - fichier asc (à l'extension près). - - Utiliser cette option pour lancer le processus complet sans la génération +\section{Microdata already as text files}{ + +To use existing asc and rda files already existing, it is possible to +provide, instead of the data.frame, a character vector indicating +the path of these files. The first element of this vector is the asc file, +the second element the rda file. The rda file can be omitted if it has the +same name as the asc file (except for the extension). +Use this option to start the whole process without the generation +of the text data. Do not specify \code{asc_filename} or +\code{rda_filename} (used to name the text files to be created, which is +irrelevant here). \cr + +Pour utiliser des fichiers asc et rda existant déjà, il est possible de +fournir à la place du data.frame un vecteur caractère indiquant le chemin +de ces fichiers. Le premier élément de ce vecteur est le fichier asc, +le deuxième élément le fichier rda. Le fichier rda peut être omis s'il +porte le même nom que le fichier asc (à l'extension près). + +Utiliser cette option pour lancer le processus complet sans la génération des données en texte. Ne pas spécifier \code{asc_filename} ou \code{rda_filename} (sert à nommer les fichiers texte à créer, ce qui est sans objet ici). } -\section{Syntaxe}{ +\section{Syntax}{ + +Tau-Argus can handle multiple tabs for the same set of +microdata. Passing a single value for an option will apply the same +processing to each tab. For differentiated options, passing a +vector containing as many values as there are tabs. If the lengths do not +match (not recommended), a recycling is performed. + +Unless otherwise stated, use the syntax mentioned in the documentation +of Tau-Argus. + +Special syntax for \code{suppress} : the first parameter in the +Tau-Argus syntax is the tab number. If the method is identical +for all tabs, this first parameter will be ignored and the numbers +are automatically recalculated for the batch. In the writing +\code{suppress = "GH(n,100)"}, n will thus be transformed into 1 for the +first tab, into 2 for the second tab, etc. -Tau-Argus peut traiter plusieurs tabulations pour un même jeu de +(Tau-Argus peut traiter plusieurs tabulations pour un même jeu de microdonnées. Passer une seule valeur pour une option appliquera le même traitement à chaque tabulation. Pour des options différenciées, passer un vecteur contenant autant de valeurs que de tabulations. Si les longueurs ne @@ -89,7 +157,7 @@ syntaxe Tau-Argus est le numéro de la tabulation. Si la méthode est identique pour toutes les tabulations, ce premier paramètre sera ignoré et les numéros recalculés automatiquement pour le batch. Dans l'écriture \code{suppress = "GH(n,100)"}, n sera ainsi transformé en 1 pour la première -tabulation, en 2 pour la deuxième tabulation, etc. +tabulation, en 2 pour la deuxième tabulation, etc.) } \examples{ @@ -99,10 +167,12 @@ rtauargus( explanatory_vars = c("V1", "V2"), safety_rules = "FREQ(3,10)", suppress = "GH(.,100)", - output_options = "AS+" # (exemple de parametre optionnel pour micro_arb) + output_options = "AS+" # (example of optional parameter for micro_arb) )} } \seealso{ -\code{\link{rtauargus_plus}}, une version optimisée pour un grand - nombre de tableaux (au prix de quelques restrictions d'usage). +\code{link{rtauargus_plus}}, a version optimized for a large +number of tables (at the cost of some usage restrictions). \cr +(\code{\link{rtauargus_plus}}, une version optimisée pour un grand + nombre de tableaux (au prix de quelques restrictions d'usage).) } diff --git a/man/rtauargus_options.Rd b/man/rtauargus_options.Rd index dc9fe3d..b6065ab 100644 --- a/man/rtauargus_options.Rd +++ b/man/rtauargus_options.Rd @@ -3,7 +3,7 @@ \name{rtauargus_options} \alias{rtauargus_options} \alias{reset_rtauargus_options} -\title{Options du package rtauargus} +\title{Manages options of rtauargus package} \usage{ rtauargus_options() @@ -12,18 +12,44 @@ rtauargus_options() reset_rtauargus_options(...) } \arguments{ -\item{...}{noms des options à réinitialiser, séparés par des virgules. Si -aucun nom n'est spécifié, toutes les options du package seront -réinitialisées. Le préfixe \code{"rtauargus."} est facultatif.} +\item{...}{names of the options to reset, separated by commas. If no name is +specified, all the options will be reset. The prefix \code{"rtauargus."} +is not required. \cr +noms des options à réinitialiser, séparés par des virgules. Si + aucun nom n'est spécifié, toutes les options du package seront + réinitialisées. Le préfixe \code{"rtauargus."} est facultatif.} } \description{ +Manages (displays, modifies, resets) the options of rtauargus package. \cr Gère les options du package (affiche, modifie, réinitialise). } \details{ +The options of the package define the default behaviour of the functions. + +These options are used if a mandatory argument of a function is not set +by the user. They let not to systematically repeat the same parameter +for each call of a function. The name of the option is the same as the +name of the function prefixed by \code{rtauargus.} : + +\emph{For example, \code{rtauargus.decimals} will be used if the argument +\code{decimals} in the \code{micro_asc_rda} function is not set by the +user.} + +On loading the package, all the rtauargus options, that are not already +been set by the user, are set with their default values (see table below). +The already defined options keep the values set by the user. + +The options can be set during a session with the following instruction +\code{options(rtauargus.}...\code{ = }...\code{)}, or with a configuration +file where the user have written its own options with such instructions, +but this latter is not a proper way if reproducibility is sought. Les options du package définissent les comportements par défaut des fonctions. -Ces options sont utilisées si un argument obligatoire d’une fonction n’est +If the user inadvertently removes some options, the functions will use +the default values of the package. \cr + +(Ces options sont utilisées si un argument obligatoire d’une fonction n’est pas renseigné. Elles permettent de ne pas répéter systématiquement le même paramètre à chaque appel d'une fonction. Le nom de l’option est le nom de l’argument d’une fonction précédé de \code{rtauargus.} : @@ -43,12 +69,12 @@ l'utilisateur (fortement déconseillé si le programme a vocation à être reproductible). En cas d'effacement accidentel d'une option par l'utilisateur, les fonctions -utiliseront les valeurs par défaut du package. +utiliseront les valeurs par défaut du package.) } -\section{Liste des options}{ +\section{List of options}{ \tabular{lll}{ - \strong{Option} \tab \strong{Valeur par défaut} \tab \strong{Fonction} \cr + \strong{Option} \tab \strong{Default Value} \tab \strong{Function} \cr \code{------------------------} \tab \code{---------------------------------} \tab \code{-------------}\cr rtauargus.decimals \tab \Sexpr{rtauargus:::op.rtauargus$rtauargus.decimals} \tab \link{micro_asc_rda}\cr rtauargus.totcode \tab "\Sexpr{rtauargus:::op.rtauargus$rtauargus.totcode}" \tab \cr @@ -71,7 +97,7 @@ utiliseront les valeurs par défaut du package. \examples{ rtauargus_options() -# modifie certaines options +# modifies some options options( rtauargus.tauargus_exe = "Z:/tmp/TauArgus.exe", rtauargus.output_type = "4", @@ -79,15 +105,15 @@ options( ) str(rtauargus_options()) -# reinitialise une partie des options (prefixe "rtauargus." facultatif) +# resets some options (prefix "rtauargus." facultatif) reset_rtauargus_options("output_type", "rtauargus.tauargus_exe") str(rtauargus_options()) -# reinitialise tout +# resets everything reset_rtauargus_options() str(rtauargus_options()) } \seealso{ -\link{options}, le système d'options de R dans lequel s'insèrent les - options de ce package. +\link{options}, R options system \cr +le système d'options de R dans lequel s'insèrent les options de ce package. } diff --git a/man/rtauargus_plus.Rd b/man/rtauargus_plus.Rd index c70ee6a..2f51853 100644 --- a/man/rtauargus_plus.Rd +++ b/man/rtauargus_plus.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/rtauargus_plus.R \name{rtauargus_plus} \alias{rtauargus_plus} -\title{Secrétisation en masse} +\title{Mass protection} \usage{ rtauargus_plus( grp_size = 5, @@ -14,43 +14,86 @@ rtauargus_plus( ) } \arguments{ -\item{grp_size}{nombre de tableaux par appel de Tau-Argus (un entier compris -entre 1 et 10).} +\item{grp_size}{number of tables per Tau-Argus call (an integer between +between 1 and 10). \cr +(nombre de tableaux par appel de Tau-Argus (un entier compris + entre 1 et 10).)} -\item{microdata}{[\strong{obligatoire}] data.frame contenant les -microdonnées.} +\item{microdata}{[\strong{required}] data.frame containing the microdata. \cr +([\strong{obligatoire}] data.frame contenant les microdonnées.)} -\item{explanatory_vars}{[\strong{obligatoire}] variables catégorielles, sous +\item{explanatory_vars}{[\strong{required}] categorical variables, in +form of a list of vectors. Each element of the list is a vector of +variable names forming a tab. +Example: \code{list(c("CJ", "A21"), c("SEX", "REGION"))} for the first +table crossing \code{CJ} x \code{A21} and the second table crossing +\code{SEXE} x \code{REGION}. +If a single tabulation, a simple vector of the variables to be crossed is +accepted (no need for \code{list(...)}). \cr +([\strong{obligatoire}] variables catégorielles, sous forme de liste de vecteurs. Chaque élément de la liste est un vecteur des noms des variables formant une tabulation. -Exemple : \code{list(c("CJ", "A21"), c("SEXE", "REGION"))} pour le premier -tableau croisant \code{CJ} x \code{A21} et le deuxième tableau croisant -\code{SEXE} x \code{REGION}. +Exemple: \code{list(c("CJ", "A21"), c("SEX", "REGION"))} pour la première +table croisant \code{CJ} x \code{A21} et la seconde croisant +\code{SEXE} x \code{REGION} Si une seule tabulation, un simple vecteur des variables à croiser est -accepté (pas besoin de \code{list(...)}).} +accepté (pas besoin de \code{list(...)}).)} -\item{safety_rules}{[\strong{obligatoire}] règle(s) de secret primaire. +\item{safety_rules}{[\strong{required}] primary secret rule(s). +String in Tau-Argus batch syntax. The weighting is treated +in a separate parameter (do not specify WGT here, use the +\code{weighted}). \cr +([\strong{obligatoire}] règle(s) de secret primaire. Chaîne de caractères en syntaxe batch Tau-Argus. La pondération est traitée dans un paramètre à part (ne pas spécifier WGT ici, utiliser le paramètre -\code{weighted}).} +\code{weighted}).)} -\item{suppress}{[\strong{obligatoire}] méthode de gestion du secret -secondaire (syntaxe batch de Tau-Argus). Une seule méthode autorisée pour -tous les tableaux. Exemple \code{"GH(.,100)"} (le point jouant le rôle du -numéro de tabulation).} +\item{suppress}{[\strong{required}] secondary secret management method +(Tau-Argus batch syntax). Only one method allowed for +all tables. Example : \code{"GH(.,100)"} (the dot playing the role of the +tabulation number). \cr +[\strong{obligatoire}] méthode de gestion du secret + secondaire (syntaxe batch de Tau-Argus). Une seule méthode autorisée pour + tous les tableaux. Exemple \code{"GH(.,100)"} (le point jouant le rôle du + numéro de tabulation).} -\item{...}{paramètres optionnels pour \code{micro_asc_rda}, \code{micro_arb} -et \code{run_arb}. Voir l'aide de ces fonctions.} +\item{...}{optional parameters for \code{micro_asc_rda}, \code{micro_arb} +and \code{run_arb}. See the help for these functions. \cr +(paramètres optionnels pour \code{micro_asc_rda}, \code{micro_arb} + et \code{run_arb}. Voir l'aide de ces fonctions.)} } \value{ -Une liste de data.frames (tableaux secrétisés). +A list of data.frames (secret arrays). \cr +(Une liste de data.frames (tableaux secrétisés).) } \description{ -Optimisation de la fonction \code{\link{rtauargus}} pour un grand nombre de -croisements (ayant tous les mêmes paramètres). +Optimization of the function \code{link{rtauargus}} for a large number of +crossovers (all having the same parameters). \cr +(Optimisation de la fonction \code{\link{rtauargus}} pour un grand nombre de +croisements (ayant tous les mêmes paramètres).) } \details{ -En mode interactif, Tau-Argus peut traiter jusqu'à 10 tabulations +In interactive mode, Tau-Argus can process up to 10 tabs +simultaneously for the same microdata set. In batch mode, a larger number of +of crossings can be specified. However, doing so +can be particularly time consuming, as Tau-Argus takes a lot of time +to read large text files of microdata. + +\code{rtauargus_plus} helps to improve the speed of execution. The function +splits the list of tabs into groups of size \code{grp_size} and +makes a call to \code{rtauargus} for each group. It writes an +asc file restricted to the only variables actually used within a +of a group. + +The results are then aggregated into a single list, as if Tau-Argus +had been called only once. + +Modifying \code{grp_size} will not change the result, only the time +execution time. A value around 5 (default) seems to be a good compromise +between reading too large asc files and calling Tau-Argus too often. +Tau-Argus too much. It can be adjusted according to the number of +common variables within each tab group. +(En mode interactif, Tau-Argus peut traiter jusqu'à 10 tabulations simultanément pour un même jeu de microdonnées. En mode batch, un nombre plus important de croisements peut être spécifié. Cependant, procéder de la sorte peut être particulièrement long, car Tau-Argus prend beaucoup de temps @@ -69,12 +112,29 @@ Modifier \code{grp_size} ne changera pas le résultat, seulement le temps d'exécution. Une valeur autour de 5 (défaut) semble être un bon compromis entre une lecture de fichiers asc trop volumineux et un nombre d'appels à Tau-Argus trop important. Elle peut être ajustée en fonction du nombre de -variables communes à l'intérieur de chaque groupe de tabulations. +variables communes à l'intérieur de chaque groupe de tabulations.) } -\section{Limites par rapport à la fonction \code{rtauargus}}{ +\section{Limits in relation to the function \code{rtauargus}}{ + + +In return for the speed of execution, the crossings must have the +same characteristics (same primary secret rules, same secondary secret method, +same secondary secret, same weighting variable, etc.). The parameters +\code{safety_rules}, \code{supress}, ..., must therefore contain a +unique value. + +Moreover, it is not possible to specify \code{asc_filename}, +\code{rda_filename}, \code{arb_filename} or \code{output_names} to +retrieve the intermediate files. These files will be written to a +temporary folder (and overwritten with each new group). Therefore, +specifying \code{import = FALSE} is irrelevant and will be ignored. + +The data must be a data.frame (asc and rda files not allowed). +If the \code{linked} option is used, the link will only be effective at +within each group of tabs. \cr -En contrepartie de la vitesse d'exécution, les croisements doivent avoir les +(En contrepartie de la vitesse d'exécution, les croisements doivent avoir les mêmes caractéristiques (mêmes règles de secret primaire, même méthode de secret secondaire, même variable de pondération, etc.). Les paramètres \code{safety_rules}, \code{supress}, ..., doivent donc contenir une valeur @@ -90,12 +150,12 @@ Les données doivent obligatoirement être un data.frame (fichiers asc et rda pas autorisés). Si l'option \code{linked} est utilisée, la liaison ne sera effective qu'à -l'intérieur de chaque groupe de tabulations. +l'intérieur de chaque groupe de tabulations.) } \examples{ \dontrun{ -# exemple de ?rtauargus, avec une repetition (artificielle) des croisements +# example of ?rtauargus, with an (artificial) repetition of the crossings rtauargus_plus( grp_size = 6, # (pour lancer les 12 croisements en 2 appels) microdata = data.frame(V1 = c("A", "A", "B", "C", "A"), V2 = "Z"), @@ -105,6 +165,8 @@ rtauargus_plus( )} } \seealso{ -\code{\link{rtauargus}}, fonction appelée de manière répétée par +\code{\link{rtauargus}}, a function called repeatedly by +\code{rtauargus_plus}. \cr +fonction appelée de manière répétée par \code{rtauargus_plus}. } diff --git a/man/run_arb.Rd b/man/run_arb.Rd index 466deb9..0e101fb 100644 --- a/man/run_arb.Rd +++ b/man/run_arb.Rd @@ -3,7 +3,7 @@ \name{run_arb} \alias{run_arb} \alias{run_tauargus} -\title{Exécute un batch Tau-Argus} +\title{Runs a Tau-Argus batch} \usage{ run_arb( arb_filename, @@ -17,41 +17,70 @@ run_arb( ) } \arguments{ -\item{arb_filename}{nom du fichier batch à exécuter.} +\item{arb_filename}{name of the batch file to execute. +(nom du fichier batch à exécuter.)} -\item{is_tabular}{booléen, si les données sont déja tabulées ou non} +\item{is_tabular}{boolean, if the data is already tabulated or not +(booléen, si les données sont déja tabulées ou non)} -\item{missing_dir}{action si les dossiers où seront écrits les -résultats n'existent pas ("stop" pour déclencher une erreur, "create" pour -créer les dossiers manquants).} +\item{missing_dir}{what to do if the folders where the results will be written +results do not exist ("stop" to trigger an error, "create" to +create the missing folders). +(action si les dossiers où seront écrits les + résultats n'existent pas ("stop" pour déclencher une erreur, "create" pour + créer les dossiers manquants).)} -\item{tauargus_exe}{répertoire et nom du logiciel Tau-Argus.} +\item{tauargus_exe}{directory and name of the Tau-Argus software. +(répertoire et nom du logiciel Tau-Argus.)} -\item{logbook}{nom du fichier où est enregistré le journal d'erreurs -(optionnel).} +\item{logbook}{name of the file where the error log is saved +(optional). +(nom du fichier où est enregistré le journal d'erreurs + (optionnel).)} -\item{show_batch_console}{pour afficher le déroulement du batch dans la -console.} +\item{show_batch_console}{to display the batch progress in the +console. +(pour afficher le déroulement du batch dans la + console.)} -\item{import}{pour importer dans R les fichiers produits, \code{TRUE} par -défaut.} +\item{import}{to import in R the files produced, \code{TRUE} by +default. +(pour importer dans R les fichiers produits, \code{TRUE} par + défaut.)} -\item{...}{paramètres supplémentaires pour \code{system()}.} +\item{...}{additional parameters for \code{system()}. +(paramètres supplémentaires pour \code{system()}.)} } \value{ \itemize{ - \item{une liste de data.frame contenant les résultats si - \code{import = TRUE} (via la fonction \code{\link{import}})} ; - \item{\code{NULL} sinon}. +\item{a list of data.frame containing the results if +\code{import = TRUE} (via the \code{link{import}} function)} ; +\item{\code{NULL} otherwise}. } } \description{ -Exécute les instructions contenues dans un fichier .arb pour Tau-Argus. +Executes the instructions contained in an .arb file for Tau-Argus. +(Exécute les instructions contenues dans un fichier .arb pour Tau-Argus.) } \details{ -Seul l’argument \code{arb_filename} est obligatoire, car toutes les -informations nécessaires sont présentes dans ce fichier. +Only the argument \code{arb_filename} is required, because all +necessary information is present in this file. + +This is the only function in the package that runs Tau-Argus. It +therefore requires the software to be accessible from the workstation. + +The location of the TauArgus.exe program is defined globally when the +loading the package. In fact, the argument \code{tauargus_exe} will not +normally not have to be specified (except to override the global option the +time of the execution of the function). + +Checks are made before the actual launching of Tau-Argus: +existence of the software on the computer, of the asc and rda files, of the folders where +write the results, the variables to be used (crossings, response variable) in the +response variable) in the metadata (rda file). +(Seul l’argument \code{arb_filename} est obligatoire, car toutes les +informations nécessaires sont présentes dans ce fichier. Il s'agit de la seule fonction du package qui exécute Tau-Argus. Elle nécessite donc que le logiciel soit accessible depuis le poste de travail. @@ -63,11 +92,15 @@ temps de l'exécution de la fonction). Des vérifications sont effectuées avant le lancement effectif de Tau-Argus : existence du logiciel sur le poste, des fichiers asc et rda, des dossiers où écrire les résultats, des variables à utiliser (croisements, variable de -réponse) dans les métadonnées (fichier rda). +réponse) dans les métadonnées (fichier rda).) } -\section{Voir aussi}{ - La fonction \code{\link{rtauargus}}, qui utilise cette -fonction et hérite de ses paramètres. +\section{See also}{ + + +The function \code{\link{rtauargus}}, which uses this +function and inherits its parameters. \cr +(La fonction \code{\link{rtauargus}}, qui utilise cette +fonction et hérite de ses paramètres.) } \examples{ diff --git a/man/write_hrc.Rd b/man/write_hrc.Rd index 267b2b3..249ed6c 100644 --- a/man/write_hrc.Rd +++ b/man/write_hrc.Rd @@ -15,14 +15,16 @@ write_hrc( ) } \arguments{ -\item{microdata}{[\strong{obligatoire}] data.frame contenant les -microdonnées.} +\item{microdata}{[\strong{required}] data.frame containing the microdata. \cr +([\strong{obligatoire}] data.frame contenant les microdonnées.)} \item{vars_hrc}{\strong{[obligatoire]} vecteur des noms des variables constituant la hiérarchie, du niveau le plus fin au niveau le plus agrégé.} -\item{hierleadstring}{caractère qui, répété n fois, indique que la valeur est -à n niveaux de profondeur dans la hiérarchie.} +\item{hierleadstring}{character which, repeated n times, indicates that the value is +at n levels deep in the hierarchy. \cr +(caractère qui, répété n fois, indique que la valeur est +à n niveaux de profondeur dans la hiérarchie.)} \item{hrc_filename}{nom et emplacement du fichier hrc produit. Si non renseigné, un fichier temporaire.} From b8b6595cce5afe399c5f6a0b819e9d8a590cf671 Mon Sep 17 00:00:00 2001 From: Julien Jamme Date: Tue, 26 Jul 2022 18:36:13 +0200 Subject: [PATCH 009/107] gets logbook error messages and displays them in the console --- R/run_arb.R | 55 +++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 55 insertions(+) diff --git a/R/run_arb.R b/R/run_arb.R index 23784a1..a96d515 100644 --- a/R/run_arb.R +++ b/R/run_arb.R @@ -113,6 +113,57 @@ apriori_decompose <- function(apriori_cmd) { } +#Affiche le logbook complet dans la console si verbose = TRUE, sinon que les erreurs + +display_console <- function ( + verbose = FALSE, + logbook_file = NULL +){ + + if (is.null(logbook_file)){ + stop("logbook_file not filled in ") + } + logbook<-(readLines(logbook_file)) + logbook<-unname(sapply(logbook, + function(l){ + substring(l, gregexpr(":[0-9]{2} : ", l)[[1]][1][1]+6) + })) + + logbook_df<-data.frame(logbook) + + start_batch<-(grep("Start of batch procedure", x=logbook, value=FALSE)) + + dernier_lancement<-tail(start_batch, n=1) + + dernier_logbook<-logbook_df[dernier_lancement:nrow(logbook_df),] + + + if (verbose){ + writeLines(dernier_logbook) + }else{ + + dernier_logbook_df<-data.frame(dernier_logbook) + + debut_error<-(grep("Error ", x=dernier_logbook, value=FALSE)) + debut_error<- data.frame(debut_error) + + if (!nrow(debut_error)==0){ + error <- dernier_logbook_df[debut_error[1,]:nrow(dernier_logbook_df),] + error_df<-data.frame(error) + debut_error2<-(grep("Error ", x=error, value=FALSE)) + debut_error2<- data.frame(debut_error2) + + fin_possible1<-(grep("End of TauArgus run", x=error, value=FALSE)) + fin_possible2<-(grep("<", x=error, value=FALSE)) + fin_error<-min(fin_possible1, fin_possible2) + + error_message<-error_df[debut_error2[1,]:fin_error-1,] + error_message<-error_df[debut_error2[1,]:fin_error-1,] + + writeLines(error_message) + } + } +} # Autres fonctions utiles ------------------------------------------------- @@ -209,6 +260,7 @@ run_arb <- function(arb_filename, tauargus_exe = getOption("rtauargus.tauargus_exe"), logbook = NULL, show_batch_console = getOption("rtauargus.show_batch_console"), + verbose = NULL, import = getOption("rtauargus.import"), ...) { @@ -324,6 +376,8 @@ run_arb <- function(arb_filename, '"', if (!is.null(logbook)) paste0(' "', normPath2(logbook), '"') ) + logbook_file<-paste0( normPath2(logbook)) + # appel ..................................................... @@ -332,6 +386,7 @@ run_arb <- function(arb_filename, show.output.on.console = show_batch_console, ... ) + display_console(verbose, logbook_file) if (import) import(arb_filename) else invisible(NULL) From 6fda389aa03e2609f76c517c771d19278b450e10 Mon Sep 17 00:00:00 2001 From: Julien Jamme Date: Tue, 26 Jul 2022 18:44:49 +0200 Subject: [PATCH 010/107] add verbose argument in run_arb function --- R/run_arb.R | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/R/run_arb.R b/R/run_arb.R index a96d515..5c012d9 100644 --- a/R/run_arb.R +++ b/R/run_arb.R @@ -227,6 +227,10 @@ unquote <- function(s) sub("^[\"'](.+)[\"']$", "\\1", s) #' console. #' (pour afficher le déroulement du batch dans la #' console.) +#' @param verbose boolean, to display the batch execution (if TRUE) or +#' only error messages if any (if FALSE) +#' (booléen, pour afficher l'exécution du batch (si TRUE) ou +#' uniquement les messages d'erreurs, s'il y en a (si FALSE)) #' @param import to import in R the files produced, \code{TRUE} by #' default. #' (pour importer dans R les fichiers produits, \code{TRUE} par From 223eadf505bd90f74b2cf2ad66b8200af95b536f Mon Sep 17 00:00:00 2001 From: Julien Jamme Date: Tue, 26 Jul 2022 19:01:16 +0200 Subject: [PATCH 011/107] improve doc of run_arb and tab_rda --- R/run_arb.R | 22 +++++------ R/tab_arb.R | 5 ++- R/tab_rda.R | 109 +++++++++++++++++++++++----------------------------- 3 files changed, 64 insertions(+), 72 deletions(-) diff --git a/R/run_arb.R b/R/run_arb.R index 5c012d9..16b1cf6 100644 --- a/R/run_arb.R +++ b/R/run_arb.R @@ -173,7 +173,7 @@ unquote <- function(s) sub("^[\"'](.+)[\"']$", "\\1", s) #' Runs a Tau-Argus batch #' -#' Executes the instructions contained in an .arb file for Tau-Argus. +#' Executes the instructions contained in an .arb file for Tau-Argus. \cr #' (Exécute les instructions contenues dans un fichier .arb pour Tau-Argus.) #' #' Only the argument \code{arb_filename} is required, because all @@ -190,7 +190,7 @@ unquote <- function(s) sub("^[\"'](.+)[\"']$", "\\1", s) #' Checks are made before the actual launching of Tau-Argus: #' existence of the software on the computer, of the asc and rda files, of the folders where #' write the results, the variables to be used (crossings, response variable) in the -#' response variable) in the metadata (rda file). +#' response variable) in the metadata (rda file). \cr #' #' (Seul l’argument \code{arb_filename} est obligatoire, car toutes les #' informations nécessaires sont présentes dans ce fichier. @@ -207,35 +207,35 @@ unquote <- function(s) sub("^[\"'](.+)[\"']$", "\\1", s) #' écrire les résultats, des variables à utiliser (croisements, variable de #' réponse) dans les métadonnées (fichier rda).) #' -#' @param arb_filename name of the batch file to execute. +#' @param arb_filename name of the batch file to execute. \cr #' (nom du fichier batch à exécuter.) -#' @param is_tabular boolean, if the data is already tabulated or not +#' @param is_tabular boolean, if the data is already tabulated or not \cr #' (booléen, si les données sont déja tabulées ou non) #' @param missing_dir what to do if the folders where the results will be written #' results do not exist ("stop" to trigger an error, "create" to -#' create the missing folders). +#' create the missing folders). \cr #' (action si les dossiers où seront écrits les #' résultats n'existent pas ("stop" pour déclencher une erreur, "create" pour #' créer les dossiers manquants).) -#' @param tauargus_exe directory and name of the Tau-Argus software. +#' @param tauargus_exe directory and name of the Tau-Argus software. \cr #' (répertoire et nom du logiciel Tau-Argus.) #' @param logbook name of the file where the error log is saved -#' (optional). +#' (optional). \cr #' (nom du fichier où est enregistré le journal d'erreurs #' (optionnel).) #' @param show_batch_console to display the batch progress in the -#' console. +#' console. \cr #' (pour afficher le déroulement du batch dans la #' console.) #' @param verbose boolean, to display the batch execution (if TRUE) or -#' only error messages if any (if FALSE) +#' only error messages if any (if FALSE) \cr #' (booléen, pour afficher l'exécution du batch (si TRUE) ou #' uniquement les messages d'erreurs, s'il y en a (si FALSE)) #' @param import to import in R the files produced, \code{TRUE} by -#' default. +#' default. \cr #' (pour importer dans R les fichiers produits, \code{TRUE} par #' défaut.) -#' @param ... additional parameters for \code{system()}. +#' @param ... additional parameters for \code{system()}. \cr #' (paramètres supplémentaires pour \code{system()}.) #' #' @return \itemize{ diff --git a/R/tab_arb.R b/R/tab_arb.R index fd3f4bd..dcf260e 100644 --- a/R/tab_arb.R +++ b/R/tab_arb.R @@ -222,10 +222,13 @@ apriori_batch <- function(ntab, hst_names, sep = ',', ignore_err = 0 , exp_triv #' @param gointeractive pour avoir la possibilité de lancer le batch depuis le #' menu de Tau-Argus (\code{FALSE} par défaut). #' +#' #' @return Une liste de deux éléments : le nom du fichier arb, les noms des #' fichiers en sortie (utile pour récupérer les noms générés aléatoirement). #' -#' @inheritSection tab_rda Voir aussi +#' +#' @inheritSection tab_rda See also +#' #' #' @examples #' \dontrun{ diff --git a/R/tab_rda.R b/R/tab_rda.R index b65af4b..8daef56 100644 --- a/R/tab_rda.R +++ b/R/tab_rda.R @@ -77,73 +77,57 @@ write_rda_tab <- function(info_vars) { #' nom du fichier rda (avec extension) #' @param hst_filename hst file name (with .hst extension) \cr #' nom du fichier hst (avec extension) -#' -#' @param explanatory_vars [\strong{obligatoire}] Vector of categorical variables -#' \cr -#' Variables catégorielles, sous forme de liste de vecteurs -#' +#' @param explanatory_vars [\strong{obligatoire}] Vector of categorical variables \cr +#' Variables catégorielles, sous forme de liste de vecteurs \cr #' Example : \code{list(c("A21", "TREFF", "REG")} #' table crossing \code{A21} x \code{TREFF} x \code{REG} -#' #' @param secret_var Boolean variable which give the primary secret : equal to -#' "TRUE" if a cell is concerned by the primary secret,"FALSE" otherwise. -#' \cr -#' variable indiquant le secret primaire de type booléen: +#' "TRUE" if a cell is concerned by the primary secret,"FALSE" otherwise. \cr +#' (Variable indiquant le secret primaire de type booléen: #' prend la valeur "TRUE" quand les cellules du tableau doivent être masquées -#' par le secret primaire, "FALSE" sinon. -#' +#' par le secret primaire, "FALSE" sinon.) #' @param decimals Minimum number of decimals to be displayed #' (see section 'Number of decimals') \cr -#' nombre minimal de décimales à afficher (voir section 'Nombre -#' de décimales'). -#' -#' @param hrc Informations on hierarchical variables (see section 'hierarchical -#' variable'). \cr -#' informations sur les variables hiérarchiques (voir section -#' 'Variables hiérarchiques'). -#' +#' (nombre minimal de décimales à afficher (voir section 'Number of decimals').) +#' @param hrc Informations on hierarchical variables (see section +#' 'Hierarchical variables'). \cr +#' (Informations sur les variables hiérarchiques (voir section +#' 'Hierarchical variables').)#' #' @param hierleadstring Character which, repeated n times, #' indicates that the value is at n levels of depth in the hierarchy. \cr -#' caractère qui, répété n fois, indique que la valeur est -#' à n niveaux de profondeur dans la hiérarchie. -#' +#' (Caractère qui, répété n fois, indique que la valeur est +#' à n niveaux de profondeur dans la hiérarchie.)#' #' @param totcode Code(s) which represent the total of a categorical variable #' (see section 'Specific parameters' for the syntax of this parameter). #' Variables not specified (neither by default nor explicitly) -#' will be assigned the value of \code{rtauargus.totcode}.\cr -#' code(s) pour le total d'une variable catégorielle (voir -#' section 'Paramètres spécifiques' pour la syntaxe de ce paramètre). Les +#' will be assigned the value of \code{rtauargus.totcode}. \cr +#' (Code(s) pour le total d'une variable catégorielle (voir +#' section 'Specific parameters' pour la syntaxe de ce paramètre). Les #' variables non spécifiées (ni par défaut, ni explicitement) se verront -#' attribuer la valeur de \code{rtauargus.totcode}. -#' +#' attribuer la valeur de \code{rtauargus.totcode}.)#' #' @param missing Code(s) for a missing value (see section 'Specific parameters' #' for the syntax of this parameter). \cr -#' code(s) pour une valeur manquante (voir section -#' 'Paramètres spécifiques' pour la syntaxe de ce paramètre). -#' +#' (Code(s) pour une valeur manquante (voir section +#' 'Specific parameters' pour la syntaxe de ce paramètre).) #' @param codelist file(s) containing labels of the categorical variables -#' (see section 'Specific parameters' for the syntax of this parameter).\cr -#' fichier(s) contenant les libellés des variables catégorielles -#' (voir section 'Paramètres spécifiques' pour la syntaxe de ce paramètre). -#' +#' (see section 'Specific parameters' for the syntax of this parameter). \cr +#' (Fichier(s) contenant les libellés des variables catégorielles +#' (voir section 'Specific parameters' pour la syntaxe de ce paramètre).) #' @param value Name of the column containing the value of the cells. \cr -#' nom de la colonne contenant la valeur des cellules -#' +#' (Nom de la colonne contenant la valeur des cellules) #' @param freq Name of the column containing the the numbers for a cell. \cr -#' Nom de la colonne contenant les effectifs pour une cellule -#' -#' @param maxscore Name of the column containing -#' the value of the largest contributor of a cell. \cr +#' (Nom de la colonne contenant les effectifs pour une cellule)#' +#' @param maxscore Name of the column containing, the value of the largest +#' contributor of a cell. \cr +#' (Nom de la colonne contenant la valeur du plus gros contributeur +#' d'une cellule) +#' @param separator Character used as separator in the .tab file. \cr +#' (Caractère utilisé en tant que separateur dans le fichier .tab) #' -#' Nom de la colonne contenant la valeur du plus gros contributeur -#' d'une cellule -#' -#' @param separator character used as separator in the .tab file. \cr -#' caractère utilisé en tant que separateur dans le fichier .tab #' #' @return Return the rda file name as a list (invisible).\cr -#' Renvoie le nom du fichier rda sous forme de liste (de -#' manière invisible). +#' (Renvoie le nom du fichier rda sous forme de liste (de +#' manière invisible).) #' #' #' @section Apriori file : @@ -154,7 +138,7 @@ write_rda_tab <- function(info_vars) { #' The parameter \code{secret_var} indicates the name of the primary secret variable. #' If there is the additional boolean variable which indicates the primary secret #' in the table (of tabulated data), the function tab_rda will create -#' an apriori file in a format conforming to tauargus.\cr +#' an apriori file in a format conforming to tauargus. \cr #' #' #' Le fichier d'apriori (.hst) récapitule pour chaque valeurs @@ -173,16 +157,16 @@ write_rda_tab <- function(info_vars) { #' must be given in the form of a vector indicating the value to take for each variable. #' The names of the elements of the vector give the variable concerned and #' the elements of the vector give the value of the parameter for Tau-Argus. -#' An unnamed element will be the default value.\cr +#' An unnamed element will be the default value. \cr #' -#' Les paramètres \code{totcode}, \code{missing} et \code{codelist} +#' (Les paramètres \code{totcode}, \code{missing} et \code{codelist} #' sont à renseigner sous la forme d'un vecteur indiquant la valeur à prendre #' pour chaque variable. #' #' Les noms des éléments du vecteur donnent la variable concernée, les éléments #' du vecteur donnent la valeur du paramètre pour Tau-Argus. Un élément non #' nommé constituera la valeur par défaut, qui sera attribuée à toutes les -#' variables pouvant prendre ce paramètre. +#' variables pouvant prendre ce paramètre.) #' #' For example : #' \itemize{ @@ -192,6 +176,7 @@ write_rda_tab <- function(info_vars) { #' idem, sauf pour les variables \code{size}et \code{income}} #' } #' +#' #' @section Hierarchical variables: #' #' Parameter \code{hrc} has the same syntax as \code{totcode},\code{missing} and @@ -202,10 +187,11 @@ write_rda_tab <- function(info_vars) { #' if it differs from the default option of the package). #' The path to the existing file is explicitly given. #' The elements of the vector in parameter must be named (with the name of the variable), -#' even if there is only one element -#' emph{Example :}\code{c(category="category.hrc")} +#' even if there is only one element. #' -#' Le paramètre \code{hrc} obéit aux mêmes règles de syntaxe que \code{totcode}, +#' emph{Example :}\code{c(category="category.hrc")} \cr +#' +#' (Le paramètre \code{hrc} obéit aux mêmes règles de syntaxe que \code{totcode}, #' \code{missing} et \code{codelist} (vecteur nommé contenant autant d'éléments #' que de variables à décrire). #' @@ -216,10 +202,11 @@ write_rda_tab <- function(info_vars) { #' s'il diffère de l'option par défaut du package). #' Le chemin vers le fichier existant est explicitement donné. #' Les éléments du vecteur en paramètre doivent nommés (avec le nom de la variable), -#' même s'il n'y a qu'un seul -#' élément. -#'\emph{Exemple :}\code{c(category="category.hrc")} +#' même s'il n'y a qu'un seul élément. +#' +#'\emph{Exemple :}\code{c(category="category.hrc")}) #' +#' #' @section Number of decimals: #' Parameter \code{decimals} indicates the minimum number of decimal places to #' include in the output file @@ -227,14 +214,16 @@ write_rda_tab <- function(info_vars) { #' It applies to all real variables (double) but not to integer variables. #' To add zeros to an integer variable, convert it with \code{as.double} beforehand.\cr #' -#' Le paramètre \code{decimals} indique le nombre minimal de décimales à faire +#' (Le paramètre \code{decimals} indique le nombre minimal de décimales à faire #' figurer dans le fichier en sortie (quel que soit le nombre de décimales #' effectivement présent dans \code{tabular}). Il s'applique à toutes les #' variables réelles (double) mais pas aux variables entières (integer). Pour #' ajouter des zéros à une variable entière, la convertir avec \code{as.double} -#' au préalable. +#' au préalable.) +#' +#' +#' @section See also #' -#' @section Voir aussi: #' #' @examples #' \dontrun{ From ebce7d5398373521909c1b3b5598e1024fa0d1e2 Mon Sep 17 00:00:00 2001 From: Rastout Nathanael Date: Wed, 27 Jul 2022 12:05:47 +0200 Subject: [PATCH 012/107] Suppression de l'argument missing de tab_rda --- R/tab_rda.R | 92 +++++++++++++++++++++++++++-------------------------- 1 file changed, 47 insertions(+), 45 deletions(-) diff --git a/R/tab_rda.R b/R/tab_rda.R index 8daef56..a2efae0 100644 --- a/R/tab_rda.R +++ b/R/tab_rda.R @@ -5,8 +5,7 @@ write_rda_1var_tab <- function(info_var) { ligne1 <- with(info_var, paste( - colname, - if (!is.na(missing) & missing != "") missing + colname ) ) @@ -54,7 +53,7 @@ write_rda_tab <- function(info_vars) { } -#' Create rda files from tabulated data \cr +#' Create rda files from tabular data \cr #' Crée les fichiers rda à partir de données tabulées #' #' Create an apriori file for the primary secret, @@ -86,36 +85,32 @@ write_rda_tab <- function(info_vars) { #' (Variable indiquant le secret primaire de type booléen: #' prend la valeur "TRUE" quand les cellules du tableau doivent être masquées #' par le secret primaire, "FALSE" sinon.) -#' @param decimals Minimum number of decimals to be displayed +#' @param decimals Minimum number of decimals to display #' (see section 'Number of decimals') \cr #' (nombre minimal de décimales à afficher (voir section 'Number of decimals').) -#' @param hrc Informations on hierarchical variables (see section +#' @param hrc Informations of hierarchical variables (see section #' 'Hierarchical variables'). \cr #' (Informations sur les variables hiérarchiques (voir section #' 'Hierarchical variables').)#' -#' @param hierleadstring Character which, repeated n times, -#' indicates that the value is at n levels of depth in the hierarchy. \cr +#' @param hierleadstring The character that is used to indicate the depth of a +#' code in the hierarchy. \cr #' (Caractère qui, répété n fois, indique que la valeur est #' à n niveaux de profondeur dans la hiérarchie.)#' #' @param totcode Code(s) which represent the total of a categorical variable -#' (see section 'Specific parameters' for the syntax of this parameter). -#' Variables not specified (neither by default nor explicitly) -#' will be assigned the value of \code{rtauargus.totcode}. \cr +#' (see section 'Specific parameters' for this parameter's syntax). +#' If unspecified for a variable(neither by default nor explicitly) +#' it will be set to \code{rtauargus.totcode}. \cr #' (Code(s) pour le total d'une variable catégorielle (voir #' section 'Specific parameters' pour la syntaxe de ce paramètre). Les #' variables non spécifiées (ni par défaut, ni explicitement) se verront #' attribuer la valeur de \code{rtauargus.totcode}.)#' -#' @param missing Code(s) for a missing value (see section 'Specific parameters' -#' for the syntax of this parameter). \cr -#' (Code(s) pour une valeur manquante (voir section -#' 'Specific parameters' pour la syntaxe de ce paramètre).) -#' @param codelist file(s) containing labels of the categorical variables +#' @param codelist file(s) containing labels of a categorical variables #' (see section 'Specific parameters' for the syntax of this parameter). \cr #' (Fichier(s) contenant les libellés des variables catégorielles #' (voir section 'Specific parameters' pour la syntaxe de ce paramètre).) #' @param value Name of the column containing the value of the cells. \cr #' (Nom de la colonne contenant la valeur des cellules) -#' @param freq Name of the column containing the the numbers for a cell. \cr +#' @param freq Name of the column containing the cell frequency. \cr #' (Nom de la colonne contenant les effectifs pour une cellule)#' #' @param maxscore Name of the column containing, the value of the largest #' contributor of a cell. \cr @@ -134,7 +129,7 @@ write_rda_tab <- function(info_vars) { #' #' The apriori file (.hst) summarizes for each value of the table #' if they are concerned by the primary secret or not. -#' With this file tauargus will not need to set the primary secret itself. +#' With this file tau-argus will not need to set the primary secret itself. #' The parameter \code{secret_var} indicates the name of the primary secret variable. #' If there is the additional boolean variable which indicates the primary secret #' in the table (of tabulated data), the function tab_rda will create @@ -143,7 +138,7 @@ write_rda_tab <- function(info_vars) { #' #' Le fichier d'apriori (.hst) récapitule pour chaque valeurs #' du tableau si elles sont concernées par le secret primaire ou non. -#' Avec ce fichier tauargus n'aura plus besoin de poser le secret primaire lui même, +#' Avec ce fichier tau-argus n'aura plus besoin de poser le secret primaire lui même, #' il se basera sur le fichier d'apriori pour le faire. #' Le paramètre \code{secret_var} indique le nom de la variable du secret primaire. #' Si l'on rajoute cette variable supplémentaire indiquant @@ -153,13 +148,13 @@ write_rda_tab <- function(info_vars) { #' #' @section Specific parameters: #' -#' The parameters \code{totcode}, \code{missing} and \code{codelist} +#' The parameters \code{totcode}, and \code{codelist} #' must be given in the form of a vector indicating the value to take for each variable. #' The names of the elements of the vector give the variable concerned and #' the elements of the vector give the value of the parameter for Tau-Argus. -#' An unnamed element will be the default value. \cr +#' An unnamed element will set the default value for each variable. \cr #' -#' (Les paramètres \code{totcode}, \code{missing} et \code{codelist} +#' (Les paramètres \code{totcode}, et \code{codelist} #' sont à renseigner sous la forme d'un vecteur indiquant la valeur à prendre #' pour chaque variable. #' @@ -179,7 +174,7 @@ write_rda_tab <- function(info_vars) { #' #' @section Hierarchical variables: #' -#' Parameter \code{hrc} has the same syntax as \code{totcode},\code{missing} and +#' Parameter \code{hrc} has the same syntax as \code{totcode} and #' \code{codelist} (named vector containing as many elements as variables to describe). #' Hierarchy is defined in an separate hrc file (\strong{hiercodelist}). #' which can be written with the function \code{link{write_hrc2}}. @@ -191,8 +186,8 @@ write_rda_tab <- function(info_vars) { #' #' emph{Example :}\code{c(category="category.hrc")} \cr #' -#' (Le paramètre \code{hrc} obéit aux mêmes règles de syntaxe que \code{totcode}, -#' \code{missing} et \code{codelist} (vecteur nommé contenant autant d'éléments +#' (Le paramètre \code{hrc} obéit aux mêmes règles de syntaxe que \code{totcode} +#' et \code{codelist} (vecteur nommé contenant autant d'éléments #' que de variables à décrire). #' #' La hiérarchie est définie dans un fichier hrc à part (\strong{hiercodelist}) @@ -206,7 +201,7 @@ write_rda_tab <- function(info_vars) { #' #'\emph{Exemple :}\code{c(category="category.hrc")}) #' -#' +#' #' @section Number of decimals: #' Parameter \code{decimals} indicates the minimum number of decimal places to #' include in the output file @@ -280,17 +275,18 @@ tab_rda <- function( tab_filename = NULL, rda_filename = NULL, hst_filename = NULL, - explanatory_vars=NULL, + explanatory_vars = NULL, secret_var=NULL, decimals = getOption("rtauargus.decimals"), hrc = NULL, hierleadstring = getOption("rtauargus.hierleadstring"), totcode = getOption("rtauargus.totcode"), - missing = getOption("rtauargus.missing"), codelist = NULL, value = NULL, freq = NULL, maxscore = NULL, + maxscore_2 = NULL, + maxscore_3 = NULL, separator = "," ) { @@ -305,7 +301,6 @@ tab_rda <- function( hierleadstring <- op.rtauargus$rtauargus.hierleadstring } if (is.null(totcode)) totcode <- op.rtauargus$rtauargus.totcode - if (is.null(missing)) missing <- op.rtauargus$rtauargus.missing if (!is.null(secret_var)){ @@ -329,34 +324,34 @@ tab_rda <- function( if (is.null(hst_filename)) hst_filename <- "apriori.hst" #Gestion du chemin des fichiers - name_rda<-basename(rda_filename) - directory_rda<-stringr::str_replace(rda_filename, pattern = name_rda, replacement="") + name_rda <- basename(rda_filename) + directory_rda <- stringr::str_replace(rda_filename, pattern = name_rda, replacement="") if(!(dir.exists(directory_rda))) - {dir.create(directory_rda, recursive = TRUE)} + {dir.create(directory_rda, recursive = TRUE)} - name_tab<-basename(tab_filename) - directory_tab<-stringr::str_replace(tab_filename, pattern = name_tab, replacement="") + name_tab <- basename(tab_filename) + directory_tab <- stringr::str_replace(tab_filename, pattern = name_tab, replacement="") if(!(dir.exists(directory_tab))) - {dir.create(directory_tab, recursive = TRUE)} + {dir.create(directory_tab, recursive = TRUE)} - name_hst<-basename(hst_filename) - directory_hst<-stringr::str_replace(hst_filename, pattern = name_hst, replacement="") + name_hst <- basename(hst_filename) + directory_hst <- stringr::str_replace(hst_filename, pattern = name_hst, replacement="") if(!(dir.exists(directory_hst))) - {dir.create(directory_hst, recursive = TRUE)} + {dir.create(directory_hst, recursive = TRUE)} #Controles sur secret_var - if (is.null(secret_var)) message("secret_var is NULL : no apriori file will be used") + if (is.null(secret_var)) message("secret_var is NULL : no apriori file will be provided") if ((!is.null(secret_var)) && (!secret_var %in% colnames(tabular))) - {stop("secret_var does not exist in tabular")} + {stop("secret_var does not exist in tabular")} if((!is.null(secret_var)) && (any(!is.na(tabular[[secret_var]]))) && (!is.logical(tabular[[secret_var]]))) - {stop("unexpected type : secret_var must be a boolean variable")} + {stop("unexpected type : secret_var must be a boolean variable")} if((!is.null(secret_var)) && any(is.na(tabular[[secret_var]]))) - {stop("NAs in secret_var are not allowed")} + {stop("NAs in secret_var are not allowed")} #Genere le fichier hst @@ -369,7 +364,7 @@ tab_rda <- function( c(explanatory_vars[(explanatory_vars %in% colnames(tabular))], secret_var) ] - if (nrow(hst)==0) message("no values are concerned by the primary secret : hst file is empty") + if (nrow(hst)==0) message("no cells are unsafe : hst file is empty") write.table( hst, @@ -421,11 +416,18 @@ tab_rda <- function( fwf_info_tabular$type_var[fwf_info_tabular$colname == maxscore] <- "MAXSCORE" } - # missing, totcode, codelist ........................................ + if (!is.null(maxscore_2)) { + fwf_info_tabular$type_var[fwf_info_tabular$colname == maxscore_2] <- "MAXSCORE" + } + + if (!is.null(maxscore_3)) { + fwf_info_tabular$type_var[fwf_info_tabular$colname == maxscore_3] <- "MAXSCORE" + } + + # totcode, codelist ........................................ var_quanti <- names(tabular)[!num] - missing_df <- df_param_defaut(names(tabular), "missing", missing) codelist_df <- df_param_defaut(var_quanti, "codelist", codelist) totcode_df <- df_param_defaut(var_quanti, "totcode", totcode) %>% @@ -454,7 +456,7 @@ tab_rda <- function( fwf_info_tabular <- purrr::reduce( - list(fwf_info_tabular, missing_df, totcode_df, codelist_df, hrc_df), + list(fwf_info_tabular, totcode_df, codelist_df, hrc_df), merge, by = "colname", all.x = TRUE From 51b767220cc49fae727882676aa5a6d0bb27756c Mon Sep 17 00:00:00 2001 From: Rastout Nathanael Date: Thu, 28 Jul 2022 16:48:48 +0200 Subject: [PATCH 013/107] Suppression du poids --- R/tab_rda.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/tab_rda.R b/R/tab_rda.R index a2efae0..8b4490d 100644 --- a/R/tab_rda.R +++ b/R/tab_rda.R @@ -27,7 +27,7 @@ write_rda_1var_tab <- function(info_var) { paste0(" \"", hierleadstring, "\""), if (!is.na(hierarchical) && grepl("^(\\d+ +)+\\d+$", hierarchical)) paste0(" ", hierarchical), - if (type_var %in% c("NUMERIC", "WEIGHT","MAXSCORE")) + if (type_var %in% c("NUMERIC","MAXSCORE")) paste0(" ", digits) ) ) From 7721c5309dedbe0cf0e9feb8fc9029a918d66bd6 Mon Sep 17 00:00:00 2001 From: Rastout Nathanael Date: Tue, 9 Aug 2022 10:41:27 +0200 Subject: [PATCH 014/107] Message d'erreur tab_arb et tab_rda ajout de cost_var --- R/tab_arb.R | 162 +++++++++++++++++++++------------------------------- R/tab_rda.R | 111 +++++++++++++++++++++++++++-------- 2 files changed, 154 insertions(+), 119 deletions(-) diff --git a/R/tab_arb.R b/R/tab_arb.R index dcf260e..5f16f8b 100644 --- a/R/tab_arb.R +++ b/R/tab_arb.R @@ -9,11 +9,11 @@ specify_tables_one_tab <- function(expl, resp, shad, cost) { # Genere partie SPECIFYTABLE et SAFETYRULE specif_safety_tab <- function(explanatory_vars, - response_var, - shadow_var, - cost_var, - safety_rules - ) { + response_var, + shadow_var, + cost_var, + safety_rules +) { specify_tables <- mapply( @@ -39,26 +39,13 @@ specif_safety_tab <- function(explanatory_vars, # Genere partie SUPPRESS et WRITETABLE suppr_writetable_tab <- function(suppress, - linked, - output_names, - output_type, - output_options) { + output_names, + output_type, + output_options) { # numero table num_table <- seq_along(output_names) - if (linked & length(suppress) > 1) { - stop("un seul suppress permis quand linked = TRUE") - } - - # methode suppr - if (length(suppress) == 1) { - if (linked) suppr_n <- 0 else suppr_n <- num_table - suppress <- gsub(" ", "", suppress) # supprime tout espace - suppress_fmt <- sub("\\([^),]+(,*.*)\\)", "(%i\\1)", suppress) - suppress <- sprintf(suppress_fmt, suppr_n) - } - # chemin complet sorties output_names <- normPath2(output_names) @@ -73,14 +60,8 @@ suppr_writetable_tab <- function(suppress, output_names, '")' ) - if (linked) { - c( - suppr_cmd, - mapply(paste, write_cmd, sep = "\n", USE.NAMES = FALSE) - ) - } else { - mapply(paste, suppr_cmd, write_cmd, sep = "\n", USE.NAMES = FALSE) - } + mapply(paste, suppr_cmd, write_cmd, sep = "\n", USE.NAMES = FALSE) + } @@ -134,44 +115,38 @@ apriori_batch <- function(ntab, hst_names, sep = ',', ignore_err = 0 , exp_triv # Exportée ---------------------------------------------------------------- -#' Crée un fichier batch (.arb) pour données tabulées -#' -#' Crée un fichier batch pour données tabulées, exécutable par Tau-Argus en ligne de -#' commande. +#' Create batch file (.arb) for tabular data in order to run Tau Argus +#' Crée un fichier batch (.arb) pour données tabulées exécutable par +#' Tau-Argus en ligne de commande. #' +#' Function doesn't check if the asc and rda files exists #' La fonction ne vérifie pas si les fichiers asc et rda existent. #' #' @section Syntaxe: -#' Tau-Argus peut traiter plusieurs tabulations pour un même jeu de -#' données. Passer une seule valeur pour une option appliquera le même -#' traitement à chaque tabulation. Pour des options différenciées, passer un -#' vecteur contenant autant de valeurs que de tabulations. Si les longueurs ne -#' correspondent pas (déconseillé), un recyclage est effectué. #' +#' For tabular data, the function secure one table +#' Pour les données tabulées la fonction traite un tableau à la fois +#' +#' Unless specific details, use syntaxe from Tau-Argus manual #' Sauf mention contraire, utiliser la syntaxe mentionnée dans la documentation #' de Tau-Argus. #' -#' Syntaxe spéciale pour \code{suppress} : le premier paramètre dans la -#' syntaxe Tau-Argus est le numéro de la tabulation. Si la méthode est identique -#' pour toutes les tabulations, ce premier paramètre sera ignoré et les numéros -#' recalculés automatiquement pour le batch. Dans l'écriture -#' \code{suppress = "GH(n,100)"}, n sera ainsi transformé en 1 pour la première -#' tabulation, en 2 pour la deuxième tabulation, etc. +#' Syntaxe spéciale pour \code{suppress} : +#' First parameter is the table number, in this case it will always be 1 +#' le premier paramètre dans la syntaxe Tau-Argus est le numéro de la tabulation. +#' Dans le cas de cette fonction ce sera toujours 1 #' -#' @section Identifiants des tableaux: -#' Si la liste \code{explanatory_vars} comporte des noms, ceux-ci seront -#' utilisés dans le batch pour donner un identifiant au tableau, sous la forme -#' d'une ligne de commentaire (\code{// "..."}). Ils seront -#' réutilisés par la fonction \code{import} pour nommer les tableaux formats R -#' en sortie. #' -#' @section Informations \emph{a priori}: -#' Il est possible de fournir un fichier a priori (.hst) pour chaque tabulation. +#' @section Informations \emph{apriori}: +#' It's possible to add an apriori file (.hst) for a tabular, it can be generated +#' by the table_rda() function +#' Il est possible de fournir un fichier apriori (.hst) pour chaque tabulation, +#' il peut être fourni par la fonction table_rda() #' -#' La manière la plus simple est de passer un vecteur contenant autant de noms de -#' fichiers hst que de tabulations. Si le fichier est le même pour toutes les -#' tabulations, spécifier le nom de ce fichier (il sera utilisé pour toutes les -#' tabulations). +#' Other options are not mandatory. To modify default value use a vector with the +#' .hst file path as first element and then complete with those parameters : +#' \code{sep} for the separator, +#' \code{ignore_err} for IgnoreError and \code{exp_triv} for ExpandTrivial. #' #' Les options supplémentaires sont facultatives. Pour modifier les valeurs par #' défaut, passer une liste ayant comme premier élément le(s) fichier(s) hst et @@ -180,21 +155,22 @@ apriori_batch <- function(ntab, hst_names, sep = ',', ignore_err = 0 , exp_triv #' Comme pour les noms de fichiers, spécifier une seule valeur par paramètre ou #' autant de valeurs que de tabulations. #' -#' @param arb_filename nom du fichier arb généré (avec -#' extension). Si non renseigné, un fichier temporaire. -#' @param tab_filename [\strong{obligatoire}] nom du fichier .tab (avec extension). +#' @param arb_filename path of the arb filename, if unspecified, creates a temporary +#' file +#' nom du fichier arb généré (avec extension). Si non renseigné, un fichier temporaire. +#' @param tab_filename [\strong{obligatoire}] path of the tab_filename, mandatory +#' nom du fichier .tab (avec extension). #' @inheritParams tab_rda -#' @param explanatory_vars [\strong{obligatoire}] variables catégorielles, sous -#' forme de liste de vecteurs. Chaque élément de la liste est un vecteur des -#' noms des variables formant une tabulation. -#' Exemple : \code{list(c("CJ", "A21"), c("SEXE", "REGION"))} pour le premier -#' tableau croisant \code{CJ} x \code{A21} et le deuxième tableau croisant -#' \code{SEXE} x \code{REGION}. -#' Si une seule tabulation, un simple vecteur des variables à croiser est -#' accepté (pas besoin de \code{list(...)}). -#' @param response_var variable de réponse à sommer, ou comptage si -#' \code{""}. Une seule valeur ou autant de valeurs que de tabulations. -#' @param shadow_var variable(s) pour l'application du secret primaire. Si non +#' @param explanatory_vars [\strong{obligatoire}] explanatory vars in a vector +#' variables catégorielles, sous forme de vecteur. +#' Example : \code{c("CJ", "A21")} for the tabular \code{CJ} x \code{A21} +#' Exemple : \code{c("CJ", "A21")} pour le premier +#' tableau croisant \code{CJ} x \code{A21} +#' @param response_var response variable name in the tabular +#' \code{""}. Une seule valeur. +#' @param shadow_var variable for primary secret. If unspecified, \code{response_var} +#' will be used by Tau Argus +#' variable(s) pour l'application du secret primaire. Si non #' renseigné, \code{response_var} sera utilisé par Tau-Argus. #' @param cost_var variable(s) de coût pour le secret secondaire. #' @param safety_rules [\strong{obligatoire}] règle(s) de secret primaire. @@ -205,9 +181,6 @@ apriori_batch <- function(ntab, hst_names, sep = ',', ignore_err = 0 , exp_triv #' secondaire (syntaxe batch de Tau-Argus). Si la méthode est la même pour #' chaque tabulation, le premier paramètre (numéro du tableau) sera ignoré et #' renuméroté automatiquement (voir la section 'Syntaxe'). -#' @param linked pour traiter le secret secondaire conjointement sur toutes les -#' tabulations. Une seule commande suppress autorisée dans ce cas (appliquée à -#' tous les tableaux). #' @param output_names noms des fichiers en sortie. Si renseigné, #' obligatoirement autant de noms de fichiers que de tabulations. Si laissé #' vide, autant de noms de fichiers temporaires que de tabulations seront @@ -232,42 +205,40 @@ apriori_batch <- function(ntab, hst_names, sep = ',', ignore_err = 0 , exp_triv #' #' @examples #' \dontrun{ -#' # creation fichier arb +#' # creating arb file #' infos_arb <- tab_arb( #' tab_filename = "donnees.tab", -#' explanatory_vars = list(c("REGION", "CJ"), c("REGION")), +#' explanatory_vars = c("REGION", "CJ"), #' response_var = c("CA", ""), -#' safety_rules = c("NK(1,85)|FREQ(3,10)", "FREQ(3,10)"), -#' suppress = "GH(.,100)", -#' output_names = c("tab1.csv", "~/tab2.csv"), -#' output_options = c("AS+SE+", "SE+"), +#' safety_rules = c("NK(1,85)|FREQ(3,10)"), +#' suppress = "GH(1,100)", +#' output_names = c("tab1.csv"), +#' output_options = "AS+SE+", #' output_type = "2" #' ) -#' +#' # show the content of the file in console #' # visualisation du contenu du fichier dans la console #' file.show(infos_arb$arb_filename, pager = "console") #' } #' @export tab_arb <- function(arb_filename = NULL, - tab_filename, - rda_filename = NULL, - explanatory_vars, - response_var = getOption("rtauargus.response_var"), - shadow_var = NULL, - cost_var = NULL, - safety_rules, - suppress, - linked = getOption("rtauargus.linked"), - output_names = NULL, - output_type = getOption("rtauargus.output_type"), - output_options = getOption("rtauargus.output_options"), - apriori = NULL, - gointeractive = FALSE) { + tab_filename, + rda_filename = NULL, + explanatory_vars, + response_var = getOption("rtauargus.response_var"), + shadow_var = NULL, + cost_var = NULL, + safety_rules, + suppress, + output_names = NULL, + output_type = getOption("rtauargus.output_type"), + output_options = getOption("rtauargus.output_options"), + apriori = NULL, + gointeractive = FALSE) { # valeur par défaut du package si option vide if (is.null(response_var)) response_var <- op.rtauargus$rtauargus.response_var - if (is.null(linked)) linked <- op.rtauargus$rtauargus.linked if (is.null(output_type)) output_type <- op.rtauargus$rtauargus.output_type if (is.null(output_options)) { output_options <- op.rtauargus$rtauargus.output_options @@ -360,7 +331,6 @@ tab_arb <- function(arb_filename = NULL, sw <- suppr_writetable_tab( suppress, - linked, output_names, output_type, output_options diff --git a/R/tab_rda.R b/R/tab_rda.R index 8b4490d..e44f3bc 100644 --- a/R/tab_rda.R +++ b/R/tab_rda.R @@ -271,23 +271,24 @@ write_rda_tab <- function(info_vars) { #' @export tab_rda <- function( - tabular, - tab_filename = NULL, - rda_filename = NULL, - hst_filename = NULL, - explanatory_vars = NULL, - secret_var=NULL, - decimals = getOption("rtauargus.decimals"), - hrc = NULL, - hierleadstring = getOption("rtauargus.hierleadstring"), - totcode = getOption("rtauargus.totcode"), - codelist = NULL, - value = NULL, - freq = NULL, - maxscore = NULL, - maxscore_2 = NULL, - maxscore_3 = NULL, - separator = "," + tabular, + tab_filename = NULL, + rda_filename = NULL, + hst_filename = NULL, + explanatory_vars = NULL, + secret_var = NULL, + cost_var = NULL, + decimals = getOption("rtauargus.decimals"), + hrc = NULL, + hierleadstring = getOption("rtauargus.hierleadstring"), + totcode = getOption("rtauargus.totcode"), + codelist = NULL, + value = NULL, + freq = NULL, + maxscore = NULL, + maxscore_2 = NULL, + maxscore_3 = NULL, + separator = "," ) { @@ -338,13 +339,33 @@ tab_rda <- function( directory_hst <- stringr::str_replace(hst_filename, pattern = name_hst, replacement="") if(!(dir.exists(directory_hst))) {dir.create(directory_hst, recursive = TRUE)} + # Controle sur le nombre de colonnes + col_tabular <- c(explanatory_vars, + secret_var, + cost_var, + value, + freq, + maxscore, + maxscore_2, + maxscore_3) + + if (length(tabular[1,]) != length(col_tabular)) + {warning("unspecified columns in table")} + # Controle hrc + if(!all(names(hrc) %in% explanatory_vars)) + {stop(" error with label of the hierarchichal variable")} + + # Controle sur frequency + + if (any(tabular[[freq]] != round(tabular[[freq]],0))) + {stop("decimals are not allowed for frequency")} #Controles sur secret_var - if (is.null(secret_var)) message("secret_var is NULL : no apriori file will be provided") + if (is.null(secret_var) && is.null(cost_var)) message("secret_var and cost_var are NULL : no apriori file will be provided") - if ((!is.null(secret_var)) && (!secret_var %in% colnames(tabular))) + if ((!is.null(secret_var)) && (!secret_var %in% colnames(tabular))) {stop("secret_var does not exist in tabular")} if((!is.null(secret_var)) && (any(!is.na(tabular[[secret_var]]))) && (!is.logical(tabular[[secret_var]]))) @@ -353,17 +374,61 @@ tab_rda <- function( if((!is.null(secret_var)) && any(is.na(tabular[[secret_var]]))) {stop("NAs in secret_var are not allowed")} + # Controles sur cost_var - #Genere le fichier hst + if ((!is.null(cost_var)) && (!cost_var %in% colnames(tabular))) + {stop("cost_var_var does not exist in tabular")} + + if((!is.null(cost_var)) && (!is.numeric(tabular[[cost_var]]))) + {stop("unexpected type : secret_var must be a numeric variable")} + + #Genere le fichier hst lié au secret primaire if((!is.null(secret_var)) && (is.logical(tabular[[secret_var]]))) { tabular[secret_var]<-ifelse(tabular[[secret_var]],"u","s") - hst=tabular[ + hst_secret_prim=tabular[ tabular[secret_var]=="u", c(explanatory_vars[(explanatory_vars %in% colnames(tabular))], secret_var) ] + } + + #Genere le fichier hst lié au coût + + if ((!is.null(cost_var)) && (is.numeric(tabular[[cost_var]]))&& + (!is.null(secret_var))){ + tabular[cost_var]<-ifelse(!is.na(tabular[[cost_var]] && tabular[[secret_var]] == "s"), + paste0("c,",tabular[[cost_var]]),"no_cost") + + hst_cost=tabular[ + tabular[cost_var]!="no_cost", + c(explanatory_vars[(explanatory_vars %in% colnames(tabular))], cost_var) + ] + } + + if ((!is.null(cost_var)) && (is.numeric(tabular[[cost_var]]))&& + (is.null(secret_var))){ + tabular[cost_var]<-ifelse(!is.na(tabular[[cost_var]]), + paste0("c,",tabular[[cost_var]]),"no_cost") + hst_cost=tabular[ + tabular[cost_var]!="no_cost", + c(explanatory_vars[(explanatory_vars %in% colnames(tabular))], cost_var) + ] + } + + + if(!is.null(cost_var) && !is.null(secret_var)){ + hst <- rbind(hst_secret_prim,hst_cost) + } + else if (is.null(cost_var) && !is.null(secret_var)){ + hst <- hst_secret_prim + } + else if (!is.null(cost_var) && is.null(secret_var)){ + hst <- hst_cost + } + + if(!is.null(cost_var) | !is.null(secret_var)) { if (nrow(hst)==0) message("no cells are unsafe : hst file is empty") write.table( @@ -376,11 +441,11 @@ tab_rda <- function( ) } - - # genere fichier longueur fixe (le fichier .tab) dans le dossier indiqué et infos associees ..................... if (!is.null(secret_var)) tabular<-tabular[,!names(tabular)==secret_var] + if (!is.null(cost_var)) tabular<-tabular[,!names(tabular)==cost_var] + fwf_info_tabular <- gdata::write.fwf( From e430346d28462f4265a278ad93b012996abb85ce Mon Sep 17 00:00:00 2001 From: julienjamme Date: Tue, 9 Aug 2022 11:02:48 +0200 Subject: [PATCH 015/107] news updated --- NEWS.md | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/NEWS.md b/NEWS.md index f307d14..4ee6b47 100644 --- a/NEWS.md +++ b/NEWS.md @@ -3,6 +3,12 @@ title: Package ‘rtauargus’ subtitle: Historique des modifications output: rmarkdown::html_vignette --- +## rtauargus 1.0.0 + +[01/09/2022] + +* English documentation +* **tab_arb()** : arument *value* is now called *response_var* as in the **tab_rda()** function. ## rtauargus 0.5.0 From 2d22a0beb8e3a9f8f459ea8ec2bdae8b845655d7 Mon Sep 17 00:00:00 2001 From: Rastout Nathanael Date: Tue, 9 Aug 2022 11:06:27 +0200 Subject: [PATCH 016/107] Specification des changements tab_arb --- NEWS.md | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index 4ee6b47..3d50b2c 100644 --- a/NEWS.md +++ b/NEWS.md @@ -8,7 +8,8 @@ output: rmarkdown::html_vignette [01/09/2022] * English documentation -* **tab_arb()** : arument *value* is now called *response_var* as in the **tab_rda()** function. +* **tab_arb()** : argument *value* is now called *response_var* as in the **tab_rda()** function. +* **tab_arb()** : argument *apriori* is now called *hst_filename* as in the **tab_rda()** function. ## rtauargus 0.5.0 From 093e454de74b65ebe6e22fb312a4f91dde733d96 Mon Sep 17 00:00:00 2001 From: Rastout Nathanael Date: Tue, 9 Aug 2022 15:48:02 +0200 Subject: [PATCH 017/107] Epurement de tab_arb et renommage de certaines variables --- R/tab_arb.R | 109 +++++++++++++--------------------------------------- R/tab_rda.R | 2 +- 2 files changed, 27 insertions(+), 84 deletions(-) diff --git a/R/tab_arb.R b/R/tab_arb.R index 5f16f8b..05e93c2 100644 --- a/R/tab_arb.R +++ b/R/tab_arb.R @@ -1,51 +1,20 @@ -specify_tables_one_tab <- function(expl, resp, shad, cost) { - paste0( +specify_tables_one_tab <- function(expl, resp, safety_rules) { + specif_table <- paste0( paste(cite(expl), collapse = ""), '|', - cite(resp), '|', - cite(shad), '|', - cite(cost) + cite(resp), '||' ) -} - -# Genere partie SPECIFYTABLE et SAFETYRULE -specif_safety_tab <- function(explanatory_vars, - response_var, - shadow_var, - cost_var, - safety_rules -) { - - specify_tables <- - mapply( - specify_tables_one_tab, - explanatory_vars, - response_var, - shadow_var, - cost_var - ) - - specify_tables <- paste("", specify_tables) - - if (!is.null(names(explanatory_vars))) { - table_ids <- sprintf('// "%s"', names(explanatory_vars)) - specify_tables <- paste(table_ids, specify_tables, sep = "\n") - } - + specif_table <- paste("", specif_table) safety_rules <- paste("", safety_rules) - - mapply(paste, specify_tables,safety_rules, sep = "\n", USE.NAMES = FALSE) - + paste(specif_table,safety_rules, sep = "\n") } + # Genere partie SUPPRESS et WRITETABLE suppr_writetable_tab <- function(suppress, output_names, output_type, output_options) { - # numero table - num_table <- seq_along(output_names) - # chemin complet sorties output_names <- normPath2(output_names) @@ -54,19 +23,18 @@ suppr_writetable_tab <- function(suppress, write_cmd <- paste0( ' (', - num_table, ',', + 1, ',', output_type, ',', output_options, ',"', output_names, '")' ) - mapply(paste, suppr_cmd, write_cmd, sep = "\n", USE.NAMES = FALSE) + paste (suppr_cmd, write_cmd, sep = "\n") } - # Paramètre a priori ------------------------------------------------------ # Normalise parametre "apriori" pour le faire passer dans la @@ -94,17 +62,12 @@ norm_apriori_params_tab <- function(params) { # Génère s -apriori_batch <- function(ntab, hst_names, sep = ',', ignore_err = 0 , exp_triv = 0) { - - # verif pour éviter recyclage qd longueurs args > 1 ne correspondent pas - n <- lengths(list(hst_names, sep, ignore_err, exp_triv)) - if (any(ntab > 1 & n > 1 & n != ntab)) stop("longueur arguments") - if (any(ntab == 1 & n != 1)) stop("longueur arguments") +apriori_batch <- function(hst_names, sep = ',', ignore_err = 0 , exp_triv = 0) { paste0( ' "', normPath2(hst_names), '",', - seq(ntab), ',"', + 1, ',"', sep, '",', ignore_err, ',', exp_triv @@ -137,7 +100,7 @@ apriori_batch <- function(ntab, hst_names, sep = ',', ignore_err = 0 , exp_triv #' Dans le cas de cette fonction ce sera toujours 1 #' #' -#' @section Informations \emph{apriori}: +#' @section Informations \emph{hst}: #' It's possible to add an apriori file (.hst) for a tabular, it can be generated #' by the table_rda() function #' Il est possible de fournir un fichier apriori (.hst) pour chaque tabulation, @@ -166,13 +129,8 @@ apriori_batch <- function(ntab, hst_names, sep = ',', ignore_err = 0 , exp_triv #' Example : \code{c("CJ", "A21")} for the tabular \code{CJ} x \code{A21} #' Exemple : \code{c("CJ", "A21")} pour le premier #' tableau croisant \code{CJ} x \code{A21} -#' @param response_var response variable name in the tabular +#' @param value response variable name in the tabular #' \code{""}. Une seule valeur. -#' @param shadow_var variable for primary secret. If unspecified, \code{response_var} -#' will be used by Tau Argus -#' variable(s) pour l'application du secret primaire. Si non -#' renseigné, \code{response_var} sera utilisé par Tau-Argus. -#' @param cost_var variable(s) de coût pour le secret secondaire. #' @param safety_rules [\strong{obligatoire}] règle(s) de secret primaire. #' Chaîne de caractères en syntaxe batch Tau-Argus. La pondération est traitée #' dans un paramètre à part (ne pas spécifier WGT ici, utiliser le paramètre @@ -190,7 +148,7 @@ apriori_batch <- function(ntab, hst_names, sep = ',', ignore_err = 0 , exp_triv #' @param output_options options supplémentaires des fichiers en sortie. Valeur #' par défaut du package : \code{"AS+"} (affichage du statut). Pour ne #' spécifier aucune option, \code{""}. -#' @param apriori fichier(s) d'informations \emph{a priori}. Voir ci-dessous +#' @param hst fichier(s) d'informations \emph{a priori}. Voir ci-dessous #' pour la syntaxe. #' @param gointeractive pour avoir la possibilité de lancer le batch depuis le #' menu de Tau-Argus (\code{FALSE} par défaut). @@ -209,7 +167,7 @@ apriori_batch <- function(ntab, hst_names, sep = ',', ignore_err = 0 , exp_triv #' infos_arb <- tab_arb( #' tab_filename = "donnees.tab", #' explanatory_vars = c("REGION", "CJ"), -#' response_var = c("CA", ""), +#' value = c("CA", ""), #' safety_rules = c("NK(1,85)|FREQ(3,10)"), #' suppress = "GH(1,100)", #' output_names = c("tab1.csv"), @@ -225,61 +183,49 @@ apriori_batch <- function(ntab, hst_names, sep = ',', ignore_err = 0 , exp_triv tab_arb <- function(arb_filename = NULL, tab_filename, rda_filename = NULL, + hst_filename = NULL, explanatory_vars, - response_var = getOption("rtauargus.response_var"), - shadow_var = NULL, - cost_var = NULL, + value = getOption("rtauargus.response_var"), safety_rules, suppress, output_names = NULL, output_type = getOption("rtauargus.output_type"), output_options = getOption("rtauargus.output_options"), - apriori = NULL, gointeractive = FALSE) { # valeur par défaut du package si option vide - if (is.null(response_var)) response_var <- op.rtauargus$rtauargus.response_var + if (is.null(value)) value <- op.rtauargus$rtauargus.value if (is.null(output_type)) output_type <- op.rtauargus$rtauargus.output_type if (is.null(output_options)) { output_options <- op.rtauargus$rtauargus.output_options } - # si une seule tabulation, vecteur autorisé - if (is.atomic(explanatory_vars)) explanatory_vars <- list(explanatory_vars) - nb_tabul <- length(explanatory_vars) - # parametres non renseignés if (is.null(arb_filename)) arb_filename <- tempfile("RTA_", fileext = ".arb") if (is.null(rda_filename)) rda_filename <- sub("tab$", "rda", tab_filename) - if (is.null(shadow_var)) shadow_var <- "" - if (is.null(cost_var)) cost_var <- "" if (is.null(output_names)) { if (length(output_type) == 1) { - ext <- rep(output_extensions[output_type], nb_tabul) + ext <- output_extensions[output_type] } else { - stopifnot(length(output_type) == nb_tabul) + stopifnot(length(output_type) == 1) ext <- output_extensions[output_type] } output_names <- tempfile("RTA_", fileext = ext) } if (is.null(output_options)) output_options <- "" - # correspondance nombre tab et nombre fichiers sortie - if (length(explanatory_vars) != length(output_names)) { - stop("renseigner autant de noms de fichiers que de tabulations") - } # interdit 'WGT' dans safety_rules if (length(grep("WGT", safety_rules, ignore.case = TRUE))) { stop( - "Le poids est applique a la creation de la table', " + "Weight need to be used when the table is created', " ) } # output_names doivent comporter une extension de fichier # (sinon Tau-Argus plante) if (!all(grepl("\\.", basename(output_names)))) { - stop("output_names doivent comporter une extension de fichier") + stop("output_names needs to specify the type of file expected") } # chemins absolus @@ -298,11 +244,9 @@ tab_arb <- function(arb_filename = NULL, # tabulations + secret primaire tab_sp <- - specif_safety_tab( - explanatory_vars = explanatory_vars, - response_var = response_var, - shadow_var = shadow_var, - cost_var = cost_var, + specify_tables_one_tab( + expl = explanatory_vars, + res = value, safety_rules = safety_rules ) res <- c(res, tab_sp) @@ -311,12 +255,11 @@ tab_arb <- function(arb_filename = NULL, res <- c(res, " 1") # apriori (doit figurer avant suppress) - if (!is.null(apriori)) { + if (!is.null(hst_filename)) { - std_apriori <- norm_apriori_params_tab(apriori) + std_apriori <- norm_apriori_params_tab(hst_filename) ap_batch <- apriori_batch( - ntab = length(explanatory_vars), hst_names = std_apriori[[1]], sep = std_apriori$sep, ignore_err = std_apriori$ignore_err, diff --git a/R/tab_rda.R b/R/tab_rda.R index e44f3bc..f155cc0 100644 --- a/R/tab_rda.R +++ b/R/tab_rda.R @@ -428,7 +428,7 @@ tab_rda <- function( hst <- hst_cost } - if(!is.null(cost_var) | !is.null(secret_var)) { + if( !is.null(secret_var)) { if (nrow(hst)==0) message("no cells are unsafe : hst file is empty") write.table( From 8a748d82d71c39b3ebca76408964dd846233b314 Mon Sep 17 00:00:00 2001 From: julienjamme Date: Tue, 9 Aug 2022 15:49:10 +0200 Subject: [PATCH 018/107] fixes write_hrc2 --- R/writehrc.R | 98 ++++++++++++++++++++++++++++++++++------------------ 1 file changed, 65 insertions(+), 33 deletions(-) diff --git a/R/writehrc.R b/R/writehrc.R index fc1a64d..c481cb6 100644 --- a/R/writehrc.R +++ b/R/writehrc.R @@ -197,8 +197,6 @@ #' \cr #' Chemin vers le fichier .hrc. #' -#' @export -#' #' @examples #' # 1. Standard example. Table will be written on your working directory. #' # Exemple standard. La table sera écrite dans votre répertoire de travail. @@ -272,7 +270,8 @@ #' ) #' path <- write_hrc2(astral_repeat, hier_lead_string = "@") #' read.table(path) - +#' @importFrom zoo na.locf +#' @export write_hrc2 <- function(corr_table, output_name = NULL, @@ -282,13 +281,21 @@ write_hrc2 <- function(corr_table, hier_lead_string = getOption("rtauargus.hierleadstring") ){ + if(! any(class(corr_table) %in% c("data.frame","matrix"))){ + class_corr <- class(corr_table) + stop(paste0("corr_table has to be a data frame or a matrix, not ", class_corr)) + } # Set default filename / directory if (is.null(output_name)) { givenfilename <- deparse(substitute(corr_table)) output_name <- givenfilename } - dir_name <- if(is.null(dir_name) | dir_name == "") getwd() else dir_name + if(is.null(dir_name) | dir_name == ""){ + dir_name <- getwd() + }else if(! dir.exists(dir_name)){ + stop(paste0("directory ", dir_name, " doesn't exist.")) + } d = dim.data.frame(corr_table) @@ -313,10 +320,20 @@ write_hrc2 <- function(corr_table, stop("hier_lead_string should be 1 single character") } - # Warn about presence of NAs - if (sum(is.na(corr_table))>0){ - warning("Missing values in correspondence table will be ignored (see documentation). + + # Error if presence of NAs on the last column + if(sum(is.na(corr_table[[d[2]]]))>0){ + stop( + "Missing values on the last column of the correspondence table is not allowed. If relevant, you could fill in with the value of the previous column" + ) + } + + # Warn about presence of NAs elsewhere + if(sum(is.na(corr_table))>0){ + + warning("Missing values in correspondence table will be filled in (see documentation). If unintended, this can cause errors when using the .hrc file with tau-Argus.") + corr_table <- zoo::na.locf(corr_table) } # (Todo : lister cas de NA non gênantes et bloquer les autres) @@ -327,13 +344,14 @@ write_hrc2 <- function(corr_table, } # Check if all columns are character - suspects <- NULL - for (col in 1:d[2]){ - if (!is.character(corr_table[,col])) { - suspects <- c(suspects, col) - } - } - if (!is.null(suspects)) message("Note : the following columns are not of character type : ", colnames(corr_table)[suspects], ". There may be an issue reading the table.") + # suspects <- NULL + # for (col in 1:d[2]){ + # if (!is.character(corr_table[,col])) { + # suspects <- c(suspects, col) + # } + # } + suspects <- names(corr_table[,!sapply(corr_table, is.character)]) + if(length(suspects) > 0) message("Note : the following columns are not of character type : ", colnames(corr_table)[suspects], ". There may be an issue reading the table.") #### Creating the hrc file @@ -343,6 +361,11 @@ write_hrc2 <- function(corr_table, corr_table <- corr_table[ order(corr_table[,d[2]-j+1]) ,] + # CORR JJ à vérifier + # sort the table is not efficient if there are NA values ! + # corr_table <- corr_table[ + # order(corr_table[,1]) + # ,] } } @@ -364,12 +387,10 @@ write_hrc2 <- function(corr_table, # 2. Add a fitting number of hier_lead_string to all - depth_table <- as.data.frame(matrix( - nrow = d[1], ncol = d[2] - )) - for (colonne in 1:d[2]) { - depth_table[,colonne] <- colonne-1 - } + depth_table <- as.data.frame( + matrix(0:(d[2]-1),nrow = d[1], ncol = d[2], byrow = TRUE) + ) + # the numeric values (from 0 to d2 -1) correspond to the depth in the # hierarchy, which will govern how many hier_lead_string are added when # writing the hrc. @@ -383,10 +404,12 @@ write_hrc2 <- function(corr_table, )) depth_table <- depth_table - compare_col - for (col in 1:d[2]){ - corr_table[,col] <- vect_aro(string = corr_table[,col], - number = depth_table[,col], - hier_lead_string) + for(col in 1:d[2]){ + corr_table[,col] <- vect_aro( + string = corr_table[,col], + number = depth_table[,col], + hier_lead_string + ) } @@ -408,20 +431,29 @@ write_hrc2 <- function(corr_table, loc_file <- paste0(c(dir_name, "/", output_name, ".hrc"), collapse = "") - write.table(x = corr_table, - file = loc_file, - quote = FALSE, - row.names = FALSE, - col.names = FALSE, - sep="", - eol = "") + write.table( + x = corr_table, + file = loc_file, + quote = FALSE, + row.names = FALSE, + col.names = FALSE, + sep = "", + eol = "" + ) invisible(loc_file) } arobase <- function(string, number, hier_lead_string){ - paste0(paste0(rep(hier_lead_string, number), collapse = "") - , string, "\n", collapse = "") + if(is.na(number)){ + return(NA) + }else{ + return( + paste0( + paste0(rep(hier_lead_string, number), collapse = "") + , string, "\n", collapse = "") + ) + } } vect_aro <- Vectorize(arobase, vectorize.args = c("string", "number")) From bb5e083e12a8abf72f524f2fae28532ab574d05b Mon Sep 17 00:00:00 2001 From: julienjamme Date: Tue, 9 Aug 2022 16:41:57 +0200 Subject: [PATCH 019/107] write_hrc2: set default for sort_table to FALSE + documentation --- R/writehrc.R | 113 +++++++++++++++++++++++---------------------------- 1 file changed, 50 insertions(+), 63 deletions(-) diff --git a/R/writehrc.R b/R/writehrc.R index c481cb6..9392d75 100644 --- a/R/writehrc.R +++ b/R/writehrc.R @@ -15,8 +15,8 @@ #' \cr #' Nom du répertoire dans lequel écrire le fichier hrc #' @param sort_table boolean. If TRUE, table will be sorted beforehand. -#' Recommended.\cr -#' Si TRUE, la table sera triée avant traitement. Recommandé. +#' (default to FALSE)\cr +#' Si TRUE, la table sera triée avant traitement. (défaut à FALSE) #' @param rev boolean. If TRUE, column order is reversed.\cr #' Si TRUE, inverse l'ordre des colonnes. #' @param hier_lead_string character. (Single) character indicating the @@ -65,14 +65,15 @@ #' #' 2 \strong{Dealing with NAs} #' -#' All levels must be filled in for the write_hrc2 function to work properly. -#' This ensures that the alphabetical sorting purposely regroups equal levels -#' together. NAs would be sorted together and, thus, be separated from their -#' expected place in the hierarchy. Other problems may also arise if NAs are -#' mixed with regular values in the table : comparisons between a line and its -#' precedessor are made, that may fail if NAs are inputed.\cr -#' There are, however, a few cases when NAs can be left relevantly. Please -#' be careful with the following possibilities and check thoroughly the +#' The write_hrc2 function has to be preferably used without any NAs in your +#' correspondence table. In presence of NAs, the \strong{sort} argument +#' has to be to FALSE. Indeed, NAs would be sorted together and, thus, +#' be separated from their expected place in the hierarchy. +#' +#' Below, we introduce two common cases where correspondence tables could have +#' NAs. The first one is supported by the function, the second one is not. +#' +#' Please be careful when dealing with NAs and check thoroughly the #' resulting .hrc file, or consider filling in NAs beforehand. #' #' 2.1 \emph{Sparse hierarchies} \cr @@ -89,10 +90,8 @@ #' | other | blackhole | #' | | pulsar | #' -#' Processing such a file will result in wrongly written .hrc, since NAs will be -#' sorted together. It is still possible to deactivate sorting ; see sexample -#' below. This crucially requires that the table has already been sorted by the -#' user. +#' Such cases still issue a warning for the presence of NAs, but do not pose +#' any problem, if \strong{sort=FALSE} is set. #' #' 2.2 \emph{Non-uniform hierarchies}\cr #' Hierarchies with non-uniform depth happen when some levels are not detailed @@ -106,10 +105,9 @@ #' | other | blackhole | #' | other | pulsar | #' -#' Such cases still issue a warning for the presence of NAs, but do not pose -#' any problem. -#' @md -#' +#' Processing such a file will generate an error with the following messages: +#' \emph{Missing values on the last column of the correspondence table is not allowed. +#' If relevant, you could fill in with the value of the previous column} #' #' @section Détails sur les tables de correspondance et le .hrc: #' Tau-Argus attend des fichiers écrits avec précision. Certaines de ses @@ -145,17 +143,17 @@ #' #' 2 \strong{Valeurs manquantes} #' -#' Tous les niveaux doivent être remplis pour que write_hrc2 marche correctement. -#' Cela assure que lors du tri de la table, les niveaux identiques soient -#' regroupés. Les NAS risquent d'être triés ensemble et donc d'être séparés de -#' leur position normale. D'autres problèmes peuvent également émerger s'il -#' reste des valeurs manquantes dans la table : des comparaisons entre une ligne -#' et sa prédécesseuse peuvent échouer.\cr +#' La fonction write_hrc2 doit être utilisée de préférence sans aucun NA dans votre +#' table de correspondance. En présence de NAs, l'argument \strong{sort} +#' doit être à FALSE. En effet, les NAs seraient triés ensemble et, donc, +#' être séparées de leur place attendue dans la hiérarchie. +#' +#' Ci-dessous, nous présentons deux cas courants où les tables de correspondance +#' pourraient avoir NAs. Le premier cas est pris en charge par la fonction, +#' le second ne l'est pas. #' -#' Il y a toutefois quelques cas où les valeurs manquantes peuvent rester -#' pertinentes. Si c'est ce que vous envisagez, faites bien attention à être -#' effectivement dans l'un des cas suivants, et prenez le temps de vérifier -#' prudemment la table .hrc ainsi créée. +#' Soyez prudent lorsque vous manipulez des NA et vérifiez soigneusement +#' le fichier .hrc résultant ou envisagez de remplir les NAs à l'avance. #' #' 2.1 \emph{Hiérarchies creuses} \cr #' Une hiérarchie est creuse si des NAs sont insérées au lieu de répéter un @@ -171,10 +169,8 @@ #' | other | blackhole | #' | | pulsar | #' -#' Utiliser un tel fichier va conduire à un mauvais .hrc, car les NAs vont être -#' regroupées par l'étape de tri des lignes . Il est cependant possible de -#' désactiver le tri (cf. exemples plus bas). Il est alors absolument nécessaire -#' que la table ait déjà été bien triée, comme ci-dessus. +#' De tels cas émettent toujours un avertissement du fait de la présence de NA, +#' mais ne posent aucun problème, si on utilise \strong{sort=FALSE}. #' #' 2.2 \emph{Hiérarchies non-uniformes}\cr #' Les hiérarchies à profondeur non-uniforme correspondent aux cas où certains @@ -189,9 +185,9 @@ #' | other | blackhole | #' | other | pulsar | #' -#' De tels cas génèrent toujours un warning à cause des NAs, mais ne posent pas -#' de problème particulier. -#' @md +#' Le traitement d'un tel fichier générera une erreur avec les messages suivants : +#' \emph{Missing values on the last column of the correspondence table is not allowed. +#' If relevant, you could fill in with the value of the previous column} #' #' @return Invisible. Path to the written .hrc file. #' \cr @@ -212,7 +208,7 @@ #' # ce qui n'a aucune conséquence pour Tau-Argus. #' #' # Wrong column order: -#' # Mauvais ordonnement des colonnes : +#' # Mauvais ordonnancement des colonnes : #' astral_inv <- data.frame( #' details = c("telluric", "gasgiant", "bluestar", "whitedwarf", "reddwarf", "blackhole", "pulsar"), #' type = c("planet", "planet", "star", "star", "star", "other", "other") @@ -234,17 +230,11 @@ #' type = c("planet", NA, "star", NA, NA, "other", NA), #' details = c("telluric", "gasgiant", "bluestar", "whitedwarf", "reddwarf", "blackhole", "pulsar") #' ) -#' # NAs in general are risky : as is, the alphabetical sorting scrambles it all. -#' # Les valeurs manquantes causent un risque, de manière générale, à cause du -#' # tri alphabétique. +#' # NAs in general are risky, but, in this case, the function works well. +#' # Les valeurs manquantes causent un risque, mais, dans ce genre de cas, la fonction +#' a le comportement attendu. #' path <- write_hrc2(astral_sparse, hier_lead_string = "@") #' read.table(path) -#' # Here, gasgiant and pulsar were misread as sublevels of 'star'. -#' # In order to correctly ignore NAs, sorting must be disabled. -#' # Ici, on voit que gasgiant et pulsar se retrouvent considérés comme des -#' # sous-types de planètes. Pour corriger, il faut désactiver le tri. -#' path2 <- write_hrc2(astral_sparse, sort_table = FALSE, hier_lead_string = "@") -#' read.table(path2) #' #' # 2.2 Non-uniform depth #' # Hiérarchie non-uniforme @@ -252,31 +242,26 @@ #' type = c("planet", "planet", "star", "other", "other"), #' details = c("telluric", "gasgiant", NA, "blackhole", "pulsar") #' ) +#' # The following code will generate an error +#' # (see section Details about correspondence table & .hrc) #' path <- write_hrc2(astral_nu, hier_lead_string = "@") -#' read.table(path) -#' # In this case, everything is alright. -#' # Cette fois, tout se passe bien. -#' -#' # In some cases, non-uniform depth hierarchies are filled in to the last -#' # level with placeholder repetition. Such repetitions should not be written -#' # in the .hrc file, and are correctly erased. -#' # Dans certains cas, des hiérarchies à profondeur non-uniformes sont remplies -#' # à tous les niveaux en répétant les niveaux les plus hauts. De telles -#' # répétitions ne doivent pas être transmises dans le .hrc, et sont -#' # correctement effacées par la fonction. -#' astral_repeat <- data.frame( -#' type = c("planet", "planet", "star", "other"), -#' details = c("telluric", "gasgiant", "star", "other") +#' To fix the issue, you have to fill in the NAs beforehand. +#' +#' astral_nu_fill <- data.frame( +#' type = c("planet", "planet", "star", "other", "other"), +#' details = c("telluric", "gasgiant", "star", "blackhole", "pulsar") #' ) -#' path <- write_hrc2(astral_repeat, hier_lead_string = "@") +#' # The following code will work +#' path <- write_hrc2(astral_nu_fill, hier_lead_string = "@") #' read.table(path) +#' #' @importFrom zoo na.locf #' @export write_hrc2 <- function(corr_table, output_name = NULL, dir_name = NULL, - sort_table = TRUE, + sort_table = FALSE, rev = FALSE, hier_lead_string = getOption("rtauargus.hierleadstring") ){ @@ -291,9 +276,11 @@ write_hrc2 <- function(corr_table, output_name <- givenfilename } - if(is.null(dir_name) | dir_name == ""){ + if(is.null(dir_name)){ + dir_name <- getwd() + }else if(dir_name == ""){ dir_name <- getwd() - }else if(! dir.exists(dir_name)){ + } else if(! dir.exists(dir_name)){ stop(paste0("directory ", dir_name, " doesn't exist.")) } From e3d01d55c50ecfbe89355acefa6f2b54ab6cbe64 Mon Sep 17 00:00:00 2001 From: julienjamme Date: Tue, 9 Aug 2022 16:43:26 +0200 Subject: [PATCH 020/107] update NEWS --- NEWS.md | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index 3d50b2c..554905a 100644 --- a/NEWS.md +++ b/NEWS.md @@ -9,7 +9,8 @@ output: rmarkdown::html_vignette * English documentation * **tab_arb()** : argument *value* is now called *response_var* as in the **tab_rda()** function. -* **tab_arb()** : argument *apriori* is now called *hst_filename* as in the **tab_rda()** function. +* **tab_arb()** : argument *apriori* is now called *hst_filename* as in the **tab_rda()** function. +* **write_hrc2()** : new function to creat a hrc file from a correspondence table ## rtauargus 0.5.0 From 685dccb98068881d29f1b7a0ef4a46b385fe2ee2 Mon Sep 17 00:00:00 2001 From: julienjamme Date: Tue, 9 Aug 2022 17:08:37 +0200 Subject: [PATCH 021/107] run_arb : behaviour when logbook is NULL --- R/run_arb.R | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/R/run_arb.R b/R/run_arb.R index 16b1cf6..0bf5f12 100644 --- a/R/run_arb.R +++ b/R/run_arb.R @@ -219,17 +219,17 @@ unquote <- function(s) sub("^[\"'](.+)[\"']$", "\\1", s) #' créer les dossiers manquants).) #' @param tauargus_exe directory and name of the Tau-Argus software. \cr #' (répertoire et nom du logiciel Tau-Argus.) -#' @param logbook name of the file where the error log is saved -#' (optional). \cr -#' (nom du fichier où est enregistré le journal d'erreurs -#' (optionnel).) +#' @param logbook name of the file where the error log is saved. +#' If NULL, a "logbook.txt" file will be saved in the working directory). \cr +#' (nom du fichier où est enregistré le journal d'erreurs. +#' Si NULL, le fichier "logbook.txt" sera suavegardé sur le répertoire de travail.) #' @param show_batch_console to display the batch progress in the #' console. \cr #' (pour afficher le déroulement du batch dans la #' console.) -#' @param verbose boolean, to display the batch execution (if TRUE) or +#' @param verbose boolean, to display the batch execution (if TRUE) or #' only error messages if any (if FALSE) \cr -#' (booléen, pour afficher l'exécution du batch (si TRUE) ou +#' (booléen, pour afficher l'exécution du batch (si TRUE) ou #' uniquement les messages d'erreurs, s'il y en a (si FALSE)) #' @param import to import in R the files produced, \code{TRUE} by #' default. \cr @@ -273,6 +273,7 @@ run_arb <- function(arb_filename, if (is.null(missing_dir)) missing_dir <- op.rtauargus$rtauargus.missing_dir if (is.null(tauargus_exe)) tauargus_exe <- op.rtauargus$rtauargus.tauargus_exe + if(is.null(logbook)) logbook <- "logbook.txt" if (is.null(show_batch_console)) { show_batch_console <- op.rtauargus$rtauargus.show_batch_console } From 43705a0b20b8e3a9c2bbc4f2e01f76ee5b51da9c Mon Sep 17 00:00:00 2001 From: Rastout Nathanael Date: Tue, 9 Aug 2022 17:10:56 +0200 Subject: [PATCH 022/107] documentation des fonctions --- R/tab_arb.R | 110 +++++++++++++++++++++++++++++++--------------------- R/tab_rda.R | 50 ++++++++++++++++++------ 2 files changed, 104 insertions(+), 56 deletions(-) diff --git a/R/tab_arb.R b/R/tab_arb.R index 05e93c2..7106145 100644 --- a/R/tab_arb.R +++ b/R/tab_arb.R @@ -80,36 +80,39 @@ apriori_batch <- function(hst_names, sep = ',', ignore_err = 0 , exp_triv = 0) { #' Create batch file (.arb) for tabular data in order to run Tau Argus #' Crée un fichier batch (.arb) pour données tabulées exécutable par -#' Tau-Argus en ligne de commande. +#' Tau-Argus en ligne de commande.\cr #' #' Function doesn't check if the asc and rda files exists #' La fonction ne vérifie pas si les fichiers asc et rda existent. #' #' @section Syntaxe: #' -#' For tabular data, the function secure one table +#' For tabular data, this function secures only one table at a time\cr #' Pour les données tabulées la fonction traite un tableau à la fois #' -#' Unless specific details, use syntaxe from Tau-Argus manual +#' Unless specific details, use syntax from Tau-Argus manual \cr #' Sauf mention contraire, utiliser la syntaxe mentionnée dans la documentation #' de Tau-Argus. #' +#' Syntax pour \code{suppress} : +#' First parameter is the table number, in this case it will always be 1 \cr #' Syntaxe spéciale pour \code{suppress} : -#' First parameter is the table number, in this case it will always be 1 -#' le premier paramètre dans la syntaxe Tau-Argus est le numéro de la tabulation. +#' le premier paramètre dans la syntaxe Tau-Argus est le numéro du tableau. #' Dans le cas de cette fonction ce sera toujours 1 #' #' -#' @section Informations \emph{hst}: +#' @section Informations \emph{hst_filename}: #' It's possible to add an apriori file (.hst) for a tabular, it can be generated -#' by the table_rda() function -#' Il est possible de fournir un fichier apriori (.hst) pour chaque tabulation, -#' il peut être fourni par la fonction table_rda() +#' by the table_rda() function. #' #' Other options are not mandatory. To modify default value use a vector with the #' .hst file path as first element and then complete with those parameters : #' \code{sep} for the separator, -#' \code{ignore_err} for IgnoreError and \code{exp_triv} for ExpandTrivial. +#' \code{ignore_err} for IgnoreError and \code{exp_triv} for ExpandTrivial. \cr +#' +#' Il est possible de fournir un fichier apriori (.hst) pour un tableau, +#' il peut être fourni par la fonction table_rda() +#' Exemple : hst_filename = "mon_chemin/apriori.hst" \cr #' #' Les options supplémentaires sont facultatives. Pour modifier les valeurs par #' défaut, passer une liste ayant comme premier élément le(s) fichier(s) hst et @@ -119,42 +122,57 @@ apriori_batch <- function(hst_names, sep = ',', ignore_err = 0 , exp_triv = 0) { #' autant de valeurs que de tabulations. #' #' @param arb_filename path of the arb filename, if unspecified, creates a temporary -#' file +#' file \cr #' nom du fichier arb généré (avec extension). Si non renseigné, un fichier temporaire. -#' @param tab_filename [\strong{obligatoire}] path of the tab_filename, mandatory +#' @param tab_filename [\strong{obligatoire/mandatory}] path of the tab_filename, #' nom du fichier .tab (avec extension). #' @inheritParams tab_rda -#' @param explanatory_vars [\strong{obligatoire}] explanatory vars in a vector -#' variables catégorielles, sous forme de vecteur. -#' Example : \code{c("CJ", "A21")} for the tabular \code{CJ} x \code{A21} -#' Exemple : \code{c("CJ", "A21")} pour le premier -#' tableau croisant \code{CJ} x \code{A21} -#' @param value response variable name in the tabular -#' \code{""}. Une seule valeur. -#' @param safety_rules [\strong{obligatoire}] règle(s) de secret primaire. -#' Chaîne de caractères en syntaxe batch Tau-Argus. La pondération est traitée -#' dans un paramètre à part (ne pas spécifier WGT ici, utiliser le paramètre -#' \code{weighted}). -#' @param suppress [\strong{obligatoire}] méthode(s) de gestion du secret -#' secondaire (syntaxe batch de Tau-Argus). Si la méthode est la même pour -#' chaque tabulation, le premier paramètre (numéro du tableau) sera ignoré et -#' renuméroté automatiquement (voir la section 'Syntaxe'). -#' @param output_names noms des fichiers en sortie. Si renseigné, -#' obligatoirement autant de noms de fichiers que de tabulations. Si laissé -#' vide, autant de noms de fichiers temporaires que de tabulations seront -#' générés. -#' @param output_type format des fichiers en sortie (codification Tau-Argus). -#' Valeur par défaut du package : \code{"2"} (csv for pivot-table). -#' @param output_options options supplémentaires des fichiers en sortie. Valeur +#' @param hst_filename Apriori file name, syntax detailed below, +#' Example : hst_filename = "path_to_file/apriori.hst" +#' fichier(s) d'informations \emph{a priori}. Voir ci-dessous +#' pour la syntaxe. Exemple : hst_filename = "path_to_file/apriori.hst" +#' @param explanatory_vars [\strong{obligatoire/mandatory}] +#' Explanatory vars in a vector +#' Example : \code{c("CJ", "A21")} for the tabular \code{CJ} x \code{A21} +#' variables catégorielles, sous forme de vecteur. +#' Exemple : \code{c("CJ", "A21")} pour le premier +#' Pour un tableau croisant \code{CJ} x \code{A21} +#' @param value Colname for response variable in the tabular +#' \code{""}. For frequency table \cr +#' Nom de la variable de réponse dans le tableau +#' \code{""}. Permet de tariter les tableaux de fréquence +#' @param safety_rules [\strong{obligatoire/mandatory}] +#' Rules for primary suppression with Argus syntax, if the primary suppression +#' has been dealt with an apriori file specify manual safety range :"MAN(10)" +#' for example.\cr +#' Règle(s) de secret primaire. +#' Chaîne de caractères en syntaxe batch Tau-Argus. Si le secret primaire +#' a été traité dans un fichier d'apriori : utiliser "MAN(10)" +#' @param suppress [\strong{obligatoire/mandatory}] +#' Algortihm for secondary suppression (Tau-Argus batch syntax), and the +#' parameters for it. +#' Algorithme de gestion du secret secondaire (syntaxe batch de Tau-Argus). +#' ainsi que les potentiels paramètres associés +#' @param output_names output file name +#' nom du fichier en sortie. +#' @param output_type Type of the output file (Argus codification) +#' By default \code{"2"} (csv for pivot-table). +#' For SBS files use \code{"4"} +#' Format des fichiers en sortie (codification Tau-Argus). +#' Valeur par défaut du package : \code{"2"} (csv for pivot-table). +#' Pour le format SBS utiliser \code{"4"} +#' @param output_options Additionnal parameter for the output, +#' by default : code{"AS+"} (print Status). To specify no options : \code{""}. +#' options supplémentaires des fichiers en sortie. Valeur #' par défaut du package : \code{"AS+"} (affichage du statut). Pour ne #' spécifier aucune option, \code{""}. -#' @param hst fichier(s) d'informations \emph{a priori}. Voir ci-dessous -#' pour la syntaxe. -#' @param gointeractive pour avoir la possibilité de lancer le batch depuis le -#' menu de Tau-Argus (\code{FALSE} par défaut). -#' +#' @param gointeractive Boolean, if TRUE will open a Tau-Argus window and launch +#' the batch in it (\code{FALSE} by default). \cr +#' Possibilité de lancer le batch depuis le menu de Tau-Argus (\code{FALSE} par défaut). #' -#' @return Une liste de deux éléments : le nom du fichier arb, les noms des +#' @return A list containing two elements : +#' the arb file name and the output name (usefull if the name is generated randomly) \cr +#' Une liste de deux éléments : le nom du fichier arb, le nom #' fichiers en sortie (utile pour récupérer les noms générés aléatoirement). #' #' @@ -165,14 +183,16 @@ apriori_batch <- function(hst_names, sep = ',', ignore_err = 0 , exp_triv = 0) { #' \dontrun{ #' # creating arb file #' infos_arb <- tab_arb( -#' tab_filename = "donnees.tab", +#' arb_filename = "path/tab1.arb", +#' tab_filename = "path/tab1.tab", +#' rda_filename = "path/tab1.rda", #' explanatory_vars = c("REGION", "CJ"), -#' value = c("CA", ""), -#' safety_rules = c("NK(1,85)|FREQ(3,10)"), +#' value = "CA", +#' safety_rules = "NK(1,85)|FREQ(3,10)", #' suppress = "GH(1,100)", -#' output_names = c("tab1.csv"), +#' output_names = "path/tab1.csv", #' output_options = "AS+SE+", -#' output_type = "2" +#' output_type = "4" #' ) #' # show the content of the file in console #' # visualisation du contenu du fichier dans la console diff --git a/R/tab_rda.R b/R/tab_rda.R index f155cc0..d9da67d 100644 --- a/R/tab_rda.R +++ b/R/tab_rda.R @@ -64,7 +64,7 @@ write_rda_tab <- function(info_vars) { #' un fichier tabular (tab) et un fichier de métadonnées #' (rda) à partir de données tabulées et d'informations additionnelles. #' -#' @param tabular [\strong{obligatoire}] +#' @param tabular [\strong{obligatoire/mandatory}] #' data.frame which contains the tabulated data and #' an additional boolean variable that indicates the primary secret of type boolean \cr #' data.frame contenant les données tabulées et @@ -76,15 +76,24 @@ write_rda_tab <- function(info_vars) { #' nom du fichier rda (avec extension) #' @param hst_filename hst file name (with .hst extension) \cr #' nom du fichier hst (avec extension) -#' @param explanatory_vars [\strong{obligatoire}] Vector of categorical variables \cr -#' Variables catégorielles, sous forme de liste de vecteurs \cr -#' Example : \code{list(c("A21", "TREFF", "REG")} +#' @param explanatory_vars [\strong{obligatoire/mandatory}] Vector of explanatory variables \cr +#' Variables catégorielles, sous forme de vecteurs \cr +#' Example : \code{c("A21", "TREFF", "REG")} #' table crossing \code{A21} x \code{TREFF} x \code{REG} #' @param secret_var Boolean variable which give the primary secret : equal to -#' "TRUE" if a cell is concerned by the primary secret,"FALSE" otherwise. \cr +#' "TRUE" if a cell is concerned by the primary secret,"FALSE" otherwise. +#' will be exported in the apriori file \cr #' (Variable indiquant le secret primaire de type booléen: #' prend la valeur "TRUE" quand les cellules du tableau doivent être masquées -#' par le secret primaire, "FALSE" sinon.) +#' par le secret primaire, "FALSE" sinon. Permet de créer un fichier d'apriori) +#' @param cost_var Numeric variable allow to change the cost suppression of a cell +#' for secondary suppression, it's the value of the cell by default, can be +#' specified for each cell, fill with NA if the cost doesn't need to be changed +#' for all cells \cr +#' Variable numeric qui permet de changer la coût de suppression d'une cellule, +#' pris en compte dans les algorithmes de secret secondaire.Par défaut le coût +#' correspond à la valeur de la cellule. peut être spécifié pour chacune des cellules, +#' peut contenir des NA pour les coûts que l'on ne souhaite pas modifier #' @param decimals Minimum number of decimals to display #' (see section 'Number of decimals') \cr #' (nombre minimal de décimales à afficher (voir section 'Number of decimals').) @@ -116,6 +125,14 @@ write_rda_tab <- function(info_vars) { #' contributor of a cell. \cr #' (Nom de la colonne contenant la valeur du plus gros contributeur #' d'une cellule) +#' @param maxscore_2 Name of the column containing, the value of the second largest +#' contributor to a cell. \cr +#' (Nom de la colonne contenant la valeur du deuxième plus gros contributeur +#' d'une cellule) +#' @param maxscore_3 Name of the column containing, the value of the third largest +#' contributor to a cell. \cr +#' (Nom de la colonne contenant la valeur du troisième plus gros contributeur +#' d'une cellule) #' @param separator Character used as separator in the .tab file. \cr #' (Caractère utilisé en tant que separateur dans le fichier .tab) #' @@ -165,13 +182,23 @@ write_rda_tab <- function(info_vars) { #' #' For example : #' \itemize{ +#' \item{\code{totcode = "global"} : writes \code{ "global"} for each +#' explanatory vars} +#' \item{\code{totcode = c("global", size="total", income="total")} : +#' \code{ "global"} for each variable except for \code{size} and +#' \code{income}} assigned with \code{ "total"} +#' by default : { "Total"} #' \item{\code{totcode = "global"} : écrit \code{ "global"} pour #' toutes les variables catégorielles} #' \item{\code{totcode = c("global", size="total", income="total")} : -#' idem, sauf pour les variables \code{size}et \code{income}} +#' \code{ "global"} pour toutes les variables catégorielles +#' sauf \code{size} and \code{income}} qui se verront affecter +#' le total : \code{ "total"} +#' Par defaut : { "Total"} #' } #' #' +#' #' @section Hierarchical variables: #' #' Parameter \code{hrc} has the same syntax as \code{totcode} and @@ -179,7 +206,7 @@ write_rda_tab <- function(info_vars) { #' Hierarchy is defined in an separate hrc file (\strong{hiercodelist}). #' which can be written with the function \code{link{write_hrc2}}. #' The function expects the location of this file (and a possible \code{hierleadstring} -#' if it differs from the default option of the package). +#' if it differs from the default option of the package : @. #' The path to the existing file is explicitly given. #' The elements of the vector in parameter must be named (with the name of the variable), #' even if there is only one element. @@ -231,7 +258,8 @@ write_rda_tab <- function(info_vars) { #' income = c( 100, 4, 7, 14, 42, 85), #' freq = c( 2, 6, 8, 45, 100, 1), #' max = c( 54, 2, 1, 13, 19, 85), -#' primary_secret = c( TRUE, FALSE, FALSE, TRUE, FALSE, TRUE) +#' primary_secret = c( TRUE, FALSE, FALSE, TRUE, FALSE, TRUE), +#' cost = c( NA, NA, NA, 1, 5, NA) #' ) #' #' # rda creation @@ -245,11 +273,11 @@ write_rda_tab <- function(info_vars) { #' hrc = c(category = "category.hrc"), #' explanatory_vars = c("category" , "size", "area"), #' secret_var = "primary_secret", +#' cost_var = "cost" #' totcode = c( #' category = "global", #' size = "total", -#' area = "global", -#' income = "total" +#' area = "global" #' ), #' value = "income", #' freq = "freq" From ffd8bc381ce07d3f0d400efe1e5fad439d345172 Mon Sep 17 00:00:00 2001 From: julienjamme Date: Tue, 9 Aug 2022 18:40:59 +0200 Subject: [PATCH 023/107] =?UTF-8?q?modif=20options=20par=20d=C3=A9faut?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- R/options.R | 11 +++++++---- R/run_arb.R | 4 ++-- R/tab_arb.R | 2 +- R/tab_rda.R | 2 +- 4 files changed, 11 insertions(+), 8 deletions(-) diff --git a/R/options.R b/R/options.R index 58ebaad..008ba78 100644 --- a/R/options.R +++ b/R/options.R @@ -8,17 +8,20 @@ op.rtauargus <- list( rtauargus.totcode = "Total", rtauargus.missing = "", rtauargus.hierleadstring = "@", + # tab_rda --------------------------------------------------------- # + rtauargus.separator = ",", # arb --------------------------------------------------------- # rtauargus.response_var = "", rtauargus.weighted = FALSE, rtauargus.linked = FALSE, - rtauargus.output_type = "2", - rtauargus.output_options = "AS+", + rtauargus.output_type = "4", + rtauargus.output_options = "", # run_arb ----------------------------------------------------- # rtauargus.missing_dir = "stop", rtauargus.tauargus_exe = "Y:/Logiciels/TauArgus/TauArgus.exe", - rtauargus.show_batch_console = TRUE, - rtauargus.import = TRUE + rtauargus.show_batch_console = FALSE, + rtauargus.import = FALSE, + rtauargus.is_tabular = TRUE ) df_op.rtauargus <- function(html = FALSE) { diff --git a/R/run_arb.R b/R/run_arb.R index 0bf5f12..3ced0b4 100644 --- a/R/run_arb.R +++ b/R/run_arb.R @@ -259,12 +259,12 @@ unquote <- function(s) sub("^[\"'](.+)[\"']$", "\\1", s) #' @export run_arb <- function(arb_filename, - is_tabular=NULL, + is_tabular = getOption("rtauargus.is_tabular"), missing_dir = getOption("rtauargus.missing_dir"), tauargus_exe = getOption("rtauargus.tauargus_exe"), logbook = NULL, show_batch_console = getOption("rtauargus.show_batch_console"), - verbose = NULL, + verbose = TRUE, import = getOption("rtauargus.import"), ...) { diff --git a/R/tab_arb.R b/R/tab_arb.R index 05e93c2..9c7d5cc 100644 --- a/R/tab_arb.R +++ b/R/tab_arb.R @@ -183,7 +183,7 @@ apriori_batch <- function(hst_names, sep = ',', ignore_err = 0 , exp_triv = 0) { tab_arb <- function(arb_filename = NULL, tab_filename, rda_filename = NULL, - hst_filename = NULL, + hst_filename = NULL, explanatory_vars, value = getOption("rtauargus.response_var"), safety_rules, diff --git a/R/tab_rda.R b/R/tab_rda.R index f155cc0..f844c34 100644 --- a/R/tab_rda.R +++ b/R/tab_rda.R @@ -288,7 +288,7 @@ tab_rda <- function( maxscore = NULL, maxscore_2 = NULL, maxscore_3 = NULL, - separator = "," + separator = getOption("rtauargus.separator") ) { From 011d27f89626a885a3ddacad7c1cca53390d2048 Mon Sep 17 00:00:00 2001 From: julienjamme Date: Tue, 9 Aug 2022 18:42:04 +0200 Subject: [PATCH 024/107] initialisation fonction tab_rtauargus --- R/tab_rtauargus.R | 104 ++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 104 insertions(+) create mode 100644 R/tab_rtauargus.R diff --git a/R/tab_rtauargus.R b/R/tab_rtauargus.R new file mode 100644 index 0000000..928e623 --- /dev/null +++ b/R/tab_rtauargus.R @@ -0,0 +1,104 @@ + +#' Title +#' +#' @inheritParams tab_rda +#' @inheritParams tab_arb +#' @inheritParams run_arb +#' +#' @param files_name string used to name all the files needed to process. +#' All files will have the same name, only their extension will be different. +#' @param dir_name string indicated the path of the directory in which to save +#' all the files (.rda, .hst, .txt, .arb, .csv) generated by the function. +#' @param ... any parameter of the tab_rda, tab_arb or run_arb functions, relevant +#' for the treatment of tabular. +#' +#' @return +#' AJOUTER TAG EXPORT à la fin +#' +#' @examples +#' 2+2 +#' @export +tab_rtauargus <- function( + tabular, + files_name = NULL, + dir_name = NULL, + explanatory_vars = NULL, + hrc = NULL, + totcode = getOption("rtauargus.totcode"), + secret_var = NULL, + cost_var = NULL, + value = NULL, + freq = NULL, + maxscore = NULL, + safety_rules = "MAN(10)", + suppress = "MOD(1,5,1,0,0)", + show_batch_console = FALSE, + ... +){ + + .dots <- list(...) + + ## 0. CONFLITS PARAMETRES ................. + + # tabular not a data.frame + if(!is.data.frame(tabular)){ + stop("tabular has to be a dataframe.") + } + + ## 1. TAB_RDA ..................... + + # parametres + param_tab_rda <- param_function(tab_rda, .dots) + param_tab_rda$tabular <- tabular + param_tab_rda$tab_filename <- file.path(dir_name, paste0(files_name, ".tab")) + param_tab_rda$rda_filename <- file.path(dir_name, paste0(files_name, ".rda")) + param_tab_rda$hst_filename <- if(is.null(secret_var) & is.null(cost_var)) NULL else file.path(dir_name, paste0(files_name, ".hst")) + param_tab_rda$explanatory_vars <- explanatory_vars + param_tab_rda$hrc <- hrc + param_tab_rda$totcode <- totcode + param_tab_rda$secret_var <- secret_var + param_tab_rda$cost_var <- cost_var + param_tab_rda$value <- value + param_tab_rda$freq <- freq + param_tab_rda$maxscore <- maxscore + # appel (+ récuperation noms tab hst et rda) + input <- do.call(tab_rda, param_tab_rda) + + + ## 2. TAB_ARB ......................... + + # parametres + param_arb <- param_function(tab_arb, .dots) + param_arb$tab_filename <- input$tab_filename + param_arb$rda_filename <- input$rda_filename + param_arb$hst_filename <- input$hst_filename + param_arb$arb_filename <- file.path(dir_name, paste0(files_name, ".arb")) + param_arb$output_names <- file.path(dir_name, paste0(files_name, ".csv")) + #TODO : generaliser le choix de l'extension + param_arb$explanatory_vars <- explanatory_vars + param_arb$value <- value + param_arb$safety_rules <- safety_rules + param_arb$suppress <- suppress + param_arb$show_batch_console <- show_batch_console + + # appel (+ récupération nom batch) + batch <- do.call(tab_arb, param_arb) + + ## 3. RUN_ARB ........................... + + # parametres + param_run0 <- param_function(run_arb, .dots) + param_system <- param_function(system, .dots) + param_run <- c(param_run0, param_system) + param_run$arb_filename <- param_arb$arb_filename + param_run$logbook <- file.path(dir_name, paste0(files_name, ".txt")) + param_run$is_tabular <- TRUE + + # appel + res <- do.call(run_arb, param_run) + + # RESULTAT ............................. + + res + +} From 448d24136349bd791d33ef081f28d37631f7485a Mon Sep 17 00:00:00 2001 From: julienjamme Date: Tue, 9 Aug 2022 18:52:38 +0200 Subject: [PATCH 025/107] modif integration continue, check uniquement sur master et developpement --- .gitlab-ci.yml | 3 +++ 1 file changed, 3 insertions(+) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index 98ac077..7c3c357 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -22,6 +22,9 @@ pkg_check: artifacts: paths: - "${PKG_NAME}_*.tar.gz" + only: + - master + - developpement pages: stage: deploy From 1948253254f832773633688f2f5f2c1c13482358 Mon Sep 17 00:00:00 2001 From: julienjamme Date: Wed, 10 Aug 2022 14:51:35 +0200 Subject: [PATCH 026/107] corr tab_rda sur partie comment code --- R/tab_rda.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/tab_rda.R b/R/tab_rda.R index bdad012..e1e65f8 100644 --- a/R/tab_rda.R +++ b/R/tab_rda.R @@ -499,7 +499,7 @@ tab_rda <- function( ordre_init = dplyr::row_number() ) - # weight_var et holding_var .......................................... + # freq et maxscore .......................................... if (!is.null(freq)) { fwf_info_tabular$type_var[fwf_info_tabular$colname == freq] <- "FREQUENCY" From f5ec45e0f1c91f0d76035b5f597fd54368e8b2b7 Mon Sep 17 00:00:00 2001 From: Rastout Nathanael Date: Wed, 10 Aug 2022 16:28:36 +0200 Subject: [PATCH 027/107] Ajout du traitement des feuilles uniques --- R/writehrc.R | 90 ++++++++++++++++++++++++++++++++++++++++++---------- 1 file changed, 74 insertions(+), 16 deletions(-) diff --git a/R/writehrc.R b/R/writehrc.R index 9392d75..b48a5c4 100644 --- a/R/writehrc.R +++ b/R/writehrc.R @@ -1,3 +1,50 @@ +ajouter_feuille_unique <- function(table_passage,racine){ + + df_long <- data.frame() + + for(i in 1 : (ncol(table_passage)-1)){ + table_prov <- unique(table_passage[,i:(i+1)]) + colnames(table_prov) <- c("parent","enfant") + table_prov$niveau <- i + filtre <- table_prov$parent != table_prov$enfant + table_prov <- table_prov[filtre,] + df_long <- rbind(df_long,table_prov) + } + compte <- table(df_long$parent) + compte <- as.data.frame(compte) + colnames(compte) <- c("parent","nb_occur") + feuille_unique <- compte[compte$nb_occur == 1,] + table_unique <- df_long[df_long$parent %in% feuille_unique$parent,] + + for (i in 1:nrow(table_unique)){ + niveau <- table_unique$niveau[[i]] + enfant <- table_unique$enfant[[i]] + parent <- table_unique$parent[[i]] + ligne_a_recup <- which((table_passage[,niveau]==parent) & table_passage[,(niveau+1)]==enfant)[[1]] + sup_df <- table_passage[1:ligne_a_recup,] + inf_df <- table_passage[ligne_a_recup:nrow(table_passage),] + sup_df[ligne_a_recup,][(niveau+1):length(sup_df[ligne_a_recup,])] <- paste0(racine,sup_df[ligne_a_recup,][(niveau+1)]) + res <- rbind(sup_df,inf_df) + table_passage <- res + } + return(res) +} + +arobase <- function(string, number, hier_lead_string){ + if(is.na(number)){ + return(NA) + }else{ + return( + paste0( + paste0(rep(hier_lead_string, number), collapse = "") + , string, "\n", collapse = "") + ) + } +} +vect_aro <- Vectorize(arobase, vectorize.args = c("string", "number")) + +# vect_aro(string = c("ab", "abb"), number = 1:2, hier_lead_string = "!") + #' .hrc writing #' #' Creates a .hrc hierarchy from a correspondence table. \cr @@ -23,7 +70,20 @@ #' hierarchy depth in the .hrc file #' \cr #' Caractère unique repérant le niveau de profondeur dans le .hrc -#' +#' @param adjust_unique_roots boolean. If TRUE will add fictional roots to the +#' correspondence table, by doing so there will be no unique roots in the hrc file. +#' With tabular function, unique roots are not handled by Tau-Argus. \cr +#' Si TRUE la fonction va ajouter des feuilles fictives au fichier .hrc afin +#' qu'il n'y ait plus de feuilles uniques. Les feuilles uniques peuvent générer +#' des problèmes dans l'exécution de Tau-Argus +#' @param add_char character If adjust_unique_roots is TRUE add_char is the string that will +#' be used to create fictional roots, be sure that this string does not create +#' duplicates.The string will be paste at the beginning of a unique root +#' default = "ZZZ" \cr +#' character Si adjust_unique_roots est TRUE add_char est l'élément qui sera +#' utilisé afin de créer des feuilles fictives, il faut être sur que cela +#' ne crée pas de doublons dans la hiérarchie.La chaine de caractère sera +#' ajouté au début d'une feuille unique. Par defaut :"ZZZ" #' @details Creates a .hrc hierarchy file adapted to tau-Argus from a #' correspondence table fully describing it. By default, lines are sorted #' alphabetically so as to regroup identical levels. @@ -263,7 +323,9 @@ write_hrc2 <- function(corr_table, dir_name = NULL, sort_table = FALSE, rev = FALSE, - hier_lead_string = getOption("rtauargus.hierleadstring") + hier_lead_string = getOption("rtauargus.hierleadstring"), + adjust_unique_roots = FALSE, + add_char = "ZZZ" ){ if(! any(class(corr_table) %in% c("data.frame","matrix"))){ @@ -311,7 +373,7 @@ write_hrc2 <- function(corr_table, # Error if presence of NAs on the last column if(sum(is.na(corr_table[[d[2]]]))>0){ stop( - "Missing values on the last column of the correspondence table is not allowed. If relevant, you could fill in with the value of the previous column" + "Missing values on the last column of the correspondence table is not allowed. If relevant, you could fill in with the value of the previous column" ) } @@ -322,6 +384,15 @@ write_hrc2 <- function(corr_table, If unintended, this can cause errors when using the .hrc file with tau-Argus.") corr_table <- zoo::na.locf(corr_table) } + + if(adjust_unique_roots==TRUE){ + warning(paste0("If there is unique roots in the table, the function will create +fictional roots to adjust the hrc file for Tau-Argus, they will be created +by copying the unique roots and adding ",add_char," at the beginning +of the root character, if this creates duplicates, change the add_char +parameter")) + corr_table <- ajouter_feuille_unique(corr_table,add_char) + } # (Todo : lister cas de NA non gênantes et bloquer les autres) # Try to detect a problem with detailed column @@ -431,17 +502,4 @@ write_hrc2 <- function(corr_table, invisible(loc_file) } -arobase <- function(string, number, hier_lead_string){ - if(is.na(number)){ - return(NA) - }else{ - return( - paste0( - paste0(rep(hier_lead_string, number), collapse = "") - , string, "\n", collapse = "") - ) - } -} -vect_aro <- Vectorize(arobase, vectorize.args = c("string", "number")) -# vect_aro(string = c("ab", "abb"), number = 1:2, hier_lead_string = "!") From bccffd50ebfb9a93ae66a625b959ad6ea181c300 Mon Sep 17 00:00:00 2001 From: julienjamme Date: Wed, 10 Aug 2022 17:21:29 +0200 Subject: [PATCH 028/107] modif options --- R/options.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/options.R b/R/options.R index 008ba78..0dcc2fe 100644 --- a/R/options.R +++ b/R/options.R @@ -38,7 +38,7 @@ df_op.rtauargus <- function(html = FALSE) { stringsAsFactors = FALSE ) - fun_names <- c("micro_asc_rda", "micro_arb", "run_arb") + fun_names <- c("micro_asc_rda", "tab_rda", "micro_arb", "tab_arb", "run_arb") param_names <- lapply(fun_names, function(x) names(formals(get(x)))) func <- data.frame( From 0ad0c79e1d5cd38f493f243f2f93cad5fa5669a0 Mon Sep 17 00:00:00 2001 From: julienjamme Date: Wed, 10 Aug 2022 18:04:27 +0200 Subject: [PATCH 029/107] =?UTF-8?q?tab=5Frtauargus=20avec=20standardisatio?= =?UTF-8?q?n=20des=20variables=20cat=C3=A9gorielles?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- NAMESPACE | 3 + R/data.R | 14 +++ R/tab_rda.R | 5 +- R/tab_rtauargus.R | 238 ++++++++++++++++++++++++++++++++++++++++++---- 4 files changed, 239 insertions(+), 21 deletions(-) create mode 100644 R/data.R diff --git a/NAMESPACE b/NAMESPACE index ead62cf..22bb6e2 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -10,8 +10,10 @@ export(rtauargus_plus) export(run_arb) export(tab_arb) export(tab_rda) +export(tab_rtauargus) export(tauargus_info) export(write_hrc) +export(write_hrc2) importFrom(dplyr,"%>%") importFrom(dplyr,arrange) importFrom(dplyr,mutate) @@ -19,3 +21,4 @@ importFrom(purrr,map) importFrom(purrr,map_at) importFrom(purrr,transpose) importFrom(rlang,.data) +importFrom(zoo,na.locf) diff --git a/R/data.R b/R/data.R new file mode 100644 index 0000000..2bbfa3d --- /dev/null +++ b/R/data.R @@ -0,0 +1,14 @@ +#' Fake values of production of red vegetables by sector and size of companies. +#' +#' A tabluar dataset containing the turnover broken down by Activity +#' and Size of companies. Useful for playing with tab_ functions. +#' +#' @format A data frame with 1242 rows and 5 variables: +#' \describe{ +#' \item{ACTIVITY}{activity, hierarchical variables} +#' \item{treff}{size of the companies (3 classes of number of employees)} +#' \item{n_obs}{Frequency, number of companies} +#' \item{tot}{turnover} +#' \item{max}{turnover of the company which contributes the most to the cell.} +#' } +"red_vegetables" diff --git a/R/tab_rda.R b/R/tab_rda.R index e1e65f8..69ef7c1 100644 --- a/R/tab_rda.R +++ b/R/tab_rda.R @@ -378,8 +378,8 @@ tab_rda <- function( maxscore_2, maxscore_3) - if (length(tabular[1,]) != length(col_tabular)) - {warning("unspecified columns in table")} + # if (length(tabular[1,]) != length(col_tabular)) + # {warning("unspecified columns in table")} # Controle hrc if(!all(names(hrc) %in% explanatory_vars)) {stop(" error with label of the hierarchichal variable")} @@ -474,6 +474,7 @@ tab_rda <- function( if (!is.null(secret_var)) tabular<-tabular[,!names(tabular)==secret_var] if (!is.null(cost_var)) tabular<-tabular[,!names(tabular)==cost_var] + tabular <- tabular[,c(explanatory_vars,value,freq,maxscore,maxscore_2,maxscore_3)] fwf_info_tabular <- gdata::write.fwf( diff --git a/R/tab_rtauargus.R b/R/tab_rtauargus.R index 928e623..e2777d7 100644 --- a/R/tab_rtauargus.R +++ b/R/tab_rtauargus.R @@ -1,3 +1,41 @@ +#' Fonction qui ajuste la taille d'une chaîne de caractères en ajoutant +#' un même caractère devant pour atteindre une taille souhaitée +#' +#' @param char string chaîne de caractères à modifier +#' @param cible_char integer - longueur de la chaîne souhaitée +#' @param add_char caractère à ajouter +#' +#' @return chaîne de caractère +trans_var_pour_tau_argus <- function(char='monchar', cible_char=12, add_char='*'){ + diff <- cible_char - nchar(char) + if(diff > 0) + char = paste0(paste0(rep(add_char,diff), collapse=''),char) + return(char) +} + +#' Fonction vectorisée de la précédente. Cette fonction est à privilégier pour +#' une utilisation sur un vecteur, une colonne d'un dataframe par exemple. +#' +#' @param char character vector +#' @param cible_char integer - longueur de la chaîne souhaitée +#' @param add_char caractère à ajouter +#' +#' @return character vector +v_trans_var_pour_tau_argus <- Vectorize(trans_var_pour_tau_argus, vectorize.args = 'char') + +#' Fonction vectorisée de la précédente. Cette fonction est à privilégier pour +#' une utilisation sur un vecteur, une colonne d'un dataframe par exemple. +#' +#' @param char character vector - vecteur à modifier +#' +#' @return character vector +rev_var_pour_tau_argus <- function(char='**monchar', del_char='*'){ + if(del_char %in% c('*','+','_',' ')){ + gsub(paste0("[",del_char,"]"),'',char) + }else gsub(del_char, '', char) +} + + #' Title #' @@ -9,31 +47,81 @@ #' All files will have the same name, only their extension will be different. #' @param dir_name string indicated the path of the directory in which to save #' all the files (.rda, .hst, .txt, .arb, .csv) generated by the function. +#' @param unif_hrc boolean, if hrc files have to be standardized (especially for internal use) +#' @param unif_expl boolean, if explanatory variables have to be standardized (especially for internal use) #' @param ... any parameter of the tab_rda, tab_arb or run_arb functions, relevant #' for the treatment of tabular. #' #' @return -#' AJOUTER TAG EXPORT à la fin +#' If output_type equals to 4, then the original tabular is returned with a new +#' column called Status, indicating the status of the cell coming from Tau-Argus : +#' "A" for a primary secret due to frequency rule, "B" for a primary secret due +#' to dominance rule, "D" for secondary secret and "V" for no secret cell. +#' +#' If output_type doesn't equal to 4, then the raw result from tau-argus is returned. +#' +#' @details +#' +#' @section Standardization of explanatory variables and hierarchies +#' +#' The two boolean arguments \code{unif_hrc} and \code{unif_expl} are useful to +#' prevent some common errors in using Tau-Argus. Indeed, Tau-Argus needs that, +#' within a same level of a hierarchy, the labels have the same number of +#' characters. When the two arguments are set to TRUE, \code{tab_rtauargus} +#' standardizes the explanatory variables to prevent this issue. +#' For hierarchical explanatory variables (explanatory variables associated to +#' a hrc file) are then modified in the tabular data and an another hrc file is +#' created to be relevant with the tabular. In the output, these modifications +#' are removed. For non hierarchical explanatory variables, +#' only the tabular is modified. #' #' @examples -#' 2+2 +#' #DON'T RUN +#' library(dplyr) +#' tabular_leg <- table_legumes_sp %>% mutate(n_obs = round(n_obs)) %>% +#' select(ACTIVITY, treff, type_leg, tot, n_obs, max, is_secret_prim) +#' res <- tab_rtauargus( +#' tabular = tabular_leg, +#' files_name = "legumes_rouges", +#' dir_name = "tauargus_files", +#' explanatory_vars = c("ACTIVITY", "treff", "type_leg"), +#' hrc = c(ACTIVITY = "legumes.hrc"), +#' totcode = c(ACTIVITY = "Ensemble", treff = "Ensemble", type_leg="rouges"), +#' secret_var = "is_secret_prim", +#' value = "tot", +#' freq = "n_obs", +#' output_type = "4", +#' output_options = "", +#' is_tabular = TRUE, +#' show_batch_console = FALSE, +#' import = FALSE, +#' separator = ",", +#' verbose = FALSE, +#' unif_hrc = TRUE, +#' unif_expl = TRUE +#' ) + #' @export tab_rtauargus <- function( - tabular, - files_name = NULL, - dir_name = NULL, - explanatory_vars = NULL, - hrc = NULL, - totcode = getOption("rtauargus.totcode"), - secret_var = NULL, - cost_var = NULL, - value = NULL, - freq = NULL, - maxscore = NULL, - safety_rules = "MAN(10)", - suppress = "MOD(1,5,1,0,0)", - show_batch_console = FALSE, - ... + tabular, + files_name = NULL, + dir_name = NULL, + explanatory_vars, + totcode, + hrc = NULL, + secret_var = NULL, + cost_var = NULL, + value = "value", + freq = "freq", + maxscore = NULL, + safety_rules = "MAN(10)", + suppress = "MOD(1,5,1,0,0)", + show_batch_console = FALSE, + output_type = 4, + output_options = "", + unif_hrc = TRUE, + unif_expl = TRUE, + ... ){ .dots <- list(...) @@ -44,8 +132,91 @@ tab_rtauargus <- function( if(!is.data.frame(tabular)){ stop("tabular has to be a dataframe.") } + if(any(!explanatory_vars %in% names(tabular))){ + stop("At least one of the explanatory vars is not a tabular's column name") + } + if(any(!c(value, freq) %in% names(tabular))){ + stop(paste0(value, " or ", freq, " is not a tabular's column name")) + } + if(!is.null(maxscore)){ + if(!maxscore %in% names(tabular)){ + stop(paste0(maxscore, " is not a tabular's column name")) + } + } + if(!is.null(cost_var)){ + if(!cost_var %in% names(tabular)){ + stop(paste0(cost_var, " is not a tabular's column name")) + } + } + if(!is.null(secret_var)){ + if(!secret_var %in% names(tabular)){ + stop(paste0(secret_var, " is not a tabular's column name")) + } + } + if(length(totcode) < length(explanatory_vars)){ + stop("totcode must have the same length as explanatory_vars") + } + if(length(names(totcode)) < length(explanatory_vars)){ + names(totcode) <- explanatory_vars + } + + if(is.null(files_name)) files_name <- paste0("tau_argus_file_", format.Date(Sys.time(), format = '%Y_%m_%d_%H:%M:%S')) + if(is.null(dir_name)) dir_name <- getwd() + ## 1. TAB_RDA ..................... + tabular_original <- tabular + # uniformisation des chaines de caractères des variables catégorielles, hors total + # tabular ...................... + if(unif_expl){ + trans_expl <- sapply( + explanatory_vars, + function(var){ + col <- tabular[[var]] + max_char = max(nchar( col[col != totcode[[var]]])) + ifelse(col == totcode[[var]], col, v_trans_var_pour_tau_argus(col, cible_char = max_char)) + }, + simplify = TRUE + ) + tabular <- cbind.data.frame( + trans_expl, + tabular[,!names(tabular) %in% explanatory_vars] + ) + } + if(unif_hrc & (length(hrc) > 0)){ + # fichiers hrc .................. + hrc_unif <- sapply( + names(hrc), + function(var_name){ + file <- hrc[[var_name]] + df <- read.table(file) + + v_gsub <- Vectorize(gsub, vectorize.args = c("pattern", "x")) + df$aro <- unlist(regmatches(df$V1, gregexpr("^@*", df$V1))) + df$lab <- v_gsub(df$aro, "", df$V1) + + df <- df[df$lab != totcode[[var_name]],] + max_char = max(nchar(df$lab)) + df$lab <- v_trans_var_pour_tau_argus(df$lab, max_char) + df$unif <- paste0(df$aro,df$lab) + + name <- gsub(".hrc$", "_unif.hrc", file) + + write.table( + x = as.data.frame(df$unif), + file = name, + quote = FALSE, + row.names = FALSE, + col.names = FALSE, + sep = "", + eol = "\n" + ) + print(paste0(name, " has been created")) + name + } + ) + hrc <- hrc_unif + } # parametres param_tab_rda <- param_function(tab_rda, .dots) @@ -55,12 +226,14 @@ tab_rtauargus <- function( param_tab_rda$hst_filename <- if(is.null(secret_var) & is.null(cost_var)) NULL else file.path(dir_name, paste0(files_name, ".hst")) param_tab_rda$explanatory_vars <- explanatory_vars param_tab_rda$hrc <- hrc + param_tab_rda$totcode <- totcode param_tab_rda$secret_var <- secret_var param_tab_rda$cost_var <- cost_var param_tab_rda$value <- value param_tab_rda$freq <- freq param_tab_rda$maxscore <- maxscore + # appel (+ récuperation noms tab hst et rda) input <- do.call(tab_rda, param_tab_rda) @@ -75,11 +248,12 @@ tab_rtauargus <- function( param_arb$arb_filename <- file.path(dir_name, paste0(files_name, ".arb")) param_arb$output_names <- file.path(dir_name, paste0(files_name, ".csv")) #TODO : generaliser le choix de l'extension + param_arb$output_type <- output_type + param_arb$output_options <- output_options param_arb$explanatory_vars <- explanatory_vars param_arb$value <- value param_arb$safety_rules <- safety_rules param_arb$suppress <- suppress - param_arb$show_batch_console <- show_batch_console # appel (+ récupération nom batch) batch <- do.call(tab_arb, param_arb) @@ -93,12 +267,38 @@ tab_rtauargus <- function( param_run$arb_filename <- param_arb$arb_filename param_run$logbook <- file.path(dir_name, paste0(files_name, ".txt")) param_run$is_tabular <- TRUE + param_run$show_batch_console <- show_batch_console # appel res <- do.call(run_arb, param_run) # RESULTAT ............................. + if(output_type == 4){ + + res <- read.csv( + param_arb$output_names, + header = FALSE, + col.names = c(explanatory_vars, value, freq, "Status","Dom"), + colClasses = c(rep("character", length(explanatory_vars)), rep("numeric",2), "character", "numeric"), + stringsAsFactors = FALSE + ) + res <- cbind.data.frame( + apply(res[,explanatory_vars], 2, rev_var_pour_tau_argus), + res[, !names(res) %in% explanatory_vars] + ) + mask <- merge(tabular_original, res[,c(explanatory_vars,"Status")], by = explanatory_vars, all = TRUE) - res + + write.csv( + res, + file = param_arb$output_names, + row.names = FALSE + ) + + return(mask) + + }else{ + return(res) + } } From cf74ec38d3ddf9fb88bd4c6ba9c24cbec0cc776b Mon Sep 17 00:00:00 2001 From: julienjamme Date: Wed, 10 Aug 2022 18:05:12 +0200 Subject: [PATCH 030/107] ajout data pour exemples --- data/red_vegetables.rda | Bin 0 -> 15969 bytes 1 file changed, 0 insertions(+), 0 deletions(-) create mode 100644 data/red_vegetables.rda diff --git a/data/red_vegetables.rda b/data/red_vegetables.rda new file mode 100644 index 0000000000000000000000000000000000000000..71b31adeb1075cd8d91b9662f32851a85c0594de GIT binary patch literal 15969 zcmajGLzE>9%qCpAW!qMlZCkg?w(Y7e+qR7^+qTUv+qO0DH~(h-%}f?ga*~{!tg?8L zh-g`GGYe}{Drasnh%lAKQ6kn4#<nH0OHazrC3B@Q7=pl(@M)FLrN?w&dDBE**%~em zJ74fRIFO~ZNnRp4X^}EiLLw7b5~IA1%Z3Y1DOAQ1kBm}iS)}q@nuJo4X<=oSTOwC7 z;mKyPD3P8X19QeoCYQ;Q1w@;(%+HmsL#ABHr3COPKf#YP0sr!q20#9K2eK*y%S(P` zl=Vp;u`Vq=t}9qUg9t&7mqaV0S>T42ceCKKaQ%~%q(j67rNb8$ zk2p$;!PnzK=H_tO<_nUR#*5@~OQ^~`GjZW1VpuHZEXKye7m3-xfsjIT^CkXs7C7Ze zOBO69y8aO4RA)`$i@i2yE+?!1608Pb*uhQ-voM_uPbLdFf`3;QK7AjKG*C z>2pt^#R(6NGSA$kCzwnt!V=M?``i-A0v0wCRuUY@T;-*8;ddajWHBp=pma%+a8sZ( zaUcl9m>k=JWhSf*8k!s!zZ@AFC2kBe+kBFogamS*oLp%PC0J=QUnZMnNd^Kg+aemJ zTn2UqGaK8Y1WG}Xus;S@d-XLxKqGs2Ku3qD)P-(mRMC)T)s8UkK-WDTT2V+*C{PaZ zJuO+s!1n=->?A`se=vb@+N$gL-}toyE=RWCaV-1Y(rVq6>-0Y z$$B%m*`8=k0dSn!6lARdAYC#QvK43$z@Q>8XB>|l;GM_~GchE|oKwyO+n8U;(uiC} z&k|~0n4SW`T|bB@MLV!rNIx`(8tmo4$Oa(jYey^IV`P%d%p^ZP9dJ)1bsKs_0Kw0n z;_{y??4zadSBMuIN>J!~d!X@*R`wxuZGyn36HhhlfQvuR7Sv@!LobI|BKMbXh-BCs zpIA9j1(rEFH6SOrs$tYFpD%QTCu|Xk*>s8Jxs#5G@yA1VCgYrOo~{i@2p@}RT3AEX zOT)LXkO@d)0>~cUO$%TEm&Zh(S~Byp`Y9IkS@O6mR})Tw#(3kPPMzGmMiMMFa$>RJ+^*G8gDFrD3>S5V+s&0ginRF1lt}hB6`u~8gD0rhm zFghmELFl@H|52!PO#f#_VG_2HcqqBX{|}fAqcu$a$7_s?Gd z_m-gwo^(+b5ZGX7-Avn+3Zvj6eSix@7A|FZTZE%HidaF#ukxOmD>vF&c2k>aq)vg} z0tnLDrD?k3S&TvXlWX0q>2-NmN1vCREOX12w;+U(lq-Hdd`$y*#L+ zfQwz8+^D}@{?c%X(&X&8nIvNcyyOh1Vj_oDg^5k$Qo))gDL9a2)E0A!uu>c}Wfc*y zG?6&CurW$(6NME#lJ0hCs{f7Kvfu`+6e*4Hg;wZ862^M9>ZP2#OtBYJIb)Pdni0u~ zqXLOx)ANWk1IkJytO3NJ$<_%CMZPy#(b#l251ffLMnse>*s|otp>eB*WHBM#V}Xo4 z+;`8I=N3~x{BYRd7GFM#d@XPo{}Lwh!@fDd&R2!&B~c*551aB91-ZCDhkE@8`~5OH z(h$sf&}(1#vsNg~Ma4_$d;dz4m#}f}T?q_`?f^(f+G>u6y7W<>`vw;13-e*@1VoVP z4;k{xzLD#+3q>FFM9Fo*lY}oxkAZ#9gm@cA4STxNz zMftDeQWs5s5E$ZrDPL5#B7#OX)`jpJWeA$`3>>nVhgMI7TTRBc!$p_oNARJ>x}D80 zg=pNW_dY)tB-2T~h6sdVyP|n@GpP zva+pI^NDo|AhnZN6GABqU?|XYtgw&yN>xzv9LgStYl3D9z1~?>3k4DAF3%)Gw$$e@ z$-@x=*jtwVa>^*Cjder6k9xJ#MA{kuBL1bR#?F1*O2Z2@1#oY0DYFl{h!rn%=!Mfn zQ?+uuD?VA$x8ZQLUU-O|1FuC z+frg|VGC`WHjUUmwP7d&&v|4LPKQg4(?Ig%deb<+ypyX9K!d0G4AxLnbc`mUDN(vQVNq%^SJs(6&HWhd!K0hPh8RrkhQs{f7fTXN=sSj3e0vd;a+lcmv5! z29kB{GzVx(zM0}#kdTPGiUQ}R60ARoA;Ww?lNj@ZUg{CBp-W_PeN>k-F8(wtjib+# zq!y$7`~BOaV@gV@9eMnu25FI|ND*_dX?-HQwmcRqI5fMZ@5Oc?OtqA3A~mx$xNhg> zlzzvy5!OoGjF;pL==0LdQkn>5jPSUlvwHJSrA9X%yBJ8s2fMT#TGH-f3Wt)`gmm@s^E)>E(P(z1&z*27P(5KcC^MUX`Gr4i&s1XR=K z7EJVY+&n&8!vMNyYkc0_7z?)tjeH$Z*=0I0D7$8ngz#8rhUISg-^HNCAJVOZ;(XY6 z68&nv0Bs2Uf(3tU>rF^EafW7LE)NROMV+AE%5$!XU@FZJJ%? zwbi|jC)`!jtF9xqGz#VStOUH(-Oc8@JE4vwDbgFS)!%mP9`Ws(&9l*C(e!wbPOFoY z1h+aRFgT8q*hV?`sF?Ep4pAOYRm>#OJm)X5QL$Uwgzq=9edvL3)0e^bHr53zM0201 zomq`y0H`e8Yd~G{@^??Rt91DVTV{sbo`FF=kk6POloTnLgZF$?iPKt8q_li63u;ea%*c z`+w64W$ufg&67~gbz>sCh%j65A9fitk5JkSuU(=$UD2?F3m@F zq>O_O1hqtEHT%yh*WY2A84gc9>(xUzmoOfd7VznUTBLLF-prwwk1I&O)Sb6%BujVp zhmF<}M=WB*!l!a2G*vRsDb`;m{R?+)aq-mspSZb9@pB`HK#a6WwPoM*K#;NL;rniV zqWUiL;TQc+q=gywqk*Kskk|b{{6ht<-^m}haNNepwxU~K-f#}(<43JZwEif-AlOy$ zN3lm*2Dsm_?pVHog>bKcHo!OWee<%-?sz3ebchKbVufr!3+lZ4RQYAI#|`ZlKjqI0 z5=<1ciu*kI%(r!bt<265E-x;mX`KvRlHH zfI3D(o|~=$N^{;7(6H~&nyI86T7CLAV^`)EB_uyFVAMyK%eZ4Df?hN zr5gjKpO=5wR`?bgJ#C_b?PDO7ZJuO0t@eKe*)PJrUgY4 z3b;f?Otu$46*>2=OX&1CxH2ipC-@jC6yDwYzDu0jgro)08^eyL34~LEYk<>&&Z3aP z&LsPYU+jmzYkz|o_+0d&k6R{lrJ)aA?K9LQP`nUWC?9)KVlr5QqC+&mAHdJQ4_6LQ z>enetP1VtE=RNr>14DVkzz+{!k2L!yR&(Fjd+|vUbiC!{AbhH6FRCbQwu7I>#o@mM zIfo}?3)%z)kHADTy3}?(&EW?RvWlF)t6QMLQlA776TCW(rwKh8G1^XYML$w?f7Nac zRkfF$(z}tFKH;wdQUJ>%;oX#EH=gR!!O=2wy9f|@^%q8ULe*n_uuP4M5#A(KVq69;x+I$%6i?_Na+Q;j# zm>KVDMCbaI>M8P|qcxACuGOjiS_qLK6c_*ip@F~zQDwtmQf0$};fX}x5$ck{G(?o= zmGEf@b7-zT&gJ<@B;YjXTX37|)4DiWC__{PnN*b}5vF4}XrEUVf}%BBtSY?dw}Zt* zgDH}@HwLmf- z{ul0fi6vv2s%c&uXDcKpwX{JbypNxl+^Wp+rcxH(7S5l6oNFHf=Meo3%W%}XTx6t z71aIs4Tbd~pghZEFpOFGdef4C%B?LJw~aq74v&P3G6|0xmqyLoS9>_9DfcJNV(;0l zfZ-%OSF-ro_wl1Ip`E!w|KwiYb!UG{lj`xj<~0)Vqj~ z0%Agzdiph7^STkkT#IQ|h76#0HL*kt9~}Y_tYv=h#FD}^z2LtQblTO`lceZCJi z=eI4!OgW355!5Kb)BsmzRREsJDr ztG^jQ{S>XW(0m*pZ5)7YU^n829!Z+_JN-)OcTk|Dekoh{AV(G~+UTm~3=Uuw+URq) z-vSEat|Hx=zW`j;!_Taq5GfI&$f7V5yLsX!pNXME0&3x624i&t4BNY9ArMJqXIYL8 zKmboq+2-`Po=pHJPiDIJXF3vqd*=!NG?Jt{E90Ivt2m zi9k{g7o$V|#vGBPPRC9Ls31lkFTsXR!l(?qjEraAUXpw+&ubGulHdn3a%lEBmd-uz zS=|d@cwadQZ?29OLv9F*8Y1a%l9-FgBeMpC85MDaN8N0C9@%nW!2BLUUF`oEZ#&oF z({a9U2F>?R2{j}QUVHKvJ0*8n=0am-MHY9DusHEmVzXbeEzGC92 zl+bbzQY6FUA^VdB3WX?#9aXw`=s3ySCkIA07rBt&cJp*F1J+&1e8Q=vx`Dlc$ViI; z{vJHHjx?#?Fi4{8xqt8tBVova6sE);%UIz5ZrM?&MnxlbA`FmmsyInaQAW?N*{f?Q zz$aV$;3+64D3mnjyKbQhMlAUIus8Il!gJpT8kG$Pue#48PC2f$VmJ_bo{6QEH;wa6 zM1!#lr8fn#7<1v-{|v-sTYJ1b2XZ1&4R(HU5Sk9EkqkyXO2BR*v0CF#p6^OJ>VPlo zy$cvI{%s3Jj^C`J#!=X0OElcLJGXvK?;TF>;)y2AN+O_q&Q00;^DBtIQWv?V^HYs4 zK(N4s34CK?V@98jlo1{D(_sYNl9x;bSxmy0iV6~_2+0$)KPLgV<-iSb602aDupb77 z3c9G+p9xsg%ZCVeL7~nZr)G-ACZ#t3AQC+gXEUKFCM^8GQ(l^aYNF5sYL|EOAI;z)ZC!OVMx6li)| zfF?024@scnziDOcV8}#H*Mr#3F+KR1Cd$LUmyJS><3zQBSYZIsIT7%CKk=w4r?5DR znV8I>mD`ZXpA*=NqzW`Y91ch9EQLyq#ctEm`dH15)b3t%jAxVcRuNJ8VvBmkNd1jPE!8pDXTN9x>S z3q49+a>uo>zVgn*#TfoVI4s9JV=Zz2JBL_w=Z#8+#Y=#L2F*TZx`652bA^9xB4*j5 zy!W@MZ)n7n3&X?wxL{FdZW!~oJMq@qE+ZyNI?kyHI0=4WIP9q*7KsZ4k?CE{;>RBb zu?7T;*qk`$)cH~mdaqEpYbk@Y8i9OWg?w5!;y^Y_;SNAm{E_%gr2K?y+6s}$rvm~* zJup;3lCm2prSEg6!YAaN@Ea~h<(hbR&KqOwa46L3*J%vL;1iRpW!l!c4}}IYLZ?w6 zKD-}_hyAG8++;FY0P!Omej)tX_wmkHdP^GWo;?jpk8BI`{uct@%##WM-eQOf-WWtd zIIT0ySZ*>?+4ouivH#W)ZcG%qH_$CNC2();h?y-s{+@U{YfccuY@>6W{{K$(TgP%tN%VfZ-B?l}kPFY9s_Qu8S z`c^~#slSY2Lke1_F>LEYr8nX>Ktp9uWmR0acE35W;5fuC1$Jo;GrvcV;h`pFC=6~o z7M;qa+L^bnxG6op8Fem@qy&W9j@Daq1%U-Sn3!8{!0W9H^h6QKhWhULd`vvbkk5FQ zaBpHzWH!BV?d3_~ZLy}P`mQL)X8T?KQD?~!2AxGi_NgjCU%uQwZeQTt4!|V8={0bfKZr;1qf*AL9k8D|tm9AGX-%Mtn@ggTpTRB0>A9V86oP;KftN^Yw z8cw-JfGrXmnv_98s zdCuC;9j5o%+ZQe=K2DZ(|8za2Smi$N9L`#dDxsBQ-MkIQ)HLPay>Z^b3UTDGAN)-D zS`y^-4O)6{mIHd^{P|E|nep}R?waI`VauE;u^Nn`%YFWJCKE|6OBdvh;n*!tNdg;F zn2xs{t6M7$biNtzovr0dsXdwR?yLOIdOm=f9I64yJuoe%k~z!-D3 z6Ws9qYQI#ymnH@0+cjY8{rc6KEeXHVdv0^3q=BbhDEdg%1TBfsePR91zqECqHx5`A zmnr%(XBp4-XdM&$DfLa_kY2ilpJBNqE8FB!w?o&4l&uZrWPvyYsF-RZQIA#G75b$R zr7!%r7gk|8hc;Eo_(t^eaSG*Fcv54%eOS(ASW=*UC?gYZjT&O(o+GQrr_Mw8hywZf zd3Lo?9bwFW^#0{i%zi?0&SZu%E=TX3=xG{}a*h*8LhG!bRvO(;|F6zYLvC$YB)LgD zEU!sdhOjri{G7oKE*Lml+a($!(fW^fM7m9@*O>1Lok>?gdqm-(t{xwdu=nTVIIErn zWoTgng}dUm4G%6M%HKgf0x&Z=2jjlfY0kUje~Fp<`;h3^#G-F~jHoLZJExLbQS%I@ zQ}#f2HSv8@?-~BMN&SI$(dkZu%p|4NBp+o8Eow5N>gF}4t`4%=Y;l^w>lzK(Ybj_j zUyj>+{$){0oc>3?&ht+@RsQoYR9eE&>(|d4+>WdHf6cfdX1qG$ZxdV2?{EWA#KgAK zV#p#N_Qp*jnMMsClOaTB?dp4NBd(Biq)$pWRXpsQk3+j}UEh;V1cMl6g@tbY&H>3& zk#FL^KNqb!T7K*XCj(KzS8#7H!=V0X_MmQvAMP0EAUVsT$)k>hfR2CV;urEe+-aEb zP2t9C65gJRkB}rCXw*SlXyls;hDn+eFkr;yCrS|)bU74b>m3z2RswWlg+q%DsJH8T zVB)khULySLs6w2FQ?c)c4^=y7ESYuauBS|ojTr@Vn>&R3Er^ic9M*2<9@=ux6yXbCFPu+x-q0l+NuJglTT>mch z91heZU%U9qPd4JJWG%p{@Zl0=a?kluB3#JJx1M}QX)KKqM0Zebxxh-aDyzFKL(${NMCSzx?iVC$CZab48@U1}g#=_>DG7YB#6tvHgt=iY}Ag9ZQ z@1WvJK*lH9kozHbvKD$(@iJhO04o4$ZG9TGmG;jNLJWIC^IZLiKln{+`ZvyaeT-cA zqvRf_N;q@@p=|PzE?C-gWeRV}@0iI?T@uVj z)s4l7cw2O*uBBJ=crA*$<)K3Mr%q|Vc3KWCT7cUK{{m7}kvu?s{F)OpDte5duSvx+GYpbQYOCJTn5#oiIW69zjd z+Fn_`^7g%qI;a@Ud54=YC5NDxyH}n(GfIYg*szilfrNT`^8^v)OqW)ScR)bG!Jb1B z@U}}uEwnW63&QhG8hZQMTCy&Gl2qB%*s7d7ZSPnQr!;1+J8c|s@T`JOhdp_>BrWmp zU{d!eykMKadbYo6&xRsKG*v~Ns>1TyRq!iO52&lz!~g*k2NhMevg;$v9_F@$Bl{j= zPM%=Te#|#t=-n8JMV6yP1(LoFj4A;1VXW79+AV{e<^bp42Paknjy9!%$(opDM(*z$ z5V*#jNp)*EjX2aICOLpez_A~2cdp*~u&Yvd%vrEkKvqnB9CtIxp zp7+1`M^c|gwJ`BF@U=to>eSh+%Muf3A`P%OsXrf?mP`{jS>sP;`sgk_bAIf~j@yTW8W=q_pO){j+bH%6`llZ}DNSaj^DTB} zrP=sCQ#wLT_?a$;5QPH!tl^&#HB^JqI3qg`rlO`?0yFz|CQ}z6_kN5k=S>lV3AYop z9O!LNSr-6kGTd1GP(xhF+x>s(sr0+tpF`213}7a|-7pD@&WXr2q(=naz3L`i(?2%c zUuA1^hD9=13p#yFXg^Z%yII*U?bC*G|v&PC4*YeU*{PhT2+VP|@G_;d$ z8tO)bg%4OdCpHip&)b;k0&`(^69gzt%z~%rngqjeWwqU@7U(`fRtb+b-T9o0l1I%T z3>;3mcnK|AIanhfGk;RYJL7vXvi2d*8@#C+>bTxpg&$)1X@ZuGy7)7m`A3^Lo4YDP z?t>B?$rDf2uWqnS2-Sy^|8W?i5Mh=iLmae#$-FQK#v&0=Q|vW zpeN6>{UbZnXH3FS@(0Z`y{zz*G%Z|uKmov zr4*EuD|r~OcEBt)%K@O7s>2l1RNU`ET}%nMJ1@{7pyJniK&HIsv-@sWsEln_x+X$f z%)<%{T?e1xskJwF=5H|z@}|0GZ16yaZahiS2|nFoFDFGe$KV$tq(nHGdW8{wqW4_% zlq{1ZFZeN{obX!mE-mUFO!1V$_kUW=a-n4iMkKR53(*5m*koc9d@ENs_w5to5OvkO zSO0h}rm(zqrI^=&8AfpJPqVfo6cH-n z?i-|S(Z{xP4qHyeDZ~tnTd8rSVR?|wNcR*CvEyVgdag5+ze`$EgZ8QXIP!n*iPna; z?SJ5!oT9&~Mnp_HS!hQ8L_$7=wJp zV=xqr>o9njx6%C;jSC8czbwP|uLv&SBHrti44a1;$56dx zMf+Ek_eB4U;UV~<;4C`+jjD%n+63Hg%{d$^9+a#dW2MN2HWQgqfKjYqR7Eoz#WQb( z_1Y^kbd9|~{8-w&Pek7jdp^13dO=I}*7Q*O0bRQ4^u6{M_Vh3lSFH7)D$^qp ztgFe5OGQ`#Uc3SwC9<2@kOtBA)lRc(Q@?wVuc12Qqn-T!n)r|AFdVkz1-X zWZh)K0skc$!>%%DYlKP4L>4WzxRDCTBSfk7C+@we&5vhj9S7n|nFCx~2}>5h4WXB5 z22IBNrdQnOwe7v%c4md}3=o<8frCt}|7Id=7}TlL0jZrfm+N{gV9xJ|P`Fkf*BpX7 z>GAVyjReS}#1Qc7pmeO3eU(L!k(E|gd3c^%y#+qO04TuK%P1$tS2~mbrt#W9L-Ct_=MZIHTl0nhYsfSV%6yAU0T!CoP=_Nv4-o-FQT~e>qtdi`Qm%Dxgv@9E_#&2r zP)a`vS~22;S8b0+`fjh)9Ps47q1|bIL)Y@Rbl~xfU1zF+`*>dRq-DQZqkngTS40Yw z>h=76bT0hIJ9UOppJIK1`Xw$HJ!HRVg%D8`6&^1j!K8+HPtN1R`*yKo{a=IdS99^* zEUvB84!%-?h*i6->87&qN`+U`>~5J|Y6fP7rt6`pTO)`ODj-Pb8{0rqbmg|WYDv$s z$5u^U=02PT*4CQ+j{!1_Nx|eBui-Tbk_t`G zVy~Ola?-vUF^lyNcf{jo<67WGq_PICLHoxNsaDpF#^D4+eAq(}#jzm7^O=8d{zp-k zA?s&62KuY_Y#V3yaIy%p$Y=uN535X`#7g#qmAbQL@olr82N5uy|MqDcpJ`~HSee-7 z{yHt6kEYrcWapShI(qRW-Iq>LHF4 z3v2Dy+MB70k+lA-_yC2ww#$82v6E*U*39fROChoN%wG6XC?&E}A+MJm1Cbll3rl-r zznRW2AAW_t`d)%${=ft5>fu=v3t|n?d=NeZ>mWoZsJIE;{a|5DV4#WrN)D^TH1Zb{ ziXYiA&V{X)F`eclfp;8S@Q*-fMy#AH)t%!qp7p|k9X`nA5mGQb8Rq_e?&f7W#n$ZF^qyUa?O@4Xz^hV!$BnJMajq6h7AtV;8oUh%#aq;R2tbOD+kB?oomx=-SoFtNK?aYP+Q1YONK0^NWGx{OD_re-s+{5{N=V7N^hYex$gvlW zV4wC5VQ)}H(TAwh2(?J)e8b&sr!h7sMt_lSa5@?l`p}4&p?w9)#3UjZ+7Bxx+CC&^ zvZDW(oov?3_X;rjAL?k@YVUG_uRbZ>A0OuUOAR^Z#hy2n75Kf#+fm>~S5@TG8vGcc zoV)XHX{ZL-Hc$n#yOFYh-``%m>hL4|)e&*kT)ahCs#7`2Vm63)2*G<<(jX~ZQ-v%u z+V^AyHD<G1TaE$`r%64cZy7entYs+`G5rIWK~doVR%<{>kV()(|Nva$ttHc@HuF$q71 z8vD?$59CADU;Cawup{iSCx_Lm6%HQlC`K2gv^vSGqYGio=FFW3FX9>PWd4=Fz>7 ztdA+)b5)_ZCX23P%QFp;Q$fHG8J?`fYK$$837Zk0ZXYu~hElk)(2>(YS(CUF-V2FW zEro;TZ~S;a##n8`?k^kFvNF5$8{@bUI}y{^V_zygF2NWo1+dLsI27w_=mVJi)p5gn zq5&1snk2J7M#iM;A-nITBmNtfLrV~5^F4}Wmu#+(m$s7*Dgi13F}`9*Khks3lA7c~ zv{3YXbI=~9TmpzsoC(<5aV+}-}4IrMM{n1h8;n)`+QKA z?%4H;75e%SHs(LF=oy_!NV@MSGa6DLXOmt% zqDZ<#e8qRAt63WmiXQQCaq*H&iBP0;j-P%V!pYvlG86CeL!JZ*ile?*UDzYh;m&)c zqrcl{tCtuP4i00-$1v4S5|a`}VIbu%OKk_jH}u0Cg5Jb<+w>v4Onn|gX0ZN0Ly z=MQ6OcTTv@?oYm>$xmAPalyRuSWDR)gTG0wKstPj6su+rektKnDB}hrj z6z150$|&f<7`WwPrs^SrdW(VuhiyVR0ke4enk3z<%0muBLWitwk6G-Zs+=Cz?0TH$ z{!V?-`b32_f#;L$1Vj}jw&S=-xUrshNOGWG-dVAMD`SqF!Im1q*ArK8hb>qf&4JMj zga#gcz5X@YzqG6%zyCCLAtQe?R`q4l>p{I8;rpi0^2}izMZaX!>F`=D)-aDzgL8*=SdColCAt~}GeL7mN!>tnsS)!)HYCOS z5cBs%2zgLezan*j+!602W*qy^Sd@t$R=SA-Cj|2zMA~=}(@`JM<+*uk*CO&nt*C|4 zhAc6_>#;9QWD3p|iO(TTB+4W>Z66JXM3cdWj%c9|%RoP`n%ad7XzzpjB*jdVaJ%pB zcwnB6ZgtGPzdx|(^J4H%N3@QGM?1`n++u%^A9LCv{c6puIFV~M54d#Cn=<5@xOgVW zCe8MO*eR17djZNz`wu)ck-OXuFQ7FmLhYk~JBi`mVM>9@`yCzsYK{p)o$5o#b+mZL z+No$cS#k_AIntMcjGocuU0r_6?fi;TyncZS zyP$s!{AOaZp`!KCiq^zY z!DcYd>=P7RlLR_@n@M;7$EJ!?!+pYUgkN9Pf^GSJuLIM z;t}K?rXFV1s`uDTm5vK`cf66<93pl(c%I%Y7#2MhjPYyXHG|GqM#mCHIy{uAAlo%~ zb4&!c8Z7Y;AZNLazY(*##CP)$mK4u`4NT_WX7<#JU@^Q*Q6hKqEzuSu+c1pFn`CLn z&ncM8!!!azMLmNT3KvEmMUJ_ZDi%V{*n~3w#HXuuqF%Y@&&d^Pnom~JvieMpc}c7D zEySO7eL7yAvD#Q-R9V{_f&L8bjlVfxECaPH=Ex+4P{e&RhK$3dOFqBL=g-vYTa4rPPlwzFUnk%Coljs7d*}7Zyn|Lj=)HZ~x1A;IU2ZAg&4^BDHUJG`g zG7xOn77W2p>4qrfYP!0|!vC5sHYSNv{L%tP#GJmtUMH zYW$MI;ppNows=;1_t8=QD!aV0afzmHlDVA01&ac0S8WDR0~)Zr zOl627o8GM7c;(vmrZ+wd&knl^B2zl8m=JU#c*Rg$6$5n$7Xva%dHE6gl&ESoYQABgL zoA;W1pPF>!9^t^QD=P6bAKQRBJcpq7vL~DHYAQ_6wdL&Pn@-h>gKjWgn~so6P3$n~ zHtSg|=%Ze!^UtQi*bKFG95APoutA<%!wcptNRsjKInX|6cf7&JGghaZ1)~r;U8?E{ zWB0^+ApLrPIM}lUw))n}udN+4Nt!+%<KM5FHoUlaJSzT-I)1E zNaaVqg6oe+z4NIf0>(h`@*^M(^|0*OD}A+b}JG9x=nve9^8v*+4KpJfwC{54D(NshGT8|ZOyrCF1 z$vBO)oky)q8~fxwo5PWCbLJ@LWjPAC-~ySxem!Wi5Meh8bVR#d8gr65CDfd)($4M! z{yN5;xHbHZ5w<$PbSmInhb?hjql#Hxrm9Q&?7nNF8BVRLFNj=7j9oi)uR)~2vXxix}7wuTF+K^&%AckSj(PLeBq2BnCQttnE+#r6(#TSBUfUyo({i& zLBlvvkO43WwJ+HePcY^NG1Z_5jEP@sLI;N|ORUj?DHd{xTBvBD` zQemluq3T;XulwuL;Jzs9oitji0Gfm(s=*h9^`%B`0VHjqQ9y-D;a4|R?H;1W5Jn)# zmKj-h%zYy~k=n0`i``qH`Cc3MoyP4jz8=ldWmet*-if$SqYguIc^Ea37(84!gyNQcj%hGQ`4?kBwTq z7+r_w9`a5Li(-}Yv^XBZFQL!*LSh_zPD%v_HMHx^41a_Q-c1v5AIb&kd_})e0#JSJ#*G`oXnQo2~O+vtFh2rs731N5# z-`WZ&a4byj`aQ^?h8g{`oIciR!Xk`%0wvA&w#zCzevs9Jia?mI-@&;0?{ZF_&-x2R z51c4cNMffD`M2A@T>5pNVtq;zRpc^oDCk{tisvEUzsA>*>1qK-hO=8=2is^<(D*$6 z29k=T(=(-pqexIajmzfU1=+7a!B^zgqdP-O1uSuJ-(8OQ@i6f}^B19_M#^13VylFh zmQY5K@J{e^sEY5d4)?J#n^D_b_!2~Te$Kg5xAurSkLR6<`5pClJCBcA$wK`p1ha!u zf8na=wvg?_tj-@ZA1nsO0-Buzrq~{c5WZQ5d6M1ZrpV%ke#3kY)@nt$sYaWWV*A|) zx-TLp!9*&XLIiJW#PK*tffK?aa(0poBpO)hj)HwT{;{l);EhfC(*j%ejFRTR@95;Y zbtgV{b3?f$J|&(C3R#1^*~cWQ^j52;qb2~V=`UFjvpj;(rQAUB!!fbfgg>}tDZ7c;-Sd=s@(^FJyegrhP0yQURY-|*f4q` zynE~wD+^v(Zp35$k@~gCLfRJ4*XX%*rBu(G)$&Ezp>UVFJRRI@0bZIwLQ>$0_ams- zu|m()CKrtu^u%awE~)B`S6N|h7P`iFwrQ6?*lS$XPJL>V@NcoFtj=!U7X`>mnzQ)| zd3Yv+vu9+KZilJT7nl6Lwpd_jtri}3e8XR@;}#Oly{4nwGz%RW96Ee}2P%4;c6rP)4tR*qa8F zL0Y^?=9#j?$GELN1gGPZ+yRWw0{Em*cedQaZ{Xa+SFPWrhEBa_q^{UC%+g|92oz@Q{-K_ftkVi`MSuB=JSE4D`PdRXsIYcVwe#}=loK5!?>5K18S)j+o^0<>E}BT^~xE_jla3dpV+m@MJzs_OT{PP zUXRDQQ8pOaYjy{)=(pv0@VT< zlCnBgq;TS0SeozP`SdH!iTC5%=1_PF$^C%>Rm!5%8ks!2D~Z0WYyZP0Vt{$&Kp@Q* zgc`pwT(9NxKH3RRg_H+)(xbdYIrb5nSBtSIr-jkM@D*b~}iBM5(|6j-B=1Cc5YAxe>`T-3Ez``+zKv_x{I>ZJFQTAHFAx zD}u3JAabF-ls-AKd;prwvq$$CpW2sfo3YmOuM$+=bfM3t=5krIOf*<#mXA?ap?3QK z#5(W`xGR@}#);|#QuzPRX?`-Gl1L^9K1Or$T0SR$s3z{^SU&g%33mT9XLVJ#DXfg6`@CNKz$asmD6w%K(tK&5la(Jql znYD~Z1)$(nR=(!**MEP&3UW*TRbWPqGT6&F_3j+dFwye~maK4TCUYmCJLP@(5bp#x zXMNr=6?Mq8GaLp{leo&-6?GTH7>v*Zj2rashwYwmIe&U#XY)y7s0$Uf@&XkrAX?|) zT7mUPh8)Lw5?5N@<<%K;kK*vPy2B^Oa5y zDxBtcBgAbV8;`efb$fe%ZW=I7o+*Mwc2@ec6giV-qeOU;?yTs{judtx@EN!0f(}BS zS7RK*6+=>le;hem(f)TSL@M@$a24{Usm_-u`|FqYZ9?tmD0JA^cIT+&7^_?e!-$91 zq24i?moWa@L{qsxv2rX+zISWa9|NaGe6PcjH}*N!qre5QAO84|(Js=QvCA{fV@AJk PhQmmQ0unED>)ihZf4Zm! literal 0 HcmV?d00001 From 8d8aa2e37777b4737e42a4b763486e457c473a95 Mon Sep 17 00:00:00 2001 From: julienjamme Date: Wed, 10 Aug 2022 18:10:50 +0200 Subject: [PATCH 031/107] Rd files --- man/red_vegetables.Rd | 24 ++++ man/run_arb.Rd | 34 +++-- man/tab_arb.Rd | 196 ++++++++++++++------------- man/tab_rda.Rd | 171 +++++++++++++----------- man/tab_rtauargus.Rd | 166 +++++++++++++++++++++++ man/write_hrc2.Rd | 302 ++++++++++++++++++++++++++++++++++++++++++ 6 files changed, 706 insertions(+), 187 deletions(-) create mode 100644 man/red_vegetables.Rd create mode 100644 man/tab_rtauargus.Rd create mode 100644 man/write_hrc2.Rd diff --git a/man/red_vegetables.Rd b/man/red_vegetables.Rd new file mode 100644 index 0000000..5d36b02 --- /dev/null +++ b/man/red_vegetables.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/data.R +\docType{data} +\name{red_vegetables} +\alias{red_vegetables} +\title{Fake values of production of red vegetables by sector and size of companies.} +\format{ +A data frame with 1242 rows and 5 variables: +\describe{ + \item{ACTIVITY}{activity, hierarchical variables} + \item{treff}{size of the companies (3 classes of number of employees)} + \item{n_obs}{Frequency, number of companies} + \item{tot}{turnover} + \item{max}{turnover of the company which contributes the most to the cell.} +} +} +\usage{ +red_vegetables +} +\description{ +A tabluar dataset containing the turnover broken down by Activity +and Size of companies. Useful for playing with tab_ functions. +} +\keyword{datasets} diff --git a/man/run_arb.Rd b/man/run_arb.Rd index 0e101fb..5216813 100644 --- a/man/run_arb.Rd +++ b/man/run_arb.Rd @@ -7,48 +7,54 @@ \usage{ run_arb( arb_filename, - is_tabular = NULL, + is_tabular = getOption("rtauargus.is_tabular"), missing_dir = getOption("rtauargus.missing_dir"), tauargus_exe = getOption("rtauargus.tauargus_exe"), logbook = NULL, show_batch_console = getOption("rtauargus.show_batch_console"), + verbose = TRUE, import = getOption("rtauargus.import"), ... ) } \arguments{ -\item{arb_filename}{name of the batch file to execute. +\item{arb_filename}{name of the batch file to execute. \cr (nom du fichier batch à exécuter.)} -\item{is_tabular}{boolean, if the data is already tabulated or not +\item{is_tabular}{boolean, if the data is already tabulated or not \cr (booléen, si les données sont déja tabulées ou non)} \item{missing_dir}{what to do if the folders where the results will be written results do not exist ("stop" to trigger an error, "create" to -create the missing folders). +create the missing folders). \cr (action si les dossiers où seront écrits les résultats n'existent pas ("stop" pour déclencher une erreur, "create" pour créer les dossiers manquants).)} -\item{tauargus_exe}{directory and name of the Tau-Argus software. +\item{tauargus_exe}{directory and name of the Tau-Argus software. \cr (répertoire et nom du logiciel Tau-Argus.)} -\item{logbook}{name of the file where the error log is saved -(optional). -(nom du fichier où est enregistré le journal d'erreurs - (optionnel).)} +\item{logbook}{name of the file where the error log is saved. +If NULL, a "logbook.txt" file will be saved in the working directory). \cr +(nom du fichier où est enregistré le journal d'erreurs. +Si NULL, le fichier "logbook.txt" sera suavegardé sur le répertoire de travail.)} \item{show_batch_console}{to display the batch progress in the -console. +console. \cr (pour afficher le déroulement du batch dans la console.)} +\item{verbose}{boolean, to display the batch execution (if TRUE) or +only error messages if any (if FALSE) \cr +(booléen, pour afficher l'exécution du batch (si TRUE) ou +uniquement les messages d'erreurs, s'il y en a (si FALSE))} + \item{import}{to import in R the files produced, \code{TRUE} by -default. +default. \cr (pour importer dans R les fichiers produits, \code{TRUE} par défaut.)} -\item{...}{additional parameters for \code{system()}. +\item{...}{additional parameters for \code{system()}. \cr (paramètres supplémentaires pour \code{system()}.)} } \value{ @@ -59,7 +65,7 @@ default. } } \description{ -Executes the instructions contained in an .arb file for Tau-Argus. +Executes the instructions contained in an .arb file for Tau-Argus. \cr (Exécute les instructions contenues dans un fichier .arb pour Tau-Argus.) } \details{ @@ -77,7 +83,7 @@ time of the execution of the function). Checks are made before the actual launching of Tau-Argus: existence of the software on the computer, of the asc and rda files, of the folders where write the results, the variables to be used (crossings, response variable) in the -response variable) in the metadata (rda file). +response variable) in the metadata (rda file). \cr (Seul l’argument \code{arb_filename} est obligatoire, car toutes les informations nécessaires sont présentes dans ce fichier. diff --git a/man/tab_arb.Rd b/man/tab_arb.Rd index 899f48a..f37580b 100644 --- a/man/tab_arb.Rd +++ b/man/tab_arb.Rd @@ -2,131 +2,127 @@ % Please edit documentation in R/tab_arb.R \name{tab_arb} \alias{tab_arb} -\title{Crée un fichier batch (.arb) pour données tabulées} +\title{Create batch file (.arb) for tabular data in order to run Tau Argus +Crée un fichier batch (.arb) pour données tabulées exécutable par +Tau-Argus en ligne de commande.\cr} \usage{ tab_arb( arb_filename = NULL, tab_filename, rda_filename = NULL, + hst_filename = NULL, explanatory_vars, - response_var = getOption("rtauargus.response_var"), - shadow_var = NULL, - cost_var = NULL, + value = getOption("rtauargus.response_var"), safety_rules, suppress, - linked = getOption("rtauargus.linked"), output_names = NULL, output_type = getOption("rtauargus.output_type"), output_options = getOption("rtauargus.output_options"), - apriori = NULL, gointeractive = FALSE ) } \arguments{ -\item{arb_filename}{nom du fichier arb généré (avec -extension). Si non renseigné, un fichier temporaire.} +\item{arb_filename}{path of the arb filename, if unspecified, creates a temporary +file \cr +nom du fichier arb généré (avec extension). Si non renseigné, un fichier temporaire.} -\item{tab_filename}{[\strong{obligatoire}] nom du fichier .tab (avec extension).} +\item{tab_filename}{[\strong{obligatoire/mandatory}] path of the tab_filename, +nom du fichier .tab (avec extension).} \item{rda_filename}{rda file name (with .rda extension) \cr nom du fichier rda (avec extension)} -\item{explanatory_vars}{[\strong{obligatoire}] variables catégorielles, sous -forme de liste de vecteurs. Chaque élément de la liste est un vecteur des -noms des variables formant une tabulation. -Exemple : \code{list(c("CJ", "A21"), c("SEXE", "REGION"))} pour le premier -tableau croisant \code{CJ} x \code{A21} et le deuxième tableau croisant -\code{SEXE} x \code{REGION}. -Si une seule tabulation, un simple vecteur des variables à croiser est -accepté (pas besoin de \code{list(...)}).} - -\item{response_var}{variable de réponse à sommer, ou comptage si -\code{""}. Une seule valeur ou autant de valeurs que de tabulations.} - -\item{shadow_var}{variable(s) pour l'application du secret primaire. Si non -renseigné, \code{response_var} sera utilisé par Tau-Argus.} - -\item{cost_var}{variable(s) de coût pour le secret secondaire.} - -\item{safety_rules}{[\strong{obligatoire}] règle(s) de secret primaire. -Chaîne de caractères en syntaxe batch Tau-Argus. La pondération est traitée -dans un paramètre à part (ne pas spécifier WGT ici, utiliser le paramètre -\code{weighted}).} - -\item{suppress}{[\strong{obligatoire}] méthode(s) de gestion du secret -secondaire (syntaxe batch de Tau-Argus). Si la méthode est la même pour -chaque tabulation, le premier paramètre (numéro du tableau) sera ignoré et -renuméroté automatiquement (voir la section 'Syntaxe').} - -\item{linked}{pour traiter le secret secondaire conjointement sur toutes les -tabulations. Une seule commande suppress autorisée dans ce cas (appliquée à -tous les tableaux).} - -\item{output_names}{noms des fichiers en sortie. Si renseigné, -obligatoirement autant de noms de fichiers que de tabulations. Si laissé -vide, autant de noms de fichiers temporaires que de tabulations seront -générés.} - -\item{output_type}{format des fichiers en sortie (codification Tau-Argus). -Valeur par défaut du package : \code{"2"} (csv for pivot-table).} - -\item{output_options}{options supplémentaires des fichiers en sortie. Valeur -par défaut du package : \code{"AS+"} (affichage du statut). Pour ne -spécifier aucune option, \code{""}.} - -\item{apriori}{fichier(s) d'informations \emph{a priori}. Voir ci-dessous -pour la syntaxe.} - -\item{gointeractive}{pour avoir la possibilité de lancer le batch depuis le -menu de Tau-Argus (\code{FALSE} par défaut).} +\item{hst_filename}{Apriori file name, syntax detailed below, +Example : hst_filename = "path_to_file/apriori.hst" +fichier(s) d'informations \emph{a priori}. Voir ci-dessous +pour la syntaxe. Exemple : hst_filename = "path_to_file/apriori.hst"} + +\item{explanatory_vars}{[\strong{obligatoire/mandatory}] +Explanatory vars in a vector +Example : \code{c("CJ", "A21")} for the tabular \code{CJ} x \code{A21} +variables catégorielles, sous forme de vecteur. +Exemple : \code{c("CJ", "A21")} pour le premier +Pour un tableau croisant \code{CJ} x \code{A21}} + +\item{value}{Colname for response variable in the tabular +\code{""}. For frequency table \cr +Nom de la variable de réponse dans le tableau +\code{""}. Permet de tariter les tableaux de fréquence} + +\item{safety_rules}{[\strong{obligatoire/mandatory}] +Rules for primary suppression with Argus syntax, if the primary suppression +has been dealt with an apriori file specify manual safety range :"MAN(10)" +for example.\cr +Règle(s) de secret primaire. +Chaîne de caractères en syntaxe batch Tau-Argus. Si le secret primaire +a été traité dans un fichier d'apriori : utiliser "MAN(10)"} + +\item{suppress}{[\strong{obligatoire/mandatory}] +Algortihm for secondary suppression (Tau-Argus batch syntax), and the +parameters for it. +Algorithme de gestion du secret secondaire (syntaxe batch de Tau-Argus). +ainsi que les potentiels paramètres associés} + +\item{output_names}{output file name +nom du fichier en sortie.} + +\item{output_type}{Type of the output file (Argus codification) +By default \code{"2"} (csv for pivot-table). +For SBS files use \code{"4"} +Format des fichiers en sortie (codification Tau-Argus). +Valeur par défaut du package : \code{"2"} (csv for pivot-table). +Pour le format SBS utiliser \code{"4"}} + +\item{output_options}{Additionnal parameter for the output, +by default : code{"AS+"} (print Status). To specify no options : \code{""}. + options supplémentaires des fichiers en sortie. Valeur + par défaut du package : \code{"AS+"} (affichage du statut). Pour ne + spécifier aucune option, \code{""}.} + +\item{gointeractive}{Boolean, if TRUE will open a Tau-Argus window and launch +the batch in it (\code{FALSE} by default). \cr +Possibilité de lancer le batch depuis le menu de Tau-Argus (\code{FALSE} par défaut).} } \value{ -Une liste de deux éléments : le nom du fichier arb, les noms des +A list containing two elements : + the arb file name and the output name (usefull if the name is generated randomly) \cr + Une liste de deux éléments : le nom du fichier arb, le nom fichiers en sortie (utile pour récupérer les noms générés aléatoirement). } \description{ -Crée un fichier batch pour données tabulées, exécutable par Tau-Argus en ligne de -commande. -} -\details{ +Function doesn't check if the asc and rda files exists La fonction ne vérifie pas si les fichiers asc et rda existent. } \section{Syntaxe}{ -Tau-Argus peut traiter plusieurs tabulations pour un même jeu de -données. Passer une seule valeur pour une option appliquera le même -traitement à chaque tabulation. Pour des options différenciées, passer un -vecteur contenant autant de valeurs que de tabulations. Si les longueurs ne -correspondent pas (déconseillé), un recyclage est effectué. +For tabular data, this function secures only one table at a time\cr +Pour les données tabulées la fonction traite un tableau à la fois + +Unless specific details, use syntax from Tau-Argus manual \cr Sauf mention contraire, utiliser la syntaxe mentionnée dans la documentation de Tau-Argus. -Syntaxe spéciale pour \code{suppress} : le premier paramètre dans la -syntaxe Tau-Argus est le numéro de la tabulation. Si la méthode est identique -pour toutes les tabulations, ce premier paramètre sera ignoré et les numéros -recalculés automatiquement pour le batch. Dans l'écriture -\code{suppress = "GH(n,100)"}, n sera ainsi transformé en 1 pour la première -tabulation, en 2 pour la deuxième tabulation, etc. +Syntax pour \code{suppress} : +First parameter is the table number, in this case it will always be 1 \cr +Syntaxe spéciale pour \code{suppress} : +le premier paramètre dans la syntaxe Tau-Argus est le numéro du tableau. +Dans le cas de cette fonction ce sera toujours 1 } -\section{Identifiants des tableaux}{ +\section{Informations \emph{hst_filename}}{ -Si la liste \code{explanatory_vars} comporte des noms, ceux-ci seront -utilisés dans le batch pour donner un identifiant au tableau, sous la forme -d'une ligne de commentaire (\code{// "..."}). Ils seront -réutilisés par la fonction \code{import} pour nommer les tableaux formats R -en sortie. -} - -\section{Informations \emph{a priori}}{ +It's possible to add an apriori file (.hst) for a tabular, it can be generated +by the table_rda() function. -Il est possible de fournir un fichier a priori (.hst) pour chaque tabulation. +Other options are not mandatory. To modify default value use a vector with the +.hst file path as first element and then complete with those parameters : +\code{sep} for the separator, +\code{ignore_err} for IgnoreError and \code{exp_triv} for ExpandTrivial. \cr -La manière la plus simple est de passer un vecteur contenant autant de noms de -fichiers hst que de tabulations. Si le fichier est le même pour toutes les -tabulations, spécifier le nom de ce fichier (il sera utilisé pour toutes les -tabulations). +Il est possible de fournir un fichier apriori (.hst) pour un tableau, +il peut être fourni par la fonction table_rda() +Exemple : hst_filename = "mon_chemin/apriori.hst" \cr Les options supplémentaires sont facultatives. Pour modifier les valeurs par défaut, passer une liste ayant comme premier élément le(s) fichier(s) hst et @@ -136,24 +132,26 @@ Comme pour les noms de fichiers, spécifier une seule valeur par paramètre ou autant de valeurs que de tabulations. } -\section{Voir aussi}{ - +\section{See also}{ +NA } \examples{ \dontrun{ -# creation fichier arb +# creating arb file infos_arb <- tab_arb( - tab_filename = "donnees.tab", - explanatory_vars = list(c("REGION", "CJ"), c("REGION")), - response_var = c("CA", ""), - safety_rules = c("NK(1,85)|FREQ(3,10)", "FREQ(3,10)"), - suppress = "GH(.,100)", - output_names = c("tab1.csv", "~/tab2.csv"), - output_options = c("AS+SE+", "SE+"), - output_type = "2" + arb_filename = "path/tab1.arb", + tab_filename = "path/tab1.tab", + rda_filename = "path/tab1.rda", + explanatory_vars = c("REGION", "CJ"), + value = "CA", + safety_rules = "NK(1,85)|FREQ(3,10)", + suppress = "GH(1,100)", + output_names = "path/tab1.csv", + output_options = "AS+SE+", + output_type = "4" ) - +# show the content of the file in console # visualisation du contenu du fichier dans la console file.show(infos_arb$arb_filename, pager = "console") } diff --git a/man/tab_rda.Rd b/man/tab_rda.Rd index 50fc025..3129453 100644 --- a/man/tab_rda.Rd +++ b/man/tab_rda.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/tab_rda.R \name{tab_rda} \alias{tab_rda} -\title{Create rda files from tabulated data \cr +\title{Create rda files from tabular data \cr Crée les fichiers rda à partir de données tabulées} \usage{ tab_rda( @@ -12,20 +12,22 @@ tab_rda( hst_filename = NULL, explanatory_vars = NULL, secret_var = NULL, + cost_var = NULL, decimals = getOption("rtauargus.decimals"), hrc = NULL, hierleadstring = getOption("rtauargus.hierleadstring"), totcode = getOption("rtauargus.totcode"), - missing = getOption("rtauargus.missing"), codelist = NULL, value = NULL, freq = NULL, maxscore = NULL, - separator = "," + maxscore_2 = NULL, + maxscore_3 = NULL, + separator = getOption("rtauargus.separator") ) } \arguments{ -\item{tabular}{[\strong{obligatoire}] +\item{tabular}{[\strong{obligatoire/mandatory}] data.frame which contains the tabulated data and an additional boolean variable that indicates the primary secret of type boolean \cr data.frame contenant les données tabulées et @@ -40,73 +42,83 @@ nom du fichier rda (avec extension)} \item{hst_filename}{hst file name (with .hst extension) \cr nom du fichier hst (avec extension)} -\item{explanatory_vars}{[\strong{obligatoire}] Vector of categorical variables -\cr -Variables catégorielles, sous forme de liste de vecteurs - -Example : \code{list(c("A21", "TREFF", "REG")} +\item{explanatory_vars}{[\strong{obligatoire/mandatory}] Vector of explanatory variables \cr +Variables catégorielles, sous forme de vecteurs \cr +Example : \code{c("A21", "TREFF", "REG")} table crossing \code{A21} x \code{TREFF} x \code{REG}} \item{secret_var}{Boolean variable which give the primary secret : equal to "TRUE" if a cell is concerned by the primary secret,"FALSE" otherwise. -\cr -variable indiquant le secret primaire de type booléen: +will be exported in the apriori file \cr +(Variable indiquant le secret primaire de type booléen: prend la valeur "TRUE" quand les cellules du tableau doivent être masquées -par le secret primaire, "FALSE" sinon.} - -\item{decimals}{Minimum number of decimals to be displayed +par le secret primaire, "FALSE" sinon. Permet de créer un fichier d'apriori)} + +\item{cost_var}{Numeric variable allow to change the cost suppression of a cell +for secondary suppression, it's the value of the cell by default, can be +specified for each cell, fill with NA if the cost doesn't need to be changed +for all cells \cr +Variable numeric qui permet de changer la coût de suppression d'une cellule, +pris en compte dans les algorithmes de secret secondaire.Par défaut le coût +correspond à la valeur de la cellule. peut être spécifié pour chacune des cellules, +peut contenir des NA pour les coûts que l'on ne souhaite pas modifier} + +\item{decimals}{Minimum number of decimals to display (see section 'Number of decimals') \cr -nombre minimal de décimales à afficher (voir section 'Nombre -de décimales').} +(nombre minimal de décimales à afficher (voir section 'Number of decimals').)} -\item{hrc}{Informations on hierarchical variables (see section 'hierarchical -variable'). \cr -informations sur les variables hiérarchiques (voir section -'Variables hiérarchiques').} +\item{hrc}{Informations of hierarchical variables (see section +'Hierarchical variables'). \cr +(Informations sur les variables hiérarchiques (voir section +'Hierarchical variables').)#'} -\item{hierleadstring}{Character which, repeated n times, -indicates that the value is at n levels of depth in the hierarchy. \cr -caractère qui, répété n fois, indique que la valeur est -à n niveaux de profondeur dans la hiérarchie.} +\item{hierleadstring}{The character that is used to indicate the depth of a +code in the hierarchy. \cr +(Caractère qui, répété n fois, indique que la valeur est +à n niveaux de profondeur dans la hiérarchie.)#'} \item{totcode}{Code(s) which represent the total of a categorical variable -(see section 'Specific parameters' for the syntax of this parameter). -Variables not specified (neither by default nor explicitly) -will be assigned the value of \code{rtauargus.totcode}.\cr -code(s) pour le total d'une variable catégorielle (voir -section 'Paramètres spécifiques' pour la syntaxe de ce paramètre). Les +(see section 'Specific parameters' for this parameter's syntax). +If unspecified for a variable(neither by default nor explicitly) +it will be set to \code{rtauargus.totcode}. \cr +(Code(s) pour le total d'une variable catégorielle (voir +section 'Specific parameters' pour la syntaxe de ce paramètre). Les variables non spécifiées (ni par défaut, ni explicitement) se verront -attribuer la valeur de \code{rtauargus.totcode}.} +attribuer la valeur de \code{rtauargus.totcode}.)#'} -\item{missing}{Code(s) for a missing value (see section 'Specific parameters' -for the syntax of this parameter). \cr -code(s) pour une valeur manquante (voir section -'Paramètres spécifiques' pour la syntaxe de ce paramètre).} - -\item{codelist}{file(s) containing labels of the categorical variables -(see section 'Specific parameters' for the syntax of this parameter).\cr -fichier(s) contenant les libellés des variables catégorielles -(voir section 'Paramètres spécifiques' pour la syntaxe de ce paramètre).} +\item{codelist}{file(s) containing labels of a categorical variables +(see section 'Specific parameters' for the syntax of this parameter). \cr +(Fichier(s) contenant les libellés des variables catégorielles +(voir section 'Specific parameters' pour la syntaxe de ce paramètre).)} \item{value}{Name of the column containing the value of the cells. \cr -nom de la colonne contenant la valeur des cellules} +(Nom de la colonne contenant la valeur des cellules)} + +\item{freq}{Name of the column containing the cell frequency. \cr +(Nom de la colonne contenant les effectifs pour une cellule)#'} -\item{freq}{Name of the column containing the the numbers for a cell. \cr -Nom de la colonne contenant les effectifs pour une cellule} +\item{maxscore}{Name of the column containing, the value of the largest +contributor of a cell. \cr +(Nom de la colonne contenant la valeur du plus gros contributeur +d'une cellule)} -\item{maxscore}{Name of the column containing -the value of the largest contributor of a cell. \cr +\item{maxscore_2}{Name of the column containing, the value of the second largest +contributor to a cell. \cr +(Nom de la colonne contenant la valeur du deuxième plus gros contributeur +d'une cellule)} -Nom de la colonne contenant la valeur du plus gros contributeur -d'une cellule} +\item{maxscore_3}{Name of the column containing, the value of the third largest +contributor to a cell. \cr +(Nom de la colonne contenant la valeur du troisième plus gros contributeur +d'une cellule)} -\item{separator}{character used as separator in the .tab file. \cr -caractère utilisé en tant que separateur dans le fichier .tab} +\item{separator}{Character used as separator in the .tab file. \cr +(Caractère utilisé en tant que separateur dans le fichier .tab)} } \value{ Return the rda file name as a list (invisible).\cr -Renvoie le nom du fichier rda sous forme de liste (de -manière invisible). +(Renvoie le nom du fichier rda sous forme de liste (de +manière invisible).) } \description{ Create an apriori file for the primary secret, @@ -123,16 +135,16 @@ un fichier tabular (tab) et un fichier de métadonnées The apriori file (.hst) summarizes for each value of the table if they are concerned by the primary secret or not. -With this file tauargus will not need to set the primary secret itself. +With this file tau-argus will not need to set the primary secret itself. The parameter \code{secret_var} indicates the name of the primary secret variable. If there is the additional boolean variable which indicates the primary secret in the table (of tabulated data), the function tab_rda will create -an apriori file in a format conforming to tauargus.\cr +an apriori file in a format conforming to tauargus. \cr Le fichier d'apriori (.hst) récapitule pour chaque valeurs du tableau si elles sont concernées par le secret primaire ou non. -Avec ce fichier tauargus n'aura plus besoin de poser le secret primaire lui même, +Avec ce fichier tau-argus n'aura plus besoin de poser le secret primaire lui même, il se basera sur le fichier d'apriori pour le faire. Le paramètre \code{secret_var} indique le nom de la variable du secret primaire. Si l'on rajoute cette variable supplémentaire indiquant @@ -143,46 +155,56 @@ tab_rda permet de créer un fichier d'apriori au format conforme pour tauargus. \section{Specific parameters}{ -The parameters \code{totcode}, \code{missing} and \code{codelist} +The parameters \code{totcode}, and \code{codelist} must be given in the form of a vector indicating the value to take for each variable. The names of the elements of the vector give the variable concerned and the elements of the vector give the value of the parameter for Tau-Argus. -An unnamed element will be the default value.\cr +An unnamed element will set the default value for each variable. \cr -Les paramètres \code{totcode}, \code{missing} et \code{codelist} +(Les paramètres \code{totcode}, et \code{codelist} sont à renseigner sous la forme d'un vecteur indiquant la valeur à prendre pour chaque variable. Les noms des éléments du vecteur donnent la variable concernée, les éléments du vecteur donnent la valeur du paramètre pour Tau-Argus. Un élément non nommé constituera la valeur par défaut, qui sera attribuée à toutes les -variables pouvant prendre ce paramètre. +variables pouvant prendre ce paramètre.) For example : \itemize{ + \item{\code{totcode = "global"} : writes \code{ "global"} for each + explanatory vars} + \item{\code{totcode = c("global", size="total", income="total")} : + \code{ "global"} for each variable except for \code{size} and + \code{income}} assigned with \code{ "total"} + by default : { "Total"} \item{\code{totcode = "global"} : écrit \code{ "global"} pour toutes les variables catégorielles} \item{\code{totcode = c("global", size="total", income="total")} : - idem, sauf pour les variables \code{size}et \code{income}} + \code{ "global"} pour toutes les variables catégorielles + sauf \code{size} and \code{income}} qui se verront affecter + le total : \code{ "total"} + Par defaut : { "Total"} } } \section{Hierarchical variables}{ -Parameter \code{hrc} has the same syntax as \code{totcode},\code{missing} and +Parameter \code{hrc} has the same syntax as \code{totcode} and \code{codelist} (named vector containing as many elements as variables to describe). Hierarchy is defined in an separate hrc file (\strong{hiercodelist}). which can be written with the function \code{link{write_hrc2}}. The function expects the location of this file (and a possible \code{hierleadstring} -if it differs from the default option of the package). +if it differs from the default option of the package : @. The path to the existing file is explicitly given. The elements of the vector in parameter must be named (with the name of the variable), -even if there is only one element -emph{Example :}\code{c(category="category.hrc")} +even if there is only one element. + +emph{Example :}\code{c(category="category.hrc")} \cr -Le paramètre \code{hrc} obéit aux mêmes règles de syntaxe que \code{totcode}, -\code{missing} et \code{codelist} (vecteur nommé contenant autant d'éléments +(Le paramètre \code{hrc} obéit aux mêmes règles de syntaxe que \code{totcode} + et \code{codelist} (vecteur nommé contenant autant d'éléments que de variables à décrire). La hiérarchie est définie dans un fichier hrc à part (\strong{hiercodelist}) @@ -192,9 +214,9 @@ La fonction attend l'emplacement de ce fichier (et un éventuel \code{hierleadst s'il diffère de l'option par défaut du package). Le chemin vers le fichier existant est explicitement donné. Les éléments du vecteur en paramètre doivent nommés (avec le nom de la variable), -même s'il n'y a qu'un seul -élément. -\emph{Exemple :}\code{c(category="category.hrc")} +même s'il n'y a qu'un seul élément. + +\emph{Exemple :}\code{c(category="category.hrc")}) } \section{Number of decimals}{ @@ -205,16 +227,16 @@ include in the output file It applies to all real variables (double) but not to integer variables. To add zeros to an integer variable, convert it with \code{as.double} beforehand.\cr -Le paramètre \code{decimals} indique le nombre minimal de décimales à faire +(Le paramètre \code{decimals} indique le nombre minimal de décimales à faire figurer dans le fichier en sortie (quel que soit le nombre de décimales effectivement présent dans \code{tabular}). Il s'applique à toutes les variables réelles (double) mais pas aux variables entières (integer). Pour ajouter des zéros à une variable entière, la convertir avec \code{as.double} -au préalable. +au préalable.) } -\section{Voir aussi}{ - +\section{See also}{ +NA } \examples{ @@ -228,7 +250,8 @@ area = c( "07", "01", "04", "06", "02", "06"), income = c( 100, 4, 7, 14, 42, 85), freq = c( 2, 6, 8, 45, 100, 1), max = c( 54, 2, 1, 13, 19, 85), -primary_secret = c( TRUE, FALSE, FALSE, TRUE, FALSE, TRUE) +primary_secret = c( TRUE, FALSE, FALSE, TRUE, FALSE, TRUE), +cost = c( NA, NA, NA, 1, 5, NA) ) # rda creation @@ -242,11 +265,11 @@ files_names <- hrc = c(category = "category.hrc"), explanatory_vars = c("category" , "size", "area"), secret_var = "primary_secret", + cost_var = "cost" totcode = c( category = "global", size = "total", - area = "global", - income = "total" + area = "global" ), value = "income", freq = "freq" diff --git a/man/tab_rtauargus.Rd b/man/tab_rtauargus.Rd new file mode 100644 index 0000000..126b6a7 --- /dev/null +++ b/man/tab_rtauargus.Rd @@ -0,0 +1,166 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/tab_rtauargus.R +\name{tab_rtauargus} +\alias{tab_rtauargus} +\title{Title} +\usage{ +tab_rtauargus( + tabular, + files_name = NULL, + dir_name = NULL, + explanatory_vars, + totcode, + hrc = NULL, + secret_var = NULL, + cost_var = NULL, + value = "value", + freq = "freq", + maxscore = NULL, + safety_rules = "MAN(10)", + suppress = "MOD(1,5,1,0,0)", + show_batch_console = FALSE, + output_type = 4, + output_options = "", + unif_hrc = TRUE, + unif_expl = TRUE, + ... +) +} +\arguments{ +\item{tabular}{[\strong{obligatoire/mandatory}] +data.frame which contains the tabulated data and +an additional boolean variable that indicates the primary secret of type boolean \cr +data.frame contenant les données tabulées et +une variable supplémentaire indiquant le secret primaire de type booléen} + +\item{files_name}{string used to name all the files needed to process. +All files will have the same name, only their extension will be different.} + +\item{dir_name}{string indicated the path of the directory in which to save +all the files (.rda, .hst, .txt, .arb, .csv) generated by the function.} + +\item{explanatory_vars}{[\strong{obligatoire/mandatory}] Vector of explanatory variables \cr +Variables catégorielles, sous forme de vecteurs \cr +Example : \code{c("A21", "TREFF", "REG")} +table crossing \code{A21} x \code{TREFF} x \code{REG}} + +\item{totcode}{Code(s) which represent the total of a categorical variable +(see section 'Specific parameters' for this parameter's syntax). +If unspecified for a variable(neither by default nor explicitly) +it will be set to \code{rtauargus.totcode}. \cr +(Code(s) pour le total d'une variable catégorielle (voir +section 'Specific parameters' pour la syntaxe de ce paramètre). Les +variables non spécifiées (ni par défaut, ni explicitement) se verront +attribuer la valeur de \code{rtauargus.totcode}.)#'} + +\item{hrc}{Informations of hierarchical variables (see section +'Hierarchical variables'). \cr +(Informations sur les variables hiérarchiques (voir section +'Hierarchical variables').)#'} + +\item{secret_var}{Boolean variable which give the primary secret : equal to +"TRUE" if a cell is concerned by the primary secret,"FALSE" otherwise. +will be exported in the apriori file \cr +(Variable indiquant le secret primaire de type booléen: +prend la valeur "TRUE" quand les cellules du tableau doivent être masquées +par le secret primaire, "FALSE" sinon. Permet de créer un fichier d'apriori)} + +\item{cost_var}{Numeric variable allow to change the cost suppression of a cell +for secondary suppression, it's the value of the cell by default, can be +specified for each cell, fill with NA if the cost doesn't need to be changed +for all cells \cr +Variable numeric qui permet de changer la coût de suppression d'une cellule, +pris en compte dans les algorithmes de secret secondaire.Par défaut le coût +correspond à la valeur de la cellule. peut être spécifié pour chacune des cellules, +peut contenir des NA pour les coûts que l'on ne souhaite pas modifier} + +\item{value}{Name of the column containing the value of the cells. \cr +(Nom de la colonne contenant la valeur des cellules)} + +\item{freq}{Name of the column containing the cell frequency. \cr +(Nom de la colonne contenant les effectifs pour une cellule)#'} + +\item{maxscore}{Name of the column containing, the value of the largest +contributor of a cell. \cr +(Nom de la colonne contenant la valeur du plus gros contributeur +d'une cellule)} + +\item{safety_rules}{[\strong{obligatoire/mandatory}] +Rules for primary suppression with Argus syntax, if the primary suppression +has been dealt with an apriori file specify manual safety range :"MAN(10)" +for example.\cr +Règle(s) de secret primaire. +Chaîne de caractères en syntaxe batch Tau-Argus. Si le secret primaire +a été traité dans un fichier d'apriori : utiliser "MAN(10)"} + +\item{suppress}{[\strong{obligatoire/mandatory}] +Algortihm for secondary suppression (Tau-Argus batch syntax), and the +parameters for it. +Algorithme de gestion du secret secondaire (syntaxe batch de Tau-Argus). +ainsi que les potentiels paramètres associés} + +\item{show_batch_console}{to display the batch progress in the +console. \cr +(pour afficher le déroulement du batch dans la + console.)} + +\item{output_type}{Type of the output file (Argus codification) +By default \code{"2"} (csv for pivot-table). +For SBS files use \code{"4"} +Format des fichiers en sortie (codification Tau-Argus). +Valeur par défaut du package : \code{"2"} (csv for pivot-table). +Pour le format SBS utiliser \code{"4"}} + +\item{output_options}{Additionnal parameter for the output, +by default : code{"AS+"} (print Status). To specify no options : \code{""}. + options supplémentaires des fichiers en sortie. Valeur + par défaut du package : \code{"AS+"} (affichage du statut). Pour ne + spécifier aucune option, \code{""}.} + +\item{unif_hrc}{boolean, if hrc files have to be standardized (especially for internal use)} + +\item{unif_expl}{boolean, if explanatory variables have to be standardized (especially for internal use)} + +\item{...}{any parameter of the tab_rda, tab_arb or run_arb functions, relevant +for the treatment of tabular.} +} +\value{ +If output_type equals to 4, then the original tabular is returned with a new +column called Status, indicating the status of the cell coming from Tau-Argus : +"A" for a primary secret due to frequency rule, "B" for a primary secret due +to dominance rule, "D" for secondary secret and "V" for no secret cell. + +If output_type doesn't equal to 4, then the raw result from tau-argus is returned. +} +\description{ +Title +} +\details{ + +} +\examples{ +#DON'T RUN +library(dplyr) +tabular_leg <- table_legumes_sp \%>\% mutate(n_obs = round(n_obs)) \%>\% +select(ACTIVITY, treff, type_leg, tot, n_obs, max, is_secret_prim) +res <- tab_rtauargus( +tabular = tabular_leg, +files_name = "legumes_rouges", +dir_name = "tauargus_files", +explanatory_vars = c("ACTIVITY", "treff", "type_leg"), +hrc = c(ACTIVITY = "legumes.hrc"), +totcode = c(ACTIVITY = "Ensemble", treff = "Ensemble", type_leg="rouges"), +secret_var = "is_secret_prim", +value = "tot", +freq = "n_obs", +output_type = "4", +output_options = "", +is_tabular = TRUE, +show_batch_console = FALSE, +import = FALSE, +separator = ",", +verbose = FALSE, +unif_hrc = TRUE, +unif_expl = TRUE +) +} diff --git a/man/write_hrc2.Rd b/man/write_hrc2.Rd new file mode 100644 index 0000000..6ee9a3f --- /dev/null +++ b/man/write_hrc2.Rd @@ -0,0 +1,302 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/writehrc.R +\name{write_hrc2} +\alias{write_hrc2} +\title{.hrc writing} +\usage{ +write_hrc2( + corr_table, + output_name = NULL, + dir_name = NULL, + sort_table = FALSE, + rev = FALSE, + hier_lead_string = getOption("rtauargus.hierleadstring"), + adjust_unique_roots = FALSE, + add_char = "ZZZ" +) +} +\arguments{ +\item{corr_table}{Data frame. Correspondence table, from most aggregated to most detailed +\cr +Table de correspondance, du plus agrégé au plus fin} + +\item{output_name}{character string. Name for the output file (with no +extension) ; default is set to the same name as the correspondence table +\cr +Nom du fichier en sortie (sans extension) ; par défaut, +identique au nom de la table de correspondance} + +\item{dir_name}{character string. Directory name for the hrc file +\cr +Nom du répertoire dans lequel écrire le fichier hrc} + +\item{sort_table}{boolean. If TRUE, table will be sorted beforehand. +(default to FALSE)\cr +Si TRUE, la table sera triée avant traitement. (défaut à FALSE)} + +\item{rev}{boolean. If TRUE, column order is reversed.\cr +Si TRUE, inverse l'ordre des colonnes.} + +\item{hier_lead_string}{character. (Single) character indicating the +hierarchy depth in the .hrc file +\cr +Caractère unique repérant le niveau de profondeur dans le .hrc} + +\item{adjust_unique_roots}{boolean. If TRUE will add fictional roots to the +correspondence table, by doing so there will be no unique roots in the hrc file. +With tabular function, unique roots are not handled by Tau-Argus. \cr +Si TRUE la fonction va ajouter des feuilles fictives au fichier .hrc afin +qu'il n'y ait plus de feuilles uniques. Les feuilles uniques peuvent générer +des problèmes dans l'exécution de Tau-Argus} + +\item{add_char}{character If adjust_unique_roots is TRUE add_char is the string that will +be used to create fictional roots, be sure that this string does not create +duplicates.The string will be paste at the beginning of a unique root + default = "ZZZ" \cr +character Si adjust_unique_roots est TRUE add_char est l'élément qui sera +utilisé afin de créer des feuilles fictives, il faut être sur que cela +ne crée pas de doublons dans la hiérarchie.La chaine de caractère sera +ajouté au début d'une feuille unique. Par defaut :"ZZZ"} +} +\value{ +Invisible. Path to the written .hrc file. +\cr +Chemin vers le fichier .hrc. +} +\description{ +Creates a .hrc hierarchy from a correspondence table. \cr +Ecrit une hiérarchie .hrc à partir d'une table de correspondance. +} +\details{ +Creates a .hrc hierarchy file adapted to tau-Argus from a +correspondence table fully describing it. By default, lines are sorted +alphabetically so as to regroup identical levels. + +Ecrit un fichier de hiérarchie .hrc lisible par tau-Argus à +partir d'une table de corrrespondance la décrivant complètement. Par défaut, +les lignes du tableau seront triées afin de regrouper les niveaux de +hiérarchie identiques. +} +\section{Details about correspondence table & .hrc}{ + +Hierarchy files read by tau-Argus are expected to follow a strict pattern. +This function mimicks some of its rigidities. +\cr + +1 \strong{Ideal case} + +Here is how a correspondence table is assumed to look like: + +| (**type**) | (**details**) | +|--------|------------| + | planet | telluric | + | planet | gasgiant | + | star | bluestar | + | star | whitedwarf | + | star | browndwarf | + | other | blackhole | + | other | pulsar | + + +Columns must be ordered from most aggregated to most detailed. +If they are in reverse order, you may want to use rev = TRUE. In any other +case, please reorder columns by hand.\cr + +Hierarchy must be well-nested : fine levels must systematically be nested +into unique higher levels. If this is not compatible with your situation, +you will have to split it in different hierarchies and insure common cells +are correctly protected (seek further documentation or help if needed). +\cr + +2 \strong{Dealing with NAs} + +The write_hrc2 function has to be preferably used without any NAs in your +correspondence table. In presence of NAs, the \strong{sort} argument +has to be to FALSE. Indeed, NAs would be sorted together and, thus, +be separated from their expected place in the hierarchy. + +Below, we introduce two common cases where correspondence tables could have +NAs. The first one is supported by the function, the second one is not. + +Please be careful when dealing with NAs and check thoroughly the +resulting .hrc file, or consider filling in NAs beforehand. + +2.1 \emph{Sparse hierarchies} \cr +Hierarchy is sparse when NAs are inserted instead of repeating under a given +level. + +| (**type**) | (**details**) | +|--------|------------| +| planet | telluric | +| | gasgiant | +| star | bluestar | +| | whitedwarf | +| | reddwarf | +| other | blackhole | +| | pulsar | + +Such cases still issue a warning for the presence of NAs, but do not pose +any problem, if \strong{sort=FALSE} is set. + +2.2 \emph{Non-uniform hierarchies}\cr +Hierarchies with non-uniform depth happen when some levels are not detailed +to the lowest detail, creating NAs. + +| (**type**) | (**details**) | +|--------|------------| + | planet | telluric | + | planet | gasgiant | + | star | | + | other | blackhole | + | other | pulsar | + +Processing such a file will generate an error with the following messages: +\emph{Missing values on the last column of the correspondence table is not allowed. +If relevant, you could fill in with the value of the previous column} +} + +\section{Détails sur les tables de correspondance et le .hrc}{ + +Tau-Argus attend des fichiers écrits avec précision. Certaines de ses +rigidités sont reproduites par cette fonction. +\cr + +1 \strong{Cas idéal} + +Voici l'aspect général que devrait avoir une table de correspondance : + +| (**type**) | (**details**) | +|--------|------------| + | planet | telluric | + | planet | gasgiant | + | star | bluestar | + | star | whitedwarf | + | star | browndwarf | + | other | blackhole | + | other | pulsar | + +Les colonnes doivent être ordonnées du niveau le plus agrégé au plus fin. +Si elles sont en sens inverse, l'option rev = TRUE permet de les mettre en +ordre. Dans toute autre situation, vous devrez d'abord les ordonner à la +main. +\cr + +La hiérarchie doit être bien emboîtée : un niveau fin doit systématiquement +correspondre à un unique niveau agrégé. Si cette exigence n'est pas remplie, +il faudra créer plusieurs hiérarchies et faire en sorte que les cellules +communes soient correctement protégées (au besoin, consultez la documentation +ou chercher de l'aide). +\cr + +2 \strong{Valeurs manquantes} + +La fonction write_hrc2 doit être utilisée de préférence sans aucun NA dans votre +table de correspondance. En présence de NAs, l'argument \strong{sort} +doit être à FALSE. En effet, les NAs seraient triés ensemble et, donc, +être séparées de leur place attendue dans la hiérarchie. + +Ci-dessous, nous présentons deux cas courants où les tables de correspondance +pourraient avoir NAs. Le premier cas est pris en charge par la fonction, +le second ne l'est pas. + +Soyez prudent lorsque vous manipulez des NA et vérifiez soigneusement +le fichier .hrc résultant ou envisagez de remplir les NAs à l'avance. + +2.1 \emph{Hiérarchies creuses} \cr +Une hiérarchie est creuse si des NAs sont insérées au lieu de répéter un +niveau donné verticalement. + +| (**type**) | (**details**) | +|--------|------------| +| planet | telluric | +| | gasgiant | +| star | bluestar | +| | whitedwarf | +| | reddwarf | +| other | blackhole | +| | pulsar | + +De tels cas émettent toujours un avertissement du fait de la présence de NA, +mais ne posent aucun problème, si on utilise \strong{sort=FALSE}. + +2.2 \emph{Hiérarchies non-uniformes}\cr +Les hiérarchies à profondeur non-uniforme correspondent aux cas où certains +niveaux ne sont pas détaillés jusqu'au bout, la fin de certaines lignes étant +manquante. + +| (**type**) | (**details**) | +|--------|------------| + | planet | telluric | + | planet | gasgiant | + | star | | + | other | blackhole | + | other | pulsar | + +Le traitement d'un tel fichier générera une erreur avec les messages suivants : +\emph{Missing values on the last column of the correspondence table is not allowed. +If relevant, you could fill in with the value of the previous column} +} + +\examples{ +# 1. Standard example. Table will be written on your working directory. +# Exemple standard. La table sera écrite dans votre répertoire de travail. +astral <- data.frame( + type = c("planet", "planet", "star", "star", "star", "other", "other"), + details = c("telluric", "gasgiant", "bluestar", "whitedwarf", "reddwarf", "blackhole", "pulsar") +) +path <- write_hrc2(astral, hier_lead_string = "@") +read.table(path) +# Note that line order was changed ('other' comes before 'planet'), to no +# consequence whatsoever for Tau-Argus. +# Remarque : l'ordre des lignes a été modifié ('other' arrive avant 'planet'), +# ce qui n'a aucune conséquence pour Tau-Argus. + +# Wrong column order: +# Mauvais ordonnancement des colonnes : +astral_inv <- data.frame( + details = c("telluric", "gasgiant", "bluestar", "whitedwarf", "reddwarf", "blackhole", "pulsar"), + type = c("planet", "planet", "star", "star", "star", "other", "other") +) +path <- write_hrc2(astral_inv, hier_lead_string = "@") +read.table(path) +# Because of the inverted order, everything is written backwards : planet is a +# subtype of gasgiant, etc. +# À cause de l'inversion des colonnes, tout est écrit à l'envers : planet est +# devenu une sous-catégorie de gasgiant, par exemple. + +# Correction : +path <- write_hrc2(astral_inv, rev = TRUE, hier_lead_string = "@") +read.table(path) + +# 2.1 Sparse case +# Cas creux +astral_sparse <- data.frame( + type = c("planet", NA, "star", NA, NA, "other", NA), + details = c("telluric", "gasgiant", "bluestar", "whitedwarf", "reddwarf", "blackhole", "pulsar") +) +# NAs in general are risky, but, in this case, the function works well. +# Les valeurs manquantes causent un risque, mais, dans ce genre de cas, la fonction +a le comportement attendu. +path <- write_hrc2(astral_sparse, hier_lead_string = "@") +read.table(path) + +# 2.2 Non-uniform depth +# Hiérarchie non-uniforme +astral_nu <- data.frame( + type = c("planet", "planet", "star", "other", "other"), + details = c("telluric", "gasgiant", NA, "blackhole", "pulsar") +) +# The following code will generate an error +# (see section Details about correspondence table & .hrc) +path <- write_hrc2(astral_nu, hier_lead_string = "@") +To fix the issue, you have to fill in the NAs beforehand. + +astral_nu_fill <- data.frame( + type = c("planet", "planet", "star", "other", "other"), + details = c("telluric", "gasgiant", "star", "blackhole", "pulsar") +) +# The following code will work +path <- write_hrc2(astral_nu_fill, hier_lead_string = "@") +read.table(path) + +} From 55db5e18fe935215a430e8dc894acc862b477d6b Mon Sep 17 00:00:00 2001 From: julienjamme Date: Sun, 21 Aug 2022 00:32:48 +0200 Subject: [PATCH 032/107] linked tables management - init --- R/multitable.R | 266 +++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 266 insertions(+) create mode 100644 R/multitable.R diff --git a/R/multitable.R b/R/multitable.R new file mode 100644 index 0000000..05a75e1 --- /dev/null +++ b/R/multitable.R @@ -0,0 +1,266 @@ +library(dplyr) +# source("fonction_traiter2.R") # fonction qui ajoute du "secret" au hasard +# #source("fonction_traiter0.R") # fonction qui appelle tau-argus + +multi_linked_tables <- function( + liste_tbx, + list_explanatory_vars, + list_hrc, + value = "value", + freq = "freq", + maxscore = "maxscore", + is_secret_primaire = "is_secret_primaire", + num_iter_max = 1000, + totcode = "total", + indice_depart_tableau = 1 +){ + + #' Attendu : + #' - liste_tbx : une liste de tableaux à secrétiser + #' - list_explanatory_vars : une liste de même longueur, où + #' list_explanatory_vars[[j]] = c(...les noms des vars catégorielles du tableau j...) + #' - freq, maxscore, is_secret_primaire : les colonnes de travail pour tau-Argus + #' - totcode : c'est important que le code des totaux soit le même dans toutes les + #' tables et pour toutes les variables + #' - indice_depart_tableau : par quel n° de tableau on commence. Si un jour on a une + #' idée pertinente sur comment choisir d'où on commence, il faudrait aussi l'implémenter + #' dans la suite du code : quand on ajoute 3 trucs à la file, dans quel ordre ; quand + #' on va piocher un tableau oublié, par lequel on commence ; etc. + + ############################################################################ + ############################################################################ + ####### === A === INITIALISATION + + n_tbx = length(liste_tbx) # nombre de tableaux + if(is.null(names(liste_tbx))){ + names(liste_tbx) <- paste0("tab", 1:n_tbx) + names(list_explanatory_vars) <- paste0("tab", 1:n_tbx) + names(list_hrc) <- paste0("tab", 1:n_tbx) + } + noms_tbx <- names(liste_tbx) + # 1. Mise en forme préalable + + noms_vars_init <- c() + for (tab in liste_tbx){ + noms_vars_init <- c(noms_vars_init, names(tab)) + } + noms_vars_init <- noms_vars_init[!duplicated(noms_vars_init)] + + table_majeure <- purrr::imap( + .x = liste_tbx, + .f = function(tableau,nom_tab){ + var_a_ajouter <- setdiff(noms_vars_init, names(tableau)) + for (nom_col in var_a_ajouter){ + tableau[[nom_col]] <- totcode + } + + tableau <- tableau %>% + relocate(all_of(value), + all_of(is_secret_primaire), + all_of(freq), + all_of(maxscore), .after = last_col()) + + nom_col_Tj <- paste0("T_", nom_tab) + tableau[[nom_col_Tj]] <- TRUE + + return(tableau) + } + ) + table_majeure <- purrr::reduce(.x = table_majeure, + .f = full_join) + + noms_cols_corres <- setdiff(names(table_majeure),noms_vars_init) + liste_pour_na <- as.list(rep(F,length(noms_cols_corres))) + names(liste_pour_na) <- noms_cols_corres + + table_majeure[noms_cols_corres] <- tidyr::replace_na(table_majeure[noms_cols_corres], + replace = liste_pour_na) + + + # 2. Préparation des listes de travail + # i0 = indice_depart_tableau + # num du tableau par lequel commencer + # i0 <- trouver_meilleur_point_de_depart() + + todolist <- noms_tbx #list() + # todolist[[1]] <- noms_tbx[i0] + # en fait la todolist va juste contenir des numéros de tableaux + + # oublis <- list() + # oublis <- as.list(noms_tbx[-i0]) #1:n_tbx + # oublis[i0] <- NULL + + ############################################################################ + ############################################################################ + ####### === B === ITÉRATIONS + + num_iter = 1 + journal = list() + + while (length(todolist) > 0 & num_iter <= num_iter_max){ + + num_tableau <- todolist[1] + cat("\n ##### Traitement tableau ", num_tableau, " ###########\n") + # nom_tableau <- names() + nom_col_identifiante <- paste0("T_", num_tableau) + tableau_a_traiter <- which(table_majeure[[nom_col_identifiante]]) + + # rappel : "todolist[[1]]" est un numéro (de tableau) ; + # corresp[,num_tableau] est une colonne donnant, pour chaque ligne de nrow(table_majeure), + # which(corresp...) est donc l'ens. des indices des lignes du tableau n°num_tableau + + # if (num_tableau %in% oublis) oublis[[which(oublis == num_tableau)]] <- NULL + + + # 0. juste pour le journal : + souvenir_todolist <- todolist + + + # 1. Traiter & récupérer le masque + # nom_nouveau_masque <- paste0("is_secret_aj_",num_iter, collapse = "") + # nom_ancien_masque <- ifelse( + # num_iter > 1, + # paste0("is_secret_aj_", num_iter-1, collapse = ""), + # is_secret_primaire + # ) + # table_majeure[[nom_nouveau_masque]] <- table_majeure[[nom_ancien_masque]] + + var_secret_apriori <- ifelse( + num_iter > 1, + paste0("is_secret_", num_iter-1, collapse = ""), + is_secret_primaire + ) + vrai_tableau <- table_majeure[tableau_a_traiter,] + + ex_var <- list_explanatory_vars[[num_tableau]] + + vrai_tableau <- vrai_tableau %>% + select(all_of(c(ex_var, value, freq, maxscore, var_secret_apriori ))) + + res <- traiter( + vrai_tableau, + explanatory_vars = ex_var, + hrc = list_hrc[[num_tableau]], + # value, + # freq, + # maxscore, + secret_var = var_secret_apriori, + totcode = totcode + ) + var_secret <- paste0("is_secret_", num_iter) + table_majeure <- merge(table_majeure, res, all = TRUE) + table_majeure[[var_secret]] <- table_majeure$is_secret + table_majeure <- table_majeure[,names(table_majeure) != "is_secret"] + # Rappel : traiter(...) renvoie un masque de secret (une colonne de booléens) + # avec une ligne pour chaque ligne du tableau d'origine + + # Rmq : ici on crée juste à chaque étape une nouvelle colonne de secret ajusté + # global. On ne crée pas la colonne intermédiaire avec masque local + des NA. + # TODO si c'est nécessaire. + + # 2. Propager + + # var_secret_aj <- paste0("is_secret_aj_", num_iter) + table_majeure[[var_secret]] <- ifelse( + is.na(table_majeure[[var_secret]]), + table_majeure[[var_secret_apriori]], + table_majeure[[var_secret]] + ) + + lignes_modifs <- which(table_majeure[[var_secret_apriori]] != table_majeure[[var_secret]]) + + for (tab in noms_tbx){ + # pour tout tableau j, si j n'est pas déjà dans la todolist + # et s'il y a au moins 1 ligne de j qui a été modifiée, ajouter j à la todolist + nom_col_identifiante <- paste0("T_", tab) + if (! (tab %in% todolist) + & (any(table_majeure[[nom_col_identifiante]][lignes_modifs])) + ) # TODO parenthéser la négation + todolist <- append(todolist,tab) + } + + todolist <- todolist[-1] + # Rmq : à ce stade, todolist[[1]] est le tableau qu'on est en train de + # traiter, donc son numéro ne va pas être ajouté à la todolist même si + # (évidemment) les lignes modifiées lui appartiennent. + + # Rmq : c'est optimisé comme un tractopelle sur un circuit de formule 1 + + #Intermède : update du journal + # on enlève de la file ce tableau + + # 3. Sonder + # if (length(todolist) == 0 & length(oublis) > 0){ + # todolist[1] <- oublis[1] + # oublis[1] <- NULL + # } + # journal[[paste0("step_",num_iter)]] <- + # list( + # explique = paste0( + # "Le tableau en cours est le ", + # num_tableau, + # # ". Au debut de l'etape, la file contenait [", + # # paste(unlist(souvenir_todolist), collapse = ", "), + # # "] et maintenant elle contient [", + # # paste(unlist(todolist), collapse = ", "), + # # "]. Cette etape a modifie ", length(lignes_modifs), " lignes. ", + # # "Tableaux non visites : ", + # # ifelse(length(oublis) > 0, + # # paste(unlist(oublis), collapse = ", "), + # # "(plus aucun)") + # collapse = " "), + # tableau_en_cours = num_tableau + # # lignes_concernees = tableau_a_traiter, + # # lignes_touchees = lignes_modifs + # ) + + num_iter <- num_iter+1 + } + + cat("End of iterating after ", num_iter, " iterations\n") + ############################################################################ + ############################################################################ + ####### === C === FINALISATION + + # names(table_majeure)[ncol(table_majeure)] <- "is_secret_final" + # + # # Calcul des stats de secret en nombre de cases touchées & en valeur totale + # valeur_tot = sum(table_majeure[[value]]) + # nombre_cases_tot = nrow(table_majeure) + # quantification <- data.frame( + # prop_cases_secret = round(c(sum(table_majeure[["is_secret_primaire"]]), + # sum(table_majeure[["is_secret_final"]]), + # sum(!table_majeure[["is_secret_final"]]))/nombre_cases_tot,2), + # prop_masse_secret = round(c(sum(table_majeure[[value]][which(table_majeure[["is_secret_primaire"]])]), + # sum(table_majeure[[value]][which(table_majeure[["is_secret_final"]])]), + # sum(table_majeure[[value]][which(!table_majeure[["is_secret_final"]])]) + # )/valeur_tot,2) + # ) + # rownames(quantification) <- c("Secret primaire", "Secret secondaire", "Diffusable") + + # Reconstruire la liste des tableaux d'entrée + liste_tbx_res <- purrr::imap( + liste_tbx, + function(tab,nom){ + expl_vars <- list_explanatory_vars[[nom]] + tab_rows <- table_majeure[[paste0("T_", nom)]] + merge(tab, table_majeure[tab_rows, names(table_majeure) %in% c(expl_vars, paste0("is_secret_", 1:100))], all.x = TRUE, all.y = FALSE, by = expl_vars) + } + ) + + # journal <- append(journal, list(quantification), after = 0) + # journal <- append(journal, list(table_majeure), after = 0) + # journal <- append(journal, list(liste_tbx2), after = 0) + # + # names(journal)[1:3] <- c("liste_tbx", "table_majeure", "quantification") + # return(journal) + + return(liste_tbx_res) +} + + + + + + + From aed1e47683df51af5423cba02381630044dc5b51 Mon Sep 17 00:00:00 2001 From: julienjamme Date: Sun, 21 Aug 2022 00:34:20 +0200 Subject: [PATCH 033/107] check code --- R/tab_arb.R | 6 +-- R/tab_rtauargus.R | 99 +++++++++++++++++++++++++---------------------- R/writehrc.R | 34 +++++++++------- 3 files changed, 76 insertions(+), 63 deletions(-) diff --git a/R/tab_arb.R b/R/tab_arb.R index 08c347b..26e0f2d 100644 --- a/R/tab_arb.R +++ b/R/tab_arb.R @@ -38,7 +38,7 @@ suppr_writetable_tab <- function(suppress, # Paramètre a priori ------------------------------------------------------ # Normalise parametre "apriori" pour le faire passer dans la -# fonction apriori_batch +# fonction tab_apriori_batch norm_apriori_params_tab <- function(params) { @@ -62,7 +62,7 @@ norm_apriori_params_tab <- function(params) { # Génère s -apriori_batch <- function(hst_names, sep = ',', ignore_err = 0 , exp_triv = 0) { +tab_apriori_batch <- function(hst_names, sep = ',', ignore_err = 0 , exp_triv = 0) { paste0( ' "', @@ -279,7 +279,7 @@ tab_arb <- function(arb_filename = NULL, std_apriori <- norm_apriori_params_tab(hst_filename) ap_batch <- - apriori_batch( + tab_apriori_batch( hst_names = std_apriori[[1]], sep = std_apriori$sep, ignore_err = std_apriori$ignore_err, diff --git a/R/tab_rtauargus.R b/R/tab_rtauargus.R index e2777d7..61f470a 100644 --- a/R/tab_rtauargus.R +++ b/R/tab_rtauargus.R @@ -1,11 +1,9 @@ -#' Fonction qui ajuste la taille d'une chaîne de caractères en ajoutant -#' un même caractère devant pour atteindre une taille souhaitée -#' -#' @param char string chaîne de caractères à modifier -#' @param cible_char integer - longueur de la chaîne souhaitée -#' @param add_char caractère à ajouter -#' -#' @return chaîne de caractère + # Fonction qui ajuste la taille d'une chaîne de caractères en ajoutant + # un même caractère devant pour atteindre une taille souhaitée + # @param char string chaîne de caractères à modifier + # @param cible_char integer - longueur de la chaîne souhaitée + # @param add_char caractère à ajouter + # @return chaîne de caractère trans_var_pour_tau_argus <- function(char='monchar', cible_char=12, add_char='*'){ diff <- cible_char - nchar(char) if(diff > 0) @@ -13,22 +11,22 @@ trans_var_pour_tau_argus <- function(char='monchar', cible_char=12, add_char='*' return(char) } -#' Fonction vectorisée de la précédente. Cette fonction est à privilégier pour -#' une utilisation sur un vecteur, une colonne d'un dataframe par exemple. -#' -#' @param char character vector -#' @param cible_char integer - longueur de la chaîne souhaitée -#' @param add_char caractère à ajouter -#' -#' @return character vector +# Fonction vectorisée de la précédente. Cette fonction est à privilégier pour +# une utilisation sur un vecteur, une colonne d'un dataframe par exemple. +# +# @param char character vector +# @param cible_char integer - longueur de la chaîne souhaitée +# @param add_char caractère à ajouter +# +# @return character vector v_trans_var_pour_tau_argus <- Vectorize(trans_var_pour_tau_argus, vectorize.args = 'char') -#' Fonction vectorisée de la précédente. Cette fonction est à privilégier pour -#' une utilisation sur un vecteur, une colonne d'un dataframe par exemple. -#' -#' @param char character vector - vecteur à modifier -#' -#' @return character vector +# Fonction vectorisée de la précédente. Cette fonction est à privilégier pour +# une utilisation sur un vecteur, une colonne d'un dataframe par exemple. +# +# @param char character vector - vecteur à modifier +# +# @return character vector rev_var_pour_tau_argus <- function(char='**monchar', del_char='*'){ if(del_char %in% c('*','+','_',' ')){ gsub(paste0("[",del_char,"]"),'',char) @@ -37,7 +35,7 @@ rev_var_pour_tau_argus <- function(char='**monchar', del_char='*'){ -#' Title +#' All in once for tabular #' #' @inheritParams tab_rda #' @inheritParams tab_arb @@ -60,8 +58,6 @@ rev_var_pour_tau_argus <- function(char='**monchar', del_char='*'){ #' #' If output_type doesn't equal to 4, then the raw result from tau-argus is returned. #' -#' @details -#' #' @section Standardization of explanatory variables and hierarchies #' #' The two boolean arguments \code{unif_hrc} and \code{unif_expl} are useful to @@ -76,31 +72,40 @@ rev_var_pour_tau_argus <- function(char='**monchar', del_char='*'){ #' only the tabular is modified. #' #' @examples -#' #DON'T RUN +#'\dontrun{ #' library(dplyr) -#' tabular_leg <- table_legumes_sp %>% mutate(n_obs = round(n_obs)) %>% -#' select(ACTIVITY, treff, type_leg, tot, n_obs, max, is_secret_prim) +#' data(red_vegetables) +#' red_vegetables_ps <-red_vegetables %>% +#' mutate( +#' is_secret_freq = n_obs<3 & n_obs>0, +#' is_secret_dom = max>0.85*tot, +#' is_secret_prim = is_secret_dom | is_secret_freq +#' ) +#' options( +#' rtauargus.tauargus_exe = +#' "Y:/Logiciels/TauArgus/TauArgus4.2.2b1/TauArgus.exe" +#' ) #' res <- tab_rtauargus( -#' tabular = tabular_leg, -#' files_name = "legumes_rouges", -#' dir_name = "tauargus_files", -#' explanatory_vars = c("ACTIVITY", "treff", "type_leg"), -#' hrc = c(ACTIVITY = "legumes.hrc"), -#' totcode = c(ACTIVITY = "Ensemble", treff = "Ensemble", type_leg="rouges"), -#' secret_var = "is_secret_prim", -#' value = "tot", -#' freq = "n_obs", -#' output_type = "4", -#' output_options = "", -#' is_tabular = TRUE, -#' show_batch_console = FALSE, -#' import = FALSE, -#' separator = ",", -#' verbose = FALSE, -#' unif_hrc = TRUE, -#' unif_expl = TRUE +#' tabular = red_vegetables_ps %>% mutate(n_obs = round(n_obs)), +#' files_name = "legumes_rouges", +#' dir_name = "tauargus_files", +#' explanatory_vars = c("ACTIVITY", "treff", "type_leg"), +#' hrc = c(ACTIVITY = "legumes.hrc"), +#' totcode = c(ACTIVITY = "Ensemble", treff = "Ensemble", type_leg="rouges"), +#' secret_var = "is_secret_prim", +#' value = "tot", +#' freq = "n_obs", +#' output_type = "4", +#' output_options = "", +#' is_tabular = TRUE, +#' show_batch_console = FALSE, +#' import = FALSE, +#' separator = ",", +#' verbose = FALSE, +#' unif_hrc = TRUE, +#' unif_expl = TRUE #' ) - +#' } #' @export tab_rtauargus <- function( tabular, diff --git a/R/writehrc.R b/R/writehrc.R index b48a5c4..346d2c0 100644 --- a/R/writehrc.R +++ b/R/writehrc.R @@ -258,10 +258,12 @@ vect_aro <- Vectorize(arobase, vectorize.args = c("string", "number")) #' # Exemple standard. La table sera écrite dans votre répertoire de travail. #' astral <- data.frame( #' type = c("planet", "planet", "star", "star", "star", "other", "other"), -#' details = c("telluric", "gasgiant", "bluestar", "whitedwarf", "reddwarf", "blackhole", "pulsar") +#' details = c( +#' "telluric", "gasgiant", "bluestar", "whitedwarf", +#' "reddwarf", "blackhole", "pulsar") #' ) #' path <- write_hrc2(astral, hier_lead_string = "@") -#' read.table(path) +#' \dontrun{read.table(path)} #' # Note that line order was changed ('other' comes before 'planet'), to no #' # consequence whatsoever for Tau-Argus. #' # Remarque : l'ordre des lignes a été modifié ('other' arrive avant 'planet'), @@ -270,11 +272,13 @@ vect_aro <- Vectorize(arobase, vectorize.args = c("string", "number")) #' # Wrong column order: #' # Mauvais ordonnancement des colonnes : #' astral_inv <- data.frame( -#' details = c("telluric", "gasgiant", "bluestar", "whitedwarf", "reddwarf", "blackhole", "pulsar"), -#' type = c("planet", "planet", "star", "star", "star", "other", "other") +#' details = c( +#' "telluric", "gasgiant", "bluestar", "whitedwarf", +#' "reddwarf", "blackhole", "pulsar"), +#' type = c("planet", "planet", "star", "star", "star", "other", "other") #' ) #' path <- write_hrc2(astral_inv, hier_lead_string = "@") -#' read.table(path) +#' \dontrun{read.table(path)} #' # Because of the inverted order, everything is written backwards : planet is a #' # subtype of gasgiant, etc. #' # À cause de l'inversion des colonnes, tout est écrit à l'envers : planet est @@ -282,19 +286,21 @@ vect_aro <- Vectorize(arobase, vectorize.args = c("string", "number")) #' #' # Correction : #' path <- write_hrc2(astral_inv, rev = TRUE, hier_lead_string = "@") -#' read.table(path) +#' \dontrun{read.table(path)} #' #' # 2.1 Sparse case #' # Cas creux #' astral_sparse <- data.frame( #' type = c("planet", NA, "star", NA, NA, "other", NA), -#' details = c("telluric", "gasgiant", "bluestar", "whitedwarf", "reddwarf", "blackhole", "pulsar") +#' details = c( +#' "telluric", "gasgiant", "bluestar", "whitedwarf", +#' "reddwarf", "blackhole", "pulsar") #' ) #' # NAs in general are risky, but, in this case, the function works well. -#' # Les valeurs manquantes causent un risque, mais, dans ce genre de cas, la fonction -#' a le comportement attendu. +#' # Les valeurs manquantes causent un risque, mais, dans ce genre de cas, +#' # la fonction a le comportement attendu. #' path <- write_hrc2(astral_sparse, hier_lead_string = "@") -#' read.table(path) +#' \dontrun{read.table(path)} #' #' # 2.2 Non-uniform depth #' # Hiérarchie non-uniforme @@ -304,8 +310,10 @@ vect_aro <- Vectorize(arobase, vectorize.args = c("string", "number")) #' ) #' # The following code will generate an error #' # (see section Details about correspondence table & .hrc) +#' \dontrun{ #' path <- write_hrc2(astral_nu, hier_lead_string = "@") -#' To fix the issue, you have to fill in the NAs beforehand. +#' } +#' #To fix the issue, you have to fill in the NAs beforehand. #' #' astral_nu_fill <- data.frame( #' type = c("planet", "planet", "star", "other", "other"), @@ -313,7 +321,7 @@ vect_aro <- Vectorize(arobase, vectorize.args = c("string", "number")) #' ) #' # The following code will work #' path <- write_hrc2(astral_nu_fill, hier_lead_string = "@") -#' read.table(path) +#' \dontrun{read.table(path)} #' #' @importFrom zoo na.locf #' @export @@ -382,7 +390,7 @@ write_hrc2 <- function(corr_table, warning("Missing values in correspondence table will be filled in (see documentation). If unintended, this can cause errors when using the .hrc file with tau-Argus.") - corr_table <- zoo::na.locf(corr_table) + corr_table <- na.locf(corr_table) } if(adjust_unique_roots==TRUE){ From 1a3b07292dc98ae6e4fb1a2662b7edd20e389795 Mon Sep 17 00:00:00 2001 From: julienjamme Date: Sun, 21 Aug 2022 00:35:17 +0200 Subject: [PATCH 034/107] modif description --- DESCRIPTION | 16 ++++++++++++---- 1 file changed, 12 insertions(+), 4 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 9ef040d..83a1d5c 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: rtauargus Type: Package -Title: Tau-Argus depuis R +Title: Using Tau-Argus from R Language: fr Version: 0.5.0.9000 Depends: R (>= 3.3) @@ -9,7 +9,8 @@ Imports: dplyr (>= 0.7), gdata, stringr, - rlang + rlang, + zoo Suggests: testthat, knitr, @@ -30,13 +31,20 @@ Authors@R: c( email = "nathanael.rastout@insee.fr", role = c("aut") ), + person( + "Jeanne", "Pointet", + role = c("ctb") + ), + person( + "Félix", "Beroud", + role = c("ctb") + ), person( family = "Institut National de la Statistique et des Études Économiques", role = "cph" ) ) -Description: Crée fichiers en entrée (asc, rda, arb), appelle Tau-Argus, - réimporte les tables secrétisées dans R. +Description: Creates all the files required by Tau-Argus, runs Tau-Argus and fetches the result. License: MIT + file LICENSE Encoding: UTF-8 LazyData: true From c7fa1e5403e3d7f4180683b4c74ed30cfcfb36a5 Mon Sep 17 00:00:00 2001 From: julienjamme Date: Mon, 22 Aug 2022 11:45:23 +0200 Subject: [PATCH 035/107] tests multitable --- .../data/corr_table_nuts23_fr.RData | Bin 0 -> 474 bytes .../data/red_vegetables_4_linked_tabs.RData | Bin 0 -> 26786 bytes tests_multitable/legumes.hrc | 121 ++++++++++++++ tests_multitable/legumes_unif.hrc | 121 ++++++++++++++ tests_multitable/nuts23.hrc | 118 +++++++++++++ tests_multitable/nuts23_unif.hrc | 118 +++++++++++++ tests_multitable/test_multitable.R | 157 ++++++++++++++++++ 7 files changed, 635 insertions(+) create mode 100644 tests_multitable/data/corr_table_nuts23_fr.RData create mode 100644 tests_multitable/data/red_vegetables_4_linked_tabs.RData create mode 100644 tests_multitable/legumes.hrc create mode 100644 tests_multitable/legumes_unif.hrc create mode 100644 tests_multitable/nuts23.hrc create mode 100644 tests_multitable/nuts23_unif.hrc create mode 100644 tests_multitable/test_multitable.R diff --git a/tests_multitable/data/corr_table_nuts23_fr.RData b/tests_multitable/data/corr_table_nuts23_fr.RData new file mode 100644 index 0000000000000000000000000000000000000000..b1dc0e5cd3b9c789e5e38dff31abc849163d8e0b GIT binary patch literal 474 zcmV<00VVz)iwFP!000002DO$?Yui8&#g)ho#84=-pCe>vc4qh9(sRivH&^-Nlbe9- z(rZ6TKWW_+DD7`eLn9m?B)zAddGlr#ExP)6t&8hL(==@}J87GCUSMZbX->z9haYYeU@Ia(x+NXP>UZ<#DluiCA8M^%)#r z3EK;>Ps4ioZydu!EYDz_hAkX`Wg^yT*uw!>j*RvHIE5o)nTB&X0Lv?3t#Ew~&4)81 zkO+yAL=q!$l0=gK5($AsNR$M1M3^JY5#}hvlwpx8v09-(WYK6OXiki3Mm3|FGt3$0 zRTzpYcR{%ek#mcoT2T_HMb0g9ZjqykTCGq`p=NYobYOH~p~}G!jdqN7jN52J0U9+L zH5xS?egPERq2x&a=xL^YqbwAKc?y{}-Q35w|TYDncSE(H~yT ziaITi$|yU$(xo6KASQRzd;U5)apuLiiip~8hvF6yRmZ$n#M{1;OZK3Xj?MEqXhc`nhWOKImyV#1e5d&tyrwKWOUy3jEsMC8lxg}?B8@O zWT||&d}byc5zh#dwm!P8*+gTd3`E=^@gh*TxR-f)8yzaL9HVW%yq>~%O60>c5g!_l zM5XaqBx@l#pNBJ3O-!Oh7IQx+w$rN2*r_fq4!3vKYr_w9tvj65kxQ_FU!Wofb);nN zz^f8FHn`nykeQ=8a=&cg)k0vLN)HnS4$Eiq?&zlr?_NxhH?V~=k{w08$zeJ8@Pva! zf}%V8sm-gxu&52CCqhKiFW;Tr{{92Lxr0n#xIT;XE{gCjit#Rr@-B+=N{H}Ei1A8@ z@=A#FHjD5!i}4b<8o4_exw{$B&eU&A|LU3+w_xMr&itFq$(>n~ESW@fWf;|9)nz0o zV8h0$FJ#BoNR0iz#s|escL^J9?6!q&)VjDYi8VXZn=}&t*WH`w^8d32=OH688(#X_ zG-AV1r3zWrg*-B+$sY~&eapgD$8+Tz<~-`>xDc)r^$@t)PL>w2K%06 zVawypzc=ciL0Ny(G(L~ASJ+Z4)N(p4{cLa^F%q-o&8|(;FdQvD8v0LLVJo~)OXsu{ z+u%H~ENp$8StBcI&6{15Hf|WWTOsSYkS7V%^<1cxbXvNHBLy7ZZHcjnHWofNHXg73 zxBOvBzXld8tdn)>l08_HRqB!*S(6RxK3X5P*HEo5F1zs%im=m(ve1chXNs_7ig9O( zvSebo&TX^)1AXPnnr!(GSogm`*5tcta`P%D^?yO=#JK;9;{FfnA7p27pw`9Oze#ZT zFWGQ2+3+vJ;R>?hcF8FIB5`&)5f+c^R3iGM*sRp&f1bsu*o~|1j;jRC{}vq1H;jV* zuvx6InX9l_sjykDuvw_ESS5+EU9T-<-A6G4o`(XDURLegU+5e(` z{0B8t`pVA=qpUTHam|IPlkhQ!f9-?$H9sI-tsz;!E#THFI1r7Vy$1jI3l0Wg+ELQ& zC|~7$=7$8dGNuSqvd3Fh&Rf|MXNtlsNur&&`oXX$;0iw&E&<@+#vDju+JcblLL=aH z1B|cMy=EN}L;=J&ouW+-5tw=d78ap74xQIlS1%C;F#-9W!C`pnt3iaRc&bhdInl~) zx!3-PANdqChyLlmr=kc;wmL-Ri>yG;+{UwJOJ`ny0-mk9BwRydT4yF9B^vP6((nb` zae#AE2{!WLAZqSgnX&edZmBgbE&>yun1uu$IZY_zn|10a5~dF&P~Nhm5Aw{uM$wJF z)6GZog(s0yMYpMpcJhtNu#VC}-2AVDlxxRpuMNnXAiCet3Q+q-_%)nzgw9a~0ZDA> zJd^;)wofHBI(3;$9;Uv#ezZ!^KK+o0auPYp6<rzGzy z@fZbr3v#?_&b|Qp-|MVF6{lKULS%f^70m>jfy#34rxE6d=BkJ9<&m>D{EZK95z2l{ zCYk3X_4}HW_Idpj%Xxyr{4LeEQ#Wbb9fi=tu3Jk5u`|ypjp1bK3y8E>w@(wuPp3WY`G>B5jd$~wz zUv>Ix(0>kp(9L|tm3UR&Ch}qIW;WV?^-eJC#+-Qu6u4+M{iy;f4AB~J`(=I!-nbL7 ztU3jzC?~*g6=dXqq6`L+Zn-6>aodw@(ZqP}#$dzU`BA39%%_gPFEWfAmzR6~R;LMP zJ(mn=Cz_LyaIcC;HLv^!!C%Dj2|Km7!B&%}ta%3BO3cuK_;}0|g&*Jr-K6Ke3xhZl zu7p`c9+S%Kj%8&=$OFH`zR7Wx`uk&o-{xT#y)pG5Cuao9MpG-oWD06)u!_q4)56h5UuodlCeP1q&mM&3y&)kd%+* zLN-o{?}waz=Hfi_$hpDIb6d>;Sgw6Id{8s2b7J|@R0WkgUvdY#;czZS4VxhVQSf0O zjyycI_V}r04X>3N#GUlUU4vR5OvJuwa|8I5KFIxKy4id-U<(lMJ#b8pNrsDg4WQX>AdTG!jlJ)K!j7URzSBwpZ?#RH zn>E2D{AAtId%cUmV)0?J7q^XJ2poqb634^Ufc!Kwu@8tQ?Rk z=M;|I@H4Na11F;jD?IX!*jZ?4zUYZ-vb|6v;mv=!>(}9u@QWko+UejuLkS@i)|?<0 z3TKlh1Xqu)G`%;R0wfFFH1QNwA0(J(mxH1DPpf9*QqJTyha!UOnJdqv6i{mxV4La^ z?DV)8J#iDQ3~m|l24qj=>Kb%T7YgxgWU6!hc`oBp-+%Yjs$fH6K(?oPU$i-R3nGf` zk()L9CgIY4O|T1)WuyqTtxoWdM~T10Lx8RV1BmiKan+l#Ck0F4^;=c?nM|aT}2bc2YeO z_LWZv`0GMrs^9Te@MdQ=-Q}`-#ea1#s{vxGw8h1N7|`EFnoP3K0*0vd zzI<%?FlS6Pa1y(ZWOAP7oD}&Zdim;w1AMyIJ4@Gch=w_^g%vwL*L8I>`Uh%b1+guL z;4OaE&ff3$^OEz5y`_I|-ZR~f>)#L#7*s z78p&&w*p%k%^#nxXfExUfqxYq`8sr8-2 zHAh_=@8T`yn@a7g`mR!0j>+`%PpbJSfHT(0r76LVpBZ03C zLI;;y=bgXl1A7xU1+CjU39*DveFh#z28xn;V_of#@;H_JDvl50zL@lJR7R{L%|a#k zhZ*P2l3cVwctLBo{<2W!MyE=^aDyb{6brwZSNVEm5_TZ2@{)~0Nq$o0A<3U2vW11; z1W?qsAjRjC8^P{63(FnA1y#yioBVUD1>$F`3lm+(u53iD{!WN_Qfci2Jotl?nckc9 z&Ph{0snWOc&R-XtDG?nG?U`RiUdIlttQ-bVd!^JWi8sif-8d!fuBCD1!z2Q|3t>2v z>7svE>Bp(|_8*Tja|BR_R_#a977g1^8^KN)FMG_eO5i1}Ey9SxNHva3(sbfS2&cwR z(J=|%>_9#D=LO=^&#EvCYu`gx;!8Cm7~Kl^-MnMKeesIdUp`RM@{5-~uS=S1j_}BXzHf0{MnxFsv2*d7TIqUQbHj#929j48y@_9P8klTKK z<|??yM#Y=eUPD1UIlRQ^-GgQ0``U|+(erUD(_sLhzwyhIO45Fyk0+Mb{OQ7t%@n8J zsv{i#yi2?*320l%iYAj7@S?zXhSRsr4wrrrjdhbpk;iRETKh^q#2a;h2lDd5IIHe+QFJ}a+ zTH!d)?e2-i7k?|~;oRzcs&;i&V6a@k>WE{$_oA))zS}J8t{1)6tbG2#Kr?rKQicmz zQu$+Qp=vFSRdM_)?1L(=^H}Wh#&va3RZ|5)kCpwii2e%4yFI2Th zzy-2F56YsKDWxkF4~vz;M^mX+;sKI$md-g`0;s75S;V6J`T}Dxtpj;N zo~zP)rDqtyGJ`E_VbStqL)9(YPY;*)yaEzfKi=yInLD@d&BXxu@?0L4$~RPibZiNOU#x{wisYu#gt=DOwbqnwE{ z+(yE;*8bn*NhvfR{9rYXnZB72HSi0RqA?ZRaeS$?KRvJg{f zsCXefbn+ z%{DI;&FnNLyP&x`{j`CD`&N-tO$QGlvRljfr^h)}@JcAwaUZnm<8U)xvgyQoplY>( zXN2FmT_OF@4LZp4EwGaP@EwA@&B=vX*5>e?8@L2tws`dI;pil_Nd`@X*@F6w6ug9# z%buF^IQ0|ux#NKvU)HwF6mcuv{O~1v>1*3IC8UpHOUN@8p#p~bifFNQ&FXi9^z8O&gGz<)1v#%E zuZ|$OG+0URf_P+f4Wr0!rXs6w-MRZB;lTcto8TO5S@zFaeKOApU5eVq%U06xke3II zzbid$4?$U0ZIV`GxcU2JtGy0JyhHkcDvZ!?W-pJn0124B;6=Ub^^AwV@?Ov`pc&Lk z@>+>>#e>uOR|NG*dPnS0f|>l);T9Yz%4I+`-ao-(_kzj~L=UNAJjvF3N}> ztkw-C;a%%Y6;j-I@>fJ)ap9k2m+Xle0s~{Gvj($iZv6K%*9%X^h@VVuLjg6Qh{E*Y zfcEw};-hLg*TF;Pe9ndJoC@)mAXB<(t?k&y57;bO2@faV-fEs-bdf${`8Xp!gZtre zxuNvkiRXJU{`!6TYjwAG3_t840Sh-3Z)zYe@uNcq3Lx3+<=EG%N)UUQf`iutE2Dpe zu<)j@8Kj5xCcOSG>*z2^NHN^Sl}r*pLJBia3RFGL{1JQ@cr5YFtJFbkkC?BKKk=X` zK<~JAtGRnK$OaNl^AN&3h1z_r=BdKeN+ zWs~9krRFtpOVUNzFGO!-I3!S18LwhZ)2r)A-+ynpX|u^89+B1{di-r zqmNu$>mamQV7gen`9hxM=Kd2BN7m(WTK^VC|2CD8yhm1FzbMkw=hafgxN@d(OZ(0u zL9U0VbeG!pi#8+f0Ht9p5nh#v(s?zGt6p7M;JT5up2#ub&ZDd8Pey+vtmw-R+w0u# z?#UcrQy$D98mTvvsc=oAg_KAV09-#JVC6k}wqpMw=_mznKUe8PEj&$89~8-O>h_qO zrMhXd6^(sW85(gHVS>}PNHfw7`1U8nU&FhT_X*c;MDudd^DzS@mt-G_#}m2QGYv^G z-Hv{17qO7={N##~MNWNs6S+ORrj}0JbaYBA@t!Y$S61KD7?mA*gY zTtx&xN07|=-Tb&kFh8F|doW1M?w642o!AlzTGi%^(c{mNY1#{ZT5ESevd=$Ds(1Tr zFjX5f-Hsz}?5&bR63kZNT@;}ip}>jyHNciROS;t5NXwVSzbOW`b;pcn$Z|c z)X`Sd1nu)fwTjJ;f-*>ENdhyaL#|S;wEUQ+dL>8qA0F>>WTr3HyNpbJtR_Uz6N~I- zGJ^1H<42Ipteyp_aaXvXax;%)2oesfcavh<6vuaMuHCi7stNC~{PhepjO-eySM|*Q zkkzeiVw~5!%{e}oxCB3zl_KFiHAGT|+YueS;0MIs(tR>tW_ml$KTQ7?pbQgHqVf^- z57pdf(`J75_p+;xG+<7yIyOD(I}C4i>fk-_UJfKO zr}s;CK?2muY>7lUA)r3ny8}(pdbBC`(hJ0ORjQ`3sx6Qbmw?P$9`YXbnZmSI@w&+s zOjceR_|cmsN_%^Z2FtQtRp#S0U_DxzA?{_xUBQ~ZQ`i8_w;V2`hAaI)OOB>1rFq38PhR zY+5M_T9cebV=c{Vf1Gbu){HNO=@SsdcpXduMU=KA;tZ40-}1NAk)8(RU~nHi1{bl| zhvIZLaUGVuv77%caMi42gM=gV_NK23)iEPRdS3U|+h}I{MTv)v@o^?5!NfRa@)BLe zGx*5c^Wk0pO;5ro2*qp_UyDq`I==^0C%_hJXyxOu<$}CyFyCq}-0e-89td0X>pTyh z`$AZ0RV!}^YdiA@T&r<<9Oz0G?dyf~YRk5ZQO+MUcJG~ZN>Ce^hQg&xcVXyZp!&|htC8;r>P2T8U(C!0P| z-E$Zv*_2Py(F5_?uZyqX_c{TXk5t>_*1*#sLdOO~fJM@d^!g4Zkp7 zC=h{_R5p;b!)83{gJ-Fb0K4EqWAc+Lz>kVqJiNgV6%t-QbBw=3D&2G6OhOl@&e`=i zhFXa3z)8#lKBZ{@h+Se~)2jaB3|HZHlOe26z)S&_=tU^c_L#y4X3PKGZ4S;;NDiNqKq>L0zu zHm-y=z2G#QtrpHq6r}dey*Qhv@e6u%I8VD~U)i-qSGD^cl_H@3hq>Ucf%+|#E};LY zq(@X>!=U*-`X#srLXtj;Axg*4@nM7`?wjZ?*6sQ*@kw3M_qegQ^rAw$2Di9_qPtCY zV{YRa>sk017xw$6%%>{@kkXeJ9@>k^P%`j(EYXuS!EJ-v3c7RD_>XlrrTZ!&Axgi< z^{kg5QEN04?Iofs1B^F-`*`w9aykPnJ#fD&xC>IU<^yA)FQJP*&$vh! zoO`n&#tP`qFc;i3P`{(i;loXFf5I8C5&@t0$S*X8)En2(NRmxwy zlD1J@@QW(h7+NDew3w>5n6f*1y1vIHiRH6xmVUDaSA+(a(m$|qaYp?IvIIS}pu!Y4&h6+Wa>g=O~tXVz>Y4eiZ!jFNRS6FWYFxQOY`M z&QOl1e}pOjOCS03|L8Ti1~fQBBMbh|@qe?HDHW}B$D!(;?8mqkj|1EIsF}W;>29Mb zi7_i@@CeK@J^I8J@gMDO8nXwyT35s{ewlF#?gc|m+!ls`r?1h{uD8K~H~)r~(F4}= z9$GeiNkcImiKu^0dD%uxE7rrT_(pY`**hwG`>Ez))|9qsbEjcWMg`1WuF^8dCYWDzI-)IDpW)1iX5%9=mZh0O)ujxe9d&v zhaGCIPTtMV$UoD+sOuK%VeM}An$&h0kee7^or2Oj?WcvDVbemCszBP^w7oBU@2~N! zIK-J?^w^Xh82kYqd(r`S;=_dF6hNBIG=s7Te@6FEl8^a}%zF`C%1P30ET*!-V~vh5 z53jz7B`ev0PS#67rsRzxRX*5Vo>|nnL*GPauAkY1(o?GmSM{>rDDW2L4SlyG(~rSR zaoZ-Qn2?s9o{HWKPhOw*qg08{4gaDM4<5}W#lN9J1n z_X3ocOp~Mf*v@V>cmrOHv)$&*OKZ`)B!$<;XP#fXrpd%-4f(QKGz*g9dy(<|QV_QE=aJo|V%IiCA4ViLTon&Q5+jx>=uv zIoLT*(05eb2mA!-V|su_Rt$(p$dz!U7%Q=!a?*_Rlm6LIHYc8TFJOqt%6Skt0nl3NXH7lI+Q*n&Ld41 zXh#oSzf)tdFKu|CDJ)D1Lqzm#B2pwIT#=SRtbywh(tayU9On{ItEtBx7~GEjQ+xG+ zA~(0wd3j$h1#2+LK= z$QJ|GuXkS+s&u#mKbTG|^!xQE#o!3m9ySOJ)UA8VV16;HS)B)1{f$0)2(;VsmS#~n zLmI`FyyqJ{^HY&;;(!GYYO|lHJZPl!-{h*})MRpEyMtYX&u)jVhMFG;o(H_ zb6q-9r2l?gwXKMbPEfZhsr9|$K$|E9IAVC?UTMo^|0C{YkkPZj+@3!0Y*ozT+Y?@d z$4U!fzx~L2TyFX>SP+y%MlK;P^kFo*@BF#Dsr!0egY+7Zi0(BlScTXx*lz%T&he+^ z_sd3Kt`pLh&I9ZP)G1l);W)(^x;L$REBUa@{`^5~CKR?J&uBf*p-!=4P?_}uwaFt= z^~>-UxuFv3)0k#WRB7JaKwl z>kfaX8o>E^-dIS(7w=~d4=uhOziWw5 zsNIkW3iq{hV?29WE~K*P|48X|I=C(Wf^jAGV;IME&ZAxv8s0XeAle8UqVhBzQ-b)N z0m;mW5{rMiq=LWl_)CEZShL-z>(h2$%bhSf{S8oRu!mvW%`<^_&bHg^!e^BX*Fh&8 zWEP1j?#N&JHc!+2dkvXZn4N36>047%-~517cH^Cxg+&o0$KYZX@q&dLqueTEA}DJR zoRQJ-y*)c^h0AjqA$P;}2?smtksBe=_IU}*kBXE$JBlMAJ-1@a@U#0z#iprLd|uLc z(jx|dvi<-r0_}lM1SFl&F4`_zI z{n<&sFVu(T!@D7?#j8Ib`MUw1W9*+=i&Enz;65-dk%S0~KZ1;w1Z)?6o?7>}xiCt_ z&v)N*30)@*r2Xo8p`$EH=nfT_Uux%}!IiI9!=Sma$Fx8}9xV<0e$1Dx-uvfDw0@0$ zZ5r=__Fx^~d#JyS7j-C6`cO$`RE*%S(<~KTdt%r z3J*GK;E|rd0!d-V7VcL~uUoE^1h1n zP>>rfx>9&ewz)f4hmt%wO7QdQ2RtI$JE8GZc9Z|Cuhvo>KAGRRXSIdOOn>835Iv1c zXW)g1XN`-p{@ecSpvuO4<}D4BRKH}ad> zpK+bbXz9?Z`K2YSFI4%K$i;q90Q2h+{{1>tACVzq?pDE3UmPNdzqQ_1=+qbB;H&hz zZfF5i4O%2r#PP_t^JX^ZJ;{q>q4S0|6M@oof8@#7Z+Z)e?&kE`O4yV}FITNA&)I!W zc=Zm=03uUzeL`%4K`tC(UFNFZ$!0y1@lDr+xfc41W!rQW4<{_+S#Xjt``7r zw(*jx%r-9Ux>jrK6s9=aiv@h=zc_p23Th51Cq*uUCh^Ri>?=*h#qC|t3-_brtOU-u76HmpK^46vEKiWg?cC=PvH7|vq#OqdJ zi@F>?f)15fFzGoq>^S@G1^Q^bu-OYM*Aoa&!ZKbeV8y##!%Kw*jtqE@gz;G|F-JGU z75boZ&Vw~jiw?n(cI$b`#Ee#3y)|TD{?Mwk)R#QDpoCV+FZ4i&C+-P@;KgscE((}YXfWj2}_*ITHa#!)0I0Muy z!-|uJZ$KKI%2boiSa(j!ZpIPZp-OM{e0LS zW6qFPA;YNXksCtigG1g^iFS7lT<-@R{QNe+3GSq96kgn#p`?)0|q znCQySJby_0+=N?1m;_hdWT_uVELAV`KMUBYH!pD}Ct#h`kKj!WPp8o0os#yW<%Ik?8jgPOYO^e;bEo>zctv5Yr zky6$Bx`#o;QUJ=|XZ-nd>};o|33x9cygX~c2G56(gGavw!ap9O?#vRY!zNrTeKesw z&!**2rMWXAiSk(n9U}EqNU0ID8R7?iX~5g&5;jVOKbHd@O~TRz%I{%rI*VzYxVrMc ziGDna64W-W%O)wk%^#`|F)A>U*{mtLmmF>39&EjJ-Rh;4=Q<`u9ZsU+4XQTeaiqA~Tqy z$*T{I$A}_x?mZ93@cWRLgm2#l=979_ehZlb%{c6kzLGy z&NGA8GVp&zNiUvdpk-PHqgQFlJmPHPQD!BVoIx7N+xe1o_1ET&^szb2xsqO!gxh>4 z83qoOQB2udza@A!_HwGOk3K*0+MGL)$`gw0FDgs>b;ZjVfNN7id=@pH{o}yq=$R=rON9x4_Nhh!_TbLS5oOtSmq zGEbiKv%IMbdQ-A=Y@l%Z5kf67E41DPVh=g5F-Hhq(XXTJz%~`){zzU7mT-b%4#(&pW zC28{g@%piS$YNIe-}L+(|@(j=`VWF7W^h?Ntu<=K%Ap z9tPFx4DLVOl94AS8J8}QTzIL%HTT1v_Nq1_L>gKDzJwvpk!Y?i$B!Tzd%*1CJ&Osy z_J@gOG30x$D}ubQ-CxFKrrZzYc{#1|Upy#WCKy*^&mR*uYTlqpxSDQUz*qG|!4iLc zV7af{_Vh5eT~jKcd|zis%133FE{j{rT;Ulloh68AyR9g8eUtwJs)Lq@D;WWD?LcAW z3g5o9enf0*W$q&*PZ!|Y;bCY#N1RjDhFp;JjfhX?>TGnI)2Y05p!fn9LsXn(mrpT^ ztQPso1hzaC5#n3XkC(!d%2lXpE5{ou&rXl{W0ZfP;U{O~p@6jaLswDXc8Y^!1A7J9<*>AN_vBD}AhY zA>RAtIujiTkoZ9KMa?pK%D-VvgpZU?gYnc_hB|;dtv{Boi8(j3F$>X1{o1&Cn77xEU^L zWOU6YAAU*hcQ^7_LNvVW^zD|;UF8WmZh^uJd1dgn*EOqNhaEwjTL-^*)BvCZT<3Ey z@iUyu2b9+&svofdd7}_Gli9zZ_{RA#I5*_a@9ArY`5ptePKC+0sd-#w(r*YeGfX)5 zu?gTHIMl}M8`ETh`fq{!EkQnG{IAcY&sw>h$)@Rf7%ikYASPqj?#|QMx&OBqFl1{;trX$lZ;mo`QfUg{P(BQ z5Mk}RfdN|-zL(wYY$88(@`5&91E1qMrR}by-alE1dC9MZv)7SF7H!Sc-hpndytcdzG zl-zd53k5bx8(*R(+C;0S>^(=$qDXTUc)HKsH>4P~gELQqYV9QgjBmbfL*Gz&UB$`; z%O$#H8;R=$kd!}2#G!Mx%yyDUpEf0z}9RSsLbZd#DhVqUF$vq3oK9exKXIwH*^cbB031s%9&%2)KxlDO~BQcLmpj&dG zIZTM(FA+xYt_~r?EwEKqUGe0fC(rldGsRzLfB1_VXP%nvKat@3jN*nhU@4F&T%4m> z`5Ct$(!;KnwBC@(O=-tt%l>?yxIMVb;>t!HD_q0+fzLo7dMmdE&9V4Nh?FQk-r}^& zp{U_Lc~lqwB;Uall+<&z4_nbu9HBs)^Q2du+fAyv z%^Hcr?gjGVJnPrJ8>0hHs7s7>%M?)weH2mrt0>pO(#d&ONuI)W4iBZRnEyCKVQdm_ zYMEJ3%;Z|HI;A=Typwu5C|0UgDmrAE%Ku6@ko%g7?N??!YbBMs`uz4Z+ligDq^9Lb zhM*sSBzYy6|Y&O28h$?7M zN@%EAX3+jhcmMM_a~bo9tEJZiyMIyz_PM@CyX9VfI%%Htoe4wl?kM{O3-VWCZKToQ z6D`$=%#mu>840MeZ?H(ZL4y?}X3Rq?Gc?jTKhS75&clFb=~_{syAq+PfM*>GFw`RA zOY5HkbQHd`d_Mi~+q0~h=v*eFb=Ejh3dXw;*hhi^$UPA1Ze&t{wfHfR0dIrC8Ss=RHLO_S*kS$tCsF0&f{tD<6w2UJpB zrRHpgX|jPYU-1lt=qEp$)`K*c*yPuMsF~(3p-Jq1dtY>%o-3lw#>&sh9hJG9p9Pem4QsZ=4o}&t%X{lKj9RXs$1IuJq#nH94? zp5YwxKR&h=E(3zuZd9w?LxP@`pI=>0?FB{m7XWK~>5`0}v$a>h1CcTmUUGCZqy+G^ zXop;o8mDJ^vX@Qn-IsJS`iBfG>?gxmxZXP&^5Eu_LHDNhaFFXx|30DJb?=~TCuLaT zX;847uy>)fF@!EwEMT=5VPVF??rr7=jM3za`gNGB{h+MHl7iA+^r$6mZncRH*FSgu zI`NJs;N-X9mhC~5h`yNv=-V1!j(q*6^mkW#gIH$EzP5XlSS47te#o*L@#dj4+D zFnhu)n0(FP*@}>)ecm)k0hX2dfZKLTy_{ezCs?BJF7fZm$o%MRSW>?rC_@KL{+CB- zX$#Itzj;{sf!=D274zzCi>~$4oh}P91;AG_x*=wO5HF_WA_XJxAInbs*WCS-AKU(~ z*~GF6|5u3aasg%x|1*rH-PhU7_Wk;``iseb!>b52xFa+;F+{?5>q<&uu9+97p)cvh ze&6fM@L({|;mEZ=cQKEifI=&y$w=ivVgMZ>xVwy_Vv*?x%iD$ktUsBPSL7w#zE zPSmN(@njn&=@h+sxcxtu4*v<4;7D|!e%boQDj0~lmNrEpkawpSC#Q5#n5a|q$qo9y z_Y@IO)aoEgdVB%6)dtozM;iwq(_vlfg1ksA>)k@6$e6YX{r4q*b2HiQ_07~bSHb6* z8J0dDyQ5w0*M0lw|2!QnUiQKh-uNi@ROnGt8B+-uJJ|zExV#oyK=F$`CjhjP9+(p$ zTX>D1LA>+LFy=Le(e9V+fCaEr_^6xlQZVo^QP|F@T)^iht_QGU99VXR+C~BGni8HO!2S}fYtkbG<`r_q^EscbO5&8Kv*aH zKyh}>2*^vzUMqz1Z_eLBXrL4%v&^UZe=VOt+-e-!ib`Xr-JqPR4IkK6=$`owh#mM22}Y z@LbC5&o`99#iW)0J-P>bEEvySW_*;)23^^a@X+dz_5$kV_$;q_zu@-neMoa|KglAq zAUz$>RwdICq8_32k%_MP6BpkGWJ(G-L(f%`S2Y|aiUzoYzB{k z5Kcha->ys$5X!9oLi40s90?O$j59D)>(Ywt?0&spInZrh*P&Yk{CIZgVT64HmthV9 z5$Fzz<@Fv~&G_B}>e*fS?U}1Czpu9L5KnNIz4T)wZyWyOfl|xGfvVlcLV9zGh}tsB z!YpSN<&DXoWP+WPVCPj+g{P?f^aUbMzsD2e+vrc?nb)5qkB0@XMQ+%c4Bp~*CR}mY z@%+oA(s7nDYU<7}Etjq&77u4r+|dZTjC@wq#*GjPe*mhF%^>a+h%fX3@(FgX-Xr^l zkhXCr2#4YHm-#u);>n1DM4nCNp=0*hebr)2X7+ddwmnK$eqJ-xE@l<;vt~$q{_(?+ zav%eIc=ib@_m+AcY(?yve#H@OnLHp&WDQ(-SzqydaInxZ^pYZ&VN&bfMS=S3g_KOy z{4owJ2!Iuza*XbOj5&PKKstdSEPP@JzMMOk8Cz!`A~GvXfWQxWo58Yl1D@raH=a2% zH<<0DMRSj+(4$k^4i7Z6(byo-qYZ!X_%ZKM6PvAsygG=BmU;8(U~n^MiotVtdGhAa zJ6<356W^nc3K4hh!?!Jxcu$T81iV+>cuv-@c-q&f;ZILugy!94s$Jutrhvx@Zg)Bg zX@^-*KZeV?Czsm0@9jWce^WF-8$PoMg4bZPGqfH%sf)>F9usIjKxQJYtQo}Zv?pPU zYMNsNgLg$_f$}htYWbf6ktZ~P!8-ixz|HpSS!U}RP$3e30uyW5T*aHv1yg$@GkIz9 z1hUD(f0Ul86N)yM#9jxXaiAO?%{7#u$l~~CvAr2_W1T$YDATl-&hkeH=~&CXD*e7{ z9c7%QQ!*SsCUO2}HXbEHsNR36yF+fQ+bk}-yfBgbSJ_#*(_Tmh0Wz>gyipn(!h3_P z7x!cOcNpSOP&MXDwbFM<4)ma)8zgOf40^9gA*KBP3c1UmIJ$LT;0Z3l-3AYC0fM^* zLI@Dt-Q7Jwf?IGOEVyg%;O_3hVUQrh00YCFckg}9J@?DGRqMm*4^P*s>Z-0@y`KM1 zsBK}T=UegS(2y#2@Yl@U4@Oj4nnfZMsS7HP&isOczj%{ye2ZwRm}8cWm5j-Xv?nld))U z(iQMXM%d=3eD`7cW=Bxe((=QA=uCZwMH9;)aW&q!l7EU9ZfBp?xPjdZ0?LW}Bop>HXwij515V>#%aO+1t3*ilavxW_Ne5HZpj${Th80?#utbbr z6}84c+2Gkq$L-_Gu!IHT)Q^?Ah}hzYn;W2<*>-fITkoR?&GfkOQz6_Ox9anpjYrma7*$WmcB>De<7J@1evbK37lCv%X7VHeGHx6 zOg2 zA#Vt^N8z0R;AFIYGTFcx}M%P=HkAdZ9p!R>GA|x z@1khLH&AAAT!;tz7xGo4JAfd^i%7VWUOG(t%9wKfRqziURH>zXyZ*^y<>Lt5TESI3 zE-7}`q4}dq|8IwkjSIQybcywkzvM1uLV9}-w#bdMhs%DBn^ywKh9ys{#!UnURcUyR zM>fE;ZXoS))R@(;@X}G;1J~^e*S^bnms;EwVwRsVqwp;ScyJSmhnD^t6n--uBqp^b&Q~ zTo*rHJnixDo%hm>v}`XjmHprDdBozpj*)KlX@s~R%b0Y^3R0!z0M(MTPSn(>lF+tc z)q>L|5o;3YrIePkQP+bN7?EK)ecYf!4B;a=;C}skTfwcRpP>NZ#H&z5Gf-bDquS&( z{>5N=TnJnkpVm+kmWC&AwO0`_F zEK6|;^)2-eOYbc=E)UpjxBuA8?s{=)!E zo~hPCZ2~t=O=CYLPfW&D{${htdh4sx`xES(h0@Na8W(o815P*Z0*I-}dxpP>jn4p= zsTJcx4>qLVWD;2%s}-!}+ZB3bUp&>B+6J6SDTXoJm5Agyqvf`Ljnz0>VaYqEak1x` z7NE%!1gK+w_$VD%?%4lp5J;{66wt7)QeQ31?d~^I|xMy8EeN~ zE+^iWDz`Il54;RDfhnnpPoBL6^|V;Gi2d>tL22p}?c!fb1tz0DcC32);fN`0MP|&J zB9-;%n(=6}poIsj@p1)#iQgE7ky4I&pfaI?Eg^v@bk2xVh)E4HGcua&cFrJa?s|Qw z(NA~n{av#AZ)5hvIC)!jo&GRrO*uN=q7M-+7##+XkE5kMF$mCzndwq-*w z*cxJn%kv>UP4qY>mcEDp{tJ#Y4e|{r-{Arx06UnRB?aoJ9oC0+^HJv6vkTW@U8ciYezLK(oy=AUz9lG zUhgTB-6d4L|EA!1pB~4IvC6Tn)c6W2+8kU6XhV3TRp}Vu%|*qr{PS7^KpJHDY_i-U z`>GY=Q+A92A$^+Ebg0~J^Nwycy<~7(r>ctcc0P#pZf1V4UIVC+TLz9z&>eZV$2Qps za;mk29S*qNJ}l6N_fzw!%>b)aMeS<8E&wry!R<~+spd!N5-*(5C=$Yoyv=$d#@GgD zIXFrY6p!sp&LK_!DAcHZp4wu!Wvuv)D&cl_&4pRscn1~{o~+7_+Q?(R1a>eE{o&Q3 zwEj3i(0)lNWO?~XRkHtDUML}1nwAH3B4QjRq|otqFU&r@koxh*v_gJ&OpYJLK)x+M zj+j=!`jOhL;xTdg#ZRa(2C`_|g#MDd)FSL4qVdyuf&Yvwkr5qY{f?t!QMC8fsX+uI zrj-}%5r5)dm@}74H?q}odcc$`q(uY%DVr^~Hh zzcEcrAY$(J#35RvzX0dN?Z70^i7>{-V)$DHYrU^`DV4tMe#lkE9lwMqD>u?2x+}|- zWuLhjpw?fGaJQJsrI3Wbi`{S}1izx%&N8G5G|mxYf|c^vj|Mtw;{eH)_r-5g)v}AJ z;(?t%$g`fACaU5@+Z~qqP7Km46<5M6wk3x+Cde7zNU4{i+y5Qj^JQ|A$C4pdXo{w9 zxDI;`eY^Ej!rGK9D7Gi@JoQ?&-ZMgN^8vA4NbWm3Z$fOueX{9(!G9tZ9B0P+w>nv7 z3H7mR@J{Q$w3amj;|=r^zjn6XTV2LF;k~7@bHM_x{IK!T*Ulnh8K{tpVR9^m#8`Br z5jbvzWLLK{d?Lw{c+Z7iZ?_siGf-i9r9$t|kHjPa#d;562XT~11MIMj&?wQEeui-b? z`pXqWW-P&t6T0}Q#ald8x-DDi2P{qRabCI*`tvL^8(**cbZ~DyXfr1y`7*KVrHQS3 zOEFBY5RJJzh*_>QmhJA*_fVOCdQn&X0I-;fVvk8PooaAppU5K`OFt7*3m6UZ3zjj93T2~dKx`hQq!g^j|wGO&ZIH4aGcp)hlw#^90V@a zQj2qzkTrayGJ(*CiTShe`tE#6UOf{^s_DR(Lj{&r{z^mA(9!7h%x{*U3jrE9WpLWGCo8b{1gxTt)CUrK5S?$|Z9 zSGPetZ}ifHl<&IEyYr2taxq7Oe4b!`_&W45gg_11>GC+sXqPxTJwer7<)7;J$cEVc zKQWx?S{bX{;n4+8<{TiQ@XkrR&N=70=0cwG!b6z)2bVKrsG)ItA9_pmzoT*|)Udmi zX>tCg4!9&I<^-4IqTv&I`;TsRT5e8Sk0+_{%RIY}W?jn}3}-xQ*TeILX|i>6A^doe zjk1nWCJIRYbhxFF!uY?V(Dt3{`bo(Du1nBXEE3rPsjLj*LZKDor+< zOy-+R)|*V0n@qNwc4nG(R+@GenszptcHoHIS`+s@$?t00-(9w*BU~X0$p{gHb*?&d z^_l)=qfD#rGreM=Ov@NBEl{L{J99B6hjk1@*fDB<>U`+qY3)}N|F1Ns zi$)s}j_sy1LK9Jf?50CQGyIP?r^jOj9manx#Qr+5AOA)0Kiu3p8yuZOw@inP{4r_Mk(|d2qkqu|(bjR79GW(@dh2X%P#=rGBs$c&$=!W#HUQbXGH%{>U zqs`q-tmI|EwK<*f|7dge(>dqmaBVK9*#YJr$k*bh*B(!>HC==^@- zr3wAMCtLc7DB}$w4>>*Y6d3C#9?rqHIljj~)s5np06dRfGqJc7LD$#xRMCObHYu_t zQsU1{4c_bK&v%723pX_U-lWf^w!@oNvtFUvX3)lNlcuCyy4YwTitjJQLgi@mlpBd? zn_Gt3u>(4bi1g}y(K{gLfvK6}c#iWrF>TBz11U0josaQ-Uf@iqYHaT_*vbR%uvtee z7qDGM^HgfwFac(or?X{Ha-)&|qBFb$^7e8B4huBmg90<4&Ix=)FJV4a;s6r!e7SbK z9_-|Sk)%R!`pH#I>d;71$z?IplcA6W>GQ@PG|?K&z@M{w&SNhJR|+Svymey5*2}?L z$Ouywe`pPus{~v~{cH;*Sr4-H0Eh~kb@)x>_vN0Z#LgOXw!Lu1Zt~Z<_K;ajt1f&N zZP^P#pqD{&D=zm9XmA5;e!8X?{lsPkzyS;^X02-1Q5hb>-19r;Y*LZWxvxWMLSdRW zK@gb!?l_$ZWUlgIdI49NDmz2fCUl*hIp`yVIn9y~ZvaU+!6ACqE0s-;~a3R!3 ze1lYk#L1M9QbllA=D{U%Sr-v`mZ{i~%U>#G@~)gzicdlnmx$m`_%lIT{LycB;iZ1Y zx|i=wzxRwd*&^j{p^<9uPGiMeur7>`(M4+$CumZg_8xAydv63p2_f{7l&yQ$$m>)H z_s?YQZJV0dD?!q1C|3hjF*^<$TNz9%mr0DIhO)bM3as(tt9gR)&X&kCH-R1re9uqi zlCc{dR55$Z#;8R^5xh3k>#VUux+B1FcCwC41MA0!MhNxHG?z)DT9m&_4;CrkKJ!~6 zcWdswk>Tg*d?i(85JUx)`!T9&d4rm=J>UAmjBpxOTFoQ;Z~G0!^duoE>)-U-6=lq- z74tiUY3+|xcQR9o4$iHpcj+#Gw)W(B(tVA{S_PhGwl^i2g(GRRago$s=6pC&(<;t& zn`T|PP1K48Q=J@%3PDk-5dOApVZqu&$SSnOun(5kOTz|zw|q3d`|y4OU(&gLdh#st z2r+Olh~|pCBJ^l}U+f~CB6Mw@OY5k;u#I5%U_e)%w%;EZelX=jGL}HS+>@4=boYk36ejsDS4QB zOo3zOQ3tX*d*Njy^%Pab8YakmdGONlj>MPksqT*Sv>xgaZpy|FI+^BnwlZ8sqZ@N$ zJl3C$BsZWQ5!4?1<4YrK%VjL^J;?HUcKYcw>ZUSx=IOoWk^5v_KGR3s&XtYRO@W~f5;)8|&)E@FHB604aE*?7Y%6B? zC~R2*x*?4nU-}1%JnP!1`L~_V>IrZVIxHlcu(S%jiyQW0>ez!3^jrwWCN2Eo3|ZFi ztksP)MkFOY;URm@X*U*KW zJNw1%X=)w+GD|wTb?<*V@nn>q5>wqy35Er*y|TIp0)S1{-~FxBz-M7Se}y+3FTUpP z#(5vN?OxmyPE^(AbmV%cgpTAp)@0P)2C$M)5_d2?Ln-oDxHG2ug=sQ*Ds3F4r-T$2cO82wJ)GDvmNhY z2XBE9|9ds*6RxO8jgl>R4!up!T?EqhLjFbR@!}M~^ZE<4{8lR{O&-^>${35aWLK=x zTDq(+t8#uk;j3lVQ(@CQTJKxClE_n~rS18*9FPvNMv^!FzY2Y>eLvJ~9FVv*0)Zc1 zB2x0!_+$c@Vgn^k#u9k=fqB-3A86zMKX_ZuL}>TM9~r{2qHgUD*NbHLUTFx}yV7}$ zdqEZA?_9*i{eGC?Zu9XO*c@co_Z7S7w;;6SDr}g7i+L4eNtQeLcd6R%uBpJ5g51|c#;p9}uh#vA8@4guPa+Q8)Ff{S5)93IGqXXU%X$VNKm}do^P7t7dZ15{|XGQHq zY4-0vAoyB-5LM6U-5sL!_g&l*_~F=-t@PWHY5MPy9+iZQdB+)*m#-BRdo^F>&06GS zD=>6MI>q@tw;5(|$~xu-d9nG{gLoI2J&^|oTub{Yh(q-Qn@^GJv3ldS^n%q@F&4xh zQ8wl(BTAA{8GnBAu%4?%yDx>{j_QKH8rG7RU<4V`llO8}Z~yex&F$@G`1!m%&L+k3 zqFycaL{?{jzwpzj|JCg}>NI{fZY*mnk(%*y7;Q2aB-eT#fCA!NCnak{l&!^?#wn|n zNloAnC=s#!xO>7}otw)psTTAVr%7FRkc z@5Gpqg}6O0|KuEabb4vou~~W;k>7UTdBu--B0&qIJ=67}Arq`|mFpi5fSW01BUWG{8^VdvJjJfr&o5tgeqp+mfv z(@C2%t#W3@KW`glm<~8t_8I*g_^i7#t=ST>{H~tM&sc31?Yw+&Gz~pihGCoS8Mukj z1V;}%q#j2Kj(#+5L|v;?ngSBfs1>!I*BPQ-@SMLkIlRvn{l9z~kF$D-aYWc*Wz+IMrG%JlegwS##tLX1}vH-6D6RA;dl_WG@yuGg>S_LisI#PbUX zl(Y-F{a`1XU@W(SOG&3&<|2Zt^soBW8lV5Vun8a7eRJ`!LFdA0i$on zF}aWcg!HdD(=`BEZGYgqWO{ymtmcAjJNccc8C&3!VIIuxf(INyy%gzMFbT?qxAMH7 zu>!BuokijV-Q8G9-mS;OwHXnqljz2q&>Kp$xy`4EEh zAhw4-FH;3`$IwJ3YDNW5(;heDJ<`uWY6{GEBvfOZ>|NnOin-oTw=l0{&!4SVw6;;h zCp21OG#3|trs3Hne`nqU8=Gaj53u&|%rXWyPil&ElH;OEr9+O|JsSJXMZ0ZD&12Ck zegD(Sol=LvL{OST3cpA|vZzo^i;7&dQaD5FAARbcSTiZIOavihlr4M|lC^5mjI!BP$67 zu_X}SX47+?-$*nRRB0EL&=9*X>fcv%5{Zf8MQYFCv-FVnuv@y8X?q)pl+{yUhNQAzO#TH_pg@N+5|BKjK2_PAG-i zJpX}@a+?+BPJV_B@mv1|H)FKUZ6fkrtQ-=sXs=b963jv2%)6+C}pG6%YxiTivvj)Cy!^5s7Y z91BZEv>P@EC#)4XuhW$c&)Alm*>%q-%pU|otvg@OuRJSA3@#Ocyc3YF@5GMRSTVCF zZkW_QX4{kJsuF+g9IFc@oV&L_eoOB887=T&Fu`@EBW$6cpWbcuus8Ey;YKcj`?TKk zn>s-66!8a$(97wsk_=O+Qq#{wK5B^I95W8j=I^qLUWKN4i5U5r#Aly`>x=c$(|8$v ze}F}`?tE{aKele*PdsU)4|0j0k&-T7-3Zhc`SKf zYM*9bZF%TDy%V=GD1)haKZkfZXWdGK#+yLLZc%(N+NoE{1JW^siNT>x^gc@*$E~n-`p=?FNQE?bx>V z_iY3gbJmKc_o2lDad6iJkG+|3-ezHLeiet=LSz-E9-99cbzX*37q*OC(Rm?FKZ2%I zv9r?0xzL%^Mt8OFA0sb{{(U#vX*|#njWzm=KrtXUkFLQd%p8ltnxPx6$S0V2Evg7;Vk!Oji zI#(9T1jcH8F7Xl`RYA_+QF;dPgyM?1GHU!%=_7#0aSDH23f>s+@z8mB3j9>YKj!di z3a4k_ChE!lw!Pgc_dZnGFX?`&DOjl}P%#I}QG&)t%doZTK0TCyI2=;cQ=ok@##?^# zwh?;<4^rD{?nM(5PYBtkYk&vyn*71oUWI(l?ciAEl%DI!!D zn@m=VE6tCPKhm%;EKp9zVQLAy#noKA115D&2+N?#i*Q~Z=Y#+ra!%BbtW=k%Sb4e> zb1`*qDRd)ZV&&(Uxvj(+j`H@KbR6TG=>0h6^W;Z)L4?)yK=DI0S!aOY?1*54Q)7#A z@M%Fs=s)6FK4u-rr)X6jLu|0d+U+8f{~=H@5$xkp;DdhYBM>46p-g$_a_&8fwE4rO z^aUAF7b4Q{|2e-F2&d3ypcX$+VHH!{XiR@ZzeQ8N*LZ1oec-imR{IsD5v<4@47{EE z2O5Mh`XY60EvCZ6B;yQm<36?DsYl6|pf7TKftjIpiL(xi7tenBxFxk%xJ2lOrWq@) zLa!NqgIn&7#NxALrivYY#`F*+rBYBu)SoluuJ}098WZOPP>*7HcoG==ET((>G zx)V`2=FZ}pR@m4zyP^M3PCX*?X(Z3zNHtobbfZAMO}r>%GQrm=T_NA0w0V#0tuJBj z7bE4`^%&^VP5f$h*bQs>QP2MJ#TWsiQvTz!X0AdeV)xu}mGV5c;S721m9qF-X4Rxp zs^d{luaXsfmGa-xcmZD^kbpv$=q4e zbM>Cg=BJ7nx% + mutate( + is_secret = Status != "V" + ) + + print(res %>% count(Status)) + + return(res %>% select(-Status)) +} + + +# res <- traiter( +# list_data_2_tabs$act_treff, +# explanatory_vars = c("ACTIVITY","treff"), +# hrc = c(ACTIVITY = "tests_multitable/legumes.hrc"), +# secret_var = "is_secret_prim" +# ) + +# Test 1 ----- +# Liste de deux tables liées + +list_data_2_tabs <- list( + act_treff = red_vegetables_act_treff, + act_cj = red_vegetables_act_cj +) %>% + purrr::map( + function(df){ + df %>% + mutate( + is_secret_freq = n_obs > 0 & n_obs < 3, + is_secret_dom = ifelse(max == 0, FALSE, max/tot>0.85), + is_secret_prim = is_secret_freq | is_secret_dom + ) %>% + mutate(n_obs = ifelse(n_obs > 0 & n_obs < 1, 1, round(n_obs))) + } + ) + + +res_1 <- multi_linked_tables( + liste_tbx = list_data_2_tabs, + list_explanatory_vars = list(act_treff = c("ACTIVITY", "treff"), act_cj = c("ACTIVITY", "cj")), + list_hrc = list( + act_treff = c(ACTIVITY = "tests_multitable/legumes.hrc"), + act_cj = c(ACTIVITY = "tests_multitable/legumes.hrc") + ), + value = "tot", + freq = "n_obs", + maxscore = "max", + is_secret_primaire = "is_secret_prim", + num_iter_max = 5, + totcode = "Ensemble", + indice_depart_tableau = 1 +) + + +# Test 2 ---- + +# Test avec 4 tables liées + +list_data_4_tabs <- list( + act_treff = red_vegetables_act_treff, + act_cj = red_vegetables_act_cj, + nuts_treff = red_vegetables_nuts_treff, + nuts_cj = red_vegetables_nuts_cj +) %>% + purrr::map( + function(df){ + df %>% + mutate( + is_secret_freq = n_obs > 0 & n_obs < 3, + is_secret_dom = ifelse(max == 0, FALSE, max/tot>0.85), + is_secret_prim = is_secret_freq | is_secret_dom + ) %>% + mutate(n_obs = ifelse(n_obs > 0 & n_obs < 1, 1, round(n_obs))) + } + ) + +load(file = "tests_multitable/data/corr_table_nuts23_fr.RData") +file_nuts_hrc <- corr_table_nuts23_fr %>% write_hrc2("nuts23", dir_name = "tests_multitable") + +res_2 <- multi_linked_tables( + liste_tbx = list_data_4_tabs, + list_explanatory_vars = list( + act_treff = c("ACTIVITY", "treff"), act_cj = c("ACTIVITY", "cj"), + nuts_treff = c("NUTS", "treff"), nuts_cj = c("NUTS", "cj") + ), + list_hrc = list( + act_treff = c(ACTIVITY = "tests_multitable/legumes.hrc"), + act_cj = c(ACTIVITY = "tests_multitable/legumes.hrc"), + nuts_treff = c(NUTS = file_nuts_hrc), + nuts_cj = c(NUTS = file_nuts_hrc) + ), + value = "tot", + freq = "n_obs", + maxscore = "max", + is_secret_primaire = "is_secret_prim", + num_iter_max = 20, + totcode = "Ensemble", + indice_depart_tableau = 1 +) + + +res_2$act_treff %>% filter(treff == "Ensemble") %>% select(ACTIVITY, is_secret_treff = last_col()) %>% + full_join( + res_2$act_cj %>% filter(cj == "Ensemble") %>% select(ACTIVITY, is_secret_cj = last_col()), + by = "ACTIVITY" + ) %>% + filter(is_secret_treff != is_secret_cj) + +res_2$nuts_treff %>% filter(treff == "Ensemble") %>% select(NUTS, is_secret_treff = last_col()) %>% + full_join( + res_2$nuts_cj %>% filter(cj == "Ensemble") %>% select(NUTS, is_secret_cj = last_col()), + by = "NUTS" + ) %>% + filter(is_secret_treff != is_secret_cj) From f52ca729f140fc6e6f699ab886ca8530298eb11e Mon Sep 17 00:00:00 2001 From: julienjamme Date: Mon, 22 Aug 2022 12:10:45 +0200 Subject: [PATCH 036/107] ajout cas sans feuilles uniques --- R/writehrc.R | 24 +++++++++++++----------- 1 file changed, 13 insertions(+), 11 deletions(-) diff --git a/R/writehrc.R b/R/writehrc.R index 346d2c0..93e9ff7 100644 --- a/R/writehrc.R +++ b/R/writehrc.R @@ -16,18 +16,20 @@ ajouter_feuille_unique <- function(table_passage,racine){ feuille_unique <- compte[compte$nb_occur == 1,] table_unique <- df_long[df_long$parent %in% feuille_unique$parent,] - for (i in 1:nrow(table_unique)){ - niveau <- table_unique$niveau[[i]] - enfant <- table_unique$enfant[[i]] - parent <- table_unique$parent[[i]] - ligne_a_recup <- which((table_passage[,niveau]==parent) & table_passage[,(niveau+1)]==enfant)[[1]] - sup_df <- table_passage[1:ligne_a_recup,] - inf_df <- table_passage[ligne_a_recup:nrow(table_passage),] - sup_df[ligne_a_recup,][(niveau+1):length(sup_df[ligne_a_recup,])] <- paste0(racine,sup_df[ligne_a_recup,][(niveau+1)]) - res <- rbind(sup_df,inf_df) - table_passage <- res + if(nrow(table_unique)>0){ + for (i in 1:nrow(table_unique)){ + niveau <- table_unique$niveau[[i]] + enfant <- table_unique$enfant[[i]] + parent <- table_unique$parent[[i]] + ligne_a_recup <- which((table_passage[,niveau]==parent) & table_passage[,(niveau+1)]==enfant)[[1]] + sup_df <- table_passage[1:ligne_a_recup,] + inf_df <- table_passage[ligne_a_recup:nrow(table_passage),] + sup_df[ligne_a_recup,][(niveau+1):length(sup_df[ligne_a_recup,])] <- paste0(racine,sup_df[ligne_a_recup,][(niveau+1)]) + res <- rbind(sup_df,inf_df) + table_passage <- res + } } - return(res) + return(table_passage) } arobase <- function(string, number, hier_lead_string){ From e4945f6b619ec11ad7607ca314ff4cd5f00599a0 Mon Sep 17 00:00:00 2001 From: julienjamme Date: Mon, 22 Aug 2022 15:55:11 +0200 Subject: [PATCH 037/107] multitable - manage totcodes --- R/multitable.R | 63 +++++++++++++++++++++++++++++++++++++------------- 1 file changed, 47 insertions(+), 16 deletions(-) diff --git a/R/multitable.R b/R/multitable.R index 05a75e1..7de6b1a 100644 --- a/R/multitable.R +++ b/R/multitable.R @@ -2,17 +2,17 @@ library(dplyr) # source("fonction_traiter2.R") # fonction qui ajoute du "secret" au hasard # #source("fonction_traiter0.R") # fonction qui appelle tau-argus + multi_linked_tables <- function( liste_tbx, list_explanatory_vars, list_hrc, + totcode = "total", value = "value", freq = "freq", maxscore = "maxscore", - is_secret_primaire = "is_secret_primaire", - num_iter_max = 1000, - totcode = "total", - indice_depart_tableau = 1 + is_secret_primaire = "is_secret_prim", + num_iter_max = 1000 ){ #' Attendu : @@ -32,12 +32,50 @@ multi_linked_tables <- function( ####### === A === INITIALISATION n_tbx = length(liste_tbx) # nombre de tableaux + if(is.null(names(liste_tbx))){ names(liste_tbx) <- paste0("tab", 1:n_tbx) names(list_explanatory_vars) <- paste0("tab", 1:n_tbx) names(list_hrc) <- paste0("tab", 1:n_tbx) } noms_tbx <- names(liste_tbx) + all_expl_vars <- unique(unname(unlist(list_explanatory_vars))) + # list_totcode management + # first case : list_totcode is one length-character vector : + # all the expl variables in all the tables have the same value to refer to the total + if(is.character(totcode)){ + if(length(totcode) == 1){ + list_totcode <- purrr::map( + list_explanatory_vars, + function(nom_tab){ + setNames( + rep(totcode, length(nom_tab)), + nom_tab + ) + } + ) + }else if(length(totcode) == length(all_expl_vars)){ + if(is.null(names(totcode))){ + stop("totcode of length > 1 must have names (explanatory_vars)") + }else{ + if(!all(sort(names(totcode)) == sort(all_expl_vars))){ + stop("Names of explanatory vars mentioned in totcode are not consistent with those used in list_explanatory_vars") + }else{ + list_totcode <- purrr::map( + list_explanatory_vars, + function(nom_vars){ + totcode[nom_vars] + } + ) + } + } + }else{ + stop("totcode has to be a character vector of length 1 or a named vector of length equal to the number of unique explanatory vars") + } + }else{ + stop("totcode has to be a character vector of length 1 or a named vector of length equal to the number of unique explanatory vars") + } + # 1. Mise en forme préalable noms_vars_init <- c() @@ -51,7 +89,7 @@ multi_linked_tables <- function( .f = function(tableau,nom_tab){ var_a_ajouter <- setdiff(noms_vars_init, names(tableau)) for (nom_col in var_a_ajouter){ - tableau[[nom_col]] <- totcode + tableau[[nom_col]] <- list_totcode[[nom_tab]][nom_col] } tableau <- tableau %>% @@ -141,11 +179,11 @@ multi_linked_tables <- function( vrai_tableau, explanatory_vars = ex_var, hrc = list_hrc[[num_tableau]], - # value, - # freq, - # maxscore, + value = value, + freq = freq, + maxscore = maxscore, secret_var = var_secret_apriori, - totcode = totcode + totcode = list_totcode[[num_tableau]] ) var_secret <- paste0("is_secret_", num_iter) table_majeure <- merge(table_majeure, res, all = TRUE) @@ -257,10 +295,3 @@ multi_linked_tables <- function( return(liste_tbx_res) } - - - - - - - From 6e3e43c1058d7e259c2373f25adb6850a17bde68 Mon Sep 17 00:00:00 2001 From: Rastout Nathanael Date: Mon, 22 Aug 2022 18:33:52 +0200 Subject: [PATCH 038/107] Correction hst_file --- R/tab_rda.R | 19 ++++++++++++------- 1 file changed, 12 insertions(+), 7 deletions(-) diff --git a/R/tab_rda.R b/R/tab_rda.R index 69ef7c1..e5896ea 100644 --- a/R/tab_rda.R +++ b/R/tab_rda.R @@ -350,7 +350,10 @@ tab_rda <- function( # parametres non renseignés ........................................... if (is.null(rda_filename)) rda_filename <- tempfile("RTA_", fileext = ".rda") if (is.null(tab_filename)) tab_filename <- "tabular.tab" - if (is.null(hst_filename)) hst_filename <- "apriori.hst" + if ((is.null(hst_filename)) & ((!is.null(secret_var))|!is.null(cost_var))) { + hst_filename <- "apriori.hst"} else if ((is.null(hst_filename)) & (is.null(secret_var)) & (is.null(cost_var))){ + hst_filename <- NULL + } #Gestion du chemin des fichiers name_rda <- basename(rda_filename) @@ -363,10 +366,13 @@ tab_rda <- function( if(!(dir.exists(directory_tab))) {dir.create(directory_tab, recursive = TRUE)} + if ((!is.null(hst_filename)) | (!is.null(secret_var))|(!is.null(cost_var))){ name_hst <- basename(hst_filename) directory_hst <- stringr::str_replace(hst_filename, pattern = name_hst, replacement="") if(!(dir.exists(directory_hst))) {dir.create(directory_hst, recursive = TRUE)} + } + # Controle sur le nombre de colonnes col_tabular <- c(explanatory_vars, @@ -448,15 +454,13 @@ tab_rda <- function( if(!is.null(cost_var) && !is.null(secret_var)){ hst <- rbind(hst_secret_prim,hst_cost) - } - else if (is.null(cost_var) && !is.null(secret_var)){ + } else if (is.null(cost_var) && !is.null(secret_var)){ hst <- hst_secret_prim - } - else if (!is.null(cost_var) && is.null(secret_var)){ + } else if (!is.null(cost_var) && is.null(secret_var)){ hst <- hst_cost } - if( !is.null(secret_var)) { + if( !is.null(secret_var) | !is.null(cost_var)) { if (nrow(hst)==0) message("no cells are unsafe : hst file is empty") write.table( @@ -586,7 +590,8 @@ tab_rda <- function( list( tab_filename = normPath2(tab_filename), rda_filename = normPath2(rda_filename), - hst_filename = normPath2(hst_filename) + hst_filename = if(!is.null(hst_filename)){ + normPath2(hst_filename)} else{NULL} ) ) From e7497d036fbe848705df1cb3bad1f60ff61b458f Mon Sep 17 00:00:00 2001 From: julienjamme Date: Mon, 22 Aug 2022 18:47:01 +0200 Subject: [PATCH 039/107] ajout tab_rtauargus2 --- R/tab_rtauargus.R | 71 ++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 70 insertions(+), 1 deletion(-) diff --git a/R/tab_rtauargus.R b/R/tab_rtauargus.R index 61f470a..76b2259 100644 --- a/R/tab_rtauargus.R +++ b/R/tab_rtauargus.R @@ -285,7 +285,8 @@ tab_rtauargus <- function( header = FALSE, col.names = c(explanatory_vars, value, freq, "Status","Dom"), colClasses = c(rep("character", length(explanatory_vars)), rep("numeric",2), "character", "numeric"), - stringsAsFactors = FALSE + stringsAsFactors = FALSE, + na.strings = "" ) res <- cbind.data.frame( apply(res[,explanatory_vars], 2, rev_var_pour_tau_argus), @@ -307,3 +308,71 @@ tab_rtauargus <- function( } } + +#' Title +#' +#' @param tabular +#' @param files_name +#' @param dir_name +#' @param explanatory_vars +#' @param totcode +#' @param hrc +#' @param secret_var +#' @param cost_var +#' @param value +#' @param freq +#' @param ip +#' @param suppress +#' @param ... +#' +#' @return +#' @export +#' +#' @examples +tab_rtauargus2 <- function( + tabular, + files_name = NULL, + dir_name = NULL, + explanatory_vars, + totcode, + hrc = NULL, + secret_var = NULL, + cost_var = NULL, + value = "value", + freq = "freq", + ip = 10, + suppress = "MOD(1,5,1,0,0)", + ... +){ + .dots = list(...) + + params <- param_function(tab_rtauargus, .dots) + params$tabular = tabular + params$files_name = files_name + params$dir_name = dir_name + params$explanatory_vars = explanatory_vars + params$totcode = totcode + params$hrc = hrc + params$secret_var = secret_var + params$cost_var = cost_var + params$value = value + params$freq = freq + if(is.null(ip)){ + if(!"safety_rules" %in% names(params)){ + stop("Either ip or safety_rules has to be set.") + } + }else{ + params$safety_rules = paste0("MAN(",ip,")") + } + params$suppress = suppress + params$show_batch_console = FALSE + params$output_type = 4 + params$output_options = "" + params$unif_hrc = TRUE + params$unif_expl = TRUE + params$separator = "," + params$verbose = FALSE + + do.call("tab_rtauargus", params) + +} From feff6e6ba0106f33ff5c4dae80f5297e3b7679bf Mon Sep 17 00:00:00 2001 From: julienjamme Date: Mon, 22 Aug 2022 18:47:49 +0200 Subject: [PATCH 040/107] =?UTF-8?q?ajout=20argument=20func=5Fto=5Fcall=20?= =?UTF-8?q?=C3=A0=20multitable?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- R/multitable.R | 81 +++++++++++++++++++++++++++++++++++--------------- 1 file changed, 57 insertions(+), 24 deletions(-) diff --git a/R/multitable.R b/R/multitable.R index 7de6b1a..a6645d6 100644 --- a/R/multitable.R +++ b/R/multitable.R @@ -7,12 +7,17 @@ multi_linked_tables <- function( liste_tbx, list_explanatory_vars, list_hrc, + dir_name = NULL, totcode = "total", value = "value", freq = "freq", - maxscore = "maxscore", - is_secret_primaire = "is_secret_prim", - num_iter_max = 1000 + cost_var = NULL, + secret_var = "is_secret_prim", + func_to_call = "tab_rtauargus2", + ip_start = 1, + ip_end = 0, + num_iter_max = 1000, + ... ){ #' Attendu : @@ -29,6 +34,16 @@ multi_linked_tables <- function( ############################################################################ ############################################################################ + + ####### Function to use to make secret ###### + .dots = list(...) + params <- param_function(eval(parse(text=func_to_call)), .dots) + params$dir_name = dir_name + params$cost_var = cost_var + params$value = value + params$freq = freq + + ####### === A === INITIALISATION n_tbx = length(liste_tbx) # nombre de tableaux @@ -94,7 +109,7 @@ multi_linked_tables <- function( tableau <- tableau %>% relocate(all_of(value), - all_of(is_secret_primaire), + all_of(secret_var), all_of(freq), all_of(maxscore), .after = last_col()) @@ -132,12 +147,15 @@ multi_linked_tables <- function( ############################################################################ ####### === B === ITÉRATIONS - num_iter = 1 + num_iter_par_tab = setNames(rep(0, length(liste_tbx)), noms_tbx) + num_iter_all = 0 journal = list() - while (length(todolist) > 0 & num_iter <= num_iter_max){ + while (length(todolist) > 0 & all(num_iter_par_tab <= num_iter_max)){ + 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("\n ##### Traitement tableau ", num_tableau, " ###########\n") # nom_tableau <- names() nom_col_identifiante <- paste0("T_", num_tableau) @@ -164,9 +182,9 @@ multi_linked_tables <- function( # table_majeure[[nom_nouveau_masque]] <- table_majeure[[nom_ancien_masque]] var_secret_apriori <- ifelse( - num_iter > 1, - paste0("is_secret_", num_iter-1, collapse = ""), - is_secret_primaire + num_iter_all > 1, + paste0("is_secret_", num_iter_all-1, collapse = ""), + secret_var ) vrai_tableau <- table_majeure[tableau_a_traiter,] @@ -175,20 +193,34 @@ multi_linked_tables <- function( vrai_tableau <- vrai_tableau %>% select(all_of(c(ex_var, value, freq, maxscore, var_secret_apriori ))) - res <- traiter( - vrai_tableau, - explanatory_vars = ex_var, - hrc = list_hrc[[num_tableau]], - value = value, - freq = freq, - maxscore = maxscore, - secret_var = var_secret_apriori, - totcode = list_totcode[[num_tableau]] - ) - var_secret <- paste0("is_secret_", num_iter) + # Other settings of the function to make secret ---- + params$tabular = vrai_tableau + params$files_name = num_tableau + params$explanatory_vars = ex_var + params$totcode = list_totcode[[num_tableau]] + params$hrc = list_hrc[[num_tableau]] + params$secret_var = var_secret_apriori + params$ip = if(num_iter_par_tab[num_tableau] == 1) ip_start else ip_end + + res <- do.call(func_to_call, params) + res$is_secret <- res$Status != "V" + print(table(res$Status)) + res <- subset(res, select = -Status) + + # res <- traiter( + # vrai_tableau, + # explanatory_vars = ex_var, + # hrc = list_hrc[[num_tableau]], + # value = value, + # freq = freq, + # maxscore = maxscore, + # secret_var = var_secret_apriori, + # totcode = list_totcode[[num_tableau]] + # ) + var_secret <- paste0("is_secret_", num_iter_all) table_majeure <- merge(table_majeure, res, all = TRUE) table_majeure[[var_secret]] <- table_majeure$is_secret - table_majeure <- table_majeure[,names(table_majeure) != "is_secret"] + table_majeure <- subset(table_majeure, select = -is_secret) # Rappel : traiter(...) renvoie un masque de secret (une colonne de booléens) # avec une ligne pour chaque ligne du tableau d'origine @@ -251,11 +283,12 @@ multi_linked_tables <- function( # # lignes_concernees = tableau_a_traiter, # # lignes_touchees = lignes_modifs # ) - - num_iter <- num_iter+1 } - cat("End of iterating after ", num_iter, " iterations\n") + purrr::iwalk( + num_iter_par_tab, + function(num,tab) cat("End of iterating after ", num, " iterations for ", tab, "\n") + ) ############################################################################ ############################################################################ ####### === C === FINALISATION From 926f751d2395925d78ef42d0df4054485881bf21 Mon Sep 17 00:00:00 2001 From: julienjamme Date: Tue, 23 Aug 2022 09:55:06 +0200 Subject: [PATCH 041/107] remove maxscore from multitable --- R/multitable.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/multitable.R b/R/multitable.R index a6645d6..f23b7fa 100644 --- a/R/multitable.R +++ b/R/multitable.R @@ -111,7 +111,7 @@ multi_linked_tables <- function( relocate(all_of(value), all_of(secret_var), all_of(freq), - all_of(maxscore), .after = last_col()) + .after = last_col()) nom_col_Tj <- paste0("T_", nom_tab) tableau[[nom_col_Tj]] <- TRUE @@ -191,7 +191,7 @@ multi_linked_tables <- function( ex_var <- list_explanatory_vars[[num_tableau]] vrai_tableau <- vrai_tableau %>% - select(all_of(c(ex_var, value, freq, maxscore, var_secret_apriori ))) + select(all_of(c(ex_var, value, freq, var_secret_apriori ))) # Other settings of the function to make secret ---- params$tabular = vrai_tableau From 421b3b4a0f68a01594846b1b3f5d76c9e3599291 Mon Sep 17 00:00:00 2001 From: julienjamme Date: Tue, 23 Aug 2022 10:35:07 +0200 Subject: [PATCH 042/107] =?UTF-8?q?gestion=20variables=20inutiles=20dans?= =?UTF-8?q?=20liste=20en=20entr=C3=A9e?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- R/multitable.R | 46 ++++++++++++++++++++++++++++++---------------- 1 file changed, 30 insertions(+), 16 deletions(-) diff --git a/R/multitable.R b/R/multitable.R index f23b7fa..43daaa0 100644 --- a/R/multitable.R +++ b/R/multitable.R @@ -99,35 +99,49 @@ multi_linked_tables <- function( } noms_vars_init <- noms_vars_init[!duplicated(noms_vars_init)] + noms_col_T <- setNames(paste0("T_", noms_tbx), noms_tbx) + table_majeure <- purrr::imap( .x = liste_tbx, .f = function(tableau,nom_tab){ - var_a_ajouter <- setdiff(noms_vars_init, names(tableau)) + + tableau <- tableau[, c(list_explanatory_vars[[nom_tab]], value, freq, cost_var, secret_var)] + + var_a_ajouter <- setdiff(all_expl_vars, names(tableau)) for (nom_col in var_a_ajouter){ - tableau[[nom_col]] <- list_totcode[[nom_tab]][nom_col] + tableau[[nom_col]] <- unname( + purrr::keep( + list_totcode, function(x) nom_col %in% names(x) + )[[1]][nom_col] + ) } - tableau <- tableau %>% - relocate(all_of(value), - all_of(secret_var), - all_of(freq), - .after = last_col()) + # tableau <- tableau %>% + # relocate(all_of(value), + # all_of(secret_var), + # all_of(cost_var), + # all_of(freq), + # .after = last_col()) - nom_col_Tj <- paste0("T_", nom_tab) - tableau[[nom_col_Tj]] <- TRUE + tableau[[noms_col_T[[nom_tab]]]] <- TRUE return(tableau) } ) - table_majeure <- purrr::reduce(.x = table_majeure, - .f = full_join) - noms_cols_corres <- setdiff(names(table_majeure),noms_vars_init) - liste_pour_na <- as.list(rep(F,length(noms_cols_corres))) - names(liste_pour_na) <- noms_cols_corres + by_vars = setdiff(unique(unlist(purrr::map(table_majeure, names))), noms_col_T) + table_majeure <- purrr::reduce( + .x = table_majeure, + .f = merge, + by = by_vars, + all = TRUE + ) + + # noms_cols_corres <- setdiff(names(table_majeure),noms_vars_init) + liste_pour_na <- setNames(as.list(rep(F,length(noms_col_T))), noms_col_T) - table_majeure[noms_cols_corres] <- tidyr::replace_na(table_majeure[noms_cols_corres], - replace = liste_pour_na) + table_majeure[noms_col_T] <- tidyr::replace_na(table_majeure[noms_col_T], + replace = liste_pour_na) # 2. Préparation des listes de travail From 670608d0b660db3266b1f8fad24a6e197c0de034 Mon Sep 17 00:00:00 2001 From: Rastout Nathanael Date: Tue, 23 Aug 2022 18:14:34 +0200 Subject: [PATCH 043/107] Correction bug si jamais une seule var de croisement --- R/tab_rtauargus.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/tab_rtauargus.R b/R/tab_rtauargus.R index 76b2259..0aa357b 100644 --- a/R/tab_rtauargus.R +++ b/R/tab_rtauargus.R @@ -289,7 +289,7 @@ tab_rtauargus <- function( na.strings = "" ) res <- cbind.data.frame( - apply(res[,explanatory_vars], 2, rev_var_pour_tau_argus), + apply(res[,explanatory_vars,drop=FALSE], 2, rev_var_pour_tau_argus), res[, !names(res) %in% explanatory_vars] ) mask <- merge(tabular_original, res[,c(explanatory_vars,"Status")], by = explanatory_vars, all = TRUE) From ab7539dbfd84fa765d628a3beb62cd3b5f249bb3 Mon Sep 17 00:00:00 2001 From: julienjamme Date: Tue, 23 Aug 2022 18:51:51 +0200 Subject: [PATCH 044/107] multitable - ajout journal --- R/multitable.R | 232 ++++++++++++++++++++++++------------------------- 1 file changed, 114 insertions(+), 118 deletions(-) diff --git a/R/multitable.R b/R/multitable.R index 43daaa0..a945770 100644 --- a/R/multitable.R +++ b/R/multitable.R @@ -2,6 +2,15 @@ library(dplyr) # source("fonction_traiter2.R") # fonction qui ajoute du "secret" au hasard # #source("fonction_traiter0.R") # fonction qui appelle tau-argus +journal_add_break_line <- function(journal){ + sep_char_jour <- "-----------------------------------------" + cat(sep_char_jour, file = journal, fill = TRUE, append = TRUE) +} + +journal_add_line <- function(journal,...){ + cat(..., file = journal, fill = TRUE, append = TRUE) +} + multi_linked_tables <- function( liste_tbx, @@ -14,7 +23,7 @@ multi_linked_tables <- function( cost_var = NULL, secret_var = "is_secret_prim", func_to_call = "tab_rtauargus2", - ip_start = 1, + ip_start = 10, ip_end = 0, num_iter_max = 1000, ... @@ -34,6 +43,14 @@ multi_linked_tables <- function( ############################################################################ ############################################################################ + dir_name <- if(is.null(dir_name)) getwd() else dir_name + dir.create(dir_name, recursive = TRUE, showWarnings = FALSE) + journal <- file.path(dir_name,"journal.txt") + if(file.exists(journal)) invisible(file.remove(journal)) + + # cat("Start time: ", format(Sys.time(), "%Y-%m-%d %H:%M:%S"), "\n", file = journal, fill = TRUE, append = TRUE) + journal_add_line(journal, "Start time: ", format(Sys.time(), "%Y-%m-%d %H:%M:%S")) + journal_add_break_line(journal) ####### Function to use to make secret ###### .dots = list(...) @@ -43,10 +60,16 @@ multi_linked_tables <- function( params$value = value params$freq = freq + journal_add_line(journal, "Function called to protect the tables: ", func_to_call) + journal_add_line(journal, "Interval Protection Level for first iteration: ", ip_start) + journal_add_line(journal, "Interval Protection Level for other iterations: ", ip_end) ####### === A === INITIALISATION n_tbx = length(liste_tbx) # nombre de tableaux + journal_add_line(journal, "Nb of tables to treat: ", n_tbx) + journal_add_break_line(journal) + if(is.null(names(liste_tbx))){ names(liste_tbx) <- paste0("tab", 1:n_tbx) @@ -54,7 +77,11 @@ multi_linked_tables <- function( names(list_hrc) <- paste0("tab", 1:n_tbx) } noms_tbx <- names(liste_tbx) + journal_add_line(journal, "Tables to treat: ", noms_tbx) + journal_add_break_line(journal) all_expl_vars <- unique(unname(unlist(list_explanatory_vars))) + journal_add_line(journal, "All explanatory variables: ", all_expl_vars) + journal_add_break_line(journal) # list_totcode management # first case : list_totcode is one length-character vector : # all the expl variables in all the tables have the same value to refer to the total @@ -116,13 +143,6 @@ multi_linked_tables <- function( ) } - # tableau <- tableau %>% - # relocate(all_of(value), - # all_of(secret_var), - # all_of(cost_var), - # all_of(freq), - # .after = last_col()) - tableau[[noms_col_T[[nom_tab]]]] <- TRUE return(tableau) @@ -143,19 +163,8 @@ multi_linked_tables <- function( table_majeure[noms_col_T] <- tidyr::replace_na(table_majeure[noms_col_T], replace = liste_pour_na) - # 2. Préparation des listes de travail - # i0 = indice_depart_tableau - # num du tableau par lequel commencer - # i0 <- trouver_meilleur_point_de_depart() - - todolist <- noms_tbx #list() - # todolist[[1]] <- noms_tbx[i0] - # en fait la todolist va juste contenir des numéros de tableaux - - # oublis <- list() - # oublis <- as.list(noms_tbx[-i0]) #1:n_tbx - # oublis[i0] <- NULL + todolist <- noms_tbx ############################################################################ ############################################################################ @@ -163,7 +172,13 @@ multi_linked_tables <- function( num_iter_par_tab = setNames(rep(0, length(liste_tbx)), noms_tbx) num_iter_all = 0 - journal = list() + + journal_add_line(journal, "Initialisation work completed") + journal_add_break_line(journal) + journal_add_break_line(journal) + + common_cells_modified <- as.data.frame(matrix(ncol = length(all_expl_vars)+1)) + names(common_cells_modified) <- c(all_expl_vars, "iteration") while (length(todolist) > 0 & all(num_iter_par_tab <= num_iter_max)){ @@ -171,29 +186,14 @@ multi_linked_tables <- function( num_tableau <- todolist[1] num_iter_par_tab[num_tableau] <- num_iter_par_tab[num_tableau] + 1 cat("\n ##### Traitement tableau ", num_tableau, " ###########\n") + journal_add_line(journal, num_iter_all, "-Treatment of table ", num_tableau) + journal_add_break_line(journal) + # nom_tableau <- names() nom_col_identifiante <- paste0("T_", num_tableau) tableau_a_traiter <- which(table_majeure[[nom_col_identifiante]]) - # rappel : "todolist[[1]]" est un numéro (de tableau) ; - # corresp[,num_tableau] est une colonne donnant, pour chaque ligne de nrow(table_majeure), - # which(corresp...) est donc l'ens. des indices des lignes du tableau n°num_tableau - - # if (num_tableau %in% oublis) oublis[[which(oublis == num_tableau)]] <- NULL - - - # 0. juste pour le journal : - souvenir_todolist <- todolist - - # 1. Traiter & récupérer le masque - # nom_nouveau_masque <- paste0("is_secret_aj_",num_iter, collapse = "") - # nom_ancien_masque <- ifelse( - # num_iter > 1, - # paste0("is_secret_aj_", num_iter-1, collapse = ""), - # is_secret_primaire - # ) - # table_majeure[[nom_nouveau_masque]] <- table_majeure[[nom_ancien_masque]] var_secret_apriori <- ifelse( num_iter_all > 1, @@ -218,33 +218,19 @@ multi_linked_tables <- function( res <- do.call(func_to_call, params) res$is_secret <- res$Status != "V" - print(table(res$Status)) + journal_add_line(journal, "New cells status counts: ") + journal_add_line(journal, "- apriori (primary) secret: ", table(res$Status)["B"], "(", round(table(res$Status)["B"]/nrow(res)*100,1), "%)") + journal_add_line(journal, "- secondary secret: ", table(res$Status)["D"], "(", round(table(res$Status)["D"]/nrow(res)*100,1), "%)") + journal_add_line(journal, "- valid cells: ", table(res$Status)["V"], "(", round(table(res$Status)["V"]/nrow(res)*100,1), "%)") + journal_add_break_line(journal) + # print(table(res$Status)) res <- subset(res, select = -Status) - # res <- traiter( - # vrai_tableau, - # explanatory_vars = ex_var, - # hrc = list_hrc[[num_tableau]], - # value = value, - # freq = freq, - # maxscore = maxscore, - # secret_var = var_secret_apriori, - # totcode = list_totcode[[num_tableau]] - # ) var_secret <- paste0("is_secret_", num_iter_all) table_majeure <- merge(table_majeure, res, all = TRUE) table_majeure[[var_secret]] <- table_majeure$is_secret table_majeure <- subset(table_majeure, select = -is_secret) - # Rappel : traiter(...) renvoie un masque de secret (une colonne de booléens) - # avec une ligne pour chaque ligne du tableau d'origine - - # Rmq : ici on crée juste à chaque étape une nouvelle colonne de secret ajusté - # global. On ne crée pas la colonne intermédiaire avec masque local + des NA. - # TODO si c'est nécessaire. - - # 2. Propager - # var_secret_aj <- paste0("is_secret_aj_", num_iter) table_majeure[[var_secret]] <- ifelse( is.na(table_majeure[[var_secret]]), table_majeure[[var_secret_apriori]], @@ -257,88 +243,98 @@ multi_linked_tables <- function( # pour tout tableau j, si j n'est pas déjà dans la todolist # et s'il y a au moins 1 ligne de j qui a été modifiée, ajouter j à la todolist nom_col_identifiante <- paste0("T_", tab) - if (! (tab %in% todolist) + if( !(tab %in% todolist) & (any(table_majeure[[nom_col_identifiante]][lignes_modifs])) - ) # TODO parenthéser la négation + ){ todolist <- append(todolist,tab) + } } todolist <- todolist[-1] - # Rmq : à ce stade, todolist[[1]] est le tableau qu'on est en train de - # traiter, donc son numéro ne va pas être ajouté à la todolist même si - # (évidemment) les lignes modifiées lui appartiennent. - - # Rmq : c'est optimisé comme un tractopelle sur un circuit de formule 1 - - #Intermède : update du journal - # on enlève de la file ce tableau - - # 3. Sonder - # if (length(todolist) == 0 & length(oublis) > 0){ - # todolist[1] <- oublis[1] - # oublis[1] <- NULL - # } - # journal[[paste0("step_",num_iter)]] <- - # list( - # explique = paste0( - # "Le tableau en cours est le ", - # num_tableau, - # # ". Au debut de l'etape, la file contenait [", - # # paste(unlist(souvenir_todolist), collapse = ", "), - # # "] et maintenant elle contient [", - # # paste(unlist(todolist), collapse = ", "), - # # "]. Cette etape a modifie ", length(lignes_modifs), " lignes. ", - # # "Tableaux non visites : ", - # # ifelse(length(oublis) > 0, - # # paste(unlist(oublis), collapse = ", "), - # # "(plus aucun)") - # collapse = " "), - # tableau_en_cours = num_tableau - # # lignes_concernees = tableau_a_traiter, - # # lignes_touchees = lignes_modifs - # ) + + cur_tab <- paste0("T_", num_tableau) + common_cells <- purrr::map_dfr( + setdiff(noms_col_T, cur_tab), + function(col_T){ + table_majeure[table_majeure[[col_T]] & table_majeure[[cur_tab]],] + } + ) %>% unique() + + modified <- common_cells[common_cells[[var_secret_apriori]] != common_cells[[var_secret]],all_expl_vars] + if(nrow(modified)>0){ + common_cells_modified <- rbind( + common_cells_modified, + cbind( + modified, + iteration = num_iter_all + ) + ) + } + + journal_add_line(journal, "Nb of new common cells hit by the secret:", nrow(modified)) + journal_add_break_line(journal) + journal_add_break_line(journal) + # print(common_cells_modified) } purrr::iwalk( num_iter_par_tab, - function(num,tab) cat("End of iterating after ", num, " iterations for ", tab, "\n") + function(num,tab) journal_add_line(journal, "End of iterating after ", num, " iterations for ", tab, "\n") ) ############################################################################ ############################################################################ ####### === C === FINALISATION - # names(table_majeure)[ncol(table_majeure)] <- "is_secret_final" - # - # # Calcul des stats de secret en nombre de cases touchées & en valeur totale - # valeur_tot = sum(table_majeure[[value]]) - # nombre_cases_tot = nrow(table_majeure) - # quantification <- data.frame( - # prop_cases_secret = round(c(sum(table_majeure[["is_secret_primaire"]]), - # sum(table_majeure[["is_secret_final"]]), - # sum(!table_majeure[["is_secret_final"]]))/nombre_cases_tot,2), - # prop_masse_secret = round(c(sum(table_majeure[[value]][which(table_majeure[["is_secret_primaire"]])]), - # sum(table_majeure[[value]][which(table_majeure[["is_secret_final"]])]), - # sum(table_majeure[[value]][which(!table_majeure[["is_secret_final"]])]) - # )/valeur_tot,2) - # ) - # rownames(quantification) <- c("Secret primaire", "Secret secondaire", "Diffusable") - # Reconstruire la liste des tableaux d'entrée liste_tbx_res <- purrr::imap( liste_tbx, function(tab,nom){ expl_vars <- list_explanatory_vars[[nom]] tab_rows <- table_majeure[[paste0("T_", nom)]] - merge(tab, table_majeure[tab_rows, names(table_majeure) %in% c(expl_vars, paste0("is_secret_", 1:100))], all.x = TRUE, all.y = FALSE, by = expl_vars) + secret_vars <- names(table_majeure)[grep("^is_secret_[1-9]", names(table_majeure))] + secret_vars <- secret_vars[order(as.integer(gsub("is_secret_", "", secret_vars)))] + res <- merge( + tab, + table_majeure[tab_rows, c(expl_vars, secret_vars)], + all.x = TRUE, all.y = FALSE, by = expl_vars + ) + } + ) + last_secret <- paste0("is_secret_", num_iter_all) + + stats <- purrr::imap_dfr( + liste_tbx_res, + function(tab, name){ + # require(data.table) + tab$primary_secret <- tab[[secret_var]] + tab$total_secret <- tab[[last_secret]] + tab$secondary_secret <- tab$total_secret & !tab$primary_secret + tab$valid_cells <- !tab$total_secret + # tab <- data.table(tab) + res <- data.frame( + tab_name = name, + primary_secret = sum(tab$primary_secret), + secondary_secret = sum(tab$secondary_secret), + total_secret = sum(tab$total_secret), + valid_cells = sum(tab$valid_cells) + # tab[,lapply(.SD, sum), .SDcols = c("primary_secret","secondary_secret","total_secret", "valid_cells")] + ) } ) - # journal <- append(journal, list(quantification), after = 0) - # journal <- append(journal, list(table_majeure), after = 0) - # journal <- append(journal, list(liste_tbx2), after = 0) - # - # names(journal)[1:3] <- c("liste_tbx", "table_majeure", "quantification") - # return(journal) + journal_add_break_line(journal) + journal_add_line(journal, "Final Summary") + journal_add_break_line(journal) + journal_add_line(journal, "Secreted cells counts per table") + suppressWarnings(gdata::write.fwf(stats, file = journal, append = TRUE)) + journal_add_break_line(journal) + journal_add_break_line(journal) + journal_add_line(journal, "Common cells hit by the secret:") + # width <- max(nchar(colnames(common_cells_modified)), sapply(common_cells_modified[-1,], function(var) max(nchar(var)))) + suppressWarnings(gdata::write.fwf(common_cells_modified[-1,], file = journal, append = TRUE)) + journal_add_break_line(journal) + journal_add_line(journal, "End time: ", format(Sys.time(), "%Y-%m-%d %H:%M:%S")) + journal_add_break_line(journal) return(liste_tbx_res) } From 0367b3f4bbdd01af0fc1133f7bfa8f5f6197c296 Mon Sep 17 00:00:00 2001 From: julienjamme Date: Tue, 23 Aug 2022 18:53:01 +0200 Subject: [PATCH 045/107] test multitable ajout exemple ofats --- tests_multitable/test_multitable.R | 76 ++------- tests_multitable/test_multitable_ofats.R | 196 +++++++++++++++++++++++ 2 files changed, 213 insertions(+), 59 deletions(-) create mode 100644 tests_multitable/test_multitable_ofats.R diff --git a/tests_multitable/test_multitable.R b/tests_multitable/test_multitable.R index 68dbbe8..f997a8a 100644 --- a/tests_multitable/test_multitable.R +++ b/tests_multitable/test_multitable.R @@ -9,55 +9,6 @@ options( "Y:/Logiciels/TauArgus/TauArgus4.2.2b1/TauArgus.exe" ) -traiter <- function( - tabular, - files_name = "link", - dir_name = "tests_multitable/tauargus_files", - explanatory_vars, - hrc, - totcode = "Ensemble", - secret_var -){ - res <- tab_rtauargus( - tabular = tabular, - files_name = files_name, - dir_name = dir_name, - explanatory_vars = explanatory_vars, - hrc = hrc, - totcode = rep(totcode, length(explanatory_vars)), - secret_var = secret_var, - cost_var = NULL, - value = "tot", - freq = "n_obs", - maxscore = "max", - safety_rules = "MAN(0)", - output_type = "4", - output_options = "", - is_tabular = TRUE, - show_batch_console = FALSE, - import = FALSE, - separator = ",", - verbose = FALSE, - unif_hrc = TRUE, - unif_expl = TRUE - ) %>% - mutate( - is_secret = Status != "V" - ) - - print(res %>% count(Status)) - - return(res %>% select(-Status)) -} - - -# res <- traiter( -# list_data_2_tabs$act_treff, -# explanatory_vars = c("ACTIVITY","treff"), -# hrc = c(ACTIVITY = "tests_multitable/legumes.hrc"), -# secret_var = "is_secret_prim" -# ) - # Test 1 ----- # Liste de deux tables liées @@ -77,7 +28,6 @@ list_data_2_tabs <- list( } ) - res_1 <- multi_linked_tables( liste_tbx = list_data_2_tabs, list_explanatory_vars = list(act_treff = c("ACTIVITY", "treff"), act_cj = c("ACTIVITY", "cj")), @@ -85,15 +35,24 @@ res_1 <- multi_linked_tables( act_treff = c(ACTIVITY = "tests_multitable/legumes.hrc"), act_cj = c(ACTIVITY = "tests_multitable/legumes.hrc") ), + dir_name = "tests_multitable/test_1/tauargus_files", value = "tot", freq = "n_obs", - maxscore = "max", - is_secret_primaire = "is_secret_prim", + secret_var = "is_secret_prim", num_iter_max = 5, - totcode = "Ensemble", - indice_depart_tableau = 1 + totcode = "Ensemble" ) +# controle de cohérence des masques sur les cases communes +res_1$act_treff %>% filter(treff == "Ensemble") %>% + select(ACTIVITY, tot, n_obs, is_secret_prim, is_secret_treff = last_col()) %>% + full_join( + res_1$act_cj %>% filter(cj == "Ensemble") %>% + select(ACTIVITY, tot, n_obs, is_secret_prim, is_secret_cj = last_col()) + ) %>% + mutate(pb = is_secret_cj != is_secret_treff) %>% + filter(pb) + # Test 2 ---- @@ -132,13 +91,12 @@ res_2 <- multi_linked_tables( nuts_treff = c(NUTS = file_nuts_hrc), nuts_cj = c(NUTS = file_nuts_hrc) ), + dir_name = "tests_multitable/test_2/tauargus_files", value = "tot", freq = "n_obs", - maxscore = "max", - is_secret_primaire = "is_secret_prim", - num_iter_max = 20, - totcode = "Ensemble", - indice_depart_tableau = 1 + secret_var = "is_secret_prim", + num_iter_max = 5, + totcode = "Ensemble" ) diff --git a/tests_multitable/test_multitable_ofats.R b/tests_multitable/test_multitable_ofats.R new file mode 100644 index 0000000..810970f --- /dev/null +++ b/tests_multitable/test_multitable_ofats.R @@ -0,0 +1,196 @@ +library(dplyr) + +devtools::load_all() + +options( + rtauargus.tauargus_exe = + "Y:/Logiciels/TauArgus/TauArgus4.2.2b1/TauArgus.exe" +) + +rep_X <- "X:/HAB-Traitement-Confidentialite/Ofats/OFATS 2020/tests" +rep_inputs <- file.path(rep_X, "inputs") +rep_traits <- file.path(rep_X, "traitements") +rep_hrc <- file.path(rep_traits, "hrc") +rep_res <- file.path(rep_X, "resultats") + +p <- lapply( + list(rep_X, rep_inputs, rep_traits, rep_hrc, rep_res), + function(rep){ + if(!dir.exists(rep)) dir.create(rep) + } +) + +nace <- readxl::read_xls( + file.path(rep_inputs, "Nomenclatures.xls"), + sheet = "NACE" +) +str(nace) + +table_passage = nace %>% + select(6:2) %>% + mutate(across(.fns = ~gsub("F$","",.x))) %>% + unique() +racine = "ZZZ" + +file_nace_hrc <- nace %>% + select(6:2) %>% + mutate(across(.fns = ~gsub("F$","",.x))) %>% + unique() %>% + arrange(across(CODE5:CODE1)) %>% + write_hrc2( + output_name = "nace", + dir_name = rep_hrc, + sort_table = FALSE, + adjust_unique_roots = TRUE + ) + +# Création de deux hiérarchies non emboîtées des pays #### + +pays <- readxl::read_xls( + file.path(rep_inputs, "Nomenclatures.xls"), + sheet = "PAYS" +) %>% + mutate( + across(everything(), ~gsub(" ","_",.)) + ) +str(pays) + +file_zone_hrc <- pays %>% + select(zone, PAYS) %>% + unique() %>% + arrange(across(zone:PAYS)) %>% + write_hrc2( + output_name = "zone", + dir_name = rep_hrc, + sort_table = FALSE, + adjust_unique_roots = TRUE + ) + +file_off_hrc <- pays %>% + select(Offshore, PAYS) %>% + unique() %>% + write_hrc2( + output_name = "offshore", + dir_name = rep_hrc, + sort_table = FALSE, + adjust_unique_roots = TRUE + ) + +# Constitution des différents tableaux #### + +ofats <- haven::read_sas(file.path(rep_inputs, "ofats_2020_pr_app_secret_V4.sas7bdat")) %>% + filter(stringr::str_ends(NACE, pattern = "F$", negate = TRUE)) %>% + mutate( + across(PAYS, ~gsub(" ","_",.)) + ) +ofats <- ofats %>% + bind_rows( + ofats %>% group_by(PAYS, NOM_VAR) %>% + summarise( + VAL_ABS = sum(VAL_ABS), + FREQ = sum(FREQ), + MAX_VAL_ABS = max(MAX_VAL_ABS), + .groups = "drop" + ) %>% + mutate(NACE = "Total", diffusion = 1) + ) + + +poser_secret_primaire <- function(df, var = "ENT"){ + df %>% + {if(var == "ENT"){ + mutate( + ., + is_secret_freq = FREQ > 0 & FREQ < 3 & (diffusion == 1), + is_secret_dom = FALSE + )} else{ + mutate( + ., + is_secret_freq = FREQ > 0 & FREQ < 3 & (diffusion == 1), + is_secret_dom = VAL_ABS > 0 & MAX_VAL_ABS/VAL_ABS > 0.85 & (diffusion == 1) + )}} %>% + mutate(is_secret_prim = is_secret_freq | is_secret_dom) %>% + mutate(FREQ = ifelse(FREQ > 0 & FREQ < 1, 1, round(FREQ))) +} + +constituer_tableaux_par_var <- function(data = ofats, type_var){ + ofats_sel <- ofats %>% + filter(NOM_VAR == type_var) %>% + poser_secret_primaire(var = type_var) + + var_liste <- list() + var_liste[["zone"]] <- ofats_sel %>% + filter(PAYS %in% c(pays$PAYS, pays$zone, "A1")) %>% + select(PAYS, NACE, VAL_ABS, MAX_VAL_ABS, FREQ, diffusion, starts_with("is_secret")) + var_liste[["off"]] <- ofats_sel %>% + filter(PAYS %in% c(pays$PAYS, pays$Offshore, "A1")) %>% + select(PAYS, NACE, VAL_ABS, MAX_VAL_ABS, FREQ, diffusion, starts_with("is_secret")) + # lapply(var_liste, str) + + return(var_liste) +} + +all_vars <- ofats$NOM_VAR %>% unique() ##################TODO######### +all_tableaux <- setNames(lapply(all_vars, constituer_tableaux_par_var, data = ofats), all_vars) + +# Pose du Secret secondaire #### + +all_masques <- purrr::map( + all_vars, + function(var){ + cat("GESTION TABLEAUX ", var, "\n") + list_data_2_tabs <- list( + t_zone = all_tableaux[[var]]$zone, + t_off = all_tableaux[[var]]$off + ) + res <- multi_linked_tables( + liste_tbx = list_data_2_tabs, + list_explanatory_vars = list(t_zone = c("PAYS", "NACE"), t_off = c("PAYS", "NACE")), + list_hrc = list( + t_zone = c(PAYS = file_zone_hrc, NACE = file_nace_hrc), + t_off = c(PAYS = file_off_hrc, NACE = file_nace_hrc) + ), + dir_name = file.path(rep_traits, var, "tauargus_files"), + totcode = c(PAYS = "A1", NACE = "Total"), + value = "VAL_ABS", + freq = "FREQ", + secret_var = "is_secret_prim", + num_iter_max = 20, + ip_start = 1, + ip_end = 0 + ) + } +) + +res$t_zone %>% mutate(status = case_when(is_secret_prim ~ "AB", is_secret_7 ~ "D", TRUE ~ "V")) %>% + count(status) + +controle <- list() + +controle[["t_zone"]] <- read.csv( + file.path("X:\\HAB-Traitement-Confidentialite\\Ofats\\OFATS 2020\\traitements\\fichiers_tauargus\\EMP\\zone.csv"), + header = FALSE, + col.names = c(c("PAYS", "NACE"), "VAL_ABS", "FREQ", "Status","Dom"), + colClasses = c(rep("character", 2), rep("numeric",2), "character", "numeric"), + na.strings = "", + stringsAsFactors = FALSE +) + +controle$t_zone %>% count(Status) + +fus <- controle$t_zone %>% select(1:2,Status) %>% unique() %>% + full_join( + res$t_zone %>% select(1:3, last_col())) + +nrow(fus) + +fus %>% + filter(is.na(Status)) %>% + nrow() +fus %>% + filter(is.na(is_secret_7)) %>% + nrow() +fus %>% filter(is_secret_7 & Status == "V") + + +all_masques <- setNames(all_masques, all_vars) From 6c69fd6afef49a337779dd7be81f648032175ebb Mon Sep 17 00:00:00 2001 From: julienjamme Date: Tue, 23 Aug 2022 19:20:47 +0200 Subject: [PATCH 046/107] multitable - remove dplyr and tidyr dependencies --- R/multitable.R | 63 +++++++++++--------------------------------------- 1 file changed, 14 insertions(+), 49 deletions(-) diff --git a/R/multitable.R b/R/multitable.R index a945770..296f17b 100644 --- a/R/multitable.R +++ b/R/multitable.R @@ -1,6 +1,4 @@ library(dplyr) -# source("fonction_traiter2.R") # fonction qui ajoute du "secret" au hasard -# #source("fonction_traiter0.R") # fonction qui appelle tau-argus journal_add_break_line <- function(journal){ sep_char_jour <- "-----------------------------------------" @@ -29,30 +27,14 @@ multi_linked_tables <- function( ... ){ - #' Attendu : - #' - liste_tbx : une liste de tableaux à secrétiser - #' - list_explanatory_vars : une liste de même longueur, où - #' list_explanatory_vars[[j]] = c(...les noms des vars catégorielles du tableau j...) - #' - freq, maxscore, is_secret_primaire : les colonnes de travail pour tau-Argus - #' - totcode : c'est important que le code des totaux soit le même dans toutes les - #' tables et pour toutes les variables - #' - indice_depart_tableau : par quel n° de tableau on commence. Si un jour on a une - #' idée pertinente sur comment choisir d'où on commence, il faudrait aussi l'implémenter - #' dans la suite du code : quand on ajoute 3 trucs à la file, dans quel ordre ; quand - #' on va piocher un tableau oublié, par lequel on commence ; etc. - - ############################################################################ - ############################################################################ dir_name <- if(is.null(dir_name)) getwd() else dir_name dir.create(dir_name, recursive = TRUE, showWarnings = FALSE) journal <- file.path(dir_name,"journal.txt") if(file.exists(journal)) invisible(file.remove(journal)) - # cat("Start time: ", format(Sys.time(), "%Y-%m-%d %H:%M:%S"), "\n", file = journal, fill = TRUE, append = TRUE) journal_add_line(journal, "Start time: ", format(Sys.time(), "%Y-%m-%d %H:%M:%S")) journal_add_break_line(journal) - ####### Function to use to make secret ###### .dots = list(...) params <- param_function(eval(parse(text=func_to_call)), .dots) params$dir_name = dir_name @@ -64,8 +46,6 @@ multi_linked_tables <- function( journal_add_line(journal, "Interval Protection Level for first iteration: ", ip_start) journal_add_line(journal, "Interval Protection Level for other iterations: ", ip_end) - ####### === A === INITIALISATION - n_tbx = length(liste_tbx) # nombre de tableaux journal_add_line(journal, "Nb of tables to treat: ", n_tbx) journal_add_break_line(journal) @@ -118,8 +98,6 @@ multi_linked_tables <- function( stop("totcode has to be a character vector of length 1 or a named vector of length equal to the number of unique explanatory vars") } - # 1. Mise en forme préalable - noms_vars_init <- c() for (tab in liste_tbx){ noms_vars_init <- c(noms_vars_init, names(tab)) @@ -157,19 +135,19 @@ multi_linked_tables <- function( all = TRUE ) - # noms_cols_corres <- setdiff(names(table_majeure),noms_vars_init) - liste_pour_na <- setNames(as.list(rep(F,length(noms_col_T))), noms_col_T) - - table_majeure[noms_col_T] <- tidyr::replace_na(table_majeure[noms_col_T], - replace = liste_pour_na) - - # 2. Préparation des listes de travail + purrr::walk( + noms_col_T, + function(col_T){ + e_par <- rlang::env_parent() + e_par$table_majeure[[col_T]] <- ifelse( + is.na(e_par$table_majeure[[col_T]]), + FALSE, + e_par$table_majeure[[col_T]] + ) + } + ) todolist <- noms_tbx - ############################################################################ - ############################################################################ - ####### === B === ITÉRATIONS - num_iter_par_tab = setNames(rep(0, length(liste_tbx)), noms_tbx) num_iter_all = 0 @@ -189,12 +167,9 @@ multi_linked_tables <- function( journal_add_line(journal, num_iter_all, "-Treatment of table ", num_tableau) journal_add_break_line(journal) - # nom_tableau <- names() nom_col_identifiante <- paste0("T_", num_tableau) tableau_a_traiter <- which(table_majeure[[nom_col_identifiante]]) - # 1. Traiter & récupérer le masque - var_secret_apriori <- ifelse( num_iter_all > 1, paste0("is_secret_", num_iter_all-1, collapse = ""), @@ -204,8 +179,7 @@ multi_linked_tables <- function( ex_var <- list_explanatory_vars[[num_tableau]] - vrai_tableau <- vrai_tableau %>% - select(all_of(c(ex_var, value, freq, var_secret_apriori ))) + vrai_tableau <- vrai_tableau[,c(ex_var, value, freq, var_secret_apriori)] # Other settings of the function to make secret ---- params$tabular = vrai_tableau @@ -218,12 +192,13 @@ multi_linked_tables <- function( res <- do.call(func_to_call, params) res$is_secret <- res$Status != "V" + journal_add_line(journal, "New cells status counts: ") journal_add_line(journal, "- apriori (primary) secret: ", table(res$Status)["B"], "(", round(table(res$Status)["B"]/nrow(res)*100,1), "%)") journal_add_line(journal, "- secondary secret: ", table(res$Status)["D"], "(", round(table(res$Status)["D"]/nrow(res)*100,1), "%)") journal_add_line(journal, "- valid cells: ", table(res$Status)["V"], "(", round(table(res$Status)["V"]/nrow(res)*100,1), "%)") journal_add_break_line(journal) - # print(table(res$Status)) + res <- subset(res, select = -Status) var_secret <- paste0("is_secret_", num_iter_all) @@ -240,8 +215,6 @@ multi_linked_tables <- function( lignes_modifs <- which(table_majeure[[var_secret_apriori]] != table_majeure[[var_secret]]) for (tab in noms_tbx){ - # pour tout tableau j, si j n'est pas déjà dans la todolist - # et s'il y a au moins 1 ligne de j qui a été modifiée, ajouter j à la todolist nom_col_identifiante <- paste0("T_", tab) if( !(tab %in% todolist) & (any(table_majeure[[nom_col_identifiante]][lignes_modifs])) @@ -274,16 +247,12 @@ multi_linked_tables <- function( journal_add_line(journal, "Nb of new common cells hit by the secret:", nrow(modified)) journal_add_break_line(journal) journal_add_break_line(journal) - # print(common_cells_modified) } purrr::iwalk( num_iter_par_tab, function(num,tab) journal_add_line(journal, "End of iterating after ", num, " iterations for ", tab, "\n") ) - ############################################################################ - ############################################################################ - ####### === C === FINALISATION # Reconstruire la liste des tableaux d'entrée liste_tbx_res <- purrr::imap( @@ -305,19 +274,16 @@ multi_linked_tables <- function( stats <- purrr::imap_dfr( liste_tbx_res, function(tab, name){ - # require(data.table) tab$primary_secret <- tab[[secret_var]] tab$total_secret <- tab[[last_secret]] tab$secondary_secret <- tab$total_secret & !tab$primary_secret tab$valid_cells <- !tab$total_secret - # tab <- data.table(tab) res <- data.frame( tab_name = name, primary_secret = sum(tab$primary_secret), secondary_secret = sum(tab$secondary_secret), total_secret = sum(tab$total_secret), valid_cells = sum(tab$valid_cells) - # tab[,lapply(.SD, sum), .SDcols = c("primary_secret","secondary_secret","total_secret", "valid_cells")] ) } ) @@ -330,7 +296,6 @@ multi_linked_tables <- function( journal_add_break_line(journal) journal_add_break_line(journal) journal_add_line(journal, "Common cells hit by the secret:") - # width <- max(nchar(colnames(common_cells_modified)), sapply(common_cells_modified[-1,], function(var) max(nchar(var)))) suppressWarnings(gdata::write.fwf(common_cells_modified[-1,], file = journal, append = TRUE)) journal_add_break_line(journal) journal_add_line(journal, "End time: ", format(Sys.time(), "%Y-%m-%d %H:%M:%S")) From 388f2835d09f56946436dc06321d383f03ca16ff Mon Sep 17 00:00:00 2001 From: julienjamme Date: Wed, 24 Aug 2022 11:45:47 +0200 Subject: [PATCH 047/107] multitable gestion de la queue plus intelligente et init doc --- R/multitable.R | 163 +++++++++++++++++++++++++++++++------------------ 1 file changed, 104 insertions(+), 59 deletions(-) diff --git a/R/multitable.R b/R/multitable.R index 296f17b..f65e017 100644 --- a/R/multitable.R +++ b/R/multitable.R @@ -1,5 +1,3 @@ -library(dplyr) - journal_add_break_line <- function(journal){ sep_char_jour <- "-----------------------------------------" cat(sep_char_jour, file = journal, fill = TRUE, append = TRUE) @@ -9,31 +7,47 @@ journal_add_line <- function(journal,...){ cat(..., file = journal, fill = TRUE, append = TRUE) } - +#' Manages the secondary secret of a list of tables +#' +#' @param list_tables named list of dataframes representing the tables to protect +#' @param list_explanatory_vars named list of character vectors of explanatory variables of each table mentionned in list_tables. Names of the list are the same as of the list of tables. +#' @param dir_name character, directory where to save tauargus files +#' @param hrc named character vector, indicated the .hrc file's path of each hierarchical variables. The names of the vector are the names of the corresponding explanatory variable. +#' @param totcode character vector: either a one length vector if all explanatory variable has the same total code (default to "Total") or a named character vector detailing the total code for each explanatory variable. +#' @param value character : name of the response variable in the tables (mandatory) +#' @param freq character: name of the frequency variable in the tables (mandatory) +#' @param secret_var character: name of the boolean variable indicating if the cell doesn't respect the primary rules (apriori) - mandatory +#' @param cost_var character: name of the cost variable (default to NULL) +#' @param func_to_call character: name of the function to use to apply the secret (calling tau-argus). By default, the function is \code{tab_rtauargus2} +#' @param ip_start integer: Interval protection level to apply at first treatment of each table +#' @param ip_end integer: Interval protection level to apply at other treatments +#' @param num_iter_max integer: Maximum of treatments to do on each table +#' @param ... other arguments of func_to_call +#' +#' @return +#' @export +#' +#' @examples multi_linked_tables <- function( - liste_tbx, + list_tables, list_explanatory_vars, - list_hrc, dir_name = NULL, + hrc = NULL, totcode = "total", value = "value", freq = "freq", - cost_var = NULL, secret_var = "is_secret_prim", + cost_var = NULL, func_to_call = "tab_rtauargus2", ip_start = 10, ip_end = 0, num_iter_max = 1000, ... ){ - + start_time <- Sys.time() dir_name <- if(is.null(dir_name)) getwd() else dir_name dir.create(dir_name, recursive = TRUE, showWarnings = FALSE) - journal <- file.path(dir_name,"journal.txt") - if(file.exists(journal)) invisible(file.remove(journal)) - journal_add_line(journal, "Start time: ", format(Sys.time(), "%Y-%m-%d %H:%M:%S")) - journal_add_break_line(journal) .dots = list(...) params <- param_function(eval(parse(text=func_to_call)), .dots) @@ -42,26 +56,28 @@ multi_linked_tables <- function( params$value = value params$freq = freq - journal_add_line(journal, "Function called to protect the tables: ", func_to_call) - journal_add_line(journal, "Interval Protection Level for first iteration: ", ip_start) - journal_add_line(journal, "Interval Protection Level for other iterations: ", ip_end) - - n_tbx = length(liste_tbx) # nombre de tableaux - journal_add_line(journal, "Nb of tables to treat: ", n_tbx) - journal_add_break_line(journal) + n_tbx = length(list_tables) # nombre de tableaux - if(is.null(names(liste_tbx))){ - names(liste_tbx) <- paste0("tab", 1:n_tbx) + if(is.null(names(list_tables))){ + names(list_tables) <- paste0("tab", 1:n_tbx) names(list_explanatory_vars) <- paste0("tab", 1:n_tbx) names(list_hrc) <- paste0("tab", 1:n_tbx) } - noms_tbx <- names(liste_tbx) - journal_add_line(journal, "Tables to treat: ", noms_tbx) - journal_add_break_line(journal) + noms_tbx <- names(list_tables) all_expl_vars <- unique(unname(unlist(list_explanatory_vars))) - journal_add_line(journal, "All explanatory variables: ", all_expl_vars) - journal_add_break_line(journal) + + if( (!is.null(hrc)) & (length(names(hrc)) == 0)){ + stop("hrc must have names corresponding to the adequate explanatory variables") + }else{ + list_hrc <- purrr::map( + list_explanatory_vars, + function(nom_vars){ + purrr::discard(hrc[nom_vars], is.na) + } + ) + } + # list_totcode management # first case : list_totcode is one length-character vector : # all the expl variables in all the tables have the same value to refer to the total @@ -99,7 +115,7 @@ multi_linked_tables <- function( } noms_vars_init <- c() - for (tab in liste_tbx){ + for (tab in list_tables){ noms_vars_init <- c(noms_vars_init, names(tab)) } noms_vars_init <- noms_vars_init[!duplicated(noms_vars_init)] @@ -107,7 +123,7 @@ multi_linked_tables <- function( noms_col_T <- setNames(paste0("T_", noms_tbx), noms_tbx) table_majeure <- purrr::imap( - .x = liste_tbx, + .x = list_tables, .f = function(tableau,nom_tab){ tableau <- tableau[, c(list_explanatory_vars[[nom_tab]], value, freq, cost_var, secret_var)] @@ -146,26 +162,38 @@ multi_linked_tables <- function( ) } ) - todolist <- noms_tbx + todolist <- noms_tbx[1] + remainlist <- noms_tbx[-1] - num_iter_par_tab = setNames(rep(0, length(liste_tbx)), noms_tbx) + num_iter_par_tab = setNames(rep(0, length(list_tables)), noms_tbx) num_iter_all = 0 + common_cells_modified <- as.data.frame(matrix(ncol = length(all_expl_vars)+1)) + names(common_cells_modified) <- c(all_expl_vars, "iteration") + + journal <- file.path(dir_name,"journal.txt") + if(file.exists(journal)) invisible(file.remove(journal)) + journal_add_line(journal, "Start time:", format(start_time, "%Y-%m-%d %H:%M:%S")) + journal_add_break_line(journal) + journal_add_line(journal, "Function called to protect the tables:", func_to_call) + journal_add_line(journal, "Interval Protection Level for first iteration:", ip_start) + journal_add_line(journal, "Interval Protection Level for other iterations:", ip_end) + journal_add_line(journal, "Nb of tables to treat: ", n_tbx) + journal_add_break_line(journal) + journal_add_line(journal, "Tables to treat:", noms_tbx) + journal_add_break_line(journal) + journal_add_line(journal, "All explanatory variables:", all_expl_vars) + journal_add_break_line(journal) journal_add_line(journal, "Initialisation work completed") journal_add_break_line(journal) journal_add_break_line(journal) - common_cells_modified <- as.data.frame(matrix(ncol = length(all_expl_vars)+1)) - names(common_cells_modified) <- c(all_expl_vars, "iteration") - - while (length(todolist) > 0 & all(num_iter_par_tab <= num_iter_max)){ + while(length(todolist) > 0 & all(num_iter_par_tab <= num_iter_max)){ 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("\n ##### Traitement tableau ", num_tableau, " ###########\n") - journal_add_line(journal, num_iter_all, "-Treatment of table ", num_tableau) - journal_add_break_line(journal) + cat("--- Current table to treat: ", num_tableau, "---\n") nom_col_identifiante <- paste0("T_", num_tableau) tableau_a_traiter <- which(table_majeure[[nom_col_identifiante]]) @@ -192,12 +220,10 @@ multi_linked_tables <- function( res <- do.call(func_to_call, params) res$is_secret <- res$Status != "V" - - journal_add_line(journal, "New cells status counts: ") - journal_add_line(journal, "- apriori (primary) secret: ", table(res$Status)["B"], "(", round(table(res$Status)["B"]/nrow(res)*100,1), "%)") - journal_add_line(journal, "- secondary secret: ", table(res$Status)["D"], "(", round(table(res$Status)["D"]/nrow(res)*100,1), "%)") - journal_add_line(journal, "- valid cells: ", table(res$Status)["V"], "(", round(table(res$Status)["V"]/nrow(res)*100,1), "%)") - journal_add_break_line(journal) + prim_stat <- table(res$Status)["B"] + sec_stat <- table(res$Status)["D"] + valid_stat <- table(res$Status)["V"] + denom_stat <- nrow(res)*100 res <- subset(res, select = -Status) @@ -214,17 +240,6 @@ multi_linked_tables <- function( lignes_modifs <- which(table_majeure[[var_secret_apriori]] != table_majeure[[var_secret]]) - for (tab in noms_tbx){ - nom_col_identifiante <- paste0("T_", tab) - if( !(tab %in% todolist) - & (any(table_majeure[[nom_col_identifiante]][lignes_modifs])) - ){ - todolist <- append(todolist,tab) - } - } - - todolist <- todolist[-1] - cur_tab <- paste0("T_", num_tableau) common_cells <- purrr::map_dfr( setdiff(noms_col_T, cur_tab), @@ -244,19 +259,40 @@ multi_linked_tables <- function( ) } + for(tab in noms_tbx){ + nom_col_identifiante <- paste0("T_", tab) + if( !(tab %in% todolist) + & (any(table_majeure[[nom_col_identifiante]][lignes_modifs])) + ){ + todolist <- append(todolist,tab) + remainlist <- remainlist[remainlist != tab] + } + } + + todolist <- todolist[-1] + if(length(todolist) == 0){ + if(length(remainlist) > 0){ + todolist <- remainlist[1] + remainlist <- remainlist[-1] + } + } + + journal_add_line(journal, num_iter_all, "-Treatment of table", num_tableau) + journal_add_break_line(journal) + journal_add_line(journal, "New cells status counts: ") + journal_add_line(journal, "- apriori (primary) secret:", prim_stat, "(", round(prim_stat/denom_stat,1), "%)") + journal_add_line(journal, "- secondary secret:", sec_stat , "(", round(sec_stat/denom_stat,1), "%)") + journal_add_line(journal, "- valid cells:", valid_stat, "(", round(valid_stat/denom_stat,1), "%)") + journal_add_break_line(journal) journal_add_line(journal, "Nb of new common cells hit by the secret:", nrow(modified)) journal_add_break_line(journal) journal_add_break_line(journal) - } - purrr::iwalk( - num_iter_par_tab, - function(num,tab) journal_add_line(journal, "End of iterating after ", num, " iterations for ", tab, "\n") - ) + } # Reconstruire la liste des tableaux d'entrée liste_tbx_res <- purrr::imap( - liste_tbx, + list_tables, function(tab,nom){ expl_vars <- list_explanatory_vars[[nom]] tab_rows <- table_majeure[[paste0("T_", nom)]] @@ -288,6 +324,15 @@ multi_linked_tables <- function( } ) + purrr::iwalk( + num_iter_par_tab, + function(num,tab){ + journal_add_line( + journal, + "End of iterating after", num, "iterations for", tab + ) + } + ) journal_add_break_line(journal) journal_add_line(journal, "Final Summary") journal_add_break_line(journal) From 5b47a24e3fc2db54c50d90da7a513170f1e7cb18 Mon Sep 17 00:00:00 2001 From: julienjamme Date: Wed, 24 Aug 2022 11:46:34 +0200 Subject: [PATCH 048/107] revision exemples --- tests_multitable/test_multitable.R | 17 ++++++----------- tests_multitable/test_multitable_ofats.R | 2 +- 2 files changed, 7 insertions(+), 12 deletions(-) diff --git a/tests_multitable/test_multitable.R b/tests_multitable/test_multitable.R index f997a8a..2e7167f 100644 --- a/tests_multitable/test_multitable.R +++ b/tests_multitable/test_multitable.R @@ -29,12 +29,9 @@ list_data_2_tabs <- list( ) res_1 <- multi_linked_tables( - liste_tbx = list_data_2_tabs, + list_tables = list_data_2_tabs, list_explanatory_vars = list(act_treff = c("ACTIVITY", "treff"), act_cj = c("ACTIVITY", "cj")), - list_hrc = list( - act_treff = c(ACTIVITY = "tests_multitable/legumes.hrc"), - act_cj = c(ACTIVITY = "tests_multitable/legumes.hrc") - ), + hrc = c(ACTIVITY = "tests_multitable/legumes.hrc"), dir_name = "tests_multitable/test_1/tauargus_files", value = "tot", freq = "n_obs", @@ -80,16 +77,14 @@ load(file = "tests_multitable/data/corr_table_nuts23_fr.RData") file_nuts_hrc <- corr_table_nuts23_fr %>% write_hrc2("nuts23", dir_name = "tests_multitable") res_2 <- multi_linked_tables( - liste_tbx = list_data_4_tabs, + list_tables = list_data_4_tabs, list_explanatory_vars = list( act_treff = c("ACTIVITY", "treff"), act_cj = c("ACTIVITY", "cj"), nuts_treff = c("NUTS", "treff"), nuts_cj = c("NUTS", "cj") ), - list_hrc = list( - act_treff = c(ACTIVITY = "tests_multitable/legumes.hrc"), - act_cj = c(ACTIVITY = "tests_multitable/legumes.hrc"), - nuts_treff = c(NUTS = file_nuts_hrc), - nuts_cj = c(NUTS = file_nuts_hrc) + hrc = c( + ACTIVITY = "tests_multitable/legumes.hrc", + NUTS = file_nuts_hrc ), dir_name = "tests_multitable/test_2/tauargus_files", value = "tot", diff --git a/tests_multitable/test_multitable_ofats.R b/tests_multitable/test_multitable_ofats.R index 810970f..e226f3c 100644 --- a/tests_multitable/test_multitable_ofats.R +++ b/tests_multitable/test_multitable_ofats.R @@ -144,7 +144,7 @@ all_masques <- purrr::map( t_off = all_tableaux[[var]]$off ) res <- multi_linked_tables( - liste_tbx = list_data_2_tabs, + list_tables = list_data_2_tabs, list_explanatory_vars = list(t_zone = c("PAYS", "NACE"), t_off = c("PAYS", "NACE")), list_hrc = list( t_zone = c(PAYS = file_zone_hrc, NACE = file_nace_hrc), From bccbe51baffa6f4627e1ae50697c53bf7a0fc366 Mon Sep 17 00:00:00 2001 From: julienjamme Date: Wed, 24 Aug 2022 19:13:14 +0200 Subject: [PATCH 049/107] writehrc remove dirname arguments and change output_name to file_name + check documentation --- R/writehrc.R | 78 +++++++++++++++++++++++++--------------------------- 1 file changed, 37 insertions(+), 41 deletions(-) diff --git a/R/writehrc.R b/R/writehrc.R index 93e9ff7..d1c142f 100644 --- a/R/writehrc.R +++ b/R/writehrc.R @@ -52,24 +52,22 @@ vect_aro <- Vectorize(arobase, vectorize.args = c("string", "number")) #' Creates a .hrc hierarchy from a correspondence table. \cr #' Ecrit une hiérarchie .hrc à partir d'une table de correspondance. #' -#' @param corr_table Data frame. Correspondence table, from most aggregated to most detailed +#' @param corr_table Data frame. Correspondence table, from most aggregated level to most detailed one #' \cr -#' Table de correspondance, du plus agrégé au plus fin -#' @param output_name character string. Name for the output file (with no -#' extension) ; default is set to the same name as the correspondence table +#' Table de correspondance, du niveau le plus agrégé au niveau le plus fin +#' @param file_name character string. Name for the output file (with .hrc extension or not). +#' If NULL (default), file_name is set to the same name as the correspondence table #' \cr -#' Nom du fichier en sortie (sans extension) ; par défaut, -#' identique au nom de la table de correspondance -#' @param dir_name character string. Directory name for the hrc file -#' \cr -#' Nom du répertoire dans lequel écrire le fichier hrc +#' Nom du fichier en sortie (avec ou sans l'extension .hrc) ; Si NULL (par défaut), +#' le nom du fichier sera identique au nom de la table de correspondance. #' @param sort_table boolean. If TRUE, table will be sorted beforehand. #' (default to FALSE)\cr #' Si TRUE, la table sera triée avant traitement. (défaut à FALSE) #' @param rev boolean. If TRUE, column order is reversed.\cr #' Si TRUE, inverse l'ordre des colonnes. #' @param hier_lead_string character. (Single) character indicating the -#' hierarchy depth in the .hrc file +#' hierarchy depth in the .hrc file. By default, the value is set to the current +#' value mentionned in the package options (i.e. "@" at the package startup). #' \cr #' Caractère unique repérant le niveau de profondeur dans le .hrc #' @param adjust_unique_roots boolean. If TRUE will add fictional roots to the @@ -264,7 +262,7 @@ vect_aro <- Vectorize(arobase, vectorize.args = c("string", "number")) #' "telluric", "gasgiant", "bluestar", "whitedwarf", #' "reddwarf", "blackhole", "pulsar") #' ) -#' path <- write_hrc2(astral, hier_lead_string = "@") +#' path <- write_hrc2(astral) #' \dontrun{read.table(path)} #' # Note that line order was changed ('other' comes before 'planet'), to no #' # consequence whatsoever for Tau-Argus. @@ -279,7 +277,7 @@ vect_aro <- Vectorize(arobase, vectorize.args = c("string", "number")) #' "reddwarf", "blackhole", "pulsar"), #' type = c("planet", "planet", "star", "star", "star", "other", "other") #' ) -#' path <- write_hrc2(astral_inv, hier_lead_string = "@") +#' path <- write_hrc2(astral_inv) #' \dontrun{read.table(path)} #' # Because of the inverted order, everything is written backwards : planet is a #' # subtype of gasgiant, etc. @@ -287,7 +285,7 @@ vect_aro <- Vectorize(arobase, vectorize.args = c("string", "number")) #' # devenu une sous-catégorie de gasgiant, par exemple. #' #' # Correction : -#' path <- write_hrc2(astral_inv, rev = TRUE, hier_lead_string = "@") +#' path <- write_hrc2(astral_inv, rev = TRUE) #' \dontrun{read.table(path)} #' #' # 2.1 Sparse case @@ -301,7 +299,7 @@ vect_aro <- Vectorize(arobase, vectorize.args = c("string", "number")) #' # NAs in general are risky, but, in this case, the function works well. #' # Les valeurs manquantes causent un risque, mais, dans ce genre de cas, #' # la fonction a le comportement attendu. -#' path <- write_hrc2(astral_sparse, hier_lead_string = "@") +#' path <- write_hrc2(astral_sparse) #' \dontrun{read.table(path)} #' #' # 2.2 Non-uniform depth @@ -313,7 +311,7 @@ vect_aro <- Vectorize(arobase, vectorize.args = c("string", "number")) #' # The following code will generate an error #' # (see section Details about correspondence table & .hrc) #' \dontrun{ -#' path <- write_hrc2(astral_nu, hier_lead_string = "@") +#' path <- write_hrc2(astral_nu) #' } #' #To fix the issue, you have to fill in the NAs beforehand. #' @@ -322,20 +320,20 @@ vect_aro <- Vectorize(arobase, vectorize.args = c("string", "number")) #' details = c("telluric", "gasgiant", "star", "blackhole", "pulsar") #' ) #' # The following code will work -#' path <- write_hrc2(astral_nu_fill, hier_lead_string = "@") +#' path <- write_hrc2(astral_nu_fill) #' \dontrun{read.table(path)} #' #' @importFrom zoo na.locf #' @export -write_hrc2 <- function(corr_table, - output_name = NULL, - dir_name = NULL, - sort_table = FALSE, - rev = FALSE, - hier_lead_string = getOption("rtauargus.hierleadstring"), - adjust_unique_roots = FALSE, - add_char = "ZZZ" +write_hrc2 <- function( + corr_table, + file_name = NULL, + sort_table = FALSE, + rev = FALSE, + hier_lead_string = getOption("rtauargus.hierleadstring"), + adjust_unique_roots = FALSE, + add_char = "ZZZ" ){ if(! any(class(corr_table) %in% c("data.frame","matrix"))){ @@ -343,18 +341,18 @@ write_hrc2 <- function(corr_table, stop(paste0("corr_table has to be a data frame or a matrix, not ", class_corr)) } # Set default filename / directory - if (is.null(output_name)) { + if(is.null(file_name)) { givenfilename <- deparse(substitute(corr_table)) - output_name <- givenfilename + file_name <- givenfilename } - if(is.null(dir_name)){ - dir_name <- getwd() - }else if(dir_name == ""){ - dir_name <- getwd() - } else if(! dir.exists(dir_name)){ - stop(paste0("directory ", dir_name, " doesn't exist.")) - } + # if(is.null(dir_name)){ + # dir_name <- getwd() + # }else if(dir_name == ""){ + # dir_name <- getwd() + # } else if(! dir.exists(dir_name)){ + # stop(paste0("directory ", dir_name, " doesn't exist.")) + # } d = dim.data.frame(corr_table) @@ -396,15 +394,13 @@ write_hrc2 <- function(corr_table, } if(adjust_unique_roots==TRUE){ - warning(paste0("If there is unique roots in the table, the function will create -fictional roots to adjust the hrc file for Tau-Argus, they will be created -by copying the unique roots and adding ",add_char," at the beginning -of the root character, if this creates duplicates, change the add_char -parameter")) +# warning(paste0("If there is unique roots in the table, the function will create +# fictional roots to adjust the hrc file for Tau-Argus, they will be created +# by copying the unique roots and adding ",add_char," at the beginning +# of the root character, if this creates duplicates, change the add_char +# parameter")) corr_table <- ajouter_feuille_unique(corr_table,add_char) } - # (Todo : lister cas de NA non gênantes et bloquer les autres) - # Try to detect a problem with detailed column if (sum(duplicated(corr_table[,d[2]]))>0) { warning("There are duplicates in the expectedly most detailed level @@ -497,7 +493,7 @@ parameter")) # not been erased still hold a line break ("\n") so that there will be line # breaks only after non-void characters. - loc_file <- paste0(c(dir_name, "/", output_name, ".hrc"), collapse = "") + loc_file <- ifelse(length(grep(".hrc$", file_name)) == 0, paste0(file_name,".hrc"), file_name) write.table( x = corr_table, From 721952ec287a03b4f494de3f99a6ba4f7b69b337 Mon Sep 17 00:00:00 2001 From: julienjamme Date: Wed, 24 Aug 2022 19:40:38 +0200 Subject: [PATCH 050/107] creation of directory if it doesn't exist --- R/writehrc.R | 3 +++ 1 file changed, 3 insertions(+) diff --git a/R/writehrc.R b/R/writehrc.R index d1c142f..3835492 100644 --- a/R/writehrc.R +++ b/R/writehrc.R @@ -344,6 +344,9 @@ write_hrc2 <- function( if(is.null(file_name)) { givenfilename <- deparse(substitute(corr_table)) file_name <- givenfilename + }else{ + dir <- dirname(path = file_name) + if(!dir.exists(dir)) dir.create(dir, recursive = FALSE) } # if(is.null(dir_name)){ From a23a78de5c2b89d6a615f01e168b22cdfe73a83c Mon Sep 17 00:00:00 2001 From: julienjamme Date: Wed, 24 Aug 2022 19:49:00 +0200 Subject: [PATCH 051/107] ajustement tests multitable avec nouvelles tables --- tests_multitable/create_corr_table_activity.R | 25 ++++++ tests_multitable/test_multitable.R | 87 ++++++++++--------- 2 files changed, 72 insertions(+), 40 deletions(-) create mode 100644 tests_multitable/create_corr_table_activity.R diff --git a/tests_multitable/create_corr_table_activity.R b/tests_multitable/create_corr_table_activity.R new file mode 100644 index 0000000..6319eb7 --- /dev/null +++ b/tests_multitable/create_corr_table_activity.R @@ -0,0 +1,25 @@ + +# devtools::load_all() + +library(dplyr) + +a <- sdcHierarchies::hier_import("tests_multitable/legumes.hrc", from = "hrc") +# hier_export(a, as = "argus", path = "tests_multitable/activity.hrc") + +activity_corr_table <- purrr::reduce( + purrr::map( + sort(unique(a$level))[-1], + function(lev){ + res <- a %>% filter(level == lev) %>% select(root, leaf) + names(res) <- paste0("V", (lev-1:0)) + res + } + ), + full_join +) %>% + mutate(V4 = ifelse(is.na(V4), V3, V4)) %>% + select(-V1) %>% + as.data.frame() +names(activity_corr_table) <- c("A10","A21","A88") + +save(activity_corr_table, file = "tests_multitable/activity_corr_table.RData") diff --git a/tests_multitable/test_multitable.R b/tests_multitable/test_multitable.R index 2e7167f..e41215c 100644 --- a/tests_multitable/test_multitable.R +++ b/tests_multitable/test_multitable.R @@ -1,9 +1,18 @@ library(dplyr) devtools::load_all() -load("tests_multitable/data/red_vegetables_4_linked_tabs.RData") +load("tests_multitable/data/turnover_2var_4tabs.RData") +# Preparation of hrc files ---- +load("tests_multitable/data/activity_corr_table.RData") +hrc_file_activity <- activity_corr_table %>% + write_hrc2(file_name = "tests_multitable/hrc/activity") + +load(file = "tests_multitable/data/corr_table_nuts23_fr.RData") +hrc_file_nuts <- corr_table_nuts23_fr %>% + write_hrc2(file_name = "tests_multitable/hrc/nuts23") + options( rtauargus.tauargus_exe = "Y:/Logiciels/TauArgus/TauArgus4.2.2b1/TauArgus.exe" @@ -13,98 +22,96 @@ options( # Liste de deux tables liées list_data_2_tabs <- list( - act_treff = red_vegetables_act_treff, - act_cj = red_vegetables_act_cj + act_size = turnover_act_size, + act_cj = turnover_act_cj ) %>% purrr::map( function(df){ df %>% mutate( - is_secret_freq = n_obs > 0 & n_obs < 3, - is_secret_dom = ifelse(max == 0, FALSE, max/tot>0.85), + is_secret_freq = N_OBS > 0 & N_OBS < 3, + is_secret_dom = ifelse(MAX == 0, FALSE, MAX/TOT>0.85), is_secret_prim = is_secret_freq | is_secret_dom - ) %>% - mutate(n_obs = ifelse(n_obs > 0 & n_obs < 1, 1, round(n_obs))) + ) + # mutate(N_OBS = ifelse(N_OBS > 0 & N_OBS < 1, 1, round(N_OBS))) } ) res_1 <- multi_linked_tables( list_tables = list_data_2_tabs, - list_explanatory_vars = list(act_treff = c("ACTIVITY", "treff"), act_cj = c("ACTIVITY", "cj")), - hrc = c(ACTIVITY = "tests_multitable/legumes.hrc"), + list_explanatory_vars = list( + act_size = c("ACTIVITY", "SIZE"), + act_cj = c("ACTIVITY", "CJ") + ), + hrc = c(ACTIVITY = hrc_file_activity), dir_name = "tests_multitable/test_1/tauargus_files", - value = "tot", - freq = "n_obs", + value = "TOT", + freq = "N_OBS", secret_var = "is_secret_prim", num_iter_max = 5, - totcode = "Ensemble" + totcode = "Total" ) # controle de cohérence des masques sur les cases communes -res_1$act_treff %>% filter(treff == "Ensemble") %>% - select(ACTIVITY, tot, n_obs, is_secret_prim, is_secret_treff = last_col()) %>% +res_1$act_size %>% filter(SIZE == "Total") %>% + select(ACTIVITY, TOT, N_OBS, is_secret_prim, is_secret_treff = last_col()) %>% full_join( - res_1$act_cj %>% filter(cj == "Ensemble") %>% - select(ACTIVITY, tot, n_obs, is_secret_prim, is_secret_cj = last_col()) + res_1$act_cj %>% filter(CJ == "Total") %>% + select(ACTIVITY, TOT, N_OBS, is_secret_prim, is_secret_cj = last_col()) ) %>% mutate(pb = is_secret_cj != is_secret_treff) %>% filter(pb) - # Test 2 ---- # Test avec 4 tables liées list_data_4_tabs <- list( - act_treff = red_vegetables_act_treff, - act_cj = red_vegetables_act_cj, - nuts_treff = red_vegetables_nuts_treff, - nuts_cj = red_vegetables_nuts_cj + act_size = turnover_act_size, + act_cj = turnover_act_cj, + nuts_treff = turnover_nuts_size, + nuts_cj = turnover_nuts_cj ) %>% purrr::map( function(df){ df %>% mutate( - is_secret_freq = n_obs > 0 & n_obs < 3, - is_secret_dom = ifelse(max == 0, FALSE, max/tot>0.85), + is_secret_freq = N_OBS > 0 & N_OBS < 3, + is_secret_dom = ifelse(MAX == 0, FALSE, MAX/TOT>0.85), is_secret_prim = is_secret_freq | is_secret_dom - ) %>% - mutate(n_obs = ifelse(n_obs > 0 & n_obs < 1, 1, round(n_obs))) + ) + # mutate(N_OBS = ifelse(N_OBS > 0 & N_OBS < 1, 1, round(N_OBS))) } ) -load(file = "tests_multitable/data/corr_table_nuts23_fr.RData") -file_nuts_hrc <- corr_table_nuts23_fr %>% write_hrc2("nuts23", dir_name = "tests_multitable") - res_2 <- multi_linked_tables( list_tables = list_data_4_tabs, list_explanatory_vars = list( - act_treff = c("ACTIVITY", "treff"), act_cj = c("ACTIVITY", "cj"), - nuts_treff = c("NUTS", "treff"), nuts_cj = c("NUTS", "cj") + act_size = c("ACTIVITY", "SIZE"), act_cj = c("ACTIVITY", "CJ"), + nuts_treff = c("NUTS", "SIZE"), nuts_cj = c("NUTS", "CJ") ), hrc = c( - ACTIVITY = "tests_multitable/legumes.hrc", - NUTS = file_nuts_hrc + ACTIVITY = hrc_file_activity, + NUTS = hrc_file_nuts ), dir_name = "tests_multitable/test_2/tauargus_files", - value = "tot", - freq = "n_obs", + value = "TOT", + freq = "N_OBS", secret_var = "is_secret_prim", num_iter_max = 5, - totcode = "Ensemble" + totcode = "Total" ) - -res_2$act_treff %>% filter(treff == "Ensemble") %>% select(ACTIVITY, is_secret_treff = last_col()) %>% +res_2$act_size %>% filter(SIZE == "Total") %>% select(ACTIVITY, is_secret_treff = last_col()) %>% full_join( - res_2$act_cj %>% filter(cj == "Ensemble") %>% select(ACTIVITY, is_secret_cj = last_col()), + res_2$act_cj %>% filter(CJ == "Total") %>% select(ACTIVITY, is_secret_cj = last_col()), by = "ACTIVITY" ) %>% filter(is_secret_treff != is_secret_cj) -res_2$nuts_treff %>% filter(treff == "Ensemble") %>% select(NUTS, is_secret_treff = last_col()) %>% +res_2$nuts_treff %>% filter(SIZE == "Total") %>% select(NUTS, is_secret_treff = last_col()) %>% full_join( - res_2$nuts_cj %>% filter(cj == "Ensemble") %>% select(NUTS, is_secret_cj = last_col()), + res_2$nuts_cj %>% filter(CJ == "Total") %>% select(NUTS, is_secret_cj = last_col()), by = "NUTS" ) %>% filter(is_secret_treff != is_secret_cj) From 1c29ff02a34ba6ef61d7e11073dd3c09784c8852 Mon Sep 17 00:00:00 2001 From: julienjamme Date: Wed, 24 Aug 2022 23:23:14 +0200 Subject: [PATCH 052/107] rename multi_linked_tables with tab_multi_manager --- R/multitable.R | 75 ++++++++++++++++++++++++++++++++++++++++++++------ 1 file changed, 66 insertions(+), 9 deletions(-) diff --git a/R/multitable.R b/R/multitable.R index f65e017..6972829 100644 --- a/R/multitable.R +++ b/R/multitable.R @@ -24,11 +24,66 @@ journal_add_line <- function(journal,...){ #' @param num_iter_max integer: Maximum of treatments to do on each table #' @param ... other arguments of func_to_call #' -#' @return -#' @export +#' @return original list of tables. Secret Results of each iteration is added to each table. +#' For example, the result of first iteration is called 'is_secret_1' in each table. +#' It's a boolean variable, whether the cell has to be masked or not. +#' +#' @seealso \code{tab_rtauargus2} #' #' @examples -multi_linked_tables <- function( +#' library(rtauargus) +#' library(dplyr) +#' data(turnover_act_size) +#' data(turnover_act_cj) +#' data(activity_corr_table) +#' +#' #0-Making hrc file of business sectors ---- +#' hrc_file_activity <- activity_corr_table %>% +#' write_hrc2(file_name = "hrc/activity") +#' +#' #1-Prepare data ---- +#' #Indicate whether each cell complies with the primary rules +#' #Boolean variable created is TRUE if the cell doesn't comply. +#' #Here the frequency rule is freq in (0;3) +#' #and the dominance rule is NK(1,85) +#' list_data_2_tabs <- list( +#' act_size = turnover_act_size, +#' act_cj = turnover_act_cj +#' ) %>% +#' purrr::map( +#' function(df){ +#' df %>% +#' mutate( +#' is_secret_freq = N_OBS > 0 & N_OBS < 3, +#' is_secret_dom = ifelse(MAX == 0, FALSE, MAX/TOT>0.85), +#' is_secret_prim = is_secret_freq | is_secret_dom +#' ) +#' } +#' ) +#' \dontrun{ +#' options( +#' rtauargus.tauargus_exe = +#' "Y:/Logiciels/TauArgus/TauArgus4.2.2b1/TauArgus.exe" +#' ) +#' res_1 <- tab_multi_manager( +#' list_tables = list_data_2_tabs, +#' list_explanatory_vars = list( +#' act_size = c("ACTIVITY", "SIZE"), +#' act_cj = c("ACTIVITY", "CJ") +#' ), +#' hrc = c(ACTIVITY = hrc_file_activity), +#' dir_name = "tauargus_files", +#' value = "TOT", +#' freq = "N_OBS", +#' secret_var = "is_secret_prim", +#' totcode = "Total" +#' ) +#' } +#' +#' @importFrom rlang .data +#' +#' @export +tab_multi_manager <- function( list_tables, list_explanatory_vars, dir_name = NULL, @@ -241,12 +296,14 @@ multi_linked_tables <- function( lignes_modifs <- which(table_majeure[[var_secret_apriori]] != table_majeure[[var_secret]]) cur_tab <- paste0("T_", num_tableau) - common_cells <- purrr::map_dfr( - setdiff(noms_col_T, cur_tab), - function(col_T){ - table_majeure[table_majeure[[col_T]] & table_majeure[[cur_tab]],] - } - ) %>% unique() + common_cells <- unique( + purrr::map_dfr( + setdiff(noms_col_T, cur_tab), + function(col_T){ + table_majeure[table_majeure[[col_T]] & table_majeure[[cur_tab]],] + } + ) + ) modified <- common_cells[common_cells[[var_secret_apriori]] != common_cells[[var_secret]],all_expl_vars] if(nrow(modified)>0){ From c60f96cb58337ee2b48ba745de746b00e8fda9ea Mon Sep 17 00:00:00 2001 From: julienjamme Date: Wed, 24 Aug 2022 23:23:56 +0200 Subject: [PATCH 053/107] revision doc tab_rtaurgus et tab_rtauargus2 --- R/tab_rtauargus.R | 116 ++++++++++++++++++++++++++++++---------------- 1 file changed, 75 insertions(+), 41 deletions(-) diff --git a/R/tab_rtauargus.R b/R/tab_rtauargus.R index 0aa357b..17edbd9 100644 --- a/R/tab_rtauargus.R +++ b/R/tab_rtauargus.R @@ -58,7 +58,7 @@ rev_var_pour_tau_argus <- function(char='**monchar', del_char='*'){ #' #' If output_type doesn't equal to 4, then the raw result from tau-argus is returned. #' -#' @section Standardization of explanatory variables and hierarchies +#' @section Standardization of explanatory variables and hierarchies: #' #' The two boolean arguments \code{unif_hrc} and \code{unif_expl} are useful to #' prevent some common errors in using Tau-Argus. Indeed, Tau-Argus needs that, @@ -74,36 +74,38 @@ rev_var_pour_tau_argus <- function(char='**monchar', del_char='*'){ #' @examples #'\dontrun{ #' library(dplyr) -#' data(red_vegetables) -#' red_vegetables_ps <-red_vegetables %>% -#' mutate( -#' is_secret_freq = n_obs<3 & n_obs>0, -#' is_secret_dom = max>0.85*tot, -#' is_secret_prim = is_secret_dom | is_secret_freq -#' ) -#' options( -#' rtauargus.tauargus_exe = -#' "Y:/Logiciels/TauArgus/TauArgus4.2.2b1/TauArgus.exe" +#' data(turnover_act_size) +#' +#' # Prepare data with primary secret ---- +#' turnover_act_size <- turnover_act_size %>% +#' mutate( +#' is_secret_freq = N_OBS > 0 & N_OBS < 3, +#' is_secret_dom = ifelse(MAX == 0, FALSE, MAX/TOT>0.85), +#' is_secret_prim = is_secret_freq | is_secret_dom #' ) +#' +#' # Make hrc file of business sectors ---- +#' data(activity_corr_table) +#' hrc_file_activity <- activity_corr_table %>% +#' write_hrc2(file_name = "hrc/activity") +#' +#' # Compute the secondary secret ---- +#' options( +#' rtauargus.tauargus_exe = +#' "Y:/Logiciels/TauArgus/TauArgus4.2.2b1/TauArgus.exe" +#' ) +#' #' res <- tab_rtauargus( -#' tabular = red_vegetables_ps %>% mutate(n_obs = round(n_obs)), -#' files_name = "legumes_rouges", +#' tabular = turnover_act_size, +#' files_name = "turn_act_size", #' dir_name = "tauargus_files", -#' explanatory_vars = c("ACTIVITY", "treff", "type_leg"), -#' hrc = c(ACTIVITY = "legumes.hrc"), -#' totcode = c(ACTIVITY = "Ensemble", treff = "Ensemble", type_leg="rouges"), +#' explanatory_vars = c("ACTIVITY", "SIZE"), +#' hrc = c(ACTIVITY = hrc_file_activity), +#' totcode = c(ACTIVITY = "Total", SIZE = "Total"), #' secret_var = "is_secret_prim", -#' value = "tot", -#' freq = "n_obs", -#' output_type = "4", -#' output_options = "", -#' is_tabular = TRUE, -#' show_batch_console = FALSE, -#' import = FALSE, -#' separator = ",", -#' verbose = FALSE, -#' unif_hrc = TRUE, -#' unif_expl = TRUE +#' value = "TOT", +#' freq = "N_OBS", +#' verbose = FALSE #' ) #' } #' @export @@ -309,26 +311,58 @@ tab_rtauargus <- function( } -#' Title +#' Wrapper of tab_rtauargus adapted for \code{tab_multi_manager} function. #' -#' @param tabular -#' @param files_name -#' @param dir_name -#' @param explanatory_vars -#' @param totcode -#' @param hrc -#' @param secret_var -#' @param cost_var -#' @param value -#' @param freq -#' @param ip -#' @param suppress -#' @param ... +#' @inheritParams tab_rtauargus +#' @param ip Interval Protection Level (10 by default) +#' @param ... Other arguments of \code{tab_rtauargus} function #' #' @return +#' The original tabular is returned with a new +#' column called Status, indicating the status of the cell coming from Tau-Argus : +#' "A" for a primary secret due to frequency rule, "B" for a primary secret due +#' to dominance rule, "D" for secondary secret and "V" for no secret cell. +#' +#' @seealso \code{tab_rtauargus} +#' #' @export #' #' @examples +#'\dontrun{ +#' library(dplyr) +#' data(turnover_act_size) +#' +#' # Prepare data with primary secret ---- +#' turnover_act_size <- turnover_act_size %>% +#' mutate( +#' is_secret_freq = N_OBS > 0 & N_OBS < 3, +#' is_secret_dom = ifelse(MAX == 0, FALSE, MAX/TOT>0.85), +#' is_secret_prim = is_secret_freq | is_secret_dom +#' ) +#' +#' # Make hrc file of business sectors ---- +#' data(activity_corr_table) +#' hrc_file_activity <- activity_corr_table %>% +#' write_hrc2(file_name = "hrc/activity") +#' +#' # Compute the secondary secret ---- +#' options( +#' rtauargus.tauargus_exe = +#' "Y:/Logiciels/TauArgus/TauArgus4.2.2b1/TauArgus.exe" +#' ) +#' +#' res <- tab_rtauargus2( +#' tabular = turnover_act_size, +#' files_name = "turn_act_size", +#' dir_name = "tauargus_files", +#' explanatory_vars = c("ACTIVITY", "SIZE"), +#' hrc = c(ACTIVITY = hrc_file_activity), +#' totcode = c(ACTIVITY = "Total", SIZE = "Total"), +#' secret_var = "is_secret_prim", +#' value = "TOT", +#' freq = "N_OBS" +#' ) +#' } tab_rtauargus2 <- function( tabular, files_name = NULL, From e8fe40ed5bc20a898223981a10dd893029342404 Mon Sep 17 00:00:00 2001 From: julienjamme Date: Wed, 24 Aug 2022 23:26:29 +0200 Subject: [PATCH 054/107] ajout data et fichiers Rd --- data/activity_corr_table.rda | Bin 0 -> 450 bytes data/nuts23_fr_corr_table.rda | Bin 0 -> 470 bytes data/red_vegetables.rda | Bin 15969 -> 0 bytes data/turnover_act_cj.rda | Bin 0 -> 6570 bytes data/turnover_act_size.rda | Bin 0 -> 6730 bytes data/turnover_nuts_cj.rda | Bin 0 -> 7646 bytes data/turnover_nuts_size.rda | Bin 0 -> 7850 bytes man/activity_corr_table.Rd | 26 +++++++ man/nuts23_fr_corr_table.Rd | 26 +++++++ man/red_vegetables.Rd | 24 ------ man/tab_multi_manager.Rd | 114 ++++++++++++++++++++++++++++ man/tab_rtauargus.Rd | 74 ++++++++++++------- man/tab_rtauargus2.Rd | 135 ++++++++++++++++++++++++++++++++++ man/turnover_act_cj.Rd | 28 +++++++ man/turnover_act_size.Rd | 29 ++++++++ man/turnover_nuts_cj.Rd | 29 ++++++++ man/turnover_nuts_size.Rd | 30 ++++++++ man/write_hrc2.Rd | 66 +++++++++-------- 18 files changed, 501 insertions(+), 80 deletions(-) create mode 100644 data/activity_corr_table.rda create mode 100644 data/nuts23_fr_corr_table.rda delete mode 100644 data/red_vegetables.rda create mode 100644 data/turnover_act_cj.rda create mode 100644 data/turnover_act_size.rda create mode 100644 data/turnover_nuts_cj.rda create mode 100644 data/turnover_nuts_size.rda create mode 100644 man/activity_corr_table.Rd create mode 100644 man/nuts23_fr_corr_table.Rd delete mode 100644 man/red_vegetables.Rd create mode 100644 man/tab_multi_manager.Rd create mode 100644 man/tab_rtauargus2.Rd create mode 100644 man/turnover_act_cj.Rd create mode 100644 man/turnover_act_size.Rd create mode 100644 man/turnover_nuts_cj.Rd create mode 100644 man/turnover_nuts_size.Rd diff --git a/data/activity_corr_table.rda b/data/activity_corr_table.rda new file mode 100644 index 0000000000000000000000000000000000000000..6ee67e2c6263d05760c9696c4323f5e2a4730388 GIT binary patch literal 450 zcmV;z0X_agT4*^jL0KkKSwsybasUN(f6)FiNB{r!1SLEVh)TDU*KMS!F3q7pa$&?T8RIM1t%itURMQ zZMPC)xO%}*AS8$b0tzWqt|0&rFU=7wO`KLc-4o9}7Wsj>60HquTH9^yLIa&?&Y78= z32SU-XHzpX4%BMZW=(5KR;~aA8LYi*L_`Bol1V~TX0arkbo8Xyz!4D-N?&X3O+f?* zBfA3#ff~XvNW5Y}sbc~WixGozFsWi(usSPRo9hv&EYiO`U|uk=>P!G0002ZQK~1YfB*mh005|^H9Vwgy-gs~ z(@4roVMF-w%cvCl2K}#NRT7|z>#d`v5aD7WRgiHBgbz*7IU36n_6aOW^5(4*w+Hh zw|fAIwTU1Qb3*`74$oGTGdI-?l1Yfj5i>X!z3xdRTGW3l=ln~G~!L$s5b4fYQb8S1L<|#`os;N@TDN3qRs+6%}l%*_KqKhn|ic-aj zl`5U!Plw&b#r5O-`0d8`^@xVsaBst6q+Ef_`)Go_|#Qgr=9Tqs0jQn M9%qCpAW!qMlZCkg?w(Y7e+qR7^+qTUv+qO0DH~(h-%}f?ga*~{!tg?8L zh-g`GGYe}{Drasnh%lAKQ6kn4#<nH0OHazrC3B@Q7=pl(@M)FLrN?w&dDBE**%~em zJ74fRIFO~ZNnRp4X^}EiLLw7b5~IA1%Z3Y1DOAQ1kBm}iS)}q@nuJo4X<=oSTOwC7 z;mKyPD3P8X19QeoCYQ;Q1w@;(%+HmsL#ABHr3COPKf#YP0sr!q20#9K2eK*y%S(P` zl=Vp;u`Vq=t}9qUg9t&7mqaV0S>T42ceCKKaQ%~%q(j67rNb8$ zk2p$;!PnzK=H_tO<_nUR#*5@~OQ^~`GjZW1VpuHZEXKye7m3-xfsjIT^CkXs7C7Ze zOBO69y8aO4RA)`$i@i2yE+?!1608Pb*uhQ-voM_uPbLdFf`3;QK7AjKG*C z>2pt^#R(6NGSA$kCzwnt!V=M?``i-A0v0wCRuUY@T;-*8;ddajWHBp=pma%+a8sZ( zaUcl9m>k=JWhSf*8k!s!zZ@AFC2kBe+kBFogamS*oLp%PC0J=QUnZMnNd^Kg+aemJ zTn2UqGaK8Y1WG}Xus;S@d-XLxKqGs2Ku3qD)P-(mRMC)T)s8UkK-WDTT2V+*C{PaZ zJuO+s!1n=->?A`se=vb@+N$gL-}toyE=RWCaV-1Y(rVq6>-0Y z$$B%m*`8=k0dSn!6lARdAYC#QvK43$z@Q>8XB>|l;GM_~GchE|oKwyO+n8U;(uiC} z&k|~0n4SW`T|bB@MLV!rNIx`(8tmo4$Oa(jYey^IV`P%d%p^ZP9dJ)1bsKs_0Kw0n z;_{y??4zadSBMuIN>J!~d!X@*R`wxuZGyn36HhhlfQvuR7Sv@!LobI|BKMbXh-BCs zpIA9j1(rEFH6SOrs$tYFpD%QTCu|Xk*>s8Jxs#5G@yA1VCgYrOo~{i@2p@}RT3AEX zOT)LXkO@d)0>~cUO$%TEm&Zh(S~Byp`Y9IkS@O6mR})Tw#(3kPPMzGmMiMMFa$>RJ+^*G8gDFrD3>S5V+s&0ginRF1lt}hB6`u~8gD0rhm zFghmELFl@H|52!PO#f#_VG_2HcqqBX{|}fAqcu$a$7_s?Gd z_m-gwo^(+b5ZGX7-Avn+3Zvj6eSix@7A|FZTZE%HidaF#ukxOmD>vF&c2k>aq)vg} z0tnLDrD?k3S&TvXlWX0q>2-NmN1vCREOX12w;+U(lq-Hdd`$y*#L+ zfQwz8+^D}@{?c%X(&X&8nIvNcyyOh1Vj_oDg^5k$Qo))gDL9a2)E0A!uu>c}Wfc*y zG?6&CurW$(6NME#lJ0hCs{f7Kvfu`+6e*4Hg;wZ862^M9>ZP2#OtBYJIb)Pdni0u~ zqXLOx)ANWk1IkJytO3NJ$<_%CMZPy#(b#l251ffLMnse>*s|otp>eB*WHBM#V}Xo4 z+;`8I=N3~x{BYRd7GFM#d@XPo{}Lwh!@fDd&R2!&B~c*551aB91-ZCDhkE@8`~5OH z(h$sf&}(1#vsNg~Ma4_$d;dz4m#}f}T?q_`?f^(f+G>u6y7W<>`vw;13-e*@1VoVP z4;k{xzLD#+3q>FFM9Fo*lY}oxkAZ#9gm@cA4STxNz zMftDeQWs5s5E$ZrDPL5#B7#OX)`jpJWeA$`3>>nVhgMI7TTRBc!$p_oNARJ>x}D80 zg=pNW_dY)tB-2T~h6sdVyP|n@GpP zva+pI^NDo|AhnZN6GABqU?|XYtgw&yN>xzv9LgStYl3D9z1~?>3k4DAF3%)Gw$$e@ z$-@x=*jtwVa>^*Cjder6k9xJ#MA{kuBL1bR#?F1*O2Z2@1#oY0DYFl{h!rn%=!Mfn zQ?+uuD?VA$x8ZQLUU-O|1FuC z+frg|VGC`WHjUUmwP7d&&v|4LPKQg4(?Ig%deb<+ypyX9K!d0G4AxLnbc`mUDN(vQVNq%^SJs(6&HWhd!K0hPh8RrkhQs{f7fTXN=sSj3e0vd;a+lcmv5! z29kB{GzVx(zM0}#kdTPGiUQ}R60ARoA;Ww?lNj@ZUg{CBp-W_PeN>k-F8(wtjib+# zq!y$7`~BOaV@gV@9eMnu25FI|ND*_dX?-HQwmcRqI5fMZ@5Oc?OtqA3A~mx$xNhg> zlzzvy5!OoGjF;pL==0LdQkn>5jPSUlvwHJSrA9X%yBJ8s2fMT#TGH-f3Wt)`gmm@s^E)>E(P(z1&z*27P(5KcC^MUX`Gr4i&s1XR=K z7EJVY+&n&8!vMNyYkc0_7z?)tjeH$Z*=0I0D7$8ngz#8rhUISg-^HNCAJVOZ;(XY6 z68&nv0Bs2Uf(3tU>rF^EafW7LE)NROMV+AE%5$!XU@FZJJ%? zwbi|jC)`!jtF9xqGz#VStOUH(-Oc8@JE4vwDbgFS)!%mP9`Ws(&9l*C(e!wbPOFoY z1h+aRFgT8q*hV?`sF?Ep4pAOYRm>#OJm)X5QL$Uwgzq=9edvL3)0e^bHr53zM0201 zomq`y0H`e8Yd~G{@^??Rt91DVTV{sbo`FF=kk6POloTnLgZF$?iPKt8q_li63u;ea%*c z`+w64W$ufg&67~gbz>sCh%j65A9fitk5JkSuU(=$UD2?F3m@F zq>O_O1hqtEHT%yh*WY2A84gc9>(xUzmoOfd7VznUTBLLF-prwwk1I&O)Sb6%BujVp zhmF<}M=WB*!l!a2G*vRsDb`;m{R?+)aq-mspSZb9@pB`HK#a6WwPoM*K#;NL;rniV zqWUiL;TQc+q=gywqk*Kskk|b{{6ht<-^m}haNNepwxU~K-f#}(<43JZwEif-AlOy$ zN3lm*2Dsm_?pVHog>bKcHo!OWee<%-?sz3ebchKbVufr!3+lZ4RQYAI#|`ZlKjqI0 z5=<1ciu*kI%(r!bt<265E-x;mX`KvRlHH zfI3D(o|~=$N^{;7(6H~&nyI86T7CLAV^`)EB_uyFVAMyK%eZ4Df?hN zr5gjKpO=5wR`?bgJ#C_b?PDO7ZJuO0t@eKe*)PJrUgY4 z3b;f?Otu$46*>2=OX&1CxH2ipC-@jC6yDwYzDu0jgro)08^eyL34~LEYk<>&&Z3aP z&LsPYU+jmzYkz|o_+0d&k6R{lrJ)aA?K9LQP`nUWC?9)KVlr5QqC+&mAHdJQ4_6LQ z>enetP1VtE=RNr>14DVkzz+{!k2L!yR&(Fjd+|vUbiC!{AbhH6FRCbQwu7I>#o@mM zIfo}?3)%z)kHADTy3}?(&EW?RvWlF)t6QMLQlA776TCW(rwKh8G1^XYML$w?f7Nac zRkfF$(z}tFKH;wdQUJ>%;oX#EH=gR!!O=2wy9f|@^%q8ULe*n_uuP4M5#A(KVq69;x+I$%6i?_Na+Q;j# zm>KVDMCbaI>M8P|qcxACuGOjiS_qLK6c_*ip@F~zQDwtmQf0$};fX}x5$ck{G(?o= zmGEf@b7-zT&gJ<@B;YjXTX37|)4DiWC__{PnN*b}5vF4}XrEUVf}%BBtSY?dw}Zt* zgDH}@HwLmf- z{ul0fi6vv2s%c&uXDcKpwX{JbypNxl+^Wp+rcxH(7S5l6oNFHf=Meo3%W%}XTx6t z71aIs4Tbd~pghZEFpOFGdef4C%B?LJw~aq74v&P3G6|0xmqyLoS9>_9DfcJNV(;0l zfZ-%OSF-ro_wl1Ip`E!w|KwiYb!UG{lj`xj<~0)Vqj~ z0%Agzdiph7^STkkT#IQ|h76#0HL*kt9~}Y_tYv=h#FD}^z2LtQblTO`lceZCJi z=eI4!OgW355!5Kb)BsmzRREsJDr ztG^jQ{S>XW(0m*pZ5)7YU^n829!Z+_JN-)OcTk|Dekoh{AV(G~+UTm~3=Uuw+URq) z-vSEat|Hx=zW`j;!_Taq5GfI&$f7V5yLsX!pNXME0&3x624i&t4BNY9ArMJqXIYL8 zKmboq+2-`Po=pHJPiDIJXF3vqd*=!NG?Jt{E90Ivt2m zi9k{g7o$V|#vGBPPRC9Ls31lkFTsXR!l(?qjEraAUXpw+&ubGulHdn3a%lEBmd-uz zS=|d@cwadQZ?29OLv9F*8Y1a%l9-FgBeMpC85MDaN8N0C9@%nW!2BLUUF`oEZ#&oF z({a9U2F>?R2{j}QUVHKvJ0*8n=0am-MHY9DusHEmVzXbeEzGC92 zl+bbzQY6FUA^VdB3WX?#9aXw`=s3ySCkIA07rBt&cJp*F1J+&1e8Q=vx`Dlc$ViI; z{vJHHjx?#?Fi4{8xqt8tBVova6sE);%UIz5ZrM?&MnxlbA`FmmsyInaQAW?N*{f?Q zz$aV$;3+64D3mnjyKbQhMlAUIus8Il!gJpT8kG$Pue#48PC2f$VmJ_bo{6QEH;wa6 zM1!#lr8fn#7<1v-{|v-sTYJ1b2XZ1&4R(HU5Sk9EkqkyXO2BR*v0CF#p6^OJ>VPlo zy$cvI{%s3Jj^C`J#!=X0OElcLJGXvK?;TF>;)y2AN+O_q&Q00;^DBtIQWv?V^HYs4 zK(N4s34CK?V@98jlo1{D(_sYNl9x;bSxmy0iV6~_2+0$)KPLgV<-iSb602aDupb77 z3c9G+p9xsg%ZCVeL7~nZr)G-ACZ#t3AQC+gXEUKFCM^8GQ(l^aYNF5sYL|EOAI;z)ZC!OVMx6li)| zfF?024@scnziDOcV8}#H*Mr#3F+KR1Cd$LUmyJS><3zQBSYZIsIT7%CKk=w4r?5DR znV8I>mD`ZXpA*=NqzW`Y91ch9EQLyq#ctEm`dH15)b3t%jAxVcRuNJ8VvBmkNd1jPE!8pDXTN9x>S z3q49+a>uo>zVgn*#TfoVI4s9JV=Zz2JBL_w=Z#8+#Y=#L2F*TZx`652bA^9xB4*j5 zy!W@MZ)n7n3&X?wxL{FdZW!~oJMq@qE+ZyNI?kyHI0=4WIP9q*7KsZ4k?CE{;>RBb zu?7T;*qk`$)cH~mdaqEpYbk@Y8i9OWg?w5!;y^Y_;SNAm{E_%gr2K?y+6s}$rvm~* zJup;3lCm2prSEg6!YAaN@Ea~h<(hbR&KqOwa46L3*J%vL;1iRpW!l!c4}}IYLZ?w6 zKD-}_hyAG8++;FY0P!Omej)tX_wmkHdP^GWo;?jpk8BI`{uct@%##WM-eQOf-WWtd zIIT0ySZ*>?+4ouivH#W)ZcG%qH_$CNC2();h?y-s{+@U{YfccuY@>6W{{K$(TgP%tN%VfZ-B?l}kPFY9s_Qu8S z`c^~#slSY2Lke1_F>LEYr8nX>Ktp9uWmR0acE35W;5fuC1$Jo;GrvcV;h`pFC=6~o z7M;qa+L^bnxG6op8Fem@qy&W9j@Daq1%U-Sn3!8{!0W9H^h6QKhWhULd`vvbkk5FQ zaBpHzWH!BV?d3_~ZLy}P`mQL)X8T?KQD?~!2AxGi_NgjCU%uQwZeQTt4!|V8={0bfKZr;1qf*AL9k8D|tm9AGX-%Mtn@ggTpTRB0>A9V86oP;KftN^Yw z8cw-JfGrXmnv_98s zdCuC;9j5o%+ZQe=K2DZ(|8za2Smi$N9L`#dDxsBQ-MkIQ)HLPay>Z^b3UTDGAN)-D zS`y^-4O)6{mIHd^{P|E|nep}R?waI`VauE;u^Nn`%YFWJCKE|6OBdvh;n*!tNdg;F zn2xs{t6M7$biNtzovr0dsXdwR?yLOIdOm=f9I64yJuoe%k~z!-D3 z6Ws9qYQI#ymnH@0+cjY8{rc6KEeXHVdv0^3q=BbhDEdg%1TBfsePR91zqECqHx5`A zmnr%(XBp4-XdM&$DfLa_kY2ilpJBNqE8FB!w?o&4l&uZrWPvyYsF-RZQIA#G75b$R zr7!%r7gk|8hc;Eo_(t^eaSG*Fcv54%eOS(ASW=*UC?gYZjT&O(o+GQrr_Mw8hywZf zd3Lo?9bwFW^#0{i%zi?0&SZu%E=TX3=xG{}a*h*8LhG!bRvO(;|F6zYLvC$YB)LgD zEU!sdhOjri{G7oKE*Lml+a($!(fW^fM7m9@*O>1Lok>?gdqm-(t{xwdu=nTVIIErn zWoTgng}dUm4G%6M%HKgf0x&Z=2jjlfY0kUje~Fp<`;h3^#G-F~jHoLZJExLbQS%I@ zQ}#f2HSv8@?-~BMN&SI$(dkZu%p|4NBp+o8Eow5N>gF}4t`4%=Y;l^w>lzK(Ybj_j zUyj>+{$){0oc>3?&ht+@RsQoYR9eE&>(|d4+>WdHf6cfdX1qG$ZxdV2?{EWA#KgAK zV#p#N_Qp*jnMMsClOaTB?dp4NBd(Biq)$pWRXpsQk3+j}UEh;V1cMl6g@tbY&H>3& zk#FL^KNqb!T7K*XCj(KzS8#7H!=V0X_MmQvAMP0EAUVsT$)k>hfR2CV;urEe+-aEb zP2t9C65gJRkB}rCXw*SlXyls;hDn+eFkr;yCrS|)bU74b>m3z2RswWlg+q%DsJH8T zVB)khULySLs6w2FQ?c)c4^=y7ESYuauBS|ojTr@Vn>&R3Er^ic9M*2<9@=ux6yXbCFPu+x-q0l+NuJglTT>mch z91heZU%U9qPd4JJWG%p{@Zl0=a?kluB3#JJx1M}QX)KKqM0Zebxxh-aDyzFKL(${NMCSzx?iVC$CZab48@U1}g#=_>DG7YB#6tvHgt=iY}Ag9ZQ z@1WvJK*lH9kozHbvKD$(@iJhO04o4$ZG9TGmG;jNLJWIC^IZLiKln{+`ZvyaeT-cA zqvRf_N;q@@p=|PzE?C-gWeRV}@0iI?T@uVj z)s4l7cw2O*uBBJ=crA*$<)K3Mr%q|Vc3KWCT7cUK{{m7}kvu?s{F)OpDte5duSvx+GYpbQYOCJTn5#oiIW69zjd z+Fn_`^7g%qI;a@Ud54=YC5NDxyH}n(GfIYg*szilfrNT`^8^v)OqW)ScR)bG!Jb1B z@U}}uEwnW63&QhG8hZQMTCy&Gl2qB%*s7d7ZSPnQr!;1+J8c|s@T`JOhdp_>BrWmp zU{d!eykMKadbYo6&xRsKG*v~Ns>1TyRq!iO52&lz!~g*k2NhMevg;$v9_F@$Bl{j= zPM%=Te#|#t=-n8JMV6yP1(LoFj4A;1VXW79+AV{e<^bp42Paknjy9!%$(opDM(*z$ z5V*#jNp)*EjX2aICOLpez_A~2cdp*~u&Yvd%vrEkKvqnB9CtIxp zp7+1`M^c|gwJ`BF@U=to>eSh+%Muf3A`P%OsXrf?mP`{jS>sP;`sgk_bAIf~j@yTW8W=q_pO){j+bH%6`llZ}DNSaj^DTB} zrP=sCQ#wLT_?a$;5QPH!tl^&#HB^JqI3qg`rlO`?0yFz|CQ}z6_kN5k=S>lV3AYop z9O!LNSr-6kGTd1GP(xhF+x>s(sr0+tpF`213}7a|-7pD@&WXr2q(=naz3L`i(?2%c zUuA1^hD9=13p#yFXg^Z%yII*U?bC*G|v&PC4*YeU*{PhT2+VP|@G_;d$ z8tO)bg%4OdCpHip&)b;k0&`(^69gzt%z~%rngqjeWwqU@7U(`fRtb+b-T9o0l1I%T z3>;3mcnK|AIanhfGk;RYJL7vXvi2d*8@#C+>bTxpg&$)1X@ZuGy7)7m`A3^Lo4YDP z?t>B?$rDf2uWqnS2-Sy^|8W?i5Mh=iLmae#$-FQK#v&0=Q|vW zpeN6>{UbZnXH3FS@(0Z`y{zz*G%Z|uKmov zr4*EuD|r~OcEBt)%K@O7s>2l1RNU`ET}%nMJ1@{7pyJniK&HIsv-@sWsEln_x+X$f z%)<%{T?e1xskJwF=5H|z@}|0GZ16yaZahiS2|nFoFDFGe$KV$tq(nHGdW8{wqW4_% zlq{1ZFZeN{obX!mE-mUFO!1V$_kUW=a-n4iMkKR53(*5m*koc9d@ENs_w5to5OvkO zSO0h}rm(zqrI^=&8AfpJPqVfo6cH-n z?i-|S(Z{xP4qHyeDZ~tnTd8rSVR?|wNcR*CvEyVgdag5+ze`$EgZ8QXIP!n*iPna; z?SJ5!oT9&~Mnp_HS!hQ8L_$7=wJp zV=xqr>o9njx6%C;jSC8czbwP|uLv&SBHrti44a1;$56dx zMf+Ek_eB4U;UV~<;4C`+jjD%n+63Hg%{d$^9+a#dW2MN2HWQgqfKjYqR7Eoz#WQb( z_1Y^kbd9|~{8-w&Pek7jdp^13dO=I}*7Q*O0bRQ4^u6{M_Vh3lSFH7)D$^qp ztgFe5OGQ`#Uc3SwC9<2@kOtBA)lRc(Q@?wVuc12Qqn-T!n)r|AFdVkz1-X zWZh)K0skc$!>%%DYlKP4L>4WzxRDCTBSfk7C+@we&5vhj9S7n|nFCx~2}>5h4WXB5 z22IBNrdQnOwe7v%c4md}3=o<8frCt}|7Id=7}TlL0jZrfm+N{gV9xJ|P`Fkf*BpX7 z>GAVyjReS}#1Qc7pmeO3eU(L!k(E|gd3c^%y#+qO04TuK%P1$tS2~mbrt#W9L-Ct_=MZIHTl0nhYsfSV%6yAU0T!CoP=_Nv4-o-FQT~e>qtdi`Qm%Dxgv@9E_#&2r zP)a`vS~22;S8b0+`fjh)9Ps47q1|bIL)Y@Rbl~xfU1zF+`*>dRq-DQZqkngTS40Yw z>h=76bT0hIJ9UOppJIK1`Xw$HJ!HRVg%D8`6&^1j!K8+HPtN1R`*yKo{a=IdS99^* zEUvB84!%-?h*i6->87&qN`+U`>~5J|Y6fP7rt6`pTO)`ODj-Pb8{0rqbmg|WYDv$s z$5u^U=02PT*4CQ+j{!1_Nx|eBui-Tbk_t`G zVy~Ola?-vUF^lyNcf{jo<67WGq_PICLHoxNsaDpF#^D4+eAq(}#jzm7^O=8d{zp-k zA?s&62KuY_Y#V3yaIy%p$Y=uN535X`#7g#qmAbQL@olr82N5uy|MqDcpJ`~HSee-7 z{yHt6kEYrcWapShI(qRW-Iq>LHF4 z3v2Dy+MB70k+lA-_yC2ww#$82v6E*U*39fROChoN%wG6XC?&E}A+MJm1Cbll3rl-r zznRW2AAW_t`d)%${=ft5>fu=v3t|n?d=NeZ>mWoZsJIE;{a|5DV4#WrN)D^TH1Zb{ ziXYiA&V{X)F`eclfp;8S@Q*-fMy#AH)t%!qp7p|k9X`nA5mGQb8Rq_e?&f7W#n$ZF^qyUa?O@4Xz^hV!$BnJMajq6h7AtV;8oUh%#aq;R2tbOD+kB?oomx=-SoFtNK?aYP+Q1YONK0^NWGx{OD_re-s+{5{N=V7N^hYex$gvlW zV4wC5VQ)}H(TAwh2(?J)e8b&sr!h7sMt_lSa5@?l`p}4&p?w9)#3UjZ+7Bxx+CC&^ zvZDW(oov?3_X;rjAL?k@YVUG_uRbZ>A0OuUOAR^Z#hy2n75Kf#+fm>~S5@TG8vGcc zoV)XHX{ZL-Hc$n#yOFYh-``%m>hL4|)e&*kT)ahCs#7`2Vm63)2*G<<(jX~ZQ-v%u z+V^AyHD<G1TaE$`r%64cZy7entYs+`G5rIWK~doVR%<{>kV()(|Nva$ttHc@HuF$q71 z8vD?$59CADU;Cawup{iSCx_Lm6%HQlC`K2gv^vSGqYGio=FFW3FX9>PWd4=Fz>7 ztdA+)b5)_ZCX23P%QFp;Q$fHG8J?`fYK$$837Zk0ZXYu~hElk)(2>(YS(CUF-V2FW zEro;TZ~S;a##n8`?k^kFvNF5$8{@bUI}y{^V_zygF2NWo1+dLsI27w_=mVJi)p5gn zq5&1snk2J7M#iM;A-nITBmNtfLrV~5^F4}Wmu#+(m$s7*Dgi13F}`9*Khks3lA7c~ zv{3YXbI=~9TmpzsoC(<5aV+}-}4IrMM{n1h8;n)`+QKA z?%4H;75e%SHs(LF=oy_!NV@MSGa6DLXOmt% zqDZ<#e8qRAt63WmiXQQCaq*H&iBP0;j-P%V!pYvlG86CeL!JZ*ile?*UDzYh;m&)c zqrcl{tCtuP4i00-$1v4S5|a`}VIbu%OKk_jH}u0Cg5Jb<+w>v4Onn|gX0ZN0Ly z=MQ6OcTTv@?oYm>$xmAPalyRuSWDR)gTG0wKstPj6su+rektKnDB}hrj z6z150$|&f<7`WwPrs^SrdW(VuhiyVR0ke4enk3z<%0muBLWitwk6G-Zs+=Cz?0TH$ z{!V?-`b32_f#;L$1Vj}jw&S=-xUrshNOGWG-dVAMD`SqF!Im1q*ArK8hb>qf&4JMj zga#gcz5X@YzqG6%zyCCLAtQe?R`q4l>p{I8;rpi0^2}izMZaX!>F`=D)-aDzgL8*=SdColCAt~}GeL7mN!>tnsS)!)HYCOS z5cBs%2zgLezan*j+!602W*qy^Sd@t$R=SA-Cj|2zMA~=}(@`JM<+*uk*CO&nt*C|4 zhAc6_>#;9QWD3p|iO(TTB+4W>Z66JXM3cdWj%c9|%RoP`n%ad7XzzpjB*jdVaJ%pB zcwnB6ZgtGPzdx|(^J4H%N3@QGM?1`n++u%^A9LCv{c6puIFV~M54d#Cn=<5@xOgVW zCe8MO*eR17djZNz`wu)ck-OXuFQ7FmLhYk~JBi`mVM>9@`yCzsYK{p)o$5o#b+mZL z+No$cS#k_AIntMcjGocuU0r_6?fi;TyncZS zyP$s!{AOaZp`!KCiq^zY z!DcYd>=P7RlLR_@n@M;7$EJ!?!+pYUgkN9Pf^GSJuLIM z;t}K?rXFV1s`uDTm5vK`cf66<93pl(c%I%Y7#2MhjPYyXHG|GqM#mCHIy{uAAlo%~ zb4&!c8Z7Y;AZNLazY(*##CP)$mK4u`4NT_WX7<#JU@^Q*Q6hKqEzuSu+c1pFn`CLn z&ncM8!!!azMLmNT3KvEmMUJ_ZDi%V{*n~3w#HXuuqF%Y@&&d^Pnom~JvieMpc}c7D zEySO7eL7yAvD#Q-R9V{_f&L8bjlVfxECaPH=Ex+4P{e&RhK$3dOFqBL=g-vYTa4rPPlwzFUnk%Coljs7d*}7Zyn|Lj=)HZ~x1A;IU2ZAg&4^BDHUJG`g zG7xOn77W2p>4qrfYP!0|!vC5sHYSNv{L%tP#GJmtUMH zYW$MI;ppNows=;1_t8=QD!aV0afzmHlDVA01&ac0S8WDR0~)Zr zOl627o8GM7c;(vmrZ+wd&knl^B2zl8m=JU#c*Rg$6$5n$7Xva%dHE6gl&ESoYQABgL zoA;W1pPF>!9^t^QD=P6bAKQRBJcpq7vL~DHYAQ_6wdL&Pn@-h>gKjWgn~so6P3$n~ zHtSg|=%Ze!^UtQi*bKFG95APoutA<%!wcptNRsjKInX|6cf7&JGghaZ1)~r;U8?E{ zWB0^+ApLrPIM}lUw))n}udN+4Nt!+%<KM5FHoUlaJSzT-I)1E zNaaVqg6oe+z4NIf0>(h`@*^M(^|0*OD}A+b}JG9x=nve9^8v*+4KpJfwC{54D(NshGT8|ZOyrCF1 z$vBO)oky)q8~fxwo5PWCbLJ@LWjPAC-~ySxem!Wi5Meh8bVR#d8gr65CDfd)($4M! z{yN5;xHbHZ5w<$PbSmInhb?hjql#Hxrm9Q&?7nNF8BVRLFNj=7j9oi)uR)~2vXxix}7wuTF+K^&%AckSj(PLeBq2BnCQttnE+#r6(#TSBUfUyo({i& zLBlvvkO43WwJ+HePcY^NG1Z_5jEP@sLI;N|ORUj?DHd{xTBvBD` zQemluq3T;XulwuL;Jzs9oitji0Gfm(s=*h9^`%B`0VHjqQ9y-D;a4|R?H;1W5Jn)# zmKj-h%zYy~k=n0`i``qH`Cc3MoyP4jz8=ldWmet*-if$SqYguIc^Ea37(84!gyNQcj%hGQ`4?kBwTq z7+r_w9`a5Li(-}Yv^XBZFQL!*LSh_zPD%v_HMHx^41a_Q-c1v5AIb&kd_})e0#JSJ#*G`oXnQo2~O+vtFh2rs731N5# z-`WZ&a4byj`aQ^?h8g{`oIciR!Xk`%0wvA&w#zCzevs9Jia?mI-@&;0?{ZF_&-x2R z51c4cNMffD`M2A@T>5pNVtq;zRpc^oDCk{tisvEUzsA>*>1qK-hO=8=2is^<(D*$6 z29k=T(=(-pqexIajmzfU1=+7a!B^zgqdP-O1uSuJ-(8OQ@i6f}^B19_M#^13VylFh zmQY5K@J{e^sEY5d4)?J#n^D_b_!2~Te$Kg5xAurSkLR6<`5pClJCBcA$wK`p1ha!u zf8na=wvg?_tj-@ZA1nsO0-Buzrq~{c5WZQ5d6M1ZrpV%ke#3kY)@nt$sYaWWV*A|) zx-TLp!9*&XLIiJW#PK*tffK?aa(0poBpO)hj)HwT{;{l);EhfC(*j%ejFRTR@95;Y zbtgV{b3?f$J|&(C3R#1^*~cWQ^j52;qb2~V=`UFjvpj;(rQAUB!!fbfgg>}tDZ7c;-Sd=s@(^FJyegrhP0yQURY-|*f4q` zynE~wD+^v(Zp35$k@~gCLfRJ4*XX%*rBu(G)$&Ezp>UVFJRRI@0bZIwLQ>$0_ams- zu|m()CKrtu^u%awE~)B`S6N|h7P`iFwrQ6?*lS$XPJL>V@NcoFtj=!U7X`>mnzQ)| zd3Yv+vu9+KZilJT7nl6Lwpd_jtri}3e8XR@;}#Oly{4nwGz%RW96Ee}2P%4;c6rP)4tR*qa8F zL0Y^?=9#j?$GELN1gGPZ+yRWw0{Em*cedQaZ{Xa+SFPWrhEBa_q^{UC%+g|92oz@Q{-K_ftkVi`MSuB=JSE4D`PdRXsIYcVwe#}=loK5!?>5K18S)j+o^0<>E}BT^~xE_jla3dpV+m@MJzs_OT{PP zUXRDQQ8pOaYjy{)=(pv0@VT< zlCnBgq;TS0SeozP`SdH!iTC5%=1_PF$^C%>Rm!5%8ks!2D~Z0WYyZP0Vt{$&Kp@Q* zgc`pwT(9NxKH3RRg_H+)(xbdYIrb5nSBtSIr-jkM@D*b~}iBM5(|6j-B=1Cc5YAxe>`T-3Ez``+zKv_x{I>ZJFQTAHFAx zD}u3JAabF-ls-AKd;prwvq$$CpW2sfo3YmOuM$+=bfM3t=5krIOf*<#mXA?ap?3QK z#5(W`xGR@}#);|#QuzPRX?`-Gl1L^9K1Or$T0SR$s3z{^SU&g%33mT9XLVJ#DXfg6`@CNKz$asmD6w%K(tK&5la(Jql znYD~Z1)$(nR=(!**MEP&3UW*TRbWPqGT6&F_3j+dFwye~maK4TCUYmCJLP@(5bp#x zXMNr=6?Mq8GaLp{leo&-6?GTH7>v*Zj2rashwYwmIe&U#XY)y7s0$Uf@&XkrAX?|) zT7mUPh8)Lw5?5N@<<%K;kK*vPy2B^Oa5y zDxBtcBgAbV8;`efb$fe%ZW=I7o+*Mwc2@ec6giV-qeOU;?yTs{judtx@EN!0f(}BS zS7RK*6+=>le;hem(f)TSL@M@$a24{Usm_-u`|FqYZ9?tmD0JA^cIT+&7^_?e!-$91 zq24i?moWa@L{qsxv2rX+zISWa9|NaGe6PcjH}*N!qre5QAO84|(Js=QvCA{fV@AJk PhQmmQ0unED>)ihZf4Zm! diff --git a/data/turnover_act_cj.rda b/data/turnover_act_cj.rda new file mode 100644 index 0000000000000000000000000000000000000000..4a7ee39e6340d194c116b56c18c25f409a9f4439 GIT binary patch literal 6570 zcmai31y>Xdw4_5iq`PC6E|G4KUK&MMx{;FZ?q*q#hNW4WMY_R78l+1a2?YcRpWk~w z;LVviGjq>9_YYhJGly4#@}?Xh)9`IJWfV%p-~Sie~^Zl55POYD;KyZ{m>FVps z+<;aTTgfx8c>0#lj*7jD?Ui~KseGjAI2<4+n+Y9}$pF|ZnmNcP%Y2rNHw^TB9S8hsapMge&HJSeZeUt zqNr4dyS=ioctlznv697fEFnxlRSmIYOZUBqy$-SR}hn0XiVfNiopO4Yiyj zi{YL9Y@^cQuLRJ40!JB8D_>kJ5Ev+V#RUXVrBCXpzk>TStuuBq}H}j+IQ~c!Gj1 zheCiAUQ$vS6NWA)f+8}5E?YDx^!XpiXv9jtO?4Im?AL z(4@$`j+$fjv9zE_A$R2sE10@`LYg7LPcu(v0ZijqSvk>~EGmtaq$MaS7L!LtLj{E_ zTwiAjSsSQa@jfMA`${C&xy9EO2+UnKWCu-L^8210()u1vZ_M8wGW3UFV4za6=<{{m zbIvUoBpVW=5EI}~g%e}2vvNOlmY48KJl@-=2MAF%SEJ>60)KSg@+^ko#1HLt2{a#` zXtvT2s?a^CA892#?C`phMENG5)8-eD+$uS5_J&o{Oofb%$=;8C5WOsTrOJMJ1}wJu zrXanuDK2Rw|73u9rDWKhPbKk7Fu$rkCdRIm?z zp5IjG9H*@zpr&O!<3Oc_lI?ox!6KmB!4|KL+FI361XOImZ0uh?i@FDE7DXQ(mj++t z2yV3H1@~E(DUi^dO%7zKtlb2^wMa0OzU(H6uqEEEl%DcIJmInPYHa)Xm-`$4z7;Am zGEL~rnkD%)6RNj#B#HNq9boZob3j}JlT)>!Rkik9 zJ;dv#C%?l*zj!$GwJ|&B|w`m<{+n5uHS(K!F25%+W z2hUh`qL-8xD1h42>>N89Le5zrlKMoAthL1c#O8YNQd@$t*;3noA<=9J==^^Ij6hmU z>y}EK%%ZFQqmi@z0`QIg0^r|>qN2(yr%4@YnkZ-o7=ixh&J^JPtw4nZAb85|pSAtx zEk;*0+iRWo&1oHadI}415i88#avXA8A%}<~Akrlqm0!eL62l6US&iE=0}qWUfdyU) z;DW;=Sk&2S5-MfZ`29W=<1v%t<0MV6L0db0&V%8LI2cK0#AzHh92M-U z?C>}=^kYkt2&Q;8dEzdl5Sb@f#Tk#>LISL7#@=O-2lt#R=@@R(qyTk~7Njdj#i8Mx zu?7?3CXh@{D&$zbYG>p-my}}vj&OThtcF00-dQnok7Bv^x&A!F%fet^B{k^bMkwWI z?RvWFG$?=JN+;{l9p$NDk!6*>G?bLGh|FBYC`D zoNs>{dmHZI(^3hKzkyHrXbNmBTwX#_^SXQvhVbdIOAG(3Zg#oWNI5@qrL&?&)HG%& zbY@97#a~Xoy(-s7SCk{|AC3!4=|8|1;}p82V(#>AIz=>Qt?|_9$5p7ViFG(4?u#;F z2xC+nq}`g)k+-s<&CW@-c%t8&Nlw9B1R7$4Z`UMdb|2I$2E0C0@4VF9vWeUTIXL>FFVkap;_i7#5dBzXb)>U>B zBpLOiTIc3MU7Ao_b+?sCn-?X1LQswO0;aM=*Si{<+j1+of^HhHl;K5%g~@e63_z_P zQoNeHe=MAcTm_#=x|mJnulHSQUvd-dmq};=Wj47#R(g}oty4P+Fc|Aw+eqkydDp`CTUg$7duA9sqxFmk1p|X=oUb-F{4kB z+mDl9zv<}h+Ete?ifVxr9RBHp_GurD2&%mI8M>z=dzy^nS|N*NY)9=uNJkmb-HI6pTW;yjvmYTTXaW}H+g8cMRr15|N8N^dw!5fXnOvF#y zL?HeaD|?%jYDB)!X&!kf(YDO*l2DruyPxR$d7Bb50P6_}W}OStql}tl*A708%Hv}C zN?QAb`3%+QmgY9N7L!_$r(ddMvdS7ZDNHO_S_mP7Y&X-qp>@cj$qu+aq_;Rixqo*Zxev&eQAM1powfm z-^uBW?6)9h=o)%`$*`NC|IOD<{V^UWCeh7(ggHJ~FWrkji=|BqQ5-}|`R z6ayM#^5bX4&r${4AFEEx8*MY<))DyRXDlkFml1(TIJ8gaMAhAMZ47jT>74B8Njvu1 zch`P}(S|`bJsw@RofGug?awFn!-6NTbHzJ*EiFWuNT@oM0et;j&~0^uFe3UwxWz_acqyDSzq%=Y1#XvwdSYqywv{pBW@s?yb3agU z@K4`gBxfZ?&RvISvMZs{QyXEhHoY`533b%VV=aM17<~X`Lw-v*zMR=5QtqVyyAo_D5XI8L?#&dNMlvIY;Y%> zW?_vwmP4d-+l)pQ^ZHdN&%3%Www^Q7C1J}WBGCL6uve}Tq=pbUW1#(z0`>iwK*Xl5RL4sxRq83*_wvfk}a}}~dWOqF$>VrrI z$Ui?VG8O?@2F@JcSx33Oe^UboRlf4q#H7n_7Ak~vcbQ^iXr5f3 z>z9uod>^OkYxb2GtiKJM;dDBzFzks?+N)hVXlOW<$-8!Qzi$bU5_$oqmw$}yKi}D* zYAGJL>g9LKCX$4<@h_wIy~JXWjIxEzZ|i>JJHVa}cb9ioGaX~6xOLY5d{>q>($;ws zEn8JpQ)o>O>yS82Jpp3+Yk-X3a0e|Cf7~H1mm73Yre6PDF`BedTp1}>g8*yk0VTvK zL|b1fVsY==BTd8;tA+SXa4tmGv-Fej)G@JR&Y}p%=BW;(!RcdJjYY-C zPRL8|h#};RxPM!yJ2@4OwY~YDZH{~xklTneck0ab3)_j-j%sGB3zz9$kBkVOh>0=m zsan)DGI2c&es6MDI#v(mwIOp3Jd~<7hC7mCGc3W=3T$P|A9@)nz@J!S z5Ny#0sxPbIfRLjaeRlhIg$u|Yelz3n=RIdJ$`)626U zXQHHEzdZmQkG`vEkM($BZ^GpcI66=yV0jOQ^1erkH6p(Qk7*@&J$Vl&q`EsAI?w}8 zUQF1-IlCW(DdrKLgHIylyvLMQrBf8oW3vTi_`kk97ewsu&DEO(Imt~uVS%Iell+U; zE;3S!K6?1YWmzgZU{ih)&Ygz3zmiSO0m zJSyh4=Be}zUuLzv!A9+w&c{M9O9qLc1GXpIu6myQv}n+&o+iy-EWem%9F#n?sjEG) z*mwGYXB3C&|Fg3uuRSrQ=m%2)=y!;(t~@Dem_P2BnOnapl0(0zbllJ2FYqY10aoDwG zd*`*N8U6Hl5PbZn)=QW8ff4OP@-cb~OMp^&F*G6YLt0F7~Uj@vwiW}8T*Qg}v#cst{&AVSwKUq1d%?n^Vt+RZhefnS= zWbsWzdq7readrLR{Ibb`DSo1)gQw%QN^!t}mrLQ))y3f8>th%@A2-(evH^K<1Dngc zl*fn5%D{=3Di^>W)BFhPx&YiyE}U#cI4)o?4Yiaq9&54{#uVP8yjRapQBI3poK@Lg zuloMxy~WO;jc(%21lK~%M7+%AM-b_W#5p<`nNRK@zCV-H8xBS@M08=dF(pI?^c1IO za*Hc`PF_^dAVMMfGu%arhDHX=+g+4+mxSh-A(5|V)oxcDAo6g5n2O<}za4l{dANhR z8N?cjLJaxy2wKK?c+zO#-h^{Co=DDShXys34E2)55A;#kxud zQ1{`aGhIsZ`n~XuEjsF4^6y9w>Wlu&gMu`5>zixP-Vj|>EJ)+ySh{w>+SLGAtj~2R zjbw-VE@eidexPt`oLqWCVxVW&YFPpNd@c>XC1AdBjy??g=8j<$D2O<4#xxmx3=y$q zHEIJoov^N|GZ&d1KAR5tzm^rgXf#^g)eYx^4F6`?`CLH9V>L05cFgM$>PUo2@5N)= zw%?5HQ%VvUgr<_JC6fG={tUin?eA<;@J{;gi)0giq_Y&hmC5Vc&^uyY-EZg5f>b2CF)zFmex^dk-%9=`npOaa~{9lDFll9+r+bhT%SUmjE3e)p! z?lkTk-{4C#rL!Q*Z`%EMQz2+KK)GVym+w4Wq3S^)r(G?;S0bv+&1;$cyg+7|EOF|a z_B*kNNp}!x_PpuZikia|%a#$HvN{0!pl&Oji<|q4xlW}SjSmFxI6whROXTzxE3%T9 zdWgk4s?i#uBnWZa?OqUwq4a|F33|ZI=rnPLf-di4e~x$MSUHe{dSR7%`-~ST=1Y}o ze=XUAnWfDPGfY%-3&m5&9byhVqLMk$^Q5eIp!C0C_y+oQ;Bj1T z*E%Cf?bxj@Qb@3@3xh!0HJfy#Cvw*Rv&D}Q5zd%%d~86GdrFKtUzB83?2B2wodus8 zzQ4$hkx8Y{%-vIm9~UW!^K^9Meh_q%Zr-Jm*mdDg84_dbHc_W5BfBSB=o`+gbQ@P% zr#p)5^CrMYp{Iu5_g&^4JvRYYaxDD8+AdfGg2-*UFRF2rr-x{>f;A+~+#*@(9Nb)X zg!URz8%~81_NTBw#vMulC?gEP?{0J#`cZ;R2VvfchO`Jmrw@oXVGm)?+05-LnofuN zj>nC>w~$44?P?tN%;QS{Ij{_Pa67Y|w7>l7;fa)UA3GrisVuo zO~rCLKYo7aWvwtZ`T zGsC3f=Hk6-O$^}i`Wy=vmM-+S>K>Z6P4mv9+|Vpinmg3G<(y_`d|N!+H?vMN2(nyq&!-Us<<{}WN7N;EfNIw@s;g{vt?v6Qyh~?+8RTBaetkp(M@he z?LF1b5SpkO`Ub^GvFzO%DEKU9gGX(e7;?qbm>a0v(XQt0)otJXB0AKvdXzrCSmx1; z8!q)fGBoox+QZnu7N%o#htBR{Qp=vSyhxqZr{sVhOP7=z4%ENtwAs)65LOs0U;eQx z$aJ~lDmShU+SEwhG4*6SDnmklxfinmn;|sP*zrE%q4*>>g$Fq>>Edd8n{oMM^tclF z+f})H;h6$^LN56L?wczdx&HYKui!OoWzp_YyS`ey(tkpB(4=@W3nEx17QdZaT~A)l z;%wDfmOi!M=0*Z3vvVy8%^*<1(y2Wb5)I@23#}%9+5hoe6cj`jGaj8OTEKBBto%`L zcPk)oj(;O3Rfo3zam%H)H6zTi;9(}`C{bpLK=|ooms0fO9BL*$yFXLw_6?UOS@ojo z3d(H|@2QYboVZq*N=|QHq|Cw!SM(_bLs}0In=RJkOZ=+90};hp-d#RxMl11-;Ya_G^e$`6mu9dNg|$*96Nz0aF_ zWIGfmaT~!tG)8V7Hi3e7F$~4Iyo{aC+lzW_w%LUBRl$@g3_~`GEBWENgxSHVj_}KH zW<5WK08h{_JswCL;*ogR*@rYt47SM&nbMO5$QPbxXu*9&u__cAxS?^|r~#Y^@L zL?7Y(h&@YD1pLRZ0!sQ^JmRFpotD?C`#DQ+svC4*Co-LQt@nL4f3vh3YOegIT(kCf S+O@;Kl%C2Gx@rIYX8s4pFsRM| literal 0 HcmV?d00001 diff --git a/data/turnover_act_size.rda b/data/turnover_act_size.rda new file mode 100644 index 0000000000000000000000000000000000000000..5de574409c7142128386c729a2bf99e5483674fe GIT binary patch literal 6730 zcmaivRZtrMgM@J??h@RgMMALR61+i!Q#2HUODS5xJy`G-hv4q+S{#ZN3KS@AMT*}) z|GnMI?d;6%?0he)XbP7QQZV6ynjC8cFQd_{JpaGip!5s7DJwyzGVpP|_R*+W!sz&W zT=1?_kdi8(>A2y>GwbBUbm3$svgs(k**yDbOJ|l90{~I9y~vKLK{`bHYlev-2Qmu4 z>?)evdBAMs{18+GGV7lm0u@2a*4Aax1p(+##DBU_o z-{Rtu>CuGw%Q?y!IDJbUDI63C$xH75a^gn0t zq8v~>{&ooHJPd*w0fWKwR{&r<<;;OCPB`8i7Lmwkfwt~}twXLf&)h5=;ICTJ2Y~x? z#X903gjF(Gk&bWx=1PKwf1zd)D*AJ>A9udLe{nPjet|$CwV`7Grd(lYU;J3S+J&QZ zupilhbiq7siJ$yMcCH^}%s-PTO!|imBoI!*Ap?0)FfX0ApU6~Pa;XV&0ka6vhXSjIHFUrlC_)yMhlHrG!_%iTZ5#sA zUqqp}($mq>~+ZXNetrlYm= z{FpOp6s5kG4asysaUtlm)mE~x0P)ZP7w~L0bVWWJbtRIGw6)fD%m~d0%?ucfKfe3t zWfWQS{tW(Sqwlxh3)K|!fS(LFw{MiFI@xK(Atgg@3;Xmun5#0hOcoa9|9@PA&;e8 z<)PA6CKNSt*l%!lSK27aBelERsMB-zwZBgKdNx4fIF9YdD>-PbSFF1F=ytEj z^XgYo7R}iGTPEGr?IDHWuM;C~~Lv zaM-2z`tk$qkwvpbh7p6t#@4c;Q(CF}cAf5Jq1NJrR=sc8Oh4Qdq4vdpum&j!tLfc+ z=8X87bm8iXZ+gQ2n*&XPm|@7VGRs1y9;p+{LqVBG3VF5oSMRb6CaUT=Z$8o2v}HFU z@bxx}=FhZFuEn}~ANHU%9y>6IEhxxeAMdeEW+!E@+VQ980Dy$sXQ#Zwh7FHU|K?6( zi?C}|%5cGxxFKl%<~W;NMUb0FKng7>3X963Y8H!~pdc#zBWFUE@sP}`Pt|=W{FYH` zTe>Ee0%qllNH^N5o0F}>=w}?q0_-o6F~cpfO}I6;E;d@;g-dJQWUBq}AROMlf*-e2 zJYuv)G0A({TxM@A7^*-rA~p1M%uz$qsdxe{7f5m&5|&=%4d{EP!B51?cM=m6V;NPV zH}*+iPG#o168>@nlgN0Juo7=poLD(RU>^|f-z#WN3Cd}9Vv1?z2r6k-2+C+A1)Sdk zy9Pb;ZxgjGX~Bk%oq8z%rb@Ro2!C*@)8G}s4R(W>a-)lx@_*w0+LS;6-as8AWXCs{ zUQcba#7}KAZc?#eGi_4w-(jVQhaWq)fjW5Flt4Lug&#ZrKSjZ=o_Yq(kDWPT*HlRz zqtr2cMa-aYp|5XD$kPQhmp=x64QQ`mB1Wn6Bu8haD1}E8 zc6x?dGzd@82fD)DvG}5&P}a{C!*HrN^g*S`rX5+Kmxo>~Oe@*6pj2L_qd<1i2x7+q zWEkIL5vBBp6h{3T#^2TYMO|EbZKg2QaDlLgG`~%)qqk_dpiW8k`igA2z~owx@FdKH zjmO3bOr|h&KZ*?MKTMBA1_sMUc)A|+r|=aHj_-2c!VEiI5=|@K6Q*jC1ul#Avga;M zTI#W-phlO|1M$$^$>_khYZJVT4;T~q$4!6IApS>-(SFPydsj+ko`HjiSU;Q(4E?6x z%4ZLG%$f1>7)fYivax>K=MI4?L}%Vett|c0sJW`E4jNrmxGoEcvIZOXwg9t_IQ8Pt zrlqk>DkRe)#)if*^J zU(KQTE^l#9e&E}{#ovTvm1$`lJfA%fb!HH-xVjU%Dq6(xor?LpTAc&MC$IIV5caU- z$RfMY)>l4f6<&IBMiEO&Q`PbZE@^<$kMZZywZeiScZ)9vR`q4)T8YfO zm!&c;VFpjNN#AS#;oAo8m#297^9o%)eeYwd^VpAdBqSxXs4cUq^t*m=>0M&TuK&*J zhh4|l0c} zSKjXOO4ID1v$l?3MEF+Xwv*z<<)(Y%N#lo_g@b>evaZ{h360!DD2FU_aQkI}(ajTzW=15!2>)>|Nk-!5M$P67B?q#)#*EkvF+ z{a%cFV72PugN_d+$S{~EKW>A|Ce7eh{qlLtvJ$0&5=~$>MW3(si^Cy#&MS}NLfiq& z#{1)naW~C--0m1`BCIRv{{=RsxkIny6T%wfRMF{2U6#4*-&)&=p&iK!kvO|&Y~^#D z{g;FG`Rcx8!ICdV1J+5PZ{q5h?~WF5nQL3i=6i7S_6k7^8%532s3dtf-zmQ1=tz@$ z+Zn~m!PA$_tKVmnP9D7Y3xd^T_V!ln?3c-;XQ+xm=yWE9B3$!D9*|9iMpCs?2+b#g z^&{4TXN&Ety49oRclgK4KvB3yQFwhxpmr#wG@XAXsG@p=D6rxFIEFUUFBq zaH+t#kJIR*nmjnq&1t4jzCX`46bob-8xIkhFFK^7H%MZceh|!tldy0@ttCQ@@}Q?yP_Hh&`8BJE;NJ1-^n3WJTGQcrX3z!&Y9@!knn8qqItzIk)b! zO~S}{1e0cADQy~g=ThyuS1)~YD8AlwYVV}!5<$a`pf)%!tJ+5LJPO#XP>s0y9yJG; zRCOn_a|xLg_bOoTnZS1EZ&DqM{Ze+;ql;|p!X8c3$z7bMvKG3Re-3dO?Dm@&p3{bt z?NqM^?bdx{;ja6K{wF8)so1CXTm9mcK;xl!&nGn=dpP}}A?p|Ar!n%3sw4*V0lzg~ z5ZVU8ZkQgmix_PQd#+#m!nC9;_Vn|K$t%lQVRXLB1-k&B;nZAa= zy&pr0lWU*0vW7_~j-!%?_4RGv{-x3orj(^sC>ZVncvyr~Ts2kAoV$J!)cPp(Jq_)a zmYMURzv$ZvC`a>?PO_p>YgPEwn|D4^_9fYkdkzoK$UXM_40F%Dc93xn#YCIdN?B-= zh*l-iZdqE>8j)c6p>a>)o+<1sj}~gg>y!EqUO?$tOD5P`+q~SWJAo5zaU0{tE`F}L ze!qh;DEdHeATphGF3WUjp*2NsFUraI^umoW2xisv3fgemA$iV z#L>6MVUc{VfFJQLxstVnw~4|Hw;Mz5%M$ye8HXT~k+v^u{v}k6F9lWPBA`VJinkvz zR#+1vf^coLUN8i)hRHh*>-NoVKi{ys{t0Z@k&qNj{QFmf%sDd0g!_ zf?*bGJu^A>2nF~sE^EN;LEEyw>Fkp4PgYt~L1 zpSIb;=sy$W7rd4d4vK3{4L*X%clH65EoNcW&rweY`H?%g875VniI@p=tN2KV65TgB zLEe)xP6!%fwS*`$bFq@Wt1q*!ih2ncs}n6E7e}ZI zxG#%qUv}}ak$OZ0yU@D9b1T*1uSC3)Q+Y9*gUK=cvc&c!WWs;jBkKI_%n97R=PdzK z>QD^tfu_BR!>2y5&kb<(&+|;ugaz?}k)rjM8^tM39Nv}mr&?7>08mwxX_XF5JJB;U2t3e>JrvotKM`Pa-UjvcJii`3oJtsJYqbu;9WV*# z+SWuIu@rO;S%R3w!kL)WZexifC69YiCGm30Jj8uEZp=|kI|Y)|wxYekmKV9i^OEg~ z!@Oi0vBI&EZGWM|h*Z%u3g=lPq$3`6nnO)A@jsi_8}GaL0>o*pGVaNybdD1r>PJ@! z97UhBIy>P~pH@ky74=vD?rgzOU?T4zRoKY7%`f3sXzx0ONfce407IA&qy@Pp248}r z)bDCCrD}m|8;R=nu=0~dR>2*6Jk`HWn3Ffo&`=HQI_waID->2YMGUg}we)A9o_Ra-qb8=u zKjCRCPVlGrQmS1y(rm>A-)^)FI0YtY)!-M<9enQHdb)2`9UVqDgMH`u=wsTd-_;Hr zG3{P|u&D3k$wW-vQhRfY|6*4!%J(ct%NOj?tvM<(Szo-gHd1 zVq&}0qOzY};7JVBrvYZUXoJhkjec54Sxe_tIx8!g8sg{w`CK{ldozZZZZ6ABMtZ@Y zd3t;tYA{lzNZzAYM@|ZpdQv5pBcr;{)Z`3!$$e%FW;enVcd+pJGfP%C>7JI*O^=Ol z^d&VuWO04hWx8;droYR1Z_Th;{FbE0P?$9a@J2Mt>PyEiTTI&NzNVaoKk3N0>&Z6@ zUH-c5cwIQ8djF+VeZ)josWT>1++h`Xm|>9ujGg(LzWZ1Z{0i9Vw4v9Ye=b=%K2NQI zj@G>sLP2d6 z+07KTw&CXi2RpjjISpZC6f&zykqlRCi7rYiLfiq|H0FlUL7B?lGi}33XT9iET<~G*4;} zzu?V;ARSux-ytE}OPwy>-yRevydsnDGyu5wEi4xyP?_08_@m4I1e6zxr z>1}6C>F?D*@@&Fc^qyy?6AK(hqKa?Cu4E^q2Rny5E7! z(^V9*KdmN7jmuIY_Y0Ym(r*g3cM`=#yDiZJd+^!s>=m~CwiHH>DL^vA68I)-Q?HNX zK65(xKNQu6{NT|ue5Js89K#gdfF^jBVK(Ef*X!`({peT+e&H$X1#|Uy zl`RlQBzx);p*~t+rGUU8C)hT6&#@KVqR0Cr_>4_`vz8uxyu1PVDv5@ zw+_y!xQjLQ@si8bJ=x%*x33+~w%jpd6bnR(25+VA0?w8S8Abr?4MKQfN)2DD|Du3u z)RYWy?Oo`9cIpHM8G9UYbOJP{UQseEWS|pOmC3j3^s-oyO0-F}H(>Ovi3KWQ*W^NH zIn~ugtYK203DLu1FDTecy3ZPjnfLged2U-m>If7a)%bgg;}2Sh@Py=BdfT96S6=7E zsaQ*9-Dlbw33Jcx{b&wVs|s6TJEIuFP>We<6Ap_u!4`od<+3PmRR3iRjuiGmwdMgA zGFJSErIagIaDQf zFBH;~K>Ai|(w2`jxYYmM<(%$E&4x#@yf(0|;hY!>vd5^~XFV++w`zAQnc|M~HnKNv zs$--#+>0)I-dNJFgmT>)%lT+K8V?H3fQLYRN6^2!uUKYll@~e=9j%#8IP-bnSm9hUH0W|1CpH~g zH5%6C8k+>z9G!BHQsQZ`i`G>qF~?SzkY69UwMAG)fqgTsI}N1Fk6bo#kLV-%Cs{zX zXYsl_33uuwlo%+lN()+T#t^0t&y`nWd$u(DTEy3fn-40H=*!#LqRL+2nV)46dtC82 zm6g&bIzc_K69gF;v`ijI5n@u$B4I~z6Ldq9r_n)JXEk82aTGbTuXsm+adc>baXsTI zNb3XSp~@H$^~ROV*I|tvv^J*_Kx`XtDR8H$fx>00EqQ#wp^i{Y;io6ug=DsZfY=$TM-; z4IBMTxEe=@XWQ44G!r^5Tqdk``uxfF9?_N)vS%kb`?i7H~;nW zuYyk8SIgCC0thA4y1hTw8M;?H506fIxStaTb+gjKqkH2<0dnAyk5|rl7}J-m`^A4> zz8&xD(BWro_K8O~onpJZQ3xL9Cm0;NEbfrafqVedP-sZ?$tilG2NJ}h@EJ`;E5=%*UcY|~ZNFz$O^!5AQ z=l*@qoM)by^UnLu%#ks+7v_;RV$wBAn%^Tvc`g0?|2-Szh=#rc8We&Ma9dkeCE^;< zjdEG!a(~n$;PA`K_2b9miit0(<0}PJ1}@Ic`=f1jmB(8Rt;-d>r_(Q))FCsF5oGBt z4@KlBr{c)s(k(UcEw8z{Ob)*6kyr<%vFOG(Id5*B=*R&pnP(qPNgu3oH z6O&4iEM4h7WR_mm!5@~8M50Hj48oX#3Lp`s9qO9uOe4q)67?i?^$1BB$gm~Js2>oZ z3I3f4aAtxbb*Yg|_VjWSSjCATflO$gI^+z3P)5#;{1!->6DTgAg{Z+Hl(aM8a5N|~ zj)@6fSG_bc4sfM8ds*&qjs=>lBu+=&>c{w#HH-*Q79qyDCl(2R}f13si`T{JnFB1?Dchf6-&g` zhQkyxEg<6jkm1?6*=Zheoc+uA%VDN0UByD*f;p@?f4IW5xEeo*n*?#0gIwX4%#QlYYORxUk<3aKCK*1Gf+CQxwJiR=NrG7{@b^QWO6kDsCibSzXC*~y-1nIbH^jN_#NxB>0roV%Y59W{r(K4gopu! z2>9I-Yu>IVOpMj?4N7#&UQ?KI%f!L;_~A&~ubl5D;?8r1g?2Tp`;WKkjV`$OW6+vT z_tkvP8r_Fu&QzC)dQ%o6uZLX9U^Brn-x_#mHeip~wnr_VRoJ{+_YJTl)T*R)s&7o)*UR^*-Y} zVfdH+5gg`#<)(3`6BFB9BmZqDh-qm{POxi7;5ALaXZt6bhQa4-pB(RQ&3Yl1Wsshn!DoNV zw3%wVAXThL!u7jwlQuMwk zMaJAe5l+{N!rn%0W0w0BIUM=WOn;C~Zg_;3waSwLo}%H}pZ7fV?^d5Cd?nDg=-MBQ z2T;o`4wOCASNF&9YhoByzVcL}O$J&n@pj%7echLCi}zKKQA0i(X9 z$0WmLDg0Dz**|O1GBQA^m`Gj|dqy5ho=ScY8*duALrz=IfhRNdKUY#xFMI^Az;pM+ z94F^~ufs*l`DUv*_S2FHo=s7azOl)_loM^End2X0qmisPKmQ+M;l#?y5mEbJO?5M# zy9>ua^FQc+07pc16WPJPr-iMJ=Gf?eN?ZR?xBip)fA{~^MmL$n{zvUMCCB(xJ8sBM zYd;NO_Sz*2&}^^9!Fjzzho%SQ; zuXFvyg2(HruSK{OKy0k8inBO%4RFl4c2^ivP5as<{^!x_a}lKM5vjwzZD|iYA54AlrJ$CLkSA;)cLQt!jA%8$bCscHdjz;{`W%YiL>3`V4i^X!@-JjmP1ix6Ks_G`G=$Q zWi#90(RR+*MV_7p)iCla6<|(8{9?)V7={b#-{R>slKM$jw1;s=G+Z24CS@MzW4WZf zMA(YcpG$?i3fixC2X<(~<1I_b41}-jA8A z3R4)Dt4pZ-=H=VK`}+%)>*KuW@rtmmSTe~hU`Zpn65t0P$1l^wkks4S8SML75#`&2 zE}mnJN#`$&HDb#R<|3|#{+LPP{8Fnfg*>HIRgM$dSw?B1_7hX&Fb@o7Z;9wJ2I*E@ z{Us&yQpmSUk3Mwz+5XpAro+`r2hP#d)A>=`Spc^FV^mS0AX{kqw&StkYn<|7=JNYEAQPW5DO?^!Q0LTaigsfp%;eO+ZpPIUC$7%71f;}Y z-|@gJ#2HLnkuHG3D1q>BupEddp5_mE2H%JQaZ7Pe3?0eMN>jI2{}%wh}(`XN4%W$!~ra zUoYbC$-qy`-Y*#P!qQP-t`mb)eBD>@gOC$=)#$xu`?h)TjLG!eoakLKM*xTE#!9|q zHfF22JEEQ0X=1d2HqGv6{Wk}YP-TN3@?*z5l6G{w+b;$`8qKu#{RjIzAK7pzKyUVu zPFR#!p6(@foD;gkE`8R4BD;h;_gtodPk{n^U+CK450fp%sj1QVlW{EPjJVH+8H7Mj zo(Pah`3rtOP~V_Ba%2W4QaDGJ_mHt>1EI{>km#Wt0y9`<;JKa^a}F%{IVo}n>( zRJw~YrdZg5P&*&MLY*<;O&dI5>#OUFQ)-6jFW3{!-mq4{Z>pT=H&|F$s1gaWr1mw# zK2yB@uNJ=qgf`xix#iJhixX~Og^QUZh(kjYl!#e+x#9HK=&w^U3Xl-X>75D6 z2`YvKgeiQgNbf5qN{AFKApipn7ZoK$`hOwn#;LCu1u04nyV#piw+V)FIhi_sMaw@| zdY;Ka9lBb$s8TGLLRvVip`}VMbiglR6beM)<{NH8uL!W2(P1#yeA_*vmJ}04cX}yW zf&wj^9`N53fc^rle|=C&L(A?LIEJump9};<$pVL_pta$e{y7D0b8&$hKI(;{ZnEN>)B+%Zwa8yd-;pi zl^*`bF|(!Ydl)J;ah9~sOPNpE#l;wxJt10JdeYH!vp4keMM-6w=nOJI8J-wkMR^P- zH%pH#XOGC0(cW>~_)?s1F$yf4R24U0UM1`9NHtWCwG*g`Btw*X%rY)lXcKbc-iseq zhtjRI7=zCu{yN8+i|`E)MLOQ*ZW*SwuwT=9q-i$Mn@YTaqQmHM({GA94 zuDd9~E)aXn{2uVR)!3~V*KHfN$22z6nx_n|I#l52D0q4g3bkaHZTszT8{0tTRH2Iu zb=~ayb)WN|26%$AOu#32*iz7+OZI6Cy=*X$duy1ww$tOh=Ml${2(CYLvwb1r1Ag1p zs>=MO$z+QokeZ6iszG^7X1G`_^#N|(Q<=jhQzD9MUx~1omvG@`bz)jTK9-fp7K@U` zj>`F9@`#;-bn2(j*?7kBV?<7`@I$Y@pBS7q+*hR(GU}?dl|>aZnE}aDT1c~*#fj>^ z$6eT-;Nf8<9d&vI-p6!x#@B9*^>n{Oh0W4{8FrS7FU@T&irQi%c)|TWBxH`9MLtiR z$u5isf><`+eQcHRD&!USqt`TFy{f>Y+FIxN_ib6fweA<a*x=A-#?PfCu<(UzD{gi_W4*D9y37@>tN2q19_ZkAVLR4QEX0FX zWxWu0ml1x?$f)U#xFVcEBa-91&mzX~fb|F$8Mwv*S5R$TTJxcJM{`ky@a{Xf=i%Zs zodW+@6Ipw!IY>lAxFaj3$ZJCH$WJ>l>Il$HOc~MP;*5rzwELJgHKPW<*oO_4PvH11 z@@==welDPK(3Snp3Wp!johZ}$J}-T!5Y+ku&VFOG>7MQq{$Scb=29*74ov4>Ih{xlX{339^!Y4tWYR@kkeXt*tu(30OWCB-yu2E^mU3XBWmiCChrzr` zZ<5m}VDic3kJA1ZYB_4M9R=ed*`@sV@6<6H`Qv(|XbXXQlDqN9Gl;*>n1j37V$y zjrr6F_v`$3kArGgM;C3mV{;d#io@H1EaL?k_oJ^~e_pBV$hY>b@{co^82x(B+rpH&j1;~QdQux*o7;{cEOrT6KJbUP zJ{r5U;{TGR|CX)G6&dgL^Y_ljcnFoob+VFy1I+@s*Zc=}v3OjhK6I!hx;*4)kM~8z zH>OPL%w3ynn3WT|aDg9V>PyxXQ9@9SeB`5!H;O@-g`2t54{Qb!?<(xio8$V@F+0v` zw?0=~@h8TRJKD90?cp0C-iW7fD%I;mZd5nB}QbUx_5_LroB* z0Yb*e-A~{=xm;z-+zsoW<|C4p&oe)lz3(e{hBIG+T7TgjGgSwawObN>a4c*!&A}{i zH2a2I{dIHpZS%?>sq>D`M-bg|S*2bWkjD zm}NYUM|9g(xS%@K4pyUXIvtB;D%ZpdOROs?OmMS)kRETp`=Qz3#h_>-`p)b`9WY>n ze~QxGAI%F?3MG`L4OI$71E2u_ymBB^jQ@-_42RH~&^iI@KR6M<>jM2*RDcN@X3hS| z_llxMJY5~>pmPTOBwS|BLHr{rYUQrYTfE(2+O6>OpKQ#F0_BZ1?fqYlY|Ba&3e4=S zxc$!hiLYw~)Vej7r)?-VFslFbY&v8n1}4bA`qP>AJa7DLoIS#hwEgK1v>YSY#Dt}t9p zopOB7V_#?S8%?*5R+%4gR&zHl9)DP6iL%()p!Q<~TA74db>0#Og z=;3I?t?-=zM)nw;KiIv{8A(b!yg(oItf4`Fts4CfE7t@3a+PE-11wy2*ET?!Zc4H; zi{wS_HyDI|^RDD()sDGeZgiUtQT%2DWWuX4kB?raobMBkU20236OsJ-AgQL$Xx2TT z6Ag27qg^^Ej;~0kZG_&&M;c(^ucxxe%6(E=neQ&__D0HMW_JfQMF-abfX3Lo3JQnk z+_3{%V;e-bp#qYCKkM&|dwQoJy(0X=n)Cg&k`he#251YC-IxY_Ci!+K zg5(3O`UkndCYn(T-@HsUJ3S^}0m4UMYx^3^avrB)AVNB9-dD)YK1ewO0*24{36{RbBE6GD$V?OFHXty8j~Dg;6c9 zQ|;M6%trwz{7HlpN-Jl=lxxLjo!w0NUEq?9Y>y49K8tN@G@XyTs`&W&>$gekkBr@V z;#gpURjxd>)$}{zWl58cKlCeJnqlF&HK}^PE?F~37hi8*y;uGtCD4{c?#M$Y;v@TA zmEitwb!p9S9JWg0dBnGazzY{yvHqWV=o<4La!UqqAL=u2$ zG_Jdn(D|~?){O;S?qKGKXzl=(C+;%XcHG;ruwUKSSyg`c+x{Di>{vS=?&^8X2HcOo zdcId5D#Q>w&;qd$0>PBIblG&LPi3)7uJvJ3$=WtQ@B|XNuo9yGbUX`*KKx7_U8sro z|2iMtelwUtg$6zq4MJ(UXD+EYprEm-iJ^6R+nX+!h9>Q?$AscF+8Ug8=bV_J{&(DI7l*FQ~aSbsxj?TK$b@-!mG)*FKKzC1H_H`63sS)9*) zekqQdCT9`fZ;KrnMZTR%9Iu*!$pqXfr!ssda*jV+d0d!IK1q~540M|Rs%$!@F}Rj5 zka_MN0L(mw3ZCHb`oE|fTvZya5|Bl^Te?V-WtgcDD>ORHTeOaZQ7%=7SdB{>q1EvY z5G2mQDmc76@LU&*uGjDk%1@fX*4dmIh2KJAK^v=9PlA7#nnT>kvV>Q6JzkL!JHEi; z5%BtUtbp>`=%g1R$kB5|esfnN-WGBj`_~^Sv)R~(PzXt5c5;}gz~eTUa0wbv|LwJO zTWS#xf(fa4?vU%r*4+(J^rXW{9zUGiSui=`3OYnm4aXw7v!dsm(?0%7QVz>LoJCaeMH-jk zDy)w1FDBkZ=FYTI!r(i_3Y?a<{~hTUb! zV5rrJjB?+GMjWtSq1gRQ=NfZu9#(jT0YmbW3G_TDHj*}dTCZQS398qiBC-#^ik|K# zVDqG$>_-2>llmYV4!m(dM%}OzzX;3@p*q8nD5Lc^{_uHb!wbbo?pG{vh)fpWYHXFv z>6BmNgH9+Q)cyRJLAwd|AkGDSsQM;d(6AY$N z)%kl3T_kVq~j=ko?+s}0)_Px_D zSo!DEk3T8OU6{g6R5Ld#u9sL8?>KCKqDgfPAEp4l1a-u)t$~ip7L!mjkXi=a-7_ED zcGOG9bfm-k4)P?qXS`&aC8t$tU~XV5Sc22V(a>UKRTxd*>|bd$XcNk#7YqEG}kV&>qw~ z?yhLp27sj|obtKQuHH;idPFLrPGf;*ZXhr5y%*S^ZAtLV$>MH^&ugq$P+izD=8qrj zLuv+iJNF2hZ(@JLj99jtZWopei60$37k31h#x1gvU}Ff5oAT(62&3d)$|m7r`X?^Efu8EM@t7!ly`Z|uVHtm4M5UTZPf+!qhD1#+}PyCwW-JwZg72?SKvnmFCI z`D%tD^WEF1O=@jLlqHg$G8aq9n$4(d z=M8cgHVzqtxOoXxX&a++15?h2Ea=R)N_!~Myru4~Kut@H08SlIbBajz2`oW2eAwQ* zja2v4^sAqh-g0chq}H0Xm8|DcQy+hOC2xj^+qNOcY4Qi%Jul-x?0nj+a72|`{~OE7 zB8X~KGS+3@S)9eg&q=$FU)M=!33yyt`vcg)mm;H>Vm*P<)>gP}`gY|oyQ%sD(3AM+ zYkBq|!2GW+(ONJ|d(LeZjimG^b2_*~NX@K~N8%|%_Z+a2JH1cOvo!`FZ|kmY;1FFA zctg`|wVg{<1Ki{D=0{Z;T z03WpfQj;+Gn?m%IRwT!hgFc4TY2wa?Ir*oW%8HIXf-u=9n@LZ%apJW4SC9Y`zd5^6 zkF6>|#yGn-wYDzw<|8(na~c=h-tYo&%L|cEY3U(*yOMAn z+PT~!x!BOb)Ymi`I735QVt#;8S2)m>U$5ru0ECai0MZWU2s!!^Y5X3JRSg&q`qDaq zH_4wT1e`4b#J{CutK(YAVaW4iWz-+IO>^Yp`LfB?!QUgFGtQRIEcVkpc3^An;PH7m zCyi>`W`FgYn7xIMpYdj8PaPrv3tm2&#qOhUYXpv`DrvPetS>jf*h>%3rGCIRAK{hjf37bWy<`Mm9@;i&FA5nUu^Rn~c6$c`3a189zu!%&JY)A{Mq>#fJ|$Ip*A zBP={|-7V^oDsc2Y8u3bVe}xtJyCp`)0Bq7e8gh=4Wi!(cE1S!+^ZJSl^CcAKbr#N9 z@%OK$Gqf!Yi*3-lj8>_^$DPB@9uLXpTj%$HD#smQ(3bKzIghgPM4^6)W*R@Y7{%9u zbf5$n*cs)oC`>f`z-a5%Lfq@v3D=31cxvi?Vbi9Yx{2VDhO-c7yUDfsks<8QQZbF~ zn@3Pypdrzz1gp?%Uv>TTZGWM=l5LSdnwzxdBj5krW5Vge?~0!B@$NM+6Mjtc-qSEB vJNSI3&u8A_h3r*zR`L(#Mvaw2W8o!FlauZ7Q%ct-&Ye$gU+I|3#~J<)BIb$= literal 0 HcmV?d00001 diff --git a/data/turnover_nuts_size.rda b/data/turnover_nuts_size.rda new file mode 100644 index 0000000000000000000000000000000000000000..687cad4480554353a1a2e7262ff36a4f53a09754 GIT binary patch literal 7850 zcmaiwWmFUlu!hN{W9g2io28VJjwP3pZbZ6ULAqnF0=X1pA7-^we|sDa8Gw$R(D2LuSdH^25XrPvO9+yDqs~= zw-sB~&bp+tqaotTLXISBmm6r8AeALjRMFEbF6M%@(hRieY(+xE>4>UJLh>D!ixkDk ziYgTIRkI%Poe!BHyH3;2Sz@C9yweY55DrD9NA}9+1$yC84%%YQhq7!lB%BDOfs(eY zl4=pW^oR)&5uO~ynyD?TR^_hbT;+h~t`$3noTD|E6|=LmnMNu)a`Lo+38y((W6Nh~ zVPoJD7dz*K1VmnS8<9l06FfOz>^vVVt1ZjM$vJCVbpdzEs|Zo$)TVRSnnSV(=iyXW zR!s9IV6hK5ESI|!mHxA=OwT$`)7FI?6s2dXWzo^mg+v_5iW8x?(PF9=7^qcDJ0j9} z^0i`%;@!2y&eNdwdV6$C(2z7p8;RbLn3&k5nBBh-#F$vby_Ytp#h7)`#JvCFKXWv|>w+1f1~+|Ey}qp6~}!z^z2R+_HsL7P&h z4u%#_I>NJI?I|^79EqiHMZI?MMc^@$`m!%R0%+>o`OMpt(zVF(v#elhs)Q$UZN&~y z=DgpWM;0>C=)oBvpa--1{nz8~G~x*HeWhz;V;!_(+pYR7{acFNDN{zQ%6P3?Pn$&h zzEaMg7?`GbEv#yYA%S}AT5GH=RBi4Ro%MT-0ug;W5;-MiWX@Kp$V~y~X3Uy^uPb4P zRWp0P-zQ(}!&+WyRps3v$(tw3;_+M)Wwe_+hJvTJ=7u{5>uCWgdT6GFKjdEL8kXMv zd6~TJ?Jux?O&g41pK`kAQ)HyNl!#8sqI9>c%tbJ?@+#8>yRWH2Gj->5!oUQ?VA$l{ zB-pZGdn#2BnCW}98h>RRSg0a?rEjCG=*Xh1a{?s`ldhe5ZJXQCZAi|Io$eUTMM9qE zBG%q4(3bO)^tvULk7g%dEF^lWls~8NXRSD%m@UrtaL$j=uJ82XCQH14pC6-tn*DT{ zd)p$lZ#p+`UtFObq`Rk)br<&XM(fM^LLYQ5oBfE zTFd?pCX_!#nJ{A_Z^!JpHKCB`!;iis-HryT!y)VkPJ{b|<&|kHNdg!8FJ^)9Mo@k1 z_?Vaom6#(M5Y$mUN)m{r0%8FbD4|!iQT2z$e{r+!6DV8$7yL<}k>>wRyuAErg#+4} zS1KRP2iB?1dRr~}Is^t*1;$lMT1}}`R9?P}Too8V2}Gj!llVX=0ql~hs#dDVX*2x9 zBn78`@}EEnyeykD`#(8tMxf^+piG{%fKt zn=_ATa?`oHu;}|JZ^KSXK2WfuMxKemn!^&UTn4Ow#rcDAIN@Y)Q*bbtw8l>CeqJL! zkIlA>2bh>ad&nB)&gHFjJ*tNE&TbX${uJ6nwL~SFNgzt$A{NXhXU3WZpOw|2S8|DNHD9F`+T#uxSFMG~yc3#O5KPM3#eA)g5a&3JNVB=+$q2r= z0ZJ+V8KI6gr^%6V&$>RbMZK`l!DxDJo7#M_3;)BM_y+t_$DQD&LWuxU5oue`8W$J*XuR7{@S^Foavyz(&O z0As{LptRICP(D66>QF90ae_AJtsG8OedHbrtSx~ok6JX&)~F<<>ydE|TG1VizkDqX zoslzLayPW-J93R$-qiAfXh^NR;QU-#;(wc&`XzC_?Gz7hO7@Eu+HMmso`3Hv7Hbm9 z6z*3;FInGUM&;m2)O_TKjYLrmS@w2!h{kdsIg0Zn@rBLo+#8r=)nfD&KG11UNv#kz zbk)5vEGu*nOZaCNZ+;TE@du2Pfx2uv{ z&1mWD`g*~h+!b;$8x)tVc{SM7@*3h(=gIoKJ11azxcbBsG1wS_` zc;#yM$S6WQlLf}>i}4_aO~`lZLIbHsSW9JuGvf=G#CadgVxtifEN2R`us46tqcVTQ zv^*B-JxnC`*ZnbI=Aqy2@L>P=;VppZwJ!DCt#QTgR9&9A>5Y`Xl7W@JOX@eWN(ZG6`tJV zgOO|+NK?Z&)0F_2^Z2x4QR}pB1IwTF^}8Y}c#M5$S?oxHmzxo4Z`!C zpwv`5n`hHk2KBoY@AXEZN5AI?|6m6`GW>y??maL)y{9G0=MlOmVBJaHk6fd9h~t^P zmbvsnAGF!IB`iYikMDSFl@6HnCsd}oRuZ&LB0smx-96ct&0BunDF0>miA)6bjCoaa z?a{|RX?*!L_DN3gw2qgh_9<05Sg=iBf14tKS3G0Y4`tv1{(vIJFjB?PIE_Ge9$pj1 zTRpxpj9D&o8yvxZGU|gyYw}{1xZK*9JPk#T#ZCzfvHHm;^irk3)pqz38DU90&X>7EZJ>?^pYLgFGxI0-ce5>lk8He;<43gP4@9sSaT34X1a|%l* zUx6j-KOj60cJTwu8}oVN`bFzKVq18srp_%L*QLj^x(aJwRe2uu{it#;6mUN^T+M%z zO-Tj;2?t%e|CQA_@5R*m^$18h$M=cd(iUk`~g3ETT1#>k&{0F`YJ_R?l zls)VDcVmLr3>&vBT{N6{k+$$xG5<%pt%J!wOez1NoE}D`2G3K9xK6^%CV8^eo-a$Ro$q_IC1?PXb znVH46^Zy5^xwEdW9=EDgz5-gItPi@U1j`*IJ(&e?r8hUSmivcd1>GJr&0sl9*wYM& zxcM@)3nXc3O!#R2cYFmjLo=zZGdVL3ghcBTCK##vM?+az*J}%eV!l8rzZ3zelO}v$tJy3C;W7cPnmzI5{yOAg!Eh zn`ZiV1@`$9M<4$bc{ls^Vm$X{_Zl9%aM%VU+7TIJHXO_)X+>=-b#t=J(sRnw;=uq@ zSF+Kz0b}y8qg5gM18>+fy3leNJ``MeZyGsGDe07Ih~FZ`yLDwdUz*`+oX$dzO9U zv#yZWsTLL090`glaY_v)GQj__5sEP37y0<}rfu;x=(3XzY=FGP`QxZGuMLX;U&}&z`t?jF4nW z_5e`nadQx^(w0mwB+0O@iuIzYs?;td&B)oMZq6u0NeU=5Sbk5-F7V{99wwA5NZawY zyf86(Dw90jR;U)P{Q*}I`fUG9qlWzRG#+yAk%-*ab*30UVRSXWf6I)eBS}(q6~p1n z=TS^F%_5~cN0>+++l(2E?#}q#e7IZL_Z&>T-R#+Uj9uk)A9NEcvrB2-BN%udyc^;yw0?sTkEl?1}_mFt|^fL7-t+F@yEqQ1g- zaB%{GGOTt-Bj!Gh!{OrRS?FAxX~B>6ui3+{)1aWxH&Yb*=CusS!<5T_zd-vBU$1Ma zMSfIF`vXssQ+~1{xv4E=l*SD>A_}T&XwER-$*_Tj!%@n-YKK}tqecjUnj=*3fY`lx zjneVpZ)}o6GjPttkk$&oQ4w;Kie8^H`6++_C@t!Slf)eSz9qO6mJz+u-;>zQP~Y>Y z*6AKd?q?9KZub7!uyThW?k1&f?GN0}7}52UDimO+iqBNwD^`V2iWf<~I7PkmH38=J z)!Cdw9S@V`i6ZLC84qRkmg4o@y9)Z<-J6t_+b^E_X-N&xCpt!Wk@>;kB<`OzbRbf7jEj~Oa}}w#NFleYe`eAE1M>Fw>tWE{=O5Vs1y2I%F%8wx2q@ ztUjRC!(;9FA_4=pX9L$ANw%FOl~TNWFvnNM4I-_ix!5nbSSeaTv|IPIRM-B*v;w`| zcC~$(BNm}<_)Uk=TOG@%nXZfy=X`mV5`f^vy=uxq1zBJ2Y2LM!^32|m;u10q5JV9| zroqad&OW4^!4At%&LD%}ae~-ca9J@3fw-)=U?47-G*W>*KEqDrG1f!S1tI**%u0!E z`9V(B7k*^!QMOx1sGVy)v`JrI`yzgT(Ix9PG6%VeA;RXgOR@nUB)m4T*5zPH{NxFO zcgdIKN@mjxP2ed9w~kyL(*;QZsPzIvs{zy1wdPY$y?65*F+aQ*d->kbxpoFN`WOKit53e=YsTuQ%3WsD3$WI^l z&v>c!*$|yot)`TfjrN0oJ=>0Rjx)gbmpUzN5f^#LxGcj>J`oia9H!s8{75LPyl*P;=9FG9?0)ZW9VriC%l)u)R7wg*Nqw7Ct6dwXI_ zyIj`hi>cMibRV1ht8)tr#ezjr)uDjW>OylPUc}4}E0hQ&7RZb3FhSph+G0>mmPnLrs)T+w>z++tyjetkmlKd2PbeX2E2RiOHkbQc5m>H}=2K!KM^6KgCO6qze|9{92QKA`PBeOQ))g!I zmH>P#LeodT=pJ<>aaj^?x;Afv7U2*-rVETOD;-TO1P8W5mU&b0TJEe9X5L1YP72}= z=o5*XP>FAU3%Cp7(%`p81XI-7YDFSptn-ncZJ8x50W&`%Y?Jcck~4J?97L27gTW3( z6Do@<(MVeK1`4@iDq9Rv-b-nW+d}3#<*NCoJXy6cz}P1`JSaTvVn#sHzmeP7Xw>A6 z>%$m}NyN3wd;J96-5K6}5b#}?a#CD3KM z^EP9THtXt(Qy9!zGM*b-i8Q2QgDZiK6A> zYpoUYLJYl1WfHt=0AnQNNqaO_#vi3XS4(6R=q@wI@;TJ|5VfS|Q1KG|Ik{5@+dY1(Kz{`?QuWc~zFS&OL7jB+)&#(acFMr zt)JTeuNJ_4!`(>0aV(`hgx&@II;A&~Zslf9{!RQcf9}I>mSjE zINk@-7ny3#@()Dcz_Pe@=!)JE4)2%CDSnSsGkzP2J9B^_7if?UHL9f|o0xpq)nNkX zM$lEAh1RgGjfaeM$x)q=896M@`siojvS?@gY8p4&SpCt%&)>&N-s?1707WKxBLp( z0k!jeWIDruFO$CbQlE%dr7?xeit_u4&L|PKlk9ib_ZbwrjgP!NRq5dW+QHaNL&2Aa zRte~OYD~S_xUxw8$UF|lQz3um)Up~1kTN8ac!WmR{Gto<+uADCi7KpO+3)ZABFw1b zZgvswiaHR!&qms&7930;#rL`kp?m1>{5V}7-ZL)>r12aH%_BY&gF8x1rLOUK(*RyA zz5g4ma4tu{V|)yPp%>Q276o3 z_N@baEV4FUvt~dGDDMc&`LH|P6UwxdYiHC8GAQ8Mp-#)4|FX^AXJs;>=j zO$*@^r?oka#~58dteIh!6{eUUpg}TMJe$6!wOjh7ZXHCx^0p(yHXP8h__1RL z^#qpcy!Shg(fA4qsu6?bqt=cSB&<0L;sUob*!I6f3Mb!%Oy{l4{z8^a1s_f+tLPzQ zwk1q(<9d?eg>{4j>%^c&-rXI~P`(4VDJ4_ju*iE8D zyPU6t=o4;iux#@(h-)#@P9~(uF~8H==7oqD`yNto?@yBidai~rd4Ej@>yTO@Lq3$9 ztg0-18%Gei(>_{ETP#|?e0GDf;x|M08L{YZC>QKmAI%vfmnO1ODP) zF(NFIEgF(7^@0H3IGzRJ`-0dytOV*6&BguAVhU^I-Ho2V5W7oLJfipeFA%V;rh3W<;6E{9|J-; zrH|>zl4QA*iz_~0>KG7VwpU8w43~J2W^w}6-ISc82`)Q3z;x5g-EnDOWF=8tWJh%n z_NZ__vT}>&M&V*J8odd7$#I!=htIzQ(Z0#U4QNM5WjLg4O;cvozdc7HZj*SvtF#q5 zUH*ubGj-i~h*)6pp9p$TGssnh0!nh)u2JtwN%| zGMw{%%&FlDws|vo`YUpDR?=|!&YhW(qc9eUL%tx|pNq75xrt zT!j(e`nj`Ejm%0sqtvlDuQb`hxujFU85vbe$_nGRmQ_qGe{$}i34Uc4?Sm7pa5@~U zT+`B~gbNCXSus{O1NE^Ng!pH+2Xp0b@5*L!g}1w^+VJQ7`?k*Wi8$6TLRZ^#q@{-s zzf(&7^sd#L*EDhRnVAu>u+G?6SkOKt@-zJ;DZk}KN~g6S;ljzv0zQ~zUzIE2Z58o9 zoDGBZ=Tj$hb3frHND43Zr0Y{y;%q)=Pyum-UPo1wL#dCM?KO zKxeMLZC>wXeXwv1m$uI2DuV^;I{YP8QnyORjNM%0w{H3Yd6Q3lB`^SGPEOk4Eear!vGNR$T;xd>Oi%Hyz0YJLvVCE~#vxOM(tmft?a&jC3Wo)OCPF`aP zkMMGEudtAk1eZilJL8aKm4`3mGY^+^n>+%B@OD1bN^ZZGYk2R3fTa?xc;}%f9A^Ct zv|-Z73$$K`l?`RFdi|KV9rmrp`P;n;3>&uaB2;?!q<+D-zaFk4Z$-Rn+e-Rmjl19F zI`Y(8SWbM${fi_d%wjnL&BaRdP13D;5Q&+zx`h&geip5L!z<0HNq4Gek34m{0T}Im ze4et}`uo@yy5p$ry>p6sUa0aOHwl^XUdd-jFCNQ#slDx&BZNmn-lmTCmzT^0 z6F|hTvq{`~yz7+K>f+xCiov5)WxRd0>In7tL9>0M=vn^u!f^Zf_kp6r1T2YiuG_(W zSmIX8toZ40s)poOMiRjL-uoDa<}WF-{Au@{!NE%brrq-+r`zIpkyVcRWiIcr!1KZ7 zwK9jb-^`ih;avxUaAxX=Uw)rn=r(-d{2k5Ge~8wPlHQHgmz3wSp|n6`nCxMMl)Msl hIHd?9;Ig@IL@?3+{2CW!_BW{uRLHGv-?I%2{~vrj_VEA! literal 0 HcmV?d00001 diff --git a/man/activity_corr_table.Rd b/man/activity_corr_table.Rd new file mode 100644 index 0000000..71a268e --- /dev/null +++ b/man/activity_corr_table.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/data.R +\docType{data} +\name{activity_corr_table} +\alias{activity_corr_table} +\title{Correspondence table describing the business sectors hierarchy.} +\format{ +A data frame with 92 rows and 3 variables: +\describe{ + \item{A10}{business sectors in 10 categories} + \item{A21}{business sectors in 21 categories} + \item{A88}{business sectors in 88 categories} +} +} +\usage{ +activity_corr_table +} +\description{ +A dataset describing the nesting of three levels of business sectors, useful +when working with the ACTIVITY variables in the turnover_ datasets. +} +\details{ +Use the \code{write_hrc2} function to create a .hrc file from this +correspondence table. +} +\keyword{datasets} diff --git a/man/nuts23_fr_corr_table.Rd b/man/nuts23_fr_corr_table.Rd new file mode 100644 index 0000000..7f927f9 --- /dev/null +++ b/man/nuts23_fr_corr_table.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/data.R +\docType{data} +\name{nuts23_fr_corr_table} +\alias{nuts23_fr_corr_table} +\title{Correspondence table describing the NUTS hierarchy.} +\format{ +A data frame with 92 rows and 3 variables: +\describe{ + \item{NUTS2}{NUTS2 levels in France - equivalent of French "Régions"} + \item{NUTS3}{NUTS3 levels in France - equivalent of French "Départements"} + \item{A88}{business sectors in 88 categories} +} +} +\usage{ +nuts23_fr_corr_table +} +\description{ +A dataset describing the nesting of NUTS2 and NUTS3 levels for Metropolitan France, useful +when working with the NUTS variables in the turnover_ datasets. +} +\details{ +Use the \code{write_hrc2} function to create a .hrc file from this +correspondence table. +} +\keyword{datasets} diff --git a/man/red_vegetables.Rd b/man/red_vegetables.Rd deleted file mode 100644 index 5d36b02..0000000 --- a/man/red_vegetables.Rd +++ /dev/null @@ -1,24 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/data.R -\docType{data} -\name{red_vegetables} -\alias{red_vegetables} -\title{Fake values of production of red vegetables by sector and size of companies.} -\format{ -A data frame with 1242 rows and 5 variables: -\describe{ - \item{ACTIVITY}{activity, hierarchical variables} - \item{treff}{size of the companies (3 classes of number of employees)} - \item{n_obs}{Frequency, number of companies} - \item{tot}{turnover} - \item{max}{turnover of the company which contributes the most to the cell.} -} -} -\usage{ -red_vegetables -} -\description{ -A tabluar dataset containing the turnover broken down by Activity -and Size of companies. Useful for playing with tab_ functions. -} -\keyword{datasets} diff --git a/man/tab_multi_manager.Rd b/man/tab_multi_manager.Rd new file mode 100644 index 0000000..614f4fd --- /dev/null +++ b/man/tab_multi_manager.Rd @@ -0,0 +1,114 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/multitable.R +\name{tab_multi_manager} +\alias{tab_multi_manager} +\title{Manages the secondary secret of a list of tables} +\usage{ +tab_multi_manager( + list_tables, + list_explanatory_vars, + dir_name = NULL, + hrc = NULL, + totcode = "total", + value = "value", + freq = "freq", + secret_var = "is_secret_prim", + cost_var = NULL, + func_to_call = "tab_rtauargus2", + ip_start = 10, + ip_end = 0, + num_iter_max = 1000, + ... +) +} +\arguments{ +\item{list_tables}{named list of dataframes representing the tables to protect} + +\item{list_explanatory_vars}{named list of character vectors of explanatory variables of each table mentionned in list_tables. Names of the list are the same as of the list of tables.} + +\item{dir_name}{character, directory where to save tauargus files} + +\item{hrc}{named character vector, indicated the .hrc file's path of each hierarchical variables. The names of the vector are the names of the corresponding explanatory variable.} + +\item{totcode}{character vector: either a one length vector if all explanatory variable has the same total code (default to "Total") or a named character vector detailing the total code for each explanatory variable.} + +\item{value}{character : name of the response variable in the tables (mandatory)} + +\item{freq}{character: name of the frequency variable in the tables (mandatory)} + +\item{secret_var}{character: name of the boolean variable indicating if the cell doesn't respect the primary rules (apriori) - mandatory} + +\item{cost_var}{character: name of the cost variable (default to NULL)} + +\item{func_to_call}{character: name of the function to use to apply the secret (calling tau-argus). By default, the function is \code{tab_rtauargus2}} + +\item{ip_start}{integer: Interval protection level to apply at first treatment of each table} + +\item{ip_end}{integer: Interval protection level to apply at other treatments} + +\item{num_iter_max}{integer: Maximum of treatments to do on each table} + +\item{...}{other arguments of func_to_call} +} +\value{ +original list of tables. Secret Results of each iteration is added to each table. +For example, the result of first iteration is called 'is_secret_1' in each table. +It's a boolean variable, whether the cell has to be masked or not. +} +\description{ +Manages the secondary secret of a list of tables +} +\examples{ +library(rtauargus) +library(dplyr) +data(turnover_act_size) +data(turnover_act_cj) +data(activity_corr_table) + +#0-Making hrc file of business sectors ---- +hrc_file_activity <- activity_corr_table \%>\% + write_hrc2(file_name = "hrc/activity") + +#1-Prepare data ---- +#Indicate whether each cell complies with the primary rules +#Boolean variable created is TRUE if the cell doesn't comply. +#Here the frequency rule is freq in (0;3) +#and the dominance rule is NK(1,85) +list_data_2_tabs <- list( + act_size = turnover_act_size, + act_cj = turnover_act_cj +) \%>\% +purrr::map( + function(df){ + df \%>\% + mutate( + is_secret_freq = N_OBS > 0 & N_OBS < 3, + is_secret_dom = ifelse(MAX == 0, FALSE, MAX/TOT>0.85), + is_secret_prim = is_secret_freq | is_secret_dom + ) + } +) +\dontrun{ +options( + rtauargus.tauargus_exe = + "Y:/Logiciels/TauArgus/TauArgus4.2.2b1/TauArgus.exe" +) +res_1 <- tab_multi_manager( + list_tables = list_data_2_tabs, + list_explanatory_vars = list( + act_size = c("ACTIVITY", "SIZE"), + act_cj = c("ACTIVITY", "CJ") + ), + hrc = c(ACTIVITY = hrc_file_activity), + dir_name = "tauargus_files", + value = "TOT", + freq = "N_OBS", + secret_var = "is_secret_prim", + totcode = "Total" +) +} + +} +\seealso{ +\code{tab_rtauargus2} +} diff --git a/man/tab_rtauargus.Rd b/man/tab_rtauargus.Rd index 126b6a7..9de2eeb 100644 --- a/man/tab_rtauargus.Rd +++ b/man/tab_rtauargus.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/tab_rtauargus.R \name{tab_rtauargus} \alias{tab_rtauargus} -\title{Title} +\title{All in once for tabular} \usage{ tab_rtauargus( tabular, @@ -133,34 +133,58 @@ to dominance rule, "D" for secondary secret and "V" for no secret cell. If output_type doesn't equal to 4, then the raw result from tau-argus is returned. } \description{ -Title +All in once for tabular } -\details{ - +\section{Standardization of explanatory variables and hierarchies}{ + + +The two boolean arguments \code{unif_hrc} and \code{unif_expl} are useful to +prevent some common errors in using Tau-Argus. Indeed, Tau-Argus needs that, +within a same level of a hierarchy, the labels have the same number of +characters. When the two arguments are set to TRUE, \code{tab_rtauargus} +standardizes the explanatory variables to prevent this issue. +For hierarchical explanatory variables (explanatory variables associated to +a hrc file) are then modified in the tabular data and an another hrc file is +created to be relevant with the tabular. In the output, these modifications +are removed. For non hierarchical explanatory variables, +only the tabular is modified. } + \examples{ -#DON'T RUN +\dontrun{ library(dplyr) -tabular_leg <- table_legumes_sp \%>\% mutate(n_obs = round(n_obs)) \%>\% -select(ACTIVITY, treff, type_leg, tot, n_obs, max, is_secret_prim) +data(turnover_act_size) + +# Prepare data with primary secret ---- +turnover_act_size <- turnover_act_size \%>\% + mutate( + is_secret_freq = N_OBS > 0 & N_OBS < 3, + is_secret_dom = ifelse(MAX == 0, FALSE, MAX/TOT>0.85), + is_secret_prim = is_secret_freq | is_secret_dom + ) + +# Make hrc file of business sectors ---- +data(activity_corr_table) +hrc_file_activity <- activity_corr_table \%>\% + write_hrc2(file_name = "hrc/activity") + +# Compute the secondary secret ---- +options( + rtauargus.tauargus_exe = + "Y:/Logiciels/TauArgus/TauArgus4.2.2b1/TauArgus.exe" +) + res <- tab_rtauargus( -tabular = tabular_leg, -files_name = "legumes_rouges", -dir_name = "tauargus_files", -explanatory_vars = c("ACTIVITY", "treff", "type_leg"), -hrc = c(ACTIVITY = "legumes.hrc"), -totcode = c(ACTIVITY = "Ensemble", treff = "Ensemble", type_leg="rouges"), -secret_var = "is_secret_prim", -value = "tot", -freq = "n_obs", -output_type = "4", -output_options = "", -is_tabular = TRUE, -show_batch_console = FALSE, -import = FALSE, -separator = ",", -verbose = FALSE, -unif_hrc = TRUE, -unif_expl = TRUE + tabular = turnover_act_size, + files_name = "turn_act_size", + dir_name = "tauargus_files", + explanatory_vars = c("ACTIVITY", "SIZE"), + hrc = c(ACTIVITY = hrc_file_activity), + totcode = c(ACTIVITY = "Total", SIZE = "Total"), + secret_var = "is_secret_prim", + value = "TOT", + freq = "N_OBS", + verbose = FALSE ) } +} diff --git a/man/tab_rtauargus2.Rd b/man/tab_rtauargus2.Rd new file mode 100644 index 0000000..6b9ff4b --- /dev/null +++ b/man/tab_rtauargus2.Rd @@ -0,0 +1,135 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/tab_rtauargus.R +\name{tab_rtauargus2} +\alias{tab_rtauargus2} +\title{Wrapper of tab_rtauargus adapted for \code{tab_multi_manager} function.} +\usage{ +tab_rtauargus2( + tabular, + files_name = NULL, + dir_name = NULL, + explanatory_vars, + totcode, + hrc = NULL, + secret_var = NULL, + cost_var = NULL, + value = "value", + freq = "freq", + ip = 10, + suppress = "MOD(1,5,1,0,0)", + ... +) +} +\arguments{ +\item{tabular}{[\strong{obligatoire/mandatory}] +data.frame which contains the tabulated data and +an additional boolean variable that indicates the primary secret of type boolean \cr +data.frame contenant les données tabulées et +une variable supplémentaire indiquant le secret primaire de type booléen} + +\item{files_name}{string used to name all the files needed to process. +All files will have the same name, only their extension will be different.} + +\item{dir_name}{string indicated the path of the directory in which to save +all the files (.rda, .hst, .txt, .arb, .csv) generated by the function.} + +\item{explanatory_vars}{[\strong{obligatoire/mandatory}] Vector of explanatory variables \cr +Variables catégorielles, sous forme de vecteurs \cr +Example : \code{c("A21", "TREFF", "REG")} +table crossing \code{A21} x \code{TREFF} x \code{REG}} + +\item{totcode}{Code(s) which represent the total of a categorical variable +(see section 'Specific parameters' for this parameter's syntax). +If unspecified for a variable(neither by default nor explicitly) +it will be set to \code{rtauargus.totcode}. \cr +(Code(s) pour le total d'une variable catégorielle (voir +section 'Specific parameters' pour la syntaxe de ce paramètre). Les +variables non spécifiées (ni par défaut, ni explicitement) se verront +attribuer la valeur de \code{rtauargus.totcode}.)#'} + +\item{hrc}{Informations of hierarchical variables (see section +'Hierarchical variables'). \cr +(Informations sur les variables hiérarchiques (voir section +'Hierarchical variables').)#'} + +\item{secret_var}{Boolean variable which give the primary secret : equal to +"TRUE" if a cell is concerned by the primary secret,"FALSE" otherwise. +will be exported in the apriori file \cr +(Variable indiquant le secret primaire de type booléen: +prend la valeur "TRUE" quand les cellules du tableau doivent être masquées +par le secret primaire, "FALSE" sinon. Permet de créer un fichier d'apriori)} + +\item{cost_var}{Numeric variable allow to change the cost suppression of a cell +for secondary suppression, it's the value of the cell by default, can be +specified for each cell, fill with NA if the cost doesn't need to be changed +for all cells \cr +Variable numeric qui permet de changer la coût de suppression d'une cellule, +pris en compte dans les algorithmes de secret secondaire.Par défaut le coût +correspond à la valeur de la cellule. peut être spécifié pour chacune des cellules, +peut contenir des NA pour les coûts que l'on ne souhaite pas modifier} + +\item{value}{Name of the column containing the value of the cells. \cr +(Nom de la colonne contenant la valeur des cellules)} + +\item{freq}{Name of the column containing the cell frequency. \cr +(Nom de la colonne contenant les effectifs pour une cellule)#'} + +\item{ip}{Interval Protection Level (10 by default)} + +\item{suppress}{[\strong{obligatoire/mandatory}] +Algortihm for secondary suppression (Tau-Argus batch syntax), and the +parameters for it. +Algorithme de gestion du secret secondaire (syntaxe batch de Tau-Argus). +ainsi que les potentiels paramètres associés} + +\item{...}{Other arguments of \code{tab_rtauargus} function} +} +\value{ +The original tabular is returned with a new +column called Status, indicating the status of the cell coming from Tau-Argus : +"A" for a primary secret due to frequency rule, "B" for a primary secret due +to dominance rule, "D" for secondary secret and "V" for no secret cell. +} +\description{ +Wrapper of tab_rtauargus adapted for \code{tab_multi_manager} function. +} +\examples{ +\dontrun{ +library(dplyr) +data(turnover_act_size) + +# Prepare data with primary secret ---- +turnover_act_size <- turnover_act_size \%>\% + mutate( + is_secret_freq = N_OBS > 0 & N_OBS < 3, + is_secret_dom = ifelse(MAX == 0, FALSE, MAX/TOT>0.85), + is_secret_prim = is_secret_freq | is_secret_dom + ) + +# Make hrc file of business sectors ---- +data(activity_corr_table) +hrc_file_activity <- activity_corr_table \%>\% + write_hrc2(file_name = "hrc/activity") + +# Compute the secondary secret ---- +options( + rtauargus.tauargus_exe = + "Y:/Logiciels/TauArgus/TauArgus4.2.2b1/TauArgus.exe" +) + +res <- tab_rtauargus2( + tabular = turnover_act_size, + files_name = "turn_act_size", + dir_name = "tauargus_files", + explanatory_vars = c("ACTIVITY", "SIZE"), + hrc = c(ACTIVITY = hrc_file_activity), + totcode = c(ACTIVITY = "Total", SIZE = "Total"), + secret_var = "is_secret_prim", + value = "TOT", + freq = "N_OBS" +) +} +} +\seealso{ +\code{tab_rtauargus} +} diff --git a/man/turnover_act_cj.Rd b/man/turnover_act_cj.Rd new file mode 100644 index 0000000..99e22a7 --- /dev/null +++ b/man/turnover_act_cj.Rd @@ -0,0 +1,28 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/data.R +\docType{data} +\name{turnover_act_cj} +\alias{turnover_act_cj} +\title{Turnover broken down by business sector and type of companies (fake values).} +\format{ +A tibble/data frame with 406 rows and 5 variables: +\describe{ + \item{ACTIVITY}{business sector, hierarchical variables with three levels described + in the activity_corr_table dataset. The root is noted "Total"} + \item{CJ}{Type of companies (3 categories + overall category "Total")} + \item{N_OBS}{Frequency, number of companies} + \item{TOT}{turnover} + \item{MAX}{turnover of the company which contributes the most to the cell.} +} +} +\usage{ +turnover_act_cj +} +\description{ +A tabular dataset containing the turnover broken down by Business sector +and Type of companies. Useful for playing with tab_ functions. +} +\seealso{ +activity_corr_table +} +\keyword{datasets} diff --git a/man/turnover_act_size.Rd b/man/turnover_act_size.Rd new file mode 100644 index 0000000..a4f9f98 --- /dev/null +++ b/man/turnover_act_size.Rd @@ -0,0 +1,29 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/data.R +\docType{data} +\name{turnover_act_size} +\alias{turnover_act_size} +\title{Turnover broken down by business sector and size of French companies (fake values).} +\format{ +A tibble/data frame with 414 rows and 5 variables: +\describe{ + \item{ACTIVITY}{business sector, hierarchical variables with three levels described + in the activity_corr_table dataset. The root is noted "Total"} + \item{SIZE}{size of the companies (Number of employees in three categories + + overall category "Total")} + \item{N_OBS}{Frequency, number of companies} + \item{TOT}{turnover value in euros} + \item{MAX}{turnover of the company which contributes the most to the cell.} +} +} +\usage{ +turnover_act_size +} +\description{ +A tabular dataset containing the turnover broken down by Business sector sector +and Size of companies. Useful for playing with tab_ functions. +} +\seealso{ +activity_corr_table +} +\keyword{datasets} diff --git a/man/turnover_nuts_cj.Rd b/man/turnover_nuts_cj.Rd new file mode 100644 index 0000000..150d8b2 --- /dev/null +++ b/man/turnover_nuts_cj.Rd @@ -0,0 +1,29 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/data.R +\docType{data} +\name{turnover_nuts_cj} +\alias{turnover_nuts_cj} +\title{Turnover broken down by NUTS and size of French companies (fake values).} +\format{ +A tibble/data frame with 452 rows and 5 variables: +\describe{ + \item{NUTS}{nuts - european denomination of administrative levels. + Hierarchical variables with two levels (nuts2 and nuts3) described + in the nuts23_fr_corr_table dataset. The root is noted "Total"} + \item{CJ}{Type of companies (3 categories + overall category "Total")} + \item{N_OBS}{Frequency, number of companies} + \item{TOT}{turnover value in euros} + \item{MAX}{turnover of the company which contributes the most to the cell.} +} +} +\usage{ +turnover_nuts_cj +} +\description{ +A tabular dataset containing the turnover broken down by NUTS geographical localisation +and Type of companies. Useful for playing with tab_ functions. +} +\seealso{ +nuts23_fr_corr_table +} +\keyword{datasets} diff --git a/man/turnover_nuts_size.Rd b/man/turnover_nuts_size.Rd new file mode 100644 index 0000000..15b10ea --- /dev/null +++ b/man/turnover_nuts_size.Rd @@ -0,0 +1,30 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/data.R +\docType{data} +\name{turnover_nuts_size} +\alias{turnover_nuts_size} +\title{Turnover broken down by NUTS and size of French companies (fake values).} +\format{ +A tibble/data frame with 460 rows and 5 variables: +\describe{ + \item{NUTS}{nuts - european denomination of administrative levels. + Hierarchical variables with two levels (nuts2 and nuts3) described + in the nuts23_fr_corr_table dataset. The root is noted "Total"} + \item{SIZE}{size of the companies (Number of employees in three categories + + overall category "Total")} + \item{N_OBS}{Frequency, number of companies} + \item{TOT}{turnover value in euros} + \item{MAX}{turnover of the company which contributes the most to the cell.} +} +} +\usage{ +turnover_nuts_size +} +\description{ +A tabular dataset containing the turnover broken down by NUTS geographical localisation +and Size of companies. Useful for playing with tab_ functions. +} +\seealso{ +nuts23_fr_corr_table +} +\keyword{datasets} diff --git a/man/write_hrc2.Rd b/man/write_hrc2.Rd index 6ee9a3f..07eb090 100644 --- a/man/write_hrc2.Rd +++ b/man/write_hrc2.Rd @@ -6,8 +6,7 @@ \usage{ write_hrc2( corr_table, - output_name = NULL, - dir_name = NULL, + file_name = NULL, sort_table = FALSE, rev = FALSE, hier_lead_string = getOption("rtauargus.hierleadstring"), @@ -16,19 +15,15 @@ write_hrc2( ) } \arguments{ -\item{corr_table}{Data frame. Correspondence table, from most aggregated to most detailed +\item{corr_table}{Data frame. Correspondence table, from most aggregated level to most detailed one \cr -Table de correspondance, du plus agrégé au plus fin} +Table de correspondance, du niveau le plus agrégé au niveau le plus fin} -\item{output_name}{character string. Name for the output file (with no -extension) ; default is set to the same name as the correspondence table +\item{file_name}{character string. Name for the output file (with .hrc extension or not). +If NULL (default), file_name is set to the same name as the correspondence table \cr -Nom du fichier en sortie (sans extension) ; par défaut, -identique au nom de la table de correspondance} - -\item{dir_name}{character string. Directory name for the hrc file -\cr -Nom du répertoire dans lequel écrire le fichier hrc} +Nom du fichier en sortie (avec ou sans l'extension .hrc) ; Si NULL (par défaut), +le nom du fichier sera identique au nom de la table de correspondance.} \item{sort_table}{boolean. If TRUE, table will be sorted beforehand. (default to FALSE)\cr @@ -38,7 +33,8 @@ Si TRUE, la table sera triée avant traitement. (défaut à FALSE)} Si TRUE, inverse l'ordre des colonnes.} \item{hier_lead_string}{character. (Single) character indicating the -hierarchy depth in the .hrc file +hierarchy depth in the .hrc file. By default, the value is set to the current +value mentionned in the package options (i.e. "@" at the package startup). \cr Caractère unique repérant le niveau de profondeur dans le .hrc} @@ -242,10 +238,12 @@ If relevant, you could fill in with the value of the previous column} # Exemple standard. La table sera écrite dans votre répertoire de travail. astral <- data.frame( type = c("planet", "planet", "star", "star", "star", "other", "other"), - details = c("telluric", "gasgiant", "bluestar", "whitedwarf", "reddwarf", "blackhole", "pulsar") + details = c( + "telluric", "gasgiant", "bluestar", "whitedwarf", + "reddwarf", "blackhole", "pulsar") ) -path <- write_hrc2(astral, hier_lead_string = "@") -read.table(path) +path <- write_hrc2(astral) +\dontrun{read.table(path)} # Note that line order was changed ('other' comes before 'planet'), to no # consequence whatsoever for Tau-Argus. # Remarque : l'ordre des lignes a été modifié ('other' arrive avant 'planet'), @@ -254,31 +252,35 @@ read.table(path) # Wrong column order: # Mauvais ordonnancement des colonnes : astral_inv <- data.frame( - details = c("telluric", "gasgiant", "bluestar", "whitedwarf", "reddwarf", "blackhole", "pulsar"), - type = c("planet", "planet", "star", "star", "star", "other", "other") + details = c( + "telluric", "gasgiant", "bluestar", "whitedwarf", + "reddwarf", "blackhole", "pulsar"), + type = c("planet", "planet", "star", "star", "star", "other", "other") ) -path <- write_hrc2(astral_inv, hier_lead_string = "@") -read.table(path) +path <- write_hrc2(astral_inv) +\dontrun{read.table(path)} # Because of the inverted order, everything is written backwards : planet is a # subtype of gasgiant, etc. # À cause de l'inversion des colonnes, tout est écrit à l'envers : planet est # devenu une sous-catégorie de gasgiant, par exemple. # Correction : -path <- write_hrc2(astral_inv, rev = TRUE, hier_lead_string = "@") -read.table(path) +path <- write_hrc2(astral_inv, rev = TRUE) +\dontrun{read.table(path)} # 2.1 Sparse case # Cas creux astral_sparse <- data.frame( type = c("planet", NA, "star", NA, NA, "other", NA), - details = c("telluric", "gasgiant", "bluestar", "whitedwarf", "reddwarf", "blackhole", "pulsar") + details = c( + "telluric", "gasgiant", "bluestar", "whitedwarf", + "reddwarf", "blackhole", "pulsar") ) # NAs in general are risky, but, in this case, the function works well. -# Les valeurs manquantes causent un risque, mais, dans ce genre de cas, la fonction -a le comportement attendu. -path <- write_hrc2(astral_sparse, hier_lead_string = "@") -read.table(path) +# Les valeurs manquantes causent un risque, mais, dans ce genre de cas, +# la fonction a le comportement attendu. +path <- write_hrc2(astral_sparse) +\dontrun{read.table(path)} # 2.2 Non-uniform depth # Hiérarchie non-uniforme @@ -288,15 +290,17 @@ astral_nu <- data.frame( ) # The following code will generate an error # (see section Details about correspondence table & .hrc) -path <- write_hrc2(astral_nu, hier_lead_string = "@") -To fix the issue, you have to fill in the NAs beforehand. +\dontrun{ +path <- write_hrc2(astral_nu) +} +#To fix the issue, you have to fill in the NAs beforehand. astral_nu_fill <- data.frame( type = c("planet", "planet", "star", "other", "other"), details = c("telluric", "gasgiant", "star", "blackhole", "pulsar") ) # The following code will work -path <- write_hrc2(astral_nu_fill, hier_lead_string = "@") -read.table(path) +path <- write_hrc2(astral_nu_fill) +\dontrun{read.table(path)} } From 05b4d2783341168aaf657ad98d88f3a4954b2e51 Mon Sep 17 00:00:00 2001 From: julienjamme Date: Wed, 24 Aug 2022 23:27:25 +0200 Subject: [PATCH 055/107] maj description et namespace --- DESCRIPTION | 6 +++--- NAMESPACE | 2 ++ 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 83a1d5c..5f72cf6 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -44,11 +44,11 @@ Authors@R: c( role = "cph" ) ) -Description: Creates all the files required by Tau-Argus, runs Tau-Argus and fetches the result. +Description: Protects tables by calling Tau-Argus software from R. License: MIT + file LICENSE Encoding: UTF-8 LazyData: true RoxygenNote: 7.1.2 VignetteBuilder: knitr -URL: http://outilsconfidentialite.gitlab-pages.insee.fr/rtauargus, https://gitlab.insee.fr/outilsconfidentialite/rtauargus -BugReports: https://gitlab.insee.fr/outilsconfidentialite/rtauargus/-/issues +URL: https://github.com/inseefrlab/rtauargus, http://outilsconfidentialite.gitlab-pages.insee.fr/rtauargus, https://gitlab.insee.fr/outilsconfidentialite/rtauargus +BugReports: https://github.com/inseefrlab/rtauargus/issues, https://gitlab.insee.fr/outilsconfidentialite/rtauargus/-/issues diff --git a/NAMESPACE b/NAMESPACE index 22bb6e2..886e19b 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -9,8 +9,10 @@ export(rtauargus_options) export(rtauargus_plus) export(run_arb) export(tab_arb) +export(tab_multi_manager) export(tab_rda) export(tab_rtauargus) +export(tab_rtauargus2) export(tauargus_info) export(write_hrc) export(write_hrc2) From 4c37740c97256206ddf1d1ee91f95613e5d5c249 Mon Sep 17 00:00:00 2001 From: julienjamme Date: Wed, 24 Aug 2022 23:28:41 +0200 Subject: [PATCH 056/107] maj tests multitable --- tests_multitable/test_multitable.R | 30 ++++++++++++++++++++++++++++-- 1 file changed, 28 insertions(+), 2 deletions(-) diff --git a/tests_multitable/test_multitable.R b/tests_multitable/test_multitable.R index e41215c..dfdf58c 100644 --- a/tests_multitable/test_multitable.R +++ b/tests_multitable/test_multitable.R @@ -18,6 +18,32 @@ options( "Y:/Logiciels/TauArgus/TauArgus4.2.2b1/TauArgus.exe" ) +# Ajout des tables au data/ du package +# nuts23_fr_corr_table <- corr_table_nuts23_fr %>% +# rename_with(toupper) +# +# usethis::use_data( +# turnover_act_size, +# turnover_act_cj, +# turnover_nuts_cj, +# turnover_nuts_size, +# nuts23_fr_corr_table, +# activity_corr_table, +# overwrite = TRUE +# ) +# +# purrr::walk( +# list( +# turnover_act_size, +# turnover_act_cj, +# turnover_nuts_cj, +# turnover_nuts_size, +# nuts23_fr_corr_table, +# activity_corr_table +# ), +# str +# ) + # Test 1 ----- # Liste de deux tables liées @@ -37,7 +63,7 @@ list_data_2_tabs <- list( } ) -res_1 <- multi_linked_tables( +res_1 <- tab_multi_manager( list_tables = list_data_2_tabs, list_explanatory_vars = list( act_size = c("ACTIVITY", "SIZE"), @@ -84,7 +110,7 @@ list_data_4_tabs <- list( } ) -res_2 <- multi_linked_tables( +res_2 <- tab_multi_manager( list_tables = list_data_4_tabs, list_explanatory_vars = list( act_size = c("ACTIVITY", "SIZE"), act_cj = c("ACTIVITY", "CJ"), From fc876877a3f8605d9f1db3c245ea036b6d59cad3 Mon Sep 17 00:00:00 2001 From: Rastout Nathanael Date: Thu, 25 Aug 2022 15:39:02 +0200 Subject: [PATCH 057/107] Modification de la vignette de presentation --- vignettes/presentation_rtauargus.Rmd | 285 +++++++++++++++++++++++++++ 1 file changed, 285 insertions(+) create mode 100644 vignettes/presentation_rtauargus.Rmd diff --git a/vignettes/presentation_rtauargus.Rmd b/vignettes/presentation_rtauargus.Rmd new file mode 100644 index 0000000..16a5851 --- /dev/null +++ b/vignettes/presentation_rtauargus.Rmd @@ -0,0 +1,285 @@ +--- +title: "vignette_presentation" +output: html_document +date: '2022-08-25' +--- + +```{r setup, include=FALSE} +knitr::opts_chunk$set(echo = TRUE) +``` + + + +## Introduction + +### Presentation of the package + +The _rtauargus_ package offers an **R** interface for **τ-Argus**. +It allows to : + +- create inputs (asc, tab and rda files) from R data; +- generate the sequence of instructions to be executed in batch mode (arb file); +- launch a batch τ-Argus ; +- retrieve the results in R. + +The syntax of some of the arguments closely matches the _batch_ syntax of +τ-Argus. This allows a large number of functions to be used without +without multiplying the arguments of the functions. The package will also be able to adapt +more easily to possible modifications of the software (new +methods available, additional options...). +The syntax rules for writing batch are given in the τ-Argus reference manual and will be specified in a dedicated help section. + +The package was developed on the basis of open source versions of τ > -Argus (versions 4.1 and higher), in particular the latest version +> The package was developed on the basis of open source versions of τ-Argus (versions 4.1 and above), in particular the latest version available at the time of development (4.1.7). +> +> It is not compatible with version 3.5.**_ + +### Purpose of this document + +This document aims to explains how the main functionalities of the package, +using relatively simple examples. +A detailed documentation of any function (exhaustive list of arguments, +technical aspects...) is available via the dedicated help section. + +

+ summary ↑ +

+ + + + + +## Setup + +The following setup should be made before the first use (and no longer afterwards) + +### τ-Argus + +_rtauargus_ fonctions using τ-Argus requires that the software can be used from the workstation. +τ-Argus can be downloaded from the [website](https://research.cbs.nl/casc/tau.htm) from +CBS Statistics Netherlands + +### Dependancies + + _rtauargus_ requires some other R packages.Those are the dependecies to install. + + ```{r, echo = FALSE, comment = "•"} +imports <- packageDescription("rtauargus", fields = "Imports") +cat(gsub(", ", "\n", imports)) +``` +The package _rtauargus_ can be installed now. + +

+ sommaire ↑ +

+ + + + +## Quick Start + +This section explains how to perform a minimal configuration of the package and +how to apply suppressive methods in a single instruction. + +### Location of τ-Argus + +When loading the package, the console displays some information: + +```{r library} +library(rtauargus) +``` + +In particular, a plausible location for the τ-Argus software is +predefined. This can be changed for the duration of the R session. A +message indicates that this location is unknown, so it is changed: + +```{r opt_exe, include = FALSE} +loc_tauargus <- + # manual selection takes precedence over the proposed shortcuts + if (params$ta_lib_man != "?") { + params$ta_lib_man + } else { + unname(loc_tauargus[params$ta_lib]) + } +if (!file.exists(loc_tauargus)) { + # message affiché lorsque build échoue à cause absence Tau-Argus sur poste + stop( + "\n--- Logiciel Tau-Argus introuvable :", + "\n--- renseigner son emplacement dans la 1ere ligne", + "\n--- de 'vignettes/tauargus_exe.ini' (a creer si n'existe pas)", + "\n--- par exemple, D:/XKFZV9/TauArgus/TauArgus4.1.7b4/TauArgus.exe", + "\n " + ) +} + +options(rtauargus.tauargus_exe = loc_tauargus) +``` + +``` r +options(rtauargus.tauargus_exe = "`r loc_tauargus`") +``` + +With this small adjustment done, the package is ready to be used. + +> _Pour une configuration plus personnalisée, consulter la section +> options du package._ + +For the following demonstration, a fictitious table will be used: + +```{r data} +act_size <- + data.frame( + ACTIVITY = c("01","01","01","02","02","02","06","06","06","Total","Total","Total"), + SIZE = c("tr1","tr2","Total","tr1","tr2","Total","tr1","tr2","Total","tr1","tr2","Total"), + VAL = c(100,50,150,30,20,50,60,40,100,190,110,300), + N_OBS = c(10,5,15,2,5,7,8,6,14,20,16,36), + MAX = c(20,15,20,20,10,20,16,38,38,20,38,38) + ) +act_size +``` +### Function `tab_rtauargus` + +The function `tab_rtauargus` performs a full processing to protect the table and retrieves the results immediately in R. + +Completely abstracting from the inner workings of τ-Argus, it allows the entire processing to be made in a single instruction in fact, all intermediate files are created in a directory. + +`tab_rtauargus` takes as mandatory arguments : + +- a data.frame containing the table ; +- the directory for the outputs; +- the name for the outputs; +- the name of all explanatory variables; +- the way to apply primary suppression (explain later) +- the code for totals in the table + +All the arguments and their default options will be detailed ( where?). + +#### Minimalist example + +``` +rtauargus_ex1, eval = params$eval_ta} # a modifier + +ex1 <- tab_rtauargus(data, + dir_name = "my_dir", + files_name = "data", + explanatory_vars = c("ACTIVITY","SIZE"), + safety_rules = "FREQ(3,10)|NK(1,85)", + value = "VAL", + freq = "N_OBS", + maxscore = "MAX", + totcode = c(ACTIVITY="Total",SIZE="Total") +) +``` +For primary suppression here, we apply 2 rules : + +- The n-k dominance rule with n=1 and k = 85 +- The minimum frequency rule with n = 3 and a safety range of 10. + +To get the results for the dominance rule, we need to specify the largest contributor to each cell, the maxscore. + +#### Results + +All the files generated by the function will be written in the specified directory. +The default format for the protected table is csv but it can be changhed. +All the τ-Argus files (.tab, .rda, .arb, etc...) will be written too. + +#### Another example + +Two arguments will be added, a hierarchy file and one for the primary secret to apply. +The hierarchy file can be genrated through the function `write_hrc2` buy using a correspondence table. + +``` +write_hrc2(corr_table = activity_corr_table, + file_name = "act.hrc") +``` + +Then we will create the boolean to specify the primary secret for Tau-Argus. +Using the same rules as before. + +``` +act_size <- act_size df %>% + mutate( + is_secret_freq = N_OBS > 0 & N_OBS < 3, + is_secret_dom = ifelse(MAX == 0, FALSE, MAX/TOT>0.85), + is_secret_prim = is_secret_freq | is_secret_dom + ) +``` + +```{r rtauargus_ex2, eval = params$eval_ta} +ex2 <- tab_rtauargus(act_size, + dir_name = "Z:/", + files_name = "act_size", + explanatory_vars =c("ACTIVITY","SIZE"), + value = "TOT", + freq = "N_OBS", + secret_var = "is_secret_prim", + hrc = c(ACTIVITY = "act.hrc"), + totcode = c(ACTIVITY="Total",SIZE="Total"), + suppress = "OPT(1,5)" + ) +``` +Since the primary suppression was already specified, no need to use the arguments, +safety_rules and maxscore. +The algorithm for secondary suppression can be changed, the default is modular. + +#### Treating multiple linked tables + +The function `tab_multi_manager` can deal with a whole set of linked tables or not. +It performs secondary suppression with one table at a time and ensure that the common cells have the same status. +It is an iterating process, it performs secondary suppression with one table at a time. +When a common cell is concerned by secondary suppression it reverberate the secret on the tables that share this common cell. +The process ends when the secondary secret is consistent in every table. + +#### Example + +For this example, two tables will be used : + +- ACTIVITY x SIZE +- ACTIVITY x CJ + +Since the two table share one common explanatory variable, they can't be treated separately. + +Indicate whether each cell complies with the primary rules +Boolean variable created is TRUE if the cell doesn't comply. +Here the frequency rule is FREQ(3,10) +and the dominance rule is NK(1,85) + +``` +list_data_2_tabs <- list( + act_size = turnover_act_size, + act_cj = turnover_act_cj +) %>% +purrr::map( + function(df){ + df %>% + mutate( + is_secret_freq = N_OBS > 0 & N_OBS < 3, + is_secret_dom = ifelse(MAX == 0, FALSE, MAX/TOT>0.85), + is_secret_prim = is_secret_freq | is_secret_dom + ) + } +) +``` +Now that the primary secret has been specified for both tables, we can run the process. + +``` +res_1 <- tab_multi_manager( + list_tables = list_data_2_tabs, + list_explanatory_vars = list( + act_size = c("ACTIVITY", "SIZE"), + act_cj = c("ACTIVITY", "CJ") + ), + hrc = c(ACTIVITY = hrc_file_activity), + dir_name = "tauargus_files", + value = "TOT", + freq = "N_OBS", + secret_var = "is_secret_prim", + totcode = "Total" +) +``` + +The function uses tab_rtauargus with many default parameters that can be changed. +The tables needs to share the same column names for : +- value +- freq +- secret_var From cd66ac42341111b7ac47ed2d983c82364c6609a1 Mon Sep 17 00:00:00 2001 From: julienjamme Date: Fri, 26 Aug 2022 09:53:59 +0200 Subject: [PATCH 058/107] doc data --- R/data.R | 105 ++++++++++++++++++++++++++++++++++++++++++++++++++----- 1 file changed, 96 insertions(+), 9 deletions(-) diff --git a/R/data.R b/R/data.R index 2bbfa3d..5a30a4a 100644 --- a/R/data.R +++ b/R/data.R @@ -1,14 +1,101 @@ -#' Fake values of production of red vegetables by sector and size of companies. +#' Turnover broken down by business sector and size of French companies (fake values). #' -#' A tabluar dataset containing the turnover broken down by Activity +#' A tabular dataset containing the turnover broken down by Business sector sector #' and Size of companies. Useful for playing with tab_ functions. #' -#' @format A data frame with 1242 rows and 5 variables: +#' @format A tibble/data frame with 414 rows and 5 variables: #' \describe{ -#' \item{ACTIVITY}{activity, hierarchical variables} -#' \item{treff}{size of the companies (3 classes of number of employees)} -#' \item{n_obs}{Frequency, number of companies} -#' \item{tot}{turnover} -#' \item{max}{turnover of the company which contributes the most to the cell.} +#' \item{ACTIVITY}{business sector, hierarchical variables with three levels described +#' in the activity_corr_table dataset. The root is noted "Total"} +#' \item{SIZE}{size of the companies (Number of employees in three categories +#' + overall category "Total")} +#' \item{N_OBS}{Frequency, number of companies} +#' \item{TOT}{turnover value in euros} +#' \item{MAX}{turnover of the company which contributes the most to the cell.} #' } -"red_vegetables" +#' @seealso activity_corr_table +"turnover_act_size" + +#' Turnover broken down by business sector and type of companies (fake values). +#' +#' A tabular dataset containing the turnover broken down by Business sector +#' and Type of companies. Useful for playing with tab_ functions. +#' +#' @format A tibble/data frame with 406 rows and 5 variables: +#' \describe{ +#' \item{ACTIVITY}{business sector, hierarchical variables with three levels described +#' in the activity_corr_table dataset. The root is noted "Total"} +#' \item{CJ}{Type of companies (3 categories + overall category "Total")} +#' \item{N_OBS}{Frequency, number of companies} +#' \item{TOT}{turnover} +#' \item{MAX}{turnover of the company which contributes the most to the cell.} +#' } +#' @seealso activity_corr_table +"turnover_act_cj" + +#' Turnover broken down by NUTS and size of French companies (fake values). +#' +#' A tabular dataset containing the turnover broken down by NUTS geographical localisation +#' and Size of companies. Useful for playing with tab_ functions. +#' +#' @format A tibble/data frame with 460 rows and 5 variables: +#' \describe{ +#' \item{NUTS}{nuts - european denomination of administrative levels. +#' Hierarchical variables with two levels (nuts2 and nuts3) described +#' in the nuts23_fr_corr_table dataset. The root is noted "Total"} +#' \item{SIZE}{size of the companies (Number of employees in three categories +#' + overall category "Total")} +#' \item{N_OBS}{Frequency, number of companies} +#' \item{TOT}{turnover value in euros} +#' \item{MAX}{turnover of the company which contributes the most to the cell.} +#' } +#' @seealso nuts23_fr_corr_table +"turnover_nuts_size" + +#' Turnover broken down by NUTS and size of French companies (fake values). +#' +#' A tabular dataset containing the turnover broken down by NUTS geographical localisation +#' and Type of companies. Useful for playing with tab_ functions. +#' +#' @format A tibble/data frame with 452 rows and 5 variables: +#' \describe{ +#' \item{NUTS}{nuts - european denomination of administrative levels. +#' Hierarchical variables with two levels (nuts2 and nuts3) described +#' in the nuts23_fr_corr_table dataset. The root is noted "Total"} +#' \item{CJ}{Type of companies (3 categories + overall category "Total")} +#' \item{N_OBS}{Frequency, number of companies} +#' \item{TOT}{turnover value in euros} +#' \item{MAX}{turnover of the company which contributes the most to the cell.} +#' } +#' @seealso nuts23_fr_corr_table +"turnover_nuts_cj" + +#' Correspondence table describing the business sectors hierarchy. +#' +#' A dataset describing the nesting of three levels of business sectors, useful +#' when working with the ACTIVITY variables in the turnover_ datasets. +#' +#' @format A data frame with 92 rows and 3 variables: +#' \describe{ +#' \item{A10}{business sectors in 10 categories} +#' \item{A21}{business sectors in 21 categories} +#' \item{A88}{business sectors in 88 categories} +#' } +#' @details Use the \code{write_hrc2} function to create a .hrc file from this +#' correspondence table. +"activity_corr_table" + +#' Correspondence table describing the NUTS hierarchy. +#' +#' A dataset describing the nesting of NUTS2 and NUTS3 levels for Metropolitan France, useful +#' when working with the NUTS variables in the turnover_ datasets. +#' +#' @format A data frame with 92 rows and 3 variables: +#' \describe{ +#' \item{NUTS2}{NUTS2 levels in France - equivalent of French "Régions"} +#' \item{NUTS3}{NUTS3 levels in France - equivalent of French "Départements"} +#' \item{A88}{business sectors in 88 categories} +#' } +#' @details Use the \code{write_hrc2} function to create a .hrc file from this +#' correspondence table. +"nuts23_fr_corr_table" From 0e0d7a9f9caeec345eb5e033d1ff12ad98250201 Mon Sep 17 00:00:00 2001 From: julienjamme Date: Fri, 26 Aug 2022 10:27:27 +0200 Subject: [PATCH 059/107] modif totcode par defaut --- R/multitable.R | 2 +- R/tab_rtauargus.R | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/multitable.R b/R/multitable.R index 6972829..6c5e010 100644 --- a/R/multitable.R +++ b/R/multitable.R @@ -88,7 +88,7 @@ tab_multi_manager <- function( list_explanatory_vars, dir_name = NULL, hrc = NULL, - totcode = "total", + totcode = getOption("rtauargus.totcode"), value = "value", freq = "freq", secret_var = "is_secret_prim", diff --git a/R/tab_rtauargus.R b/R/tab_rtauargus.R index 17edbd9..e6bbc3a 100644 --- a/R/tab_rtauargus.R +++ b/R/tab_rtauargus.R @@ -114,7 +114,7 @@ tab_rtauargus <- function( files_name = NULL, dir_name = NULL, explanatory_vars, - totcode, + totcode = getOption("rtauargus.totcode"), hrc = NULL, secret_var = NULL, cost_var = NULL, From 41d7eb9691cb547adfd2fd31b33909c25340b5f4 Mon Sep 17 00:00:00 2001 From: julienjamme Date: Fri, 26 Aug 2022 12:25:21 +0200 Subject: [PATCH 060/107] enrich vignette --- vignettes/presentation_rtauargus.Rmd | 245 +++++++++++++++++---------- 1 file changed, 153 insertions(+), 92 deletions(-) diff --git a/vignettes/presentation_rtauargus.Rmd b/vignettes/presentation_rtauargus.Rmd index 16a5851..fd59d18 100644 --- a/vignettes/presentation_rtauargus.Rmd +++ b/vignettes/presentation_rtauargus.Rmd @@ -6,6 +6,7 @@ date: '2022-08-25' ```{r setup, include=FALSE} knitr::opts_chunk$set(echo = TRUE) +knitr::opts_knit$set(root.dir = getwd()) ``` @@ -24,22 +25,21 @@ It allows to : The syntax of some of the arguments closely matches the _batch_ syntax of τ-Argus. This allows a large number of functions to be used without -without multiplying the arguments of the functions. The package will also be able to adapt +multiplying the arguments of the functions. The package will also be able to adapt more easily to possible modifications of the software (new methods available, additional options...). The syntax rules for writing batch are given in the τ-Argus reference manual and will be specified in a dedicated help section. -The package was developed on the basis of open source versions of τ > -Argus (versions 4.1 and higher), in particular the latest version > The package was developed on the basis of open source versions of τ-Argus (versions 4.1 and above), in particular the latest version available at the time of development (4.1.7). > > It is not compatible with version 3.5.**_ ### Purpose of this document -This document aims to explains how the main functionalities of the package, +This document aims to explain the main functionalities of the package, using relatively simple examples. A detailed documentation of any function (exhaustive list of arguments, -technical aspects...) is available via the dedicated help section. +technical aspects...) is available *via* the dedicated help section.

summary ↑ @@ -56,12 +56,12 @@ The following setup should be made before the first use (and no longer afterward ### τ-Argus _rtauargus_ fonctions using τ-Argus requires that the software can be used from the workstation. -τ-Argus can be downloaded from the [website](https://research.cbs.nl/casc/tau.htm) from -CBS Statistics Netherlands +The github repository of τ-Argus is here: [https://github.com/sdcTools/tauargus](https://github.com/sdcTools/tauargus). +The latest releases can be downloaded here: [https://github.com/sdcTools/tauargus/releases](https://github.com/sdcTools/tauargus/releases). -### Dependancies +### Dependencies - _rtauargus_ requires some other R packages.Those are the dependecies to install. + _rtauargus_ requires some other R packages.Those are the dependencies to install. ```{r, echo = FALSE, comment = "•"} imports <- packageDescription("rtauargus", fields = "Imports") @@ -90,39 +90,37 @@ library(rtauargus) ``` In particular, a plausible location for the τ-Argus software is -predefined. This can be changed for the duration of the R session. A -message indicates that this location is unknown, so it is changed: +predefined. This can be changed for the duration of the R session, as follows: ```{r opt_exe, include = FALSE} -loc_tauargus <- - # manual selection takes precedence over the proposed shortcuts - if (params$ta_lib_man != "?") { - params$ta_lib_man - } else { - unname(loc_tauargus[params$ta_lib]) - } -if (!file.exists(loc_tauargus)) { - # message affiché lorsque build échoue à cause absence Tau-Argus sur poste - stop( - "\n--- Logiciel Tau-Argus introuvable :", - "\n--- renseigner son emplacement dans la 1ere ligne", - "\n--- de 'vignettes/tauargus_exe.ini' (a creer si n'existe pas)", - "\n--- par exemple, D:/XKFZV9/TauArgus/TauArgus4.1.7b4/TauArgus.exe", - "\n " - ) -} +loc_tauargus <- "Y:/Logiciels/TauArgus/TauArgus4.2.2b1/TauArgus.exe" options(rtauargus.tauargus_exe = loc_tauargus) ``` -``` r -options(rtauargus.tauargus_exe = "`r loc_tauargus`") -``` With this small adjustment done, the package is ready to be used. -> _Pour une configuration plus personnalisée, consulter la section -> options du package._ +> _For a more customized configuration, see the specific vignettes_ + +### Using `tab_rtauargus` function + +The `tab_rtauargus` function performs a full processing to protect the table and retrieves the results immediately in R. + +Completely abstracting from the inner workings of τ-Argus, it allows the entire processing to be made in a single instruction in fact, all intermediate files are created in a local directory. + +`tab_rtauargus` requires the following arguments : + +- `tabular`: a data.frame containing the table ; +- `dir_name`: the directory for the outputs; +- `files_name`: all the τ-Argus files will be named with it (different extensions); +- `explanatory_vars`: the name of all explanatory variables in `tabular`; +- `secret_var` or `safety_rules`: the way to apply primary suppression (explain later) +- `totcode`: the code for total of each explanatory variable in `tabular` + +All the arguments and their default options will be detailed ( where?). + +#### Minimalist example For the following demonstration, a fictitious table will be used: @@ -137,90 +135,153 @@ act_size <- ) act_size ``` -### Function `tab_rtauargus` -The function `tab_rtauargus` performs a full processing to protect the table and retrieves the results immediately in R. +As primary rules, we use the two following ones: -Completely abstracting from the inner workings of τ-Argus, it allows the entire processing to be made in a single instruction in fact, all intermediate files are created in a directory. +- The n-k dominance rule with n=1 and k = 85 +- The minimum frequency rule with n = 3 and a safety range of 10. -`tab_rtauargus` takes as mandatory arguments : +To get the results for the dominance rule, we need to specify the largest contributor to each cell, corresponding to the `MAX` variable in the tabular data. + +```{r rtauargus_ex1} +ex1 <- tab_rtauargus( + act_size, + dir_name = "tauargus_files", + files_name = "ex1", + explanatory_vars = c("ACTIVITY","SIZE"), + safety_rules = "FREQ(3,10)|NK(1,85)", + value = "VAL", + freq = "N_OBS", + maxscore = "MAX", + totcode = c(ACTIVITY="Total",SIZE="Total") +) +``` -- a data.frame containing the table ; -- the directory for the outputs; -- the name for the outputs; -- the name of all explanatory variables; -- the way to apply primary suppression (explain later) -- the code for totals in the table +By default, the function displays in the console the logbook content in which +user can read all steps run by τ-Argus. This can be retrieved in the logbook.txt file. With `verbose = FALSE`, the function can be silenced. -All the arguments and their default options will be detailed ( where?). +By default, the function returns the original dataset with one variable more, +called `Status`, direct result of τ-Argus describing the status of each cell +as follows: -#### Minimalist example +-`A`: primary secret cell because of frequency rule; +-`B`: primary secret cell because of dominance rule (1st contributor); +-`C`: primary secret cell because of frequency rule (more contributors in case when n>1); +-`D`: secondary secret cell; +-`V`: valid cells - no need to mask. +```{r} +ex1 ``` -rtauargus_ex1, eval = params$eval_ta} # a modifier - -ex1 <- tab_rtauargus(data, - dir_name = "my_dir", - files_name = "data", - explanatory_vars = c("ACTIVITY","SIZE"), - safety_rules = "FREQ(3,10)|NK(1,85)", - value = "VAL", - freq = "N_OBS", - maxscore = "MAX", - totcode = c(ACTIVITY="Total",SIZE="Total") -) -``` -For primary suppression here, we apply 2 rules : -- The n-k dominance rule with n=1 and k = 85 -- The minimum frequency rule with n = 3 and a safety range of 10. -To get the results for the dominance rule, we need to specify the largest contributor to each cell, the maxscore. +All the files generated by the function are written in the specified directory +(`dir_name` argument). The default format for the protected table is csv but it can be changed. All the τ-Argus files (.tab, .rda, .arb and .txt) will be written too. +To go further, you can consult the latest version of the τ-Argus manual is downloadable here: +[https://research.cbs.nl/casc/Software/TauManualV4.1.pdf](https://research.cbs.nl/casc/Software/TauManualV4.1.pdf). -#### Results -All the files generated by the function will be written in the specified directory. -The default format for the protected table is csv but it can be changhed. -All the τ-Argus files (.tab, .rda, .arb, etc...) will be written too. +#### Example with hierarchy and primary secret already done -#### Another example +##### Data -Two arguments will be added, a hierarchy file and one for the primary secret to apply. -The hierarchy file can be genrated through the function `write_hrc2` buy using a correspondence table. +For this example, we'd like to protect a table in which companies' turnover +is broken down by business sectors and size. To load the data, do: +```{r load_data} +data("turnover_act_size") ``` -write_hrc2(corr_table = activity_corr_table, - file_name = "act.hrc") + +```{r head_data} +head(turnover_act_size) ``` -Then we will create the boolean to specify the primary secret for Tau-Argus. -Using the same rules as before. +The meaning of each variable is: +-`ACTIVITY`: business sector, hierarchical variables with three levels described +in the `activity_corr_table` dataset. The root is noted "Total"; +-`SIZE`: size of the companies (Number of employees in three categories ++ overall category "Total"); +-`N_OBS`: Frequency, number of companies; +-`TOT`: turnover value in euros; +-`MAX`: turnover of the company which contributes the most to the cell. + +##### Hierarchy's file + +Before performing the `tab_rtauargus()` function, we have to prepare the hierarchical +information into the appropriate format for τ-Argus, *.i.e.* a `.hrc` file. +From a correspondence table, the `write_hrc2()` function does the job for you. + +Here, the correspondence table describes the nesting of the three levels of business +sectors, from the most aggregated to the least one: + +```{r} +data(activity_corr_table) +head(activity_corr_table) ``` -act_size <- act_size df %>% - mutate( - is_secret_freq = N_OBS > 0 & N_OBS < 3, - is_secret_dom = ifelse(MAX == 0, FALSE, MAX/TOT>0.85), - is_secret_prim = is_secret_freq | is_secret_dom - ) + + +```{r hierarchy} +write_hrc2( + corr_table = activity_corr_table, + file_name = "act.hrc" +) ``` -```{r rtauargus_ex2, eval = params$eval_ta} -ex2 <- tab_rtauargus(act_size, - dir_name = "Z:/", - files_name = "act_size", - explanatory_vars =c("ACTIVITY","SIZE"), - value = "TOT", - freq = "N_OBS", - secret_var = "is_secret_prim", - hrc = c(ACTIVITY = "act.hrc"), - totcode = c(ACTIVITY="Total",SIZE="Total"), - suppress = "OPT(1,5)" - ) +##### Primary secret + +In this example, we'll apply the primary secret ourselves, *i.e.* not with the +help of τ-Argus. So, the idea is to use τ-Argus with an apriori file. +For that purpose, we create a boolean variable to specify +which cells don't respect the primary secret rules. Using the same rules as before: + + +```{r prim_secret} +turnover_act_size <- turnover_act_size %>% + mutate( + is_secret_freq = N_OBS > 0 & N_OBS < 3, + is_secret_dom = MAX > TOT*0.85, + is_secret_prim = is_secret_freq | is_secret_dom + ) ``` + +##### Running τ-Argus + +Two arguments has to be added to the `tab_rtauargus()` function: + +-`secret_var`, indicating the name of the variable in `tabular` containing the +primary secret (apriori) information, +-`hrc`, indicating the name of the hierarchy file to use for `ACTIVITY` variable. + Since the primary suppression was already specified, no need to use the arguments, -safety_rules and maxscore. -The algorithm for secondary suppression can be changed, the default is modular. +`safety_rules` and `maxscore`. The first one is set by default to "MAN(10)", so +as to say that a 10% Interval Protection is applied. + +By default, `tab_rtauargus()` runs the Modular method to perform the secondary secret. Here, we choose to use the Optimal method by changing the `suppress` argument. + +```{r rtauargus_ex2} +ex2 <- tab_rtauargus( + turnover_act_size, + dir_name = "tauargus_files/", + files_name = "ex2", + explanatory_vars = c("ACTIVITY","SIZE"), + value = "TOT", + freq = "N_OBS", + secret_var = "is_secret_prim", + hrc = c(ACTIVITY = "act.hrc"), + totcode = c(ACTIVITY="Total",SIZE="Total"), + suppress = "OPT(1,5)", + verbose=FALSE +) +``` + +##### Result + +```{r} +str(ex2) +``` + + #### Treating multiple linked tables From a03f1dc1591582ee8a3f50286fe6bb10be911759 Mon Sep 17 00:00:00 2001 From: julienjamme Date: Fri, 26 Aug 2022 12:46:08 +0200 Subject: [PATCH 061/107] =?UTF-8?q?supprime=20warning=20sur=20la=20cr?= =?UTF-8?q?=C3=A9ation=20d'un=20dossier=20existant?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- R/run_arb.R | 69 +++++++++++++++++++++++++++-------------------------- R/tab_arb.R | 26 ++++++++++---------- R/tab_rda.R | 35 +++++++++++++-------------- 3 files changed, 66 insertions(+), 64 deletions(-) diff --git a/R/run_arb.R b/R/run_arb.R index 3ced0b4..2e2573f 100644 --- a/R/run_arb.R +++ b/R/run_arb.R @@ -31,7 +31,7 @@ #' @importFrom purrr transpose #' @importFrom dplyr %>% -specif_decompose <- function(specif) { +specif_decompose <- function(specif){ ## extrait les infos contenus dans instructions d'un batch ## pour par exemple les utiliser dans reimport des données @@ -70,7 +70,7 @@ specif_decompose <- function(specif) { } -write_decompose <- function(write_cmd) { +write_decompose <- function(write_cmd){ ## extrait les infos contenus dans instructions d'un batch ## pour par exemple les utiliser dans reimport des données @@ -92,7 +92,7 @@ write_decompose <- function(write_cmd) { } -apriori_decompose <- function(apriori_cmd) { +apriori_decompose <- function(apriori_cmd){ res <- NULL @@ -116,11 +116,11 @@ apriori_decompose <- function(apriori_cmd) { #Affiche le logbook complet dans la console si verbose = TRUE, sinon que les erreurs display_console <- function ( - verbose = FALSE, - logbook_file = NULL + verbose = FALSE, + logbook_file = NULL ){ - if (is.null(logbook_file)){ + if(is.null(logbook_file)){ stop("logbook_file not filled in ") } logbook<-(readLines(logbook_file)) @@ -138,7 +138,7 @@ display_console <- function ( dernier_logbook<-logbook_df[dernier_lancement:nrow(logbook_df),] - if (verbose){ + if(verbose){ writeLines(dernier_logbook) }else{ @@ -258,30 +258,31 @@ unquote <- function(s) sub("^[\"'](.+)[\"']$", "\\1", s) #' #' @export -run_arb <- function(arb_filename, - is_tabular = getOption("rtauargus.is_tabular"), - missing_dir = getOption("rtauargus.missing_dir"), - tauargus_exe = getOption("rtauargus.tauargus_exe"), - logbook = NULL, - show_batch_console = getOption("rtauargus.show_batch_console"), - verbose = TRUE, - import = getOption("rtauargus.import"), - - ...) { +run_arb <- function( + arb_filename, + is_tabular = getOption("rtauargus.is_tabular"), + missing_dir = getOption("rtauargus.missing_dir"), + tauargus_exe = getOption("rtauargus.tauargus_exe"), + logbook = NULL, + show_batch_console = getOption("rtauargus.show_batch_console"), + verbose = TRUE, + import = getOption("rtauargus.import"), + ... +){ # valeur par défaut du package si option vide ................ - if (is.null(missing_dir)) missing_dir <- op.rtauargus$rtauargus.missing_dir - if (is.null(tauargus_exe)) tauargus_exe <- op.rtauargus$rtauargus.tauargus_exe + if(is.null(missing_dir)) missing_dir <- op.rtauargus$rtauargus.missing_dir + if(is.null(tauargus_exe)) tauargus_exe <- op.rtauargus$rtauargus.tauargus_exe if(is.null(logbook)) logbook <- "logbook.txt" - if (is.null(show_batch_console)) { + if(is.null(show_batch_console)){ show_batch_console <- op.rtauargus$rtauargus.show_batch_console } - if (is.null(import)) import <- op.rtauargus$rtauargus.import + if(is.null(import)) import <- op.rtauargus$rtauargus.import # présence TauArgus.exe ...................................... - if (!file.exists(tauargus_exe)) { + if (!file.exists(tauargus_exe)){ stop( "Tau-Argus introuvable (", tauargus_exe, ")\n ", "renseigner le parametre tauargus_exe ou l'option rtauargus.tauargus_exe" @@ -290,7 +291,7 @@ run_arb <- function(arb_filename, # lecture contenu fichier arb pour vérifications ............. - if (!file.exists(arb_filename)) { + if (!file.exists(arb_filename)){ stop( "Fichier introuvable : ", arb_filename, "\n", "(utiliser `micro_arb` pour creer un fichier batch)" @@ -299,23 +300,23 @@ run_arb <- function(arb_filename, infos_arb <- arb_contents(arb_filename) # présence des fichiers (input) .............................. - if (is_tabular!= TRUE){ - if (!file.exists(infos_arb$openmicrodata)) { + if(is_tabular!= TRUE){ + if (!file.exists(infos_arb$openmicrodata)){ stop( "Fichier asc introuvable : ", infos_arb$openmicrodata, "\n", "(utiliser `micro_asc_rda` pour creer un fichier asc)" ) } } - if (!file.exists(infos_arb$openmetadata)) { + if(!file.exists(infos_arb$openmetadata)){ stop( "Fichier rda introuvable : ", infos_arb$openmetadata, "\n", "(utiliser `micro_asc_rda` pour creer un fichier rda)" ) } - if (!is.null(infos_arb$apriori)) { + if(!is.null(infos_arb$apriori)){ hst <- infos_arb$apriori$file - if (any(manq <- !file.exists(hst))) { + if(any(manq <- !file.exists(hst))){ stop( "Fichier(s) d'apriori introuvable(s) : ", paste(unique(hst[manq]), collapse = "\n") @@ -328,21 +329,21 @@ run_arb <- function(arb_filename, output_names <- infos_arb$writetable$output_names ouput_dirs <- dirname(output_names) - if (any(manq <- !dir.exists(ouput_dirs))) { + if(any(manq <- !dir.exists(ouput_dirs))){ missd <- unique(ouput_dirs[manq]) - if (missing_dir == "stop") { + if(missing_dir == "stop"){ stop( "\nDossiers introuvable(s) :\n ", paste(missd, collapse = "\n "), "\n(utiliser missing_dir = \"create\" ?)" ) - } else if (missing_dir == "create") { + }else if(missing_dir == "create"){ warning( "Dossier(s) cree(s) :\n ", paste(missd, collapse = "\n ") ) purrr::walk(missd, dir.create, recursive = TRUE) - } else { + }else { stop("'missing_dir' incorrect. Valeurs permises : \"stop\", \"create\".") } } @@ -361,7 +362,7 @@ run_arb <- function(arb_filename, rda_vars <- vars_micro_rda(infos_arb$openmetadata) vars_manq <- setdiff(used_vars, rda_vars) - if (length(vars_manq)) { + if(length(vars_manq)){ stop( "Variable(s) specifiee(s) absente(s) des metadonnees (rda) :\n ", paste(vars_manq, collapse = "\n ") @@ -393,6 +394,6 @@ run_arb <- function(arb_filename, ) display_console(verbose, logbook_file) - if (import) import(arb_filename) else invisible(NULL) + if(import) import(arb_filename) else invisible(NULL) } diff --git a/R/tab_arb.R b/R/tab_arb.R index 26e0f2d..bfa3126 100644 --- a/R/tab_arb.R +++ b/R/tab_arb.R @@ -200,18 +200,20 @@ tab_apriori_batch <- function(hst_names, sep = ',', ignore_err = 0 , exp_triv = #' } #' @export -tab_arb <- function(arb_filename = NULL, - tab_filename, - rda_filename = NULL, - hst_filename = NULL, - explanatory_vars, - value = getOption("rtauargus.response_var"), - safety_rules, - suppress, - output_names = NULL, - output_type = getOption("rtauargus.output_type"), - output_options = getOption("rtauargus.output_options"), - gointeractive = FALSE) { +tab_arb <- function( + arb_filename = NULL, + tab_filename, + rda_filename = NULL, + hst_filename = NULL, + explanatory_vars, + value = getOption("rtauargus.response_var"), + safety_rules, + suppress, + output_names = NULL, + output_type = getOption("rtauargus.output_type"), + output_options = getOption("rtauargus.output_options"), + gointeractive = FALSE +){ # valeur par défaut du package si option vide if (is.null(value)) value <- op.rtauargus$rtauargus.value diff --git a/R/tab_rda.R b/R/tab_rda.R index e5896ea..b2b1702 100644 --- a/R/tab_rda.R +++ b/R/tab_rda.R @@ -358,31 +358,30 @@ tab_rda <- function( #Gestion du chemin des fichiers name_rda <- basename(rda_filename) directory_rda <- stringr::str_replace(rda_filename, pattern = name_rda, replacement="") - if(!(dir.exists(directory_rda))) - {dir.create(directory_rda, recursive = TRUE)} + if(!(dir.exists(directory_rda))) dir.create(directory_rda, recursive = TRUE, showWarnings = FALSE) name_tab <- basename(tab_filename) directory_tab <- stringr::str_replace(tab_filename, pattern = name_tab, replacement="") - if(!(dir.exists(directory_tab))) - {dir.create(directory_tab, recursive = TRUE)} - - if ((!is.null(hst_filename)) | (!is.null(secret_var))|(!is.null(cost_var))){ - name_hst <- basename(hst_filename) - directory_hst <- stringr::str_replace(hst_filename, pattern = name_hst, replacement="") - if(!(dir.exists(directory_hst))) - {dir.create(directory_hst, recursive = TRUE)} + if(!(dir.exists(directory_tab))) dir.create(directory_tab, recursive = TRUE, showWarnings = FALSE) + + if((!is.null(hst_filename)) | (!is.null(secret_var))|(!is.null(cost_var))){ + name_hst <- basename(hst_filename) + directory_hst <- stringr::str_replace(hst_filename, pattern = name_hst, replacement="") + if(!(dir.exists(directory_hst))) dir.create(directory_hst, recursive = TRUE, showWarnings = FALSE) } # Controle sur le nombre de colonnes - col_tabular <- c(explanatory_vars, - secret_var, - cost_var, - value, - freq, - maxscore, - maxscore_2, - maxscore_3) + col_tabular <- c( + explanatory_vars, + secret_var, + cost_var, + value, + freq, + maxscore, + maxscore_2, + maxscore_3 + ) # if (length(tabular[1,]) != length(col_tabular)) # {warning("unspecified columns in table")} From ef0bd8a03250c2e77bf28dcfd7a0fac91a1cc5af Mon Sep 17 00:00:00 2001 From: julienjamme Date: Fri, 26 Aug 2022 12:56:19 +0200 Subject: [PATCH 062/107] enrich presentation vignette --- vignettes/presentation_rtauargus.Rmd | 24 +++++++++++++++++++----- 1 file changed, 19 insertions(+), 5 deletions(-) diff --git a/vignettes/presentation_rtauargus.Rmd b/vignettes/presentation_rtauargus.Rmd index fd59d18..6b44619 100644 --- a/vignettes/presentation_rtauargus.Rmd +++ b/vignettes/presentation_rtauargus.Rmd @@ -281,15 +281,29 @@ ex2 <- tab_rtauargus( str(ex2) ``` +```{r} +table(ex2$Status) +``` + +As we can see in the `table()` results, all the primary secret has the status "B" +in the output produced by τ-Argus. To adjust this, we can do: + +```{r} +ex2 %>% + mutate( + Status = dplyr::case_when( + is_secret_freq ~ "A", + TRUE ~ Status + ) + ) %>% + dplyr::count(Status) +``` #### Treating multiple linked tables -The function `tab_multi_manager` can deal with a whole set of linked tables or not. -It performs secondary suppression with one table at a time and ensure that the common cells have the same status. -It is an iterating process, it performs secondary suppression with one table at a time. -When a common cell is concerned by secondary suppression it reverberate the secret on the tables that share this common cell. -The process ends when the secondary secret is consistent in every table. +The function `tab_multi_manager` can deal with a whole set of linked (or not) tables. +It is an iterating process, performing secondary suppression with one table at a time and ensure that the common cells have the same status. When a common cell is concerned by secondary suppression it reverberates the secret on each table that shares this common cell. The process ends when the secondary secret is consistent in every tables. #### Example From 22abe00c7f4430cb0ada409586a3ca37fd71c636 Mon Sep 17 00:00:00 2001 From: Rastout Nathanael Date: Fri, 26 Aug 2022 14:03:17 +0200 Subject: [PATCH 063/107] Gestion conflit --- .Rbuildignore | 12 - .gitignore | 9 - .gitlab-ci.yml | 43 - DESCRIPTION | 54 -- LICENSE | 19 - NAMESPACE | 26 - NEWS.md | 116 --- README.md | 71 -- _pkgdown.yml | 46 - rtauargus.Rproj | 20 - tests/testthat.R | 5 - tests/testthat/test_hrc.R | 917 ------------------ tests/testthat/test_micro_arb.R | 106 -- tests/testthat/test_micro_asc_rda.R | 114 --- tests/testthat/test_util.R | 135 --- tests_multitable/create_corr_table_activity.R | 25 - .../data/corr_table_nuts23_fr.RData | Bin 474 -> 0 bytes .../data/red_vegetables_4_linked_tabs.RData | Bin 26786 -> 0 bytes tests_multitable/legumes.hrc | 121 --- tests_multitable/legumes_unif.hrc | 121 --- tests_multitable/nuts23.hrc | 118 --- tests_multitable/nuts23_unif.hrc | 118 --- tests_multitable/test_multitable.R | 143 --- tests_multitable/test_multitable_ofats.R | 196 ---- 24 files changed, 2535 deletions(-) delete mode 100644 .Rbuildignore delete mode 100644 .gitignore delete mode 100644 .gitlab-ci.yml delete mode 100644 DESCRIPTION delete mode 100644 LICENSE delete mode 100644 NAMESPACE delete mode 100644 NEWS.md delete mode 100644 README.md delete mode 100644 _pkgdown.yml delete mode 100644 rtauargus.Rproj delete mode 100644 tests/testthat.R delete mode 100644 tests/testthat/test_hrc.R delete mode 100644 tests/testthat/test_micro_arb.R delete mode 100644 tests/testthat/test_micro_asc_rda.R delete mode 100644 tests/testthat/test_util.R delete mode 100644 tests_multitable/create_corr_table_activity.R delete mode 100644 tests_multitable/data/corr_table_nuts23_fr.RData delete mode 100644 tests_multitable/data/red_vegetables_4_linked_tabs.RData delete mode 100644 tests_multitable/legumes.hrc delete mode 100644 tests_multitable/legumes_unif.hrc delete mode 100644 tests_multitable/nuts23.hrc delete mode 100644 tests_multitable/nuts23_unif.hrc delete mode 100644 tests_multitable/test_multitable.R delete mode 100644 tests_multitable/test_multitable_ofats.R diff --git a/.Rbuildignore b/.Rbuildignore deleted file mode 100644 index 60b5030..0000000 --- a/.Rbuildignore +++ /dev/null @@ -1,12 +0,0 @@ -^.*\.Rproj$ -^\.Rproj\.user$ -^\.Rprofile$ -^NEWS\.rmd$ -^NEWS\.md$ -^NEWS\.html$ -^tmp$ -# ^vignettes/.+\.png$ -^vignettes/rtauargus\.Rmd\.orig$ -^vignettes/precompilation.R$ -^\.gitlab-ci\.yml$ -^_pkgdown\.yml$ diff --git a/.gitignore b/.gitignore deleted file mode 100644 index 0c1fac5..0000000 --- a/.gitignore +++ /dev/null @@ -1,9 +0,0 @@ -.Rproj.user -.Rhistory -.RData -.Ruserdata -.Rprofile -NEWS.html -tmp -inst/doc -vignettes/tauargus_exe.ini diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml deleted file mode 100644 index 7c3c357..0000000 --- a/.gitlab-ci.yml +++ /dev/null @@ -1,43 +0,0 @@ -image: rocker/tidyverse:latest - -stages: - - check - - deploy - -variables: - GIT_SSL_NO_VERIFY: "1" - PKG_NAME: "rtauargus" - -pkg_check: - stage: check - tags: - - poc-kube - script: - - R -e 'install.packages("gdata", repos = "https://nexus.insee.fr/repository/r-cran")' - - R -e 'devtools::check(check_dir = ".", - error_on = "error", - cran = FALSE, - document = FALSE, - manual = FALSE)' - artifacts: - paths: - - "${PKG_NAME}_*.tar.gz" - only: - - master - - developpement - -pages: - stage: deploy - image: colinfay/r-ci-tidyverse:3.6.0 - tags: - - poc-kube - script: - - R -e 'install.packages("gdata", repos = "https://nexus.insee.fr/repository/r-cran")' - - R -e 'devtools::install(dependencies = FALSE)' - - R -e 'options(pkgdown.internet = FALSE) ; pkgdown::build_site()' - artifacts: - paths: - - public - when: manual # pour declencher manuellement le job quand version stable - only: - - master diff --git a/DESCRIPTION b/DESCRIPTION deleted file mode 100644 index 5f72cf6..0000000 --- a/DESCRIPTION +++ /dev/null @@ -1,54 +0,0 @@ -Package: rtauargus -Type: Package -Title: Using Tau-Argus from R -Language: fr -Version: 0.5.0.9000 -Depends: R (>= 3.3) -Imports: - purrr (>= 0.2), - dplyr (>= 0.7), - gdata, - stringr, - rlang, - zoo -Suggests: - testthat, - knitr, - rmarkdown -Authors@R: c( - person( - "Pierre-Yves", "Berrard", - email = "pierre-yves.berrard@insee.fr", - role = c("aut", "cre") - ), - person( - "Julien", "Jamme", - email = "julien.jamme@insee.fr", - role = c("aut") - ), - person( - "Nathanaël", "Rastout", - email = "nathanael.rastout@insee.fr", - role = c("aut") - ), - person( - "Jeanne", "Pointet", - role = c("ctb") - ), - person( - "Félix", "Beroud", - role = c("ctb") - ), - person( - family = "Institut National de la Statistique et des Études Économiques", - role = "cph" - ) - ) -Description: Protects tables by calling Tau-Argus software from R. -License: MIT + file LICENSE -Encoding: UTF-8 -LazyData: true -RoxygenNote: 7.1.2 -VignetteBuilder: knitr -URL: https://github.com/inseefrlab/rtauargus, http://outilsconfidentialite.gitlab-pages.insee.fr/rtauargus, https://gitlab.insee.fr/outilsconfidentialite/rtauargus -BugReports: https://github.com/inseefrlab/rtauargus/issues, https://gitlab.insee.fr/outilsconfidentialite/rtauargus/-/issues diff --git a/LICENSE b/LICENSE deleted file mode 100644 index 4313a10..0000000 --- a/LICENSE +++ /dev/null @@ -1,19 +0,0 @@ -Copyright 2021 Institut National de la Statistique et des Études Économiques - -Permission is hereby granted, free of charge, to any person obtaining a copy -of this software and associated documentation files (the "Software"), to deal -in the Software without restriction, including without limitation the rights -to use, copy, modify, merge, publish, distribute, sublicense, and/or sell -copies of the Software, and to permit persons to whom the Software is -furnished to do so, subject to the following conditions: - -The above copyright notice and this permission notice shall be included in all -copies or substantial portions of the Software. - -THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR -IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE -AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER -LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, -OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE -SOFTWARE. diff --git a/NAMESPACE b/NAMESPACE deleted file mode 100644 index 886e19b..0000000 --- a/NAMESPACE +++ /dev/null @@ -1,26 +0,0 @@ -# Generated by roxygen2: do not edit by hand - -export(import) -export(micro_arb) -export(micro_asc_rda) -export(reset_rtauargus_options) -export(rtauargus) -export(rtauargus_options) -export(rtauargus_plus) -export(run_arb) -export(tab_arb) -export(tab_multi_manager) -export(tab_rda) -export(tab_rtauargus) -export(tab_rtauargus2) -export(tauargus_info) -export(write_hrc) -export(write_hrc2) -importFrom(dplyr,"%>%") -importFrom(dplyr,arrange) -importFrom(dplyr,mutate) -importFrom(purrr,map) -importFrom(purrr,map_at) -importFrom(purrr,transpose) -importFrom(rlang,.data) -importFrom(zoo,na.locf) diff --git a/NEWS.md b/NEWS.md deleted file mode 100644 index 554905a..0000000 --- a/NEWS.md +++ /dev/null @@ -1,116 +0,0 @@ ---- -title: Package ‘rtauargus’ -subtitle: Historique des modifications -output: rmarkdown::html_vignette ---- -## rtauargus 1.0.0 - -[01/09/2022] - -* English documentation -* **tab_arb()** : argument *value* is now called *response_var* as in the **tab_rda()** function. -* **tab_arb()** : argument *apriori* is now called *hst_filename* as in the **tab_rda()** function. -* **write_hrc2()** : new function to creat a hrc file from a correspondence table - -## rtauargus 0.5.0 - -[18/04/2022] - -* Ajout de fonctions pour gérer le secret directement sur des données tabulées. -Addition of functions to manage confidentiality directly on tabular data. - -## rtauargus 0.4.3 - -[13/10/2021] - -* projet transféré dans le groupe `outilsconfidentialite` - -## rtauargus 0.4.2 - -[17/12/2020] - -* projet migré vers gitlab.insee.fr - -## rtauargus 0.4.1 - -[18/10/2019] - -* **rtauargus_plus()** : extension de la fonction `rtauargus` pour un grand - nombre de croisements (ayant tous les mêmes caractéristiques). Réduit le temps - d'exécution par rapport à la version "normale". - -## rtauargus 0.4.0 - -[04/09/2019] - -* **rtauargus()** peut désormais prendre en entrée un couple de fichiers asc et - rda (au lieu d'un data.frame). Permet de lancer un traitement dans le cas - où ces fichiers texte de microdonnées existent déjà. -* **run_arb()** : - - nouveau nom de run_tauargus (nom plus explicite, - principalement pour éviter la confusion avec la fonction _rtauargus_). - L'ancien nom reste pour l'instant utilisable : un message avertit du - changement. Il sera remplacé par un message d'erreur dans une prochaine - version. - - vérifications préalables à l'exécution de τ-Argus : - * existence du logiciel sur le poste ; - * existence des fichiers asc et rda ; - * présence des variables à utiliser (croisements, variable de réponse, - ...) dans les métadonnées (fichier rda) ; - * existence des dossiers où vont être écrits les résultats. Si absents, - possibilité de les créer automatiquement (paramètre `missing_dir` avec - option associée `rtauargus.missing_dir`). -* **import()** : si des fichiers _apriori_ ont été utilisés, stockage du nom de - ces fichiers dans les métadonnées (attributs) de l'objet R créé -* améliorations de la documentation (rubriques d'aide et vignette) - -## rtauargus 0.3.1 - -[11/07/2019] - -* informe de l'absence de tauargus.exe au chargement du package -* diverses améliorations de la documentation (rubriques d'aide et vignette) -* utilise valeurs par défaut des options en cas d'effacement accidentel par - l'utilisateur - -## rtauargus 0.3.0 - -[29/03/2019] - -* **micro_arb()** : - - ajoute paramètre apriori (fichiers hst) - - conserve les noms de tabulations en sortie si précisés dans - `explanatory_vars` -* vérification plus rigoureuse de certains paramètres - -## rtauargus 0.2.1 - -[03/12/2018] - -* **write_hrc()** : prise en compte de davantage de cas particuliers -* améliore vignette - -## rtauargus 0.2.0 - -[14/08/2018] - -* **micro_arb()** : - - implémente tableaux liés (paramètre **linked**) - - corrige extensions de fichiers pour `"5"` (.tab) et `"6"` (.jj) - - corrige bug quand un seul paramètre à suppress, par exemple `MOD(1)` -* **write_hrc()** : nouvelle fonction créant un fichier .hrc à partir de - variables hiérarchiques présentes dans les microdonnées -* **micro_asc_rda()** : - - implémente paramètres **missing**, **totcode** et **codelist** - - simplifie syntaxe pour paramètre **hrc** (cohérente avec nouveaux - paramètres) - - nouveau paramètre **hierleadstring** (valeur par défaut dans l'option de - package **rtauargus.hierleadstring**) -* efface les options du package à son déchargement -* corrections diverses documentation - -## rtauargus 0.1.0 - -[01/08/2018] - -* Première version stable. diff --git a/README.md b/README.md deleted file mode 100644 index 0d7c1cb..0000000 --- a/README.md +++ /dev/null @@ -1,71 +0,0 @@ - -[![pipeline status](https://gitlab.insee.fr/outilsconfidentialite/rtauargus/badges/master/pipeline.svg)](https://gitlab.insee.fr/outilsconfidentialite/rtauargus/-/pipelines) - - -rtauargus -========= - -![](vignettes/R_logo_small.png) ![](vignettes/TauBall2_small.png) - -### τ-Argus depuis R - -Le package *rtauargus* offre une interface **R** pour **τ-Argus**. - -Il permet de : - -- créer les inputs (fichiers asc et rda) à partir de données au format R ; -- générer la séquence d'instructions à exécuter en mode batch (fichier arb) ; -- lancer un batch τ-Argus en ligne de commande ; -- récupérer les résultats dans R. - -Ces différentes opérations peuvent être exécutées en une seule fois, mais aussi de manière modulaire. Elles permettent d'intégrer les tâches réalisées par τ-Argus dans une chaîne de traitement écrite en R. - -Le package présente d'autres fonctionnalités annexes, comme créer une variable hiérarchique à partir de microdonnées. - -### Installation - -* **version stable la plus récente** (recommandé) - - ```r - install.packages("rtauargus", repos = "https://nexus.insee.fr/repository/r-public") - ``` - -* **version de développement** - - ```r - # install.packages("remotes") - remotes::install_gitlab( - repo = "outilsconfidentialite/rtauargus", - host = "gitlab.insee.fr", - build_vignettes = TRUE, - upgrade = "never" - ) - ``` - - Pour installer une version spécifique, ajouter au répertoire une référence - ([commit](https://gitlab.insee.fr/outilsconfidentialite/rtauargus/-/commits/master) ou - [tag](https://gitlab.insee.fr/outilsconfidentialite/rtauargus/-/tags)), - par exemple `"outilsconfidentialite/rtauargus@v-0.4.1"`. - -### Exemple simple - -``` r -library(rtauargus) - -rtauargus( - microdata = donnees, - explanatory_vars = c("variable1", "variable2"), - safety_rules = "FREQ(3,10)", - suppress = "GH(1,100)" -) -``` - -Une prise en main détaillée est disponible par `vignette("rtauargus")`. - -### Remarques importantes - -Les fonctions de *rtauargus* appelant τ-Argus nécessitent que ce logiciel soit accessible depuis le poste de travail. Le téléchargement de τ-Argus se fait sur la [page dédiée](https://research.cbs.nl/casc/tau.htm) du site de l'office néerlandais de statistiques. Cependant, toutes les fonctions n'exécutent pas τ-Argus (création des microdonnées...). Ne pas l'avoir sur son poste n'est donc pas bloquant. - -Le package a été développé sur la base des versions open source de τ -Argus (versions 4.1 et supérieures), en particulier la dernière version disponible lors du développement (4.1.7). **Il n'est pas compatible avec la version 3.5.** - -Pour l'instant, **seules les microdonnées sont acceptées** en entrée (pas les données déjà tabulées). diff --git a/_pkgdown.yml b/_pkgdown.yml deleted file mode 100644 index e2c61b3..0000000 --- a/_pkgdown.yml +++ /dev/null @@ -1,46 +0,0 @@ -destination: public - -navbar: - structure: - left: - - home - - intro - - reference - - news - right: - - gitlab - components: - home: - icon: fas fa-home fa-lg - href: index.html - intro: - text: Mode d'emploi - href: articles/rtauargus.html - reference: - text: Fonctions - href: reference/index.html - news: - text: NEWS - href: news/index.html - gitlab: - text: Contribuer - href: https://gitlab.insee.fr/outilsconfidentialite/rtauargus - icon: fa-gitlab - -reference: - - title: Secrétiser en une seule instruction - contents: - - rtauargus - - rtauargus_plus - - title: Secrétiser étape par étape - contents: - - micro_asc_rda - - micro_arb - - run_arb - - import - - title: Autres - contents: - - rtauargus_options - - tauargus_info - - write_hrc - - rtauargus-package diff --git a/rtauargus.Rproj b/rtauargus.Rproj deleted file mode 100644 index 497f8bf..0000000 --- a/rtauargus.Rproj +++ /dev/null @@ -1,20 +0,0 @@ -Version: 1.0 - -RestoreWorkspace: Default -SaveWorkspace: Default -AlwaysSaveHistory: Default - -EnableCodeIndexing: Yes -UseSpacesForTab: Yes -NumSpacesForTab: 2 -Encoding: UTF-8 - -RnwWeave: Sweave -LaTeX: pdfLaTeX - -AutoAppendNewline: Yes -StripTrailingWhitespace: Yes - -BuildType: Package -PackageUseDevtools: Yes -PackageInstallArgs: --no-multiarch --with-keep.source diff --git a/tests/testthat.R b/tests/testthat.R deleted file mode 100644 index 4b786e4..0000000 --- a/tests/testthat.R +++ /dev/null @@ -1,5 +0,0 @@ -library(testthat) -library(rtauargus) -library(dplyr) - -test_check("rtauargus") diff --git a/tests/testthat/test_hrc.R b/tests/testthat/test_hrc.R deleted file mode 100644 index 2e5553a..0000000 --- a/tests/testthat/test_hrc.R +++ /dev/null @@ -1,917 +0,0 @@ -# données test ------------------------------------------------------------ - -df <- - tibble( - niv1 = rep( - c("A", "B"), - c(27, 23) - ), - niv2 = rep( - c("A1", "A2", "B1", "B2"), - c(17, 10, 10, 13) - ), - niv3 = rep( - c("A1x", "A1z", "A2y", "A2z", "B1x", "B1y", "B2x", "B2z"), - c(16L, 1L, 8L, 2L, 9L, 1L, 10L, 3L) - ), - niv4 = rep( - c("A1x6", "A1x7", "A1z6", "A2y7", "A2y6", "A2z7", "A2z6", - "B1x7", "B1x6", "B1y6", "B2x7", "B2x6", "B2z6"), - c(7L, 9L, 1L, 5L, 3L, 1L, 1L, 6L, 3L, 1L, 7L, 3L, 3L) - ) - ) - - -# fill_na_hrc ------------------------------------------------------------- - -context(":::fill_na_hrc") - -test_that("différentes configurations et ordre des variables", { - - df_NA <- - tibble( - niv1 = c("A" , "A" , "B", NA, NA, NA, NA ), - niv2 = c("A1" , "A2", NA, NA, "D", NA, "F1"), - niv3 = c("A1x", NA , NA, NA, NA, "E", "F" ) - ) - - expect_equal( - fill_na_hrc( - df_NA, - c("niv1", "niv2", "niv3") - ), - tibble( - niv1 = c("A" , "A" , "B", NA, NA, NA, NA ), - niv2 = c("A1" , "A2", "B", NA, "D", NA, "F1"), - niv3 = c("A1x", "A2", "B", NA, "D", "E", "F" ) - ) - ) - - expect_equal( - fill_na_hrc( - df_NA, - c("niv3", "niv2", "niv1") # inversion ordre - ), - tibble( - niv3 = c("A1x", NA , NA, NA, NA, "E", "F" ), - niv2 = c("A1" , "A2", NA, NA, "D", "E", "F1"), - niv1 = c("A" , "A" , "B", NA, "D", "E", "F1") - ) - ) - -}) - - -# sublevels --------------------------------------------------------------- - -context(":::sublevels") - -subl12 <- - list( - A = list(A1 = NULL, A2 = NULL), - B = list(B1 = NULL, B2 = NULL) - ) - -subl13 <- - list( - A = list(A1x = NULL, A1z = NULL, A2y = NULL, A2z = NULL), - B = list(B1x = NULL, B1y = NULL, B2x = NULL, B2z = NULL) - ) - -subl14 <- - list( - A = list( - A1x6 = NULL, A1x7 = NULL, A1z6 = NULL, - A2y6 = NULL, A2y7 = NULL, A2z6 = NULL, A2z7 = NULL - ), - B = list( - B1x6 = NULL, B1x7 = NULL, B1y6 = NULL, - B2x6 = NULL, B2x7 = NULL, B2z6 = NULL - ) - ) - -subl23 <- - list( - A1 = list(A1x = NULL, A1z = NULL), - A2 = list(A2y = NULL, A2z = NULL), - B1 = list(B1x = NULL, B1y = NULL), - B2 = list(B2x = NULL, B2z = NULL) - ) - -subl24 <- - list( - A1 = list(A1x6 = NULL, A1x7 = NULL, A1z6 = NULL), - A2 = list(A2y6 = NULL, A2y7 = NULL, A2z6 = NULL, A2z7 = NULL), - B1 = list(B1x6 = NULL, B1x7 = NULL, B1y6 = NULL), - B2 = list(B2x6 = NULL, B2x7 = NULL, B2z6 = NULL) - ) - -subl34 <- - list( - A1x = list(A1x6 = NULL, A1x7 = NULL), - A1z = list(A1z6 = NULL), - A2y = list(A2y6 = NULL, A2y7 = NULL), - A2z = list(A2z6 = NULL, A2z7 = NULL), - B1x = list(B1x6 = NULL, B1x7 = NULL), - B1y = list(B1y6 = NULL), - B2x = list(B2x6 = NULL, B2x7 = NULL), - B2z = list(B2z6 = NULL) - ) - -test_that("normal", { - - # niv 1 x (2 3 4) ........................... - - expect_equal( - sublevels(df$niv2, df$niv1), - subl12 - ) - - expect_equal( - sublevels(df$niv3, df$niv1), - subl13 - ) - - expect_equal( - sublevels(df$niv4, df$niv1), - subl14 - ) - - # niv 2 x (3 4) ............................ - - expect_equal( - sublevels(df$niv3, df$niv2), - subl23 - ) - - expect_equal( - sublevels(df$niv4, df$niv2), - subl24 - ) - - # niv 3 x 4 ........................... - - expect_equal( - sublevels(df$niv4, df$niv3), - subl34 - ) - -}) - -test_that("présence NAs", { - - expect_error( - sublevels(c(NA, NA), c(NA , NA)), - "aucun croisement exploitable" - ) - - expect_error( - sublevels(c("A", NA), c(NA , NA)), - "aucun croisement exploitable" - ) - - expect_error( - sublevels(c("A1", NA), c(NA , "B")), - "aucun croisement exploitable" - ) - - res <- list(A = list(A1 = NULL)) # (attendu) - - expect_equal( - sublevels(c("A1", NA), c("A", NA)), - res - ) - - expect_equal( - sublevels(c("A1", NA), c("A", "B")), - res # B disparaît à cause du NA au niveau inférieur - ) - - expect_equal( - sublevels(c("A1", "B1"), c("A", NA)), - res # B1 disparaît à cause du NA au niveau supérieur - ) - - expect_equal( - sublevels(c("A1", "A1"), c("A", NA)), - res - ) - - # plusieurs cas combinés - expect_equal( - sublevels(c("A1", "B2", NA, NA), c("A", NA, "B", NA)), - res - ) - -}) - -test_that("détecte variables non hierarchiques", { - - # niv 1 x (2 3 4) ........................... - - expect_error( - sublevels(df$niv1, df$niv2), - "variables non hierarchiques" - ) - - expect_error( - sublevels(df$niv1, df$niv3), - "variables non hierarchiques" - ) - - expect_error( - sublevels(df$niv1, df$niv4), - "variables non hierarchiques" - ) - - # niv 2 x (3 4) ............................ - - expect_error( - sublevels(df$niv2, df$niv3), - "variables non hierarchiques" - ) - - expect_error( - sublevels(df$niv2, df$niv4), - "variables non hierarchiques" - ) - - # niv 3 x 4 ........................... - - expect_error( - sublevels(df$niv3, df$niv4), - "variables non hierarchiques" - ) - - -}) - - -# imbrique ---------------------------------------------------------------- - -context(":::imbrique") - -p_12 <- - list( - A = list( - A1 = NULL, - A2 = NULL - ), - B = list( - B1 = NULL, - B2 = NULL - ) - ) - -p_23 <- - list( - A1 = list( - A1x = NULL, - A1z = NULL - ), - A2 =list( - A2y = NULL, - A2z = NULL - ), - B1 = list( - B1x = NULL, - B1y = NULL - ), - B2 = list( - B2x = NULL, - B2z = NULL - ) - ) - -i_13 <- - list( - A = list( - A1 = list(A1x = NULL, A1z = NULL), - A2 = list(A2y = NULL, A2z = NULL) - ), - B = list( - B1 = list(B1x = NULL, B1y = NULL), - B2 = list(B2x = NULL, B2z = NULL) - ) - ) - -test_that("normal", { - - expect_equal( - imbrique(p_23, p_12), - i_13 - ) - -}) - -test_that("melange", { - - # melange input 1 - expect_equal( - imbrique( - p_23[c(3, 2, 4, 1)], - p_12 - ), - i_13 - ) - - # melange input 2 - expect_equal( - imbrique(p_23, p_12[2:1]), - i_13[2:1] - ) - - # melange inputs 1 et 2 - expect_equal( - imbrique(p_23[c(3, 2, 4, 1)], p_12[2:1]), - i_13[2:1] - ) - -}) - - -# hrc_list ----------------------------------------------------------------- - -context(":::hrc_list") - -hrc_123 <- list( - A = list( - A1 = list( - A1x = NULL, - A1z = NULL - ), - A2 = list( - A2y = NULL, - A2z = NULL - ) - ), - B = list( - B1 = list( - B1x = NULL, - B1y = NULL - ), - B2 = list( - B2x = NULL, - B2z = NULL - ) - ) -) - -hrc_124 <- list( - A = list( - A1 = list( - A1x6 = NULL, - A1x7 = NULL, - A1z6 = NULL - ), - A2 = list( - A2y6 = NULL, - A2y7 = NULL, - A2z6 = NULL, - A2z7 = NULL - ) - ), - B = list( - B1 = list( - B1x6 = NULL, - B1x7 = NULL, - B1y6 = NULL - ), - B2 = list( - B2x6 = NULL, - B2x7 = NULL, - B2z6 = NULL - ) - ) -) - -hrc_1234 <- list( - A = list( - A1 = list( - A1x = list(A1x6 = NULL, A1x7 = NULL), - A1z = list(A1z6 = NULL) - ), - A2 = list( - A2y = list(A2y6 = NULL, A2y7 = NULL), - A2z = list(A2z6 = NULL, A2z7 = NULL) - ) - ), - B = list( - B1 = list( - B1x = list(B1x6 = NULL, B1x7 = NULL), - B1y = list(B1y6 = NULL) - ), - B2 = list( - B2x = list(B2x6 = NULL, B2x7 = NULL), - B2z = list(B2z6 = NULL) - ) - ) -) - -test_that("2 input (équivaut à sublevels)", { - - # 2 inputs équivaut à sublevels - expect_equal( - hrc_list(df, c("niv2", "niv1")), - subl12 - ) - - expect_equal( - hrc_list(df, c("niv4", "niv1")), - subl14 - ) - - expect_equal( - hrc_list(df, c("niv4", "niv2")), - subl24 - ) - - expect_equal( - hrc_list(df, c("niv3", "niv2")), - subl23 - ) - #... - -}) - -test_that("3 input", { - - expect_equal( - hrc_list(df, c("niv3", "niv2", "niv1")), - hrc_123 - ) - - expect_equal( - hrc_list(df, c("niv4", "niv2", "niv1")), - hrc_124 - ) - -}) - -test_that("4 input", { - - expect_equal( - hrc_list(df, c("niv4", "niv3", "niv2", "niv1")), - hrc_1234 - ) - -}) - - -# prof_list --------------------------------------------------------------- - -context(":::prof_list") - -test_that("2 niveaux", { - - expect_equal( - prof_list(subl12), - c(A = 0, A1 = 1, A2 = 1, B = 0, B1 = 1, B2 = 1) - ) - -}) - -test_that("3 niveaux", { - - expect_equal( - prof_list(hrc_124), - c(A = 0, - A1 = 1, - A1x6 = 2, A1x7 = 2, A1z6 = 2, - A2 = 1, - A2y6 = 2, A2y7 = 2, A2z6 = 2, A2z7 = 2, - B = 0, - B1 = 1, - B1x6 = 2, B1x7 = 2, B1y6 = 2, - B2 = 1, - B2x6 = 2, B2x7 = 2, B2z6 = 2 - ) - ) - -}) - -test_that("4 niveaux", { - - expect_equal( - prof_list(hrc_1234), - c(A = 0, - A1 = 1, - A1x = 2, - A1x6 = 3, A1x7 = 3, - A1z = 2, - A1z6 = 3, - A2 = 1, - A2y = 2, - A2y6 = 3, A2y7 = 3, - A2z = 2, - A2z6 = 3, A2z7 = 3, - B = 0, - B1 = 1, - B1x = 2, - B1x6 = 3, B1x7 = 3, - B1y = 2, - B1y6 = 3, - B2 = 1, - B2x = 2, - B2x6 = 3, B2x7 = 3, - B2z = 2, - B2z6 = 3 - ) - ) - -}) - - -# is_hrc ------------------------------------------------------------------ - -context(":::is_hrc") - -test_that("depuis precomptage", { - - mat2col <- purrr::partial(matrix, ncol = 2, byrow = TRUE) - - expect_true( - mat2col( - c(1, 0, - 0, 2) - ) %>% is_hrc() - ) - - expect_true( - mat2col( - c(1, 0, - 0, 2, - 8, 0) - ) %>% is_hrc() - ) - - expect_false( - mat2col( - c(7, 1, # deux niveaux agrégés pour un niveau fin - 0, 2) - ) %>% is_hrc() - ) - - expect_true( - matrix( - nrow = 2, - c(1, 0, - 0, 0 - ) - ) %>% is_hrc() - ) - -}) - -test_that("sortie table()", { - - # TRUE ...................... - - expect_true( - is_hrc( - table( - fin = c("A1", "A2"), - agr = c("A" , "A" ) - ) - ) - ) - - expect_true( - is_hrc( - table( - fin = c("A1", "A2", "B1"), - agr = c("A" , "A" , "B" ) - ) - ) - ) - - expect_true( - is_hrc( - table( - fin = c("A1", "A2"), - agr = c("A" , NA ) - ) - ) - ) - - expect_true( - is_hrc( - table( - fin = c("A1", NA ), - agr = c("A" , "B") - ) - ) - ) - - expect_true( - is_hrc( - table( - fin = c("A1", "A2", "B1"), - agr = c("A" , "A" , "B" ) - ) - ) - ) - - expect_true( - is_hrc( - table( - fin = c("A1", "A2", "B1", NA), - agr = c("A" , "A" , "B" , "B") - ) - ) - ) - - expect_true( - is_hrc( - table( - fin = c("A1", "A2", "B1", NA), - agr = c("A" , "A" , "B" , "C") - ) - ) - ) - - expect_true( - is_hrc( - table( - fin = c("A1", "B1", "B2"), # ligne de 0 pour B2 - agr = c("A" , "B" , NA ) - ) - ) - ) - - # FALSE ...................... - - expect_false( - is_hrc( - table( - fin = c("A1", "A1"), - agr = c("A" , "B" ) # deux niveaux agrégés pour un niveau fin - ) - ) - ) - - expect_false( - is_hrc( - table( - fin = c("A1", "A2"), - agr = c( NA , NA ) - ) - ) - ) - - expect_false( - is_hrc( - table( - fin = c( NA , NA ), - agr = c("A" , "A") - ) - ) - ) - -}) - - -# check_seq_prof ---------------------------------------------------------- - -context(":::check_seq_prof") - -test_that("input invalide", { - - expect_false(check_seq_prof(integer(0))) - expect_false(check_seq_prof(1:2)) - expect_false(check_seq_prof(0:-1)) - expect_false(check_seq_prof((0:1) / 2)) - -}) - -test_that("input valide", { - - expect_true(check_seq_prof(0:2)) - expect_false(check_seq_prof(c(0, 2))) - expect_true(check_seq_prof(c(0, 1, 1, 0, 1, 2))) - expect_true(check_seq_prof(c(0, 1, 2, 3, 2))) - expect_true(check_seq_prof(c(0, 1, 2, 3, 1))) - expect_true(check_seq_prof(c(0, 1, 1, 2, 3, 3, 2, 3, 3, 2, 0, 1, 0))) - -}) - - -# normalise_hrc ----------------------------------------------------------- - -context(":::normalise_hrc") - -test_that("rien à normaliser", { - - expect_null(normalise_hrc(NULL)) - - expect_equal( - normalise_hrc(c("1 2", "3 4 5")), - c("1 2", "3 4 5") - ) - -}) - -test_that("syntaxe valeur incorrecte", { - - expect_error( - normalise_hrc("fich"), - "Parametres hrc incorrects" - ) - - expect_error( - normalise_hrc("3 Q 5"), - "Parametres hrc incorrects" - ) - -}) - -test_that("microdata absent si V1>V2...", { - - expect_error( - normalise_hrc("V1>V2"), - "specifier microdata" - ) - -}) - - -# df_hierlevels ----------------------------------------------------------- - -context(":::df_hierlevels") - -test_that("base", { - - expect_equal( - df_hierlevels(df$niv2, "1 1"), - data.frame( - var_hrc = c("A1", "A2", "B1", "B2"), - V2 = c("A", "A", "B", "B" ), - stringsAsFactors = FALSE - ) - ) - - expect_equal( - df_hierlevels(df$niv3, "1 1 1"), - data.frame( - var_hrc = c("A1x", "A1z", "A2y", "A2z", "B1x", "B1y", "B2x", "B2z"), - V2 = c("A1" , "A1" , "A2" , "A2" , "B1" , "B1" , "B2" , "B2" ), - V3 = c("A" , "A" , "A" , "A" , "B" , "B" , "B" , "B" ), - stringsAsFactors = FALSE - ) - ) - - -}) - -test_that("error", { - - expect_error( - df_hierlevels(df$niv2, "1 un"), - "chiffres separes par des espaces" - ) - - expect_error( - df_hierlevels(df$niv4, "1 2 3"), - "somme de hierlevels" - ) - - expect_error( - df_hierlevels(c(df$niv3, df$niv2), "1 3"), - "nombre de caracteres" - ) - -}) - -# write_hrc --------------------------------------------------------------- - -context("write_hrc") - -test_that("hierlevels", { - - expect_error( - write_hrc(df, c("niv1", "niv2"), hierlevels = "2 1"), - "une seule variable hierarchique a specifier" - ) - - expect_equal( - df %>% write_hrc("niv2", hierlevels = "1 1") %>% readLines(), - c("A", "@A1", "@A2", "B", "@B1", "@B2") - ) - -}) - -test_that("colonne absente", { - - expect_error( - write_hrc(df, c("niv1", "niv0")), - "introuvable.+ niv0$" - ) - -}) - -test_that("un seul niveau", { - - expect_warning( - res <- write_hrc(df, "niv2"), - "hierarchie d'un seul niveau" - ) - expect_equal(readLines(res), c("A1", "A2", "B1", "B2")) - -}) - -test_that("fill_na", { - - hrc_complet <- purrr::partial(write_hrc, compact = FALSE) # [n'élague pas] - - df$niv2[df$niv2 == "A1"] <- NA - - # fill_na "up" ................................................... - - expect_warning( - res <- hrc_complet(df, c("niv2", "niv1"), fill_na = "up"), - "valeurs manquantes imputees" - ) - expect_equal(readLines(res), c("A", "@A", "@A2", "B", "@B1", "@B2")) - # ex-A1 imputés par le haut deviennent A - - # fill_na "down" ................................................. - - expect_warning( - res <- hrc_complet(df, c("niv2", "niv1"), fill_na = "down"), - "valeurs manquantes imputees" - ) - expect_equal(readLines(res), c("A", "@A2", "B", "@B1", "@B2")) - # pas de niveau inférieur à niv2 : imputation down sans effet, - # donc croisement A x NA simplement ignorés - - df <- df[df$niv1 == "A", ] - expect_warning( - res <- hrc_complet(df, c("niv3", "niv2"), fill_na = "down"), - "valeurs manquantes imputees" - ) - expect_equal( - readLines(res), - c("A1x", "@A1x", "A1z", "@A1z", "A2", "@A2y", "@A2z") - ) # ex-A1 imputés par le bas deviennent A1x et A1z - -}) - -test_that("compact", { - - df$niv3[df$niv1 == "A"] <- NA # vide niveau 3 pour A - - expect_warning( - res <- write_hrc(df, paste0("niv", 3:1), compact = TRUE), - "valeurs manquantes imputees" - ) - - expect_equal( - readLines(res), - c("A", "@A1", "@A2", "B", "@B1", "@@B1x", "@@B1y", "@B2", "@@B2x", "@@B2z") - ) - - df$niv2[df$niv1 == "A"] <- NA # vide aussi niveau 2 pour A - - expect_warning( - res <- write_hrc(df, paste0("niv", 3:1), compact = TRUE), - "valeurs manquantes imputees" - ) - - expect_equal( - readLines(res), - c("A", "B", "@B1", "@@B1x", "@@B1y", "@B2", "@@B2x", "@@B2z") - ) - -}) - -test_that("validité arbre", { - - # vide niveau intermédiaire (produira une erreur si compactage) - df$niv2<- NA - - expect_error( - suppressWarnings(write_hrc(df, paste0("niv", 3:1), compact = TRUE)), - "Niveaux de hierarchie incoherents" - ) - -}) - -test_that("hierleadstring", { - - expect_equal( - df %>% - write_hrc(paste0("niv", 2:1), hierleadstring = ":") %>% - readLines(), - c("A", ":A1", ":A2", "B", ":B1", ":B2") - ) - -}) - -test_that("cas exotiques", { - skip("a->b b->a") - # expect_error ? - write_hrc( - data.frame(niv1 = letters[1:2], niv2 = letters[2:1]), - c("niv2", "niv1") - ) -}) diff --git a/tests/testthat/test_micro_arb.R b/tests/testthat/test_micro_arb.R deleted file mode 100644 index 55b96f4..0000000 --- a/tests/testthat/test_micro_arb.R +++ /dev/null @@ -1,106 +0,0 @@ -# suppr_writetable -------------------------------------------------------- - -context("suppr_writetable") - -suppr_writetable <- rtauargus:::suppr_writetable -out <- c("t1.csv", "tmp/t2.csv", "~/t3.csv") -outn <- normalizePath(out, mustWork = FALSE) - -test_that("suppress unique", { - - expect_equal( - suppr_writetable( - "GH(###, 100)", - linked = FALSE, - output_names = out[1:2], - output_type = "2", - output_options = "" - ), - c( - sprintf(" GH(1,100)\n (1,2,,\"%s\")", outn[1]), - sprintf(" GH(2,100)\n (2,2,,\"%s\")", outn[2]) - ) - ) - - expect_equal( - suppr_writetable( - "MOD(0,3)", - linked = FALSE, - output_names = out, - output_type = "2", - output_options = "AS+" - ), - c( - sprintf(" MOD(1,3)\n (1,2,AS+,\"%s\")", outn[1]), - sprintf(" MOD(2,3)\n (2,2,AS+,\"%s\")", outn[2]), - sprintf(" MOD(3,3)\n (3,2,AS+,\"%s\")", outn[3]) - ) - ) - - expect_equal( - suppr_writetable( - "MOD(n)", # un seul parametre (num tableau) - linked = FALSE, - output_names = out, - output_type = "2", - output_options = c("", "AS+", "AS+SE+") - ), - c( - sprintf(" MOD(1)\n (1,2,,\"%s\")", outn[1]), - sprintf(" MOD(2)\n (2,2,AS+,\"%s\")", outn[2]), - sprintf(" MOD(3)\n (3,2,AS+SE+,\"%s\")", outn[3]) - ) - ) - - -}) - -test_that("suppress multiple", { - - expect_equal( - suppr_writetable( - c("GH(1,100)", "MOD(2)", "GH(###,100)"), - linked = FALSE, - output_names = out, - output_type = "2", - output_options = "" - ), - c( - sprintf(" GH(1,100)\n (1,2,,\"%s\")", outn[1]), - sprintf(" MOD(2)\n (2,2,,\"%s\")", outn[2]), - sprintf(" GH(###,100)\n (3,2,,\"%s\")", outn[3]) - ) - ) - -}) - -test_that("linked", { - - expect_error( - suppr_writetable( - c("GH(1,100)", "MOD(2)", "GH(###,100)"), - linked = TRUE, - output_names = out, - output_type = "2", - output_options = "" - ), - "un seul suppress permis quand linked = TRUE" - ) - - expect_equal( - suppr_writetable( - "GH(.,100)", - linked = TRUE, - output_names = out, - output_type = c("2", "4", "1"), - output_options = "" - ), - c( - " GH(0,100)", - sprintf(" (1,2,,\"%s\")", outn[1]), - sprintf(" (2,4,,\"%s\")", outn[2]), - sprintf(" (3,1,,\"%s\")", outn[3]) - ) - ) - -}) diff --git a/tests/testthat/test_micro_asc_rda.R b/tests/testthat/test_micro_asc_rda.R deleted file mode 100644 index a917de1..0000000 --- a/tests/testthat/test_micro_asc_rda.R +++ /dev/null @@ -1,114 +0,0 @@ -donnees <- - data.frame( - V1 = c("A", "A", "A", "A", "B", "B", "B", "C"), - V2 = c("Y", "Z"), - V3 = c("T1", "T2", "T1", "S_", "T1", "T1", "T1", "S_"), - VAL = c(100, 0, 7, 25, 0, 4, 0, 5), - POIDS = c(1, 2.71, 4.2, 1), - HOLD = c("H1", "H2", "H3", "H4") - ) - - -context("micro_asc_rda") - - -# input et attendu -------------------------------------------------------- - -input <- - data.frame( - type_var = c( rep("RECODEABLE", 3), "NUMERIC", "WEIGHT", "HOLDING"), - colname = c("V1", "V2", "V3", "VAL", "POIDS", "HOLD"), - position = c( 1, 3, 5, 8, 12, 17), - width = c( 1L, 1L, 2L, 3L, 4L, 2L), - digits = c( 0, 0, 0, 0, 2, 0), - missing = c( "?", "", "#", "9999", "#", "#"), - totcode = c( rep("Total", 3) , NA, NA, "Total"), - codelist = c( NA, NA, "V3.cdl", NA, NA, NA), - hierarchical = c( NA, "V2.hrc", "1 1", NA, NA, NA), - hierleadstring = c( NA, "@", NA, NA, NA, NA), - stringsAsFactors = FALSE - ) %>% - purrr::transpose() - -hrc_full <- normalizePath("V2.hrc", mustWork = FALSE) -cdl_full <- normalizePath("V3.cdl", mustWork = FALSE) - -attendu <- c( - "V1 1 1 ?", - "", - " \"Total\"", - "V2 3 1", - "", - " \"Total\"", - "", - " \"V2.hrc\"", - " \"@\"", - "V3 5 2 #", - "", - " \"Total\"", - " \"%s\"" %>% sprintf(cdl_full), - "", - " 1 1", - "VAL 8 3 9999", - "", - " 0", - "POIDS 12 4 #", - "", - " 2", - "HOLD 17 2 #", - "", - " \"Total\"" -) - - -# write_rda --------------------------------------------------------------- - -test_that("write_rda", { - - write_rda <- rtauargus:::write_rda - - expect_equal( - write_rda(input) %>% strsplit("\n +") %>% unlist(), - attendu - ) - -}) - - -# micro_asc_rda ----------------------------------------------------------- - -test_that("micro_asc_rda", { - - # genere fichiers - tmp <- - micro_asc_rda( - donnees, - weight_var = "POIDS", - holding_var = "HOLD", - hrc = c(V2 = "V2.hrc", V3 = "1 1"), - missing = c("#", V1 = "?", V2 = NA, VAL = 9999), - codelist = c(V3 = "V3.cdl") - ) - - # .asc - expect_equal( - readLines(tmp$asc_filename), - c( - "A Y T1 100 1.00 H1", - "A Z T2 0 2.71 H2", - "A Y T1 7 4.20 H3", - "A Z S_ 25 1.00 H4", - "B Y T1 0 1.00 H1", - "B Z T1 4 2.71 H2", - "B Y T1 0 4.20 H3", - "C Z S_ 5 1.00 H4" - ) - ) - - # .rda - expect_equal( - trimws(readLines(tmp$rda_filename)), - attendu %>% sub("V2.hrc", hrc_full, ., fixed = TRUE) - ) - -}) diff --git a/tests/testthat/test_util.R b/tests/testthat/test_util.R deleted file mode 100644 index 799ba7c..0000000 --- a/tests/testthat/test_util.R +++ /dev/null @@ -1,135 +0,0 @@ -# cite -------------------------------------------------------------------- - -context(":::cite") - -test_that("cite", { - - cite <- rtauargus:::cite - - expect_equal( - cite(c("A", "", "C")), - c("\"A\"", "", "\"C\"") - ) - - expect_equal( - cite(c("A", "", "C"), guillemet = "*"), - c("*A*", "", "*C*") - ) - - expect_equal( - cite(c("A", "", "C"), ignore_vide = FALSE), - c("\"A\"", "\"\"", "\"C\"") - ) - -}) - - -# df_param_defaut --------------------------------------------------------- - -context(":::df_param_defaut") - -test_that("df_param_defaut", { - - df_param_defaut <- rtauargus:::df_param_defaut - - # fonctions préremplies ................................... - - vn <- sprintf("V%i", 1:4) - - f_vn <- purrr::partial(df_param_defaut, varnames = vn) - f_vn_totcode <- purrr::partial(f_vn, param_name = "totcode") - - df_attendu <- - purrr::partial( - data.frame, - colname = vn, - stringsAsFactors = FALSE, - row.names = vn - ) - - # expect_ ................................................ - - val_defaut <- "---" - - expect_warning( - deux_val_def <- f_vn_totcode(c(val_defaut, V3 = "T3", "drop")), - "plusieurs valeurs par defaut" - ) - - expect_equal( - deux_val_def, - df_attendu(totcode = c(val_defaut, val_defaut, "T3", val_defaut)) - ) - - expect_equal( - f_vn_totcode(NULL), - df_attendu(totcode = rep(NA, 4)) - ) - - expect_equal( - f_vn_totcode(val_defaut), - df_attendu(totcode = val_defaut) - ) - - expect_equal( - f_vn_totcode(c(val_defaut, V1 = "T1", V3 = "T3")), - df_attendu(totcode = c("T1", val_defaut, "T3", val_defaut)) - ) - - expect_equal( - f_vn_totcode(c(val_defaut, V3 = "T3", V1 = "T1")), # permute ordre liste - df_attendu(totcode = c("T1", val_defaut, "T3", val_defaut)) - ) - - expect_equal( - f_vn_totcode(c(V3 = "T3", V1 = "T1", val_defaut)), # permute ordre liste - df_attendu(totcode = c("T1", val_defaut, "T3", val_defaut)) - ) - - expect_equal( - f_vn("param1", c(V1 = "T1", V3 = "T3")), # pas de val defaut (NA) - df_attendu(param1 = c("T1", NA, "T3", NA)) - ) - - expect_equal( - f_vn("param1", c(V1 = "T1", V3 = "T3")), # pas de val defaut (NA) - df_attendu(param1 = c("T1", NA, "T3", NA)) - ) - - expect_equal( - f_vn("param1", c(V1 = "T1", V3 = 3)), # (types différents) - df_attendu(param1 = c("T1", NA, "3", NA)) - ) - - expect_equal( - f_vn("param1", c(V1 = 1, V3 = 3)), # (types identiques) - df_attendu(param1 = c(1, NA, 3, NA)) - ) - -}) - - -# following_dup ----------------------------------------------------------- - -context(":::following_dup") - -following_dup <- rtauargus:::following_dup - -test_that("following_dup", { - - expect_equal( - following_dup(1:3), - c(FALSE, FALSE, FALSE) - ) - - expect_equal( - following_dup(c( 1, 1, 2, 1, 1, 3, 2, 2, 2)), - c(FALSE, TRUE, FALSE, FALSE, TRUE, FALSE, FALSE, TRUE, TRUE) - ) - - expect_error( - following_dup(c(1, NA, NA)), - "manquante" - ) - -}) diff --git a/tests_multitable/create_corr_table_activity.R b/tests_multitable/create_corr_table_activity.R deleted file mode 100644 index 6319eb7..0000000 --- a/tests_multitable/create_corr_table_activity.R +++ /dev/null @@ -1,25 +0,0 @@ - -# devtools::load_all() - -library(dplyr) - -a <- sdcHierarchies::hier_import("tests_multitable/legumes.hrc", from = "hrc") -# hier_export(a, as = "argus", path = "tests_multitable/activity.hrc") - -activity_corr_table <- purrr::reduce( - purrr::map( - sort(unique(a$level))[-1], - function(lev){ - res <- a %>% filter(level == lev) %>% select(root, leaf) - names(res) <- paste0("V", (lev-1:0)) - res - } - ), - full_join -) %>% - mutate(V4 = ifelse(is.na(V4), V3, V4)) %>% - select(-V1) %>% - as.data.frame() -names(activity_corr_table) <- c("A10","A21","A88") - -save(activity_corr_table, file = "tests_multitable/activity_corr_table.RData") diff --git a/tests_multitable/data/corr_table_nuts23_fr.RData b/tests_multitable/data/corr_table_nuts23_fr.RData deleted file mode 100644 index b1dc0e5cd3b9c789e5e38dff31abc849163d8e0b..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 474 zcmV<00VVz)iwFP!000002DO$?Yui8&#g)ho#84=-pCe>vc4qh9(sRivH&^-Nlbe9- z(rZ6TKWW_+DD7`eLn9m?B)zAddGlr#ExP)6t&8hL(==@}J87GCUSMZbX->z9haYYeU@Ia(x+NXP>UZ<#DluiCA8M^%)#r z3EK;>Ps4ioZydu!EYDz_hAkX`Wg^yT*uw!>j*RvHIE5o)nTB&X0Lv?3t#Ew~&4)81 zkO+yAL=q!$l0=gK5($AsNR$M1M3^JY5#}hvlwpx8v09-(WYK6OXiki3Mm3|FGt3$0 zRTzpYcR{%ek#mcoT2T_HMb0g9ZjqykTCGq`p=NYobYOH~p~}G!jdqN7jN52J0U9+L zH5xS?egPERq2x&a=xL^YqbwAKc?y{}-Q35w|TYDncSE(H~yT ziaITi$|yU$(xo6KASQRzd;U5)apuLiiip~8hvF6yRmZ$n#M{1;OZK3Xj?MEqXhc`nhWOKImyV#1e5d&tyrwKWOUy3jEsMC8lxg}?B8@O zWT||&d}byc5zh#dwm!P8*+gTd3`E=^@gh*TxR-f)8yzaL9HVW%yq>~%O60>c5g!_l zM5XaqBx@l#pNBJ3O-!Oh7IQx+w$rN2*r_fq4!3vKYr_w9tvj65kxQ_FU!Wofb);nN zz^f8FHn`nykeQ=8a=&cg)k0vLN)HnS4$Eiq?&zlr?_NxhH?V~=k{w08$zeJ8@Pva! zf}%V8sm-gxu&52CCqhKiFW;Tr{{92Lxr0n#xIT;XE{gCjit#Rr@-B+=N{H}Ei1A8@ z@=A#FHjD5!i}4b<8o4_exw{$B&eU&A|LU3+w_xMr&itFq$(>n~ESW@fWf;|9)nz0o zV8h0$FJ#BoNR0iz#s|escL^J9?6!q&)VjDYi8VXZn=}&t*WH`w^8d32=OH688(#X_ zG-AV1r3zWrg*-B+$sY~&eapgD$8+Tz<~-`>xDc)r^$@t)PL>w2K%06 zVawypzc=ciL0Ny(G(L~ASJ+Z4)N(p4{cLa^F%q-o&8|(;FdQvD8v0LLVJo~)OXsu{ z+u%H~ENp$8StBcI&6{15Hf|WWTOsSYkS7V%^<1cxbXvNHBLy7ZZHcjnHWofNHXg73 zxBOvBzXld8tdn)>l08_HRqB!*S(6RxK3X5P*HEo5F1zs%im=m(ve1chXNs_7ig9O( zvSebo&TX^)1AXPnnr!(GSogm`*5tcta`P%D^?yO=#JK;9;{FfnA7p27pw`9Oze#ZT zFWGQ2+3+vJ;R>?hcF8FIB5`&)5f+c^R3iGM*sRp&f1bsu*o~|1j;jRC{}vq1H;jV* zuvx6InX9l_sjykDuvw_ESS5+EU9T-<-A6G4o`(XDURLegU+5e(` z{0B8t`pVA=qpUTHam|IPlkhQ!f9-?$H9sI-tsz;!E#THFI1r7Vy$1jI3l0Wg+ELQ& zC|~7$=7$8dGNuSqvd3Fh&Rf|MXNtlsNur&&`oXX$;0iw&E&<@+#vDju+JcblLL=aH z1B|cMy=EN}L;=J&ouW+-5tw=d78ap74xQIlS1%C;F#-9W!C`pnt3iaRc&bhdInl~) zx!3-PANdqChyLlmr=kc;wmL-Ri>yG;+{UwJOJ`ny0-mk9BwRydT4yF9B^vP6((nb` zae#AE2{!WLAZqSgnX&edZmBgbE&>yun1uu$IZY_zn|10a5~dF&P~Nhm5Aw{uM$wJF z)6GZog(s0yMYpMpcJhtNu#VC}-2AVDlxxRpuMNnXAiCet3Q+q-_%)nzgw9a~0ZDA> zJd^;)wofHBI(3;$9;Uv#ezZ!^KK+o0auPYp6<rzGzy z@fZbr3v#?_&b|Qp-|MVF6{lKULS%f^70m>jfy#34rxE6d=BkJ9<&m>D{EZK95z2l{ zCYk3X_4}HW_Idpj%Xxyr{4LeEQ#Wbb9fi=tu3Jk5u`|ypjp1bK3y8E>w@(wuPp3WY`G>B5jd$~wz zUv>Ix(0>kp(9L|tm3UR&Ch}qIW;WV?^-eJC#+-Qu6u4+M{iy;f4AB~J`(=I!-nbL7 ztU3jzC?~*g6=dXqq6`L+Zn-6>aodw@(ZqP}#$dzU`BA39%%_gPFEWfAmzR6~R;LMP zJ(mn=Cz_LyaIcC;HLv^!!C%Dj2|Km7!B&%}ta%3BO3cuK_;}0|g&*Jr-K6Ke3xhZl zu7p`c9+S%Kj%8&=$OFH`zR7Wx`uk&o-{xT#y)pG5Cuao9MpG-oWD06)u!_q4)56h5UuodlCeP1q&mM&3y&)kd%+* zLN-o{?}waz=Hfi_$hpDIb6d>;Sgw6Id{8s2b7J|@R0WkgUvdY#;czZS4VxhVQSf0O zjyycI_V}r04X>3N#GUlUU4vR5OvJuwa|8I5KFIxKy4id-U<(lMJ#b8pNrsDg4WQX>AdTG!jlJ)K!j7URzSBwpZ?#RH zn>E2D{AAtId%cUmV)0?J7q^XJ2poqb634^Ufc!Kwu@8tQ?Rk z=M;|I@H4Na11F;jD?IX!*jZ?4zUYZ-vb|6v;mv=!>(}9u@QWko+UejuLkS@i)|?<0 z3TKlh1Xqu)G`%;R0wfFFH1QNwA0(J(mxH1DPpf9*QqJTyha!UOnJdqv6i{mxV4La^ z?DV)8J#iDQ3~m|l24qj=>Kb%T7YgxgWU6!hc`oBp-+%Yjs$fH6K(?oPU$i-R3nGf` zk()L9CgIY4O|T1)WuyqTtxoWdM~T10Lx8RV1BmiKan+l#Ck0F4^;=c?nM|aT}2bc2YeO z_LWZv`0GMrs^9Te@MdQ=-Q}`-#ea1#s{vxGw8h1N7|`EFnoP3K0*0vd zzI<%?FlS6Pa1y(ZWOAP7oD}&Zdim;w1AMyIJ4@Gch=w_^g%vwL*L8I>`Uh%b1+guL z;4OaE&ff3$^OEz5y`_I|-ZR~f>)#L#7*s z78p&&w*p%k%^#nxXfExUfqxYq`8sr8-2 zHAh_=@8T`yn@a7g`mR!0j>+`%PpbJSfHT(0r76LVpBZ03C zLI;;y=bgXl1A7xU1+CjU39*DveFh#z28xn;V_of#@;H_JDvl50zL@lJR7R{L%|a#k zhZ*P2l3cVwctLBo{<2W!MyE=^aDyb{6brwZSNVEm5_TZ2@{)~0Nq$o0A<3U2vW11; z1W?qsAjRjC8^P{63(FnA1y#yioBVUD1>$F`3lm+(u53iD{!WN_Qfci2Jotl?nckc9 z&Ph{0snWOc&R-XtDG?nG?U`RiUdIlttQ-bVd!^JWi8sif-8d!fuBCD1!z2Q|3t>2v z>7svE>Bp(|_8*Tja|BR_R_#a977g1^8^KN)FMG_eO5i1}Ey9SxNHva3(sbfS2&cwR z(J=|%>_9#D=LO=^&#EvCYu`gx;!8Cm7~Kl^-MnMKeesIdUp`RM@{5-~uS=S1j_}BXzHf0{MnxFsv2*d7TIqUQbHj#929j48y@_9P8klTKK z<|??yM#Y=eUPD1UIlRQ^-GgQ0``U|+(erUD(_sLhzwyhIO45Fyk0+Mb{OQ7t%@n8J zsv{i#yi2?*320l%iYAj7@S?zXhSRsr4wrrrjdhbpk;iRETKh^q#2a;h2lDd5IIHe+QFJ}a+ zTH!d)?e2-i7k?|~;oRzcs&;i&V6a@k>WE{$_oA))zS}J8t{1)6tbG2#Kr?rKQicmz zQu$+Qp=vFSRdM_)?1L(=^H}Wh#&va3RZ|5)kCpwii2e%4yFI2Th zzy-2F56YsKDWxkF4~vz;M^mX+;sKI$md-g`0;s75S;V6J`T}Dxtpj;N zo~zP)rDqtyGJ`E_VbStqL)9(YPY;*)yaEzfKi=yInLD@d&BXxu@?0L4$~RPibZiNOU#x{wisYu#gt=DOwbqnwE{ z+(yE;*8bn*NhvfR{9rYXnZB72HSi0RqA?ZRaeS$?KRvJg{f zsCXefbn+ z%{DI;&FnNLyP&x`{j`CD`&N-tO$QGlvRljfr^h)}@JcAwaUZnm<8U)xvgyQoplY>( zXN2FmT_OF@4LZp4EwGaP@EwA@&B=vX*5>e?8@L2tws`dI;pil_Nd`@X*@F6w6ug9# z%buF^IQ0|ux#NKvU)HwF6mcuv{O~1v>1*3IC8UpHOUN@8p#p~bifFNQ&FXi9^z8O&gGz<)1v#%E zuZ|$OG+0URf_P+f4Wr0!rXs6w-MRZB;lTcto8TO5S@zFaeKOApU5eVq%U06xke3II zzbid$4?$U0ZIV`GxcU2JtGy0JyhHkcDvZ!?W-pJn0124B;6=Ub^^AwV@?Ov`pc&Lk z@>+>>#e>uOR|NG*dPnS0f|>l);T9Yz%4I+`-ao-(_kzj~L=UNAJjvF3N}> ztkw-C;a%%Y6;j-I@>fJ)ap9k2m+Xle0s~{Gvj($iZv6K%*9%X^h@VVuLjg6Qh{E*Y zfcEw};-hLg*TF;Pe9ndJoC@)mAXB<(t?k&y57;bO2@faV-fEs-bdf${`8Xp!gZtre zxuNvkiRXJU{`!6TYjwAG3_t840Sh-3Z)zYe@uNcq3Lx3+<=EG%N)UUQf`iutE2Dpe zu<)j@8Kj5xCcOSG>*z2^NHN^Sl}r*pLJBia3RFGL{1JQ@cr5YFtJFbkkC?BKKk=X` zK<~JAtGRnK$OaNl^AN&3h1z_r=BdKeN+ zWs~9krRFtpOVUNzFGO!-I3!S18LwhZ)2r)A-+ynpX|u^89+B1{di-r zqmNu$>mamQV7gen`9hxM=Kd2BN7m(WTK^VC|2CD8yhm1FzbMkw=hafgxN@d(OZ(0u zL9U0VbeG!pi#8+f0Ht9p5nh#v(s?zGt6p7M;JT5up2#ub&ZDd8Pey+vtmw-R+w0u# z?#UcrQy$D98mTvvsc=oAg_KAV09-#JVC6k}wqpMw=_mznKUe8PEj&$89~8-O>h_qO zrMhXd6^(sW85(gHVS>}PNHfw7`1U8nU&FhT_X*c;MDudd^DzS@mt-G_#}m2QGYv^G z-Hv{17qO7={N##~MNWNs6S+ORrj}0JbaYBA@t!Y$S61KD7?mA*gY zTtx&xN07|=-Tb&kFh8F|doW1M?w642o!AlzTGi%^(c{mNY1#{ZT5ESevd=$Ds(1Tr zFjX5f-Hsz}?5&bR63kZNT@;}ip}>jyHNciROS;t5NXwVSzbOW`b;pcn$Z|c z)X`Sd1nu)fwTjJ;f-*>ENdhyaL#|S;wEUQ+dL>8qA0F>>WTr3HyNpbJtR_Uz6N~I- zGJ^1H<42Ipteyp_aaXvXax;%)2oesfcavh<6vuaMuHCi7stNC~{PhepjO-eySM|*Q zkkzeiVw~5!%{e}oxCB3zl_KFiHAGT|+YueS;0MIs(tR>tW_ml$KTQ7?pbQgHqVf^- z57pdf(`J75_p+;xG+<7yIyOD(I}C4i>fk-_UJfKO zr}s;CK?2muY>7lUA)r3ny8}(pdbBC`(hJ0ORjQ`3sx6Qbmw?P$9`YXbnZmSI@w&+s zOjceR_|cmsN_%^Z2FtQtRp#S0U_DxzA?{_xUBQ~ZQ`i8_w;V2`hAaI)OOB>1rFq38PhR zY+5M_T9cebV=c{Vf1Gbu){HNO=@SsdcpXduMU=KA;tZ40-}1NAk)8(RU~nHi1{bl| zhvIZLaUGVuv77%caMi42gM=gV_NK23)iEPRdS3U|+h}I{MTv)v@o^?5!NfRa@)BLe zGx*5c^Wk0pO;5ro2*qp_UyDq`I==^0C%_hJXyxOu<$}CyFyCq}-0e-89td0X>pTyh z`$AZ0RV!}^YdiA@T&r<<9Oz0G?dyf~YRk5ZQO+MUcJG~ZN>Ce^hQg&xcVXyZp!&|htC8;r>P2T8U(C!0P| z-E$Zv*_2Py(F5_?uZyqX_c{TXk5t>_*1*#sLdOO~fJM@d^!g4Zkp7 zC=h{_R5p;b!)83{gJ-Fb0K4EqWAc+Lz>kVqJiNgV6%t-QbBw=3D&2G6OhOl@&e`=i zhFXa3z)8#lKBZ{@h+Se~)2jaB3|HZHlOe26z)S&_=tU^c_L#y4X3PKGZ4S;;NDiNqKq>L0zu zHm-y=z2G#QtrpHq6r}dey*Qhv@e6u%I8VD~U)i-qSGD^cl_H@3hq>Ucf%+|#E};LY zq(@X>!=U*-`X#srLXtj;Axg*4@nM7`?wjZ?*6sQ*@kw3M_qegQ^rAw$2Di9_qPtCY zV{YRa>sk017xw$6%%>{@kkXeJ9@>k^P%`j(EYXuS!EJ-v3c7RD_>XlrrTZ!&Axgi< z^{kg5QEN04?Iofs1B^F-`*`w9aykPnJ#fD&xC>IU<^yA)FQJP*&$vh! zoO`n&#tP`qFc;i3P`{(i;loXFf5I8C5&@t0$S*X8)En2(NRmxwy zlD1J@@QW(h7+NDew3w>5n6f*1y1vIHiRH6xmVUDaSA+(a(m$|qaYp?IvIIS}pu!Y4&h6+Wa>g=O~tXVz>Y4eiZ!jFNRS6FWYFxQOY`M z&QOl1e}pOjOCS03|L8Ti1~fQBBMbh|@qe?HDHW}B$D!(;?8mqkj|1EIsF}W;>29Mb zi7_i@@CeK@J^I8J@gMDO8nXwyT35s{ewlF#?gc|m+!ls`r?1h{uD8K~H~)r~(F4}= z9$GeiNkcImiKu^0dD%uxE7rrT_(pY`**hwG`>Ez))|9qsbEjcWMg`1WuF^8dCYWDzI-)IDpW)1iX5%9=mZh0O)ujxe9d&v zhaGCIPTtMV$UoD+sOuK%VeM}An$&h0kee7^or2Oj?WcvDVbemCszBP^w7oBU@2~N! zIK-J?^w^Xh82kYqd(r`S;=_dF6hNBIG=s7Te@6FEl8^a}%zF`C%1P30ET*!-V~vh5 z53jz7B`ev0PS#67rsRzxRX*5Vo>|nnL*GPauAkY1(o?GmSM{>rDDW2L4SlyG(~rSR zaoZ-Qn2?s9o{HWKPhOw*qg08{4gaDM4<5}W#lN9J1n z_X3ocOp~Mf*v@V>cmrOHv)$&*OKZ`)B!$<;XP#fXrpd%-4f(QKGz*g9dy(<|QV_QE=aJo|V%IiCA4ViLTon&Q5+jx>=uv zIoLT*(05eb2mA!-V|su_Rt$(p$dz!U7%Q=!a?*_Rlm6LIHYc8TFJOqt%6Skt0nl3NXH7lI+Q*n&Ld41 zXh#oSzf)tdFKu|CDJ)D1Lqzm#B2pwIT#=SRtbywh(tayU9On{ItEtBx7~GEjQ+xG+ zA~(0wd3j$h1#2+LK= z$QJ|GuXkS+s&u#mKbTG|^!xQE#o!3m9ySOJ)UA8VV16;HS)B)1{f$0)2(;VsmS#~n zLmI`FyyqJ{^HY&;;(!GYYO|lHJZPl!-{h*})MRpEyMtYX&u)jVhMFG;o(H_ zb6q-9r2l?gwXKMbPEfZhsr9|$K$|E9IAVC?UTMo^|0C{YkkPZj+@3!0Y*ozT+Y?@d z$4U!fzx~L2TyFX>SP+y%MlK;P^kFo*@BF#Dsr!0egY+7Zi0(BlScTXx*lz%T&he+^ z_sd3Kt`pLh&I9ZP)G1l);W)(^x;L$REBUa@{`^5~CKR?J&uBf*p-!=4P?_}uwaFt= z^~>-UxuFv3)0k#WRB7JaKwl z>kfaX8o>E^-dIS(7w=~d4=uhOziWw5 zsNIkW3iq{hV?29WE~K*P|48X|I=C(Wf^jAGV;IME&ZAxv8s0XeAle8UqVhBzQ-b)N z0m;mW5{rMiq=LWl_)CEZShL-z>(h2$%bhSf{S8oRu!mvW%`<^_&bHg^!e^BX*Fh&8 zWEP1j?#N&JHc!+2dkvXZn4N36>047%-~517cH^Cxg+&o0$KYZX@q&dLqueTEA}DJR zoRQJ-y*)c^h0AjqA$P;}2?smtksBe=_IU}*kBXE$JBlMAJ-1@a@U#0z#iprLd|uLc z(jx|dvi<-r0_}lM1SFl&F4`_zI z{n<&sFVu(T!@D7?#j8Ib`MUw1W9*+=i&Enz;65-dk%S0~KZ1;w1Z)?6o?7>}xiCt_ z&v)N*30)@*r2Xo8p`$EH=nfT_Uux%}!IiI9!=Sma$Fx8}9xV<0e$1Dx-uvfDw0@0$ zZ5r=__Fx^~d#JyS7j-C6`cO$`RE*%S(<~KTdt%r z3J*GK;E|rd0!d-V7VcL~uUoE^1h1n zP>>rfx>9&ewz)f4hmt%wO7QdQ2RtI$JE8GZc9Z|Cuhvo>KAGRRXSIdOOn>835Iv1c zXW)g1XN`-p{@ecSpvuO4<}D4BRKH}ad> zpK+bbXz9?Z`K2YSFI4%K$i;q90Q2h+{{1>tACVzq?pDE3UmPNdzqQ_1=+qbB;H&hz zZfF5i4O%2r#PP_t^JX^ZJ;{q>q4S0|6M@oof8@#7Z+Z)e?&kE`O4yV}FITNA&)I!W zc=Zm=03uUzeL`%4K`tC(UFNFZ$!0y1@lDr+xfc41W!rQW4<{_+S#Xjt``7r zw(*jx%r-9Ux>jrK6s9=aiv@h=zc_p23Th51Cq*uUCh^Ri>?=*h#qC|t3-_brtOU-u76HmpK^46vEKiWg?cC=PvH7|vq#OqdJ zi@F>?f)15fFzGoq>^S@G1^Q^bu-OYM*Aoa&!ZKbeV8y##!%Kw*jtqE@gz;G|F-JGU z75boZ&Vw~jiw?n(cI$b`#Ee#3y)|TD{?Mwk)R#QDpoCV+FZ4i&C+-P@;KgscE((}YXfWj2}_*ITHa#!)0I0Muy z!-|uJZ$KKI%2boiSa(j!ZpIPZp-OM{e0LS zW6qFPA;YNXksCtigG1g^iFS7lT<-@R{QNe+3GSq96kgn#p`?)0|q znCQySJby_0+=N?1m;_hdWT_uVELAV`KMUBYH!pD}Ct#h`kKj!WPp8o0os#yW<%Ik?8jgPOYO^e;bEo>zctv5Yr zky6$Bx`#o;QUJ=|XZ-nd>};o|33x9cygX~c2G56(gGavw!ap9O?#vRY!zNrTeKesw z&!**2rMWXAiSk(n9U}EqNU0ID8R7?iX~5g&5;jVOKbHd@O~TRz%I{%rI*VzYxVrMc ziGDna64W-W%O)wk%^#`|F)A>U*{mtLmmF>39&EjJ-Rh;4=Q<`u9ZsU+4XQTeaiqA~Tqy z$*T{I$A}_x?mZ93@cWRLgm2#l=979_ehZlb%{c6kzLGy z&NGA8GVp&zNiUvdpk-PHqgQFlJmPHPQD!BVoIx7N+xe1o_1ET&^szb2xsqO!gxh>4 z83qoOQB2udza@A!_HwGOk3K*0+MGL)$`gw0FDgs>b;ZjVfNN7id=@pH{o}yq=$R=rON9x4_Nhh!_TbLS5oOtSmq zGEbiKv%IMbdQ-A=Y@l%Z5kf67E41DPVh=g5F-Hhq(XXTJz%~`){zzU7mT-b%4#(&pW zC28{g@%piS$YNIe-}L+(|@(j=`VWF7W^h?Ntu<=K%Ap z9tPFx4DLVOl94AS8J8}QTzIL%HTT1v_Nq1_L>gKDzJwvpk!Y?i$B!Tzd%*1CJ&Osy z_J@gOG30x$D}ubQ-CxFKrrZzYc{#1|Upy#WCKy*^&mR*uYTlqpxSDQUz*qG|!4iLc zV7af{_Vh5eT~jKcd|zis%133FE{j{rT;Ulloh68AyR9g8eUtwJs)Lq@D;WWD?LcAW z3g5o9enf0*W$q&*PZ!|Y;bCY#N1RjDhFp;JjfhX?>TGnI)2Y05p!fn9LsXn(mrpT^ ztQPso1hzaC5#n3XkC(!d%2lXpE5{ou&rXl{W0ZfP;U{O~p@6jaLswDXc8Y^!1A7J9<*>AN_vBD}AhY zA>RAtIujiTkoZ9KMa?pK%D-VvgpZU?gYnc_hB|;dtv{Boi8(j3F$>X1{o1&Cn77xEU^L zWOU6YAAU*hcQ^7_LNvVW^zD|;UF8WmZh^uJd1dgn*EOqNhaEwjTL-^*)BvCZT<3Ey z@iUyu2b9+&svofdd7}_Gli9zZ_{RA#I5*_a@9ArY`5ptePKC+0sd-#w(r*YeGfX)5 zu?gTHIMl}M8`ETh`fq{!EkQnG{IAcY&sw>h$)@Rf7%ikYASPqj?#|QMx&OBqFl1{;trX$lZ;mo`QfUg{P(BQ z5Mk}RfdN|-zL(wYY$88(@`5&91E1qMrR}by-alE1dC9MZv)7SF7H!Sc-hpndytcdzG zl-zd53k5bx8(*R(+C;0S>^(=$qDXTUc)HKsH>4P~gELQqYV9QgjBmbfL*Gz&UB$`; z%O$#H8;R=$kd!}2#G!Mx%yyDUpEf0z}9RSsLbZd#DhVqUF$vq3oK9exKXIwH*^cbB031s%9&%2)KxlDO~BQcLmpj&dG zIZTM(FA+xYt_~r?EwEKqUGe0fC(rldGsRzLfB1_VXP%nvKat@3jN*nhU@4F&T%4m> z`5Ct$(!;KnwBC@(O=-tt%l>?yxIMVb;>t!HD_q0+fzLo7dMmdE&9V4Nh?FQk-r}^& zp{U_Lc~lqwB;Uall+<&z4_nbu9HBs)^Q2du+fAyv z%^Hcr?gjGVJnPrJ8>0hHs7s7>%M?)weH2mrt0>pO(#d&ONuI)W4iBZRnEyCKVQdm_ zYMEJ3%;Z|HI;A=Typwu5C|0UgDmrAE%Ku6@ko%g7?N??!YbBMs`uz4Z+ligDq^9Lb zhM*sSBzYy6|Y&O28h$?7M zN@%EAX3+jhcmMM_a~bo9tEJZiyMIyz_PM@CyX9VfI%%Htoe4wl?kM{O3-VWCZKToQ z6D`$=%#mu>840MeZ?H(ZL4y?}X3Rq?Gc?jTKhS75&clFb=~_{syAq+PfM*>GFw`RA zOY5HkbQHd`d_Mi~+q0~h=v*eFb=Ejh3dXw;*hhi^$UPA1Ze&t{wfHfR0dIrC8Ss=RHLO_S*kS$tCsF0&f{tD<6w2UJpB zrRHpgX|jPYU-1lt=qEp$)`K*c*yPuMsF~(3p-Jq1dtY>%o-3lw#>&sh9hJG9p9Pem4QsZ=4o}&t%X{lKj9RXs$1IuJq#nH94? zp5YwxKR&h=E(3zuZd9w?LxP@`pI=>0?FB{m7XWK~>5`0}v$a>h1CcTmUUGCZqy+G^ zXop;o8mDJ^vX@Qn-IsJS`iBfG>?gxmxZXP&^5Eu_LHDNhaFFXx|30DJb?=~TCuLaT zX;847uy>)fF@!EwEMT=5VPVF??rr7=jM3za`gNGB{h+MHl7iA+^r$6mZncRH*FSgu zI`NJs;N-X9mhC~5h`yNv=-V1!j(q*6^mkW#gIH$EzP5XlSS47te#o*L@#dj4+D zFnhu)n0(FP*@}>)ecm)k0hX2dfZKLTy_{ezCs?BJF7fZm$o%MRSW>?rC_@KL{+CB- zX$#Itzj;{sf!=D274zzCi>~$4oh}P91;AG_x*=wO5HF_WA_XJxAInbs*WCS-AKU(~ z*~GF6|5u3aasg%x|1*rH-PhU7_Wk;``iseb!>b52xFa+;F+{?5>q<&uu9+97p)cvh ze&6fM@L({|;mEZ=cQKEifI=&y$w=ivVgMZ>xVwy_Vv*?x%iD$ktUsBPSL7w#zE zPSmN(@njn&=@h+sxcxtu4*v<4;7D|!e%boQDj0~lmNrEpkawpSC#Q5#n5a|q$qo9y z_Y@IO)aoEgdVB%6)dtozM;iwq(_vlfg1ksA>)k@6$e6YX{r4q*b2HiQ_07~bSHb6* z8J0dDyQ5w0*M0lw|2!QnUiQKh-uNi@ROnGt8B+-uJJ|zExV#oyK=F$`CjhjP9+(p$ zTX>D1LA>+LFy=Le(e9V+fCaEr_^6xlQZVo^QP|F@T)^iht_QGU99VXR+C~BGni8HO!2S}fYtkbG<`r_q^EscbO5&8Kv*aH zKyh}>2*^vzUMqz1Z_eLBXrL4%v&^UZe=VOt+-e-!ib`Xr-JqPR4IkK6=$`owh#mM22}Y z@LbC5&o`99#iW)0J-P>bEEvySW_*;)23^^a@X+dz_5$kV_$;q_zu@-neMoa|KglAq zAUz$>RwdICq8_32k%_MP6BpkGWJ(G-L(f%`S2Y|aiUzoYzB{k z5Kcha->ys$5X!9oLi40s90?O$j59D)>(Ywt?0&spInZrh*P&Yk{CIZgVT64HmthV9 z5$Fzz<@Fv~&G_B}>e*fS?U}1Czpu9L5KnNIz4T)wZyWyOfl|xGfvVlcLV9zGh}tsB z!YpSN<&DXoWP+WPVCPj+g{P?f^aUbMzsD2e+vrc?nb)5qkB0@XMQ+%c4Bp~*CR}mY z@%+oA(s7nDYU<7}Etjq&77u4r+|dZTjC@wq#*GjPe*mhF%^>a+h%fX3@(FgX-Xr^l zkhXCr2#4YHm-#u);>n1DM4nCNp=0*hebr)2X7+ddwmnK$eqJ-xE@l<;vt~$q{_(?+ zav%eIc=ib@_m+AcY(?yve#H@OnLHp&WDQ(-SzqydaInxZ^pYZ&VN&bfMS=S3g_KOy z{4owJ2!Iuza*XbOj5&PKKstdSEPP@JzMMOk8Cz!`A~GvXfWQxWo58Yl1D@raH=a2% zH<<0DMRSj+(4$k^4i7Z6(byo-qYZ!X_%ZKM6PvAsygG=BmU;8(U~n^MiotVtdGhAa zJ6<356W^nc3K4hh!?!Jxcu$T81iV+>cuv-@c-q&f;ZILugy!94s$Jutrhvx@Zg)Bg zX@^-*KZeV?Czsm0@9jWce^WF-8$PoMg4bZPGqfH%sf)>F9usIjKxQJYtQo}Zv?pPU zYMNsNgLg$_f$}htYWbf6ktZ~P!8-ixz|HpSS!U}RP$3e30uyW5T*aHv1yg$@GkIz9 z1hUD(f0Ul86N)yM#9jxXaiAO?%{7#u$l~~CvAr2_W1T$YDATl-&hkeH=~&CXD*e7{ z9c7%QQ!*SsCUO2}HXbEHsNR36yF+fQ+bk}-yfBgbSJ_#*(_Tmh0Wz>gyipn(!h3_P z7x!cOcNpSOP&MXDwbFM<4)ma)8zgOf40^9gA*KBP3c1UmIJ$LT;0Z3l-3AYC0fM^* zLI@Dt-Q7Jwf?IGOEVyg%;O_3hVUQrh00YCFckg}9J@?DGRqMm*4^P*s>Z-0@y`KM1 zsBK}T=UegS(2y#2@Yl@U4@Oj4nnfZMsS7HP&isOczj%{ye2ZwRm}8cWm5j-Xv?nld))U z(iQMXM%d=3eD`7cW=Bxe((=QA=uCZwMH9;)aW&q!l7EU9ZfBp?xPjdZ0?LW}Bop>HXwij515V>#%aO+1t3*ilavxW_Ne5HZpj${Th80?#utbbr z6}84c+2Gkq$L-_Gu!IHT)Q^?Ah}hzYn;W2<*>-fITkoR?&GfkOQz6_Ox9anpjYrma7*$WmcB>De<7J@1evbK37lCv%X7VHeGHx6 zOg2 zA#Vt^N8z0R;AFIYGTFcx}M%P=HkAdZ9p!R>GA|x z@1khLH&AAAT!;tz7xGo4JAfd^i%7VWUOG(t%9wKfRqziURH>zXyZ*^y<>Lt5TESI3 zE-7}`q4}dq|8IwkjSIQybcywkzvM1uLV9}-w#bdMhs%DBn^ywKh9ys{#!UnURcUyR zM>fE;ZXoS))R@(;@X}G;1J~^e*S^bnms;EwVwRsVqwp;ScyJSmhnD^t6n--uBqp^b&Q~ zTo*rHJnixDo%hm>v}`XjmHprDdBozpj*)KlX@s~R%b0Y^3R0!z0M(MTPSn(>lF+tc z)q>L|5o;3YrIePkQP+bN7?EK)ecYf!4B;a=;C}skTfwcRpP>NZ#H&z5Gf-bDquS&( z{>5N=TnJnkpVm+kmWC&AwO0`_F zEK6|;^)2-eOYbc=E)UpjxBuA8?s{=)!E zo~hPCZ2~t=O=CYLPfW&D{${htdh4sx`xES(h0@Na8W(o815P*Z0*I-}dxpP>jn4p= zsTJcx4>qLVWD;2%s}-!}+ZB3bUp&>B+6J6SDTXoJm5Agyqvf`Ljnz0>VaYqEak1x` z7NE%!1gK+w_$VD%?%4lp5J;{66wt7)QeQ31?d~^I|xMy8EeN~ zE+^iWDz`Il54;RDfhnnpPoBL6^|V;Gi2d>tL22p}?c!fb1tz0DcC32);fN`0MP|&J zB9-;%n(=6}poIsj@p1)#iQgE7ky4I&pfaI?Eg^v@bk2xVh)E4HGcua&cFrJa?s|Qw z(NA~n{av#AZ)5hvIC)!jo&GRrO*uN=q7M-+7##+XkE5kMF$mCzndwq-*w z*cxJn%kv>UP4qY>mcEDp{tJ#Y4e|{r-{Arx06UnRB?aoJ9oC0+^HJv6vkTW@U8ciYezLK(oy=AUz9lG zUhgTB-6d4L|EA!1pB~4IvC6Tn)c6W2+8kU6XhV3TRp}Vu%|*qr{PS7^KpJHDY_i-U z`>GY=Q+A92A$^+Ebg0~J^Nwycy<~7(r>ctcc0P#pZf1V4UIVC+TLz9z&>eZV$2Qps za;mk29S*qNJ}l6N_fzw!%>b)aMeS<8E&wry!R<~+spd!N5-*(5C=$Yoyv=$d#@GgD zIXFrY6p!sp&LK_!DAcHZp4wu!Wvuv)D&cl_&4pRscn1~{o~+7_+Q?(R1a>eE{o&Q3 zwEj3i(0)lNWO?~XRkHtDUML}1nwAH3B4QjRq|otqFU&r@koxh*v_gJ&OpYJLK)x+M zj+j=!`jOhL;xTdg#ZRa(2C`_|g#MDd)FSL4qVdyuf&Yvwkr5qY{f?t!QMC8fsX+uI zrj-}%5r5)dm@}74H?q}odcc$`q(uY%DVr^~Hh zzcEcrAY$(J#35RvzX0dN?Z70^i7>{-V)$DHYrU^`DV4tMe#lkE9lwMqD>u?2x+}|- zWuLhjpw?fGaJQJsrI3Wbi`{S}1izx%&N8G5G|mxYf|c^vj|Mtw;{eH)_r-5g)v}AJ z;(?t%$g`fACaU5@+Z~qqP7Km46<5M6wk3x+Cde7zNU4{i+y5Qj^JQ|A$C4pdXo{w9 zxDI;`eY^Ej!rGK9D7Gi@JoQ?&-ZMgN^8vA4NbWm3Z$fOueX{9(!G9tZ9B0P+w>nv7 z3H7mR@J{Q$w3amj;|=r^zjn6XTV2LF;k~7@bHM_x{IK!T*Ulnh8K{tpVR9^m#8`Br z5jbvzWLLK{d?Lw{c+Z7iZ?_siGf-i9r9$t|kHjPa#d;562XT~11MIMj&?wQEeui-b? z`pXqWW-P&t6T0}Q#ald8x-DDi2P{qRabCI*`tvL^8(**cbZ~DyXfr1y`7*KVrHQS3 zOEFBY5RJJzh*_>QmhJA*_fVOCdQn&X0I-;fVvk8PooaAppU5K`OFt7*3m6UZ3zjj93T2~dKx`hQq!g^j|wGO&ZIH4aGcp)hlw#^90V@a zQj2qzkTrayGJ(*CiTShe`tE#6UOf{^s_DR(Lj{&r{z^mA(9!7h%x{*U3jrE9WpLWGCo8b{1gxTt)CUrK5S?$|Z9 zSGPetZ}ifHl<&IEyYr2taxq7Oe4b!`_&W45gg_11>GC+sXqPxTJwer7<)7;J$cEVc zKQWx?S{bX{;n4+8<{TiQ@XkrR&N=70=0cwG!b6z)2bVKrsG)ItA9_pmzoT*|)Udmi zX>tCg4!9&I<^-4IqTv&I`;TsRT5e8Sk0+_{%RIY}W?jn}3}-xQ*TeILX|i>6A^doe zjk1nWCJIRYbhxFF!uY?V(Dt3{`bo(Du1nBXEE3rPsjLj*LZKDor+< zOy-+R)|*V0n@qNwc4nG(R+@GenszptcHoHIS`+s@$?t00-(9w*BU~X0$p{gHb*?&d z^_l)=qfD#rGreM=Ov@NBEl{L{J99B6hjk1@*fDB<>U`+qY3)}N|F1Ns zi$)s}j_sy1LK9Jf?50CQGyIP?r^jOj9manx#Qr+5AOA)0Kiu3p8yuZOw@inP{4r_Mk(|d2qkqu|(bjR79GW(@dh2X%P#=rGBs$c&$=!W#HUQbXGH%{>U zqs`q-tmI|EwK<*f|7dge(>dqmaBVK9*#YJr$k*bh*B(!>HC==^@- zr3wAMCtLc7DB}$w4>>*Y6d3C#9?rqHIljj~)s5np06dRfGqJc7LD$#xRMCObHYu_t zQsU1{4c_bK&v%723pX_U-lWf^w!@oNvtFUvX3)lNlcuCyy4YwTitjJQLgi@mlpBd? zn_Gt3u>(4bi1g}y(K{gLfvK6}c#iWrF>TBz11U0josaQ-Uf@iqYHaT_*vbR%uvtee z7qDGM^HgfwFac(or?X{Ha-)&|qBFb$^7e8B4huBmg90<4&Ix=)FJV4a;s6r!e7SbK z9_-|Sk)%R!`pH#I>d;71$z?IplcA6W>GQ@PG|?K&z@M{w&SNhJR|+Svymey5*2}?L z$Ouywe`pPus{~v~{cH;*Sr4-H0Eh~kb@)x>_vN0Z#LgOXw!Lu1Zt~Z<_K;ajt1f&N zZP^P#pqD{&D=zm9XmA5;e!8X?{lsPkzyS;^X02-1Q5hb>-19r;Y*LZWxvxWMLSdRW zK@gb!?l_$ZWUlgIdI49NDmz2fCUl*hIp`yVIn9y~ZvaU+!6ACqE0s-;~a3R!3 ze1lYk#L1M9QbllA=D{U%Sr-v`mZ{i~%U>#G@~)gzicdlnmx$m`_%lIT{LycB;iZ1Y zx|i=wzxRwd*&^j{p^<9uPGiMeur7>`(M4+$CumZg_8xAydv63p2_f{7l&yQ$$m>)H z_s?YQZJV0dD?!q1C|3hjF*^<$TNz9%mr0DIhO)bM3as(tt9gR)&X&kCH-R1re9uqi zlCc{dR55$Z#;8R^5xh3k>#VUux+B1FcCwC41MA0!MhNxHG?z)DT9m&_4;CrkKJ!~6 zcWdswk>Tg*d?i(85JUx)`!T9&d4rm=J>UAmjBpxOTFoQ;Z~G0!^duoE>)-U-6=lq- z74tiUY3+|xcQR9o4$iHpcj+#Gw)W(B(tVA{S_PhGwl^i2g(GRRago$s=6pC&(<;t& zn`T|PP1K48Q=J@%3PDk-5dOApVZqu&$SSnOun(5kOTz|zw|q3d`|y4OU(&gLdh#st z2r+Olh~|pCBJ^l}U+f~CB6Mw@OY5k;u#I5%U_e)%w%;EZelX=jGL}HS+>@4=boYk36ejsDS4QB zOo3zOQ3tX*d*Njy^%Pab8YakmdGONlj>MPksqT*Sv>xgaZpy|FI+^BnwlZ8sqZ@N$ zJl3C$BsZWQ5!4?1<4YrK%VjL^J;?HUcKYcw>ZUSx=IOoWk^5v_KGR3s&XtYRO@W~f5;)8|&)E@FHB604aE*?7Y%6B? zC~R2*x*?4nU-}1%JnP!1`L~_V>IrZVIxHlcu(S%jiyQW0>ez!3^jrwWCN2Eo3|ZFi ztksP)MkFOY;URm@X*U*KW zJNw1%X=)w+GD|wTb?<*V@nn>q5>wqy35Er*y|TIp0)S1{-~FxBz-M7Se}y+3FTUpP z#(5vN?OxmyPE^(AbmV%cgpTAp)@0P)2C$M)5_d2?Ln-oDxHG2ug=sQ*Ds3F4r-T$2cO82wJ)GDvmNhY z2XBE9|9ds*6RxO8jgl>R4!up!T?EqhLjFbR@!}M~^ZE<4{8lR{O&-^>${35aWLK=x zTDq(+t8#uk;j3lVQ(@CQTJKxClE_n~rS18*9FPvNMv^!FzY2Y>eLvJ~9FVv*0)Zc1 zB2x0!_+$c@Vgn^k#u9k=fqB-3A86zMKX_ZuL}>TM9~r{2qHgUD*NbHLUTFx}yV7}$ zdqEZA?_9*i{eGC?Zu9XO*c@co_Z7S7w;;6SDr}g7i+L4eNtQeLcd6R%uBpJ5g51|c#;p9}uh#vA8@4guPa+Q8)Ff{S5)93IGqXXU%X$VNKm}do^P7t7dZ15{|XGQHq zY4-0vAoyB-5LM6U-5sL!_g&l*_~F=-t@PWHY5MPy9+iZQdB+)*m#-BRdo^F>&06GS zD=>6MI>q@tw;5(|$~xu-d9nG{gLoI2J&^|oTub{Yh(q-Qn@^GJv3ldS^n%q@F&4xh zQ8wl(BTAA{8GnBAu%4?%yDx>{j_QKH8rG7RU<4V`llO8}Z~yex&F$@G`1!m%&L+k3 zqFycaL{?{jzwpzj|JCg}>NI{fZY*mnk(%*y7;Q2aB-eT#fCA!NCnak{l&!^?#wn|n zNloAnC=s#!xO>7}otw)psTTAVr%7FRkc z@5Gpqg}6O0|KuEabb4vou~~W;k>7UTdBu--B0&qIJ=67}Arq`|mFpi5fSW01BUWG{8^VdvJjJfr&o5tgeqp+mfv z(@C2%t#W3@KW`glm<~8t_8I*g_^i7#t=ST>{H~tM&sc31?Yw+&Gz~pihGCoS8Mukj z1V;}%q#j2Kj(#+5L|v;?ngSBfs1>!I*BPQ-@SMLkIlRvn{l9z~kF$D-aYWc*Wz+IMrG%JlegwS##tLX1}vH-6D6RA;dl_WG@yuGg>S_LisI#PbUX zl(Y-F{a`1XU@W(SOG&3&<|2Zt^soBW8lV5Vun8a7eRJ`!LFdA0i$on zF}aWcg!HdD(=`BEZGYgqWO{ymtmcAjJNccc8C&3!VIIuxf(INyy%gzMFbT?qxAMH7 zu>!BuokijV-Q8G9-mS;OwHXnqljz2q&>Kp$xy`4EEh zAhw4-FH;3`$IwJ3YDNW5(;heDJ<`uWY6{GEBvfOZ>|NnOin-oTw=l0{&!4SVw6;;h zCp21OG#3|trs3Hne`nqU8=Gaj53u&|%rXWyPil&ElH;OEr9+O|JsSJXMZ0ZD&12Ck zegD(Sol=LvL{OST3cpA|vZzo^i;7&dQaD5FAARbcSTiZIOavihlr4M|lC^5mjI!BP$67 zu_X}SX47+?-$*nRRB0EL&=9*X>fcv%5{Zf8MQYFCv-FVnuv@y8X?q)pl+{yUhNQAzO#TH_pg@N+5|BKjK2_PAG-i zJpX}@a+?+BPJV_B@mv1|H)FKUZ6fkrtQ-=sXs=b963jv2%)6+C}pG6%YxiTivvj)Cy!^5s7Y z91BZEv>P@EC#)4XuhW$c&)Alm*>%q-%pU|otvg@OuRJSA3@#Ocyc3YF@5GMRSTVCF zZkW_QX4{kJsuF+g9IFc@oV&L_eoOB887=T&Fu`@EBW$6cpWbcuus8Ey;YKcj`?TKk zn>s-66!8a$(97wsk_=O+Qq#{wK5B^I95W8j=I^qLUWKN4i5U5r#Aly`>x=c$(|8$v ze}F}`?tE{aKele*PdsU)4|0j0k&-T7-3Zhc`SKf zYM*9bZF%TDy%V=GD1)haKZkfZXWdGK#+yLLZc%(N+NoE{1JW^siNT>x^gc@*$E~n-`p=?FNQE?bx>V z_iY3gbJmKc_o2lDad6iJkG+|3-ezHLeiet=LSz-E9-99cbzX*37q*OC(Rm?FKZ2%I zv9r?0xzL%^Mt8OFA0sb{{(U#vX*|#njWzm=KrtXUkFLQd%p8ltnxPx6$S0V2Evg7;Vk!Oji zI#(9T1jcH8F7Xl`RYA_+QF;dPgyM?1GHU!%=_7#0aSDH23f>s+@z8mB3j9>YKj!di z3a4k_ChE!lw!Pgc_dZnGFX?`&DOjl}P%#I}QG&)t%doZTK0TCyI2=;cQ=ok@##?^# zwh?;<4^rD{?nM(5PYBtkYk&vyn*71oUWI(l?ciAEl%DI!!D zn@m=VE6tCPKhm%;EKp9zVQLAy#noKA115D&2+N?#i*Q~Z=Y#+ra!%BbtW=k%Sb4e> zb1`*qDRd)ZV&&(Uxvj(+j`H@KbR6TG=>0h6^W;Z)L4?)yK=DI0S!aOY?1*54Q)7#A z@M%Fs=s)6FK4u-rr)X6jLu|0d+U+8f{~=H@5$xkp;DdhYBM>46p-g$_a_&8fwE4rO z^aUAF7b4Q{|2e-F2&d3ypcX$+VHH!{XiR@ZzeQ8N*LZ1oec-imR{IsD5v<4@47{EE z2O5Mh`XY60EvCZ6B;yQm<36?DsYl6|pf7TKftjIpiL(xi7tenBxFxk%xJ2lOrWq@) zLa!NqgIn&7#NxALrivYY#`F*+rBYBu)SoluuJ}098WZOPP>*7HcoG==ET((>G zx)V`2=FZ}pR@m4zyP^M3PCX*?X(Z3zNHtobbfZAMO}r>%GQrm=T_NA0w0V#0tuJBj z7bE4`^%&^VP5f$h*bQs>QP2MJ#TWsiQvTz!X0AdeV)xu}mGV5c;S721m9qF-X4Rxp zs^d{luaXsfmGa-xcmZD^kbpv$=q4e zbM>Cg=BJ7nx% - write_hrc2(file_name = "tests_multitable/hrc/activity") - -load(file = "tests_multitable/data/corr_table_nuts23_fr.RData") -hrc_file_nuts <- corr_table_nuts23_fr %>% - write_hrc2(file_name = "tests_multitable/hrc/nuts23") - -options( - rtauargus.tauargus_exe = - "Y:/Logiciels/TauArgus/TauArgus4.2.2b1/TauArgus.exe" -) - -# Ajout des tables au data/ du package -# nuts23_fr_corr_table <- corr_table_nuts23_fr %>% -# rename_with(toupper) -# -# usethis::use_data( -# turnover_act_size, -# turnover_act_cj, -# turnover_nuts_cj, -# turnover_nuts_size, -# nuts23_fr_corr_table, -# activity_corr_table, -# overwrite = TRUE -# ) -# -# purrr::walk( -# list( -# turnover_act_size, -# turnover_act_cj, -# turnover_nuts_cj, -# turnover_nuts_size, -# nuts23_fr_corr_table, -# activity_corr_table -# ), -# str -# ) - -# Test 1 ----- -# Liste de deux tables liées - -list_data_2_tabs <- list( - act_size = turnover_act_size, - act_cj = turnover_act_cj -) %>% - purrr::map( - function(df){ - df %>% - mutate( - is_secret_freq = N_OBS > 0 & N_OBS < 3, - is_secret_dom = ifelse(MAX == 0, FALSE, MAX/TOT>0.85), - is_secret_prim = is_secret_freq | is_secret_dom - ) - # mutate(N_OBS = ifelse(N_OBS > 0 & N_OBS < 1, 1, round(N_OBS))) - } - ) - -res_1 <- tab_multi_manager( - list_tables = list_data_2_tabs, - list_explanatory_vars = list( - act_size = c("ACTIVITY", "SIZE"), - act_cj = c("ACTIVITY", "CJ") - ), - hrc = c(ACTIVITY = hrc_file_activity), - dir_name = "tests_multitable/test_1/tauargus_files", - value = "TOT", - freq = "N_OBS", - secret_var = "is_secret_prim", - num_iter_max = 5, - totcode = "Total" -) - -# controle de cohérence des masques sur les cases communes -res_1$act_size %>% filter(SIZE == "Total") %>% - select(ACTIVITY, TOT, N_OBS, is_secret_prim, is_secret_treff = last_col()) %>% - full_join( - res_1$act_cj %>% filter(CJ == "Total") %>% - select(ACTIVITY, TOT, N_OBS, is_secret_prim, is_secret_cj = last_col()) - ) %>% - mutate(pb = is_secret_cj != is_secret_treff) %>% - filter(pb) - -# Test 2 ---- - -# Test avec 4 tables liées - -list_data_4_tabs <- list( - act_size = turnover_act_size, - act_cj = turnover_act_cj, - nuts_treff = turnover_nuts_size, - nuts_cj = turnover_nuts_cj -) %>% - purrr::map( - function(df){ - df %>% - mutate( - is_secret_freq = N_OBS > 0 & N_OBS < 3, - is_secret_dom = ifelse(MAX == 0, FALSE, MAX/TOT>0.85), - is_secret_prim = is_secret_freq | is_secret_dom - ) - # mutate(N_OBS = ifelse(N_OBS > 0 & N_OBS < 1, 1, round(N_OBS))) - } - ) - -res_2 <- tab_multi_manager( - list_tables = list_data_4_tabs, - list_explanatory_vars = list( - act_size = c("ACTIVITY", "SIZE"), act_cj = c("ACTIVITY", "CJ"), - nuts_treff = c("NUTS", "SIZE"), nuts_cj = c("NUTS", "CJ") - ), - hrc = c( - ACTIVITY = hrc_file_activity, - NUTS = hrc_file_nuts - ), - dir_name = "tests_multitable/test_2/tauargus_files", - value = "TOT", - freq = "N_OBS", - secret_var = "is_secret_prim", - num_iter_max = 5, - totcode = "Total" -) - -res_2$act_size %>% filter(SIZE == "Total") %>% select(ACTIVITY, is_secret_treff = last_col()) %>% - full_join( - res_2$act_cj %>% filter(CJ == "Total") %>% select(ACTIVITY, is_secret_cj = last_col()), - by = "ACTIVITY" - ) %>% - filter(is_secret_treff != is_secret_cj) - -res_2$nuts_treff %>% filter(SIZE == "Total") %>% select(NUTS, is_secret_treff = last_col()) %>% - full_join( - res_2$nuts_cj %>% filter(CJ == "Total") %>% select(NUTS, is_secret_cj = last_col()), - by = "NUTS" - ) %>% - filter(is_secret_treff != is_secret_cj) diff --git a/tests_multitable/test_multitable_ofats.R b/tests_multitable/test_multitable_ofats.R deleted file mode 100644 index e226f3c..0000000 --- a/tests_multitable/test_multitable_ofats.R +++ /dev/null @@ -1,196 +0,0 @@ -library(dplyr) - -devtools::load_all() - -options( - rtauargus.tauargus_exe = - "Y:/Logiciels/TauArgus/TauArgus4.2.2b1/TauArgus.exe" -) - -rep_X <- "X:/HAB-Traitement-Confidentialite/Ofats/OFATS 2020/tests" -rep_inputs <- file.path(rep_X, "inputs") -rep_traits <- file.path(rep_X, "traitements") -rep_hrc <- file.path(rep_traits, "hrc") -rep_res <- file.path(rep_X, "resultats") - -p <- lapply( - list(rep_X, rep_inputs, rep_traits, rep_hrc, rep_res), - function(rep){ - if(!dir.exists(rep)) dir.create(rep) - } -) - -nace <- readxl::read_xls( - file.path(rep_inputs, "Nomenclatures.xls"), - sheet = "NACE" -) -str(nace) - -table_passage = nace %>% - select(6:2) %>% - mutate(across(.fns = ~gsub("F$","",.x))) %>% - unique() -racine = "ZZZ" - -file_nace_hrc <- nace %>% - select(6:2) %>% - mutate(across(.fns = ~gsub("F$","",.x))) %>% - unique() %>% - arrange(across(CODE5:CODE1)) %>% - write_hrc2( - output_name = "nace", - dir_name = rep_hrc, - sort_table = FALSE, - adjust_unique_roots = TRUE - ) - -# Création de deux hiérarchies non emboîtées des pays #### - -pays <- readxl::read_xls( - file.path(rep_inputs, "Nomenclatures.xls"), - sheet = "PAYS" -) %>% - mutate( - across(everything(), ~gsub(" ","_",.)) - ) -str(pays) - -file_zone_hrc <- pays %>% - select(zone, PAYS) %>% - unique() %>% - arrange(across(zone:PAYS)) %>% - write_hrc2( - output_name = "zone", - dir_name = rep_hrc, - sort_table = FALSE, - adjust_unique_roots = TRUE - ) - -file_off_hrc <- pays %>% - select(Offshore, PAYS) %>% - unique() %>% - write_hrc2( - output_name = "offshore", - dir_name = rep_hrc, - sort_table = FALSE, - adjust_unique_roots = TRUE - ) - -# Constitution des différents tableaux #### - -ofats <- haven::read_sas(file.path(rep_inputs, "ofats_2020_pr_app_secret_V4.sas7bdat")) %>% - filter(stringr::str_ends(NACE, pattern = "F$", negate = TRUE)) %>% - mutate( - across(PAYS, ~gsub(" ","_",.)) - ) -ofats <- ofats %>% - bind_rows( - ofats %>% group_by(PAYS, NOM_VAR) %>% - summarise( - VAL_ABS = sum(VAL_ABS), - FREQ = sum(FREQ), - MAX_VAL_ABS = max(MAX_VAL_ABS), - .groups = "drop" - ) %>% - mutate(NACE = "Total", diffusion = 1) - ) - - -poser_secret_primaire <- function(df, var = "ENT"){ - df %>% - {if(var == "ENT"){ - mutate( - ., - is_secret_freq = FREQ > 0 & FREQ < 3 & (diffusion == 1), - is_secret_dom = FALSE - )} else{ - mutate( - ., - is_secret_freq = FREQ > 0 & FREQ < 3 & (diffusion == 1), - is_secret_dom = VAL_ABS > 0 & MAX_VAL_ABS/VAL_ABS > 0.85 & (diffusion == 1) - )}} %>% - mutate(is_secret_prim = is_secret_freq | is_secret_dom) %>% - mutate(FREQ = ifelse(FREQ > 0 & FREQ < 1, 1, round(FREQ))) -} - -constituer_tableaux_par_var <- function(data = ofats, type_var){ - ofats_sel <- ofats %>% - filter(NOM_VAR == type_var) %>% - poser_secret_primaire(var = type_var) - - var_liste <- list() - var_liste[["zone"]] <- ofats_sel %>% - filter(PAYS %in% c(pays$PAYS, pays$zone, "A1")) %>% - select(PAYS, NACE, VAL_ABS, MAX_VAL_ABS, FREQ, diffusion, starts_with("is_secret")) - var_liste[["off"]] <- ofats_sel %>% - filter(PAYS %in% c(pays$PAYS, pays$Offshore, "A1")) %>% - select(PAYS, NACE, VAL_ABS, MAX_VAL_ABS, FREQ, diffusion, starts_with("is_secret")) - # lapply(var_liste, str) - - return(var_liste) -} - -all_vars <- ofats$NOM_VAR %>% unique() ##################TODO######### -all_tableaux <- setNames(lapply(all_vars, constituer_tableaux_par_var, data = ofats), all_vars) - -# Pose du Secret secondaire #### - -all_masques <- purrr::map( - all_vars, - function(var){ - cat("GESTION TABLEAUX ", var, "\n") - list_data_2_tabs <- list( - t_zone = all_tableaux[[var]]$zone, - t_off = all_tableaux[[var]]$off - ) - res <- multi_linked_tables( - list_tables = list_data_2_tabs, - list_explanatory_vars = list(t_zone = c("PAYS", "NACE"), t_off = c("PAYS", "NACE")), - list_hrc = list( - t_zone = c(PAYS = file_zone_hrc, NACE = file_nace_hrc), - t_off = c(PAYS = file_off_hrc, NACE = file_nace_hrc) - ), - dir_name = file.path(rep_traits, var, "tauargus_files"), - totcode = c(PAYS = "A1", NACE = "Total"), - value = "VAL_ABS", - freq = "FREQ", - secret_var = "is_secret_prim", - num_iter_max = 20, - ip_start = 1, - ip_end = 0 - ) - } -) - -res$t_zone %>% mutate(status = case_when(is_secret_prim ~ "AB", is_secret_7 ~ "D", TRUE ~ "V")) %>% - count(status) - -controle <- list() - -controle[["t_zone"]] <- read.csv( - file.path("X:\\HAB-Traitement-Confidentialite\\Ofats\\OFATS 2020\\traitements\\fichiers_tauargus\\EMP\\zone.csv"), - header = FALSE, - col.names = c(c("PAYS", "NACE"), "VAL_ABS", "FREQ", "Status","Dom"), - colClasses = c(rep("character", 2), rep("numeric",2), "character", "numeric"), - na.strings = "", - stringsAsFactors = FALSE -) - -controle$t_zone %>% count(Status) - -fus <- controle$t_zone %>% select(1:2,Status) %>% unique() %>% - full_join( - res$t_zone %>% select(1:3, last_col())) - -nrow(fus) - -fus %>% - filter(is.na(Status)) %>% - nrow() -fus %>% - filter(is.na(is_secret_7)) %>% - nrow() -fus %>% filter(is_secret_7 & Status == "V") - - -all_masques <- setNames(all_masques, all_vars) From 12c22d47d46765e2c897460a1a733bef640da08a Mon Sep 17 00:00:00 2001 From: Rastout Nathanael Date: Fri, 26 Aug 2022 14:04:46 +0200 Subject: [PATCH 064/107] Modif message run_arb --- R/run_arb.R | 24 +++++++++++------------- R/tab_rda.R | 11 ++++++----- 2 files changed, 17 insertions(+), 18 deletions(-) diff --git a/R/run_arb.R b/R/run_arb.R index 3ced0b4..093a5ec 100644 --- a/R/run_arb.R +++ b/R/run_arb.R @@ -283,8 +283,8 @@ run_arb <- function(arb_filename, if (!file.exists(tauargus_exe)) { stop( - "Tau-Argus introuvable (", tauargus_exe, ")\n ", - "renseigner le parametre tauargus_exe ou l'option rtauargus.tauargus_exe" + "Tau-Argus cannot be found (", tauargus_exe, ")\n ", + "please specify the parammeter tauargus_exe or the option rtauargus.tauargus_exe" ) } @@ -292,8 +292,7 @@ run_arb <- function(arb_filename, if (!file.exists(arb_filename)) { stop( - "Fichier introuvable : ", arb_filename, "\n", - "(utiliser `micro_arb` pour creer un fichier batch)" + "Batch file cannot be found : ", arb_filename ) } infos_arb <- arb_contents(arb_filename) @@ -302,14 +301,13 @@ run_arb <- function(arb_filename, if (is_tabular!= TRUE){ if (!file.exists(infos_arb$openmicrodata)) { stop( - "Fichier asc introuvable : ", infos_arb$openmicrodata, "\n", - "(utiliser `micro_asc_rda` pour creer un fichier asc)" + "Microdata file cannot be found (.asc): ", infos_arb$openmicrodata ) } } if (!file.exists(infos_arb$openmetadata)) { stop( - "Fichier rda introuvable : ", infos_arb$openmetadata, "\n", + "Metadata file cannot be found (.rda) : ", infos_arb$openmetadata, "\n", "(utiliser `micro_asc_rda` pour creer un fichier rda)" ) } @@ -317,7 +315,7 @@ run_arb <- function(arb_filename, hst <- infos_arb$apriori$file if (any(manq <- !file.exists(hst))) { stop( - "Fichier(s) d'apriori introuvable(s) : ", + "Apriori file cannot be found (.hst): ", paste(unique(hst[manq]), collapse = "\n") ) } @@ -332,18 +330,18 @@ run_arb <- function(arb_filename, missd <- unique(ouput_dirs[manq]) if (missing_dir == "stop") { stop( - "\nDossiers introuvable(s) :\n ", + "\nDirectory cannot be found :\n ", paste(missd, collapse = "\n "), - "\n(utiliser missing_dir = \"create\" ?)" + "\n(use missing_dir = \"create\" ?)" ) } else if (missing_dir == "create") { warning( - "Dossier(s) cree(s) :\n ", + "Directory created :\n ", paste(missd, collapse = "\n ") ) purrr::walk(missd, dir.create, recursive = TRUE) } else { - stop("'missing_dir' incorrect. Valeurs permises : \"stop\", \"create\".") + stop("'missing_dir' incorrect. allowed values : \"stop\", \"create\".") } } @@ -363,7 +361,7 @@ run_arb <- function(arb_filename, vars_manq <- setdiff(used_vars, rda_vars) if (length(vars_manq)) { stop( - "Variable(s) specifiee(s) absente(s) des metadonnees (rda) :\n ", + "Variable(s) specified(s) missing(s) in the metadata file (rda) :\n ", paste(vars_manq, collapse = "\n ") ) } diff --git a/R/tab_rda.R b/R/tab_rda.R index e5896ea..856f0b8 100644 --- a/R/tab_rda.R +++ b/R/tab_rda.R @@ -367,10 +367,10 @@ tab_rda <- function( {dir.create(directory_tab, recursive = TRUE)} if ((!is.null(hst_filename)) | (!is.null(secret_var))|(!is.null(cost_var))){ - name_hst <- basename(hst_filename) - directory_hst <- stringr::str_replace(hst_filename, pattern = name_hst, replacement="") - if(!(dir.exists(directory_hst))) - {dir.create(directory_hst, recursive = TRUE)} + name_hst <- basename(hst_filename) + directory_hst <- stringr::str_replace(hst_filename, pattern = name_hst, replacement="") + if(!(dir.exists(directory_hst))) + {dir.create(directory_hst, recursive = TRUE)} } # Controle sur le nombre de colonnes @@ -397,7 +397,8 @@ tab_rda <- function( #Controles sur secret_var - if (is.null(secret_var) && is.null(cost_var)) message("secret_var and cost_var are NULL : no apriori file will be provided") + if (is.null(secret_var) && is.null(safety_rules)) + {stop("Please specify safety_rules of secret_var for primary suppression")} if ((!is.null(secret_var)) && (!secret_var %in% colnames(tabular))) {stop("secret_var does not exist in tabular")} From b2235a9cfbc29bae63016e62a762a7f8f72196d0 Mon Sep 17 00:00:00 2001 From: Rastout Nathanael Date: Fri, 26 Aug 2022 14:17:59 +0200 Subject: [PATCH 065/107] Restore file --- .Rbuildignore | 12 + .gitignore | 9 + .gitlab-ci.yml | 43 ++ DESCRIPTION | 54 ++ LICENSE | 19 + NAMESPACE | 26 + NEWS.md | 116 ++++ README.md | 71 +++ _pkgdown.yml | 46 ++ tests/testthat.R | 5 + tests/testthat/test_hrc.R | 917 ++++++++++++++++++++++++++++ tests/testthat/test_micro_arb.R | 106 ++++ tests/testthat/test_micro_asc_rda.R | 114 ++++ tests/testthat/test_util.R | 135 ++++ 14 files changed, 1673 insertions(+) create mode 100644 .Rbuildignore create mode 100644 .gitignore create mode 100644 .gitlab-ci.yml create mode 100644 DESCRIPTION create mode 100644 LICENSE create mode 100644 NAMESPACE create mode 100644 NEWS.md create mode 100644 README.md create mode 100644 _pkgdown.yml create mode 100644 tests/testthat.R create mode 100644 tests/testthat/test_hrc.R create mode 100644 tests/testthat/test_micro_arb.R create mode 100644 tests/testthat/test_micro_asc_rda.R create mode 100644 tests/testthat/test_util.R diff --git a/.Rbuildignore b/.Rbuildignore new file mode 100644 index 0000000..60b5030 --- /dev/null +++ b/.Rbuildignore @@ -0,0 +1,12 @@ +^.*\.Rproj$ +^\.Rproj\.user$ +^\.Rprofile$ +^NEWS\.rmd$ +^NEWS\.md$ +^NEWS\.html$ +^tmp$ +# ^vignettes/.+\.png$ +^vignettes/rtauargus\.Rmd\.orig$ +^vignettes/precompilation.R$ +^\.gitlab-ci\.yml$ +^_pkgdown\.yml$ diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..0c1fac5 --- /dev/null +++ b/.gitignore @@ -0,0 +1,9 @@ +.Rproj.user +.Rhistory +.RData +.Ruserdata +.Rprofile +NEWS.html +tmp +inst/doc +vignettes/tauargus_exe.ini diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml new file mode 100644 index 0000000..7c3c357 --- /dev/null +++ b/.gitlab-ci.yml @@ -0,0 +1,43 @@ +image: rocker/tidyverse:latest + +stages: + - check + - deploy + +variables: + GIT_SSL_NO_VERIFY: "1" + PKG_NAME: "rtauargus" + +pkg_check: + stage: check + tags: + - poc-kube + script: + - R -e 'install.packages("gdata", repos = "https://nexus.insee.fr/repository/r-cran")' + - R -e 'devtools::check(check_dir = ".", + error_on = "error", + cran = FALSE, + document = FALSE, + manual = FALSE)' + artifacts: + paths: + - "${PKG_NAME}_*.tar.gz" + only: + - master + - developpement + +pages: + stage: deploy + image: colinfay/r-ci-tidyverse:3.6.0 + tags: + - poc-kube + script: + - R -e 'install.packages("gdata", repos = "https://nexus.insee.fr/repository/r-cran")' + - R -e 'devtools::install(dependencies = FALSE)' + - R -e 'options(pkgdown.internet = FALSE) ; pkgdown::build_site()' + artifacts: + paths: + - public + when: manual # pour declencher manuellement le job quand version stable + only: + - master diff --git a/DESCRIPTION b/DESCRIPTION new file mode 100644 index 0000000..5f72cf6 --- /dev/null +++ b/DESCRIPTION @@ -0,0 +1,54 @@ +Package: rtauargus +Type: Package +Title: Using Tau-Argus from R +Language: fr +Version: 0.5.0.9000 +Depends: R (>= 3.3) +Imports: + purrr (>= 0.2), + dplyr (>= 0.7), + gdata, + stringr, + rlang, + zoo +Suggests: + testthat, + knitr, + rmarkdown +Authors@R: c( + person( + "Pierre-Yves", "Berrard", + email = "pierre-yves.berrard@insee.fr", + role = c("aut", "cre") + ), + person( + "Julien", "Jamme", + email = "julien.jamme@insee.fr", + role = c("aut") + ), + person( + "Nathanaël", "Rastout", + email = "nathanael.rastout@insee.fr", + role = c("aut") + ), + person( + "Jeanne", "Pointet", + role = c("ctb") + ), + person( + "Félix", "Beroud", + role = c("ctb") + ), + person( + family = "Institut National de la Statistique et des Études Économiques", + role = "cph" + ) + ) +Description: Protects tables by calling Tau-Argus software from R. +License: MIT + file LICENSE +Encoding: UTF-8 +LazyData: true +RoxygenNote: 7.1.2 +VignetteBuilder: knitr +URL: https://github.com/inseefrlab/rtauargus, http://outilsconfidentialite.gitlab-pages.insee.fr/rtauargus, https://gitlab.insee.fr/outilsconfidentialite/rtauargus +BugReports: https://github.com/inseefrlab/rtauargus/issues, https://gitlab.insee.fr/outilsconfidentialite/rtauargus/-/issues diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..4313a10 --- /dev/null +++ b/LICENSE @@ -0,0 +1,19 @@ +Copyright 2021 Institut National de la Statistique et des Études Économiques + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. diff --git a/NAMESPACE b/NAMESPACE new file mode 100644 index 0000000..886e19b --- /dev/null +++ b/NAMESPACE @@ -0,0 +1,26 @@ +# Generated by roxygen2: do not edit by hand + +export(import) +export(micro_arb) +export(micro_asc_rda) +export(reset_rtauargus_options) +export(rtauargus) +export(rtauargus_options) +export(rtauargus_plus) +export(run_arb) +export(tab_arb) +export(tab_multi_manager) +export(tab_rda) +export(tab_rtauargus) +export(tab_rtauargus2) +export(tauargus_info) +export(write_hrc) +export(write_hrc2) +importFrom(dplyr,"%>%") +importFrom(dplyr,arrange) +importFrom(dplyr,mutate) +importFrom(purrr,map) +importFrom(purrr,map_at) +importFrom(purrr,transpose) +importFrom(rlang,.data) +importFrom(zoo,na.locf) diff --git a/NEWS.md b/NEWS.md new file mode 100644 index 0000000..554905a --- /dev/null +++ b/NEWS.md @@ -0,0 +1,116 @@ +--- +title: Package ‘rtauargus’ +subtitle: Historique des modifications +output: rmarkdown::html_vignette +--- +## rtauargus 1.0.0 + +[01/09/2022] + +* English documentation +* **tab_arb()** : argument *value* is now called *response_var* as in the **tab_rda()** function. +* **tab_arb()** : argument *apriori* is now called *hst_filename* as in the **tab_rda()** function. +* **write_hrc2()** : new function to creat a hrc file from a correspondence table + +## rtauargus 0.5.0 + +[18/04/2022] + +* Ajout de fonctions pour gérer le secret directement sur des données tabulées. +Addition of functions to manage confidentiality directly on tabular data. + +## rtauargus 0.4.3 + +[13/10/2021] + +* projet transféré dans le groupe `outilsconfidentialite` + +## rtauargus 0.4.2 + +[17/12/2020] + +* projet migré vers gitlab.insee.fr + +## rtauargus 0.4.1 + +[18/10/2019] + +* **rtauargus_plus()** : extension de la fonction `rtauargus` pour un grand + nombre de croisements (ayant tous les mêmes caractéristiques). Réduit le temps + d'exécution par rapport à la version "normale". + +## rtauargus 0.4.0 + +[04/09/2019] + +* **rtauargus()** peut désormais prendre en entrée un couple de fichiers asc et + rda (au lieu d'un data.frame). Permet de lancer un traitement dans le cas + où ces fichiers texte de microdonnées existent déjà. +* **run_arb()** : + - nouveau nom de run_tauargus (nom plus explicite, + principalement pour éviter la confusion avec la fonction _rtauargus_). + L'ancien nom reste pour l'instant utilisable : un message avertit du + changement. Il sera remplacé par un message d'erreur dans une prochaine + version. + - vérifications préalables à l'exécution de τ-Argus : + * existence du logiciel sur le poste ; + * existence des fichiers asc et rda ; + * présence des variables à utiliser (croisements, variable de réponse, + ...) dans les métadonnées (fichier rda) ; + * existence des dossiers où vont être écrits les résultats. Si absents, + possibilité de les créer automatiquement (paramètre `missing_dir` avec + option associée `rtauargus.missing_dir`). +* **import()** : si des fichiers _apriori_ ont été utilisés, stockage du nom de + ces fichiers dans les métadonnées (attributs) de l'objet R créé +* améliorations de la documentation (rubriques d'aide et vignette) + +## rtauargus 0.3.1 + +[11/07/2019] + +* informe de l'absence de tauargus.exe au chargement du package +* diverses améliorations de la documentation (rubriques d'aide et vignette) +* utilise valeurs par défaut des options en cas d'effacement accidentel par + l'utilisateur + +## rtauargus 0.3.0 + +[29/03/2019] + +* **micro_arb()** : + - ajoute paramètre apriori (fichiers hst) + - conserve les noms de tabulations en sortie si précisés dans + `explanatory_vars` +* vérification plus rigoureuse de certains paramètres + +## rtauargus 0.2.1 + +[03/12/2018] + +* **write_hrc()** : prise en compte de davantage de cas particuliers +* améliore vignette + +## rtauargus 0.2.0 + +[14/08/2018] + +* **micro_arb()** : + - implémente tableaux liés (paramètre **linked**) + - corrige extensions de fichiers pour `"5"` (.tab) et `"6"` (.jj) + - corrige bug quand un seul paramètre à suppress, par exemple `MOD(1)` +* **write_hrc()** : nouvelle fonction créant un fichier .hrc à partir de + variables hiérarchiques présentes dans les microdonnées +* **micro_asc_rda()** : + - implémente paramètres **missing**, **totcode** et **codelist** + - simplifie syntaxe pour paramètre **hrc** (cohérente avec nouveaux + paramètres) + - nouveau paramètre **hierleadstring** (valeur par défaut dans l'option de + package **rtauargus.hierleadstring**) +* efface les options du package à son déchargement +* corrections diverses documentation + +## rtauargus 0.1.0 + +[01/08/2018] + +* Première version stable. diff --git a/README.md b/README.md new file mode 100644 index 0000000..0d7c1cb --- /dev/null +++ b/README.md @@ -0,0 +1,71 @@ + +[![pipeline status](https://gitlab.insee.fr/outilsconfidentialite/rtauargus/badges/master/pipeline.svg)](https://gitlab.insee.fr/outilsconfidentialite/rtauargus/-/pipelines) + + +rtauargus +========= + +![](vignettes/R_logo_small.png) ![](vignettes/TauBall2_small.png) + +### τ-Argus depuis R + +Le package *rtauargus* offre une interface **R** pour **τ-Argus**. + +Il permet de : + +- créer les inputs (fichiers asc et rda) à partir de données au format R ; +- générer la séquence d'instructions à exécuter en mode batch (fichier arb) ; +- lancer un batch τ-Argus en ligne de commande ; +- récupérer les résultats dans R. + +Ces différentes opérations peuvent être exécutées en une seule fois, mais aussi de manière modulaire. Elles permettent d'intégrer les tâches réalisées par τ-Argus dans une chaîne de traitement écrite en R. + +Le package présente d'autres fonctionnalités annexes, comme créer une variable hiérarchique à partir de microdonnées. + +### Installation + +* **version stable la plus récente** (recommandé) + + ```r + install.packages("rtauargus", repos = "https://nexus.insee.fr/repository/r-public") + ``` + +* **version de développement** + + ```r + # install.packages("remotes") + remotes::install_gitlab( + repo = "outilsconfidentialite/rtauargus", + host = "gitlab.insee.fr", + build_vignettes = TRUE, + upgrade = "never" + ) + ``` + + Pour installer une version spécifique, ajouter au répertoire une référence + ([commit](https://gitlab.insee.fr/outilsconfidentialite/rtauargus/-/commits/master) ou + [tag](https://gitlab.insee.fr/outilsconfidentialite/rtauargus/-/tags)), + par exemple `"outilsconfidentialite/rtauargus@v-0.4.1"`. + +### Exemple simple + +``` r +library(rtauargus) + +rtauargus( + microdata = donnees, + explanatory_vars = c("variable1", "variable2"), + safety_rules = "FREQ(3,10)", + suppress = "GH(1,100)" +) +``` + +Une prise en main détaillée est disponible par `vignette("rtauargus")`. + +### Remarques importantes + +Les fonctions de *rtauargus* appelant τ-Argus nécessitent que ce logiciel soit accessible depuis le poste de travail. Le téléchargement de τ-Argus se fait sur la [page dédiée](https://research.cbs.nl/casc/tau.htm) du site de l'office néerlandais de statistiques. Cependant, toutes les fonctions n'exécutent pas τ-Argus (création des microdonnées...). Ne pas l'avoir sur son poste n'est donc pas bloquant. + +Le package a été développé sur la base des versions open source de τ -Argus (versions 4.1 et supérieures), en particulier la dernière version disponible lors du développement (4.1.7). **Il n'est pas compatible avec la version 3.5.** + +Pour l'instant, **seules les microdonnées sont acceptées** en entrée (pas les données déjà tabulées). diff --git a/_pkgdown.yml b/_pkgdown.yml new file mode 100644 index 0000000..e2c61b3 --- /dev/null +++ b/_pkgdown.yml @@ -0,0 +1,46 @@ +destination: public + +navbar: + structure: + left: + - home + - intro + - reference + - news + right: + - gitlab + components: + home: + icon: fas fa-home fa-lg + href: index.html + intro: + text: Mode d'emploi + href: articles/rtauargus.html + reference: + text: Fonctions + href: reference/index.html + news: + text: NEWS + href: news/index.html + gitlab: + text: Contribuer + href: https://gitlab.insee.fr/outilsconfidentialite/rtauargus + icon: fa-gitlab + +reference: + - title: Secrétiser en une seule instruction + contents: + - rtauargus + - rtauargus_plus + - title: Secrétiser étape par étape + contents: + - micro_asc_rda + - micro_arb + - run_arb + - import + - title: Autres + contents: + - rtauargus_options + - tauargus_info + - write_hrc + - rtauargus-package diff --git a/tests/testthat.R b/tests/testthat.R new file mode 100644 index 0000000..4b786e4 --- /dev/null +++ b/tests/testthat.R @@ -0,0 +1,5 @@ +library(testthat) +library(rtauargus) +library(dplyr) + +test_check("rtauargus") diff --git a/tests/testthat/test_hrc.R b/tests/testthat/test_hrc.R new file mode 100644 index 0000000..2e5553a --- /dev/null +++ b/tests/testthat/test_hrc.R @@ -0,0 +1,917 @@ +# données test ------------------------------------------------------------ + +df <- + tibble( + niv1 = rep( + c("A", "B"), + c(27, 23) + ), + niv2 = rep( + c("A1", "A2", "B1", "B2"), + c(17, 10, 10, 13) + ), + niv3 = rep( + c("A1x", "A1z", "A2y", "A2z", "B1x", "B1y", "B2x", "B2z"), + c(16L, 1L, 8L, 2L, 9L, 1L, 10L, 3L) + ), + niv4 = rep( + c("A1x6", "A1x7", "A1z6", "A2y7", "A2y6", "A2z7", "A2z6", + "B1x7", "B1x6", "B1y6", "B2x7", "B2x6", "B2z6"), + c(7L, 9L, 1L, 5L, 3L, 1L, 1L, 6L, 3L, 1L, 7L, 3L, 3L) + ) + ) + + +# fill_na_hrc ------------------------------------------------------------- + +context(":::fill_na_hrc") + +test_that("différentes configurations et ordre des variables", { + + df_NA <- + tibble( + niv1 = c("A" , "A" , "B", NA, NA, NA, NA ), + niv2 = c("A1" , "A2", NA, NA, "D", NA, "F1"), + niv3 = c("A1x", NA , NA, NA, NA, "E", "F" ) + ) + + expect_equal( + fill_na_hrc( + df_NA, + c("niv1", "niv2", "niv3") + ), + tibble( + niv1 = c("A" , "A" , "B", NA, NA, NA, NA ), + niv2 = c("A1" , "A2", "B", NA, "D", NA, "F1"), + niv3 = c("A1x", "A2", "B", NA, "D", "E", "F" ) + ) + ) + + expect_equal( + fill_na_hrc( + df_NA, + c("niv3", "niv2", "niv1") # inversion ordre + ), + tibble( + niv3 = c("A1x", NA , NA, NA, NA, "E", "F" ), + niv2 = c("A1" , "A2", NA, NA, "D", "E", "F1"), + niv1 = c("A" , "A" , "B", NA, "D", "E", "F1") + ) + ) + +}) + + +# sublevels --------------------------------------------------------------- + +context(":::sublevels") + +subl12 <- + list( + A = list(A1 = NULL, A2 = NULL), + B = list(B1 = NULL, B2 = NULL) + ) + +subl13 <- + list( + A = list(A1x = NULL, A1z = NULL, A2y = NULL, A2z = NULL), + B = list(B1x = NULL, B1y = NULL, B2x = NULL, B2z = NULL) + ) + +subl14 <- + list( + A = list( + A1x6 = NULL, A1x7 = NULL, A1z6 = NULL, + A2y6 = NULL, A2y7 = NULL, A2z6 = NULL, A2z7 = NULL + ), + B = list( + B1x6 = NULL, B1x7 = NULL, B1y6 = NULL, + B2x6 = NULL, B2x7 = NULL, B2z6 = NULL + ) + ) + +subl23 <- + list( + A1 = list(A1x = NULL, A1z = NULL), + A2 = list(A2y = NULL, A2z = NULL), + B1 = list(B1x = NULL, B1y = NULL), + B2 = list(B2x = NULL, B2z = NULL) + ) + +subl24 <- + list( + A1 = list(A1x6 = NULL, A1x7 = NULL, A1z6 = NULL), + A2 = list(A2y6 = NULL, A2y7 = NULL, A2z6 = NULL, A2z7 = NULL), + B1 = list(B1x6 = NULL, B1x7 = NULL, B1y6 = NULL), + B2 = list(B2x6 = NULL, B2x7 = NULL, B2z6 = NULL) + ) + +subl34 <- + list( + A1x = list(A1x6 = NULL, A1x7 = NULL), + A1z = list(A1z6 = NULL), + A2y = list(A2y6 = NULL, A2y7 = NULL), + A2z = list(A2z6 = NULL, A2z7 = NULL), + B1x = list(B1x6 = NULL, B1x7 = NULL), + B1y = list(B1y6 = NULL), + B2x = list(B2x6 = NULL, B2x7 = NULL), + B2z = list(B2z6 = NULL) + ) + +test_that("normal", { + + # niv 1 x (2 3 4) ........................... + + expect_equal( + sublevels(df$niv2, df$niv1), + subl12 + ) + + expect_equal( + sublevels(df$niv3, df$niv1), + subl13 + ) + + expect_equal( + sublevels(df$niv4, df$niv1), + subl14 + ) + + # niv 2 x (3 4) ............................ + + expect_equal( + sublevels(df$niv3, df$niv2), + subl23 + ) + + expect_equal( + sublevels(df$niv4, df$niv2), + subl24 + ) + + # niv 3 x 4 ........................... + + expect_equal( + sublevels(df$niv4, df$niv3), + subl34 + ) + +}) + +test_that("présence NAs", { + + expect_error( + sublevels(c(NA, NA), c(NA , NA)), + "aucun croisement exploitable" + ) + + expect_error( + sublevels(c("A", NA), c(NA , NA)), + "aucun croisement exploitable" + ) + + expect_error( + sublevels(c("A1", NA), c(NA , "B")), + "aucun croisement exploitable" + ) + + res <- list(A = list(A1 = NULL)) # (attendu) + + expect_equal( + sublevels(c("A1", NA), c("A", NA)), + res + ) + + expect_equal( + sublevels(c("A1", NA), c("A", "B")), + res # B disparaît à cause du NA au niveau inférieur + ) + + expect_equal( + sublevels(c("A1", "B1"), c("A", NA)), + res # B1 disparaît à cause du NA au niveau supérieur + ) + + expect_equal( + sublevels(c("A1", "A1"), c("A", NA)), + res + ) + + # plusieurs cas combinés + expect_equal( + sublevels(c("A1", "B2", NA, NA), c("A", NA, "B", NA)), + res + ) + +}) + +test_that("détecte variables non hierarchiques", { + + # niv 1 x (2 3 4) ........................... + + expect_error( + sublevels(df$niv1, df$niv2), + "variables non hierarchiques" + ) + + expect_error( + sublevels(df$niv1, df$niv3), + "variables non hierarchiques" + ) + + expect_error( + sublevels(df$niv1, df$niv4), + "variables non hierarchiques" + ) + + # niv 2 x (3 4) ............................ + + expect_error( + sublevels(df$niv2, df$niv3), + "variables non hierarchiques" + ) + + expect_error( + sublevels(df$niv2, df$niv4), + "variables non hierarchiques" + ) + + # niv 3 x 4 ........................... + + expect_error( + sublevels(df$niv3, df$niv4), + "variables non hierarchiques" + ) + + +}) + + +# imbrique ---------------------------------------------------------------- + +context(":::imbrique") + +p_12 <- + list( + A = list( + A1 = NULL, + A2 = NULL + ), + B = list( + B1 = NULL, + B2 = NULL + ) + ) + +p_23 <- + list( + A1 = list( + A1x = NULL, + A1z = NULL + ), + A2 =list( + A2y = NULL, + A2z = NULL + ), + B1 = list( + B1x = NULL, + B1y = NULL + ), + B2 = list( + B2x = NULL, + B2z = NULL + ) + ) + +i_13 <- + list( + A = list( + A1 = list(A1x = NULL, A1z = NULL), + A2 = list(A2y = NULL, A2z = NULL) + ), + B = list( + B1 = list(B1x = NULL, B1y = NULL), + B2 = list(B2x = NULL, B2z = NULL) + ) + ) + +test_that("normal", { + + expect_equal( + imbrique(p_23, p_12), + i_13 + ) + +}) + +test_that("melange", { + + # melange input 1 + expect_equal( + imbrique( + p_23[c(3, 2, 4, 1)], + p_12 + ), + i_13 + ) + + # melange input 2 + expect_equal( + imbrique(p_23, p_12[2:1]), + i_13[2:1] + ) + + # melange inputs 1 et 2 + expect_equal( + imbrique(p_23[c(3, 2, 4, 1)], p_12[2:1]), + i_13[2:1] + ) + +}) + + +# hrc_list ----------------------------------------------------------------- + +context(":::hrc_list") + +hrc_123 <- list( + A = list( + A1 = list( + A1x = NULL, + A1z = NULL + ), + A2 = list( + A2y = NULL, + A2z = NULL + ) + ), + B = list( + B1 = list( + B1x = NULL, + B1y = NULL + ), + B2 = list( + B2x = NULL, + B2z = NULL + ) + ) +) + +hrc_124 <- list( + A = list( + A1 = list( + A1x6 = NULL, + A1x7 = NULL, + A1z6 = NULL + ), + A2 = list( + A2y6 = NULL, + A2y7 = NULL, + A2z6 = NULL, + A2z7 = NULL + ) + ), + B = list( + B1 = list( + B1x6 = NULL, + B1x7 = NULL, + B1y6 = NULL + ), + B2 = list( + B2x6 = NULL, + B2x7 = NULL, + B2z6 = NULL + ) + ) +) + +hrc_1234 <- list( + A = list( + A1 = list( + A1x = list(A1x6 = NULL, A1x7 = NULL), + A1z = list(A1z6 = NULL) + ), + A2 = list( + A2y = list(A2y6 = NULL, A2y7 = NULL), + A2z = list(A2z6 = NULL, A2z7 = NULL) + ) + ), + B = list( + B1 = list( + B1x = list(B1x6 = NULL, B1x7 = NULL), + B1y = list(B1y6 = NULL) + ), + B2 = list( + B2x = list(B2x6 = NULL, B2x7 = NULL), + B2z = list(B2z6 = NULL) + ) + ) +) + +test_that("2 input (équivaut à sublevels)", { + + # 2 inputs équivaut à sublevels + expect_equal( + hrc_list(df, c("niv2", "niv1")), + subl12 + ) + + expect_equal( + hrc_list(df, c("niv4", "niv1")), + subl14 + ) + + expect_equal( + hrc_list(df, c("niv4", "niv2")), + subl24 + ) + + expect_equal( + hrc_list(df, c("niv3", "niv2")), + subl23 + ) + #... + +}) + +test_that("3 input", { + + expect_equal( + hrc_list(df, c("niv3", "niv2", "niv1")), + hrc_123 + ) + + expect_equal( + hrc_list(df, c("niv4", "niv2", "niv1")), + hrc_124 + ) + +}) + +test_that("4 input", { + + expect_equal( + hrc_list(df, c("niv4", "niv3", "niv2", "niv1")), + hrc_1234 + ) + +}) + + +# prof_list --------------------------------------------------------------- + +context(":::prof_list") + +test_that("2 niveaux", { + + expect_equal( + prof_list(subl12), + c(A = 0, A1 = 1, A2 = 1, B = 0, B1 = 1, B2 = 1) + ) + +}) + +test_that("3 niveaux", { + + expect_equal( + prof_list(hrc_124), + c(A = 0, + A1 = 1, + A1x6 = 2, A1x7 = 2, A1z6 = 2, + A2 = 1, + A2y6 = 2, A2y7 = 2, A2z6 = 2, A2z7 = 2, + B = 0, + B1 = 1, + B1x6 = 2, B1x7 = 2, B1y6 = 2, + B2 = 1, + B2x6 = 2, B2x7 = 2, B2z6 = 2 + ) + ) + +}) + +test_that("4 niveaux", { + + expect_equal( + prof_list(hrc_1234), + c(A = 0, + A1 = 1, + A1x = 2, + A1x6 = 3, A1x7 = 3, + A1z = 2, + A1z6 = 3, + A2 = 1, + A2y = 2, + A2y6 = 3, A2y7 = 3, + A2z = 2, + A2z6 = 3, A2z7 = 3, + B = 0, + B1 = 1, + B1x = 2, + B1x6 = 3, B1x7 = 3, + B1y = 2, + B1y6 = 3, + B2 = 1, + B2x = 2, + B2x6 = 3, B2x7 = 3, + B2z = 2, + B2z6 = 3 + ) + ) + +}) + + +# is_hrc ------------------------------------------------------------------ + +context(":::is_hrc") + +test_that("depuis precomptage", { + + mat2col <- purrr::partial(matrix, ncol = 2, byrow = TRUE) + + expect_true( + mat2col( + c(1, 0, + 0, 2) + ) %>% is_hrc() + ) + + expect_true( + mat2col( + c(1, 0, + 0, 2, + 8, 0) + ) %>% is_hrc() + ) + + expect_false( + mat2col( + c(7, 1, # deux niveaux agrégés pour un niveau fin + 0, 2) + ) %>% is_hrc() + ) + + expect_true( + matrix( + nrow = 2, + c(1, 0, + 0, 0 + ) + ) %>% is_hrc() + ) + +}) + +test_that("sortie table()", { + + # TRUE ...................... + + expect_true( + is_hrc( + table( + fin = c("A1", "A2"), + agr = c("A" , "A" ) + ) + ) + ) + + expect_true( + is_hrc( + table( + fin = c("A1", "A2", "B1"), + agr = c("A" , "A" , "B" ) + ) + ) + ) + + expect_true( + is_hrc( + table( + fin = c("A1", "A2"), + agr = c("A" , NA ) + ) + ) + ) + + expect_true( + is_hrc( + table( + fin = c("A1", NA ), + agr = c("A" , "B") + ) + ) + ) + + expect_true( + is_hrc( + table( + fin = c("A1", "A2", "B1"), + agr = c("A" , "A" , "B" ) + ) + ) + ) + + expect_true( + is_hrc( + table( + fin = c("A1", "A2", "B1", NA), + agr = c("A" , "A" , "B" , "B") + ) + ) + ) + + expect_true( + is_hrc( + table( + fin = c("A1", "A2", "B1", NA), + agr = c("A" , "A" , "B" , "C") + ) + ) + ) + + expect_true( + is_hrc( + table( + fin = c("A1", "B1", "B2"), # ligne de 0 pour B2 + agr = c("A" , "B" , NA ) + ) + ) + ) + + # FALSE ...................... + + expect_false( + is_hrc( + table( + fin = c("A1", "A1"), + agr = c("A" , "B" ) # deux niveaux agrégés pour un niveau fin + ) + ) + ) + + expect_false( + is_hrc( + table( + fin = c("A1", "A2"), + agr = c( NA , NA ) + ) + ) + ) + + expect_false( + is_hrc( + table( + fin = c( NA , NA ), + agr = c("A" , "A") + ) + ) + ) + +}) + + +# check_seq_prof ---------------------------------------------------------- + +context(":::check_seq_prof") + +test_that("input invalide", { + + expect_false(check_seq_prof(integer(0))) + expect_false(check_seq_prof(1:2)) + expect_false(check_seq_prof(0:-1)) + expect_false(check_seq_prof((0:1) / 2)) + +}) + +test_that("input valide", { + + expect_true(check_seq_prof(0:2)) + expect_false(check_seq_prof(c(0, 2))) + expect_true(check_seq_prof(c(0, 1, 1, 0, 1, 2))) + expect_true(check_seq_prof(c(0, 1, 2, 3, 2))) + expect_true(check_seq_prof(c(0, 1, 2, 3, 1))) + expect_true(check_seq_prof(c(0, 1, 1, 2, 3, 3, 2, 3, 3, 2, 0, 1, 0))) + +}) + + +# normalise_hrc ----------------------------------------------------------- + +context(":::normalise_hrc") + +test_that("rien à normaliser", { + + expect_null(normalise_hrc(NULL)) + + expect_equal( + normalise_hrc(c("1 2", "3 4 5")), + c("1 2", "3 4 5") + ) + +}) + +test_that("syntaxe valeur incorrecte", { + + expect_error( + normalise_hrc("fich"), + "Parametres hrc incorrects" + ) + + expect_error( + normalise_hrc("3 Q 5"), + "Parametres hrc incorrects" + ) + +}) + +test_that("microdata absent si V1>V2...", { + + expect_error( + normalise_hrc("V1>V2"), + "specifier microdata" + ) + +}) + + +# df_hierlevels ----------------------------------------------------------- + +context(":::df_hierlevels") + +test_that("base", { + + expect_equal( + df_hierlevels(df$niv2, "1 1"), + data.frame( + var_hrc = c("A1", "A2", "B1", "B2"), + V2 = c("A", "A", "B", "B" ), + stringsAsFactors = FALSE + ) + ) + + expect_equal( + df_hierlevels(df$niv3, "1 1 1"), + data.frame( + var_hrc = c("A1x", "A1z", "A2y", "A2z", "B1x", "B1y", "B2x", "B2z"), + V2 = c("A1" , "A1" , "A2" , "A2" , "B1" , "B1" , "B2" , "B2" ), + V3 = c("A" , "A" , "A" , "A" , "B" , "B" , "B" , "B" ), + stringsAsFactors = FALSE + ) + ) + + +}) + +test_that("error", { + + expect_error( + df_hierlevels(df$niv2, "1 un"), + "chiffres separes par des espaces" + ) + + expect_error( + df_hierlevels(df$niv4, "1 2 3"), + "somme de hierlevels" + ) + + expect_error( + df_hierlevels(c(df$niv3, df$niv2), "1 3"), + "nombre de caracteres" + ) + +}) + +# write_hrc --------------------------------------------------------------- + +context("write_hrc") + +test_that("hierlevels", { + + expect_error( + write_hrc(df, c("niv1", "niv2"), hierlevels = "2 1"), + "une seule variable hierarchique a specifier" + ) + + expect_equal( + df %>% write_hrc("niv2", hierlevels = "1 1") %>% readLines(), + c("A", "@A1", "@A2", "B", "@B1", "@B2") + ) + +}) + +test_that("colonne absente", { + + expect_error( + write_hrc(df, c("niv1", "niv0")), + "introuvable.+ niv0$" + ) + +}) + +test_that("un seul niveau", { + + expect_warning( + res <- write_hrc(df, "niv2"), + "hierarchie d'un seul niveau" + ) + expect_equal(readLines(res), c("A1", "A2", "B1", "B2")) + +}) + +test_that("fill_na", { + + hrc_complet <- purrr::partial(write_hrc, compact = FALSE) # [n'élague pas] + + df$niv2[df$niv2 == "A1"] <- NA + + # fill_na "up" ................................................... + + expect_warning( + res <- hrc_complet(df, c("niv2", "niv1"), fill_na = "up"), + "valeurs manquantes imputees" + ) + expect_equal(readLines(res), c("A", "@A", "@A2", "B", "@B1", "@B2")) + # ex-A1 imputés par le haut deviennent A + + # fill_na "down" ................................................. + + expect_warning( + res <- hrc_complet(df, c("niv2", "niv1"), fill_na = "down"), + "valeurs manquantes imputees" + ) + expect_equal(readLines(res), c("A", "@A2", "B", "@B1", "@B2")) + # pas de niveau inférieur à niv2 : imputation down sans effet, + # donc croisement A x NA simplement ignorés + + df <- df[df$niv1 == "A", ] + expect_warning( + res <- hrc_complet(df, c("niv3", "niv2"), fill_na = "down"), + "valeurs manquantes imputees" + ) + expect_equal( + readLines(res), + c("A1x", "@A1x", "A1z", "@A1z", "A2", "@A2y", "@A2z") + ) # ex-A1 imputés par le bas deviennent A1x et A1z + +}) + +test_that("compact", { + + df$niv3[df$niv1 == "A"] <- NA # vide niveau 3 pour A + + expect_warning( + res <- write_hrc(df, paste0("niv", 3:1), compact = TRUE), + "valeurs manquantes imputees" + ) + + expect_equal( + readLines(res), + c("A", "@A1", "@A2", "B", "@B1", "@@B1x", "@@B1y", "@B2", "@@B2x", "@@B2z") + ) + + df$niv2[df$niv1 == "A"] <- NA # vide aussi niveau 2 pour A + + expect_warning( + res <- write_hrc(df, paste0("niv", 3:1), compact = TRUE), + "valeurs manquantes imputees" + ) + + expect_equal( + readLines(res), + c("A", "B", "@B1", "@@B1x", "@@B1y", "@B2", "@@B2x", "@@B2z") + ) + +}) + +test_that("validité arbre", { + + # vide niveau intermédiaire (produira une erreur si compactage) + df$niv2<- NA + + expect_error( + suppressWarnings(write_hrc(df, paste0("niv", 3:1), compact = TRUE)), + "Niveaux de hierarchie incoherents" + ) + +}) + +test_that("hierleadstring", { + + expect_equal( + df %>% + write_hrc(paste0("niv", 2:1), hierleadstring = ":") %>% + readLines(), + c("A", ":A1", ":A2", "B", ":B1", ":B2") + ) + +}) + +test_that("cas exotiques", { + skip("a->b b->a") + # expect_error ? + write_hrc( + data.frame(niv1 = letters[1:2], niv2 = letters[2:1]), + c("niv2", "niv1") + ) +}) diff --git a/tests/testthat/test_micro_arb.R b/tests/testthat/test_micro_arb.R new file mode 100644 index 0000000..55b96f4 --- /dev/null +++ b/tests/testthat/test_micro_arb.R @@ -0,0 +1,106 @@ +# suppr_writetable -------------------------------------------------------- + +context("suppr_writetable") + +suppr_writetable <- rtauargus:::suppr_writetable +out <- c("t1.csv", "tmp/t2.csv", "~/t3.csv") +outn <- normalizePath(out, mustWork = FALSE) + +test_that("suppress unique", { + + expect_equal( + suppr_writetable( + "GH(###, 100)", + linked = FALSE, + output_names = out[1:2], + output_type = "2", + output_options = "" + ), + c( + sprintf(" GH(1,100)\n (1,2,,\"%s\")", outn[1]), + sprintf(" GH(2,100)\n (2,2,,\"%s\")", outn[2]) + ) + ) + + expect_equal( + suppr_writetable( + "MOD(0,3)", + linked = FALSE, + output_names = out, + output_type = "2", + output_options = "AS+" + ), + c( + sprintf(" MOD(1,3)\n (1,2,AS+,\"%s\")", outn[1]), + sprintf(" MOD(2,3)\n (2,2,AS+,\"%s\")", outn[2]), + sprintf(" MOD(3,3)\n (3,2,AS+,\"%s\")", outn[3]) + ) + ) + + expect_equal( + suppr_writetable( + "MOD(n)", # un seul parametre (num tableau) + linked = FALSE, + output_names = out, + output_type = "2", + output_options = c("", "AS+", "AS+SE+") + ), + c( + sprintf(" MOD(1)\n (1,2,,\"%s\")", outn[1]), + sprintf(" MOD(2)\n (2,2,AS+,\"%s\")", outn[2]), + sprintf(" MOD(3)\n (3,2,AS+SE+,\"%s\")", outn[3]) + ) + ) + + +}) + +test_that("suppress multiple", { + + expect_equal( + suppr_writetable( + c("GH(1,100)", "MOD(2)", "GH(###,100)"), + linked = FALSE, + output_names = out, + output_type = "2", + output_options = "" + ), + c( + sprintf(" GH(1,100)\n (1,2,,\"%s\")", outn[1]), + sprintf(" MOD(2)\n (2,2,,\"%s\")", outn[2]), + sprintf(" GH(###,100)\n (3,2,,\"%s\")", outn[3]) + ) + ) + +}) + +test_that("linked", { + + expect_error( + suppr_writetable( + c("GH(1,100)", "MOD(2)", "GH(###,100)"), + linked = TRUE, + output_names = out, + output_type = "2", + output_options = "" + ), + "un seul suppress permis quand linked = TRUE" + ) + + expect_equal( + suppr_writetable( + "GH(.,100)", + linked = TRUE, + output_names = out, + output_type = c("2", "4", "1"), + output_options = "" + ), + c( + " GH(0,100)", + sprintf(" (1,2,,\"%s\")", outn[1]), + sprintf(" (2,4,,\"%s\")", outn[2]), + sprintf(" (3,1,,\"%s\")", outn[3]) + ) + ) + +}) diff --git a/tests/testthat/test_micro_asc_rda.R b/tests/testthat/test_micro_asc_rda.R new file mode 100644 index 0000000..a917de1 --- /dev/null +++ b/tests/testthat/test_micro_asc_rda.R @@ -0,0 +1,114 @@ +donnees <- + data.frame( + V1 = c("A", "A", "A", "A", "B", "B", "B", "C"), + V2 = c("Y", "Z"), + V3 = c("T1", "T2", "T1", "S_", "T1", "T1", "T1", "S_"), + VAL = c(100, 0, 7, 25, 0, 4, 0, 5), + POIDS = c(1, 2.71, 4.2, 1), + HOLD = c("H1", "H2", "H3", "H4") + ) + + +context("micro_asc_rda") + + +# input et attendu -------------------------------------------------------- + +input <- + data.frame( + type_var = c( rep("RECODEABLE", 3), "NUMERIC", "WEIGHT", "HOLDING"), + colname = c("V1", "V2", "V3", "VAL", "POIDS", "HOLD"), + position = c( 1, 3, 5, 8, 12, 17), + width = c( 1L, 1L, 2L, 3L, 4L, 2L), + digits = c( 0, 0, 0, 0, 2, 0), + missing = c( "?", "", "#", "9999", "#", "#"), + totcode = c( rep("Total", 3) , NA, NA, "Total"), + codelist = c( NA, NA, "V3.cdl", NA, NA, NA), + hierarchical = c( NA, "V2.hrc", "1 1", NA, NA, NA), + hierleadstring = c( NA, "@", NA, NA, NA, NA), + stringsAsFactors = FALSE + ) %>% + purrr::transpose() + +hrc_full <- normalizePath("V2.hrc", mustWork = FALSE) +cdl_full <- normalizePath("V3.cdl", mustWork = FALSE) + +attendu <- c( + "V1 1 1 ?", + "", + " \"Total\"", + "V2 3 1", + "", + " \"Total\"", + "", + " \"V2.hrc\"", + " \"@\"", + "V3 5 2 #", + "", + " \"Total\"", + " \"%s\"" %>% sprintf(cdl_full), + "", + " 1 1", + "VAL 8 3 9999", + "", + " 0", + "POIDS 12 4 #", + "", + " 2", + "HOLD 17 2 #", + "", + " \"Total\"" +) + + +# write_rda --------------------------------------------------------------- + +test_that("write_rda", { + + write_rda <- rtauargus:::write_rda + + expect_equal( + write_rda(input) %>% strsplit("\n +") %>% unlist(), + attendu + ) + +}) + + +# micro_asc_rda ----------------------------------------------------------- + +test_that("micro_asc_rda", { + + # genere fichiers + tmp <- + micro_asc_rda( + donnees, + weight_var = "POIDS", + holding_var = "HOLD", + hrc = c(V2 = "V2.hrc", V3 = "1 1"), + missing = c("#", V1 = "?", V2 = NA, VAL = 9999), + codelist = c(V3 = "V3.cdl") + ) + + # .asc + expect_equal( + readLines(tmp$asc_filename), + c( + "A Y T1 100 1.00 H1", + "A Z T2 0 2.71 H2", + "A Y T1 7 4.20 H3", + "A Z S_ 25 1.00 H4", + "B Y T1 0 1.00 H1", + "B Z T1 4 2.71 H2", + "B Y T1 0 4.20 H3", + "C Z S_ 5 1.00 H4" + ) + ) + + # .rda + expect_equal( + trimws(readLines(tmp$rda_filename)), + attendu %>% sub("V2.hrc", hrc_full, ., fixed = TRUE) + ) + +}) diff --git a/tests/testthat/test_util.R b/tests/testthat/test_util.R new file mode 100644 index 0000000..799ba7c --- /dev/null +++ b/tests/testthat/test_util.R @@ -0,0 +1,135 @@ +# cite -------------------------------------------------------------------- + +context(":::cite") + +test_that("cite", { + + cite <- rtauargus:::cite + + expect_equal( + cite(c("A", "", "C")), + c("\"A\"", "", "\"C\"") + ) + + expect_equal( + cite(c("A", "", "C"), guillemet = "*"), + c("*A*", "", "*C*") + ) + + expect_equal( + cite(c("A", "", "C"), ignore_vide = FALSE), + c("\"A\"", "\"\"", "\"C\"") + ) + +}) + + +# df_param_defaut --------------------------------------------------------- + +context(":::df_param_defaut") + +test_that("df_param_defaut", { + + df_param_defaut <- rtauargus:::df_param_defaut + + # fonctions préremplies ................................... + + vn <- sprintf("V%i", 1:4) + + f_vn <- purrr::partial(df_param_defaut, varnames = vn) + f_vn_totcode <- purrr::partial(f_vn, param_name = "totcode") + + df_attendu <- + purrr::partial( + data.frame, + colname = vn, + stringsAsFactors = FALSE, + row.names = vn + ) + + # expect_ ................................................ + + val_defaut <- "---" + + expect_warning( + deux_val_def <- f_vn_totcode(c(val_defaut, V3 = "T3", "drop")), + "plusieurs valeurs par defaut" + ) + + expect_equal( + deux_val_def, + df_attendu(totcode = c(val_defaut, val_defaut, "T3", val_defaut)) + ) + + expect_equal( + f_vn_totcode(NULL), + df_attendu(totcode = rep(NA, 4)) + ) + + expect_equal( + f_vn_totcode(val_defaut), + df_attendu(totcode = val_defaut) + ) + + expect_equal( + f_vn_totcode(c(val_defaut, V1 = "T1", V3 = "T3")), + df_attendu(totcode = c("T1", val_defaut, "T3", val_defaut)) + ) + + expect_equal( + f_vn_totcode(c(val_defaut, V3 = "T3", V1 = "T1")), # permute ordre liste + df_attendu(totcode = c("T1", val_defaut, "T3", val_defaut)) + ) + + expect_equal( + f_vn_totcode(c(V3 = "T3", V1 = "T1", val_defaut)), # permute ordre liste + df_attendu(totcode = c("T1", val_defaut, "T3", val_defaut)) + ) + + expect_equal( + f_vn("param1", c(V1 = "T1", V3 = "T3")), # pas de val defaut (NA) + df_attendu(param1 = c("T1", NA, "T3", NA)) + ) + + expect_equal( + f_vn("param1", c(V1 = "T1", V3 = "T3")), # pas de val defaut (NA) + df_attendu(param1 = c("T1", NA, "T3", NA)) + ) + + expect_equal( + f_vn("param1", c(V1 = "T1", V3 = 3)), # (types différents) + df_attendu(param1 = c("T1", NA, "3", NA)) + ) + + expect_equal( + f_vn("param1", c(V1 = 1, V3 = 3)), # (types identiques) + df_attendu(param1 = c(1, NA, 3, NA)) + ) + +}) + + +# following_dup ----------------------------------------------------------- + +context(":::following_dup") + +following_dup <- rtauargus:::following_dup + +test_that("following_dup", { + + expect_equal( + following_dup(1:3), + c(FALSE, FALSE, FALSE) + ) + + expect_equal( + following_dup(c( 1, 1, 2, 1, 1, 3, 2, 2, 2)), + c(FALSE, TRUE, FALSE, FALSE, TRUE, FALSE, FALSE, TRUE, TRUE) + ) + + expect_error( + following_dup(c(1, NA, NA)), + "manquante" + ) + +}) From 976b6f7bac78ae79037b67a89a958405b81b9a4e Mon Sep 17 00:00:00 2001 From: julienjamme Date: Fri, 26 Aug 2022 14:21:54 +0200 Subject: [PATCH 066/107] untrack rproj --- rtauargus.Rproj | 20 -------------------- 1 file changed, 20 deletions(-) delete mode 100644 rtauargus.Rproj diff --git a/rtauargus.Rproj b/rtauargus.Rproj deleted file mode 100644 index 497f8bf..0000000 --- a/rtauargus.Rproj +++ /dev/null @@ -1,20 +0,0 @@ -Version: 1.0 - -RestoreWorkspace: Default -SaveWorkspace: Default -AlwaysSaveHistory: Default - -EnableCodeIndexing: Yes -UseSpacesForTab: Yes -NumSpacesForTab: 2 -Encoding: UTF-8 - -RnwWeave: Sweave -LaTeX: pdfLaTeX - -AutoAppendNewline: Yes -StripTrailingWhitespace: Yes - -BuildType: Package -PackageUseDevtools: Yes -PackageInstallArgs: --no-multiarch --with-keep.source From d0314d6a0e1bc8ce87e7587479116fffd0a15443 Mon Sep 17 00:00:00 2001 From: Rastout Nathanael Date: Fri, 26 Aug 2022 14:25:55 +0200 Subject: [PATCH 067/107] Ajout test_multitable --- tests_multitable/activity_corr_table.RData | Bin 0 -> 488 bytes tests_multitable/create_corr_table_activity.R | 25 +++ .../data/corr_table_nuts23_fr.RData | Bin 0 -> 474 bytes .../data/red_vegetables_4_linked_tabs.RData | Bin 0 -> 26786 bytes tests_multitable/legumes.hrc | 121 +++++++++++ tests_multitable/legumes_unif.hrc | 121 +++++++++++ tests_multitable/legumes_unif_unif.hrc | 121 +++++++++++ tests_multitable/nuts23.hrc | 118 +++++++++++ tests_multitable/nuts23_unif.hrc | 118 +++++++++++ tests_multitable/test_multitable.R | 143 +++++++++++++ tests_multitable/test_multitable_ofats.R | 196 ++++++++++++++++++ 11 files changed, 963 insertions(+) create mode 100644 tests_multitable/activity_corr_table.RData create mode 100644 tests_multitable/create_corr_table_activity.R create mode 100644 tests_multitable/data/corr_table_nuts23_fr.RData create mode 100644 tests_multitable/data/red_vegetables_4_linked_tabs.RData create mode 100644 tests_multitable/legumes.hrc create mode 100644 tests_multitable/legumes_unif.hrc create mode 100644 tests_multitable/legumes_unif_unif.hrc create mode 100644 tests_multitable/nuts23.hrc create mode 100644 tests_multitable/nuts23_unif.hrc create mode 100644 tests_multitable/test_multitable.R create mode 100644 tests_multitable/test_multitable_ofats.R diff --git a/tests_multitable/activity_corr_table.RData b/tests_multitable/activity_corr_table.RData new file mode 100644 index 0000000000000000000000000000000000000000..a4761d1fbec1df59256969b33d2035faa1b3e2f8 GIT binary patch literal 488 zcmVH0CTEw-Ig<@vlJ0s>HF^ypL@esHSi}n+#fP>1L~1ES zJ@RKYQ5TE;dAS&j&aTczHz$LO;qYWsd^z4m47UH8nzD`~m<^88p4pO|5=4 zYIpuWZT9CuTNP>hN!rpEiXYYz-k3pd!w*kf{hB$nhnPR+Oy%) zzd)x1o6mwUAGNL7a1>y>1cw23UIx3*g1r*#m*8MFbSuE;zrfUQTr+{>^b|!+16jyH zS)il|p-UvBpcK*&jf6%*BcUN_NE(ucq#Komb~TdSgMw)<@Q)&7PG_bFgwf+pW_qNkfY(ad5)T+meI&)WHd5% zpHa&&XJ+c3>cX$$=jr8SUgOEdIA_-4oI!|lzlX=G7l#+uE5Wez5V-XZTEACBK+lQTJG3jhEM(d!NX literal 0 HcmV?d00001 diff --git a/tests_multitable/create_corr_table_activity.R b/tests_multitable/create_corr_table_activity.R new file mode 100644 index 0000000..6319eb7 --- /dev/null +++ b/tests_multitable/create_corr_table_activity.R @@ -0,0 +1,25 @@ + +# devtools::load_all() + +library(dplyr) + +a <- sdcHierarchies::hier_import("tests_multitable/legumes.hrc", from = "hrc") +# hier_export(a, as = "argus", path = "tests_multitable/activity.hrc") + +activity_corr_table <- purrr::reduce( + purrr::map( + sort(unique(a$level))[-1], + function(lev){ + res <- a %>% filter(level == lev) %>% select(root, leaf) + names(res) <- paste0("V", (lev-1:0)) + res + } + ), + full_join +) %>% + mutate(V4 = ifelse(is.na(V4), V3, V4)) %>% + select(-V1) %>% + as.data.frame() +names(activity_corr_table) <- c("A10","A21","A88") + +save(activity_corr_table, file = "tests_multitable/activity_corr_table.RData") diff --git a/tests_multitable/data/corr_table_nuts23_fr.RData b/tests_multitable/data/corr_table_nuts23_fr.RData new file mode 100644 index 0000000000000000000000000000000000000000..b1dc0e5cd3b9c789e5e38dff31abc849163d8e0b GIT binary patch literal 474 zcmV<00VVz)iwFP!000002DO$?Yui8&#g)ho#84=-pCe>vc4qh9(sRivH&^-Nlbe9- z(rZ6TKWW_+DD7`eLn9m?B)zAddGlr#ExP)6t&8hL(==@}J87GCUSMZbX->z9haYYeU@Ia(x+NXP>UZ<#DluiCA8M^%)#r z3EK;>Ps4ioZydu!EYDz_hAkX`Wg^yT*uw!>j*RvHIE5o)nTB&X0Lv?3t#Ew~&4)81 zkO+yAL=q!$l0=gK5($AsNR$M1M3^JY5#}hvlwpx8v09-(WYK6OXiki3Mm3|FGt3$0 zRTzpYcR{%ek#mcoT2T_HMb0g9ZjqykTCGq`p=NYobYOH~p~}G!jdqN7jN52J0U9+L zH5xS?egPERq2x&a=xL^YqbwAKc?y{}-Q35w|TYDncSE(H~yT ziaITi$|yU$(xo6KASQRzd;U5)apuLiiip~8hvF6yRmZ$n#M{1;OZK3Xj?MEqXhc`nhWOKImyV#1e5d&tyrwKWOUy3jEsMC8lxg}?B8@O zWT||&d}byc5zh#dwm!P8*+gTd3`E=^@gh*TxR-f)8yzaL9HVW%yq>~%O60>c5g!_l zM5XaqBx@l#pNBJ3O-!Oh7IQx+w$rN2*r_fq4!3vKYr_w9tvj65kxQ_FU!Wofb);nN zz^f8FHn`nykeQ=8a=&cg)k0vLN)HnS4$Eiq?&zlr?_NxhH?V~=k{w08$zeJ8@Pva! zf}%V8sm-gxu&52CCqhKiFW;Tr{{92Lxr0n#xIT;XE{gCjit#Rr@-B+=N{H}Ei1A8@ z@=A#FHjD5!i}4b<8o4_exw{$B&eU&A|LU3+w_xMr&itFq$(>n~ESW@fWf;|9)nz0o zV8h0$FJ#BoNR0iz#s|escL^J9?6!q&)VjDYi8VXZn=}&t*WH`w^8d32=OH688(#X_ zG-AV1r3zWrg*-B+$sY~&eapgD$8+Tz<~-`>xDc)r^$@t)PL>w2K%06 zVawypzc=ciL0Ny(G(L~ASJ+Z4)N(p4{cLa^F%q-o&8|(;FdQvD8v0LLVJo~)OXsu{ z+u%H~ENp$8StBcI&6{15Hf|WWTOsSYkS7V%^<1cxbXvNHBLy7ZZHcjnHWofNHXg73 zxBOvBzXld8tdn)>l08_HRqB!*S(6RxK3X5P*HEo5F1zs%im=m(ve1chXNs_7ig9O( zvSebo&TX^)1AXPnnr!(GSogm`*5tcta`P%D^?yO=#JK;9;{FfnA7p27pw`9Oze#ZT zFWGQ2+3+vJ;R>?hcF8FIB5`&)5f+c^R3iGM*sRp&f1bsu*o~|1j;jRC{}vq1H;jV* zuvx6InX9l_sjykDuvw_ESS5+EU9T-<-A6G4o`(XDURLegU+5e(` z{0B8t`pVA=qpUTHam|IPlkhQ!f9-?$H9sI-tsz;!E#THFI1r7Vy$1jI3l0Wg+ELQ& zC|~7$=7$8dGNuSqvd3Fh&Rf|MXNtlsNur&&`oXX$;0iw&E&<@+#vDju+JcblLL=aH z1B|cMy=EN}L;=J&ouW+-5tw=d78ap74xQIlS1%C;F#-9W!C`pnt3iaRc&bhdInl~) zx!3-PANdqChyLlmr=kc;wmL-Ri>yG;+{UwJOJ`ny0-mk9BwRydT4yF9B^vP6((nb` zae#AE2{!WLAZqSgnX&edZmBgbE&>yun1uu$IZY_zn|10a5~dF&P~Nhm5Aw{uM$wJF z)6GZog(s0yMYpMpcJhtNu#VC}-2AVDlxxRpuMNnXAiCet3Q+q-_%)nzgw9a~0ZDA> zJd^;)wofHBI(3;$9;Uv#ezZ!^KK+o0auPYp6<rzGzy z@fZbr3v#?_&b|Qp-|MVF6{lKULS%f^70m>jfy#34rxE6d=BkJ9<&m>D{EZK95z2l{ zCYk3X_4}HW_Idpj%Xxyr{4LeEQ#Wbb9fi=tu3Jk5u`|ypjp1bK3y8E>w@(wuPp3WY`G>B5jd$~wz zUv>Ix(0>kp(9L|tm3UR&Ch}qIW;WV?^-eJC#+-Qu6u4+M{iy;f4AB~J`(=I!-nbL7 ztU3jzC?~*g6=dXqq6`L+Zn-6>aodw@(ZqP}#$dzU`BA39%%_gPFEWfAmzR6~R;LMP zJ(mn=Cz_LyaIcC;HLv^!!C%Dj2|Km7!B&%}ta%3BO3cuK_;}0|g&*Jr-K6Ke3xhZl zu7p`c9+S%Kj%8&=$OFH`zR7Wx`uk&o-{xT#y)pG5Cuao9MpG-oWD06)u!_q4)56h5UuodlCeP1q&mM&3y&)kd%+* zLN-o{?}waz=Hfi_$hpDIb6d>;Sgw6Id{8s2b7J|@R0WkgUvdY#;czZS4VxhVQSf0O zjyycI_V}r04X>3N#GUlUU4vR5OvJuwa|8I5KFIxKy4id-U<(lMJ#b8pNrsDg4WQX>AdTG!jlJ)K!j7URzSBwpZ?#RH zn>E2D{AAtId%cUmV)0?J7q^XJ2poqb634^Ufc!Kwu@8tQ?Rk z=M;|I@H4Na11F;jD?IX!*jZ?4zUYZ-vb|6v;mv=!>(}9u@QWko+UejuLkS@i)|?<0 z3TKlh1Xqu)G`%;R0wfFFH1QNwA0(J(mxH1DPpf9*QqJTyha!UOnJdqv6i{mxV4La^ z?DV)8J#iDQ3~m|l24qj=>Kb%T7YgxgWU6!hc`oBp-+%Yjs$fH6K(?oPU$i-R3nGf` zk()L9CgIY4O|T1)WuyqTtxoWdM~T10Lx8RV1BmiKan+l#Ck0F4^;=c?nM|aT}2bc2YeO z_LWZv`0GMrs^9Te@MdQ=-Q}`-#ea1#s{vxGw8h1N7|`EFnoP3K0*0vd zzI<%?FlS6Pa1y(ZWOAP7oD}&Zdim;w1AMyIJ4@Gch=w_^g%vwL*L8I>`Uh%b1+guL z;4OaE&ff3$^OEz5y`_I|-ZR~f>)#L#7*s z78p&&w*p%k%^#nxXfExUfqxYq`8sr8-2 zHAh_=@8T`yn@a7g`mR!0j>+`%PpbJSfHT(0r76LVpBZ03C zLI;;y=bgXl1A7xU1+CjU39*DveFh#z28xn;V_of#@;H_JDvl50zL@lJR7R{L%|a#k zhZ*P2l3cVwctLBo{<2W!MyE=^aDyb{6brwZSNVEm5_TZ2@{)~0Nq$o0A<3U2vW11; z1W?qsAjRjC8^P{63(FnA1y#yioBVUD1>$F`3lm+(u53iD{!WN_Qfci2Jotl?nckc9 z&Ph{0snWOc&R-XtDG?nG?U`RiUdIlttQ-bVd!^JWi8sif-8d!fuBCD1!z2Q|3t>2v z>7svE>Bp(|_8*Tja|BR_R_#a977g1^8^KN)FMG_eO5i1}Ey9SxNHva3(sbfS2&cwR z(J=|%>_9#D=LO=^&#EvCYu`gx;!8Cm7~Kl^-MnMKeesIdUp`RM@{5-~uS=S1j_}BXzHf0{MnxFsv2*d7TIqUQbHj#929j48y@_9P8klTKK z<|??yM#Y=eUPD1UIlRQ^-GgQ0``U|+(erUD(_sLhzwyhIO45Fyk0+Mb{OQ7t%@n8J zsv{i#yi2?*320l%iYAj7@S?zXhSRsr4wrrrjdhbpk;iRETKh^q#2a;h2lDd5IIHe+QFJ}a+ zTH!d)?e2-i7k?|~;oRzcs&;i&V6a@k>WE{$_oA))zS}J8t{1)6tbG2#Kr?rKQicmz zQu$+Qp=vFSRdM_)?1L(=^H}Wh#&va3RZ|5)kCpwii2e%4yFI2Th zzy-2F56YsKDWxkF4~vz;M^mX+;sKI$md-g`0;s75S;V6J`T}Dxtpj;N zo~zP)rDqtyGJ`E_VbStqL)9(YPY;*)yaEzfKi=yInLD@d&BXxu@?0L4$~RPibZiNOU#x{wisYu#gt=DOwbqnwE{ z+(yE;*8bn*NhvfR{9rYXnZB72HSi0RqA?ZRaeS$?KRvJg{f zsCXefbn+ z%{DI;&FnNLyP&x`{j`CD`&N-tO$QGlvRljfr^h)}@JcAwaUZnm<8U)xvgyQoplY>( zXN2FmT_OF@4LZp4EwGaP@EwA@&B=vX*5>e?8@L2tws`dI;pil_Nd`@X*@F6w6ug9# z%buF^IQ0|ux#NKvU)HwF6mcuv{O~1v>1*3IC8UpHOUN@8p#p~bifFNQ&FXi9^z8O&gGz<)1v#%E zuZ|$OG+0URf_P+f4Wr0!rXs6w-MRZB;lTcto8TO5S@zFaeKOApU5eVq%U06xke3II zzbid$4?$U0ZIV`GxcU2JtGy0JyhHkcDvZ!?W-pJn0124B;6=Ub^^AwV@?Ov`pc&Lk z@>+>>#e>uOR|NG*dPnS0f|>l);T9Yz%4I+`-ao-(_kzj~L=UNAJjvF3N}> ztkw-C;a%%Y6;j-I@>fJ)ap9k2m+Xle0s~{Gvj($iZv6K%*9%X^h@VVuLjg6Qh{E*Y zfcEw};-hLg*TF;Pe9ndJoC@)mAXB<(t?k&y57;bO2@faV-fEs-bdf${`8Xp!gZtre zxuNvkiRXJU{`!6TYjwAG3_t840Sh-3Z)zYe@uNcq3Lx3+<=EG%N)UUQf`iutE2Dpe zu<)j@8Kj5xCcOSG>*z2^NHN^Sl}r*pLJBia3RFGL{1JQ@cr5YFtJFbkkC?BKKk=X` zK<~JAtGRnK$OaNl^AN&3h1z_r=BdKeN+ zWs~9krRFtpOVUNzFGO!-I3!S18LwhZ)2r)A-+ynpX|u^89+B1{di-r zqmNu$>mamQV7gen`9hxM=Kd2BN7m(WTK^VC|2CD8yhm1FzbMkw=hafgxN@d(OZ(0u zL9U0VbeG!pi#8+f0Ht9p5nh#v(s?zGt6p7M;JT5up2#ub&ZDd8Pey+vtmw-R+w0u# z?#UcrQy$D98mTvvsc=oAg_KAV09-#JVC6k}wqpMw=_mznKUe8PEj&$89~8-O>h_qO zrMhXd6^(sW85(gHVS>}PNHfw7`1U8nU&FhT_X*c;MDudd^DzS@mt-G_#}m2QGYv^G z-Hv{17qO7={N##~MNWNs6S+ORrj}0JbaYBA@t!Y$S61KD7?mA*gY zTtx&xN07|=-Tb&kFh8F|doW1M?w642o!AlzTGi%^(c{mNY1#{ZT5ESevd=$Ds(1Tr zFjX5f-Hsz}?5&bR63kZNT@;}ip}>jyHNciROS;t5NXwVSzbOW`b;pcn$Z|c z)X`Sd1nu)fwTjJ;f-*>ENdhyaL#|S;wEUQ+dL>8qA0F>>WTr3HyNpbJtR_Uz6N~I- zGJ^1H<42Ipteyp_aaXvXax;%)2oesfcavh<6vuaMuHCi7stNC~{PhepjO-eySM|*Q zkkzeiVw~5!%{e}oxCB3zl_KFiHAGT|+YueS;0MIs(tR>tW_ml$KTQ7?pbQgHqVf^- z57pdf(`J75_p+;xG+<7yIyOD(I}C4i>fk-_UJfKO zr}s;CK?2muY>7lUA)r3ny8}(pdbBC`(hJ0ORjQ`3sx6Qbmw?P$9`YXbnZmSI@w&+s zOjceR_|cmsN_%^Z2FtQtRp#S0U_DxzA?{_xUBQ~ZQ`i8_w;V2`hAaI)OOB>1rFq38PhR zY+5M_T9cebV=c{Vf1Gbu){HNO=@SsdcpXduMU=KA;tZ40-}1NAk)8(RU~nHi1{bl| zhvIZLaUGVuv77%caMi42gM=gV_NK23)iEPRdS3U|+h}I{MTv)v@o^?5!NfRa@)BLe zGx*5c^Wk0pO;5ro2*qp_UyDq`I==^0C%_hJXyxOu<$}CyFyCq}-0e-89td0X>pTyh z`$AZ0RV!}^YdiA@T&r<<9Oz0G?dyf~YRk5ZQO+MUcJG~ZN>Ce^hQg&xcVXyZp!&|htC8;r>P2T8U(C!0P| z-E$Zv*_2Py(F5_?uZyqX_c{TXk5t>_*1*#sLdOO~fJM@d^!g4Zkp7 zC=h{_R5p;b!)83{gJ-Fb0K4EqWAc+Lz>kVqJiNgV6%t-QbBw=3D&2G6OhOl@&e`=i zhFXa3z)8#lKBZ{@h+Se~)2jaB3|HZHlOe26z)S&_=tU^c_L#y4X3PKGZ4S;;NDiNqKq>L0zu zHm-y=z2G#QtrpHq6r}dey*Qhv@e6u%I8VD~U)i-qSGD^cl_H@3hq>Ucf%+|#E};LY zq(@X>!=U*-`X#srLXtj;Axg*4@nM7`?wjZ?*6sQ*@kw3M_qegQ^rAw$2Di9_qPtCY zV{YRa>sk017xw$6%%>{@kkXeJ9@>k^P%`j(EYXuS!EJ-v3c7RD_>XlrrTZ!&Axgi< z^{kg5QEN04?Iofs1B^F-`*`w9aykPnJ#fD&xC>IU<^yA)FQJP*&$vh! zoO`n&#tP`qFc;i3P`{(i;loXFf5I8C5&@t0$S*X8)En2(NRmxwy zlD1J@@QW(h7+NDew3w>5n6f*1y1vIHiRH6xmVUDaSA+(a(m$|qaYp?IvIIS}pu!Y4&h6+Wa>g=O~tXVz>Y4eiZ!jFNRS6FWYFxQOY`M z&QOl1e}pOjOCS03|L8Ti1~fQBBMbh|@qe?HDHW}B$D!(;?8mqkj|1EIsF}W;>29Mb zi7_i@@CeK@J^I8J@gMDO8nXwyT35s{ewlF#?gc|m+!ls`r?1h{uD8K~H~)r~(F4}= z9$GeiNkcImiKu^0dD%uxE7rrT_(pY`**hwG`>Ez))|9qsbEjcWMg`1WuF^8dCYWDzI-)IDpW)1iX5%9=mZh0O)ujxe9d&v zhaGCIPTtMV$UoD+sOuK%VeM}An$&h0kee7^or2Oj?WcvDVbemCszBP^w7oBU@2~N! zIK-J?^w^Xh82kYqd(r`S;=_dF6hNBIG=s7Te@6FEl8^a}%zF`C%1P30ET*!-V~vh5 z53jz7B`ev0PS#67rsRzxRX*5Vo>|nnL*GPauAkY1(o?GmSM{>rDDW2L4SlyG(~rSR zaoZ-Qn2?s9o{HWKPhOw*qg08{4gaDM4<5}W#lN9J1n z_X3ocOp~Mf*v@V>cmrOHv)$&*OKZ`)B!$<;XP#fXrpd%-4f(QKGz*g9dy(<|QV_QE=aJo|V%IiCA4ViLTon&Q5+jx>=uv zIoLT*(05eb2mA!-V|su_Rt$(p$dz!U7%Q=!a?*_Rlm6LIHYc8TFJOqt%6Skt0nl3NXH7lI+Q*n&Ld41 zXh#oSzf)tdFKu|CDJ)D1Lqzm#B2pwIT#=SRtbywh(tayU9On{ItEtBx7~GEjQ+xG+ zA~(0wd3j$h1#2+LK= z$QJ|GuXkS+s&u#mKbTG|^!xQE#o!3m9ySOJ)UA8VV16;HS)B)1{f$0)2(;VsmS#~n zLmI`FyyqJ{^HY&;;(!GYYO|lHJZPl!-{h*})MRpEyMtYX&u)jVhMFG;o(H_ zb6q-9r2l?gwXKMbPEfZhsr9|$K$|E9IAVC?UTMo^|0C{YkkPZj+@3!0Y*ozT+Y?@d z$4U!fzx~L2TyFX>SP+y%MlK;P^kFo*@BF#Dsr!0egY+7Zi0(BlScTXx*lz%T&he+^ z_sd3Kt`pLh&I9ZP)G1l);W)(^x;L$REBUa@{`^5~CKR?J&uBf*p-!=4P?_}uwaFt= z^~>-UxuFv3)0k#WRB7JaKwl z>kfaX8o>E^-dIS(7w=~d4=uhOziWw5 zsNIkW3iq{hV?29WE~K*P|48X|I=C(Wf^jAGV;IME&ZAxv8s0XeAle8UqVhBzQ-b)N z0m;mW5{rMiq=LWl_)CEZShL-z>(h2$%bhSf{S8oRu!mvW%`<^_&bHg^!e^BX*Fh&8 zWEP1j?#N&JHc!+2dkvXZn4N36>047%-~517cH^Cxg+&o0$KYZX@q&dLqueTEA}DJR zoRQJ-y*)c^h0AjqA$P;}2?smtksBe=_IU}*kBXE$JBlMAJ-1@a@U#0z#iprLd|uLc z(jx|dvi<-r0_}lM1SFl&F4`_zI z{n<&sFVu(T!@D7?#j8Ib`MUw1W9*+=i&Enz;65-dk%S0~KZ1;w1Z)?6o?7>}xiCt_ z&v)N*30)@*r2Xo8p`$EH=nfT_Uux%}!IiI9!=Sma$Fx8}9xV<0e$1Dx-uvfDw0@0$ zZ5r=__Fx^~d#JyS7j-C6`cO$`RE*%S(<~KTdt%r z3J*GK;E|rd0!d-V7VcL~uUoE^1h1n zP>>rfx>9&ewz)f4hmt%wO7QdQ2RtI$JE8GZc9Z|Cuhvo>KAGRRXSIdOOn>835Iv1c zXW)g1XN`-p{@ecSpvuO4<}D4BRKH}ad> zpK+bbXz9?Z`K2YSFI4%K$i;q90Q2h+{{1>tACVzq?pDE3UmPNdzqQ_1=+qbB;H&hz zZfF5i4O%2r#PP_t^JX^ZJ;{q>q4S0|6M@oof8@#7Z+Z)e?&kE`O4yV}FITNA&)I!W zc=Zm=03uUzeL`%4K`tC(UFNFZ$!0y1@lDr+xfc41W!rQW4<{_+S#Xjt``7r zw(*jx%r-9Ux>jrK6s9=aiv@h=zc_p23Th51Cq*uUCh^Ri>?=*h#qC|t3-_brtOU-u76HmpK^46vEKiWg?cC=PvH7|vq#OqdJ zi@F>?f)15fFzGoq>^S@G1^Q^bu-OYM*Aoa&!ZKbeV8y##!%Kw*jtqE@gz;G|F-JGU z75boZ&Vw~jiw?n(cI$b`#Ee#3y)|TD{?Mwk)R#QDpoCV+FZ4i&C+-P@;KgscE((}YXfWj2}_*ITHa#!)0I0Muy z!-|uJZ$KKI%2boiSa(j!ZpIPZp-OM{e0LS zW6qFPA;YNXksCtigG1g^iFS7lT<-@R{QNe+3GSq96kgn#p`?)0|q znCQySJby_0+=N?1m;_hdWT_uVELAV`KMUBYH!pD}Ct#h`kKj!WPp8o0os#yW<%Ik?8jgPOYO^e;bEo>zctv5Yr zky6$Bx`#o;QUJ=|XZ-nd>};o|33x9cygX~c2G56(gGavw!ap9O?#vRY!zNrTeKesw z&!**2rMWXAiSk(n9U}EqNU0ID8R7?iX~5g&5;jVOKbHd@O~TRz%I{%rI*VzYxVrMc ziGDna64W-W%O)wk%^#`|F)A>U*{mtLmmF>39&EjJ-Rh;4=Q<`u9ZsU+4XQTeaiqA~Tqy z$*T{I$A}_x?mZ93@cWRLgm2#l=979_ehZlb%{c6kzLGy z&NGA8GVp&zNiUvdpk-PHqgQFlJmPHPQD!BVoIx7N+xe1o_1ET&^szb2xsqO!gxh>4 z83qoOQB2udza@A!_HwGOk3K*0+MGL)$`gw0FDgs>b;ZjVfNN7id=@pH{o}yq=$R=rON9x4_Nhh!_TbLS5oOtSmq zGEbiKv%IMbdQ-A=Y@l%Z5kf67E41DPVh=g5F-Hhq(XXTJz%~`){zzU7mT-b%4#(&pW zC28{g@%piS$YNIe-}L+(|@(j=`VWF7W^h?Ntu<=K%Ap z9tPFx4DLVOl94AS8J8}QTzIL%HTT1v_Nq1_L>gKDzJwvpk!Y?i$B!Tzd%*1CJ&Osy z_J@gOG30x$D}ubQ-CxFKrrZzYc{#1|Upy#WCKy*^&mR*uYTlqpxSDQUz*qG|!4iLc zV7af{_Vh5eT~jKcd|zis%133FE{j{rT;Ulloh68AyR9g8eUtwJs)Lq@D;WWD?LcAW z3g5o9enf0*W$q&*PZ!|Y;bCY#N1RjDhFp;JjfhX?>TGnI)2Y05p!fn9LsXn(mrpT^ ztQPso1hzaC5#n3XkC(!d%2lXpE5{ou&rXl{W0ZfP;U{O~p@6jaLswDXc8Y^!1A7J9<*>AN_vBD}AhY zA>RAtIujiTkoZ9KMa?pK%D-VvgpZU?gYnc_hB|;dtv{Boi8(j3F$>X1{o1&Cn77xEU^L zWOU6YAAU*hcQ^7_LNvVW^zD|;UF8WmZh^uJd1dgn*EOqNhaEwjTL-^*)BvCZT<3Ey z@iUyu2b9+&svofdd7}_Gli9zZ_{RA#I5*_a@9ArY`5ptePKC+0sd-#w(r*YeGfX)5 zu?gTHIMl}M8`ETh`fq{!EkQnG{IAcY&sw>h$)@Rf7%ikYASPqj?#|QMx&OBqFl1{;trX$lZ;mo`QfUg{P(BQ z5Mk}RfdN|-zL(wYY$88(@`5&91E1qMrR}by-alE1dC9MZv)7SF7H!Sc-hpndytcdzG zl-zd53k5bx8(*R(+C;0S>^(=$qDXTUc)HKsH>4P~gELQqYV9QgjBmbfL*Gz&UB$`; z%O$#H8;R=$kd!}2#G!Mx%yyDUpEf0z}9RSsLbZd#DhVqUF$vq3oK9exKXIwH*^cbB031s%9&%2)KxlDO~BQcLmpj&dG zIZTM(FA+xYt_~r?EwEKqUGe0fC(rldGsRzLfB1_VXP%nvKat@3jN*nhU@4F&T%4m> z`5Ct$(!;KnwBC@(O=-tt%l>?yxIMVb;>t!HD_q0+fzLo7dMmdE&9V4Nh?FQk-r}^& zp{U_Lc~lqwB;Uall+<&z4_nbu9HBs)^Q2du+fAyv z%^Hcr?gjGVJnPrJ8>0hHs7s7>%M?)weH2mrt0>pO(#d&ONuI)W4iBZRnEyCKVQdm_ zYMEJ3%;Z|HI;A=Typwu5C|0UgDmrAE%Ku6@ko%g7?N??!YbBMs`uz4Z+ligDq^9Lb zhM*sSBzYy6|Y&O28h$?7M zN@%EAX3+jhcmMM_a~bo9tEJZiyMIyz_PM@CyX9VfI%%Htoe4wl?kM{O3-VWCZKToQ z6D`$=%#mu>840MeZ?H(ZL4y?}X3Rq?Gc?jTKhS75&clFb=~_{syAq+PfM*>GFw`RA zOY5HkbQHd`d_Mi~+q0~h=v*eFb=Ejh3dXw;*hhi^$UPA1Ze&t{wfHfR0dIrC8Ss=RHLO_S*kS$tCsF0&f{tD<6w2UJpB zrRHpgX|jPYU-1lt=qEp$)`K*c*yPuMsF~(3p-Jq1dtY>%o-3lw#>&sh9hJG9p9Pem4QsZ=4o}&t%X{lKj9RXs$1IuJq#nH94? zp5YwxKR&h=E(3zuZd9w?LxP@`pI=>0?FB{m7XWK~>5`0}v$a>h1CcTmUUGCZqy+G^ zXop;o8mDJ^vX@Qn-IsJS`iBfG>?gxmxZXP&^5Eu_LHDNhaFFXx|30DJb?=~TCuLaT zX;847uy>)fF@!EwEMT=5VPVF??rr7=jM3za`gNGB{h+MHl7iA+^r$6mZncRH*FSgu zI`NJs;N-X9mhC~5h`yNv=-V1!j(q*6^mkW#gIH$EzP5XlSS47te#o*L@#dj4+D zFnhu)n0(FP*@}>)ecm)k0hX2dfZKLTy_{ezCs?BJF7fZm$o%MRSW>?rC_@KL{+CB- zX$#Itzj;{sf!=D274zzCi>~$4oh}P91;AG_x*=wO5HF_WA_XJxAInbs*WCS-AKU(~ z*~GF6|5u3aasg%x|1*rH-PhU7_Wk;``iseb!>b52xFa+;F+{?5>q<&uu9+97p)cvh ze&6fM@L({|;mEZ=cQKEifI=&y$w=ivVgMZ>xVwy_Vv*?x%iD$ktUsBPSL7w#zE zPSmN(@njn&=@h+sxcxtu4*v<4;7D|!e%boQDj0~lmNrEpkawpSC#Q5#n5a|q$qo9y z_Y@IO)aoEgdVB%6)dtozM;iwq(_vlfg1ksA>)k@6$e6YX{r4q*b2HiQ_07~bSHb6* z8J0dDyQ5w0*M0lw|2!QnUiQKh-uNi@ROnGt8B+-uJJ|zExV#oyK=F$`CjhjP9+(p$ zTX>D1LA>+LFy=Le(e9V+fCaEr_^6xlQZVo^QP|F@T)^iht_QGU99VXR+C~BGni8HO!2S}fYtkbG<`r_q^EscbO5&8Kv*aH zKyh}>2*^vzUMqz1Z_eLBXrL4%v&^UZe=VOt+-e-!ib`Xr-JqPR4IkK6=$`owh#mM22}Y z@LbC5&o`99#iW)0J-P>bEEvySW_*;)23^^a@X+dz_5$kV_$;q_zu@-neMoa|KglAq zAUz$>RwdICq8_32k%_MP6BpkGWJ(G-L(f%`S2Y|aiUzoYzB{k z5Kcha->ys$5X!9oLi40s90?O$j59D)>(Ywt?0&spInZrh*P&Yk{CIZgVT64HmthV9 z5$Fzz<@Fv~&G_B}>e*fS?U}1Czpu9L5KnNIz4T)wZyWyOfl|xGfvVlcLV9zGh}tsB z!YpSN<&DXoWP+WPVCPj+g{P?f^aUbMzsD2e+vrc?nb)5qkB0@XMQ+%c4Bp~*CR}mY z@%+oA(s7nDYU<7}Etjq&77u4r+|dZTjC@wq#*GjPe*mhF%^>a+h%fX3@(FgX-Xr^l zkhXCr2#4YHm-#u);>n1DM4nCNp=0*hebr)2X7+ddwmnK$eqJ-xE@l<;vt~$q{_(?+ zav%eIc=ib@_m+AcY(?yve#H@OnLHp&WDQ(-SzqydaInxZ^pYZ&VN&bfMS=S3g_KOy z{4owJ2!Iuza*XbOj5&PKKstdSEPP@JzMMOk8Cz!`A~GvXfWQxWo58Yl1D@raH=a2% zH<<0DMRSj+(4$k^4i7Z6(byo-qYZ!X_%ZKM6PvAsygG=BmU;8(U~n^MiotVtdGhAa zJ6<356W^nc3K4hh!?!Jxcu$T81iV+>cuv-@c-q&f;ZILugy!94s$Jutrhvx@Zg)Bg zX@^-*KZeV?Czsm0@9jWce^WF-8$PoMg4bZPGqfH%sf)>F9usIjKxQJYtQo}Zv?pPU zYMNsNgLg$_f$}htYWbf6ktZ~P!8-ixz|HpSS!U}RP$3e30uyW5T*aHv1yg$@GkIz9 z1hUD(f0Ul86N)yM#9jxXaiAO?%{7#u$l~~CvAr2_W1T$YDATl-&hkeH=~&CXD*e7{ z9c7%QQ!*SsCUO2}HXbEHsNR36yF+fQ+bk}-yfBgbSJ_#*(_Tmh0Wz>gyipn(!h3_P z7x!cOcNpSOP&MXDwbFM<4)ma)8zgOf40^9gA*KBP3c1UmIJ$LT;0Z3l-3AYC0fM^* zLI@Dt-Q7Jwf?IGOEVyg%;O_3hVUQrh00YCFckg}9J@?DGRqMm*4^P*s>Z-0@y`KM1 zsBK}T=UegS(2y#2@Yl@U4@Oj4nnfZMsS7HP&isOczj%{ye2ZwRm}8cWm5j-Xv?nld))U z(iQMXM%d=3eD`7cW=Bxe((=QA=uCZwMH9;)aW&q!l7EU9ZfBp?xPjdZ0?LW}Bop>HXwij515V>#%aO+1t3*ilavxW_Ne5HZpj${Th80?#utbbr z6}84c+2Gkq$L-_Gu!IHT)Q^?Ah}hzYn;W2<*>-fITkoR?&GfkOQz6_Ox9anpjYrma7*$WmcB>De<7J@1evbK37lCv%X7VHeGHx6 zOg2 zA#Vt^N8z0R;AFIYGTFcx}M%P=HkAdZ9p!R>GA|x z@1khLH&AAAT!;tz7xGo4JAfd^i%7VWUOG(t%9wKfRqziURH>zXyZ*^y<>Lt5TESI3 zE-7}`q4}dq|8IwkjSIQybcywkzvM1uLV9}-w#bdMhs%DBn^ywKh9ys{#!UnURcUyR zM>fE;ZXoS))R@(;@X}G;1J~^e*S^bnms;EwVwRsVqwp;ScyJSmhnD^t6n--uBqp^b&Q~ zTo*rHJnixDo%hm>v}`XjmHprDdBozpj*)KlX@s~R%b0Y^3R0!z0M(MTPSn(>lF+tc z)q>L|5o;3YrIePkQP+bN7?EK)ecYf!4B;a=;C}skTfwcRpP>NZ#H&z5Gf-bDquS&( z{>5N=TnJnkpVm+kmWC&AwO0`_F zEK6|;^)2-eOYbc=E)UpjxBuA8?s{=)!E zo~hPCZ2~t=O=CYLPfW&D{${htdh4sx`xES(h0@Na8W(o815P*Z0*I-}dxpP>jn4p= zsTJcx4>qLVWD;2%s}-!}+ZB3bUp&>B+6J6SDTXoJm5Agyqvf`Ljnz0>VaYqEak1x` z7NE%!1gK+w_$VD%?%4lp5J;{66wt7)QeQ31?d~^I|xMy8EeN~ zE+^iWDz`Il54;RDfhnnpPoBL6^|V;Gi2d>tL22p}?c!fb1tz0DcC32);fN`0MP|&J zB9-;%n(=6}poIsj@p1)#iQgE7ky4I&pfaI?Eg^v@bk2xVh)E4HGcua&cFrJa?s|Qw z(NA~n{av#AZ)5hvIC)!jo&GRrO*uN=q7M-+7##+XkE5kMF$mCzndwq-*w z*cxJn%kv>UP4qY>mcEDp{tJ#Y4e|{r-{Arx06UnRB?aoJ9oC0+^HJv6vkTW@U8ciYezLK(oy=AUz9lG zUhgTB-6d4L|EA!1pB~4IvC6Tn)c6W2+8kU6XhV3TRp}Vu%|*qr{PS7^KpJHDY_i-U z`>GY=Q+A92A$^+Ebg0~J^Nwycy<~7(r>ctcc0P#pZf1V4UIVC+TLz9z&>eZV$2Qps za;mk29S*qNJ}l6N_fzw!%>b)aMeS<8E&wry!R<~+spd!N5-*(5C=$Yoyv=$d#@GgD zIXFrY6p!sp&LK_!DAcHZp4wu!Wvuv)D&cl_&4pRscn1~{o~+7_+Q?(R1a>eE{o&Q3 zwEj3i(0)lNWO?~XRkHtDUML}1nwAH3B4QjRq|otqFU&r@koxh*v_gJ&OpYJLK)x+M zj+j=!`jOhL;xTdg#ZRa(2C`_|g#MDd)FSL4qVdyuf&Yvwkr5qY{f?t!QMC8fsX+uI zrj-}%5r5)dm@}74H?q}odcc$`q(uY%DVr^~Hh zzcEcrAY$(J#35RvzX0dN?Z70^i7>{-V)$DHYrU^`DV4tMe#lkE9lwMqD>u?2x+}|- zWuLhjpw?fGaJQJsrI3Wbi`{S}1izx%&N8G5G|mxYf|c^vj|Mtw;{eH)_r-5g)v}AJ z;(?t%$g`fACaU5@+Z~qqP7Km46<5M6wk3x+Cde7zNU4{i+y5Qj^JQ|A$C4pdXo{w9 zxDI;`eY^Ej!rGK9D7Gi@JoQ?&-ZMgN^8vA4NbWm3Z$fOueX{9(!G9tZ9B0P+w>nv7 z3H7mR@J{Q$w3amj;|=r^zjn6XTV2LF;k~7@bHM_x{IK!T*Ulnh8K{tpVR9^m#8`Br z5jbvzWLLK{d?Lw{c+Z7iZ?_siGf-i9r9$t|kHjPa#d;562XT~11MIMj&?wQEeui-b? z`pXqWW-P&t6T0}Q#ald8x-DDi2P{qRabCI*`tvL^8(**cbZ~DyXfr1y`7*KVrHQS3 zOEFBY5RJJzh*_>QmhJA*_fVOCdQn&X0I-;fVvk8PooaAppU5K`OFt7*3m6UZ3zjj93T2~dKx`hQq!g^j|wGO&ZIH4aGcp)hlw#^90V@a zQj2qzkTrayGJ(*CiTShe`tE#6UOf{^s_DR(Lj{&r{z^mA(9!7h%x{*U3jrE9WpLWGCo8b{1gxTt)CUrK5S?$|Z9 zSGPetZ}ifHl<&IEyYr2taxq7Oe4b!`_&W45gg_11>GC+sXqPxTJwer7<)7;J$cEVc zKQWx?S{bX{;n4+8<{TiQ@XkrR&N=70=0cwG!b6z)2bVKrsG)ItA9_pmzoT*|)Udmi zX>tCg4!9&I<^-4IqTv&I`;TsRT5e8Sk0+_{%RIY}W?jn}3}-xQ*TeILX|i>6A^doe zjk1nWCJIRYbhxFF!uY?V(Dt3{`bo(Du1nBXEE3rPsjLj*LZKDor+< zOy-+R)|*V0n@qNwc4nG(R+@GenszptcHoHIS`+s@$?t00-(9w*BU~X0$p{gHb*?&d z^_l)=qfD#rGreM=Ov@NBEl{L{J99B6hjk1@*fDB<>U`+qY3)}N|F1Ns zi$)s}j_sy1LK9Jf?50CQGyIP?r^jOj9manx#Qr+5AOA)0Kiu3p8yuZOw@inP{4r_Mk(|d2qkqu|(bjR79GW(@dh2X%P#=rGBs$c&$=!W#HUQbXGH%{>U zqs`q-tmI|EwK<*f|7dge(>dqmaBVK9*#YJr$k*bh*B(!>HC==^@- zr3wAMCtLc7DB}$w4>>*Y6d3C#9?rqHIljj~)s5np06dRfGqJc7LD$#xRMCObHYu_t zQsU1{4c_bK&v%723pX_U-lWf^w!@oNvtFUvX3)lNlcuCyy4YwTitjJQLgi@mlpBd? zn_Gt3u>(4bi1g}y(K{gLfvK6}c#iWrF>TBz11U0josaQ-Uf@iqYHaT_*vbR%uvtee z7qDGM^HgfwFac(or?X{Ha-)&|qBFb$^7e8B4huBmg90<4&Ix=)FJV4a;s6r!e7SbK z9_-|Sk)%R!`pH#I>d;71$z?IplcA6W>GQ@PG|?K&z@M{w&SNhJR|+Svymey5*2}?L z$Ouywe`pPus{~v~{cH;*Sr4-H0Eh~kb@)x>_vN0Z#LgOXw!Lu1Zt~Z<_K;ajt1f&N zZP^P#pqD{&D=zm9XmA5;e!8X?{lsPkzyS;^X02-1Q5hb>-19r;Y*LZWxvxWMLSdRW zK@gb!?l_$ZWUlgIdI49NDmz2fCUl*hIp`yVIn9y~ZvaU+!6ACqE0s-;~a3R!3 ze1lYk#L1M9QbllA=D{U%Sr-v`mZ{i~%U>#G@~)gzicdlnmx$m`_%lIT{LycB;iZ1Y zx|i=wzxRwd*&^j{p^<9uPGiMeur7>`(M4+$CumZg_8xAydv63p2_f{7l&yQ$$m>)H z_s?YQZJV0dD?!q1C|3hjF*^<$TNz9%mr0DIhO)bM3as(tt9gR)&X&kCH-R1re9uqi zlCc{dR55$Z#;8R^5xh3k>#VUux+B1FcCwC41MA0!MhNxHG?z)DT9m&_4;CrkKJ!~6 zcWdswk>Tg*d?i(85JUx)`!T9&d4rm=J>UAmjBpxOTFoQ;Z~G0!^duoE>)-U-6=lq- z74tiUY3+|xcQR9o4$iHpcj+#Gw)W(B(tVA{S_PhGwl^i2g(GRRago$s=6pC&(<;t& zn`T|PP1K48Q=J@%3PDk-5dOApVZqu&$SSnOun(5kOTz|zw|q3d`|y4OU(&gLdh#st z2r+Olh~|pCBJ^l}U+f~CB6Mw@OY5k;u#I5%U_e)%w%;EZelX=jGL}HS+>@4=boYk36ejsDS4QB zOo3zOQ3tX*d*Njy^%Pab8YakmdGONlj>MPksqT*Sv>xgaZpy|FI+^BnwlZ8sqZ@N$ zJl3C$BsZWQ5!4?1<4YrK%VjL^J;?HUcKYcw>ZUSx=IOoWk^5v_KGR3s&XtYRO@W~f5;)8|&)E@FHB604aE*?7Y%6B? zC~R2*x*?4nU-}1%JnP!1`L~_V>IrZVIxHlcu(S%jiyQW0>ez!3^jrwWCN2Eo3|ZFi ztksP)MkFOY;URm@X*U*KW zJNw1%X=)w+GD|wTb?<*V@nn>q5>wqy35Er*y|TIp0)S1{-~FxBz-M7Se}y+3FTUpP z#(5vN?OxmyPE^(AbmV%cgpTAp)@0P)2C$M)5_d2?Ln-oDxHG2ug=sQ*Ds3F4r-T$2cO82wJ)GDvmNhY z2XBE9|9ds*6RxO8jgl>R4!up!T?EqhLjFbR@!}M~^ZE<4{8lR{O&-^>${35aWLK=x zTDq(+t8#uk;j3lVQ(@CQTJKxClE_n~rS18*9FPvNMv^!FzY2Y>eLvJ~9FVv*0)Zc1 zB2x0!_+$c@Vgn^k#u9k=fqB-3A86zMKX_ZuL}>TM9~r{2qHgUD*NbHLUTFx}yV7}$ zdqEZA?_9*i{eGC?Zu9XO*c@co_Z7S7w;;6SDr}g7i+L4eNtQeLcd6R%uBpJ5g51|c#;p9}uh#vA8@4guPa+Q8)Ff{S5)93IGqXXU%X$VNKm}do^P7t7dZ15{|XGQHq zY4-0vAoyB-5LM6U-5sL!_g&l*_~F=-t@PWHY5MPy9+iZQdB+)*m#-BRdo^F>&06GS zD=>6MI>q@tw;5(|$~xu-d9nG{gLoI2J&^|oTub{Yh(q-Qn@^GJv3ldS^n%q@F&4xh zQ8wl(BTAA{8GnBAu%4?%yDx>{j_QKH8rG7RU<4V`llO8}Z~yex&F$@G`1!m%&L+k3 zqFycaL{?{jzwpzj|JCg}>NI{fZY*mnk(%*y7;Q2aB-eT#fCA!NCnak{l&!^?#wn|n zNloAnC=s#!xO>7}otw)psTTAVr%7FRkc z@5Gpqg}6O0|KuEabb4vou~~W;k>7UTdBu--B0&qIJ=67}Arq`|mFpi5fSW01BUWG{8^VdvJjJfr&o5tgeqp+mfv z(@C2%t#W3@KW`glm<~8t_8I*g_^i7#t=ST>{H~tM&sc31?Yw+&Gz~pihGCoS8Mukj z1V;}%q#j2Kj(#+5L|v;?ngSBfs1>!I*BPQ-@SMLkIlRvn{l9z~kF$D-aYWc*Wz+IMrG%JlegwS##tLX1}vH-6D6RA;dl_WG@yuGg>S_LisI#PbUX zl(Y-F{a`1XU@W(SOG&3&<|2Zt^soBW8lV5Vun8a7eRJ`!LFdA0i$on zF}aWcg!HdD(=`BEZGYgqWO{ymtmcAjJNccc8C&3!VIIuxf(INyy%gzMFbT?qxAMH7 zu>!BuokijV-Q8G9-mS;OwHXnqljz2q&>Kp$xy`4EEh zAhw4-FH;3`$IwJ3YDNW5(;heDJ<`uWY6{GEBvfOZ>|NnOin-oTw=l0{&!4SVw6;;h zCp21OG#3|trs3Hne`nqU8=Gaj53u&|%rXWyPil&ElH;OEr9+O|JsSJXMZ0ZD&12Ck zegD(Sol=LvL{OST3cpA|vZzo^i;7&dQaD5FAARbcSTiZIOavihlr4M|lC^5mjI!BP$67 zu_X}SX47+?-$*nRRB0EL&=9*X>fcv%5{Zf8MQYFCv-FVnuv@y8X?q)pl+{yUhNQAzO#TH_pg@N+5|BKjK2_PAG-i zJpX}@a+?+BPJV_B@mv1|H)FKUZ6fkrtQ-=sXs=b963jv2%)6+C}pG6%YxiTivvj)Cy!^5s7Y z91BZEv>P@EC#)4XuhW$c&)Alm*>%q-%pU|otvg@OuRJSA3@#Ocyc3YF@5GMRSTVCF zZkW_QX4{kJsuF+g9IFc@oV&L_eoOB887=T&Fu`@EBW$6cpWbcuus8Ey;YKcj`?TKk zn>s-66!8a$(97wsk_=O+Qq#{wK5B^I95W8j=I^qLUWKN4i5U5r#Aly`>x=c$(|8$v ze}F}`?tE{aKele*PdsU)4|0j0k&-T7-3Zhc`SKf zYM*9bZF%TDy%V=GD1)haKZkfZXWdGK#+yLLZc%(N+NoE{1JW^siNT>x^gc@*$E~n-`p=?FNQE?bx>V z_iY3gbJmKc_o2lDad6iJkG+|3-ezHLeiet=LSz-E9-99cbzX*37q*OC(Rm?FKZ2%I zv9r?0xzL%^Mt8OFA0sb{{(U#vX*|#njWzm=KrtXUkFLQd%p8ltnxPx6$S0V2Evg7;Vk!Oji zI#(9T1jcH8F7Xl`RYA_+QF;dPgyM?1GHU!%=_7#0aSDH23f>s+@z8mB3j9>YKj!di z3a4k_ChE!lw!Pgc_dZnGFX?`&DOjl}P%#I}QG&)t%doZTK0TCyI2=;cQ=ok@##?^# zwh?;<4^rD{?nM(5PYBtkYk&vyn*71oUWI(l?ciAEl%DI!!D zn@m=VE6tCPKhm%;EKp9zVQLAy#noKA115D&2+N?#i*Q~Z=Y#+ra!%BbtW=k%Sb4e> zb1`*qDRd)ZV&&(Uxvj(+j`H@KbR6TG=>0h6^W;Z)L4?)yK=DI0S!aOY?1*54Q)7#A z@M%Fs=s)6FK4u-rr)X6jLu|0d+U+8f{~=H@5$xkp;DdhYBM>46p-g$_a_&8fwE4rO z^aUAF7b4Q{|2e-F2&d3ypcX$+VHH!{XiR@ZzeQ8N*LZ1oec-imR{IsD5v<4@47{EE z2O5Mh`XY60EvCZ6B;yQm<36?DsYl6|pf7TKftjIpiL(xi7tenBxFxk%xJ2lOrWq@) zLa!NqgIn&7#NxALrivYY#`F*+rBYBu)SoluuJ}098WZOPP>*7HcoG==ET((>G zx)V`2=FZ}pR@m4zyP^M3PCX*?X(Z3zNHtobbfZAMO}r>%GQrm=T_NA0w0V#0tuJBj z7bE4`^%&^VP5f$h*bQs>QP2MJ#TWsiQvTz!X0AdeV)xu}mGV5c;S721m9qF-X4Rxp zs^d{luaXsfmGa-xcmZD^kbpv$=q4e zbM>Cg=BJ7nx% + write_hrc2(file_name = "tests_multitable/hrc/activity") + +load(file = "tests_multitable/data/corr_table_nuts23_fr.RData") +hrc_file_nuts <- corr_table_nuts23_fr %>% + write_hrc2(file_name = "tests_multitable/hrc/nuts23") + +options( + rtauargus.tauargus_exe = + "Y:/Logiciels/TauArgus/TauArgus4.2.2b1/TauArgus.exe" +) + +# Ajout des tables au data/ du package +# nuts23_fr_corr_table <- corr_table_nuts23_fr %>% +# rename_with(toupper) +# +# usethis::use_data( +# turnover_act_size, +# turnover_act_cj, +# turnover_nuts_cj, +# turnover_nuts_size, +# nuts23_fr_corr_table, +# activity_corr_table, +# overwrite = TRUE +# ) +# +# purrr::walk( +# list( +# turnover_act_size, +# turnover_act_cj, +# turnover_nuts_cj, +# turnover_nuts_size, +# nuts23_fr_corr_table, +# activity_corr_table +# ), +# str +# ) + +# Test 1 ----- +# Liste de deux tables liées + +list_data_2_tabs <- list( + act_size = turnover_act_size, + act_cj = turnover_act_cj +) %>% + purrr::map( + function(df){ + df %>% + mutate( + is_secret_freq = N_OBS > 0 & N_OBS < 3, + is_secret_dom = ifelse(MAX == 0, FALSE, MAX/TOT>0.85), + is_secret_prim = is_secret_freq | is_secret_dom + ) + # mutate(N_OBS = ifelse(N_OBS > 0 & N_OBS < 1, 1, round(N_OBS))) + } + ) + +res_1 <- tab_multi_manager( + list_tables = list_data_2_tabs, + list_explanatory_vars = list( + act_size = c("ACTIVITY", "SIZE"), + act_cj = c("ACTIVITY", "CJ") + ), + hrc = c(ACTIVITY = hrc_file_activity), + dir_name = "tests_multitable/test_1/tauargus_files", + value = "TOT", + freq = "N_OBS", + secret_var = "is_secret_prim", + num_iter_max = 5, + totcode = "Total" +) + +# controle de cohérence des masques sur les cases communes +res_1$act_size %>% filter(SIZE == "Total") %>% + select(ACTIVITY, TOT, N_OBS, is_secret_prim, is_secret_treff = last_col()) %>% + full_join( + res_1$act_cj %>% filter(CJ == "Total") %>% + select(ACTIVITY, TOT, N_OBS, is_secret_prim, is_secret_cj = last_col()) + ) %>% + mutate(pb = is_secret_cj != is_secret_treff) %>% + filter(pb) + +# Test 2 ---- + +# Test avec 4 tables liées + +list_data_4_tabs <- list( + act_size = turnover_act_size, + act_cj = turnover_act_cj, + nuts_treff = turnover_nuts_size, + nuts_cj = turnover_nuts_cj +) %>% + purrr::map( + function(df){ + df %>% + mutate( + is_secret_freq = N_OBS > 0 & N_OBS < 3, + is_secret_dom = ifelse(MAX == 0, FALSE, MAX/TOT>0.85), + is_secret_prim = is_secret_freq | is_secret_dom + ) + # mutate(N_OBS = ifelse(N_OBS > 0 & N_OBS < 1, 1, round(N_OBS))) + } + ) + +res_2 <- tab_multi_manager( + list_tables = list_data_4_tabs, + list_explanatory_vars = list( + act_size = c("ACTIVITY", "SIZE"), act_cj = c("ACTIVITY", "CJ"), + nuts_treff = c("NUTS", "SIZE"), nuts_cj = c("NUTS", "CJ") + ), + hrc = c( + ACTIVITY = hrc_file_activity, + NUTS = hrc_file_nuts + ), + dir_name = "tests_multitable/test_2/tauargus_files", + value = "TOT", + freq = "N_OBS", + secret_var = "is_secret_prim", + num_iter_max = 5, + totcode = "Total" +) + +res_2$act_size %>% filter(SIZE == "Total") %>% select(ACTIVITY, is_secret_treff = last_col()) %>% + full_join( + res_2$act_cj %>% filter(CJ == "Total") %>% select(ACTIVITY, is_secret_cj = last_col()), + by = "ACTIVITY" + ) %>% + filter(is_secret_treff != is_secret_cj) + +res_2$nuts_treff %>% filter(SIZE == "Total") %>% select(NUTS, is_secret_treff = last_col()) %>% + full_join( + res_2$nuts_cj %>% filter(CJ == "Total") %>% select(NUTS, is_secret_cj = last_col()), + by = "NUTS" + ) %>% + filter(is_secret_treff != is_secret_cj) diff --git a/tests_multitable/test_multitable_ofats.R b/tests_multitable/test_multitable_ofats.R new file mode 100644 index 0000000..e226f3c --- /dev/null +++ b/tests_multitable/test_multitable_ofats.R @@ -0,0 +1,196 @@ +library(dplyr) + +devtools::load_all() + +options( + rtauargus.tauargus_exe = + "Y:/Logiciels/TauArgus/TauArgus4.2.2b1/TauArgus.exe" +) + +rep_X <- "X:/HAB-Traitement-Confidentialite/Ofats/OFATS 2020/tests" +rep_inputs <- file.path(rep_X, "inputs") +rep_traits <- file.path(rep_X, "traitements") +rep_hrc <- file.path(rep_traits, "hrc") +rep_res <- file.path(rep_X, "resultats") + +p <- lapply( + list(rep_X, rep_inputs, rep_traits, rep_hrc, rep_res), + function(rep){ + if(!dir.exists(rep)) dir.create(rep) + } +) + +nace <- readxl::read_xls( + file.path(rep_inputs, "Nomenclatures.xls"), + sheet = "NACE" +) +str(nace) + +table_passage = nace %>% + select(6:2) %>% + mutate(across(.fns = ~gsub("F$","",.x))) %>% + unique() +racine = "ZZZ" + +file_nace_hrc <- nace %>% + select(6:2) %>% + mutate(across(.fns = ~gsub("F$","",.x))) %>% + unique() %>% + arrange(across(CODE5:CODE1)) %>% + write_hrc2( + output_name = "nace", + dir_name = rep_hrc, + sort_table = FALSE, + adjust_unique_roots = TRUE + ) + +# Création de deux hiérarchies non emboîtées des pays #### + +pays <- readxl::read_xls( + file.path(rep_inputs, "Nomenclatures.xls"), + sheet = "PAYS" +) %>% + mutate( + across(everything(), ~gsub(" ","_",.)) + ) +str(pays) + +file_zone_hrc <- pays %>% + select(zone, PAYS) %>% + unique() %>% + arrange(across(zone:PAYS)) %>% + write_hrc2( + output_name = "zone", + dir_name = rep_hrc, + sort_table = FALSE, + adjust_unique_roots = TRUE + ) + +file_off_hrc <- pays %>% + select(Offshore, PAYS) %>% + unique() %>% + write_hrc2( + output_name = "offshore", + dir_name = rep_hrc, + sort_table = FALSE, + adjust_unique_roots = TRUE + ) + +# Constitution des différents tableaux #### + +ofats <- haven::read_sas(file.path(rep_inputs, "ofats_2020_pr_app_secret_V4.sas7bdat")) %>% + filter(stringr::str_ends(NACE, pattern = "F$", negate = TRUE)) %>% + mutate( + across(PAYS, ~gsub(" ","_",.)) + ) +ofats <- ofats %>% + bind_rows( + ofats %>% group_by(PAYS, NOM_VAR) %>% + summarise( + VAL_ABS = sum(VAL_ABS), + FREQ = sum(FREQ), + MAX_VAL_ABS = max(MAX_VAL_ABS), + .groups = "drop" + ) %>% + mutate(NACE = "Total", diffusion = 1) + ) + + +poser_secret_primaire <- function(df, var = "ENT"){ + df %>% + {if(var == "ENT"){ + mutate( + ., + is_secret_freq = FREQ > 0 & FREQ < 3 & (diffusion == 1), + is_secret_dom = FALSE + )} else{ + mutate( + ., + is_secret_freq = FREQ > 0 & FREQ < 3 & (diffusion == 1), + is_secret_dom = VAL_ABS > 0 & MAX_VAL_ABS/VAL_ABS > 0.85 & (diffusion == 1) + )}} %>% + mutate(is_secret_prim = is_secret_freq | is_secret_dom) %>% + mutate(FREQ = ifelse(FREQ > 0 & FREQ < 1, 1, round(FREQ))) +} + +constituer_tableaux_par_var <- function(data = ofats, type_var){ + ofats_sel <- ofats %>% + filter(NOM_VAR == type_var) %>% + poser_secret_primaire(var = type_var) + + var_liste <- list() + var_liste[["zone"]] <- ofats_sel %>% + filter(PAYS %in% c(pays$PAYS, pays$zone, "A1")) %>% + select(PAYS, NACE, VAL_ABS, MAX_VAL_ABS, FREQ, diffusion, starts_with("is_secret")) + var_liste[["off"]] <- ofats_sel %>% + filter(PAYS %in% c(pays$PAYS, pays$Offshore, "A1")) %>% + select(PAYS, NACE, VAL_ABS, MAX_VAL_ABS, FREQ, diffusion, starts_with("is_secret")) + # lapply(var_liste, str) + + return(var_liste) +} + +all_vars <- ofats$NOM_VAR %>% unique() ##################TODO######### +all_tableaux <- setNames(lapply(all_vars, constituer_tableaux_par_var, data = ofats), all_vars) + +# Pose du Secret secondaire #### + +all_masques <- purrr::map( + all_vars, + function(var){ + cat("GESTION TABLEAUX ", var, "\n") + list_data_2_tabs <- list( + t_zone = all_tableaux[[var]]$zone, + t_off = all_tableaux[[var]]$off + ) + res <- multi_linked_tables( + list_tables = list_data_2_tabs, + list_explanatory_vars = list(t_zone = c("PAYS", "NACE"), t_off = c("PAYS", "NACE")), + list_hrc = list( + t_zone = c(PAYS = file_zone_hrc, NACE = file_nace_hrc), + t_off = c(PAYS = file_off_hrc, NACE = file_nace_hrc) + ), + dir_name = file.path(rep_traits, var, "tauargus_files"), + totcode = c(PAYS = "A1", NACE = "Total"), + value = "VAL_ABS", + freq = "FREQ", + secret_var = "is_secret_prim", + num_iter_max = 20, + ip_start = 1, + ip_end = 0 + ) + } +) + +res$t_zone %>% mutate(status = case_when(is_secret_prim ~ "AB", is_secret_7 ~ "D", TRUE ~ "V")) %>% + count(status) + +controle <- list() + +controle[["t_zone"]] <- read.csv( + file.path("X:\\HAB-Traitement-Confidentialite\\Ofats\\OFATS 2020\\traitements\\fichiers_tauargus\\EMP\\zone.csv"), + header = FALSE, + col.names = c(c("PAYS", "NACE"), "VAL_ABS", "FREQ", "Status","Dom"), + colClasses = c(rep("character", 2), rep("numeric",2), "character", "numeric"), + na.strings = "", + stringsAsFactors = FALSE +) + +controle$t_zone %>% count(Status) + +fus <- controle$t_zone %>% select(1:2,Status) %>% unique() %>% + full_join( + res$t_zone %>% select(1:3, last_col())) + +nrow(fus) + +fus %>% + filter(is.na(Status)) %>% + nrow() +fus %>% + filter(is.na(is_secret_7)) %>% + nrow() +fus %>% filter(is_secret_7 & Status == "V") + + +all_masques <- setNames(all_masques, all_vars) From 9e64e4c393d30245bba9caf7525084da6dfda850 Mon Sep 17 00:00:00 2001 From: julienjamme Date: Fri, 26 Aug 2022 15:43:16 +0200 Subject: [PATCH 068/107] gestion params unif dans tab_rtauargus --- R/tab_rda.R | 4 ---- R/tab_rtauargus.R | 4 ++-- 2 files changed, 2 insertions(+), 6 deletions(-) diff --git a/R/tab_rda.R b/R/tab_rda.R index 8a95823..5ca1f91 100644 --- a/R/tab_rda.R +++ b/R/tab_rda.R @@ -395,10 +395,6 @@ tab_rda <- function( {stop("decimals are not allowed for frequency")} #Controles sur secret_var - - if (is.null(secret_var) && is.null(safety_rules)) - {stop("Please specify safety_rules of secret_var for primary suppression")} - if ((!is.null(secret_var)) && (!secret_var %in% colnames(tabular))) {stop("secret_var does not exist in tabular")} diff --git a/R/tab_rtauargus.R b/R/tab_rtauargus.R index e6bbc3a..040dc6b 100644 --- a/R/tab_rtauargus.R +++ b/R/tab_rtauargus.R @@ -402,8 +402,8 @@ tab_rtauargus2 <- function( params$show_batch_console = FALSE params$output_type = 4 params$output_options = "" - params$unif_hrc = TRUE - params$unif_expl = TRUE + if(! "unif_hrc" %in% names(params)) params$unif_hrc = TRUE + if(! "unif_expl" %in% names(params)) params$unif_expl = TRUE params$separator = "," params$verbose = FALSE From 8133287d0e6ee2b68008520a9a4df3d38eeffd18 Mon Sep 17 00:00:00 2001 From: Rastout Nathanael Date: Fri, 26 Aug 2022 15:43:45 +0200 Subject: [PATCH 069/107] Ajout de la vignette pour gestion du secret --- vignettes/vignette_options_secret.Rmd | 90 +++++++++++++++++++++++++++ 1 file changed, 90 insertions(+) create mode 100644 vignettes/vignette_options_secret.Rmd diff --git a/vignettes/vignette_options_secret.Rmd b/vignettes/vignette_options_secret.Rmd new file mode 100644 index 0000000..f1f3fbe --- /dev/null +++ b/vignettes/vignette_options_secret.Rmd @@ -0,0 +1,90 @@ +--- +title: "vignette_suppress" +output: html_document +date: '2022-08-25' +--- + +```{r setup, include=FALSE} +knitr::opts_chunk$set(echo = TRUE) +knitr::opts_knit$set(root.dir = getwd()) +``` + + +## Primary and secondary suppression for tabular data + +### The safety_rules options : + +By default this parameters is set to **"MAN(10)"**, that is because we always use an apriori to specify the primary suppression. + +If you want to set rules for primary suppression th syntax is : +- *"rule_number1|rule_number2|rule_number3|..."* +At least one safety rule is required. + +These are all allowed rules according to τ-Argus manual . +The most common rules are : + +- The dominance rule **NK(n,k)** with : + - n the size of the coalition + - k the max percentage +- The treshold rule **Freq(n,p)** with : + - n the minimum frequency allowed + - p the Frequency Safety Range +- The p percent rule **P(p,n)** with : + - the maximum accuracy of the estimation in percent + - n (optional, default = 1), the size of the coalition +- The safety margin **MAN(p)** with : + - p the margin to use in percent, default (20) + +The other ones : + +- The request rule **REQ(p1,p2,SafetyMargin)** +- The zero safety range parameter **ZERO(p)** +- The status of missing codes **MIS(b)** with : + - b = 0 (default) cells with a missing code is unsafe if the safety rules ares are violated + - b = 1 these cells are always safe + +Some rules can appear multiple times **(P,NK)** + +You can get more details with the τ-Argus manual in the sections : +- _4.4.4 Specify Tables_ +- _5.7 The Batch command file_ + +### The suppress options : + +The default options is **"MOD(1,5,1,0,0)"** +It fits for our business statistics. + +For each of the following parameters, the number of the table is needed, in our case it will always be **1**. + +The possible options are : + +- **MOD: Modular** : + - MOD(TabNo, MaxTimePerSubtable, SingleSingle,SingleMultiple, MinFreq) + - The last 3 parameters are the singleton options. + Each parameter can be 0 or 1. If 1 the option is activated. + + - **OPT: Optimal** : + - OPT(TabNo, MaxComputingTime) + +- **GH Hypercube** : + - GH(TabNo, A priori Bounds Percentage, ModelSize,ApplySingleton) + - ModelSize 0 = normal, 1 indicates the large model. + - ApplySingleton: 1 = yes,0 = no; default = yes if the table has frequency-information, no if not. + +- **NET: Network** : + - NET(TabNo) + +- **RND: Controlled rounding** : + - RND(TabNo, RoundingBase, Steps, MaxTime, Partitions, StopRule) + - Steps: number of steps allowed, normally 0 (default) + - MaxTime: Max computing time (10 = default) + - Partitions: 0, 1 (0 = no partitioning (default), 1 = apply the partitioning procedure) + - StopRule: 1 = Rapid only, 2 = First feasible solution, 3 = optimal solution (3 =default) + +- **CTA: Controlled Tabular Adjustment** : + - CTA(TabNo) + +More details are available in the τ-Argus manual, especially in the section **4.2.3** + + + From 08303a78d2b9a75e404fbb3b61f7a3b61d4d9b5b Mon Sep 17 00:00:00 2001 From: julienjamme Date: Fri, 26 Aug 2022 16:16:23 +0200 Subject: [PATCH 070/107] enrich presentation_rtauargus vignette --- vignettes/presentation_rtauargus.Rmd | 168 +++++++++++++++------------ 1 file changed, 95 insertions(+), 73 deletions(-) diff --git a/vignettes/presentation_rtauargus.Rmd b/vignettes/presentation_rtauargus.Rmd index 6b44619..b193d18 100644 --- a/vignettes/presentation_rtauargus.Rmd +++ b/vignettes/presentation_rtauargus.Rmd @@ -11,6 +11,11 @@ knitr::opts_knit$set(root.dir = getwd()) +```{r} +devtools::load_all() +``` + + ## Introduction ### Presentation of the package @@ -30,7 +35,7 @@ more easily to possible modifications of the software (new methods available, additional options...). The syntax rules for writing batch are given in the τ-Argus reference manual and will be specified in a dedicated help section. -> The package was developed on the basis of open source versions of τ-Argus (versions 4.1 and above), in particular the latest version available at the time of development (4.1.7). +> The package was developed on the basis of open source versions of τ-Argus (versions 4.2 and above), in particular the latest version available at the time of development (4.2.2b1). > > It is not compatible with version 3.5.**_ @@ -63,7 +68,7 @@ The latest releases can be downloaded here: [https://github.com/sdcTools/tauargu _rtauargus_ requires some other R packages.Those are the dependencies to install. - ```{r, echo = FALSE, comment = "•"} + ```{r, echo = FALSE, comment = "•"} imports <- packageDescription("rtauargus", fields = "Imports") cat(gsub(", ", "\n", imports)) ``` @@ -103,13 +108,13 @@ With this small adjustment done, the package is ready to be used. > _For a more customized configuration, see the specific vignettes_ -### Using `tab_rtauargus` function +### Protecting a single tabular data with `tab_rtauargus()` function -The `tab_rtauargus` function performs a full processing to protect the table and retrieves the results immediately in R. +The `tab_rtauargus()` function performs a full processing to protect the table and retrieves the results immediately in R. -Completely abstracting from the inner workings of τ-Argus, it allows the entire processing to be made in a single instruction in fact, all intermediate files are created in a local directory. +Completely abstracting from the inner workings of τ-Argus, it allows the entire processing to be made in a single instruction. All intermediate files are created in a local directory. -`tab_rtauargus` requires the following arguments : +`tab_rtauargus()` requires the following arguments : - `tabular`: a data.frame containing the table ; - `dir_name`: the directory for the outputs; @@ -120,7 +125,7 @@ Completely abstracting from the inner workings of τ-Argus, it allows the ent All the arguments and their default options will be detailed ( where?). -#### Minimalist example +#### Minimal example For the following demonstration, a fictitious table will be used: @@ -161,13 +166,13 @@ By default, the function displays in the console the logbook content in which user can read all steps run by τ-Argus. This can be retrieved in the logbook.txt file. With `verbose = FALSE`, the function can be silenced. By default, the function returns the original dataset with one variable more, -called `Status`, direct result of τ-Argus describing the status of each cell -as follows: +called `Status`, directly resulting from τ-Argus and describing the status of +each cell as follows: --`A`: primary secret cell because of frequency rule; --`B`: primary secret cell because of dominance rule (1st contributor); --`C`: primary secret cell because of frequency rule (more contributors in case when n>1); --`D`: secondary secret cell; +-`A`: primary secret cell because of frequency rule; +-`B`: primary secret cell because of dominance rule (1st contributor); +-`C`: primary secret cell because of frequency rule (more contributors in case when n>1); +-`D`: secondary secret cell; -`V`: valid cells - no need to mask. ```{r} @@ -176,9 +181,9 @@ ex1 All the files generated by the function are written in the specified directory -(`dir_name` argument). The default format for the protected table is csv but it can be changed. All the τ-Argus files (.tab, .rda, .arb and .txt) will be written too. -To go further, you can consult the latest version of the τ-Argus manual is downloadable here: -[https://research.cbs.nl/casc/Software/TauManualV4.1.pdf](https://research.cbs.nl/casc/Software/TauManualV4.1.pdf). +(`dir_name` argument). The default format for the protected table is csv but it can be changed. All the τ-Argus files (.tab, .rda, .arb and .txt) are written in the +same directory, too. To go further, you can consult the latest version of the τ-Argus manual is downloadable here: +[https://research.cbs.nl/casc/Software/TauManualV4.1.pdf](https://research.cbs.nl/casc/Software/TauManualV4.1.pdf). #### Example with hierarchy and primary secret already done @@ -190,21 +195,18 @@ is broken down by business sectors and size. To load the data, do: ```{r load_data} data("turnover_act_size") -``` - -```{r head_data} head(turnover_act_size) ``` The meaning of each variable is: -`ACTIVITY`: business sector, hierarchical variables with three levels described -in the `activity_corr_table` dataset. The root is noted "Total"; +in the `activity_corr_table` dataset. The root is noted "Total"; -`SIZE`: size of the companies (Number of employees in three categories -+ overall category "Total"); --`N_OBS`: Frequency, number of companies; --`TOT`: turnover value in euros; --`MAX`: turnover of the company which contributes the most to the cell. ++ overall category "Total"); +-`N_OBS`: Frequency, number of companies; +-`TOT`: turnover value in euros; +-`MAX`: turnover of the company which contributes the most to the cell. ##### Hierarchy's file @@ -222,19 +224,19 @@ head(activity_corr_table) ```{r hierarchy} -write_hrc2( +hrc_file_activity <- write_hrc2( corr_table = activity_corr_table, - file_name = "act.hrc" + file_name = "hrc/activity.hrc" ) ``` ##### Primary secret In this example, we'll apply the primary secret ourselves, *i.e.* not with the -help of τ-Argus. So, the idea is to use τ-Argus with an apriori file. +help of τ-Argus. The idea is to use τ-Argus with an apriori file. For that purpose, we create a boolean variable to specify -which cells don't respect the primary secret rules. Using the same rules as before: - +which cells don't comply with the primary secret rules. Using the same rules as before, +we get: ```{r prim_secret} turnover_act_size <- turnover_act_size %>% @@ -250,8 +252,8 @@ turnover_act_size <- turnover_act_size %>% Two arguments has to be added to the `tab_rtauargus()` function: -`secret_var`, indicating the name of the variable in `tabular` containing the -primary secret (apriori) information, --`hrc`, indicating the name of the hierarchy file to use for `ACTIVITY` variable. +primary secret (apriori) information; +-`hrc`, indicating the name of the hierarchy file to use for `ACTIVITY` variable. Since the primary suppression was already specified, no need to use the arguments, `safety_rules` and `maxscore`. The first one is set by default to "MAN(10)", so @@ -268,10 +270,12 @@ ex2 <- tab_rtauargus( value = "TOT", freq = "N_OBS", secret_var = "is_secret_prim", - hrc = c(ACTIVITY = "act.hrc"), + hrc = c(ACTIVITY = hrc_file_activity), totcode = c(ACTIVITY="Total",SIZE="Total"), suppress = "OPT(1,5)", - verbose=FALSE + verbose=FALSE, + unif_hrc = FALSE, + unif_expl = FALSE ) ``` @@ -300,61 +304,79 @@ ex2 %>% ``` -#### Treating multiple linked tables +### Protecting several tables at the same time, with `tab_muli_manager()` function -The function `tab_multi_manager` can deal with a whole set of linked (or not) tables. -It is an iterating process, performing secondary suppression with one table at a time and ensure that the common cells have the same status. When a common cell is concerned by secondary suppression it reverberates the secret on each table that shares this common cell. The process ends when the secondary secret is consistent in every tables. +The function `tab_multi_manager()` can deal with a whole set of (linked or not) tables. +It is an iterating process, performing secondary suppression with one table at a time and it ensures that the common cells have the same status. When a common cell is concerned by secondary suppression, it reverberates the secret on each table that shares this common cell. The process ends when the secondary secret is consistent in every tables. See more details in vignettes *Manage the protection of linked tables* -#### Example +#### Data For this example, two tables will be used : -- ACTIVITY x SIZE -- ACTIVITY x CJ +```{r} +data("turnover_act_size") +data("turnover_act_cj") +str(turnover_act_cj) +``` -Since the two table share one common explanatory variable, they can't be treated separately. +The second tabular dataset provides the turnover of companies broken down by +business sectors (`ACTIVITY`) and type of company (`CJ`). The latter has three +categories and the overall category is noted "Total". -Indicate whether each cell complies with the primary rules -Boolean variable created is TRUE if the cell doesn't comply. -Here the frequency rule is FREQ(3,10) -and the dominance rule is NK(1,85) +Since the two tables share one common explanatory variable (`ACTIVITY`), they can't be treated separately without risk of inconsistent protection. -``` +#### Primary secret + +The first step consists in indicating whether each cell complies with the primary rules, +or not. A boolean variable is created, equal to TRUE if the cell doesn't comply. + +Here, we use the same rules as previously. + +```{r} list_data_2_tabs <- list( - act_size = turnover_act_size, - act_cj = turnover_act_cj + act_size = turnover_act_size, + act_cj = turnover_act_cj ) %>% -purrr::map( - function(df){ - df %>% - mutate( - is_secret_freq = N_OBS > 0 & N_OBS < 3, - is_secret_dom = ifelse(MAX == 0, FALSE, MAX/TOT>0.85), - is_secret_prim = is_secret_freq | is_secret_dom - ) - } -) + purrr::map( + function(df){ + df %>% + mutate( + is_secret_freq = N_OBS > 0 & N_OBS < 3, + is_secret_dom = MAX > TOT*0.85, + is_secret_prim = is_secret_freq | is_secret_dom + ) + } + ) ``` + + +#### Running τ-Argus + Now that the primary secret has been specified for both tables, we can run the process. -``` -res_1 <- tab_multi_manager( +```{r} +ex3 <- tab_multi_manager( list_tables = list_data_2_tabs, list_explanatory_vars = list( - act_size = c("ACTIVITY", "SIZE"), - act_cj = c("ACTIVITY", "CJ") - ), - hrc = c(ACTIVITY = hrc_file_activity), - dir_name = "tauargus_files", - value = "TOT", - freq = "N_OBS", - secret_var = "is_secret_prim", - totcode = "Total" + act_size = c("ACTIVITY", "SIZE"), + act_cj = c("ACTIVITY", "CJ") + ), + hrc = c(ACTIVITY = hrc_file_activity), + dir_name = "ex3", + value = "TOT", + freq = "N_OBS", + secret_var = "is_secret_prim", + totcode = "Total" ) ``` -The function uses tab_rtauargus with many default parameters that can be changed. -The tables needs to share the same column names for : -- value -- freq -- secret_var +By default, the function uses a wrapper of `tab_rtauargus()` function, called `tab_rtauargus2()`, to apply secondary secret with τ-Argus. Many default parameters are set. In particular: +- Interval Protection fixed to 10; +- Suppress method set to "MOD(1,5,1,0,0); +- Output. + +When running, the function displays at each iteration which table is treated. + +The vignette *Manage the protection of linked tables* provides a full presentation +of `tab_multi_manager()` function. + From cb3d0b78c47567006764a5d1340fe0748eb35458 Mon Sep 17 00:00:00 2001 From: julienjamme Date: Fri, 26 Aug 2022 16:35:25 +0200 Subject: [PATCH 071/107] qqs corrections sur vignette presentation des options de secret --- vignettes/vignette_options_secret.Rmd | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/vignettes/vignette_options_secret.Rmd b/vignettes/vignette_options_secret.Rmd index f1f3fbe..21132b2 100644 --- a/vignettes/vignette_options_secret.Rmd +++ b/vignettes/vignette_options_secret.Rmd @@ -1,5 +1,5 @@ --- -title: "vignette_suppress" +title: "Primary and secondary suppression for tabular data " output: html_document date: '2022-08-25' --- @@ -10,17 +10,17 @@ knitr::opts_knit$set(root.dir = getwd()) ``` -## Primary and secondary suppression for tabular data - -### The safety_rules options : +## Primary suppression with the `safety_rules` options : -By default this parameters is set to **"MAN(10)"**, that is because we always use an apriori to specify the primary suppression. +In `tab_rtauargus()` function, the primary suppression options have to be set in the `safety_rules` argument. By default this parameter is set to **"MAN(10)"**, useful when using +apriori and Interval protection level of 10%. -If you want to set rules for primary suppression th syntax is : +If you want to set rules for primary suppression the syntax is : - *"rule_number1|rule_number2|rule_number3|..."* At least one safety rule is required. -These are all allowed rules according to τ-Argus manual . +These are all allowed rules according to τ-Argus manual. + The most common rules are : - The dominance rule **NK(n,k)** with : @@ -33,7 +33,7 @@ The most common rules are : - the maximum accuracy of the estimation in percent - n (optional, default = 1), the size of the coalition - The safety margin **MAN(p)** with : - - p the margin to use in percent, default (20) + - p the margin to use in percent The other ones : @@ -49,7 +49,7 @@ You can get more details with the τ-Argus manual in the sections : - _4.4.4 Specify Tables_ - _5.7 The Batch command file_ -### The suppress options : +## The suppress options : The default options is **"MOD(1,5,1,0,0)"** It fits for our business statistics. From b075d420215f649b74bd64bbf13d1b24503347b0 Mon Sep 17 00:00:00 2001 From: julienjamme Date: Mon, 29 Aug 2022 11:11:14 +0200 Subject: [PATCH 072/107] gestion vignettes --- .gitignore | 6 + vignettes/options_safety_rules.Rmd | 95 ++ ...cret.Rmd => options_safety_rules.Rmd.orig} | 57 +- vignettes/precompilation.R | 10 + vignettes/presentation_rtauargus.Rmd | 382 ------ vignettes/rtauargus.Rmd | 1092 +++++------------ vignettes/rtauargus.Rmd.orig | 854 ++++--------- vignettes/rtauargus_micro.Rmd | 974 +++++++++++++++ vignettes/rtauargus_micro.Rmd.orig | 699 +++++++++++ 9 files changed, 2404 insertions(+), 1765 deletions(-) create mode 100644 vignettes/options_safety_rules.Rmd rename vignettes/{vignette_options_secret.Rmd => options_safety_rules.Rmd.orig} (70%) delete mode 100644 vignettes/presentation_rtauargus.Rmd create mode 100644 vignettes/rtauargus_micro.Rmd create mode 100644 vignettes/rtauargus_micro.Rmd.orig diff --git a/.gitignore b/.gitignore index 0c1fac5..c4d8fa6 100644 --- a/.gitignore +++ b/.gitignore @@ -7,3 +7,9 @@ NEWS.html tmp inst/doc vignettes/tauargus_exe.ini +.hrc +.rda +.asc +.arb +.hst + diff --git a/vignettes/options_safety_rules.Rmd b/vignettes/options_safety_rules.Rmd new file mode 100644 index 0000000..e27fbad --- /dev/null +++ b/vignettes/options_safety_rules.Rmd @@ -0,0 +1,95 @@ +--- +title: "Safety rules and Suppress Options" +subtitle:

![logo R](R_logo_small.png)![logo τ-Argus](TauBall2_small.png)
Package {rtauargus}

+output: + rmarkdown::html_vignette: + toc: true + toc_depth: 3 +vignette: > + %\VignetteIndexEntry{Safety rules and Suppress Options} + %\VignetteEngine{knitr::rmarkdown} + %\VignetteEncoding{UTF-8} +--- + + + + + +## Primary suppression with the `safety_rules` options : + +In `tab_rtauargus()` function, the primary suppression options have to be set in the `safety_rules` argument. By default this parameter is set to **"MAN(10)"**, useful when using +apriori and Interval protection level of 10%. + +If you want to set rules for primary suppression the syntax is : +- *"rule_number1|rule_number2|rule_number3|..."* +At least one safety rule is required. + +These are all allowed rules according to τ-Argus manual. + +The most common rules are : + +- The dominance rule **NK(n,k)** with : + - n the size of the coalition + - k the max percentage +- The treshold rule **Freq(n,p)** with : + - n the minimum frequency allowed + - p the Frequency Safety Range +- The p percent rule **P(p,n)** with : + - the maximum accuracy of the estimation in percent + - n (optional, default = 1), the size of the coalition +- The safety margin **MAN(p)** with : + - p the margin to use in percent + +The other ones : + +- The request rule **REQ(p1,p2,SafetyMargin)** +- The zero safety range parameter **ZERO(p)** +- The status of missing codes **MIS(b)** with : + - b = 0 (default) cells with a missing code is unsafe if the safety rules ares are violated + - b = 1 these cells are always safe + +Some rules can appear multiple times **(P,NK)** + +You can get more details with the τ-Argus manual in the sections : +- _4.4.4 Specify Tables_ +- _5.7 The Batch command file_ + +## The suppress options : + +The default options is **"MOD(1,5,1,0,0)"** +It fits for our business statistics. + +For each of the following parameters, the number of the table is needed, in our case it will always be **1**. + +The possible options are : + +- **MOD: Modular** : + - MOD(TabNo, MaxTimePerSubtable, SingleSingle,SingleMultiple, MinFreq) + - The last 3 parameters are the singleton options. + Each parameter can be 0 or 1. If 1 the option is activated. + + - **OPT: Optimal** : + - OPT(TabNo, MaxComputingTime) + +- **GH Hypercube** : + - GH(TabNo, A priori Bounds Percentage, ModelSize,ApplySingleton) + - ModelSize 0 = normal, 1 indicates the large model. + - ApplySingleton: 1 = yes,0 = no; default = yes if the table has frequency-information, no if not. + +- **NET: Network** : + - NET(TabNo) + +- **RND: Controlled rounding** : + - RND(TabNo, RoundingBase, Steps, MaxTime, Partitions, StopRule) + - Steps: number of steps allowed, normally 0 (default) + - MaxTime: Max computing time (10 = default) + - Partitions: 0, 1 (0 = no partitioning (default), 1 = apply the partitioning procedure) + - StopRule: 1 = Rapid only, 2 = First feasible solution, 3 = optimal solution (3 =default) + +- **CTA: Controlled Tabular Adjustment** : + - CTA(TabNo) + +More details are available in the τ-Argus manual, especially in the section **4.2.3** + + + diff --git a/vignettes/vignette_options_secret.Rmd b/vignettes/options_safety_rules.Rmd.orig similarity index 70% rename from vignettes/vignette_options_secret.Rmd rename to vignettes/options_safety_rules.Rmd.orig index 21132b2..9fa277a 100644 --- a/vignettes/vignette_options_secret.Rmd +++ b/vignettes/options_safety_rules.Rmd.orig @@ -1,35 +1,42 @@ --- -title: "Primary and secondary suppression for tabular data " -output: html_document -date: '2022-08-25' +title: "Safety rules and Suppress Options" +subtitle:

![logo R](R_logo_small.png)![logo τ-Argus](TauBall2_small.png)
Package {rtauargus}

+output: + rmarkdown::html_vignette: + toc: true + toc_depth: 3 +vignette: > + %\VignetteIndexEntry{Safety rules and Suppress Options} + %\VignetteEngine{knitr::rmarkdown} + %\VignetteEncoding{UTF-8} --- + ```{r setup, include=FALSE} knitr::opts_chunk$set(echo = TRUE) -knitr::opts_knit$set(root.dir = getwd()) ``` -## Primary suppression with the `safety_rules` options : +## Primary suppression with the `safety_rules` options : -In `tab_rtauargus()` function, the primary suppression options have to be set in the `safety_rules` argument. By default this parameter is set to **"MAN(10)"**, useful when using +In `tab_rtauargus()` function, the primary suppression options have to be set in the `safety_rules` argument. By default this parameter is set to **"MAN(10)"**, useful when using apriori and Interval protection level of 10%. -If you want to set rules for primary suppression the syntax is : +If you want to set rules for primary suppression the syntax is : - *"rule_number1|rule_number2|rule_number3|..."* At least one safety rule is required. -These are all allowed rules according to τ-Argus manual. +These are all allowed rules according to τ-Argus manual. -The most common rules are : +The most common rules are : -- The dominance rule **NK(n,k)** with : +- The dominance rule **NK(n,k)** with : - n the size of the coalition - k the max percentage - The treshold rule **Freq(n,p)** with : - n the minimum frequency allowed - - p the Frequency Safety Range -- The p percent rule **P(p,n)** with : + - p the Frequency Safety Range +- The p percent rule **P(p,n)** with : - the maximum accuracy of the estimation in percent - n (optional, default = 1), the size of the coalition - The safety margin **MAN(p)** with : @@ -40,16 +47,16 @@ The other ones : - The request rule **REQ(p1,p2,SafetyMargin)** - The zero safety range parameter **ZERO(p)** - The status of missing codes **MIS(b)** with : - - b = 0 (default) cells with a missing code is unsafe if the safety rules ares are violated + - b = 0 (default) cells with a missing code is unsafe if the safety rules ares are violated - b = 1 these cells are always safe Some rules can appear multiple times **(P,NK)** -You can get more details with the τ-Argus manual in the sections : +You can get more details with the τ-Argus manual in the sections : - _4.4.4 Specify Tables_ - _5.7 The Batch command file_ -## The suppress options : +## The suppress options : The default options is **"MOD(1,5,1,0,0)"** It fits for our business statistics. @@ -58,30 +65,30 @@ For each of the following parameters, the number of the table is needed, in our The possible options are : -- **MOD: Modular** : +- **MOD: Modular** : - MOD(TabNo, MaxTimePerSubtable, SingleSingle,SingleMultiple, MinFreq) - The last 3 parameters are the singleton options. - Each parameter can be 0 or 1. If 1 the option is activated. - + Each parameter can be 0 or 1. If 1 the option is activated. + - **OPT: Optimal** : - - OPT(TabNo, MaxComputingTime) - + - OPT(TabNo, MaxComputingTime) + - **GH Hypercube** : - GH(TabNo, A priori Bounds Percentage, ModelSize,ApplySingleton) - ModelSize 0 = normal, 1 indicates the large model. - ApplySingleton: 1 = yes,0 = no; default = yes if the table has frequency-information, no if not. -- **NET: Network** : +- **NET: Network** : - NET(TabNo) - -- **RND: Controlled rounding** : + +- **RND: Controlled rounding** : - RND(TabNo, RoundingBase, Steps, MaxTime, Partitions, StopRule) - Steps: number of steps allowed, normally 0 (default) - MaxTime: Max computing time (10 = default) - Partitions: 0, 1 (0 = no partitioning (default), 1 = apply the partitioning procedure) - StopRule: 1 = Rapid only, 2 = First feasible solution, 3 = optimal solution (3 =default) - -- **CTA: Controlled Tabular Adjustment** : + +- **CTA: Controlled Tabular Adjustment** : - CTA(TabNo) More details are available in the τ-Argus manual, especially in the section **4.2.3** diff --git a/vignettes/precompilation.R b/vignettes/precompilation.R index ccff7a8..c25a2c4 100644 --- a/vignettes/precompilation.R +++ b/vignettes/precompilation.R @@ -5,3 +5,13 @@ knitr::knit( "vignettes/rtauargus.Rmd.orig", "vignettes/rtauargus.Rmd" ) + +knitr::knit( + "vignettes/rtauargus_micro.Rmd.orig", + "vignettes/rtauargus_micro.Rmd" +) + +knitr::knit( + "vignettes/options_safety_rules.Rmd.orig", + "vignettes/options_safety_rules.Rmd" +) diff --git a/vignettes/presentation_rtauargus.Rmd b/vignettes/presentation_rtauargus.Rmd deleted file mode 100644 index b193d18..0000000 --- a/vignettes/presentation_rtauargus.Rmd +++ /dev/null @@ -1,382 +0,0 @@ ---- -title: "vignette_presentation" -output: html_document -date: '2022-08-25' ---- - -```{r setup, include=FALSE} -knitr::opts_chunk$set(echo = TRUE) -knitr::opts_knit$set(root.dir = getwd()) -``` - - - -```{r} -devtools::load_all() -``` - - -## Introduction - -### Presentation of the package - -The _rtauargus_ package offers an **R** interface for **τ-Argus**. -It allows to : - -- create inputs (asc, tab and rda files) from R data; -- generate the sequence of instructions to be executed in batch mode (arb file); -- launch a batch τ-Argus ; -- retrieve the results in R. - -The syntax of some of the arguments closely matches the _batch_ syntax of -τ-Argus. This allows a large number of functions to be used without -multiplying the arguments of the functions. The package will also be able to adapt -more easily to possible modifications of the software (new -methods available, additional options...). -The syntax rules for writing batch are given in the τ-Argus reference manual and will be specified in a dedicated help section. - -> The package was developed on the basis of open source versions of τ-Argus (versions 4.2 and above), in particular the latest version available at the time of development (4.2.2b1). -> -> It is not compatible with version 3.5.**_ - -### Purpose of this document - -This document aims to explain the main functionalities of the package, -using relatively simple examples. -A detailed documentation of any function (exhaustive list of arguments, -technical aspects...) is available *via* the dedicated help section. - -

- summary ↑ -

- - - - - -## Setup - -The following setup should be made before the first use (and no longer afterwards) - -### τ-Argus - -_rtauargus_ fonctions using τ-Argus requires that the software can be used from the workstation. -The github repository of τ-Argus is here: [https://github.com/sdcTools/tauargus](https://github.com/sdcTools/tauargus). -The latest releases can be downloaded here: [https://github.com/sdcTools/tauargus/releases](https://github.com/sdcTools/tauargus/releases). - -### Dependencies - - _rtauargus_ requires some other R packages.Those are the dependencies to install. - - ```{r, echo = FALSE, comment = "•"} -imports <- packageDescription("rtauargus", fields = "Imports") -cat(gsub(", ", "\n", imports)) -``` -The package _rtauargus_ can be installed now. - -

- sommaire ↑ -

- - - - -## Quick Start - -This section explains how to perform a minimal configuration of the package and -how to apply suppressive methods in a single instruction. - -### Location of τ-Argus - -When loading the package, the console displays some information: - -```{r library} -library(rtauargus) -``` - -In particular, a plausible location for the τ-Argus software is -predefined. This can be changed for the duration of the R session, as follows: - -```{r opt_exe, include = FALSE} -loc_tauargus <- "Y:/Logiciels/TauArgus/TauArgus4.2.2b1/TauArgus.exe" - -options(rtauargus.tauargus_exe = loc_tauargus) -``` - - -With this small adjustment done, the package is ready to be used. - -> _For a more customized configuration, see the specific vignettes_ - -### Protecting a single tabular data with `tab_rtauargus()` function - -The `tab_rtauargus()` function performs a full processing to protect the table and retrieves the results immediately in R. - -Completely abstracting from the inner workings of τ-Argus, it allows the entire processing to be made in a single instruction. All intermediate files are created in a local directory. - -`tab_rtauargus()` requires the following arguments : - -- `tabular`: a data.frame containing the table ; -- `dir_name`: the directory for the outputs; -- `files_name`: all the τ-Argus files will be named with it (different extensions); -- `explanatory_vars`: the name of all explanatory variables in `tabular`; -- `secret_var` or `safety_rules`: the way to apply primary suppression (explain later) -- `totcode`: the code for total of each explanatory variable in `tabular` - -All the arguments and their default options will be detailed ( where?). - -#### Minimal example - -For the following demonstration, a fictitious table will be used: - -```{r data} -act_size <- - data.frame( - ACTIVITY = c("01","01","01","02","02","02","06","06","06","Total","Total","Total"), - SIZE = c("tr1","tr2","Total","tr1","tr2","Total","tr1","tr2","Total","tr1","tr2","Total"), - VAL = c(100,50,150,30,20,50,60,40,100,190,110,300), - N_OBS = c(10,5,15,2,5,7,8,6,14,20,16,36), - MAX = c(20,15,20,20,10,20,16,38,38,20,38,38) - ) -act_size -``` - -As primary rules, we use the two following ones: - -- The n-k dominance rule with n=1 and k = 85 -- The minimum frequency rule with n = 3 and a safety range of 10. - -To get the results for the dominance rule, we need to specify the largest contributor to each cell, corresponding to the `MAX` variable in the tabular data. - -```{r rtauargus_ex1} -ex1 <- tab_rtauargus( - act_size, - dir_name = "tauargus_files", - files_name = "ex1", - explanatory_vars = c("ACTIVITY","SIZE"), - safety_rules = "FREQ(3,10)|NK(1,85)", - value = "VAL", - freq = "N_OBS", - maxscore = "MAX", - totcode = c(ACTIVITY="Total",SIZE="Total") -) -``` - -By default, the function displays in the console the logbook content in which -user can read all steps run by τ-Argus. This can be retrieved in the logbook.txt file. With `verbose = FALSE`, the function can be silenced. - -By default, the function returns the original dataset with one variable more, -called `Status`, directly resulting from τ-Argus and describing the status of -each cell as follows: - --`A`: primary secret cell because of frequency rule; --`B`: primary secret cell because of dominance rule (1st contributor); --`C`: primary secret cell because of frequency rule (more contributors in case when n>1); --`D`: secondary secret cell; --`V`: valid cells - no need to mask. - -```{r} -ex1 -``` - - -All the files generated by the function are written in the specified directory -(`dir_name` argument). The default format for the protected table is csv but it can be changed. All the τ-Argus files (.tab, .rda, .arb and .txt) are written in the -same directory, too. To go further, you can consult the latest version of the τ-Argus manual is downloadable here: -[https://research.cbs.nl/casc/Software/TauManualV4.1.pdf](https://research.cbs.nl/casc/Software/TauManualV4.1.pdf). - - -#### Example with hierarchy and primary secret already done - -##### Data - -For this example, we'd like to protect a table in which companies' turnover -is broken down by business sectors and size. To load the data, do: - -```{r load_data} -data("turnover_act_size") -head(turnover_act_size) -``` - -The meaning of each variable is: - --`ACTIVITY`: business sector, hierarchical variables with three levels described -in the `activity_corr_table` dataset. The root is noted "Total"; --`SIZE`: size of the companies (Number of employees in three categories -+ overall category "Total"); --`N_OBS`: Frequency, number of companies; --`TOT`: turnover value in euros; --`MAX`: turnover of the company which contributes the most to the cell. - -##### Hierarchy's file - -Before performing the `tab_rtauargus()` function, we have to prepare the hierarchical -information into the appropriate format for τ-Argus, *.i.e.* a `.hrc` file. -From a correspondence table, the `write_hrc2()` function does the job for you. - -Here, the correspondence table describes the nesting of the three levels of business -sectors, from the most aggregated to the least one: - -```{r} -data(activity_corr_table) -head(activity_corr_table) -``` - - -```{r hierarchy} -hrc_file_activity <- write_hrc2( - corr_table = activity_corr_table, - file_name = "hrc/activity.hrc" -) -``` - -##### Primary secret - -In this example, we'll apply the primary secret ourselves, *i.e.* not with the -help of τ-Argus. The idea is to use τ-Argus with an apriori file. -For that purpose, we create a boolean variable to specify -which cells don't comply with the primary secret rules. Using the same rules as before, -we get: - -```{r prim_secret} -turnover_act_size <- turnover_act_size %>% - mutate( - is_secret_freq = N_OBS > 0 & N_OBS < 3, - is_secret_dom = MAX > TOT*0.85, - is_secret_prim = is_secret_freq | is_secret_dom - ) -``` - -##### Running τ-Argus - -Two arguments has to be added to the `tab_rtauargus()` function: - --`secret_var`, indicating the name of the variable in `tabular` containing the -primary secret (apriori) information; --`hrc`, indicating the name of the hierarchy file to use for `ACTIVITY` variable. - -Since the primary suppression was already specified, no need to use the arguments, -`safety_rules` and `maxscore`. The first one is set by default to "MAN(10)", so -as to say that a 10% Interval Protection is applied. - -By default, `tab_rtauargus()` runs the Modular method to perform the secondary secret. Here, we choose to use the Optimal method by changing the `suppress` argument. - -```{r rtauargus_ex2} -ex2 <- tab_rtauargus( - turnover_act_size, - dir_name = "tauargus_files/", - files_name = "ex2", - explanatory_vars = c("ACTIVITY","SIZE"), - value = "TOT", - freq = "N_OBS", - secret_var = "is_secret_prim", - hrc = c(ACTIVITY = hrc_file_activity), - totcode = c(ACTIVITY="Total",SIZE="Total"), - suppress = "OPT(1,5)", - verbose=FALSE, - unif_hrc = FALSE, - unif_expl = FALSE -) -``` - -##### Result - -```{r} -str(ex2) -``` - -```{r} -table(ex2$Status) -``` - -As we can see in the `table()` results, all the primary secret has the status "B" -in the output produced by τ-Argus. To adjust this, we can do: - -```{r} -ex2 %>% - mutate( - Status = dplyr::case_when( - is_secret_freq ~ "A", - TRUE ~ Status - ) - ) %>% - dplyr::count(Status) -``` - - -### Protecting several tables at the same time, with `tab_muli_manager()` function - -The function `tab_multi_manager()` can deal with a whole set of (linked or not) tables. -It is an iterating process, performing secondary suppression with one table at a time and it ensures that the common cells have the same status. When a common cell is concerned by secondary suppression, it reverberates the secret on each table that shares this common cell. The process ends when the secondary secret is consistent in every tables. See more details in vignettes *Manage the protection of linked tables* - -#### Data - -For this example, two tables will be used : - -```{r} -data("turnover_act_size") -data("turnover_act_cj") -str(turnover_act_cj) -``` - -The second tabular dataset provides the turnover of companies broken down by -business sectors (`ACTIVITY`) and type of company (`CJ`). The latter has three -categories and the overall category is noted "Total". - -Since the two tables share one common explanatory variable (`ACTIVITY`), they can't be treated separately without risk of inconsistent protection. - -#### Primary secret - -The first step consists in indicating whether each cell complies with the primary rules, -or not. A boolean variable is created, equal to TRUE if the cell doesn't comply. - -Here, we use the same rules as previously. - -```{r} -list_data_2_tabs <- list( - act_size = turnover_act_size, - act_cj = turnover_act_cj -) %>% - purrr::map( - function(df){ - df %>% - mutate( - is_secret_freq = N_OBS > 0 & N_OBS < 3, - is_secret_dom = MAX > TOT*0.85, - is_secret_prim = is_secret_freq | is_secret_dom - ) - } - ) -``` - - -#### Running τ-Argus - -Now that the primary secret has been specified for both tables, we can run the process. - -```{r} -ex3 <- tab_multi_manager( - list_tables = list_data_2_tabs, - list_explanatory_vars = list( - act_size = c("ACTIVITY", "SIZE"), - act_cj = c("ACTIVITY", "CJ") - ), - hrc = c(ACTIVITY = hrc_file_activity), - dir_name = "ex3", - value = "TOT", - freq = "N_OBS", - secret_var = "is_secret_prim", - totcode = "Total" -) -``` - -By default, the function uses a wrapper of `tab_rtauargus()` function, called `tab_rtauargus2()`, to apply secondary secret with τ-Argus. Many default parameters are set. In particular: -- Interval Protection fixed to 10; -- Suppress method set to "MOD(1,5,1,0,0); -- Output. - -When running, the function displays at each iteration which table is treated. - -The vignette *Manage the protection of linked tables* provides a full presentation -of `tab_multi_manager()` function. - diff --git a/vignettes/rtauargus.Rmd b/vignettes/rtauargus.Rmd index b3ce016..0f361e5 100644 --- a/vignettes/rtauargus.Rmd +++ b/vignettes/rtauargus.Rmd @@ -1,17 +1,16 @@ --- -title: "τ-Argus depuis R" +title: "τ-Argus from R - tabular version" subtitle:

![logo R](R_logo_small.png)![logo τ-Argus](TauBall2_small.png)
Package {rtauargus}

output: rmarkdown::html_vignette: toc: true toc_depth: 3 vignette: > - %\VignetteIndexEntry{Tau-Argus depuis R} + %\VignetteIndexEntry{Tau-Argus from R - tabular version} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- - +```r +devtools::load_all() +#> i Loading rtauargus +#> +#> Tau-Argus : "Y:/Logiciels/TauArgus/TauArgus4.2.2b1/TauArgus.exe" +#> +#> Pour changer ce repertoire : +#> options(rtauargus.tauargus_exe = "chemin/vers/TauArgus.exe") +#> +#> Pour revenir a l'emplacement par defaut : +#> reset_rtauargus_options("tauargus_exe") +#> +#> Pour afficher l'ensemble des options du package : +#> rtauargus_options() +``` - - - ## Introduction -### Présentation du package - -Le package _rtauargus_ offre une interface **R** pour **τ-Argus**. -Il permet de : +### Presentation of the package -- créer les inputs (fichiers asc et rda) à partir de données au format R ; -- générer la séquence d'instructions à exécuter en mode batch (fichier arb) ; -- lancer un batch τ-Argus en ligne de commande ; -- récupérer les résultats dans R. +The _rtauargus_ package offers an **R** interface for **τ-Argus**. +It allows to : -Ces différentes opérations peuvent être exécutées en une seule fois, mais aussi -de manière modulaire. Elles permettent d'intégrer les tâches réalisées par -τ-Argus dans une chaîne de traitement écrite en R. +- create inputs (asc, tab and rda files) from R data; +- generate the sequence of instructions to be executed in batch mode (arb file); +- launch a batch τ-Argus ; +- retrieve the results in R. -La syntaxe de certains arguments colle au plus près à la syntaxe _batch_ de -τ-Argus. Ceci permet d'utiliser un grand nombre de fonctionnalités sans -multiplier les arguments des fonctions. Le package pourra en outre s'adapter -plus facilement à d'éventuelles modifications du logiciel (nouvelles -méthodes disponibles, options supplémentaires...). Les règles de syntaxe pour -l'écriture de batch figurent dans le manuel de référence de τ-Argus. +The syntax of some of the arguments closely matches the _batch_ syntax of +τ-Argus. This allows a large number of functions to be used without +multiplying the arguments of the functions. The package will also be able to adapt +more easily to possible modifications of the software (new +methods available, additional options...). +The syntax rules for writing batch are given in the τ-Argus reference manual and will be specified in a dedicated help section. -> _Le package a été développé sur la base des versions open source de τ -> -Argus (versions 4.1 et supérieures), en particulier la dernière version -> disponible lors du développement (4.1.7)._ -> -> _**Il n'est pas compatible avec la version 3.5.**_ +> The package was developed on the basis of open source versions of τ-Argus (versions 4.2 and above), in particular the latest version available at the time of development (4.2.2b1). > -> Pour l'instant, **seules les microdonnées sont acceptées** en entrée (pas les -> données déjà tabulées). +> It is not compatible with version 3.5.**_ -### Objectif de ce document +### Purpose of this document -Ce document vise à montrer comment les fonctionnalités principales du package -peuvent être articulées, à partir d'exemples relativement simples. Une -documentation détaillée d'une fonction (liste exhaustive des arguments, -aspects techniques...) est disponible via la rubrique d'aide dédiée. - -Pour la démonstration qui va suivre, un jeu de microdonnées fictif sera -utilisé : - - -```r -donnees <- - data.frame( - V1 = c("A", "A", "A", "A", "B", "B", "B", "C"), - V2 = c("Y", "Z"), - V3 = c("T1", "T2", "T1", "S_", "T1", "T1", "T1", "S_"), - VAL = c(100, 0, 7, 25, 0, 4, 0, 5), - POIDS = c(1, 2.71, 4.2, 1) - ) -donnees -#> V1 V2 V3 VAL POIDS -#> 1 A Y T1 100 1.00 -#> 2 A Z T2 0 2.71 -#> 3 A Y T1 7 4.20 -#> 4 A Z S_ 25 1.00 -#> 5 B Y T1 0 1.00 -#> 6 B Z T1 4 2.71 -#> 7 B Y T1 0 4.20 -#> 8 C Z S_ 5 1.00 -``` +This document aims to explain the main functionalities of the package, +using relatively simple examples. +A detailed documentation of any function (exhaustive list of arguments, +technical aspects...) is available *via* the dedicated help section.

- sommaire ↑ + summary ↑

-## Installation -Les installations suivantes sont à réaliser avant la première utilisation (et -plus par la suite). +## Setup -### τ-Argus +The following setup should be made before the first use (and no longer afterwards) -Les fonctions de _rtauargus_ appelant τ-Argus nécessitent que ce logiciel -soit accessible depuis le poste de travail. Le téléchargement de τ-Argus -se fait sur la [page dédiée](https://research.cbs.nl/casc/tau.htm) du site de -l'office néerlandais de statistiques. +### τ-Argus -Cependant, toutes les fonctions n'exécutent pas τ-Argus (création des -microdonnées...). Ne pas l'avoir sur son poste n'est donc pas bloquant. +_rtauargus_ fonctions using τ-Argus requires that the software can be used from the workstation. +The github repository of τ-Argus is here: [https://github.com/sdcTools/tauargus](https://github.com/sdcTools/tauargus). +The latest releases can be downloaded here: [https://github.com/sdcTools/tauargus/releases](https://github.com/sdcTools/tauargus/releases). -### Dépendances +### Dependencies -Pour fonctionner, _rtauargus_ dépend d'autres packages R. Ceux-ci sont à -installer au préalable (entre parenthèses les versions minimales requises). + _rtauargus_ requires some other R packages.Those are the dependencies to install. ``` -• purrr (>= 0.2) -• dplyr (>= 0.7) -• gdata -• stringr +• purrr (>= 0.2), +• dplyr (>= 0.7), +• gdata, +• stringr, +• rlang, +• zoo ``` - -### Package - -Le package _rtauargus_ est prêt à être installé. +The package _rtauargus_ can be installed now.

- sommaire ↑ + sommaire ↑

-## Prise en main rapide +## Quick Start -Cette partie explique comment effectuer une configuration minimale du package et -comment appliquer le secret statistique en une seule instruction. +This section explains how to perform a minimal configuration of the package and +how to apply suppressive methods in a single instruction. -### Emplacement de τ-Argus +### Location of τ-Argus -Au chargement du package, la console affiche quelques informations : +When loading the package, the console displays some information: ```r library(rtauargus) -#> -#> Tau-Argus : "Y:/Logiciels/Tau/TauArgus.exe" -#> (note : emplacement inconnu) -#> -#> Pour changer ce repertoire : -#> options(rtauargus.tauargus_exe = "chemin/vers/TauArgus.exe") -#> -#> Pour revenir a l'emplacement par defaut : -#> reset_rtauargus_options("tauargus_exe") -#> -#> Pour afficher l'ensemble des options du package : -#> rtauargus_options() ``` -En particulier, un emplacement plausible pour le logiciel τ-Argus est -prédéfini. Il est possible de le changer pour toute la durée de la session R. Un -message indique que cet emplacement est inconnu, on le modifie donc : +In particular, a plausible location for the τ-Argus software is +predefined. This can be changed for the duration of the R session, as follows: -``` r -options(rtauargus.tauargus_exe = "D:/Program Files/TauArgus/TauArgus4.1.7b4/TauArgus.exe") -``` -Ce petit réglage effectué, le package est prêt à être utilisé. +With this small adjustment done, the package is ready to be used. -> _Pour une configuration plus personnalisée, consulter la section -> options du package._ +> _For a more customized configuration, see the specific vignettes_ +### Protecting a single tabular data with `tab_rtauargus()` function -### Fonction `rtauargus` +The `tab_rtauargus()` function performs a full processing to protect the table and retrieves the results immediately in R. -La fonction éponyme `rtauargus` effectue un traitement et récupère les -résultats immédiatement dans R. +Completely abstracting from the inner workings of τ-Argus, it allows the entire processing to be made in a single instruction. All intermediate files are created in a local directory. -S'abstrayant totalement des rouages internes de τ-Argus, elle permet de -réaliser l'ensemble du traitement en une seule instruction (concrètement, tous -les fichiers intermédiaires sont créés dans un répertoire temporaire qui est -effacé à la fin de la session R). +`tab_rtauargus()` requires the following arguments : -`rtauargus` prend comme arguments obligatoires : +- `tabular`: a data.frame containing the table ; +- `dir_name`: the directory for the outputs; +- `files_name`: all the τ-Argus files will be named with it (different extensions); +- `explanatory_vars`: the name of all explanatory variables in `tabular`; +- `secret_var` or `safety_rules`: the way to apply primary suppression (explain later) +- `totcode`: the code for total of each explanatory variable in `tabular` -- un data.frame contenant les microdonnées ; -- une liste de 1 à 10 tabulations composées de variables du data.frame (une - seule dans l'exemple ci-après) ; -- la (les) règle(s) à appliquer pour le secret primaire ; -- la (les) méthode(s) pour la suppression des cases en secret secondaire. +All the arguments and their default options will be detailed ( where?). -Les deux derniers arguments utilisent la syntaxe batch τ-Argus. +#### Minimal example -#### Exemple minimaliste +For the following demonstration, a fictitious table will be used: ```r -rtauargus( - microdata = donnees, - explanatory_vars = "V1", - safety_rules = "FREQ(3,10)", - suppress = "GH(1,100)" -) -#> [[1]] -#> V1 Freq Status -#> 1 Total 8 1 -#> 2 A 4 1 -#> 3 B 3 11 -#> 4 C 1 5 +act_size <- + data.frame( + ACTIVITY = c("01","01","01","02","02","02","06","06","06","Total","Total","Total"), + SIZE = c("tr1","tr2","Total","tr1","tr2","Total","tr1","tr2","Total","tr1","tr2","Total"), + VAL = c(100,50,150,30,20,50,60,40,100,190,110,300), + N_OBS = c(10,5,15,2,5,7,8,6,14,20,16,36), + MAX = c(20,15,20,20,10,20,16,38,38,20,38,38) + ) +act_size +#> ACTIVITY SIZE VAL N_OBS MAX +#> 1 01 tr1 100 10 20 +#> 2 01 tr2 50 5 15 +#> 3 01 Total 150 15 20 +#> 4 02 tr1 30 2 20 +#> 5 02 tr2 20 5 10 +#> 6 02 Total 50 7 20 +#> 7 06 tr1 60 8 16 +#> 8 06 tr2 40 6 38 +#> 9 06 Total 100 14 38 +#> 10 Total tr1 190 20 20 +#> 11 Total tr2 110 16 38 +#> 12 Total Total 300 36 38 ``` -Comme aucune variable de réponse n'est renseignée, un comptage est effectué -("<freq>"). +As primary rules, we use the two following ones: -#### Exemple élaboré +- The n-k dominance rule with n=1 and k = 85 +- The minimum frequency rule with n = 3 and a safety range of 10. -D'autres paramètres sont disponibles. On peut par exemple compléter -l'instruction précédente avec : +To get the results for the dominance rule, we need to specify the largest contributor to each cell, corresponding to the `MAX` variable in the tabular data. - - une deuxième tabulation (les deux tableaux seront traités indépendamment) ; - - un paramètre permettant de ne pas afficher le statut du secret pour le - premier tableau ; - - un paramètre permettant de masquer le journal de τ-Argus dans la console. -De plus, les tables produites ne sont plus simplement envoyées dans la console. -Elles sont stockées dans un objet `secret1` (une liste constituée de deux -data.frame), que l'on pourra continuer de manipuler. +```r +ex1 <- tab_rtauargus( + act_size, + dir_name = "tauargus_files", + files_name = "ex1", + explanatory_vars = c("ACTIVITY","SIZE"), + safety_rules = "FREQ(3,10)|NK(1,85)", + value = "VAL", + freq = "N_OBS", + maxscore = "MAX", + totcode = c(ACTIVITY="Total",SIZE="Total") +) +#> Start of batch procedure; file: Z:\SDC\OutilsConfidentialite\rtauargus\vignettes\tauargus_files\ex1.arb +#> "Z:\SDC\OutilsConfidentialite\rtauargus\vignettes\tauargus_files\ex1.tab" +#> "Z:\SDC\OutilsConfidentialite\rtauargus\vignettes\tauargus_files\ex1.rda" +#> "ACTIVITY""SIZE"|"VAL"|| +#> FREQ(3,10)|NK(1,85) +#> 1 +#> Tables have been read +#> MOD(1,5,1,0,0) +#> Start of the modular protection for table ACTIVITY x SIZE | VAL +#> End of modular protection. Time used 0 seconds +#> Number of suppressions: 2 +#> (1,4,,"Z:\SDC\OutilsConfidentialite\rtauargus\vignettes\tauargus_files\ex1.csv") +#> Table: ACTIVITY x SIZE | VAL has been written +#> Output file name: Z:\SDC\OutilsConfidentialite\rtauargus\vignettes\tauargus_files\ex1.csv +#> End of TauArgus run +``` + +By default, the function displays in the console the logbook content in which +user can read all steps run by τ-Argus. This can be retrieved in the logbook.txt file. With `verbose = FALSE`, the function can be silenced. + +By default, the function returns the original dataset with one variable more, +called `Status`, directly resulting from τ-Argus and describing the status of +each cell as follows: + +-`A`: primary secret cell because of frequency rule; +-`B`: primary secret cell because of dominance rule (1st contributor); +-`C`: primary secret cell because of frequency rule (more contributors in case when n>1); +-`D`: secondary secret cell; +-`V`: valid cells - no need to mask. ```r -secret1 <- - rtauargus( - microdata = donnees, - explanatory_vars = list("V1", c("V1", "V2")), # 2 tabulations (V1, V1xV2) - safety_rules = "FREQ(3,10)", - suppress = "GH(.,100)", # . remplace le numéro de tabulation - output_options = c("", "AS+"), # pas de statut pour le 1er tableau - show_batch_console = FALSE # pour masquer le journal - ) - -secret1 -#> [[1]] -#> V1 Freq -#> 1 Total 8 -#> 2 A 4 -#> 3 B x -#> 4 C x -#> -#> [[2]] -#> V1 V2 Freq Status -#> 1 Total Total 8 1 -#> 2 Total Y 4 1 -#> 3 Total Z 4 1 -#> 4 A Total 4 11 -#> 5 A Y 2 5 -#> 6 A Z 2 5 -#> 7 B Total 3 11 -#> 8 B Y 2 5 -#> 9 B Z 1 5 -#> 10 C Total 1 5 -#> 11 C Y NA 14 -#> 12 C Z 1 5 +ex1 +#> ACTIVITY SIZE VAL N_OBS MAX Status +#> 1 01 Total 150 15 20 V +#> 2 01 tr1 100 10 20 V +#> 3 01 tr2 50 5 15 V +#> 4 02 Total 50 7 20 V +#> 5 02 tr1 30 2 20 A +#> 6 02 tr2 20 5 10 D +#> 7 06 Total 100 14 38 V +#> 8 06 tr1 60 8 16 D +#> 9 06 tr2 40 6 38 B +#> 10 Total Total 300 36 38 V +#> 11 Total tr1 190 20 20 V +#> 12 Total tr2 110 16 38 V ``` -> _Note sur l'écriture `suppress = "GH(.,100)"` :_ -> -> _Le premier paramètre attendu par τ-Argus est le numéro de la tabulation. -> Ici, on souhaite appliquer la même méthode de suppression du secret secondaire -> à chaque tableau. S'il n'y a qu'une méthode et plusieurs tabulations, les -> caractères entre la parenthèse et la première virgule sont ignorés et les -> numéros des tabulations calculés automatiquement._ - -L'aide de la fonction ne décrit que les 4 arguments obligatoires. Les arguments -optionnels disponibles sont documentés dans les fonctions élémentaires la -constituant (`micro_asc_rda`, `micro_arb`, `run_arb`, `import`). Tout -argument de ces fonctions peut être utilisé dans `rtauargus`. Leur -fonctionnement est détaillé dans la section qui suit. - -

- sommaire ↑ -

- - - - -## Décomposition du processus - - -Utiliser la fonction `rtauargus` est pratique en terme de lignes de code à -saisir. Toutefois, cette manière de procéder peut s'avérer assez lourde -si les tableaux à secrétiser ont en commun un certain nombre de -caractéristiques. - -On voudrait par exemple ne générer que les fichiers asc et rda, puis lancer -plusieurs batch utilisant ces mêmes fichiers. Ce n'était pas le cas dans les -exemples vus jusqu'à maintenant, où tous les fichiers intermédiaires étaient -systématiquement regénérés, même si leur contenu était identique. - -Pour cela, on peut utiliser les fonctions appelées successivement par la -fonction `rtauargus`, à savoir : -> **[micro_asc_rda()](#fonction-micro_asc_rda)   →   - [micro_arb()](#fonction-micro_arb)   →   - [run_arb()](#fonction-run_arb)   →   - [import()](#fonction-import)** +All the files generated by the function are written in the specified directory +(`dir_name` argument). The default format for the protected table is csv but it can be changed. All the τ-Argus files (.tab, .rda, .arb and .txt) are written in the +same directory, too. To go further, you can consult the latest version of the τ-Argus manual is downloadable here: +[https://research.cbs.nl/casc/Software/TauManualV4.1.pdf](https://research.cbs.nl/casc/Software/TauManualV4.1.pdf). -### [1] Fonction `micro_asc_rda` -τ-Argus n'accepte en entrée que des microdonnées sous une forme bien -spécifique : +#### Example with hierarchy and primary secret already done -- un fichier texte aux colonnes de longueur fixe, sans en-tête de colonnes - (fichier .asc) ; -- un fichier de description des variables (fichier .rda). +##### Data -La fonction `micro_asc_rda` produit ces deux fichiers à partir d'un data.frame. +For this example, we'd like to protect a table in which companies' turnover +is broken down by business sectors and size. To load the data, do: -#### Exemple minimaliste - -On ne renseigne ici que les données et le nom du fichier asc. Comme le nom du -fichier de métadonnées n'est pas spécifié, il prend le même nom que le fichier -asc, mais avec l'extension .rda. - - -```r -micro_asc_rda(donnees, asc_filename = "Z:/donnees.asc") -``` - -Contenu des fichiers créés : ```r -file.show("Z:/donnees.asc", "Z:/donnees.rda", pager = "internal") +data("turnover_act_size") +head(turnover_act_size) +#> # A tibble: 6 x 5 +#> ACTIVITY SIZE N_OBS TOT MAX +#> +#> 1 AZ Total 405 44475. 6212. +#> 2 BE Total 12878 24827613. 1442029. +#> 3 FZ Total 28043 8907311. 1065833. +#> 4 GI Total 62053 26962063. 3084242. +#> 5 JZ Total 8135 8584917. 3957364. +#> 6 KZ Total 8140 62556596. 10018017. ``` -``` - donnees.asc donnees.rda - - A Y T1 100 1.00 V1 1 1 - A Z T2 0 2.71 - A Y T1 7 4.20 "Total" - A Z S_ 25 1.00 V2 3 1 - B Y T1 0 1.00 - B Z T1 4 2.71 "Total" - B Y T1 0 4.20 V3 5 2 - C Z S_ 5 1.00 - "Total" - VAL 8 3 - - 0 - POIDS 12 4 - - 2 -``` - -> _Les fonctions du package acceptent les emplacements de fichiers sous forme -> de chemin relatif. Par exemple, `asc_filename = "donnees.asc"` avec un -> répertoire de travail sur `Z:/` est équivalent à -> `asc_filename = "Z:/donnees.asc"`._ +The meaning of each variable is: -#### Exemple élaboré +-`ACTIVITY`: business sector, hierarchical variables with three levels described +in the `activity_corr_table` dataset. The root is noted "Total"; +-`SIZE`: size of the companies (Number of employees in three categories ++ overall category "Total"); +-`N_OBS`: Frequency, number of companies; +-`TOT`: turnover value in euros; +-`MAX`: turnover of the company which contributes the most to the cell. -On ajoute à l'exemple précédent : +##### Hierarchy's file -- une variable de poids ; -- les informations sur une variable hiérarchique ; -- des codes différenciés pour les totaux ; -- un nombre minimal de décimales à écrire pour les variables numériques. +Before performing the `tab_rtauargus()` function, we have to prepare the hierarchical +information into the appropriate format for τ-Argus, *.i.e.* a `.hrc` file. +From a correspondence table, the `write_hrc2()` function does the job for you. +Here, the correspondence table describes the nesting of the three levels of business +sectors, from the most aggregated to the least one: -```r -micro_asc_rda( - microdata = donnees, - asc_filename = "Z:/donnees.asc", - weight_var = "POIDS", - hrc = c(V3 = "1 1"), - totcode = c("Ensemble", V2 = "TOTAL"), - decimals = 1 -) -``` -Contenu des fichiers créés : ```r -file.show("Z:/donnees.asc", "Z:/donnees.rda", pager = "internal") +data(activity_corr_table) +head(activity_corr_table) +#> A10 A21 A88 +#> 1 AZ A 01 +#> 2 AZ A 02 +#> 3 AZ X X +#> 4 BE B 06 +#> 5 BE B 07 +#> 6 BE B 08 ``` -``` - donnees.asc donnees.rda - - A Y T1 100.0 1.00 V1 1 1 - A Z T2 0.0 2.71 - A Y T1 7.0 4.20 "Ensemble" - A Z S_ 25.0 1.00 V2 3 1 - B Y T1 0.0 1.00 - B Z T1 4.0 2.71 "TOTAL" - B Y T1 0.0 4.20 V3 5 2 - C Z S_ 5.0 1.00 - "Ensemble" - - 1 1 - VAL 8 5 - - 1 - POIDS 14 4 - - 2 -``` - -#### Fichiers temporaires - -Pour tout paramètre `*_filename` non renseigné, les fichiers générés sont placés -dans un dossier temporaire. Il est possible de récupérer l'emplacement et le nom -(aléatoire) de ces fichiers dans la valeur de retour de la fonction. ```r -noms_asc_rda <- micro_asc_rda(donnees) -noms_asc_rda -#> $asc_filename -#> [1] "C:\\Users\\XKFZV9\\AppData\\Local\\Temp\\Rtmpm62gsd\\RTA_f80634f49c8.asc" -#> -#> $rda_filename -#> [1] "C:\\Users\\XKFZV9\\AppData\\Local\\Temp\\Rtmpm62gsd\\RTA_f80634f49c8.rda" +hrc_file_activity <- write_hrc2( + corr_table = activity_corr_table, + file_name = "hrc/activity.hrc" +) ``` -

- sommaire ↑ -

- -### [2] Fonction `micro_arb` - -Cette fonction construit un fichier batch exécutable par τ-Argus. Elle prend -comme arguments obligatoires : - -- nom du fichier asc ; -- tabulation(s) (jusqu'à 10, sous forme de liste) ; -- règle(s) de secret primaire ; -- méthode(s) de gestion du secret secondaire. - -La fonction a également besoin du nom du fichier rda. S'il n'est pas spécifié, -le même nom que le fichier asc avec l'extension .rda est utilisé. +##### Primary secret -> _La fonction ne vérifie pas l'existence des répertoires ou fichiers spécifiés. -> Elle ne fait que générer un fichier d'instructions, sans en évaluer la -> validité._ +In this example, we'll apply the primary secret ourselves, *i.e.* not with the +help of τ-Argus. The idea is to use τ-Argus with an apriori file. +For that purpose, we create a boolean variable to specify +which cells don't comply with the primary secret rules. Using the same rules as before, +we get: -#### Exemple minimaliste - - -```r -micro_arb( - arb_filename = "Z:/donnees.arb", - asc_filename = "Z:/donnees.asc", - explanatory_vars = "V1", - safety_rules = "FREQ(3,10)", - suppress = "GH(.,100)", - output_names = "Z:/resultats/secretV1.csv" -) -``` - -Contenu du fichier créé : ```r -file.show("Z:/donnees.arb", pager = "internal") +turnover_act_size <- turnover_act_size %>% + mutate( + is_secret_freq = N_OBS > 0 & N_OBS < 3, + is_secret_dom = MAX > TOT*0.85, + is_secret_prim = is_secret_freq | is_secret_dom + ) ``` +##### Running τ-Argus -``` -// Batch generated by package *rtauargus* -// (2020-12-16 09:27:21 CET) - "Z:\donnees.asc" - "Z:\donnees.rda" - "V1"|""|| - FREQ(3,10) - - GH(1,100) - (1,2,AS+,"Z:\resultats\secretV1.csv") -``` - -#### Exemple élaboré +Two arguments has to be added to the `tab_rtauargus()` function: -On complète l'exemple précédent avec : +-`secret_var`, indicating the name of the variable in `tabular` containing the +primary secret (apriori) information; +-`hrc`, indicating the name of the hierarchy file to use for `ACTIVITY` variable. -- une deuxième tabulation ; -- une variable de réponse à sommer (au lieu d'un comptage) ; -- l'ajout d'une dominance à 85 % pour le deuxième tableau ; -- une pondération au premier tableau (mais pas au deuxième) ; -- la suppression des croisements vides dans les deux tableaux (SE+). +Since the primary suppression was already specified, no need to use the arguments, +`safety_rules` and `maxscore`. The first one is set by default to "MAN(10)", so +as to say that a 10% Interval Protection is applied. -Passer une seule valeur pour une option applique le même traitement à chaque -tabulation. Pour des options différenciées, il faut impérativement passer un -vecteur contenant autant de valeurs que de tabulations. +By default, `tab_rtauargus()` runs the Modular method to perform the secondary secret. Here, we choose to use the Optimal method by changing the `suppress` argument. ```r -micro_arb( - arb_filename = "Z:/donnees.arb", - asc_filename = "Z:/donnees.asc", - explanatory_vars = list("V1", c("V2", "V3")), - response_var = "VAL", - safety_rules = c("FREQ(3,10)", "FREQ(3,10)|NK(1,85)"), - weighted = c(TRUE, FALSE), - suppress = "GH(.,100)", - output_options = "AS+SE+" +ex2 <- tab_rtauargus( + turnover_act_size, + dir_name = "tauargus_files/", + files_name = "ex2", + explanatory_vars = c("ACTIVITY","SIZE"), + value = "TOT", + freq = "N_OBS", + secret_var = "is_secret_prim", + hrc = c(ACTIVITY = hrc_file_activity), + totcode = c(ACTIVITY="Total",SIZE="Total"), + suppress = "OPT(1,5)", + verbose=FALSE, + unif_hrc = FALSE, + unif_expl = FALSE ) ``` - -```r -file.show("Z:/donnees.arb", pager = "internal") -``` - - -``` -// Batch generated by package *rtauargus* -// (2020-12-16 09:27:22 CET) - "Z:\donnees.asc" - "Z:\donnees.rda" - "V1"|"VAL"|| - FREQ(3,10)|Wgt(1) - "V2""V3"|"VAL"|| - FREQ(3,10)|NK(1,85) - - GH(1,100) - (1,2,AS+SE+,"C:\Users\XKFZV9\AppData\Local\Temp\Rtmpm62gsd\RTA_f801761dcc.csv") - GH(2,100) - (2,2,AS+SE+,"C:\Users\XKFZV9\AppData\Local\Temp\Rtmpm62gsd\RTA_f80668c6ce4.csv") -``` - -#### Fichiers temporaires - -Dans l'exemple précédent, les noms des fichiers en sortie (`output_names`) -n'étaient pas précisés, ce qui a conduit à la génération de noms de fichiers -temporaires. Préciser le nom du fichier .arb n'est pas obligatoire non plus. Ces -informations sont récupérables dans la valeur de retour de la fonction. +##### Result ```r -infos_arb <- - micro_arb( - asc_filename = "Z:/donnees.asc", - explanatory_vars = list("V1", c("V2", "V3")), - safety_rules = "FREQ(3,10)", - suppress = "GH(.,100)", - output_type = "4" - ) -infos_arb -#> $arb_filename -#> [1] "C:\\Users\\XKFZV9\\AppData\\Local\\Temp\\Rtmpm62gsd\\RTA_f802a8071e6.arb" -#> -#> $output_names -#> [1] "C:\\Users\\XKFZV9\\AppData\\Local\\Temp\\Rtmpm62gsd\\RTA_f80729b5e2.sbs" -#> [2] "C:\\Users\\XKFZV9\\AppData\\Local\\Temp\\Rtmpm62gsd\\RTA_f8086c4487.sbs" +str(ex2) +#> 'data.frame': 414 obs. of 9 variables: +#> $ ACTIVITY : chr "01" "01" "02" "02" ... +#> $ SIZE : chr "Total" "tr1" "Total" "tr1" ... +#> $ N_OBS : int 18 18 387 381 6 1 1 4 4 84 ... +#> $ TOT : num 853 853 43623 35503 8120 ... +#> $ MAX : num 303 303 6212 6212 4812 ... +#> $ is_secret_freq: logi FALSE FALSE FALSE FALSE FALSE TRUE ... +#> $ is_secret_dom : logi FALSE FALSE FALSE FALSE FALSE TRUE ... +#> $ is_secret_prim: logi FALSE FALSE FALSE FALSE FALSE TRUE ... +#> $ Status : chr "V" "V" "V" "V" ... ``` -

- sommaire ↑ -

- - -### [3] Fonction `run_arb` - -Maintenant que les instructions ont été générées dans un fichier .arb, on peut -le soumettre à τ-Argus en mode batch. On récupère la liste des tableaux -secrétisés : - ```r -secret2 <- run_arb("Z:/donnees.arb") - -secret2 -#> [[1]] -#> V1 VAL Status -#> 1 Ensemble 170.2 1 -#> 2 A 154.4 1 -#> 3 B 10.8 11 -#> 4 C 5.0 5 +table(ex2$Status) #> -#> [[2]] -#> V2 V3 VAL Status -#> 1 TOTAL Ensemble 141 11 -#> 2 TOTAL S 30 5 -#> 3 TOTAL S_ 30 5 -#> 4 TOTAL T 111 3 -#> 5 TOTAL T1 111 3 -#> 6 TOTAL T2 0 5 -#> 7 Y Ensemble 107 3 -#> 8 Y T 107 3 -#> 9 Y T1 107 3 -#> 10 Z Ensemble 34 11 -#> 11 Z S 30 5 -#> 12 Z S_ 30 5 -#> 13 Z T 4 3 -#> 14 Z T1 4 3 -#> 15 Z T2 0 5 +#> B D V +#> 77 64 273 ``` -`run_arb` est la seule fonction du package qui exécute τ-Argus. Elle -nécessite donc que le logiciel soit accessible depuis le poste de travail. - -Seul l'argument `arb_filename` est obligatoire, car toutes les informations -nécessaires sont présentes dans le fichier .arb. Des paramètres optionnels sont -également disponibles : - -- `missing_dir` : action à effectuer si un dossier où sera écrit le résultat - n'existe pas (déclencher une erreur ou le créer) -- `tauargus_exe` : pour changer l'exécutable (surcharge l'option - `rtauargus.tauargus_exe` le temps de la fonction) ; -- `logbook` : emplacement et nom du fichier contenant le journal d'erreurs ; -- `show_batch_on_console` : pour afficher ou non le déroulement du batch dans la - console ; -- `import` : si désactivé, la fonction ne fait que générer les fichiers texte - sans les importer dans R (voir section suivante pour plus de détails). - -Si les tabulations ont reçu un nom dans `micro_arb`, ces noms sont utilisés pour -la liste de data.frames en sortie de `run_arb` (pas de noms définis dans -l'exemple ci-dessus). - -> _Des vérifications sont effectuées avant le lancement effectif de τ-Argus : -> existence du logiciel sur le poste, des fichiers asc et rda, des dossiers où -> écrire les résultats, des variables à utiliser (croisements, variable de -> réponse, ...) dans les métadonnées (fichier rda)._ - -

- sommaire ↑ -

- -### [4] Fonction `import` - -Cette fonction importe les résultats produits par τ-Argus (fichiers texte) à -partir des informations contenues dans un fichier arb. Elle nécessite donc que -le batch se soit déroulé sans erreur et que les fichiers soient toujours -présents. - -Pour cette dernière raison, la fonction `import` est typiquement appelée depuis -`run_arb` en paramétrant `import = TRUE`. Elle est aussi utilisable de -manière indépendante (par exemple si on ne souhaite pas relancer un batch qui a -mis beaucoup de temps à s'exécuter). +As we can see in the `table()` results, all the primary secret has the status "B" +in the output produced by τ-Argus. To adjust this, we can do: ```r -secret2 <- import("Z:/donnees.arb") -# produit le même résultat que run_arb("Z:/donnees.arb", import = TRUE) +ex2 %>% + mutate( + Status = dplyr::case_when( + is_secret_freq ~ "A", + TRUE ~ Status + ) + ) %>% + dplyr::count(Status) +#> Status n +#> 1 A 52 +#> 2 B 25 +#> 3 D 64 +#> 4 V 273 ``` -#### Formats acceptés - -Il n'est possible (à l'heure actuelle) que d'importer les résultats de type : - -- `"2"` : csv for pivot-table -- `"4"` : sbs output format -Si l'import est impossible pour une tabulation donnée, un data.frame vide est -retourné (avec un message d'avertissement). +### Protecting several tables at the same time, with `tab_muli_manager()` function -#### Attributs des tabulations +The function `tab_multi_manager()` can deal with a whole set of (linked or not) tables. +It is an iterating process, performing secondary suppression with one table at a time and it ensures that the common cells have the same status. When a common cell is concerned by secondary suppression, it reverberates the secret on each table that shares this common cell. The process ends when the secondary secret is consistent in every tables. See more details in vignettes *Manage the protection of linked tables* -À chaque data.frame de la liste est associé un ensemble d'attributs, des -métadonnées gardant une trace des spécifications passées à τ-Argus. +#### Data -Par exemple, pour `secret2[[2]]` (le deuxième tableau de `secret2`), on y -retrouve les paramètres que l'on a transmis à la fonction (les autres -correspondent à des valeurs par défaut du package). +For this example, two tables will be used : ```r -str(secret2[[2]]) -#> 'data.frame': 15 obs. of 4 variables: -#> $ V2 : chr "TOTAL" "TOTAL" "TOTAL" "TOTAL" ... -#> $ V3 : chr "Ensemble" "S" "S_" "T" ... -#> $ VAL : num 141 30 30 111 111 0 107 107 107 34 ... -#> $ Status: chr "11" "5" "5" "3" ... -#> - attr(*, "explanatory_vars")= chr [1:2] "V2" "V3" -#> - attr(*, "response_var")= chr "VAL" -#> - attr(*, "safetyrule")= chr "FREQ(3,10)|NK(1,85)" -#> - attr(*, "suppress")= chr "GH(.,100)" -#> - attr(*, "linked")= logi FALSE -#> - attr(*, "output_type")= chr "2" -#> - attr(*, "output_options")= chr "AS+SE+" +data("turnover_act_size") +data("turnover_act_cj") +str(turnover_act_cj) +#> tibble [406 x 5] (S3: tbl_df/tbl/data.frame) +#> $ ACTIVITY: chr [1:406] "AZ" "BE" "FZ" "GI" ... +#> $ CJ : chr [1:406] "Total" "Total" "Total" "Total" ... +#> $ N_OBS : int [1:406] 405 12878 28043 62053 8135 8140 11961 41359 26686 25108 ... +#> $ TOT : num [1:406] 44475 24827613 8907311 26962063 8584917 ... +#> $ MAX : num [1:406] 6212 1442029 1065833 3084242 3957364 ... ``` -

- sommaire ↑ -

- - - - -## Options du package - - -Les options du package définissent les comportements par défaut des fonctions. - -Ces options sont utilisées si un argument obligatoire d'une fonction n'est pas -renseigné. Elles permettent de ne pas répéter systématiquement le même paramètre -à chaque appel d'une fonction. Le nom de l'option est le nom de l'argument d'une -fonction précédé de `rtauargus.` : +The second tabular dataset provides the turnover of companies broken down by +business sectors (`ACTIVITY`) and type of company (`CJ`). The latter has three +categories and the overall category is noted "Total". -> Par exemple, `rtauargus.decimals` sera la valeur utilisée si l'argument -> `decimals` de la fonction `micro_asc_rda` n'est pas renseigné par -> l'utilisateur. +Since the two tables share one common explanatory variable (`ACTIVITY`), they can't be treated separately without risk of inconsistent protection. -Au chargement, le package attribue une valeur par défaut à toutes les options -de rtauargus qui ne sont pas encore déclarées. Les options déjà définies par -l'utilisateur gardent leurs valeurs. +#### Primary secret -Les options disponibles ainsi que leurs valeurs par défaut sont listées -ci-dessous : +The first step consists in indicating whether each cell complies with the primary rules, +or not. A boolean variable is created, equal to TRUE if the cell doesn't comply. - -|Option |Valeur par défaut |Type | Fonction concernée| -|:----------------------------|:-------------------------------|:---------|------------------:| -|rtauargus.decimals |0 |integer | micro_asc_rda| -|rtauargus.totcode |"Total" |character | micro_asc_rda| -|rtauargus.missing |"" |character | micro_asc_rda| -|rtauargus.hierleadstring |"@" |character | micro_asc_rda| -|rtauargus.response_var |"<freq>" |character | micro_arb| -|rtauargus.weighted |FALSE |logical | micro_arb| -|rtauargus.linked |FALSE |logical | micro_arb| -|rtauargus.output_type |"2" |character | micro_arb| -|rtauargus.output_options |"AS+" |character | micro_arb| -|rtauargus.missing_dir |"stop" |character | run_arb| -|rtauargus.tauargus_exe |"Y:/Logiciels/Tau/TauArgus.exe" |character | run_arb| -|rtauargus.show_batch_console |TRUE |logical | run_arb| -|rtauargus.import |TRUE |logical | run_arb| - -### Affichage - -Pour afficher les options définies pour la session en cours : +Here, we use the same rules as previously. ```r -rtauargus_options() -#> $rtauargus.decimals -#> [1] 0 -#> -#> $rtauargus.hierleadstring -#> [1] "@" -#> -#> $rtauargus.import -#> [1] TRUE -#> -#> $rtauargus.linked -#> [1] FALSE -#> -#> $rtauargus.missing -#> [1] "" -#> -#> $rtauargus.missing_dir -#> [1] "stop" -#> -#> $rtauargus.output_options -#> [1] "AS+" -#> -#> $rtauargus.output_type -#> [1] "2" -#> -#> $rtauargus.response_var -#> [1] "" -#> -#> $rtauargus.show_batch_console -#> [1] TRUE -#> -#> $rtauargus.tauargus_exe -#> [1] "D:/Program Files/TauArgus/TauArgus4.1.7b4/TauArgus.exe" -#> -#> $rtauargus.totcode -#> [1] "Total" -#> -#> $rtauargus.weighted -#> [1] FALSE +list_data_2_tabs <- list( + act_size = turnover_act_size, + act_cj = turnover_act_cj +) %>% + purrr::map( + function(df){ + df %>% + mutate( + is_secret_freq = N_OBS > 0 & N_OBS < 3, + is_secret_dom = MAX > TOT*0.85, + is_secret_prim = is_secret_freq | is_secret_dom + ) + } + ) ``` -Les valeurs sont identiques aux valeurs par défaut, hormis l'emplacement de -τ-Argus, qui a été préalablement modifié. Elles apparaissent dans l'ordre -alphabétique. - -

- sommaire ↑ -

-### Modification, réinitialisation +#### Running τ-Argus -Pour modifier une ou plusieurs options, utiliser la syntaxe suivante (la même -que celle employée pour modifier l'emplacement de τ-Argus) : +Now that the primary secret has been specified for both tables, we can run the process. ```r -options( - rtauargus.show_batch_console = FALSE, - rtauargus.output_options = "AS+SE+", - rtauargus.output_type = "4", - rtauargus.response_var = "VAL" +ex3 <- tab_multi_manager( + list_tables = list_data_2_tabs, + list_explanatory_vars = list( + act_size = c("ACTIVITY", "SIZE"), + act_cj = c("ACTIVITY", "CJ") + ), + hrc = c(ACTIVITY = hrc_file_activity), + dir_name = "ex3", + value = "TOT", + freq = "N_OBS", + secret_var = "is_secret_prim", + totcode = "Total" ) - -str(rtauargus_options()) -#> List of 13 -#> $ rtauargus.decimals : int 0 -#> $ rtauargus.hierleadstring : chr "@" -#> $ rtauargus.import : logi TRUE -#> $ rtauargus.linked : logi FALSE -#> $ rtauargus.missing : chr "" -#> $ rtauargus.missing_dir : chr "stop" -#> $ rtauargus.output_options : chr "AS+SE+" -#> $ rtauargus.output_type : chr "4" -#> $ rtauargus.response_var : chr "VAL" -#> $ rtauargus.show_batch_console: logi FALSE -#> $ rtauargus.tauargus_exe : chr "D:/Program Files/TauArgus/TauArgus4.1.7b4/TauArgus.exe" -#> $ rtauargus.totcode : chr "Total" -#> $ rtauargus.weighted : logi FALSE -``` - -Pour réinitialiser certaines options : - - -```r -reset_rtauargus_options("rtauargus.response_var", "rtauargus.output_type") - -# Il est possible d'omettre le préfixe 'rtauargus.' -# L'instruction suivante est équivalente : -reset_rtauargus_options("response_var", "output_type") - -str(rtauargus_options()) -#> List of 13 -#> $ rtauargus.decimals : int 0 -#> $ rtauargus.hierleadstring : chr "@" -#> $ rtauargus.import : logi TRUE -#> $ rtauargus.linked : logi FALSE -#> $ rtauargus.missing : chr "" -#> $ rtauargus.missing_dir : chr "stop" -#> $ rtauargus.output_options : chr "AS+SE+" -#> $ rtauargus.output_type : chr "2" -#> $ rtauargus.response_var : chr "" -#> $ rtauargus.show_batch_console: logi FALSE -#> $ rtauargus.tauargus_exe : chr "D:/Program Files/TauArgus/TauArgus4.1.7b4/TauArgus.exe" -#> $ rtauargus.totcode : chr "Total" -#> $ rtauargus.weighted : logi FALSE -``` - -Pour remettre toutes les valeurs par défaut (y compris le chemin vers -τ-Argus modifié en début de démonstration), ne spécifier aucun argument : - - -```r -reset_rtauargus_options() +#> --- Current table to treat: act_size --- +#> [1] "hrc/activity_unif.hrc has been created" +#> --- Current table to treat: act_cj --- +#> [1] "hrc/activity_unif.hrc has been created" +#> --- Current table to treat: act_size --- +#> [1] "hrc/activity_unif.hrc has been created" ``` -

- sommaire ↑ -

- -### Portée locale ou globale - -Comme toute fonction R, le paramétrage s'effectue en spécifiant chacun des -arguments au moment de l'appel de la fonction (portée locale). - -Le système d'options du package permet par les instructions -`options(rtauargus.