The R Project SVN – R-packages – Diff – /branches/Matrix-APIchange/src/CHMfactor.c



 
SEXP CHMfactor_to_sparse(SEXP x)
{
    CHM_FR L = AS_CHM_FR(x), Lcp;
    CHM_SP Lm;
    R_CheckStack();
 
    /* cholmod_factor_to_sparse changes its first argument. Make a copy */
    Lcp = cholmod_copy_factor(L, &c);
    if (!(Lcp->is_ll))
	if (!cholmod_change_factor(Lcp->xtype, 1, 0, 1, 1, Lcp, &c))
	    error(_("cholmod_change_factor failed with status %d"), c.status);
    Lm = cholmod_factor_to_sparse(Lcp, &c); cholmod_free_factor(&Lcp, &c);
    return chm_sparse_to_SEXP(Lm, 1/*do_free*/, -1/*uploT*/, 0/*Rkind*/,

{
    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 */
	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));
}
 
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 */
	error(_("system argument is not valid"));
    return chm_sparse_to_SEXP(cholmod_spsolve(sys, L, B, &c),
			      1/*do_free*/, 0/*uploT*/, 0/*Rkind*/,

The R Project SVN R-packages

(root)/branches/Matrix-APIchange/src/CHMfactor.c – Rev 4530 → 4558

Rev 4530		Rev 4558
Line 3...		Line 3...
3		3
4	`SEXP CHMfactor_to_sparse(SEXP x)`	4	`SEXP CHMfactor_to_sparse(SEXP x)`
5	`{`	5	`{`
6	`CHM_FR L = AS_CHM_FR(x), Lcp;`	6	`CHM_FR L = AS_CHM_FR(x), Lcp;`
7	`CHM_SP Lm;`	7	`CHM_SP Lm;`
-		8	`R_CheckStack();`
8		9
9	`/* cholmod_factor_to_sparse changes its first argument. Make a copy */`	10	`/* cholmod_factor_to_sparse changes its first argument. Make a copy */`
10	`Lcp = cholmod_copy_factor(L, &c);`	11	`Lcp = cholmod_copy_factor(L, &c);`
11	`if (!(Lcp->is_ll))`	12	`if (!(Lcp->is_ll))`
12	`if (!cholmod_change_factor(Lcp->xtype, 1, 0, 1, 1, Lcp, &c))`	13	`if (!cholmod_change_factor(Lcp->xtype, 1, 0, 1, 1, Lcp, &c))`
13	`error(_("cholmod_change_factor failed with status %d"), c.status);`	14	`error(_("cholmod_change_factor failed with status %d"), c.status);`
14	`Lm = cholmod_factor_to_sparse(Lcp, &c); cholmod_free_factor(&Lcp, &c);`	15	`Lm = cholmod_factor_to_sparse(Lcp, &c); cholmod_free_factor(&Lcp, &c);`
15	`return chm_sparse_to_SEXP(Lm, 1/do_free/, -1/uploT/, 0/Rkind/,`	16	`return chm_sparse_to_SEXP(Lm, 1/do_free/, -1/uploT/, 0/Rkind/,`
Line 20...		Line 21...
20	`{`	21	`{`
21	`CHM_FR L = AS_CHM_FR(a);`	22	`CHM_FR L = AS_CHM_FR(a);`
22	`SEXP bb = PROTECT(dup_mMatrix_as_dgeMatrix(b));`	23	`SEXP bb = PROTECT(dup_mMatrix_as_dgeMatrix(b));`
23	`CHM_DN B = AS_CHM_DN(bb), X;`	24	`CHM_DN B = AS_CHM_DN(bb), X;`
24	`int sys = asInteger(system);`	25	`int sys = asInteger(system);`
-		26	`R_CheckStack();`
25		27
26	`if (!(sys--)) /* -- align with CHOLMOD defs */`	28	`if (!(sys--)) /* -- align with CHOLMOD defs */`
27	`error(_("system argument is not valid"));`	29	`error(_("system argument is not valid"));`
28		30
29	`X = cholmod_solve(sys, L, B, &c);`	31	`X = cholmod_solve(sys, L, B, &c);`
30	`UNPROTECT(1);`	32	`UNPROTECT(1);`
31	`return chm_dense_to_SEXP(X, 1/do_free/, 0/Rkind/,`	33	`return chm_dense_to_SEXP(X, 1/do_free/, 0/Rkind/,`
32	`GET_SLOT(bb, Matrix_DimNamesSym));`	34	`GET_SLOT(bb, Matrix_DimNamesSym));`
33	`}`	35	`}`
34		36
35	`SEXP CHMfactor_spsolve(SEXP a, SEXP b, SEXP system)`	37	`SEXP CHMfactor_spsolve(SEXP a, SEXP b, SEXP system)`
36	`{`	38	`{`
37	`CHM_FR L = AS_CHM_FR(a);`	39	`CHM_FR L = AS_CHM_FR(a);`
38	`CHM_SP B = AS_CHM_SP(b);`	40	`CHM_SP B = AS_CHM_SP(b);`
39	`int sys = asInteger(system);`	41	`int sys = asInteger(system);`
-		42	`R_CheckStack();`
40		43
41	`if (!(sys--)) /* -- align with CHOLMOD defs */`	44	`if (!(sys--)) /* -- align with CHOLMOD defs */`
42	`error(_("system argument is not valid"));`	45	`error(_("system argument is not valid"));`
43	`return chm_sparse_to_SEXP(cholmod_spsolve(sys, L, B, &c),`	46	`return chm_sparse_to_SEXP(cholmod_spsolve(sys, L, B, &c),`
44	`1/do_free/, 0/uploT/, 0/Rkind/,`	47	`1/do_free/, 0/uploT/, 0/Rkind/,`