SCM

SCM Repository

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

Diff of /pkg/src/dsyMatrix.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 38  Line 38 
38      return ScalarReal(get_norm_sy(obj, CHAR(asChar(type))));      return ScalarReal(get_norm_sy(obj, CHAR(asChar(type))));
39  }  }
40    
 static  
 double set_rcond_sy(SEXP obj, char *typstr)  
 {  
     char typnm[] = {'\0', '\0'};  
     SEXP rcv = GET_SLOT(obj, Matrix_rcondSym);  
     double rcond;  
41    
42      typnm[0] = rcond_type(typstr);  SEXP dsyMatrix_rcond(SEXP obj, SEXP type)
43      rcond = get_double_by_name(rcv, typnm);  {
   
     if (R_IsNA(rcond)) {  
44          SEXP trf = dsyMatrix_trf(obj);          SEXP trf = dsyMatrix_trf(obj);
45        char typnm[] = {'\0', '\0'};
46          int *dims = INTEGER(GET_SLOT(obj, Matrix_DimSym)), info;          int *dims = INTEGER(GET_SLOT(obj, Matrix_DimSym)), info;
47          double anorm = get_norm_sy(obj, "O");          double anorm = get_norm_sy(obj, "O");
48        double rcond;
49    
50        typnm[0] = rcond_type(CHAR(asChar(type)));
51          F77_CALL(dsycon)(uplo_P(trf), dims,          F77_CALL(dsycon)(uplo_P(trf), dims,
52                           REAL   (GET_SLOT(trf, Matrix_xSym)), dims,                           REAL   (GET_SLOT(trf, Matrix_xSym)), dims,
53                           INTEGER(GET_SLOT(trf, Matrix_permSym)),                           INTEGER(GET_SLOT(trf, Matrix_permSym)),
54                           &anorm, &rcond,                           &anorm, &rcond,
55                           (double *) R_alloc(2*dims[0], sizeof(double)),                           (double *) R_alloc(2*dims[0], sizeof(double)),
56                           (int *) R_alloc(dims[0], sizeof(int)), &info);                           (int *) R_alloc(dims[0], sizeof(int)), &info);
57          SET_SLOT(obj, Matrix_rcondSym,      return ScalarReal(rcond);
                  set_double_by_name(rcv, rcond, typnm));  
     }  
     return rcond;  
 }  
   
 SEXP dsyMatrix_rcond(SEXP obj, SEXP type)  
 {  
     return ScalarReal(set_rcond_sy(obj, CHAR(asChar(type))));  
58  }  }
59    
60  static  static
# Line 98  Line 85 
85      SET_SLOT(val, Matrix_uploSym, duplicate(GET_SLOT(trf, Matrix_uploSym)));      SET_SLOT(val, Matrix_uploSym, duplicate(GET_SLOT(trf, Matrix_uploSym)));
86      SET_SLOT(val, Matrix_xSym, duplicate(GET_SLOT(trf, Matrix_xSym)));      SET_SLOT(val, Matrix_xSym, duplicate(GET_SLOT(trf, Matrix_xSym)));
87      SET_SLOT(val, Matrix_DimSym, duplicate(GET_SLOT(trf, Matrix_DimSym)));      SET_SLOT(val, Matrix_DimSym, duplicate(GET_SLOT(trf, Matrix_DimSym)));
     SET_SLOT(val, Matrix_rcondSym, duplicate(GET_SLOT(a, Matrix_rcondSym)));  
