SCM

SCM Repository

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

Annotation of /pkg/src/dgTMatrix.c

Parent Directory Parent Directory | Revision Log Revision Log


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

1 : bates 10 /* Sparse matrices in triplet form */
2 : bates 478 #include "dgTMatrix.h"
3 : bates 10
4 : bates 478 SEXP dgTMatrix_validate(SEXP x)
5 : bates 10 {
6 : maechler 534 SEXP
7 : bates 10 islot = GET_SLOT(x, Matrix_iSym),
8 : maechler 534 jslot = GET_SLOT(x, Matrix_jSym),
9 : bates 10 xslot = GET_SLOT(x, Matrix_xSym),
10 :     dimslot = GET_SLOT(x, Matrix_DimSym);
11 :     int j,
12 :     *dims = INTEGER(dimslot),
13 :     ncol, nrow, nnz = length(islot),
14 :     *xj = INTEGER(jslot),
15 :     *xi = INTEGER(islot);
16 : maechler 534
17 : bates 10 if (length(xslot) != nnz || length(jslot) != nnz)
18 : bates 582 return mkString(_("lengths of slots i, j, and x must match"));
19 : bates 10 if (length(dimslot) != 2)
20 : bates 582 return mkString(_("slot Dim must have length 2"));
21 : bates 10 nrow = dims[0]; ncol = dims[1];
22 :     for (j = 0; j < nnz; j++) {
23 :     if (xi[j] < 0 || xi[j] >= nrow)
24 : bates 582 return mkString(_("all row indices must be between 0 and nrow-1"));
25 : bates 10 if (xj[j] < 0 || xj[j] >= ncol)
26 : bates 582 return mkString(_("all column indices must be between 0 and ncol-1"));
27 : bates 10 }
28 :     return ScalarLogical(1);
29 :     }
30 : bates 70
31 : bates 488 SEXP dgTMatrix_to_dgCMatrix(SEXP x)
32 :     {
33 :     SEXP dd = GET_SLOT(x, Matrix_DimSym),
34 :     iP = GET_SLOT(x, Matrix_iSym),
35 :     ans = PROTECT(NEW_OBJECT(MAKE_CLASS("dgCMatrix")));
36 :     int *dims = INTEGER(dd), nnz = length(iP);
37 :     int *p, *ti = Calloc(nnz, int), m = dims[0], n = dims[1];
38 :     double *tx = Calloc(nnz, double);
39 : maechler 534
40 : bates 488 SET_SLOT(ans, Matrix_pSym, allocVector(INTSXP, n + 1));
41 :     SET_SLOT(ans, Matrix_DimSym, duplicate(dd));
42 :     p = INTEGER(GET_SLOT(ans, Matrix_pSym));
43 :     triplet_to_col(m, n, nnz, INTEGER(iP),
44 :     INTEGER(GET_SLOT(x, Matrix_jSym)),
45 :     REAL(GET_SLOT(x, Matrix_xSym)),
46 :     p, ti, tx);
47 :     nnz = p[n];
48 :     SET_SLOT(ans, Matrix_iSym, allocVector(INTSXP, nnz));
49 :     Memcpy(INTEGER(GET_SLOT(ans, Matrix_iSym)), ti, nnz);
50 :     SET_SLOT(ans, Matrix_xSym, allocVector(REALSXP, nnz));
51 :     Memcpy(REAL(GET_SLOT(ans, Matrix_xSym)), tx, nnz);
52 :    
53 :     Free(ti); Free(tx);
54 :     UNPROTECT(1);
55 :     return ans;
56 :     }
57 :    
58 : bates 390 static void
59 : bates 482 insert_triplets_in_array(int m, int n, int nnz,
60 : bates 390 const int xi[], const int xj[], const double xx[],
61 :     double vx[])
62 :     {
63 :     int i;
64 :     memset(vx, 0, sizeof(double) * m * n);
65 :     for (i = 0; i < nnz; i++) {
66 :     vx[xi[i] + xj[i] * m] += xx[i]; /* allow redundant entries in x */
67 :     }
68 : maechler 534 }
69 :    
70 : bates 478 SEXP dgTMatrix_to_dgeMatrix(SEXP x)
71 : bates 70 {
72 :     SEXP dd = GET_SLOT(x, Matrix_DimSym),
73 :     islot = GET_SLOT(x, Matrix_iSym),
74 : bates 478 ans = PROTECT(NEW_OBJECT(MAKE_CLASS("dgeMatrix")));
75 : maechler 534
76 : bates 70 int *dims = INTEGER(dd),
77 :     m = dims[0],
78 : bates 390 n = dims[1];
79 : maechler 534
80 : bates 342 SET_SLOT(ans, Matrix_rcondSym, allocVector(REALSXP, 0));
81 : bates 476 SET_SLOT(ans, Matrix_factorSym, allocVector(VECSXP, 0));
82 : bates 70 SET_SLOT(ans, Matrix_DimSym, duplicate(dd));
83 :     SET_SLOT(ans, Matrix_xSym, allocVector(REALSXP, m * n));
84 : bates 390 insert_triplets_in_array(m, n, length(islot),
85 :     INTEGER(islot), INTEGER(GET_SLOT(x, Matrix_jSym)),
86 : maechler 534 REAL(GET_SLOT(x, Matrix_xSym)),
87 : bates 390 REAL(GET_SLOT(ans, Matrix_xSym)));
88 : bates 70 UNPROTECT(1);
89 :     return ans;
90 :     }
91 :    
92 : bates 478 SEXP dgTMatrix_to_matrix(SEXP x)
93 : bates 390 {
94 :     SEXP dd = GET_SLOT(x, Matrix_DimSym),
95 :     islot = GET_SLOT(x, Matrix_iSym);
96 :     int m = INTEGER(dd)[0],
97 :     n = INTEGER(dd)[1];
98 :     SEXP ans = PROTECT(allocMatrix(REALSXP, m, n));
99 :    
100 :     insert_triplets_in_array(m, n, length(islot),
101 :     INTEGER(islot), INTEGER(GET_SLOT(x, Matrix_jSym)),
102 : maechler 534 REAL(GET_SLOT(x, Matrix_xSym)),
103 : bates 390 REAL(ans));
104 :     UNPROTECT(1);
105 :     return ans;
106 :     }
107 : bates 862
108 : maechler 874 SEXP graphNEL_as_dgTMatrix(SEXP x, SEXP symmetric)
109 : bates 862 {
110 :     SEXP nodes = GET_SLOT(x, install("nodes")),
111 :     edgeL = GET_SLOT(x, install("edgeL")),
112 : maechler 874 ans = PROTECT(NEW_OBJECT(MAKE_CLASS(LOGICAL(symmetric)[0]
113 :     ? "dsTMatrix"
114 :     : "dgTMatrix")));
115 : bates 862 int *ii, *jj, *dims, i, j, nnd = LENGTH(nodes), pos, totl;
116 :     double *xx;
117 : maechler 874
118 : bates 862 totl = 0;
119 :     for (i = 0; i < nnd; i++)
120 :     totl += LENGTH(Matrix_getElement(VECTOR_ELT(edgeL, i), "edges"));
121 :     dims = INTEGER(ALLOC_SLOT(ans, Matrix_DimSym, INTSXP, 2));
122 :     dims[0] = dims[1] = nnd;
123 :     if (isString(nodes)) {
124 :     SEXP dnms = ALLOC_SLOT(ans, Matrix_DimNamesSym, VECSXP, 2);
125 :     SET_VECTOR_ELT(dnms, 0, duplicate(nodes));
126 :     SET_VECTOR_ELT(dnms, 1, duplicate(nodes));
127 :     }
128 :     ii = INTEGER(ALLOC_SLOT(ans, Matrix_iSym, INTSXP, totl));
129 :     jj = INTEGER(ALLOC_SLOT(ans, Matrix_jSym, INTSXP, totl));
130 :     xx = REAL(ALLOC_SLOT(ans, Matrix_xSym, REALSXP, totl));
131 :     pos = 0;
132 :     for (i = 0; i < nnd; i++) {
133 :     SEXP edg = VECTOR_ELT(edgeL, i);
134 :     SEXP edges = Matrix_getElement(edg, "edges"),
135 :     weights = Matrix_getElement(edg, "weights");
136 :     int *edgs = INTEGER(edges), nedg = LENGTH(edges);
137 :     double *wts = REAL(weights);
138 : maechler 874
139 : bates 862 for (j = 0; j < nedg; j++) {
140 :     ii[pos] = i;
141 :     jj[pos] = edgs[j] - 1;
142 :     xx[pos] = wts[j];
143 :     }
144 :     }
145 :     UNPROTECT(1);
146 :     return ans;
147 :     }

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