R/RcppExports.R

In zhenkewu/doubletree: Nested Latent Class Models for Domain-Adaptive and Semisupervised Learning of Cause-of-Deaths using Verbal Autopsy

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

#' xlogx
#'
#' utility function
#'
#' @param x a positive number or zero
#'
#' @useDynLib doubletree
#' @importFrom Rcpp sourceCpp
#' @export
xlogx <- function(x) {
    .Call('_doubletree_xlogx', PACKAGE = 'doubletree', x)
}

#' logsumexp
#'
#' utility function
#'
#' @param logv_arma a vector of numbers
#'
#' @useDynLib doubletree
#' @importFrom Rcpp sourceCpp
#' @export
logsumexp <- function(logv_arma) {
    .Call('_doubletree_logsumexp', PACKAGE = 'doubletree', logv_arma)
}

#' logexpit to avoid numerical underflow
#'
#' @param x a number
#' @useDynLib doubletree
#' @importFrom Rcpp sourceCpp
logexpit_cpp <- function(x) {
    .Call('_doubletree_logexpit_cpp', PACKAGE = 'doubletree', x)
}

logsumexp_row <- function(logv_arma) {
    .Call('_doubletree_logsumexp_row', PACKAGE = 'doubletree', logv_arma)
}

mtv <- function(mat, v) {
    .Call('_doubletree_mtv', PACKAGE = 'doubletree', mat, v)
}

#' Calculate variational moments during the updates
#'
#' Get all moments that need updating when iterating over internal and leaf nodes;
#' for both trees. When updating a node u, all the moments
#' of the descendant nodes will be changed. A recalculation of the moments are necessary
#' when moving on to another node.
#'
#' @param prob1,prob2 variational probabilities; `prob1` is for \code{s*_u} - length `p1`;
#' `prob2` is for `s_cu` - a matrix `pL1` by `p2`; in R, a list of pL1 length - each element being of length `p2`.
#' @param mu_gamma variational Gaussian means (for \code{s*_u=1} component) for J*K
#' logit(class-specific response probabilities); (J,K,p1) array; In R, we used a list of p1 (J,K) matrices
#' @param sigma_gamma variational Gaussian variances (for \code{s*_u=1} component)
#' for J*K logit(class-specific response probabilities); (J,K,p1) array; in R, we used a list o f p1 (J,K) matrices
#' @param mu_alpha variational Gaussian mean vectors (for \code{s_cu=1} component) -
#' this is a pL1 by K-1 by p2 array; in R, we used a list of p2 matrices (each of dimension pL1 by K-1)
#' @param sigma_alpha variational Gaussian variances (for \code{s_cu=1} component)
#' - this is an array of dimension (pL1, K-1, p2); in R, we used a list of p2 matrices,
#' each of dimension pL1 by K-1.
#' @param anc1,anc2 `anc1` is a list of pL1 vectors, each vector has the node ids of the ancestors in tree1;
#' lengths may differ. The ancestors include the node concerned; similarly for `anc2`
#' @param cardanc1,cardanc2 `cardanc1` is a numeric vector of length pL1; integers. The number
#' of ancestors for each leaf node in tree1; similarly for `cardanc2`.
#'
#' @return a List
#'
#' \describe{
#'   return List::create(Named("E_beta")=E_beta,
#'    Named("E_beta_sq")=E_beta_sq,
#'    Named("E_eta")=E_eta,
#'    Named("E_eta_sq")=E_eta_sq);
#'}
#'
#' @useDynLib doubletree
#' @importFrom Rcpp sourceCpp
#' @export
get_moments_cpp_doubletree <- function(prob1, prob2, mu_gamma, sigma_gamma, mu_alpha, sigma_alpha, anc1, anc2, cardanc1, cardanc2) {
    .Call('_doubletree_get_moments_cpp_doubletree', PACKAGE = 'doubletree', prob1, prob2, mu_gamma, sigma_gamma, mu_alpha, sigma_alpha, anc1, anc2, cardanc1, cardanc2)
}

