inst/doc/dcorBSS-introduction.R

In dcorBSS: Distance-Correlation Based Methods for Blind Source Separation and Dependence Analysis

## ----include = FALSE----------------------------------------------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>",
  fig.width = 7,
  fig.height = 4,
  message = FALSE,
  warning = FALSE
)

## ----setup--------------------------------------------------------------------
library(dcorBSS)

## ----distance-correlation-----------------------------------------------------
set.seed(1)
n <- 200

x <- rnorm(n)
y_dep <- x^2 + 0.25 * rnorm(n)
y_ind <- rnorm(n)

c(
  dependent = dcor_large(x, y_dep),
  independent = dcor_large(x, y_ind)
)

## ----multivariate-dcor--------------------------------------------------------
X <- cbind(rnorm(n), rnorm(n))
Y <- cbind(X[, 1]^2 + 0.2 * rnorm(n), rnorm(n))

dcor_large(X, Y)

## ----blockwise-dcor-----------------------------------------------------------
r_full <- dcor_large(X, Y)
r_block <- dcor_large(X, Y, block_size = 64L)

c(full = r_full, blockwise = r_block)
all.equal(r_full, r_block, tolerance = 1e-10)

## ----lagged-dcor--------------------------------------------------------------
set.seed(1)

x <- arima.sim(n = 500, list(ma = c(0.8)))

dacor_large(x, lag = 1)
dacor_large(x, lag = 2)


## ----bowl-transform-----------------------------------------------------------
set.seed(2)
X_heavy <- cbind(rt(100, df = 3), rnorm(100))

head(bowl_transform(X_heavy, do_scale = TRUE))
dim(bowl_transform(X_heavy, do_scale = TRUE))

## ----biloop-transform---------------------------------------------------------
z <- rt(100, df = 3)
z_biloop <- biloop_transform(z, do_scale = TRUE)

head(z_biloop)
dim(z_biloop)

## ----transformed-dependence---------------------------------------------------
set.seed(3)
x <- rt(200, df = 3)
y <- x^2 + 0.3 * rnorm(200)

x_b <- biloop_transform(x, do_scale = TRUE)
y_b <- biloop_transform(y, do_scale = TRUE)

dcor_large(x_b, y_b)

## ----dcorica-simulation-------------------------------------------------------
set.seed(4)
n <- 300

S <- cbind(
  uniform = runif(n, -1, 1),
  normal = rnorm(n),
  chisq = rchisq(n, df = 3)
)

A <- matrix(rnorm(9), 3, 3)
X <- tcrossprod(S, A)

fit <- dcorICA(X, seed = 1, sweeps = 2)

str(fit, max.level = 1)
head(fit$S)

## ----dcorica-result-----------------------------------------------------------
fit$W
pairs(fit$S, main = "Estimated components from dcorICA()")

## ----dcorica-blockwise, eval = FALSE------------------------------------------
# fit_block <- dcorICA(X, seed = 1, sweeps = 2, block_size = 128L)

## ----dcorica-robust, eval = FALSE---------------------------------------------
# if (requireNamespace("robustbase", quietly = TRUE)) {
#   mcd <- robustbase::covMcd(X)
# 
#   fit_robust <- dcorICA(
#     X,
#     mu = mcd$center,
#     scatter = mcd$cov,
#     transform = "bowl",
#     seed = 1,
#     sweeps = 2
#   )
# 
#   head(fit_robust$S)
# }

## ----dacf-curve---------------------------------------------------------------
data(Nile)

curve <- dacf_curve(Nile, lags = 1:12, measure = "dcor")
curve$estimate
plot(curve, type = "line")

## ----dcor-serial-test---------------------------------------------------------
test_dcor <- dcor_serial_test(
  Nile,
  type = "FP",
  measure = "dcor",
  lags = 1:6,
  B = 99,
  seed = 1
)

test_dcor
plot(test_dcor)

## ----hsic-serial-test---------------------------------------------------------
test_hsic <- hsic_serial_test(
  Nile,
  lags = 1:6,
  type = "H96",
  B = 99,
  seed = 1
)

test_hsic
plot(test_hsic, type = "line")

## ----nhsic--------------------------------------------------------------------
set.seed(6)
x <- matrix(rnorm(200), ncol = 1)
y <- x^2 + 0.3 * rnorm(200)
z <- matrix(rnorm(200), ncol = 1)

c(
  dependent = nHSIC(x, y),
  independent = nHSIC(x, z)
)