These functions create rejection samplers, and uniform manifold samplers based on them, using user-provided parameterization and Jacobian functions.
make_rejection_sampler(
parameterization,
jacobian,
min_params,
max_params,
max_jacobian
)
A function that takes parameter vector arguments and returns a matrix of coordinates.
A function that takes parameter vector arguments and returns a vector of Jacobian determinants.
(Optionally named) vectors of minimum and maximum values of the parameters, used for uniform sampling.
An (ideally sharp) upper bound on the Jacobian determinant.
The rejection sampling technique of Diaconis, Holmes, and
Shahshahani (2013) uses a parameterized embedding from a parameter space to
a coordinate space and relies on a formula for its jacobian determinant.
The parameterization
must be a function that takes vector arguments of
equal length and returns a coordinate matrix of the same number of rows.
The jacobian
must be a function that takes the same arguments and returns
a scalar value. The parameters must range from their respective minima
min_params
to their respective maxima max_params
. max_jacobian
must
be provided, though it may be larger than the theoretical maximum of the
jacobian determinant.
P Diaconis, S Holmes, and M Shahshahani (2013) Sampling from a Manifold. Advances in Modern Statistical Theory and Applications: A Festschrift in honor of Morris L. Eaton, 102--125. doi:10.1214/12-IMSCOLL1006
set.seed(47569L)
# parameterization and Jacobian for Klein bottle tube embedding
klein_parameterization <- function(theta, phi) {
cbind(
w = (1 + .5 * cos(theta)) * cos(phi),
x = (1 + .5 * cos(theta)) * sin(phi),
y = .5 * sin(theta) * cos(phi/2),
z = .5 * sin(theta) * sin(phi/2)
)
}
klein_jacobian <- function(theta, phi) {
unname(.5 * sqrt((1 + .5 * cos(theta)) ^ 2 + (.5 * .5 * sin(theta)) ^ 2))
}
# custom sampler based on these functions
klein_sampler <- make_rejection_sampler(
klein_parameterization,
klein_jacobian,
max_params = c(theta = 2*pi, phi = 2*pi),
max_jacobian = klein_jacobian(cbind(theta = 0))
)
# compare custom sampler to `sample_klein_tube()`
pairs(klein_sampler(n = 360), asp = 1, pch = 19, cex = .5)
pairs(sample_klein_tube(n = 360, ar = 2), asp = 1, pch = 19, cex = .5)