R/RcppExports.R

In deruncie/MegaLMM: MegaLMM

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

rstdnorm_mat_f <- function(n, p) {
    .Call(`_MegaLMM_rstdnorm_mat_f`, n, p)
}

#' Draws samples from all ``fixed" coefficients (fixed and random) of a set of parallel linear regression models, conditional on the variance components.
#'
#' The model is either: \itemize{
#' \item y_i = X1_base*alpha1 + X1_list_[i]*alpha2 + X2*beta + e, e ~ N(0,1/Y_prec[i]*V)
#' \item y_i = X1_base*alpha1 + X1_list_[i]*alpha2 + X2*V_*beta + e, e ~ N(0,1/Y_prec[i]*V)
#' }
#' Where \code{V = RtR}, priors on elements of alpha1, alpha2 and beta are independent.
#' Each column of Y is considered independent
#'
#' @param which_sampler int: \itemize{
#'   \item 1: block sampler: b < n
#'   \item 2: block sampler: n >= b and X doesn't factorize
#'   \item 3: block sampler: n >= b, but X factorizes into UxVx where Ux is n x m and Vx = m x b, and m << n <= b
#' }
#' @param Y n x p matrix of observations
#' @param X1_base n x a1 matrix of X1 covariates common to all p. Can be NULL
#' @param X1_list_ p-list of n x a2 matrices of X1 covariates unique to each p. Can be NULL
#' @param X2 either X2, a n x b matrix, or Ux, a n x m matrix. If Ux, then V must be non-NULL
#' @param V_ m x b matrix if X2 is Ux, otherwise NULL
#' @param beta1_list_ p-list of a2-vectors for X1 coefficients. Can be NULL
#' @param beta2 a b x p matrix of current values for beta
#' @param h2s_index p-vector of indices for to select appropriate V of each trait
#' @param chol_V_list_ list of cholesky decompositions of V: RtR (each nxn). Can be either dense or sparse
#' @param Y_prec p-vector of Y current precisions
#' @param Y_prec_a0,Y_prec_b0 scalars giving the shape and rate of the Gamma distribution for the prior on Y_prec
#' @param prior_prec_alpha1 a1 x p matrix of prior precisions for alpha1
#' @param prior_prec_alpha2 p-vector of precision of alpha2s for each trait
#' @param prior_mean_beta b x p matrix of prior means of beta
#' @param prior_prec_beta b x p matrix of prior precisions of beta
#' @param beta2_alpha_ b x p matrix for BayesC priors for beta2. Can be NULL
#' @param beta2_delta_ b x p matrix for BayesC priors for beta2. Can be NULL,
#' @param beta2_p_i_ b x p matrix for BayesC priors for beta2. Can be NULL
#' @return List with elements: \itemize{
#'   \item alpha1 a1 x p matrix of alpha1
#'   \item alpha2 concatenated vector of alpha2 for all traits
#'   \item beta b x p matrix of beta
#'   \item Y_prec p x 1 vector of Y_prec
#'   \item beta2_alpha b x p matrix (optional)
#'   \item beta2_delta_ b x p matrix (optional)
#' }
SingleSite_regression_sampler_parallel <- function(Y, X1_base, X1_list_, X2_, Vx_, h2s_index, chol_V_list_, Y_prec, Y_prec_a0, Y_prec_b0, prior_prec_alpha1, prior_prec_alpha2, prior_mean_beta, prior_prec_beta, current_alpha1s_, current_alpha2s_, BayesAlphabet_parms) {
    .Call(`_MegaLMM_SingleSite_regression_sampler_parallel`, Y, X1_base, X1_list_, X2_, Vx_, h2s_index, chol_V_list_, Y_prec, Y_prec_a0, Y_prec_b0, prior_prec_alpha1, prior_prec_alpha2, prior_mean_beta, prior_prec_beta, current_alpha1s_, current_alpha2s_, BayesAlphabet_parms)
}

LDLt <- function(A_) {
    .Call(`_MegaLMM_LDLt`, A_)
}

make_chol_ZtZ_Kinv_list <- function(chol_Ki_mats_, h2s_matrix, ZtZ, drop0_tol, verbose, pb, setTxtProgressBar, getTxtProgressBar, ncores) {
    .Call(`_MegaLMM_make_chol_ZtZ_Kinv_list`, chol_Ki_mats_, h2s_matrix, ZtZ, drop0_tol, verbose, pb, setTxtProgressBar, getTxtProgressBar, ncores)
}

