SCM

SCM Repository

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

Diff of /pkg/src/dgeMatrix.c

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

revision 1452, Sat Aug 26 18:24:13 2006 UTC revision 1453, Sun Aug 27 16:16:35 2006 UTC
# Line 582  Line 582 
582      UNPROTECT(1);      UNPROTECT(1);
583      return ans;      return ans;
584  }  }
   
 /* Always returns a full matrix with entries outside the band zeroed  
  * Class of the value can be dtrMatrix or dgeMatrix  
  *  
  */  
   
 SEXP dgeMatrix_band(SEXP x, SEXP k1P, SEXP k2P)  
 {  
     SEXP aa, ans = PROTECT(dup_mMatrix_as_dgeMatrix(x));  
     int *adims = INTEGER(GET_SLOT(ans, Matrix_DimSym)),  
         i, j, k1 = asInteger(k1P), k2 = asInteger(k2P);  
     int m = adims[0], n = adims[1], sz,  
         tru = (k1 >= 0), trl = (k2 <= 0);  
     double *aax, *ax = REAL(GET_SLOT(ans, Matrix_xSym));  
   
     if (k1 > k2)  
         error(_("Lower band %d > upper band %d"), k1, k2);  
     for (j = 0; j < n; j++) {  
         int i1 = j - k2, i2 = j + 1 - k1;  
         for (i = 0; i < i1; i++) ax[i + j * m] = 0.;  
         for (i = i2; i < m; i++) ax[i + j * m] = 0.;  
     }  
     if (!tru && !trl) {         /* return the dgeMatrix */  
         UNPROTECT(1);  
         return ans;  
     }  
     /* Copy ans to a dtrMatrix object (must be square) */  
     aa = PROTECT(NEW_OBJECT(MAKE_CLASS("dtrMatrix")));  
     sz = (m < n) ? m : n;  
     SET_SLOT(aa, Matrix_xSym, GET_SLOT(ans, Matrix_xSym));  
     /* FIXME: Shrink the dimnames of ans as appropriate */  
     SET_SLOT(aa, Matrix_DimNamesSym, allocVector(VECSXP, 2));  
     SET_SLOT(aa, Matrix_diagSym, mkString("N"));  
     SET_SLOT(aa, Matrix_uploSym, mkString(tru ? "U" : "L"));  
     adims = INTEGER(ALLOC_SLOT(aa, Matrix_DimSym, INTSXP, 2));  
     adims[0] = adims[1] = sz;  
     aax = REAL(ALLOC_SLOT(aa, Matrix_xSym, REALSXP, sz * sz));  
     for (j = 0; j < sz; j++)  
         Memcpy(aax + j * sz, ax + j * m, sz);  
     UNPROTECT(2);  
     return aa;  
 }  

Legend:
Removed from v.1452  
changed lines
  Added in v.1453

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