#' Calculate variational moments during the updates
#'
#' Get all moments that need updating when iterating over internal and leaf nodes;
#' for both trees. When updating a node u, all the moments
#' of the descendant nodes will be changed. A recalculation of the moments are necessary
#' when moving on to another node.
#'
#' @param prob1 variational probabilities; `prob1` is for \code{s*_u} - length `p1`.
#' @param mu_gamma variational Gaussian means (for \code{s*_u=1} component) for J*K
#' logit(class-specific response probabilities); (J,K,p1) array; In R, we used a list of p1 (J,K) matrices
#' @param sigma_gamma variational Gaussian variances (for \code{s*_u=1} component)
#' for J*K logit(class-specific response probabilities); (J,K,p1) array; in R, we used a list o f p1 (J,K) matrices
#' @param E_beta,E_beta_sq J by K by pL1
#' each of dimension pL1 by K-1.
#' @param anc1 `anc1` is a list of pL1 vectors, each vector has the node ids of the ancestors in tree1;
#' lengths may differ. The ancestors include the node concerned; similarly for `anc2`
#' @param leaf_desc an integer vector of leaf descendant ids under consideration
#'
#' @return a List
#'
#' \describe{
#'   return List::create(Named("E_beta")=E_beta,
#'    Named("E_beta_sq")=E_beta_sq);
#'}
#'
#' @useDynLib doubletree
#' @importFrom Rcpp sourceCpp
#' @export
get_moments_cpp_eco_gamma_doubletree <- function(prob1, mu_gamma, sigma_gamma, E_beta, E_beta_sq, anc1, leaf_desc) {
    .Call('_doubletree_get_moments_cpp_eco_gamma_doubletree', PACKAGE = 'doubletree', prob1, mu_gamma, sigma_gamma, E_beta, E_beta_sq, anc1, leaf_desc)
}

#' Calculate variational moments during the updates
#'
#' Get all moments that need updating when iterating over internal and leaf nodes;
#' for both trees. When updating a node u, all the moments
#' of the descendant nodes will be changed. A recalculation of the moments are necessary
#' when moving on to another node.
#'
#' @param prob2
#' `prob2` is for `s_cu` - a matrix `pL1` by `p2`; in R, a list of pL1 length - each element being of length `p2`.
#' @param mu_alpha variational Gaussian mean vectors (for \code{s_cu=1} component) -
#' this is a pL1 by K-1 by p2 array; in R, we used a list of p2 matrices (each of dimension pL1 by K-1)
#' @param sigma_alpha variational Gaussian variances (for \code{s_cu=1} component)
#' - this is an array of dimension (pL1, K-1, p2); in R, we used a list of p2 matrices,
#' each of dimension pL1 by K-1.
#' @param E_eta,E_eta_sq the intermediate moments to be updated.
#' @param anc2 `anc2` is a list of pL1 vectors, each vector has the node ids of the ancestors in tree2;
#' @param leaf_desc leaf descendants under consideration
#'
#' @return a List
#'
#' \describe{
#'   return List::create(Named("E_eta")=E_eta,
#'    Named("E_eta_sq")=E_eta_sq);
#'}
#'
#' @useDynLib doubletree
#' @importFrom Rcpp sourceCpp
#' @export
get_moments_cpp_eco_alpha_doubletree <- function(prob2, mu_alpha, sigma_alpha, E_eta, E_eta_sq, anc2, leaf_desc) {
    .Call('_doubletree_get_moments_cpp_eco_alpha_doubletree', PACKAGE = 'doubletree', prob2, mu_alpha, sigma_alpha, E_eta, E_eta_sq, anc2, leaf_desc)
}

