166 lines
6.5 KiB
C
166 lines
6.5 KiB
C
#include "cve.h"
|
|
|
|
// TODO: clarify
|
|
static inline double gaussKernel(const double x, const double scale) {
|
|
return exp(scale * x * x);
|
|
}
|
|
|
|
void cve_simple_sub(const int n, const int p, const int q,
|
|
const double *X, const double *Y, const double h,
|
|
const double tau_init, const double tol_init,
|
|
const int epochs, const int attempts,
|
|
double *V, double *L,
|
|
SEXP logger, SEXP loggerEnv) {
|
|
|
|
int attempt, epoch, i, nn = (n * (n - 1)) / 2;
|
|
double loss, loss_last, loss_best, err, tau;
|
|
double tol = tol_init * sqrt((double)(2 * q));
|
|
double gKscale = -0.5 / h;
|
|
|
|
/* Create further intermediate or internal variables. */
|
|
double *Q = (double*)R_alloc(p * p, sizeof(double));
|
|
double *V_best = (double*)R_alloc(p * q, sizeof(double));
|
|
double *L_best = (double*)R_alloc(n, sizeof(double));
|
|
double *V_tau = (double*)R_alloc(p * q, sizeof(double));
|
|
double *X_diff = (double*)R_alloc(nn * p, sizeof(double));
|
|
double *X_proj = (double*)R_alloc(nn * p, sizeof(double)); // TODO: needed?
|
|
double *y1 = (double*)R_alloc(n , sizeof(double)); // TODO: needed?
|
|
double *vecD = (double*)R_alloc(nn, sizeof(double));
|
|
double *vecK = (double*)R_alloc(nn, sizeof(double));
|
|
double *vecS = (double*)R_alloc(nn, sizeof(double));
|
|
double *colSums = (double*)R_alloc(n, sizeof(double));
|
|
double *G = (double*)R_alloc(p * q, sizeof(double));
|
|
double *A = (double*)R_alloc(p * p, sizeof(double));
|
|
|
|
/* Determine size of working memory used by subroutines. */
|
|
const int workLen = getWorkLen(n, p, q);
|
|
double *workMem = (double*)R_alloc(workLen, sizeof(double));
|
|
|
|
/* Compute X_diff, this is static for the entire algorithm. */
|
|
rowDiffs(X, n, p, X_diff);
|
|
|
|
for (attempt = 0; attempt < attempts; ++attempt) {
|
|
/* (Re)set learning rate. */
|
|
tau = tau_init;
|
|
|
|
/* Sample start value from stiefl manifold. */
|
|
rStiefl(p, q, V, workMem, workLen);
|
|
|
|
/* Create projection matrix for initial `V`. */
|
|
nullProj(V, p, q, Q);
|
|
|
|
/* Compute Distance vector. */
|
|
matrixprod(X, n, p, Q, p, p, X_proj); // here X_proj is only `(n, p)`.
|
|
rowDiffSquareSums(X_proj, n, p, vecD);
|
|
|
|
/* Apply kernel to distances. */
|
|
for (i = 0; i < nn; ++i) {
|
|
vecK[i] = gaussKernel(vecD[i], gKscale);
|
|
}
|
|
|
|
/* Compute col(row) sums of kernal vector (sym. packed lower tri
|
|
* matrix.), because `K == K^T` the rowSums are equal to colSums. */
|
|
rowSumsSymVec(vecK, n, 1.0, colSums);
|
|
|
|
/* Compute loss given the kernel vector and its column sums.
|
|
* Additionally the first momentum `y1` is computed and stored in
|
|
* the working memory (only intermidiate result, needed for `vecS`). */
|
|
loss_last = cost(n, Y, vecK, colSums, y1, L);
|
|
|
|
if (logger) {
|
|
callLogger(logger, loggerEnv,
|
|
attempt, 0,
|
|
L, n, V, p, q, tau);
|
|
}
|
|
|
|
/* Calc the scaling vector used for final computation of grad. */
|
|
scaling(n, Y, y1, L, vecD, vecK, colSums, vecS);
|
|
|
|
/* Compute the eucledian gradient `G`. */
|
|
rowSweep(X_diff, nn, p, "*", vecS, X_proj);
|
|
crossprod(X_diff, nn, p, X_proj, nn, p, workMem);
|
|
matrixprod(workMem, p, p, V, p, q, G);
|
|
scale(-2. / (((double)n) * h * h), G, p * q); // in-place
|
|
|
|
/* Compute Skew-Symmetric matrix `A` used in Cayley transform.
|
|
+ `A <- tau * (G V^T - V G^T) + 0 * A`*/
|
|
skew(p, q, tau, G, V, 0.0, A);
|
|
|
|
for (epoch = 0; epoch < epochs; ++epoch) {
|
|
/* Move V allong A */
|
|
cayleyTransform(p, q, A, V, V_tau, workMem);
|
|
|
|
/* Create projection matrix for `V_tau`. */
|
|
nullProj(V_tau, p, q, Q);
|
|
|
|
/* Compute Distance vector. */
|
|
matrixprod(X, n, p, Q, p, p, X_proj); // here X_proj only `(n, p)`.
|
|
rowDiffSquareSums(X_proj, n, p, vecD);
|
|
|
|
/* Apply kernel to distances. */
|
|
for (i = 0; i < nn; ++i) {
|
|
vecK[i] = gaussKernel(vecD[i], gKscale);
|
|
}
|
|
|
|
/* Compute col(row) sums of kernal vector (sym. packed lower tri
|
|
* matrix.), because `K == K^T` the rowSums are equal to colSums. */
|
|
rowSumsSymVec(vecK, n, 1.0, colSums);
|
|
|
|
/* Compute loss given the kernel vector and its column sums.
|
|
* Additionally the first momentum `y1` is computed and stored in
|
|
* the working memory (only intermidiate result, needed for `vecS`). */
|
|
loss = cost(n, Y, vecK, colSums, y1, L);
|
|
|
|
/* Check if step is appropriate, iff not reduce learning rate. */
|
|
if ((loss - loss_last) > 0.0) {
|
|
tau *= 0.5;
|
|
scale(0.5, A, p * p);
|
|
continue;
|
|
}
|
|
|
|
// Compute error, use workMem (keep first `n`, they store `y1`).
|
|
skew(p, q, 1.0, V, V_tau, 0.0, workMem);
|
|
err = norm(workMem, p, p, "F");
|
|
|
|
// Shift next step to current step and store loss to last.
|
|
memcpy(V, V_tau, p * q * sizeof(double));
|
|
loss_last = loss;
|
|
|
|
if (logger) {
|
|
callLogger(logger, loggerEnv,
|
|
attempt, epoch + 1,
|
|
L, n, V, p, q, tau);
|
|
}
|
|
|
|
// Check Break condition.
|
|
if (err < tol || epoch + 1 >= epochs) {
|
|
break;
|
|
}
|
|
|
|
/* Continue computing the gradient. */
|
|
/* Calc the scaling vector used for final computation of grad. */
|
|
scaling(n, Y, y1, L, vecD, vecK, colSums, vecS);
|
|
|
|
/* Compute the eucledian gradient `G`. */
|
|
rowSweep(X_diff, nn, p, "*", vecS, X_proj);
|
|
crossprod(X_diff, nn, p, X_proj, nn, p, workMem);
|
|
matrixprod(workMem, p, p, V, p, q, G);
|
|
scale(-2. / (((double)n) * h * h), G, p * q); // in-place
|
|
|
|
/* Compute Skew-Symmetric matrix `A` used in Cayley transform.
|
|
+ `A <- tau * (G V^T - V G^T) + 0 * A`*/
|
|
skew(p, q, tau, G, V, 0.0, A);
|
|
}
|
|
|
|
/* Check if current attempt improved previous ones */
|
|
if (attempt == 0 || loss < loss_best) {
|
|
loss_best = loss;
|
|
memcpy(V_best, V, p * q * sizeof(double));
|
|
memcpy(L_best, L, n * sizeof(double));
|
|
}
|
|
}
|
|
|
|
memcpy(V, V_best, p * q * sizeof(double));
|
|
memcpy(L, L_best, n * sizeof(double));
|
|
}
|