CVE/benchmark.h

#ifndef CVE_INCLUDE_GUARD_
#define CVE_INCLUDE_GUARD_

#include <Rinternals.h>

#define CVE_MEM_CHUNK_SMALL 1016
#define CVE_MEM_CHUNK_SIZE 2032

void rowSums(const double *A,
             const int nrow, const int ncol,
             double *sum);
SEXP R_rowSums(SEXP A) {
    SEXP sums = PROTECT(allocVector(REALSXP, nrows(A)));

    rowSums(REAL(A), nrows(A), ncols(A), REAL(sums));

    UNPROTECT(1);
    return sums;
}
void rowSumsV2(const double *A,
               const int nrow, const int ncol,
               double *sum);
SEXP R_rowSumsV2(SEXP A) {
    SEXP sums = PROTECT(allocVector(REALSXP, nrows(A)));

    rowSumsV2(REAL(A), nrows(A), ncols(A), REAL(sums));

    UNPROTECT(1);
    return sums;
}
void rowSumsV3(const double *A,
               const int nrow, const int ncol,
               double *sum);
SEXP R_rowSumsV3(SEXP A) {
    SEXP sums = PROTECT(allocVector(REALSXP, nrows(A)));

    rowSumsV3(REAL(A), nrows(A), ncols(A), REAL(sums));

    UNPROTECT(1);
    return sums;
}

void colSums(const double *A,
             const int nrow, const int ncol,
             double *sum);
SEXP R_colSums(SEXP A) {
    SEXP sums = PROTECT(allocVector(REALSXP, ncols(A)));

    colSums(REAL(A), nrows(A), ncols(A), REAL(sums));

    UNPROTECT(1);
    return sums;
}

void rowSquareSums(const double*, const int, const int, double*);
SEXP R_rowSquareSums(SEXP A) {
    SEXP result = PROTECT(allocVector(REALSXP, nrows(A)));

    rowSquareSums(REAL(A), nrows(A), ncols(A), REAL(result));

    UNPROTECT(1);
    return result;
}

void rowSumsSymVec(const double *Avec, const int nrow,
                   const double diag,
                   double *sum);
SEXP R_rowSumsSymVec(SEXP Avec, SEXP nrow, SEXP diag) {
    SEXP sum = PROTECT(allocVector(REALSXP, *INTEGER(nrow)));

    rowSumsSymVec(REAL(Avec), *INTEGER(nrow), *REAL(diag), REAL(sum));

    UNPROTECT(1);
    return sum;
}

void rowSweep(const double *A, const int nrow, const int ncol,
              const char* op,
              const double *v, // vector of length nrow
              double *C);
SEXP R_rowSweep(SEXP A, SEXP v, SEXP op) {
    SEXP C = PROTECT(allocMatrix(REALSXP, nrows(A), ncols(A)));

    rowSweep(REAL(A), nrows(A), ncols(A),
             CHAR(STRING_ELT(op, 0)),
             REAL(v), REAL(C));

    UNPROTECT(1);
    return C;
}

void transpose(const double *A, const int nrow, const int ncol, double* T);
SEXP R_transpose(SEXP A) {
    SEXP T = PROTECT(allocMatrix(REALSXP, ncols(A), nrows(A)));

    transpose(REAL(A), nrows(A), ncols(A), REAL(T));

    UNPROTECT(1); /* T */
    return T;
}

void sympMV(const double* vecA, const int nrow, const double* x, double* y);
SEXP R_sympMV(SEXP vecA, SEXP x) {
    SEXP y = PROTECT(allocVector(REALSXP, length(x)));

    sympMV(REAL(vecA), length(x), REAL(x), REAL(y));

    UNPROTECT(1); /* y */
    return y;
}

void matrixprod(const double *A, const int nrowA, const int ncolA,
                const double *B, const int nrowB, const int ncolB,
                double *C);
SEXP R_matrixprod(SEXP A, SEXP B) {
    SEXP C = PROTECT(allocMatrix(REALSXP, nrows(A), ncols(B)));

    matrixprod(REAL(A), nrows(A), ncols(A),
               REAL(B), nrows(B), ncols(B),
               REAL(C));

    UNPROTECT(1);
    return C;
}

void crossprod(const double* A, const int nrowA, const int ncolA,
               const double* B, const int ncolB, const int nrowB,
               double* C);
SEXP R_crossprod(SEXP A, SEXP B) {
    SEXP C = PROTECT(allocMatrix(REALSXP, ncols(A), ncols(B)));

    crossprod(REAL(A), nrows(A), ncols(A),
              REAL(B), nrows(B), ncols(B),
              REAL(C));

    UNPROTECT(1);
    return C;
}

void kronecker(const double *A, const int nrowA, const int ncolA,
               const double *B, const int nrowB, const int ncolB,
               const char *op,
               double *C);
SEXP R_kronecker(SEXP A, SEXP B, SEXP op) {
    SEXP C = PROTECT(allocMatrix(REALSXP,
                                 nrows(A) * nrows(B),
                                 ncols(A) * ncols(B)));

    kronecker(REAL(A), nrows(A), ncols(A),
              REAL(B), nrows(B), ncols(B),
              CHAR(STRING_ELT(op, 0)),
              REAL(C));

    UNPROTECT(1);
    return C;
}

void skewSymRank2k(const int n, const int k,
                   double alpha, const double *A, const double *B,
                   double beta,
                   double *C);
SEXP R_skewSymRank2k(SEXP A, SEXP B, SEXP alpha, SEXP beta) {
    SEXP C = PROTECT(allocMatrix(REALSXP, nrows(A), nrows(A)));
    memset(REAL(C), 0, nrows(A) * nrows(A) * sizeof(double));

    skewSymRank2k(nrows(A), ncols(A),
                  *REAL(alpha), REAL(A), REAL(B),
                  *REAL(beta), REAL(C));

    UNPROTECT(1);
    return C;
}

void nullProj(const double* B, const int nrowB, const int ncolB,
              double* Q);
SEXP R_nullProj(SEXP B) {
    SEXP Q = PROTECT(allocMatrix(REALSXP, nrows(B), nrows(B)));

    nullProj(REAL(B), nrows(B), ncols(B), REAL(Q));

    UNPROTECT(1);
    return Q;
}

void rangePairs(const int from, const int to, int *pairs);
SEXP R_rangePairs(SEXP from, SEXP to) {
    int start = asInteger(from);
    int end = asInteger(to) + 1;
    int n = end - start;

    SEXP out = PROTECT(allocMatrix(INTSXP, 2, n * (n - 1) / 2));
    rangePairs(start, end, INTEGER(out));

    UNPROTECT(1);
    return out;
}

void grad(const int n, const int p, const int q,
          const double *X,
          const double *X_diff,
          const double *Y,
          const double *V,
          const double h,
          double *G, double *const loss);
SEXP R_grad(SEXP X, SEXP X_diff, SEXP Y, SEXP V, SEXP h) {
    int N = (nrows(X) * (nrows(X) - 1)) / 2;

    SEXP G = PROTECT(allocMatrix(REALSXP, nrows(V), ncols(V)));
    SEXP loss = PROTECT(allocVector(REALSXP, 1));

    grad(nrows(X), ncols(X), ncols(V),
         REAL(X), REAL(X_diff), REAL(Y), REAL(V), *REAL(h),
         REAL(G), REAL(loss));

    UNPROTECT(2);
    return G;
}

#endif /* CVE_INCLUDE_GUARD_ */