R/RcppExports.R

In rchan26/exp4FusionRCPP: Hierarchical and Sequential Monte Carlo Fusion for exp(-(x^4)/2)

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

#' phi-function for exp(-(((x-mean)^4)*beta)/2)
#'
#' phi-function for the Exact Algorithm for exp(-(((x-mean)^4)*beta)/2)
#'
#' @param x real value
#' @param mean mean value
#' @param beta real value
#'
#' @return real value
#'
#' @examples
#' curve(phi_exp_4(x, 0, 1), from = -4, to = 4)
#'
#' @export
phi_exp_4 <- function(x, mean, beta) {
    .Call(`_exp4FusionRCPP_phi_exp_4`, x, mean, beta)
}

#' Obtain bounds for phi function
#'
#' Finds the lower and upper bounds of the phi function between an interval
#'
#' @param beta real value
#' @param mean mean value
#' @param lower lower end of interval
#' @param upper upper end of interval
#'
#' @return vector of lower and upper bound of phi-function between [lower, upper]
#'
#' @examples
#' bound_phi_exp_4(mean = 1/2, beta = 1, interval = c(-2, -1))
#'
#' @export
bound_phi_exp_4 <- function(mean, beta, lower, upper) {
    .Call(`_exp4FusionRCPP_bound_phi_exp_4`, mean, beta, lower, upper)
}

#' Diffusion probability for the Exact Algorithm for langevin diffusion with pi = exp(-(beta*(x-mean)^4)/2)
#'
#' Simulate langevin diffusion using the Exact Algorithm with pi = exp(-(beta*(x-mean)^4)/2)
#'
#' @param x0 start value
#' @param y end value
#' @param s start time
#' @param t end time
#' @param K lower bound of the phi function
#' @param mean mean value
#' @param beta real value
#'
#' @return acceptance probability of simulating langevin diffusion with pi = exp(-(beta*(x-mean)^4)/2)
#'
#' @examples
#' lower_bound <- optimise(function(x) phi_function_exp_4(x, beta = 1/2), interval = c(0, 100), maximum = FALSE)$objective
#' test <- diffusion_probability_exp_4x0 = 0, y = 0.3, s = 0, t = 1, K = lower_bound, beta = 1/2)
#'
#' @export
diffusion_probability_exp_4 <- function(x0, y, s, t, K, mean, beta) {
    .Call(`_exp4FusionRCPP_diffusion_probability_exp_4`, x0, y, s, t, K, mean, beta)
}

#' Exact Algorithm for langevin diffusion with pi = exp(-(beta*(x-mean)^4)/2)
#'
#' Simulate langevin diffusion using the Exact Algorithm with pi = exp(-(beta*(x-mean)^4)/2)
#'
#' @param x0 start value
#' @param y end value
#' @param s start time
#' @param t end time
#' @param K lower bound of the phi function
#' @param mean mean value
#' @param beta real value
#'
#' @return matrix holding skeleton of the langevin diffusion with pi = exp(-(beta*(x-mean)^4)/2)
#'
#' @examples
#' lower_bound <- optimise(function(x) phi_function_exp_4(x, beta = 1/2), interval = c(0, 100), maximum = FALSE)$objective
#' test <- exact_algorithm_exp_4(x0 = 0, y = 0.3, s = 0, t = 1, K = lower_bound, beta = 1/2)
#' plot(x = test['time',], y = test['X',], type = 'l')
#'
#' @export
exact_algorithm_exp_4 <- function(x0, y, s, t, K, mean, beta) {
    .Call(`_exp4FusionRCPP_exact_algorithm_exp_4`, x0, y, s, t, K, mean, beta)
}

#' Standard Fusion
#'
#' Monte Carlo Fusion for sub-posteriors of the form exp(-((x^4)*beta)/2)
#'
#' @param N number of samples
#' @param mean mean value
#' @param time time T for fusion algorithm
#' @param C number of sub-posteriors to combine
#' @param samples_to_fuse list of length C, where samples_to_fuse[c] containg the samples for the c-th sub-posterior
#' @param betas vector of length C, where betas[c] is the beta for c-th sub-posterior
#'
#' @return samples: fusion samples
#' @return iters_rho: number of iterations from the first accept/reject step (rho)
#' @return iters_Q: number of iterations from the second (diffusion) accept/reject step (Q)
#' @return time: run-time of fusion sampler
#'
#' @examples
#' input_samples <- base_rejection_sampler_exp_4(beta = 1/2, nsamples = 100000, proposal_mean = 0, proposal_sd = 1, dominating_M = 1.3)
#' test1_standard <- fusion_diff_exp_4(N = 10000, time = 1, C = 2, samples_to_fuse = input_samples, betas = rep(1/2, 2))
#'
#' @export
fusion_diff_exp_4_rcpp <- function(N, mean, time, C, samples_to_fuse, betas) {
    .Call(`_exp4FusionRCPP_fusion_diff_exp_4_rcpp`, N, mean, time, C, samples_to_fuse, betas)
}

#' Time-adapting Fusion
#'
#' Time-adapting Monte Carlo Fusion for sub-posteriors of the form exp(-((x^4)*beta)/2)
#'
#' @param N number of samples
#' @param mean mean value
#' @param time time T for time-adapting fusion algorithm
#' @param C number of sub-posteriors to combine
#' @param samples_to_fuse list of length C, where samples_to_fuse[c] containg the samples for the c-th sub-posterior
#' @param betas vector of length C, where betas[c] is the beta for c-th sub-posterior
#'
#' @return samples: fusion samples
#' @return iters_rho: number of iterations from the first accept/reject step (rho)
#' @return iters_Q: number of iterations from the second (diffusion) accept/reject step (Q)
#' @return time: run-time of fusion sampler
#'
#' @examples
#' input_samples <- base_rejection_sampler_exp_4(beta = 1/2, nsamples = 100000, proposal_mean = 0, proposal_sd = 1, dominating_M = 1.3)
#' test1_standard <- fusion_TA_exp_4(N = 10000, time = 1, C = 2, samples_to_fuse = input_samples, betas = rep(1/2, 2))
#'
#' @export
fusion_TA_exp_4_rcpp <- function(N, mean, time, C, samples_to_fuse, betas) {
    .Call(`_exp4FusionRCPP_fusion_TA_exp_4_rcpp`, N, mean, time, C, samples_to_fuse, betas)
}