R/RcppExports.R

In bayescopulareg: Bayesian Copula Regression

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

#' CDF of GLM
#' 
#' This function computes the CDF for each observation y in a GLM
#' 
#' @name cdf_cpp
#' @param y response \code{vector}
#' @param X design \code{matrix}
#' @param beta regression coefficient \code{vector}
#' @param phi Dispersion parameter. Ignored for binomial and Poisson models
#' @param linkname string giving name of link function. Must be one of \code{ c( "logit", "probit", "cauchit", "cloglog", "identity", "log", "sqrt", "1/mu^2", "inverse" ) }
#' @param distname name of distribution as a string. Must be one of \code{ c ( "gaussian", "gamma", "poisson", "binomial" ) ) }
#' @param n number of observations
#' 
#' @return vector applying CDF to \eqn{ y \mid X, \beta, \phi }
#' @keywords internal
#' @noRd
cdf_cpp <- function(y, X, beta, phi, distname, linkname, n) {
    .Call('_bayescopulareg_cdf_cpp', PACKAGE = 'bayescopulareg', y, X, beta, phi, distname, linkname, n)
}

free_to_chol_cpp <- function(y) {
    .Call('_bayescopulareg_free_to_chol_cpp', PACKAGE = 'bayescopulareg', y)
}

chol_to_free_cpp <- function(X) {
    .Call('_bayescopulareg_chol_to_free_cpp', PACKAGE = 'bayescopulareg', X)
}

#' Convert to Normal
#' 
#' This function computes \eqn{h_{ij}^{-1}(y_{ij}) = \Phi^{-1}(F_{ij}(y_{ij} | \beta_j, \phi_j))}
#' 
#' @name conv_to_normal
#' @param y response \code{vector}
#' @param X design \code{matrix}
#' @param beta regression coefficient \code{vector}
#' @param phi Dispersion parameter. Ignored for binomial and Poisson models
#' @param linkname string giving name of link function. Must be one of \code{ c( "logit", "probit", "cauchit", "cloglog", "identity", "log", "sqrt", "1/mu^2", "inverse" ) }
#' @param distname name of distribution as a string. Must be one of \code{ c ( "gaussian", "Gamma", "poisson", "binomial" ) ) }
#' @param n number of observations
#' 
#' @return vector of standard normal variables
#' @keywords internal
#' @noRd
conv_to_normal <- function(y, X, beta, phi, distname, linkname, n) {
    .Call('_bayescopulareg_conv_to_normal', PACKAGE = 'bayescopulareg', y, X, beta, phi, distname, linkname, n)
}

condnormal_cpp <- function(Z, Gamma, j) {
    .Call('_bayescopulareg_condnormal_cpp', PACKAGE = 'bayescopulareg', Z, Gamma, j)
}

#' Posterior predictive sample of copula GLM
#' 
#' Obtain a sample from the posterior predictive density of a copula GLM
#' 
#' @param Xlist a \code{list} of length \eqn{J}, each element is a design \code{matrix}
#' @param distnamevec a \code{character} vector of length \eqn{J} giving the name of the distribution of each endpoint
#' @param linknamevec a \code{character} vector of length \eqn{J} giving the name of the link function of each endpoint
#' @param Gamma a sampled correlation \code{matrix}
#' @param betasample a \eqn{J}-dimensional \code{list} of sampled regression coefficients
#' @param phisample a \code{vector} of sampled dispersion parameters
#' @param n sample size for future data
#' @param J number of endpoints
#' 
#' @return a \eqn{n \times J} matrix of samples from the predictive posterior density
#' @keywords internal
#' @noRd
copula_predict <- function(Xlist, distnamevec, linknamevec, Gamma, betasample, phisample, n, J) {
    .Call('_bayescopulareg_copula_predict', PACKAGE = 'bayescopulareg', Xlist, distnamevec, linknamevec, Gamma, betasample, phisample, n, J)
}

