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 534, Tue Feb 8 08:59:31 2005 UTC revision 592, Thu Mar 3 05:16:50 2005 UTC
# Line 2  Line 2 
2    
3  SEXP dsCMatrix_validate(SEXP obj)  SEXP dsCMatrix_validate(SEXP obj)
4  {  {
5      SEXP uplo = GET_SLOT(obj, Matrix_uploSym);      SEXP val = check_scalar_string(GET_SLOT(obj, Matrix_uploSym),
6                                       "LU", "uplo");
7      int *Dim = INTEGER(GET_SLOT(obj, Matrix_DimSym));      int *Dim = INTEGER(GET_SLOT(obj, Matrix_DimSym));
     char *val;  
8    
9      if (length(uplo) != 1)      if (isString(val)) return val;
         return mkString("uplo slot must have length 1");  
     val = CHAR(STRING_ELT(uplo, 0));  
     if (strlen(val) != 1)  
         return mkString("uplo[1] must have string length 1");  
     if (*val != 'U' && *val != 'L')  
         return mkString("uplo[1] must be \"U\" or \"L\"");  
10      if (Dim[0] != Dim[1])      if (Dim[0] != Dim[1])
11          return mkString("Symmetric matrix must be square");          return mkString(_("Symmetric matrix must be square"));
12      csc_check_column_sorting(obj);      csc_check_column_sorting(obj);
13      return ScalarLogical(1);      return ScalarLogical(1);
14  }  }
# Line 86  Line 80 
80                           (piv) ? P : (int *)NULL,                           (piv) ? P : (int *)NULL,
81                           (piv) ? Pinv : (int *)NULL);                           (piv) ? Pinv : (int *)NULL);
82      if (info != n)      if (info != n)
83          error("Leading minor of size %d (possibly after permutation) is indefinite",          error(_("Leading minor of size %d (possibly after permutation) is indefinite"),
84                info + 1);                info + 1);
85      if (piv) {      if (piv) {
86          Free(Pinv); Free(Ax); Free(Ai); Free(Ap);          Free(Pinv); Free(Ax); Free(Ai); Free(Ap);
# Line 105  Line 99 
99      double *Lx, *D, *in = REAL(b), *out = REAL(val), *tmp = (double *) NULL;      double *Lx, *D, *in = REAL(b), *out = REAL(val), *tmp = (double *) NULL;
100    
101      if (!(isReal(b) && isMatrix(b)))      if (!(isReal(b) && isMatrix(b)))
102          error("Argument b must be a numeric matrix");          error(_("Argument b must be a numeric matrix"));
103      if (*adims != *bdims || bdims[1] < 1 || *adims < 1)      if (*adims != *bdims || bdims[1] < 1 || *adims < 1)
104          error("Dimensions of system to be solved are inconsistent");          error(_("Dimensions of system to be solved are inconsistent"));
105      if (Chol == R_NilValue) Chol = dsCMatrix_chol(a, ScalarLogical(1));      if (Chol == R_NilValue) Chol = dsCMatrix_chol(a, ScalarLogical(1));
106      perm = GET_SLOT(Chol, Matrix_permSym);      perm = GET_SLOT(Chol, Matrix_permSym);
107      piv = length(perm);      piv = length(perm);
# Line 136  Line 130 
130    
131  SEXP ssc_transpose(SEXP x)  SEXP ssc_transpose(SEXP x)
132  {  {
133      SEXP      SEXP ans = PROTECT(NEW_OBJECT(MAKE_CLASS("dsCMatrix"))),
         ans = PROTECT(NEW_OBJECT(MAKE_CLASS("dsCMatrix"))),  
134          islot = GET_SLOT(x, Matrix_iSym);          islot = GET_SLOT(x, Matrix_iSym);
135      int nnz = length(islot),      int nnz = length(islot), *adims,
         *adims = INTEGER(GET_SLOT(ans, Matrix_DimSym)),  
136          *xdims = INTEGER(GET_SLOT(x, Matrix_DimSym));          *xdims = INTEGER(GET_SLOT(x, Matrix_DimSym));
137    
138        adims = INTEGER(ALLOC_SLOT(ans, Matrix_DimSym, INTSXP, 2));
139      adims[0] = xdims[1]; adims[1] = xdims[0];      adims[0] = xdims[1]; adims[1] = xdims[0];
140      if (CHAR(asChar(GET_SLOT(x, Matrix_uploSym)))[0] == 'U')      if (CHAR(asChar(GET_SLOT(x, Matrix_uploSym)))[0] == 'U')
141          SET_SLOT(ans, Matrix_uploSym, mkString("L"));          SET_SLOT(ans, Matrix_uploSym, mkString("L"));
142      SET_SLOT(ans, Matrix_pSym, allocVector(INTSXP, xdims[0] + 1));      csc_compTr(xdims[0], xdims[1], nnz,
143      SET_SLOT(ans, Matrix_iSym, allocVector(INTSXP, nnz));                 INTEGER(GET_SLOT(x, Matrix_pSym)), INTEGER(islot),
     SET_SLOT(ans, Matrix_xSym, allocVector(REALSXP, nnz));  
     csc_components_transpose(xdims[0], xdims[1], nnz,  
                              INTEGER(GET_SLOT(x, Matrix_pSym)),  
                              INTEGER(islot),  
144                               REAL(GET_SLOT(x, Matrix_xSym)),                               REAL(GET_SLOT(x, Matrix_xSym)),
145                               INTEGER(GET_SLOT(ans, Matrix_pSym)),                 INTEGER(ALLOC_SLOT(ans, Matrix_pSym, INTSXP, xdims[0] + 1)),
146                               INTEGER(GET_SLOT(ans, Matrix_iSym)),                 INTEGER(ALLOC_SLOT(ans, Matrix_iSym, INTSXP, nnz)),
147                               REAL(GET_SLOT(ans, Matrix_xSym)));                 REAL(ALLOC_SLOT(ans, Matrix_xSym, REALSXP, nnz)));
148      UNPROTECT(1);      UNPROTECT(1);
149      return ans;      return ans;
150  }  }

Legend:
Removed from v.534  
changed lines
  Added in v.592

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