The R Project SVN R-packages

Rev

Rev 4418 | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 4418 Rev 4573
Line 24... Line 24...
24 
    dims = INTEGER(dimP);
 24 
    dims = INTEGER(dimP);
25 
    val = PROTECT(NEW_OBJECT(MAKE_CLASS("pCholesky")));
 25 
    val = PROTECT(NEW_OBJECT(MAKE_CLASS("pCholesky")));
26 
    SET_SLOT(val, Matrix_uploSym, duplicate(uploP));
 26 
    SET_SLOT(val, Matrix_uploSym, duplicate(uploP));
27 
    SET_SLOT(val, Matrix_diagSym, mkString("N"));
 27 
    SET_SLOT(val, Matrix_diagSym, mkString("N"));
28 
    SET_SLOT(val, Matrix_DimSym, duplicate(dimP));
 28 
    SET_SLOT(val, Matrix_DimSym, duplicate(dimP));
29 
    SET_SLOT(val, Matrix_xSym, duplicate(GET_SLOT(x, Matrix_xSym)));
 29 
    slot_dup(val, x, Matrix_xSym);
30 
    F77_CALL(dpptrf)(uplo, dims, REAL(GET_SLOT(val, Matrix_xSym)), &info);
 30 
    F77_CALL(dpptrf)(uplo, dims, REAL(GET_SLOT(val, Matrix_xSym)), &info);
31 
    if (info) {
 31 
    if (info) {
32 
	if(info > 0) /* e.g. x singular */
 32 
	if(info > 0) /* e.g. x singular */
33 
	    error(_("the leading minor of order %d is not positive definite"),
 33 
	    error(_("the leading minor of order %d is not positive definite"),
34 
		    info);
 34 
		    info);
Line 57... Line 57...
57 
{
 57 
{
58 
    SEXP Chol = dppMatrix_chol(x);
 58 
    SEXP Chol = dppMatrix_chol(x);
59 
    SEXP val = PROTECT(NEW_OBJECT(MAKE_CLASS("dppMatrix")));
 59 
    SEXP val = PROTECT(NEW_OBJECT(MAKE_CLASS("dppMatrix")));
60 
    int *dims = INTEGER(GET_SLOT(x, Matrix_DimSym)), info;
 60 
    int *dims = INTEGER(GET_SLOT(x, Matrix_DimSym)), info;
61 
 
 61 
 
62 
    SET_SLOT(val, Matrix_uploSym, duplicate(GET_SLOT(Chol, Matrix_uploSym)));
 62 
    slot_dup(val, Chol, Matrix_uploSym);
63 
    SET_SLOT(val, Matrix_xSym, duplicate(GET_SLOT(Chol, Matrix_xSym)));
 63 
    slot_dup(val, Chol, Matrix_xSym);
64 
    SET_SLOT(val, Matrix_DimSym, duplicate(GET_SLOT(Chol, Matrix_DimSym)));
 64 
    slot_dup(val, Chol, Matrix_DimSym);
65 
    F77_CALL(dpptri)(uplo_P(val), dims,
 65 
    F77_CALL(dpptri)(uplo_P(val), dims,
66 
		     REAL(GET_SLOT(val, Matrix_xSym)), &info);
 66 
		     REAL(GET_SLOT(val, Matrix_xSym)), &info);
67 
    UNPROTECT(1);
 67 
    UNPROTECT(1);
68 
    return val;
 68 
    return val;
69 
}
 69 
}