File Coverage

/root/.cpan/build/PDL-CCS-1.23.13-0/blib/lib/PDL/CCS/Utils.pm
Criterion Covered Total %
statement 32 64 50.0
branch 14 58 24.1
condition 2 30 6.6
subroutine 6 10 60.0
pod 0 6 0.0
total 54 168 32.1


line stmt bran cond sub pod time code
1              
2             #
3             # GENERATED WITH PDL::PP! Don't modify!
4             #
5             package PDL::CCS::Utils;
6              
7             @EXPORT_OK = qw( PDL::PP nnz PDL::PP nnza PDL::PP ccs_encode_pointers PDL::PP ccs_decode_pointer PDL::PP ccs_pointerlen PDL::PP ccs_xindex1d PDL::PP ccs_xindex2d PDL::PP ccs_dump_which );
8             %EXPORT_TAGS = (Func=>[@EXPORT_OK]);
9              
10 4     4   65 use PDL::Core;
  4         8  
  4         28  
11 4     4   1050 use PDL::Exporter;
  4         22  
  4         64  
12 4     4   147 use DynaLoader;
  4         10  
  4         355  
13              
14              
15              
16             $PDL::CCS::Utils::VERSION = 1.23.13;
17             @ISA = ( 'PDL::Exporter','DynaLoader' );
18             push @PDL::Core::PP, __PACKAGE__;
19             bootstrap PDL::CCS::Utils $VERSION;
20              
21              
22              
23              
24              
25             #use PDL::CCS::Config;
26 4     4   31 use strict;
  4         8  
  4         4248  
