## ----setup, include = FALSE---------------------------------------------------
knitr::opts_chunk$set(
  collapse   = TRUE,
  comment    = "#>",
  fig.width  = 8,
  fig.height = 6.5,
  warning    = FALSE,
  message    = FALSE
)
library(PSinference)
library(MASS)
set.seed(2026)

## ----load_data----------------------------------------------------------------
data(brittany_soil_ps)
cat("Dimensions:", nrow(brittany_soil_ps), "x", ncol(brittany_soil_ps), "\n")
cat("Variables :", colnames(brittany_soil_ps), "\n\n")

round(head(brittany_soil_ps, 4), 3)

## ----corr---------------------------------------------------------------------
round(cor(brittany_soil_ps), 2)

## ----mvn, fig.cap = "Multivariate normality diagnostic panel for `brittany_soil_ps`. Histograms (blue = Shapiro-Wilk test not rejected) with fitted normal curves, and chi-square Q-Q plot.", fig.height = 6, fig.width = 6.9----
mvn_result <- mvn_test(brittany_soil_ps, hz_nsim = 1000)

## ----mvn_summary--------------------------------------------------------------
print(mvn_result)

## ----gen_synth----------------------------------------------------------------
set.seed(2026)
X <- brittany_soil_ps
n <- nrow(X) # 37
p <- ncol(X) # 6

# M = 1: single release
V1 <- simSynthData(X)
cat("Single release: ", nrow(V1), "x", ncol(V1), "\n")

# M = 3: three stacked releases
V3 <- simSynthData(X, M = 3)
cat("Three releases: ", nrow(V3), "x", ncol(V3), "\n")

## ----gv, fig.cap = "GV null distribution (log10 scale) for M = 1 (left) and M = 3 (right). The null distribution narrows with M; the observed statistic falls within the non-rejection region in both cases.", fig.height = 4, fig.width = 6.9----
op <- par(mfrow = c(1, 2))
gv1 <- gv_test(V1, M = 1, Sigma = cov(X), iterations = 5000)
plot(gv1, main = "Gen. Variance  (M = 1)")
gv3 <- gv_test(V3, M = 3, Sigma = cov(X), iterations = 5000)
plot(gv3, main = "Gen. Variance  (M = 3)")
par(op)

## ----gv_print-----------------------------------------------------------------
cat("M = 1: p =", gv1$p.value, "|", gv1$decision, "\n")
cat("M = 3: p =", gv3$p.value, "|", gv3$decision, "\n")

## ----sph, fig.cap = "Sphericity null distribution for M = 1 (left) and M = 3 (right). The observed statistic is far into the left rejection region in both cases; larger M concentrates the null distribution.", fig.height = 4, fig.width = 6.9----
op <- par(mfrow = c(1, 2))
sph1 <- sphericity_test(V1, M = 1, iterations = 5000)
plot(sph1, main = "Sphericity  (M = 1)")
sph3 <- sphericity_test(V3, M = 3, iterations = 5000)
plot(sph3, main = "Sphericity  (M = 3)")
par(op)

## ----sph_print----------------------------------------------------------------
cat(
  "M = 1: stat =", round(sph1$statistic, 4),
  "| p =", sph1$p.value, "|", sph1$decision, "\n"
)
cat(
  "M = 3: stat =", round(sph3$statistic, 4),
  "| p =", sph3$p.value, "|", sph3$decision, "\n"
)

## ----ind, fig.cap = "Independence null distribution for M = 1 (left) and M = 3 (right). Rejection is clear in both cases; the critical value moves right as M increases.", fig.height = 4, fig.width = 6.7----
op <- par(mfrow = c(1, 2))
ind1 <- independence_test(V1,
  M = 1,
  group_a = c("pH_water", "pH_KCl", "log_CEC_Metson"),
  group_b = c("log_Organic_C", "log_Total_N", "log_P_Olsen"),
  iterations = 5000
)
plot(ind1, main = "Independence  (M = 1)")
ind3 <- independence_test(V3,
  M = 3,
  group_a = c("pH_water", "pH_KCl", "log_CEC_Metson"),
  group_b = c("log_Organic_C", "log_Total_N", "log_P_Olsen"),
  iterations = 5000
)
plot(ind3, main = "Independence  (M = 3)")
par(op)

## ----ind_print----------------------------------------------------------------
cat(
  "M = 1: stat =", round(ind1$statistic, 4),
  "| p =", ind1$p.value, "|", ind1$decision, "\n"
)
cat(
  "M = 3: stat =", round(ind3$statistic, 4),
  "| p =", ind3$p.value, "|", ind3$decision, "\n"
)

## ----reg, fig.cap = "Regression null distribution (log10 scale) for M = 1 (left) and M = 3 (right). Both reject the zero-regression null.", fig.height = 4, fig.width = 6.9----
op <- par(mfrow = c(1, 2))
reg1 <- regression_test(V1,
  M = 1,
  response = c("pH_water", "pH_KCl", "log_CEC_Metson"),
  predictors = c("log_Organic_C", "log_Total_N", "log_P_Olsen"),
  Delta0 = matrix(0, 3, 3),
  iterations = 5000
)
plot(reg1, main = "Regression  (M = 1)")
reg3 <- regression_test(V3,
  M = 3,
  response = c("pH_water", "pH_KCl", "log_CEC_Metson"),
  predictors = c("log_Organic_C", "log_Total_N", "log_P_Olsen"),
  Delta0 = matrix(0, 3, 3),
  iterations = 5000
)
plot(reg3, main = "Regression  (M = 3)")
par(op)

## ----reg_print----------------------------------------------------------------
cat(
  "M = 1: stat =", round(reg1$statistic, 5),
  "| p =", reg1$p.value, "|", reg1$decision, "\n"
)
cat(
  "M = 3: stat =", round(reg3$statistic, 5),
  "| p =", reg3$p.value, "|", reg3$decision, "\n"
)

## ----M_effect, fig.cap = "Sphericity null distribution for M = 1, 2, 3, 5. The distribution concentrates as M grows, lowering the critical value and strengthening evidence against the false null.", fig.height = 5, fig.width = 6.9----
op <- par(mfrow = c(2, 2))
for (m in c(1L, 2L, 3L, 5L)) {
  Vm <- simSynthData(X, M = m)
  res <- sphericity_test(Vm, M = m, iterations = 2000)
  plot(res, main = sprintf("Sphericity: M = %d  (N = %d)", m, m * n))
}
par(op)

## ----M_table------------------------------------------------------------------
# Numerical summary across M
results <- lapply(c(1L, 2L, 3L, 5L), function(m) {
  Vm <- simSynthData(X, M = m)
  s <- sphericity_test(Vm, M = m, iterations = 3000)
  i <- independence_test(Vm,
    M = m,
    group_a = c("pH_water", "pH_KCl", "log_CEC_Metson"),
    group_b = c("log_Organic_C", "log_Total_N", "log_P_Olsen"),
    iterations = 3000
  )
  data.frame(
    M = m,
    N = m * n,
    sph_stat = round(s$statistic, 5),
    sph_pval = round(s$p.value, 5),
    ind_stat = round(i$statistic, 5),
    ind_pval = round(i$p.value, 5)
  )
})
do.call(rbind, results)