#' List of posterior predictive samples of copula GLM
#' 
#' Obtain a sample from the posterior predictive density of a copula GLM
#' 
#' @param Xlist a \code{J}-dimensional list of design matrices corresponding to new data
#' @param distnamevec a \code{character} vector of length \eqn{J} giving the name of the distribution of each endpoint
#' @param linknamevec a \code{character} vector of length \eqn{J} giving the name of the link function of each endpoint
#' @param betasamplelist a list of length \code{J}. Each element is a list of length \code{M} giving the posterior draws
#' @param phisamplemat a \eqn{M \times J} matrix of sampled dispersion parameters
#' @param Gammaarray a \eqn{J \times J \times M} array of sampled correlation matrices
#' @param n sample size for future data
#' @param J number of endpoints
#' @param M number of samples
#' 
#' @return \code{array} of dimension \code{c(n, J, nsims)} of predictive posterior draws. Each slice corresponds to 1 draw
#' @keywords internal
#' @noRd
copula_predict_all <- function(Xlist, distnamevec, linknamevec, betasamplelist, phisamplemat, Gammaarray, n, J, M) {
    .Call('_bayescopulareg_copula_predict_all', PACKAGE = 'bayescopulareg', Xlist, distnamevec, linknamevec, betasamplelist, phisamplemat, Gammaarray, n, J, M)
}

#' List of posterior predictive samples of copula GLM
#' 
#' Obtain a sample from the posterior predictive density of a copula GLM
#' 
#' @param Xlistlist a \code{M}-dimensional \code{list} of lists. The inner list is a list of design matrices of length \code{J}
#' @param distnamevec a \code{character} vector of length \eqn{J} giving the name of the distribution of each endpoint
#' @param linknamevec a \code{character} vector of length \eqn{J} giving the name of the link function of each endpoint
#' @param betasamplelist a list of length \code{M}. Each element is a list of length \code{J} giving the design matrix for each endpoint
#' @param phisamplemat a \eqn{M \times J} matrix of sampled dispersion parameters
#' @param Gammaarray a \eqn{J \times J \times M} array of sampled correlation matrices
#' @param n sample size for future data
#' @param J number of endpoints
#' @param M number of samples
#' 
#' @return a \eqn{n \times J} matrix of samples from the predictive posterior density
#' @keywords internal
#' @noRd
copula_predict_all_list <- function(Xlistlist, distnamevec, linknamevec, betasamplelist, phisamplemat, Gammaarray, n, J, M) {
    .Call('_bayescopulareg_copula_predict_all_list', PACKAGE = 'bayescopulareg', Xlistlist, distnamevec, linknamevec, betasamplelist, phisamplemat, Gammaarray, n, J, M)
}

#' Inverse CDF of GLM
#'
#' This function computes the Inverse CDF for each observation y in a GLM
#'
#' @param u a \code{vector} consisting of values between 0 and 1
#' @param X design \code{matrix}
#' @param beta regression coefficient \code{vector}
#' @param phi Dispersion parameter. Ignored for binomial and Poisson models
#' @param linkname string giving name of link function. Must be one of \code{ c( "logit", "probit", "cauchit", "cloglog", "identity", "log", "sqrt", "1/mu^2", "inverse" ) }
#' @param distname name of distribution as a string. Must be one of \code{ c ( "gaussian", "gamma", "poisson", "binomial" ) ) }
#' @param n number of observations
#'
#' @return vector applying CDF to \eqn{ y \mid X, \beta, \phi }
#' @keywords internal
#' @noRd
invcdf_cpp <- function(u, X, beta, phi, distname, linkname, n) {
    .Call('_bayescopulareg_invcdf_cpp', PACKAGE = 'bayescopulareg', u, X, beta, phi, distname, linkname, n)
}

