SCM

SCM Repository

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

Diff of /pkg/src/syMatrix.c

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

revision 295, Mon Oct 4 17:08:54 2004 UTC revision 296, Mon Oct 4 17:13:29 2004 UTC
# Line 18  Line 18 
18      return ScalarLogical(1);      return ScalarLogical(1);
19  }  }
20    
21    double get_norm_sy(SEXP obj, char *typstr)
22    {
23        char typnm[] = {'\0', '\0'};
24        int *dims = INTEGER(GET_SLOT(obj, Matrix_DimSym));
25        double *work = (double *) NULL;
26    
27        typnm[0] = norm_type(typstr);
28        if (*typnm == 'I' || *typnm == 'O') {
29            work = (double *) R_alloc(dims[0], sizeof(double));
30        }
31        return F77_CALL(dlansy)(typnm,
32                                CHAR(asChar(GET_SLOT(obj, Matrix_uploSym))),
33                                dims, REAL(GET_SLOT(obj, Matrix_xSym)),
34                                dims, work);
35    }
36    
37    SEXP syMatrix_norm(SEXP obj, SEXP type)
38    {
39        return ScalarReal(get_norm_sy(obj, CHAR(asChar(type))));
40    }
41    
42    static
43    double set_rcond_sy(SEXP obj, char *typstr)
44    {
45        char typnm[] = {'\0', '\0'};
46        SEXP rcv = GET_SLOT(obj, install("rcond"));
47        double rcond;
48    
49        typnm[0] = rcond_type(typstr);
50        rcond = get_double_by_name(rcv, typnm);
51    
52    /* FIXME: Need a factorization here. */
53        if (R_IsNA(rcond)) {
54            int *dims = INTEGER(GET_SLOT(obj, Matrix_DimSym)), info;
55            double anorm = get_norm_sy(obj, "O");
56    
57            error("Code for set_rcond_sy not yet written");
58            F77_CALL(dsycon)(CHAR(asChar(GET_SLOT(obj, Matrix_uploSym))),
59                             dims, REAL(GET_SLOT(obj, Matrix_xSym)),
60                             dims, INTEGER(GET_SLOT(obj, install("pivot"))),
61                             &anorm, &rcond,
62                             (double *) R_alloc(2*dims[0], sizeof(double)),
63                             (int *) R_alloc(dims[0], sizeof(int)), &info);
64            SET_SLOT(obj, install("rcond"),
65                     set_double_by_name(rcv, rcond, typnm));
66        }
67        return rcond;
68    }
69    
70    SEXP syMatrix_rcond(SEXP obj, SEXP type)
71    {
72    /* FIXME: This is a stub */
73    /*     return ScalarReal(set_rcond_sy(obj, CHAR(asChar(type)))); */
74        return ScalarReal(NA_REAL);
75    }
76    
77  static  static
78  void make_symmetric(double *to, SEXP from, int n)  void make_symmetric(double *to, SEXP from, int n)
79  {  {
# Line 37  Line 93 
93      }      }
94  }  }
95    
96    SEXP syMatrix_solve(SEXP a)
97    {
98    /* FIXME: Write the code */
99        error("code for syMatrix_solve not yet written");
100    }
101    
102    SEXP syMatrix_matrix_solve(SEXP a, SEXP b)
103    {
104    /* FIXME: Write the code */
105        error("code for syMatrix_matrix_solve not yet written");
106    }
107    
108  SEXP syMatrix_as_geMatrix(SEXP from)  SEXP syMatrix_as_geMatrix(SEXP from)
109  {  {
110      SEXP val = PROTECT(NEW_OBJECT(MAKE_CLASS("geMatrix"))),      SEXP val = PROTECT(NEW_OBJECT(MAKE_CLASS("geMatrix"))),
# Line 64  Line 132 
132      return val;      return val;
133  }  }
134    
 double get_norm_sy(SEXP obj, char *typstr)  
 {  
     char typnm[] = {'\0', '\0'};  
     int *dims = INTEGER(GET_SLOT(obj, Matrix_DimSym));  
     double *work = (double *) NULL;  
   
     typnm[0] = norm_type(typstr);  
     if (*typnm == 'I' || *typnm == 'O') {  
         work = (double *) R_alloc(dims[0], sizeof(double));  
     }  
     return F77_CALL(dlansy)(typnm,  
                             CHAR(asChar(GET_SLOT(obj, Matrix_uploSym))),  
                             dims, REAL(GET_SLOT(obj, Matrix_xSym)),  
                             dims, work);  
 }  
   
 SEXP syMatrix_norm(SEXP obj, SEXP type)  
 {  
     return ScalarReal(get_norm_sy(obj, CHAR(asChar(type))));  
 }  
   
135  SEXP syMatrix_geMatrix_mm(SEXP a, SEXP b)  SEXP syMatrix_geMatrix_mm(SEXP a, SEXP b)
136  {  {
137      int *adims = INTEGER(GET_SLOT(a, Matrix_DimSym)),      int *adims = INTEGER(GET_SLOT(a, Matrix_DimSym)),

Legend:
Removed from v.295  
changed lines
  Added in v.296

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