R/RcppExports.R

Defines functions sur_sample_cpp sur_sample_cov_helper_cpp sur_sample_gibbs_cpp sample_sigma predict_surbayes_cpp predict_surbayes_helper fastKronEye_crossprod fastKronEye_Y

Documented in fastKronEye_crossprod fastKronEye_Y predict_surbayes_cpp predict_surbayes_helper sample_sigma sur_sample_cov_helper_cpp sur_sample_cpp sur_sample_gibbs_cpp

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

#' Fast kronecker product with response vector
#' 
#' This is a c++ implementation of the fast kronecker product with response vector
#'
#' @param Sigma covariance matrix
#' @param Y matrix of response variables (Y1, ..., YJ)
#' @param n number of observations
#' @param J number of endpoints
#' @return Returns a vector with result of \code{ kron(Sigma, diag(n)) \% y }
#' @keywords internal
fastKronEye_Y <- function(Sigma, Y, n, J) {
    .Call('_surbayes_fastKronEye_Y', PACKAGE = 'surbayes', Sigma, Y, n, J)
}

#' Fast kronecker product of crossproduct matrix
#' 
#' This is a c++ implementation of the fast kronecker product
#' t(X) %*% kron(Sigma, I) %*% X. It avoids computing the kronecker product
#'
#' @param XtX a matrix that is crossprod((X1, ..., XJ)) in R
#' @param Sigma JxJ covariance matrix
#' @param pvec J-dimensional vector giving number of observations for each endpoint
#' @param n number of observations
#' @param J number of endpoints
#' @keywords internal
#' @return \code{matrix} result of \eqn{X' (\Sigma \otimes I_n) X}
fastKronEye_crossprod <- function(XtX, Sigma, pvec, n, J) {
    .Call('_surbayes_fastKronEye_crossprod', PACKAGE = 'surbayes', XtX, Sigma, pvec, n, J)
}

#' Get one sample from predictive posterior of SUR
#' 
#' C++ implementation to obtain one sample from predictive posterior
#' density
#'
#' @param mu vector of means
#' @param Sigma covariance matrix shared among all observations
#' @param n number of observations
#' @param J number of endpoints
predict_surbayes_helper <- function(mu, Sigma, n, J) {
    .Call('_surbayes_predict_surbayes_helper', PACKAGE = 'surbayes', mu, Sigma, n, J)
}

#' Sample from predictive posterior density C++ helper
#' 
#' C++ implementation to obtain a matrix of samples from predictive posterior density
#'
#' @param Mu matrix of means
#' @param Sigmalist list of covariance matrices
#' @param n number of observations
#' @param J number of endpoints
#' @param nsims Number of simulations (number of rows in Mu)
predict_surbayes_cpp <- function(Mu, Sigmalist, n, J, nsims) {
    .Call('_surbayes_predict_surbayes_cpp', PACKAGE = 'surbayes', Mu, Sigmalist, n, J, nsims)
}

#' Sample Sigma via Gibbs for SUR model
#' 
#' This is a c++ implementation of sampling Sigma via Gibbs in SUR model--inverse Wishart
#'
#' @param nu degrees of freedom
#' @param V scale matrix
#' @param p dimension of covariance matrix
#' @return sampled covariance matrix
sample_sigma <- function(nu, V, p) {
    .Call('_surbayes_sample_sigma', PACKAGE = 'surbayes', nu, V, p)
}

#' Power Prior Gibbs sampling
#' 
#' This is a c++ implementation of Gibbs sampling SUR model with power prior
#'
#' @param Sigma initial value for covariance matrix
#' @param M number of samples
#' @param X design matrix for current data
#' @param X0 design matrix for historical data
#' @param XtX matrix that is \code{crossprod(cbind(X1, ..., XJ))}
#' @param X0tX0 matrix that is \code{crossprod(cbind(X01, ..., X0J))}
#' @param Y future response as matrix (Y1, ..., YJ)
#' @param Y0 historical response as matrix (Y01, ..., Y0J)
#' @param y future response as vector
#' @param y0 historical response as vector
#' @param a0 power prior parameter
#' @param pvec \code{vector} giving number of covariates per endpoint
#' @param burnin Burn-in parameter
#' @param thin Thin parameter
#' @return sampled covariance matrix
sur_sample_gibbs_cpp <- function(Sigma, M, X, X0, XtX, X0tX0, Y, Y0, y, y0, a0, pvec, burnin, thin) {
    .Call('_surbayes_sur_sample_gibbs_cpp', PACKAGE = 'surbayes', Sigma, M, X, X0, XtX, X0tX0, Y, Y0, y, y0, a0, pvec, burnin, thin)
}

#' Helper function to sample covariance
#' 
#' This function is called by \code{sur_sample_cov_cpp}.
#' It samples the covariance matrix of a SUR
#'
#' @param Y A \code{matrix}, each column a \code{vector} of responses
#' @param Xlist A \code{list}, each element a design \code{matrix}
#' @param n Integer giving number of observations
#' @param J Integer giving number of endpoints
#' @param pj A \code{vector} giving number of covariates per endpoint
#' @param sigma11 A scalar giving a draw for the (1,1) component of the covariance matrix
#' @param r1 A \code{vector} of residuals for the first endpoint's regression
sur_sample_cov_helper_cpp <- function(Y, Xlist, n, J, pj, sigma11, r1) {
    .Call('_surbayes_sur_sample_cov_helper_cpp', PACKAGE = 'surbayes', Y, Xlist, n, J, pj, sigma11, r1)
}

#' Sample from SUR via Direct Monte Carlo (C++ version)
#' 
#' C++ implementation of Zellner and Ando (2010) Direct Monte Carlo
#' method for sampling from the posterior of a Bayesian SUR
#'
#' @param Y \code{matrix} \eqn{(y_1, \ldots y_J)}
#' @param Xlist A \code{list}, each element a design \code{matrix}
#' @param y \code{vector} of responses
#' @param X design \code{matrix}
#' @param XtX \code{matrix} giving \code{crossprod(cbind(X1, ..., XJ))}
#' @param pj \code{vector} giving number of covariates per endpoint
#' @param M An integer giving the number of desired samples
sur_sample_cpp <- function(Y, Xlist, y, X, XtX, pj, M) {
    .Call('_surbayes_sur_sample_cpp', PACKAGE = 'surbayes', Y, Xlist, y, X, XtX, pj, M)
}

Try the surbayes package in your browser

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

surbayes documentation built on Aug. 26, 2020, 5:16 p.m.