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 1100, Thu Dec 29 19:50:05 2005 UTC revision 1101, Thu Dec 29 20:05:37 2005 UTC
# Line 127  Line 127 
127  SEXP dgeMatrix_matrix_crossprod(SEXP x, SEXP y, SEXP trans)  SEXP dgeMatrix_matrix_crossprod(SEXP x, SEXP y, SEXP trans)
128  {  {
129      int tr = asLogical(trans);/* trans=TRUE: tcrossprod(x,y) */      int tr = asLogical(trans);/* trans=TRUE: tcrossprod(x,y) */
 /*==== FIXME:  implement  'tr' aka 'trans' !! =========*/  
130      SEXP val = PROTECT(NEW_OBJECT(MAKE_CLASS("dgeMatrix")));      SEXP val = PROTECT(NEW_OBJECT(MAKE_CLASS("dgeMatrix")));
131      int *xDims = INTEGER(GET_SLOT(x, Matrix_DimSym)),      int *xDims = INTEGER(GET_SLOT(x, Matrix_DimSym)),
132          *yDims = INTEGER(getAttrib(y, R_DimSymbol)),          *yDims = INTEGER(getAttrib(y, R_DimSymbol)),
133          *vDims;          *vDims;
134      int m = xDims[1], n = yDims[1];      int m  = xDims[!tr],  n = yDims[!tr];/* -> result dim */
135        int xd = xDims[ tr], yd = yDims[ tr];/* the conformable dims */
136      double one = 1.0, zero = 0.0;      double one = 1.0, zero = 0.0;
137    
138      if (!(isMatrix(y) && isReal(y)))      if (!(isMatrix(y) && isReal(y)))
# Line 141  Line 141 
141      SET_SLOT(val, Matrix_factorSym, allocVector(VECSXP, 0));      SET_SLOT(val, Matrix_factorSym, allocVector(VECSXP, 0));
142      SET_SLOT(val, Matrix_DimSym, allocVector(INTSXP, 2));      SET_SLOT(val, Matrix_DimSym, allocVector(INTSXP, 2));
143      vDims = INTEGER(GET_SLOT(val, Matrix_DimSym));      vDims = INTEGER(GET_SLOT(val, Matrix_DimSym));
144      if ((*xDims) > 0 && (*yDims) > 0 && n > 0 && m > 0) {      if (xd > 0 && yd > 0 && n > 0 && m > 0) {
145          if (*xDims != *yDims)          if (xd != yd)
146              error(_("Dimensions of x and y are not compatible for crossprod"));              error(_("Dimensions of x and y are not compatible for %s"),
147                      tr ? "tcrossprod" : "crossprod");
148          vDims[0] = m; vDims[1] = n;          vDims[0] = m; vDims[1] = n;
149          SET_SLOT(val, Matrix_xSym, allocVector(REALSXP, m * n));          SET_SLOT(val, Matrix_xSym, allocVector(REALSXP, m * n));
150          F77_CALL(dgemm)("T", "N", xDims + 1, yDims + 1, xDims, &one,          F77_CALL(dgemm)(tr ? "N" : "T", tr ? "T" : "N", &m, &n, &xd, &one,
151                          REAL(GET_SLOT(x, Matrix_xSym)), xDims,                          REAL(GET_SLOT(x, Matrix_xSym)), xDims,
152                          REAL(y), yDims,                          REAL(y), yDims,
153                          &zero, REAL(GET_SLOT(val, Matrix_xSym)),                          &zero, REAL(GET_SLOT(val, Matrix_xSym)), &m);
                         xDims + 1);  
154      }      }
155      UNPROTECT(1);      UNPROTECT(1);
156      return val;      return val;

Legend:
Removed from v.1100  
changed lines
  Added in v.1101

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