inst/doc/multivariate.R

In algebraic.dist: Algebra over Probability Distributions

## ----setup, include = FALSE---------------------------------------------------
knitr::opts_chunk$set(collapse = TRUE, comment = "#>")

## ----library------------------------------------------------------------------
library(algebraic.dist)

## ----mvn-construct------------------------------------------------------------
M <- mvn(mu = c(1, 2, 3),
         sigma = matrix(c(1.0, 0.5, 0.2,
                          0.5, 2.0, 0.3,
                          0.2, 0.3, 1.5), nrow = 3, byrow = TRUE))
M

## ----mvn-accessors------------------------------------------------------------
mean(M)
vcov(M)
dim(M)

## ----mvn-params---------------------------------------------------------------
params(M)

## ----mvn-sampling-------------------------------------------------------------
set.seed(42)
samp <- sampler(M)
X <- samp(100)
dim(X)
head(X, 5)

## ----mvn-marginal-------------------------------------------------------------
M13 <- marginal(M, c(1, 3))
M13
mean(M13)
vcov(M13)

## ----mvn-marginal-univariate--------------------------------------------------
M1 <- marginal(M, 1)
M1
mean(M1)
vcov(M1)

## ----mvn-conditional-closedform-----------------------------------------------
M2 <- mvn(mu = c(0, 0), sigma = matrix(c(1, 0.8, 0.8, 1), 2, 2))

# Condition on X2 = 1
M_cond <- conditional(M2, given_indices = 2, given_values = 1)
mean(M_cond)
vcov(M_cond)

## ----mvn-conditional-mc-------------------------------------------------------
set.seed(42)
M_cond_mc <- conditional(M2, P = function(x) abs(x[2] - 1) < 0.1)
mean(M_cond_mc)

## ----affine-portfolio---------------------------------------------------------
returns <- mvn(
  mu = c(0.05, 0.08),
  sigma = matrix(c(0.04, 0.01,
                   0.01, 0.09), 2, 2)
)

# 60/40 portfolio weights
w <- matrix(c(0.6, 0.4), nrow = 1)
portfolio <- affine_transform(returns, A = w)
mean(portfolio)
vcov(portfolio)

## ----affine-sumdiff-----------------------------------------------------------
X <- mvn(mu = c(3, 7), sigma = matrix(c(4, 1, 1, 9), 2, 2))

# A maps (X1, X2) -> (X1 + X2, X1 - X2)
A <- matrix(c(1, 1,
              1, -1), nrow = 2, byrow = TRUE)
Y <- affine_transform(X, A = A)
mean(Y)
vcov(Y)

## ----mixture-construct--------------------------------------------------------
m <- mixture(
  components = list(normal(-2, 1), normal(3, 0.5)),
  weights = c(0.4, 0.6)
)
m

## ----mixture-mean-------------------------------------------------------------
mean(m)

## ----mixture-vcov-------------------------------------------------------------
vcov(m)

## ----mixture-density, fig.height = 4, fig.width = 6---------------------------
f <- density(m)

x_vals <- seq(-6, 8, length.out = 200)
y_vals <- sapply(x_vals, f)
plot(x_vals, y_vals, type = "l", lwd = 2,
     main = "Bimodal mixture density",
     xlab = "x", ylab = "f(x)")

## ----mixture-cdf, fig.height = 4, fig.width = 6-------------------------------
F <- cdf(m)
F_vals <- sapply(x_vals, F)
plot(x_vals, F_vals, type = "l", lwd = 2,
     main = "Mixture CDF",
     xlab = "x", ylab = "F(x)")

## ----mixture-sampling, fig.height = 4, fig.width = 6--------------------------
set.seed(123)
s <- sampler(m)
samples <- s(2000)
hist(samples, breaks = 50, probability = TRUE, col = "lightblue",
     main = "Mixture samples with true density",
     xlab = "x")
lines(x_vals, y_vals, col = "red", lwd = 2)

## ----mixture-marginal---------------------------------------------------------
m2 <- mixture(
  list(mvn(c(0, 0), diag(2)), mvn(c(3, 3), diag(2))),
  c(0.5, 0.5)
)

m2_x1 <- marginal(m2, 1)
m2_x1
mean(m2_x1)

## ----mixture-conditional------------------------------------------------------
mc <- conditional(m2, given_indices = 2, given_values = 0)
mc
mean(mc)

## ----mixture-conditional-high-------------------------------------------------
mc_high <- conditional(m2, given_indices = 2, given_values = 3)
mc_high
mean(mc_high)

## ----gmm-setup----------------------------------------------------------------
class_a <- mvn(c(-2, -1), matrix(c(1.0, 0.3, 0.3, 0.8), 2, 2))
class_b <- mvn(c(2, 1.5), matrix(c(0.6, -0.2, -0.2, 1.2), 2, 2))

gmm <- mixture(
  components = list(class_a, class_b),
  weights = c(0.5, 0.5)
)
gmm

## ----gmm-scatter, fig.height = 5, fig.width = 6-------------------------------
set.seed(314)
samp_a <- sampler(class_a)(300)
samp_b <- sampler(class_b)(300)

plot(samp_a[, 1], samp_a[, 2], col = "steelblue", pch = 16, cex = 0.6,
     xlim = c(-6, 6), ylim = c(-5, 5),
     xlab = expression(X[1]), ylab = expression(X[2]),
     main = "Two-class GMM samples")
points(samp_b[, 1], samp_b[, 2], col = "tomato", pch = 16, cex = 0.6)
legend("topright", legend = c("Class A", "Class B"),
       col = c("steelblue", "tomato"), pch = 16)

## ----gmm-classify-neg---------------------------------------------------------
post_neg <- conditional(gmm, given_indices = 1, given_values = -1)
post_neg

## ----gmm-classify-neg-density, fig.height = 4, fig.width = 6------------------
f_post <- density(post_neg)
x2_grid <- seq(-5, 5, length.out = 200)
y_post <- sapply(x2_grid, f_post)
plot(x2_grid, y_post, type = "l", lwd = 2,
     xlab = expression(X[2]),
     ylab = expression(f(X[2] ~ "|" ~ X[1] == -1)),
     main = "Posterior density of X2 given X1 = -1")

## ----gmm-classify-pos---------------------------------------------------------
post_pos <- conditional(gmm, given_indices = 1, given_values = 2)
post_pos

## ----gmm-classify-pos-density, fig.height = 4, fig.width = 6------------------
f_post_pos <- density(post_pos)
y_post_pos <- sapply(x2_grid, f_post_pos)
plot(x2_grid, y_post_pos, type = "l", lwd = 2,
     xlab = expression(X[2]),
     ylab = expression(f(X[2] ~ "|" ~ X[1] == 2)),
     main = "Posterior density of X2 given X1 = 2")

## ----gmm-classify-mid---------------------------------------------------------
post_mid <- conditional(gmm, given_indices = 1, given_values = 0)
post_mid

## ----gmm-classify-mid-density, fig.height = 4, fig.width = 6------------------
f_post_mid <- density(post_mid)
y_post_mid <- sapply(x2_grid, f_post_mid)
plot(x2_grid, y_post_mid, type = "l", lwd = 2,
     xlab = expression(X[2]),
     ylab = expression(f(X[2] ~ "|" ~ X[1] == 0)),
     main = "Posterior density of X2 given X1 = 0 (ambiguous)")