File Coverage

blib/lib/PDL/CCS/Nd.pm
Criterion Covered Total %
statement 72 930 7.7
branch 2 416 0.4
condition 0 129 0.0
subroutine 27 172 15.7
pod 61 112 54.4
total 162 1759 9.2


line stmt bran cond sub pod time code
1             ## File: PDL::CCS::Nd.pm
2             ## Author: Bryan Jurish
3             ## Description: N-dimensional CCS-encoded pseudo-PDL
4              
5             package PDL::CCS::Nd;
6 2     2   817 use PDL::Lite qw();
  2         1621  
  2         46  
7 2     2   14 use PDL::VectorValued;
  2         3  
  2         14  
8 2     2   438 use PDL::CCS::Config qw(ccs_indx);
  2         4  
  2         126  
9 2     2   10 use PDL::CCS::Functions qw(ccs_decode ccs_qsort);
  2         3  
  2         12  
10 2     2   240 use PDL::CCS::Utils qw(ccs_encode_pointers ccs_decode_pointer);
  2         3  
  2         12  
11 2     2   195 use PDL::CCS::Ufunc;
  2         3  
  2         13  
12 2     2   359 use PDL::CCS::Ops;
  2         4  
  2         13  
13 2     2   181 use PDL::CCS::MatrixOps;
  2         2  
  2         11  
14 2     2   222 use Carp;
  2         3  
  2         143  
15 2     2   11 use strict;
  2         3  
  2         105  
