Apply Cell Key Method to a contingency table

This function applies the Cell Key Method perturbation to a contingency table generated by `tabulate_cnt_micro_data`, using specified deviation and variance parameters.

Usage

apply_ckm(
  tab_data,
  cnt_var = "nb_obs",
  ck_var = "ckey",
  D,
  V,
  js = 0,
  I = NULL,
  J = NULL,
  stack = NULL,
  ...
)

Arguments

tab_data

Object returned by `tabulate_cnt_micro_data` (data.frame or list)

cnt_var

Character. Name of the count variable (default: "nb_obs")

ck_var

Character. Name of the cell key variable (must be decimal between 0-1)

D

integer. Deviation parameter (must be strictly positive)

V

numeric. Noise variance (must be strictly positive)

js

integer. Threshold for sensitive values (default: 0). If js=0, only value 0 will be forbidden

I

integer vector. Original values to consider

J

integer vector. Perturbed values to consider

stack

Named list of parameters (D, V) to produce a stacked matrix with these parameters applied only on the large counts. js is set to 0 for this part.

...

Additional parameters passed to transition matrix creation

Value

List containing: - tab: Perturbed table (tibble) - risque: Risk measures (NULL if empirical frequencies not provided) - utilite: Utility measures (MAD, RMAD, Hellinger distance) - ptab: Transition matrix object

Examples

if (FALSE) { # \dontrun{
data("dtest")
set.seed(8245)
dtest_avec_cles <- build_individual_keys(dtest)

tab_avant <- tabulate_cnt_micro_data(
  df = dtest_avec_cles,
  cat_vars = c("DIPLOME", "SEXE", "AGE", "REG"),
  marge_label = "Total",
  freq_empiriq = TRUE
)

res_ckm <- apply_ckm(tab_avant, D = 5, V = 2)
str(res_ckm, max.level = 2)

# With a hierarchical structure
tab_avant2 <- tabulate_cnt_micro_data(
  df = dtest_avec_cles |> mutate(NUM = 12),
  cat_vars = c("DIPLOME", "SEXE", "AGE"),
  hrc_vars = list(GEO = c("REG", "DEP")),
  num_var = "NUM",
  marge_label = "Total",
  freq_empiriq = TRUE #to measure the risk
)

res_ckm2 <- apply_ckm(tab_avant2, cnt_var = "num_tot", D = 5, V = 2)
head(res_ckm2$tab)

# With or without a stacked matrix ?
res_ckm3a <- apply_ckm(tab_avant, D = 15, V = 35, js = 10)
res_ckm3a$utilite

res_ckm3b <- apply_ckm(tab_avant,
  D = 15, V = 35, js = 10,
  stack = list(D = 15, V = 5)
)
res_ckm3b$utilite
} # }