SCM

SCM Repository

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

Annotation of /pkg/Matrix/src/t_gCMatrix_colSums.c

Parent Directory Parent Directory | Revision Log Revision Log


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

1 : maechler 1920 /*------ Definition of a template for [diln]gCMatrix_colsums(...) : *
2 :     * -------- ~~~~~~~~~~~~~~~~~~~~~~
3 :     * i.e., included several times from ./dgCMatrix.c
4 :     * ~~~~~~~~~~~~~
5 :     */
6 :    
7 :    
8 :     /* for all cases with an 'x' slot -- i.e. almost all cases ;
9 :     * just redefine this in the other cases:
10 :     */
11 :    
12 :     #ifdef _dgC_
13 :    
14 :     # define gCMatrix_colSums dgCMatrix_colSums
15 :     # define _DOUBLE_ans
16 :     # define _has_x_slot_
17 : maechler 1921 /*Future? # define _has_x_d_slot_ */
18 : maechler 1920 # undef _dgC_
19 :    
20 :     #elif defined (_igC_)
21 :    
22 :     # define gCMatrix_colSums igCMatrix_colSums
23 :     # define _DOUBLE_ans
24 :     # define _has_x_slot_
25 : maechler 1921 /*Future? # define _has_x_d_slot_ */
26 : maechler 1920 # undef _igC_
27 :    
28 :     #elif defined (_lgC_)
29 :    
30 :     # define gCMatrix_colSums lgCMatrix_colSums_i
31 :     # define _INT_ans
32 :     # define _has_x_slot_
33 : maechler 1921 /*Future? # define _has_x_l_slot_ */
34 : maechler 1920 # undef _lgC_
35 :    
36 :     #elif defined (_lgC_mn)
37 :    
38 :     # define gCMatrix_colSums lgCMatrix_colSums_d
39 :     # define _DOUBLE_ans
40 :     # define _has_x_slot_
41 : maechler 1921 /*Future? # define _has_x_l_slot_ */
42 : maechler 1920 # undef _lgC_mn
43 :    
44 :     #elif defined (_ngC_)
45 :    
46 :     # define gCMatrix_colSums ngCMatrix_colSums_i
47 :     # define _INT_ans
48 : maechler 1921 /* withOUT 'x' slot */
49 : maechler 1920 # undef _ngC_
50 :    
51 :     #elif defined (_ngC_mn)
52 :    
53 :     # define gCMatrix_colSums ngCMatrix_colSums_d
54 :     # define _DOUBLE_ans
55 : maechler 1921 /* withOUT 'x' slot */
56 : maechler 1920 # undef _ngC_mn
57 :    
58 :     #elif defined (_zgC_)
59 :    
60 :     # error "zgC* not yet implemented"
61 :    
62 :     #else
63 :    
64 :     # error "no valid _[dilnz]gC_ option"
65 :    
66 :     #endif
67 :    
68 :     /* - - - - - - - - - - - - - - - - - - - - */
69 :    
70 : maechler 1921 /* Most of this is maybe for the future,
71 :     * when cholmod has integer 'x' slot :*/
72 :     #ifdef _has_x_d_slot_
73 :    
74 :     # define Type_x_ double
75 :     # define STYP_x_ REAL
76 :     # define _has_x_slot_
77 :     # undef _has_x_d_slot_
78 :    
79 :     #elif defined (_has_x_i_slot_)
80 :    
81 :     # define Type_x_ int
82 :     # define STYP_x_ INTEGER
83 :     # define _has_x_slot_
84 :     # undef _has_x_i_slot_
85 :    
86 :     #elif defined (_has_x_l_slot_)
87 :    
88 :     # define Type_x_ int
89 :     # define STYP_x_ LOGICAL
90 :     # define _has_x_slot_
91 :     # undef _has_x_l_slot_
92 :    
93 :     #endif
94 :    
95 :     /* - - - - - - - - - - - - - - - - - - - - */
96 :    
97 : maechler 1920 #ifdef _DOUBLE_ans
98 :    
99 :     # define SparseResult_class "dsparseVector"
100 :     # define Type_ans double
101 :     # define STYP_ans REAL
102 :     # define NA_ans NA_REAL
103 :     # define SXP_ans REALSXP
104 : maechler 1921 # define COERCED(x) (x)
105 : maechler 1920 #undef _DOUBLE_ans
106 :    
107 :     #elif defined (_INT_ans)
108 :    
109 :     # define SparseResult_class "isparseVector"
110 :     # define Type_ans int
111 :     # define STYP_ans INTEGER
112 :     # define NA_ans NA_INTEGER
113 :     # define SXP_ans INTSXP
114 : maechler 1921 # define COERCED(x) (Type_ans)(x != 0)
115 : maechler 1920 #undef _INT_ans
116 :    
117 :     #else
118 :     # error "invalid macro logic"
119 :     #endif
120 :    
121 :     /* - - - - - - - - - - - - - - - - - - - - */
122 :    
123 :     #ifdef _has_x_slot_
124 : maechler 1921
125 :     /* currently have x slot always double (cholmod restriction): */
126 :     # define is_NA_x_(u) ISNAN(u)
127 :    
128 : maechler 1920 # define ColSUM_column(_i1_,_i2_,_SUM_) \
129 :     if(mn) dnm = cx->nrow; /* denominator for means */ \
130 : maechler 1921 for(i = _i1_, _SUM_ = 0; i < _i2_; i++) { \
131 :     if (is_NA_x_(xx[i])) { \
132 :     if(!na_rm) { \
133 :     _SUM_ = NA_ans; \
134 :     break; \
135 :     } \
136 :     /* else: na_rm : skip NAs , */ \
137 :     if(mn) /* but decrement denominator */ \
138 :     dnm--; \
139 :     } else _SUM_ += COERCED(xx[i]); \
140 :     } \
141 : maechler 1920 if(mn) _SUM_ = (dnm > 0) ? _SUM_/dnm : NA_ans
142 :    
143 : maechler 1921 #else /* no 'x' slot -> no NAs ... */
144 :    
145 : maechler 1920 # define ColSUM_column(_i1_,_i2_,_SUM_) \
146 :     _SUM_ = _i2_ - _i1_; \
147 :     if(mn) _SUM_ /= cx->nrow
148 :     #endif
149 :    
150 : maechler 1921 /* Now the template which depends on the above macros : */
151 : maechler 1920
152 :     SEXP gCMatrix_colSums(SEXP x, SEXP NArm, SEXP spRes, SEXP trans, SEXP means)
153 :     {
154 :     int mn = asLogical(means), sp = asLogical(spRes), tr = asLogical(trans);
155 : maechler 1921 /* cholmod_sparse: drawback of coercing lgC to double: */
156 : mmaechler 2223 CHM_SP cx = AS_CHM_SP__(x);
157 : maechler 1960 R_CheckStack();
158 :    
159 : maechler 1921 if (tr) {
160 : mmaechler 2661 cholmod_sparse *cxt = cholmod_transpose(cx, (int)cx->xtype, &c);
161 : maechler 1921 cx = cxt;
162 :     }
163 : maechler 1960
164 : maechler 1921 /* everything else *after* the above potential transpose : */
165 : maechler 1960 /* Don't declarations here require the C99 standard? Can we assume C99? */
166 :    
167 : maechler 1921 int j, nc = cx->ncol;
168 :     int *xp = (int *)(cx -> p);
169 : maechler 1920 #ifdef _has_x_slot_
170 :     int na_rm = asLogical(NArm), i, dnm = 0/*Wall*/;
171 : maechler 1921 double *xx = (double *)(cx -> x);
172 : maechler 1920 #endif
173 :     SEXP ans = PROTECT(sp ? NEW_OBJECT(MAKE_CLASS(SparseResult_class))
174 : maechler 1921 : allocVector(SXP_ans, nc));
175 : maechler 1920
176 : mmaechler 2661 if (sp) { // sparseResult, i.e. *sparseVector (never allocating length-nc)
177 : maechler 1920 int nza, i1, i2, p, *ai;
178 :     Type_ans *ax;
179 :    
180 : maechler 1921 for (j = 0, nza = 0; j < nc; j++)
181 : maechler 1920 if(xp[j] < xp[j + 1])
182 :     nza++;
183 :    
184 :     ai = INTEGER(ALLOC_SLOT(ans, Matrix_iSym, INTSXP, nza));
185 :     ax = STYP_ans(ALLOC_SLOT(ans, Matrix_xSym, SXP_ans, nza));
186 :    
187 : maechler 1921 SET_SLOT(ans, Matrix_lengthSym, ScalarInteger(nc));
188 : maechler 1920
189 :     i2 = xp[0];
190 : maechler 1921 for (j = 1, p = 0; j <= nc; j++) {
191 : maechler 1920 /* j' =j+1, since 'i' slot will be 1-based */
192 :     i1 = i2; i2 = xp[j];
193 :     if(i1 < i2) {
194 :     Type_ans sum;
195 :     ColSUM_column(i1,i2, sum);
196 :    
197 :     ai[p] = j;
198 :     ax[p++] = sum;
199 :     }
200 :     }
201 :     }
202 :     else { /* "numeric" (non sparse) result */
203 :     Type_ans *a = STYP_ans(ans);
204 : maechler 1921 for (j = 0; j < nc; j++) {
205 : maechler 1920 ColSUM_column(xp[j], xp[j + 1], a[j]);
206 :     }
207 :     }
208 :    
209 : mmaechler 2661 if (tr) cholmod_free_sparse(&cx, &c);
210 : maechler 1920 UNPROTECT(1);
211 :     return ans;
212 :     }
213 :    
214 :     #undef ColSUM_column
215 :    
216 :     #undef NA_ans
217 :     #undef STYP_ans
218 :     #undef SXP_ans
219 :     #undef SparseResult_class
220 :     #undef Type_ans
221 :    
222 : maechler 1921 #undef COERCED
223 :    
224 :     #ifdef _has_x_slot_
225 :     # undef NA_x_
226 :     # undef Type_x_
227 :     # undef STYP_x_
228 :     # undef _has_x_slot_
229 :     #endif
230 :    
231 : maechler 1920 #undef gCMatrix_colSums

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