#' Sample GLM copula response variable
#'
#' This function computes the response variable y from a copula GLM given Z, a sample from N(0, Gamma)
#'
#' @param z \code{vector} of \eqn{N(0, 1)} samples from \eqn{Z \sim N(0, \Gamma)}
#' @param X design \code{matrix}
#' @param beta regression coefficient \code{vector}
#' @param phi Dispersion parameter. Ignored for binomial and Poisson models
#' @param linkname string giving name of link function. Must be one of \code{ c( "logit", "probit", "cauchit", "cloglog", "identity", "log", "sqrt", "1/mu^2", "inverse" ) }
#' @param distname name of distribution as a string. Must be one of \code{ c ( "gaussian", "gamma", "poisson", "binomial" ) ) }
#' @param n number of observations
#'
#' @return \code{vector} applying inverse CDF
#' @keywords internal
#' @noRd
sample_y <- function(z, X, beta, phi, distname, linkname, n) {
    .Call('_bayescopulareg_sample_y', PACKAGE = 'bayescopulareg', z, X, beta, phi, distname, linkname, n)
}

#' Expit
#' 
#' Inverse logit link function
#' 
#' @param eta \code{vector} of linear predictors
#' @return \code{vector} giving \eqn{e^{eta} / (1 + e^{eta})}
NULL

#' Inverse probit
#' 
#' Inverse probit link function
#' 
#' @param eta \code{vector} of linear predictors
#' @return \code{vector} giving \eqn{\Phi^{-1}(\eta)}
NULL

#' Inverse probit
#' 
#' Inverse probit link function
#' 
#' @param eta \code{vector} of linear predictors
#' @return \code{vector} giving \eqn{F^{-1}(eta)} where \eqn{F} is the CDF of a cauchy random variable
NULL

#' Inverse complentary log-log
#' 
#' Inverse complentary log-log function
#' 
#' @param eta \code{vector} of linear predictors
#' @return \code{vector} giving \eqn{1 - e^{-e^{eta}}}
NULL

#' Inverse identity link
#' 
#' Inverse identity link function
#' 
#' @param eta \code{vector} of linear predictors
#' @return \code{eta}
NULL

#' Inverse log link
#' 
#' Inverse log link function
#' 
#' @param eta \code{vector} of linear predictors
#' @return \code{vector} giving \eqn{\exp(eta)}
NULL

#' Inverse square root link
#' 
#' Inverse square root link function
#' 
#' @param eta \code{vector} of linear predictors
#' @return \code{vector} giving\eqn{ eta^2 }
NULL

#' Inverse 1/mu^2 link
#' 
#' Inverse link of 1/mu^2 link function
#' 
#' @param eta \code{vector} of linear predictors
#' @return \code{vector} giving \code{eta^(-0.5)}
NULL

#' Inverse link function for inverse link
#' 
#' Inverse link function for inverse link
#' 
#' @param eta \code{vector} of linear predictors
#' @return \code{vector} giving \code{eta^(-1)}
NULL

#' Inverse link
#' 
#' This function takes as input a linear predictor eta and the name of a link function,
#' and outputs the inverse link function applied to eta
#' 
#' @param eta \code{vector} of linear predictors
#' @param linkname string giving name of link function. Must be one of
#' \code{ c( "logit", "probit", "cauchit", "cloglog", "identity", "log", "sqrt", "1/mu^2", "inverse" ) }
#' 
#' 
#' @return \code{vector} applying inverse link function to \code{eta}
#' @keywords internal
#' @noRd
linkinv_cpp <- function(eta, linkname) {
    .Call('_bayescopulareg_linkinv_cpp', PACKAGE = 'bayescopulareg', eta, linkname)
}

#' Log joint posterior density for (beta, phi)
#' 
#' This function returns the log joint posterior density \eqn{(\beta, \phi)}
#' 
#' @param y response \code{vector} for current data
#' @param X design \code{matrix} for current data
#' @param beta \code{vector} of regression coefficients
#' @param phi dispersion parameter
#' @param Z \code{matrix} giving unobserved variables
#' @param Gammainv inverse correlation \code{matrix}
#' @param distname \code{character} giving which distribution to use
#' @param linkname \code{character} giving which link function to use
#' @param n sample size of current data
#' @param j index of which margin to compute likelihood for, \eqn{0 \le j \le J - 1}
#' @param J number of endpoints of current data,
#' @param p number of covariates in current endpoint,
#' @param c0 variance multiple in \eqn{\beta \mid \phi} normal prior
#' @param alpha0 Gamma distribution shape parameter for prior on \code{phi}
#' @param gamma0 Gamma distribution rate parameter for prior on \code{phi}
#' @param b0 power prior parameter for historical data
#' @param y0 \code{vector} of historical responses
#' @param X0 design \code{matrix} for historical data
#' @param n0 historical data sample size
#' 
#' @return scalar giving log posterior density for (beta, phi)
#' @keywords internal
#' @noRd
logPost <- function(y, X, beta, phi, Z, Gammainv, distname, linkname, n, j, J, p, c0, alpha0, gamma0, b0, y0, X0, n0) {
    .Call('_bayescopulareg_logPost', PACKAGE = 'bayescopulareg', y, X, beta, phi, Z, Gammainv, distname, linkname, n, j, J, p, c0, alpha0, gamma0, b0, y0, X0, n0)
}