make_chol_V_list <- function(ZKZts_, h2s_matrix, drop0_tol, verbose, pb, setTxtProgressBar, getTxtProgressBar, ncores) {
    .Call(`_MegaLMM_make_chol_V_list`, ZKZts_, h2s_matrix, drop0_tol, verbose, pb, setTxtProgressBar, getTxtProgressBar, ncores)
}

record_sample_Posterior_array <- function(current_sample, Posterior_array_, sp_num) {
    invisible(.Call(`_MegaLMM_record_sample_Posterior_array`, current_sample, Posterior_array_, sp_num))
}

get_MegaLMM_nthreads <- function() {
    .Call(`_MegaLMM_get_MegaLMM_nthreads`)
}

set_MegaLMM_nthreads <- function(n_threads) {
    invisible(.Call(`_MegaLMM_set_MegaLMM_nthreads`, n_threads))
}

get_omp_nthreads <- function() {
    invisible(.Call(`_MegaLMM_get_omp_nthreads`))
}

set_omp_nthreads <- function(threads) {
    invisible(.Call(`_MegaLMM_set_omp_nthreads`, threads))
}

#' Multiplies two matrices (sparse or dense by dense), returns the product as a dense matrix
#'
#' @param X_ First matrix (matrix or dgCMatrix)
#' @param Y_ Second matrix (matrix)
#' @return Product of X_ and Y_ as a dense matrix
matrix_multiply_toDense <- function(X_, Y_) {
    .Call(`_MegaLMM_matrix_multiply_toDense`, X_, Y_)
}

#' Draws a matrix of standard normal variables
#' 
#' Uses the ziggr function of the RcppZiggurat package as the RNG 
#'
#' @param n number of rows of matrix
#' @param p number of columns of matrix
#' @return nxp matrix of independent std normal values
rstdnorm_mat <- function(n, p) {
    .Call(`_MegaLMM_rstdnorm_mat`, n, p)
}

#' Finds the set of variance component proportions within a specified distance from a starting proportion
#'
#' @param h2s_matrix Mxl matrix of all valid variance component proportions for M random effects
#' @param step_size value measuring the maximum euclidean distance to a new set of variance component proportions
#' @param old_state index in h2s_matrix of the current value of the variance component proportions
#' @return vector of indices of \code{h2s_matrix} giving new candidate variance component proportions
find_candidate_states <- function(h2s_matrix, step_size, old_state) {
    .Call(`_MegaLMM_find_candidate_states`, h2s_matrix, step_size, old_state)
}

#' Draws samples from all ``fixed" coefficients (fixed and random) of a set of parallel linear regression models, conditional on the variance components.
#'
#' The model is either: \itemize{
#' \item y_i = X1_base*alpha1 + X1_list_[i]*alpha2 + X2*beta + e, e ~ N(0,1/Y_prec[i]*V)
#' \item y_i = X1_base*alpha1 + X1_list_[i]*alpha2 + X2*V_*beta + e, e ~ N(0,1/Y_prec[i]*V)
#' }
#' Where \code{V = RtR}, priors on elements of alpha1, alpha2 and beta are independent.
#' Each column of Y is considered independent
#'
#' @param Y n x p matrix of observations
#' @param X1_base n x a1 matrix of X1 covariates common to all p. Can be NULL
#' @param X1_list_ p-list of n x a2 matrices of X1 covariates unique to each p. Can be NULL
#' @param X2 either X2, a n x b matrix, or Ux, a n x m matrix. If Ux, then V must be non-NULL
#' @param V_ m x b matrix if X2 is Ux, otherwise NULL
#' @param h2s_index p-vector of indices for to select appropriate V of each trait
#' @param chol_V_list_ list of cholesky decompositions of V: RtR (each nxn). Can be either dense or sparse
#' @param Y_prec p-vector of Y current precisions
#' @param Y_prec_a0,Y_prec_b0 scalars giving the shape and rate of the Gamma distribution for the prior on Y_prec
#' @param prior_prec_alpha1 a1 x p matrix of prior precisions for alpha1
#' @param prior_prec_alpha2 p-vector of precision of alpha2s for each trait
#' @param prior_mean_beta b x p matrix of prior means of beta
#' @param prior_prec_beta b x p matrix of prior precisions of beta
#' @return List with elements: \itemize{
#'   \item alpha1 a1 x p matrix of alpha1
#'   \item alpha2 concatenated vector of alpha2 for all traits
#'   \item beta b x p matrix of beta
#'   \item Y_prec p x 1 vector of Y_prec
#' }
regression_sampler_parallel <- function(Y, X1_base, X1_list_, X2, Vx_, h2s_index, chol_V_list_, Y_prec, Y_prec_a0, Y_prec_b0, prior_prec_alpha1, prior_prec_alpha2, prior_mean_beta, prior_prec_beta) {
    .Call(`_MegaLMM_regression_sampler_parallel`, Y, X1_base, X1_list_, X2, Vx_, h2s_index, chol_V_list_, Y_prec, Y_prec_a0, Y_prec_b0, prior_prec_alpha1, prior_prec_alpha2, prior_mean_beta, prior_prec_beta)
}

