SCM

SCM Repository

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

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

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

revision 3212, Tue Apr 18 19:03:59 2017 UTC revision 3213, Tue Apr 18 20:14:20 2017 UTC
# Line 170  Line 170 
170    
171  SEXP lapack_qr(SEXP Xin, SEXP tl)  SEXP lapack_qr(SEXP Xin, SEXP tl)
172  {  {
173      SEXP ans, Givens, Gcpy, nms, pivot, qraux, X;      SEXP ans, Givens, Gcpy, nms, pivot, qraux, X, sym;
174      int i, n, nGivens = 0, p, trsz, *Xdims, rank;      int i, n, nGivens = 0, p, trsz, *Xdims, rank;
175      double rcond = 0., tol = asReal(tl), *work;      double rcond = 0., tol = asReal(tl), *work;
176    
# Line 239  Line 239 
239      for (i = 0; i < nGivens; i++)      for (i = 0; i < nGivens; i++)
240          SET_VECTOR_ELT(Gcpy, i, VECTOR_ELT(Givens, i));          SET_VECTOR_ELT(Gcpy, i, VECTOR_ELT(Givens, i));
241      SET_VECTOR_ELT(ans, 1, ScalarInteger(rank));      SET_VECTOR_ELT(ans, 1, ScalarInteger(rank));
242      setAttrib(ans, install("useLAPACK"), ScalarLogical(1));      sym = PROTECT(install("useLAPACK")); setAttrib(ans, sym, ScalarLogical(1)); UNPROTECT(1);
243      setAttrib(ans, install("rcond"), ScalarReal(rcond));      sym = PROTECT(install("rcond"));     setAttrib(ans, sym, ScalarReal(rcond));UNPROTECT(1);
244      UNPROTECT(2);      UNPROTECT(2);
245      return ans;      return ans;
246  }  }
# Line 398  Line 398 
398          else          else
399              SET_VECTOR_ELT(dns,1, VECTOR_ELT(dns,0));              SET_VECTOR_ELT(dns,1, VECTOR_ELT(dns,0));
400      }      }
401      if(!isNull(nms_dns = getAttrib(dns, R_NamesSymbol)) &&      nms_dns = PROTECT(getAttrib(dns, R_NamesSymbol));
402        if(!isNull(nms_dns) &&
403         !R_compute_identical(STRING_ELT(nms_dns, 0),         !R_compute_identical(STRING_ELT(nms_dns, 0),
404                              STRING_ELT(nms_dns, 1), 16)) { // names(dimnames(.)) :                              STRING_ELT(nms_dns, 1), 16)) { // names(dimnames(.)) :
405          if(*CHAR(asChar(uplo)) == 'U')          if(*CHAR(asChar(uplo)) == 'U')
# Line 416  Line 417 
417      SET_SLOT(ans, Matrix_DimNamesSym, dns);      SET_SLOT(ans, Matrix_DimNamesSym, dns);
418      SET_SLOT(ans, Matrix_uploSym,     ScalarString(asChar(uplo)));      SET_SLOT(ans, Matrix_uploSym,     ScalarString(asChar(uplo)));
419    
420      UNPROTECT(2);      UNPROTECT(3);
421      return ans;      return ans;
422  }  }
423    
# Line 455  Line 456 
456              SET_VECTOR_ELT(dns, !J, VECTOR_ELT(dns, J));                \              SET_VECTOR_ELT(dns, !J, VECTOR_ELT(dns, J));                \
457          }                                                               \          }                                                               \
458          /* names(dimnames(.)): */                                       \          /* names(dimnames(.)): */                                       \
459          if(!isNull(nms_dns = getAttrib(dns, R_NamesSymbol)) &&          \          nms_dns = PROTECT(getAttrib(dns, R_NamesSymbol));               \
460            if(!isNull(nms_dns) &&                                          \
461             !R_compute_identical(STRING_ELT(nms_dns, 0),                 \             !R_compute_identical(STRING_ELT(nms_dns, 0),                 \
462                                  STRING_ELT(nms_dns, 1), 16)) {          \                                  STRING_ELT(nms_dns, 1), 16)) {          \
463              SET_STRING_ELT(nms_dns, !J, STRING_ELT(nms_dns, J));        \              SET_STRING_ELT(nms_dns, !J, STRING_ELT(nms_dns, J));        \
# Line 471  Line 473 
473          SET_SLOT(ans, Matrix_DimNamesSym, dns);                         \          SET_SLOT(ans, Matrix_DimNamesSym, dns);                         \
474          SET_SLOT(ans, Matrix_uploSym,     mkString("U"));               \          SET_SLOT(ans, Matrix_uploSym,     mkString("U"));               \
475                                                                          \                                                                          \
476          UNPROTECT(2);                                                   \          UNPROTECT(3);                                                   \
477          return ans          return ans
478    
479          MK_SYMMETRIC_DIMNAMES_AND_RETURN;          MK_SYMMETRIC_DIMNAMES_AND_RETURN;

Legend:
Removed from v.3212  
changed lines
  Added in v.3213

R-Forge@R-project.org
ViewVC Help
Powered by ViewVC 1.0.0  
Thanks to:
Vienna University of Economics and Business University of Wisconsin - Madison Powered By FusionForge