# NOT RUN {
## Simulation and density evaluation for p = 2
# Parameters
p <- 2
n <- 1e3
theta <- c(rep(0, p - 1), 1)
Lambda <- matrix(0.5, nrow = p - 1, ncol = p - 1)
diag(Lambda) <- 1
kappa_V <- 2
# Required functions
r_V <- function(n) r_g_vMF(n = n, p = p, kappa = kappa_V)
g_scaled <- function(t, log) {
g_vMF(t, p = p - 1, kappa = kappa_V, scaled = TRUE, log = log)
}
# Sample and color according to density
x <- r_TE(n = n, theta = theta, r_V = r_V, Lambda = Lambda)
col <- viridisLite::viridis(n)
r <- runif(n, 0.95, 1.05) # Radius perturbation to improve visualization
dens <- d_TE(x = x, theta = theta, g_scaled = g_scaled, Lambda = Lambda)
plot(r * x, pch = 16, col = col[rank(dens)])
## Simulation and density evaluation for p = 3
# Parameters
p <- 3
n <- 5e3
theta <- c(rep(0, p - 1), 1)
Lambda <- matrix(0.5, nrow = p - 1, ncol = p - 1)
diag(Lambda) <- 1
kappa_V <- 2
# Sample and color according to density
x <- r_TE(n = n, theta = theta, r_V = r_V, Lambda = Lambda)
col <- viridisLite::viridis(n)
dens <- d_TE(x = x, theta = theta, g_scaled = g_scaled, Lambda = Lambda)
rgl::plot3d(x, col = col[rank(dens)], size = 5)
## A non-vMF angular function: g(t) = 1 - t^2. It is sssociated to the
## Beta(1/2, (p + 1)/2) distribution.
# Scaled angular function
g_scaled <- function(t, log) {
log_c_g <- lgamma(0.5 * p) + log(0.5 * p / (p - 1)) - 0.5 * p * log(pi)
log_g <- log_c_g + log(1 - t^2)
switch(log + 1, exp(log_g), log_g)
}
# Simulation
r_V <- function(n) {
sample(x = c(-1, 1), size = n, replace = TRUE) *
sqrt(rbeta(n = n, shape1 = 0.5, shape2 = 0.5 * (p + 1)))
}
# Sample and color according to density
kappa_V <- 1
Lambda <- matrix(0.75, nrow = p - 1, ncol = p - 1)
diag(Lambda) <- 1
x <- r_TE(n = n, theta = theta, r_V = r_V, Lambda = Lambda)
col <- viridisLite::viridis(n)
dens <- d_TE(x = x, theta = theta, g_scaled = g_scaled, Lambda = Lambda)
rgl::plot3d(x, col = col[rank(dens)], size = 5)
# }
Run the code above in your browser using DataLab