SCM

SCM Repository

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

Diff of /pkg/Matrix/src/dtCMatrix.c

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

revision 1967, Sat Jul 7 22:47:52 2007 UTC revision 1968, Sat Jul 7 22:49:12 2007 UTC
# Line 2  Line 2 
2  #include "dtCMatrix.h"  #include "dtCMatrix.h"
3  #include "cs_utils.h"  #include "cs_utils.h"
4    
5  /* This should be use for *BOTH* triangular and symmetric Csparse: */  #define RETURN(_CH_)   UNPROTECT(1); return (_CH_);
6    
7    /* This is used for *BOTH* triangular and symmetric Csparse: */
8  SEXP tCMatrix_validate(SEXP x)  SEXP tCMatrix_validate(SEXP x)
9  {  {
10      SEXP val = xCMatrix_validate(x);/* checks x slot */      SEXP val = xCMatrix_validate(x);/* checks x slot */
# Line 17  Line 19 
19              *xi = INTEGER(islot),              *xi = INTEGER(islot),
20              *xj = INTEGER(PROTECT(allocVector(INTSXP, nnz)));              *xj = INTEGER(PROTECT(allocVector(INTSXP, nnz)));
21    
 #define RETURN(_CH_)   UNPROTECT(1); return (_CH_);  
   
22          expand_cmprPt(length(pslot) - 1, INTEGER(pslot), xj);          expand_cmprPt(length(pslot) - 1, INTEGER(pslot), xj);
23    
24          /* Maybe FIXME: ">" should be ">="      for diag = 'U' (uplo = 'U') */          /* Maybe FIXME: ">" should be ">="      for diag = 'U' (uplo = 'U') */
# Line 38  Line 38 
38          RETURN(ScalarLogical(1));          RETURN(ScalarLogical(1));
39      }      }
40  }  }
41    
42    /* This is used for *BOTH* triangular and symmetric Rsparse: */
43    SEXP tRMatrix_validate(SEXP x)
44    {
45        SEXP val = xRMatrix_validate(x);/* checks x slot */
46        if(isString(val))
47            return(val);
48        else {
49            SEXP
50                jslot = GET_SLOT(x, Matrix_jSym),
51                pslot = GET_SLOT(x, Matrix_pSym);
52            int uploT = (*uplo_P(x) == 'U'),
53                k, nnz = length(jslot),
54                *xj = INTEGER(jslot),
55                *xi = INTEGER(PROTECT(allocVector(INTSXP, nnz)));
56    
57            expand_cmprPt(length(pslot) - 1, INTEGER(pslot), xi);
58    
59            /* Maybe FIXME: ">" should be ">="      for diag = 'U' (uplo = 'U') */
60            if(uploT) {
61                for (k = 0; k < nnz; k++)
62                    if(xi[k] > xj[k]) {
63                        RETURN(mkString(_("uplo='U' must not have sparse entries in lower diagonal")));
64                    }
65            }
66            else {
67                for (k = 0; k < nnz; k++)
68                    if(xi[k] < xj[k]) {
69                        RETURN(mkString(_("uplo='L' must not have sparse entries in upper diagonal")));
70                    }
71            }
72    
73            RETURN(ScalarLogical(1));
74        }
75    }
76    
77    
78  #undef RETURN  #undef RETURN
79    
80  /**  /**
# Line 124  Line 161 
161      int *xi = Alloca(2*A->n, int);      /* for cs_reach */      int *xi = Alloca(2*A->n, int);      /* for cs_reach */
162      R_CheckStack();      R_CheckStack();
163    
164      SET_SLOT(ans, Matrix_DimSym, duplicate(GET_SLOT(a, Matrix_DimSym)));      slot_dup(ans, a, Matrix_DimSym);
165      SET_DimNames(ans, a);      SET_DimNames(ans, a);
166      SET_SLOT(ans, Matrix_uploSym, duplicate(GET_SLOT(a, Matrix_uploSym)));      slot_dup(ans, a, Matrix_uploSym);
167      SET_SLOT(ans, Matrix_diagSym, duplicate(GET_SLOT(a, Matrix_diagSym)));      slot_dup(ans, a, Matrix_diagSym);
168      /* initialize the "constant part" of the sparse unit vector */      /* initialize the "constant part" of the sparse unit vector */
169      u->x[0] = 1.;      u->x[0] = 1.;
170      u->p[0] = 0; u->p[1] = 1;      u->p[0] = 0; u->p[1] = 1;
# Line 225  Line 262 
262      nz = bp[n];      nz = bp[n];
263      Memcpy(INTEGER(ALLOC_SLOT(ans, Matrix_iSym, INTSXP, nz)), ti, nz);      Memcpy(INTEGER(ALLOC_SLOT(ans, Matrix_iSym, INTSXP, nz)), ti, nz);
264      Memcpy(REAL(ALLOC_SLOT(ans, Matrix_xSym, REALSXP, nz)), tx, nz);      Memcpy(REAL(ALLOC_SLOT(ans, Matrix_xSym, REALSXP, nz)), tx, nz);
265      SET_SLOT(ans, Matrix_DimSym, duplicate(GET_SLOT(a, Matrix_DimSym)));      slot_dup(ans, a, Matrix_DimSym);
266      SET_DimNames(ans, a);      SET_DimNames(ans, a);
267      SET_SLOT(ans, Matrix_uploSym, duplicate(GET_SLOT(a, Matrix_uploSym)));      slot_dup(ans, a, Matrix_uploSym);
268      SET_SLOT(ans, Matrix_diagSym, duplicate(GET_SLOT(a, Matrix_diagSym)));      slot_dup(ans, a, Matrix_diagSym);
269      UNPROTECT(1);      UNPROTECT(1);
270      return ans;      return ans;
271  }  }

Legend:
Removed from v.1967  
changed lines
  Added in v.1968

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