R/RcppExports.R

In lgaborini/rdirdirgamma: Generate samples from Dirichlet-Dirichlet-Gamma model, and perform ABC.

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

#' Perform ABC sampling and distance calculation using the stick breaking procedure.
#'
#' Perform ABC sampling and distance calculation using the stick breaking procedure.
#'
#' ## Procedure
#'
#' 1. samples from Dirichlet using [rdirdirgamma_beta_cpp()].
#' 2. computes summary statistics on datasets:
#'
#' - column-wise mean
#' - column-wise standard deviation
#'
#' or a set of column-wise moments (mean, sd, kurtosis, skewness).
#'
#' 3. the generated dataset is invisibly is truncated to the same amount of rows as the observed dataset.
#' 4. compute the Minkowski norms of the differences between summary statistics.
#' 5. repeat `reps` times.
#'
#' ## RNG
#'
#' this function uses R's RNG seed.
#'
#' @param mtx_obs the observed data matrix
#' @param reps number of ABC samples to generate
#' @param n_sample hyperparameters that are used to generate data: number of samples per source
#' @param m_sample hyperparameters that are used to generate data: number of sources
#' @param alpha_0 hyperparameters that are used to generate data
#' @param beta_0 hyperparameters that are used to generate data
#' @param nu_0 hyperparameters that are used to generate data
#' @param p_norm exponent of the L^p norm (can be `Inf`) (default: 2)
#' @export
#' @return a reps*2 matrix of distances between summary statistics
#' @inheritParams get_number_summary_statistics
#' @family ABC functions
sample_ABC_rdirdirgamma_beta_cpp <- function(n_sample, m_sample, alpha_0, beta_0, nu_0, mtx_obs, reps, p_norm = 2, use_optimized_summary = FALSE) {
    .Call('_rdirdirgamma_sample_ABC_rdirdirgamma_beta_cpp', PACKAGE = 'rdirdirgamma', n_sample, m_sample, alpha_0, beta_0, nu_0, mtx_obs, reps, p_norm, use_optimized_summary)
}

#' Generate data that is accepted by ABC.
#'
#' @param summarize_eps ABC thresholds: as many as summary statistics
#' @param reps how many datasets are returned
#' @param max_iter how many iterations are tried
#' @return a (n x n_obs x p) array of generated data
#' @export
#' @inheritParams sample_ABC_rdirdirgamma_beta_cpp
#' @inheritParams get_number_summary_statistics
#' @family ABC functions
generate_acceptable_data_cpp <- function(n_sample, m_sample, alpha_0, beta_0, nu_0, mtx_obs, summarize_eps, reps, max_iter, p_norm, use_optimized_summary) {
    .Call('_rdirdirgamma_generate_acceptable_data_cpp', PACKAGE = 'rdirdirgamma', n_sample, m_sample, alpha_0, beta_0, nu_0, mtx_obs, summarize_eps, reps, max_iter, p_norm, use_optimized_summary)
}

#' Perform ABC sampling using the stick breaking procedure, returning the acceptance ratio.
#'
#' Perform ABC sampling using the stick breaking procedure, returning the acceptance ratio.
#' Similar to [sample_ABC_rdirdirgamma_beta_cpp()] but also performs the acceptance step.
#'
#' @param return_distances if TRUE, also return distances for all samples
#' @return a list with components:
#'   - `n_accepted`: number of accepted samples
#'   - `accept_ratio`: the acceptance ratio, where 1 means that all max_iter samples were accepted.
#'   - `d_ABC`: a (max_iter x n_summary) matrix of distances (if `return_distances` is TRUE)
#'
#' @export
#' @inheritParams sample_ABC_rdirdirgamma_beta_cpp
#' @inheritParams generate_acceptable_data_cpp
#' @inheritParams get_number_summary_statistics
#' @family ABC functions
compute_ABC_cpp <- function(n_sample, m_sample, alpha_0, beta_0, nu_0, mtx_obs, summarize_eps, reps, p_norm, use_optimized_summary, return_distances = FALSE) {
    .Call('_rdirdirgamma_compute_ABC_cpp', PACKAGE = 'rdirdirgamma', n_sample, m_sample, alpha_0, beta_0, nu_0, mtx_obs, summarize_eps, reps, p_norm, use_optimized_summary, return_distances)
}

#' Compute distances between summary statistics.
#'
#' @param mtx_gen the generated data matrix; number of rows is free, it must have the same number of columns as `mtx_obs`
#' @param mtx_obs the observed data matrix; number of rows is free, it must have the same number of columns as `mtx_gen`
#' @param p_norm exponent of the L^p norm (can be `Inf`) (default: 2)
#' @param use_optimized_summary if TRUE, use quantile matrix, else compute mean and sd vectors
#' @export
#' @return a vector of distances between summary statistics: as many entries as summary statistics
#' @family ABC functions
compute_distances_gen_obs_cpp <- function(mtx_gen, mtx_obs, p_norm = 2, use_optimized_summary = FALSE) {
    .Call('_rdirdirgamma_compute_distances_gen_obs_cpp', PACKAGE = 'rdirdirgamma', mtx_gen, mtx_obs, p_norm, use_optimized_summary)
}

#' Get the number of multivariate summary statistics.
#'
#' @param use_optimized_summary if TRUE, return the optimized summary statistics (mean, sd, kurtosis, skewness), else standard (mean, sd)
#' @export
#' @return an integer
#' @family ABC summary functions
get_number_summary_statistics <- function(use_optimized_summary) {
    .Call('_rdirdirgamma_get_number_summary_statistics', PACKAGE = 'rdirdirgamma', use_optimized_summary)
}