sample_MME_ZKZts_c <- function(Y, Z_, tot_Eta_prec, chol_ZtZ_Kinv_list_, h2s, h2s_index) {
    .Call(`_MegaLMM_sample_MME_ZKZts_c`, Y, Z_, tot_Eta_prec, chol_ZtZ_Kinv_list_, h2s, h2s_index)
}

log_p_h2s <- function(Y, tot_Eta_prec, chol_V_list_, discrete_priors) {
    .Call(`_MegaLMM_log_p_h2s`, Y, tot_Eta_prec, chol_V_list_, discrete_priors)
}

sample_h2s <- function(log_ps) {
    .Call(`_MegaLMM_sample_h2s`, log_ps)
}

sample_h2s_discrete_MH_c <- function(Y, tot_Eta_prec, discrete_priors, h2_index, h2s_matrix, chol_V_list_, step_size) {
    .Call(`_MegaLMM_sample_h2s_discrete_MH_c`, Y, tot_Eta_prec, discrete_priors, h2_index, h2s_matrix, chol_V_list_, step_size)
}

sample_factors_scores_c <- function(Eta_tilde, prior_mean, Lambda, resid_Eta_prec, F_e_prec) {
    .Call(`_MegaLMM_sample_factors_scores_c`, Eta_tilde, prior_mean, Lambda, resid_Eta_prec, F_e_prec)
}

sample_tau2_delta_c_Eigen_v2 <- function(tau2, xi, delta, scores, tau_0, delta_shape, delta_scale, p, times) {
    .Call(`_MegaLMM_sample_tau2_delta_c_Eigen_v2`, tau2, xi, delta, scores, tau_0, delta_shape, delta_scale, p, times)
}

sample_trunc_delta_c_Eigen <- function(delta, tauh, scores, shapes, delta_1_rate, delta_2_rate, randu_draws, trunc_point) {
    .Call(`_MegaLMM_sample_trunc_delta_c_Eigen`, delta, tauh, scores, shapes, delta_1_rate, delta_2_rate, randu_draws, trunc_point)
}

sample_MME_single_diagK <- function(y, X, prior_mean, prior_prec, chol_R, tot_Eta_prec, randn_theta, randn_e) {
    .Call(`_MegaLMM_sample_MME_single_diagK`, y, X, prior_mean, prior_prec, chol_R, tot_Eta_prec, randn_theta, randn_e)
}

sample_coefs_set_c <- function(model_matrices, prior_mean, prior_prec) {
    .Call(`_MegaLMM_sample_coefs_set_c`, model_matrices, prior_mean, prior_prec)
}

get_fitted_set_c <- function(model_matrices, coefs) {
    .Call(`_MegaLMM_get_fitted_set_c`, model_matrices, coefs)
}

parallel_block_regression_sampler <- function(Y, X1, X2, V_, chol_V_, Y_prec, Y_prec_a0, Y_prec_b0, prior_prec_alpha, prior_mean_beta, prior_prec_beta) {
    .Call(`_MegaLMM_parallel_block_regression_sampler`, Y, X1, X2, V_, chol_V_, Y_prec, Y_prec_a0, Y_prec_b0, prior_prec_alpha, prior_mean_beta, prior_prec_beta)
}

parallel_Single_regression_sampler <- function(Y_, X1_, X2_, V_, chol_V_, Y_prec, Y_prec_a0, Y_prec_b0, prior_prec_alpha, prior_mean_beta, prior_prec_beta, current_alphas, betas_alpha, betas_beta, betas_pi, betas_delta, run_sampler_times) {
    .Call(`_MegaLMM_parallel_Single_regression_sampler`, Y_, X1_, X2_, V_, chol_V_, Y_prec, Y_prec_a0, Y_prec_b0, prior_prec_alpha, prior_mean_beta, prior_prec_beta, current_alphas, betas_alpha, betas_beta, betas_pi, betas_delta, run_sampler_times)
}

cbind_list_withName <- function(combined, list, variable) {
    invisible(.Call(`_MegaLMM_cbind_list_withName`, combined, list, variable))
}