46 lines
1.8 KiB
C
46 lines
1.8 KiB
C
#include "cve.h"
|
|
|
|
/**
|
|
* Calles a R function passed to the algoritm and supplied intermidiate
|
|
* optimization values for logging the optimization progress.
|
|
* The supplied parameters to the logger functions are as follows:
|
|
* - attempt: Attempts counter.
|
|
* - epoch: Current epoch staring with 0 as initial epoch.
|
|
* - L: Per X_i to X_j pair loss.
|
|
* - V: Current estimated SDR null space basis.
|
|
* - tau: Step-size.
|
|
* - err: Error \eqn{|| V V^T - V_{tau} V_{tau}^T ||}.
|
|
*
|
|
* @param logger Pointer to a SEXP R object representing an R function.
|
|
* @param loggerEnv Pointer to a SEXP R object representing an R environment.
|
|
*/
|
|
void callLogger(SEXP logger, SEXP env,
|
|
const int attempt, const int epoch,
|
|
const double* L, const int lenL,
|
|
const double* V, const int nrowV, const int ncolV,
|
|
const double tau) {
|
|
/* Create R objects to be passed to R logger function. */
|
|
// Attempt is converted from 0-indexed to 1-indexed as R index.
|
|
SEXP R_attempt = PROTECT(ScalarInteger(attempt + 1));
|
|
// No index shift for the epoch because the 0 epoch is before the first
|
|
// optimization step.
|
|
SEXP R_epoch = PROTECT(ScalarInteger(epoch));
|
|
SEXP R_L = PROTECT(allocVector(REALSXP, lenL));
|
|
SEXP R_V = PROTECT(allocMatrix(REALSXP, nrowV, ncolV));
|
|
SEXP R_tau = PROTECT(ScalarReal(tau));
|
|
|
|
/* Copy data to created R objects. */
|
|
memcpy(REAL(R_L), L, lenL * sizeof(double));
|
|
memcpy(REAL(R_V), V, nrowV * ncolV * sizeof(double));
|
|
|
|
/* Create logger function call as R language expression. */
|
|
SEXP R_exp = PROTECT(lang6(logger, R_epoch, R_attempt,
|
|
R_L, R_V, R_tau));
|
|
|
|
/* Evaluate the logger function call expression. */
|
|
eval(R_exp, env);
|
|
|
|
/* Unprotext created R objects. */
|
|
UNPROTECT(6);
|
|
}
|