#' Power prior for \eqn{(\beta, \phi)}
#' 
#' This function returns the log power prior for \eqn{(\beta, \phi)}
#' 
#' @name logPowerPrior_cpp
#' @param y0 \code{vector} of historical responses
#' @param X0 design \code{matrix} for historical data
#' @param beta regression coefficients
#' @param phi dispersion parameter
#' @param b0 power prior parameter, a \code{b0} \eqn{\in (0, 1])}
#' @param distname name of distribution
#' @param linkname name of link function
#' @param n0 historical data sample size
#' 
#' @return scalar giving log prior density
#' @keywords internal
#' @noRd
logPowerPrior_cpp <- function(y0, X0, beta, phi, b0, distname, linkname, n0) {
    .Call('_bayescopulareg_logPowerPrior_cpp', PACKAGE = 'bayescopulareg', y0, X0, beta, phi, b0, distname, linkname, n0)
}

#' Initial validation prior for (beta, phi)
#' 
#' This function returns the log prior density for (beta, phi) where
#' \eqn{\beta \mid \phi \sim N_p(0, \phi c_0 I)} and
#' \eqn{\phi \sim } Gamma \eqn{ ( \alpha_0, \gamma_0 ) }
#' 
#' @name logInitPrior_cpp
#' @param beta \code{vector} of regression coefficients
#' @param phi dispersion parameter
#' @param c0 prior variance multiple for regression coefficients given inverse dispersion
#' @param alpha0 shape parameter for inverse dispersion
#' @param gamma0 rate parameter for inverse dispersion
#' @param p dimension of \code{beta}
#' @return scalar giving log prior joint density
#' @keywords internal
#' @noRd
logInitPrior_cpp <- function(beta, phi, c0, alpha0, gamma0, p) {
    .Call('_bayescopulareg_logInitPrior_cpp', PACKAGE = 'bayescopulareg', beta, phi, c0, alpha0, gamma0, p)
}

#' Gaussian log likelihood
#' 
#' This function takes as its input a respone vector,
#' a design matrix, a vector of regression coefficients,
#' a dispersion parameter, the name of a link function,
#' and number of observations, and it outputs the log likelihood of a 
#' Gaussian GLM
#' 
#' @param y response \code{vector}
#' @param X design \code{matrix}
#' @param beta regression coefficient \code{vector}
#' @param phi dispersion parameter
#' @param linkname name of link function
#' @param n integer giving number of observations
#' @return scalar giving log likelihood
NULL

#' Gamma log likelihood
#' 
#' This function takes as its input a respone vector,
#' a design matrix, a vector of regression coefficients,
#' a dispersion parameter, the name of a link function,
#' and number of observations, and it outputs the log likelihood of a 
#' Gamma GLM
#' 
#' @param y response \code{vector}
#' @param X design \code{matrix}
#' @param beta regression coefficient \code{vector}
#' @param phi dispersion parameter
#' @param linkname name of link function
#' @param n integer giving number of observations
#' @return scalar giving log likelihood
NULL

#' Bernoulli log likelihood
#' 
#' This function takes as its input a respone vector,
#' a design matrix, a vector of regression coefficients,
#' a dispersion parameter, the name of a link function,
#' and number of observations, and it outputs the log likelihood of a 
#' Bernoulli GLM
#' 
#' @param y response \code{vector}
#' @param X design \code{matrix}
#' @param beta regression coefficient \code{vector}
#' @param phi dispersion parameter. Assumed to be 1 (ignored in function)
#' @param linkname name of link function
#' @param n integer giving number of observations
#' @return scalar giving log likelihood
NULL

