RcppExports.R

# Generated by using Rcpp::compileAttributes() -> do not edit by hand
# Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393

#' Sample from the Polya Gamma distribution PG(h, z)
#'
#' Chooses the most efficient implemented method to sample from a Polya Gamma
#' distribution. Details on algorithm selection presented below.
#'
#' @param n     The number of samples to taken from a PG(h, z). Used only by
#'              the vector sampler.
#' @param h     `integer` values corresponding to the "shape" parameter.
#' @param z     `numeric` values corresponding to the "scale" parameter.
#' @param trunc Truncation cut-off. Only used by the gamma sampler.
#'
#' @return
#' A single `numeric` value.
#'
#' @details
#' The following sampling cases are enabled:
#'
#' - `h > 170`: Normal approximation method
#' - `h > 13`: Saddlepoint approximation method
#' - `h = 1` or `h = 2`: Devroye method
#' - `h > 0`: Sum of Gammas method.
#' - `h < 0`: Result is automatically set to zero.
#'
#' @export
#' @rdname rpg-sampler
#'
#' @examples
#' # Fixed parameter distribution simulation ----
#'
#' ## Parameters  ----
#' h = 1; z = .5
#'
#' ## Sample only one value  ----
#' single_value = rpg_scalar(h, z)
#' single_value
#'
#' ## Attempt distribution recovery  ----
#' vector_of_pg_samples = rpg_vector(1e6, h, z)
#'
#' head(vector_of_pg_samples)
#' length(vector_of_pg_samples)
#'
#' ## Obtain the empirical results   ----
#' empirical_mean = mean(vector_of_pg_samples)
#' empirical_var = var(vector_of_pg_samples)
#'
#' ## Take the theoretical values ----
#' theoretical_mean = pg_mean(h, z)
#' theoretical_var = pg_var(h, z)
#'
#' ## Form a comparison table ----
#'
#' # empirically sampled vs. theoretical values
#' rbind(c(empirical_mean, theoretical_mean),
#'       c(empirical_var, theoretical_var))
#'
#' # Varying distribution parameters ----
#'
#' ## Generate varying parameters ----
#' u_h = 20:100
#' u_z = 0.5*u_h
#'
#' ## Sample from varying parameters ----
#' x = rpg_hybrid(u_h, u_z)
rpg_scalar <- function(h, z) {
    .Call(`_pg_rpg_scalar`, h, z)
}

#' @export
#' @rdname rpg-sampler
rpg_vector <- function(n, h, z) {
    .Call(`_pg_rpg_vector`, n, h, z)
}

#' @export
#' @rdname rpg-sampler
rpg_hybrid <- function(h, z) {
    .Call(`_pg_rpg_hybrid`, h, z)
}

rpg_scalar_loop <- function(h, z) {
    .Call(`_pg_rpg_scalar_loop`, h, z)
}

#' @export
#' @rdname rpg-sampler
rpg_gamma <- function(h, z, trunc = 1000L) {
    .Call(`_pg_rpg_gamma`, h, z, trunc)
}

#' @export
#' @rdname rpg-sampler
rpg_devroye <- function(h, z) {
    .Call(`_pg_rpg_devroye`, h, z)
}

#' @export
#' @rdname rpg-sampler
rpg_sp <- function(h, z) {
    .Call(`_pg_rpg_sp`, h, z)
}

#' @export
#' @rdname rpg-sampler
rpg_normal <- function(h, z) {
    .Call(`_pg_rpg_normal`, h, z)
}