R/RcppExports.R

# This file was generated by Rcpp::compileAttributes
# Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393

#' Simulate one draw from a multivariate normal distribution
#'
#' @param mu A numeric vector, the mean of the distribution.
#' @param Sigma_inv A numeric matrix, the precision matrix (inverse of the
#' of the variance-covariance matrix) of the distribution
#' @return A column vector containing the draw.
#' @details Uses the Cholesky decomposition of Sigma_inv.
#' @examples
#' M <- matrix(c(1, 0.5, 0.5, 1), 2, 2)
#' draw_normal(c(0, 0), solve(M))
draw_normal <- function(mu, Sigma_inv) {
    .Call('zoofactr_draw_normal', PACKAGE = 'zoofactr', mu, Sigma_inv)
}

#' Multivariate normal probability density function
#'
#' @param x A numeric matrix, each column of which is a point at which the
#' density is to be evaluated.
#' @param mu A numeric vector, the mean of the distribution.
#' @param Sigma_inv A numeric matrix, the precision matrix (inverse of the
#' of the variance-covariance matrix) of the distribution.
#' @param logret, a logical value indicating whether to return the log density.
#' Defaults to FALSE.
#' @return A column vector whose jth element is the density of a multivariate
#' normal distribution with mean mu and precision matrix Sigma_inv evaluated at
#' the jth column of x. If logret is true, the natural logarithm of the density
#' is returned.
#' @examples
#' M <- matrix(c(1, 0.5, 0.5, 1), 2, 2)
#' m <- c(0, 0)
#' density_normal(cbind(c(0, 0), c(2, 2)), m, solve(M))
#' density_normal(cbind(c(0, 0), c(2, 2)), m, solve(M), TRUE)
density_normal <- function(x, mu, Sigma_inv, logret = FALSE) {
    .Call('zoofactr_density_normal', PACKAGE = 'zoofactr', x, mu, Sigma_inv, logret)
}

#' Simulate one draw from the Wishart distribution
#'
#' @param v An integer, the degrees of freedom of the distribution.
#' @param S A numeric matrix, the scale matrix of the distribution.
#' @return A column vector containing the draw.
#' @details Employs the Bartlett Decomposition (Smith & Hocking 1972).
#' Output exactly matches that of rwish from the MCMCpack package if the same
#' random seed is used.
#' @examples
#' M <- matrix(c(1, 0.5, 0.5, 1), 2, 2)
#' draw_wishart(10, M)
draw_wishart <- function(v, S) {
    .Call('zoofactr_draw_wishart', PACKAGE = 'zoofactr', v, S)
}

#' Natural logarithm of the p-dimensional MV Gamma function
#'
#' @param p An integer, the dimesion of the MV Gamma function.
#' @param a A real number, the argument of the MV Gamma function.
#' @details Used to calculate the normalizing constant for the density of the
#' Wishart distribution.
log_mv_gamma <- function(p, a) {
    .Call('zoofactr_log_mv_gamma', PACKAGE = 'zoofactr', p, a)
}

#' Wishart probability density function
#'
#' @param x A numeric matrix, the point at which the density is to be
#' evaluated.
#' @param v An integer, the degrees of freedom of the distribution.
#' @param S A numeric matrix, the scale matrix of the distribution.
#' of the variance-covariance matrix) of the distribution.
#' @param logret, a logical value indicating whether to return the log density.
#' Defaults to FALSE.
#' @return A column real number: the value of the probability density function
#' by the default or the natural logarithm if logret is TRUE.
#' @examples
#' M <- matrix(c(1, 0.5, 0.5, 1), 2, 2)
#' density_wishart(M, 10, M)
#' density_wishart(M, 10, M, TRUE)
density_wishart <- function(X, v, S, logret = FALSE) {
    .Call('zoofactr_density_wishart', PACKAGE = 'zoofactr', X, v, S, logret)
}

#' Armadillo wrapper for R's log1p function.
#'
#' @param x A numeric vector.
#' @return A numeric vector whose values are log(1 + x).
#' @details This is simply a wrapper to the vectorized Rcpp sugar function
#' log1p which uses the same implementation as R. It takes an Armadillo vector
#' as input and returns and Armadillo vector as output. It is intended for use
#' in C++ code that uses only Armadillo types.
#' @examples
#' log1p_arma(1/10^(0:5))
log1p_arma <- function(x) {
    .Call('zoofactr_log1p_arma', PACKAGE = 'zoofactr', x)
}