88      F77_CALL(dsytri)(uplo_P(val), dims,      F77_CALL(dsytri)(uplo_P(val), dims,
89                       REAL(GET_SLOT(val, Matrix_xSym)), dims,                       REAL(GET_SLOT(val, Matrix_xSym)), dims,
90                       INTEGER(GET_SLOT(trf, Matrix_permSym)),                       INTEGER(GET_SLOT(trf, Matrix_permSym)),
# Line 151  Line 137 
137    
138  SEXP dsyMatrix_as_dgeMatrix(SEXP from)  SEXP dsyMatrix_as_dgeMatrix(SEXP from)
139  {  {
140      SEXP val = PROTECT(NEW_OBJECT(MAKE_CLASS("dgeMatrix"))),      SEXP val = PROTECT(NEW_OBJECT(MAKE_CLASS("dgeMatrix")));
         rcondSym = Matrix_rcondSym;  
141    
     SET_SLOT(val, Matrix_rcondSym, allocVector(REALSXP, 0));  
142      SET_SLOT(val, Matrix_factorSym, allocVector(VECSXP, 0));      SET_SLOT(val, Matrix_factorSym, allocVector(VECSXP, 0));
     SET_SLOT(val, rcondSym, duplicate(GET_SLOT(from, rcondSym)));  
143      SET_SLOT(val, Matrix_xSym, duplicate(GET_SLOT(from, Matrix_xSym)));      SET_SLOT(val, Matrix_xSym, duplicate(GET_SLOT(from, Matrix_xSym)));
144      SET_SLOT(val, Matrix_DimSym,      SET_SLOT(val, Matrix_DimSym,
145               duplicate(GET_SLOT(from, Matrix_DimSym)));               duplicate(GET_SLOT(from, Matrix_DimSym)));
# Line 193  Line 176 
176      if (m < 1 || n < 1 || k < 1)      if (m < 1 || n < 1 || k < 1)
177          error(_("Matrices with zero extents cannot be multiplied"));          error(_("Matrices with zero extents cannot be multiplied"));
178      SET_SLOT(val, Matrix_factorSym, allocVector(VECSXP, 0));      SET_SLOT(val, Matrix_factorSym, allocVector(VECSXP, 0));
     SET_SLOT(val, Matrix_rcondSym, allocVector(REALSXP, 0));  
179      SET_SLOT(val, Matrix_xSym, allocVector(REALSXP, m * n));      SET_SLOT(val, Matrix_xSym, allocVector(REALSXP, m * n));
180      SET_SLOT(val, Matrix_DimSym, allocVector(INTSXP, 2));      SET_SLOT(val, Matrix_DimSym, allocVector(INTSXP, 2));
181      cdims = INTEGER(GET_SLOT(val, Matrix_DimSym));      cdims = INTEGER(GET_SLOT(val, Matrix_DimSym));
# Line 219  Line 201 
201          error(_("Matrices are not conformable for multiplication"));          error(_("Matrices are not conformable for multiplication"));
202      if (m < 1 || n < 1 || k < 1)      if (m < 1 || n < 1 || k < 1)
203          error(_("Matrices with zero extents cannot be multiplied"));          error(_("Matrices with zero extents cannot be multiplied"));
     SET_SLOT(val, Matrix_rcondSym, allocVector(REALSXP, 0));  
204      SET_SLOT(val, Matrix_factorSym, allocVector(VECSXP, 0));      SET_SLOT(val, Matrix_factorSym, allocVector(VECSXP, 0));
205      SET_SLOT(val, Matrix_xSym, allocVector(REALSXP, m * n));      SET_SLOT(val, Matrix_xSym, allocVector(REALSXP, m * n));
206      SET_SLOT(val, Matrix_DimSym, allocVector(INTSXP, 2));      SET_SLOT(val, Matrix_DimSym, allocVector(INTSXP, 2));
# Line 270  Line 251 
251          dimP = GET_SLOT(from, Matrix_DimSym);          dimP = GET_SLOT(from, Matrix_DimSym);
252      int n = *INTEGER(dimP);      int n = *INTEGER(dimP);
253    
     SET_SLOT(val, Matrix_rcondSym,  
              duplicate(GET_SLOT(from, Matrix_rcondSym)));  
254      SET_SLOT(val, Matrix_DimSym, duplicate(dimP));      SET_SLOT(val, Matrix_DimSym, duplicate(dimP));
255      SET_SLOT(val, Matrix_uploSym, duplicate(uplo));      SET_SLOT(val, Matrix_uploSym, duplicate(uplo));
256      full_to_packed_double(      full_to_packed_double(

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