//! %*% -- generalized from dge to *ge():
SEXP geMatrix_matrix_mm(SEXP a, SEXP b, SEXP right) {
SEXP
da = PROTECT(dup_mMatrix_as_geMatrix(a)),
db = PROTECT(dup_mMatrix_as_geMatrix(b)),
val = _geMatrix_matrix_mm(da, db, right);
UNPROTECT(2);
return val;
}
SEXP geMatrix_geMatrix_crossprod(SEXP x, SEXP y, SEXP trans)
{
SEXP gx = PROTECT(dup_mMatrix_as_geMatrix(x)),
gy = PROTECT(dup_mMatrix_as_geMatrix(y)),
val = _geMatrix__geMatrix_crossprod(gx, gy, trans);
UNPROTECT(2);
return val;
}
SEXP geMatrix_crossprod(SEXP x, SEXP trans)
{
SEXP y = PROTECT(dup_mMatrix_as_geMatrix(x)),
val = _geMatrix_crossprod(y, trans);
UNPROTECT(1);
return val;
}
SEXP dense_band(SEXP x, SEXP k1P, SEXP k2P)
/* Always returns a full matrix with entries outside the band zeroed
* Class of the value can be [dln]trMatrix or [dln]geMatrix
*/
{
int k1 = asInteger(k1P), k2 = asInteger(k2P);
if (k1 > k2) {
error(_("Lower band %d > upper band %d"), k1, k2);
return R_NilValue; /* -Wall */
}
else {
SEXP ans = PROTECT(dup_mMatrix_as_geMatrix(x));
int *adims = INTEGER(GET_SLOT(ans, Matrix_DimSym)),
j, m = adims[0], n = adims[1],
sqr = (adims[0] == adims[1]),
tru = (k1 >= 0), trl = (k2 <= 0);
const char *cl = class_P(ans);
enum dense_enum { ddense, ldense, ndense
} M_type = ( (cl[0] == 'd') ? ddense :
((cl[0] == 'l') ? ldense : ndense));
#define SET_ZERO_OUTSIDE \
for (j = 0; j < n; j++) { \
int i, i1 = j - k2, i2 = j + 1 - k1; \
if(i1 > m) i1 = m; \
if(i2 < 0) i2 = 0; \
for (i = 0; i < i1; i++) xx[i + j * m] = 0; \
for (i = i2; i < m; i++) xx[i + j * m] = 0; \
}
if(M_type == ddense) {
double *xx = REAL(GET_SLOT(ans, Matrix_xSym));
SET_ZERO_OUTSIDE
}
else { /* (M_type == ldense || M_type == ndense) */
