R/RcppExports.R

Defines functions colmeanNA sample_index mvrnormArma dmvnrm_arma em_with_zero_mean_c rinvwish_c get_target_c update_Sigma_c update_gamma_random_c betagam_accept_random_c update_betagam_random_c get_sigmabeta_from_h_c get_h_from_sigmabeta_c update_h_c mmvbvs

Documented in mmvbvs

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

colmeanNA <- function(Y) {
    .Call('_MMVBVS_colmeanNA', PACKAGE = 'MMVBVS', Y)
}

sample_index <- function(size, prob = as.numeric( c())) {
    .Call('_MMVBVS_sample_index', PACKAGE = 'MMVBVS', size, prob)
}

mvrnormArma <- function(n, mu, Sigma) {
    .Call('_MMVBVS_mvrnormArma', PACKAGE = 'MMVBVS', n, mu, Sigma)
}

dmvnrm_arma <- function(x, mean, sigma, logd = FALSE) {
    .Call('_MMVBVS_dmvnrm_arma', PACKAGE = 'MMVBVS', x, mean, sigma, logd)
}

em_with_zero_mean_c <- function(y, maxit) {
    .Call('_MMVBVS_em_with_zero_mean_c', PACKAGE = 'MMVBVS', y, maxit)
}

rinvwish_c <- function(n, v, S) {
    .Call('_MMVBVS_rinvwish_c', PACKAGE = 'MMVBVS', n, v, S)
}

get_target_c <- function(X, Y, sigmabeta, Sigma, gam, beta) {
    .Call('_MMVBVS_get_target_c', PACKAGE = 'MMVBVS', X, Y, sigmabeta, Sigma, gam, beta)
}

update_Sigma_c <- function(n, nu, X, beta, Phi, Y) {
    .Call('_MMVBVS_update_Sigma_c', PACKAGE = 'MMVBVS', n, nu, X, beta, Phi, Y)
}

update_gamma_random_c <- function(X, Y, gam) {
    .Call('_MMVBVS_update_gamma_random_c', PACKAGE = 'MMVBVS', X, Y, gam)
}

betagam_accept_random_c <- function(X, Y, sigmabeta1, inputSigma, Vbeta, gam1, beta1, gam2, beta2, changeind, change) {
    .Call('_MMVBVS_betagam_accept_random_c', PACKAGE = 'MMVBVS', X, Y, sigmabeta1, inputSigma, Vbeta, gam1, beta1, gam2, beta2, changeind, change)
}

update_betagam_random_c <- function(X, Y, gam1, beta1, Sigma, sigmabeta, Vbeta, bgiter, smallchange) {
    .Call('_MMVBVS_update_betagam_random_c', PACKAGE = 'MMVBVS', X, Y, gam1, beta1, Sigma, sigmabeta, Vbeta, bgiter, smallchange)
}

get_sigmabeta_from_h_c <- function(h, gam, Sigma, X, T) {
    .Call('_MMVBVS_get_sigmabeta_from_h_c', PACKAGE = 'MMVBVS', h, gam, Sigma, X, T)
}

get_h_from_sigmabeta_c <- function(X, sigmabeta, Sigma, gam, n, T) {
    .Call('_MMVBVS_get_h_from_sigmabeta_c', PACKAGE = 'MMVBVS', X, sigmabeta, Sigma, gam, n, T)
}

update_h_c <- function(initialh, hiter, gam, beta, Sig, X, T) {
    .Call('_MMVBVS_update_h_c', PACKAGE = 'MMVBVS', initialh, hiter, gam, beta, Sig, X, T)
}

#' Main function for variable selection
#' @param X covariate with length N, sample size
#' @param Y multivariate normal response variable N by P
#' @param initial_chain list of starting points for beta, gamma, sigma, and sigmabeta. beta is length P for the coefficients, gamma is length P inclusion vector where each element is 0 or 1. sigma should be P x P covariance matrix, and sigmabeta should be the expected variance of the betas.
#' @param Phi prior for the covariance matrix. We suggest identity matrix if there is no appropriate prior information
#' @param marcor length P vector of correlation between X and each variable of Y
#' @param niter total number of iteration for MCMC
#' @param bgiter number of MH iterations within one iteration of MCMC to fit Beta and Gamma
#' @param burnin number of MH iterations for h, proportion of variance explained
#' @param hiter number of first iterations to ignore
#' @param Vbeta variance of beta
#' @param smallchange perturbation size for MH algorithm
#' @param verbose if set TRUE, print gamma for each iteration
#' @return list of posterior beta, gamma, and covariance matrix sigma
#' @examples
#' beta = c(rep(0.5, 3), rep(0,3))
#' n = 200; T = length(beta); nu = T+5
#' Sigma = matrix(0.8, T, T); diag(Sigma) = 1
#' X = as.numeric(scale(rnorm(n)))
#' error = MASS::mvrnorm(n, rep(0,T), Sigma)
#' gamma = c(rep(1,3), rep(0,3))
#' Y = X %*% t(beta) + error; Y = scale(Y)
#' Phi = matrix(0.5, T, T); diag(Phi) = 1
#' initial_chain = list(beta = rep(0,T),
#'                      gamma = rep(0,T),
#'                      Sigma = Phi,
#'                      sigmabeta = 1)
#' result = mmvbvs(X = X,
#'                 Y = Y,
#'                 initial_chain = initial_chain,
#'                 Phi = Phi,
#'                 marcor = colMeans(X*Y, na.rm=TRUE),
#'                 niter=10,
#'                 verbose = FALSE)
#' @export
mmvbvs <- function(X, Y, initial_chain, Phi, marcor, niter = 1000L, bgiter = 500L, hiter = 50L, burnin = 100000L, Vbeta = 1L, smallchange = 1e-4, verbose = TRUE) {
    .Call('_MMVBVS_mmvbvs', PACKAGE = 'MMVBVS', X, Y, initial_chain, Phi, marcor, niter, bgiter, hiter, burnin, Vbeta, smallchange, verbose)
}

Try the MMVBVS package in your browser

Any scripts or data that you put into this service are public.

MMVBVS documentation built on Dec. 16, 2019, 1:33 a.m.