SCM

SCM Repository

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

Diff of /pkg/src/dgeMatrix.c

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

revision 652, Wed Mar 16 01:08:36 2005 UTC revision 694, Mon Apr 18 17:11:32 2005 UTC
# Line 76  Line 76 
76    return ScalarReal(set_rcond(obj, CHAR(asChar(type))));    return ScalarReal(set_rcond(obj, CHAR(asChar(type))));
77  }  }
78    
79  SEXP dgeMatrix_crossprod(SEXP x)  SEXP dgeMatrix_crossprod(SEXP x, SEXP trans)
80  {  {
81        int tr = asLogical(trans);
82      SEXP val = PROTECT(NEW_OBJECT(MAKE_CLASS("dpoMatrix")));      SEXP val = PROTECT(NEW_OBJECT(MAKE_CLASS("dpoMatrix")));
83      int *Dims = INTEGER(GET_SLOT(x, Matrix_DimSym)),      int *Dims = INTEGER(GET_SLOT(x, Matrix_DimSym)),
84          *vDims;          *vDims = INTEGER(ALLOC_SLOT(val, Matrix_DimSym, INTSXP, 2));
85      int i, n = Dims[1];      int i, k = tr ? Dims[1] : Dims[0], n = tr ? Dims[0] : Dims[1];
     int nsqr = n * n;  
86      double one = 1.0, *xvals, zero = 0.0;      double one = 1.0, *xvals, zero = 0.0;
87    
     SET_SLOT(val, Matrix_factorSym, allocVector(VECSXP, 0));  
     SET_SLOT(val, Matrix_rcondSym, allocVector(REALSXP, 0));  
88      SET_SLOT(val, Matrix_uploSym, mkString("U"));      SET_SLOT(val, Matrix_uploSym, mkString("U"));
     SET_SLOT(val, Matrix_DimSym, allocVector(INTSXP, 2));  
     vDims = INTEGER(GET_SLOT(val, Matrix_DimSym));  
89      vDims[0] = vDims[1] = n;      vDims[0] = vDims[1] = n;
90      SET_SLOT(val, Matrix_xSym, allocVector(REALSXP, nsqr));      F77_CALL(dsyrk)("U", tr ? "N" : "T", &n, &k,
91      xvals = REAL(GET_SLOT(val, Matrix_xSym));                      &one, REAL(GET_SLOT(x, Matrix_xSym)), Dims, &zero,
92      for (i = 0; i < nsqr; i++) xvals[i] = 0.; /* keep valgrind happy */                      REAL(ALLOC_SLOT(val, Matrix_xSym, REALSXP, n * n)), &n);
     F77_CALL(dsyrk)("U", "T", vDims, Dims,  
                     &one, REAL(GET_SLOT(x, Matrix_xSym)), Dims,  
                     &zero, xvals, vDims);  
93      UNPROTECT(1);      UNPROTECT(1);
94      return val;      return val;
95  }  }
# Line 190  Line 183 
183                       dims,                       dims,
184                       INTEGER(ALLOC_SLOT(val, Matrix_permSym, INTSXP, npiv)),                       INTEGER(ALLOC_SLOT(val, Matrix_permSym, INTSXP, npiv)),
185                       &info);                       &info);
186      if (info)      if (info < 0)
187          error(_("Lapack routine %s returned error code %d"), "dgetrf", info);          error(_("Lapack routine %s returned error code %d"), "dgetrf", info);
188        else if (info > 0)
189            warning(_("Exact singularity detected during LU decomposition."));
190      UNPROTECT(1);      UNPROTECT(1);
191      return set_factors(x, val, "LU");      return set_factors(x, val, "LU");
192  }  }
# Line 264  Line 259 
259      if (*adims != *bdims || bdims[1] < 1 || *adims < 1 || *adims != adims[1])      if (*adims != *bdims || bdims[1] < 1 || *adims < 1 || *adims != adims[1])
260          error(_("Dimensions of system to be solved are inconsistent"));          error(_("Dimensions of system to be solved are inconsistent"));
261      Memcpy(INTEGER(ALLOC_SLOT(val, Matrix_DimSym, INTSXP, 2)), bdims, 2);      Memcpy(INTEGER(ALLOC_SLOT(val, Matrix_DimSym, INTSXP, 2)), bdims, 2);
262      F77_CALL(dgetrs)("N", &n, &nrhs, REAL(GET_SLOT(val, Matrix_xSym)), &n,      F77_CALL(dgetrs)("N", &n, &nrhs, REAL(GET_SLOT(lu, Matrix_xSym)), &n,
263                       INTEGER(GET_SLOT(lu, Matrix_permSym)),                       INTEGER(GET_SLOT(lu, Matrix_permSym)),
264                       Memcpy(REAL(ALLOC_SLOT(val, Matrix_xSym, REALSXP, sz)),                       Memcpy(REAL(ALLOC_SLOT(val, Matrix_xSym, REALSXP, sz)),
265                              REAL(cl ? GET_SLOT(b, Matrix_xSym):b), sz),                              REAL(cl ? GET_SLOT(b, Matrix_xSym):b), sz),
# Line 275  Line 270 
270    
271  SEXP dgeMatrix_matrix_mm(SEXP a, SEXP b, SEXP classed, SEXP right)  SEXP dgeMatrix_matrix_mm(SEXP a, SEXP b, SEXP classed, SEXP right)
272  {  {
273      int cl = asLogical(classed), rt = asLogical(right);      int cl = asLogical(classed);
274      SEXP val = PROTECT(NEW_OBJECT(MAKE_CLASS("dgeMatrix")));      SEXP val = PROTECT(NEW_OBJECT(MAKE_CLASS("dgeMatrix")));
275      int *adims = INTEGER(GET_SLOT(a, Matrix_DimSym)),      int *adims = INTEGER(GET_SLOT(a, Matrix_DimSym)),
276          *bdims = INTEGER(cl ? GET_SLOT(b, Matrix_DimSym) :          *bdims = INTEGER(cl ? GET_SLOT(b, Matrix_DimSym) :

Legend:
Removed from v.652  
changed lines
  Added in v.694

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