R/RcppExports.R

In dcgerard/UltimateDeconvolution: Deconvolution Problem in Multivariate Gaussian Mixtures

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

#' Multivariate normal density at mean 0 and a covariance that is the sum
#' of a rank-1 matrix and a diagonal matrix.
#'
#' @inheritParams dr1_norm
#' @param return_log Should we return the log-density (\code{TRUE}) or not (\code{FALSE})?
#'
#' @author David Gerard
#'
#' @export
#'
dnorm_rank1 <- function(x, v, s_diag, mu, return_log = FALSE) {
    .Call('UltimateDeconvolution_dnorm_rank1', PACKAGE = 'UltimateDeconvolution', x, v, s_diag, mu, return_log)
}

#' Get's a matrix of likeklihood values.
#'
#' Element (i, j) of the returned matrix is the log of
#' pi_j N(x_i | 0, v_j v_j^T + S_i)
#'
#' @inheritParams dmixlike
#'
#' @author David Gerard
#'
get_llike_mat_cpp <- function(x_mat, s_mat, v_mat, pi_vec) {
    .Call('UltimateDeconvolution_get_llike_mat_cpp', PACKAGE = 'UltimateDeconvolution', x_mat, s_mat, v_mat, pi_vec)
}

#' Calculates the gaussian mixture density.
#'
#' This function assumes that the mixing means are all zeros and
#' the mixing covariances are rank-1 matrices. Each observation
#' has its own independent noise (variances collected in
#' \code{s_mat}).
#'
#' @inheritParams dmixlike
#' @param return_log A logical. Should we return the log-density
#'     (\code{TRUE}) or not (\code{FALSE})?
#'
#' @author David Gerard
#'
dmixlike_cpp <- function(x_mat, s_mat, v_mat, pi_vec, return_log = FALSE) {
    .Call('UltimateDeconvolution_dmixlike_cpp', PACKAGE = 'UltimateDeconvolution', x_mat, s_mat, v_mat, pi_vec, return_log)
}

#' Fixed point iteration from the EM algorithm.
#'
#' Note that I am changing v_mat and pi_vec by reference, but also returning them in the list.
#'
#' @inheritParams dmixlike
#' @param w_mat The individual probabilities of being in a particular group.
#' @param theta_mat The means of the a_j's given in group k times w_kj's
#' @param eta_mat The second (non-central) moment of the a_j's given in group k times the w_kj's
#'
#' @author David Gerard
#'
em_fix_cpp <- function(x_mat, s_mat, v_mat, pi_vec, w_mat, theta_mat, eta_mat) {
    invisible(.Call('UltimateDeconvolution_em_fix_cpp', PACKAGE = 'UltimateDeconvolution', x_mat, s_mat, v_mat, pi_vec, w_mat, theta_mat, eta_mat))
}

#' C++ version of EM algorithm.
#'
#' @inheritParams ultimate_deconvolution
#' @param plot_iter A logical. Should we plot updates (\code{TRUE}) or not (\code{FALSE})?
#'
#' @return A list of the following elements:
#'
#'     \code{pi_vec}: The final estimate of the mixing proportions.
#'
#'     \code{v_mat}: The final estimate of the square roots of the rank-1 covariance matrices.
#'         These are the factors.
#'
#'     \code{llike_vec}: The vector of log-likelihoods. Should be increasing.
#'
#'     \code{convergence}: A value of \code{0} indicates convergence. A value of \code{1} indicates that
#'         the limit \code{itermax} has been reached. A vlue of \code{2} indicates that the user
#'         interupted the optimization.
#'
#'     \code{loadings}: An estimate for the loadings.
#'
#'     \code{w_mat}: An estimate for the probability of being in a group.
#'
#' @author David Gerard
#'
#' @export
#'
em_cpp <- function(x_mat, s_mat, v_mat, pi_vec, itermax = 500L, tol = 10 ^ -5, plot_iter = FALSE) {
    .Call('UltimateDeconvolution_em_cpp', PACKAGE = 'UltimateDeconvolution', x_mat, s_mat, v_mat, pi_vec, itermax, tol, plot_iter)
}