File Coverage

blib/lib/PDL/VectorValued.pm
Criterion Covered Total %
statement 29 36 80.5
branch 4 14 28.5
condition 0 9 0.0
subroutine 7 8 87.5
pod 4 4 100.0
total 44 71 61.9


line stmt bran cond sub pod time code
1             ## $Id: VectorValued.pm 9576 2018-05-15 06:59:23Z moocow $
2             ##
3             ## File: PDL::VectorValued.pm
4             ## Author: Bryan Jurish
5             ## Description: Vector utilities for PDL: perl side only
6             ##======================================================================
7              
8             package PDL::VectorValued;
9 6     6   1995750 use strict;
  6         34  
  6         209  
10              
11             ##======================================================================
12             ## Export hacks
13 6     6   39 use PDL;
  6         15  
  6         32  
14 6     6   18371 use PDL::Exporter;
  6         15  
  6         35  
15 6     6   3358 use PDL::VectorValued::Utils;
  6         23  
  6         45  
16             our @ISA = qw(PDL::Exporter);
17             our @EXPORT_OK =
18             (
19             (@PDL::VectorValued::Utils::EXPORT_OK), ##-- inherited
20             qw(vv_uniqvec),
21             qw(rleND rldND),
22             qw(vv_indx),
23             );
24             our %EXPORT_TAGS =
25             (
26             Func => [@EXPORT_OK], ##-- respect PDL conventions (hopefully)
27             );
28              
29             ## VERSION was formerly set by PDL::VectorValued::Version, now use perl-reversion from Perl::Version instead
30             our $VERSION = '1.0.8';
31              
32             ##======================================================================
33             ## pod: header
34             =pod
35              
36             =head1 NAME
37              
38             PDL::VectorValued - Utilities for vector-valued PDLs
39              
40             =head1 SYNOPSIS
41              
42             use PDL;
43             use PDL::VectorValued;
44              
45             ##---------------------------------------------------------------------
46             ## ... stuff happens
47              
48             =cut
49              
50             ##======================================================================
51             ## Description
52             =pod
53              
54             =head1 DESCRIPTION
55              
56             PDL::VectorValued provides generalizations of some elementary PDL
57             functions to higher-order PDLs which treat vectors as "data values".
58              
59             =cut
60              
61             ##======================================================================
62             ## pod: Functions
63             =pod
64              
65             =head1 FUNCTIONS
66              
67             =cut
68              
69             ##----------------------------------------------------------------------
70             ## vv_uniqvec
71              
72             =pod
73              
74             =head2 vv_uniqvec
75              
76             =for sig
77              
78             Signature: (v(N,M); [o]vu(N,MU))
79              
80             =for ref
81              
82             Drop-in replacement for broken uniqvec() which uses vv_qsortvec().
83             Otherwise copied from PDL::Primitive::primitive.pd.
84              
85             See also: PDL::VectorValued::Utils::vv_qsortvec, PDL::Primitive::uniqvec.
86              
87             =cut
88              
89             *PDL::vv_uniqvec = \&vv_uniqvec;
90             sub vv_uniqvec {
91 0     0 1 0 my($pdl) = shift;
92              
93             # slice is not cheap but uniqvec isn't either -- shouldn't cost too much.
94 0 0 0     0 return $pdl if($pdl->nelem == 0 || $pdl->ndims <2 || $pdl->slice("(0)")->nelem < 2);
      0        
95              
96 0         0 my $srt = $pdl->mv(0,-1)->
97             clump($pdl->ndims - 1)->
98             mv(-1,0)->vv_qsortvec-> ##-- moo: Tue, 24 Apr 2007 17:17:39 +0200: use vv_qsortvec
99             mv(0,-1);
100              
101 0 0 0     0 $srt=$srt->dice($srt->mv(0,-1)->ngoodover->which) if ($PDL::Bad::Status && $srt->badflag);
102             ##use dice instead of nslice since qsortvec might be packing the badvals to the front of
103             #the array instead of the end like the docs say. If that is the case and it gets fixed,
104             #it won't bust uniqvec. DAL 14-March 2006
105 0         0 my $uniq = ($srt != $srt->rotate(-1)) -> mv(0,-1) -> orover->which;
106              
107 0 0       0 return $uniq->nelem==0 ?
108             $srt->slice("0,:")->mv(0,-1) :
109             $srt->dice($uniq)->mv(0,-1);
110             }
111              
112              
113             ##======================================================================
114             ## Run-Length Encoding/Decoding: n-dimensionl
115             =pod
116              
117             =head1 Higher-Order Run-Length Encoding and Decoding
118              
119             The following functions generalize the builtin PDL functions rle() and rld()
120             for higher-order "values".
121              
122             See also:
123             PDL::VectorValued::Utils::rlevec(), PDL::VectorValued::Utils::rldvec().
124              
125             =cut
126              
127             ##----------------------------------------------------------------------
128             ## rleND()
129             =pod
130              
131             =head2 rleND
132              
133             =for sig
134              
135             Signature: (data(@vdims,N); int [o]counts(N); [o]elts(@vdims,N))
136              
137             =for ref
138              
139             Run-length encode a set of (sorted) n-dimensional values.
140              
141             Generalization of rle() and rlevec():
142             given set of values $data, generate a vector $counts with the number of occurrences of each element
143             (where an "element" is a matrix of dimensions @vdims ocurring as a sequential run over the
144             final dimension in $data), and a set of vectors $elts containing the elements which begin a run.
145             Really just a wrapper for clump() and rlevec().
146              
147             See also: PDL::Slices::rle, PDL::Ngrams::VectorValued::Utils::rlevec.
148              
149             =cut
150              
151             *PDL::rleND = \&rleND;
152             sub rleND {
153 2     2 1 4127 my $data = shift;
154 2         10 my @vdimsN = $data->dims;
155              
156             ##-- construct output pdls
157 2 50       66 my $counts = $#_ >= 0 ? $_[0] : zeroes(long, $vdimsN[$#vdimsN]);
158 2 50       171 my $elts = $#_ >= 1 ? $_[1] : zeroes($data->type, @vdimsN);
159              
160             ##-- guts: call rlevec()
161 2         206 rlevec($data->clump($#vdimsN), $counts, $elts->clump($#vdimsN));
162              
163 2         91 return ($counts,$elts);
164             }
165              
166             ##----------------------------------------------------------------------
167             ## rldND()
168             =pod
169              
170             =head2 rldND
171              
172             =for sig
173              
174             Signature: (int counts(N); elts(@vdims,N); [o]data(@vdims,N);)
175              
176             =for ref
177              
178             Run-length decode a set of (sorted) n-dimensional values.
179              
180             Generalization of rld() and rldvec():
181             given a vector $counts() of the number of occurrences of each @vdims-dimensioned element,
182             and a set $elts() of @vdims-dimensioned elements, run-length decode to $data().
183              
184             Really just a wrapper for clump() and rldvec().
185              
186             See also: PDL::Slices::rld, PDL::VectorValued::Utils::rldvec
187              
188             =cut
189              
190             *PDL::rldND = \&rldND;
191             sub rldND {
192 2     2 1 2933 my ($counts,$elts) = (shift,shift);
193 2         9 my @vdimsN = $elts->dims;
194              
195             ##-- construct output pdl
196 2         60 my ($data);
197 2 50       7 if ($#_ >= 0) { $data = $_[0]; }
  0         0  
198             else {
199 2         31 my $size = $counts->sumover->max; ##-- get maximum size for Nth-dimension for small encodings
200 2         116 my @countdims = $counts->dims;
201 2         48 shift(@countdims);
202 2         7 $data = zeroes($elts->type, @vdimsN, @countdims);
203             }
204              
205             ##-- guts: call rldvec()
206 2         221 rldvec($counts, $elts->clump($#vdimsN), $data->clump($#vdimsN));
207              
208 2         17 return $data;
209             }
210              
211             ##======================================================================
212             ## pod: Functions: datatype utilities
213             =pod
214              
215             =head1 Datatype Utilities
216              
217             =cut
218              
219             ##----------------------------------------------------------------------
220             ## vv_indx()
221             =pod
222              
223             =head2 vv_indx
224              
225             =for sig
226              
227             Signature: vv_indx()
228              
229             =for ref
230              
231             Returns PDL::Type subclass used for indices.
232             If built with PDL E v2.007, this should return C, otherwise C.
233              
234             =cut
235              
236             sub vv_indx {
237 2 50   2 1 749 return defined(&PDL::indx) ? PDL::indx(@_) : PDL::long(@_);
238             }
239              
240             1; ##-- make perl happy
241              
242              
243             ##======================================================================
244             ## pod: Functions: low-level
245             =pod
246              
247             =head2 Low-Level Functions
248              
249             Some additional low-level functions are provided in the
250             PDL::VectorValued::Utils
251             package.
252             See L for details.
253              
254             =cut
255              
256              
257              
258             ##======================================================================
259             ## pod: Footer
260             =pod
261              
262             =head1 ACKNOWLEDGEMENTS
263              
264             perl by Larry Wall.
265              
266             =head1 AUTHOR
267              
268             Bryan Jurish Emoocow@cpan.orgE
269              
270             PDL by Karl Glazebrook, Tuomas J. Lukka, Christian Soeller, and others.
271              
272             =head1 COPYRIGHT
273              
274             Copyright (c) 2007, Bryan Jurish. All rights reserved.
275              
276             This package is free software. You may redistribute it
277             and/or modify it under the same terms as Perl itself.
278              
279             =head1 SEE ALSO
280              
281             perl(1), PDL(3perl), PDL::VectorValued::Utils(3perl)
282              
283             =cut