inst/doc/getting-started.R

In SynthesizerPlus: Synthetic Data Generation with Copulas, Evaluation and Multi-Format I/O

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

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

## -----------------------------------------------------------------------------
fit <- fit_synthesizer(iris)
fit
syn <- generate(fit, n = 500, seed = 1)
head(syn)

## -----------------------------------------------------------------------------
syn2 <- synthesize(mtcars, n = 100, seed = 2)
str(syn2[, 1:5])

## -----------------------------------------------------------------------------
out_csv <- file.path(tempdir(), "mtcars_synthetic.csv")
synthesize(mtcars, n = 100, seed = 2, file = out_csv)
file.exists(out_csv)
readLines(out_csv, n = 3)          # the first lines of the file

## -----------------------------------------------------------------------------
syn_back <- read_data(out_csv, template = mtcars)
str(syn_back[, 1:5])
all.equal(syn_back, syn2, check.attributes = FALSE)   # the file holds the same data

## -----------------------------------------------------------------------------
set.seed(10)
n <- 200
people <- data.frame(
  age = as.integer(round(runif(n, 18, 80))),
  income = round(rlnorm(n, 10, 0.6)),
  sector = factor(sample(c("agri", "industry", "services"), n, TRUE,
                         prob = c(0.1, 0.3, 0.6))),
  education = factor(sample(c("primary", "secondary", "tertiary"), n, TRUE),
                     levels = c("primary", "secondary", "tertiary"), ordered = TRUE),
  region = sample(c("North", "South", "East", "West"), n, TRUE),
  employed = runif(n) < 0.7,
  survey_date = as.Date("2024-01-01") + sample(0:365, n, TRUE),
  stringsAsFactors = FALSE
)
people$income[sample(n, 20)] <- NA

fit_p <- fit_synthesizer(people)
summary(fit_p)
str(generate(fit_p, n = 5, seed = 3))

## -----------------------------------------------------------------------------
set.seed(11)
age <- round(runif(2000, 18, 80))
income <- exp(7 + 0.01 * age + rnorm(2000, sd = 0.5))
income[runif(2000) < plogis(-4 + 0.05 * age)] <- NA
svy <- data.frame(age, income)
syn_svy <- generate(fit_synthesizer(svy, seed = 1), n = 20000, seed = 1)
bands <- function(a) cut(a, c(17, 30, 45, 60, 80))
rbind(real = tapply(is.na(svy$income), bands(svy$age), mean),
      synthetic = tapply(is.na(syn_svy$income), bands(syn_svy$age), mean))

## -----------------------------------------------------------------------------
aq_pooled <- generate(fit_synthesizer(airquality, seed = 1), n = 5000, seed = 4)
aq_strat <- generate(fit_synthesizer(airquality, by = "Month", seed = 1), n = 5000, seed = 4)
miss_by_month <- function(d) tapply(is.na(d$Ozone), d$Month, mean)
round(rbind(real = miss_by_month(airquality), pooled = miss_by_month(aq_pooled),
            `by = "Month"` = miss_by_month(aq_strat)), 2)

## -----------------------------------------------------------------------------
syn_pooled <- generate(fit_synthesizer(iris), seed = 1)
syn_strat <- generate(fit_synthesizer(iris, by = "Species"), seed = 1)
quality <- rbind(
  pooled = summary(compare_synthetic(iris, syn_pooled, seed = 1))$value[c(3, 5)],
  stratified = summary(compare_synthetic(iris, syn_strat, seed = 1))$value[c(3, 5)]
)
colnames(quality) <- c("mean |assoc. diff|", "discriminator AUC")
round(quality, 3)

## ----fig.height = 5-----------------------------------------------------------
plot_pairs(iris, syn_strat, vars = c("Sepal.Length", "Petal.Length", "Petal.Width"))

## -----------------------------------------------------------------------------
fit_mt <- fit_synthesizer(mtcars)
sapply(c(0, 0.5, 1), function(l) {
  s <- generate(fit_mt, n = 2000, dependence = l, seed = 5)
  cor(s$mpg, s$wt, method = "spearman")
})
cor(mtcars$mpg, mtcars$wt, method = "spearman")

## -----------------------------------------------------------------------------
r <- as.data.frame(diff(log(EuStockMarkets)))
fit_t <- fit_synthesizer(r, copula = "t")
fit_t

## -----------------------------------------------------------------------------
d <- data.frame(id = sprintf("R%04d", 1:1000), x = rexp(1000))
fit_k <- fit_synthesizer(d, id_cols = "id", knots = 200)
head(generate(fit_k, n = 3, seed = 1))
format(object.size(fit_k), units = "Kb")

## -----------------------------------------------------------------------------
sims <- simulate(fit_mt, nsim = 5, seed = 1)
sapply(sims, function(s) coef(lm(mpg ~ wt, data = s))[["wt"]])