ru {rust} | R Documentation |
Generalized ratio-of-uniforms sampling
Description
Uses the generalized ratio-of-uniforms method to simulate from a
distribution with log-density \log f
(up to an additive
constant). The density f
must be bounded, perhaps after a
transformation of variable.
Usage
ru(
logf,
...,
n = 1,
d = 1,
init = NULL,
mode = NULL,
trans = c("none", "BC", "user"),
phi_to_theta = NULL,
log_j = NULL,
user_args = list(),
lambda = rep(1L, d),
lambda_tol = 1e-06,
gm = NULL,
rotate = ifelse(d == 1, FALSE, TRUE),
lower = rep(-Inf, d),
upper = rep(Inf, d),
r = 1/2,
ep = 0L,
a_algor = if (d == 1) "nlminb" else "optim",
b_algor = c("nlminb", "optim"),
a_method = c("Nelder-Mead", "BFGS", "CG", "L-BFGS-B", "SANN", "Brent"),
b_method = c("Nelder-Mead", "BFGS", "CG", "L-BFGS-B", "SANN", "Brent"),
a_control = list(),
b_control = list(),
var_names = NULL,
shoof = 0.2
)
Arguments
logf |
A function returning the log of the target density |
... |
Further arguments to be passed to |
n |
A non-negative integer scalar. The number of simulated values
required. If |
d |
A positive integer scalar. The dimension of |
init |
A numeric vector. Initial estimates of the mode of |
mode |
A numeric vector of length |
trans |
A character scalar. |
phi_to_theta |
A function returning (the inverse) of the transformation
from |
log_j |
A function returning the log of the Jacobian of the
transformation from |
user_args |
A list of numeric components. If |
lambda |
Either
|
lambda_tol |
A numeric scalar. Any values in lambda that are less
than |
gm |
A numeric vector. Box-cox scaling parameters (optional). If
|
rotate |
A logical scalar. If TRUE ( |
lower , upper |
Numeric vectors. Lower/upper bounds on the arguments of
the function after any transformation from theta to phi implied by
the inverse of |
r |
A numeric scalar. Parameter of generalized ratio-of-uniforms. |
ep |
A numeric scalar. Controls initial estimates for optimisations
to find the |
a_algor , b_algor |
Character scalars. Either |
a_method , b_method |
Character scalars. Respective methods used by
|
a_control , b_control |
Lists of control arguments to |
var_names |
A character (or numeric) vector of length |
shoof |
A numeric scalar in [0, 1]. Sometimes a spurious
non-zero convergence indicator is returned from
|
Details
For information about the generalised ratio-of-uniforms method and
transformations see the
Introducing rust vignette. This can also be accessed using
vignette("rust-a-vignette", package = "rust")
.
If trans = "none"
and rotate = FALSE
then ru
implements the (multivariate) generalized ratio of uniforms method
described in Wakefield, Gelfand and Smith (1991) using a target
density whose mode is relocated to the origin (‘mode relocation’) in the
hope of increasing efficiency.
If trans = "BC"
then marginal Box-Cox transformations of each of
the d
variables is performed, with parameters supplied in
lambda
. The function phi_to_theta
may be used, if
necessary, to ensure positivity of the variables prior to Box-Cox
transformation.
If trans = "user"
then the function phi_to_theta
enables
the user to specify their own transformation.
In all cases the mode of the target function is relocated to the origin after any user-supplied transformation and/or Box-Cox transformation.
If d
is greater than one and rotate = TRUE
then a rotation
of the variable axes is performed after mode relocation. The
rotation is based on the Choleski decomposition (see chol) of the
estimated Hessian (computed using optimHess
of the negated
log-density after any user-supplied transformation or Box-Cox
transformation. If any of the eigenvalues of the estimated Hessian are
non-positive (which may indicate that the estimated mode of logf
is close to a variable boundary) then rotate
is set to FALSE
with a warning. A warning is also given if this happens when
d
= 1.
The default value of the tuning parameter r
is 1/2, which is
likely to be close to optimal in many cases, particularly if
trans = "BC"
.
Value
An object of class "ru"
is a list containing the following
components:
sim_vals |
An |
box |
A (2 *
Scaling of f within |
pa |
A numeric scalar. An estimate of the probability of acceptance. |
r |
The value of |
d |
The value of |
logf |
A function. |
logf_rho |
A function. The target function actually used in the ratio-of-uniforms algorithm. |
sim_vals_rho |
An |
logf_args |
A list of further arguments to |
f_mode |
The estimated mode of the target density f, after any Box-Cox transformation and/or user supplied transformation, but before mode relocation. |
trans_fn |
An R function that performs the inverse transformation
from the transformed variable |
References
Wakefield, J. C., Gelfand, A. E. and Smith, A. F. M. (1991) Efficient generation of random variates via the ratio-of-uniforms method. Statistics and Computing (1991), 1, 129-133. doi:10.1007/BF01889987.
See Also
ru_rcpp
for a version of ru
that uses
the Rcpp package to improve efficiency.
summary.ru
for summaries of the simulated values
and properties of the ratio-of-uniforms algorithm.
plot.ru
for a diagnostic plot.
find_lambda_one_d
to produce (somewhat) automatically
a list for the argument lambda
of ru
for the
d
= 1 case.
find_lambda
to produce (somewhat) automatically
a list for the argument lambda
of ru
for any value of
d
.
optim
for choices of the arguments
a_method
, b_method
, a_control
and b_control
.
nlminb
for choices of the arguments
a_control
and b_control
.
optimHess
for Hessian estimation.
chol
for the Choleski decomposition.
Examples
# Normal density ===================
# One-dimensional standard normal ----------------
x <- ru(logf = function(x) -x ^ 2 / 2, d = 1, n = 1000, init = 0.1)
# Two-dimensional standard normal ----------------
x <- ru(logf = function(x) -(x[1]^2 + x[2]^2) / 2, d = 2, n = 1000,
init = c(0, 0))
# Two-dimensional normal with positive association ----------------
rho <- 0.9
covmat <- matrix(c(1, rho, rho, 1), 2, 2)
log_dmvnorm <- function(x, mean = rep(0, d), sigma = diag(d)) {
x <- matrix(x, ncol = length(x))
d <- ncol(x)
- 0.5 * (x - mean) %*% solve(sigma) %*% t(x - mean)
}
# No rotation.
x <- ru(logf = log_dmvnorm, sigma = covmat, d = 2, n = 1000, init = c(0, 0),
rotate = FALSE)
# With rotation.
x <- ru(logf = log_dmvnorm, sigma = covmat, d = 2, n = 1000, init = c(0, 0))
# three-dimensional normal with positive association ----------------
covmat <- matrix(rho, 3, 3) + diag(1 - rho, 3)
# No rotation. Slow !
x <- ru(logf = log_dmvnorm, sigma = covmat, d = 3, n = 1000,
init = c(0, 0, 0), rotate = FALSE)
# With rotation.
x <- ru(logf = log_dmvnorm, sigma = covmat, d = 3, n = 1000,
init = c(0, 0, 0))
# Log-normal density ===================
# Sampling on original scale ----------------
x <- ru(logf = dlnorm, log = TRUE, d = 1, n = 1000, lower = 0, init = 1)
# Box-Cox transform with lambda = 0 ----------------
lambda <- 0
x <- ru(logf = dlnorm, log = TRUE, d = 1, n = 1000, lower = 0, init = 0.1,
trans = "BC", lambda = lambda)
# Equivalently, we could use trans = "user" and supply the (inverse) Box-Cox
# transformation and the log-Jacobian by hand
x <- ru(logf = dlnorm, log = TRUE, d = 1, n = 1000, init = 0.1,
trans = "user", phi_to_theta = function(x) exp(x),
log_j = function(x) -log(x))
# Gamma(alpha, 1) density ===================
# Note: the gamma density in unbounded when its shape parameter is < 1.
# Therefore, we can only use trans="none" if the shape parameter is >= 1.
# Sampling on original scale ----------------
alpha <- 10
x <- ru(logf = dgamma, shape = alpha, log = TRUE, d = 1, n = 1000,
lower = 0, init = alpha)
alpha <- 1
x <- ru(logf = dgamma, shape = alpha, log = TRUE, d = 1, n = 1000,
lower = 0, init = alpha)
# Box-Cox transform with lambda = 1/3 works well for shape >= 1. -----------
alpha <- 1
x <- ru(logf = dgamma, shape = alpha, log = TRUE, d = 1, n = 1000,
trans = "BC", lambda = 1/3, init = alpha)
summary(x)
# Equivalently, we could use trans = "user" and supply the (inverse) Box-Cox
# transformation and the log-Jacobian by hand
# Note: when phi_to_theta is undefined at x this function returns NA
phi_to_theta <- function(x, lambda) {
ifelse(x * lambda + 1 > 0, (x * lambda + 1) ^ (1 / lambda), NA)
}
log_j <- function(x, lambda) (lambda - 1) * log(x)
lambda <- 1/3
x <- ru(logf = dgamma, shape = alpha, log = TRUE, d = 1, n = 1000,
trans = "user", phi_to_theta = phi_to_theta, log_j = log_j,
user_args = list(lambda = lambda), init = alpha)
summary(x)
# Generalized Pareto posterior distribution ===================
# Sample data from a GP(sigma, xi) distribution
gpd_data <- rgpd(m = 100, xi = -0.5, sigma = 1)
# Calculate summary statistics for use in the log-likelihood
ss <- gpd_sum_stats(gpd_data)
# Calculate an initial estimate
init <- c(mean(gpd_data), 0)
# Mode relocation only ----------------
n <- 1000
x1 <- ru(logf = gpd_logpost, ss = ss, d = 2, n = n, init = init,
lower = c(0, -Inf), rotate = FALSE)
plot(x1, xlab = "sigma", ylab = "xi")
# Parameter constraint line xi > -sigma/max(data)
# [This may not appear if the sample is far from the constraint.]
abline(a = 0, b = -1 / ss$xm)
summary(x1)
# Rotation of axes plus mode relocation ----------------
x2 <- ru(logf = gpd_logpost, ss = ss, d = 2, n = n, init = init,
lower = c(0, -Inf))
plot(x2, xlab = "sigma", ylab = "xi")
abline(a = 0, b = -1 / ss$xm)
summary(x2)
# Cauchy ========================
# The bounding box cannot be constructed if r < 1. For r = 1 the
# bounding box parameters b1-(r) and b1+(r) are attained in the limits
# as x decreases/increases to infinity respectively. This is fine in
# theory but using r > 1 avoids this problem and the largest probability
# of acceptance is obtained for r approximately equal to 1.26.
res <- ru(logf = dcauchy, log = TRUE, init = 0, r = 1.26, n = 1000)
# Half-Cauchy ===================
log_halfcauchy <- function(x) {
return(ifelse(x < 0, -Inf, dcauchy(x, log = TRUE)))
}
# Like the Cauchy case the bounding box cannot be constructed if r < 1.
# We could use r > 1 but the mode is on the edge of the support of the
# density so as an alternative we use a log transformation.
x <- ru(logf = log_halfcauchy, init = 0, trans = "BC", lambda = 0, n = 1000)
x$pa
plot(x, ru_scale = TRUE)
# Example 4 from Wakefield et al. (1991) ===================
# Bivariate normal x bivariate student-t
log_norm_t <- function(x, mean = rep(0, d), sigma1 = diag(d), sigma2 = diag(d)) {
x <- matrix(x, ncol = length(x))
log_h1 <- -0.5 * (x - mean) %*% solve(sigma1) %*% t(x - mean)
log_h2 <- -2 * log(1 + 0.5 * x %*% solve(sigma2) %*% t(x))
return(log_h1 + log_h2)
}
rho <- 0.9
covmat <- matrix(c(1, rho, rho, 1), 2, 2)
y <- c(0, 0)
# Case in the top right corner of Table 3
x <- ru(logf = log_norm_t, mean = y, sigma1 = covmat, sigma2 = covmat,
d = 2, n = 10000, init = y, rotate = FALSE)
x$pa
# Rotation increases the probability of acceptance
x <- ru(logf = log_norm_t, mean = y, sigma1 = covmat, sigma2 = covmat,
d = 2, n = 10000, init = y, rotate = TRUE)
x$pa
# Normal x log-normal: different Box-Cox parameters ==================
norm_lognorm <- function(x, ...) {
dnorm(x[1], ...) + dlnorm(x[2], ...)
}
x <- ru(logf = norm_lognorm, log = TRUE, n = 1000, d = 2, init = c(-1, 0),
trans = "BC", lambda = c(1, 0))
plot(x)
plot(x, ru_scale = TRUE)