#' Compute optimized summary statistics.
#'
#' Compute optimized summary statistics:
#'
#' - column-wise mean
#' - column-wise standard deviation
#' - column-wise kurtosis
#' - column-wise skewess
#'
#' @export
#' @return a kxp matrix of summary statistics
#' @inheritParams get_summary_statistics_cpp
#' @inheritParams get_number_summary_statistics
#' @family ABC summary functions
get_optimized_summary_statistics_cpp <- function(mtx) {
    .Call('_rdirdirgamma_get_optimized_summary_statistics_cpp', PACKAGE = 'rdirdirgamma', mtx)
}

#' Compute standard summary statistics.
#'
#' Compute standard summary statistics:
#'
#' - column-wise mean
#' - column-wise standard deviation
#'
#' @export
#' @return a kxp matrix of summary statistics
#' @inheritParams get_summary_statistics_cpp
#' @inheritParams get_number_summary_statistics
#' @family ABC summary functions
get_standard_summary_statistics_cpp <- function(mtx) {
    .Call('_rdirdirgamma_get_standard_summary_statistics_cpp', PACKAGE = 'rdirdirgamma', mtx)
}

#' Compute summary statistics.
#'
#' @param mtx a data matrix (nxp)
#' @inheritParams get_number_summary_statistics
#' @export
#' @return a kxp matrix of summary statistics
#' @family ABC summary functions
get_summary_statistics_cpp <- function(mtx, use_optimized_summary) {
    .Call('_rdirdirgamma_get_summary_statistics_cpp', PACKAGE = 'rdirdirgamma', mtx, use_optimized_summary)
}

#' Generate one sample from a Dirichlet distribution.
#'
#' ## RNG
#'
#' this function uses GSL's RNG seed, unaffected by R's RNG.
#'
#' @param alpha the Dirichlet hyperparameter
#' @param seed the RNG seed: if 0 (default), generate a time-based seed
#' @return a numeric vector
#' @export
#' @family RNG functions
rdirichlet_cpp <- function(alpha, seed = 0L) {
    .Call('_rdirdirgamma_rdirichlet_cpp', PACKAGE = 'rdirdirgamma', alpha, seed)
}

#' Generate from a Dirichlet distribution using the stick breaking definition (safer).
#'
#' ## RNG
#'
#' this function uses R's RNG seed.
#'
#' @param n how many samples to generate
#' @param alpha the Dirichlet hyperparameter, with p entries
#' @return a numeric matrix, n*p
#' @export
#' @family RNG functions
rdirichlet_beta_cpp <- function(n, alpha) {
    .Call('_rdirdirgamma_rdirichlet_beta_cpp', PACKAGE = 'rdirdirgamma', n, alpha)
}

#' Generate a Dirichlet-Dirichlet-Gamma population (unsafe).
#'
#' Generate samples from m sources and p parameters, n sample per source.
#' The between-source alpha hyperparameter used to generate the source parameters is mandatory.
#'
#' ## RNG
#'
#' this function uses GSL's RNG seed, unaffected by R's RNG.
#'
#' @param n number of samples per source
#' @param m number of sources
#' @param alpha_0 between-source Gamma hyperparameter, a scalar
#' @param beta_0 between-source Gamma hyperparameter, a scalar
#' @param nu_0 between-source Dirichlet hyperparameter, a numeric vector
#' @export
#' @return a matrix with n*m rows
#' @inheritParams rdirichlet_cpp
#' @family RNG functions
rdirdirgamma_cpp <- function(n, m, alpha_0, beta_0, nu_0, seed = 0L) {
    .Call('_rdirdirgamma_rdirdirgamma_cpp', PACKAGE = 'rdirdirgamma', n, m, alpha_0, beta_0, nu_0, seed)
}

#' Generate a Dirichlet-Dirichlet-Gamma population (safer).
#'
#' Generate samples from m sources and p parameters, n sample per source.
#' The between-source alpha hyperparameter used to generate the source parameters is mandatory.
#'
#' ## RNG
#'
#' this function uses R's RNG seed.
#'
#' @export
#' @return a matrix with n*m rows
#' @inheritParams rdirdirgamma_cpp
#' @family RNG functions
rdirdirgamma_beta_cpp <- function(n, m, alpha_0, beta_0, nu_0) {
    .Call('_rdirdirgamma_rdirdirgamma_beta_cpp', PACKAGE = 'rdirdirgamma', n, m, alpha_0, beta_0, nu_0)
}

#' Compute column-wise sd
#'
#' @param mtx a nxp matrix
#' @return a 1xp vector
#' @family column-wise and utilities
colsd <- function(mtx) {
    .Call('_rdirdirgamma_colsd', PACKAGE = 'rdirdirgamma', mtx)
}

#' Compute column-wise kurtosis
#'
#' @param mtx a nxp matrix
#' @return a 1xp vector
#' @family column-wise and utilities
colkurtosis <- function(mtx) {
    .Call('_rdirdirgamma_colkurtosis', PACKAGE = 'rdirdirgamma', mtx)
}

#' Compute column-wise skewness
#'
#' @param mtx a nxp matrix
#' @return a 1xp vector
#' @family column-wise and utilities
colskewness <- function(mtx) {
    .Call('_rdirdirgamma_colskewness', PACKAGE = 'rdirdirgamma', mtx)
}

#' Compute the Minkowski norm of a vector
#'
#' Compute the Minkowski norm of a vector.
#' $p$ can range from 1 to infinity.
#'
#' @param v a vector
#' @param p exponent of the Minkowski norm (from 1 to Inf)
#' @return a double
#' @family column-wise and utilities
norm_minkowski <- function(v, p = 2) {
    .Call('_rdirdirgamma_norm_minkowski', PACKAGE = 'rdirdirgamma', v, p)
}