File Coverage

blib/lib/PDL/Primitive.pm
Criterion Covered Total %
statement 9 9 100.0
branch n/a
condition n/a
subroutine 3 3 100.0
pod n/a
total 12 12 100.0


line stmt bran cond sub pod time code
1             #
2             # GENERATED WITH PDL::PP from lib/PDL/Primitive.pd! Don't modify!
3             #
4             package PDL::Primitive;
5              
6             our @EXPORT_OK = qw(inner outer matmult innerwt inner2 inner2d inner2t crossp norm indadd conv1d in uniq uniqind uniqvec hclip lclip clip wtstat statsover stats histogram whistogram histogram2d whistogram2d fibonacci append axisvalues cmpvec eqvec enumvec enumvecg vsearchvec unionvec intersectvec setdiffvec union_sorted intersect_sorted setdiff_sorted vcos srandom random randsym grandom vsearch vsearch_sample vsearch_insert_leftmost vsearch_insert_rightmost vsearch_match vsearch_bin_inclusive vsearch_bin_exclusive interpolate interpol interpND one2nd which which_both whichover approx_artol where where_both whereND whereND_both whichND whichND_both setops intersect pchip_chim pchip_chic pchip_chsp pchip_chfd pchip_chfe pchip_chia pchip_chid pchip_chbs pchip_bvalu );
7             our %EXPORT_TAGS = (Func=>\@EXPORT_OK);
8              
9 70     70   500 use PDL::Core;
  70         141  
  70         543  
10 70     70   519 use PDL::Exporter;
  70         168  
  70         440  
11 70     70   363 use DynaLoader;
  70         175  
  70         17154  
