R/RcppExports.R

In bpnreg: Bayesian Projected Normal Regression Models for Circular Data

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

#' Compute the Likelihood of the PN distribution (mixed effects)
#'
#' @param theta_cos A List with the cosine of the circular dependent variable.
#' @param theta_sin A List with the sine of the circular dependent variable.
#' @param X1 A list of fixed effect model matrices for component I.
#' @param X2 A list of fixed effect model matrices for component II.
#' @param Z1 A list of random effect model matrices for component I.
#' @param Z2 A list of random effect model matrices for component II.
#' @param beta1 estimated fixed effect coefficients of the first component
#' @param beta2 estimated fixed effect coefficients of the second component
#' @param b1 estimated random effect coefficients of the first component
#' @param b2 estimated random effect coefficients of the second component
#' @param N sample size at second level
#' @param pred An empty list for likelihood computation.
#' @param iteration iteration number at which likelihood is computed
NULL

#' Sample fixed effect coefficients
#'
#' @param Omega current covariance matrix
#' @param Y current outcome vector (Y.I=cos(theta)*R, Y.II=sin(theta)*R)
#' @param X design matrix model parameters (differs per person)
#' @param Z design matrix for random effects (differs per person)
#' @param p dimension X (number of columns/variables+indicator variables)
#' @param A prior variance of fixed effect coefficients
#' @param N sample size at second level
#'
#' @keywords internal
#'
betaBlock <- function(Omega, R, theta, X, Z, p, A, N) {
    .Call(`_bpnreg_betaBlock`, Omega, R, theta, X, Z, p, A, N)
}

#' Sample subject specific random effects
#'
#' @param Omega current covariance matrix
#' @param beta current fixed effect coefficients vector
#' @param Y current outcome vector (Y.I=cos(theta)*R, Y.II=sin(theta)*R)
#' @param X design matrix model parameters (differs per person)
#' @param q dimension Z(number of random effects)
#' @param Z design matrix for random effects (differs per person)
#' @param ZtZ transpose(Z)*Z
#' @param N sample size at second level
#'
#' @keywords internal
#'
b_samp <- function(Omega, beta, R, theta, X, q, Z, ZtZ, N) {
    .Call(`_bpnreg_b_samp`, Omega, beta, R, theta, X, q, Z, ZtZ, N)
}

#' Sample precision matrix
#'
#' @param b subject specific random effects vectors
#' @param B prior sum of squares matrix, scale parameter Wishart distribution
#'   (of b=random effect if prior close to 0-->no random effect)
#' @param q dimension Z(number of random effects)
#' @param v prior df=dimension Z
#' @param N sample size at second level
#'
#' @keywords internal
#'
omega_samp <- function(b, B, v, q, N) {
    .Call(`_bpnreg_omega_samp`, b, B, v, q, N)
}

#'
lik_me <- function(theta_cos, theta_sin, X1, X2, Z1, Z2, beta1, beta2, b1, b2, N, pred, iteration) {
    .Call(`_bpnreg_lik_me`, theta_cos, theta_sin, X1, X2, Z1, Z2, beta1, beta2, b1, b2, N, pred, iteration)
}

#' A Gibbs sampler for a projected normal mixed-effects model
#'
#' @param theta_cos A List with the cosine of the circular dependent variable.
#' @param theta_sin A List with the sine of the circular dependent variable.
#' @param X1 A list of fixed effect model matrices for component I.
#' @param X2 A list of fixed effect model matrices for component II.
#' @param Z1 A list of random effect model matrices for component I.
#' @param Z2 A list of random effect model matrices for component II.
#' @param ZtZ1 A list of transformed random effect model matrices for component I.
#' @param ZtZ2 A list of transformed random effect model matrices for component II.
#' @param R A list of starting values for R.
#' @param pred An empty list for likelihood computation.
#' @param its An integer specifying the number of iterations
#' @param lag An integer specifying the amount of lag.
#' @param burn An integer specifying the number of burn-in iterations.
#' @param N An integer specifying the number of burn-in iterations.
#'
pnme <- function(theta_cos, theta_sin, X1, X2, Z1, Z2, ZtZ1, ZtZ2, R, pred, its, lag, burn, N) {
    .Call(`_bpnreg_pnme`, theta_cos, theta_sin, X1, X2, Z1, Z2, ZtZ1, ZtZ2, R, pred, its, lag, burn, N)
}

#' Compute the Likelihood of the PN distribution (regression)
#'
#' @param X1 the model matrix of the first component
#' @param X2 the model matrix of the second component
#' @param theta a circular outcome value
#' @param beta1 estimated linear coefficients of the first component
#' @param beta2 estimated linear coefficients of the second component
#' @param n sample size
#'
lik_reg <- function(X1, X2, theta, beta1, beta2, n) {
    .Call(`_bpnreg_lik_reg`, X1, X2, theta, beta1, beta2, n)
}

