R/RcppExports.R

In ridgetorus: PCA on the Torus via Density Ridges

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

#' @title Unnormalized gradient and Hessian of a multivariate sine von Mises
#'
#' @description Computation of the gradient and Hessian of an arbitrary
#' multivariate sine von Mises density, without normalizing constants and
#' density factor.
#'
#' @param theta a matrix of size \code{c(nx, d)} with angles on
#' \eqn{[-\pi, \pi)}.
#' @param kappa vector with the \eqn{d} concentration parameters
#' \eqn{\boldsymbol{\kappa} = (\kappa_1, \ldots, \kappa_d)'}.
#' @param Lambda dependence matrix \eqn{\boldsymbol{\Lambda}}.
#' @return A list:
#' \item{grad}{unnormalized gradient, a matrix of size \code{c(nx, d)}.}
#' \item{hess}{unnormalized Hessian, an array of size \code{c(nx, d, d)}.}
#' @references
#' Mardia, K. V., Hughes, G., Taylor, C. C., and Singh, H. (2008).
#' A multivariate von Mises with applications to bioinformatics.
#' \emph{Canadian Journal of Statistics}, 36(1):99--109.
#' \doi{10.1002/cjs.5550360110}
#' @noRd
grad_hess_mvm <- function(theta, kappa, Lambda) {
    .Call('_ridgetorus_grad_hess_mvm', PACKAGE = 'ridgetorus', theta, kappa, Lambda)
}

#' @title Unnormalized gradient and Hessian of a multivariate wrapped normal
#'
#' @description Computation of the gradient and Hessian of an arbitrary
#' multivariate wrapped normal density, without normalizing constants and
#' density factor.
#'
#' @inheritParams grad_hess_mvm
#' @param mu vector of length \code{d} with the mean of the normal
#' distribution.
#' @param Sigma matrix of size \code{c(d, d)} with the covariance matrix of
#' the normal distribution.
#' @param k integer values for the wrapped normal truncation.
#' @return A list:
#' \item{grad}{unnormalized gradient, a matrix of size \code{c(nx, d)}.}
#' \item{hess}{unnormalized Hessian, an array of size \code{c(nx, d, d)}.}
#' @noRd
grad_hess_mwn <- function(theta, mu, Sigma, k) {
    .Call('_ridgetorus_grad_hess_mwn', PACKAGE = 'ridgetorus', theta, mu, Sigma, k)
}

#' @title Unnormalized gradient and Hessian of a bivariate wrapped Cauchy
#'
#' @description Gradient and Hessian of a bivariate wrapped Cauchy density,
#' without normalizing constants and density factor.
#'
#' @param theta2 evaluation points (vector).
#' @param theta1 evaluation point (scalar).
#' @inheritParams bwc
#' @return A list:
#' \item{D1,D2}{vectors of size \code{nx} with the unnormalized
#' first derivative.}
#' \item{u,w}{vector of size \code{nx} with the unnormalized
#' second derivative.}
#' \item{v}{vector of size \code{nx} with the unnormalized mixed derivative.}
#' @noRd
grad_hess_bwc <- function(theta2, theta1, xi) {
    .Call('_ridgetorus_grad_hess_bwc', PACKAGE = 'ridgetorus', theta2, theta1, xi)
}

#' @title Implicit equation of a toroidal density ridge
#'
#' @description One of the conditions for the density ridge of a given density
#' \eqn{f} is that the modulus of its projected gradient is zero:
#' \eqn{\|\mathrm{D}_{p-1}f(\mathbf{x})\|=0}. This function computes the
#' LHS of that implicit equation for the case of a given density.
#'
#' @param theta1,theta2 evaluation points.
#' @param density chosen model for the density: \code{"bvm"}, \code{"bwc"}, or
#' \code{"bwn"}.
#' @inheritParams d_bwc
#' @param kappa,Lambda vector of concentrations and dependence matrix of the
#' multivariate von Mises distribution.
#' @param mu,Sigma vector of means and covariance matrix of the multivariate
#' normal distribution.
#' @inheritParams grad_hess_mwn
#' @return The value of the LHS of the implicit equation.
#' @examples
#' n <- 200
#' x <- seq(-pi, pi, l = n)
#' mu <- c(0, 0)
#' kappa <- c(0.3, 0.4, 0.5)
#' val <- sapply(x, function(th1) ridgetorus:::implicit_equation(
#'     theta2 = x, theta1 = th1, density = "bvm", kappa = kappa[1:2],
#'     Lambda = matrix(c(0, kappa[3], kappa[3], 0), nrow = 2, ncol = 2)))
#' val <- matrix(val, nrow = n, ncol = n)
#' old_par <- par(no.readonly = TRUE)
#' par(mfrow = c(1, 2))
#' image(x, x, -log(abs(val)), axes = FALSE, col = viridisLite::viridis(20))
#' sdetorus::torusAxis()
#' sdetorus::plotSurface2D(x, x, f = function(x) d_bvm(x = x, mu = mu,
#'                                                     kappa = kappa),
#'                         axes = FALSE)
#' sdetorus::torusAxis()
#' par(old_par)
#' @noRd
implicit_equation <- function(theta2, theta1, density, kappa = 0L, Lambda = NULL, xi = 0L, mu = 0L, Sigma = NULL, k = NULL) {
    .Call('_ridgetorus_implicit_equation', PACKAGE = 'ridgetorus', theta2, theta1, density, kappa, Lambda, xi, mu, Sigma, k)
}