12              
13              
14            
15             our @ISA = ( 'PDL::Exporter','DynaLoader' );
16             push @PDL::Core::PP, __PACKAGE__;
17             bootstrap PDL::Primitive ;
18              
19             { package # hide from MetaCPAN
20             PDL;
21              
22             #line 1440 "lib/PDL/PP.pm"
23             {
24             my ($foo, $overload_sub);
25             use overload 'x' => $overload_sub = sub {
26             Carp::confess("PDL::matmult: overloaded 'x' given undef")
27             if grep !defined, @_[0,1];
28             return PDL::matmult(@_) unless ref $_[1]
29             && (ref $_[1] ne 'PDL')
30             && defined($foo = overload::Method($_[1], 'x'))
31             && $foo != $overload_sub; # recursion guard
32             goto &$foo;
33             };
34             }
35             #line 36 "lib/PDL/Primitive.pm"
36             }
37              
38              
39              
40              
41              
42              
43              
44             #line 12 "lib/PDL/Primitive.pd"
45              
46             use strict;
47             use warnings;
48             use PDL::Slices;
49             use Carp;
50              
51             =head1 NAME
52              
53             PDL::Primitive - primitive operations for pdl
54              
55             =head1 DESCRIPTION
56              
57             This module provides some primitive and useful functions defined
58             using PDL::PP and able to use the new indexing tricks.
59              
60             See L for how to use indices creatively.
61             For explanation of the signature format, see L.
62              
63             =head1 SYNOPSIS
64              
65             # Pulls in PDL::Primitive, among other modules.
66             use PDL;
67              
68             # Only pull in PDL::Primitive:
69             use PDL::Primitive;
70              
71             =cut
72             #line 73 "lib/PDL/Primitive.pm"
73              
74              
75             =head1 FUNCTIONS
76              
77             =cut
78              
79              
80              
81              
82              
83              
84             =head2 inner
85              
86             =for sig
87              
88             Signature: (a(n); b(n); [o]c())
89             Types: (sbyte byte short ushort long ulong indx ulonglong longlong
90             float double ldouble cfloat cdouble cldouble)
91              
92             =for usage
93              
94             $c = inner($a, $b);
95             inner($a, $b, $c); # all arguments given
96             $c = $a->inner($b); # method call
97             $a->inner($b, $c);
98              
99             =for ref
100              
101             Inner product over one dimension
102              
103             c = sum_i a_i * b_i
104              
105             See also L, L.
106              
107             =pod
108              
109             Broadcasts over its inputs.
110              
111             =for bad
112              
113             If C contains only bad data,
114             C is set bad. Otherwise C will have its bad flag cleared,
115             as it will not contain any bad values.
116              
117             =cut
118              
119              
120              
121              
122             *inner = \&PDL::inner;
123              
124              
125              
126              
127              
128              
129             =head2 outer
130              
131             =for sig
132              
133             Signature: (a(n); b(m); [o]c(n,m))
134             Types: (sbyte byte short ushort long ulong indx ulonglong longlong
135             float double ldouble cfloat cdouble cldouble)
136              
137             =for usage
138              
139             $c = outer($a, $b);
140             outer($a, $b, $c); # all arguments given
141             $c = $a->outer($b); # method call
142             $a->outer($b, $c);
143              
144             =for ref
145              
146             outer product over one dimension
147              
148             Naturally, it is possible to achieve the effects of outer
149             product simply by broadcasting over the "C<*>"
150             operator but this function is provided for convenience.
151              
152             =pod
153              
154             Broadcasts over its inputs.
155              
156             =for bad
157              
158             C processes bad values.
159             It will set the bad-value flag of all output ndarrays if the flag is set for any of the input ndarrays.
160              
161             =cut
162              
163              
164              
165              
166             *outer = \&PDL::outer;
167              
168              
169              
170              
171              
172             #line 98 "lib/PDL/Primitive.pd"
173              
174             =head2 x
175              
176             =for sig
177              
178             Signature: (a(i,z), b(x,i),[o]c(x,z))
179              
180             =for ref
181              
182             Matrix multiplication
183              
184             PDL overloads the C operator (normally the repeat operator) for
185             matrix multiplication. The number of columns (size of the 0
186             dimension) in the left-hand argument must normally equal the number of
187             rows (size of the 1 dimension) in the right-hand argument.
188              
189             Row vectors are represented as (N x 1) two-dimensional PDLs, or you
190             may be sloppy and use a one-dimensional PDL. Column vectors are
191             represented as (1 x N) two-dimensional PDLs.
192              
193             Broadcasting occurs in the usual way, but as both the 0 and 1 dimension
194             (if present) are included in the operation, you must be sure that
195             you don't try to broadcast over either of those dims.
196              
197             Of note, due to how Perl v5.14.0 and above implement operator overloading of
198             the C operator, the use of parentheses for the left operand creates a list
199             context, that is
200              
201             pdl> ( $x * $y ) x $z
202             ERROR: Argument "..." isn't numeric in repeat (x) ...
203              
204             treats C<$z> as a numeric count for the list repeat operation and does not call
205             the scalar form of the overloaded operator. To use the operator in this case,
206             use a scalar context:
207              
208             pdl> scalar( $x * $y ) x $z
209              
210             or by calling L directly:
211              
212             pdl> ( $x * $y )->matmult( $z )
213              
214             EXAMPLES
215              
216             Here are some simple ways to define vectors and matrices:
217              
218             pdl> $r = pdl(1,2); # A row vector
219             pdl> $c = pdl([[3],[4]]); # A column vector
220             pdl> $c = pdl(3,4)->(*1); # A column vector, using NiceSlice
221             pdl> $m = pdl([[1,2],[3,4]]); # A 2x2 matrix
222              
223             Now that we have a few objects prepared, here is how to
224             matrix-multiply them:
225              
226             pdl> print $r x $m # row x matrix = row
227             [
228             [ 7 10]
229             ]
230              
231             pdl> print $m x $r # matrix x row = ERROR
232             PDL: Dim mismatch in matmult of [2x2] x [2x1]: 2 != 1
233              
234             pdl> print $m x $c # matrix x column = column
235             [
236             [ 5]
237             [11]
238             ]
239              
240             pdl> print $m x 2 # Trivial case: scalar mult.
241             [
242             [2 4]
243             [6 8]
244             ]
245              
246             pdl> print $r x $c # row x column = scalar
247             [
248             [11]
249             ]
250              
251             pdl> print $c x $r # column x row = matrix
252             [
253             [3 6]
254             [4 8]
255             ]
256              
257             INTERNALS
258              
259             The mechanics of the multiplication are carried out by the
260             L method.
261              
262             =cut
263             #line 264 "lib/PDL/Primitive.pm"
264              
265              
266             =head2 matmult
267              
268             =for sig
269              
270             Signature: (a(t,h); b(w,t); [o]c(w,h))
271             Types: (sbyte byte short ushort long ulong indx ulonglong longlong
272             float double ldouble cfloat cdouble cldouble)
273              
274             =for usage
275              
276             $c = x $a, $b; # overloads the Perl 'x' operator
277             $c = matmult($a, $b);
278             matmult($a, $b, $c); # all arguments given
279             $c = $a->matmult($b); # method call
280             $a->matmult($b, $c);
281              
282             =for ref
283              
284             Matrix multiplication
285              
286             Notionally, matrix multiplication $x x $y is equivalent to the
287             broadcasting expression
288              
289             $x->dummy(1)->inner($y->xchg(0,1)->dummy(2),$c);
290              
291             but for large matrices that breaks CPU cache and is slow. Instead,
292             matmult calculates its result in 32x32x32 tiles, to keep the memory
293             footprint within cache as long as possible on most modern CPUs.
294              
295             For usage, see L, a description of the overloaded 'x' operator
296              
297             =pod
298              
299             Broadcasts over its inputs.
300              
301             =for bad
302              
303             C processes bad values.
304             It will set the bad-value flag of all output ndarrays if the flag is set for any of the input ndarrays.
305              
306             =cut
307              
308              
309              
310              
311              
312             #line 197 "lib/PDL/Primitive.pd"
313             sub PDL::matmult {
314             my ($x,$y,$c) = @_;
315             $y = PDL->topdl($y);
316             $c = PDL->null if !UNIVERSAL::isa($c, 'PDL');
317             while($x->getndims < 2) {$x = $x->dummy(-1)}
318             while($y->getndims < 2) {$y = $y->dummy(-1)}
319             return ($c .= $x * $y) if( ($x->dim(0)==1 && $x->dim(1)==1) ||
320             ($y->dim(0)==1 && $y->dim(1)==1) );
321             barf sprintf 'Dim mismatch in matmult of [%1$dx%2$d] x [%3$dx%4$d]: %1$d != %4$d',$x->dim(0),$x->dim(1),$y->dim(0),$y->dim(1)
322             if $y->dim(1) != $x->dim(0);
323             PDL::_matmult_int($x,$y,$c);
324             $c;
325             }
326             #line 327 "lib/PDL/Primitive.pm"
327              
328             *matmult = \&PDL::matmult;
329              
330              
331              
332              
333              
334              
335             =head2 innerwt
336              
337             =for sig
338              
339             Signature: (a(n); b(n); c(n); [o]d())
340             Types: (sbyte byte short ushort long ulong indx ulonglong longlong
341             float double ldouble cfloat cdouble cldouble)
342              
343             =for usage
344              
345             $d = innerwt($a, $b, $c);
346             innerwt($a, $b, $c, $d); # all arguments given
347             $d = $a->innerwt($b, $c); # method call
348             $a->innerwt($b, $c, $d);
349              
350             =for ref
351              
352             Weighted (i.e. triple) inner product
353              
354             d = sum_i a(i) b(i) c(i)
355              
356             =pod
357              
358             Broadcasts over its inputs.
359              
360             =for bad
361              
362             C processes bad values.
363             It will set the bad-value flag of all output ndarrays if the flag is set for any of the input ndarrays.
364              
365             =cut
366              
367              
368              
369              
370             *innerwt = \&PDL::innerwt;
371              
372              
373              
374              
375              
376              
377             =head2 inner2
378              
379             =for sig
380              
381             Signature: (a(n); b(n,m); c(m); [o]d())
382             Types: (sbyte byte short ushort long ulong indx ulonglong longlong
383             float double ldouble cfloat cdouble cldouble)
384              
385             =for usage
386              
387             $d = inner2($a, $b, $c);
388             inner2($a, $b, $c, $d); # all arguments given
389             $d = $a->inner2($b, $c); # method call
390             $a->inner2($b, $c, $d);
391              
392             =for ref
393              
394             Inner product of two vectors and a matrix
395              
396             d = sum_ij a(i) b(i,j) c(j)
397              
398             Note that you should probably not broadcast over C and C since that would be
399             very wasteful. Instead, you should use a temporary for C.
400              
401             =pod
402              
403             Broadcasts over its inputs.
404              
405             =for bad
406              
407             C processes bad values.
408             It will set the bad-value flag of all output ndarrays if the flag is set for any of the input ndarrays.
409              
410             =cut
411              
412              
413              
414              
415             *inner2 = \&PDL::inner2;
416              
417              
418              
419              
420              
421              
422             =head2 inner2d
423              
424             =for sig
425              
426             Signature: (a(n,m); b(n,m); [o]c())
427             Types: (sbyte byte short ushort long ulong indx ulonglong longlong
428             float double ldouble cfloat cdouble cldouble)
429              
430             =for usage
431              
432             $c = inner2d($a, $b);
433             inner2d($a, $b, $c); # all arguments given
434             $c = $a->inner2d($b); # method call
435             $a->inner2d($b, $c);
436              
437             =for ref
438              
439             Inner product over 2 dimensions.
440              
441             Equivalent to
442              
443             $c = inner($x->clump(2), $y->clump(2))
444              
445             =pod
446              
447             Broadcasts over its inputs.
448              
449             =for bad
450              
451             C processes bad values.
452             It will set the bad-value flag of all output ndarrays if the flag is set for any of the input ndarrays.
453              
454             =cut
455              
456              
457              
458              
459             *inner2d = \&PDL::inner2d;
460              
461              
462              
463              
464              
465              
466             =head2 inner2t
467              
468             =for sig
469              
470             Signature: (a(j,n); b(n,m); c(m,k); [t]tmp(n,k); [o]d(j,k))
471             Types: (sbyte byte short ushort long ulong indx ulonglong longlong
472             float double ldouble cfloat cdouble cldouble)
473              
474             =for usage
475              
476             $d = inner2t($a, $b, $c);
477             inner2t($a, $b, $c, $d); # all arguments given
478             $d = $a->inner2t($b, $c); # method call
479             $a->inner2t($b, $c, $d);
480              
481             =for ref
482              
483             Efficient Triple matrix product C
484              
485             Efficiency comes from by using the temporary C. This operation only
486             scales as C whereas broadcasting using L would scale
487             as C.
488              
489             The reason for having this routine is that you do not need to
490             have the same broadcast-dimensions for C as for the other arguments,
491             which in case of large numbers of matrices makes this much more
492             memory-efficient.
493              
494             It is hoped that things like this could be taken care of as a kind of
495             closure at some point.
496              
497             =pod
498              
499             Broadcasts over its inputs.
500              
501             =for bad
502              
503             C processes bad values.
504             It will set the bad-value flag of all output ndarrays if the flag is set for any of the input ndarrays.
505              
506             =cut
507              
508              
509              
510              
511             *inner2t = \&PDL::inner2t;
512              
513              
514              
515              
516              
517              
518             =head2 crossp
519              
520             =for sig
521              
522             Signature: (a(tri=3); b(tri); [o] c(tri))
523             Types: (sbyte byte short ushort long ulong indx ulonglong longlong
524             float double ldouble cfloat cdouble cldouble)
525              
526             =for usage
527              
528             $c = crossp($a, $b);
529             crossp($a, $b, $c); # all arguments given
530             $c = $a->crossp($b); # method call
531             $a->crossp($b, $c);
532              
533             =for ref
534              
535             Cross product of two 3D vectors
536              
537             After
538              
539             =for example
540              
541             $c = crossp $x, $y
542              
543             the inner product C<$c*$x> and C<$c*$y> will be zero, i.e. C<$c> is
544             orthogonal to C<$x> and C<$y>
545              
546             =pod
547              
548             Broadcasts over its inputs.
549              
550             =for bad
551              
552             C does not process bad values.
553             It will set the bad-value flag of all output ndarrays if the flag is set for any of the input ndarrays.
554              
555             =cut
556              
557              
558              
559              
560             *crossp = \&PDL::crossp;
561              
562              
563              
564              
565              
566              
567             =head2 norm
568              
569             =for sig
570              
571             Signature: (vec(n); [o] norm(n))
572             Types: (sbyte byte short ushort long ulong indx ulonglong longlong
573             float double ldouble cfloat cdouble cldouble)
574              
575             =for usage
576              
577             $norm = norm($vec);
578             norm($vec, $norm); # all arguments given
579             $norm = $vec->norm; # method call
580             $vec->norm($norm);
581              
582             Normalises a vector to unit Euclidean length
583              
584             See also L, L.
585              
586             =pod
587              
588             Broadcasts over its inputs.
589              
590             =for bad
591              
592             C processes bad values.
593             It will set the bad-value flag of all output ndarrays if the flag is set for any of the input ndarrays.
594              
595             =cut
596              
597              
598              
599              
600             *norm = \&PDL::norm;
601              
602              
603              
604              
605              
606              
607             =head2 indadd
608              
609             =for sig
610              
611             Signature: (input(n); indx ind(n); [io] sum(m))
612             Types: (sbyte byte short ushort long ulong indx ulonglong longlong
613             float double ldouble cfloat cdouble cldouble)
614              
615             =for usage
616              
617             indadd($input, $ind, $sum); # all arguments given
618             $input->indadd($ind, $sum); # method call
619              
620             =for ref
621              
622             Broadcasting index add: add C to the C element of C, i.e:
623              
624             sum(ind) += input
625              
626             =for example
627              
628             Simple example:
629              
630             $x = 2;
631             $ind = 3;
632             $sum = zeroes(10);
633             indadd($x,$ind, $sum);
634             print $sum
635             #Result: ( 2 added to element 3 of $sum)
636             # [0 0 0 2 0 0 0 0 0 0]
637              
638             Broadcasting example:
639              
640             $x = pdl( 1,2,3);
641             $ind = pdl( 1,4,6);
642             $sum = zeroes(10);
643             indadd($x,$ind, $sum);
644             print $sum."\n";
645             #Result: ( 1, 2, and 3 added to elements 1,4,6 $sum)
646             # [0 1 0 0 2 0 3 0 0 0]
647              
648             =pod
649              
650             Broadcasts over its inputs.
651              
652             =for bad
653              
654             The routine barfs on bad indices, and bad inputs set target outputs bad.
655              
656             =cut
657              
658              
659              
660              
661             *indadd = \&PDL::indadd;
662              
663              
664              
665              
666              
667              
668             =head2 conv1d
669              
670             =for sig
671              
672             Signature: (a(m); kern(p); [o]b(m); int reflect)
673             Types: (sbyte byte short ushort long ulong indx ulonglong longlong
674             float double ldouble cfloat cdouble cldouble)
675              
676             =for usage
677              
678             $b = conv1d($a, $kern, $reflect);
679             conv1d($a, $kern, $b, $reflect); # all arguments given
680             $b = $a->conv1d($kern, $reflect); # method call
681             $a->conv1d($kern, $b, $reflect);
682              
683             =for ref
684              
685             1D convolution along first dimension
686              
687             The m-th element of the discrete convolution of an input ndarray
688             C<$a> of size C<$M>, and a kernel ndarray C<$kern> of size C<$P>, is
689             calculated as
690              
691             n = ($P-1)/2
692             ====
693             \
694             ($a conv1d $kern)[m] = > $a_ext[m - n] * $kern[n]
695             /
696             ====
697             n = -($P-1)/2
698              
699             where C<$a_ext> is either the periodic (or reflected) extension of
700             C<$a> so it is equal to C<$a> on C< 0..$M-1 > and equal to the
701             corresponding periodic/reflected image of C<$a> outside that range.
702              
703             =for example
704              
705             $con = conv1d sequence(10), pdl(-1,0,1);
706              
707             $con = conv1d sequence(10), pdl(-1,0,1), {Boundary => 'reflect'};
708              
709             By default, periodic boundary conditions are assumed (i.e. wrap around).
710             Alternatively, you can request reflective boundary conditions using
711             the C option:
712              
713             {Boundary => 'reflect'} # case in 'reflect' doesn't matter
714              
715             The convolution is performed along the first dimension. To apply it across
716             another dimension use the slicing routines, e.g.
717              
718             $y = $x->mv(2,0)->conv1d($kernel)->mv(0,2); # along third dim
719              
720             This function is useful for broadcasted filtering of 1D signals.
721              
722             Compare also L, L,
723             L
724              
725             =for bad
726              
727             WARNING: C processes bad values in its inputs as
728             the numeric value of C<< $pdl->badvalue >> so it is not
729             recommended for processing pdls with bad values in them
730             unless special care is taken.
731              
732             =pod
733              
734             Broadcasts over its inputs.
735              
736             =for bad
737              
738             C ignores the bad-value flag of the input ndarrays.
739             It will set the bad-value flag of all output ndarrays if the flag is set for any of the input ndarrays.
740              
741             =cut
742              
743              
744              
745              
746              
747             #line 568 "lib/PDL/Primitive.pd"
748             sub PDL::conv1d {
749             my $opt = pop @_ if ref($_[-1]) eq 'HASH';
750             die 'Usage: conv1d( a(m), kern(p), [o]b(m), {Options} )'
751             if @_<2 || @_>3;
752             my($x,$kern) = @_;
753             my $c = @_ == 3 ? $_[2] : PDL->null;
754             PDL::_conv1d_int($x,$kern,$c,
755             !(defined $opt && exists $$opt{Boundary}) ? 0 :
756             lc $$opt{Boundary} eq "reflect");
757             return $c;
758             }
759             #line 760 "lib/PDL/Primitive.pm"
760              
761             *conv1d = \&PDL::conv1d;
762              
763              
764              
765              
766              
767              
768             =head2 in
769              
770             =for sig
771              
772             Signature: (a(); b(n); [o] c())
773             Types: (sbyte byte short ushort long ulong indx ulonglong longlong
774             float double ldouble cfloat cdouble cldouble)
775              
776             =for usage
777              
778             $c = in($a, $b);
779             in($a, $b, $c); # all arguments given
780             $c = $a->in($b); # method call
781             $a->in($b, $c);
782              
783             =for ref
784              
785             test if a is in the set of values b
786              
787             =for example
788              
789             $goodmsk = $labels->in($goodlabels);
790             print pdl(3,1,4,6,2)->in(pdl(2,3,3));
791             [1 0 0 0 1]
792              
793             C is akin to the I of set theory. In principle,
794             PDL broadcasting could be used to achieve its functionality by using a
795             construct like
796              
797             $msk = ($labels->dummy(0) == $goodlabels)->orover;
798              
799             However, C doesn't create a (potentially large) intermediate
800             and is generally faster.
801              
802             =pod
803              
804             Broadcasts over its inputs.
805              
806             =for bad
807              
808             C does not process bad values.
809             It will set the bad-value flag of all output ndarrays if the flag is set for any of the input ndarrays.
810              
811             =cut
812              
813              
814              
815              
816             *in = \&PDL::in;
817              
818              
819              
820              
821              
822             #line 636 "lib/PDL/Primitive.pd"
823              
824             =head2 uniq
825              
826             =for ref
827              
828             return all unique elements of an ndarray
829              
830             The unique elements are returned in ascending order.
831              
832             =for example
833              
834             PDL> p pdl(2,2,2,4,0,-1,6,6)->uniq
835             [-1 0 2 4 6] # 0 is returned 2nd (sorted order)
836              
837             PDL> p pdl(2,2,2,4,nan,-1,6,6)->uniq
838             [-1 2 4 6 nan] # NaN value is returned at end
839              
840             Note: The returned pdl is 1D; any structure of the input
841             ndarray is lost. C values are never compare equal to
842             any other values, even themselves. As a result, they are
843             always unique. C returns the NaN values at the end
844             of the result ndarray. This follows the Matlab usage.
845              
846             See L if you need the indices of the unique
847             elements rather than the values.
848              
849             =for bad
850              
851             Bad values are not considered unique by uniq and are ignored.
852              
853             $x=sequence(10);
854             $x=$x->setbadif($x%3);
855             print $x->uniq;
856             [0 3 6 9]
857              
858             =cut
859              
860             *uniq = \&PDL::uniq;
861             # return unique elements of array
862             # find as jumps in the sorted array
863             # flattens in the process
864             sub PDL::uniq {
865             my ($arr) = @_;
866             return $arr if($arr->nelem == 0); # The null list is unique (CED)
867             return $arr->flat if($arr->nelem == 1); # singleton list is unique
868             my $aflat = $arr->flat;
869             my $srt = $aflat->where($aflat==$aflat)->qsort; # no NaNs or BADs for qsort
870             my $nans = $aflat->where($aflat!=$aflat);
871             my $uniq = ($srt->nelem > 1) ? $srt->where($srt != $srt->rotate(-1)) : $srt;
872             # make sure we return something if there is only one value
873             (
874             $uniq->nelem > 0 ? $uniq :
875             $srt->nelem == 0 ? $srt :
876             PDL::pdl( ref($srt), [$srt->index(0)] )
877             )->append($nans);
878             }
879              
880             #line 695 "lib/PDL/Primitive.pd"
881              
882             =head2 uniqind
883              
884             =for ref
885              
886             Return the indices of all unique elements of an ndarray
887             The order is in the order of the values to be consistent
888             with uniq. C values never compare equal with any
889             other value and so are always unique. This follows the
890             Matlab usage.
891              
892             =for example
893              
894             PDL> p pdl(2,2,2,4,0,-1,6,6)->uniqind
895             [5 4 1 3 6] # the 0 at index 4 is returned 2nd, but...
896              
897             PDL> p pdl(2,2,2,4,nan,-1,6,6)->uniqind
898             [5 1 3 6 4] # ...the NaN at index 4 is returned at end
899              
900             Note: The returned pdl is 1D; any structure of the input
901             ndarray is lost.
902              
903             See L if you want the unique values instead of the
904             indices.
905              
906             =for bad
907              
908             Bad values are not considered unique by uniqind and are ignored.
909              
910             =cut
911              
912             *uniqind = \&PDL::uniqind;
913             # return unique elements of array
914             # find as jumps in the sorted array
915             # flattens in the process
916             sub PDL::uniqind {
917             use PDL::Core 'barf';
918             my ($arr) = @_;
919             return $arr if($arr->nelem == 0); # The null list is unique (CED)
920             # Different from uniq we sort and store the result in an intermediary
921             my $aflat = $arr->flat;
922             my $nanind = which($aflat!=$aflat); # NaN indexes
923             my $good = PDL->sequence(indx, $aflat->dims)->where($aflat==$aflat); # good indexes
924             my $i_srt = $aflat->where($aflat==$aflat)->qsorti; # no BAD or NaN values for qsorti
925             my $srt = $aflat->where($aflat==$aflat)->index($i_srt);
926             my $uniqind;
927             if ($srt->nelem > 0) {
928             $uniqind = which($srt != $srt->rotate(-1));
929             $uniqind = $i_srt->slice('0') if $uniqind->isempty;
930             } else {
931             $uniqind = which($srt);
932             }
933             # Now map back to the original space
934             my $ansind = $nanind;
935             if ( $uniqind->nelem > 0 ) {
936             $ansind = ($good->index($i_srt->index($uniqind)))->append($ansind);
937             } else {
938             $ansind = $uniqind->append($ansind);
939             }
940             return $ansind;
941             }
942              
943             #line 761 "lib/PDL/Primitive.pd"
944              
945             =head2 uniqvec
946              
947             =for ref
948              
949             Return all unique vectors out of a collection
950              
951             NOTE: If any vectors in the input ndarray have NaN values
952             they are returned at the end of the non-NaN ones. This is
953             because, by definition, NaN values never compare equal with
954             any other value.
955              
956             NOTE: The current implementation does not sort the vectors
957             containing NaN values.
958              
959             The unique vectors are returned in lexicographically sorted
960             ascending order. The 0th dimension of the input PDL is treated
961             as a dimensional index within each vector, and the 1st and any
962             higher dimensions are taken to run across vectors. The return
963             value is always 2D; any structure of the input PDL (beyond using
964             the 0th dimension for vector index) is lost.
965              
966             See also L for a unique list of scalars; and
967             L for sorting a list of vectors
968             lexicographcally.
969              
970             =for bad
971              
972             If a vector contains all bad values, it is ignored as in L.
973             If some of the values are good, it is treated as a normal vector. For
974             example, [1 2 BAD] and [BAD 2 3] could be returned, but [BAD BAD BAD]
975             could not. Vectors containing BAD values will be returned after any
976             non-NaN and non-BAD containing vectors, followed by the NaN vectors.
977              
978             =cut
979              
980             sub PDL::uniqvec {
981             my($pdl) = shift;
982              
983             return $pdl if ( $pdl->nelem == 0 || $pdl->ndims < 2 );
984             return $pdl if ( $pdl->slice("(0)")->nelem < 2 ); # slice isn't cheap but uniqvec isn't either
985              
986             my $pdl2d = $pdl->clump(1..$pdl->ndims-1);
987             my $ngood = $pdl2d->ngoodover;
988             $pdl2d = $pdl2d->mv(0,-1)->dice($ngood->which)->mv(-1,0); # remove all-BAD vectors
989              
990             my $numnan = ($pdl2d!=$pdl2d)->sumover; # works since no all-BADs to confuse
991              
992             my $presrt = $pdl2d->mv(0,-1)->dice($numnan->not->which)->mv(0,-1); # remove vectors with any NaN values
993             my $nanvec = $pdl2d->mv(0,-1)->dice($numnan->which)->mv(0,-1); # the vectors with any NaN values
994              
995             my $srt = $presrt->qsortvec->mv(0,-1); # BADs are sorted by qsortvec
996             my $srtdice = $srt;
997             my $somebad = null;
998             if ($srt->badflag) {
999             $srtdice = $srt->dice($srt->mv(0,-1)->nbadover->not->which);
1000             $somebad = $srt->dice($srt->mv(0,-1)->nbadover->which);
1001             }
1002              
1003             my $uniq = $srtdice->nelem > 0
1004             ? ($srtdice != $srtdice->rotate(-1))->mv(0,-1)->orover->which
1005             : $srtdice->orover->which;
1006              
1007             my $ans = $uniq->nelem > 0 ? $srtdice->dice($uniq) :
1008             ($srtdice->nelem > 0) ? $srtdice->slice("0,:") :
1009             $srtdice;
1010             return $ans->append($somebad)->append($nanvec->mv(0,-1))->mv(0,-1);
1011             }
1012             #line 1013 "lib/PDL/Primitive.pm"
1013              
1014              
1015             =head2 hclip
1016              
1017             =for sig
1018              
1019             Signature: (a(); b(); [o] c())
1020             Types: (sbyte byte short ushort long ulong indx ulonglong longlong
1021             float double ldouble)
1022              
1023             =for usage
1024              
1025             $c = hclip($a, $b);
1026             hclip($a, $b, $c); # all arguments given
1027             $c = $a->hclip($b); # method call
1028             $a->hclip($b, $c);
1029              
1030             =for ref
1031              
1032             clip (threshold) C<$a> by C<$b> (C<$b> is upper bound)
1033              
1034             =pod
1035              
1036             Broadcasts over its inputs.
1037              
1038             =for bad
1039              
1040             C processes bad values.
1041             It will set the bad-value flag of all output ndarrays if the flag is set for any of the input ndarrays.
1042              
1043             =cut
1044              
1045              
1046              
1047              
1048              
1049             #line 856 "lib/PDL/Primitive.pd"
1050             sub PDL::hclip {
1051             my ($x,$y) = @_;
1052             my $c;
1053             if ($x->is_inplace) {
1054             $x->set_inplace(0); $c = $x;
1055             } elsif (@_ > 2) {$c=$_[2]} else {$c=PDL->nullcreate($x)}
1056             PDL::_hclip_int($x,$y,$c);
1057             return $c;
1058             }
1059             #line 1060 "lib/PDL/Primitive.pm"
1060              
1061             *hclip = \&PDL::hclip;
1062              
1063              
1064              
1065              
1066              
1067              
1068             =head2 lclip
1069              
1070             =for sig
1071              
1072             Signature: (a(); b(); [o] c())
1073             Types: (sbyte byte short ushort long ulong indx ulonglong longlong
1074             float double ldouble)
1075              
1076             =for usage
1077              
1078             $c = lclip($a, $b);
1079             lclip($a, $b, $c); # all arguments given
1080             $c = $a->lclip($b); # method call
1081             $a->lclip($b, $c);
1082              
1083             =for ref
1084              
1085             clip (threshold) C<$a> by C<$b> (C<$b> is lower bound)
1086              
1087             =pod
1088              
1089             Broadcasts over its inputs.
1090              
1091             =for bad
1092              
1093             C processes bad values.
1094             It will set the bad-value flag of all output ndarrays if the flag is set for any of the input ndarrays.
1095              
1096             =cut
1097              
1098              
1099              
1100              
1101              
1102             #line 856 "lib/PDL/Primitive.pd"
1103             sub PDL::lclip {
1104             my ($x,$y) = @_;
1105             my $c;
1106             if ($x->is_inplace) {
1107             $x->set_inplace(0); $c = $x;
1108             } elsif (@_ > 2) {$c=$_[2]} else {$c=PDL->nullcreate($x)}
1109             PDL::_lclip_int($x,$y,$c);
1110             return $c;
1111             }
1112             #line 1113 "lib/PDL/Primitive.pm"
1113              
1114             *lclip = \&PDL::lclip;
1115              
1116              
1117              
1118              
1119              
1120              
1121             =head2 clip
1122              
1123             =for sig
1124              
1125             Signature: (a(); l(); h(); [o] c())
1126             Types: (sbyte byte short ushort long ulong indx ulonglong longlong
1127             float double ldouble)
1128              
1129             =for ref
1130              
1131             Clip (threshold) an ndarray by (optional) upper or lower bounds.
1132              
1133             =for usage
1134              
1135             $y = $x->clip(0,3);
1136             $c = $x->clip(undef, $x);
1137              
1138             =pod
1139              
1140             Broadcasts over its inputs.
1141              
1142             =for bad
1143              
1144             C processes bad values.
1145             It will set the bad-value flag of all output ndarrays if the flag is set for any of the input ndarrays.
1146              
1147             =cut
1148              
1149              
1150              
1151              
1152              
1153             #line 892 "lib/PDL/Primitive.pd"
1154             *clip = \&PDL::clip;
1155             sub PDL::clip {
1156             my($x, $l, $h) = @_;
1157             my $d;
1158             unless(defined($l) || defined($h)) {
1159             # Deal with pathological case
1160             if($x->is_inplace) {
1161             $x->set_inplace(0);
1162             return $x;
1163             } else {
1164             return $x->copy;
1165             }
1166             }
1167              
1168             if($x->is_inplace) {
1169             $x->set_inplace(0); $d = $x
1170             } elsif (@_ > 3) {
1171             $d=$_[3]
1172             } else {
1173             $d = PDL->nullcreate($x);
1174             }
1175             if(defined($l) && defined($h)) {
1176             PDL::_clip_int($x,$l,$h,$d);
1177             } elsif( defined($l) ) {
1178             PDL::_lclip_int($x,$l,$d);
1179             } elsif( defined($h) ) {
1180             PDL::_hclip_int($x,$h,$d);
1181             } else {
1182             die "This can't happen (clip contingency) - file a bug";
1183             }
1184              
1185             return $d;
1186             }
1187             #line 1188 "lib/PDL/Primitive.pm"
1188              
1189             *clip = \&PDL::clip;
1190              
1191              
1192              
1193              
1194              
1195              
1196             =head2 wtstat
1197              
1198             =for sig
1199              
1200             Signature: (a(n); wt(n); avg(); [o]b(); int deg)
1201             Types: (sbyte byte short ushort long ulong indx ulonglong longlong
1202             float double ldouble cfloat cdouble cldouble)
1203              
1204             =for usage
1205              
1206             $b = wtstat($a, $wt, $avg, $deg);
1207             wtstat($a, $wt, $avg, $b, $deg); # all arguments given
1208             $b = $a->wtstat($wt, $avg, $deg); # method call
1209             $a->wtstat($wt, $avg, $b, $deg);
1210              
1211             =for ref
1212              
1213             Weighted statistical moment of given degree
1214              
1215             This calculates a weighted statistic over the vector C.
1216             The formula is
1217              
1218             b() = (sum_i wt_i * (a_i ** degree - avg)) / (sum_i wt_i)
1219              
1220             =pod
1221              
1222             Broadcasts over its inputs.
1223              
1224             =for bad
1225              
1226             Bad values are ignored in any calculation; C<$b> will only
1227             have its bad flag set if the output contains any bad data.
1228              
1229             =cut
1230              
1231              
1232              
1233              
1234             *wtstat = \&PDL::wtstat;
1235              
1236              
1237              
1238              
1239              
1240              
1241             =head2 statsover
1242              
1243             =for sig
1244              
1245             Signature: (a(n); w(n); float+ [o]avg(); float+ [o]prms(); int+ [o]min(); int+ [o]max(); float+ [o]adev(); float+ [o]rms())
1246             Types: (sbyte byte short ushort long ulong indx ulonglong longlong
1247             float double ldouble)
1248              
1249             =for ref
1250              
1251             Calculate useful statistics over a dimension of an ndarray
1252              
1253             =for usage
1254              
1255             ($mean,$prms,$median,$min,$max,$adev,$rms) = statsover($ndarray, $weights);
1256              
1257             This utility function calculates various useful
1258             quantities of an ndarray. These are:
1259              
1260             =over 3
1261              
1262             =item * the mean:
1263              
1264             MEAN = sum (x)/ N
1265              
1266             with C being the number of elements in x
1267              
1268             =item * the population RMS deviation from the mean:
1269              
1270             PRMS = sqrt( sum( (x-mean(x))^2 )/(N-1) )
1271              
1272             The population deviation is the best-estimate of the deviation
1273             of the population from which a sample is drawn.
1274              
1275             =item * the median
1276              
1277             The median is the 50th percentile data value. Median is found by
1278             L, so WEIGHTING IS IGNORED FOR THE MEDIAN CALCULATION.
1279              
1280             =item * the minimum
1281              
1282             =item * the maximum
1283              
1284             =item * the average absolute deviation:
1285              
1286             AADEV = sum( abs(x-mean(x)) )/N
1287              
1288             =item * RMS deviation from the mean:
1289              
1290             RMS = sqrt(sum( (x-mean(x))^2 )/N)
1291              
1292             (also known as the root-mean-square deviation, or the square root of the
1293             variance)
1294              
1295             =back
1296              
1297             This operator is a projection operator so the calculation
1298             will take place over the final dimension. Thus if the input
1299             is N-dimensional each returned value will be N-1 dimensional,
1300             to calculate the statistics for the entire ndarray either
1301             use C directly on the ndarray or call C.
1302              
1303             =pod
1304              
1305             Broadcasts over its inputs.
1306              
1307             =for bad
1308              
1309             Bad values are simply ignored in the calculation, effectively reducing
1310             the sample size. If all data are bad then the output data are marked bad.
1311              
1312             =cut
1313              
1314              
1315              
1316              
1317              
1318             #line 1018 "lib/PDL/Primitive.pd"
1319             sub PDL::statsover {
1320             barf('Usage: ($mean,[$prms, $median, $min, $max, $adev, $rms]) = statsover($data,[$weights])') if @_>2;
1321             my ($data, $weights) = @_;
1322             $weights //= $data->ones();
1323             my $median = $data->medover;
1324             my $mean = PDL->nullcreate($data);
1325             my $rms = PDL->nullcreate($data);
1326             my $min = PDL->nullcreate($data);
1327             my $max = PDL->nullcreate($data);
1328             my $adev = PDL->nullcreate($data);
1329             my $prms = PDL->nullcreate($data);
1330             PDL::_statsover_int($data, $weights, $mean, $prms, $min, $max, $adev, $rms);
1331             wantarray ? ($mean, $prms, $median, $min, $max, $adev, $rms) : $mean;
1332             }
1333             #line 1334 "lib/PDL/Primitive.pm"
1334              
1335             *statsover = \&PDL::statsover;
1336              
1337              
1338              
1339              
1340              
1341             #line 1095 "lib/PDL/Primitive.pd"
1342              
1343             =head2 stats
1344              
1345             =for ref
1346              
1347             Calculates useful statistics on an ndarray
1348              
1349             =for usage
1350              
1351             ($mean,$prms,$median,$min,$max,$adev,$rms) = stats($ndarray,[$weights]);
1352              
1353             This utility calculates all the most useful quantities in one call.
1354             It works the same way as L, except that the quantities are
1355             calculated considering the entire input PDL as a single sample, rather
1356             than as a collection of rows. See L for definitions of the
1357             returned quantities.
1358              
1359             =for bad
1360              
1361             Bad values are handled; if all input values are bad, then all of the output
1362             values are flagged bad.
1363              
1364             =cut
1365              
1366             *stats = \&PDL::stats;
1367             sub PDL::stats {
1368             barf('Usage: ($mean,[$rms]) = stats($data,[$weights])') if @_>2;
1369             my ($data,$weights) = @_;
1370              
1371             # Ensure that $weights is properly broadcasted over; this could be
1372             # done rather more efficiently...
1373             if(defined $weights) {
1374             $weights = pdl($weights) unless UNIVERSAL::isa($weights,'PDL');
1375             if( ($weights->ndims != $data->ndims) or
1376             (pdl($weights->dims) != pdl($data->dims))->or
1377             ) {
1378             $weights = $weights + zeroes($data)
1379             }
1380             $weights = $weights->flat;
1381             }
1382              
1383             return PDL::statsover($data->flat,$weights);
1384             }
1385             #line 1386 "lib/PDL/Primitive.pm"
1386              
1387              
1388             =head2 histogram
1389              
1390             =for sig
1391              
1392             Signature: (in(n); int+[o] hist(m); double step; double min; IV msize => m)
1393             Types: (sbyte byte short ushort long ulong indx ulonglong longlong
1394             float double ldouble cfloat cdouble cldouble)
1395              
1396             =for ref
1397              
1398             Calculates a histogram for given stepsize and minimum.
1399              
1400             =for usage
1401              
1402             $h = histogram($data, $step, $min, $numbins);
1403             $hist = zeroes $numbins; # Put histogram in existing ndarray.
1404             histogram($data, $hist, $step, $min, $numbins);
1405              
1406             The histogram will contain C<$numbins> bins starting from C<$min>, each
1407             C<$step> wide. The value in each bin is the number of
1408             values in C<$data> that lie within the bin limits.
1409              
1410             Data below the lower limit is put in the first bin, and data above the
1411             upper limit is put in the last bin.
1412              
1413             The output is reset in a different broadcastloop so that you
1414             can take a histogram of C<$a(10,12)> into C<$b(15)> and get the result
1415             you want.
1416              
1417             For a higher-level interface, see L.
1418              
1419             =for example
1420              
1421             pdl> p histogram(pdl(1,1,2),1,0,3)
1422             [0 2 1]
1423              
1424             =pod
1425              
1426             Broadcasts over its inputs.
1427              
1428             =for bad
1429              
1430             C processes bad values.
1431             It will set the bad-value flag of all output ndarrays if the flag is set for any of the input ndarrays.
1432              
1433             =cut
1434              
1435              
1436              
1437              
1438             *histogram = \&PDL::histogram;
1439              
1440              
1441              
1442              
1443              
1444              
1445             =head2 whistogram
1446              
1447             =for sig
1448              
1449             Signature: (in(n); float+ wt(n);float+[o] hist(m); double step; double min; IV msize => m)
1450             Types: (sbyte byte short ushort long ulong indx ulonglong longlong
1451             float double ldouble cfloat cdouble cldouble)
1452              
1453             =for ref
1454              
1455             Calculates a histogram from weighted data for given stepsize and minimum.
1456              
1457             =for usage
1458              
1459             $h = whistogram($data, $weights, $step, $min, $numbins);
1460             $hist = zeroes $numbins; # Put histogram in existing ndarray.
1461             whistogram($data, $weights, $hist, $step, $min, $numbins);
1462              
1463             The histogram will contain C<$numbins> bins starting from C<$min>, each
1464             C<$step> wide. The value in each bin is the sum of the values in C<$weights>
1465             that correspond to values in C<$data> that lie within the bin limits.
1466              
1467             Data below the lower limit is put in the first bin, and data above the
1468             upper limit is put in the last bin.
1469              
1470             The output is reset in a different broadcastloop so that you
1471             can take a histogram of C<$a(10,12)> into C<$b(15)> and get the result
1472             you want.
1473              
1474             =for example
1475              
1476             pdl> p whistogram(pdl(1,1,2), pdl(0.1,0.1,0.5), 1, 0, 4)
1477             [0 0.2 0.5 0]
1478              
1479             =pod
1480              
1481             Broadcasts over its inputs.
1482              
1483             =for bad
1484              
1485             C processes bad values.
1486             It will set the bad-value flag of all output ndarrays if the flag is set for any of the input ndarrays.
1487              
1488             =cut
1489              
1490              
1491              
1492              
1493             *whistogram = \&PDL::whistogram;
1494              
1495              
1496              
1497              
1498              
1499              
1500             =head2 histogram2d
1501              
1502             =for sig
1503              
1504             Signature: (ina(n); inb(n); int+[o] hist(ma,mb); double stepa; double mina; IV masize => ma;
1505             double stepb; double minb; IV mbsize => mb;)
1506             Types: (sbyte byte short ushort long ulong indx ulonglong longlong
1507             float double ldouble cfloat cdouble cldouble)
1508              
1509             =for ref
1510              
1511             Calculates a 2d histogram.
1512              
1513             =for usage
1514              
1515             $h = histogram2d($datax, $datay, $stepx, $minx,
1516             $nbinx, $stepy, $miny, $nbiny);
1517             $hist = zeroes $nbinx, $nbiny; # Put histogram in existing ndarray.
1518             histogram2d($datax, $datay, $hist, $stepx, $minx,
1519             $nbinx, $stepy, $miny, $nbiny);
1520              
1521             The histogram will contain C<$nbinx> x C<$nbiny> bins, with the lower
1522             limits of the first one at C<($minx, $miny)>, and with bin size
1523             C<($stepx, $stepy)>.
1524             The value in each bin is the number of
1525             values in C<$datax> and C<$datay> that lie within the bin limits.
1526              
1527             Data below the lower limit is put in the first bin, and data above the
1528             upper limit is put in the last bin.
1529              
1530             =for example
1531              
1532             pdl> p histogram2d(pdl(1,1,1,2,2),pdl(2,1,1,1,1),1,0,3,1,0,3)
1533             [
1534             [0 0 0]
1535             [0 2 2]
1536             [0 1 0]
1537             ]
1538              
1539             =pod
1540              
1541             Broadcasts over its inputs.
1542              
1543             =for bad
1544              
1545             C processes bad values.
1546             It will set the bad-value flag of all output ndarrays if the flag is set for any of the input ndarrays.
1547              
1548             =cut
1549              
1550              
1551              
1552              
1553             *histogram2d = \&PDL::histogram2d;
1554              
1555              
1556              
1557              
1558              
1559              
1560             =head2 whistogram2d
1561              
1562             =for sig
1563              
1564             Signature: (ina(n); inb(n); float+ wt(n);float+[o] hist(ma,mb); double stepa; double mina; IV masize => ma;
1565             double stepb; double minb; IV mbsize => mb;)
1566             Types: (sbyte byte short ushort long ulong indx ulonglong longlong
1567             float double ldouble cfloat cdouble cldouble)
1568              
1569             =for ref
1570              
1571             Calculates a 2d histogram from weighted data.
1572              
1573             =for usage
1574              
1575             $h = whistogram2d($datax, $datay, $weights,
1576             $stepx, $minx, $nbinx, $stepy, $miny, $nbiny);
1577             $hist = zeroes $nbinx, $nbiny; # Put histogram in existing ndarray.
1578             whistogram2d($datax, $datay, $weights, $hist,
1579             $stepx, $minx, $nbinx, $stepy, $miny, $nbiny);
1580              
1581             The histogram will contain C<$nbinx> x C<$nbiny> bins, with the lower
1582             limits of the first one at C<($minx, $miny)>, and with bin size
1583             C<($stepx, $stepy)>.
1584             The value in each bin is the sum of the values in
1585             C<$weights> that correspond to values in C<$datax> and C<$datay> that lie within the bin limits.
1586              
1587             Data below the lower limit is put in the first bin, and data above the
1588             upper limit is put in the last bin.
1589              
1590             =for example
1591              
1592             pdl> p whistogram2d(pdl(1,1,1,2,2),pdl(2,1,1,1,1),pdl(0.1,0.2,0.3,0.4,0.5),1,0,3,1,0,3)
1593             [
1594             [ 0 0 0]
1595             [ 0 0.5 0.9]
1596             [ 0 0.1 0]
1597             ]
1598              
1599             =pod
1600              
1601             Broadcasts over its inputs.
1602              
1603             =for bad
1604              
1605             C processes bad values.
1606             It will set the bad-value flag of all output ndarrays if the flag is set for any of the input ndarrays.
1607              
1608             =cut
1609              
1610              
1611              
1612              
1613             *whistogram2d = \&PDL::whistogram2d;
1614              
1615              
1616              
1617              
1618              
1619              
1620             =head2 fibonacci
1621              
1622             =for sig
1623              
1624             Signature: (i(n); [o]x(n))
1625             Types: (sbyte byte short ushort long ulong indx ulonglong longlong
1626             float double ldouble cfloat cdouble cldouble)
1627              
1628             =for usage
1629              
1630             $x = fibonacci($i);
1631             fibonacci($i, $x); # all arguments given
1632             $x = $i->fibonacci; # method call
1633             $i->fibonacci($x);
1634             $i->inplace->fibonacci; # can be used inplace
1635             fibonacci($i->inplace);
1636              
1637             =for ref
1638              
1639             Constructor - a vector with Fibonacci's sequence
1640              
1641             =pod
1642              
1643             Broadcasts over its inputs.
1644              
1645             =for bad
1646              
1647             C does not process bad values.
1648             It will set the bad-value flag of all output ndarrays if the flag is set for any of the input ndarrays.
1649              
1650             =cut
1651              
1652              
1653              
1654              
1655              
1656             #line 1363 "lib/PDL/Primitive.pd"
1657             sub fibonacci { ref($_[0]) && ref($_[0]) ne 'PDL::Type' ? $_[0]->fibonacci : PDL->fibonacci(@_) }
1658             sub PDL::fibonacci{
1659             my $x = &PDL::Core::_construct;
1660             my $is_inplace = $x->is_inplace;
1661             my ($in, $out) = $x->flat;
1662             $out = $is_inplace ? $in->inplace : PDL->null;
1663             PDL::_fibonacci_int($in, $out);
1664             $out;
1665             }
1666             #line 1667 "lib/PDL/Primitive.pm"
1667              
1668              
1669             =head2 append
1670              
1671             =for sig
1672              
1673             Signature: (a(n); b(m); [o] c(mn=CALC($SIZE(n)+$SIZE(m))))
1674             Types: (sbyte byte short ushort long ulong indx ulonglong longlong
1675             float double ldouble cfloat cdouble cldouble)
1676              
1677             =for usage
1678              
1679             $c = append($a, $b);
1680             append($a, $b, $c); # all arguments given
1681             $c = $a->append($b); # method call
1682             $a->append($b, $c);
1683              
1684             =for ref
1685              
1686             append two ndarrays by concatenating along their first dimensions
1687              
1688             =for example
1689              
1690             $x = ones(2,4,7);
1691             $y = sequence 5;
1692             $c = $x->append($y); # size of $c is now (7,4,7) (a jumbo-ndarray ;)
1693              
1694             C appends two ndarrays along their first dimensions. The rest of the
1695             dimensions must be compatible in the broadcasting sense. The resulting
1696             size of the first dimension is the sum of the sizes of the first dimensions
1697             of the two argument ndarrays - i.e. C.
1698              
1699             Similar functions include L (below), which can append more
1700             than two ndarrays along an arbitrary dimension, and
1701             L, which can append more than two ndarrays that all
1702             have the same sized dimensions.
1703              
1704             =pod
1705              
1706             Broadcasts over its inputs.
1707              
1708             =for bad
1709              
1710             C does not process bad values.
1711             It will set the bad-value flag of all output ndarrays if the flag is set for any of the input ndarrays.
1712              
1713             =cut
1714              
1715              
1716              
1717              
1718              
1719             #line 1389 "lib/PDL/Primitive.pd"
1720              
1721             sub PDL::append {
1722             my ($i1, $i2, $o) = map PDL->topdl($_), @_;
1723             $_ = empty() for grep $_->isnull, $i1, $i2;
1724             my $nempty = grep $_->isempty, $i1, $i2;
1725             if ($nempty == 2) {
1726             my @dims = $i1->dims;
1727             $dims[0] += $i2->dim(0);
1728             return PDL->zeroes($i1->type, @dims);
1729             }
1730             $o //= PDL->null;
1731             $o .= $i1->isempty ? $i2 : $i1, return $o if $nempty == 1;
1732             PDL::_append_int($i1, $i2->convert($i1->type), $o);
1733             $o;
1734             }
1735            
1736             #line 1737 "lib/PDL/Primitive.pm"
1737              
1738             *append = \&PDL::append;
1739              
1740              
1741              
1742              
1743              
1744             #line 1433 "lib/PDL/Primitive.pd"
1745              
1746             =head2 glue
1747              
1748             =for usage
1749              
1750             $c = $x->glue(,$y,...)
1751              
1752             =for ref
1753              
1754             Glue two or more PDLs together along an arbitrary dimension
1755             (N-D L).
1756              
1757             Sticks $x, $y, and all following arguments together along the
1758             specified dimension. All other dimensions must be compatible in the
1759             broadcasting sense.
1760              
1761             Glue is permissive, in the sense that every PDL is treated as having an
1762             infinite number of trivial dimensions of order 1 -- so C<< $x->glue(3,$y) >>
1763             works, even if $x and $y are only one dimensional.
1764              
1765             If one of the PDLs has no elements, it is ignored. Likewise, if one
1766             of them is actually the undefined value, it is treated as if it had no
1767             elements.
1768              
1769             If the first parameter is a defined perl scalar rather than a pdl,
1770             then it is taken as a dimension along which to glue everything else,
1771             so you can say C<$cube = PDL::glue(3,@image_list);> if you like.
1772              
1773             C is implemented in pdl, using a combination of L and
1774             L. It should probably be updated (one day) to a pure PP
1775             function.
1776              
1777             Similar functions include L (above), which appends
1778             only two ndarrays along their first dimension, and
1779             L, which can append more than two ndarrays that all
1780             have the same sized dimensions.
1781              
1782             =cut
1783              
1784             sub PDL::glue{
1785             my($x) = shift;
1786             my($dim) = shift;
1787              
1788             ($dim, $x) = ($x, $dim) if defined $x && !ref $x;
1789             confess 'dimension must be Perl scalar' if ref $dim;
1790              
1791             if(!defined $x || $x->nelem==0) {
1792             return $x unless(@_);
1793             return shift() if(@_<=1);
1794             $x=shift;
1795             return PDL::glue($x,$dim,@_);
1796             }
1797              
1798             if($dim - $x->dim(0) > 100) {
1799             print STDERR "warning:: PDL::glue allocating >100 dimensions!\n";
1800             }
1801             while($dim >= $x->ndims) {
1802             $x = $x->dummy(-1,1);
1803             }
1804             $x = $x->xchg(0,$dim) if 0 != $dim;
1805              
1806             while(scalar(@_)){
1807             my $y = shift;
1808             next unless(defined $y && $y->nelem);
1809              
1810             while($dim >= $y->ndims) {
1811             $y = $y->dummy(-1,1);
1812             }
1813             $y = $y->xchg(0,$dim) if 0 != $dim;
1814             $x = $x->append($y);
1815             }
1816             0 == $dim ? $x : $x->xchg(0,$dim);
1817             }
1818             #line 1819 "lib/PDL/Primitive.pm"
1819              
1820             *axisvalues = \&PDL::axisvalues;
1821              
1822              
1823              
1824              
1825              
1826              
1827             =head2 cmpvec
1828              
1829             =for sig
1830              
1831             Signature: (a(n); b(n); sbyte [o]c())
1832             Types: (sbyte byte short ushort long ulong indx ulonglong longlong
1833             float double ldouble)
1834              
1835             =for usage
1836              
1837             $c = cmpvec($a, $b);
1838             cmpvec($a, $b, $c); # all arguments given
1839             $c = $a->cmpvec($b); # method call
1840             $a->cmpvec($b, $c);
1841              
1842             =for ref
1843              
1844             Compare two vectors lexicographically.
1845              
1846             Returns -1 if a is less, 1 if greater, 0 if equal.
1847              
1848             =pod
1849              
1850             Broadcasts over its inputs.
1851              
1852             =for bad
1853              
1854             The output is bad if any input values up to the point of inequality are
1855             bad - any after are ignored.
1856              
1857             =cut
1858              
1859              
1860              
1861              
1862             *cmpvec = \&PDL::cmpvec;
1863              
1864              
1865              
1866              
1867              
1868              
1869             =head2 eqvec
1870              
1871             =for sig
1872              
1873             Signature: (a(n); b(n); sbyte [o]c())
1874             Types: (sbyte byte short ushort long ulong indx ulonglong longlong
1875             float double ldouble)
1876              
1877             =for usage
1878              
1879             $c = eqvec($a, $b);
1880             eqvec($a, $b, $c); # all arguments given
1881             $c = $a->eqvec($b); # method call
1882             $a->eqvec($b, $c);
1883              
1884             =for ref
1885              
1886             Compare two vectors, returning 1 if equal, 0 if not equal.
1887              
1888             =pod
1889              
1890             Broadcasts over its inputs.
1891              
1892             =for bad
1893              
1894             The output is bad if any input values are bad.
1895              
1896             =cut
1897              
1898              
1899              
1900              
1901             *eqvec = \&PDL::eqvec;
1902              
1903              
1904              
1905              
1906              
1907              
1908             =head2 enumvec
1909              
1910             =for sig
1911              
1912             Signature: (v(M,N); indx [o]k(N))
1913             Types: (sbyte byte short ushort long ulong indx ulonglong longlong
1914             float double ldouble)
1915              
1916             =for usage
1917              
1918             $k = enumvec($v);
1919             enumvec($v, $k); # all arguments given
1920             $k = $v->enumvec; # method call
1921             $v->enumvec($k);
1922              
1923             =for ref
1924              
1925             Enumerate a list of vectors with locally unique keys.
1926              
1927             Given a sorted list of vectors $v, generate a vector $k containing locally unique keys for the elements of $v
1928             (where an "element" is a vector of length $M occurring in $v).
1929              
1930             Note that the keys returned in $k are only unique over a run of a single vector in $v,
1931             so that each unique vector in $v has at least one 0 (zero) index in $k associated with it.
1932             If you need global keys, see enumvecg().
1933              
1934             Contributed by Bryan Jurish Emoocow@cpan.orgE.
1935              
1936             =pod
1937              
1938             Broadcasts over its inputs.
1939              
1940             =for bad
1941              
1942             C does not process bad values.
1943             It will set the bad-value flag of all output ndarrays if the flag is set for any of the input ndarrays.
1944              
1945             =cut
1946              
1947              
1948              
1949              
1950             *enumvec = \&PDL::enumvec;
1951              
1952              
1953              
1954              
1955              
1956              
1957             =head2 enumvecg
1958              
1959             =for sig
1960              
1961             Signature: (v(M,N); indx [o]k(N))
1962             Types: (sbyte byte short ushort long ulong indx ulonglong longlong
1963             float double ldouble)
1964              
1965             =for usage
1966              
1967             $k = enumvecg($v);
1968             enumvecg($v, $k); # all arguments given
1969             $k = $v->enumvecg; # method call
1970             $v->enumvecg($k);
1971              
1972             =for ref
1973              
1974             Enumerate a list of vectors with globally unique keys.
1975              
1976             Given a sorted list of vectors $v, generate a vector $k containing globally unique keys for the elements of $v
1977             (where an "element" is a vector of length $M occurring in $v).
1978             Basically does the same thing as:
1979              
1980             $k = $v->vsearchvec($v->uniqvec);
1981              
1982             ... but somewhat more efficiently.
1983              
1984             Contributed by Bryan Jurish Emoocow@cpan.orgE.
1985              
1986             =pod
1987              
1988             Broadcasts over its inputs.
1989              
1990             =for bad
1991              
1992             C does not process bad values.
1993             It will set the bad-value flag of all output ndarrays if the flag is set for any of the input ndarrays.
1994              
1995             =cut
1996              
1997              
1998              
1999              
2000             *enumvecg = \&PDL::enumvecg;
2001              
2002              
2003              
2004              
2005              
2006              
2007             =head2 vsearchvec
2008              
2009             =for sig
2010              
2011             Signature: (find(M); which(M,N); indx [o]found())
2012             Types: (sbyte byte short ushort long ulong indx ulonglong longlong
2013             float double ldouble)
2014              
2015             =for usage
2016              
2017             $found = vsearchvec($find, $which);
2018             vsearchvec($find, $which, $found); # all arguments given
2019             $found = $find->vsearchvec($which); # method call
2020             $find->vsearchvec($which, $found);
2021              
2022             =for ref
2023              
2024             Routine for searching N-dimensional values - akin to vsearch() for vectors.
2025              
2026             =for example
2027              
2028             $found = vsearchvec($find, $which);
2029             $nearest = $which->dice_axis(1,$found);
2030              
2031             Returns for each row-vector in C<$find> the index along dimension N
2032             of the least row vector of C<$which>
2033             greater or equal to it.
2034             C<$which> should be sorted in increasing order.
2035             If the value of C<$find> is larger
2036             than any member of C<$which>, the index to the last element of C<$which> is
2037             returned.
2038              
2039             See also: L.
2040             Contributed by Bryan Jurish Emoocow@cpan.orgE.
2041              
2042             =pod
2043              
2044             Broadcasts over its inputs.
2045              
2046             =for bad
2047              
2048             C does not process bad values.
2049             It will set the bad-value flag of all output ndarrays if the flag is set for any of the input ndarrays.
2050              
2051             =cut
2052              
2053              
2054              
2055              
2056             *vsearchvec = \&PDL::vsearchvec;
2057              
2058              
2059              
2060              
2061              
2062              
2063             =head2 unionvec
2064              
2065             =for sig
2066              
2067             Signature: (a(M,NA); b(M,NB); [o]c(M,NC=CALC($SIZE(NA) + $SIZE(NB))); indx [o]nc())
2068             Types: (sbyte byte short ushort long ulong indx ulonglong longlong
2069             float double ldouble)
2070              
2071             =for usage
2072              
2073             ($c, $nc) = unionvec($a, $b);
2074             unionvec($a, $b, $c, $nc); # all arguments given
2075             ($c, $nc) = $a->unionvec($b); # method call
2076             $a->unionvec($b, $c, $nc);
2077              
2078             =for ref
2079              
2080             Union of two vector-valued PDLs.
2081              
2082             Input PDLs $a() and $b() B be sorted in lexicographic order.
2083             On return, $nc() holds the actual number of vector-values in the union.
2084              
2085             In scalar context, slices $c() to the actual number of elements in the union
2086             and returns the sliced PDL.
2087              
2088             Contributed by Bryan Jurish Emoocow@cpan.orgE.
2089              
2090             =pod
2091              
2092             Broadcasts over its inputs.
2093              
2094             =for bad
2095              
2096             C does not process bad values.
2097             It will set the bad-value flag of all output ndarrays if the flag is set for any of the input ndarrays.
2098              
2099             =cut
2100              
2101              
2102              
2103              
2104              
2105             #line 1708 "lib/PDL/Primitive.pd"
2106             sub PDL::unionvec {
2107             my ($a,$b,$c,$nc) = @_;
2108             $c = PDL->null if (!defined($nc));
2109             $nc = PDL->null if (!defined($nc));
2110             PDL::_unionvec_int($a,$b,$c,$nc);
2111             return ($c,$nc) if (wantarray);
2112             return $c->slice(",0:".($nc->max-1));
2113             }
2114             #line 2115 "lib/PDL/Primitive.pm"
2115              
2116             *unionvec = \&PDL::unionvec;
2117              
2118              
2119              
2120              
2121              
2122              
2123             =head2 intersectvec
2124              
2125             =for sig
2126              
2127             Signature: (a(M,NA); b(M,NB); [o]c(M,NC=CALC(PDLMIN($SIZE(NA),$SIZE(NB)))); indx [o]nc())
2128             Types: (sbyte byte short ushort long ulong indx ulonglong longlong
2129             float double ldouble)
2130              
2131             =for usage
2132              
2133             ($c, $nc) = intersectvec($a, $b);
2134             intersectvec($a, $b, $c, $nc); # all arguments given
2135             ($c, $nc) = $a->intersectvec($b); # method call
2136             $a->intersectvec($b, $c, $nc);
2137              
2138             =for ref
2139              
2140             Intersection of two vector-valued PDLs.
2141             Input PDLs $a() and $b() B be sorted in lexicographic order.
2142             On return, $nc() holds the actual number of vector-values in the intersection.
2143              
2144             In scalar context, slices $c() to the actual number of elements in the intersection
2145             and returns the sliced PDL.
2146              
2147             Contributed by Bryan Jurish Emoocow@cpan.orgE.
2148              
2149             =pod
2150              
2151             Broadcasts over its inputs.
2152              
2153             =for bad
2154              
2155             C does not process bad values.
2156             It will set the bad-value flag of all output ndarrays if the flag is set for any of the input ndarrays.
2157              
2158             =cut
2159              
2160              
2161              
2162              
2163              
2164             #line 1767 "lib/PDL/Primitive.pd"
2165             sub PDL::intersectvec {
2166             my ($a,$b,$c,$nc) = @_;
2167             $c = PDL->null if (!defined($c));
2168             $nc = PDL->null if (!defined($nc));
2169             PDL::_intersectvec_int($a,$b,$c,$nc);
2170             return ($c,$nc) if (wantarray);
2171             my $nc_max = $nc->max;
2172             return ($nc_max > 0
2173             ? $c->slice(",0:".($nc_max-1))
2174             : $c->reshape($c->dim(0), 0, ($c->dims)[2..($c->ndims-1)]));
2175             }
2176             #line 2177 "lib/PDL/Primitive.pm"
2177              
2178             *intersectvec = \&PDL::intersectvec;
2179              
2180              
2181              
2182              
2183              
2184              
2185             =head2 setdiffvec
2186              
2187             =for sig
2188              
2189             Signature: (a(M,NA); b(M,NB); [o]c(M,NC=CALC($SIZE(NA))); indx [o]nc())
2190             Types: (sbyte byte short ushort long ulong indx ulonglong longlong
2191             float double ldouble)
2192              
2193             =for usage
2194              
2195             ($c, $nc) = setdiffvec($a, $b);
2196             setdiffvec($a, $b, $c, $nc); # all arguments given
2197             ($c, $nc) = $a->setdiffvec($b); # method call
2198             $a->setdiffvec($b, $c, $nc);
2199              
2200             =for ref
2201              
2202             Set-difference ($a() \ $b()) of two vector-valued PDLs.
2203              
2204             Input PDLs $a() and $b() B be sorted in lexicographic order.
2205             On return, $nc() holds the actual number of vector-values in the computed vector set.
2206              
2207             In scalar context, slices $c() to the actual number of elements in the output vector set
2208             and returns the sliced PDL.
2209              
2210             Contributed by Bryan Jurish Emoocow@cpan.orgE.
2211              
2212             =pod
2213              
2214             Broadcasts over its inputs.
2215              
2216             =for bad
2217              
2218             C does not process bad values.
2219             It will set the bad-value flag of all output ndarrays if the flag is set for any of the input ndarrays.
2220              
2221             =cut
2222              
2223              
2224              
2225              
2226              
2227             #line 1822 "lib/PDL/Primitive.pd"
2228             sub PDL::setdiffvec {
2229             my ($a,$b,$c,$nc) = @_;
2230             $c = PDL->null if (!defined($c));
2231             $nc = PDL->null if (!defined($nc));
2232             PDL::_setdiffvec_int($a,$b,$c,$nc);
2233             return ($c,$nc) if (wantarray);
2234             my $nc_max = $nc->max;
2235             return ($nc_max > 0
2236             ? $c->slice(",0:".($nc_max-1))
2237             : $c->reshape($c->dim(0), 0, ($c->dims)[2..($c->ndims-1)]));
2238             }
2239             #line 2240 "lib/PDL/Primitive.pm"
2240              
2241             *setdiffvec = \&PDL::setdiffvec;
2242              
2243              
2244              
2245              
2246              
2247              
2248             =head2 union_sorted
2249              
2250             =for sig
2251              
2252             Signature: (a(NA); b(NB); [o]c(NC=CALC($SIZE(NA) + $SIZE(NB))); indx [o]nc())
2253             Types: (sbyte byte short ushort long ulong indx ulonglong longlong
2254             float double ldouble)
2255              
2256             =for usage
2257              
2258             ($c, $nc) = union_sorted($a, $b);
2259             union_sorted($a, $b, $c, $nc); # all arguments given
2260             ($c, $nc) = $a->union_sorted($b); # method call
2261             $a->union_sorted($b, $c, $nc);
2262              
2263             =for ref
2264              
2265             Union of two flat sorted unique-valued PDLs.
2266             Input PDLs $a() and $b() B be sorted in lexicographic order and contain no duplicates.
2267             On return, $nc() holds the actual number of values in the union.
2268              
2269             In scalar context, reshapes $c() to the actual number of elements in the union and returns it.
2270              
2271             Contributed by Bryan Jurish Emoocow@cpan.orgE.
2272              
2273             =pod
2274              
2275             Broadcasts over its inputs.
2276              
2277             =for bad
2278              
2279             C does not process bad values.
2280             It will set the bad-value flag of all output ndarrays if the flag is set for any of the input ndarrays.
2281              
2282             =cut
2283              
2284              
2285              
2286              
2287              
2288             #line 1888 "lib/PDL/Primitive.pd"
2289             sub PDL::union_sorted {
2290             my ($a,$b,$c,$nc) = @_;
2291             $c = PDL->null if (!defined($c));
2292             $nc = PDL->null if (!defined($nc));
2293             PDL::_union_sorted_int($a,$b,$c,$nc);
2294             return ($c,$nc) if (wantarray);
2295             return $c->slice("0:".($nc->max-1));
2296             }
2297             #line 2298 "lib/PDL/Primitive.pm"
2298              
2299             *union_sorted = \&PDL::union_sorted;
2300              
2301              
2302              
2303              
2304              
2305              
2306             =head2 intersect_sorted
2307              
2308             =for sig
2309              
2310             Signature: (a(NA); b(NB); [o]c(NC=CALC(PDLMIN($SIZE(NA),$SIZE(NB)))); indx [o]nc())
2311             Types: (sbyte byte short ushort long ulong indx ulonglong longlong
2312             float double ldouble)
2313              
2314             =for usage
2315              
2316             ($c, $nc) = intersect_sorted($a, $b);
2317             intersect_sorted($a, $b, $c, $nc); # all arguments given
2318             ($c, $nc) = $a->intersect_sorted($b); # method call
2319             $a->intersect_sorted($b, $c, $nc);
2320              
2321             =for ref
2322              
2323             Intersection of two flat sorted unique-valued PDLs.
2324             Input PDLs $a() and $b() B be sorted in lexicographic order and contain no duplicates.
2325             On return, $nc() holds the actual number of values in the intersection.
2326              
2327             In scalar context, reshapes $c() to the actual number of elements in the intersection and returns it.
2328              
2329             Contributed by Bryan Jurish Emoocow@cpan.orgE.
2330              
2331             =pod
2332              
2333             Broadcasts over its inputs.
2334              
2335             =for bad
2336              
2337             C does not process bad values.
2338             It will set the bad-value flag of all output ndarrays if the flag is set for any of the input ndarrays.
2339              
2340             =cut
2341              
2342              
2343              
2344              
2345              
2346             #line 1947 "lib/PDL/Primitive.pd"
2347             sub PDL::intersect_sorted {
2348             my ($a,$b,$c,$nc) = @_;
2349             $c = PDL->null if (!defined($c));
2350             $nc = PDL->null if (!defined($nc));
2351             PDL::_intersect_sorted_int($a,$b,$c,$nc);
2352             return ($c,$nc) if (wantarray);
2353             my $nc_max = $nc->max;
2354             return ($nc_max > 0
2355             ? $c->slice("0:".($nc_max-1))
2356             : $c->reshape(0, ($c->dims)[1..($c->ndims-1)]));
2357             }
2358             #line 2359 "lib/PDL/Primitive.pm"
2359              
2360             *intersect_sorted = \&PDL::intersect_sorted;
2361              
2362              
2363              
2364              
2365              
2366              
2367             =head2 setdiff_sorted
2368              
2369             =for sig
2370              
2371             Signature: (a(NA); b(NB); [o]c(NC=CALC($SIZE(NA))); indx [o]nc())
2372             Types: (sbyte byte short ushort long ulong indx ulonglong longlong
2373             float double ldouble)
2374              
2375             =for usage
2376              
2377             ($c, $nc) = setdiff_sorted($a, $b);
2378             setdiff_sorted($a, $b, $c, $nc); # all arguments given
2379             ($c, $nc) = $a->setdiff_sorted($b); # method call
2380             $a->setdiff_sorted($b, $c, $nc);
2381              
2382             =for ref
2383              
2384             Set-difference ($a() \ $b()) of two flat sorted unique-valued PDLs.
2385              
2386             Input PDLs $a() and $b() B be sorted in lexicographic order and contain no duplicate values.
2387             On return, $nc() holds the actual number of values in the computed vector set.
2388              
2389             In scalar context, reshapes $c() to the actual number of elements in the difference set and returns it.
2390              
2391             Contributed by Bryan Jurish Emoocow@cpan.orgE.
2392              
2393             =pod
2394              
2395             Broadcasts over its inputs.
2396              
2397             =for bad
2398              
2399             C does not process bad values.
2400             It will set the bad-value flag of all output ndarrays if the flag is set for any of the input ndarrays.
2401              
2402             =cut
2403              
2404              
2405              
2406              
2407              
2408             #line 2003 "lib/PDL/Primitive.pd"
2409             sub PDL::setdiff_sorted {
2410             my ($a,$b,$c,$nc) = @_;
2411             $c = PDL->null if (!defined($c));
2412             $nc = PDL->null if (!defined($nc));
2413             PDL::_setdiff_sorted_int($a,$b,$c,$nc);
2414             return ($c,$nc) if (wantarray);
2415             my $nc_max = $nc->max;
2416             return ($nc_max > 0
2417             ? $c->slice("0:".($nc_max-1))
2418             : $c->reshape(0, ($c->dims)[1..($c->ndims-1)]));
2419             }
2420             #line 2421 "lib/PDL/Primitive.pm"
2421              
2422             *setdiff_sorted = \&PDL::setdiff_sorted;
2423              
2424              
2425              
2426              
2427              
2428              
2429             =head2 vcos
2430              
2431             =for sig
2432              
2433             Signature: (a(M,N);b(M);float+ [o]vcos(N))
2434             Types: (sbyte byte short ushort long ulong indx ulonglong longlong
2435             float double ldouble cfloat cdouble cldouble)
2436              
2437             =for usage
2438              
2439             $vcos = vcos($a, $b);
2440             vcos($a, $b, $vcos); # all arguments given
2441             $vcos = $a->vcos($b); # method call
2442             $a->vcos($b, $vcos);
2443              
2444             Computes the vector cosine similarity of a dense vector $b() with respect
2445             to each row $a(*,i) of a dense PDL $a(). This is basically the same
2446             thing as:
2447              
2448             inner($a, $b) / $a->magnover * $b->magnover
2449              
2450             ... but should be much faster to compute, and avoids allocating
2451             potentially large temporaries for the vector magnitudes. Output values
2452             in $vcos() are cosine similarities in the range [-1,1], except for
2453             zero-magnitude vectors which will result in NaN values in $vcos().
2454              
2455             You can use PDL broadcasting to batch-compute distances for multiple $b()
2456             vectors simultaneously:
2457              
2458             $bx = random($M, $NB); ##-- get $NB random vectors of size $N
2459             $vcos = vcos($a,$bx); ##-- $vcos(i,j) ~ sim($a(,i),$b(,j))
2460              
2461             Contributed by Bryan Jurish Emoocow@cpan.orgE.
2462              
2463             =pod
2464              
2465             Broadcasts over its inputs.
2466              
2467             =for bad
2468              
2469             vcos() will set the bad status flag on the output $vcos() if
2470             it is set on either of the inputs $a() or $b(), but BAD values
2471             will otherwise be ignored for computing the cosine similarity.
2472              
2473             =cut
2474              
2475              
2476              
2477              
2478             *vcos = \&PDL::vcos;
2479              
2480              
2481              
2482              
2483              
2484              
2485             =head2 srandom
2486              
2487             =for sig
2488              
2489             Signature: (a())
2490             Types: (longlong)
2491              
2492             =for ref
2493              
2494             Seed random-number generator with a 64-bit int. Will generate seed data
2495             for a number of threads equal to the return-value of
2496             L.
2497             As of 2.062, the generator changed from Perl's generator to xoshiro256++
2498             (see L).
2499             Before PDL 2.090, this was called C, but was renamed to avoid
2500             clashing with Perl's built-in.
2501              
2502             =for usage
2503              
2504             srandom(); # uses current time
2505             srandom(5); # fixed number e.g. for testing
2506              
2507             =pod
2508              
2509             Does not broadcast.
2510             Can't use POSIX threads.
2511              
2512             =for bad
2513              
2514             C does not process bad values.
2515             It will set the bad-value flag of all output ndarrays if the flag is set for any of the input ndarrays.
2516              
2517             =cut
2518              
2519              
2520              
2521              
2522              
2523             #line 2179 "lib/PDL/Primitive.pd"
2524             *srandom = \&PDL::srandom;
2525             sub PDL::srandom { PDL::_srandom_int($_[0] // PDL::Core::seed()) }
2526             #line 2527 "lib/PDL/Primitive.pm"
2527              
2528             *srandom = \&PDL::srandom;
2529              
2530              
2531              
2532              
2533              
2534              
2535             =head2 random
2536              
2537             =for sig
2538              
2539             Signature: ([o] a())
2540             Types: (sbyte byte short ushort long ulong indx ulonglong longlong
2541             float double ldouble)
2542              
2543             =for ref
2544              
2545             Constructor which returns ndarray of random numbers, real data-types only.
2546              
2547             =for usage
2548              
2549             $x = random([type], $nx, $ny, $nz,...);
2550             $x = random $y;
2551              
2552             etc (see L).
2553              
2554             This is the uniform distribution between 0 and 1 (assumedly
2555             excluding 1 itself). The arguments are the same as C
2556             (q.v.) - i.e. one can specify dimensions, types or give
2557             a template.
2558              
2559             You can use the PDL function L to seed the random generator.
2560             If it has not been called yet, it will be with the current time.
2561             As of 2.062, the generator changed from Perl's generator to xoshiro256++
2562             (see L).
2563              
2564             =pod
2565              
2566             Broadcasts over its inputs.
2567              
2568             =for bad
2569              
2570             C does not process bad values.
2571             It will set the bad-value flag of all output ndarrays if the flag is set for any of the input ndarrays.
2572              
2573             =cut
2574              
2575              
2576              
2577              
2578              
2579             #line 2219 "lib/PDL/Primitive.pd"
2580             sub random { ref($_[0]) && ref($_[0]) ne 'PDL::Type' ? $_[0]->random : PDL->random(@_) }
2581             sub PDL::random {
2582             splice @_, 1, 0, double() if !ref($_[0]) and @_<=1;
2583             my $x = &PDL::Core::_construct;
2584             PDL::_random_int($x);
2585             return $x;
2586             }
2587             #line 2588 "lib/PDL/Primitive.pm"
2588              
2589              
2590             =head2 randsym
2591              
2592             =for sig
2593              
2594             Signature: ([o] a())
2595             Types: (sbyte byte short ushort long ulong indx ulonglong longlong
2596             float double ldouble)
2597              
2598             =for ref
2599              
2600             Constructor which returns ndarray of random numbers, real data-types only.
2601              
2602             =for usage
2603              
2604             $x = randsym([type], $nx, $ny, $nz,...);
2605             $x = randsym $y;
2606              
2607             etc (see L).
2608              
2609             This is the uniform distribution between 0 and 1 (excluding both 0 and
2610             1, cf L). The arguments are the same as C (q.v.) -
2611             i.e. one can specify dimensions, types or give a template.
2612              
2613             You can use the PDL function L to seed the random generator.
2614             If it has not been called yet, it will be with the current time.
2615              
2616             =pod
2617              
2618             Broadcasts over its inputs.
2619              
2620             =for bad
2621              
2622             C does not process bad values.
2623             It will set the bad-value flag of all output ndarrays if the flag is set for any of the input ndarrays.
2624              
2625             =cut
2626              
2627              
2628              
2629              
2630              
2631             #line 2263 "lib/PDL/Primitive.pd"
2632             sub randsym { ref($_[0]) && ref($_[0]) ne 'PDL::Type' ? $_[0]->randsym : PDL->randsym(@_) }
2633             sub PDL::randsym {
2634             splice @_, 1, 0, double() if !ref($_[0]) and @_<=1;
2635             my $x = &PDL::Core::_construct;
2636             PDL::_randsym_int($x);
2637             return $x;
2638             }
2639              
2640             #line 2274 "lib/PDL/Primitive.pd"
2641              
2642             =head2 grandom
2643              
2644             =for ref
2645              
2646             Constructor which returns ndarray of Gaussian random numbers
2647              
2648             =for usage
2649              
2650             $x = grandom([type], $nx, $ny, $nz,...);
2651             $x = grandom $y;
2652              
2653             etc (see L).
2654              
2655             This is generated using the math library routine C.
2656              
2657             Mean = 0, Stddev = 1
2658              
2659             You can use the PDL function L to seed the random generator.
2660             If it has not been called yet, it will be with the current time.
2661              
2662             =cut
2663              
2664             sub grandom { ref($_[0]) && ref($_[0]) ne 'PDL::Type' ? $_[0]->grandom : PDL->grandom(@_) }
2665             sub PDL::grandom {
2666             my $x = &PDL::Core::_construct;
2667             use PDL::Math 'ndtri';
2668             $x .= ndtri(randsym($x));
2669             return $x;
2670             }
2671              
2672             #line 2313 "lib/PDL/Primitive.pd"
2673              
2674             =head2 vsearch
2675              
2676             =for sig
2677              
2678             Signature: ( vals(); xs(n); [o] indx(); [\%options] )
2679              
2680             =for ref
2681              
2682             Efficiently search for values in a sorted ndarray, returning indices.
2683              
2684             =for usage
2685              
2686             $idx = vsearch( $vals, $x, [\%options] );
2687             vsearch( $vals, $x, $idx, [\%options ] );
2688              
2689             B performs a binary search in the ordered ndarray C<$x>,
2690             for the values from C<$vals> ndarray, returning indices into C<$x>.
2691             What is a "match", and the meaning of the returned indices, are determined
2692             by the options.
2693              
2694             The C option indicates which method of searching to use, and may
2695             be one of:
2696              
2697             =over
2698              
2699             =item C
2700              
2701             invoke L|/vsearch_sample>, returning indices appropriate for sampling
2702             within a distribution.
2703              
2704             =item C
2705              
2706             invoke L|/vsearch_insert_leftmost>, returning the left-most possible
2707             insertion point which still leaves the ndarray sorted.
2708              
2709             =item C
2710              
2711             invoke L|/vsearch_insert_rightmost>, returning the right-most possible
2712             insertion point which still leaves the ndarray sorted.
2713              
2714             =item C
2715              
2716             invoke L|/vsearch_match>, returning the index of a matching element,
2717             else -(insertion point + 1)
2718              
2719             =item C
2720              
2721             invoke L|/vsearch_bin_inclusive>, returning an index appropriate for binning
2722             on a grid where the left bin edges are I of the bin. See
2723             below for further explanation of the bin.
2724              
2725             =item C
2726              
2727             invoke L|/vsearch_bin_exclusive>, returning an index appropriate for binning
2728             on a grid where the left bin edges are I of the bin. See
2729             below for further explanation of the bin.
2730              
2731             =back
2732              
2733             The default value of C is C.
2734              
2735             =for example
2736              
2737             use PDL;
2738              
2739             my @modes = qw( sample insert_leftmost insert_rightmost match
2740             bin_inclusive bin_exclusive );
2741              
2742             # Generate a sequence of 3 zeros, 3 ones, ..., 3 fours.
2743             my $x = zeroes(3,5)->yvals->flat;
2744              
2745             for my $mode ( @modes ) {
2746             # if the value is in $x
2747             my $contained = 2;
2748             my $idx_contained = vsearch( $contained, $x, { mode => $mode } );
2749             my $x_contained = $x->copy;
2750             $x_contained->slice( $idx_contained ) .= 9;
2751              
2752             # if the value is not in $x
2753             my $not_contained = 1.5;
2754             my $idx_not_contained = vsearch( $not_contained, $x, { mode => $mode } );
2755             my $x_not_contained = $x->copy;
2756             $x_not_contained->slice( $idx_not_contained ) .= 9;
2757              
2758             print sprintf("%-23s%30s\n", '$x', $x);
2759             print sprintf("%-23s%30s\n", "$mode ($contained)", $x_contained);
2760             print sprintf("%-23s%30s\n\n", "$mode ($not_contained)", $x_not_contained);
2761             }
2762              
2763             # $x [0 0 0 1 1 1 2 2 2 3 3 3 4 4 4]
2764             # sample (2) [0 0 0 1 1 1 9 2 2 3 3 3 4 4 4]
2765             # sample (1.5) [0 0 0 1 1 1 9 2 2 3 3 3 4 4 4]
2766             #
2767             # $x [0 0 0 1 1 1 2 2 2 3 3 3 4 4 4]
2768             # insert_leftmost (2) [0 0 0 1 1 1 9 2 2 3 3 3 4 4 4]
2769             # insert_leftmost (1.5) [0 0 0 1 1 1 9 2 2 3 3 3 4 4 4]
2770             #
2771             # $x [0 0 0 1 1 1 2 2 2 3 3 3 4 4 4]
2772             # insert_rightmost (2) [0 0 0 1 1 1 2 2 2 9 3 3 4 4 4]
2773             # insert_rightmost (1.5) [0 0 0 1 1 1 9 2 2 3 3 3 4 4 4]
2774             #
2775             # $x [0 0 0 1 1 1 2 2 2 3 3 3 4 4 4]
2776             # match (2) [0 0 0 1 1 1 2 9 2 3 3 3 4 4 4]
2777             # match (1.5) [0 0 0 1 1 1 2 2 9 3 3 3 4 4 4]
2778             #
2779             # $x [0 0 0 1 1 1 2 2 2 3 3 3 4 4 4]
2780             # bin_inclusive (2) [0 0 0 1 1 1 2 2 9 3 3 3 4 4 4]
2781             # bin_inclusive (1.5) [0 0 0 1 1 9 2 2 2 3 3 3 4 4 4]
2782             #
2783             # $x [0 0 0 1 1 1 2 2 2 3 3 3 4 4 4]
2784             # bin_exclusive (2) [0 0 0 1 1 9 2 2 2 3 3 3 4 4 4]
2785             # bin_exclusive (1.5) [0 0 0 1 1 9 2 2 2 3 3 3 4 4 4]
2786              
2787             Also see
2788             L|/vsearch_sample>,
2789             L|/vsearch_insert_leftmost>,
2790             L|/vsearch_insert_rightmost>,
2791             L|/vsearch_match>,
2792             L|/vsearch_bin_inclusive>, and
2793             L|/vsearch_bin_exclusive>
2794              
2795             =cut
2796              
2797             sub vsearch {
2798             my $opt = 'HASH' eq ref $_[-1]
2799             ? pop
2800             : { mode => 'sample' };
2801              
2802             croak( "unknown options to vsearch\n" )
2803             if ( ! defined $opt->{mode} && keys %$opt )
2804             || keys %$opt > 1;
2805              
2806             my $mode = $opt->{mode};
2807             goto
2808             $mode eq 'sample' ? \&vsearch_sample
2809             : $mode eq 'insert_leftmost' ? \&vsearch_insert_leftmost
2810             : $mode eq 'insert_rightmost' ? \&vsearch_insert_rightmost
2811             : $mode eq 'match' ? \&vsearch_match
2812             : $mode eq 'bin_inclusive' ? \&vsearch_bin_inclusive
2813             : $mode eq 'bin_exclusive' ? \&vsearch_bin_exclusive
2814             : croak( "unknown vsearch mode: $mode\n" );
2815             }
2816              
2817             *PDL::vsearch = \&vsearch;
2818             #line 2819 "lib/PDL/Primitive.pm"
2819              
2820              
2821             =head2 vsearch_sample
2822              
2823             =for sig
2824              
2825             Signature: (vals(); x(n); indx [o]idx())
2826             Types: (float double ldouble)
2827              
2828             =for ref
2829              
2830             Search for values in a sorted array, return index appropriate for sampling from a distribution
2831              
2832             =for usage
2833              
2834             $idx = vsearch_sample($vals, $x);
2835              
2836             C<$x> must be sorted, but may be in decreasing or increasing
2837             order. if C<$x> is empty, then all values in C<$idx> will be
2838             set to the bad value.
2839              
2840             B returns an index I for each value I of C<$vals> appropriate
2841             for sampling C<$vals>
2842              
2843            
2844              
2845             I has the following properties:
2846              
2847             =over
2848              
2849             =item *
2850              
2851             if C<$x> is sorted in increasing order
2852              
2853             V <= x[0] : I = 0
2854             x[0] < V <= x[-1] : I s.t. x[I-1] < V <= x[I]
2855             x[-1] < V : I = $x->nelem -1
2856              
2857             =item *
2858              
2859             if C<$x> is sorted in decreasing order
2860              
2861             V > x[0] : I = 0
2862             x[0] >= V > x[-1] : I s.t. x[I] >= V > x[I+1]
2863             x[-1] >= V : I = $x->nelem - 1
2864              
2865             =back
2866              
2867             If all elements of C<$x> are equal, I<< I = $x->nelem - 1 >>.
2868              
2869             If C<$x> contains duplicated elements, I is the index of the
2870             leftmost (by position in array) duplicate if I matches.
2871              
2872             =for example
2873              
2874             This function is useful e.g. when you have a list of probabilities
2875             for events and want to generate indices to events:
2876              
2877             $x = pdl(.01,.86,.93,1); # Barnsley IFS probabilities cumulatively
2878             $y = random 20;
2879             $c = vsearch_sample($y, $x); # Now, $c will have the appropriate distr.
2880              
2881             It is possible to use the L
2882             function to obtain cumulative probabilities from absolute probabilities.
2883              
2884             =pod
2885              
2886             Broadcasts over its inputs.
2887              
2888             =for bad
2889              
2890             bad values in vals() result in bad values in idx()
2891              
2892             =cut
2893              
2894              
2895              
2896              
2897             *vsearch_sample = \&PDL::vsearch_sample;
2898              
2899              
2900              
2901              
2902              
2903              
2904             =head2 vsearch_insert_leftmost
2905              
2906             =for sig
2907              
2908             Signature: (vals(); x(n); indx [o]idx())
2909             Types: (float double ldouble)
2910              
2911             =for ref
2912              
2913             Determine the insertion point for values in a sorted array, inserting before duplicates.
2914              
2915             =for usage
2916              
2917             $idx = vsearch_insert_leftmost($vals, $x);
2918              
2919             C<$x> must be sorted, but may be in decreasing or increasing
2920             order. if C<$x> is empty, then all values in C<$idx> will be
2921             set to the bad value.
2922              
2923             B returns an index I for each value I of
2924             C<$vals> equal to the leftmost position (by index in array) within
2925             C<$x> that I may be inserted and still maintain the order in
2926             C<$x>.
2927              
2928             Insertion at index I involves shifting elements I and higher of
2929             C<$x> to the right by one and setting the now empty element at index
2930             I to I.
2931              
2932            
2933              
2934             I has the following properties:
2935              
2936             =over
2937              
2938             =item *
2939              
2940             if C<$x> is sorted in increasing order
2941              
2942             V <= x[0] : I = 0
2943             x[0] < V <= x[-1] : I s.t. x[I-1] < V <= x[I]
2944             x[-1] < V : I = $x->nelem
2945              
2946             =item *
2947              
2948             if C<$x> is sorted in decreasing order
2949              
2950             V > x[0] : I = -1
2951             x[0] >= V >= x[-1] : I s.t. x[I] >= V > x[I+1]
2952             x[-1] >= V : I = $x->nelem -1
2953              
2954             =back
2955              
2956             If all elements of C<$x> are equal,
2957              
2958             i = 0
2959              
2960             If C<$x> contains duplicated elements, I is the index of the
2961             leftmost (by index in array) duplicate if I matches.
2962              
2963             =pod
2964              
2965             Broadcasts over its inputs.
2966              
2967             =for bad
2968              
2969             bad values in vals() result in bad values in idx()
2970              
2971             =cut
2972              
2973              
2974              
2975              
2976             *vsearch_insert_leftmost = \&PDL::vsearch_insert_leftmost;
2977              
2978              
2979              
2980              
2981              
2982              
2983             =head2 vsearch_insert_rightmost
2984              
2985             =for sig
2986              
2987             Signature: (vals(); x(n); indx [o]idx())
2988             Types: (float double ldouble)
2989              
2990             =for ref
2991              
2992             Determine the insertion point for values in a sorted array, inserting after duplicates.
2993              
2994             =for usage
2995              
2996             $idx = vsearch_insert_rightmost($vals, $x);
2997              
2998             C<$x> must be sorted, but may be in decreasing or increasing
2999             order. if C<$x> is empty, then all values in C<$idx> will be
3000             set to the bad value.
3001              
3002             B returns an index I for each value I of
3003             C<$vals> equal to the rightmost position (by index in array) within
3004             C<$x> that I may be inserted and still maintain the order in
3005             C<$x>.
3006              
3007             Insertion at index I involves shifting elements I and higher of
3008             C<$x> to the right by one and setting the now empty element at index
3009             I to I.
3010              
3011            
3012              
3013             I has the following properties:
3014              
3015             =over
3016              
3017             =item *
3018              
3019             if C<$x> is sorted in increasing order
3020              
3021             V < x[0] : I = 0
3022             x[0] <= V < x[-1] : I s.t. x[I-1] <= V < x[I]
3023             x[-1] <= V : I = $x->nelem
3024              
3025             =item *
3026              
3027             if C<$x> is sorted in decreasing order
3028              
3029             V >= x[0] : I = -1
3030             x[0] > V >= x[-1] : I s.t. x[I] >= V > x[I+1]
3031             x[-1] > V : I = $x->nelem -1
3032              
3033             =back
3034              
3035             If all elements of C<$x> are equal,
3036              
3037             i = $x->nelem - 1
3038              
3039             If C<$x> contains duplicated elements, I is the index of the
3040             leftmost (by index in array) duplicate if I matches.
3041              
3042             =pod
3043              
3044             Broadcasts over its inputs.
3045              
3046             =for bad
3047              
3048             bad values in vals() result in bad values in idx()
3049              
3050             =cut
3051              
3052              
3053              
3054              
3055             *vsearch_insert_rightmost = \&PDL::vsearch_insert_rightmost;
3056              
3057              
3058              
3059              
3060              
3061              
3062             =head2 vsearch_match
3063              
3064             =for sig
3065              
3066             Signature: (vals(); x(n); indx [o]idx())
3067             Types: (float double ldouble)
3068              
3069             =for ref
3070              
3071             Match values against a sorted array.
3072              
3073             =for usage
3074              
3075             $idx = vsearch_match($vals, $x);
3076              
3077             C<$x> must be sorted, but may be in decreasing or increasing
3078             order. if C<$x> is empty, then all values in C<$idx> will be
3079             set to the bad value.
3080              
3081             B returns an index I for each value I of
3082             C<$vals>. If I matches an element in C<$x>, I is the
3083             index of that element, otherwise it is I<-( insertion_point + 1 )>,
3084             where I is an index in C<$x> where I may be
3085             inserted while maintaining the order in C<$x>. If C<$x> has
3086             duplicated values, I may refer to any of them.
3087              
3088            
3089              
3090             =pod
3091              
3092             Broadcasts over its inputs.
3093              
3094             =for bad
3095              
3096             bad values in vals() result in bad values in idx()
3097              
3098             =cut
3099              
3100              
3101              
3102              
3103             *vsearch_match = \&PDL::vsearch_match;
3104              
3105              
3106              
3107              
3108              
3109              
3110             =head2 vsearch_bin_inclusive
3111              
3112             =for sig
3113              
3114             Signature: (vals(); x(n); indx [o]idx())
3115             Types: (float double ldouble)
3116              
3117             =for ref
3118              
3119             Determine the index for values in a sorted array of bins, lower bound inclusive.
3120              
3121             =for usage
3122              
3123             $idx = vsearch_bin_inclusive($vals, $x);
3124              
3125             C<$x> must be sorted, but may be in decreasing or increasing
3126             order. if C<$x> is empty, then all values in C<$idx> will be
3127             set to the bad value.
3128              
3129             C<$x> represents the edges of contiguous bins, with the first and
3130             last elements representing the outer edges of the outer bins, and the
3131             inner elements the shared bin edges.
3132              
3133             The lower bound of a bin is inclusive to the bin, its outer bound is exclusive to it.
3134             B returns an index I for each value I of C<$vals>
3135              
3136            
3137              
3138             I has the following properties:
3139              
3140             =over
3141              
3142             =item *
3143              
3144             if C<$x> is sorted in increasing order
3145              
3146             V < x[0] : I = -1
3147             x[0] <= V < x[-1] : I s.t. x[I] <= V < x[I+1]
3148             x[-1] <= V : I = $x->nelem - 1
3149              
3150             =item *
3151              
3152             if C<$x> is sorted in decreasing order
3153              
3154             V >= x[0] : I = 0
3155             x[0] > V >= x[-1] : I s.t. x[I+1] > V >= x[I]
3156             x[-1] > V : I = $x->nelem
3157              
3158             =back
3159              
3160             If all elements of C<$x> are equal,
3161              
3162             i = $x->nelem - 1
3163              
3164             If C<$x> contains duplicated elements, I is the index of the
3165             righmost (by index in array) duplicate if I matches.
3166              
3167             =pod
3168              
3169             Broadcasts over its inputs.
3170              
3171             =for bad
3172              
3173             bad values in vals() result in bad values in idx()
3174              
3175             =cut
3176              
3177              
3178              
3179              
3180             *vsearch_bin_inclusive = \&PDL::vsearch_bin_inclusive;
3181              
3182              
3183              
3184              
3185              
3186              
3187             =head2 vsearch_bin_exclusive
3188              
3189             =for sig
3190              
3191             Signature: (vals(); x(n); indx [o]idx())
3192             Types: (float double ldouble)
3193              
3194             =for ref
3195              
3196             Determine the index for values in a sorted array of bins, lower bound exclusive.
3197              
3198             =for usage
3199              
3200             $idx = vsearch_bin_exclusive($vals, $x);
3201              
3202             C<$x> must be sorted, but may be in decreasing or increasing
3203             order. if C<$x> is empty, then all values in C<$idx> will be
3204             set to the bad value.
3205              
3206             C<$x> represents the edges of contiguous bins, with the first and
3207             last elements representing the outer edges of the outer bins, and the
3208             inner elements the shared bin edges.
3209              
3210             The lower bound of a bin is exclusive to the bin, its upper bound is inclusive to it.
3211             B returns an index I for each value I of C<$vals>.
3212              
3213            
3214              
3215             I has the following properties:
3216              
3217             =over
3218              
3219             =item *
3220              
3221             if C<$x> is sorted in increasing order
3222              
3223             V <= x[0] : I = -1
3224             x[0] < V <= x[-1] : I s.t. x[I] < V <= x[I+1]
3225             x[-1] < V : I = $x->nelem - 1
3226              
3227             =item *
3228              
3229             if C<$x> is sorted in decreasing order
3230              
3231             V > x[0] : I = 0
3232             x[0] >= V > x[-1] : I s.t. x[I-1] >= V > x[I]
3233             x[-1] >= V : I = $x->nelem
3234              
3235             =back
3236              
3237             If all elements of C<$x> are equal,
3238              
3239             i = $x->nelem - 1
3240              
3241             If C<$x> contains duplicated elements, I is the index of the
3242             righmost (by index in array) duplicate if I matches.
3243              
3244             =pod
3245              
3246             Broadcasts over its inputs.
3247              
3248             =for bad
3249              
3250             bad values in vals() result in bad values in idx()
3251              
3252             =cut
3253              
3254              
3255              
3256              
3257             *vsearch_bin_exclusive = \&PDL::vsearch_bin_exclusive;
3258              
3259              
3260              
3261              
3262              
3263              
3264             =head2 interpolate
3265              
3266             =for sig
3267              
3268             Signature: (!complex xi(); !complex x(n); y(n); [o] yi(); int [o] err())
3269             Types: (float ldouble cfloat cdouble cldouble double)
3270              
3271             =for usage
3272              
3273             ($yi, $err) = interpolate($xi, $x, $y);
3274             interpolate($xi, $x, $y, $yi, $err); # all arguments given
3275             ($yi, $err) = $xi->interpolate($x, $y); # method call
3276             $xi->interpolate($x, $y, $yi, $err);
3277              
3278             =for ref
3279              
3280             routine for 1D linear interpolation
3281              
3282             Given a set of points C<($x,$y)>, use linear interpolation
3283             to find the values C<$yi> at a set of points C<$xi>.
3284              
3285             C uses a binary search to find the suspects, er...,
3286             interpolation indices and therefore abscissas (ie C<$x>)
3287             have to be I ordered (increasing or decreasing).
3288             For interpolation at lots of
3289             closely spaced abscissas an approach that uses the last index found as
3290             a start for the next search can be faster (compare Numerical Recipes
3291             C routine). Feel free to implement that on top of the binary
3292             search if you like. For out of bounds values it just does a linear
3293             extrapolation and sets the corresponding element of C<$err> to 1,
3294             which is otherwise 0.
3295              
3296             See also L, which uses the same routine,
3297             differing only in the handling of extrapolation - an error message
3298             is printed rather than returning an error ndarray.
3299              
3300             Note that C can use complex values for C<$y> and C<$yi> but
3301             C<$x> and C<$xi> must be real.
3302              
3303             =pod
3304              
3305             Broadcasts over its inputs.
3306              
3307             =for bad
3308              
3309             needs major (?) work to handles bad values
3310              
3311             =cut
3312              
3313              
3314              
3315              
3316             *interpolate = \&PDL::interpolate;
3317              
3318              
3319              
3320              
3321              
3322             #line 2987 "lib/PDL/Primitive.pd"
3323              
3324             =head2 interpol
3325              
3326             =for sig
3327              
3328             Signature: (xi(); x(n); y(n); [o] yi())
3329              
3330             =for ref
3331              
3332             routine for 1D linear interpolation
3333              
3334             =for usage
3335              
3336             $yi = interpol($xi, $x, $y)
3337              
3338             C uses the same search method as L,
3339             hence C<$x> must be I ordered (either increasing or decreasing).
3340             The difference occurs in the handling of out-of-bounds values; here
3341             an error message is printed.
3342              
3343             =cut
3344              
3345             # kept in for backwards compatibility
3346             sub interpol ($$$;$) {
3347             my $xi = shift;
3348             my $x = shift;
3349             my $y = shift;
3350             my $yi = @_ == 1 ? $_[0] : PDL->null;
3351             interpolate( $xi, $x, $y, $yi, my $err = PDL->null );
3352             print "some values had to be extrapolated\n"
3353             if any $err;
3354             return $yi if @_ == 0;
3355             } # sub: interpol()
3356             *PDL::interpol = \&interpol;
3357              
3358             #line 3025 "lib/PDL/Primitive.pd"
3359              
3360             =head2 interpND
3361              
3362             =for ref
3363              
3364             Interpolate values from an N-D ndarray, with switchable method
3365              
3366             =for example
3367              
3368             $source = 10*xvals(10,10) + yvals(10,10);
3369             $index = pdl([[2.2,3.5],[4.1,5.0]],[[6.0,7.4],[8,9]]);
3370             print $source->interpND( $index );
3371              
3372             InterpND acts like L,
3373             collapsing C<$index> by lookup
3374             into C<$source>; but it does interpolation rather than direct sampling.
3375             The interpolation method and boundary condition are switchable via
3376             an options hash.
3377              
3378             By default, linear or sample interpolation is used, with constant
3379             value outside the boundaries of the source pdl. No dataflow occurs,
3380             because in general the output is computed rather than indexed.
3381              
3382             All the interpolation methods treat the pixels as value-centered, so
3383             the C method will return C<< $a->(0) >> for coordinate values on
3384             the set [-0.5,0.5], and all methods will return C<< $a->(1) >> for
3385             a coordinate value of exactly 1.
3386              
3387             Recognized options:
3388              
3389             =over 3
3390              
3391             =item method
3392              
3393             Values can be:
3394              
3395             =over 3
3396              
3397             =item * 0, s, sample, Sample (default for integer source types)
3398              
3399             The nearest value is taken. Pixels are regarded as centered on their
3400             respective integer coordinates (no offset from the linear case).
3401              
3402             =item * 1, l, linear, Linear (default for floating point source types)
3403              
3404             The values are N-linearly interpolated from an N-dimensional cube of size 2.
3405              
3406             =item * 3, c, cube, cubic, Cubic
3407              
3408             The values are interpolated using a local cubic fit to the data. The
3409             fit is constrained to match the original data and its derivative at the
3410             data points. The second derivative of the fit is not continuous at the
3411             data points. Multidimensional datasets are interpolated by the
3412             successive-collapse method.
3413              
3414             (Note that the constraint on the first derivative causes a small amount
3415             of ringing around sudden features such as step functions).
3416              
3417             =item * f, fft, fourier, Fourier
3418              
3419             The source is Fourier transformed, and the interpolated values are
3420             explicitly calculated from the coefficients. The boundary condition
3421             option is ignored -- periodic boundaries are imposed.
3422              
3423             If you pass in the option "fft", and it is a list (ARRAY) ref, then it
3424             is a stash for the magnitude and phase of the source FFT. If the list
3425             has two elements then they are taken as already computed; otherwise
3426             they are calculated and put in the stash.
3427              
3428             =back
3429              
3430             =item b, bound, boundary, Boundary
3431              
3432             This option is passed unmodified into L,
3433             which is used as the indexing engine for the interpolation.
3434             Some current allowed values are 'extend', 'periodic', 'truncate', and 'mirror'
3435             (default is 'truncate').
3436              
3437             =item bad
3438              
3439             contains the fill value used for 'truncate' boundary. (default 0)
3440              
3441             =item fft
3442              
3443             An array ref whose associated list is used to stash the FFT of the source
3444             data, for the FFT method.
3445              
3446             =back
3447              
3448             =cut
3449              
3450             *interpND = *PDL::interpND;
3451             sub PDL::interpND {
3452             my $source = shift;
3453             my $index = shift;
3454             my $options = shift;
3455              
3456             barf 'Usage: interpND($source,$index[,{%options}])'
3457             if(defined $options and ref $options ne 'HASH');
3458              
3459             my $opt = defined $options ? $options : {};
3460              
3461             my $method = $opt->{m} || $opt->{meth} || $opt->{method} || $opt->{Method};
3462             $method //= $source->type->integer ? 'sample' : 'linear';
3463              
3464             my $boundary = $opt->{b} || $opt->{boundary} || $opt->{Boundary} || $opt->{bound} || $opt->{Bound} || 'extend';
3465             my $bad = $opt->{bad} || $opt->{Bad} || 0.0;
3466              
3467             return $source->range(PDL::Math::floor($index+0.5),0,$boundary)
3468             if $method =~ m/^s(am(p(le)?)?)?/i;
3469              
3470             if (($method eq 1) || $method =~ m/^l(in(ear)?)?/i) {
3471             ## key: (ith = index broadcast; cth = cube broadcast; sth = source broadcast)
3472             my $d = $index->dim(0);
3473             my $di = $index->ndims - 1;
3474              
3475             # Grab a 2-on-a-side n-cube around each desired pixel
3476             my $samp = $source->range($index->floor,2,$boundary); # (ith, cth, sth)
3477              
3478             # Reorder to put the cube dimensions in front and convert to a list
3479             $samp = $samp->reorder( $di .. $di+$d-1,
3480             0 .. $di-1,
3481             $di+$d .. $samp->ndims-1) # (cth, ith, sth)
3482             ->clump($d); # (clst, ith, sth)
3483              
3484             # Enumerate the corners of an n-cube and convert to a list
3485             # (the 'x' is the normal perl repeat operator)
3486             my $crnr = PDL::Basic::ndcoords( (2) x $index->dim(0) ) # (index,cth)
3487             ->mv(0,-1)->clump($index->dim(0))->mv(-1,0); # (index, clst)
3488             # a & b are the weighting coefficients.
3489             my($x,$y);
3490             $index->where( 0 * $index ) .= -10; # Change NaN to invalid
3491             {
3492             my $bb = PDL::Math::floor($index);
3493             $x = ($index - $bb) -> dummy(1,$crnr->dim(1)); # index, clst, ith
3494             $y = ($bb + 1 - $index) -> dummy(1,$crnr->dim(1)); # index, clst, ith
3495             }
3496              
3497             # Use 1/0 corners to select which multiplier happens, multiply
3498             # 'em all together to get sample weights, and sum to get the answer.
3499             my $out0 = ( ($x * ($crnr==1) + $y * ($crnr==0)) #index, clst, ith
3500             -> prodover #clst, ith
3501             );
3502              
3503             my $out = ($out0 * $samp)->sumover; # ith, sth
3504              
3505             # Work around BAD-not-being-contagious bug in PDL <= 2.6 bad handling code --CED 3-April-2013
3506             if ($source->badflag) {
3507             my $baddies = $samp->isbad->orover;
3508             $out = $out->setbadif($baddies);
3509             }
3510              
3511             $out = $out->convert($source->type->enum) if $out->type != $source->type;
3512             return $out;
3513              
3514             } elsif(($method eq 3) || $method =~ m/^c(u(b(e|ic)?)?)?/i) {
3515              
3516             my ($d,@di) = $index->dims;
3517             my $di = $index->ndims - 1;
3518              
3519             # Grab a 4-on-a-side n-cube around each desired pixel
3520             my $samp = $source->range($index->floor - 1,4,$boundary) #ith, cth, sth
3521             ->reorder( $di .. $di+$d-1, 0..$di-1, $di+$d .. $source->ndims-1 );
3522             # (cth, ith, sth)
3523              
3524             # Make a cube of the subpixel offsets, and expand its dims to
3525             # a 4-on-a-side N-1 cube, to match the slices of $samp (used below).
3526             my $y = $index - $index->floor;
3527             for my $i(1..$d-1) {
3528             $y = $y->dummy($i,4);
3529             }
3530              
3531             # Collapse by interpolation, one dimension at a time...
3532             for my $i(0..$d-1) {
3533             my $a0 = $samp->slice("(1)"); # Just-under-sample
3534             my $a1 = $samp->slice("(2)"); # Just-over-sample
3535             my $a1a0 = $a1 - $a0;
3536              
3537             my $gradient = 0.5 * ($samp->slice("2:3")-$samp->slice("0:1"));
3538             my $s0 = $gradient->slice("(0)"); # Just-under-gradient
3539             my $s1 = $gradient->slice("(1)"); # Just-over-gradient
3540              
3541             my $bb = $y->slice("($i)");
3542              
3543             # Collapse the sample...
3544             $samp = ( $a0 +
3545             $bb * (
3546             $s0 +
3547             $bb * ( (3 * $a1a0 - 2*$s0 - $s1) +
3548             $bb * ( $s1 + $s0 - 2*$a1a0 )
3549             )
3550             )
3551             );
3552              
3553             # "Collapse" the subpixel offset...
3554             $y = $y->slice(":,($i)");
3555             }
3556              
3557             $samp = $samp->convert($source->type->enum) if $samp->type != $source->type;
3558             return $samp;
3559              
3560             } elsif($method =~ m/^f(ft|ourier)?/i) {
3561              
3562             require PDL::FFT;
3563             my $fftref = $opt->{fft};
3564             $fftref = [] unless(ref $fftref eq 'ARRAY');
3565             if(@$fftref != 2) {
3566             my $x = $source->copy;
3567             my $y = zeroes($source);
3568             PDL::FFT::fftnd($x,$y);
3569             $fftref->[0] = sqrt($x*$x+$y*$y) / $x->nelem;
3570             $fftref->[1] = - atan2($y,$x);
3571             }
3572              
3573             my $i;
3574             my $c = PDL::Basic::ndcoords($source); # (dim, source-dims)
3575             for $i(1..$index->ndims-1) {
3576             $c = $c->dummy($i,$index->dim($i))
3577             }
3578             my $id = $index->ndims-1;
3579             my $phase = (($c * $index * 3.14159 * 2 / pdl($source->dims))
3580             ->sumover) # (index-dims, source-dims)
3581             ->reorder($id..$id+$source->ndims-1,0..$id-1); # (src, index)
3582              
3583             my $phref = $fftref->[1]->copy; # (source-dims)
3584             my $mag = $fftref->[0]->copy; # (source-dims)
3585              
3586             for $i(1..$index->ndims-1) {
3587             $phref = $phref->dummy(-1,$index->dim($i));
3588             $mag = $mag->dummy(-1,$index->dim($i));
3589             }
3590             my $out = cos($phase + $phref ) * $mag;
3591             $out = $out->clump($source->ndims)->sumover;
3592             $out = $out->convert($source->type->enum) if $out->type != $source->type;
3593             return $out;
3594             } else {
3595             barf("interpND: unknown method '$method'; valid ones are 'linear' and 'sample'.\n");
3596             }
3597             }
3598              
3599             #line 3272 "lib/PDL/Primitive.pd"
3600              
3601             =head2 one2nd
3602              
3603             =for ref
3604              
3605             Converts a one dimensional index ndarray to a set of ND coordinates
3606              
3607             =for usage
3608              
3609             @coords=one2nd($x, $indices)
3610              
3611             returns an array of ndarrays containing the ND indexes corresponding to
3612             the one dimensional list indices. The indices are assumed to
3613             correspond to array C<$x> clumped using C. This routine is
3614             used in the old vector form of L, but is useful on
3615             its own occasionally.
3616              
3617             Returned ndarrays have the L datatype. C<$indices> can have
3618             values larger than C<< $x->nelem >> but negative values in C<$indices>
3619             will not give the answer you expect.
3620              
3621             =for example
3622              
3623             pdl> $x=pdl [[[1,2],[-1,1]], [[0,-3],[3,2]]]; $c=$x->clump(-1)
3624             pdl> $maxind=maximum_ind($c); p $maxind;
3625             6
3626             pdl> print one2nd($x, maximum_ind($c))
3627             0 1 1
3628             pdl> p $x->at(0,1,1)
3629             3
3630              
3631             =cut
3632              
3633             *one2nd = \&PDL::one2nd;
3634             sub PDL::one2nd {
3635             barf "Usage: one2nd \$array, \$indices\n" if @_ != 2;
3636             my ($x, $ind)=@_;
3637             my @dimension=$x->dims;
3638             $ind = indx($ind);
3639             my(@index);
3640             my $count=0;
3641             foreach (@dimension) {
3642             $index[$count++]=$ind % $_;
3643             $ind /= $_;
3644             }
3645             return @index;
3646             }
3647             #line 3648 "lib/PDL/Primitive.pm"
3648              
3649              
3650             =head2 which
3651              
3652             =for sig
3653              
3654             Signature: (mask(n); indx [o] inds(n); indx [o]lastout())
3655             Types: (sbyte byte short ushort long ulong indx ulonglong longlong
3656             float double ldouble cfloat cdouble cldouble)
3657              
3658             =for ref
3659              
3660             Returns indices of non-zero values from a 1-D PDL
3661              
3662             =for usage
3663              
3664             $i = which($mask);
3665              
3666             returns a pdl with indices for all those elements that are nonzero in
3667             the mask. Note that the returned indices will be 1D. If you feed in a
3668             multidimensional mask, it will be flattened before the indices are
3669             calculated. See also L for multidimensional masks.
3670              
3671             If you want to index into the original mask or a similar ndarray
3672             with output from C, remember to flatten it before calling index:
3673              
3674             $data = random 5, 5;
3675             $idx = which $data > 0.5; # $idx is now 1D
3676             $bigsum = $data->flat->index($idx)->sum; # flatten before indexing
3677              
3678             Compare also L for similar functionality.
3679              
3680             SEE ALSO:
3681              
3682             L returns separately the indices of both nonzero and zero
3683             values in the mask.
3684              
3685             L returns separately slices of both nonzero and zero
3686             values in the mask.
3687              
3688             L returns associated values from a data PDL, rather than
3689             indices into the mask PDL.
3690              
3691             L returns N-D indices into a multidimensional PDL.
3692              
3693             =for example
3694              
3695             pdl> $x = sequence(10); p $x
3696             [0 1 2 3 4 5 6 7 8 9]
3697             pdl> $indx = which($x>6); p $indx
3698             [7 8 9]
3699              
3700             =pod
3701              
3702             Broadcasts over its inputs.
3703              
3704             =for bad
3705              
3706             C processes bad values.
3707             It will set the bad-value flag of all output ndarrays if the flag is set for any of the input ndarrays.
3708              
3709             =cut
3710              
3711              
3712              
3713              
3714              
3715             #line 3405 "lib/PDL/Primitive.pd"
3716             sub which { my ($this,$out) = @_;
3717             $this = $this->flat;
3718             $out //= $this->nullcreate;
3719             PDL::_which_int($this,$out,my $lastout = $this->nullcreate);
3720             my $lastoutmax = $lastout->max->sclr;
3721             $lastoutmax ? $out->slice('0:'.($lastoutmax-1))->sever : empty(indx);
3722             }
3723             *PDL::which = \&which;
3724             #line 3725 "lib/PDL/Primitive.pm"
3725              
3726             *which = \&PDL::which;
3727              
3728              
3729              
3730              
3731              
3732              
3733             =head2 which_both
3734              
3735             =for sig
3736              
3737             Signature: (mask(n); indx [o] inds(n); indx [o]notinds(n); indx [o]lastout(); indx [o]lastoutn())
3738             Types: (sbyte byte short ushort long ulong indx ulonglong longlong
3739             float double ldouble cfloat cdouble cldouble)
3740              
3741             =for ref
3742              
3743             Returns indices of nonzero and zero values in a mask PDL
3744              
3745             =for usage
3746              
3747             ($i, $c_i) = which_both($mask);
3748              
3749             This works just as L, but the complement of C<$i> will be in
3750             C<$c_i>.
3751              
3752             =for example
3753              
3754             pdl> p $x = sequence(10)
3755             [0 1 2 3 4 5 6 7 8 9]
3756             pdl> ($big, $small) = which_both($x >= 5); p "$big\n$small"
3757             [5 6 7 8 9]
3758             [0 1 2 3 4]
3759              
3760             See also L for the n-dimensional version.
3761              
3762             =pod
3763              
3764             Broadcasts over its inputs.
3765              
3766             =for bad
3767              
3768             C processes bad values.
3769             It will set the bad-value flag of all output ndarrays if the flag is set for any of the input ndarrays.
3770              
3771             =cut
3772              
3773              
3774              
3775              
3776              
3777             #line 3422 "lib/PDL/Primitive.pd"
3778             sub which_both { my ($this,$outi,$outni) = @_;
3779             $this = $this->flat;
3780             $outi //= $this->nullcreate;
3781             $outni //= $this->nullcreate;
3782             PDL::_which_both_int($this,$outi,$outni,my $lastout = $this->nullcreate,my $lastoutn = $this->nullcreate);
3783             my $lastoutmax = $lastout->max->sclr;
3784             $outi = $lastoutmax ? $outi->slice('0:'.($lastoutmax-1))->sever : empty(indx);
3785             return $outi if !wantarray;
3786             my $lastoutnmax = $lastoutn->max->sclr;
3787             ($outi, $lastoutnmax ? $outni->slice('0:'.($lastoutnmax-1))->sever : empty(indx));
3788             }
3789             *PDL::which_both = \&which_both;
3790             #line 3791 "lib/PDL/Primitive.pm"
3791              
3792             *which_both = \&PDL::which_both;
3793              
3794              
3795              
3796              
3797              
3798              
3799             =head2 whichover
3800              
3801             =for sig
3802              
3803             Signature: (a(n); [o]o(n))
3804             Types: (sbyte byte short ushort long ulong indx ulonglong longlong
3805             float double ldouble cfloat cdouble cldouble)
3806              
3807             =for usage
3808              
3809             $o = whichover($a);
3810             whichover($a, $o); # all arguments given
3811             $o = $a->whichover; # method call
3812             $a->whichover($o);
3813             $a->inplace->whichover; # can be used inplace
3814             whichover($a->inplace);
3815              
3816             =for ref
3817              
3818             Collects the coordinates of non-zero, non-bad values in each 1D mask in
3819             ndarray at the start of the output, and fills the rest with -1.
3820              
3821             By using L etc. it is possible to use I dimension.
3822              
3823             =for example
3824              
3825             my $a = pdl q[3 4 2 3 2 3 1];
3826             my $b = $a->uniq;
3827             my $c = +($a->dummy(0) == $b)->transpose;
3828             print $c, $c->whichover;
3829             # [
3830             # [0 0 0 0 0 0 1]
3831             # [0 0 1 0 1 0 0]
3832             # [1 0 0 1 0 1 0]
3833             # [0 1 0 0 0 0 0]
3834             # ]
3835             # [
3836             # [ 6 -1 -1 -1 -1 -1 -1]
3837             # [ 2 4 -1 -1 -1 -1 -1]
3838             # [ 0 3 5 -1 -1 -1 -1]
3839             # [ 1 -1 -1 -1 -1 -1 -1]
3840             # ]
3841              
3842             =pod
3843              
3844             Broadcasts over its inputs.
3845              
3846             =for bad
3847              
3848             C processes bad values.
3849             It will set the bad-value flag of all output ndarrays if the flag is set for any of the input ndarrays.
3850              
3851             =cut
3852              
3853              
3854              
3855              
3856             *whichover = \&PDL::whichover;
3857              
3858              
3859              
3860              
3861              
3862              
3863             =head2 approx_artol
3864              
3865             =for sig
3866              
3867             Signature: (got(); expected(); sbyte [o] result(); double atol; double rtol)
3868             Types: (sbyte byte short ushort long ulong indx ulonglong longlong
3869             float double ldouble cfloat cdouble cldouble)
3870              
3871             =for usage
3872              
3873             $result = approx_artol($got, $expected); # using defaults of atol=1e-06, rtol=0
3874             $result = approx_artol($got, $expected, $atol);
3875             $result = approx_artol($got, $expected, $atol, $rtol);
3876             approx_artol($got, $expected, $atol, $rtol, $result); # all arguments given
3877             $result = $got->approx_artol($expected); # method call
3878             $result = $got->approx_artol($expected, $atol);
3879             $result = $got->approx_artol($expected, $atol, $rtol);
3880             $got->approx_artol($expected, $atol, $rtol, $result);
3881              
3882             =for ref
3883              
3884             Returns C mask whether C<< abs($got()-$expected())> <= >> either
3885             absolute or relative (C * C<$expected()>) tolerances.
3886              
3887             Relative tolerance defaults to zero, and absolute tolerance defaults to
3888             C<1e-6>, for compatibility with L.
3889              
3890             Works with complex numbers, and to avoid expensive Cing uses the
3891             squares of the input quantities and differences. Bear this in mind for
3892             numbers outside the range (for C) of about C<1e-154..1e154>.
3893              
3894             Handles Cs by showing them approximately equal (i.e. true in the
3895             output) if both values are C, and not otherwise.
3896              
3897             Adapted from code by Edward Baudrez, test changed from C<< < >> to C<< <= >>.
3898              
3899             =pod
3900              
3901             Broadcasts over its inputs.
3902              
3903             =for bad
3904              
3905             Handles bad values similarly to Cs, above. This includes if only
3906             one of the two input ndarrays has their badflag true.
3907              
3908             =cut
3909              
3910              
3911              
3912              
3913             *approx_artol = \&PDL::approx_artol;
3914              
3915              
3916              
3917              
3918              
3919             #line 3554 "lib/PDL/Primitive.pd"
3920              
3921             =head2 where
3922              
3923             =for ref
3924              
3925             Use a mask to select values from one or more data PDLs
3926              
3927             C accepts one or more data ndarrays and a mask ndarray. It
3928             returns a list of output ndarrays, corresponding to the input data
3929             ndarrays. Each output ndarray is a 1-dimensional list of values in its
3930             corresponding data ndarray. The values are drawn from locations where
3931             the mask is nonzero.
3932              
3933             The output PDLs are still connected to the original data PDLs, for the
3934             purpose of dataflow.
3935              
3936             C combines the functionality of L and L
3937             into a single operation.
3938              
3939             BUGS:
3940              
3941             While C works OK for most N-dimensional cases, it does not
3942             broadcast properly over (for example) the (N+1)th dimension in data
3943             that is compared to an N-dimensional mask. Use C for that.
3944              
3945             =for example
3946              
3947             $i = $x->where($x+5 > 0); # $i contains those elements of $x
3948             # where mask ($x+5 > 0) is 1
3949             $i .= -5; # Set those elements (of $x) to -5. Together, these
3950             # commands clamp $x to a maximum of -5.
3951              
3952             It is also possible to use the same mask for several ndarrays with
3953             the same call:
3954              
3955             ($i,$j,$k) = where($x,$y,$z, $x+5>0);
3956              
3957             Note: C<$i> is always 1-D, even if C<$x> is E1-D.
3958              
3959             WARNING: The first argument
3960             (the values) and the second argument (the mask) currently have to have
3961             the exact same dimensions (or horrible things happen). You *cannot*
3962             broadcast over a smaller mask, for example.
3963              
3964             =cut
3965              
3966             sub PDL::where :lvalue {
3967             barf "Usage: where( \$pdl1, ..., \$pdlN, \$mask )\n" if @_ == 1;
3968             my $mask = pop->flat->which;
3969             @_ == 1 ? $_[0]->flat->index($mask) : map $_->flat->index($mask), @_;
3970             }
3971             *where = \&PDL::where;
3972              
3973             #line 3610 "lib/PDL/Primitive.pd"
3974              
3975             =head2 where_both
3976              
3977             =for ref
3978              
3979             Returns slices (non-zero in mask, zero) of an ndarray according to a mask
3980              
3981             =for usage
3982              
3983             ($match_vals, $non_match_vals) = where_both($pdl, $mask);
3984              
3985             This works like L, but (flattened) data-flowing slices
3986             rather than index-sets are returned.
3987              
3988             =for example
3989              
3990             pdl> p $x = sequence(10) + 2
3991             [2 3 4 5 6 7 8 9 10 11]
3992             pdl> ($big, $small) = where_both($x, $x > 5); p "$big\n$small"
3993             [6 7 8 9 10 11]
3994             [2 3 4 5]
3995             pdl> p $big += 2, $small -= 1
3996             [8 9 10 11 12 13] [1 2 3 4]
3997             pdl> p $x
3998             [1 2 3 4 8 9 10 11 12 13]
3999              
4000             =cut
4001              
4002             sub PDL::where_both {
4003             barf "Usage: where_both(\$pdl, \$mask)\n" if @_ != 2;
4004             my ($arr, $mask) = @_; # $mask has 0==false, 1==true
4005             my $arr_flat = $arr->flat;
4006             map $arr_flat->index1d($_), PDL::which_both($mask);
4007             }
4008             *where_both = \&PDL::where_both;
4009              
4010             #line 3648 "lib/PDL/Primitive.pd"
4011              
4012             =head2 whereND
4013              
4014             =for ref
4015              
4016             C with support for ND masks and broadcasting
4017              
4018             C accepts one or more data ndarrays and a
4019             mask ndarray. It returns a list of output ndarrays,
4020             corresponding to the input data ndarrays. The values
4021             are drawn from locations where the mask is nonzero.
4022              
4023             C differs from C in that the mask
4024             dimensionality is preserved which allows for
4025             proper broadcasting of the selection operation over
4026             higher dimensions.
4027              
4028             As with C the output PDLs are still connected
4029             to the original data PDLs, for the purpose of dataflow.
4030              
4031             =for usage
4032              
4033             $sdata = whereND $data, $mask
4034             ($s1, $s2, ..., $sn) = whereND $d1, $d2, ..., $dn, $mask
4035              
4036             where
4037              
4038             $data is M dimensional
4039             $mask is N < M dimensional
4040             dims($data) 1..N == dims($mask) 1..N
4041             with broadcasting over N+1 to M dimensions
4042              
4043             =for example
4044              
4045             $data = sequence(4,3,2); # example data array
4046             $mask4 = (random(4)>0.5); # example 1-D mask array, has $n4 true values
4047             $mask43 = (random(4,3)>0.5); # example 2-D mask array, has $n43 true values
4048             $sdat4 = whereND $data, $mask4; # $sdat4 is a [$n4,3,2] pdl
4049             $sdat43 = whereND $data, $mask43; # $sdat43 is a [$n43,2] pdl
4050              
4051             Just as with C, you can use the returned value in an
4052             assignment. That means that both of these examples are valid:
4053              
4054             # Used to create a new slice stored in $sdat4:
4055             $sdat4 = $data->whereND($mask4);
4056             $sdat4 .= 0;
4057             # Used in lvalue context:
4058             $data->whereND($mask4) .= 0;
4059              
4060             SEE ALSO:
4061              
4062             L returns N-D indices into a multidimensional PDL, from a mask.
4063              
4064             =cut
4065              
4066             sub PDL::whereND :lvalue {
4067             barf "Usage: whereND( \$pdl1, ..., \$pdlN, \$mask )\n" if @_ == 1;
4068             my $mask = pop @_; # $mask has 0==false, 1==true
4069             my @to_return;
4070             my $n = PDL::sum($mask);
4071             my $maskndims = $mask->ndims;
4072             foreach my $arr (@_) {
4073             # count the number of dims in $mask and $arr
4074             # $mask = a b c d e f.....
4075             my @idims = dims($arr);
4076             splice @idims, 0, $maskndims; # pop off the number of dims in $mask
4077             if (!$n or $arr->isempty) {
4078             push @to_return, PDL->zeroes($arr->type, $n, @idims);
4079             next;
4080             }
4081             my $sub_i = $mask * ones($arr);
4082             my $where_sub_i = PDL::where($arr, $sub_i);
4083             my $ndim = 0;
4084             foreach my $id ($n, @idims[0..($#idims-1)]) {
4085             $where_sub_i = $where_sub_i->splitdim($ndim++,$id) if $n>0;
4086             }
4087             push @to_return, $where_sub_i;
4088             }
4089             return (@to_return == 1) ? $to_return[0] : @to_return;
4090             }
4091             *whereND = \&PDL::whereND;
4092              
4093             =head2 whereND_both
4094              
4095             =for ref
4096              
4097             C with support for ND masks and broadcasting
4098              
4099             This works like L, but data-flowing slices
4100             rather than index-sets are returned.
4101              
4102             C differs from C in that the mask
4103             dimensionality is preserved which allows for
4104             proper broadcasting of the selection operation over
4105             higher dimensions.
4106              
4107             As with C the output PDLs are still connected
4108             to the original data PDLs, for the purpose of dataflow.
4109              
4110             =for usage
4111              
4112             ($match_vals, $non_match_vals) = whereND_both($pdl, $mask);
4113              
4114             =cut
4115              
4116             sub PDL::whereND_both :lvalue {
4117             barf "Usage: whereND_both(\$pdl, \$mask)\n" if @_ != 2;
4118             my ($arr, $mask) = @_; # $mask has 0==false, 1==true
4119             map $arr->indexND($_), PDL::whichND_both($mask);
4120             }
4121             *whereND_both = \&PDL::whereND_both;
4122              
4123             #line 3762 "lib/PDL/Primitive.pd"
4124              
4125             =head2 whichND
4126              
4127             =for ref
4128              
4129             Return the coordinates of non-zero values in a mask.
4130              
4131             =for usage
4132              
4133             WhichND returns the N-dimensional coordinates of each nonzero value in
4134             a mask PDL with any number of dimensions. The returned values arrive
4135             as an array-of-vectors suitable for use in
4136             L or L.
4137              
4138             $coords = whichND($mask);
4139              
4140             returns a PDL containing the coordinates of the elements that are non-zero
4141             in C<$mask>, suitable for use in L. The 0th dimension contains the
4142             full coordinate listing of each point; the 1st dimension lists all the points.
4143             For example, if $mask has rank 4 and 100 matching elements, then $coords has
4144             dimension 4x100.
4145              
4146             If no such elements exist, then whichND returns a structured empty PDL:
4147             an Nx0 PDL that contains no values (but matches, broadcasting-wise, with
4148             the vectors that would be produced if such elements existed).
4149              
4150             DEPRECATED BEHAVIOR IN LIST CONTEXT:
4151              
4152             whichND once delivered different values in list context than in scalar
4153             context, for historical reasons. In list context, it returned the
4154             coordinates transposed, as a collection of 1-PDLs (one per dimension)
4155             in a list. This usage is deprecated in PDL 2.4.10, and will cause a
4156             warning to be issued every time it is encountered. To avoid the
4157             warning, you can set the global variable "$PDL::whichND" to 's' to
4158             get scalar behavior in all contexts, or to 'l' to get list behavior in
4159             list context.
4160              
4161             In later versions of PDL, the deprecated behavior will disappear. Deprecated
4162             list context whichND expressions can be replaced with:
4163              
4164             @list = $x->whichND->mv(0,-1)->dog;
4165              
4166             SEE ALSO:
4167              
4168             L finds coordinates of nonzero values in a 1-D mask.
4169              
4170             L extracts values from a data PDL that are associated
4171             with nonzero values in a mask PDL.
4172              
4173             L can be fed the coordinates to return the values.
4174              
4175             =for example
4176              
4177             pdl> $s=sequence(10,10,3,4)
4178             pdl> ($x, $y, $z, $w)=whichND($s == 203); p $x, $y, $z, $w
4179             [3] [0] [2] [0]
4180             pdl> print $s->at(list(cat($x,$y,$z,$w)))
4181             203
4182              
4183             =cut
4184              
4185             sub _one2nd {
4186             my ($mask, $ind) = @_;
4187             my $ndims = my @mdims = $mask->dims;
4188             # In the empty case, explicitly return the correct type of structured empty
4189             return PDL->new_from_specification(indx, $ndims, 0) if !$ind->nelem;
4190             my $mult = ones(indx, $ndims);
4191             $mult->index($_+1) .= $mult->index($_) * $mdims[$_] for 0..$#mdims-1;
4192             for my $i (0..$#mdims) {
4193             my $s = $ind->index($i);
4194             $s /= $mult->index($i);
4195             $s %= $mdims[$i];
4196             }
4197             $ind;
4198             }
4199              
4200             *whichND = \&PDL::whichND;
4201             sub PDL::whichND {
4202             my $mask = PDL->topdl(shift);
4203              
4204             # List context: generate a perl list by dimension
4205             if(wantarray) {
4206             if(!defined($PDL::whichND)) {
4207             printf STDERR "whichND: WARNING - list context deprecated. Set \$PDL::whichND. Details in pod.";
4208             } elsif($PDL::whichND =~ m/l/i) {
4209             # old list context enabled by setting $PDL::whichND to 'l'
4210             return $mask->one2nd($mask->flat->which);
4211             }
4212             # if $PDL::whichND does not contain 'l' or 'L', fall through to scalar context
4213             }
4214              
4215             # Scalar context: generate an N-D index ndarray
4216             my $ndims = $mask->getndims;
4217             return PDL->new_from_specification(indx,$ndims,0) if !$mask->nelem;
4218             return $mask ? pdl(indx,0) : PDL->new_from_specification(indx,0) if !$ndims;
4219             _one2nd($mask, $mask->flat->which->dummy(0,$ndims)->sever);
4220             }
4221              
4222             =head2 whichND_both
4223              
4224             =for ref
4225              
4226             Return the coordinates of non-zero values in a mask.
4227              
4228             =for usage
4229              
4230             Like L, but returns the N-dimensional coordinates (like
4231             L) of the nonzero, zero values in the mask PDL. The
4232             returned values arrive as an array-of-vectors suitable for use in
4233             L or L.
4234             Added in 2.099.
4235              
4236             ($nonzero_coords, $zero_coords) = whichND_both($mask);
4237              
4238             SEE ALSO:
4239              
4240             L finds coordinates of nonzero values in a 1-D mask.
4241              
4242             L extracts values from a data PDL that are associated
4243             with nonzero values in a mask PDL.
4244              
4245             L can be fed the coordinates to return the values.
4246              
4247             =for example
4248              
4249             pdl> $s=sequence(10,10,3,4)
4250             pdl> ($x, $y, $z, $w)=whichND($s == 203); p $x, $y, $z, $w
4251             [3] [0] [2] [0]
4252             pdl> print $s->at(list(cat($x,$y,$z,$w)))
4253             203
4254              
4255             =cut
4256              
4257             *whichND_both = \&PDL::whichND_both;
4258             sub PDL::whichND_both {
4259             my $mask = PDL->topdl(shift);
4260             return ((PDL->new_from_specification(indx,$mask->ndims,0))x2) if !$mask->nelem;
4261             my $ndims = $mask->getndims;
4262             if (!$ndims) {
4263             my ($t, $f) = (pdl(indx,0), PDL->new_from_specification(indx,0));
4264             return $mask ? ($t,$f) : ($f,$t);
4265             }
4266             map _one2nd($mask, $_->dummy(0,$ndims)->sever), $mask->flat->which_both;
4267             }
4268              
4269             #line 3913 "lib/PDL/Primitive.pd"
4270              
4271             =head2 setops
4272              
4273             =for ref
4274              
4275             Implements simple set operations like union and intersection
4276              
4277             =for usage
4278              
4279             Usage: $set = setops($x, , $y);
4280              
4281             The operator can be C, C or C. This is then applied
4282             to C<$x> viewed as a set and C<$y> viewed as a set. Set theory says
4283             that a set may not have two or more identical elements, but setops
4284             takes care of this for you, so C<$x=pdl(1,1,2)> is OK. The functioning
4285             is as follows:
4286              
4287             =over
4288              
4289             =item C
4290              
4291             The resulting vector will contain the elements that are either in C<$x>
4292             I in C<$y> or both. This is the union in set operation terms
4293              
4294             =item C
4295              
4296             The resulting vector will contain the elements that are either in C<$x>
4297             or C<$y>, but not in both. This is
4298              
4299             Union($x, $y) - Intersection($x, $y)
4300              
4301             in set operation terms.
4302              
4303             =item C
4304              
4305             The resulting vector will contain the intersection of C<$x> and C<$y>, so
4306             the elements that are in both C<$x> and C<$y>. Note that for convenience
4307             this operation is also aliased to L.
4308              
4309             =back
4310              
4311             It should be emphasized that these routines are used when one or both of
4312             the sets C<$x>, C<$y> are hard to calculate or that you get from a separate
4313             subroutine.
4314              
4315             Finally IDL users might be familiar with Craig Markwardt's C
4316             routine which has inspired this routine although it was written independently
4317             However the present routine has a few less options (but see the examples)
4318              
4319             =for example
4320              
4321             You will very often use these functions on an index vector, so that is
4322             what we will show here. We will in fact something slightly silly. First
4323             we will find all squares that are also cubes below 10000.
4324              
4325             Create a sequence vector:
4326              
4327             pdl> $x = sequence(10000)
4328              
4329             Find all odd and even elements:
4330              
4331             pdl> ($even, $odd) = which_both( ($x % 2) == 0)
4332              
4333             Find all squares
4334              
4335             pdl> $squares= which(ceil(sqrt($x)) == floor(sqrt($x)))
4336              
4337             Find all cubes (being careful with roundoff error!)
4338              
4339             pdl> $cubes= which(ceil($x**(1.0/3.0)) == floor($x**(1.0/3.0)+1e-6))
4340              
4341             Then find all squares that are cubes:
4342              
4343             pdl> $both = setops($squares, 'AND', $cubes)
4344              
4345             And print these (assumes that C is loaded!)
4346              
4347             pdl> p $x($both)
4348             [0 1 64 729 4096]
4349              
4350             Then find all numbers that are either cubes or squares, but not both:
4351              
4352             pdl> $cube_xor_square = setops($squares, 'XOR', $cubes)
4353              
4354             pdl> p $cube_xor_square->nelem()
4355             112
4356              
4357             So there are a total of 112 of these!
4358              
4359             Finally find all odd squares:
4360              
4361             pdl> $odd_squares = setops($squares, 'AND', $odd)
4362              
4363             Another common occurrence is to want to get all objects that are
4364             in C<$x> and in the complement of C<$y>. But it is almost always best
4365             to create the complement explicitly since the universe that both are
4366             taken from is not known. Thus use L if possible
4367             to keep track of complements.
4368              
4369             If this is impossible the best approach is to make a temporary:
4370              
4371             This creates an index vector the size of the universe of the sets and
4372             set all elements in C<$y> to 0
4373              
4374             pdl> $tmp = ones($n_universe); $tmp($y) .= 0;
4375              
4376             This then finds the complement of C<$y>
4377              
4378             pdl> $C_b = which($tmp == 1);
4379              
4380             and this does the final selection:
4381              
4382             pdl> $set = setops($x, 'AND', $C_b)
4383              
4384             =cut
4385              
4386             *setops = \&PDL::setops;
4387              
4388             sub PDL::setops {
4389              
4390             my ($x, $op, $y)=@_;
4391              
4392             # Check that $x and $y are 1D.
4393             if ($x->ndims() > 1 || $y->ndims() > 1) {
4394             warn 'setops: $x and $y must be 1D - flattening them!'."\n";
4395             $x = $x->flat;
4396             $y = $y->flat;
4397             }
4398              
4399             #Make sure there are no duplicate elements.
4400             $x=$x->uniq;
4401             $y=$y->uniq;
4402              
4403             my $result;
4404              
4405             if ($op eq 'OR') {
4406             # Easy...
4407             $result = uniq(append($x, $y));
4408             } elsif ($op eq 'XOR') {
4409             # Make ordered list of set union.
4410             my $union = append($x, $y)->qsort;
4411             # Index lists.
4412             my $s1=zeroes(byte, $union->nelem());
4413             my $s2=zeroes(byte, $union->nelem());
4414              
4415             # Find indices which are duplicated - these are to be excluded
4416             #
4417             # We do this by comparing x with x shifted each way.
4418             my $i1 = which($union != rotate($union, 1));
4419             my $i2 = which($union != rotate($union, -1));
4420             #
4421             # We then mark/mask these in the s1 and s2 arrays to indicate which ones
4422             # are not equal to their neighbours.
4423             #
4424             my $ts;
4425             ($ts = $s1->index($i1)) .= byte(1) if $i1->nelem() > 0;
4426             ($ts = $s2->index($i2)) .= byte(1) if $i2->nelem() > 0;
4427              
4428             my $inds=which($s1 == $s2);
4429              
4430             if ($inds->nelem() > 0) {
4431             return $union->index($inds);
4432             } else {
4433             return $inds;
4434             }
4435              
4436             } elsif ($op eq 'AND') {
4437             # The intersection of the arrays.
4438             return $x if $x->isempty;
4439             return $y if $y->isempty;
4440             # Make ordered list of set union.
4441             my $union = append($x, $y)->qsort;
4442             return $union->where($union == rotate($union, -1))->uniq;
4443             } else {
4444             print "The operation $op is not known!";
4445             return -1;
4446             }
4447              
4448             }
4449              
4450             #line 4096 "lib/PDL/Primitive.pd"
4451              
4452             =head2 intersect
4453              
4454             =for ref
4455              
4456             Calculate the intersection of two ndarrays
4457              
4458             =for usage
4459              
4460             Usage: $set = intersect($x, $y);
4461              
4462             This routine is merely a simple interface to L. See
4463             that for more information
4464              
4465             =for example
4466              
4467             Find all numbers less that 100 that are of the form 2*y and 3*x
4468              
4469             pdl> $x=sequence(100)
4470             pdl> $factor2 = which( ($x % 2) == 0)
4471             pdl> $factor3 = which( ($x % 3) == 0)
4472             pdl> $ii=intersect($factor2, $factor3)
4473             pdl> p $x($ii)
4474             [0 6 12 18 24 30 36 42 48 54 60 66 72 78 84 90 96]
4475              
4476             =cut
4477              
4478             *intersect = \&PDL::intersect;
4479              
4480             sub PDL::intersect { setops($_[0], 'AND', $_[1]) }
4481             #line 4482 "lib/PDL/Primitive.pm"
4482              
4483              
4484             =head2 pchip_chim
4485              
4486             =for sig
4487              
4488             Signature: (x(n); f(n); [o]d(n); indx [o]ierr())
4489             Types: (sbyte byte short ushort long ulong indx ulonglong longlong
4490             float double ldouble)
4491              
4492             =for usage
4493              
4494             ($d, $ierr) = pchip_chim($x, $f);
4495             pchip_chim($x, $f, $d, $ierr); # all arguments given
4496             ($d, $ierr) = $x->pchip_chim($f); # method call
4497             $x->pchip_chim($f, $d, $ierr);
4498              
4499             =for ref
4500              
4501             Calculate the derivatives of (x,f(x)) using cubic Hermite interpolation.
4502              
4503             Calculate the derivatives needed to determine a monotone piecewise
4504             cubic Hermite interpolant to the given set of points (C<$x,$f>,
4505             where C<$x> is strictly increasing).
4506             The resulting set of points - C<$x,$f,$d>, referred to
4507             as the cubic Hermite representation - can then be used in
4508             other functions, such as L, L,
4509             and L.
4510              
4511             The boundary conditions are compatible with monotonicity,
4512             and if the data are only piecewise monotonic, the interpolant
4513             will have an extremum at the switch points; for more control
4514             over these issues use L.
4515              
4516             References:
4517              
4518             1. F. N. Fritsch and J. Butland, A method for constructing
4519             local monotone piecewise cubic interpolants, SIAM
4520             Journal on Scientific and Statistical Computing 5, 2
4521             (June 1984), pp. 300-304.
4522              
4523             F. N. Fritsch and R. E. Carlson, Monotone piecewise
4524             cubic interpolation, SIAM Journal on Numerical Analysis
4525             17, 2 (April 1980), pp. 238-246.
4526              
4527             =pod
4528              
4529             =head3 Parameters
4530              
4531             =over
4532              
4533             =item x
4534              
4535             ordinate data
4536              
4537             =item f
4538              
4539             array of dependent variable values to be
4540             interpolated. F(I) is value corresponding to
4541             X(I). C is designed for monotonic data, but it will
4542             work for any F-array. It will force extrema at points where
4543             monotonicity switches direction. If some other treatment of
4544             switch points is desired, DPCHIC should be used instead.
4545              
4546             =item d
4547              
4548             array of derivative values at the data
4549             points. If the data are monotonic, these values will
4550             determine a monotone cubic Hermite function.
4551              
4552             =item ierr
4553              
4554             Error status:
4555              
4556             =over
4557              
4558             =item *
4559              
4560             0 if successful.
4561              
4562             =item *
4563              
4564             E 0 if there were C switches in the direction of
4565             monotonicity (data still valid).
4566              
4567             =item *
4568              
4569             -1 if C 2>.
4570              
4571             =item *
4572              
4573             -3 if C<$x> is not strictly increasing.
4574              
4575             =back
4576              
4577             (The D-array has not been changed in any of these cases.)
4578             NOTE: The above errors are checked in the order listed,
4579             and following arguments have B been validated.
4580              
4581             =back
4582              
4583             Broadcasts over its inputs.
4584              
4585             =for bad
4586              
4587             C does not process bad values.
4588             It will set the bad-value flag of all output ndarrays if the flag is set for any of the input ndarrays.
4589              
4590             =cut
4591              
4592              
4593              
4594              
4595             *pchip_chim = \&PDL::pchip_chim;
4596              
4597              
4598              
4599              
4600              
4601              
4602             =head2 pchip_chic
4603              
4604             =for sig
4605              
4606             Signature: (sbyte ic(two=2); vc(two=2); mflag(); x(n); f(n);
4607             [o]d(n); indx [o]ierr();
4608             [t]h(nless1=CALC($SIZE(n)-1)); [t]slope(nless1);)
4609             Types: (float double ldouble)
4610              
4611             =for usage
4612              
4613             ($d, $ierr) = pchip_chic($ic, $vc, $mflag, $x, $f);
4614             pchip_chic($ic, $vc, $mflag, $x, $f, $d, $ierr); # all arguments given
4615             ($d, $ierr) = $ic->pchip_chic($vc, $mflag, $x, $f); # method call
4616             $ic->pchip_chic($vc, $mflag, $x, $f, $d, $ierr);
4617              
4618             =for ref
4619              
4620             Set derivatives needed to determine a piecewise monotone piecewise
4621             cubic Hermite interpolant to given data. User control is available
4622             over boundary conditions and/or treatment of points where monotonicity
4623             switches direction.
4624              
4625             Calculate the derivatives needed to determine a piecewise monotone piecewise
4626             cubic interpolant to the data given in (C<$x,$f>,
4627             where C<$x> is strictly increasing).
4628             Control over the boundary conditions is given by the
4629             C<$ic> and C<$vc> ndarrays, and the value of C<$mflag> determines
4630             the treatment of points where monotonicity switches
4631             direction. A simpler, more restricted, interface is available
4632             using L.
4633             The resulting piecewise cubic Hermite function may be evaluated
4634             by L or L.
4635              
4636             References:
4637              
4638             1. F. N. Fritsch, Piecewise Cubic Hermite Interpolation
4639             Package, Report UCRL-87285, Lawrence Livermore National
4640             Laboratory, July 1982. [Poster presented at the
4641             SIAM 30th Anniversary Meeting, 19-23 July 1982.]
4642              
4643             2. F. N. Fritsch and J. Butland, A method for constructing
4644             local monotone piecewise cubic interpolants, SIAM
4645             Journal on Scientific and Statistical Computing 5, 2
4646             (June 1984), pp. 300-304.
4647              
4648             3. F. N. Fritsch and R. E. Carlson, Monotone piecewise
4649             cubic interpolation, SIAM Journal on Numerical
4650             Analysis 17, 2 (April 1980), pp. 238-246.
4651              
4652             =pod
4653              
4654             =head3 Parameters
4655              
4656             =over
4657              
4658             =item ic
4659              
4660             The first and second elements of C<$ic> determine the boundary
4661             conditions at the start and end of the data respectively.
4662             If the value is 0, then the default condition, as used by
4663             L, is adopted.
4664             If greater than zero, no adjustment for monotonicity is made,
4665             otherwise if less than zero the derivative will be adjusted.
4666             The allowed magnitudes for C are:
4667              
4668             =over
4669              
4670             =item *
4671              
4672             1 if first derivative at C is given in C.
4673              
4674             =item *
4675              
4676             2 if second derivative at C is given in C.
4677              
4678             =item *
4679              
4680             3 to use the 3-point difference formula for C.
4681             (Reverts to the default b.c. if C 3>)
4682              
4683             =item *
4684              
4685             4 to use the 4-point difference formula for C.
4686             (Reverts to the default b.c. if C 4>)
4687              
4688             =item *
4689              
4690             5 to set C so that the second derivative is
4691             continuous at C.
4692             (Reverts to the default b.c. if C 4>)
4693             This option is somewhat analogous to the "not a knot"
4694             boundary condition provided by DPCHSP.
4695              
4696             =back
4697              
4698             The values for C are the same as above, except that
4699             the first-derivative value is stored in C for cases 1 and 2.
4700             The values of C<$vc> need only be set if options 1 or 2 are chosen
4701             for C<$ic>. NOTES:
4702              
4703             =over
4704              
4705             =item *
4706              
4707             Only in case C<$ic(n)> E 0 is it guaranteed that the interpolant
4708             will be monotonic in the first interval. If the returned value of
4709             D(start_or_end) lies between zero and 3*SLOPE(start_or_end), the
4710             interpolant will be monotonic. This is B checked if C<$ic(n)>
4711             E 0.
4712              
4713             =item *
4714              
4715             If C<$ic(n)> E 0 and D(0) had to be changed to achieve monotonicity,
4716             a warning error is returned.
4717              
4718             =back
4719              
4720             Set C<$mflag = 0> if interpolant is required to be monotonic in
4721             each interval, regardless of monotonicity of data. This causes C<$d> to be
4722             set to 0 at all switch points. NOTES:
4723              
4724             =over
4725              
4726             =item *
4727              
4728             This will cause D to be set to zero at all switch points, thus
4729             forcing extrema there.
4730              
4731             =item *
4732              
4733             The result of using this option with the default boundary conditions
4734             will be identical to using DPCHIM, but will generally cost more
4735             compute time. This option is provided only to facilitate comparison
4736             of different switch and/or boundary conditions.
4737              
4738             =back
4739              
4740             =item vc
4741              
4742             See ic for details
4743              
4744             =item mflag
4745              
4746             Set to non-zero to
4747             use a formula based on the 3-point difference formula at switch
4748             points. If C<$mflag E 0>, then the interpolant at switch points
4749             is forced to not deviate from the data by more than C<$mflag*dfloc>,
4750             where C is the maximum of the change of C<$f> on this interval
4751             and its two immediate neighbours.
4752             If C<$mflag E 0>, no such control is to be imposed.
4753              
4754             =item x
4755              
4756             array of independent variable values. The
4757             elements of X must be strictly increasing:
4758              
4759             X(I-1) .LT. X(I), I = 2(1)N.
4760              
4761             (Error return if not.)
4762              
4763             =item f
4764              
4765             array of dependent variable values to be
4766             interpolated. F(I) is value corresponding to X(I).
4767              
4768             =item d
4769              
4770             array of derivative values at the data
4771             points. These values will determine a monotone cubic
4772             Hermite function on each subinterval on which the data
4773             are monotonic, except possibly adjacent to switches in
4774             monotonicity. The value corresponding to X(I) is stored in D(I).
4775             No other entries in D are changed.
4776              
4777             =item ierr
4778              
4779             Error status:
4780              
4781             =over
4782              
4783             =item *
4784              
4785             0 if successful.
4786              
4787             =item *
4788              
4789             1 if C 0> and C had to be adjusted for
4790             monotonicity.
4791              
4792             =item *
4793              
4794             2 if C 0> and C had to be adjusted
4795             for monotonicity.
4796              
4797             =item *
4798              
4799             3 if both 1 and 2 are true.
4800              
4801             =item *
4802              
4803             -1 if C 2>.
4804              
4805             =item *
4806              
4807             -3 if C<$x> is not strictly increasing.
4808              
4809             =item *
4810              
4811             -4 if C 5>.
4812              
4813             =item *
4814              
4815             -5 if C 5>.
4816              
4817             =item *
4818              
4819             -6 if both -4 and -5 are true.
4820              
4821             =item *
4822              
4823             -7 if C 2*(n-1)>.
4824              
4825             =back
4826              
4827             (The D-array has not been changed in any of these cases.)
4828             NOTE: The above errors are checked in the order listed,
4829             and following arguments have B been validated.
4830              
4831             =back
4832              
4833             Broadcasts over its inputs.
4834              
4835             =for bad
4836              
4837             C does not process bad values.
4838             It will set the bad-value flag of all output ndarrays if the flag is set for any of the input ndarrays.
4839              
4840             =cut
4841              
4842              
4843              
4844              
4845             *pchip_chic = \&PDL::pchip_chic;
4846              
4847              
4848              
4849              
4850              
4851              
4852             =head2 pchip_chsp
4853              
4854             =for sig
4855              
4856             Signature: (sbyte ic(two=2); vc(two=2); x(n); f(n);
4857             [o]d(n); indx [o]ierr();
4858             [t]dx(n); [t]dy_dx(n);
4859             )
4860             Types: (float double ldouble)
4861              
4862             =for usage
4863              
4864             ($d, $ierr) = pchip_chsp($ic, $vc, $x, $f);
4865             pchip_chsp($ic, $vc, $x, $f, $d, $ierr); # all arguments given
4866             ($d, $ierr) = $ic->pchip_chsp($vc, $x, $f); # method call
4867             $ic->pchip_chsp($vc, $x, $f, $d, $ierr);
4868              
4869             =for ref
4870              
4871             Calculate the derivatives of (x,f(x)) using cubic spline interpolation.
4872              
4873             Computes the Hermite representation of the cubic spline interpolant
4874             to the data given in (C<$x,$f>), with the specified boundary conditions.
4875             Control over the boundary conditions is given by the
4876             C<$ic> and C<$vc> ndarrays.
4877             The resulting values - C<$x,$f,$d> - can
4878             be used in all the functions which expect a cubic
4879             Hermite function, including L.
4880              
4881             References: Carl de Boor, A Practical Guide to Splines, Springer-Verlag,
4882             New York, 1978, pp. 53-59.
4883              
4884             =pod
4885              
4886             =head3 Parameters
4887              
4888             =over
4889              
4890             =item ic
4891              
4892             The first and second elements determine the boundary
4893             conditions at the start and end of the data respectively.
4894             The allowed values for C are:
4895              
4896             =over
4897              
4898             =item *
4899              
4900             0 to set C so that the third derivative is
4901             continuous at C.
4902              
4903             =item *
4904              
4905             1 if first derivative at C is given in C).
4906              
4907             =item *
4908              
4909             2 if second derivative at C) is given in C.
4910              
4911             =item *
4912              
4913             3 to use the 3-point difference formula for C.
4914             (Reverts to the default b.c. if C 3>.)
4915              
4916             =item *
4917              
4918             4 to use the 4-point difference formula for C.
4919             (Reverts to the default b.c. if C 4>.)
4920              
4921             =back
4922              
4923             The values for C are the same as above, except that
4924             the first-derivative value is stored in C for cases 1 and 2.
4925             The values of C<$vc> need only be set if options 1 or 2 are chosen
4926             for C<$ic>.
4927              
4928             NOTES: For the "natural" boundary condition, use IC(n)=2 and VC(n)=0.
4929              
4930             =item vc
4931              
4932             See ic for details
4933              
4934             =item ierr
4935              
4936             Error status:
4937              
4938             =over
4939              
4940             =item *
4941              
4942             0 if successful.
4943              
4944             =item *
4945              
4946             -1 if C 2>.
4947              
4948             =item *
4949              
4950             -3 if C<$x> is not strictly increasing.
4951              
4952             =item *
4953              
4954             -4 if C 0> or C 4>.
4955              
4956             =item *
4957              
4958             -5 if C 0> or C 4>.
4959              
4960             =item *
4961              
4962             -6 if both of the above are true.
4963              
4964             =item *
4965              
4966             -7 if C 2*n>.
4967              
4968             NOTE: The above errors are checked in the order listed,
4969             and following arguments have B been validated.
4970             (The D-array has not been changed in any of these cases.)
4971              
4972             =item *
4973              
4974             -8 in case of trouble solving the linear system
4975             for the interior derivative values.
4976             (The D-array may have been changed in this case. Do B use it!)
4977              
4978             =back
4979              
4980             =back
4981              
4982             Broadcasts over its inputs.
4983              
4984             =for bad
4985              
4986             C does not process bad values.
4987             It will set the bad-value flag of all output ndarrays if the flag is set for any of the input ndarrays.
4988              
4989             =cut
4990              
4991              
4992              
4993              
4994             *pchip_chsp = \&PDL::pchip_chsp;
4995              
4996              
4997              
4998              
4999              
5000              
5001             =head2 pchip_chfd
5002              
5003             =for sig
5004              
5005             Signature: (x(n); f(n); d(n); xe(ne);
5006             [o] fe(ne); [o] de(ne); indx [o] ierr(); int [o] skip())
5007             Types: (float double ldouble)
5008              
5009             =for usage
5010              
5011             ($fe, $de, $ierr, $skip) = pchip_chfd($x, $f, $d, $xe);
5012             pchip_chfd($x, $f, $d, $xe, $fe, $de, $ierr, $skip); # all arguments given
5013             ($fe, $de, $ierr, $skip) = $x->pchip_chfd($f, $d, $xe); # method call
5014             $x->pchip_chfd($f, $d, $xe, $fe, $de, $ierr, $skip);
5015              
5016             =for ref
5017              
5018             Evaluate a piecewise cubic Hermite function and its first derivative
5019             at an array of points. May be used by itself for Hermite interpolation,
5020             or as an evaluator for DPCHIM or DPCHIC.
5021              
5022             Given a piecewise cubic Hermite function - such as from
5023             L - evaluate the function (C<$fe>) and
5024             derivative (C<$de>) at a set of points (C<$xe>).
5025             If function values alone are required, use L.
5026              
5027             =pod
5028              
5029             =head3 Parameters
5030              
5031             =over
5032              
5033             =item xe
5034              
5035             array of points at which the functions are to
5036             be evaluated. NOTES:
5037              
5038             =over
5039              
5040             =item 1
5041              
5042             The evaluation will be most efficient if the elements
5043             of XE are increasing relative to X;
5044             that is, XE(J) .GE. X(I)
5045             implies XE(K) .GE. X(I), all K.GE.J .
5046              
5047             =item 2
5048              
5049             If any of the XE are outside the interval [X(1),X(N)],
5050             values are extrapolated from the nearest extreme cubic,
5051             and a warning error is returned.
5052              
5053             =back
5054              
5055             =item fe
5056              
5057             array of values of the cubic Hermite
5058             function defined by N, X, F, D at the points XE.
5059              
5060             =item de
5061              
5062             array of values of the first derivative of the same function at the points XE.
5063              
5064             =item ierr
5065              
5066             Error status:
5067              
5068             =over
5069              
5070             =item *
5071              
5072             0 if successful.
5073              
5074             =item *
5075              
5076             E0 if extrapolation was performed at C points
5077             (data still valid).
5078              
5079             =item *
5080              
5081             -1 if C 2>
5082              
5083             =item *
5084              
5085             -3 if C<$x> is not strictly increasing.
5086              
5087             =item *
5088              
5089             -4 if C 1>.
5090              
5091             =item *
5092              
5093             -5 if an error has occurred in a lower-level routine,
5094             which should never happen.
5095              
5096             =back
5097              
5098             =item skip
5099              
5100             Set to 1 to skip checks on the input data.
5101             This will save time in case these checks have already
5102             been performed (say, in L or L).
5103             Will be set to TRUE on normal return.
5104              
5105             =back
5106              
5107             Broadcasts over its inputs.
5108              
5109             =for bad
5110              
5111             C does not process bad values.
5112             It will set the bad-value flag of all output ndarrays if the flag is set for any of the input ndarrays.
5113              
5114             =cut
5115              
5116              
5117              
5118              
5119             *pchip_chfd = \&PDL::pchip_chfd;
5120              
5121              
5122              
5123              
5124              
5125              
5126             =head2 pchip_chfe
5127              
5128             =for sig
5129              
5130             Signature: (x(n); f(n); d(n); xe(ne);
5131             [o] fe(ne); indx [o] ierr(); int [o] skip())
5132             Types: (float double ldouble)
5133              
5134             =for usage
5135              
5136             ($fe, $ierr, $skip) = pchip_chfe($x, $f, $d, $xe);
5137             pchip_chfe($x, $f, $d, $xe, $fe, $ierr, $skip); # all arguments given
5138             ($fe, $ierr, $skip) = $x->pchip_chfe($f, $d, $xe); # method call
5139             $x->pchip_chfe($f, $d, $xe, $fe, $ierr, $skip);
5140              
5141             =for ref
5142              
5143             Evaluate a piecewise cubic Hermite function at an array of points.
5144             May be used by itself for Hermite interpolation, or as an evaluator
5145             for L or L.
5146              
5147             Given a piecewise cubic Hermite function - such as from
5148             L - evaluate the function (C<$fe>) at
5149             a set of points (C<$xe>).
5150             If derivative values are also required, use L.
5151              
5152             =pod
5153              
5154             =head3 Parameters
5155              
5156             =over
5157              
5158             =item x
5159              
5160             array of independent variable values. The
5161             elements of X must be strictly increasing:
5162              
5163             X(I-1) .LT. X(I), I = 2(1)N.
5164              
5165             (Error return if not.)
5166              
5167             =item f
5168              
5169             array of function values. F(I) is the value corresponding to X(I).
5170              
5171             =item d
5172              
5173             array of derivative values. D(I) is the value corresponding to X(I).
5174              
5175             =item xe
5176              
5177             array of points at which the function is to be evaluated. NOTES:
5178              
5179             =over
5180              
5181             =item 1
5182              
5183             The evaluation will be most efficient if the elements
5184             of XE are increasing relative to X;
5185             that is, XE(J) .GE. X(I)
5186             implies XE(K) .GE. X(I), all K.GE.J .
5187              
5188             =item 2
5189              
5190             If any of the XE are outside the interval [X(1),X(N)],
5191             values are extrapolated from the nearest extreme cubic,
5192             and a warning error is returned.
5193              
5194             =back
5195              
5196             =item fe
5197              
5198             array of values of the cubic Hermite
5199             function defined by N, X, F, D at the points XE.
5200              
5201             =item ierr
5202              
5203             Error status returned by C<$>:
5204              
5205             =over
5206              
5207             =item *
5208              
5209             0 if successful.
5210              
5211             =item *
5212              
5213             E0 if extrapolation was performed at C points
5214             (data still valid).
5215              
5216             =item *
5217              
5218             -1 if C 2>
5219              
5220             =item *
5221              
5222             -3 if C<$x> is not strictly increasing.
5223              
5224             =item *
5225              
5226             -4 if C 1>.
5227              
5228             =back
5229              
5230             (The FE-array has not been changed in any of these cases.)
5231             NOTE: The above errors are checked in the order listed,
5232             and following arguments have B been validated.
5233              
5234             =item skip
5235              
5236             Set to 1 to skip checks on the input data.
5237             This will save time in case these checks have already
5238             been performed (say, in L or L).
5239             Will be set to TRUE on normal return.
5240              
5241             =back
5242              
5243             Broadcasts over its inputs.
5244              
5245             =for bad
5246              
5247             C does not process bad values.
5248             It will set the bad-value flag of all output ndarrays if the flag is set for any of the input ndarrays.
5249              
5250             =cut
5251              
5252              
5253              
5254              
5255             *pchip_chfe = \&PDL::pchip_chfe;
5256              
5257              
5258              
5259              
5260              
5261              
5262             =head2 pchip_chia
5263              
5264             =for sig
5265              
5266             Signature: (x(n); f(n); d(n); la(); lb();
5267             [o]ans(); indx [o]ierr(); int [o]skip())
5268             Types: (float double ldouble)
5269              
5270             =for usage
5271              
5272             ($ans, $ierr, $skip) = pchip_chia($x, $f, $d, $la, $lb);
5273             pchip_chia($x, $f, $d, $la, $lb, $ans, $ierr, $skip); # all arguments given
5274             ($ans, $ierr, $skip) = $x->pchip_chia($f, $d, $la, $lb); # method call
5275             $x->pchip_chia($f, $d, $la, $lb, $ans, $ierr, $skip);
5276              
5277             =for ref
5278              
5279             Integrate (x,f(x)) over arbitrary limits.
5280              
5281             Evaluate the definite integral of a piecewise
5282             cubic Hermite function over an arbitrary interval, given by C<[$la,$lb]>.
5283              
5284             =pod
5285              
5286             =head3 Parameters
5287              
5288             =over
5289              
5290             =item x
5291              
5292             array of independent variable values. The elements
5293             of X must be strictly increasing (error return if not):
5294              
5295             X(I-1) .LT. X(I), I = 2(1)N.
5296              
5297             =item f
5298              
5299             array of function values. F(I) is the value corresponding to X(I).
5300              
5301             =item d
5302              
5303             should contain the derivative values, computed by L.
5304             See L if the integration limits are data points.
5305              
5306             =item la
5307              
5308             The values of C<$la> and C<$lb> do not have
5309             to lie within C<$x>, although the resulting integral
5310             value will be highly suspect if they are not.
5311              
5312             =item lb
5313              
5314             See la
5315              
5316             =item ierr
5317              
5318             Error status:
5319              
5320             =over
5321              
5322             =item *
5323              
5324             0 if successful.
5325              
5326             =item *
5327              
5328             1 if C<$la> lies outside C<$x>.
5329              
5330             =item *
5331              
5332             2 if C<$lb> lies outside C<$x>.
5333              
5334             =item *
5335              
5336             3 if both 1 and 2 are true. (Note that this means that either [A,B]
5337             contains data interval or the intervals do not intersect at all.)
5338              
5339             =item *
5340              
5341             -1 if C 2>
5342              
5343             =item *
5344              
5345             -3 if C<$x> is not strictly increasing.
5346              
5347             =item *
5348              
5349             -4 if an error has occurred in a lower-level routine,
5350             which should never happen.
5351              
5352             =back
5353              
5354             =item skip
5355              
5356             Set to 1 to skip checks on the input data.
5357             This will save time in case these checks have already
5358             been performed (say, in L or L).
5359             Will be set to TRUE on return with IERR E= 0.
5360              
5361             =back
5362              
5363             Broadcasts over its inputs.
5364              
5365             =for bad
5366              
5367             C does not process bad values.
5368             It will set the bad-value flag of all output ndarrays if the flag is set for any of the input ndarrays.
5369              
5370             =cut
5371              
5372              
5373              
5374              
5375             *pchip_chia = \&PDL::pchip_chia;
5376              
5377              
5378              
5379              
5380              
5381              
5382             =head2 pchip_chid
5383              
5384             =for sig
5385              
5386             Signature: (x(n); f(n); d(n);
5387             indx ia(); indx ib();
5388             [o]ans(); indx [o]ierr(); int [o]skip())
5389             Types: (float double ldouble)
5390              
5391             =for usage
5392              
5393             ($ans, $ierr, $skip) = pchip_chid($x, $f, $d, $ia, $ib);
5394             pchip_chid($x, $f, $d, $ia, $ib, $ans, $ierr, $skip); # all arguments given
5395             ($ans, $ierr, $skip) = $x->pchip_chid($f, $d, $ia, $ib); # method call
5396             $x->pchip_chid($f, $d, $ia, $ib, $ans, $ierr, $skip);
5397              
5398             =for ref
5399              
5400             Evaluate the definite integral of a piecewise cubic Hermite function
5401             over an interval whose endpoints are data points.
5402              
5403             Evaluate the definite integral of a a piecewise cubic Hermite
5404             function between C and C.
5405              
5406             See L for integration between arbitrary
5407             limits.
5408              
5409             =pod
5410              
5411             =head3 Parameters
5412              
5413             =over
5414              
5415             =item x
5416              
5417             array of independent variable values. The
5418             elements of X must be strictly increasing:
5419              
5420             X(I-1) .LT. X(I), I = 2(1)N.
5421              
5422             (Error return if not.)
5423              
5424             It is a fatal error to pass in data with C E 2.
5425              
5426             =item f
5427              
5428             array of function values. F(I) is the value corresponding to X(I).
5429              
5430             =item d
5431              
5432             should contain the derivative values, computed by L.
5433              
5434             =item ia
5435              
5436             IA,IB -- (input) indices in X-array for the limits of integration.
5437             both must be in the range [0,N-1] (this is different from the Fortran
5438             version) - error return if not. No restrictions on their relative
5439             values.
5440              
5441             =item ib
5442              
5443             See ia for details
5444              
5445             =item ierr
5446              
5447             Error status - this will be set, but an exception
5448             will also be thrown:
5449              
5450             =over
5451              
5452             =item *
5453              
5454             0 if successful.
5455              
5456             =item *
5457              
5458             -3 if C<$x> is not strictly increasing.
5459              
5460             =item *
5461              
5462             -4 if C<$ia> or C<$ib> is out of range.
5463              
5464             =back
5465              
5466             (VALUE will be zero in any of these cases.)
5467             NOTE: The above errors are checked in the order listed, and following
5468             arguments have B been validated.
5469              
5470             =item skip
5471              
5472             Set to 1 to skip checks on the input data.
5473             This will save time in case these checks have already
5474             been performed (say, in L or L).
5475             Will be set to TRUE on return with IERR of 0 or -4.
5476              
5477             =back
5478              
5479             Broadcasts over its inputs.
5480              
5481             =for bad
5482              
5483             C does not process bad values.
5484             It will set the bad-value flag of all output ndarrays if the flag is set for any of the input ndarrays.
5485              
5486             =cut
5487              
5488              
5489              
5490              
5491             *pchip_chid = \&PDL::pchip_chid;
5492              
5493              
5494              
5495              
5496              
5497              
5498             =head2 pchip_chbs
5499              
5500             =for sig
5501              
5502             Signature: (x(n); f(n); d(n); sbyte knotyp();
5503             [o]t(nknots=CALC(2*$SIZE(n)+4));
5504             [o]bcoef(ndim=CALC(2*$SIZE(n))); indx [o]ierr())
5505             Types: (float double ldouble)
5506              
5507             =for usage
5508              
5509             ($t, $bcoef, $ierr) = pchip_chbs($x, $f, $d, $knotyp);
5510             pchip_chbs($x, $f, $d, $knotyp, $t, $bcoef, $ierr); # all arguments given
5511             ($t, $bcoef, $ierr) = $x->pchip_chbs($f, $d, $knotyp); # method call
5512             $x->pchip_chbs($f, $d, $knotyp, $t, $bcoef, $ierr);
5513              
5514             =for ref
5515              
5516             Piecewise Cubic Hermite function to B-Spline converter.
5517              
5518             Computes the B-spline representation of the PCH function
5519             determined by N,X,F,D. The output is the B-representation for the
5520             function: NKNOTS, T, BCOEF, NDIM, KORD.
5521              
5522             L, L, or L can be used to
5523             determine an interpolating PCH function from a set of data. The
5524             B-spline routine L can be used to evaluate the
5525             resulting B-spline representation of the data
5526             (i.e. C, C, C, C, and
5527             C).
5528              
5529             Caution: Since it is assumed that the input PCH function has been
5530             computed by one of the other routines in the package PCHIP,
5531             input arguments N, X are B checked for validity.
5532              
5533             Restrictions/assumptions:
5534              
5535             =over
5536              
5537             =item C<1>
5538              
5539             N.GE.2 . (not checked)
5540              
5541             =item C<2>
5542              
5543             X(i).LT.X(i+1), i=1,...,N . (not checked)
5544              
5545             =item C<4>
5546              
5547             KNOTYP.LE.2 . (error return if not)
5548              
5549             =item C<6>
5550              
5551             T(2*k+1) = T(2*k) = X(k), k=1,...,N . (not checked)
5552              
5553             * Indicates this applies only if KNOTYP.LT.0 .
5554              
5555             =back
5556              
5557             References: F. N. Fritsch, "Representations for parametric cubic
5558             splines," Computer Aided Geometric Design 6 (1989), pp.79-82.
5559              
5560             =pod
5561              
5562             =head3 Parameters
5563              
5564             =over
5565              
5566             =item f
5567              
5568             the array of dependent variable values.
5569             C is the value corresponding to C.
5570              
5571             =item d
5572              
5573             the array of derivative values at the data points.
5574             C is the value corresponding to C.
5575              
5576             =item knotyp
5577              
5578             flag which controls the knot sequence.
5579             The knot sequence C is normally computed from C<$x>
5580             by putting a double knot at each C and setting the end knot pairs
5581             according to the value of C (where C):
5582              
5583             =over
5584              
5585             =item *
5586              
5587             0 - Quadruple knots at the first and last points.
5588              
5589             =item *
5590              
5591             1 - Replicate lengths of extreme subintervals:
5592             C and
5593             C
5594              
5595             =item *
5596              
5597             2 - Periodic placement of boundary knots:
5598             C and
5599             C
5600              
5601             =item *
5602              
5603             E0 - Assume the C and C were set in a previous call.
5604             This option is provided for improved efficiency when used
5605             in a parametric setting.
5606              
5607             =back
5608              
5609             =item t
5610              
5611             the array of C<2*n+4> knots for the B-representation
5612             and may be changed by the routine.
5613             If C= 0>, C will be changed so that the
5614             interior double knots are equal to the x-values and the
5615             boundary knots set as indicated above,
5616             otherwise it is assumed that C was set by a
5617             previous call (no check is made to verify that the data
5618             forms a legitimate knot sequence).
5619              
5620             =item bcoef
5621              
5622             the array of 2*N B-spline coefficients.
5623              
5624             =item ierr
5625              
5626             Error status:
5627              
5628             =over
5629              
5630             =item *
5631              
5632             0 if successful.
5633              
5634             =item *
5635              
5636             -4 if C 2>. (recoverable)
5637              
5638             =item *
5639              
5640             -5 if C 0> and C. (recoverable)
5641              
5642             =back
5643              
5644             =back
5645              
5646             Broadcasts over its inputs.
5647              
5648             =for bad
5649              
5650             C does not process bad values.
5651             It will set the bad-value flag of all output ndarrays if the flag is set for any of the input ndarrays.
5652              
5653             =cut
5654              
5655              
5656              
5657              
5658             *pchip_chbs = \&PDL::pchip_chbs;
5659              
5660              
5661              
5662              
5663              
5664              
5665             =head2 pchip_bvalu
5666              
5667             =for sig
5668              
5669             Signature: (t(nplusk); a(n); indx ideriv(); x();
5670             [o]ans(); indx [o] inbv();
5671             [t] work(k3=CALC(3*($SIZE(nplusk)-$SIZE(n))));)
5672             Types: (float double ldouble)
5673              
5674             =for usage
5675              
5676             ($ans, $inbv) = pchip_bvalu($t, $a, $ideriv, $x);
5677             pchip_bvalu($t, $a, $ideriv, $x, $ans, $inbv); # all arguments given
5678             ($ans, $inbv) = $t->pchip_bvalu($a, $ideriv, $x); # method call
5679             $t->pchip_bvalu($a, $ideriv, $x, $ans, $inbv);
5680              
5681             =for ref
5682              
5683             Evaluate the B-representation of a B-spline at X for the
5684             function value or any of its derivatives.
5685              
5686             Evaluates the B-representation C<(T,A,N,K)> of a B-spline
5687             at C for the function value on C or any of its
5688             derivatives on C. Right limiting values
5689             (right derivatives) are returned except at the right end
5690             point C where left limiting values are computed. The
5691             spline is defined on C. BVALU returns
5692             a fatal error message when C is outside of this interval.
5693              
5694             To compute left derivatives or left limiting values at a
5695             knot C, replace C by C and set C, C.
5696              
5697             References: Carl de Boor, Package for calculating with B-splines,
5698             SIAM Journal on Numerical Analysis 14, 3 (June 1977), pp. 441-472.
5699              
5700             =pod
5701              
5702             =head3 Parameters
5703              
5704             =over
5705              
5706             =item t
5707              
5708             knot vector of length N+K
5709              
5710             =item a
5711              
5712             B-spline coefficient vector of length N,
5713             the number of B-spline coefficients; N = sum of knot multiplicities-K
5714              
5715             =item ideriv
5716              
5717             order of the derivative, 0 .LE. IDERIV .LE. K-1
5718              
5719             IDERIV=0 returns the B-spline value
5720              
5721             =item x
5722              
5723             T(K) .LE. X .LE. T(N+1)
5724              
5725             =item ans
5726              
5727             value of the IDERIV-th derivative at X
5728              
5729             =item inbv
5730              
5731             contains information for efficient processing after the initial
5732             call and INBV must not
5733             be changed by the user. Distinct splines require distinct INBV parameters.
5734              
5735             =back
5736              
5737             Broadcasts over its inputs.
5738              
5739             =for bad
5740              
5741             C does not process bad values.
5742             It will set the bad-value flag of all output ndarrays if the flag is set for any of the input ndarrays.
5743              
5744             =cut
5745              
5746              
5747              
5748              
5749             *pchip_bvalu = \&PDL::pchip_bvalu;
5750              
5751              
5752              
5753              
5754              
5755              
5756              
5757             #line 6328 "lib/PDL/Primitive.pd"
5758              
5759             =head1 AUTHOR
5760              
5761             Copyright (C) Tuomas J. Lukka 1997 (lukka@husc.harvard.edu). Contributions
5762             by Christian Soeller (c.soeller@auckland.ac.nz), Karl Glazebrook
5763             (kgb@aaoepp.aao.gov.au), Craig DeForest (deforest@boulder.swri.edu)
5764             and Jarle Brinchmann (jarle@astro.up.pt)
5765             All rights reserved. There is no warranty. You are allowed
5766             to redistribute this software / documentation under certain
5767             conditions. For details, see the file COPYING in the PDL
5768             distribution. If this file is separated from the PDL distribution,
5769             the copyright notice should be included in the file.
5770              
5771             Updated for CPAN viewing compatibility by David Mertens.
5772              
5773             =cut
5774             #line 5775 "lib/PDL/Primitive.pm"
5775              
5776             # Exit with OK status
5777              
5778             1;