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 587, Wed Mar 2 18:19:15 2005 UTC revision 725, Tue May 10 14:50:39 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);
# Line 95  Line 89 
89      return set_factors(xorig, val, "Cholesky");      return set_factors(xorig, val, "Cholesky");
90  }  }
91    
92  SEXP dsCMatrix_matrix_solve(SEXP a, SEXP b)  SEXP dsCMatrix_matrix_solve(SEXP a, SEXP b, SEXP classed)
93  {  {
94        int cl = asLogical(classed);
95      SEXP Chol = get_factors(a, "Cholesky"), perm,      SEXP Chol = get_factors(a, "Cholesky"), perm,
96          val = PROTECT(duplicate(b));          bdP = cl ? GET_SLOT(b, Matrix_DimSym) : getAttrib(b, R_DimSymbol),
97            val = PROTECT(NEW_OBJECT(MAKE_CLASS("dgeMatrix")));
98      int *adims = INTEGER(GET_SLOT(a, Matrix_DimSym)),      int *adims = INTEGER(GET_SLOT(a, Matrix_DimSym)),
99          *bdims = INTEGER(getAttrib(b, R_DimSymbol)),          *bdims = INTEGER(bdP),
100          *Li, *Lp, j, n = adims[1], ncol = bdims[1], piv;          *Li, *Lp, j, piv;
101      double *Lx, *D, *in = REAL(b), *out = REAL(val), *tmp = (double *) NULL;      int n = adims[1], ncol = bdims[1];
102        double *Lx, *D, *in = REAL(cl ? GET_SLOT(b, Matrix_xSym) : b),
103            *out = REAL(ALLOC_SLOT(val, Matrix_xSym, REALSXP, n * ncol)),
104            *tmp = (double *) NULL;
105    
106      if (!(isReal(b) && isMatrix(b)))      if (!cl && !(isReal(b) && isMatrix(b)))
107          error(_("Argument b must be a numeric matrix"));          error(_("Argument b must be a numeric matrix"));
108      if (*adims != *bdims || bdims[1] < 1 || *adims < 1)      if (*adims != *bdims || ncol < 1 || *adims < 1)
109          error(_("Dimensions of system to be solved are inconsistent"));          error(_("Dimensions of system to be solved are inconsistent"));
110      if (Chol == R_NilValue) Chol = dsCMatrix_chol(a, ScalarLogical(1));      if (Chol == R_NilValue) Chol = dsCMatrix_chol(a, ScalarLogical(1));
111        SET_SLOT(val, Matrix_DimSym, duplicate(bdP));
112      perm = GET_SLOT(Chol, Matrix_permSym);      perm = GET_SLOT(Chol, Matrix_permSym);
113      piv = length(perm);      piv = length(perm);
114      if (piv) tmp = Calloc(n, double);      if (piv) tmp = Calloc(n, double);
# Line 145  Line 145 
145      adims[0] = xdims[1]; adims[1] = xdims[0];      adims[0] = xdims[1]; adims[1] = xdims[0];
146      if (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, mkString("L"));          SET_SLOT(ans, Matrix_uploSym, mkString("L"));
148        else
149            SET_SLOT(ans, Matrix_uploSym, mkString("U"));
150      csc_compTr(xdims[0], xdims[1], nnz,      csc_compTr(xdims[0], xdims[1], nnz,
151                 INTEGER(GET_SLOT(x, Matrix_pSym)), INTEGER(islot),                 INTEGER(GET_SLOT(x, Matrix_pSym)), INTEGER(islot),
152                 REAL(GET_SLOT(x, Matrix_xSym)),                 REAL(GET_SLOT(x, Matrix_xSym)),

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

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