Example #1
0
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;
}
Example #2
0
File: extmat.c Project: eodus/svd
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;
}
Example #3
0
File: extmat.c Project: eodus/svd
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;
}