自学教程：C++ GET_SLOT函数代码示例

SEXP Csparse_Csparse_crossprod(SEXP a, SEXP b, SEXP trans){    int tr = asLogical(trans);    CHM_SP	cha = AS_CHM_SP(a),	chb = AS_CHM_SP(b),	chTr, chc;    const char *cl_a = class_P(a), *cl_b = class_P(b);    char diag[] = {'/0', '/0'};    int uploT = 0;    SEXP dn = PROTECT(allocVector(VECSXP, 2));    R_CheckStack();    chTr = cholmod_transpose((tr) ? chb : cha, chb->xtype, &c);    chc = cholmod_ssmult((tr) ? cha : chTr, (tr) ? chTr : chb,			 /*out_stype:*/ 0, cha->xtype, /*out sorted:*/ 1, &c);    cholmod_free_sparse(&chTr, &c);    /* Preserve triangularity and unit-triangularity if appropriate;     * see Csparse_Csparse_prod() for comments */    if (cl_a[1] == 't' && cl_b[1] == 't')	if(*uplo_P(a) != *uplo_P(b)) { /* one 'U', the other 'L' */	    uploT = (*uplo_P(b) == 'U') ? 1 : -1;	    if(*diag_P(a) == 'U' && *diag_P(b) == 'U') { /* return UNIT-triag. */		chm_diagN2U(chc, uploT, /* do_realloc */ FALSE);		diag[0]= 'U';	    }	    else diag[0]= 'N';	}    SET_VECTOR_ELT(dn, 0,	/* establish dimnames */		   duplicate(VECTOR_ELT(GET_SLOT(a, Matrix_DimNamesSym), (tr) ? 0 : 1)));    SET_VECTOR_ELT(dn, 1,		   duplicate(VECTOR_ELT(GET_SLOT(b, Matrix_DimNamesSym), (tr) ? 0 : 1)));    UNPROTECT(1);    return chm_sparse_to_SEXP(chc, 1, uploT, /*Rkind*/0, diag, dn);}

/** * Create credential object from S4 class 'cred_user_pass'. * * @param cred The newly created credential object. * @param allowed_types A bitmask stating which cred types are OK to return. * @param credentials The S4 class object with credentials. * @return 0 on success, else -1. */static int git2r_cred_user_pass(    git_cred **cred,    unsigned int allowed_types,    SEXP credentials){    if (GIT_CREDTYPE_USERPASS_PLAINTEXT & allowed_types) {        const char *username;        const char *password;        username = CHAR(STRING_ELT(                            GET_SLOT(credentials,                                     Rf_install("username")), 0));        password = CHAR(STRING_ELT(                            GET_SLOT(credentials,                                     Rf_install("password")), 0));        if (git_cred_userpass_plaintext_new(cred, username, password))            return -1;        return 0;    }    return -1;}

SEXP tsc_transpose(SEXP x){    SEXP ans = PROTECT(NEW_OBJECT(MAKE_CLASS("dtCMatrix"))),	islot = GET_SLOT(x, Matrix_iSym);    int nnz = length(islot),	*adims, *xdims = INTEGER(GET_SLOT(x, Matrix_DimSym));    int up = uplo_P(x)[0] == 'U';    adims = INTEGER(ALLOC_SLOT(ans, Matrix_DimSym, INTSXP, 2));    adims[0] = xdims[1]; adims[1] = xdims[0];    if(*diag_P(x) == 'U')	SET_SLOT(ans, Matrix_diagSym, duplicate(GET_SLOT(x, Matrix_diagSym)));    SET_SLOT(ans, Matrix_uploSym, mkString(up ? "L" : "U"));    csc_compTr(xdims[0], xdims[1], nnz,	       INTEGER(GET_SLOT(x, Matrix_pSym)), INTEGER(islot),	       REAL(GET_SLOT(x, Matrix_xSym)),	       INTEGER(ALLOC_SLOT(ans, Matrix_pSym, INTSXP, xdims[0] + 1)),	       INTEGER(ALLOC_SLOT(ans, Matrix_iSym, INTSXP, nnz)),	       REAL(ALLOC_SLOT(ans, Matrix_xSym, REALSXP, nnz)));    UNPROTECT(1);    return ans;}

