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 1166, Sun Jan 15 19:18:20 2006 UTC revision 1167, Sun Jan 15 21:13:54 2006 UTC
# Line 19  Line 19 
19  SEXP dgeMatrix_validate(SEXP obj)  SEXP dgeMatrix_validate(SEXP obj)
20  {  {
21      SEXP val,      SEXP val,
22          fact = GET_SLOT(obj, Matrix_factorSym),          fact = GET_SLOT(obj, Matrix_factorSym);
         rc = GET_SLOT(obj, Matrix_rcondSym);  
23    
24      if (isString(val = dense_nonpacked_validate(obj)))      if (isString(val = dense_nonpacked_validate(obj)))
25          return(val);          return(val);
26    
27      if (length(fact) > 0 && getAttrib(fact, R_NamesSymbol) == R_NilValue)      if (length(fact) > 0 && getAttrib(fact, R_NamesSymbol) == R_NilValue)
28          return mkString(_("factors slot must be named list"));          return mkString(_("factors slot must be named list"));
     if (length(rc) > 0 && getAttrib(rc, R_NamesSymbol) == R_NilValue)  
         return mkString(_("rcond slot must be named numeric vector"));  
29      return ScalarLogical(1);      return ScalarLogical(1);
30  }  }
31    
# Line 53  Line 50 
50      return ScalarReal(get_norm(obj, CHAR(asChar(type))));      return ScalarReal(get_norm(obj, CHAR(asChar(type))));
51  }  }
52    
53  static  SEXP dgeMatrix_rcond(SEXP obj, SEXP type)
 double set_rcond(SEXP obj, char *typstr)  
54  {  {
     char typnm[] = {'\0', '\0'};  
     SEXP rcv = GET_SLOT(obj, Matrix_rcondSym);  
     double rcond = get_double_by_name(rcv, typnm);  
   
     typnm[0] = rcond_type(typstr);  
     if (R_IsNA(rcond)) {  
55          SEXP LU = dgeMatrix_LU(obj);          SEXP LU = dgeMatrix_LU(obj);
56        char typnm[] = {'\0', '\0'};
57          int *dims = INTEGER(GET_SLOT(LU, Matrix_DimSym)), info;          int *dims = INTEGER(GET_SLOT(LU, Matrix_DimSym)), info;
58          double anorm = get_norm(obj, typstr);      double anorm, rcond;
59    
60          if (dims[0] != dims[1] || dims[0] < 1)          if (dims[0] != dims[1] || dims[0] < 1)
61              error(_("rcond requires a square, non-empty matrix"));              error(_("rcond requires a square, non-empty matrix"));
62        typnm[0] = rcond_type(CHAR(asChar(type)));
63        anorm = get_norm(obj, typnm);
64          F77_CALL(dgecon)(typnm,          F77_CALL(dgecon)(typnm,
65                           dims, REAL(GET_SLOT(LU, Matrix_xSym)),                           dims, REAL(GET_SLOT(LU, Matrix_xSym)),
66                           dims, &anorm, &rcond,                           dims, &anorm, &rcond,
67                           (double *) R_alloc(4*dims[0], sizeof(double)),                           (double *) R_alloc(4*dims[0], sizeof(double)),
68                           (int *) R_alloc(dims[0], sizeof(int)), &info);                           (int *) R_alloc(dims[0], sizeof(int)), &info);
69          SET_SLOT(obj, Matrix_rcondSym,      return ScalarReal(rcond);
                  set_double_by_name(rcv, rcond, typnm));  
     }  
     return rcond;  
 }  
   
 SEXP dgeMatrix_rcond(SEXP obj, SEXP type)  
 {  
   return ScalarReal(set_rcond(obj, CHAR(asChar(type))));  
70  }  }
71    
72  SEXP dgeMatrix_crossprod(SEXP x, SEXP trans)  SEXP dgeMatrix_crossprod(SEXP x, SEXP trans)
# Line 113  Line 98 
98      int xd = xDims[ tr], yd = yDims[ tr];/* the conformable dims */      int xd = xDims[ tr], yd = yDims[ tr];/* the conformable dims */
99      double one = 1.0, zero = 0.0;      double one = 1.0, zero = 0.0;
100    
     SET_SLOT(val, Matrix_rcondSym, allocVector(REALSXP, 0));  
101      SET_SLOT(val, Matrix_factorSym, allocVector(VECSXP, 0));      SET_SLOT(val, Matrix_factorSym, allocVector(VECSXP, 0));
102      SET_SLOT(val, Matrix_DimSym, allocVector(INTSXP, 2));      SET_SLOT(val, Matrix_DimSym, allocVector(INTSXP, 2));
103      vDims = INTEGER(GET_SLOT(val, Matrix_DimSym));      vDims = INTEGER(GET_SLOT(val, Matrix_DimSym));
# Line 145  Line 129 
129    
130      if (!(isMatrix(y) && isReal(y)))      if (!(isMatrix(y) && isReal(y)))
131          error(_("Argument y must be a numeric (real) matrix"));          error(_("Argument y must be a numeric (real) matrix"));
     SET_SLOT(val, Matrix_rcondSym, allocVector(REALSXP, 0));  
132      SET_SLOT(val, Matrix_factorSym, allocVector(VECSXP, 0));      SET_SLOT(val, Matrix_factorSym, allocVector(VECSXP, 0));
133      SET_SLOT(val, Matrix_DimSym, allocVector(INTSXP, 2));      SET_SLOT(val, Matrix_DimSym, allocVector(INTSXP, 2));
134      vDims = INTEGER(GET_SLOT(val, Matrix_DimSym));      vDims = INTEGER(GET_SLOT(val, Matrix_DimSym));

Legend:
Removed from v.1166  
changed lines
  Added in v.1167

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