#' Multivariate Student-t probability density function
#'
#' @param nu A positive integer, the degrees of freedom of the distribution.
#' @param x A numeric matrix, each column of which is a point at which the
#' density is to be evaluated.
#' @param mu A numeric vector, the location parameter of the distribution.
#' @param Sigma_inv A numeric matrix, the inverse of the scale matrix the
#' of the variance-covariance matrix) of the distribution.
#' @param logret, a logical value indicating whether to return the log density.
#' Defaults to FALSE.
#' @return A column vector whose jth element is the density of a multivariate
#' Student-t with the specified parameters evaluated at  the jth column of x.
#' If logret is true, the natural logarithm of the density is returned.
#' @examples
#' M <- matrix(c(1, 0.5, 0.5, 1), 2, 2)
#' m <- c(0, 0)
#' df <- 20
#' density_t(cbind(c(0, 0), c(2, 2)), df, m, solve(M))
#' density_t(cbind(c(0, 0), c(2, 2)), df, m, solve(M), TRUE)
density_t <- function(x, nu, mu, Sigma_inv, logret = FALSE) {
    .Call('zoofactr_density_t', PACKAGE = 'zoofactr', x, nu, mu, Sigma_inv, logret)
}

#' Simulate draws from the Gamma distribution.
#'
#' @param a A positive number, the shape parameter of the distribution.
#' @param rate A numeric vector of positive values containing the rates
#' rates parameters for each draw.
#' @return A vector of random draws. The jth element is a Gamma(a, rate(j))
#' variate.
#' @details Note that the rate parameter is the reciprocal of the scale
#' parameter which appears as an argument in the underlying C function rgamma
#' from Rmath.h called here. The function draw_gamma is vectorized for its
#' second argument, the vector of rate parameters, and uses the length of this
#' parameter to determine how many draws to make. This function is intended
#' for use in a Gibbs sampler that uses the scale mixture of normals
#' representation of the Student-t distribution. In each step of the sampler
#' we draw an auxiliary parameter (a Gamma variate) for each observation in the
#' sample. Each of these draws has the same shape parameter but a different
#' rate parameter.
#' @examples
#' draw_gamma(1, 1:10)
draw_gamma <- function(a, rate) {
    .Call('zoofactr_draw_gamma', PACKAGE = 'zoofactr', a, rate)
}

#' Half-vectorization of a symmetric matrix
#'
#' @param M An n by n symmetric matrix.
#' @return A column vector containing the vech of M, i.e.
#' the n * (n + 1) / 2 unique elements of M.
#' @details Throws an error if M is not square, but does not test if M is
#' symmetric. Elements above the main diagonal are simply ignored.
#' @examples
#' M <- matrix(c(11, 12, 13, 14,
#'               12, 22, 23, 24,
#'               13, 23, 33, 34,
#'               14, 24, 34, 44), 4, 4, byrow = TRUE)
#' vech(M)
vech <- function(M) {
    .Call('zoofactr_vech', PACKAGE = 'zoofactr', M)
}

#' Convert Half-vectorization to symmetric matrix
#'
#' @param v A numeric vector with n * (n + 1) / 2 elements.
#' @param dim An integer indicating the dimension of the resulting square,
#' symmetric matrix.
#' @return The n by n symmetric matrix whose half-vectorization is v.
#' @details Throws an error if dim does not correspond to the length of v.
#' @examples
#' v <- c(11:14, 22:24, 33:34, 44)
#' devech(v, 4)
devech <- function(v, dim) {
    .Call('zoofactr_devech', PACKAGE = 'zoofactr', v, dim)
}

samplerTest_normal <- function(X, Y, G0, g0, R0, r0, n_draws, burn_in) {
    .Call('zoofactr_samplerTest_normal', PACKAGE = 'zoofactr', X, Y, G0, g0, R0, r0, n_draws, burn_in)
}

logML_SUR_normal <- function(X, Y, G0, g0, R0, r0, n_draws = 5000L, burn_in = 1000L) {
    .Call('zoofactr_logML_SUR_normal', PACKAGE = 'zoofactr', X, Y, G0, g0, R0, r0, n_draws, burn_in)
}

defaultSUR_normal <- function(X, Y, coef_scale = 10, cov_scale = 10) {
    .Call('zoofactr_defaultSUR_normal', PACKAGE = 'zoofactr', X, Y, coef_scale, cov_scale)
}

samplerTest_t <- function(X, Y, G0, g0, R0, r0, nu, n_draws, burn_in) {
    .Call('zoofactr_samplerTest_t', PACKAGE = 'zoofactr', X, Y, G0, g0, R0, r0, nu, n_draws, burn_in)
}

logML_SUR_t <- function(X, Y, G0, g0, R0, r0, nu, n_draws = 5000L, burn_in = 1000L) {
    .Call('zoofactr_logML_SUR_t', PACKAGE = 'zoofactr', X, Y, G0, g0, R0, r0, nu, n_draws, burn_in)
}

defaultSUR_t <- function(X, Y, coef_scale = 10, cov_scale = 10) {
    .Call('zoofactr_defaultSUR_t', PACKAGE = 'zoofactr', X, Y, coef_scale, cov_scale)
}
fditraglia/zoofactr documentation built on May 16, 2019, 12:12 p.m.