#' Calculate the F term; an array
#'
#' NB: does this work for the case where missing tree1 label can be in multiple domains,
#' and missing/non-missing can happen at the same time for any domain?
#'
#' This function updates the N by pL1 matrix \code{emat} in the package
#' @param psi,g_psi,phi,g_phi local variational parameters
#' @param X transformed data: `2Y-1`; with potential missing responses
#' @param ind_obs_i List of length N; each element is a vector of integers; variable lengths.
#' @param rmat matrix (N by K); row sums are one - the class probabilities for each observation.
#' @param E_beta,E_beta_sq,E_eta,E_eta_sq moment updates produced by \code{\link{get_moments_cpp_doubletree}}
#' @param v1_lookup_NA_replaced pL1+1 for `NA` in tree1 leaf
#' @param v2_lookup `v2_lookup` is a vector of length equal to the total number of rows in \code{X};
#' each element is an integer, indicating which leaf does the observation belong to in tree2
#'
#' @return  n by pL1 by K
#'
#' @useDynLib doubletree
#' @importFrom Rcpp sourceCpp
#' @export
F_doubletree <- function(psi, g_psi, phi, g_phi, X, ind_obs_i, rmat, E_beta, E_beta_sq, E_eta, E_eta_sq, v1_lookup_NA_replaced, v2_lookup) {
    .Call('_doubletree_F_doubletree', PACKAGE = 'doubletree', psi, g_psi, phi, g_phi, X, ind_obs_i, rmat, E_beta, E_beta_sq, E_eta, E_eta_sq, v1_lookup_NA_replaced, v2_lookup)
}

#' Update the variational probabilities of each observation in one of `pL1` leaves in tree1
#'
#' NB: does this work for the case where missing tree1 label can be in multiple domains,
#' and missing/non-missing can happen at the same time for any domain?
#'
#' This function updates the N by pL1 matrix \code{emat} in the package
#' @param curr_F F from [F_doubletree()]
#' @param rmat matrix (N by K); row sums are one - the class probabilities for each observation.
#' @param digamma_emat matrix(pL1 by pL2)
#' @param v2_lookup `v2_lookup` is a vector of length equal to the total number of rows in \code{X};
#' each element is an integer, indicating which leaf does the observation belong to in tree2
#'
#' @return  N by pL1 variational multinomial probabilities for
#' the posterior distribution of N people's membership in the pL1 leaves in tree1;
#' row sums are 1s. `F` is to prepare for `rmat` updates. For subjects with
#' observed leaf label in tree1, the corresponding rows of `res` should be further modified.
#'
#' @useDynLib doubletree
#' @importFrom Rcpp sourceCpp
#' @export
update_emat_with_F_doubletree <- function(curr_F, rmat, digamma_emat, v2_lookup) {
    .Call('_doubletree_update_emat_with_F_doubletree', PACKAGE = 'doubletree', curr_F, rmat, digamma_emat, v2_lookup)
}

#' Update the variational probabilities of each observation in one of `K` classes
#'
#' This function updates the N by K matrix \code{rmat} in the package
#'
#' @param curr_F from \code{\link{F_doubletree}}
#' @param emat matrix (N by K); row sums are one - the class probabilities for each observation.
#'
#' @return  N by K variational multinomial probabilities for
#' the posterior distribution of N people's membership in the K classes in tree1;
#' row sums are 1s.
#'
#' @useDynLib doubletree
#' @importFrom Rcpp sourceCpp
#' @export
update_rmat_with_F_doubletree <- function(curr_F, emat) {
    .Call('_doubletree_update_rmat_with_F_doubletree', PACKAGE = 'doubletree', curr_F, emat)
}

