R/RcppExports.R

In scorematchingad: Score Matching Estimation by Automatic Differentiation

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

abort_recording <- function() {
    invisible(.Call(`_scorematchingad_abort_recording`))
}

#' @noRd
#' @describeIn evaltape_internal The value of a recorded function approximated by Taylor expansion.
#' Returns the approximate value of `pfun` at `x`.
#' @details
#' # taylorApprox_currentdynparam evaluates the tape without updating the dynamic parameter value 
#' Approximates the value of a `CppAD` tape at `x` using a Taylor approximation at `centre`. The dynamic parameters of the tape are set by `dynparam`.
#' @param centre For pTaylorApprox. A vector in the domain of the taped function to approximate the value at `x` from.
#' @param order For pTaylorApprox. The order of Taylor expansion to use.
taylorApprox_currentdynparam <- function(pfun, x, centre, order) {
    .Call(`_scorematchingad_taylorApprox_currentdynparam`, pfun, x, centre, order)
}

#' @noRd
#' @describeIn evaltape_internal The value of a recorded function approximated by Taylor expansion.
#' Returns the approximate value of `pfun` at `x`.
taylorApprox <- function(pfun, x, centre, dynparam, order) {
    .Call(`_scorematchingad_taylorApprox`, pfun, x, centre, dynparam, order)
}

set_cppad_error_handler <- function() {
    invisible(.Call(`_scorematchingad_set_cppad_error_handler`))
}

test_Rcpphandler <- function() {
    invisible(.Call(`_scorematchingad_test_Rcpphandler`))
}

fixdynamic <- function(uld, theta, fixedtheta) {
    .Call(`_scorematchingad_fixdynamic`, uld, theta, fixedtheta)
}

reembed <- function(uld, tran) {
    .Call(`_scorematchingad_reembed`, uld, tran)
}

#' @title Tape the Jacobian of CppAD Tape
#' @family tape builders
#' @param pfun An `Rcpp_ADFun` object.
#' @description Creates a tape of the Jacobian of a function taped by `CppAD`.
#' When the function returns a real value (as is the case for densities and the score matching objective) the Jacobian is equivalent to the gradient.
#' The `x` vector is used as the value to conduct the taping.
#' @details
#' When the returned tape is evaluated (via say `$eval()`, the resultant vector contains the Jacobian in long format (see <https://cppad.readthedocs.io/latest/Jacobian.html>).
#' Suppose the function represented by `pfun` maps from \eqn{n}-dimensional space to \eqn{m}-dimensional space, then
#' the first \eqn{n} elements of vector is the gradient of the first component of function output.
#' The next \eqn{n} elements of the vector is the gradient of the second component of the function output.
#' The Jacobian as a matrix, could then be obtained by [`as.matrix()`] with `byrow = TRUE` and `ncol = n`.
#'
#' For creating this tape, the values of `pfun$xtape` and `pfun$dyntape` are used.
#' @return An `Rcpp_ADFun` object.
#' @export
tape_Jacobian <- function(pfun) {
    .Call(`_scorematchingad_tape_Jacobian`, pfun)
}

#' @title Tape the Hessian of a CppAD Tape
#' @family tape builders
#' @inheritParams tape_Jacobian
#' @description Creates a tape of the Hessian of a function taped by `CppAD`.
#' The taped function represented by `pfun` must be scalar-valued (i.e. a vector of length 1).
#' The `x` vector and `dynparam` are used as the values to conduct the taping.
#' @details
#' When the returned tape is evaluated (via say [`eval()`][Rcpp_ADFun-class]), the resultant vector contains the Hessian in long format (see <https://cppad.readthedocs.io/latest/Hessian.html>):
#' suppose the function represented by `pfun` maps from \eqn{n}-dimensional space to \eqn{1}-dimensional space, then
#' the first \eqn{n} elements of the vector is the gradient of the partial derivative with respect to the first dimension of the function's domain;
#' the next \eqn{n} elements of the vector is the gradient of the partial derivative of the second dimension of the function's domain.
#' The Hessian as a matrix, can be obtained by using [`as.matrix()`] with `ncol = n`.
#'
#' For creating this tape, the values of `pfun$xtape` and `pfun$dyntape` are used.
#' @return An `Rcpp_ADFun` object.
#' @export
tape_Hessian <- function(pfun) {
    .Call(`_scorematchingad_tape_Hessian`, pfun)
}

