SEXP is_hbhmat(SEXP ptr) { SEXP ans = NILSXP, tchk; ext_matrix *e = NULL; PROTECT(ans = allocVector(LGLSXP, 1)); LOGICAL(ans)[0] = 1; /* Object should be external matrix */ PROTECT(tchk = is_extmat(ptr)); /* pointer itself should not be null */ if (LOGICAL(tchk)[0]) { e = R_ExternalPtrAddr(ptr); if (!e) LOGICAL(ans)[0] = 0; } else LOGICAL(ans)[0] = 0; /* finally, type should be `hankel matrix' */ if (LOGICAL(ans)[0] && e && strcmp(e->type, "hbhankel matrix") != 0) LOGICAL(ans)[0] = 0; UNPROTECT(2); return ans; }
SEXP ematmul(SEXP emat, SEXP v, SEXP transposed) { SEXP Y = NILSXP, tchk; /* Perform a type checking */ PROTECT(tchk = is_extmat(emat)); if (LOGICAL(tchk)[0]) { Y = ematmul_unchecked(emat, v, transposed); } else error("pointer provided is not an external matrix"); UNPROTECT(1); return Y; }
SEXP extmat_ncol(SEXP ptr) { SEXP tchk; SEXP ans = NILSXP; /* Perform a type checking */ PROTECT(tchk = is_extmat(ptr)); if (LOGICAL(tchk)[0]) { ext_matrix *e = R_ExternalPtrAddr(ptr); PROTECT(ans = allocVector(INTSXP, 1)); INTEGER(ans)[0] = e->ncol(e->matrix); UNPROTECT(1); } else error("pointer provided is not an external matrix"); UNPROTECT(1); return ans; }