#' Compute Model Fit Measures Regression Model
#'
#' @param theta circular outcome values
#' @param beta1 regression coefficients for the second component for each mcmc iteration from pnr function
#' @param beta2 regression coefficients for the second component for each mcmc iteration from pnr function
#' @param Likelihood likelihood values for each individual and mcmc itertion from pnr function
#' @param X1 model matrix for the first component
#' @param X2 model matrix for the second component
#'
DIC_reg <- function(theta, beta1, beta2, Likelihood, X1, X2) {
    .Call(`_bpnreg_DIC_reg`, theta, beta1, beta2, Likelihood, X1, X2)
}

#' A slice sampler for the latent lengths r
#'
#' @param X1 A model matrix for component I.
#' @param X2 A model matrix for component II.
#' @param theta A vector with the circular dependent variable.
#' @param beta1 A matrix containing the coefficients of component I for the current iteration.
#' @param beta2 A matrix containing the coefficients of component II for the current iteration.
#' @param n An integer indicating the sample size of the data.
#' @param r A matrix with the estimates of r of the previous iteration.
#'
slice_rcpp <- function(X1, X2, theta, beta1, beta2, n, r) {
    .Call(`_bpnreg_slice_rcpp`, X1, X2, theta, beta1, beta2, n, r)
}

#' A Gibbs sampler for a projected normal regression model
#'
#' @param theta A vector with the circular dependent variable.
#' @param X1 A model matrix for component I.
#' @param X2 A model matrix for component II.
#' @param its An integer specifying the number of iterations
#' @param lag An integer specifying the amount of lag.
#' @param burn An integer specifying the number of burn-in iterations.
#'
pnr <- function(theta, X1, X2, its, lag, burn) {
    .Call(`_bpnreg_pnr`, theta, X1, X2, its, lag, burn)
}

#' Compute a mean resultant length
#'
#' @param theta a circular variable in radians.
#'
rho <- function(theta) {
    .Call(`_bpnreg_rho`, theta)
}

#' Compute a mean direction
#'
#' @inheritParams rho
#'
theta_bar <- function(theta) {
    .Call(`_bpnreg_theta_bar`, theta)
}

#' Compute Eigenvalues
#'
#' @param X A matrix.
#'
eigen_val <- function(X) {
    .Call(`_bpnreg_eigen_val`, X)
}

#' Compute Eigenvectors
#'
#' @inheritParams eigen_val
#'
eigen_vec <- function(X) {
    .Call(`_bpnreg_eigen_vec`, X)
}

#' Sample from a multivariate normal distribution
#'
#' @param sigma A variance-covariance matrix.
#' @param mu A mean vector.
#' @param n An integer indicating the number of samples to take.
#'
mvrnorm_arma_eigen <- function(n, mu, sigma) {
    .Call(`_bpnreg_mvrnorm_arma_eigen`, n, mu, sigma)
}

#' Compute circular coefficients
#'
#' @param a1 intercept estimate of component I.
#' @param a2 intercept estimate of component I.
#' @param b1 slope estimate of component I.
#' @param b2 slope estimate of component I.
#'
circ_coef_rcpp <- function(a1, a2, b1, b2) {
    .Call(`_bpnreg_circ_coef_rcpp`, a1, a2, b1, b2)
}

#' Estimate the mode by finding the highest posterior density interval
#'
#' @param x a  sample from which to estimate the interval
#' @param cip bandwidth for the algorithm, ranging from 0 to 1
#'
#' @return a scalar containing the estimate of the mode
#'
hmodeC <- function(x, cip) {
    .Call(`_bpnreg_hmodeC`, x, cip)
}

#' Find the highest density interval of a circular variable
#'
#' @inheritParams hmodeC
#'
#' @return a vector of length 2 containing the lower and upper bound of the interval
#'
hmodeciC <- function(x, cip) {
    .Call(`_bpnreg_hmodeciC`, x, cip)
}

#' Estimate the mode by finding the highest posterior density interval
#'
#' @inheritParams hmodeC
#'
#' @return a scalar containing the estimate of the mode
#'
hmode <- function(x, cip) {
    .Call(`_bpnreg_hmode`, x, cip)
}

#' Find the highest density interval.
#'
#' @inheritParams hmodeC
#' @inheritParams hmodeC
#'
#' @return a vector of length 2 containing the lower and upper bound of the interval.
#'
hmodeci <- function(x, cip) {
    .Call(`_bpnreg_hmodeci`, x, cip)
}