SEXP magChol(SEXP a){   SEXP gpu = GET_SLOT(a, install("gpu")),        b = PROTECT(NEW_OBJECT(MAKE_CLASS("magma")));   int *DIMA = INTEGER(GET_DIM(a)), N = DIMA[0], N2 = N * N, LDB = N, info;   double *B;   if(DIMA[1] != N) error("non-square matrix");   b = SET_SLOT(b, install(".Data"), AS_NUMERIC(a));   SET_SLOT(b, install("gpu"), duplicate(gpu));   B = REAL(b);      if(LOGICAL_VALUE(gpu)) {      double *dB;      magma_malloc((void**)&dB, N2*sizeof(double));      magma_dsetmatrix(N, N, B, LDB, dB, LDB);      magma_dpotrf_gpu(magma_uplo_const('U'), N, dB, LDB, &info);      magma_dgetmatrix(N, N, dB, LDB, B, LDB);      magma_free(dB);   } else {      double *hB;      magma_malloc_pinned((void**)&hB, N2*sizeof(double));      lapackf77_dlacpy(MagmaUpperStr, &N, &N, B, &LDB, hB, &LDB);      magma_dpotrf(magma_uplo_const('U'), N, hB, N, &info);      lapackf77_dlacpy(MagmaUpperStr, &N, &N, hB, &LDB, B, &LDB);      magma_free_pinned(hB);   }   if(info < 0) error("illegal argument %d in 'magChol", -1 * info);   else if(info > 0) error("leading minor of order %d is not positive definite", info);   int i, j;   for(j = 0; j < N; j++) {      for(i = j + 1; i < N; i++) {         B[i + j * N] = 0.0;      }   }   UNPROTECT(1);   return b;}

staticSEXP get_factor_pattern(SEXP obj, char *pat, int offset){    SEXP facs = GET_SLOT(obj, Matrix_factorSym), nms;    int i;    /* Why should this be nessary?  Shouldn't nms have length 0 if facs does? */    if (!LENGTH(facs)) return R_NilValue;    nms = getAttrib(facs, R_NamesSymbol);    for (i = 0; i < LENGTH(nms); i++) {	char *nm = CHAR(STRING_ELT(nms, i));	if (strlen(nm) > offset && !strcmp(pat + offset, nm + offset))	    return VECTOR_ELT(facs, i);    }    return R_NilValue;}

/** * Check commit argument * * @param arg the arg to check * @return 0 if OK, else 1 */int git2r_arg_check_commit(SEXP arg){    SEXP class_name;    if (R_NilValue == arg || S4SXP != TYPEOF(arg))        return 1;    class_name = getAttrib(arg, R_ClassSymbol);    if (0 != strcmp(CHAR(STRING_ELT(class_name, 0)), "git_commit"))        return 1;    if (git2r_arg_check_string(GET_SLOT(arg, Rf_install("hex"))))        return 1;    return 0;}

SEXP dgCMatrix_matrix_solve(SEXP Ap, SEXP b, SEXP give_sparse)// FIXME:  add  'keep_dimnames' as argument{    Rboolean sparse = asLogical(give_sparse);    if(sparse) {	// FIXME: implement this	error(_("dgCMatrix_matrix_solve(.., sparse=TRUE) not yet implemented"));	/* Idea: in the  for(j = 0; j < nrhs ..) loop below, build the *sparse* result matrix	 * ----- *column* wise -- which is perfect for dgCMatrix	 * --> build (i,p,x) slots "increasingly" [well, allocate in batches ..]	 *	 * --> maybe first a protoype in R	 */    }    SEXP ans = PROTECT(dup_mMatrix_as_dgeMatrix(b)),	lu, qslot;    CSP L, U;    int *bdims = INTEGER(GET_SLOT(ans, Matrix_DimSym)), *p, *q;    int j, n = bdims[0], nrhs = bdims[1];    double *x, *ax = REAL(GET_SLOT(ans, Matrix_xSym));    C_or_Alloca_TO(x, n, double);    if (isNull(lu = get_factors(Ap, "LU"))) {	install_lu(Ap, /* order = */ 1, /* tol = */ 1.0, /* err_sing = */ TRUE,		   /* keep_dimnames = */ TRUE);	lu = get_factors(Ap, "LU");    }    qslot = GET_SLOT(lu, install("q"));    L = AS_CSP__(GET_SLOT(lu, install("L")));    U = AS_CSP__(GET_SLOT(lu, install("U")));    R_CheckStack();    if (U->n != n)	error(_("Dimensions of system to be solved are inconsistent"));    if(nrhs >= 1 && n >= 1) {	p = INTEGER(GET_SLOT(lu, Matrix_pSym));	q = LENGTH(qslot) ? INTEGER(qslot) : (int *) NULL;	for (j = 0; j < nrhs; j++) {	    cs_pvec(p, ax + j * n, x, n);  /* x = b(p) */	    cs_lsolve(L, x);	       /* x = L/x */	    cs_usolve(U, x);	       /* x = U/x */	    if (q)		       /* r(q) = x , hence					  r = Q' U{^-1} L{^-1} P b = A^{-1} b */		cs_ipvec(q, x, ax + j * n, n);	    else		Memcpy(ax + j * n, x, n);	}    }    if(n >= SMALL_4_Alloca) Free(x);    UNPROTECT(1);    return ans;}