27              
28             =pod
29              
30             =head1 NAME
31              
32             PDL::CCS::Utils - Low-level utilities for compressed storage sparse PDLs
33              
34             =head1 SYNOPSIS
35              
36             use PDL;
37             use PDL::CCS::Utils;
38              
39             ##---------------------------------------------------------------------
40             ## ... stuff happens
41              
42             =cut
43              
44              
45              
46              
47              
48              
49              
50             =head1 FUNCTIONS
51              
52              
53              
54             =cut
55              
56              
57              
58              
59             *ccs_indx = \&PDL::indx; ##-- typecasting for CCS indices
60              
61              
62              
63             =pod
64              
65             =head1 Non-missing Value Counts
66              
67             =cut
68              
69              
70              
71              
72              
73             =head2 nnz
74              
75             =for sig
76              
77             Signature: (a(N); int+ [o]nnz())
78              
79             Get number of non-zero values in a PDL $a();
80             For 1d PDLs, should be equivalent to:
81              
82             $nnz = nelem(which($a!=0));
83              
84             For k>1 dimensional PDLs, projects via number of nonzero elements
85             to N-1 dimensions by computing the number of nonzero elements
86             along the the 1st dimension.
87              
88              
89             =for bad
90              
91             nnz does not process bad values.
92             It will set the bad-value flag of all output piddles if the flag is set for any of the input piddles.
93              
94              
95             =cut
96              
97              
98              
99              
100              
101              
102             *nnz = \&PDL::nnz;
103              
104              
105              
106              
107              
108             =head2 nnza
109              
110             =for sig
111              
112             Signature: (a(N); eps(); int+ [o]nnz())
113              
114             Like nnz() using tolerance constant $eps().
115             For 1d PDLs, should be equivalent to:
116              
117             $nnz = nelem(which(!$a->approx(0,$eps)));
118              
119              
120             =for bad
121              
122             nnza does not process bad values.
123             It will set the bad-value flag of all output piddles if the flag is set for any of the input piddles.
124              
125              
126             =cut
127              
128              
129              
130              
131              
132              
133             *nnza = \&PDL::nnza;
134              
135              
136              
137              
138             =pod
139              
140             =head1 Encoding Utilities
141              
142             =cut
143              
144              
145              
146              
147              
148             =head2 ccs_encode_pointers
149              
150             =for sig
151              
152             Signature: (indx ix(Nnz); indx N(); indx [o]ptr(Nplus1); indx [o]ixix(Nnz))
153              
154             General CCS encoding utility.
155              
156             Get a compressed storage "pointer" vector $ptr
157             for a dimension of size $N with non-missing values at indices $ix. Also returns a vector
158             $ixix() which may be used as an index for $ix() to align its elements with $ptr()
159             along the compressed dimension.
160              
161             The induced vector $ix-Eindex($ixix) is
162             guaranteed to be stably sorted along dimension $N():
163              
164             \forall $i,$j with 1 <= $i < $j <= $Nnz :
165              
166             $ix->index($ixix)->at($i) < $ix->index($ixix)->at($j) ##-- primary sort on $ix()
167             or
168             $ixix->at($i) < $ixix->at($j) ##-- ... stable
169              
170              
171              
172             =for bad
173              
174             ccs_encode_pointers does not process bad values.
175             It will set the bad-value flag of all output piddles if the flag is set for any of the input piddles.
176              
177              
178             =cut
179              
180              
181              
182              
183              
184             sub PDL::ccs_encode_pointers {
185 11     11 0 184 my ($ix,$N,$ptr,$ixix) = @_;
186 11 50       37 barf("Usage: ccs_encode_pointers(ix(Nnz), N(), [o]ptr(N+1), [o]ixix(Nnz)") if (!defined($ix));
187 11 50       25 $N = $ix->max()+1 if (!defined($N));
188 11 50       80 $ptr = PDL->zeroes(ccs_indx(), $N+1) if (!defined($ptr));
189 11 50       704 $ixix = PDL->zeroes(ccs_indx(), $ix->dim(0)) if (!defined($ixix));
190 11         755 &PDL::_ccs_encode_pointers_int($ix,$N,$ptr,$ixix);
191 11         78 return ($ptr,$ixix);
192             }
193              
194              
195             *ccs_encode_pointers = \&PDL::ccs_encode_pointers;
196              
197              
198              
199              
200             =pod
201              
202             =head1 Decoding Utilities
203              
204             =cut
205              
206              
207              
208              
209              
210             =head2 ccs_decode_pointer
211              
212             =for sig
213              
214             Signature: (indx ptr(Nplus1); indx proj(Nproj); indx [o]projix(NnzProj); indx [o]nzix(NnzProj))
215              
216             General CCS decoding utility.
217              
218             Project indices $proj() from a compressed storage "pointer" vector $proj().
219             If unspecified, $proj() defaults to:
220              
221             sequence($ptr->dim(0))
222              
223              
224              
225             =for bad
226              
227             ccs_decode_pointer does not process bad values.
228             It will set the bad-value flag of all output piddles if the flag is set for any of the input piddles.
229              
230              
231             =cut
232              
233              
234              
235              
236              
237             sub PDL::ccs_decode_pointer {
238 15     15 0 397 my ($ptr,$proj,$projix,$nzix) = @_;
239 15 50       41 barf("Usage: ccs_decode_pointer(ptr(N+1), proj(Nproj), [o]projix(NnzProj), [o]nzix(NnzProj)")
240             if (!defined($ptr));
241 15         21 my ($nnzproj);
242 15 100       32 if (!defined($proj)) {
243 5         15 $proj = PDL->sequence(ccs_indx(), $ptr->dim(0)-1);
244 5         536 $nnzproj = $ptr->at(-1);
245             }
246 15 50 66     90 if (!defined($projix) || !defined($nzix)) {
247 15 100       312 $nnzproj = ($ptr->index($proj+1)-$ptr->index($proj))->sum if (!defined($nnzproj));
248 15 50       613 return (null,null) if (!$nnzproj);
249 15 100       53 $projix = PDL->zeroes(ccs_indx(), $nnzproj) if (!defined($projix));
250 15 50       821 $nzix = PDL->zeroes(ccs_indx(), $nnzproj) if (!defined($nzix));
251             }
252 15         962 &PDL::_ccs_decode_pointer_int($ptr,$proj,$projix,$nzix);
253 15         68 return ($projix,$nzix);
254             }
255              
256              
257             *ccs_decode_pointer = \&PDL::ccs_decode_pointer;
258              
259              
260              
261              
262              
263             =head2 ccs_pointerlen
264              
265             =for sig
266              
267             Signature: (ptr(Nplus1); [o]ptrlen(N))
268              
269              
270             Get number of non-missing values for each axis value from a CCS-encoded
271             offset pointer vector $ptr().
272              
273              
274              
275             =for bad
276              
277             ccs_pointerlen does not process bad values.
278             It will set the bad-value flag of all output piddles if the flag is set for any of the input piddles.
279              
280              
281             =cut
282              
283              
284              
285              
286              
287             sub PDL::ccs_pointerlen {
288 0     0 0   my ($ptr,$len) = @_;
289 0 0         $len = zeroes($ptr->type, $ptr->nelem-1) if (!defined($len));
290 0           &PDL::_ccs_pointerlen_int($ptr,$len);
291 0           return $len;
292             }
293              
294              
295             *ccs_pointerlen = \&PDL::ccs_pointerlen;
296              
297              
298              
299              
300             =pod
301              
302             =head1 Indexing Utilities
303              
304             =cut
305              
306              
307              
308              
309              
310             =head2 ccs_xindex1d
311              
312             =for sig
313              
314             Signature: (which(Ndims,Nnz); a(Na); [o]nzia(NnzA); [o]nnza())
315              
316              
317             Compute indices $nzai() along dimension C of $which() whose initial values $which(0,$nzai)
318             match some element of $a(). Appropriate for indexing a sparse encoded PDL
319             with non-missing entries at $which()
320             along the 0th dimension, a la L.
321             $which((0),) and $a() must be both sorted in ascending order.
322              
323             In list context, returns a list ($nzai,$nnza), where $nnza() is the number of indices found,
324             and $nzai are those C indices. In scalar context, trims the output vector $nzai() to $nnza()
325             elements.
326              
327              
328              
329             =for bad
330              
331             ccs_xindex1d does not process bad values.
332             It will set the bad-value flag of all output piddles if the flag is set for any of the input piddles.
333              
334              
335             =cut
336              
337              
338              
339              
340              
341             sub PDL::ccs_xindex1d {
342 0     0 0   my ($which,$a,$nzia,$nnza) = @_;
343             barf("Usage: ccs_xindex2d(which(Ndims,Nnz), a(Na), [o]nzia(NnzA), [o]nnza()")
344 0 0 0       if ((grep {!defined($_)} @_[0..1]) || $which->ndims < 2 || $which->dim(0) < 1);
  0   0        
345 0 0 0       $nnza = $nzia->dim(0) if (defined($nzia) && !defined($nnza));
346 0 0         $nnza = $which->dim(1) if (!defined($nnza));
347 0 0         $nnza = pdl($which->type, $nnza) if (!ref($nnza));
348 0 0         $nzia = PDL->zeroes($which->type, $nnza->sclr) if (!defined($nzia));
349 0           &PDL::_ccs_xindex1d_int($which,$a,$nzia,$nnza);
350 0 0         return ($nzia,$nnza) if (wantarray);
351 0           return $nzia->reshape($nnza->sclr);
352             }
353              
354              
355             *ccs_xindex1d = \&PDL::ccs_xindex1d;
356              
357              
358              
359              
360              
361             =head2 ccs_xindex2d
362              
363             =for sig
364              
365             Signature: (which(Ndims,Nnz); a(Na); b(Nb); [o]ab(Nab); [o]nab())
366              
367              
368             Compute indices along dimension C of $which() corresponding to any combination
369             of values in the Cartesian product of $a() and $b(). Appropriate for indexing a
370             2d sparse encoded PDL with non-missing entries at $which() via the ND-index piddle
371             $a-Eslice("*1,")-Ecat($b)-Eclump(2)-Exchg(0,1), i.e. all pairs $ai,$bi with $ai in $a()
372             and $bi in $b(). $a() and $b() values must be be sorted in ascending order
373              
374             In list context, returns a list ($ab,$nab), where $nab() is the number of indices found,
375             and $ab are those C indices. In scalar context, trims the output vector $ab() to $nab()
376             elements.
377              
378              
379              
380             =for bad
381              
382             ccs_xindex2d does not process bad values.
383             It will set the bad-value flag of all output piddles if the flag is set for any of the input piddles.
384              
385              
386             =cut
387              
388              
389              
390              
391              
392             sub PDL::ccs_xindex2d {
393 0     0 0   my ($which,$a,$b,$ab,$nab) = @_;
394             barf("Usage: ccs_xindex2d(which(2,Nnz), a(Na), b(Nb), [o]nab(), [o]ab(Nab)")
395 0 0 0       if ((grep {!defined($_)} @_[0..2]) || $which->ndims != 2 || $which->dim(0) < 2);
  0   0        
396 0 0 0       $nab = $ab->dim(0) if (defined($ab) && !defined($nab));
397 0 0         if (!defined($nab)) {
398 0           $nab = $a->nelem*$b->nelem;
399 0 0         $nab = $which->dim(1) if ($which->dim(1)) < $nab;
400             }
401 0 0         $nab = pdl($which->type, $nab) if (!ref($nab));
402 0 0         $ab = PDL->zeroes($which->type, $nab->sclr) if (!defined($ab));
403 0           &PDL::_ccs_xindex2d_int($which,$a,$b,$ab,$nab);
404 0 0         return ($ab,$nab) if (wantarray);
405 0           return $ab->reshape($nab->sclr);
406             }
407              
408              
409             *ccs_xindex2d = \&PDL::ccs_xindex2d;
410              
411              
412              
413              
414             =pod
415              
416             =head1 Debugging Utilities
417              
418             =cut
419              
420              
421              
422              
423              
424             =head2 ccs_dump_which
425              
426             =for sig
427              
428             Signature: (indx which(Ndims,Nnz); SV *HANDLE; char *fmt; char *fsep; char *rsep)
429              
430              
431             Print a text dump of an index PDL to the filehandle C, which default to C.
432             C<$fmt> is a printf() format to use for output, which defaults to "%d".
433             C<$fsep> and C<$rsep> are field-and record separators, which default to
434             a single space and C<$/>, respectively.
435              
436              
437              
438             =for bad
439              
440             ccs_dump_which does not process bad values.
441             It will set the bad-value flag of all output piddles if the flag is set for any of the input piddles.
442              
443              
444             =cut
445              
446              
447              
448              
449              
450             sub PDL::ccs_dump_which {
451 0     0 0   my ($which,$fh,$fmt,$fsep,$rsep) = @_;
452 0 0 0       $fmt = '%d' if (!defined($fmt) || $fmt eq '');
453 0 0 0       $fsep = " " if (!defined($fsep) || $fsep eq '');
454 0 0 0       $rsep = "$/" if (!defined($rsep) || $rsep eq '');
455 0 0         $fh = \*STDOUT if (!defined($fh));
456 0           &PDL::_ccs_dump_which_int($which,$fh,$fmt,$fsep,$rsep);
457             }
458              
459              
460             *ccs_dump_which = \&PDL::ccs_dump_which;
461              
462              
463              
464              
465             ##---------------------------------------------------------------------
466             =pod
467              
468             =head1 ACKNOWLEDGEMENTS
469              
470             Perl by Larry Wall.
471              
472             PDL by Karl Glazebrook, Tuomas J. Lukka, Christian Soeller, and others.
473              
474             =cut
475              
476             ##----------------------------------------------------------------------
477             =pod
478              
479             =head1 KNOWN BUGS
480              
481             Probably many.
482              
483             =cut
484              
485              
486             ##---------------------------------------------------------------------
487             =pod
488              
489             =head1 AUTHOR
490              
491             Bryan Jurish Emoocow@cpan.orgE
492              
493             =head2 Copyright Policy
494              
495             Copyright (C) 2007-2013, Bryan Jurish. All rights reserved.
496              
497             This package is free software, and entirely without warranty.
498             You may redistribute it and/or modify it under the same terms
499             as Perl itself.
500              
501             =head1 SEE ALSO
502              
503             perl(1), PDL(3perl)
504              
505             =cut
506              
507              
508              
509             ;
510              
511              
512              
513             # Exit with OK status
514              
515             1;
516              
517