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 113, Tue Apr 20 17:34:49 2004 UTC revision 114, Wed Apr 21 20:45:22 2004 UTC
# Line 602  Line 602 
602                          RZX, &n, &one, RXX, &pp1);                          RZX, &n, &one, RXX, &pp1);
603          F77_CALL(dpotrf)("U", &pp1, RXX, &pp1, &i);          F77_CALL(dpotrf)("U", &pp1, RXX, &pp1, &i);
604          if (i)          if (i)
605              error("DPOTRF returned error code %d", i);              error("Could not factor downdated X'X, code %d", i);
606                                  /* logdet of RXX */                                  /* logdet of RXX */
607          for (i = 0; i < (pp1 - 1); i++)          for (i = 0; i < (pp1 - 1); i++)
608              dcmp[2] += 2 * log(RXX[i*pp2]);              dcmp[2] += 2 * log(RXX[i*pp2]);
# Line 1222  Line 1222 
1222                  }                  }
1223              }              }
1224              F77_CALL(dpotrf)("U", &nci, vali, &nci, &info);              F77_CALL(dpotrf)("U", &nci, vali, &nci, &info);
1225              if (info) error("DPOTRF returned error code %d", info);              if (info)
1226                    error("DPOTRF returned error code %d in Omega[[%d]] update",
1227                          info, i + 1);
1228              F77_CALL(dpotri)("U", &nci, vali, &nci, &info);              F77_CALL(dpotri)("U", &nci, vali, &nci, &info);
1229              if (info) error("DPOTRI returned error code %d", info);              if (info)
1230                    error("DPOTRI returned error code %d in Omega[[%d]] update",
1231                          info, i + 1);
1232          }          }
1233          status[0] = status[1] = 0;          status[0] = status[1] = 0;
1234      }      }
# Line 1413  Line 1417 
1417      return val;      return val;
1418  }  }
1419    
1420    SEXP ssclme_collapse(SEXP x)
1421    {
1422        SEXP ans = PROTECT(NEW_OBJECT(MAKE_CLASS("ssclme"))),
1423            Omega = GET_SLOT(x, Matrix_OmegaSym),
1424            Dim = GET_SLOT(x, Matrix_DimSym);
1425        int i, nf = length(Omega), nz = INTEGER(Dim)[1];
1426        SEXP copy[] = {Matrix_DSym, Matrix_DIsqrtSym, Matrix_DimSym,
1427                       Matrix_GpSym, Matrix_LIiSym, Matrix_LIpSym,
1428                       Matrix_LIxSym, Matrix_LiSym, Matrix_LpSym,
1429                       Matrix_LxSym, Matrix_OmegaSym, Matrix_ParentSym,
1430                       Matrix_LIxSym, Matrix_LiSym, Matrix_LpSym,
1431                       Matrix_bVarSym, Matrix_devianceSym,
1432                       Matrix_devCompSym, Matrix_iSym, Matrix_ncSym,
1433                       Matrix_statusSym, Matrix_pSym, Matrix_xSym};
1434    
1435        for (i = 0; i < 23; i++)
1436            SET_SLOT(ans, copy[i], duplicate(GET_SLOT(x, copy[i])));
1437    
1438        INTEGER(GET_SLOT(ans, Matrix_ncSym))[nf] = 1;
1439        SET_SLOT(ans, Matrix_XtXSym, allocMatrix(REALSXP, 1, 1));
1440        SET_SLOT(ans, Matrix_RXXSym, allocMatrix(REALSXP, 1, 1));
1441        SET_SLOT(ans, Matrix_ZtXSym, allocMatrix(REALSXP, nz, 1));
1442        SET_SLOT(ans, Matrix_RZXSym, allocMatrix(REALSXP, nz, 1));
1443        UNPROTECT(1);
1444        return ans;
1445    }
1446    
1447    

Legend:
Removed from v.113  
changed lines
  Added in v.114

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