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

## ----data---------------------------------------------------------------------
library(HDElliptical)

set.seed(20260814)
p <- 8
shape <- toeplitz(0.45^(0:(p - 1)))
x <- relliptical(40, rep(0.10, p), shape)
y <- relliptical(44, c(rep(0.10, 3), rep(0, p - 3)), shape)
colnames(x) <- colnames(y) <- paste0("V", seq_len(p))

## ----classical-tests----------------------------------------------------------
classical <- list(
  Hotelling.one = hotelling_one_sample_test(x),
  Hotelling.two = hotelling_two_sample_test(x, y),
  Sign.one = spatial_sign_test(x),
  Signed.rank.one = spatial_signed_rank_test(x),
  Spatial.rank.two = spatial_rank_test(x, y)
)

data.frame(
  method = names(classical),
  statistic = vapply(classical, function(z) unname(z$statistic), numeric(1)),
  p.value = vapply(classical, function(z) z$p.value, numeric(1)),
  row.names = NULL
)

## ----high-dimensional-tests---------------------------------------------------
high_dimensional <- list(
  Srivastava.Du = srivastava_du_one_sample_test(x),
  Park.Ayyala = park_ayyala_one_sample_test(x),
  Bai.Saranadasa = bai_saranadasa_two_sample_test(x, y),
  Chen.Qin = chen_qin_two_sample_test(x, y),
  Srivastava.Katayama.Kano =
    srivastava_katayama_kano_two_sample_test(x, y)
)

data.frame(
  method = names(high_dimensional),
  Z = vapply(high_dimensional, function(z) unname(z$statistic), numeric(1)),
  p.value = vapply(high_dimensional, function(z) z$p.value, numeric(1)),
  row.names = NULL
)

## ----behrens-fisher-----------------------------------------------------------
set.seed(2411)
x.bf <- matrix(rnorm(8 * 7), 8, 7)
y.bf <- matrix(rnorm(9 * 7, 0.15), 9, 7)
bf <- feng_zou_wang_zhu_two_sample_test(x.bf, y.bf)
c(Z = unname(bf$statistic), p.value = bf$p.value)

## ----clx----------------------------------------------------------------------
clx_adaptive <- cai_liu_xia_two_sample_test(x, y)
clx_oracle <- cai_liu_xia_two_sample_test(
  x, y, precision = solve(shape), precision_source = "oracle"
)

c(
  adaptive.G = unname(clx_adaptive$statistic),
  adaptive.p = clx_adaptive$p.value,
  oracle.G = unname(clx_oracle$statistic),
  oracle.p = clx_oracle$p.value
)

clx_adaptive$diagnostics$denominator.source
clx_adaptive$components$maximum.coordinate

## ----high-dimensional-signs---------------------------------------------------
wpl <- wang_peng_li_one_sample_test(x)

set.seed(2608)
x.fs <- matrix(rt(8 * 6, df = 5), 8, 6)
fs <- feng_sun_one_sample_test(x.fs, tol = 1e-6)

set.seed(25101)
x.sign <- matrix(rnorm(8 * 3), 8, 3)
y.sign <- matrix(rnorm(11 * 3, 0.2), 11, 3)
tinst <- tinst_two_sample_test(
  x.sign, y.sign, tol = 1e-7, max_iter = 2000
)

c(WPL.p = wpl$p.value, FengSun.p = fs$p.value, tINST.p = tinst$p.value)
tinst$diagnostics[c("iteration.stable", "score.residual")]