SEXP CombineSubMapsTransSimple(BigMatrix *oneVox_allSubs, SEXP allVoxs_allSubs, index_type seed, double *pVoxs, index_type nvoxs, index_type nsubs) {    //using namespace Rcpp;        BMAccessorType outMat( *oneVox_allSubs );        if (nvoxs != oneVox_allSubs->ncol())        ::Rf_error("nvoxs must equal oneVox_allSubs->ncol");    if (nsubs != oneVox_allSubs->nrow())        ::Rf_error("nsubs must equal oneVox_allSubs->nrow");        // loop through each subject's map    index_type s = 0;    index_type v = 0;    index_type vv = 0;    LDOUBLE x = 0;    LDOUBLE delta = 0;    LDOUBLE mean = 0;    LDOUBLE M2 = 0;    LDOUBLE stdev = 0;//    CType *inCol;    CType *outCol;    LDOUBLE scaled_x;    BigMatrix *allVoxs_oneSub;    SEXP Rp;    SEXP tmp;    //RObject RallVoxs_oneSub;    for (s=0; s < nsubs; ++s) {        PROTECT(tmp = VECTOR_ELT(allVoxs_allSubs, s));        //RallVoxs_oneSub(tmp);        //Rp = RallVoxs_oneSub.slot("address");        PROTECT(Rp = GET_SLOT(tmp, install("address")));        //tmp = allVoxs_allSubs[s];        //RObject RallVoxs_oneSub(tmp);        //Rp = RallVoxs_oneSub.slot("address");        allVoxs_oneSub = reinterpret_cast<BigMatrix*>(R_ExternalPtrAddr(Rp));        UNPROTECT(2);        BMAccessorType inMat( *allVoxs_oneSub );                for (v=0; v < nvoxs; ++v) {            vv = static_cast<index_type>(pVoxs[v]-1);            outMat[v][s] = static_cast<CType>(inMat[vv][seed]);        }    }        return R_NilValue;}

// n.CMatrix --> [dli].CMatrix  (not going through CHM!)SEXP nz2Csparse(SEXP x, enum x_slot_kind r_kind){    const char *cl_x = class_P(x);    if(cl_x[0] != 'n') error(_("not a 'n.CMatrix'"));    if(cl_x[2] != 'C') error(_("not a CsparseMatrix"));    int nnz = LENGTH(GET_SLOT(x, Matrix_iSym));    SEXP ans;    char *ncl = strdup(cl_x);    double *dx_x; int *ix_x;    ncl[0] = (r_kind == x_double ? 'd' :	      (r_kind == x_logical ? 'l' :	       /* else (for now):  r_kind == x_integer : */ 'i'));    PROTECT(ans = NEW_OBJECT(MAKE_CLASS(ncl)));    // create a correct 'x' slot:    switch(r_kind) {	int i;    case x_double: // 'd'	dx_x = REAL(ALLOC_SLOT(ans, Matrix_xSym, REALSXP, nnz));	for (i=0; i < nnz; i++) dx_x[i] = 1.;	break;    case x_logical: // 'l'	ix_x = LOGICAL(ALLOC_SLOT(ans, Matrix_xSym, LGLSXP, nnz));	for (i=0; i < nnz; i++) ix_x[i] = TRUE;	break;    case x_integer: // 'i'	ix_x = INTEGER(ALLOC_SLOT(ans, Matrix_xSym, INTSXP, nnz));	for (i=0; i < nnz; i++) ix_x[i] = 1;	break;    default:	error(_("nz2Csparse(): invalid/non-implemented r_kind = %d"),	      r_kind);    }    // now copy all other slots :    slot_dup(ans, x, Matrix_iSym);    slot_dup(ans, x, Matrix_pSym);    slot_dup(ans, x, Matrix_DimSym);    slot_dup(ans, x, Matrix_DimNamesSym);    if(ncl[1] != 'g') { // symmetric or triangular ...	slot_dup_if_has(ans, x, Matrix_uploSym);	slot_dup_if_has(ans, x, Matrix_diagSym);    }    UNPROTECT(1);    return ans;}

/** * Get the tree pointed to by a commit * * @param commit S4 class git_commit or git_stash * @return S4 class git_tree */SEXP git2r_commit_tree(SEXP commit){    int err;    SEXP result = R_NilValue;    SEXP repo;    git_commit *commit_obj = NULL;    git_repository *repository = NULL;    git_tree *tree = NULL;    if (git2r_arg_check_commit(commit))        git2r_error(git2r_err_commit_arg, __func__, "commit");    repo = GET_SLOT(commit, Rf_install("repo"));    repository = git2r_repository_open(repo);    if (!repository)        git2r_error(git2r_err_invalid_repository, __func__, NULL);    err = git2r_commit_lookup(&commit_obj, repository, commit);    if (GIT_OK != err)        goto cleanup;    err = git_commit_tree(&tree, commit_obj);    if (GIT_OK != err)        goto cleanup;    PROTECT(result = NEW_OBJECT(MAKE_CLASS("git_tree")));    git2r_tree_init((git_tree*)tree, repo, result);cleanup:    if (commit_obj)        git_commit_free(commit_obj);    if (tree)        git_tree_free(tree);    if (repository)        git_repository_free(repository);    if (R_NilValue != result)        UNPROTECT(1);    if (GIT_OK != err)        git2r_error(git2r_err_from_libgit2, __func__, giterr_last()->message);    return result;}

SEXP CHMfactor_solve(SEXP a, SEXP b, SEXP system){    CHM_FR L = AS_CHM_FR(a);    SEXP bb = PROTECT(dup_mMatrix_as_dgeMatrix(b));    CHM_DN B = AS_CHM_DN(bb), X;    int sys = asInteger(system);    R_CheckStack();    if (!(sys--))		/* align with CHOLMOD defs: R's {1:9} --> {0:8},				   see ./CHOLMOD/Cholesky/cholmod_solve.c */	error(_("system argument is not valid"));    X = cholmod_solve(sys, L, B, &c);    UNPROTECT(1);    return chm_dense_to_SEXP(X, 1/*do_free*/, 0/*Rkind*/,			     GET_SLOT(bb, Matrix_DimNamesSym), FALSE);}

SEXP Rgraphviz_doLayout(SEXP graph, SEXP layoutType, SEXP size) {    /* Will perform a Graphviz layout on a graph */    Agraph_t *g;    SEXP slotTmp, nLayout, cPoints, bb;    /* Extract the Agraph_t pointer from the S4 object */    PROTECT(slotTmp = GET_SLOT(graph, install("agraph")));    CHECK_Rgraphviz_graph(slotTmp);    g = R_ExternalPtrAddr(slotTmp);    if (size != R_NilValue) {        agsafeset(g, "size", CHAR(STRING_ELT(size, 0)), NULL);    }    /* Call the appropriate Graphviz layout routine */    gvLayout(gvc, g, CHAR(STRING_ELT(layoutType, 0)));    /*    if (!isInteger(layoutType))        error("layoutType must be an integer value");    else {        gvLayout(gvc, g, layouts[INTEGER(layoutType)[0]]);    }    */    /* Here we want to extract information for the resultant S4       object */    PROTECT(nLayout = getNodeLayouts(g));    PROTECT(bb = getBoundBox(g));    PROTECT(cPoints = getEdgeLocs(g));    SET_SLOT(graph, Rf_install("agraph"), slotTmp);    SET_SLOT(graph,Rf_install("AgNode"), nLayout);    SET_SLOT(graph,Rf_install("laidout"), Rgraphviz_ScalarLogicalFromRbool(TRUE));    SET_SLOT(graph,Rf_install("AgEdge"), cPoints);    SET_SLOT(graph,Rf_install("boundBox"), bb);    SET_SLOT(graph,Rf_install("fg"), Rgraphviz_ScalarStringOrNull(agget(g, "fgcolor")));    SET_SLOT(graph,Rf_install("bg"), Rgraphviz_ScalarStringOrNull(agget(g, "bgcolor")));    UNPROTECT(4);    /* free gvc after rendering */    gvFreeLayout(gvc, g);    return(graph);}

SEXPR_duplicateArray(SEXP r_ref, SEXP r_size, SEXP r_elementDup){    void *array, *copy;    size_t numBytes = (size_t) REAL(r_size)[0];    SEXP r_ans, tmp;    array = R_getNativeReference(r_ref, NULL, NULL);    copy = malloc( numBytes );    if(!copy) {	    PROBLEM "Cannot allocate %lf bytes to copy native array", REAL(r_size)[0]	    ERROR;    }    memcpy(copy, array, numBytes);    tmp = GET_SLOT(r_ref, Rf_install("ref"));    r_ans = R_MakeExternalPtr(copy, R_ExternalPtrTag(tmp), R_ExternalPtrProtected(tmp));    return(r_ans);}

/* Csparse_drop(x, tol):  drop entries with absolute value < tol, i.e,*  at least all "explicit" zeros */SEXP Csparse_drop(SEXP x, SEXP tol){    const char *cl = class_P(x);    /* dtCMatrix, etc; [1] = the second character =?= 't' for triangular */    int tr = (cl[1] == 't');    CHM_SP chx = AS_CHM_SP__(x);    CHM_SP ans = cholmod_l_copy(chx, chx->stype, chx->xtype, &c);    double dtol = asReal(tol);    int Rkind = (chx->xtype != CHOLMOD_PATTERN) ? Real_kind(x) : 0;    R_CheckStack();    if(!cholmod_l_drop(dtol, ans, &c))	error(_("cholmod_l_drop() failed"));    return chm_sparse_to_SEXP(ans, 1,			      tr ? ((*uplo_P(x) == 'U') ? 1 : -1) : 0,			      Rkind, tr ? diag_P(x) : "",			      GET_SLOT(x, Matrix_DimNamesSym));}

/* * --- .Call ENTRY POINT --- */SEXP SimpleIRangesList_isNormal(SEXP x){	SEXP list_ir, ans, ans_names;	IRanges_holder ir_holder;	int x_len, i;	list_ir = GET_SLOT(x, install("listData"));	x_len = LENGTH(list_ir);	PROTECT(ans = NEW_LOGICAL(x_len));	for (i = 0; i < x_len; i++) {		ir_holder = _hold_IRanges(VECTOR_ELT(list_ir, i));		LOGICAL(ans)[i] = _is_normal_IRanges_holder(&ir_holder);	}	PROTECT(ans_names = duplicate(GET_NAMES(list_ir)));	SET_NAMES(ans, ans_names);	UNPROTECT(2);	return ans;}

SEXPR_setVariant(SEXP svar, SEXP value, SEXP type){  VARIANT *var;  var = (VARIANT *)R_ExternalPtrAddr(GET_SLOT(svar, Rf_install("ref")));  if(!var) {    PROBLEM "Null VARIANT value passed to R_setVariant. Was this saved in another session/n"   ERROR;  }  HRESULT hr;  hr = R_convertRObjectToDCOM(value, var);  SEXP ans;  ans = NEW_LOGICAL(1);  LOGICAL_DATA(ans)[0] = hr == S_OK ? TRUE : FALSE;  return(ans);}

static ReactionGlyph_t *rsbml_build_doc_reaction_glyph(SEXP r_reaction_glyph){  ReactionGlyph_t * reaction_glyph;  SEXP r_curve = GET_SLOT(r_reaction_glyph, install("curve"));    reaction_glyph = ReactionGlyph_create();    rsbml_build_doc_base_graphical_object((GraphicalObject_t *)reaction_glyph, r_reaction_glyph);    SET_ATTR(ReactionGlyph, reaction_glyph, ReactionId, reaction, STRING);  if (GET_LENGTH(r_curve))    ReactionGlyph_setCurve(reaction_glyph, rsbml_build_doc_curve(r_curve));  ADD_LIST(ReactionGlyph, reaction_glyph, SpeciesReferenceGlyph,     speciesReferenceGlyphs, species_reference_glyph);    return reaction_glyph;}

SEXP csc_col_permute(SEXP x, SEXP perm){    SEXP val = PROTECT(NEW_OBJECT(MAKE_CLASS("dgCMatrix"))), tmp;    int *iperm, *prm, *vi, *vp, *xi, *xp, j, k, ncol, pos;    double *vx, *xx;    SET_SLOT(val, Matrix_factorSym, allocVector(VECSXP, 0));    tmp = GET_SLOT(x, Matrix_DimSym);    SET_SLOT(val, Matrix_DimSym, duplicate(tmp));    ncol = INTEGER(tmp)[1];    if (!(isInteger(perm) && length(perm) == ncol))	error(_("perm must be an integer vector of length %d"),	      ncol);    prm = INTEGER(perm);    if (!R_ldl_valid_perm(ncol, prm))	error(_("perm is not a valid 0-based permutation"));    iperm = Calloc(ncol, int);    for (j = 0; j < ncol; j++) iperm[prm[j]] = j;    tmp = GET_SLOT(x, Matrix_pSym);    xp = INTEGER(tmp);    SET_SLOT(val, Matrix_pSym, duplicate(tmp));    vp = INTEGER(GET_SLOT(val, Matrix_pSym));    tmp = GET_SLOT(x, Matrix_iSym);    xi = INTEGER(tmp);    SET_SLOT(val, Matrix_iSym, duplicate(tmp));    vi = INTEGER(GET_SLOT(val, Matrix_iSym));    tmp = GET_SLOT(x, Matrix_xSym);    xx = REAL(tmp);    SET_SLOT(val, Matrix_xSym, duplicate(tmp));    vx = REAL(GET_SLOT(val, Matrix_xSym));    pos = vp[0] = 0;    for (j = 0; j < ncol; j++) {	int jj = iperm[j];	int j1 = xp[jj], j2 = xp[jj+1];	vp[j + 1] = vp[j] + (j2 - j1);	for (k = j1; k < j2; k++) {	    vi[pos] = xi[k];	    vx[pos] = xx[k];	    pos++;	}    }    Free(iperm);    UNPROTECT(1);    return val;}

SEXP Csparse_transpose(SEXP x, SEXP tri){    /* TODO: lgCMatrix & igC* currently go via double prec. cholmod -     *       since cholmod (& cs) lacks sparse 'int' matrices */    CHM_SP chx = AS_CHM_SP__(x);    int Rkind = (chx->xtype != CHOLMOD_PATTERN) ? Real_kind(x) : 0;    CHM_SP chxt = cholmod_l_transpose(chx, chx->xtype, &c);    SEXP dn = PROTECT(duplicate(GET_SLOT(x, Matrix_DimNamesSym))), tmp;    int tr = asLogical(tri);    R_CheckStack();    tmp = VECTOR_ELT(dn, 0);	/* swap the dimnames */    SET_VECTOR_ELT(dn, 0, VECTOR_ELT(dn, 1));    SET_VECTOR_ELT(dn, 1, tmp);    UNPROTECT(1);    return chm_sparse_to_SEXP(chxt, 1, /* SWAP 'uplo' for triangular */			      tr ? ((*uplo_P(x) == 'U') ? -1 : 1) : 0,			      Rkind, tr ? diag_P(x) : "", dn);}

void onSet_SW_SKY(SEXP sxp_SW_SKY) {	int i, k = 6;	SW_SKY *v = &SW_Sky;	RealD *p_Cloud;	PROTECT(sxp_SW_SKY);	p_Cloud = REAL(GET_SLOT(sxp_SW_SKY, install("Cloud")));	MyFileName = SW_F_name(eSky);	for (i = 0; i < 12; i++) { //i=columns		v->cloudcov[i] = p_Cloud[0 + k * i];		v->windspeed[i] = p_Cloud[1 + k * i];		v->r_humidity[i] = p_Cloud[2 + k * i];		v->transmission[i] = p_Cloud[3 + k * i];		v->snow_density[i] = p_Cloud[4 + k * i];		v->n_rain_per_day[i] = p_Cloud[5 + k * i];	}	UNPROTECT(1);}

SEXP dsyMatrix_solve(SEXP a){    SEXP trf = dsyMatrix_trf(a);    SEXP val = PROTECT(NEW_OBJECT(MAKE_CLASS("dsyMatrix")));    int *dims = INTEGER(GET_SLOT(trf, Matrix_DimSym)), info;    SET_SLOT(val, Matrix_uploSym, duplicate(GET_SLOT(trf, Matrix_uploSym)));    SET_SLOT(val, Matrix_xSym, duplicate(GET_SLOT(trf, Matrix_xSym)));    SET_SLOT(val, Matrix_DimSym, duplicate(GET_SLOT(trf, Matrix_DimSym)));    SET_SLOT(val, Matrix_rcondSym, duplicate(GET_SLOT(a, Matrix_rcondSym)));    F77_CALL(dsytri)(uplo_P(val), dims,		     REAL(GET_SLOT(val, Matrix_xSym)), dims,		     INTEGER(GET_SLOT(trf, Matrix_permSym)),		     (double *) R_alloc((long) dims[0], sizeof(double)),		     &info);    UNPROTECT(1);    return val;}

SEXP rgeos_delaunaytriangulation(SEXP env, SEXP obj, SEXP tol,  SEXP onlyEdges) {    GEOSContextHandle_t GEOShandle = getContextHandle(env);    double tolerance = NUMERIC_POINTER(tol)[0];    int oE = INTEGER_POINTER(onlyEdges)[0];    int pc=0;    SEXP ans, id;        SEXP p4s = GET_SLOT(obj, install("proj4string"));    GEOSGeom geom = rgeos_convert_R2geos(env, obj);    GEOSGeom resgeom = GEOSDelaunayTriangulation_r(GEOShandle, geom,        tolerance, oE);    if (resgeom == NULL)            error("rgeos_delaunaytriangulation: unable to compute");    GEOSGeom_destroy_r(GEOShandle, geom);//    int type = GEOSGeomTypeId_r(GEOShandle, resgeom);    int ng = GEOSGetNumGeometries_r(GEOShandle, resgeom);//Rprintf("ng: %d, type: %d, %s/n", ng, type, GEOSGeomType_r(GEOShandle, resgeom));// FIXME convert type 5 to type 7    char buf[BUFSIZ];    PROTECT(id = NEW_CHARACTER(ng)); pc++;    for (int i=0; i<ng; i++) {        sprintf(buf, "%d", i);        SET_STRING_ELT(id, i, COPY_TO_USER_STRING(buf));    }    ans = rgeos_convert_geos2R(env, resgeom, p4s, id);     UNPROTECT(pc);    return(ans);}

SEXPR_wxSize_new(SEXP r_width, SEXP r_height, SEXP r_addFinalizer){    int width = asInteger(r_width);    int height = asInteger(r_height);        R_CFinalizer_t finalizer = NULL;    wxSize *ans = new wxSize(width, height);    SEXP r_ans = R_make_wx_Ref(ans, "wxSize");    if(TYPEOF(r_addFinalizer) == LGLSXP && LOGICAL(r_addFinalizer)[0])        finalizer = R_finalize_wxSize;        if(finalizer) {       SEXP tmp = GET_SLOT(r_ans, Rf_install("ref"));       R_RegisterCFinalizer(tmp, finalizer);    }    return(r_ans);}

static SpeciesReferenceGlyph_t *rsbml_build_doc_species_reference_glyph(SEXP r_species_reference_glyph){  SpeciesReferenceGlyph_t * species_reference_glyph;  SEXP r_curve = GET_SLOT(r_species_reference_glyph, install("curve"));    species_reference_glyph = SpeciesReferenceGlyph_create();    rsbml_build_doc_base_graphical_object((GraphicalObject_t *)species_reference_glyph,     r_species_reference_glyph);    SET_ATTR(SpeciesReferenceGlyph, species_reference_glyph, SpeciesGlyphId, speciesGlyph, STRING);  SET_ATTR(SpeciesReferenceGlyph, species_reference_glyph, SpeciesReferenceId, speciesReference, STRING);  // FIXME: SpeciesReferenceGlyph_setRole is not exported  /*SET_ATTR(SpeciesReferenceGlyph, species_reference_glyph, Role, role, STRING);*/  if (GET_LENGTH(r_curve))    SpeciesReferenceGlyph_setCurve(species_reference_glyph, rsbml_build_doc_curve(r_curve));    return species_reference_glyph;}

SEXP CHMfactor_spsolve(SEXP a, SEXP b, SEXP system){    CHM_FR L = AS_CHM_FR(a);    CHM_SP B = AS_CHM_SP__(b);    int sys = asInteger(system);    R_CheckStack();    if (!(sys--))		/* align with CHOLMOD defs: R's {1:9} --> {0:8},				   see ./CHOLMOD/Cholesky/cholmod_solve.c */	error(_("system argument is not valid"));    // dimnames:    SEXP dn = PROTECT(allocVector(VECSXP, 2));    // none from a: our CHMfactor objects have no dimnames    SET_VECTOR_ELT(dn, 1, duplicate(VECTOR_ELT(GET_SLOT(b, Matrix_DimNamesSym), 1)));    UNPROTECT(1);    return chm_sparse_to_SEXP(cholmod_spsolve(sys, L, B, &c),			      1/*do_free*/, 0/*uploT*/, 0/*Rkind*/, "", dn);}

SEXP csc_matrix_mm(SEXP a, SEXP b, SEXP classed, SEXP right){    int cl = asLogical(classed), rt = asLogical(right);    SEXP val = PROTECT(NEW_OBJECT(MAKE_CLASS("dgeMatrix")));    int *adims = INTEGER(GET_SLOT(a, Matrix_DimSym)),	*ai = INTEGER(GET_SLOT(a, Matrix_iSym)),	*ap = INTEGER(GET_SLOT(a, Matrix_pSym)),	*bdims = INTEGER(cl ? GET_SLOT(b, Matrix_DimSym) :			 getAttrib(b, R_DimSymbol)),	*cdims = INTEGER(ALLOC_SLOT(val, Matrix_DimSym, INTSXP, 2)),	chk, ione = 1, j, jj, k, m, n;    double *ax = REAL(GET_SLOT(a, Matrix_xSym)),	*bx = REAL(cl ? GET_SLOT(b, Matrix_xSym) : b), *cx;    if (rt) {	m = bdims[0]; n = adims[1]; k = bdims[1]; chk = adims[0];    } else {	m = adims[0]; n = bdims[1]; k = adims[1]; chk = bdims[0];    }    if (chk != k)	error(_("Matrices are not conformable for multiplication"));    if (m < 1 || n < 1 || k < 1)	error(_("Matrices with zero extents cannot be multiplied"));    cx = REAL(ALLOC_SLOT(val, Matrix_xSym, REALSXP, m * n));    AZERO(cx, m * n); /* zero the accumulators */    for (j = 0; j < n; j++) { /* across columns of c */	if (rt) {	    int kk, k2 = ap[j + 1];	    for (kk = ap[j]; kk < k2; kk++) {		F77_CALL(daxpy)(&m, &ax[kk], &bx[ai[kk]*m],				&ione, &cx[j*m], &ione);	    }	} else {	    double *ccol = cx + j * m,		*bcol = bx + j * k;	    for (jj = 0; jj < k; jj++) { /* across columns of a */		int kk, k2 = ap[jj + 1];		for (kk = ap[jj]; kk < k2; kk++) {		    ccol[ai[kk]] += ax[kk] * bcol[jj];		}	    }	}    }    cdims[0] = m; cdims[1] = n;    UNPROTECT(1);    return val;}