Xρ=||X||2aXρX/||X||ρσχ(n)
X∼N(0,In)
Pχ2(d)(a/σ)2
Y=σPX/||X||
Xd
PF−1χ2(d)UF((a/σ)2)1P=F(U)−−−−−√
105σPσ=3n=11a=7
χ(11)σ=3
a=3σ=1n=2Y2Y1104a
Xia=0an−1a((n−1)/2,(n−1)/2)(−a,a)a=3σ2−13σ
1053a=10σ=1(1,1)
n−1
R
Ya
d
n
sigma
plot(y[1,], y[2,], pch=16, cex=1/2, col="#00000010")
y
U1−UP
想定されたアルゴリズムに従ってデータをシミュレートし、それをヒストグラムで要約し、ヒストグラムを重ね合わせる同じ手法を使用して、質問で説明されている方法をテストできます。メソッドが期待どおりに機能しないことが確認されます。
a <- 7 # Lower threshold
d <- 11 # Dimensions
n <- 1e5 # Sample size
sigma <- 3 # Original SD
#
# The algorithm.
#
set.seed(17)
u.max <- pchisq((a/sigma)^2, d, lower.tail=FALSE)
if (u.max == 0) stop("The threshold is too large.")
u <- runif(n, 0, u.max)
rho <- sigma * sqrt(qchisq(u, d, lower.tail=FALSE))
x <- matrix(rnorm(n*d, 0, 1), ncol=d)
y <- t(x * rho / apply(x, 1, function(y) sqrt(sum(y*y))))
#
# Draw histograms of the marginal distributions.
#
h <- function(z) {
s <- sd(z)
hist(z, freq=FALSE, ylim=c(0, 1/sqrt(2*pi*s^2)),
main="Marginal Histogram",
sub="Best Normal Fit Superimposed")
curve(dnorm(x, mean(z), s), add=TRUE, lwd=2, col="Red")
}
par(mfrow=c(1, min(d, 4)))
invisible(apply(y, 1, h))
#
# Draw a nice histogram of the distances.
#
#plot(y[1,], y[2,], pch=16, cex=1/2, col="#00000010") # For figure 2
rho.max <- min(qchisq(1 - 0.001*pchisq(a/sigma, d, lower.tail=FALSE), d)*sigma,
max(rho), na.rm=TRUE)
k <- ceiling(rho.max/a)
hist(rho, freq=FALSE, xlim=c(0, rho.max),
breaks=seq(0, max(rho)+a, by=a/ceiling(50/k)))
#
# Superimpose the theoretical distribution.
#
dchi <- function(x, d) {
exp((d-1)*log(x) + (1-d/2)*log(2) - x^2/2 - lgamma(d/2))
}
curve((x >= a)*dchi(x/sigma, d) / (1-pchisq((a/sigma)^2, d))/sigma, add=TRUE,
lwd=2, col="Red", n=257)