File Coverage

/root/.cpan/build/PDL-CCS-1.23.12-0/blib/lib/PDL/CCS/Compat.pm
Criterion Covered Total %
statement 145 173 83.8
branch 38 60 63.3
condition 6 18 33.3
subroutine 30 36 83.3
pod 16 23 69.5
total 235 310 75.8


line stmt bran cond sub pod time code
1             ## File: PDL::CCS::Compat.pm
2             ## Author: Bryan Jurish
3             ## Description: backwards-compatibility hacks for PDL::CCS
4              
5             package PDL::CCS::Compat;
6 4     4   27 use PDL;
  4         9  
  4         22  
7 4     4   11639 use PDL::VectorValued;
  4         25070  
  4         35  
8 4     4   709 use PDL::CCS::Config qw(ccs_indx);
  4         9  
  4         191  
9 4     4   1867 use PDL::CCS::Functions;
  4         9  
  4         29  
10 4     4   743 use PDL::CCS::Utils;
  4         9  
  4         23  
11 4     4   2935 use PDL::CCS::Ufunc;
  4         11  
  4         29  
12 4     4   2503 use PDL::CCS::Ops;
  4         12  
  4         27  
13 4     4   436 use strict;
  4         21  
  4         13258  
14              
15             our $VERSION = '1.23.12'; ##-- update with perl-reversion from Perl::Version module
16             our @ISA = ('PDL::Exporter');
17             our @ccs_binops = (qw(plus minus mult divide modulo power),
18             qw(gt ge lt le eq ne spaceship),
19             qw(and2 or2 xor shiftleft shiftright),
20             );
21             our @EXPORT_OK =
22             (
23             ##
24             ##-- Encoding
25             qw(ccs_encode_compat),
26             qw(ccsencode ccsencode_nz ccsencodefull ccsencodefull_nz),
27             qw(ccsencodea ccsencode_naz ccsencodefulla ccsencodefull_naz),
28             qw(ccsencodeg ccsencode_g ccsencodefullg ccsencodefull_g),
29             qw(ccsencodei ccsencode_i ccsencodefulli ccsencodefull_i),
30             qw(ccsencodei2d ccsencode_i2d ccsencodefulli2d ccsencodefull_i2d),
31             ##
32             ##-- Decoding
33             qw(_ccsdecodecols ccsdecodecols),
34             qw(ccsdecode ccsdecodefull),
35             qw(ccsdecode_g ccsdecodeg ccsdecodefull_g ccsdecodefullg),
36             ##
37             ##-- Indexing
38             qw(ccsiNDtonzi ccsi2dtonzi ccsitonzi),
39             qw(ccswhichND ccswhich2d ccswhichfull ccswhich),
40             qw(ccstranspose ccstransposefull),
41             ##
42             ##-- Lookup
43             qw(ccsget ccsget2d),
44             ##
45             ##-- Operations
46             (map {("ccs${_}_cv","ccs${_}_rv")} (@ccs_binops,qw(add diff))),
47             ##
48             ##-- Ufuncs
49             (map {("ccs${_}","ccs${_}t")} qw(sumover prodover)),
50             );
51             our %EXPORT_TAGS =
52             (
53             Func => [@EXPORT_OK], ##-- respect PDL conventions (hopefully)
54             );
55              
56             ##======================================================================
57             ## pod: headers
58             =pod
59              
60             =head1 NAME
61              
62             PDL::CCS::Compat - Backwards-compatibility module for PDL::CCS
63              
64             =head1 SYNOPSIS
65              
66             use PDL;
67             use PDL::CCS::Compat;
68              
69             ##-- source pdl
70             $a = random($N=8,$M=7);
71              
72             ##---------------------------------------------------------------------
73             ## Non-missing value counts
74             $nnz = $a->flat->nnz; ##-- "missing" == 0
75             $nnaz = $a->flat->nnza(1e-6); ##-- "missing" ~= 0
76             #$ngood = $a->ngood; ##-- "missing" == BAD (see PDL::Bad)
77              
78             ##---------------------------------------------------------------------
79             ## CCS Encoding
80             ($ptr,$rowids,$vals) = ccsencode_nz ($a); # missing == 0
81             ($ptr,$rowids,$vals) = ccsencode_naz($a,$eps); # missing ~= 0
82             ($ptr,$rowids,$vals) = ccsencode_g ($a); # missing == BAD
83             ($ptr,$rowids,$vals) = ccsencode_i ($i,$ivals,$N); # generic flat
84             ($ptr,$rowids,$vals) = ccsencode_i2d($xi,$yi,$ivals); # generic 2d
85              
86             ##---------------------------------------------------------------------
87             ## CCS Decoding
88             $cols = ccsdecodecols($ptr,$rowids,$nzvals, $xvals
89             $a2 = ccsdecode ($ptr,$rowids,$vals); # missing == 0
90             $a2 = ccsdecode_g($ptr,$rowids,$vals); # missing == BAD
91              
92             ##---------------------------------------------------------------------
93             ## CCS Index Conversion
94             $nzi = ccsitonzi ($ptr,$rowids, $ix, $missing); # ix => nzi
95             $nzi = ccsi2dtonzi($ptr,$rowids, $xi,$yi, $missing); # 2d => nzi
96              
97             $ix = ccswhich ($ptr,$rowids,$vals); # CCS => ix
98             ($xi,$yi) = ccswhichND($ptr,$rowids,$vals); # CCS => 2d
99             $xyi = ccswhichND($ptr,$rowids,$vals); # ...as scalar
100              
101             ##---------------------------------------------------------------------
102             ## CCS Lookup
103              
104             $ixvals = ccsget ($ptr,$rowids,$vals, $ix,$missing); # ix => values
105             $ixvals = ccsget2d($ptr,$rowids,$vals, $xi,$yi,$missing); # 2d => values
106              
107             ##---------------------------------------------------------------------
108             ## CCS Operations
109             ($ptrT,$rowidsT,$valsT) = ccstranspose($ptr,$rowids,$vals); # CCS<->CRS
110              
111             ##---------------------------------------------------------------------
112             ## Vector Operations, by column
113             $nzvals_out = ccsadd_cv ($ptr,$rowids,$nzvals, $colvec);
114             $nzvals_out = ccsdiff_cv($ptr,$rowids,$nzvals, $colvec);
115             $nzvals_out = ccsmult_cv($ptr,$rowids,$nzvals, $colvec);
116             $nzvals_out = ccsdiv_cv ($ptr,$rowids,$nzvals, $colvec);
117              
118             ##---------------------------------------------------------------------
119             ## Vector Operations, by row
120             $nzvals_out = ccsadd_rv ($ptr,$rowids,$nzvals, $rowvec);
121             $nzvals_out = ccsdiff_rv($ptr,$rowids,$nzvals, $rowvec);
122             $nzvals_out = ccsmult_rv($ptr,$rowids,$nzvals, $rowvec);
123             $nzvals_out = ccsdiv_rv ($ptr,$rowids,$nzvals, $rowvec);
124              
125             ##---------------------------------------------------------------------
126             ## Scalar Operations
127             $nzvals_out = $nzvals * 42; # ... or whatever
128              
129             ##---------------------------------------------------------------------
130             ## Accumulators
131             $rowsumover = ccssumover ($ptr,$rowids,$nzvals); ##-- like $a->sumover()
132             $colsumovert = ccssumovert($ptr,$rowids,$nzvals); ##-- like $a->xchg(0,1)->sumover
133              
134             =cut
135              
136             ##======================================================================
137             ## Encoding
138             =pod
139              
140             =head1 Encoding
141              
142             =cut
143              
144             ##---------------------------------------------------------------
145             ## Encoding: generic
146              
147             =pod
148              
149             =head2 ccs_encode_compat
150              
151             =for sig
152              
153             Signature: (indx awhich(2,Nnz); avals(Nnz);
154             indx $N; indx $M;
155             indx [o]ptr(N); indx [o]rowids(Nnz); [o]nzvals(Nnz))
156              
157             Generic wrapper for backwards-compatible ccsencode() variants.
158              
159             =cut
160              
161             *ccs_encode_compat = \&PDL::ccs_encode_compat;
162             sub PDL::ccs_encode_compat {
163 11     11 0 743 my ($aw,$avals,$N,$M,$ptr,$rowids,$nzvals) = @_;
164              
165 11 50       34 $N = $aw->slice("(0),")->max+1 if (!defined($N));
166 11 100       32 $M = $aw->slice("(1),")->max+1 if (!defined($M));
167              
168 11         268 my ($ptr1,$awi) = ccs_encode_pointers($aw->slice("(0),"), $N);
169              
170 11 100       59 if (defined($ptr)) { $ptr .= $ptr1->slice("0:-2"); }
  4         15  
171 7         23 else { $ptr = $ptr1->slice("0:-2"); $ptr->sever; }
  7         127  
172              
173 11 100       230 if (defined($rowids)) { $rowids .= $aw->slice("(1),")->index($awi); }
  4         13  
174 7         18 else { $rowids = $aw->slice("(1),")->index($awi); $rowids->sever; }
  7         166  
175              
176 11 100       199 if (defined($nzvals)) { $nzvals .= $avals->index($awi); }
  4         24  
177 7         31 else { $nzvals = $avals->index($awi); $nzvals->sever; }
  7         64  
178              
179 11         192 return ($ptr,$rowids,$nzvals);
180             }
181              
182             ##---------------------------------------------------------------
183             ## Encoding: MISSING=zero
184             =pod
185              
186             =head2 ccsencode
187              
188             =head2 ccsencode_nz
189              
190             =for sig
191              
192             Signature: (a(N,M); indx [o]ptr(N); indx [o]rowids(Nnz); [o]nzvals(Nnz))
193              
194             Encodes matrix $a() in compressed column format, interpreting zeroes
195             as "missing" values.
196              
197             Allocates output vectors if required.
198              
199             =cut
200              
201             *ccsencode
202             = *ccsencodefull = *ccsencodefull_nz
203             = *PDL::ccsencode = *PDL::ccsencode_nz
204             = *PDL::ccsencodefull = *PDL::ccsencodefull_nz
205             = \&ccsencode_nz;
206             sub ccsencode_nz {
207             #my ($a,$ptr,$rowids,$nzvals) = @_;
208 4     4 1 1543 my $a = shift;
209 4         33 $a = $a->clump(1+$a->ndims-2); ##-- clump(-2) broken in PDL-2.0.14
210 4         74 my $aw = $a->whichND;
211 4         2164 return ccs_encode_compat($aw, $a->indexND($aw), $a->dims, @_);
212             }
213              
214             ##---------------------------------------------------------------
215             ## Encoding: MISSING=ZERO (approx)
216             =pod
217              
218             =head2 ccsencodea
219              
220             =head2 ccsencode_naz
221              
222             =for sig
223              
224             Signature: (a(N,M); eps(); indx [o]ptr(N); indx [o]rowids(Nnz); [o]nzvals(Nnz))
225              
226             Encodes matrix $a() in CCS format interpreting approximate zeroes as "missing" values.
227             This function is just like ccsencode_nz(), but uses the tolerance parameter
228             $eps() to determine which elements are to be treated as zeroes.
229              
230             Allocates output vectors if required.
231              
232             =cut
233              
234             *ccsencodea
235             = *ccsencodefulla = *ccsencodefull_naz
236             = *PDL::ccsencodea = *PDL::ccsencode_naz
237             = *PDL::ccsencodefulla = *PDL::ccsencodefull_naz
238             = \&ccsencode_naz;
239             sub ccsencode_naz {
240             #my ($a,$eps,$ptr,$rowids,$nzvals) = @_;
241 2     2 1 968 my $a = shift;
242 2         4 my $eps = shift;
243 2         11 $a = $a->clump(1+$a->ndims-2); ##-- clump(-2) is broken in PDL-2.014
244 2         28 my $aw = $a->approx(0,$eps)->inplace->not->whichND; ##-- FIXME: optimize
245 2         985 return ccs_encode_compat($aw, $a->indexND($aw), $a->dims, @_);
246             }
247              
248             ##---------------------------------------------------------------
249             ## Encoding: MISSING=BAD
250             =pod
251              
252             =head2 ccsencodeg
253              
254             =head2 ccsencode_g
255              
256             =for sig
257              
258             Signature: (a(N,M); indx [o]ptr(N); indx [o]rowids(Nnz); [o]nzvals(Nnz))
259              
260             Encodes matrix $a() in CCS format interpreting BAD values
261             as "missing". Requires bad-value support built into PDL.
262              
263             Allocates output vectors if required.
264              
265             =cut
266              
267             *ccsencodeg
268             = *ccsencodefullg = *ccsencodefull_g
269             = *PDL::ccsencodeg = *PDL::ccsencode_g
270             = *PDL::ccsencodefullg = *PDL::ccsencodefull_g
271             = \&ccsencode_g;
272             sub ccsencode_g {
273             #my ($a,$ptr,$rowids,$nzvals) = @_;
274 0     0 1 0 my $a = shift;
275 0         0 $a = $a->clump(1+$a->ndims-2); ##-- clump(-2) is broken in PDL-v2.014
276 0         0 my $amask = zeroes(byte,$a->dims);
277 0         0 $a->isgood($amask);
278 0         0 my $aw = $amask->whichND;
279 0         0 return ccs_encode_compat($aw, $a->indexND($aw), $a->dims, @_);
280             }
281              
282             ##---------------------------------------------------------------
283             ## Encoding: from flat index
284             =pod
285              
286             =head2 ccsencode_i
287              
288             =for sig
289              
290             Signature: (indx ix(Nnz); nzvals(Nnz); indx $N; int [o]ptr(N); indx [o]rowids(Nnz); [o]nzvals_enc(Nnz))
291              
292             General-purpose CCS encoding method for flat indices.
293             Encodes values $nzvals() from flat-index locations $ix() into a CCS matrix ($ptr(), $rowids(), $nzvals_enc()).
294              
295             Allocates output vectors if required.
296              
297             $N (~ $a-Edim(0)) must be specified.
298              
299             =cut
300              
301             *ccsencodei
302             = *ccsencodefulli = *ccsencodefull_i
303             = *PDL::ccsencodei = *PDL::ccsencode_i
304             = *PDL::ccsencodefulli = *PDL::ccsencodefull_i
305             = \&ccsencode_i;
306             sub ccsencode_i {
307             #my ($iflat,$avals,$N_optional,$ptr,$rowids,$nzvals) = @_;
308 2     2 1 889 my ($iflat,$avals) = splice(@_,0,2);
309 2 100 66     21 my $N = defined($_[0]) && (!ref($_[0]) || $_[0]->nelem==1) ? shift : $_[0]->nelem;
310 2         48 my $aw = ($iflat % $N)->cat($iflat/$N)->xchg(0,1);
311 2         384 return ccs_encode_compat($aw, $avals, $N, undef, @_);
312             }
313              
314              
315             ##---------------------------------------------------------------
316             ## Encoding: from 2d index
317             =pod
318              
319             =head2 ccsencode_i2d
320              
321             =for sig
322              
323             Signature: (
324             indx xvals(Nnz) ;
325             indx yvals(Nnz) ;
326             nzvals(Nnz) ;
327             indx $N ; ##-- optional
328             indx [o]ptr(N) ;
329             indx [o]rowids(Nnz) ;
330             [o]nzvals_enc(Nnz);
331             )
332              
333             General-purpose encoding method.
334             Encodes values $nzvals() from 2d-index locations ($xvals(), $yvals()) in an $N-by-(whatever) PDL
335             into a CCS matrix $ptr(), $rowids(), $nzvals_enc().
336              
337             Allocates output vectors if required.
338             If $N is omitted, it defaults to the maximum column index given in $xvals().
339              
340             =cut
341              
342             *ccsencodei2d
343             = *ccsencodefulli2d = *ccsencodefull_i2d
344             = *PDL::ccsencodei2d = *PDL::ccsencode_i2d
345             = *PDL::ccsencodefulli2d = *PDL::ccsencodefull_i2d
346             = \&ccsencode_i2d;
347             sub ccsencode_i2d {
348             #my ($whichx,$whichy,$avals,$N_optional,$ptr,$rowids,$nzvals) = @_;
349 2     2 1 1288 my ($whichx,$whichy,$avals) = splice(@_, 0, 3);
350 2         9 my $aw = $whichx->cat($whichy)->xchg(0,1);
351 2 50 66     432 my $N = defined($_[0]) && (!ref($_[0]) || $_[0]->nelem==1) ? shift : ($whichx->max+1);
352 2         127 return ccs_encode_compat($aw, $avals, $N, undef, @_);
353             }
354              
355             ##======================================================================
356             ## Decoding
357             =pod
358              
359             =head1 Decoding
360              
361             =cut
362              
363             ##---------------------------------------------------------------
364             ## Decoding: column-wise
365              
366             =pod
367              
368             =head2 ccsdecodecols
369              
370             =for sig
371              
372             Signature: (
373             indx ptr (N) ;
374             indx rowids (Nnz);
375             nzvals (Nnz);
376             indx xvals (I) ; # default=sequence($N)
377             missing() ; # default=0
378             M () ; # default=rowids->max+1
379             [o]cols (I,M); # default=new
380             )
381              
382             Extract dense columns from a CCS-encoded matrix (no dataflow).
383             Allocates output matrix if required.
384             If $a(N,M) was the dense source matrix for the CCS-encoding, and
385             if missing values are zeros, then the
386             following two calls are equivalent (modulo data flow):
387              
388             $cols = $a->dice_axis(1,$col_ix);
389             $cols = ccsdecodecols($ptr,$rowids,$nzvals, $col_ix,0);
390              
391             =cut
392              
393              
394             *PDL::_ccsdecodecols = \&_ccsdecodecols;
395             #Pars => 'indx ptr(N); indx rowids(Nnz); nzvals(Nnz); indx col_ix(I); missing(); [o]cols(I,M);',
396             sub _ccsdecodecols {
397 0     0   0 ccsdecodecols(@_[0,1,2], $_[3],$_[4], undef, $_[5]);
398             }
399             *PDL::ccsdecodecols = \&ccsdecodecols;
400             sub ccsdecodecols {
401 7     7 1 478 my ($ptr,$rowids,$nzvals, $coli,$missing,$M, $cols) = @_;
402 7 100       29 $coli = sequence(ccs_indx,$ptr->dim(0)) if (!defined($coli));
403 7 100       519 $coli = pdl(ccs_indx,$coli) if (!ref($coli));
404 7         91 my $ptr1 = zeroes(ccs_indx,$ptr->nelem+1);
405 7         442 $ptr1->slice("0:-2") .= $ptr;
406 7         245 $ptr1->set(-1 => $nzvals->nelem);
407 7 100       97 $M = $rowids->max+1 if (!defined($M));
408 7         156 my ($ptrix,$nzix) = ccs_decode_pointer($ptr1,$coli);
409 7         85 my $which = $ptrix->cat($rowids->index($nzix))->xchg(0,1);
410 7 100       1298 if (!defined($cols)) {
411 2         19 $cols = ccs_decode($which, $nzvals->index($nzix), $missing, [$coli->nelem,$M]);
412 2         12 $cols->sever; ##-- compat
413             } else {
414 5         49 ccs_decode($which, $nzvals->index($nzix), $missing, [$coli->nelem,$M], $cols);
415             }
416 7         55 return $cols;
417             }
418              
419              
420             ##---------------------------------------------------------------
421             ## Decoding: MISSING=0
422             =pod
423              
424             =head2 ccsdecode
425              
426             =for sig
427              
428             Signature: (indx ptr(N); indx rowids(Nnz); nzvals(Nnz); $M; [o]dense(N,M))
429              
430             Decodes compressed column format vectors $ptr(), $rowids(), and $nzvals()
431             into dense output matrix $a().
432             Allocates the output matrix if required.
433              
434             Note that if the original
435             matrix (pre-encoding) contained trailing rows with no nonzero elements,
436             such rows will not be allocated by this method (unless you specify either $M or $dense).
437             In such cases, you might prefer to call ccsdecodecols() directly.
438              
439             =cut
440              
441             *PDL::ccsdecodefull = \&ccsdecodefull; ##-- (indx ptr(N); indx rowids(Nnz); nzvals(Nnz); [o]dense(N,M))
442 1     1 0 436 sub ccsdecodefull { ccsdecodecols(@_[0,1,2], undef,0,undef, @_[3..$#_]); }
443              
444             *PDL::ccsdecode = \&ccsdecode;
445             sub ccsdecode {
446 4     4 1 379 my ($ptr,$rowids,$nzvals, $M, $dense)=@_;
447 4 50       18 if (!defined($dense)) {
448             ##-- check for old calling convention (is $M a multi-dim PDL?)
449 4 50 33     21 if (ref($M) && UNIVERSAL::isa($M, 'PDL') && $M->dim(0)==$ptr->dim(0)) {
      33        
450 0         0 $dense = $M;
451             } else {
452 4 50       24 $M = $rowids->max+1 if (!defined($M));
453 4         203 $dense = zeroes($nzvals->type,$ptr->dim(0),$M);
454             }
455             }
456 4         363 ccsdecodecols($ptr,$rowids,$nzvals, undef,0,$M, $dense);
457 4         23 return $dense;
458             }
459              
460              
461             ##---------------------------------------------------------------
462             ## Decoding: MISSING=BAD
463             =pod
464              
465             =head2 ccsdecode_g
466              
467             =for sig
468              
469             Signature: (indx ptr(N); indx rowids(Nnz); nzvals(Nnz); $M; [o]dense(N,M))
470              
471             Convenience method.
472             Like ccsdecode() but sets "missing" values to BAD.
473              
474             =cut
475              
476             *ccsdecodefullg = *PDL::ccsdecodefullg = *PDL::ccsdecodefull_g = \&ccsdecodefull_g;
477             sub ccsdecodefull_g {
478 0     0 0 0 my $badval = pdl($_[2]->type,0)->setvaltobad(0);
479 0         0 ccsdecodecols(@_[0,1,2], undef,$badval,undef,undef, @_[3..$#_]);
480             }
481              
482             *ccsdecodeg = *PDL::ccsdecodeg = *PDL::ccsdecode_g = \&ccsdecode_g;
483             sub ccsdecode_g {
484 0     0 1 0 my ($ptr,$rowids,$nzvals, $M, $dense)=@_;
485 0 0       0 if (!defined($dense)) {
486             ##-- check for old calling convention (is $M a multi-dim PDL?)
487 0 0 0     0 if (ref($M) && UNIVERSAL::isa($M, 'PDL') && $M->dim(0)==$ptr->dim(0)) {
      0        
488 0         0 $dense = $M;
489             } else {
490 0 0       0 $M = $rowids->max+1 if (!defined($M));
491 0         0 $dense = zeroes($nzvals->type,$ptr->dim(0),$M);
492             }
493             }
494 0         0 my $badval = pdl($nzvals->type,0)->setvaltobad(0);
495 0         0 ccsdecodecols($ptr,$rowids,$nzvals, undef,$badval,$M, $dense);
496 0         0 return $dense;
497             }
498              
499              
500             ##======================================================================
501             ## Index Conversion
502             ##======================================================================
503             =pod
504              
505             =head1 Index Conversion
506              
507             =cut
508              
509             ##------------------------------------------------------
510             ## ccsiNDtonzi() : index conversion: N-dimensional
511              
512             =pod
513              
514             =for sig
515              
516             Signature: (indx ptr(N); indx rowids(Nnz); indx ind(2,I); indx missing(); indx [o]nzix(I))
517              
518             =head2 ccsiNDtonzi
519              
520             Convert N-dimensional index values $ind() appropriate for a dense matrix (N,M)
521             into indices $nzix() appropriate for the $rowids() and/or $nzvals() components
522             of the CCS-encoded matrix ($ptr(),$rowids(),$nzvals()).
523             Missing values are returned in $nzix() as $missing().
524              
525             =cut
526              
527             *PDL::ccsiNDtonzi = \&ccsiNDtonzi;
528             sub ccsiNDtonzi {
529 4     4 1 740 my ($ptr,$rowids,$ind, $missing, $nzix) = @_;
530 4         60 my ($ptri,$ptrnzi) = ccs_decode_pointer($ptr->append($rowids->nelem));
531 4         40 my $ccswnd = $ptri->cat($rowids->index($ptrnzi))->xchg(0,1)->vv_qsortvec;
532 4         844 $nzix = $ind->vsearchvec($ccswnd);
533 4         27 my $nzix_mask = ($ind==$ccswnd->dice_axis(1,$nzix))->andover;
534 4         268 $nzix_mask->inplace->not;
535             #(my $tmp = $nzix->where($nzix_mask)) .= $missing; ##-- fix "Can't modify non-lvalue subroutine call" in 5.15.x (perl bug #107366)
536 4         106 $nzix->where($nzix_mask) .= $missing;
537 4         313 return $nzix;
538             }
539              
540             ##------------------------------------------------------
541             ## ccsi2dtonzi() : index conversion: 2d
542              
543             =pod
544              
545             =head2 ccsi2dtonzi
546              
547             =for sig
548              
549             Signaure: (indx ptr(N); indx rowids(Nnz); indx col_ix(I); indx row_ix(I); indx missing(); indx [o]nzix(I))
550              
551             Convert 2d index values $col_ix() and $row_ix() appropriate for a dense matrix (N,M)
552             into indices $nzix() appropriate for the $rowids() and/or $nzvals() components
553             of the CCS-encoded matrix ($ptr(),$rowids(),$nzvals()).
554             Missing values are returned in $nzix() as $missing().
555              
556             =cut
557              
558             *PDL::ccsi2dtonzi = \&ccsi2dtonzi;
559             sub ccsi2dtonzi {
560 2     2 1 6 my ($ptr,$rowids,$xi,$yi, $missing, $nzix) = @_;
561 2         8 return ccsiNDtonzi($ptr,$rowids, $xi->cat($yi)->xchg(0,1), $missing,$nzix);
562             }
563              
564              
565             ##------------------------------------------------------
566             ## ccsitonzi() : index conversion: flat
567              
568             =pod
569              
570             =for sig
571              
572             Signature: (indx ptr(N); indx rowids(Nnz); indx ix(I); indx missing(); indx [o]nzix(I))
573              
574             =head2 ccsitonzi
575              
576             Convert flat index values $ix() appropriate for a dense matrix (N,M)
577             into indices $nzix() appropriate for the $rowids() and/or $nzvals() components
578             of the CCS-encoded matrix ($ptr(),$rowids(),$nzvals()).
579             Missing values are returned in $nzix() as $missing().
580              
581             =cut
582              
583             *PDL::ccsitonzi = \&ccsitonzi;
584             sub ccsitonzi {
585 2     2 1 6 my ($ptr,$rowids,$ix, $missing, $nzix) = @_;
586 2         7 my $dummy = pdl(byte,0)->slice("*".($ptr->dim(0)).",*".($rowids->max+1));
587 2         286 my ($xi,$yi) = $dummy->one2nd($ix);
588 2         321 return ccsiNDtonzi($ptr,$rowids, $xi->cat($yi)->xchg(0,1), $missing,$nzix);
589             }
590              
591              
592              
593             ##------------------------------------------------------
594             ## ccswhichND: get indices (N-dimensional)
595              
596             =pod
597              
598             =head2 ccswhichND
599              
600             =head2 ccswhich2d
601              
602             =head2 ccswhichfull
603              
604             =for sig
605              
606             Signature: (indx ptr(N); indx rowids(Nnz); nzvals(Nnz); indx [o]which_cols(Nnz); indx [o]which_rows(Nnz)',
607              
608             In scalar context, returns concatenation of $which_cols() and $which_rows(),
609             similar to the builtin whichND(). Note however that ccswhichND() may return
610             its index PDLs sorted in a different order than the builtin whichND() method
611             for dense matrices. Use the qsort() or qsorti() methods if you need sorted index PDLs.
612              
613             =cut
614              
615             *ccswhich2d = *PDL::which2d = *PDL::ccswhichND
616             = *ccswhichfull = *PDL::ccswhichfull
617             = \&ccswhichND;
618             sub ccswhichND {
619 3     3 1 518 my ($ptr,$rowids,$nzvals, $which_cols,$which_rows) = @_;
620 3         5 my ($ptrnzi);
621 3         61 ($which_cols,$ptrnzi) = ccs_decode_pointer($ptr->append($rowids->nelem),
622             sequence(ccs_indx, $ptr->nelem),
623             $which_cols
624             );
625 3 100       27 $which_rows = zeroes(ccs_indx, $rowids->nelem) if (!defined($which_rows));
626 3         132 $which_rows .= $rowids->index($ptrnzi);
627 3 100       82 return wantarray ? ($which_cols,$which_rows) : $which_cols->cat($which_rows)->xchg(0,1);
628             }
629              
630              
631             ##------------------------------------------------------
632             ## ccswhich(): get indices (flat)
633              
634             =head2 ccswhich
635              
636             =for sig
637              
638             Signature: (indx ptr(N); indx rowids(Nnz); nzvals(Nnz); indx [o]which(Nnz); indx [t]wcols(Nnz)',
639              
640             Convenience method.
641             Calls ccswhichfull(), and scales the output PDLs to correspond to a flat enumeration.
642             The output PDL $which() is B guaranteed to be sorted in any meaningful order.
643             Use the qsort() method if you need sorted output.
644              
645             =cut
646              
647             *PDL::ccswhich = \&ccswhich;
648             sub ccswhich {
649 1     1 1 371 my ($ptr,$rowids,$nzvals, $which, $wcols) = @_;
650 1         6 my $nnz = $rowids->dim(0);
651 1 50       7 $which = zeroes(ccs_indx,$nnz) if (!defined($which));
652 1 50       68 $wcols = zeroes(ccs_indx,$nnz) if (!defined($wcols));
653 1         56 ccswhichfull($ptr,$rowids,$nzvals, $wcols,$which);
654 1         218 $which *= $ptr->dim(0);
655 1         26 $which += $wcols;
656 1         23 return $which;
657             }
658              
659             ##------------------------------------------------------
660             ## ccstranspose() : transposition (convenience)
661              
662             =pod
663              
664             =head2 ccstranspose
665              
666             =for sig
667              
668             Signature: (indx ptr(N); indx rowids(Nnz); nzvals(Nnz); indx [o]ptrT(M); indx [o]rowidsT(Nnz); [o]nzvalsT(Nnz)',
669              
670             Transpose a compressed matrix.
671              
672             =cut
673              
674             *ccstransposefull = *PDL::ccstransposefull = *PDL::ccstranspose = \&ccstranspose;
675             sub ccstranspose {
676 1     1 1 10 my ($ptr,$rowids,$nzvals, $ptrT,$rowidsT,$nzvalsT)=@_;
677 1         5 my $N = $ptr->dim(0);
678 1 50       7 my $M = defined($ptrT) ? $ptrT->dim(0) : $rowids->max+1;
679 1         94 my $wnd = ccswhichND($ptr,$rowids,$nzvals)->slice("1:0,");
680 1         235 return ccs_encode_compat($wnd,$nzvals,$M,$N, $ptrT,$rowidsT,$nzvalsT);
681             }
682              
683              
684             ##======================================================================
685             ## Lookup
686             ##======================================================================
687              
688             =pod
689              
690             =head1 Lookup
691              
692             =cut
693              
694             ##------------------------------------------------------
695             ## ccsget2d() : lookup: 2d
696              
697             =pod
698              
699             =head2 ccsget2d
700              
701             =for sig
702              
703             Signature: (indx ptr(N); indx rowids(Nnz); nzvals(Nnz); indx xvals(I); indx yvals(I); missing(); [o]ixvals(I))
704              
705             Lookup values in a CCS-encoded PDL by 2d source index (no dataflow).
706             Pretty much like ccsi2dtonzi(), but returns values instead of indices.
707             If you know that your index PDLs $xvals() and $yvals() do not refer to any missing
708             values in the CCS-encoded matrix,
709             then the following two calls are equivalent (modulo dataflow):
710              
711             $ixvals = ccsget2d ($ptr,$rowids,$nzvals, $xvals,$yvals,0);
712             $ixvals = index($nzvals, ccsi2dtonzi($ptr,$rowids, $xvals,$yvals,0));
713              
714             The difference is that only the second incantation will cause subsequent changes to $ixvals
715             to be propagated back into $nzvals.
716              
717             =cut
718              
719             *PDL::ccsget2d = \&ccsget2d;
720             sub ccsget2d {
721 2     2 1 544 my ($ptr,$rowids,$nzvals, $xi,$yi, $missing, $ixnzvals) = @_;
722 2         9 my $nzi = ccsi2dtonzi($ptr,$rowids, $xi,$yi, -1);
723 2         26 my $nzi_isgood = ($nzi != -1);
724 2 50       16 $ixnzvals = zeroes($nzvals->type, $xi->nelem) if (!defined($ixnzvals));
725 2 50       171 if (!all($nzi_isgood)) {
726 2         92 my $tmp;
727 2         7 ($tmp=$ixnzvals->where( $nzi_isgood)) .= $nzvals->index($nzi->where($nzi_isgood));
728 2         215 ($tmp=$ixnzvals->where(!$nzi_isgood)) .= $missing;
729 2 100       142 $ixnzvals->badflag(1) if (PDL->topdl($missing)->badflag);
730             }
731 2         85 return $ixnzvals;
732             }
733              
734              
735             ##------------------------------------------------------
736             ## ccsget() : lookup: flat
737              
738             =pod
739              
740             =head2 ccsget
741              
742             =for sig
743              
744             Signature: (indx ptr(N); indx rowids(Nnz); nzvals(Nnz); indx ix(I); missing(); [o]ixvals(I))
745              
746             Lookup values in a CCS-encoded PDL by flat source index (no dataflow).
747             Pretty much like ccsitonzi(), but returns values instead of indices.
748             If you know that your index PDL $ix() does not refer to any missing
749             values in the CCS-encoded matrix,
750             then the following two calls are equivalent (modulo dataflow):
751              
752             $ixvals = ccsget ($ptr,$rowids,$nzvals, $ix,0);
753             $ixvals = index($nzvals, ccsitonzi($ptr,$rowids, $ix,0))
754              
755             The difference is that only the second incantation will cause subsequent changes to $ixvals
756             to be propagated back into $nzvals.
757              
758             =cut
759              
760             *PDL::ccsget = \&ccsget;
761             sub ccsget {
762 2     2 1 503 my ($ptr,$rowids,$nzvals, $ix, $missing, $ixnzvals) = @_;
763 2         7 my $nzi = ccsitonzi($ptr,$rowids, $ix,-1);
764 2         27 my $nzi_isgood = ($nzi != -1);
765 2 50       16 $ixnzvals = zeroes($nzvals->type, $ix->nelem) if (!defined($ixnzvals));
766 2 50       169 if (!all($nzi_isgood)) {
767 2         92 my $tmp;
768 2         7 ($tmp=$ixnzvals->where( $nzi_isgood)) .= $nzvals->index($nzi->where($nzi_isgood));
769 2         221 ($tmp=$ixnzvals->where(!$nzi_isgood)) .= $missing;
770 2 100       142 $ixnzvals->badflag(1) if (PDL->topdl($missing)->badflag);
771             }
772 2         88 return $ixnzvals;
773             }
774              
775              
776             ##======================================================================
777             ## Vector Operations
778             ##======================================================================
779             =pod
780              
781             =head1 Vector Operations
782              
783             =cut
784              
785             ##======================================================================
786             ## Vector Operations: Columns
787             ##======================================================================
788             =pod
789              
790             =head2 ccs${OP}_cv
791              
792             =for sig
793              
794             Signature: (indx ptr(N); indx rowids(Nnz); nzvals_in(Nnz); colvec(M); [o]nzvals_out(Nnz))
795              
796             Column-vector operation ${OP} on CCS-encoded PDL.
797              
798             Should do something like the following
799             (without decoding the CCS matrix):
800              
801             ($colvec ${OP} ccsdecode(\$ptr,\$rowids,\$nzvals))->ccsencode;
802              
803             Missing values in the CCS-encoded PDL are not affected by this operation.
804              
805             ${OP} is one of the following:
806              
807             plus ##-- addition (alias: 'add')
808             minus ##-- subtraction (alias: 'diff')
809             mult ##-- multiplication (NOT matrix-multiplication)
810             divide ##-- division (alias: 'div')
811             modulo ##-- modulo
812             power ##-- potentiation
813              
814             gt ##-- greater-than
815             ge ##-- greater-than-or-equal
816             lt ##-- less-than
817             le ##-- less-than-or-equal
818             eq ##-- equality
819             ne ##-- inequality
820             spaceship ##-- 3-way comparison
821              
822             and2 ##-- binary AND
823             or2 ##-- binary OR
824             xor ##-- binary XOR
825             shiftleft ##-- left-shift
826             shiftright ##-- right-shift
827              
828             =cut
829              
830             sub ccs_binop_compat_cv {
831 72     72 0 121 my $ccsop = shift;
832 72     1   695 return sub { $ccsop->(@_[1,2,3,4]) };
  1         132  
833             }
834             foreach my $op (@ccs_binops) {
835             eval "*ccs${op}_cv = *PDL::ccs${op}_cv = ccs_binop_compat_cv(\\&PDL::ccs_${op}_vector_mia);";
836             }
837             *ccsadd_cv = *PDL::ccsadd_cv = \&ccsplus_cv;
838             *ccsdiff_cv = *PDL::ccsdiff_cv = \&ccsminus_cv;
839             *ccsdiv_cv = *PDL::ccsdiv_cv = \&ccsdivide_cv;
840              
841             ##======================================================================
842             ## Vector Operations: Rows
843             ##======================================================================
844             =pod
845              
846             =head2 ccs${OP}_rv
847              
848             =for sig
849              
850             Signature: (indx ptr(N); indx rowids(Nnz); nzvals_in(Nnz); rowvec(N); [o]nzvals_out(Nnz))
851              
852             Row-vector operation ${OP} on CCS-encoded PDL.
853             Should do something like the following (without decoding the CCS matrix):
854              
855             ($column->slice("*1,") ${OP} ccsdecode($ptr,$rowids,$nzvals))->ccsencode;
856              
857             Missing values in the CCS-encoded PDL are not effected by this operation.
858              
859             See ccs${OP}_cv() above for supported operations.
860              
861             =cut
862              
863             sub ccs_binop_compat_rv {
864 72     72 0 125 my $ccsop = shift;
865             return sub {
866 1     1   458 my $ptr = shift;
867 1         15 my ($ptri,$ptrnzi) = ccs_decode_pointer($ptr->append($_[1]->nelem));
868 1         14 $ccsop->($ptri, $_[1]->index($ptrnzi), @_[2,3]);
869 72         767 };
870             }
871             foreach my $op (@ccs_binops) {
872             eval "*ccs${op}_rv = *PDL::ccs${op}_rv = ccs_binop_compat_rv(\\&PDL::ccs_${op}_vector_mia);";
873             }
874             *ccsadd_rv = *PDL::ccsadd_rv = \&ccsplus_rv;
875             *ccsdiff_rv = *PDL::ccsdiff_rv = \&ccsminus_rv;
876             *ccsdiv_rv = *PDL::ccsdiv_rv = \&ccsdivide_rv;
877              
878              
879             ##------------------------------------------------------
880             ## Ufuncs (accumulators)
881              
882             ## \&ufuncsub = ccs_ufunc_compat(\&ccs_accum_sub)
883             sub ccs_ufunc_compat {
884 8     8 0 13 my $sub = shift;
885             return sub {
886 0     0   0 my ($ptr,$rowids,$nzvals, $M,$rowvals) = @_;
887 0         0 my ($ixout,$valsout) = $sub->($rowids->slice("*1,"),$nzvals, 0,0);
888 0 0       0 $M = $rowids->max+1 if (!defined($M));
889 0 0       0 $rowvals = zeroes($nzvals->type,$M) if (!defined($rowvals));
890 0         0 $rowvals->index($ixout->flat) .= $valsout;
891 0         0 return $rowvals;
892 8         32 };
893             }
894              
895             ## \&ufuncsub = ccs_ufunc_compat_t(\&ccs_accum_sub)
896             sub ccs_ufunc_compat_t {
897 8     8 0 16 my $sub = shift;
898             return sub {
899 0     0     my ($ptr,$rowids,$nzvals, $colvals) = @_;
900 0           my ($colids,$nzix) = ccs_decode_pointer($ptr->append($nzvals->nelem));
901 0           ccs_ufunc_compat(undef,$colids,$nzvals->index($nzix), $ptr->dim(0),$colvals);
902 8         46 };
903             }
904              
905             *ccssumover = *PDL::ccssumover = ccs_ufunc_compat (\&ccs_accum_sum);
906             *ccssumovert = *PDL::ccssumovert = ccs_ufunc_compat_t(\&ccs_accum_sum);
907              
908             *ccprodover = *PDL::ccsprodover = ccs_ufunc_compat (\&ccs_accum_prod);
909             *ccsprodovert = *PDL::ccsprodovert = ccs_ufunc_compat_t(\&ccs_accum_prod);
910              
911              
912             1; ##-- make perl happy
913              
914             ##======================================================================
915             ## Footer Administrivia
916             ##======================================================================
917              
918             ##---------------------------------------------------------------------
919             =pod
920              
921             =head1 EXAMPLES
922              
923             =head2 Compressed Column Format Example
924              
925             $a = pdl([
926             [10, 0, 0, 0,-2, 0],
927             [3, 9, 0, 0, 0, 3],
928             [0, 7, 8, 7, 0, 0],
929             [3, 0, 8, 7, 5, 0],
930             [0, 8, 0, 9, 9, 13],
931             [0, 4, 0, 0, 2, -1]
932             ]);
933              
934             ($ptr,$rowids,$nzvals) = ccsencode($a);
935              
936             print join("\n", "ptr=$ptr", "rowids=$rowids", "nzvals=$nzvals");
937              
938             ... prints something like:
939              
940             ptr=[0 3 7 9 12 16]
941             rowids=[ 0 1 3 1 2 4 5 2 3 2 3 4 0 3 4 5 1 4 5]
942             nzvals=[10 3 3 9 7 8 4 8 8 7 7 9 -2 5 9 2 3 13 -1]
943              
944              
945             =head2 Sparse Matrix Example
946              
947             ##-- create a random sparse matrix
948             $a = random(100,100);
949             $a *= ($a>.9);
950              
951             ##-- encode it
952             ($ptr,$rowids,$nzvals) = ccsencode($a);
953              
954             ##-- what did we save?
955             sub pdlsize { return PDL::howbig($_[0]->type)*$_[0]->nelem; }
956             print "Encoding saves us ",
957             ($saved = pdlsize($a) - pdlsize($ptr) - pdlsize($rowids) - pdlsize($nzvals)),
958             " bytes (", (100.0*$saved/pdlsize($a)), "%)\n";
959              
960             ... prints something like:
961              
962             Encoding saves us 71416 bytes (89.27%)
963              
964              
965             =head2 Decoding Example
966              
967             ##-- random matrix
968             $a = random(100,100);
969              
970             ##-- make an expensive copy of $a by encoding & decoding
971             ($ptr,$rowids,$nzvals) = ccsencode($a);
972             $a2 = ccsdecode($ptr,$rowids,$nzvals);
973              
974             ##-- ...and make sure it's good
975             print all($a==$a2) ? "Decoding is good!\n" : "Nasty icky bug!\n";
976              
977             =cut
978              
979             ##---------------------------------------------------------------------
980             =pod
981              
982             =head1 ACKNOWLEDGEMENTS
983              
984             Perl by Larry Wall.
985              
986             PDL by Karl Glazebrook, Tuomas J. Lukka, Christian Soeller, and others.
987              
988             Original inspiration and algorithms from the SVDLIBC C library by Douglas Rohde;
989             which is itself based on SVDPACKC
990             by Michael Berry, Theresa Do, Gavin O'Brien, Vijay Krishna and Sowmini Varadhan.
991              
992             =cut
993              
994             ##----------------------------------------------------------------------
995             =pod
996              
997             =head1 KNOWN BUGS
998              
999             Many.
1000              
1001             =cut
1002              
1003              
1004             ##---------------------------------------------------------------------
1005             =pod
1006              
1007             =head1 AUTHOR
1008              
1009             Bryan Jurish Emoocow@cpan.orgE
1010              
1011             =head2 Copyright Policy
1012              
1013             Copyright (C) 2005-2018, Bryan Jurish. All rights reserved.
1014              
1015             This package is free software, and entirely without warranty.
1016             You may redistribute it and/or modify it under the same terms
1017             as Perl itself.
1018              
1019             =head1 SEE ALSO
1020              
1021             perl(1),
1022             PDL(3perl),
1023             PDL::SVDLIBC(3perl),
1024             PDL::CCS::Nd(3perl),
1025              
1026             SVDLIBC: http://tedlab.mit.edu/~dr/SVDLIBC/
1027              
1028             SVDPACKC: http://www.netlib.org/svdpack/
1029              
1030             =cut