SCM

SCM Repository

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

Diff of /pkg/src/ssclme.c

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

revision 21, Sat Mar 27 00:06:02 2004 UTC revision 22, Sat Mar 27 18:17:00 2004 UTC
# Line 338  Line 338 
338  }  }
339    
340  SEXP  SEXP
341  ssclme_update_mm(SEXP x, SEXP facs, SEXP mmats)  ssclme_transfer_dimnames(SEXP x, SEXP facs, SEXP mmats)
342  {  {
343        SEXP bVar = GET_SLOT(x, Matrix_bVarSym),
344            nms2 = PROTECT(allocVector(VECSXP, 2)),
345            nms3 = PROTECT(allocVector(VECSXP, 3));
346        int i, nf = length(mmats) - 1;
347        SEXP xcols = VECTOR_ELT(GetArrayDimnames(VECTOR_ELT(mmats, nf)), 1);
348    
349        for (i = 0; i < nf; i++) {
350            SEXP cnms = VECTOR_ELT(GetArrayDimnames(VECTOR_ELT(mmats, i)), 1);
351            SET_VECTOR_ELT(nms3, 0, cnms);
352            SET_VECTOR_ELT(nms3, 1, cnms);
353            SET_VECTOR_ELT(nms3, 2,
354                           getAttrib(VECTOR_ELT(facs, i), R_LevelsSymbol));
355            dimnamesgets(VECTOR_ELT(bVar, i), duplicate(nms3));
356        }
357        SET_VECTOR_ELT(nms2, 0, xcols);
358        SET_VECTOR_ELT(nms2, 1, xcols);
359        dimnamesgets(GET_SLOT(x, Matrix_XtXSym), nms2);
360        dimnamesgets(GET_SLOT(x, Matrix_RXXSym), nms2);
361        UNPROTECT(2);
362        return R_NilValue;
363    }
364    
365      SEXP      SEXP
366          bVar = GET_SLOT(x, Matrix_bVarSym);  ssclme_update_mm(SEXP x, SEXP facs, SEXP mmats)
367    {
368        SEXP bVar = GET_SLOT(x, Matrix_bVarSym);
369      int      int
370          *Ai = INTEGER(GET_SLOT(x, Matrix_iSym)),          *Ai = INTEGER(GET_SLOT(x, Matrix_iSym)),
371          *Ap = INTEGER(GET_SLOT(x, Matrix_pSym)),          *Ap = INTEGER(GET_SLOT(x, Matrix_pSym)),
# Line 428  Line 452 
452                  if (ind < 0) error("logic error in ssclme_update_mm");                  if (ind < 0) error("logic error in ssclme_update_mm");
453                  if (Ncj || nck > 1) {                  if (Ncj || nck > 1) {
454                                  /* FIXME: run a loop to update */                                  /* FIXME: run a loop to update */
455                        error("code not yet written");
456                  } else {        /* update scalars directly */                  } else {        /* update scalars directly */
457                      Ax[ind] += Zj[fpji] * Zk[fpki];                      Ax[ind] += Zj[fpji] * Zk[fpki];
458                  }                  }
# Line 435  Line 460 
460          }          }
461      }      }
462      Free(Z);      Free(Z);
463        ssclme_transfer_dimnames(x, facs, mmats);
464      return R_NilValue;      return R_NilValue;
465  }  }
466    

Legend:
Removed from v.21  
changed lines
  Added in v.22

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