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 100, Sat Apr 17 17:03:59 2004 UTC revision 101, Sun Apr 18 14:59:53 2004 UTC
# Line 252  Line 252 
252      SET_SLOT(ssc, Matrix_RXXSym, allocMatrix(REALSXP, pp1, pp1));      SET_SLOT(ssc, Matrix_RXXSym, allocMatrix(REALSXP, pp1, pp1));
253      SET_SLOT(ssc, Matrix_ZtXSym, allocMatrix(REALSXP, nzcol, pp1));      SET_SLOT(ssc, Matrix_ZtXSym, allocMatrix(REALSXP, nzcol, pp1));
254      SET_SLOT(ssc, Matrix_RZXSym, allocMatrix(REALSXP, nzcol, pp1));      SET_SLOT(ssc, Matrix_RZXSym, allocMatrix(REALSXP, nzcol, pp1));
255          /* Zero the symmetric matrices (for cosmetic reasons only). */                                  /* Zero symmetric matrices (cosmetic) */
256      memset(REAL(GET_SLOT(ssc, Matrix_XtXSym)), 0,      memset(REAL(GET_SLOT(ssc, Matrix_XtXSym)), 0,
257             sizeof(double) * pp1 * pp1);             sizeof(double) * pp1 * pp1);
258      memset(REAL(GET_SLOT(ssc, Matrix_RXXSym)), 0,      memset(REAL(GET_SLOT(ssc, Matrix_RXXSym)), 0,
# Line 791  Line 791 
791      }      }
792      return R_NilValue;      return R_NilValue;
793  }  }
794    
795  SEXP ssclme_invert(SEXP x)  SEXP ssclme_invert(SEXP x)
796  {  {
797      int *status = LOGICAL(GET_SLOT(x, Matrix_statusSym));      int *status = LOGICAL(GET_SLOT(x, Matrix_statusSym));
# Line 1209  Line 1210 
1210      return R_NilValue;      return R_NilValue;
1211  }  }
1212    
1213  SEXP ssclme_gradient(SEXP x, SEXP REMLp)  SEXP ssclme_gradient(SEXP x, SEXP REMLp, SEXP Uncp)
1214  {  {
1215      SEXP      SEXP
1216            Omega = GET_SLOT(x, Matrix_OmegaSym),
1217          RZXsl = GET_SLOT(x, Matrix_RZXSym),          RZXsl = GET_SLOT(x, Matrix_RZXSym),
1218          ans = PROTECT(duplicate(GET_SLOT(x, Matrix_OmegaSym))),          ans = PROTECT(duplicate(Omega)),
1219          ncsl = GET_SLOT(x, Matrix_ncSym),          ncsl = GET_SLOT(x, Matrix_ncSym),
1220          bVar = GET_SLOT(x, Matrix_bVarSym);          bVar = GET_SLOT(x, Matrix_bVarSym);
1221      int      int
# Line 1226  Line 1228 
1228          nf = length(ncsl) - 2,          nf = length(ncsl) - 2,
1229          nobs = nc[nf + 1],          nobs = nc[nf + 1],
1230          p,          p,
1231          pp1 = dims[1];          pp1 = dims[1],
1232            uncst = asLogical(Uncp);
1233      double      double
1234          *RZX = REAL(RZXsl),          *RZX = REAL(RZXsl),
1235          *b,          *b,
# Line 1267  Line 1270 
1270                                  &one, vali, &nci);                                  &one, vali, &nci);
1271              }              }
1272          }          }
1273            if (uncst) {
1274                if (nci == 1) {
1275                    *vali *= *REAL(VECTOR_ELT(Omega, i));
1276                } else {
1277                    error("Code not written yet");
1278                }
1279            }
1280      }      }
1281      UNPROTECT(1);      UNPROTECT(1);
1282      return ans;      return ans;

Legend:
Removed from v.100  
changed lines
  Added in v.101

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