#' @title Tape the Gradient Offset of a Quadratic CppAD Tape
#' @family tape builders
#' @inheritParams tape_Jacobian
#' @return An `Rcpp_ADFun` object. The independent argument to the function are the dynamic parameters of `pfun`.
#' @details A quadratic function can be written as
#' \deqn{f(x;\theta) = \frac{1}{2} x^T W(\theta) x + b(\theta)^Tx + c.}
#' The gradient of \eqn{f(x; \theta)} with respect to \eqn{x} is
#' \deqn{\Delta f(x; \theta) = \frac{1}{2}(W(\theta) + W(\theta)^T)x + b(\theta).}
#' The Hessian is 
#' \deqn{H f(x; \theta) = \frac{1}{2}(W(\theta) + W(\theta)^T),}
#' which does not depend on \eqn{x},
#' so the gradient of the function can be rewritten as
#' \deqn{\Delta f(x;\theta) = H f(x; \theta) x + b(\theta)^T.}
#' The tape calculates \eqn{b(\theta)} as
#'  \deqn{b(\theta) = \Delta f(x;\theta) - H f(x; \theta) x,}
#' which does not depend on \eqn{x}.
#'
#' For creating this tape, the values of `pfun$xtape` and `pfun$dyntape` are used.
#' @export
tape_gradoffset <- function(pfun) {
    .Call(`_scorematchingad_tape_gradoffset`, pfun)
}

#' @title Tape the log of Jacobian determinant of a CppAD Tape
#' @family tape builders
#' @inheritParams tape_Jacobian
#' @description Creates a tape of the log of the Jacobian determinant of a function taped by CppAD.
#' The `x` vector is used as the value to conduct the taping.
#'
#' For creating this tape, the values of `pfun$xtape` and `pfun$dyntape` are used.
#' @return An `Rcpp_ADFun` object.
#' @export
tape_logJacdet <- function(pfun) {
    .Call(`_scorematchingad_tape_logJacdet`, pfun)
}

#' @title Switch Dynamic and Independent Values of a Tape
#' @family tape builders
#' @inheritParams tape_Jacobian
#' @description Convert an `Rcpp_ADFun` object so that the independent values become dynamic parameters
#' and the dynamic parameters become independent values
#' @details
#' For creating this tape, the values of `pfun$xtape` and `pfun$dyntape` are used.
#' @return An `Rcpp_ADFun` object.
#' @export
tape_swap <- function(pfun) {
    .Call(`_scorematchingad_tape_swap`, pfun)
}

#' @noRd
#' @title Tape of a log-density calculation 2
#' @param p dimension of measurements
#' @param bd dimension of the parameter vector
#' @param llname name of the likelihood function
#' @return An RCpp::XPtr object pointing to the ADFun
ptapell2 <- function(z_ad, theta_ad, llfXPtr, tran, fixedtheta, verbose) {
    .Call(`_scorematchingad_ptapell2`, z_ad, theta_ad, llfXPtr, tran, fixedtheta, verbose)
}

#' @noRd
#' @title Get an XPtr to a named log-density function in source code of package
#' @param llname name of the likelihood function
#' @return An RCpp::XPtr object pointing to a `llPtr` object of the log-density function. Since `llPtr` is itself a pointer object, we have an XPtr pointing to a pointer that points to a function.
getllptr <- function(llname) {
    .Call(`_scorematchingad_getllptr`, llname)
}

#' @rdname tape_uld
#' @name tape_uld
#' @param name Name of an inbuilt function. See details.
#' @details
#' For `tape_uld_inbuilt()`, currently available unnormalised log-density functions are:
#'
#' ```{r, results = "asis", echo = FALSE}
#' cat(paste(" +", llnames), sep = "\n")
#' ```
#' @export
tape_uld_inbuilt <- function(name, x, theta) {
    .Call(`_scorematchingad_tape_uld_inbuilt`, name, x, theta)
}

#' @noRd
#' @title The score matching objective calculator.
#' @param xbetain a concatenated vector of sqrt(x) and beta
#' @param n The dimension of x.
#' @param manifoldname The name of the manifold to transform to
#' @param weightname The name of the weight function to use
#' @param acut The constraint a_c in the weight function
#' @return An RCpp::XPtr object pointing to the ADFun
tapesmd <- function(uldtape, tran, M, weightname, acut, verbose) {
    .Call(`_scorematchingad_tapesmd`, uldtape, tran, M, weightname, acut, verbose)
}