#include "cve.h"

// SEXP rStiefel_c(SEXP pin, SEXP qin) {
//     int p = asInteger(pin);
//     int q = asInteger(qin);

//     SEXP Vout = PROTECT(allocMatrix(REALSXP, p, q));

//     int workLen = 2 * (p + 1) * q;
//     double *workMem = (double*)R_alloc(workLen, sizeof(double));

//     rStiefel(p, q, REAL(Vout), workMem, workLen);

//     UNPROTECT(1);
//     return Vout;
// }

SEXP cve(SEXP X, SEXP Y, SEXP k, SEXP h,
         SEXP method,
         SEXP V, // initial
         SEXP momentum, SEXP tau, SEXP tol,
         SEXP slack, SEXP gamma,
         SEXP epochs, SEXP attempts,
         SEXP logger, SEXP loggerEnv) {
    /* Handle logger parameter, set to NULL pointer if not a function. */
    if (!(isFunction(logger) && isEnvironment(loggerEnv))) {
        logger = (void*)0;
    }

    /* Get dimensions. */
    int n = nrows(X);
    int p = ncols(X);
    int q = p - asInteger(k);

    /* Convert types if needed. */
    // TODO: implement! (or leave in calling R code?)

    /* Create output list. */
    SEXP Vout = PROTECT(allocMatrix(REALSXP, p, q));
    SEXP Lout = PROTECT(allocVector(REALSXP, n));

    /* Check `attempts`, if not positive use passed values of `V` as
     * optimization start value without further attempts.
     * Therefor, copy from `V` to `Vout`. */
    if (asInteger(attempts) < 1L) {
        // TODO: Check for 
        memcpy(REAL(Vout), REAL(V), p * q * sizeof(double));
    }

    /* Call CVE simple subroutine. */
    cve_sub(n, p, q,
            REAL(X), REAL(Y), asReal(h),
            asInteger(method),
            asReal(momentum), asReal(tau), asReal(tol),
            asReal(slack), asReal(gamma),
            asInteger(epochs), asInteger(attempts),
            REAL(Vout), REAL(Lout),
            logger, loggerEnv);

    /* Build output list object with names "V", "L" */
    SEXP out = PROTECT(allocVector(VECSXP, 2));
    SET_VECTOR_ELT(out, 0, Vout);
    SET_VECTOR_ELT(out, 1, Lout);
    SEXP names = PROTECT(allocVector(STRSXP, 2));
    SET_STRING_ELT(names, 0, mkChar("V"));
    SET_STRING_ELT(names, 1, mkChar("L"));
    setAttrib(out, R_NamesSymbol, names);

    UNPROTECT(4);
    return out;
}