160 lines
4.7 KiB
C
160 lines
4.7 KiB
C
#ifndef _CVE_INCLUDE_GUARD_
|
|
#define _CVE_INCLUDE_GUARD_
|
|
|
|
#include <Rinternals.h>
|
|
|
|
#define CVE_MEM_CHUNK_SMALL 1016
|
|
#define CVE_MEM_CHUNK_SIZE 2032
|
|
|
|
static inline 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;
|
|
}
|
|
|
|
static inline 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;
|
|
}
|
|
|
|
static inline 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;
|
|
}
|
|
|
|
static inline 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;
|
|
}
|
|
|
|
static 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;
|
|
}
|
|
|
|
static inline 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;
|
|
}
|
|
|
|
static inline 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;
|
|
}
|
|
|
|
static 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;
|
|
}
|
|
|
|
static inline 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;
|
|
}
|
|
|
|
static inline 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;
|
|
}
|
|
|
|
static void gradient(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_gradient(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));
|
|
|
|
gradient(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_ */
|