114 lines
4.4 KiB
R
114 lines
4.4 KiB
R
# Generated by using Rcpp::compileAttributes() -> do not edit by hand
|
|
# Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393
|
|
|
|
#' Gradient computation of the loss `L_n(V)`.
|
|
#'
|
|
#' The loss is defined as
|
|
#' \deqn{L_n(V) := \frac{1}{n}\sum_{j=1}^n y_2(V, X_j) - y_1(V, X_j)^2}{L_n(V) := 1/n sum_j( (y_2(V, X_j) - y_1(V, X_j)^2 )}
|
|
#' with
|
|
#' \deqn{y_l(s_0) := \sum_{i=1}^n w_i(V, s_0)Y_i^l}{y_l(s_0) := sum_i(w_i(V, s_0) Y_i^l)}
|
|
#'
|
|
#' @rdname optStiefel
|
|
#' @keywords internal
|
|
#' @name gradient
|
|
NULL
|
|
|
|
#' Stiefel Optimization.
|
|
#'
|
|
#' Stiefel Optimization for \code{V} given a dataset \code{X} and responces
|
|
#' \code{Y} for the model \deqn{Y\sim g(B'X) + \epsilon}{Y ~ g(B'X) + epsilon}
|
|
#' to compute the matrix `B` such that \eqn{span{B} = span(V)^{\bot}}{%
|
|
#' span(B) = orth(span(B))}.
|
|
#'
|
|
#' @param X data points
|
|
#' @param Y response
|
|
#' @param k assumed \eqn{rank(B)}
|
|
#' @param nObs parameter for bandwidth estimation, typical value
|
|
#' \code{nObs = nrow(X)^lambda} with \code{lambda} in the range [0.3, 0.8].
|
|
#' @param tau Initial step size
|
|
#' @param tol Tolerance for update error used for stopping criterion
|
|
#' \eqn{|| V(j) V(j)' - V(j+1) V(j+1)' ||_2 < tol}{%
|
|
#' \| V_j V_j' - V_{j+1} V_{j+1}' \|_2 < tol}.
|
|
#' @param maxIter Upper bound of optimization iterations
|
|
#'
|
|
#' @return List containing the bandwidth \code{h}, optimization objective \code{V}
|
|
#' and the matrix \code{B} estimated for the model as a orthogonal basis of the
|
|
#' orthogonal space spaned by \code{V}.
|
|
#'
|
|
#' @rdname optStiefel
|
|
#' @keywords internal
|
|
#' @name optStiefel_simple
|
|
NULL
|
|
|
|
#' @rdname optStiefel
|
|
#' @keywords internal
|
|
#' @name optStiefel_linesearch
|
|
NULL
|
|
|
|
#' Estimated bandwidth for CVE.
|
|
#'
|
|
#' Estimates a propper bandwidth \code{h} according
|
|
#' \deqn{h = \chi_{p-q}^{-1}\left(\frac{nObs - 1}{n-1}\right)\frac{2 tr(\Sigma)}{p}}{%
|
|
#' h = qchisq( (nObs - 1)/(n - 1), p - q ) 2 tr(Sigma) / p}
|
|
#'
|
|
#' @param X data matrix of dimension (n x p) with n data points X_i of dimension
|
|
#' q. Therefor each row represents a datapoint of dimension p.
|
|
#' @param k Guess for rank(B).
|
|
#' @param nObs Ether numeric of a function. If specified as numeric value
|
|
#' its used in the computation of the bandwidth directly. If its a function
|
|
#' `nObs` is evaluated as \code{nObs(nrow(x))}. The default behaviou if not
|
|
#' supplied at all is to use \code{nObs <- nrow(x)^0.5}.
|
|
#'
|
|
#' @seealso [qchisq()]
|
|
#'
|
|
#' @export
|
|
estimateBandwidth <- function(X, k, nObs) {
|
|
.Call('_CVE_estimateBandwidth', PACKAGE = 'CVE', X, k, nObs)
|
|
}
|
|
|
|
#' Random element from Stiefel Manifold `S(p, q)`.
|
|
#'
|
|
#' Draws an element of \eqn{S(p, q)} which is the Stiefel Manifold.
|
|
#' This is done by taking the Q-component of the QR decomposition
|
|
#' from a `(p, q)` Matrix with independent standart normal entries.
|
|
#' As a semi-orthogonal Matrix the result `V` satisfies \eqn{V'V = I_q}.
|
|
#'
|
|
#' @param p Row dimension
|
|
#' @param q Column dimension
|
|
#'
|
|
#' @return Matrix of dim `(p, q)`.
|
|
#'
|
|
#' @seealso <https://en.wikipedia.org/wiki/Stiefel_manifold>
|
|
#'
|
|
#' @export
|
|
rStiefel <- function(p, q) {
|
|
.Call('_CVE_rStiefel', PACKAGE = 'CVE', p, q)
|
|
}
|
|
|
|
#' Conditional Variance Estimation (CVE) method.
|
|
#'
|
|
#' This version uses a "simple" stiefel optimization schema.
|
|
#'
|
|
#' @param X data points
|
|
#' @param Y response
|
|
#' @param k assumed \eqn{rank(B)}
|
|
#' @param nObs parameter for bandwidth estimation, typical value
|
|
#' \code{nObs = nrow(X)^lambda} with \code{lambda} in the range [0.3, 0.8].
|
|
#' @param h Bandwidth, if not specified \code{nObs} is used to compute a bandwidth.
|
|
#' on the other hand if given (positive floating point number) \code{nObs} is ignored.
|
|
#' @param tau Initial step size (default 1)
|
|
#' @param tol Tolerance for update error used for stopping criterion (default 1e-5)
|
|
#' @param slack Ratio of small negative error allowed in loss optimization (default -1e-10)
|
|
#' @param maxIter Upper bound of optimization iterations (default 50)
|
|
#' @param attempts Number of tryes with new random optimization starting points (default 10)
|
|
#'
|
|
#' @return List containing the bandwidth \code{h}, optimization objective \code{V}
|
|
#' and the matrix \code{B} estimated for the model as a orthogonal basis of the
|
|
#' orthogonal space spaned by \code{V}.
|
|
#'
|
|
#' @keywords internal
|
|
cve_cpp <- function(X, Y, method, k, nObs, h = -1., tauInitial = 1., rho1 = 0.1, rho2 = 0.9, tol = 1e-5, maxIter = 50L, maxLineSearchIter = 10L, attempts = 10L) {
|
|
.Call('_CVE_cve_cpp', PACKAGE = 'CVE', X, Y, method, k, nObs, h, tauInitial, rho1, rho2, tol, maxIter, maxLineSearchIter, attempts)
|
|
}
|
|
|