## ----include = FALSE----------------------------------------------------------
knitr::opts_chunk$set(collapse = TRUE, comment = "#>", fig.width = 7,
                      fig.height = 4, dpi = 72, out.width = "100%")

## -----------------------------------------------------------------------------
library(SynthesizerPlus)
library(ggplot2)

## -----------------------------------------------------------------------------
str(census_sim)
keys <- c("age", "sex", "region", "household_size")   # what an intruder may know
sensitive <- c("income", "education")                 # what must be protected

## -----------------------------------------------------------------------------
risk_real <- disclosure_risk(census_sim, census_sim, keys = keys, target = sensitive,
                             ignore = "person_id")
risk_real

## -----------------------------------------------------------------------------
fit <- fit_synthesizer(census_sim, id_cols = "person_id",
                       by = c("employment", "sex"), knots = 500)
syn <- generate(fit, seed = 1)
head(syn)
disclosure_risk(census_sim, syn, keys = keys, target = sensitive,
                ignore = "person_id")

## -----------------------------------------------------------------------------
conf <- census_sim[-1]                 # without the identifier
dcr(conf, syn[-1], max_rows = 1500, seed = 1)$close_share

## -----------------------------------------------------------------------------
detailed <- fit_synthesizer(census_sim, id_cols = "person_id",
                            by = c("region", "employment", "sex"),
                            min_stratum_size = 5, discrete_threshold = 60)

## -----------------------------------------------------------------------------
model <- income ~ age + sex + education + employment
risk_utility <- function(fit, closeness, seeds = 1:4) {
  v <- sapply(seeds, function(sd) {
    s <- generate(fit, closeness = closeness, seed = sd)
    c(dcr(conf, s[-1], max_rows = 1500, seed = 1)$close_share,
      mean(pmax(ci_overlap(census_sim, s, model)$overlap, 0)))
  })
  data.frame(noise = 1 - closeness, risk = mean(v[1, ]), utility = mean(v[2, ]))
}
ru <- do.call(rbind, lapply(c(1, 0.95, 0.9, 0.85, 0.8, 0.7), function(cl) {
  cbind(model = "detailed (64 strata)", risk_utility(detailed, cl))
}))
ru <- rbind(ru, cbind(model = "stratified by employment x sex", risk_utility(fit, 1)))
ru[-1] <- round(ru[-1], 3)
ru

## ----fig.height = 4.2---------------------------------------------------------
ggplot(ru, aes(risk, utility, colour = model)) +
  geom_path(data = ru[ru$model != ru$model[nrow(ru)], ], colour = "#c3c2b7") +
  geom_point(size = 3) +
  geom_text(aes(label = paste("noise", noise)), vjust = -1, size = 3,
            colour = "#52514e", show.legend = FALSE) +
  geom_vline(xintercept = 0.05, linetype = "dashed", colour = "#898781") +
  scale_x_reverse(expand = expansion(mult = 0.08)) +
  scale_y_continuous(expand = expansion(mult = c(0.08, 0.15))) +
  scale_colour_manual(values = c("#eb6834", "#2a78d6"), name = NULL) +
  labs(x = "disclosure risk: share of near-copies (axis reversed: right is safer)",
       y = "utility: mean CI overlap", title = "Risk-utility map") +
  theme_minimal(base_size = 10) +
  theme(legend.position = "top", panel.grid.minor = element_blank())

## -----------------------------------------------------------------------------
near_copies <- function(real, synthetic) {
  dcr(real[-1], synthetic[-1], max_rows = 1500, seed = 1)$close_share
}
cal <- calibrate_closeness(detailed, census_sim, target = 0.06, metric = near_copies,
                           grid = c(0.7, 0.8, 0.9, 1), refine = 2)
cal
release <- generate(detailed, closeness = cal$closeness, seed = 2026)

## -----------------------------------------------------------------------------
ci_overlap(census_sim, release, model)[, c("term", "estimate_real",
                                           "estimate_synthetic", "overlap")]
disclosure_risk(census_sim, release, keys = keys, target = sensitive,
                ignore = "person_id")
dcr(conf, release[-1], max_rows = 1500, seed = 2)$close_share

## ----fig.height = 3.5---------------------------------------------------------
plot_marginals(conf, release[-1], vars = c("age", "income", "household_size"))

## -----------------------------------------------------------------------------
targeted <- perturbation(noise = c(income = 0.5, age = 0.3), swap = c(household_size = 0.2))
rel2 <- generate(detailed, perturb = targeted, seed = 1)
c(risk = near_copies(census_sim, rel2),
  utility = mean(pmax(ci_overlap(census_sim, rel2, model)$overlap, 0)))