SCM

SCM Repository

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

Diff of /pkg/Matrix/src/dpoMatrix.c

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

revision 1141, Thu Jan 12 03:02:46 2006 UTC revision 1167, Sun Jan 15 21:13:54 2006 UTC
# Line 44  Line 44 
44      return set_factors(x, val, "Cholesky");      return set_factors(x, val, "Cholesky");
45  }  }
46    
47  static  SEXP dpoMatrix_rcond(SEXP obj, SEXP type)
 double set_rcond(SEXP obj, char *typstr)  
48  {  {
     char typnm[] = {'O', '\0'}; /* always use the one norm */  
     SEXP rcv = GET_SLOT(obj, Matrix_rcondSym);  
     double rcond = get_double_by_name(rcv, typnm);  
   
     if (R_IsNA(rcond)) {  
49          SEXP Chol = dpoMatrix_chol(obj);          SEXP Chol = dpoMatrix_chol(obj);
50        char typnm[] = {'O', '\0'}; /* always use the one norm */
51          int *dims = INTEGER(GET_SLOT(Chol, Matrix_DimSym)), info;          int *dims = INTEGER(GET_SLOT(Chol, Matrix_DimSym)), info;
52          double anorm = get_norm_sy(obj, typnm);      double anorm = get_norm_sy(obj, typnm), rcond;
53    
54          F77_CALL(dpocon)(uplo_P(Chol),          F77_CALL(dpocon)(uplo_P(Chol),
55                           dims, REAL(GET_SLOT(Chol, Matrix_xSym)),                           dims, REAL(GET_SLOT(Chol, Matrix_xSym)),
56                           dims, &anorm, &rcond,                           dims, &anorm, &rcond,
57                           (double *) R_alloc(3*dims[0], sizeof(double)),                           (double *) R_alloc(3*dims[0], sizeof(double)),
58                           (int *) R_alloc(dims[0], sizeof(int)), &info);                           (int *) R_alloc(dims[0], sizeof(int)), &info);
59          SET_SLOT(obj, Matrix_rcondSym,      return ScalarReal(rcond);
                  set_double_by_name(rcv, rcond, typnm));  
     }  
     return rcond;  
 }  
   
 SEXP dpoMatrix_rcond(SEXP obj, SEXP type)  
 {  
     return ScalarReal(set_rcond(obj, CHAR(asChar(type))));  
60  }  }
61    
62  SEXP dpoMatrix_solve(SEXP x)  SEXP dpoMatrix_solve(SEXP x)
# Line 84  Line 71 
71      SET_SLOT(val, Matrix_DimSym, duplicate(GET_SLOT(Chol, Matrix_DimSym)));      SET_SLOT(val, Matrix_DimSym, duplicate(GET_SLOT(Chol, Matrix_DimSym)));
72      SET_SLOT(val, Matrix_DimNamesSym,      SET_SLOT(val, Matrix_DimNamesSym,
73               duplicate(GET_SLOT(x, Matrix_DimNamesSym)));               duplicate(GET_SLOT(x, Matrix_DimNamesSym)));
     SET_SLOT(val, Matrix_rcondSym, duplicate(GET_SLOT(x, Matrix_rcondSym)));  
74      F77_CALL(dpotri)(uplo_P(val), dims,      F77_CALL(dpotri)(uplo_P(val), dims,
75                       REAL(GET_SLOT(val, Matrix_xSym)), dims, &info);                       REAL(GET_SLOT(val, Matrix_xSym)), dims, &info);
76      UNPROTECT(1);      UNPROTECT(1);
# Line 101  Line 87 
87    
88      if (*adims != *bdims || bdims[1] < 1 || *adims < 1)      if (*adims != *bdims || bdims[1] < 1 || *adims < 1)
89          error(_("Dimensions of system to be solved are inconsistent"));          error(_("Dimensions of system to be solved are inconsistent"));
     SET_SLOT(val, Matrix_rcondSym, allocVector(REALSXP, 0));  
90      SET_SLOT(val, Matrix_factorSym, allocVector(VECSXP, 0));      SET_SLOT(val, Matrix_factorSym, allocVector(VECSXP, 0));
91      SET_SLOT(val, Matrix_DimSym, duplicate(GET_SLOT(b, Matrix_DimSym)));      SET_SLOT(val, Matrix_DimSym, duplicate(GET_SLOT(b, Matrix_DimSym)));
92      SET_SLOT(val, Matrix_xSym, duplicate(GET_SLOT(b, Matrix_xSym)));      SET_SLOT(val, Matrix_xSym, duplicate(GET_SLOT(b, Matrix_xSym)));

Legend:
Removed from v.1141  
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