SCM

SCM Repository

[matrix] Diff of /pkg/src/dsCMatrix.c
ViewVC logotype

Diff of /pkg/src/dsCMatrix.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 184, Sun May 30 22:38:37 2004 UTC revision 209, Thu Jun 3 18:22:56 2004 UTC
# Line 178  Line 178 
178      return ans;      return ans;
179  }  }
180    
181  SEXP sscMatrix_ldl_symbolic(SEXP x)  SEXP sscMatrix_ldl_symbolic(SEXP x, SEXP doPerm)
182  {  {
183      SEXP ans = PROTECT(allocVector(VECSXP, 2));      SEXP Ax, Dims = GET_SLOT(x, Matrix_DimSym),
184      int lo = toupper(CHAR(asChar(GET_SLOT(x, Matrix_uploSym)))[0]) == 'L',          ans = PROTECT(allocVector(VECSXP, 3)), tsc;
185          n = INTEGER(GET_SLOT(x, Matrix_DimSym))[0];      int i, n = INTEGER(Dims)[0], nz, nza,
186            *Ap, *Ai, *Lp, *Li, *Parent,
187            doperm = asLogical(doPerm),
188            *Lnz = (int *) R_alloc(n, sizeof(int)),
189            *Flag = (int *) R_alloc(n, sizeof(int)),
190            *P = (int *) NULL, *Pinv = (int *) NULL;
191    
192      if (lo) x = PROTECT(ssc_transpose(x));  
193        if (toupper(CHAR(asChar(GET_SLOT(x, Matrix_uploSym)))[0]) == 'L') {
194            x = PROTECT(ssc_transpose(x));
195        } else {
196            x = PROTECT(duplicate(x));
197        }
198        Ax = GET_SLOT(x, Matrix_xSym);
199        nza = length(Ax);
200        Ap = INTEGER(GET_SLOT(x, Matrix_pSym));
201        Ai = INTEGER(GET_SLOT(x, Matrix_iSym));
202        if (doperm) {
203            int *perm;
204            SET_VECTOR_ELT(ans, 2, allocVector(INTSXP, n));
205            perm = INTEGER(VECTOR_ELT(ans, 2));
206            ssc_metis_order(n, Ap, Ai, perm, Flag);
207            ssc_symbolic_permute(n, 1, Flag, Ap, Ai);
208        }
209      SET_VECTOR_ELT(ans, 0, allocVector(INTSXP, n));      SET_VECTOR_ELT(ans, 0, allocVector(INTSXP, n));
210      SET_VECTOR_ELT(ans, 1, allocVector(INTSXP, n + 1));      Parent = INTEGER(VECTOR_ELT(ans, 0));
211      ldl_symbolic(n, INTEGER(GET_SLOT(x, Matrix_pSym)),      SET_VECTOR_ELT(ans, 1, NEW_OBJECT(MAKE_CLASS("tscMatrix")));
212                   INTEGER(GET_SLOT(x, Matrix_iSym)),      tsc = VECTOR_ELT(ans, 1);
213                   INTEGER(VECTOR_ELT(ans, 1)), /* Lp */      SET_SLOT(tsc, Matrix_uploSym, ScalarString(mkChar("L")));
214                   INTEGER(VECTOR_ELT(ans, 0)), /* Parent */      SET_SLOT(tsc, Matrix_diagSym, ScalarString(mkChar("U")));
215                   (int *) R_alloc(n, sizeof(int)), /* Lnz */      SET_SLOT(tsc, Matrix_DimSym, Dims);
216                   (int *) R_alloc(n, sizeof(int)), /* Flag */      SET_SLOT(tsc, Matrix_pSym, allocVector(INTSXP, n + 1));
217                   (int *) NULL, (int *) NULL);  /* P & Pinv */      Lp = INTEGER(GET_SLOT(tsc, Matrix_pSym));
218      UNPROTECT(lo ? 2 : 1);      ldl_symbolic(n, Ap, Ai, Lp, Parent, Lnz, Flag, P, Pinv);
219        nz = Lp[n];
220        SET_SLOT(tsc, Matrix_iSym, allocVector(INTSXP, nz));
221        Li = INTEGER(GET_SLOT(tsc, Matrix_iSym));
222        SET_SLOT(tsc, Matrix_xSym, allocVector(REALSXP, nz));
223        for (i = 0; i < nza; i++) REAL(Ax)[i] = 0.00001;
224        for (i = 0; i < n; i++) REAL(Ax)[Ap[i+1]-1] = 10000.;
225        i = ldl_numeric(n, Ap, Ai, REAL(Ax), Lp, Parent, Lnz, Li,
226                        REAL(GET_SLOT(tsc, Matrix_xSym)),
227                        (double *) R_alloc(n, sizeof(double)), /* D */
228                        (double *) R_alloc(n, sizeof(double)), /* Y */
229                        (int *) R_alloc(n, sizeof(int)), /* Pattern */
230                        Flag, P, Pinv);
231        UNPROTECT(2);
232      return ans;      return ans;
233  }  }
234    

Legend:
Removed from v.184  
changed lines
  Added in v.209

root@r-forge.r-project.org
ViewVC Help
Powered by ViewVC 1.0.0  
Thanks to:
Vienna University of Economics and Business Powered By FusionForge