SCM

SCM Repository

[matrix] Annotation of /pkg/src/factorizations.c
ViewVC logotype

Annotation of /pkg/src/factorizations.c

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1200 - (view) (download) (as text)

1 : bates 10 #include "factorizations.h"
2 :    
3 :     SEXP LU_validate(SEXP obj)
4 :     {
5 :     return ScalarLogical(1);
6 :     }
7 :    
8 : bates 631 SEXP BunchKaufman_validate(SEXP obj)
9 :     {
10 :     return ScalarLogical(1);
11 :     }
12 :    
13 : bates 649 SEXP pBunchKaufman_validate(SEXP obj)
14 :     {
15 :     return ScalarLogical(1);
16 :     }
17 :    
18 : bates 10 SEXP Cholesky_validate(SEXP obj)
19 :     {
20 :     return ScalarLogical(1);
21 :     }
22 :    
23 : bates 649 SEXP pCholesky_validate(SEXP obj)
24 :     {
25 :     return ScalarLogical(1);
26 :     }
27 :    
28 : bates 10 SEXP SVD_validate(SEXP obj)
29 :     {
30 :     return ScalarLogical(1);
31 :     }
32 : bates 582
33 :     SEXP LU_expand(SEXP x)
34 :     {
35 : bates 652 char *nms[] = {"L", "U", "P", ""};
36 :     SEXP L, U, P, val = PROTECT(Matrix_make_named(VECSXP, nms)),
37 : bates 582 lux = GET_SLOT(x, Matrix_xSym),
38 :     dd = GET_SLOT(x, Matrix_DimSym);
39 : bates 653 int *iperm, *perm, *pivot = INTEGER(GET_SLOT(x, Matrix_permSym)),
40 : bates 652 i, n = INTEGER(dd)[0];
41 : bates 582
42 :     SET_VECTOR_ELT(val, 0, NEW_OBJECT(MAKE_CLASS("dtrMatrix")));
43 :     L = VECTOR_ELT(val, 0);
44 :     SET_VECTOR_ELT(val, 1, NEW_OBJECT(MAKE_CLASS("dtrMatrix")));
45 :     U = VECTOR_ELT(val, 1);
46 : bates 652 SET_VECTOR_ELT(val, 2, NEW_OBJECT(MAKE_CLASS("pMatrix")));
47 :     P = VECTOR_ELT(val, 2);
48 : bates 582 SET_SLOT(L, Matrix_xSym, duplicate(lux));
49 : bates 652 SET_SLOT(L, Matrix_DimSym, duplicate(dd));
50 : bates 582 SET_SLOT(L, Matrix_uploSym, mkString("L"));
51 :     SET_SLOT(L, Matrix_diagSym, mkString("U"));
52 : maechler 1200 make_d_matrix_triangular(REAL(GET_SLOT(L, Matrix_xSym)), L);
53 : bates 582 SET_SLOT(U, Matrix_xSym, duplicate(lux));
54 : bates 652 SET_SLOT(U, Matrix_DimSym, duplicate(dd));
55 : bates 582 SET_SLOT(U, Matrix_uploSym, mkString("U"));
56 :     SET_SLOT(U, Matrix_diagSym, mkString("N"));
57 : maechler 1200 make_d_matrix_triangular(REAL(GET_SLOT(U, Matrix_xSym)), U);
58 : bates 652 SET_SLOT(P, Matrix_DimSym, duplicate(dd));
59 : bates 653 iperm = Calloc(n, int);
60 : bates 652 perm = INTEGER(ALLOC_SLOT(P, Matrix_permSym, INTSXP, n));
61 : maechler 1200
62 : bates 653 for (i = 0; i < n; i++) iperm[i] = i + 1; /* initialize permutation*/
63 :     for (i = 0; i < n; i++) { /* generate inverse permutation */
64 : bates 652 int newpos = pivot[i] - 1;
65 :     if (newpos != i) {
66 : bates 653 int tmp = iperm[i];
67 : bates 652
68 : bates 653 iperm[i] = iperm[newpos];
69 :     iperm[newpos] = tmp;
70 : bates 652 }
71 :     }
72 : bates 653 /* invert the inverse */
73 :     for (i = 0; i < n; i++) perm[iperm[i] - 1] = i + 1;
74 : bates 1196 Free(iperm);
75 : bates 582 UNPROTECT(1);
76 :     return val;
77 :     }

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