# Tests for Wishart package
library(tinytest)
# Check that error if x or S is not positive definite
source(
  "~/Documents/Dropbox/Publications/Ongoing/BGOR_2024_Wishart_asym_kernels/Code/functions.R"
)
library(ksm)

# Check dimension of output returned by rWishart
d <- 10L
S <- ksm::symmetrize(diag(d) + matrix(0.5, d, d))
df <- d + 1
b <- 2
n <- 100L
set.seed(6543)
samp <- rWishart(
  n = n,
  df = df,
  S = S
)
for (i in 1:n) {
  samp[,, i] <- symmetrize(cov2cor(samp[,, i]))
}
sampfull <- samp
expect_equal(dim(samp), c(d, d, n))
expect_equal(
  current = c(dWishart(x = samp[,, 1, drop = FALSE], df = df, S = S)),
  LaplacesDemon::dwishart(Omega = symmetrize(samp[,, 1]), nu = df, S = S)
)

expect_equal(
  current = c(dinvWishart(
    x = samp[,, 1, drop = FALSE],
    df = df,
    S = S,
    log = TRUE
  )),
  LaplacesDemon::dinvwishart(
    log = TRUE,
    Sigma = symmetrize(samp[,, 1]),
    nu = df,
    S = S
  )
)


expect_equal(
  LaplacesDemon::dwishart(
    symmetrize(samp[,, 1]),
    nu = 1 / b + d + 1,
    S = symmetrize(b * samp[,, 1]),
    log = TRUE
  ),
  c(dWishart(
    samp[,, 1, drop = FALSE],
    df = 1 / b + d + 1,
    S = b * samp[,, 1],
    log = TRUE
  ))
)

isTRUE(all(
  apply(samp, 3, function(x) {
    tail(eigen(x, only.values = TRUE)$values, 1)
  }) >
    0
))

# Check matrix-variate normal
expect_equal(
  c(dsmnorm(x = samp, b = b, M = S, log = TRUE)),
  log(apply(samp, 3, function(x) {
    G(x - S, b = b)
  }))
)

expect_equal(
  log(LG(X = S, b = b, S = samp[,, 1])),
  c(dsmlnorm(x = samp[,, 1, drop = FALSE], b = b, M = S, log = TRUE))
)

xg <- rexp(n = 10, rate = 0.1)
expect_equal(
  c(Cholksm::lmvgamma(xg, p = 5)),
  c(mgamma(xg, p = 5, log = TRUE))
)
expect_equal(
  ksm:::lmgamma(3.2, 4),
  c(Cholksm::lmvgamma(3.2, 4))
)


expect_equal(
  c(dmbeta2(samp, shape1 = 15, shape2 = 10)),
  log(apply(samp, 3, function(x) {
    dmatrixbeta_typeII(x, 15, 10)
  }))
)

M2 <- matrix(c(0.3, -0.3, -0.3, 0.3), nrow = 2)
# Covariance matrices
Sigma2 <- matrix(c(1, 0.5, 0.5, 1), nrow = 2)

expect_equal(
  Riccati(S = Sigma2, M = M2)$solution,
  solve_riccati(M = M2, Sigma = Sigma2)
)

## Kernels and Leave-one-out cross validation
## This does not work anymore for some reason
# expect_equal(
#   mean(sapply(1:10, function(i) {
#     kdens_Wishart(x = samp[,, i, drop = FALSE], xs = samp[,, -i], b = b)
#   })),
#   lcv_kern_Wishart(x = samp[,, 1:10], b = b)
# )
#
# expect_equal(
#   mean(sapply(1:10, function(i) {
#     kdens_smlnorm(x = samp[,, i, drop = FALSE], xs = samp[,, -i], b = b)
#   })),
#   lcv_kern_smlnorm(x = samp[,, 1:10], b = b)
# )

u <- runif(100)
expect_equal(
  exp(meanlog(log(u))),
  mean(u)
)


# Reduce sample size since R functions are slow

samp <- samp[,, 1:10]
XX <- list()
for (i in 1:dim(samp)[3]) {
  XX[[i]] <- symmetrize(samp[,, i])
}


expect_equal(
  log(hat_f(XX[-1], S = XX[[1]], b = b, method = "WK")),
  kdens_Wishart(
    x = samp[,, 1, drop = FALSE],
    xs = samp[,, -1],
    b = b
  )
)

expect_equal(
  log(hat_f(XX[-1], S = XX[[1]], b = b, method = "LG")),
  kdens_smlnorm(x = samp[,, 1, drop = FALSE], xs = samp[,, -1], b = b)
)

expect_equal(
  LCV(XX = XX, b = b, method = "LG"),
  lcv_kern_smlnorm(x = samp[,, 1:10], b = b)
)
expect_equal(
  LCV(XX = XX, b = b, method = "WK"),
  lcv_kern_Wishart(x = samp[,, 1:10], b = b)
)


expect_equal(
  c(lscv_kern_Wishart(x = samp, b = b, h = 1)),
  LSCV_MC(XX = XX, b = b, method = "WK", h = 1)
)

expect_equal(
  c(lscv_kern_Wishart(x = samp, b = b, h = 2)),
  LSCV_MC(XX = XX, b = b, method = "WK", h = 2)
)
expect_equal(
  c(lscv_kern_smlnorm(x = samp, b = b, h = 1)),
  LSCV_MC(XX = XX, b = b, method = "LG", h = 1)
)

expect_equal(
  c(lscv_kern_smlnorm(x = samp, b = b, h = 2)),
  LSCV_MC(XX = XX, b = b, method = "LG", h = 2)
)

microbenchmark::microbenchmark(
  c(lcv_kern_Wishart(x = sampfull, b = b)),
  c(lcv_kern_smlnorm(x = sampfull, b = b)),
  c(lcv_kern_smnorm(x = sampfull, b = b))
)

microbenchmark::microbenchmark(
  c(lscv_kern_Wishart(x = sampfull, b = b, h = 1)),
  c(lscv_kern_smlnorm(x = sampfull, b = b, h = 1))
)

microbenchmark::microbenchmark(
  kdens_Wishart(x = sampfull, xs = sampfull, b = b),
  kdens_smlnorm(x = sampfull, xs = sampfull, b = b),
  kdens_smnorm(x = sampfull, xs = sampfull, b = b)
)


# Define the integrand for cubature
integrand <- function(vars, shape) {
  # Construct SPD matrix X from the parameters theta, lambda1, lambda2
  X <- array(
    ksm::rotation_scaling(vars[1], c(vars[2], vars[3])),
    dim = c(2, 2, 1)
  )
  # Compute the density using the dmatrixbeta_typeII function
  density_value <- dmbeta2(X, shape[1], shape[2], log = FALSE)

  # Return the density multiplied by the Jacobian adjustment for polar coordinates
  jacobian_value <- abs(vars[2] - vars[3]) / 4
  return(density_value * jacobian_value)
}

# Perform the numerical integration using adaptIntegrate from the cubature package
result_test <- cubature::adaptIntegrate(
  integrand,
  lowerLimit = c(0, 0, 0),
  upperLimit = c(2 * pi, Inf, Inf),
  tol = 1e-4,
  shape = 2 + rexp(2)
)
expect_equal(1, result_test$integral, tolerance = 1e-4)
