maotai (version 0.2.7)

WLmedian: Geometric Median of vMF Distributions Under a Wasserstein-Like Geometry

Description

Given a collection of von Mises-Fisher (vMF) distributions, each characterized by a mean direction \(\mathbf{\mu}\) and a concentration parameter \(\kappa\), this function solves the geometric median problem to compute the vMF distribution that minimizes the weighted sum of distances under an approximate Wasserstein geometry.

Usage

WLmedian(means, concentrations, weights = NULL)

Value

A named list containing:

mean

A length-\(p\) vector representing the median direction.

concentration

A scalar representing the median concentration.

Arguments

means

An \((n \times p)\) matrix where each row represents the mean direction of one of the \(n\) vMF distributions.

concentrations

A length-\(n\) vector of nonnegative concentration parameters.

weights

A weight vector of length \(n\). If NULL, equal weights (rep(1/n, n)) are used.

Examples

# \donttest{
# Set seed for reproducibility
set.seed(123)

# Number of vMF distributions
n <- 5   

# Generate mean directions concentrated around a specific angle (e.g., 45 degrees)
base_angle <- pi / 4  # 45 degrees in radians
angles <- rnorm(n, mean = base_angle, sd = pi / 20)  # Small deviation from base_angle
means <- cbind(cos(angles), sin(angles))  # Convert angles to unit vectors

# Generate concentration parameters with large magnitudes (tight distributions)
concentrations <- rnorm(n, mean = 50, sd = 5)  # Large values around 50

# Compute the median under the Wasserstein-like geometry
barycenter <- WLmedian(means, concentrations)

# Convert median mean direction to an angle
bary_angle <- atan2(barycenter$mean[2], barycenter$mean[1])

## Visualize
opar <- par(no.readonly=TRUE)
par(mfrow=c(1,2), pty="s")

# Plot the unit circle
plot(cos(seq(0, 2 * pi, length.out = 200)), sin(seq(0, 2 * pi, length.out = 200)), 
     type = "l", col = "gray", lwd = 2, xlab = "x", ylab = "y", 
     main = "Median of vMF Distributions on S^1")

# Add input mean directions
points(means[,1], means[,2], col = "blue", pch = 19, cex = 1.5)

# Add the computed barycenter
points(cos(bary_angle), sin(bary_angle), col = "red", pch = 17, cex = 2)

# Add legend
legend("bottomleft", legend = c("vMF Means", "Median"), col = c("blue", "red"), 
       pch = c(19, 17), cex = 1)

# Plot the concentration parameters
hist(concentrations, main = "Concentration Parameters", xlab = "Concentration")
abline(v=barycenter$concentration, col="red", lwd=2)
par(opar)
# }