#' Poisson log likelihood
#' 
#' This function takes as its input a respone vector,
#' a design matrix, a vector of regression coefficients,
#' a dispersion parameter, the name of a link function,
#' and number of observations, and it outputs the log likelihood of a 
#' Poisson GLM
#' 
#' @param y response \code{vector}
#' @param X design \code{matrix}
#' @param beta regression coefficient \code{vector}
#' @param phi dispersion parameter. Assumed to be 1 (ignored in function)
#' @param linkname name of link function
#' @param n integer giving number of observations
#' @return scalar giving log likelihood
NULL

#' Log likelihood of GLM
#' 
#' This function computes log likelihood based on data, parameters, link function, and a string giving
#' the proper distribution
#' 
#' @name loglik_cpp
#' @param y response \code{vector}
#' @param X design \code{matrix}
#' @param beta regression coefficient \code{vector}
#' @param phi Dispersion parameter. Ignored for binomial and Poisson models
#' @param linkname string giving name of link function. Must be one of \code{ c( "logit", "probit", "cauchit", "cloglog", "identity", "log", "sqrt", "1/mu^2", "inverse" ) }
#' @param n number of observations
#' @param distname name of distribution as a string. Must be one of \code{ c ( "gaussian", "Gamma", "poisson", "binomial" ) ) }
#' 
#' @return scalar giving log likelihood
#' @keywords internal
#' @noRd
loglik_cpp <- function(y, X, beta, phi, distname, linkname, n) {
    .Call('_bayescopulareg_loglik_cpp', PACKAGE = 'bayescopulareg', y, X, beta, phi, distname, linkname, n)
}

#' MCMC sample of copula GLM
#' 
#' This function samples from the posterior distribution of a copula GLM
#' 
#' @param ymat \eqn{n \times J} \code{matrix} of response variables
#' @param Xlist \eqn{J}-dimensional list of design matrices
#' @param distnamevec \code{character} vector of length \eqn{J}  giving name of distribution
#' @param linknamevec \code{character} vector of length \eqn{J}  giving name of link function. See \code{help(family)}
#' @param c0vec \code{numeric} vector giving scale hyperparmeter for conditional prior. The prior covariance for beta is c0 * phi * I.
#' @param sigma0logphivec \code{vector} giving random walk variance for log dispersion parameter
#' @param alpha0vec \code{numeric} vector giving shape parameter for the gamma density prior on phi
#' @param gamma0vec \code{numeric} vector giving rate parameter for the gamma density prior on phi
#' @param Gamma \code{matrix} giving starting values for correlation parameters
#' @param v0 integer giving degrees of freedom for Inverse wishart prior on correlation matrix \code{Gamma}
#' @param V0 \code{matrix} giving prior scale parameter for Inverse wishart prior on correlation matrix \code{Gamma}
#' @param b0 scalar between 0 and 1 giving power prior hyperparameter. If \code{b0 == 0}, historical data is ignored.
#' @param y0mat \code{matrix} giving responses for historical data set
#' @param X0list \code{list} giving design matrices for historical data responses
#' @param M number of samples to draw
#' @param beta0list \code{list} of vectors giving starting values for regression coefficients
#' @param phi0vec \code{numeric} vector giving starting values for dispersion parameters
#' 
#' @return sampled correlation matrix
#' @keywords internal
#' @noRd
sample_copula_cpp <- function(ymat, Xlist, distnamevec, linknamevec, c0vec, S0betalist, sigma0logphivec, alpha0vec, gamma0vec, Gamma, v0, V0, b0, y0mat, X0list, M, beta0list, phi0vec, thin) {
    .Call('_bayescopulareg_sample_copula_cpp', PACKAGE = 'bayescopulareg', ymat, Xlist, distnamevec, linknamevec, c0vec, S0betalist, sigma0logphivec, alpha0vec, gamma0vec, Gamma, v0, V0, b0, y0mat, X0list, M, beta0list, phi0vec, thin)
}

