R/RcppExports.R

In andrewraim/COMMultReg: Conway-Maxwell Multinomial Regression

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

#' @name cmb
#' @export
r_cmb <- function(n, m, p, nu) {
    .Call(`_COMMultReg_r_cmb`, n, m, p, nu)
}

#' @name cmb
#' @export
d_cmb <- function(x, m, p, nu, take_log = FALSE, normalize = TRUE) {
    .Call(`_COMMultReg_d_cmb`, x, m, p, nu, take_log, normalize)
}

#' @name cmb
#' @export
normconst_cmb <- function(m, p, nu, take_log = FALSE) {
    .Call(`_COMMultReg_normconst_cmb`, m, p, nu, take_log)
}

#' Density for CMB random sample
#' 
#' Compute individual density contributions for
#' \deqn{
#' X_i \sim \textrm{CMB}(m_i, p_i, \nu_i),
#' \quad i = 1, \ldots, n.
#' }
#' 
#' @param x An \eqn{n}-dimensional vector of outcomes
#' @param m An \eqn{n}-dimensional vector \eqn{m_1, \ldots, m_n}
#' @param p An \eqn{n}-dimensional vector of probability parameters
#' \eqn{p_1, \ldots, p_n}
#' @param nu An \eqn{n}-dimensional vector of dispersion parameters
#' \eqn{\nu_1, \ldots, \nu_n}
#' @param take_log \code{TRUE} or \code{FALSE}; if \code{TRUE}, return the
#' value on the log-scale.
#' 
#' @return
#' A vector of density values
#' \eqn{f(x_1 \mid m_1, p_1, \nu_1), \ldots, f(x_n \mid m_n, p_n, \nu_n),}
#' which may be on the log-scale and/or unnormalized
#' according to input arguments. See \link{cmb}.
#'
#' @examples
#' set.seed(1234)
#' 
#' n = 20
#' m = rep(10, n)
#' 
#' x = rnorm(n)
#' X = model.matrix(~ x)
#' beta = c(-1, 1)
#' p = plogis(X %*% beta)
#' 
#' w = rnorm(n)
#' W = model.matrix(~ w)
#' gamma = c(0.1, -0.1)
#' nu = X %*% gamma
#' 
#' y = numeric(n)
#' for (i in 1:n) {
#'     y[i] = r_cmb(1, m[i], p[i], nu[i])
#' }
#' 
#' d_cmb_sample(y, m, p, nu, take_log = TRUE)
#' 
#' @export
d_cmb_sample <- function(x, m, p, nu, take_log = FALSE) {
    .Call(`_COMMultReg_d_cmb_sample`, x, m, p, nu, take_log)
}

gunterize <- function(X, all = FALSE) {
    .Call(`_COMMultReg_gunterize`, X, all)
}

loglik_score_fim_cmm <- function(par, dat_xform, baseline) {
    .Call(`_COMMultReg_loglik_score_fim_cmm`, par, dat_xform, baseline)
}

r_cmm_internal <- function(n, m, p, nu, burn, thin, x_init, report_period) {
    .Call(`_COMMultReg_r_cmm_internal`, n, m, p, nu, burn, thin, x_init, report_period)
}

#' @name cmm
#' @export
d_cmm <- function(x, p, nu, take_log = FALSE, normalize = TRUE) {
    .Call(`_COMMultReg_d_cmm`, x, p, nu, take_log, normalize)
}

#' @name cmm
#' @export
normconst_cmm <- function(m, p, nu, take_log = FALSE) {
    .Call(`_COMMultReg_normconst_cmm`, m, p, nu, take_log)
}

#' Density for CMM random sample
#' 
#' Compute individual density contributions for 
#' \deqn{
#' \bm{X}_i \sim \textrm{CMM}_k(m_i, \bm{p}_i, \nu_i),
#' \quad i = 1, \ldots, n.
#' }
#' 
#' @param X An \eqn{n \times k} matrix of outcomes, where the \eqn{i}th row
#' \eqn{\bm{x}_i^\top} represents the \eqn{i}th observation.
#' @param P An \eqn{n \times k} matrix, where the \eqn{i}th row
#' \eqn{\bm{p}_i^\top} represents the probability parameter for the
#' \eqn{i}th observation.
#' @param nu An \eqn{n}-dimensional vector of dispersion parameters
#' \eqn{\nu_1, \ldots, \nu_n}
#' @param take_log \code{TRUE} or \code{FALSE}; if \code{TRUE}, return the
#' value on the log-scale.
#' @param normalize \code{TRUE} or \code{FALSE}; if \code{FALSE}, do not
#' compute or apply the normalizing constant to each density value.
#' 
#' @return
#' A vector of density values
#' \eqn{
#' f(\bm{x}_1^\top \mid m_1, \bm{p}_1^\top, \nu_1),
#' \ldots,
#' f(\bm{x}_n^\top \mid m_n, \bm{p}_n^\top, \nu_n),
#' }
#' which may be on the log-scale and/or unnormalized
#' according to input arguments. The value of each
#' \eqn{m_i} is assumed to be \eqn{\sum_{j=1}^k x_{ij}}.
#'
#' @details
#' The entire computation for this function is done in C++, and therefore
#' may be more efficient than calling \code{d_cmm} in a loop from R.
#'
#' @examples
#' set.seed(1234)
#' 
#' n = 20
#' m = rep(10, n)
#' k = 3
#' 
#' x = rnorm(n)
#' X = model.matrix(~ x)
#' beta = matrix(NA, 2, k-1)
#' beta[1,] = -1
#' beta[2,] = 1
#' P = t(apply(X %*% beta, 1, inv_mlogit))
#' 
#' w = rnorm(n)
#' W = model.matrix(~ x)
#' gamma = c(1, -0.1)
#' nu = X %*% gamma
#' 
#' y = matrix(NA, n, k)
#' for (i in 1:n) {
#'     y[i,] = r_cmm(1, m[i], P[i,], nu[i], burn = 200)
#' }
#' 
#' d_cmm_sample(y, P, nu, take_log = TRUE)
#' 
#' @export
d_cmm_sample <- function(X, P, nu, take_log = FALSE, normalize = TRUE) {
    .Call(`_COMMultReg_d_cmm_sample`, X, P, nu, take_log, normalize)
}

pinv <- function(x) {
    .Call(`_COMMultReg_pinv`, x)
}

logchoose <- function(x) {
    .Call(`_COMMultReg_logchoose`, x)
}

normalize <- function(x, na_rm = TRUE) {
    .Call(`_COMMultReg_normalize`, x, na_rm)
}