inst/doc/multivariate-distributions.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.5, dpi = 72, out.width = "100%")

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

## -----------------------------------------------------------------------------
make_corr(4, "ar1", rho = 0.6)
make_corr(3, "exchangeable", rho = 0.3, names = c("x", "y", "z"))
R <- make_corr(5, "random")
round(R, 2)

## -----------------------------------------------------------------------------
S <- make_corr(3, "ar1", 0.7)
x <- r_mvnorm(2000, mean = c(0, 5, 10), sigma = S, seed = 1)
round(colMeans(x), 2)
round(cor(x), 2)

t3 <- r_mvt(2000, df = 3, sigma = S, seed = 1)
c(normal = max(abs(x[, 1])), t3 = max(abs(t3[, 1])))

## -----------------------------------------------------------------------------
sn <- r_mvskewnorm(2000, omega = make_corr(2, "exchangeable", 0.5),
                   alpha = c(8, -3), seed = 1)
plot_pairs(as.data.frame(sn))

## -----------------------------------------------------------------------------
mix <- r_mvmixture(1500, weights = c(0.5, 0.3, 0.2),
                   means = list(c(0, 0), c(4, 4), c(-3, 5)),
                   sigmas = list(diag(2), make_corr(2, "exchangeable", 0.8),
                                 diag(c(0.5, 2))),
                   seed = 1)
plot_pairs(as.data.frame(mix))

## -----------------------------------------------------------------------------
shares <- r_dirichlet(5, alpha = c(agriculture = 2, industry = 5, services = 10), seed = 1)
round(shares, 3)

## -----------------------------------------------------------------------------
u_c <- r_copula(3000, "clayton", dim = 2, theta = 2, seed = 1)
u_g <- r_copula(3000, "gumbel", dim = 2, theta = 2, seed = 1)
c(clayton = cor(u_c, method = "kendall")[1, 2],
  gumbel = cor(u_g, method = "kendall")[1, 2])

## -----------------------------------------------------------------------------
both <- rbind(data.frame(u1 = u_c[, 1], u2 = u_c[, 2], copula = "Clayton (theta = 2)"),
              data.frame(u1 = u_g[, 1], u2 = u_g[, 2], copula = "Gumbel (theta = 2)"))
ggplot2::ggplot(both, ggplot2::aes(u1, u2)) +
  ggplot2::geom_point(alpha = 0.25, size = 0.6, colour = "#2a78d6") +
  ggplot2::facet_wrap(~copula) +
  ggplot2::coord_equal() +
  ggplot2::theme_minimal()

## -----------------------------------------------------------------------------
sim <- r_mvdist(
  1000,
  margins = list(
    income = list(dist = "lnorm", meanlog = 10, sdlog = 0.6),
    age = list(dist = "unif", min = 18, max = 80),
    children = list(dist = "pois", lambda = 1.5),
    sector = margin_categorical(c("agri", "industry", "services"), c(0.1, 0.3, 0.6)),
    eruption = margin_empirical(faithful$eruptions)
  ),
  copula = "t", corr = make_corr(5, "exchangeable", 0.4), df = 4, seed = 1
)
str(sim)
round(association_matrix(sim), 2)

## -----------------------------------------------------------------------------
syn <- synthesize(sim, seed = 2)
summary(compare_synthetic(sim, syn, seed = 1))