#' Update correlation matrix
#' 
#' This function samples from the posterior correlation matrix given
#' the latent variables given as a matrix Z
#' 
#' @param Z a \eqn{n \times J} \code{matrix} of latent variables
#' @param n number of rows in Z
#' @param v0 hyperparameter giving degrees of freedom for inverse Wishart sample
#' @param v0V0 v0 * hyperparameter giving scale matrix for inverse Wishart sample
#' 
#' @return sampled correlation matrix
#' @keywords internal
#' @noRd
update_Gamma <- function(Z, n, v0, v0V0) {
    .Call('_bayescopulareg_update_Gamma', PACKAGE = 'bayescopulareg', Z, n, v0, v0V0)
}

#' Get updated Z
#' 
#' This function updates the hidden variables in a GLM copula based on \eqn{\beta, \phi}
#' 
#' @param y response \code{vector}
#' @param X design \code{matrix}
#' @param beta regression coefficient \code{vector}
#' @param phi Dispersion parameter. Ignored for binomial and Poisson models
#' @param Z current \code{matrix} of latent variables
#' @param Gamma current correlation \code{matrix}
#' @param distname name of distribution as a string. Must be one of \code{ c ( "gaussian", "Gamma", "poisson", "binomial" ) ) }
#' @param linkname string giving name of link function. Must be one of \code{ c( "logit", "probit", "cauchit", "cloglog", "identity", "log", "sqrt", "1/mu^2", "inverse" ) }
#' @param n number of observations
#' @param j index of which column of Z to update, an integer between 0 and J-1
#' 
#' @return vector applying CDF to \eqn{ y \mid X, \beta, \phi }
#' @keywords internal
#' @noRd
update_Z <- function(y, X, beta, phi, Z, Gamma, distname, linkname, n, j) {
    .Call('_bayescopulareg_update_Z', PACKAGE = 'bayescopulareg', y, X, beta, phi, Z, Gamma, distname, linkname, n, j)
}

#' @keywords internal
NULL

#' @keywords internal
NULL

#' Update GLM parameters for one endpoint
#' 
#' This function samples the conditionals of beta, phi, and Z
#' 
#' @param y response \code{vector}
#' @param X design \code{matrix}
#' @param beta regression coefficient \code{vector}
#' @param phi dispersion parameter
#' @param Z \code{matrix} of latent variables
#' @param Gammainv inverse correlation \code{matrix}
#' @param c0 scalar giving prior value to scale correlation matrix: \eqn{\beta \sim N(0, c_0 \phi S_0) }
#' @param S0beta covariance matrix to sample betas from random walk
#' @param sigma0logphi standard deviation to sample log(phi) from random walk
#' @param distname name of distribution. See \code{?family}
#' @param linkname name of link function. See \code{?family}
#' @param n number of observations
#' @param j index of which endpoint to update. \eqn{0 \le j < J}
#' @param J number of endpoints
#' @param p number of regressors
#' @param alpha0 hyperparameter for shape parameter of phi assuming gamma density. Ignored if jth endpoint is discrete.
#' @param gamma0 hyperparameter for scale parameter of phi assuming gamma density. Ignored if jth endpoint is discrete.
#' @param b0 \emph{optional} power prior parameter. If \code{b0==0}, assumes no power prior being used.
#' @param y0 \emph{optional} historical response vector. Ignored if \code{b0 == 0}
#' @param X0 \emph{optional} historical design matrix. Ignored if \code{b0 == 0}
#' 
#' @return sampled correlation matrix
#' @keywords internal
#' @noRd
update_params <- function(y, X, beta, phi, Z, Gammainv, c0, S0beta, sigma0logphi, distname, linkname, n, j, J, p, alpha0, gamma0, b0, y0, X0, n0) {
    .Call('_bayescopulareg_update_params', PACKAGE = 'bayescopulareg', y, X, beta, phi, Z, Gammainv, c0, S0beta, sigma0logphi, distname, linkname, n, j, J, p, alpha0, gamma0, b0, y0, X0, n0)
}