#' Update gamma's variational distribution. Update the variational mean and variance for logit of
#' class-specific response probabilities (for the \code{s*_u=1} component in tree1.)
#'
#' @param u node id; internal or leaf node in tree1
#' @param g_psi g of local variational parameters
#' @param tau_1_t_u variational Gaussian variances for gamma
#' @param E_beta,E_zeta_u moment updates produced by \code{\link{get_moments_cpp}};
#' \code{E_zeta_u} is directly calculated: \code{prob1[u]*sigma_gamma[u,,]}
#' @param X_zeropad transformed data: `2Y-1`; contains potential missing data.
#' @param rmat a matrix of variational probabilities of all observations
#' belong to K classes; N by K; each row sums to 1
#' @param emat a matrix of variational probability for all observations
#' belonging to pL1 leaf nodes; N by pL1; each row sums to 1. Importantly,
#' for rows with observed leaf nodes in tree1, we just have an one-hot represention
#' of that cause.
#' @param h_pau a numeric vector of length p indicating the branch length
#' between a node and its parent
#' @param leaf_desc a vector of leaf descendants nested under node `u`
#'
#' @return  a list
#' \describe{
#'   \item{resA}{actually 1/A in the paper, this is variance}
#'   \item{resB}{}
#'   \item{logresBsq_o_A}{}
#' }
#'
#' @useDynLib doubletree
#' @importFrom Rcpp sourceCpp
#' @export
update_gamma_subid_doubletree <- function(u, g_psi, tau_1_t_u, E_beta, E_zeta_u, X_zeropad, rmat, emat, h_pau, leaf_desc) {
    .Call('_doubletree_update_gamma_subid_doubletree', PACKAGE = 'doubletree', u, g_psi, tau_1_t_u, E_beta, E_zeta_u, X_zeropad, rmat, emat, h_pau, leaf_desc)
}

#' Update alpha's variational distribution.
#'
#' @param u node id; internal or leaf node in tree1
#' @param v1 leaf node id in tree1.
#' @param g_phi g of local variational parameters
#' @param tau_2_t_u variational Gaussian variances for gamma
#' @param E_eta,E_xi_u moment updates produced by \code{\link{get_moments_cpp}};
#' \code{E_xi_u} is directly calculated
#' @param X transformed data: `2Y-1`; contains potential missing data.
#' @param rmat a matrix of variational probabilities of all observations
#' belong to K classes; N by K; each row sums to 1
#' @param emat a matrix of variational probability for all observations
#' belonging to pL1 leaf nodes; N by pL1; each row sums to 1. Importantly,
#' for rows with obsered leaf nodes in tree1, we just have an one-hot representation.
#' of that cause.
#' @param h_pau a numeric vector of length p indicating the branch length
#' between a node and its parent; for tree2
#' @param levels a vector of possibly repeating integers from 1 to Fg2
#' @param subject_ids integer ids for subjects nested under node `u`
#' @param v2_lookup a vector of length equal to the total number of rows in X;
#' each element is an integer, indicating which leaf does the observation belong to in tree2.
#'
#' @return  a list
#' \describe{
#'   \item{resC}{actually 1/C in the paper, this is variance}
#'   \item{resD}{}
#'   \item{logresDsq_o_C}{}
#' }
#'
#' @useDynLib doubletree
#' @importFrom Rcpp sourceCpp
#' @export
update_alpha_subid_doubletree <- function(u, v1, g_phi, tau_2_t_u, E_eta, E_xi_u, X, rmat, emat, h_pau, levels, subject_ids, v2_lookup) {
    .Call('_doubletree_update_alpha_subid_doubletree', PACKAGE = 'doubletree', u, v1, g_phi, tau_2_t_u, E_eta, E_xi_u, X, rmat, emat, h_pau, levels, subject_ids, v2_lookup)
}

update_alpha_subid_doubletree0 <- function(u, v1, g_phi, tau_2_t_u, E_eta, E_xi_u, X, rmat, emat, h_pau, levels, subject_ids, v2_lookup) {
    .Call('_doubletree_update_alpha_subid_doubletree0', PACKAGE = 'doubletree', u, v1, g_phi, tau_2_t_u, E_eta, E_xi_u, X, rmat, emat, h_pau, levels, subject_ids, v2_lookup)
}

