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 492, Thu Feb 3 14:24:03 2005 UTC revision 587, Wed Mar 2 18:19:15 2005 UTC
# Line 7  Line 7 
7      char *val;      char *val;
8    
9      if (length(uplo) != 1)      if (length(uplo) != 1)
10          return ScalarString(mkChar("uplo slot must have length 1"));          return mkString(_("uplo slot must have length 1"));
11      val = CHAR(STRING_ELT(uplo, 0));      val = CHAR(STRING_ELT(uplo, 0));
12      if (strlen(val) != 1)      if (strlen(val) != 1)
13          return ScalarString(mkChar("uplo[1] must have string length 1"));          return mkString(_("uplo[1] must have string length 1"));
14      if (toupper(*val) != 'U' && toupper(*val) != 'L')      if (*val != 'U' && *val != 'L')
15          return ScalarString(mkChar("uplo[1] must be \"U\" or \"L\""));          return mkString(_("uplo[1] must be \"U\" or \"L\""));
16      if (Dim[0] != Dim[1])      if (Dim[0] != Dim[1])
17          return ScalarString(mkChar("Symmetric matrix must be square"));          return mkString(_("Symmetric matrix must be square"));
18      csc_check_column_sorting(obj);      csc_check_column_sorting(obj);
19      return ScalarLogical(1);      return ScalarLogical(1);
20  }  }
# Line 25  Line 25 
25      int *Ai = INTEGER(GET_SLOT(x, Matrix_iSym)),      int *Ai = INTEGER(GET_SLOT(x, Matrix_iSym)),
26          *Ap = INTEGER(pSlot),          *Ap = INTEGER(pSlot),
27          *Lp, *Parent, info,          *Lp, *Parent, info,
28          lo = toupper(CHAR(asChar(GET_SLOT(x, Matrix_uploSym)))[0]) == 'L',          lo = CHAR(asChar(GET_SLOT(x, Matrix_uploSym)))[0] == 'L',
29          n = length(pSlot)-1,          n = length(pSlot)-1,
30          nnz, piv = asLogical(pivot);          nnz, piv = asLogical(pivot);
31      SEXP val = PROTECT(NEW_OBJECT(MAKE_CLASS("dCholCMatrix")));      SEXP val = PROTECT(NEW_OBJECT(MAKE_CLASS("dCholCMatrix")));
# Line 86  Line 86 
86                           (piv) ? P : (int *)NULL,                           (piv) ? P : (int *)NULL,
87                           (piv) ? Pinv : (int *)NULL);                           (piv) ? Pinv : (int *)NULL);
88      if (info != n)      if (info != n)
89          error("Leading minor of size %d (possibly after permutation) is indefinite",          error(_("Leading minor of size %d (possibly after permutation) is indefinite"),
90                info + 1);                info + 1);
91      if (piv) {      if (piv) {
92          Free(Pinv); Free(Ax); Free(Ai); Free(Ap);          Free(Pinv); Free(Ax); Free(Ai); Free(Ap);
# Line 105  Line 105 
105      double *Lx, *D, *in = REAL(b), *out = REAL(val), *tmp = (double *) NULL;      double *Lx, *D, *in = REAL(b), *out = REAL(val), *tmp = (double *) NULL;
106    
107      if (!(isReal(b) && isMatrix(b)))      if (!(isReal(b) && isMatrix(b)))
108          error("Argument b must be a numeric matrix");          error(_("Argument b must be a numeric matrix"));
109      if (*adims != *bdims || bdims[1] < 1 || *adims < 1)      if (*adims != *bdims || bdims[1] < 1 || *adims < 1)
110          error("Dimensions of system to be solved are inconsistent");          error(_("Dimensions of system to be solved are inconsistent"));
111      if (Chol == R_NilValue) Chol = dsCMatrix_chol(a, ScalarLogical(1));      if (Chol == R_NilValue) Chol = dsCMatrix_chol(a, ScalarLogical(1));
112      perm = GET_SLOT(Chol, Matrix_permSym);      perm = GET_SLOT(Chol, Matrix_permSym);
113      piv = length(perm);      piv = length(perm);
# Line 136  Line 136 
136    
137  SEXP ssc_transpose(SEXP x)  SEXP ssc_transpose(SEXP x)
138  {  {
139      SEXP      SEXP ans = PROTECT(NEW_OBJECT(MAKE_CLASS("dsCMatrix"))),
         ans = PROTECT(NEW_OBJECT(MAKE_CLASS("dsCMatrix"))),  
140          islot = GET_SLOT(x, Matrix_iSym);          islot = GET_SLOT(x, Matrix_iSym);
141      int nnz = length(islot),      int nnz = length(islot), *adims,
         *adims = INTEGER(GET_SLOT(ans, Matrix_DimSym)),  
142          *xdims = INTEGER(GET_SLOT(x, Matrix_DimSym));          *xdims = INTEGER(GET_SLOT(x, Matrix_DimSym));
143    
144        adims = INTEGER(ALLOC_SLOT(ans, Matrix_DimSym, INTSXP, 2));
145      adims[0] = xdims[1]; adims[1] = xdims[0];      adims[0] = xdims[1]; adims[1] = xdims[0];
146      if (toupper(CHAR(asChar(GET_SLOT(x, Matrix_uploSym)))[0]) == 'U')      if (CHAR(asChar(GET_SLOT(x, Matrix_uploSym)))[0] == 'U')
147          SET_SLOT(ans, Matrix_uploSym, ScalarString(mkChar("L")));          SET_SLOT(ans, Matrix_uploSym, mkString("L"));
148      SET_SLOT(ans, Matrix_pSym, allocVector(INTSXP, xdims[0] + 1));      csc_compTr(xdims[0], xdims[1], nnz,
149      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),  
150                               REAL(GET_SLOT(x, Matrix_xSym)),                               REAL(GET_SLOT(x, Matrix_xSym)),
151                               INTEGER(GET_SLOT(ans, Matrix_pSym)),                 INTEGER(ALLOC_SLOT(ans, Matrix_pSym, INTSXP, xdims[0] + 1)),
152                               INTEGER(GET_SLOT(ans, Matrix_iSym)),                 INTEGER(ALLOC_SLOT(ans, Matrix_iSym, INTSXP, nnz)),
153                               REAL(GET_SLOT(ans, Matrix_xSym)));                 REAL(ALLOC_SLOT(ans, Matrix_xSym, REALSXP, nnz)));
154      UNPROTECT(1);      UNPROTECT(1);
155      return ans;      return ans;
156  }  }
# Line 214  Line 209 
209          *P = (int *) NULL, *Pinv = (int *) NULL;          *P = (int *) NULL, *Pinv = (int *) NULL;
210    
211    
212      if (toupper(CHAR(asChar(GET_SLOT(x, Matrix_uploSym)))[0]) == 'L') {      if (CHAR(asChar(GET_SLOT(x, Matrix_uploSym)))[0] == 'L') {
213          x = PROTECT(ssc_transpose(x));          x = PROTECT(ssc_transpose(x));
214      } else {      } else {
215          x = PROTECT(duplicate(x));          x = PROTECT(duplicate(x));
# Line 236  Line 231 
231      Parent = INTEGER(VECTOR_ELT(ans, 0));      Parent = INTEGER(VECTOR_ELT(ans, 0));
232      SET_VECTOR_ELT(ans, 1, NEW_OBJECT(MAKE_CLASS("dtCMatrix")));      SET_VECTOR_ELT(ans, 1, NEW_OBJECT(MAKE_CLASS("dtCMatrix")));
233      tsc = VECTOR_ELT(ans, 1);      tsc = VECTOR_ELT(ans, 1);
234      SET_SLOT(tsc, Matrix_uploSym, ScalarString(mkChar("L")));      SET_SLOT(tsc, Matrix_uploSym, mkString("L"));
235      SET_SLOT(tsc, Matrix_diagSym, ScalarString(mkChar("U")));      SET_SLOT(tsc, Matrix_diagSym, mkString("U"));
236      SET_SLOT(tsc, Matrix_DimSym, Dims);      SET_SLOT(tsc, Matrix_DimSym, Dims);
237      SET_SLOT(tsc, Matrix_pSym, allocVector(INTSXP, n + 1));      SET_SLOT(tsc, Matrix_pSym, allocVector(INTSXP, n + 1));
238      Lp = INTEGER(GET_SLOT(tsc, Matrix_pSym));      Lp = INTEGER(GET_SLOT(tsc, Matrix_pSym));

Legend:
Removed from v.492  
changed lines
  Added in v.587

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