16              
17             BEGIN {
18 2     2   9 *isa = \&UNIVERSAL::isa;
19 2         3773 *can = \&UNIVERSAL::can;
20             }
21              
22             our $VERSION = '1.24.1'; ##-- update with perl-reversion from Perl::Version module
23             our @ISA = qw();
24             our %EXPORT_TAGS =
25             (
26             ##-- respect PDL conventions (hopefully)
27             Func => [
28             ##-- Encoding/Decoding
29             qw(toccs todense),
30             ],
31             vars => [
32             qw($PDIMS $VDIMS $WHICH $VALS $PTRS $FLAGS $USER),
33             qw($BINOP_BLOCKSIZE_MIN $BINOP_BLOCKSIZE_MAX),
34             ],
35             flags => [
36             qw($CCSND_BAD_IS_MISSING $CCSND_NAN_IS_MISSING $CCSND_INPLACE $CCSND_FLAGS_DEFAULT),
37             ],
38             );
39             $EXPORT_TAGS{all} = [map {@$_} values(%EXPORT_TAGS)];
40             our @EXPORT = @{$EXPORT_TAGS{Func}};
41             our @EXPORT_OK = @{$EXPORT_TAGS{all}};
42              
43             ##--------------------------------------------------------------
44             ## Global variables for block-wise computation of binary operations
45              
46             ##-- some (hopefully sensible) defaults
47             #our $BINOP_BLOCKSIZE_MIN = 64;
48             #our $BINOP_BLOCKSIZE_MAX = undef; ##-- undef or zero: no maximum
49              
50             ##-- debug/devel defaults
51             our $BINOP_BLOCKSIZE_MIN = 1;
52             our $BINOP_BLOCKSIZE_MAX = 0;
53              
54             ##======================================================================
55             ## Globals
56              
57             our $PDIMS = 0;
58             our $VDIMS = 1;
59             our $WHICH = 2;
60             our $VALS = 3;
61             our $PTRS = 4;
62             our $FLAGS = 5;
63             our $USER = 6;
64              
65             ##-- flags
66             our $CCSND_BAD_IS_MISSING = 1;
67             our $CCSND_NAN_IS_MISSING = 2;
68             our $CCSND_INPLACE = 4;
69             our $CCSND_FLAGS_DEFAULT = 0; ##-- default flags
70              
71             ##-- pdl constants
72             our $P_BYTE = PDL::byte();
73             our $P_LONG = PDL::long();
74             our $P_INDX = ccs_indx();
75              
76 0 0   0   0 sub _min2 ($$) { $_[0]<$_[1] ? $_[0] : $_[1]; }
77 0 0   0   0 sub _max2 ($$) { $_[0]>$_[1] ? $_[0] : $_[1]; }
78              
79             ##======================================================================
80             ## Constructors etc.
81              
82             ## $obj = $class_or_obj->newFromDense($denseND);
83             ## $obj = $class_or_obj->newFromDense($denseND,$missing);
84             ## $obj = $class_or_obj->newFromDense($denseND,$missing,$flags);
85             ## + object structure: ARRAY
86             ## $PDIMS => $pdims, ##-- pdl(indx,$NPdims) : physical dimension sizes : $pdim_i => $dimSize_i
87             ## $VDIMS => $vdims, ##-- pdl(indx,$NVdims) : virtual dimension sizes
88             ## ## + $vdim_i => / -$vdimSize_i if $vdim_i is dummy
89             ## ## \ $pdim_i otherwise
90             ## ## + s.t. $whichND_logical_physical = $whichND->dice_axis(0,$vdims->where($vdims>=0));
91             ## $WHICH => $whichND, ##-- pdl(indx,$NPdims,$Nnz) ~ $dense_orig->whichND
92             ## ## + guaranteed to be sorted as for qsortvec() specs
93             ## ## + NOT changed by dimension-shuffling transformations
94             ## $VALS => $vals, ##-- pdl( ? ,$Nnz+1) ~ $dense->where($dense)->append($missing)
95             ## $PTRS => \@PTRS, ##-- array of ccsutils-pointers by physical dimension number
96             ## $FLAGS => $flags, ##-- integer holding some flags
97             ##
98             ## + each element of @PTRS is itself an array:
99             ## $PTRS[$i] => [ $PTR, $NZI ]
100             ##
101             sub newFromDense :lvalue {
102 0     0 1 0 my $that = shift;
103 0   0     0 return my $tmp=(bless [], ref($that)||$that)->fromDense(@_);
104             }
105              
106             ## $obj = $obj->fromDense($denseND,$missing,$flags)
107             sub fromDense :lvalue {
108 0     0 1 0 my ($obj,$p,$missing,$flags) = @_;
109 0         0 $p = PDL->topdl($p);
110 0 0       0 $p = $p->slice("*1") if (!$p->dims);
111 0 0       0 $missing = (defined($missing)
    0          
112             ? PDL->pdl($p->type,$missing)
113             : ($p->badflag
114             ? PDL->pdl($p->type,0)->setvaltobad(0)
115             : PDL->pdl($p->type,0)));
116 0 0       0 $flags = $CCSND_FLAGS_DEFAULT if (!defined($flags));
117 0 0       0 my $pwhichND = ($missing->isbad ? $p->isgood() : ($p != $missing))->whichND->vv_qsortvec;
118 0         0 my $pnz = $p->indexND($pwhichND)->append($missing);
119 0         0 $pnz->sever; ##-- always sever nzvals ?
120 0         0 my $pdims = PDL->pdl($P_INDX,[$p->dims]);
121 0         0 $obj->[$PDIMS] = $pdims;
122 0 0       0 $obj->[$VDIMS] = $pdims->isempty ? $pdims->pdl : $pdims->sequence;
123 0         0 $obj->[$WHICH] = $pwhichND;
124 0         0 $obj->[$VALS] = $pnz;
125 0         0 $obj->[$PTRS] = []; ##-- do we really need this ... yes
126 0         0 $obj->[$FLAGS] = $flags;
127 0         0 return $obj;
128             }
129              
130             ## $obj = $class_or_obj->newFromWhich($whichND,$nzvals,%options);
131             ## $obj = $class_or_obj->newFromWhich($whichND,$nzvals);
132             ## + %options: see $obj->fromWhich()
133             sub newFromWhich :lvalue {
134 0     0 1 0 my $that = shift;
135 0   0     0 return my $tmp=bless([],ref($that)||$that)->fromWhich(@_);
136             }
137              
138             ## $obj = $obj->fromWhich($whichND,$nzvals,%options);
139             ## $obj = $obj->fromWhich($whichND,$nzvals);
140             ## + %options:
141             ## sorted => $bool, ##-- if true, $whichND is assumed to be pre-sorted
142             ## steal => $bool, ##-- if true, $whichND and $nzvals are used literally (formerly implied 'sorted')
143             ## ## + in this case, $nzvals should really be: $nzvals->append($missing)
144             ## pdims => $pdims, ##-- physical dimension list; default guessed from $whichND (alias: 'dims')
145             ## missing => $missing, ##-- default: BAD if $nzvals->badflag, 0 otherwise
146             ## vdims => $vdims, ##-- virtual dims (default: sequence($nPhysDims)); alias: 'xdims'
147             ## flags => $flags, ##-- flags
148             sub fromWhich :lvalue {
149 0     0 1 0 my ($obj,$wnd,$nzvals,%opts) = @_;
150             my $missing = (defined($opts{missing})
151             ? PDL->pdl($nzvals->type,$opts{missing})
152 0 0       0 : ($nzvals->badflag
    0          
153             ? PDL->pdl($nzvals->type,0)->setvaltobad(0)
154             : PDL->pdl($nzvals->type,0)));
155              
156             ##-- get dims
157 0   0     0 my $pdims = $opts{pdims} // $opts{dims} // PDL->pdl($P_INDX, [($wnd->xchg(0,1)->maximum+1)->list]);
      0        
158 0 0       0 $pdims = PDL->pdl($P_INDX, $pdims) if (!UNIVERSAL::isa($pdims,'PDL'));
159              
160 0   0     0 my $vdims = $opts{vdims} // $opts{xdims} // $pdims->sequence;
      0        
161 0 0       0 $vdims = PDL->pdl($P_INDX, $vdims) if (!UNIVERSAL::isa($vdims,'PDL'));
162              
163             ##-- maybe sort & copy
164 0 0       0 if (!$opts{steal}) {
    0          
165             ##-- not stolen: copy or sever
166 0 0       0 if (!$opts{sorted}) {
167 0         0 my $wi = $wnd->qsortveci;
168 0         0 $wnd = $wnd->dice_axis(1,$wi);
169 0         0 $nzvals = $nzvals->index($wi);
170             }
171 0         0 $wnd->sever; ##-- sever (~ copy)
172 0         0 $nzvals = $nzvals->append($missing); ##-- copy (b/c append)
173             }
174             elsif (!$opts{sorted}) {
175             ##-- "stolen" but un-sorted: we have "missing" value in $vals
176 0         0 my $wi = PDL->zeroes(ccs_indx, $wnd->dim(1)+1);
177 0         0 $wnd->vv_qsortveci($wi->slice("0:-2"));
178 0         0 $wi->set($wnd->dim(1) => $nzvals->nelem-1);
179 0         0 $wnd = $wnd->dice_axis(1,$wi->slice("0:-2"));
180 0         0 $nzvals = $nzvals->index($wi);
181             }
182              
183             ##-- setup and return
184 0         0 $obj->[$PDIMS] = $pdims;
185 0         0 $obj->[$VDIMS] = $vdims;
186 0         0 $obj->[$WHICH] = $wnd;
187 0         0 $obj->[$VALS] = $nzvals;
188 0         0 $obj->[$PTRS] = [];
189 0 0       0 $obj->[$FLAGS] = defined($opts{flags}) ? $opts{flags} : $CCSND_FLAGS_DEFAULT;
190 0         0 return $obj;
191             }
192              
193              
194             ## DESTROY : avoid PDL inheritance
195       0     sub DESTROY { ; }
196              
197             ## $ccs = $ccs->insertWhich($whichND,$whichVals)
198             ## + set or insert $whichND=>$whichVals
199             ## + implicitly calls make_physically_indexed
200             sub insertWhich :lvalue {
201 0     0 1 0 my ($ccs,$which,$vals) = @_;
202 0         0 $ccs->make_physically_indexed();
203              
204             ##-- sanity check
205 0 0       0 if ($which->dim(0) != $ccs->[$WHICH]->dim(0)) {
206 0         0 PDL::Lite::barf(ref($ccs)."::insertWhich(): wrong number of index dimensions in whichND argument:",
207             " is ", $which->dim(0), ", should be ", $ccs->[$WHICH]->dim(0));
208             }
209              
210             ##-- check for existing indices (potentially slow)
211 0         0 my $nzi = $ccs->indexNDi($which);
212 0         0 my ($nzi_new,$nzi_old) = ($nzi==$ccs->[$WHICH]->dim(1))->which_both;
213              
214             ##-- just set values for existing indices
215 0         0 $ccs->[$VALS]->index($nzi->index($nzi_old)) .= $vals->index($nzi_old);
216              
217             ##-- delegate insertion of new values to appendWhich()
218 0         0 my ($tmp);
219 0 0       0 return $tmp=$ccs->sortwhich if ($nzi_new->isempty);
220 0         0 return $tmp=$ccs->appendWhich($which->dice_axis(1,$nzi_new), $vals->index($nzi_new));
221             }
222              
223             ## $ccs = $ccs->appendWhich($whichND,$whichVals)
224             ## + inserts $whichND=>$whichVals into $ccs which are assumed NOT to be already present
225             ## + implicitly calls make_physically_indexed
226             sub appendWhich :lvalue {
227 0     0 1 0 my ($ccs,$which,$vals) = @_;
228 0         0 $ccs->make_physically_indexed();
229              
230             ##-- sanity check
231             #if ($which->dim(0) != $ccs->[$WHICH]->dim(0))
232 0 0       0 if ($which->dim(0) != $ccs->[$PDIMS]->nelem)
233             {
234 0         0 PDL::Lite::barf(ref($ccs)."::appendWhich(): wrong number of index dimensions in whichND argument:",
235             " is ", $which->dim(0), ", should be ", $ccs->[$PDIMS]->nelem);
236             }
237              
238             ##-- append: which
239 0 0       0 if (!$which->isempty) {
240 0         0 $ccs->[$WHICH] = $ccs->[$WHICH]->reshape($which->dim(0), $ccs->[$WHICH]->dim(1)+$which->dim(1));
241 0         0 $ccs->[$WHICH]->slice(",-".$which->dim(1).":-1") .= $which;
242             }
243              
244             ##-- append: vals
245 0 0       0 if (!$vals->isempty) {
246 0         0 my $missing = $ccs->missing;
247 0         0 $ccs->[$VALS] = $ccs->[$VALS]->reshape($ccs->[$VALS]->dim(0) + $vals->dim(0));
248 0         0 $ccs->[$VALS]->slice("-".($vals->dim(0)+1).":-2") .= $vals;
249 0         0 $ccs->[$VALS]->slice("-1") .= $missing;
250             }
251              
252 0         0 return $ccs->sortwhich();
253             }
254              
255             ## $ccs = $pdl->toccs()
256             ## $ccs = $pdl->toccs($missing)
257             ## $ccs = $pdl->toccs($missing,$flags)
258             *PDL::toccs = \&toccs;
259             sub toccs :lvalue {
260 0 0   0 1 0 return $_[0] if (isa($_[0],__PACKAGE__));
261 0         0 return my $tmp=__PACKAGE__->newFromDense(@_);
262             }
263              
264             ## $ccs = $ccs->copy()
265 2     2   3379 BEGIN { *clone = \© }
266             sub copy :lvalue {
267 0     0 1 0 my $ccs1 = shift;
268 0         0 my $ccs2 = bless [], ref($ccs1);
269 0         0 $ccs2->[$PDIMS] = $ccs1->[$PDIMS]->pdl;
270 0         0 $ccs2->[$VDIMS] = $ccs1->[$VDIMS]->pdl;
271 0         0 $ccs2->[$WHICH] = $ccs1->[$WHICH]->pdl;
272 0         0 $ccs2->[$VALS] = $ccs1->[$VALS]->pdl;
273 0 0       0 $ccs2->[$PTRS] = [ map {defined($_) ? [map {$_->pdl} @$_] : undef} @{$ccs1->[$PTRS]} ]; ##-- copy pointers?
  0         0  
  0         0  
  0         0  
274 0         0 $ccs2->[$FLAGS] = $ccs1->[$FLAGS];
275 0         0 return $ccs2;
276             }
277              
278             ## $ccs2 = $ccs->copyShallow()
279             ## + a very shallow version of copy()
280             ## + Copied : $PDIMS, @$PTRS, @{$PTRS->[*]}, $FLAGS
281             ## + Referenced: $VDIMS, $WHICH, $VALS, $PTRS->[*][*]
282             sub copyShallow :lvalue {
283 0     0 1 0 my $ccs = bless [@{$_[0]}], ref($_[0]);
  0         0  
284             ##
285             ##-- do copy some of it
286 0         0 $ccs->[$PDIMS] = $ccs->[$PDIMS]->pdl;
287             #$ccs->[$VDIMS] = $ccs->[$VDIMS]->pdl;
288 0 0       0 $ccs->[$PTRS] = [ map {defined($_) ? [@$_] : undef} @{$ccs->[$PTRS]} ];
  0         0  
  0         0  
289 0         0 $ccs;
290             }
291              
292             ## $ccs2 = $ccs->shadow(%args)
293             ## + args:
294             ## to => $ccs2, ##-- default: new
295             ## pdims => $pdims2, ##-- default: $pdims1->pdl (alias: 'dims')
296             ## vdims => $vdims2, ##-- default: $vdims1->pdl (alias: 'xdims')
297             ## ptrs => \@ptrs2, ##-- default: []
298             ## which => $which2, ##-- default: undef
299             ## vals => $vals2, ##-- default: undef ; if specified, should include final 'missing' element
300             ## flags => $flags, ##-- default: $flags1
301             sub shadow :lvalue {
302 0     0 1 0 my ($ccs,%args) = @_;
303 0 0 0     0 my $ccs2 = defined($args{to}) ? $args{to} : bless([], ref($ccs)||$ccs);
304 0 0       0 $ccs2->[$PDIMS] = (defined($args{pdims}) ? $args{pdims} : (defined($args{dims}) ? $args{dims} : $ccs->[$PDIMS]->pdl));
    0          
305 0 0       0 $ccs2->[$VDIMS] = (defined($args{vdims}) ? $args{vdims} : (defined($args{xdims}) ? $args{xdims} : $ccs->[$VDIMS]->pdl));
    0          
306 0 0       0 $ccs2->[$PTRS] = $args{ptrs} ? $args{ptrs} : [];
307 0         0 $ccs2->[$WHICH] = $args{which};
308 0         0 $ccs2->[$VALS] = $args{vals};
309 0 0       0 $ccs2->[$FLAGS] = defined($args{flags}) ? $args{flags} : $ccs->[$FLAGS];
310 0         0 return $ccs2;
311             }
312              
313              
314             ##--------------------------------------------------------------
315             ## Maintenance
316              
317             ## $ccs = $ccs->recode()
318             ## + recodes object, removing any missing values from $nzvals
319             sub recode :lvalue {
320 0     0 1 0 my $ccs = shift;
321 0         0 my $nz = $ccs->_nzvals;
322 0         0 my $z = $ccs->[$VALS]->slice("-1");
323              
324             ##-- get mask of "real" non-zero values
325 0         0 my ($nzmask, $nzmask1);
326 0 0       0 if ($z->isbad) {
327 0         0 $nzmask = $nz->isgood;
328             }
329             else {
330 0         0 $nzmask = $nz != $z;
331 0 0       0 if ($ccs->[$FLAGS] & $CCSND_BAD_IS_MISSING) {
332 0         0 $nzmask1 = $nz->isgood;
333 0         0 $nzmask &= $nzmask1;
334             }
335             }
336 0 0       0 if ($ccs->[$FLAGS] & $CCSND_NAN_IS_MISSING) {
337 0 0       0 $nzmask1 = $nzmask->pdl if (!defined($nzmask1));
338 0         0 $nz->isfinite($nzmask1);
339 0         0 $nzmask &= $nzmask1;
340             }
341              
342             ##-- maybe recode
343 0 0       0 if (!$nzmask->all) {
344 0         0 my $nzi = $nzmask->which;
345 0         0 $ccs->[$WHICH] = $ccs->[$WHICH]->dice_axis(1,$nzi);
346 0         0 $ccs->[$VALS] = $ccs->[$VALS]->index($nzi)->append($z);
347 0         0 @{$ccs->[$PTRS]} = qw(); ##-- clear pointers
  0         0  
348             }
349              
350 0         0 return $ccs;
351             }
352              
353             ## $ccs = $ccs->sortwhich()
354             ## + sorts on $ccs->[$WHICH]
355             ## + may be DANGEROUS to indexing methods, b/c it alters $VALS
356             ## + clears pointers
357             sub sortwhich :lvalue {
358 0 0   0 1 0 return $_[0] if ($_[0][$WHICH]->isempty);
359 0         0 my $sorti = $_[0][$WHICH]->vv_qsortveci;
360 0         0 $_[0][$WHICH] = $_[0][$WHICH]->dice_axis(1,$sorti);
361 0         0 $_[0][$VALS] = $_[0][$VALS]->index($sorti->append($_[0][$WHICH]->dim(1)));
362             #
363             #-- DANGEROUS: pointer copy
364             # foreach (grep {defined($_)} @{$_[0][$PTRS]}) {
365             # $_->[1]->index($sorti) .= $_->[1];
366             # }
367             #--/DANGEROUS: pointer copy
368             #
369 0 0       0 @{$_[0][$PTRS]} = qw() if (! ($sorti==PDL->sequence($P_INDX,$sorti->dims))->all );
  0         0  
370 0         0 return $_[0];
371             }
372              
373              
374             ##--------------------------------------------------------------
375             ## Decoding
376              
377             ## $dense = $ccs->decode()
378             ## $dense = $ccs->decode($dense)
379             sub decode :lvalue {
380             ##-- decode physically stored index+value pairs
381 0     0 1 0 my $dense = ccs_decode($_[0][$WHICH],
382             $_[0]->_nzvals,
383             $_[0]->missing,
384             [ $_[0][$PDIMS] ],
385             );
386              
387             ##-- map physical dims with reorder()
388 0         0 my $porder = $_[0][$VDIMS]->where($_[0][$VDIMS]>=0);
389 0         0 $dense = $dense->reorder($porder->list); #if (($porder!=$_[0][$PDIMS]->sequence)->any);
390              
391             ##-- map virtual dims with dummy()
392 0         0 my @vdims = $_[0][$VDIMS]->list;
393 0         0 foreach (grep {$vdims[$_]<0} (0..$#vdims)) {
  0         0  
394 0         0 $dense = $dense->dummy($_, -$vdims[$_]);
395             }
396              
397             ##-- assign if $dense was specified by the user
398 0 0       0 if (defined($_[1])) {
399 0         0 $_[1] .= $dense;
400 0         0 return $_[1];
401             }
402              
403 0         0 return $dense;
404             }
405              
406             ## $dense = $ccs_or_dense->todense()
407             *PDL::todense = \&todense;
408 0 0   0 1 0 sub todense :lvalue { isa($_[0],__PACKAGE__) ? (my $tmp=$_[0]->decode(@_[1..$#_])) : $_[0]; }
409              
410             ##--------------------------------------------------------------
411             ## PDL API: Basic Properties
412              
413             ## $type = $obj->type()
414 0     0 0 0 sub type { $_[0][$VALS]->type; }
415 0     0 0 0 sub info { $_[0][$VALS]->info; }
416              
417             ## $obj2 = $obj->convert($type)
418             ## + unlike PDL function, respects 'inplace' flag
419             sub convert :lvalue {
420 0 0   0 0 0 if ($_[0][$FLAGS] & $CCSND_INPLACE) {
421 0         0 $_[0][$VALS] = $_[0][$VALS]->convert($_[1]);
422 0         0 $_[0][$FLAGS] &= ~$CCSND_INPLACE;
423 0         0 return $_[0];
424             }
425 0         0 return my $tmp=$_[0]->shadow(which=>$_[0][$WHICH]->pdl, vals=>$_[0][$VALS]->convert($_[1]));
426             }
427              
428             ## byte,short,ushort,long,double,...
429             sub _pdltype_sub {
430 30     30   116 my $pdltype = shift;
431 30 0   0   175 return sub { return $pdltype if (!@_); convert(@_,$pdltype); };
  0         0  
  0         0  
432             }
433             foreach my $pdltype (map {$_->{convertfunc}} values %PDL::Types::typehash) {
434 2     2   16 no strict 'refs';
  2         4  
  2         2315  
435             #qw(byte short ushort long longlong indx float double)
436             *$pdltype = _pdltype_sub("PDL::${pdltype}"->());
437             }
438              
439             ## $dimpdl = $obj->dimpdl()
440             ## + values in $dimpdl are negative for virtual dimensions
441             sub dimpdl :lvalue {
442 0     0 0 0 my $dims = $_[0][$VDIMS]->pdl;
443 0         0 my $physi = ($_[0][$VDIMS]>=0)->which;
444 0         0 (my $tmp=$dims->index($physi)) .= $_[0][$PDIMS]->index($_[0][$VDIMS]->index($physi));
445 0         0 return $dims;
446             }
447              
448             ## @dims = $obj->dims()
449 0     0 0 0 sub dims { $_[0]->dimpdl->abs->list; }
450              
451             ## $dim = $obj->dim($dimi)
452 0     0 0 0 sub dim { $_[0]->dimpdl->abs->at($_[1]); }
453             *getdim = \&dim;
454              
455             ## $ndims = $obj->ndims()
456 0     0 0 0 sub ndims { $_[0][$VDIMS]->nelem; }
457             *getndims = \&ndims;
458              
459             ## $nelem = $obj->nelem
460 0     0 0 0 sub nelem { $_[0]->dimpdl->abs->dprod; }
461              
462             ## $bool = $obj->isnull
463 0     0 0 0 sub isnull { $_[0][$VALS]->isnull; }
464              
465             ## $bool = $obj->isempty
466 0     0 0 0 sub isempty { $_[0]->nelem==0; }
467              
468             ##--------------------------------------------------------------
469             ## Low-level CCS access
470              
471             ## $bool = $ccs->is_physically_indexed()
472             ## + returns true iff only physical dimensions are present
473             sub is_physically_indexed {
474             (
475 0 0   0 1 0 $_[0][$VDIMS]->ndims==$_[0][$PDIMS]->ndims
476             &&
477             ($_[0][$VDIMS]==$_[0][$VDIMS]->sequence)->all
478             );
479             }
480              
481             ## $ccs2 = $ccs->to_physically_indexed()
482             ## + ensures that all non-missing elements are physically indexed
483             ## + just returns $ccs if all non-missing elements are already physically indexed
484             sub to_physically_indexed {
485 0 0   0 1 0 return $_[0] if ($_[0]->is_physically_indexed);
486 0         0 my $ccs = shift;
487 0         0 my $which = $ccs->whichND;
488 0         0 my $vals = $ccs->whichVals;
489 0         0 my $sorti = $which->vv_qsortveci;
490 0         0 return $ccs->shadow(
491             pdims=>$ccs->dimpdl->abs,
492             vdims=>$ccs->[$VDIMS]->sequence,
493             which=>$which->dice_axis(1,$sorti),
494             vals =>$vals->index($sorti)->append($ccs->missing),
495             )->sever;
496             }
497              
498             ## $ccs = $ccs->make_physically_indexed()
499             *make_physical = \&make_physically_indexed;
500             sub make_physically_indexed {
501 0 0   0 1 0 return $_[0] if ($_[0]->is_physically_indexed);
502 0         0 @{$_[0]} = @{$_[0]->to_physically_indexed};
  0         0  
  0         0  
503 0         0 return $_[0];
504             }
505              
506             ## $pdims = $obj->pdims()
507             ## $vdims = $obj->vdims()
508 0     0 1 0 sub pdims :lvalue { $_[0][$PDIMS]; }
509 0     0 1 0 sub vdims :lvalue { $_[0][$VDIMS]; }
510              
511              
512             ## $nelem_p = $obj->nelem_p : maximum number of physically addressable elements
513             ## $nelem_v = $obj->nelem_v : maximum number of virtually addressable elements
514 0     0 1 0 sub nelem_p { $_[0][$PDIMS]->dprod; }
515             *nelem_v = \&nelem;
516              
517             ## $v_per_p = $obj->_ccs_nvperp() : number of virtual elements per physical element
518 0     0   0 sub _ccs_nvperp { $_[0][$VDIMS]->where($_[0][$VDIMS]<0)->abs->dprod; }
519              
520             ## $nstored_p = $obj->nstored_p : actual number of physically stored elements
521             ## $nstored_v = $obj->nstored_v : actual number of physically+virtually stored elements
522 0     0 1 0 sub nstored_p { $_[0][$WHICH]->dim(1); }
523 0     0 1 0 sub nstored_v { $_[0][$WHICH]->dim(1) * $_[0]->_ccs_nvperp; }
524             *nstored = \&nstored_v;
525              
526              
527             ## $nnz = $obj->_nnz_p : returns actual $obj->[$VALS]->dim(0)-1
528             ## $nnz = $obj->_nnz_v : returns virtual $obj->[$VALS]->dim(0)-1
529 0     0   0 sub _nnz_p { $_[0][$VALS]->dim(0)-1; }
530 0     0   0 sub _nnz_v { ($_[0][$VALS]->dim(0)-1) * $_[0]->_ccs_nvperp; }
531             *_nnz = \&_nnz_v;
532              
533             ## $nmissing_p = $obj->nmissing_p()
534             ## $nmissing_v = $obj->nmissing_v()
535 0     0 1 0 sub nmissing_p { $_[0]->nelem_p - $_[0]->nstored_p; }
536 0     0 1 0 sub nmissing_v { $_[0]->nelem_v - $_[0]->nstored_v; }
537             *nmissing = \&nmissing_v;
538              
539             ## $bool = $obj->allmissing
540             ## + true if no non-missing values are stored
541 0     0 1 0 sub allmissing { $_[0][$VALS]->nelem <= 1; }
542              
543              
544             ## $missing = $obj->missing()
545             ## $missing = $obj->missing($missing)
546             sub missing {
547 0 0   0 1 0 $_[0][$VALS]->set(-1,$_[1]) if (@_>1);
548 0         0 $_[0][$VALS]->slice("-1");
549             }
550              
551             ## $obj = $obj->_missing($missingVal)
552             sub _missing :lvalue {
553 0 0   0   0 $_[0][$VALS]->set(-1,$_[1]) if (@_>1);
554 0         0 $_[0];
555             }
556              
557             ## $whichND_stored = $obj->_whichND()
558             ## $whichND_stored = $obj->_whichND($whichND)
559             sub _whichND :lvalue {
560 0 0   0   0 $_[0][$WHICH] = $_[1] if (@_>1);
561 0         0 $_[0][$WHICH];
562             }
563              
564             ## $_nzvals = $obj->_nzvals()
565             ## $_nzvals = $obj->_nzvals($nzvals)
566             ## + physical storage only
567 2     2   3429 BEGIN { *_whichVals = \&_nzvals; }
568             sub _nzvals :lvalue {
569 0     0   0 my ($tmp);
570 0 0       0 $_[0][$VALS]=$_[1]->append($_[0][$VALS]->slice("-1")) if (@_ > 1);
571 0 0       0 return $tmp=$_[0][$VALS]->index(PDL->zeroes(ccs_indx(), 0)) if ($_[0][$VALS]->dim(0)<=1);
572 0         0 return $tmp=$_[0][$VALS]->slice("0:-2");
573             }
574              
575             ## $vals = $obj->_vals()
576             ## $vals = $obj->_vals($storedvals)
577             ## + physical storage only
578             sub _vals :lvalue {
579 0 0   0   0 $_[0][$VALS]=$_[1] if (@_ > 1);
580 0         0 $_[0][$VALS];
581             }
582              
583              
584             ## $ptr = $obj->ptr($dim_p); ##-- scalar context
585             ## ($ptr,$pi2nzi) = $obj->ptr($dim_p); ##-- list context
586             ## + returns cached value in $ccs->[$PTRS][$dim_p] if present
587             ## + caches value in $ccs->[$PTRS][$dim_p] otherwise
588             ## + $dim defaults to zero, for compatibility
589             ## + if $dim is zero, all($pi2nzi==sequence($obj->nstored))
590             ## + physical dimensions ONLY
591             sub ptr {
592 0     0 1 0 my ($ccs,$dim) = @_;
593 0 0       0 $dim = 0 if (!defined($dim));
594 0 0       0 $ccs->[$PTRS][$dim] = [$ccs->getptr($dim)] if (!$ccs->hasptr($dim));
595 0 0       0 return wantarray ? @{$ccs->[$PTRS][$dim]} : $ccs->[$PTRS][$dim][0];
  0         0  
596             }
597              
598             ## $bool = $obj->hasptr($dim_p)
599             ## + returns true iff $obj has a cached pointer for physical dim $dim_p
600             sub hasptr {
601 0     0 1 0 my ($ccs,$dim) = @_;
602 0 0       0 $dim = 0 if (!defined($dim));
603 0 0       0 return defined($ccs->[$PTRS][$dim]) ? scalar(@{$ccs->[$PTRS][$dim]}) : 0;
  0         0  
604             }
605              
606             ## ($ptr,$pi2nzi) = $obj->getptr($dim_p);
607             ## + as for ptr(), but does NOT cache anything, and does NOT check the cache
608             ## + physical dimensions ONLY
609 0     0 1 0 sub getptr { ccs_encode_pointers($_[0][$WHICH]->slice("($_[1]),"), $_[0][$PDIMS]->index($_[1])); }
610              
611             ## ($ptr,$pi2nzi) = $obj->setptr($dim_p, $ptr,$pi2nzi );
612             ## + low-level: set pointer for $dim_p
613             sub setptr {
614 0 0   0 0 0 if (UNIVERSAL::isa($_[2],'ARRAY')) {
615 0         0 $_[0][$PTRS][$_[1]] = $_[2];
616             } else {
617 0         0 $_[0][$PTRS][$_[1]] = [$_[2],$_[3]];
618             }
619 0         0 return $_[0]->ptr($_[1]);
620             }
621              
622             ## $obj = $obj->clearptrs()
623 0     0 1 0 sub clearptrs :lvalue { @{$_[0][$PTRS]}=qw(); return $_[0]; }
  0         0  
  0         0  
624              
625             ## $obj = $obj->clearptr($dim_p)
626             ## + low-level: clear pointer(s) for $dim_p
627             sub clearptr :lvalue {
628 0     0 1 0 my ($ccs,$dim) = @_;
629 0 0       0 return $ccs->clearptrs() if (!defined($dim));
630 0         0 $ccs->[$PTRS][$dim] = undef;
631 0         0 return $ccs;
632             }
633              
634             ## $flags = $obj->flags()
635             ## $flags = $obj->flags($flags)
636             ## + get local flags
637 0 0   0 1 0 sub flags { $_[0][$FLAGS] = $_[1] if (@_ > 1); $_[0][$FLAGS]; }
  0         0  
638              
639             ## $bool = $obj->bad_is_missing()
640             ## $bool = $obj->bad_is_missing($bool)
641             sub bad_is_missing {
642 0 0   0 1 0 if (@_ > 1) {
643 0 0       0 if ($_[1]) { $_[0][$FLAGS] |= $CCSND_BAD_IS_MISSING; }
  0         0  
644 0         0 else { $_[0][$FLAGS] &= ~$CCSND_BAD_IS_MISSING; }
645             }
646 0         0 $_[0][$FLAGS] & $CCSND_BAD_IS_MISSING;
647             }
648              
649             ## $obj = $obj->badmissing()
650 0     0 1 0 sub badmissing { $_[0][$FLAGS] |= $CCSND_BAD_IS_MISSING; $_[0]; }
  0         0  
651              
652             ## $bool = $obj->nan_is_missing()
653             ## $bool = $obj->nan_is_missing($bool)
654             sub nan_is_missing {
655 0 0   0 1 0 if (@_ > 1) {
656 0 0       0 if ($_[1]) { $_[0][$FLAGS] |= $CCSND_NAN_IS_MISSING; }
  0         0  
657 0         0 else { $_[0][$FLAGS] &= ~$CCSND_NAN_IS_MISSING; }
658             }
659 0         0 $_[0][$FLAGS] & $CCSND_NAN_IS_MISSING;
660             }
661              
662             ## $obj = $obj->nanmissing()
663 0     0 1 0 sub nanmissing { $_[0][$FLAGS] |= $CCSND_NAN_IS_MISSING; $_[0]; }
  0         0  
664              
665              
666             ## undef = $obj->set_inplace($bool)
667             ## + sets local inplace flag
668             sub set_inplace ($$) {
669 0 0   0 0 0 if ($_[1]) { $_[0][$FLAGS] |= $CCSND_INPLACE; }
  0         0  
670 0         0 else { $_[0][$FLAGS] &= ~$CCSND_INPLACE; }
671             }
672              
673             ## $bool = $obj->is_inplace()
674 0 0   0 0 0 sub is_inplace ($) { ($_[0][$FLAGS] & $CCSND_INPLACE) ? 1 : 0; }
675              
676             ## $obj = $obj->inplace()
677             ## + sets local inplace flag
678 0     0 0 0 sub inplace ($) { $_[0][$FLAGS] |= $CCSND_INPLACE; $_[0]; }
  0         0  
679              
680             ## $bool = $obj->badflag()
681             ## $bool = $obj->badflag($bool)
682             ## + wraps $obj->[$WHICH]->badflag, $obj->[$VALS]->badflag()
683             sub badflag {
684 0 0   0 0 0 if (@_ > 1) {
685 0         0 $_[0][$WHICH]->badflag($_[1]);
686 0         0 $_[0][$VALS]->badflag($_[1]);
687             }
688 0   0     0 return $_[0][$WHICH]->badflag || $_[0][$VALS]->badflag;
689             }
690              
691             ## $obj = $obj->sever()
692             ## + severs all sub-pdls
693             sub sever {
694 0     0 0 0 $_[0][$PDIMS]->sever;
695 0         0 $_[0][$VDIMS]->sever;
696 0         0 $_[0][$WHICH]->sever;
697 0         0 $_[0][$VALS]->sever;
698 0         0 foreach (grep {defined($_)} (@{$_[0][$PTRS]})) {
  0         0  
  0         0  
699 0         0 $_->[0]->sever;
700 0         0 $_->[1]->sever;
701             }
702 0         0 $_[0];
703             }
704              
705             ## \&code = _setbad_sub($pdlcode)
706             ## + returns a sub implementing setbadtoval(), setvaltobad(), etc.
707             sub _setbad_sub {
708 8     8   16 my $pdlsub = shift;
709             return sub {
710 0 0   0   0 if ($_[0]->is_inplace) {
711 0         0 $pdlsub->($_[0][$VALS]->inplace, @_[1..$#_]);
712 0         0 $_[0]->set_inplace(0);
713 0         0 return $_[0];
714             }
715 0         0 $_[0]->shadow(
716             which=>$_[0][$WHICH]->pdl,
717             vals=>$pdlsub->($_[0][$VALS],@_[1..$#_]),
718             );
719 8         84 };
720             }
721              
722             ## $obj = $obj->setnantobad()
723             foreach my $badsub (qw(setnantobad setbadtonan setbadtoval setvaltobad)) {
724 2     2   21 no strict 'refs';
  2         3  
  2         8555  
725             *$badsub = _setbad_sub(PDL->can($badsub));
726             }
727              
728             ##--------------------------------------------------------------
729             ## Dimension Shuffling
730              
731             ## $ccs = $ccs->setdims_p(@dims)
732             ## + sets physical dimensions
733             *setdims = \&setdims_p;
734 0     0 1 0 sub setdims_p { $_[0][$PDIMS] = PDL->pdl($P_INDX,@_[1..$#_]); }
735              
736             ## $ccs2 = $ccs->dummy($vdim_index)
737             ## $ccs2 = $ccs->dummy($vdim_index, $vdim_size)
738             sub dummy :lvalue {
739 0     0 1 0 my ($ccs,$vdimi,$vdimsize) = @_;
740 0         0 my @vdims = $ccs->[$VDIMS]->list;
741 0 0       0 $vdimsize = 1 if (!defined($vdimsize));
742 0 0       0 $vdimi = 0 if (!defined($vdimi));
743 0 0       0 $vdimi = @vdims + $vdimi + 1 if ($vdimi < 0);
744 0 0       0 if ($vdimi < 0) {
745 0         0 PDL::Lite::barf(ref($ccs). "::dummy(): negative dimension number ", ($vdimi+@vdims), " exceeds number of dims ", scalar(@vdims));
746             }
747 0         0 splice(@vdims,$vdimi,0,-$vdimsize);
748 0         0 my $ccs2 = $ccs->copyShallow;
749 0         0 $ccs2->[$VDIMS] = PDL->pdl($P_INDX,\@vdims);
750 0         0 return $ccs2;
751             }
752              
753             ## $ccs2 = $ccs->reorder_pdl($vdim_index_pdl)
754             sub reorder_pdl :lvalue {
755 0     0 0 0 my $ccs2 = $_[0]->copyShallow;
756 0         0 $ccs2->[$VDIMS] = $ccs2->[$VDIMS]->index($_[1]);
757 0         0 $ccs2->[$VDIMS]->sever;
758 0         0 $ccs2;
759             }
760              
761             ## $ccs2 = $ccs->reorder(@vdim_list)
762 0     0 1 0 sub reorder :lvalue { $_[0]->reorder_pdl(PDL->pdl($P_INDX,@_[1..$#_])); }
763              
764             ## $ccs2 = $ccs->xchg($vdim1,$vdim2)
765             sub xchg :lvalue {
766 0     0 1 0 my $dimpdl = PDL->sequence($P_INDX,$_[0]->ndims);
767 0         0 my $tmp = $dimpdl->at($_[1]);
768 0         0 $dimpdl->set($_[1], $dimpdl->at($_[2]));
769 0         0 $dimpdl->set($_[2], $tmp);
770 0         0 return $tmp=$_[0]->reorder_pdl($dimpdl);
771             }
772              
773             ## $ccs2 = $ccs->mv($vDimFrom,$vDimTo)
774             sub mv :lvalue {
775 0     0 1 0 my ($d1,$d2) = @_[1,2];
776 0         0 my $ndims = $_[0]->ndims;
777 0 0       0 $d1 = $ndims+$d1 if ($d1 < 0);
778 0 0       0 $d2 = $ndims+$d2 if ($d2 < 0);
779 0 0       0 return my $tmp=$_[0]->reorder($d1 < $d2
780             ? ((0..($d1-1)), (($d1+1)..$d2), $d1, (($d2+1)..($ndims-1)))
781             : ((0..($d2-1)), $d1, ($d2..($d1-1)), (($d1+1)..($ndims-1)))
782             );
783             }
784              
785             ## $ccs2 = $ccs->transpose()
786             ## + always copies
787             sub transpose :lvalue {
788 0     0 1 0 my ($tmp);
789 0 0       0 if ($_[0]->ndims==1) {
790 0         0 return $tmp=$_[0]->dummy(0,1)->copy;
791             } else {
792 0         0 return $tmp=$_[0]->xchg(0,1)->copy;
793             }
794             }
795              
796              
797              
798             ##--------------------------------------------------------------
799             ## PDL API: Indexing
800              
801             sub slice { #:lvalue
802 0     0 0 0 PDL::Lite::barf(ref($_[0])."::slice() is not implemented yet (try dummy, dice_axis, indexND, etc.)");
803             }
804              
805             ## $nzi = $ccs->indexNDi($ndi)
806             ## + returns Nnz indices for virtual ND-index PDL $ndi
807             ## + index values in $ndi which are not present in $ccs are returned in $nzi as:
808             ## $ccs->[$WHICH]->dim(1) == $ccs->_nnz_p
809             sub indexNDi :lvalue {
810 0     0 1 0 my ($ccs,$ndi) = @_;
811             ##
812             ##-- get physical dims
813 0         0 my $dims = $ccs->[$VDIMS];
814 0         0 my $whichdimp = ($dims>=0)->which;
815 0         0 my $pdimi = $dims->index($whichdimp);
816             ##
817             #$ndi = $ndi->dice_axis(0,$whichdimp) ##-- BUG?!
818 0 0 0     0 $ndi = $ndi->dice_axis(0,$pdimi)
819             if ( $ndi->dim(0)!=$ccs->[$WHICH]->dim(0) || ($pdimi!=PDL->sequence($ccs->[$WHICH]->dim(0)))->any );
820             ##
821 0         0 my $foundi = $ndi->vsearchvec($ccs->[$WHICH]);
822 0         0 my $foundi_mask = ($ndi==$ccs->[$WHICH]->dice_axis(1,$foundi))->andover;
823 0         0 $foundi_mask->inplace->not;
824 0         0 (my $tmp=$foundi->where($foundi_mask)) .= $ccs->[$WHICH]->dim(1);
825 0         0 return $foundi;
826             }
827              
828             ## $vals = $ccs->indexND($ndi)
829 0     0 1 0 sub indexND :lvalue { my $tmp=$_[0][$VALS]->index($_[0]->indexNDi($_[1])); }
830              
831             ## $vals = $ccs->index2d($xi,$yi)
832 0     0 1 0 sub index2d :lvalue { my $tmp=$_[0]->indexND($_[1]->cat($_[2])->xchg(0,1)); }
833              
834             ## $nzi = $ccs->xindex1d($xi)
835             ## + nzi indices for dice_axis(0,$xi)
836             ## + physically indexed only
837             sub xindex1d :lvalue {
838 0     0 1 0 my ($ccs,$xi) = @_;
839 0         0 $ccs->make_physically_indexed;
840 0         0 my $nzi = $ccs->[$WHICH]->ccs_xindex1d($xi);
841 0         0 $nzi->sever;
842 0         0 return $nzi;
843             }
844              
845             ## $subset = $ccs->xsubset1d($xi)
846             ## + subset object like dice_axis(0,$xi) without $xi-renumbering
847             ## + returned object should participate in dataflow
848             ## + physically indexed only
849             sub xsubset1d :lvalue {
850 0     0 1 0 my ($ccs,$xi) = @_;
851 0         0 my $nzi = $ccs->xindex1d($xi);
852 0         0 return $ccs->shadow(which=>$ccs->[$WHICH]->dice_axis(1,$nzi),
853             vals =>$ccs->[$VALS]->index($nzi->append($ccs->_nnz)));
854             }
855              
856             ## $nzi = $ccs->pxindex1d($dimi,$xi)
857             ## + nzi indices for dice_axis($dimi,$xi), using ptr($dimi)
858             ## + physically indexed only
859             sub pxindex1d :lvalue {
860 0     0 1 0 my ($ccs,$dimi,$xi) = @_;
861 0         0 $ccs->make_physically_indexed();
862 0         0 my ($ptr,$pix) = $ccs->ptr($dimi);
863 0         0 my $xptr = $ptr->index($xi);
864 0         0 my $xlen = $ptr->index($xi+1) - $xptr;
865 0 0       0 my $nzi = defined($pix) ? $pix->index($xlen->rldseq($xptr))->qsort : $xlen->rldseq($xptr);
866 0         0 $nzi->sever;
867 0         0 return $nzi;
868             }
869              
870             ## $subset = $ccs->pxsubset1d($dimi,$xi)
871             ## + subset object like dice_axis($dimi,$xi) without $xi-renumbering, using ptr($dimi)
872             ## + returned object should participate in dataflow
873             ## + physically indexed only
874             sub pxsubset1d {
875 0     0 1 0 my ($ccs,$dimi,$xi) = @_;
876 0         0 my $nzi = $ccs->pxindex1d($dimi,$xi);
877 0         0 return $ccs->shadow(which=>$ccs->[$WHICH]->dice_axis(1,$nzi),
878             vals =>$ccs->[$VALS]->index($nzi->append($ccs->_nnz)));
879             }
880              
881             ## $nzi = $ccs->xindex2d($xi,$yi)
882             ## + returns nz-index piddle matching any index-pair in Cartesian product ($xi x $yi)
883             ## + caller object must be a ccs-encoded 2d matrix
884             ## + physically indexed only
885             sub xindex2d :lvalue {
886 0     0 1 0 my ($ccs,$xi,$yi) = @_;
887 0         0 $ccs->make_physically_indexed;
888 0         0 my $nzi = $ccs->[$WHICH]->ccs_xindex2d($xi,$yi);
889 0         0 $nzi->sever;
890 0         0 return $nzi;
891             }
892              
893             ## $subset = $ccs->xsubset2d($xi,$yi)
894             ## + returns a subset CCS object for all index-pairs in $xi,$yi
895             ## + caller object must be a ccs-encoded 2d matrix
896             ## + returned object should participate in dataflow
897             ## + physically indexed only
898             sub xsubset2d :lvalue {
899 0     0 1 0 my ($ccs,$xi,$yi) = @_;
900 0         0 my $nzi = $ccs->xindex2d($xi,$yi);
901 0         0 return $ccs->shadow(which=>$ccs->[$WHICH]->dice_axis(1,$nzi),
902             vals =>$ccs->[$VALS]->index($nzi->append($ccs->_nnz)));
903             }
904              
905             ## $vals = $ccs->index($flati)
906             sub index :lvalue {
907 0     0 1 0 my ($ccs,$i) = @_;
908 0         0 my $dummy = PDL->pdl(0)->slice(join(',', map {"*$_"} $ccs->dims));
  0         0  
909 0         0 my @coords = $dummy->one2nd($i);
910 0         0 my $ind = PDL->zeroes($P_INDX,$ccs->ndims,$i->dims);
911 0         0 my ($tmp);
912 0         0 ($tmp=$ind->slice("($_),")) .= $coords[$_] foreach (0..$#coords);
913 0         0 return $tmp=$ccs->indexND($ind);
914             }
915              
916             ## $ccs2 = $ccs->dice_axis($axis_v, $axisi)
917             ## + returns a new ccs object, should participate in dataflow
918             sub dice_axis :lvalue {
919 0     0 1 0 my ($ccs,$axis_v,$axisi) = @_;
920             ##
921             ##-- get
922 0         0 my $ndims = $ccs->ndims;
923 0 0       0 $axis_v = $ndims + $axis_v if ($axis_v < 0);
924 0 0 0     0 PDL::Lite::barf(ref($ccs)."::dice_axis(): axis ".($axis_v<0 ? ($axis_v+$ndims) : $axis_v)." out of range: should be 0<=dim<$ndims")
    0          
925             if ($axis_v < 0 || $axis_v >= $ndims);
926 0         0 my $axis = $ccs->[$VDIMS]->at($axis_v);
927 0 0       0 my $asize = $axis < 0 ? -$axis : $ccs->[$PDIMS]->at($axis);
928 0         0 $axisi = PDL->topdl($axisi);
929 0         0 my ($aimin,$aimax) = $axisi->minmax;
930 0 0       0 PDL::Lite::barf(ref($ccs)."::dice_axis(): invalid index $aimin (valid range 0..".($asize-1).")") if ($aimin < 0);
931 0 0       0 PDL::Lite::barf(ref($ccs)."::dice_axis(): invalid index $aimax (valid range 0..".($asize-1).")") if ($aimax >= $asize);
932             ##
933             ##-- check for virtual
934 0 0       0 if ($axis < 0) {
935             ##-- we're dicing a virtual axis: ok, but why?
936 0         0 my $naxisi = $axisi->nelem;
937 0         0 my $ccs2 = $ccs->copyShallow();
938 0         0 $ccs2->[$VDIMS] = $ccs->[$VDIMS]->pdl;
939 0         0 $ccs2->[$VDIMS]->set($axis_v, -$naxisi);
940 0         0 return $ccs2;
941             }
942             ##-- ok, we're dicing on a real axis
943 0         0 my ($ptr,$pi2nzi) = $ccs->ptr($axis);
944 0         0 my ($ptrix,$pi2nzix) = $ptr->ccs_decode_pointer($axisi);
945 0 0       0 my $nzix = defined($pi2nzi) ? $pi2nzi->index($pi2nzix) : $pi2nzix;
946 0         0 my $which = $ccs->[$WHICH]->dice_axis(1,$nzix);
947 0         0 $which->sever;
948 0 0       0 (my $tmp=$which->slice("($axis),")) .= $ptrix if (!$which->isempty); ##-- isempty() fix: v1.12
949 0         0 my $nzvals = $ccs->[$VALS]->index($nzix->append($ccs->[$WHICH]->dim(1)));
950             ##
951             ##-- construct output object
952 0         0 my $ccs2 = $ccs->shadow();
953 0         0 $ccs2->[$PDIMS]->set($axis, $axisi->nelem);
954 0         0 $ccs2->[$WHICH] = $which;
955 0         0 $ccs2->[$VALS] = $nzvals;
956             ##
957             ##-- sort output object (if not dicing on 0th dimension)
958 0 0       0 return $axis==0 ? $ccs2 : ($tmp=$ccs2->sortwhich());
959             }
960              
961             ## $onedi = $ccs->n2oned($ndi)
962             ## + returns a pseudo-index
963             sub n2oned :lvalue {
964 0     0 1 0 my $dimsizes = PDL->pdl($P_INDX,1)->append($_[0]->dimpdl->abs)->slice("0:-2")->cumuprodover;
965 0         0 return my $tmp=($_[1] * $dimsizes)->sumover;
966             }
967              
968             ## $whichND = $obj->whichND
969             ## + just returns the literal index PDL if possible: beware of dataflow!
970             ## + indices are NOT guaranteed to be returned in any surface-logical order,
971             ## although physically indexed dimensions should be sorted in physical-lexicographic order
972             sub whichND :lvalue {
973 0     0 1 0 my $vpi = ($_[0][$VDIMS]>=0)->which;
974 0         0 my ($wnd);
975 0 0       0 if ( $_[0][$VDIMS]->nelem==$_[0][$PDIMS]->nelem ) {
976 0 0       0 if (($_[0][$VDIMS]->index($vpi)==$_[0][$PDIMS]->sequence)->all) {
977             ##-- all literal & physically ordered
978 0         0 $wnd=$_[0][$WHICH];
979             }
980             else {
981             ##-- all physical, but shuffled
982 0         0 $wnd=$_[0][$WHICH]->dice_axis(0,$_[0][$VDIMS]->index($vpi));
983             }
984 0 0       0 return wantarray ? $wnd->xchg(0,1)->dog : $wnd;
985             }
986             ##-- virtual dims are in the game: construct output pdl
987 0         0 my $ccs = shift;
988 0         0 my $nvperp = $ccs->_ccs_nvperp;
989 0         0 my $nv = $ccs->nstored_v;
990 0         0 $wnd = PDL->zeroes($P_INDX, $ccs->ndims, $nv);
991 0         0 (my $tmp=$wnd->dice_axis(0,$vpi)->flat) .= $ccs->[$WHICH]->dummy(1,$nvperp)->flat;
992 0 0       0 if (!$wnd->isempty) {
993 0         0 my $nzi = PDL->sequence($P_INDX,$nv);
994 0         0 my @vdims = $ccs->[$VDIMS]->list;
995 0         0 my ($vdimi);
996 0         0 foreach (grep {$vdims[$#vdims-$_]<0} (0..$#vdims)) {
  0         0  
997 0         0 $vdimi = $#vdims-$_;
998 0         0 $nzi->modulo(-$vdims[$vdimi], $wnd->slice("($vdimi),"), 0);
999             }
1000             }
1001 0 0       0 return wantarray ? $wnd->xchg(0,1)->dog : $wnd;
1002             }
1003              
1004             ## $whichVals = $ccs->whichVals()
1005             ## + returns $VALS corresponding to whichND() indices
1006             ## + beware of dataflow!
1007             sub whichVals :lvalue {
1008 0     0 1 0 my $vpi = ($_[0][$VDIMS]>=0)->which;
1009 0         0 my ($tmp);
1010 0 0       0 return $tmp=$_[0]->_nzvals() if ( $_[0][$VDIMS]->nelem==$_[0][$PDIMS]->nelem ); ##-- all physical
1011             ##
1012             ##-- virtual dims are in the game: construct output pdl
1013 0         0 return $tmp=$_[0]->_nzvals->slice("*".($_[0]->_ccs_nvperp))->flat;
1014             }
1015              
1016             ## $which = $obj->which()
1017             ## + not guaranteed to be returned in any meaningful order
1018 0     0 1 0 sub which :lvalue { my $tmp=$_[0]->n2oned(scalar $_[0]->whichND); }
1019              
1020             ## $val = $ccs->at(@index)
1021 0     0 1 0 sub at { $_[0]->indexND(PDL->pdl($P_INDX,@_[1..$#_]))->sclr; }
1022              
1023             ## $val = $ccs->set(@index,$value)
1024             sub set {
1025 0     0 1 0 my $foundi = $_[0]->indexNDi(PDL->pdl($P_INDX,@_[1..($#_-1)]));
1026 0 0       0 if ( ($foundi==$_[0][$WHICH]->dim(1))->any ) {
1027 0         0 carp(ref($_[0]).": cannot set() a missing value!")
1028             } else {
1029 0         0 (my $tmp=$_[0][$VALS]->index($foundi)) .= $_[$#_];
1030             }
1031 0         0 return $_[0];
1032             }
1033              
1034             ##--------------------------------------------------------------
1035             ## Mask Utilities
1036              
1037             ## $missing_mask = $ccs->ismissing()
1038             sub ismissing :lvalue {
1039 0     0 0 0 $_[0]->shadow(which=>$_[0][$WHICH]->pdl, vals=>$_[0]->_nzvals->zeroes->ccs_indx->append(1));
1040             }
1041              
1042             ## $nonmissing_mask = $ccs->ispresent()
1043             sub ispresent :lvalue {
1044 0     0 0 0 $_[0]->shadow(which=>$_[0][$WHICH]->pdl, vals=>$_[0]->_nzvals->ones->ccs_indx->append(0));
1045             }
1046              
1047             ##--------------------------------------------------------------
1048             ## Ufuncs
1049              
1050             ## $ufunc_sub = _ufuncsub($subname, \&ccs_accum_sub, $allow_bad_missing)
1051             sub _ufuncsub {
1052 28     28   153 my ($subname,$accumsub,$allow_bad_missing) = @_;
1053 28 50       173 PDL::Lite::barf(__PACKAGE__, "::_ufuncsub($subname): no underlying CCS accumulator func!") if (!defined($accumsub));
1054             return sub :lvalue {
1055 0     0   0 my $ccs = shift;
1056             ##
1057             ##-- preparation
1058 0         0 my $which = $ccs->whichND;
1059 0         0 my $vals = $ccs->whichVals;
1060 0         0 my $missing = $ccs->missing;
1061 0         0 my @dims = $ccs->dims;
1062 0         0 my ($which1,$vals1);
1063 0 0       0 if ($which->dim(0) <= 1) {
1064             ##-- flat sum
1065 0         0 $which1 = PDL->zeroes($P_INDX,1,$which->dim(1)); ##-- dummy
1066 0         0 $vals1 = $vals;
1067             } else {
1068 0         0 $which1 = $which->slice("1:-1,");
1069 0         0 my $sorti = $which1->vv_qsortveci;
1070 0         0 $which1 = $which1->dice_axis(1,$sorti);
1071 0         0 $vals1 = $vals->index($sorti);
1072             }
1073             ##
1074             ##-- guts
1075 0 0 0     0 my ($which2,$nzvals2) = $accumsub->($which1,$vals1,
1076             ($allow_bad_missing || $missing->isgood
1077             ? ($missing, $dims[0])
1078             : (PDL->pdl($vals1->type, 0), 0))
1079             );
1080             ##
1081             ##-- get output pdl
1082 0         0 shift(@dims);
1083 0         0 my ($tmp);
1084 0 0       0 return $tmp=$nzvals2->squeeze if (!@dims); ##-- just a scalar: return a plain PDL
1085             ##
1086 0         0 my $newdims = PDL->pdl($P_INDX,\@dims);
1087 0         0 return $tmp=$ccs->shadow(
1088             pdims =>$newdims,
1089             vdims =>$newdims->sequence,
1090             which =>$which2,
1091             vals =>$nzvals2->append($missing->convert($nzvals2->type)),
1092             );
1093 28         204 };
1094             }
1095              
1096             foreach my $ufunc (
1097             qw(prod dprod sum dsum),
1098             qw(and or band bor),
1099             )
1100             {
1101 2     2   20 no strict 'refs';
  2         7  
  2         287  
1102             *{"${ufunc}over"} = _ufuncsub("${ufunc}over", PDL::CCS::Ufunc->can("ccs_accum_${ufunc}"));
1103             }
1104             foreach my $ufunc (qw(maximum minimum average))
1105             {
1106 2     2   16 no strict 'refs';
  2         5  
  2         5118  
1107             *$ufunc = _ufuncsub($ufunc, PDL::CCS::Ufunc->can("ccs_accum_${ufunc}"));
1108             }
1109              
1110             *nbadover = _ufuncsub('nbadover', PDL::CCS::Ufunc->can('ccs_accum_nbad'), 1);
1111             *ngoodover = _ufuncsub('ngoodover', PDL::CCS::Ufunc->can('ccs_accum_ngood'), 1);
1112             *nnz = _ufuncsub('nnz', PDL::CCS::Ufunc->can('ccs_accum_nnz'), 1);
1113              
1114             sub average_nz :lvalue {
1115 0     0 0 0 my $ccs = shift;
1116 0         0 return my $tmp=($ccs->sumover / $ccs->nnz);
1117             }
1118             #sub average {
1119             # my $ccs = shift;
1120             # my $missing = $ccs->missing;
1121             # return $ccs->sumover / $ccs->dim(0) if ($missing==0);
1122             # return ($ccs->sumover + (-$ccs->nnz+$ccs->dim(0))*$missing) / $ccs->dim(0);
1123             #}
1124              
1125 0 0   0 0 0 sub sum { my $z=$_[0]->missing; $_[0]->_nzvals->sum + ($z->isgood ? ($z->sclr * $_[0]->nmissing) : 0); }
  0         0  
1126 0 0   0 0 0 sub dsum { my $z=$_[0]->missing; $_[0]->_nzvals->dsum + ($z->isgood ? ($z->sclr * $_[0]->nmissing) : 0); }
  0         0  
1127 0 0   0 0 0 sub prod { my $z=$_[0]->missing; $_[0]->_nzvals->prod * ($z->isgood ? ($z->sclr ** $_[0]->nmissing) : 1); }
  0         0  
1128 0 0   0 0 0 sub dprod { my $z=$_[0]->missing; $_[0]->_nzvals->dprod * ($z->isgood ? ($z->sclr ** $_[0]->nmissing) : 1); }
  0         0  
1129 0     0 0 0 sub min { $_[0][$VALS]->min; }
1130 0     0 0 0 sub max { $_[0][$VALS]->max; }
1131 0     0 0 0 sub minmax { $_[0][$VALS]->minmax; }
1132              
1133 0 0   0 0 0 sub nbad { my $z=$_[0]->missing; $_[0]->_nzvals->nbad + ($z->isbad ? $_[0]->nmissing : 0); }
  0         0  
1134 0 0   0 0 0 sub ngood { my $z=$_[0]->missing; $_[0]->_nzvals->ngood + ($z->isgood ? $_[0]->nmissing : 0); }
  0         0  
1135              
1136 0     0 0 0 sub any { $_[0][$VALS]->any; }
1137 0     0 0 0 sub all { $_[0][$VALS]->all; }
1138              
1139              
1140             sub avg {
1141 0     0 0 0 my $z=$_[0]->missing;
1142 0         0 return ($_[0]->_nzvals->sum + ($_[0]->nelem-$_[0]->_nnz)*$z->sclr) / $_[0]->nelem;
1143             }
1144 0     0 0 0 sub avg_nz { $_[0]->_nzvals->avg; }
1145              
1146             sub isbad {
1147 0     0 0 0 my ($a,$out) = @_;
1148 0         0 return $a->shadow(which=>$a->[$WHICH]->pdl,vals=>$a->[$VALS]->isbad,to=>$out);
1149             }
1150             sub isgood {
1151 0     0 0 0 my ($a,$out) = @_;
1152 0         0 return $a->shadow(which=>$a->[$WHICH]->pdl,vals=>$a->[$VALS]->isgood,to=>$out);
1153             }
1154              
1155             ##--------------------------------------------------------------
1156             ## Index-Ufuncs
1157              
1158             sub _ufunc_ind_sub {
1159 4     4   14 my ($subname,$accumsub,$allow_bad_missing) = @_;
1160 4 50       12 PDL::Lite::barf(__PACKAGE__, "::_ufuncsub($subname): no underlying CCS accumulator func!") if (!defined($accumsub));
1161             return sub :lvalue {
1162 0     0   0 my $ccs = shift;
1163             ##
1164             ##-- preparation
1165 0         0 my $which = $ccs->whichND;
1166 0         0 my $vals = $ccs->whichVals;
1167 0         0 my $missing = $ccs->missing;
1168 0         0 my @dims = $ccs->dims;
1169 0         0 my ($which0,$which1,$vals1);
1170 0 0       0 if ($which->dim(0) <= 1) {
1171             ##-- flat X_ind
1172 0         0 $which0 = $which->slice("(0),");
1173 0         0 $which1 = PDL->zeroes($P_INDX,1,$which->dim(1)); ##-- dummy
1174 0         0 $vals1 = $vals;
1175             } else {
1176 0         0 my $sorti = $which->dice_axis(0, PDL->sequence($P_INDX,$which->dim(0))->rotate(-1))->vv_qsortveci;
1177 0         0 $which1 = $which->slice("1:-1,")->dice_axis(1,$sorti);
1178 0         0 $which0 = $which->slice("(0),")->index($sorti);
1179 0         0 $vals1 = $vals->index($sorti);
1180             }
1181             ##
1182             ##-- guts
1183 0 0 0     0 my ($which2,$nzvals2) = $accumsub->($which1,$vals1,
1184             ($allow_bad_missing || $missing->isgood ? ($missing,$dims[0]) : (0,0))
1185             );
1186             ##
1187             ##-- get output pdl
1188 0         0 shift(@dims);
1189 0         0 my $nzi2 = $nzvals2;
1190 0         0 my $nzi2_ok = ($nzvals2>=0);
1191 0         0 my ($tmp);
1192 0         0 ($tmp=$nzi2->where($nzi2_ok)) .= $which0->index($nzi2->where($nzi2_ok));
1193 0 0       0 return $tmp=$nzi2->squeeze if (!@dims); ##-- just a scalar: return a plain PDL
1194             ##
1195 0         0 my $newdims = PDL->pdl($P_INDX,\@dims);
1196 0         0 return $tmp=$ccs->shadow(
1197             pdims =>$newdims,
1198             vdims =>$newdims->sequence,
1199             which =>$which2,
1200             vals =>$nzi2->append(ccs_indx(-1)),
1201             );
1202 4         49 };
1203             }
1204              
1205             *maximum_ind = _ufunc_ind_sub('maximum_ind', PDL::CCS::Ufunc->can('ccs_accum_maximum_nz_ind'),1);
1206             *minimum_ind = _ufunc_ind_sub('minimum_ind', PDL::CCS::Ufunc->can('ccs_accum_minimum_nz_ind'),1);
1207              
1208             ##--------------------------------------------------------------
1209             ## Ufuncs: qsort (from CCS::Functions)
1210              
1211             ## ($which0,$nzVals0, $nzix,$nzenum, $whichOut) = $ccs->_qsort()
1212             ## ($which0,$nzVals0, $nzix,$nzenum, $whichOut) = $ccs->_qsort([o]nzix(NNz), [o]nzenum(Nnz))
1213             sub _qsort {
1214 0     0   0 my $ccs = shift;
1215 0         0 my $which0 = $ccs->whichND;
1216 0         0 my $nzvals0 = $ccs->whichVals;
1217 0         0 return ($which0,$nzvals0, ccs_qsort($which0->slice("1:-1,"),$nzvals0, $ccs->missing,$ccs->dim(0), @_));
1218             }
1219              
1220             ## $ccs_sorted = $ccs->qsort()
1221             ## $ccs_sorted = $ccs->qsort($ccs_sorted)
1222             sub qsort :lvalue {
1223 0     0 0 0 my $ccs = shift;
1224 0         0 my ($which0,$nzvals0,$nzix,$nzenum) = $ccs->_qsort();
1225 0         0 my $newdims = PDL->pdl($P_INDX,[$ccs->dims]);
1226 0         0 return my $tmp=$ccs->shadow(
1227             to => $_[0],
1228             pdims =>$newdims,
1229             vdims =>$newdims->sequence,
1230             which =>$nzenum->slice("*1,")->glue(0,$which0->slice("1:-1,")->dice_axis(1,$nzix)),
1231             vals =>$nzvals0->index($nzix)->append($ccs->missing),
1232             );
1233             }
1234              
1235             ## $ccs_sortedi = $ccs->qsorti()
1236             ## $ccs_sortedi = $ccs->qsorti($ccs_sortedi)
1237             sub qsorti :lvalue {
1238 0     0 0 0 my $ccs = shift;
1239 0         0 my ($which0,$nzvals0,$nzix,$nzenum) = $ccs->_qsort();
1240 0         0 my $newdims = PDL->pdl($P_INDX,[$ccs->dims]);
1241 0         0 return my $tmp=$ccs->shadow(
1242             to => $_[0],
1243             pdims =>$newdims,
1244             vdims =>$newdims->sequence,
1245             which =>$nzenum->slice("*1,")->glue(0,$which0->slice("1:-1,")->dice_axis(1,$nzix)),
1246             vals =>$which0->slice("(0),")->index($nzix)->append(ccs_indx(-1)),
1247             );
1248             }
1249              
1250             ##--------------------------------------------------------------
1251             ## Unary Operations
1252              
1253             ## $sub = _unary_op($opname,$pdlsub)
1254             sub _unary_op {
1255 18     18   38 my ($opname,$pdlsub) = @_;
1256             return sub :lvalue {
1257 0 0   0   0 if ($_[0]->is_inplace) {
1258 0         0 $pdlsub->($_[0][$VALS]->inplace);
1259 0         0 $_[0]->set_inplace(0);
1260 0         0 return $_[0];
1261             }
1262 0         0 return my $tmp=$_[0]->shadow(which=>$_[0][$WHICH]->pdl, vals=>$pdlsub->($_[0][$VALS]));
1263 18         94 };
1264             }
1265              
1266             foreach my $unop (qw(bitnot sqrt abs sin cos not exp log log10))
1267             {
1268 2     2   25 no strict 'refs';
  2         5  
  2         10459  
1269             *$unop = _unary_op($unop,PDL->can($unop));
1270             }
1271              
1272             ##--------------------------------------------------------------
1273             ## OLD (but still used): Binary Operations: missing-is-annihilator
1274              
1275             ## ($rdpdl,$pdimsc,$vdimsc,$apcp,$bpcp) = _ccsnd_binop_align_dims($pdimsa,$vdimsa, $pdimsb,$vdimsb, $opname)
1276             # + returns:
1277             ## $rdpdl : (indx,2,$nrdims) : [ [$vdimai,$vdimbi], ...] s.t. $vdimai should align with $vdimbi
1278             ## $pdimsc : (indx,$ndimsc) : physical dim-size pdl for CCS output $c()
1279             ## $vdimsc : (indx,$ndimsc) : virtual dim-size pdl for CCS output $c()
1280             ## $apcp : (indx,2,$nac) : [ [$apdimi,$cpdimi], ... ] s.t. $cpdimi aligns 1-1 with $apdimi
1281             ## $bpcp : (indx,2,$nbc) : [ [$bpdimi,$cpdimi], ... ] s.t. $cpdimi aligns 1-1 with $bpdimi
1282             sub _ccsnd_binop_align_dims {
1283 0     0   0 my ($pdimsa,$vdimsa,$pdimsb,$vdimsb, $opname) = @_;
1284 0 0       0 $opname = '_ccsnd_binop_relevant_dims' if (!defined($opname));
1285              
1286             ##-- init
1287 0         0 my @pdimsa = $pdimsa->list;
1288 0         0 my @pdimsb = $pdimsb->list;
1289 0         0 my @vdimsa = $vdimsa->list;
1290 0         0 my @vdimsb = $vdimsb->list;
1291              
1292             ##-- get alignment-relevant dims
1293 0         0 my @rdims = qw();
1294 0         0 my ($vdima,$vdimb, $dimsza,$dimszb);
1295 0 0       0 foreach (0..($#vdimsa < $#vdimsb ? $#vdimsa : $#vdimsb)) {
1296 0         0 $vdima = $vdimsa[$_];
1297 0         0 $vdimb = $vdimsb[$_];
1298              
1299             ##-- get (virtual) dimension sizes
1300 0 0       0 $dimsza = $vdima>=0 ? $pdimsa[$vdima] : -$vdima;
1301 0 0       0 $dimszb = $vdimb>=0 ? $pdimsb[$vdimb] : -$vdimb;
1302              
1303             ##-- check for (virtual) size mismatch
1304 0 0 0     0 next if ($dimsza==1 || $dimszb==1); ##... ignoring (virtual) dims of size 1
1305 0 0       0 PDL::Lite::barf( __PACKAGE__ , "::$opname(): dimension size mismatch on dim($_): $dimsza != $dimszb")
1306             if ($dimsza != $dimszb);
1307              
1308             ##-- dims match: only align if both are physical
1309 0 0 0     0 push(@rdims, [$vdima,$vdimb]) if ($vdima>=0 && $vdimb>=0);
1310             }
1311 0         0 my $rdpdl = PDL->pdl($P_INDX,\@rdims);
1312              
1313             ##-- get output dimension sources
1314 0         0 my @_cdsrc = qw(); ##-- ( $a_or_b_for_dim0, ... )
1315 0 0       0 foreach (0..($#vdimsa > $#vdimsb ? $#vdimsa : $#vdimsb)) {
1316 0 0       0 push(@vdimsa, -1) if ($_ >= @vdimsa);
1317 0 0       0 push(@vdimsb, -1) if ($_ >= @vdimsb);
1318 0         0 $vdima = $vdimsa[$_];
1319 0         0 $vdimb = $vdimsb[$_];
1320 0 0       0 $dimsza = $vdima>=0 ? $pdimsa[$vdima] : -$vdima;
1321 0 0       0 $dimszb = $vdimb>=0 ? $pdimsb[$vdimb] : -$vdimb;
1322 0 0       0 if ($vdima>=0) {
    0          
1323 0 0       0 if ($vdimb>=0) { push(@_cdsrc, $dimsza>=$dimszb ? 0 : 1); } ##-- a:p, b:p --> c:p[max2(sz(a),sz(b))]
  0 0       0  
1324 0         0 else { push(@_cdsrc, 0); } ##-- a:p, b:v --> c:p[a]
1325             }
1326 0         0 elsif ($vdimb>=0) { push(@_cdsrc, 1); } ##-- a:v, b:p --> c:p[b]
1327 0 0       0 else { push(@_cdsrc, $dimsza>=$dimszb ? 0 : 1); } ##-- a:v, b:v --> c:v[max2(sz(a),sz(b))]
1328             }
1329 0         0 my $_cdsrcp = PDL->pdl($P_INDX,@_cdsrc);
1330              
1331             ##-- get c() dimension pdls
1332 0         0 my @pdimsc = qw();
1333 0         0 my @vdimsc = qw();
1334 0         0 my @apcp = qw(); ##-- ([$apdimi,$cpdimi], ...)
1335 0         0 my @bpcp = qw(); ##-- ([$bpdimi,$bpdimi], ...)
1336 0         0 foreach (0..$#_cdsrc) {
1337 0 0       0 if ($_cdsrc[$_]==0) { ##-- source(dim=$_) == a
1338 0 0       0 if ($vdimsa[$_]<0) { $vdimsc[$_]=$vdimsa[$_]; }
  0         0  
1339             else {
1340 0         0 $vdimsc[$_] = @pdimsc;
1341 0         0 push(@apcp, [$vdimsa[$_],scalar(@pdimsc)]);
1342 0         0 push(@pdimsc, $pdimsa[$vdimsa[$_]]);
1343             }
1344             } else { ##-- source(dim=$_) == b
1345 0 0       0 if ($vdimsb[$_]<0) { $vdimsc[$_]=$vdimsb[$_]; }
  0         0  
1346             else {
1347 0         0 $vdimsc[$_] = @pdimsc;
1348 0         0 push(@bpcp, [$vdimsb[$_],scalar(@pdimsc)]);
1349 0         0 push(@pdimsc, $pdimsb [$vdimsb[$_]]);
1350             }
1351             }
1352             }
1353 0         0 my $pdimsc = PDL->pdl($P_INDX,\@pdimsc);
1354 0         0 my $vdimsc = PDL->pdl($P_INDX,\@vdimsc);
1355 0         0 my $apcp = PDL->pdl($P_INDX,\@apcp);
1356 0         0 my $bpcp = PDL->pdl($P_INDX,\@bpcp);
1357              
1358 0         0 return ($rdpdl,$pdimsc,$vdimsc,$apcp,$bpcp);
1359             }
1360              
1361             ##-- OLD (but still used)
1362             ## \&code = _ccsnd_binary_op_mia($opName, \&pdlSub, $defType, $noSwap)
1363             ## + returns code for wrapping a builtin PDL binary operation \&pdlSub under the name "$opName"
1364             ## + $opName is just used for error reporting
1365             ## + $defType (if specified) is the default output type of the operation (e.g. PDL::long())
1366             sub _ccsnd_binary_op_mia {
1367 40     40   131 my ($opname,$pdlsub,$deftype,$noSwap) = @_;
1368              
1369             return sub :lvalue {
1370 0     0     my ($a,$b,$swap) = @_;
1371 0           my ($tmp);
1372 0 0         $swap=0 if (!defined($swap));
1373              
1374             ##-- check for & dispatch scalar operations
1375 0 0 0       if (!ref($b) || $b->nelem==1) {
1376 0 0         if ($a->is_inplace) {
1377 0 0         $pdlsub->($a->[$VALS]->inplace, todense($b), ($noSwap ? qw() : $swap));
1378 0           $a->set_inplace(0);
1379 0           return $tmp=$a->recode;
1380             }
1381 0 0         return $tmp=$a->shadow(
1382             which => $a->[$WHICH]->pdl,
1383             vals => $pdlsub->($a->[$VALS], todense($b), ($noSwap ? qw() : $swap))
1384             )->recode;
1385             }
1386              
1387             ##-- convert b to CCS
1388 0           $b = toccs($b);
1389              
1390             ##-- align dimensions & determine output sources
1391 0           my ($rdpdl,$pdimsc,$vdimsc,$apcp,$bpcp) = _ccsnd_binop_align_dims(@$a[$PDIMS,$VDIMS],
1392             @$b[$PDIMS,$VDIMS],
1393             $opname);
1394 0           my $nrdims = $rdpdl->dim(1);
1395              
1396             ##-- get & sort relevant indices, vals
1397 0           my $ixa = $a->[$WHICH];
1398 0           my $avals = $a->[$VALS];
1399 0           my $nixa = $ixa->dim(1);
1400 0           my $ra = $rdpdl->slice("(0)");
1401 0           my ($ixar,$avalsr);
1402 0 0         if ( $rdpdl->isempty ) {
    0          
1403             ##-- a: no relevant dims: align all pairs using a pseudo-dimension
1404 0           $ixar = PDL->zeroes($P_INDX, 1,$nixa);
1405 0           $avalsr = $avals;
1406             } elsif ( ($ra==PDL->sequence($P_INDX,$nrdims))->all ) {
1407             ##-- a: relevant dims are a prefix of physical dims, e.g. pre-sorted
1408 0 0         $ixar = $nrdims==$ixa->dim(0) ? $ixa : $ixa->slice("0:".($nrdims-1));
1409 0           $avalsr = $avals;
1410             } else {
1411 0           $ixar = $ixa->dice_axis(0,$ra);
1412 0           my $ixar_sorti = $ixar->qsortveci;
1413 0           $ixa = $ixa->dice_axis(1,$ixar_sorti);
1414 0           $ixar = $ixar->dice_axis(1,$ixar_sorti);
1415 0           $avalsr = $avals->index($ixar_sorti);
1416             }
1417             ##
1418 0           my $ixb = $b->[$WHICH];
1419 0           my $bvals = $b->[$VALS];
1420 0           my $nixb = $ixb->dim(1);
1421 0           my $rb = $rdpdl->slice("(1)");
1422 0           my ($ixbr,$bvalsr);
1423 0 0         if ( $rdpdl->isempty ) {
    0          
1424             ##-- b: no relevant dims: align all pairs using a pseudo-dimension
1425 0           $ixbr = PDL->zeroes($P_INDX, 1,$nixb);
1426 0           $bvalsr = $bvals;
1427             } elsif ( ($rb==PDL->sequence($P_INDX,$nrdims))->all ) {
1428             ##-- b: relevant dims are a prefix of physical dims, e.g. pre-sorted
1429 0 0         $ixbr = $nrdims==$ixb->dim(0) ? $ixb : $ixb->slice("0:".($nrdims-1));
1430 0           $bvalsr = $bvals;
1431             } else {
1432 0           $ixbr = $ixb->dice_axis(0,$rb);
1433 0           my $ixbr_sorti = $ixbr->qsortveci;
1434 0           $ixb = $ixb->dice_axis(1,$ixbr_sorti);
1435 0           $ixbr = $ixbr->dice_axis(1,$ixbr_sorti);
1436 0           $bvalsr = $bvals->index($ixbr_sorti);
1437             }
1438              
1439              
1440             ##-- initialize: state vars
1441 0 0         my $blksz = $nixa > $nixb ? $nixa : $nixb;
1442 0 0 0       $blksz = $BINOP_BLOCKSIZE_MIN if ($BINOP_BLOCKSIZE_MIN && $blksz < $BINOP_BLOCKSIZE_MIN);
1443 0 0 0       $blksz = $BINOP_BLOCKSIZE_MAX if ($BINOP_BLOCKSIZE_MAX && $blksz > $BINOP_BLOCKSIZE_MAX);
1444 0           my $istate = PDL->zeroes($P_INDX,7); ##-- [ nnzai,nnzai_nxt, nnzbi,nnzbi_nxt, nnzci,nnzci_nxt, cmpval ]
1445 0           my $ostate = $istate->pdl;
1446              
1447             ##-- initialize: output vectors
1448 0           my $nzai = PDL->zeroes($P_INDX,$blksz);
1449 0           my $nzbi = PDL->zeroes($P_INDX,$blksz);
1450 0 0         my $nzc = PDL->zeroes((defined($deftype)
    0          
1451             ? $deftype
1452             : ($avals->type > $bvals->type
1453             ? $avals->type
1454             : $bvals->type)),
1455             $blksz);
1456 0           my $ixc = PDL->zeroes($P_INDX, $pdimsc->nelem, $blksz);
1457 0           my $nnzc = 0;
1458 0 0         my $zc = $pdlsub->($avals->slice("-1"), $bvals->slice("-1"), ($noSwap ? qw() : $swap))->convert($nzc->type);
1459 0           my $nanismissing = ($a->[$FLAGS]&$CCSND_NAN_IS_MISSING);
1460 0           my $badismissing = ($a->[$FLAGS]&$CCSND_BAD_IS_MISSING);
1461 0 0 0       $zc = $zc->setnantobad() if ($nanismissing && $badismissing);
1462 0 0         my $zc_isbad = $zc->isbad ? 1 : 0;
1463              
1464             ##-- block-wise variables
1465             ## + there are way too many of these...
1466 0           my ($nzai_prv,$nzai_pnx, $nzbi_prv,$nzbi_pnx, $nzci_prv,$nzci_pnx,$cmpval_prv);
1467 0           my ($nzai_cur,$nzai_nxt, $nzbi_cur,$nzbi_nxt, $nzci_cur,$nzci_nxt,$cmpval);
1468 0           my ($nzci_max, $blk_slice, $nnzc_blk,$nnzc_slice_blk);
1469 0           my ($nzai_blk,$nzbi_blk,$ixa_blk,$ixb_blk,$ixc_blk,$nzc_blk,$cimask_blk,$ciwhich_blk);
1470 0           my $nnzc_prev=0;
1471 0   0       do {
1472             ##-- align a block of data
1473 0           ccs_binop_align_block_mia($ixar,$ixbr,$istate, $nzai,$nzbi,$ostate);
1474              
1475             ##-- parse current alignment algorithm state
1476 0           ($nzai_prv,$nzai_pnx, $nzbi_prv,$nzbi_pnx, $nzci_prv,$nzci_pnx,$cmpval_prv) = $istate->list;
1477 0           ($nzai_cur,$nzai_nxt, $nzbi_cur,$nzbi_nxt, $nzci_cur,$nzci_nxt,$cmpval) = $ostate->list;
1478 0           $nzci_max = $nzci_cur-1;
1479              
1480 0 0         if ($nzci_max >= 0) {
1481             ##-- construct block output pdls: nzvals
1482 0           $blk_slice = "${nzci_prv}:${nzci_max}";
1483 0           $nzai_blk = $nzai->slice($blk_slice);
1484 0           $nzbi_blk = $nzbi->slice($blk_slice);
1485 0 0         $nzc_blk = $pdlsub->($avalsr->index($nzai_blk), $bvalsr->index($nzbi_blk), ($noSwap ? qw() : $swap));
1486              
1487             ##-- get indices of non-$missing c() values
1488 0 0 0       $cimask_blk = $zc_isbad || $nzc_blk->badflag ? $nzc_blk->isgood : ($nzc_blk!=$zc);
1489 0 0 0       $cimask_blk &= $nzc_blk->isgood if (!$zc_isbad && $badismissing);
1490 0 0         $cimask_blk &= $nzc_blk->isfinite if ($nanismissing);
1491 0 0         if ($cimask_blk->any) {
1492 0           $ciwhich_blk = $cimask_blk->which;
1493 0           $nzc_blk = $nzc_blk->index($ciwhich_blk);
1494              
1495 0           $nnzc_blk = $nzc_blk->nelem;
1496 0           $nnzc += $nnzc_blk;
1497 0           $nnzc_slice_blk = "${nnzc_prev}:".($nnzc-1);
1498              
1499             ##-- construct block output pdls: ixc
1500 0           $ixc_blk = $ixc->slice(",$nnzc_slice_blk");
1501 0 0         if (!$apcp->isempty) {
1502 0           $ixa_blk = $ixa->dice_axis(1,$nzai_blk->index($ciwhich_blk));
1503 0           ($tmp=$ixc_blk->dice_axis(0,$apcp->slice("(1),"))) .= $ixa_blk->dice_axis(0,$apcp->slice("(0),"));
1504             }
1505 0 0         if (!$bpcp->isempty) {
1506 0           $ixb_blk = $ixb->dice_axis(1,$nzbi_blk->index($ciwhich_blk));
1507 0           ($tmp=$ixc_blk->dice_axis(0,$bpcp->slice("(1),"))) .= $ixb_blk->dice_axis(0,$bpcp->slice("(0),"));
1508             }
1509              
1510             ##-- construct block output pdls: nzc
1511 0           ($tmp=$nzc->slice($nnzc_slice_blk)) .= $nzc_blk;
1512             }
1513             }
1514              
1515             ##-- possibly allocate for another block
1516 0 0 0       if ($nzai_cur < $nixa || $nzbi_cur < $nixb) {
1517 0           $nzci_nxt -= $nzci_cur;
1518 0           $nzci_cur = 0;
1519              
1520 0 0         if ($nzci_nxt+$blksz > $nzai->dim(0)) {
1521 0           $nzai = $nzai->reshape($nzci_nxt+$blksz);
1522 0           $nzbi = $nzbi->reshape($nzci_nxt+$blksz);
1523             }
1524 0           $ixc = $ixc->reshape($ixc->dim(0), $ixc->dim(1)+$nzai->dim(0));
1525 0           $nzc = $nzc->reshape($nzc->dim(0)+$nzai->dim(0));
1526              
1527 0           ($tmp=$istate) .= $ostate;
1528 0           $istate->set(4, $nzci_cur);
1529 0           $istate->set(5, $nzci_nxt);
1530             }
1531 0           $nnzc_prev = $nnzc;
1532              
1533             } while ($nzai_cur < $nixa || $nzbi_cur < $nixb);
1534              
1535             ##-- trim output pdls
1536 0 0         if ($nnzc > 0) {
1537             ##-- usual case: some values are non-missing
1538 0           $ixc = $ixc->slice(",0:".($nnzc-1));
1539 0           my $ixc_sorti = $ixc->vv_qsortveci;
1540 0           $nzc = $nzc->index($ixc_sorti)->append($zc->convert($nzc->type));
1541 0           $nzc->sever;
1542 0           $ixc = $ixc->dice_axis(1,$ixc_sorti);
1543 0           $ixc->sever;
1544             } else {
1545             ##-- pathological case: all values are "missing"
1546 0           $ixc = $ixc->dice_axis(1,PDL->pdl([]));
1547 0           $ixc->sever;
1548 0           $nzc = $zc->convert($zc->type);
1549             }
1550              
1551             ##-- set up final output object
1552 0           my $c = $a->shadow(
1553             pdims => $pdimsc,
1554             vdims => $vdimsc,
1555             which => $ixc,
1556             vals => $nzc,
1557             );
1558 0 0         if ($a->is_inplace) {
1559 0           @$a = @$c;
1560 0           $a->set_inplace(0);
1561 0           return $a;
1562             }
1563 0           return $c;
1564 40         925 };
1565             }
1566              
1567             ##--------------------------------------------------------------
1568             ## NEW (but unused): Binary Operations: missing-is-annihilator: alignment
1569              
1570             ## \@parsed = _ccsnd_parse_signature($sig)
1571             ## \@parsed = _ccsnd_parse_signature($sig, $errorName)
1572             ## + parses a PDL-style signature
1573             ## + returned array has the form:
1574             ## ( $parsed_arg1, $parsed_arg2, ..., $parsed_argN )
1575             ## + where $parsed_arg$i =
1576             ## { name=>$argName, type=>$type, flags=>$flags, dims=>\@argDimNames, ... }
1577             ## + $flags is the string inside [] between type and arg name, if any
1578             sub _ccsnd_parse_signature {
1579 0     0     my ($sig,$errname) = @_;
1580 0 0         if ($sig =~ /^\s*\(/) {
1581             ##-- remove leading and trailing parentheses from signature
1582 0           $sig =~ s/^\s*\(\s*//;
1583 0           $sig =~ s/\s*\)\s*//;
1584             }
1585 0           my @args = ($sig =~ /[\s;]*([^\;]+)/g);
1586 0           my $parsed = [];
1587 0           my ($argName,$dimStr,$type,$flags,@dims);
1588 0           foreach (@args) {
1589 0           ($type,$flags) = ('','');
1590              
1591             ##-- check for type
1592 0 0         if ($_ =~ s/^\s*(byte|short|ushort|int|long|longlong|indx|float|double)\s*//) {
1593 0           $type = $1;
1594             }
1595              
1596             ##-- check for []-flags
1597 0 0         if ($_ =~ s/^\s*\[([^\]]*)\]\s*//g) {
1598 0           $flags = $1;
1599             }
1600              
1601             ##-- create output list: $argNumber=>{name=>$argName, dims=>[$dimNumber=>$dimName]}
1602 0 0         if ($_ =~ /^\s*(\S+)\s*\(([^\)]*)\)\s*$/) {
1603 0           ($argName,$dimStr) = ($1,$2);
1604 0 0         @dims = grep {defined($_) && $_ ne ''} split(/\,\s*/, $dimStr);
  0            
1605 0           push(@$parsed,{type=>$type,flags=>$flags,name=>$argName,dims=>[@dims]});
1606             } else {
1607 0 0         $errname = __PACKAGE__ . "::_ccsnd_parse_signature()" if (!defined($errname));
1608 0           die("${errname}: could not parse argument string '$_' for signature '$sig'");
1609             }
1610             }
1611 0           return $parsed;
1612             }
1613              
1614             ## \%dims = _ccsnd_align_dims(\@parsedSig, \@ccs_arg_pdls)
1615             ## \%dims = _ccsnd_align_dims(\@parsedSig, \@ccs_arg_pdls, $opName)
1616             ## + returns an dimension-alignment structure for @parsedSig with args @ccs_arg_pdls
1617             ## + returned %dims:
1618             ## ( $dimName => {size=>$dimSize, phys=>\@physical }, ... )
1619             ## - dim names "__thread_dim_${i}" are reserved
1620             ## - \@physical = [ [$argi,$pdimi_in_argi], ... ]
1621             sub _ccsnd_align_dims {
1622 0     0     my ($sig,$args,$opName) = @_;
1623 0 0         $opName = __PACKAGE__ . "::_ccsnd_align_dims()" if (!defined($opName));
1624              
1625             ##-- init: get virtual & physical dimension lists for arguments
1626 0           my @vdims = map { [$_->[$VDIMS]->list] } @$args;
  0            
1627 0           my @pdims = map { [$_->[$PDIMS]->list] } @$args;
  0            
1628              
1629             ##-- %dims = ($dimName => {size=>$dimSize, phys=>\@physical,... })
1630             ## + dim names "__thread_dim_${i}" are reserved
1631             ## + \@physical = [ [$argi,$pdimi], ... ]
1632 0           my %dims = map {($_=>undef)} map {@{$_->{dims}}} @$sig;
  0            
  0            
  0            
1633 0           my $nthreads = 0; ##-- number of threaded dims
1634              
1635             ##-- iterate over signature arguments, getting & checking dimension sizes
1636 0           my ($threadi, $argi,$arg_sig,$arg_ccs, $maxdim,$dimi,$pdimi,$dim_sig,$dim_ccs,$dimName, $dimsize,$isvdim);
1637 0           foreach $argi (0..$#$sig) {
1638 0           $arg_sig = $sig->[$argi];
1639 0           $arg_ccs = $args->[$argi];
1640              
1641             ##-- check for unspecified args
1642 0 0         if (!defined($arg_ccs)) {
1643 0 0         next if ($arg_sig->{flags} =~ /[ot]/); ##-- ... but not output or temporaries
1644 0           croak("$opName: argument '$arg_sig->{name}' not specified!");
1645             }
1646              
1647             ##-- reset thread counter
1648 0           $threadi=0;
1649              
1650             ##-- check dimension sizes
1651 0           $maxdim = _max2($#{$arg_sig->{dims}}, $#{$vdims[$argi]});
  0            
  0            
1652 0           foreach $dimi (0..$maxdim) {
1653 0 0         if (defined($dim_sig = $arg_sig->{dims}[$dimi])) {
1654             ##-- explicit dimension: name it
1655 0           $dimName = $dim_sig;
1656             } else {
1657 0           $dimName = "__thread_dim_".($threadi++);
1658             }
1659              
1660 0 0         if ($#{$vdims[$argi]} >= $dimi) {
  0            
1661 0           $pdimi = $vdims[$argi][$dimi];
1662 0 0         if ($pdimi >= 0) {
1663 0           $dimsize = $pdims[$argi][$pdimi];
1664 0           $isvdim = 0;
1665             } else {
1666 0           $dimsize = -$pdimi;
1667 0           $isvdim = 1;
1668             }
1669             } else {
1670 0           $dimsize = 1;
1671 0           $isvdim = 1;
1672             }
1673              
1674 0 0         if (!defined($dims{$dimName})) {
    0          
1675             ##-- new dimension
1676 0           $dims{$dimName} = { size=>$dimsize, phys=>[] };
1677             }
1678             elsif ($dims{$dimName}{size} != $dimsize) {
1679 0 0         if ($dims{$dimName}{size}==1) {
    0          
1680             ##-- ... we already had it, but as size=1 : override the stored size
1681 0           $dims{$dimName}{size} = $dimsize;
1682             }
1683             elsif ($dimsize != 1) {
1684             ##-- ... this is a non-trivial (size>1) dim which doesn't match: complain
1685 0           croak("$opName: size mismatch on dimension '$dimName' in argument '$arg_sig->{name}'",
1686             ": is $dimsize, should be $dims{$dimName}{size}");
1687             }
1688             }
1689 0 0         if (!$isvdim) {
1690             ##-- physical dim: add to alignment structure
1691 0           push(@{$dims{$dimName}{phys}}, [$argi,$pdimi]);
  0            
1692             }
1693             }
1694 0 0         $nthreads = $threadi if ($threadi > $nthreads);
1695             }
1696              
1697             ##-- check for undefined dims
1698 0           foreach (grep {!defined($dims{$_})} keys(%dims)) {
  0            
1699             #croak("$opName: cannot determine size for dimension '$_'");
1700             ##
1701             ##-- just set it to 1?
1702 0           $dims{$_} = {size=>1,phys=>[]};
1703             }
1704              
1705 0           return \%dims;
1706             }
1707              
1708             ##--------------------------------------------------------------
1709             ## Binary Operations: missing-is-annihilator: wrappers
1710              
1711             ##-- arithmetical & comparison operations
1712             foreach my $binop (
1713             qw(plus minus mult divide modulo power),
1714             qw(gt ge lt le eq ne spaceship),
1715             )
1716             {
1717 2     2   27 no strict 'refs';
  2         8  
  2         457  
1718             *$binop = *{"${binop}_mia"} = _ccsnd_binary_op_mia($binop,PDL->can($binop));
1719             die(__PACKAGE__, ": could not define binary operation $binop: $@") if ($@);
1720             }
1721              
1722             *pow = *pow_mia = _ccsnd_binary_op_mia('power',PDL->can('pow'),undef,1);
1723              
1724             ##-- integer-only operations
1725             foreach my $intop (
1726             qw(and2 or2 xor shiftleft shiftright),
1727             )
1728             {
1729             my $deftype = PDL->can($intop)->(PDL->pdl(0),PDL->pdl(0),0)->type->ioname;
1730 2     2   17 no strict 'refs';
  2         4  
  2         8599  
1731             *$intop = *{"${intop}_mia"} = _ccsnd_binary_op_mia($intop,PDL->can($intop),"PDL::${deftype}"->());
1732             die(__PACKAGE__, ": could not define integer operation $intop: $@") if ($@);
1733             }
1734              
1735             ## rassgn_mia($to,$from): binary assignment operation with missing-annihilator assumption
1736             ## + argument order is REVERSE of PDL 'assgn()' argument order
1737             *rassgn_mia = _ccsnd_binary_op_mia('rassgn', sub { PDL::assgn($_[1],$_[0]); $_[1]; });
1738              
1739             ## $to = $to->rassgn($from)
1740             ## + calls newFromDense() with $to flags if $from is dense
1741             ## + otherwise, copies $from to $to
1742             ## + argument order is REVERSED wrt PDL::assgn()
1743             sub rassgn :lvalue {
1744 0     0 0   my ($to,$from) = @_;
1745 0 0 0       if (!ref($from) || $from->nelem==1) {
1746             ##-- assignment from a scalar: treat the Nd object as a mask of available values
1747 0           (my $tmp=$to->[$VALS]) .= todense($from);
1748 0           return $to;
1749             }
1750 0 0         if (isa($from,__PACKAGE__)) {
1751             ##-- assignment from a CCS object: copy on a full dim match or an empty "$to"
1752 0           my $fromdimp = $from->dimpdl;
1753 0           my $todimp = $to->dimpdl;
1754 0 0 0       if ( $to->[$VALS]->dim(0)<=1 || $todimp->isempty || ($fromdimp==$todimp)->all ) {
      0        
1755 0           @$to = @{$from->copy};
  0            
1756 0           return $to;
1757             }
1758             }
1759             ##-- $from is something else: pass it on to 'rassgn_mia': effectively treat $to->[$WHICH] as a mask for $from
1760 0           $to->[$FLAGS] |= $CCSND_INPLACE;
1761 0           return my $tmp=$to->rassgn_mia($from);
1762             }
1763              
1764             ## $to = $from->assgn($to)
1765             ## + obeys PDL conventions
1766 0     0 0   sub assgn :lvalue { return my $tmp=$_[1]->rassgn($_[0]); }
1767              
1768              
1769             ##--------------------------------------------------------------
1770             ## CONTINUE HERE
1771              
1772             ## TODO:
1773             ## + virtual dimensions: clump
1774             ## + OPERATIONS:
1775             ## - accumulators: (some still missing: statistical, extrema-indices, atan2, ...)
1776              
1777             ##--------------------------------------------------------------
1778             ## Matrix operations
1779              
1780             ## $c = $a->inner($b)
1781             ## + inner product (may produce a large temporary)
1782 0     0 0   sub inner :lvalue { $_[0]->mult_mia($_[1],0)->sumover; }
1783              
1784             ## $c = $a->matmult($b)
1785             ## + mostly ganked from PDL::Primitive::matmult
1786             sub matmult :lvalue {
1787 0 0   0 0   PDL::Lite::barf("Invalid number of arguments for ", __PACKAGE__, "::matmult") if ($#_ < 1);
1788 0           my ($a,$b,$c) = @_; ##-- no $c!
1789 0 0 0       $c = undef if (!ref($c) && defined($c) && $c eq ''); ##-- strangeness: getting $c=''
      0        
1790              
1791 0           $b=toccs($b); ##-- ensure 2nd arg is a CCS object
1792              
1793             ##-- promote if necessary
1794 0           while ($a->getndims < 2) {$a = $a->dummy(-1)}
  0            
1795 0           while ($b->getndims < 2) {$b = $b->dummy(-1)}
  0            
1796              
1797             ##-- vector multiplication (easy)
1798 0 0 0       if ( ($a->dim(0)==1 && $a->dim(1)==1) || ($b->dim(0)==1 && $b->dim(1)==1) ) {
      0        
      0        
1799 0 0         if (defined($c)) { @$c = @{$a*$b}; return $c; }
  0            
  0            
  0            
1800 0           return $c=($a*$b);
1801             }
1802              
1803 0 0         if ($b->dim(1) != $a->dim(0)) {
1804 0           PDL::Lite::barf(sprintf("Dim mismatch in ", __PACKAGE__ , "::matmult of [%dx%d] x [%dx%d]: %d != %d",
1805             $a->dim(0),$a->dim(1),$b->dim(0),$b->dim(1),$a->dim(0),$b->dim(1)));
1806             }
1807              
1808 0           my $_c = $a->dummy(1)->inner($b->xchg(0,1)->dummy(2)); ##-- ye olde guttes
1809 0 0         if (defined($c)) { @$c = @$_c; return $c; }
  0            
  0            
1810              
1811 0           return $_c;
1812             }
1813              
1814             ## $c_dense = $a->matmult2d_sdd($b_dense)
1815             ## $c_dense = $a->matmult2d_sdd($b_dense, $zc)
1816             ## + signature as for PDL::Primitive::matmult()
1817             ## + should handle missing values correctly (except for BAD, inf, NaN, etc.)
1818             ## + see PDL::CCS::MatrixOps(3pm) for details
1819             sub matmult2d_sdd :lvalue {
1820 0     0 0   my ($a,$b,$c, $zc) = @_;
1821 0 0 0       $c = undef if (!ref($c) && defined($c) && $c eq ''); ##-- strangeness: getting $c=''
      0        
1822              
1823             ##-- promote if necessary
1824 0           while ($a->getndims < 2) {$a = $a->dummy(-1)}
  0            
1825 0           while ($b->getndims < 2) {$b = $b->dummy(-1)}
  0            
1826              
1827             ##-- vector multiplication (easy)
1828 0 0 0       if ( ($a->dim(0)==1 && $a->dim(1)==1) || ($b->dim(0)==1 && $b->dim(1)==1) ) {
      0        
      0        
1829 0 0         if (defined($c)) { @$c = @{$a*$b}; return $c; }
  0            
  0            
  0            
1830 0           return $c=($a*$b);
1831             }
1832              
1833             ##-- check dim sizes
1834 0 0         if ($b->dim(1) != $a->dim(0)) {
1835 0           PDL::Lite::barf(sprintf("Dim mismatch in ", __PACKAGE__, "::matmult2d [%dx%d] x [%dx%d] : %d != %d",
1836             $a->dims,$b->dims, $a->dim(0),$b->dim(1)));
1837             }
1838              
1839             ##-- ensure $b dense, $a physically indexed ccs
1840 0 0         $b = todense($b) if ($b->isa(__PACKAGE__));
1841 0           $a = $a->to_physically_indexed();
1842 0   0       $c //= PDL->null;
1843              
1844             ##-- compute $zc if required
1845 0 0         if (!defined($zc)) {
1846 0           $zc = (($a->missing + PDL->zeroes($a->type, $a->dim(0), 1)) x $b)->flat;
1847             }
1848              
1849 0           ccs_matmult2d_sdd($a->_whichND,$a->_nzvals,$a->missing->squeeze, $b, $zc, $c, $a->dim(1));
1850              
1851 0           return $c;
1852             }
1853              
1854             ## $c_dense = $a->matmult2d_zdd($b_dense)
1855             ## + signature as for PDL::Primitive::matmult()
1856             ## + assumes $a->missing==0
1857             sub matmult2d_zdd :lvalue {
1858 0     0 0   my ($a,$b,$c) = @_;
1859 0 0 0       $c = undef if (!ref($c) && defined($c) && $c eq ''); ##-- strangeness: getting $c=''
      0        
1860              
1861             ##-- promote if necessary
1862 0           while ($a->getndims < 2) {$a = $a->dummy(-1)}
  0            
1863 0           while ($b->getndims < 2) {$b = $b->dummy(-1)}
  0            
1864              
1865             ##-- vector multiplication (easy)
1866 0 0 0       if ( ($a->dim(0)==1 && $a->dim(1)==1) || ($b->dim(0)==1 && $b->dim(1)==1) ) {
      0        
      0        
1867 0 0         if (defined($c)) { @$c = @{$a*$b}; return $c; }
  0            
  0            
  0            
1868 0           return $c=($a*$b);
1869             }
1870              
1871             ##-- check dim sizes
1872 0 0         if ($b->dim(1) != $a->dim(0)) {
1873 0           PDL::Lite::barf(sprintf("Dim mismatch in ", __PACKAGE__, "::matmult2d [%dx%d] x [%dx%d] : %d != %d",
1874             $a->dims,$b->dims, $a->dim(0),$b->dim(1)));
1875             }
1876              
1877             ##-- ensure $b dense, $a physically indexed ccs
1878 0 0         $b = todense($b) if ($b->isa(__PACKAGE__));
1879 0           $a = $a->to_physically_indexed();
1880 0   0       $c //= PDL->null;
1881              
1882 0           ccs_matmult2d_zdd($a->_whichND,$a->_nzvals, $b, $c, $a->dim(1));
1883              
1884 0           return $c;
1885             }
1886              
1887             ## $vnorm_dense = $a->vnorm($pdimi, ?$vnorm_dense)
1888             ## + assumes $a->missing==0
1889             sub vnorm {
1890 0     0 0   my ($a,$pdimi,$vnorm) = @_;
1891 0           $a = $a->to_physically_indexed();
1892 0   0       ccs_vnorm($a->_whichND->slice("($pdimi),"), $a->_nzvals, ($vnorm//=PDL->null), $a->dim($pdimi));
1893 0           return $vnorm;
1894             }
1895              
1896              
1897             ## $vcos_dense = $a->vcos_zdd($b_dense, ?$vcos_dense, ?$norm_dense)
1898             ## + assumes $a->missing==0
1899             sub vcos_zdd {
1900 0     0 0   my $a = shift;
1901 0           my $b = shift;
1902              
1903             ##-- ensure $b dense, $a physically indexed ccs
1904 0 0         $b = todense($b) if (!UNIVERSAL::isa($b,__PACKAGE__));
1905 0           $a = $a->to_physically_indexed();
1906              
1907             ##-- guts
1908 0           return ccs_vcos_zdd($a->_whichND, $a->_nzvals, $b, $a->dim(0), @_);
1909             }
1910              
1911             ## $vcos_dense = $a->vcos_pzd($b_sparse, ?$norm_dense, ?$vcos_dense)
1912             ## + assumes $a->missing==0
1913             ## + uses $a->ptr(1)
1914             sub vcos_pzd {
1915 0     0 0   my $a = shift;
1916 0           my $b = shift;
1917              
1918             ##-- ensure $b dense, $a physically indexed ccs
1919 0 0         $b = toccs($b) if (!UNIVERSAL::isa($b,__PACKAGE__));
1920 0           $a = $a->to_physically_indexed();
1921 0           $b = $b->to_physically_indexed();
1922              
1923             ##-- get params
1924 0           my ($aptr,$aqsi) = $a->ptr(1);
1925 0           my $arows = $a->[$WHICH]->slice("(0),")->index($aqsi);
1926 0           my $avals = $a->[$VALS]->index($aqsi);
1927 0 0         my $anorm = @_ ? shift : $a->vnorm(0);
1928 0           my $brows = $b->[$WHICH]->slice("(0),");
1929 0           my $bvals = $b->_nzvals;
1930              
1931             ##-- guts
1932 0           return ccs_vcos_pzd($aptr,$arows,$avals, $brows,$bvals, $anorm, @_);
1933             }
1934              
1935              
1936             ##--------------------------------------------------------------
1937             ## Interpolation
1938              
1939             ## ($yi,$err) = $xi->interpolate($x,$y)
1940             ## + Signature: (xi(); x(n); y(n); [o] yi(); int [o] err())
1941             ## + routine for 1D linear interpolation
1942             ## + Given a set of points "($x,$y)", use linear interpolation to find the values $yi at a set of points $xi.
1943             ## + see PDL::Primitive::interpolate()
1944             sub interpolate {
1945 0     0 0   my ($xi,$x,$y, $yi,$err) = @_;
1946 0 0         $yi = $xi->clone if (!defined($yi));
1947 0 0         $err = $xi->clone if (!defined($err));
1948 0           $xi->[$VALS]->interpolate($x,$y, $yi->[$VALS], $err->[$VALS]);
1949 0 0         return wantarray ? ($yi,$err) : $yi;
1950             }
1951              
1952             ## $yi = $xi->interpolate($x,$y)
1953             ## + Signature: (xi(); x(n); y(n); [o] yi())
1954             ## + routine for 1D linear interpolation
1955             ## + see PDL::Primitive::interpol()
1956             sub interpol :lvalue {
1957 0     0 0   my ($xi,$x,$y, $yi) = @_;
1958 0 0         $yi = $xi->clone if (!defined($yi));
1959 0           $xi->[$VALS]->interpol($x,$y, $yi->[$VALS]);
1960 0           return $yi;
1961             }
1962              
1963              
1964             ##--------------------------------------------------------------
1965             ## General Information
1966              
1967             ## $density = $ccs->density()
1968             ## + returns PDL density as a scalar (lower is more sparse)
1969 0     0 1   sub density { $_[0][$WHICH]->dim(1) / $_[0]->nelem; }
1970              
1971             ## $compressionRate = $ccs->compressionRate()
1972             ## + higher is better
1973             ## + negative value indicates that dense storage would be more memory-efficient
1974             ## + pointers aren't included in the statistics: just which,nzvals,missing
1975             sub compressionRate {
1976 0     0 1   my $ccs = shift;
1977 0           my $dsize = PDL->pdl($ccs->nelem) * PDL::howbig($ccs->type);
1978 0           my $ccssize = (0
1979             + PDL->pdl($ccs->[$WHICH]->nelem) * PDL::howbig($ccs->[$WHICH]->type)
1980             + PDL->pdl($ccs->[$VALS]->nelem) * PDL::howbig($ccs->[$VALS]->type)
1981             + PDL->pdl($ccs->[$PDIMS]->nelem) * PDL::howbig($ccs->[$PDIMS]->type)
1982             + PDL->pdl($ccs->[$VDIMS]->nelem) * PDL::howbig($ccs->[$VDIMS]->type)
1983             );
1984 0           return (($dsize - $ccssize) / $dsize)->sclr;
1985             }
1986              
1987             ##--------------------------------------------------------------
1988             ## Stringification & Viewing
1989              
1990             ## $dimstr = _dimstr($pdl)
1991 0     0     sub _dimstr { return $_[0]->type.'('.join(',',$_[0]->dims).')'; }
1992 0     0     sub _pdlstr { return _dimstr($_[0]).'='.$_[0]; }
1993              
1994             ## $str = $obj->string()
1995             sub string {
1996 0     0 0   my ($pdims,$vdims,$which,$vals) = @{$_[0]}[$PDIMS,$VDIMS,$WHICH,$VALS];
  0            
1997 0 0         my $whichstr = ''.($which->isempty ? "Empty" : $which->xchg(0,1));
1998 0           $whichstr =~ s/^([^A-Z])/ $1/mg;
1999 0           chomp($whichstr);
2000             return
2001             (
2002 0           ''
2003             .ref($_[0]) . ':' . _dimstr($_[0]) ."\n"
2004             ." pdims:" . _pdlstr($pdims) ."\n"
2005             ." vdims:" . _pdlstr($vdims) ."\n"
2006             ." which:" . _dimstr($which)."^T=" . $whichstr . "\n"
2007             ." vals:" . _pdlstr($vals) ."\n"
2008             ." missing:" . _pdlstr($_[0]->missing) ."\n"
2009             );
2010             }
2011              
2012             ## $pstr = $obj->lstring()
2013             ## + literal perl-type string
2014 0     0 0   sub lstring { return overload::StrVal($_[0]); }
2015              
2016              
2017             ##======================================================================
2018             ## AUTOLOAD: pass to nonzero-PDL
2019             ## + doesn't seem to work well
2020             ##======================================================================
2021              
2022             #our $AUTOLOAD;
2023             #sub AUTOLOAD {
2024             # my $d = shift;
2025             # return undef if (!defined($d) || !defined($d->[$VALS]));
2026             # (my $name = $AUTOLOAD) =~ s/.*:://; ##-- strip qualification
2027             # my ($sub);
2028             # if (!($sub=UNIVERSAL::can($d->[$VALS],$name))) {
2029             # croak( ref($d) , "::$name() not defined for nzvals in ", __PACKAGE__ , "::AUTOLOAD.\n");
2030             # }
2031             # return $sub->($d->[$VALS],@_);
2032             #}
2033              
2034             ##--------------------------------------------------------------
2035             ## Operator overloading
2036              
2037             use overload (
2038             ##-- Binary ops: arithmetic
2039             "+" => \&plus_mia,
2040             "-" => \&minus_mia,
2041             "*" => \&mult_mia,
2042             "/" => \÷_mia,
2043             "%" => \&modulo_mia,
2044             "**" => \&power_mia,
2045 0     0   0 '+=' => sub { $_[0]->inplace->plus_mia(@_[1..$#_]); },
2046 0     0   0 '-=' => sub { $_[0]->inplace->minus_mia(@_[1..$#_]); },
2047 0     0   0 '*=' => sub { $_[0]->inplace->mult_mia(@_[1..$#_]); },
2048 0     0   0 '%=' => sub { $_[0]->inplace->divide_mia(@_[1..$#_]); },
2049 0     0   0 '**=' => sub { $_[0]->inplace->modulo_mia(@_[1..$#_]); },
2050              
2051             ##-- Binary ops: comparisons
2052             ">" => \>_mia,
2053             "<" => \<_mia,
2054             ">=" => \&ge_mia,
2055             "<=" => \&le_mia,
2056             "<=>" => \&spaceship_mia,
2057             "==" => \&eq_mia,
2058             "!=" => \&ne_mia,
2059             #"eq" => \&eq_mia
2060              
2061             ##-- Binary ops: bitwise & logic
2062             "|" => \&or2_mia,
2063             "&" => \&and2_mia,
2064             "^" => \&xor_mia,
2065             "<<" => \&shiftleft_mia,
2066             ">>" => \&shiftright_mia,
2067 0     0   0 '|=' => sub { $_[0]->inplace->or2_mia(@_[1..$#_]); },
2068 0     0   0 '&=' => sub { $_[0]->inplace->and2_mia(@_[1..$#_]); },
2069 0     0   0 '^=' => sub { $_[0]->inplace->xor_mia(@_[1..$#_]); },
2070 0     0   0 '<<=' => sub { $_[0]->inplace->shiftleft_mia(@_[1..$#_]); },
2071 0     0   0 '>>=' => sub { $_[0]->inplace->shiftright_mia(@_[1..$#_]); },
2072              
2073             ##-- Unary operations
2074             "!" => \¬,
2075             "~" => \&bitnot,
2076             "sqrt" => \&sqrt,
2077             "abs" => \&abs,
2078             "sin" => \&sin,
2079             "cos" => \&cos,
2080             "log" => \&log,
2081             "exp" => \&exp,
2082              
2083             ##-- assignment & assigning variants
2084             ".=" => \&rassgn,
2085              
2086             ##-- matrix operations
2087             'x' => \&matmult,
2088              
2089             ##-- Stringification & casts
2090             'bool' => sub {
2091 0     0   0 my $nelem = $_[0]->nelem;
2092 0 0       0 return 0 if ($nelem==0);
2093 0 0       0 croak("multielement ", __PACKAGE__, " pseudo-piddle in conditional expression") if ($nelem!=1);
2094 0         0 $_[0][$VALS]->at(0);
2095             },
2096 2         160 "\"\"" => \&string,
2097 2     2   29 );
  2         6  
2098              
2099              
2100             1; ##-- make perl happy
2101              
2102             ##======================================================================
2103             ## PODS: Header Administrivia
2104             ##======================================================================
2105             =pod
2106              
2107             =head1 NAME
2108              
2109             PDL::CCS::Nd - N-dimensional sparse pseudo-PDLs
2110              
2111             =head1 SYNOPSIS
2112              
2113             use PDL;
2114             use PDL::CCS::Nd;
2115              
2116             ##---------------------------------------------------------------------
2117             ## Example data
2118              
2119             $missing = 0; ##-- missing values
2120             $dense = random(@dims); ##-- densely encoded pdl
2121             $dense->where(random(@dims)<=0.95) .= $missing; ## ... made sparse
2122              
2123             $whichND = $dense->whichND; ##-- which values are present?
2124             $nzvals = $dense->indexND($whichND); ##-- ... and what are they?
2125              
2126              
2127             ##---------------------------------------------------------------------
2128             ## Constructors etc.
2129              
2130             $ccs = PDL::CCS:Nd->newFromDense($dense,%args); ##-- construct from dense matrix
2131             $ccs = PDL::CCS:Nd->newFromWhich($whichND,$nzvals,%args); ##-- construct from index+value pairs
2132              
2133             $ccs = $dense->toccs(); ##-- ensure PDL::CCS::Nd-hood
2134             $ccs = $ccs->toccs(); ##-- ... analogous to PDL::topdl()
2135             $ccs = $dense->toccs($missing,$flags); ##-- ... with optional arguments
2136              
2137             $ccs2 = $ccs->copy(); ##-- copy constructor
2138             $ccs2 = $ccs->copyShallow(); ##-- shallow copy, mainly for internal use
2139             $ccs2 = $ccs->shadow(%args); ##-- flexible copy method, for internal use
2140              
2141             ##---------------------------------------------------------------------
2142             ## Maintenance & Decoding
2143              
2144             $ccs = $ccs->recode(); ##-- remove missing values from stored VALS
2145             $ccs = $ccs->sortwhich(); ##-- internal use only
2146              
2147             $dense2 = $ccs->decode(); ##-- extract to a (new) dense matrix
2148              
2149             $dense2 = $ccs->todense(); ##-- ensure dense storage
2150             $dense2 = $dense2->todense(); ##-- ... analogous to PDL::topdl()
2151              
2152             ##---------------------------------------------------------------------
2153             ## PDL API: Basic Properties
2154              
2155             ##---------------------------------------
2156             ## Type conversion & Checking
2157             $ccs2 = $ccs->convert($type);
2158             $ccs2 = $ccs->byte;
2159             $ccs2 = $ccs->short;
2160             $ccs2 = $ccs->ushort;
2161             $ccs2 = $ccs->long;
2162             $ccs2 = $ccs->longlong;
2163             $ccs2 = $ccs->float;
2164             $ccs2 = $ccs->double;
2165              
2166             ##---------------------------------------
2167             ## Dimensions
2168             @dims = $ccs->dims();
2169             $ndims = $ccs->ndims();
2170             $dim = $ccs->dim($dimi);
2171             $nelem = $ccs->nelem;
2172             $bool = $ccs->isnull;
2173             $bool = $ccs->isempty;
2174              
2175             ##---------------------------------------
2176             ## Inplace & Dataflow
2177             $ccs = $ccs->inplace();
2178             $bool = $ccs->is_inplace;
2179             $bool = $ccs->set_inplace($bool);
2180             $ccs = $ccs->sever;
2181              
2182             ##---------------------------------------
2183             ## Bad Value Handling
2184              
2185             $bool = $ccs->bad_is_missing(); ##-- treat BAD values as missing?
2186             $bool = $ccs->bad_is_missing($bool);
2187             $ccs = $ccs->badmissing(); ##-- ... a la inplace()
2188              
2189             $bool = $ccs->nan_is_missing(); ##-- treat NaN values as missing?
2190             $bool = $ccs->nan_is_missing($bool);
2191             $ccs = $ccs->nanmissing(); ##-- ... a la inplace()
2192              
2193             $ccs2 = $ccs->setnantobad();
2194             $ccs2 = $ccs->setbadtonan();
2195             $ccs2 = $ccs->setbadtoval($val);
2196             $ccs2 = $ccs->setvaltobad($val);
2197              
2198             ##---------------------------------------------------------------------
2199             ## PDL API: Dimension Shuffling
2200              
2201             $ccs2 = $ccs->dummy($vdimi,$size);
2202             $ccs2 = $ccs->reorder(@vdims);
2203             $ccs2 = $ccs->xchg($vdim1,$vdim2);
2204             $ccs2 = $ccs->mv($vdimFrom,$vdimTo);
2205             $ccs2 = $ccs->transpose();
2206              
2207             ##---------------------------------------------------------------------
2208             ## PDL API: Indexing
2209              
2210             $nzi = $ccs->indexNDi($ndi); ##-- guts for indexing methods
2211             $ndi = $ccs->n2oned($ndi); ##-- returns 1d pseudo-index for $ccs
2212              
2213             $ivals = $ccs->indexND($ndi);
2214             $ivals = $ccs->index2d($xi,$yi);
2215             $ivals = $ccs->index($flati); ##-- buggy: no pseudo-threading!
2216             $ccs2 = $ccs->dice_axis($vaxis,$vaxis_ix);
2217              
2218             $nzi = $ccs->xindex1d($xi); ##-- nz-indices along 0th dimension
2219             $nzi = $ccs->pxindex1d($dimi,$xi); ##-- ... or any dimension, using ptr()
2220             $nzi = $ccs->xindex2d($xi,$yi); ##-- ... or for Cartesian product on 2d matrix
2221              
2222             $ccs2 = $ccs->xsubset1d($xi); ##-- subset along 0th dimension
2223             $ccs2 = $ccs->pxsubset1d($dimi,$xi); ##-- ... or any dimension, using ptr()
2224             $ccs2 = $ccs->xsubset2d($xi,$yi); ##-- ... or for Cartesian product on 2d matrix
2225              
2226             $whichND = $ccs->whichND();
2227             $vals = $ccs->whichVals(); ##-- like $ccs->indexND($ccs->whichND), but faster
2228             $which = $ccs->which()
2229              
2230             $value = $ccs->at(@index);
2231             $ccs = $ccs->set(@index,$value);
2232              
2233             ##---------------------------------------------------------------------
2234             ## PDL API: Ufuncs
2235              
2236             $ccs2 = $ccs->prodover;
2237             $ccs2 = $ccs->dprodover;
2238             $ccs2 = $ccs->sumover;
2239             $ccs2 = $ccs->dsumover;
2240             $ccs2 = $ccs->andover;
2241             $ccs2 = $ccs->orover;
2242             $ccs2 = $ccs->bandover;
2243             $ccs2 = $ccs->borover;
2244             $ccs2 = $ccs->maximum;
2245             $ccs2 = $ccs->minimum;
2246             $ccs2 = $ccs->maximum_ind; ##-- -1 indicates "missing" value is maximal
2247             $ccs2 = $ccs->minimum_ind; ##-- -1 indicates "missing" value is minimal
2248             $ccs2 = $ccs->nbadover;
2249             $ccs2 = $ccs->ngoodover;
2250             $ccs2 = $ccs->nnz;
2251              
2252             $sclr = $ccs->prod;
2253             $sclr = $ccs->dprod;
2254             $sclr = $ccs->sum;
2255             $sclr = $ccs->dsum;
2256             $sclr = $ccs->nbad;
2257             $sclr = $ccs->ngood;
2258             $sclr = $ccs->min;
2259             $sclr = $ccs->max;
2260             $bool = $ccs->any;
2261             $bool = $ccs->all;
2262              
2263             ##---------------------------------------------------------------------
2264             ## PDL API: Unary Operations (Overloaded)
2265              
2266             $ccs2 = $ccs->bitnot; $ccs2 = ~$ccs;
2267             $ccs2 = $ccs->not; $ccs2 = !$ccs;
2268             $ccs2 = $ccs->sqrt;
2269             $ccs2 = $ccs->abs;
2270             $ccs2 = $ccs->sin;
2271             $ccs2 = $ccs->cos;
2272             $ccs2 = $ccs->exp;
2273             $ccs2 = $ccs->log;
2274             $ccs2 = $ccs->log10;
2275              
2276             ##---------------------------------------------------------------------
2277             ## PDL API: Binary Operations (missing is annihilator)
2278             ## + $b may be a perl scalar, a dense PDL, or a PDL::CCS::Nd object
2279             ## + $c is always returned as a PDL::CCS::Nd ojbect
2280              
2281             ##---------------------------------------
2282             ## Arithmetic
2283             $c = $ccs->plus($b); $c = $ccs1 + $b;
2284             $c = $ccs->minus($b); $c = $ccs1 - $b;
2285             $c = $ccs->mult($b); $c = $ccs1 * $b;
2286             $c = $ccs->divide($b); $c = $ccs1 / $b;
2287             $c = $ccs->modulo($b); $c = $ccs1 % $b;
2288             $c = $ccs->power($b); $c = $ccs1 ** $b;
2289              
2290             ##---------------------------------------
2291             ## Comparisons
2292             $c = $ccs->gt($b); $c = ($ccs > $b);
2293             $c = $ccs->ge($b); $c = ($ccs >= $b);
2294             $c = $ccs->lt($b); $c = ($ccs < $b);
2295             $c = $ccs->le($b); $c = ($ccs <= $b);
2296             $c = $ccs->eq($b); $c = ($ccs == $b);
2297             $c = $ccs->ne($b); $c = ($ccs != $b);
2298             $c = $ccs->spaceship($b); $c = ($ccs <=> $b);
2299              
2300             ##---------------------------------------
2301             ## Bitwise Operations
2302             $c = $ccs->and2($b); $c = ($ccs & $b);
2303             $c = $ccs->or2($b); $c = ($ccs | $b);
2304             $c = $ccs->xor($b); $c = ($ccs ^ $b);
2305             $c = $ccs->shiftleft($b); $c = ($ccs << $b);
2306             $c = $ccs->shiftright($b); $c = ($ccs >> $b);
2307              
2308             ##---------------------------------------
2309             ## Matrix Operations
2310             $c = $ccs->inner($b);
2311             $c = $ccs->matmult($b); $c = $ccs x $b;
2312             $c_dense = $ccs->matmult2d_sdd($b_dense, $zc);
2313             $c_dense = $ccs->matmult2d_zdd($b_dense);
2314            
2315             $vnorm = $ccs->vnorm($pdimi);
2316             $vcos = $ccs->vcos_zdd($b_dense);
2317             $vcos = $ccs->vcos_pzd($b_ccs);
2318              
2319             ##---------------------------------------
2320             ## Other Operations
2321             $ccs->rassgn($b); $ccs .= $b;
2322             $str = $ccs->string(); $str = "$ccs";
2323              
2324             ##---------------------------------------------------------------------
2325             ## Indexing Utilities
2326              
2327              
2328             ##---------------------------------------------------------------------
2329             ## Low-Level Object Access
2330              
2331             $num_v_per_p = $ccs->_ccs_nvperp; ##-- num virtual / num physical
2332             $pdims = $ccs->pdims; $vdims = $ccs->vdims; ##-- physical|virtual dim pdl
2333             $nelem = $ccs->nelem_p; $nelem = $ccs->nelem_v; ##-- physical|virtual nelem
2334             $nstored = $ccs->nstored_p; $nstored = $ccs->nstored_v; ##-- physical|virtual Nnz+1
2335             $nmissing = $ccs->nmissing_p; $nmissing = $ccs->nmissing_v; ##-- physical|virtual nelem-Nnz
2336              
2337             $ccs = $ccs->make_physically_indexed(); ##-- ensure all dimensions are physically indexed
2338              
2339             $bool = $ccs->allmissing(); ##-- are all values missing?
2340              
2341             $missing_val = $ccs->missing; ##-- get missing value
2342             $missing_val = $ccs->missing($missing_val); ##-- set missing value
2343             $ccs = $ccs->_missing($missing_val); ##-- ... returning the object
2344              
2345             $whichND_phys = $ccs->_whichND(); ##-- get/set physical indices
2346             $whichND_phys = $ccs->_whichND($whichND_phys);
2347              
2348             $nzvals_phys = $ccs->_nzvals(); ##-- get/set physically indexed values
2349             $nzvals_phys = $ccs->_nzvals($vals_phys);
2350              
2351             $vals_phys = $ccs->_vals(); ##-- get/set physically indexed values
2352             $vals_phys = $ccs->_vals($vals_phys);
2353              
2354             $bool = $ccs->hasptr($pdimi); ##-- check for cached Harwell-Boeing pointer
2355             ($ptr,$ptrix) = $ccs->ptr($pdimi); ##-- ... get one, caching for later use
2356             ($ptr,$ptrix) = $ccs->getptr($pdimi); ##-- ... compute one, regardless of cache
2357             ($ptr,$ptrix) = $ccs->setptr($pdimi,$p,$pix); ##-- ... set a cached pointer
2358             $ccs->clearptr($pdimi); ##-- ... clear a cached pointer
2359             $ccs->clearptrs(); ##-- ... clear all cached pointers
2360              
2361             $flags = $ccs->flags(); ##-- get/set object-local flags
2362             $flags = $ccs->flags($flags);
2363              
2364             $density = $ccs->density; ##-- get object density
2365             $crate = $ccs->compressionRate; ##-- get compression rate
2366              
2367             =cut
2368              
2369             ##======================================================================
2370             ## Description
2371             ##======================================================================
2372             =pod
2373              
2374             =head1 DESCRIPTION
2375              
2376             PDL::CCS::Nd provides an object-oriented implementation of
2377             sparse N-dimensional vectors & matrices using a set of low-level
2378             PDLs to encode non-missing values.
2379             Currently, only a portion of the PDL API is implemented.
2380              
2381             =cut
2382              
2383             ##======================================================================
2384             ## Globals
2385             ##======================================================================
2386             =pod
2387              
2388             =head1 GLOBALS
2389              
2390             The following package-global variables are defined:
2391              
2392             =cut
2393              
2394             ##--------------------------------------------------------------
2395             ## Globals: Block Sizes
2396             =pod
2397              
2398             =head2 Block Size Constants
2399              
2400             $BINOP_BLOCKSIZE_MIN = 1;
2401             $BINOP_BLOCKSIZE_MAX = 0;
2402              
2403             Minimum (maximum) block size for block-wise incremental computation of binary operations.
2404             Zero or undef indicates no minimum (maximum).
2405              
2406             =cut
2407              
2408             ##--------------------------------------------------------------
2409             ## Globals: Object structure
2410             =pod
2411              
2412             =head2 Object Structure
2413              
2414             PDL::CCS::Nd object are implemented as perl ARRAY-references.
2415             For more intuitive access to object components, the following
2416             package-global variables can be used as array indices to access
2417             internal object structure:
2418              
2419             =over 4
2420              
2421             =item $PDIMS
2422              
2423             Indexes a pdl(long,$NPdims) of physically indexed dimension sizes:
2424              
2425             $ccs->[$PDIMS]->at($pdim_i) == $dimSize_i
2426              
2427             =item $VDIMS
2428              
2429             Indexes a pdl(long,$NVdims) of "virtual" dimension sizes:
2430              
2431             $ccs->[$VDIMS]->at($vdim_i) == / -$vdimSize_i if $vdim_i is a dummy dimension
2432             \ $pdim_i otherwise
2433              
2434             The $VDIMS piddle is used for dimension-shuffling transformations such as xchg()
2435             and reorder(), as well as for dummy().
2436              
2437             =item $WHICH
2438              
2439             Indexes a pdl(long,$NPdims,$Nnz) of the "physical indices" of all non-missing values
2440             in the non-dummy dimensions of the corresponding dense matrix.
2441             Vectors in $WHICH are guaranteed to be sorted in lexicographic order.
2442             If your $missing value is zero, and if your qsortvec() function works,
2443             it should be the case that:
2444              
2445             all( $ccs->[$WHICH] == $dense->whichND->qsortvec )
2446              
2447             A "physically indexed dimension" is just a dimension
2448             corresponding tp a single column of the $WHICH pdl, whereas a dummy dimension does
2449             not correspond to any physically indexed dimension.
2450              
2451             =item $VALS
2452              
2453             Indexes a vector pdl($valType, $Nnz+1) of all values in the sparse matrix,
2454             where $Nnz is the number of non-missing values in the sparse matrix. Non-final
2455             elements of the $VALS piddle are interpreted as the values of the corresponding
2456             indices in the $WHICH piddle:
2457              
2458             all( $ccs->[$VALS]->slice("0:-2") == $dense->indexND($ccs->[$WHICH]) )
2459              
2460             The final element of the $VALS piddle is referred to as "$missing", and
2461             represents the value of all elements of the dense physical matrix whose
2462             indices are not explicitly listed in the $WHICH piddle:
2463              
2464             all( $ccs->[$VALS]->slice("-1") == $dense->flat->index(which(!$dense)) )
2465              
2466             =item $PTRS
2467              
2468             Indexes an array of arrays containing Harwell-Boeing "pointer" piddle pairs
2469             for the corresponding physically indexed dimension.
2470             For a physically indexed dimension $d of size $N, $ccs-E[$PTRS][$d]
2471             (if it exists) is a pair [$ptr,$ptrix] as returned by
2472             PDL::CCS::Utils::ccs_encode_pointers($WHICH,$N), which are such that:
2473              
2474             =over 4
2475              
2476             =item $ptr
2477              
2478             $ptr is a pdl(long,$N+1) containing the offsets in $ptrix corresponding
2479             to the first non-missing value in the dimension $d.
2480             For all $i, 0 E= $i E $N, $ptr($i) contains the
2481             index of the first non-missing value (if any) from column $i of $dense(...,N,...)
2482             encoded in the $WHICH piddle. $ptr($N+1) contains the number of
2483             physically indexed cells in the $WHICH piddle.
2484              
2485             =item $ptrix
2486              
2487             Is an index piddle into dim(1) of $WHICH rsp. dim(0) of $VALS whose key
2488             positions correspond to the offsets listed in $ptr. The point here is
2489             that:
2490              
2491             $WHICH->dice_axis(1,$ptrix)
2492              
2493             is guaranteed to be primarily sorted along the pointer dimension $d, and
2494             stably sorted along all other dimensions, e.g. should be identical to:
2495              
2496             $WHICH->mv($d,0)->qsortvec->mv(0,$d)
2497              
2498             =back
2499              
2500              
2501             =item $FLAGS
2502              
2503             Indexes a perl scalar containing some object-local flags. See
2504             L<"Object Flags"> for details.
2505              
2506             =item $USER
2507              
2508             Indexes the first unused position in the object array.
2509             If you derive a class from PDL::CCS::Nd, you should use this
2510             position to place any new object-local data.
2511              
2512             =back
2513              
2514             =cut
2515              
2516              
2517             ##--------------------------------------------------------------
2518             ## Globals: Object Flags
2519             =pod
2520              
2521             =head2 Object Flags
2522              
2523             The following object-local constants are defined as bitmask flags:
2524              
2525             =over 4
2526              
2527             =item $CCSND_BAD_IS_MISSING
2528              
2529             Bitmask of the "bad-is-missing" flag. See the bad_is_missing() method.
2530              
2531             =item $CCSND_NAN_IS_MISSING
2532              
2533             Bitmask of the "NaN-is-missing" flag. See the nan_is_missing() method.
2534              
2535             =item $CCSND_INPLACE
2536              
2537             Bitmask of the "inplace" flag. See PDL::Core for details.
2538              
2539             =item $CCSND_FLAGS_DEFAULT
2540              
2541             Default flags for new objects.
2542              
2543             =back
2544              
2545             =cut
2546              
2547             ##======================================================================
2548             ## Methods
2549             ##======================================================================
2550             =pod
2551              
2552             =head1 METHODS
2553              
2554             =cut
2555              
2556             ##======================================================================
2557             ## Methods: Constructors etc.
2558             ##======================================================================
2559             =pod
2560              
2561             =head2 Constructors, etc.
2562              
2563             =over 4
2564              
2565             =item $class_or_obj-EnewFromDense($dense,$missing,$flags)
2566              
2567             =for sig
2568              
2569             Signature ($class_or_obj; dense(N1,...,NNdims); missing(); int flags)
2570              
2571             Class method. Create and return a new PDL::CCS::Nd object from a dense N-dimensional
2572             PDL $dense. If specified, $missing is used as the value for "missing" elements,
2573             and $flags are used to initialize the object-local flags.
2574              
2575             $missing defaults to BAD if the bad flag of $dense is set, otherwise
2576             $missing defaults to zero.
2577              
2578              
2579             =item $ccs-EfromDense($dense,$missing,$flags)
2580              
2581             =for sig
2582              
2583             Signature ($ccs; dense(N1,...,NNdims); missing(); int flags)
2584              
2585             Object method. Populate a sparse matrix object from a dense piddle $dense.
2586             See newFromDense().
2587              
2588              
2589             =item $class_or_obj-EnewFromWhich($whichND,$nzvals,%options)
2590              
2591             =for sig
2592              
2593             Signature ($class_or_obj; int whichND(Ndims,Nnz); nzvals(Nnz+1); %options)
2594              
2595             Class method. Create and return a new PDL::CCS::Nd object from a set
2596             of indices $whichND of non-missing elements in a (hypothetical) dense piddle
2597             and a vector $nzvals of the corresponding values. Known %options:
2598              
2599             sorted => $bool, ##-- if true, $whichND is assumed to be pre-sorted
2600             steal => $bool, ##-- if true, $whichND and $nzvals are used literally (formerly implied 'sorted')
2601             ## + in this case, $nzvals should really be: $nzvals->append($missing)
2602             pdims => $pdims, ##-- physical dimension list; default guessed from $whichND (alias: 'dims')
2603             vdims => $vdims, ##-- virtual dims (default: sequence($nPhysDims)); alias: 'xdims'
2604             missing => $missing, ##-- default: BAD if $nzvals->badflag, 0 otherwise
2605             flags => $flags ##-- flags
2606              
2607             =item $ccs-EfromWhich($whichND,$nzvals,%options)
2608              
2609             Object method. Guts for newFromWhich().
2610              
2611              
2612             =item $a-Etoccs($missing,$flags)
2613              
2614             Wrapper for newFromDense(). Return a PDL::CCS::Nd object for any piddle or
2615             perl scalar $a.
2616             If $a is already a PDL::CCS::Nd object, just returns $a.
2617             This method gets exported into the PDL namespace for ease of use.
2618              
2619              
2620             =item $ccs = $ccs-Ecopy()
2621              
2622             Full copy constructor.
2623              
2624             =item $ccs2 = $ccs-EcopyShallow()
2625              
2626             Shallow copy constructor, used e.g. by dimension-shuffling transformations.
2627             Copied components:
2628              
2629             $PDIMS, @$PTRS, @{$PTRS->[*]}, $FLAGS
2630              
2631             Referenced components:
2632              
2633             $VDIMS, $WHICH, $VALS, $PTRS->[*][*]
2634              
2635              
2636             =item $ccs2 = $ccs1-Eshadow(%args)
2637              
2638             Flexible constructor for computed PDL::CCS::Nd objects.
2639             Known %args:
2640              
2641             to => $ccs2, ##-- default: new
2642             pdims => $pdims2, ##-- default: $pdims1->pdl (alias: 'dims')
2643             vdims => $vdims2, ##-- default: $vdims1->pdl (alias: 'xdims')
2644             ptrs => \@ptrs2, ##-- default: []
2645             which => $which2, ##-- default: undef
2646             vals => $vals2, ##-- default: undef
2647             flags => $flags, ##-- default: $flags1
2648              
2649             =back
2650              
2651             =cut
2652              
2653              
2654             ##======================================================================
2655             ## Methods: Maintenance & Decoding
2656             ##======================================================================
2657             =pod
2658              
2659             =head2 Maintenance & Decoding
2660              
2661             =over 4
2662              
2663             =item $ccs = $ccs-Erecode()
2664              
2665             Recodes the PDL::CCS::Nd object, removing any missing values from its $VALS piddle.
2666              
2667             =item $ccs = $ccs-Esortwhich()
2668              
2669             Lexicographically sorts $ccs-E[$WHICH], altering $VALS accordingly.
2670             Clears $PTRS.
2671              
2672              
2673             =item $dense = $ccs-Edecode()
2674              
2675             =item $dense = $ccs-Edecode($dense)
2676              
2677             Decode a PDL::CCS::Nd object to a dense piddle.
2678             Dummy dimensions in $ccs should be created as dummy dimensions in $dense.
2679              
2680             =item $dense = $a-Etodense()
2681              
2682             Ensures that $a is not a PDL::CCS::Nd by wrapping decode().
2683             For PDLs or perl scalars, just returns $a.
2684              
2685             =back
2686              
2687             =cut
2688              
2689             ##======================================================================
2690             ## Methods: PDL API: Basic Properties
2691             ##======================================================================
2692             =pod
2693              
2694             =head2 PDL API: Basic Properties
2695              
2696             The following basic PDL API methods are implemented and/or wrapped
2697             for PDL::CCS::Nd objects:
2698              
2699             =over 4
2700              
2701             =item Type Checking & Conversion
2702              
2703             type, convert, byte, short, ushort, long, double
2704              
2705             Type-checking and conversion routines are passed on to the $VALS sub-piddle.
2706              
2707             =item Dimension Access
2708              
2709             dims, dim, getdim, ndims, getndims, nelem, isnull, isempty
2710              
2711             Note that nelem() returns the number of hypothetically addressable
2712             cells -- the number of cells in the corresponding dense matrix, rather
2713             than the number of non-missing elements actually stored.
2714              
2715             =item Inplace Operations
2716              
2717             set_inplace($bool), is_inplace(), inplace()
2718              
2719             =item Dataflow
2720              
2721             sever
2722              
2723             =item Bad Value Handling
2724              
2725             setnantobad, setbadtonan, setbadtoval, setvaltobad
2726              
2727             See also the bad_is_missing() and nan_is_missing() methods, below.
2728              
2729             =back
2730              
2731             =cut
2732              
2733             ##======================================================================
2734             ## Methods: PDL API: Dimension Shuffling
2735             ##======================================================================
2736             =pod
2737              
2738             =head2 PDL API: Dimension Shuffling
2739              
2740             The following dimension-shuffling methods are supported,
2741             and should be compatible to their PDL counterparts:
2742              
2743             =over 4
2744              
2745             =item dummy($vdimi)
2746              
2747             =item dummy($vdimi, $size)
2748              
2749             Insert a "virtual" dummy dimension of size $size at dimension index $vdimi.
2750              
2751              
2752             =item reorder(@vdim_list)
2753              
2754             Reorder dimensions according to @vdim_list.
2755              
2756             =item xchg($vdim1,$vdim2)
2757              
2758             Exchange two dimensions.
2759              
2760             =item mv($vdimFrom, $vdimTo)
2761              
2762             Move a dimension to another position, shoving remaining
2763             dimensions out of the way to make room.
2764              
2765             =item transpose()
2766              
2767             Always copies, unlike xchg(). Also unlike xchg(), works for 1d row-vectors.
2768              
2769             =back
2770              
2771             =cut
2772              
2773             ##======================================================================
2774             ## Methods: PDL API: Indexing
2775             ##======================================================================
2776             =pod
2777              
2778             =head2 PDL API: Indexing
2779              
2780             =over 4
2781              
2782             =item indexNDi($ndi)
2783              
2784             =for sig
2785              
2786             Signature: ($ccs; int ndi(NVdims,Nind); int [o]nzi(Nind))
2787              
2788             Guts for indexing methods. Given an N-dimensional index piddle $ndi, return
2789             a 1d index vector into $VALS for the corresponding values.
2790             Missing values are returned in $nzi as $Nnz == $ccs-E_nnz_p;
2791              
2792             Uses PDL::VectorValues::vsearchvec() internally, so expect O(Ndims * log(Nnz)) complexity.
2793             Although the theoretical complexity is tough to beat, this method could be
2794             made much faster in the usual (read "sparse") case by an intelligent use of $PTRS if
2795             and when available.
2796              
2797             =item indexND($ndi)
2798              
2799             =item index2d($xi,$yi)
2800              
2801             Should be mostly compatible to the PDL functions of the same names,
2802             but without any boundary handling.
2803              
2804             =item index($flati)
2805              
2806             Implicitly flattens the source pdl.
2807             This ought to be fixed.
2808              
2809             =item dice_axis($axis_v, $axisi)
2810              
2811             Should be compatible with the PDL function of the same name.
2812             Returns a new PDL::CCS::Nd object which should participate
2813             in dataflow.
2814              
2815             =item xindex1d($xi)
2816              
2817             Get non-missing indices for any element of $xi along 0th dimension;
2818             $xi must be sorted in ascending order.
2819              
2820             =item pxindex1d($dimi,$xi)
2821              
2822             Get non-missing indices for any element of $xi along physically indexed dimension $dimi,
2823             using L.
2824             $xi must be sorted in ascending order.
2825              
2826             =item xindex2d($xi,$yi)
2827              
2828             Get non-missing indices for any element in Cartesian product ($xi x $yi) for 2d sparse
2829             matrix.
2830             $xi and $yi must be sorted in ascending order.
2831              
2832             =item xsubset1d($xi)
2833              
2834             Returns a subset object similar to L,
2835             but without renumbering of indices along the diced dimension;
2836             $xi must be sorted in ascending order.
2837              
2838             =item pxsubset1d($dimi,$xi)
2839              
2840             Returns a subset object similar to L,
2841             but without renumbering of indices along the diced dimension;
2842             $xi must be sorted in ascending order.
2843              
2844             =item xsubset2d($xi,$yi)
2845              
2846             Returns a subset object similar to
2847             indexND( $xi-Eslice("*1,")-Ecat($yi)-Eclump(2)-Exchg(0,1) ),
2848             but without renumbering of indices;
2849             $xi and $yi must be sorted in ascending order.
2850              
2851              
2852             =item n2oned($ndi)
2853              
2854             Returns a 1d pseudo-index, used for implementation of which(), etc.
2855              
2856             =item whichND()
2857              
2858             Should behave mostly like the PDL function of the same name.
2859              
2860             Just returns the literal $WHICH piddle if possible: beware of dataflow!
2861             Indices are NOT guaranteed to be returned in any surface-logical order,
2862             although physically indexed dimensions should be sorted in physical-lexicographic
2863             order.
2864              
2865             =item whichVals()
2866              
2867             Returns $VALS indexed to correspond to the indices returned by whichND().
2868             The only reason to use whichND() and whichVals() rather than $WHICH and $VALS
2869             would be a need for physical representations of dummy dimension indices: try
2870             to avoid it if you can.
2871              
2872             =item which()
2873              
2874             As for the builtin PDL function.
2875              
2876              
2877             =item at(@index)
2878              
2879             Return a perl scalar corresponding to the Nd index @index.
2880              
2881             =item set(@index, $value)
2882              
2883             Set a non-missing value at index @index to $value.
2884             barf()s if @index points to a missing value.
2885              
2886             =back
2887              
2888             =cut
2889              
2890             ##======================================================================
2891             ## Methods: Operations: Ufuncs
2892             ##======================================================================
2893             =pod
2894              
2895             =head2 Ufuncs
2896              
2897             The following functions from PDL::Ufunc are implemented, and
2898             ought to handle missing values correctly (i.e. as their dense
2899             counterparts would):
2900              
2901             prodover
2902             prod
2903             dprodover
2904             dprod
2905             sumover
2906             sum
2907             dsumover
2908             dsum
2909             andover
2910             orover
2911             bandover
2912             borover
2913             maximum
2914             maximum_ind ##-- goofy if "missing" value is maximal
2915             max
2916             minimum
2917             minimum_ind ##-- goofy if "missing" value is minimal
2918             min
2919             nbadover
2920             nbad
2921             ngoodover
2922             ngood
2923             nnz
2924             any
2925             all
2926              
2927             Some Ufuncs are still unimplemented. see PDL::CCS::Ufunc for details.
2928              
2929             =cut
2930              
2931             ##======================================================================
2932             ## Methods: Operations: Unary
2933             ##======================================================================
2934             =pod
2935              
2936             =head2 Unary Operations
2937              
2938             The following unary operations are supported:
2939              
2940             FUNCTION OVERLOADS
2941             bitnot ~
2942             not !
2943             sqrt
2944             abs
2945             sin
2946             cos
2947             exp
2948             log
2949             log10
2950              
2951             Note that any pointwise unary operation can be performed directly on
2952             the $VALS piddle. You can wrap such an operation MY_UNARY_OP on piddles
2953             into a PDL::CCS::Nd method using the idiom:
2954              
2955             package PDL::CCS::Nd;
2956             *MY_UNARY_OP = _unary_op('MY_UNARY_OP', PDL->can('MY_UNARY_OP'));
2957              
2958             Note also that unary operations may change the "missing" value associated
2959             with the sparse matrix. This is easily seen to be the Right Way To Do It
2960             if you consider unary "not" over a very sparse (say 99% missing)
2961             binary-valued matrix: is is much easier and more efficient to alter only
2962             the 1% of physically stored (non-missing) values as well as the missing value
2963             than to generate a new matrix with 99% non-missing values, assuming $missing==0.
2964              
2965             =cut
2966              
2967             ##======================================================================
2968             ## Methods: Operations: Binary
2969             ##======================================================================
2970             =pod
2971              
2972             =head2 Binary Operations
2973              
2974             A number of basic binary operations on PDL::CCS::Nd operations are supported,
2975             which will produce correct results only under the assumption that "missing" values
2976             C<$missing> are annihilators for the operation in question. For example, if
2977             we want to compute:
2978              
2979             $c = OP($a,$b)
2980              
2981             for a binary operation OP on PDL::CCS::Nd objects C<$a> and C<$b>, the
2982             current implementation will produce the correct result for $c only if
2983             for all values C<$av> in C<$a> and C<$bv> in C<$b>:
2984              
2985             OP($av,$b->missing) == OP($a->missing,$b->missing) , and
2986             OP($a->missing,$bv) == OP($a->missing,$b->missing)
2987              
2988             This is true in general for OP==\&mult and $missing==0,
2989             but not e.g. for OP==\&plus and $missing==0.
2990             It should always hold for $missing==BAD (except in the case of assignment,
2991             which is a funny kind of operation anyways).
2992              
2993             Currently, the only way to ensure that all values are computed correctly
2994             in the general case is for $a and $b to contain exactly the same physically
2995             indexed values, which rather defeats the purposes of sparse storage,
2996             particularly if implicit pseudo-threading is involved (because then we would
2997             likely wind up instantiating -- or at least inspecting -- the entire dense
2998             matrix). Future implementations may relax these restrictions somewhat.
2999              
3000             The following binary operations are implemented:
3001              
3002             =over 4
3003              
3004             =item Arithmetic Operations
3005              
3006             FUNCTION OVERLOADS
3007             plus +
3008             minus -
3009             mult *
3010             divide /
3011             modulo %
3012             power **
3013              
3014             =item Comparisons
3015              
3016             FUNCTION OVERLOADS
3017             gt >
3018             ge >=
3019             lt <
3020             le <=
3021             eq ==
3022             ne !=
3023             spaceship <=>
3024              
3025             =item Bitwise Operations
3026              
3027             FUNCTION OVERLOADS
3028             and2 &
3029             or2 |
3030             xor ^
3031             shiftleft <<
3032             shiftright >>
3033              
3034             =item Matrix Operations
3035              
3036             FUNCTION OVERLOADS
3037             inner (none)
3038             matmult x
3039              
3040             =item Other Operations
3041              
3042             FUNCTION OVERLOADS
3043             rassgn .=
3044             string ""
3045              
3046             =back
3047              
3048             All supported binary operation functions obey the PDL input calling conventions
3049             (i.e. they all accept a third argument C<$swap>), and delegate computation
3050             to the underlying PDL functions. Note that the PDL::CCS::Nd methods currently
3051             do B support a third "output" argument.
3052             To wrap a new binary operation MY_BINOP into
3053             a PDL::CCS::Nd method, you can use the following idiom:
3054              
3055             package PDL::CCS::Nd;
3056             *MY_BINOP = _ccsnd_binary_op_mia('MY_BINOP', PDL->can('MY_BINOP'));
3057              
3058             The low-level alignment of physically indexed values
3059             for binary operations is performed by the
3060             function PDL::CCS::ccs_binop_align_block_mia().
3061             Computation is performed block-wise at the perl level to avoid
3062             over- rsp. underflow of the space requirements for the output PDL.
3063              
3064             =cut
3065              
3066              
3067             ##======================================================================
3068             ## Methods: Low-Level Object Access
3069             ##======================================================================
3070             =pod
3071              
3072             =head2 Low-Level Object Access
3073              
3074             The following methods provide low-level access to
3075             PDL::CCS::Nd object structure:
3076              
3077             =over 4
3078              
3079             =item insertWhich
3080              
3081             =for sig
3082              
3083             Signature: ($ccs; int whichND(Ndims,Nnz1); vals(Nnz1))
3084              
3085             Set or insert values in C<$ccs> for the indices in C<$whichND> to C<$vals>.
3086             C<$whichND> need not be sorted.
3087             Implicitly makes C<$ccs> physically indexed.
3088             Returns the (destructively altered) C<$ccs>.
3089              
3090              
3091             =item appendWhich
3092              
3093             =for sig
3094              
3095             Signature: ($ccs; int whichND(Ndims,Nnz1); vals(Nnz1))
3096              
3097             Like insertWhich(), but assumes that no values for any of the $whichND
3098             indices are already present in C<$ccs>. This is faster (because indexNDi
3099             need not be called), but less safe.
3100              
3101              
3102             =item is_physically_indexed()
3103              
3104             Returns true iff only physical dimensions are present.
3105              
3106             =item to_physically_indexed()
3107              
3108             Just returns the calling object if all non-missing elements are already physically indexed.
3109             Otherwise, returns a new PDL::CCS::Nd object identical to the caller
3110             except that all non-missing elements are physically indexed. This may gobble a large
3111             amount of memory if the calling element has large dummy dimensions.
3112             Also ensures that physical dimension order is identical to logical dimension order.
3113              
3114             =item make_physically_indexed
3115              
3116             Wrapper for to_physically_indexed() which eliminates dummy dimensions
3117             destructively in the calling object.
3118              
3119             Alias: make_physical().
3120              
3121              
3122             =item pdims()
3123              
3124             Returns the $PDIMS piddle. See L<"Object Structure">, above.
3125              
3126             =item vdims()
3127              
3128             Returns the $VDIMS piddle. See L<"Object Structure">, above.
3129              
3130              
3131             =item setdims_p(@dims)
3132              
3133             Sets $PDIMS piddle. See L<"Object Structure">, above.
3134             Returns the calling object.
3135             Alias: setdims().
3136              
3137             =item nelem_p()
3138              
3139             Returns the number of physically addressable elements.
3140              
3141             =item nelem_v()
3142              
3143             Returns the number of virtually addressable elements.
3144             Alias for nelem().
3145              
3146              
3147             =item _ccs_nvperp()
3148              
3149             Returns number of virtually addressable elements per physically
3150             addressable element, which should be a positive integer.
3151              
3152              
3153             =item nstored_p()
3154              
3155             Returns actual number of physically addressed stored elements
3156             (aka $Nnz aka $WHICH-Edim(1)).
3157              
3158             =item nstored_v()
3159              
3160             Returns actual number of physically+virtually addressed stored elements.
3161              
3162              
3163             =item nmissing_p()
3164              
3165             Returns number of physically addressable elements minus the number of
3166             physically stored elements.
3167              
3168             =item nmissing_v()
3169              
3170             Returns number of physically+virtually addressable elements minus the number of
3171             physically+virtually stored elements.
3172              
3173              
3174             =item allmissing()
3175              
3176             Returns true iff no non-missing values are stored.
3177              
3178              
3179             =item missing()
3180              
3181             =item missing($missing)
3182              
3183             Get/set the value to use for missing elements.
3184             Returns the (new) value for $missing.
3185              
3186              
3187             =item _whichND()
3188              
3189             =item _whichND($whichND)
3190              
3191             Get/set the underlying $WHICH piddle.
3192              
3193              
3194             =item _nzvals()
3195              
3196             =item _nzvals($storedvals)
3197              
3198             Get/set the slice of the underlying $VALS piddle corresponding for non-missing values only.
3199             Alias: whichVals().
3200              
3201              
3202             =item _vals()
3203              
3204             =item _vals($storedvals)
3205              
3206             Get/set the underlying $VALS piddle.
3207              
3208             =item hasptr($pdimi)
3209              
3210             Returns true iff a pointer for physical dim $pdimi is cached.
3211              
3212             =item ptr($pdimi)
3213              
3214             Get a pointer pair for a physically indexed dimension $pdimi.
3215             Uses cached piddles in $PTRS if present, computes & caches otherwise.
3216              
3217             $pdimi defaults to zero. If $pdimi is zero, then it should hold that:
3218              
3219             all( $pi2nzi==sequence($ccs->nstored_p) )
3220              
3221             =item getptr($pdimi)
3222              
3223             Guts for ptr(). Does not check $PTRS and does not cache anything.
3224              
3225             =item clearptr($pdimi)
3226              
3227             Clears any cached Harwell-Boeing pointers for physically indexed dimension $pdimi.
3228              
3229             =item clearptrs()
3230              
3231             Clears any cached Harwell-Boeing pointers.
3232              
3233             =item flags()
3234              
3235             =item flags($flags)
3236              
3237             Get/set object-local $FLAGS.
3238              
3239              
3240             =item bad_is_missing()
3241              
3242             =item bad_is_missing($bool)
3243              
3244             Get/set the value of the object-local "bad-is-missing" flag.
3245             If this flag is set, BAD values in $VALS are considered "missing",
3246             regardless of the current value of $missing.
3247              
3248             =item badmissing()
3249              
3250             Sets the "bad-is-missing" flag and returns the calling object.
3251              
3252             =item nan_is_missing()
3253              
3254             =item nan_is_missing($bool)
3255              
3256             Get/set the value of the object-local "NaN-is-missing" flag.
3257             If this flag is set, NaN (and +inf, -inf) values in $VALS are considered "missing",
3258             regardless of the current value of $missing.
3259              
3260             =item nanmissing()
3261              
3262             Sets the "nan-is-missing" flag and returns the calling object.
3263              
3264             =back
3265              
3266             =cut
3267              
3268             ##======================================================================
3269             ## Methods: General Information
3270             ##======================================================================
3271             =pod
3272              
3273             =head2 General Information
3274              
3275             =over 4
3276              
3277             =item density()
3278              
3279             Returns the number of non-missing values divided by the number
3280             of indexable values in the sparse object as a perl scalar.
3281              
3282             =item compressionRate()
3283              
3284             Returns the compression rate of the PDL::CCS::Nd object
3285             compared to a dense piddle of the physically indexable dimensions.
3286             Higher values indicate better compression (e.g. lower density).
3287             Negative values indicate that dense storage would be more
3288             memory-efficient. Pointers are not included in the computation
3289             of the compression rate.
3290              
3291             =back
3292              
3293             =cut
3294              
3295             ##======================================================================
3296             ## Footer Administrivia
3297             ##======================================================================
3298              
3299             ##---------------------------------------------------------------------
3300             =pod
3301              
3302             =head1 ACKNOWLEDGEMENTS
3303              
3304             Perl by Larry Wall.
3305              
3306             PDL by Karl Glazebrook, Tuomas J. Lukka, Christian Soeller, and others.
3307              
3308             =cut
3309              
3310             ##----------------------------------------------------------------------
3311             =pod
3312              
3313             =head1 KNOWN BUGS
3314              
3315             Many.
3316              
3317             =cut
3318              
3319              
3320             ##---------------------------------------------------------------------
3321             =pod
3322              
3323             =head1 AUTHOR
3324              
3325             Bryan Jurish Emoocow@cpan.orgE
3326              
3327             =head2 Copyright Policy
3328              
3329             Copyright (C) 2007-2024, Bryan Jurish. All rights reserved.
3330              
3331             This package is free software, and entirely without warranty.
3332             You may redistribute it and/or modify it under the same terms
3333             as Perl itself.
3334              
3335             =head1 SEE ALSO
3336              
3337             perl(1),
3338             PDL(3perl),
3339             PDL::SVDLIBC(3perl),
3340             PDL::CCS::Nd(3perl),
3341              
3342             SVDLIBC: http://tedlab.mit.edu/~dr/SVDLIBC/
3343              
3344             SVDPACKC: http://www.netlib.org/svdpack/
3345              
3346             =cut