SCM

SCM Repository

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

Diff of /pkg/src/dtrMatrix.c

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

revision 479, Wed Feb 2 14:52:26 2005 UTC revision 534, Tue Feb 8 08:59:31 2005 UTC
# Line 1  Line 1 
1    /* double (precision) TRiangular Matrices */
2    
3  #include "dtrMatrix.h"  #include "dtrMatrix.h"
4    
5  SEXP dtrMatrix_validate(SEXP obj)  SEXP dtrMatrix_validate(SEXP obj)
# Line 7  Line 9 
9      char *val;      char *val;
10    
11      if (length(uplo) != 1)      if (length(uplo) != 1)
12          return ScalarString(mkChar("uplo slot must have length 1"));          return mkString("'uplo' slot must have length 1");
13      if (length(diag) != 1)      if (length(diag) != 1)
14          return ScalarString(mkChar("diag slot must have length 1"));          return mkString("'diag' slot must have length 1");
15      val = CHAR(STRING_ELT(uplo, 0));      val = CHAR(STRING_ELT(uplo, 0));
16      if (strlen(val) != 1)      if (strlen(val) != 1)
17          return ScalarString(mkChar("uplo[1] must have string length 1"));          return mkString("'uplo' must have string length 1");
18      if (toupper(*val) != 'U' && toupper(*val) != 'L')      if (*val != 'U' && *val != 'L')
19          return ScalarString(mkChar("uplo[1] must be \"U\" or \"L\""));          return mkString("'uplo' must be \"U\" or \"L\"");
20      val = CHAR(STRING_ELT(diag, 0));      val = CHAR(STRING_ELT(diag, 0));
21      if (strlen(val) != 1)      if (strlen(val) != 1)
22          return ScalarString(mkChar("diag[1] must have string length 1"));          return mkString("'diag' must have string length 1");
23      if (toupper(*val) != 'U' && toupper(*val) != 'N')      if (*val != 'U' && *val != 'N')
24          return ScalarString(mkChar("diag[1] must be \"U\" or \"N\""));          return mkString("'diag' must be \"U\" or \"N\"");
25      return ScalarLogical(1);      return ScalarLogical(1);
26  }  }
27    
# Line 111  Line 113 
113      int i, j, *dims = INTEGER(GET_SLOT(from, Matrix_DimSym));      int i, j, *dims = INTEGER(GET_SLOT(from, Matrix_DimSym));
114      int n = dims[0], m = dims[1];      int n = dims[0], m = dims[1];
115    
116      if (toupper(*CHAR(asChar(GET_SLOT(from, Matrix_uploSym)))) == 'U') {      if (*CHAR(asChar(GET_SLOT(from, Matrix_uploSym))) == 'U') {
117          for (j = 0; j < n; j++) {          for (j = 0; j < n; j++) {
118              for (i = j+1; i < m; i++) {              for (i = j+1; i < m; i++) {
119                  to[i + j*m] = 0.;                  to[i + j*m] = 0.;
# Line 124  Line 126 
126              }              }
127          }          }
128      }      }
129      if (toupper(*CHAR(asChar(GET_SLOT(from, Matrix_diagSym)))) == 'U') {      if (*CHAR(asChar(GET_SLOT(from, Matrix_diagSym))) == 'U') {
130          j = (n < m) ? n : m;          j = (n < m) ? n : m;
131          for (i = 0; i < j; i++) {          for (i = 0; i < j; i++) {
132              to[i * (m + 1)] = 1.;              to[i * (m + 1)] = 1.;
# Line 166  Line 168 
168      SEXP ret = PROTECT(allocVector(REALSXP, n)),      SEXP ret = PROTECT(allocVector(REALSXP, n)),
169          xv = GET_SLOT(x, Matrix_xSym);          xv = GET_SLOT(x, Matrix_xSym);
170    
171      if ('U' == toupper(CHAR(STRING_ELT(GET_SLOT(x, Matrix_diagSym), 0))[0])) {      if ('U' == CHAR(STRING_ELT(GET_SLOT(x, Matrix_diagSym), 0))[0]) {
172          for (i = 0; i < n; i++) REAL(ret)[i] = 1.;          for (i = 0; i < n; i++) REAL(ret)[i] = 1.;
173      } else {      } else {
174          for (i = 0; i < n; i++) {          for (i = 0; i < n; i++) {

Legend:
Removed from v.479  
changed lines
  Added in v.534

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