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 1059 - (view) (download) (as text)

1 : bates 478 #include "dgTMatrix.h"
2 : bates 10
3 : bates 922 #include "chm_common.h"
4 :     #include "Tsparse.h"
5 :    
6 : bates 478 SEXP dgTMatrix_validate(SEXP x)
7 : bates 10 {
8 : maechler 534 SEXP
9 : bates 10 islot = GET_SLOT(x, Matrix_iSym),
10 : bates 922 xslot = GET_SLOT(x, Matrix_xSym);
11 : maechler 534
12 : bates 922 if (LENGTH(xslot) != LENGTH(islot))
13 :     return mkString(_("lengths of slots i and x must match"));
14 : bates 10 return ScalarLogical(1);
15 :     }
16 : bates 70
17 : bates 488 SEXP dgTMatrix_to_dgCMatrix(SEXP x)
18 :     {
19 : bates 922 return Tsparse_to_Csparse(x);
20 : bates 488 }
21 :    
22 : bates 390 static void
23 : bates 482 insert_triplets_in_array(int m, int n, int nnz,
24 : bates 390 const int xi[], const int xj[], const double xx[],
25 :     double vx[])
26 :     {
27 :     int i;
28 :     memset(vx, 0, sizeof(double) * m * n);
29 :     for (i = 0; i < nnz; i++) {
30 :     vx[xi[i] + xj[i] * m] += xx[i]; /* allow redundant entries in x */
31 :     }
32 : maechler 534 }
33 :    
34 : bates 478 SEXP dgTMatrix_to_dgeMatrix(SEXP x)
35 : bates 70 {
36 :     SEXP dd = GET_SLOT(x, Matrix_DimSym),
37 :     islot = GET_SLOT(x, Matrix_iSym),
38 : bates 478 ans = PROTECT(NEW_OBJECT(MAKE_CLASS("dgeMatrix")));
39 : maechler 534
40 : bates 70 int *dims = INTEGER(dd),
41 :     m = dims[0],
42 : bates 390 n = dims[1];
43 : maechler 534
44 : bates 342 SET_SLOT(ans, Matrix_rcondSym, allocVector(REALSXP, 0));
45 : bates 476 SET_SLOT(ans, Matrix_factorSym, allocVector(VECSXP, 0));
46 : bates 70 SET_SLOT(ans, Matrix_DimSym, duplicate(dd));
47 :     SET_SLOT(ans, Matrix_xSym, allocVector(REALSXP, m * n));
48 : bates 390 insert_triplets_in_array(m, n, length(islot),
49 :     INTEGER(islot), INTEGER(GET_SLOT(x, Matrix_jSym)),
50 : maechler 534 REAL(GET_SLOT(x, Matrix_xSym)),
51 : bates 390 REAL(GET_SLOT(ans, Matrix_xSym)));
52 : bates 70 UNPROTECT(1);
53 :     return ans;
54 :     }
55 :    
56 : bates 478 SEXP dgTMatrix_to_matrix(SEXP x)
57 : bates 390 {
58 :     SEXP dd = GET_SLOT(x, Matrix_DimSym),
59 :     islot = GET_SLOT(x, Matrix_iSym);
60 :     int m = INTEGER(dd)[0],
61 :     n = INTEGER(dd)[1];
62 :     SEXP ans = PROTECT(allocMatrix(REALSXP, m, n));
63 :    
64 :     insert_triplets_in_array(m, n, length(islot),
65 :     INTEGER(islot), INTEGER(GET_SLOT(x, Matrix_jSym)),
66 : maechler 534 REAL(GET_SLOT(x, Matrix_xSym)),
67 : bates 390 REAL(ans));
68 :     UNPROTECT(1);
69 :     return ans;
70 :     }
71 : bates 862
72 : maechler 874 SEXP graphNEL_as_dgTMatrix(SEXP x, SEXP symmetric)
73 : bates 862 {
74 : bates 876 int sym = asLogical(symmetric);
75 : bates 862 SEXP nodes = GET_SLOT(x, install("nodes")),
76 :     edgeL = GET_SLOT(x, install("edgeL")),
77 : bates 876 ans = PROTECT(NEW_OBJECT(MAKE_CLASS(sym
78 : maechler 874 ? "dsTMatrix"
79 :     : "dgTMatrix")));
80 : bates 862 int *ii, *jj, *dims, i, j, nnd = LENGTH(nodes), pos, totl;
81 :     double *xx;
82 : maechler 874
83 : bates 862 totl = 0;
84 :     for (i = 0; i < nnd; i++)
85 :     totl += LENGTH(Matrix_getElement(VECTOR_ELT(edgeL, i), "edges"));
86 :     dims = INTEGER(ALLOC_SLOT(ans, Matrix_DimSym, INTSXP, 2));
87 :     dims[0] = dims[1] = nnd;
88 :     if (isString(nodes)) {
89 :     SEXP dnms = ALLOC_SLOT(ans, Matrix_DimNamesSym, VECSXP, 2);
90 :     SET_VECTOR_ELT(dnms, 0, duplicate(nodes));
91 :     SET_VECTOR_ELT(dnms, 1, duplicate(nodes));
92 :     }
93 : bates 876 ii = Calloc(totl, int);
94 :     jj = Calloc(totl, int);
95 :     xx = Calloc(totl, double);
96 : bates 862 pos = 0;
97 :     for (i = 0; i < nnd; i++) {
98 :     SEXP edg = VECTOR_ELT(edgeL, i);
99 :     SEXP edges = Matrix_getElement(edg, "edges"),
100 :     weights = Matrix_getElement(edg, "weights");
101 : bates 876 int *edgs = INTEGER(PROTECT(coerceVector(edges, INTSXP))),
102 :     nedg = LENGTH(edges);
103 : bates 862 double *wts = REAL(weights);
104 : maechler 874
105 : bates 862 for (j = 0; j < nedg; j++) {
106 : bates 876 int j1 = edgs[j] - 1;
107 :     /* symmetric case stores upper triangle only */
108 :     if ((!sym) || i <= j1) {
109 :     ii[pos] = i;
110 :     jj[pos] = j1;
111 :     xx[pos] = wts[j];
112 :     pos++;
113 :     }
114 : bates 862 }
115 : bates 876 UNPROTECT(1);
116 : bates 862 }
117 : bates 876 Memcpy(INTEGER(ALLOC_SLOT(ans, Matrix_iSym, INTSXP, pos)), ii, pos);
118 :     Memcpy(INTEGER(ALLOC_SLOT(ans, Matrix_jSym, INTSXP, pos)), jj, pos);
119 :     Memcpy(REAL(ALLOC_SLOT(ans, Matrix_xSym, REALSXP, pos)), xx, pos);
120 :    
121 :     Free(ii); Free(jj); Free(xx);
122 : bates 862 UNPROTECT(1);
123 :     return ans;
124 :     }

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