#' calculate line 1, 2, and 15 of ELBO*
#'
#' Intended to be faster than its counterpart implementation in `R`.
#'
#' This function updates the N by pL1 matrix \code{emat} in the package
#' @param F intermediate values from updates of rmat and emat; dimension: N by pL1 by K;
#' currently for observations with known leaf labels in tree1 AND tree2, there is redundancy
#' because once we know i, we know the leaf 1 label, hence no need for
#' the second dimension
#' @param digamma_emat matrix(pL1 by pL2)
#' @param rmat matrix (N by K); row sums are one - the class probabilities for each observation.
#' @param emat matrix (N by pL1)
#' @param v1_lookup_NA_replaced vector; includes values of pL+1 for unknown leaf label in tree1.
#' @param v2_lookup `v2_lookup` is a vector of length equal to the total number of rows in \code{X};
#' each element is an integer, indicating which leaf does the observation belong to in tree2
#'
#' @return  line 1, 2, 15 of the ELBO* in Appendix
#'
#' @useDynLib doubletree
#' @importFrom Rcpp sourceCpp
#' @export
get_line1_2_15_doubletree <- function(F, digamma_emat, rmat, emat, v1_lookup_NA_replaced, v2_lookup) {
    .Call('_doubletree_get_line1_2_15_doubletree', PACKAGE = 'doubletree', F, digamma_emat, rmat, emat, v1_lookup_NA_replaced, v2_lookup)
}

#' Summarize the posterior mean, sd, and confidence interval (lower
#' and upper endpoints)
#'
#' applicable to grouped or individual estimates by proper choices of `prob1` and
#' `prob2`; one or zeros give grouped estimates; probabilities give individual estimates
#'
#' @param prob1,prob2 variational probabilities; `prob1` is for \code{s*_u} - length `p1`;
#' `prob2` is for `s_cu` - a matrix `pL1` by `p2`; in R, a list of pL1 length - each element being of length `p2`.
#' @param mu_gamma variational Gaussian means (for \code{s*_u=1} component) for J*K
#' logit(class-specific response probabilities); (J,K,p1) array; In R, we used a list of p1 (J,K) matrices
#' @param sigma_gamma variational Gaussian variances (for \code{s*_u=1} component)
#' for J*K logit(class-specific response probabilities); (J,K,p1) array; in R, we used a list o f p1 (J,K) matrices
#' @param mu_alpha variational Gaussian mean vectors (for \code{s_cu=1} component) -
#' this is a pL1 by K-1 by p2 array; in R, we used a list of p2 matrices (each of dimension pL1 by K-1)
#' @param sigma_alpha variational Gaussian variances (for \code{s_cu=1} component)
#' - this is an array of dimension (pL1, K-1, p2); in R, we used a list of p2 matrices,
#' each of dimension pL1 by K-1.
#' @param anc1,anc2 `anc1` is a list of pL1 vectors, each vector has the node ids of the ancestors in tree1;
#' lengths may differ. The ancestors include the node concerned; similarly for `anc2`
#' @param cardanc1,cardanc2 `cardanc1` is a numeric vector of length pL1; integers. The number
#' of ancestors for each leaf node in tree1; similarly for `cardanc2`.
#' @param z double z=\code{ ci_level+(1-ci_level)/2}
#'
#' @return a List
#'
#' \describe{
#' List::create(Named("beta_est")=beta_est,
#'              Named("beta_sd")=beta_sd,
#'              Named("beta_cil")=beta_cil,
#'              Named("beta_ciu")=beta_ciu,
#'              Named("eta_est")=eta_est,
#'              Named("eta_sd")=eta_sd,
#'              Named("eta_cil")=eta_cil,
#'              Named("eta_ciu")=eta_ciu);
#'}
#'
#' @useDynLib doubletree
#' @importFrom Rcpp sourceCpp
#' @export
get_est_cpp_dt <- function(prob1, prob2, mu_gamma, sigma_gamma, mu_alpha, sigma_alpha, anc1, anc2, cardanc1, cardanc2, z) {
    .Call('_doubletree_get_est_cpp_dt', PACKAGE = 'doubletree', prob1, prob2, mu_gamma, sigma_gamma, mu_alpha, sigma_alpha, anc1, anc2, cardanc1, cardanc2, z)
}