File Coverage

blib/lib/PDL/ImageND.pm
Criterion Covered Total %
statement 58 62 93.5
branch 14 24 58.3
condition 1 6 16.6
subroutine 6 6 100.0
pod 0 2 0.0
total 79 100 79.0


line stmt bran cond sub pod time code
1             #
2             # GENERATED WITH PDL::PP from lib/PDL/ImageND.pd! Don't modify!
3             #
4             package PDL::ImageND;
5              
6             our @EXPORT_OK = qw(kernctr convolve ninterpol rebin circ_mean circ_mean_p convolveND contour_segments contour_polylines path_join path_segs combcoords repulse attract );
7             our %EXPORT_TAGS = (Func=>\@EXPORT_OK);
8              
9 5     5   680 use PDL::Core;
  5         11  
  5         54  
10 5     5   62 use PDL::Exporter;
  5         12  
  5         34  
11 5     5   30 use DynaLoader;
  5         10  
  5         2932  
12              
13              
14            
15             our @ISA = ( 'PDL::Exporter','DynaLoader' );
16             push @PDL::Core::PP, __PACKAGE__;
17             bootstrap PDL::ImageND ;
18              
19              
20              
21              
22              
23              
24              
25              
26             #line 4 "lib/PDL/ImageND.pd"
27              
28             =head1 NAME
29              
30             PDL::ImageND - useful image processing in N dimensions
31              
32             =head1 DESCRIPTION
33              
34             These routines act on PDLs as N-dimensional objects, not as broadcasted
35             sets of 0-D or 1-D objects. The file is sort of a catch-all for
36             broadly functional routines, most of which could legitimately
37             be filed elsewhere (and probably will, one day).
38              
39             ImageND is not a part of the PDL core (v2.4) and hence must be explicitly
40             loaded.
41              
42             =head1 SYNOPSIS
43              
44             use PDL::ImageND;
45              
46             $y = $x->convolveND($kernel,{bound=>'periodic'});
47             $y = $x->rebin(50,30,10);
48              
49             =cut
50              
51             use strict;
52             use warnings;
53             #line 54 "lib/PDL/ImageND.pm"
54              
55              
56             =head1 FUNCTIONS
57              
58             =cut
59              
60              
61              
62              
63              
64             #line 50 "lib/PDL/ImageND.pd"
65              
66             use Carp;
67             #line 68 "lib/PDL/ImageND.pm"
68              
69              
70             =head2 convolve
71              
72             =for sig
73              
74             Signature: (a(m); b(n); indx adims(p); indx bdims(q); [o]c(m))
75             Types: (sbyte byte short ushort long ulong indx ulonglong longlong
76             float double ldouble)
77              
78             =for ref
79              
80             N-dimensional convolution (Deprecated; use convolveND)
81              
82             =for usage
83              
84             $new = convolve $x, $kernel
85              
86             Convolve an array with a kernel, both of which are N-dimensional. This
87             routine does direct convolution (by copying) but uses quasi-periodic
88             boundary conditions: each dim "wraps around" to the next higher row in
89             the next dim.
90              
91             This routine is kept for backwards compatibility with earlier scripts;
92             for most purposes you want L instead:
93             it runs faster and handles a variety of boundary conditions.
94              
95             =pod
96              
97             Broadcasts over its inputs.
98              
99             =for bad
100              
101             C does not process bad values.
102             It will set the bad-value flag of all output ndarrays if the flag is set for any of the input ndarrays.
103              
104             =cut
105              
106              
107              
108              
109              
110             sub PDL::convolve {
111 1     1 0 4 my($x,$y,$c) = @_;
112 1 50 33     28 barf("Usage: convolve(a(*), b(*), [o]c(*)") if $#_<1 || $#_>2;
113 1 50       11 $c = PDL->null if $#_<2;
114 1 50       6 PDL::_convolve_int( $x->flat, $y->flat,
115             $x->shape, $y->shape,
116             $c->isnull ? $c : $c->flat,
117             );
118 1         28 $c->setdims([$x->dims]);
119              
120 1 50       8 if($x->is_inplace) {
121 0         0 $x .= $c;
122 0         0 $x->set_inplace(0);
123 0         0 return $x;
124             }
125 1         8 return $c;
126             }
127              
128              
129              
130             *convolve = \&PDL::convolve;
131              
132              
133              
134              
135              
136             #line 209 "lib/PDL/ImageND.pd"
137              
138             =head2 ninterpol()
139              
140             =for ref
141              
142             N-dimensional interpolation routine
143              
144             =for sig
145              
146             Signature: ninterpol(point(),data(n),[o]value())
147              
148             =for usage
149              
150             $value = ninterpol($point, $data);
151              
152             C uses C to find a linearly interpolated value in
153             N dimensions, assuming the data is spread on a uniform grid. To use
154             an arbitrary grid distribution, need to find the grid-space point from
155             the indexing scheme, then call C -- this is far from
156             trivial (and ill-defined in general).
157              
158             See also L, which includes boundary
159             conditions and allows you to switch the method of interpolation, but
160             which runs somewhat slower.
161              
162             =cut
163              
164             *ninterpol = \&PDL::ninterpol;
165              
166             sub PDL::ninterpol {
167             use PDL::Math 'floor';
168             use PDL::Primitive 'interpol';
169             print 'Usage: $x = ninterpolate($point(s), $data);' if $#_ != 1;
170             my ($p, $y) = @_;
171             my ($ip) = floor($p);
172             # isolate relevant N-cube
173             $y = $y->slice(join (',',map($_.':'.($_+1),list $ip)));
174             for (list ($p-$ip)) { $y = interpol($_,$y->xvals,$y); }
175             $y;
176             }
177             #line 178 "lib/PDL/ImageND.pm"
178              
179              
180             =head2 rebin
181              
182             =for sig
183              
184             Signature: (a(m); [o]b(n); int ns => n)
185             Types: (sbyte byte short ushort long ulong indx ulonglong longlong
186             float double ldouble)
187              
188             =for ref
189              
190             N-dimensional rebinning algorithm
191              
192             =for usage
193              
194             $new = rebin $x, $dim1, $dim2,..;.
195             $new = rebin $x, $template;
196             $new = rebin $x, $template, {Norm => 1};
197              
198             Rebin an N-dimensional array to newly specified dimensions.
199             Specifying `Norm' keeps the sum constant, otherwise the intensities
200             are kept constant. If more template dimensions are given than for the
201             input pdl, these dimensions are created; if less, the final dimensions
202             are maintained as they were.
203              
204             So if C<$x> is a 10 x 10 pdl, then C is a 15 x 10 pdl,
205             while C is a 15 x 16 x 17 pdl (where the values
206             along the final dimension are all identical).
207              
208             Expansion is performed by sampling; reduction is performed by averaging.
209             If you want different behavior, use L
210             instead. PDL::Transform::map runs slower but is more flexible.
211              
212             =pod
213              
214             Broadcasts over its inputs.
215              
216             =for bad
217              
218             C does not process bad values.
219             It will set the bad-value flag of all output ndarrays if the flag is set for any of the input ndarrays.
220              
221             =cut
222              
223              
224              
225              
226              
227             #line 286 "lib/PDL/ImageND.pd"
228             sub PDL::rebin {
229             my($x) = shift;
230             my($opts) = ref $_[-1] eq "HASH" ? pop : {};
231             my(@idims) = $x->dims;
232             my(@odims) = ref $_[0] ? $_[0]->dims : @_;
233             my($i,$y);
234             foreach $i (0..$#odims) {
235             if ($i > $#idims) { # Just dummy extra dimensions
236             $x = $x->dummy($i,$odims[$i]);
237             next;
238             # rebin_int can cope with all cases, but code
239             # 1->n and n->1 separately for speed
240             } elsif ($odims[$i] != $idims[$i]) { # If something changes
241             if (!($odims[$i] % $idims[$i])) { # Cells map 1 -> n
242             my ($r) = $odims[$i]/$idims[$i];
243             $y = ($i==0 ? $x : $x->mv($i,0))->dupN($r);
244             } elsif (!($idims[$i] % $odims[$i])) { # Cells map n -> 1
245             my ($r) = $idims[$i]/$odims[$i];
246             $x = $x->mv($i,0) if $i != 0;
247             # -> copy so won\'t corrupt input PDL
248             $y = $x->slice("0:-1:$r")->copy;
249             foreach (1..$r-1) {
250             $y += $x->slice("$_:-1:$r");
251             }
252             $y /= $r;
253             } else { # Cells map n -> m
254             &PDL::_rebin_int(($i==0 ? $x : $x->mv($i,0)), $y = null, $odims[$i]);
255             }
256             $x = $y->mv(0,$i);
257             }
258             }
259             if (exists $opts->{Norm} and $opts->{Norm}) {
260             my ($norm) = 1;
261             for $i (0..$#odims) {
262             if ($i > $#idims) {
263             $norm /= $odims[$i];
264             } else {
265             $norm *= $idims[$i]/$odims[$i];
266             }
267             }
268             return $x * $norm;
269             } else {
270             # Explicit copy so i) can\'t corrupt input PDL through this link
271             # ii) don\'t waste space on invisible elements
272             return $x -> copy;
273             }
274             }
275             #line 276 "lib/PDL/ImageND.pm"
276              
277             *rebin = \&PDL::rebin;
278              
279              
280              
281              
282              
283             #line 359 "lib/PDL/ImageND.pd"
284              
285             =head2 circ_mean_p
286              
287             =for ref
288              
289             Calculates the circular mean of an n-dim image and returns
290             the projection. Optionally takes the center to be used.
291              
292             =for usage
293              
294             $cmean=circ_mean_p($im);
295             $cmean=circ_mean_p($im,{Center => [10,10]});
296              
297             =cut
298              
299             sub circ_mean_p {
300             my ($x,$opt) = @_;
301             my ($rad,$sum,$norm);
302              
303             if (defined $opt) {
304             $rad = indx PDL::rvals($x,$opt);
305             }
306             else {
307             $rad = indx rvals $x;
308             }
309             my $max1 = $rad->max->sclr+1;
310             $sum = zeroes($max1);
311             PDL::indadd $x->flat, $rad->flat, $sum; # this does the real work
312             $norm = zeroes($max1);
313             PDL::indadd pdl(1), $rad->flat, $norm; # equivalent to get norm
314             $sum /= $norm;
315             return $sum;
316             }
317              
318             =head2 circ_mean
319              
320             =for ref
321              
322             Smooths an image by applying circular mean.
323             Optionally takes the center to be used.
324              
325             =for usage
326              
327             circ_mean($im);
328             circ_mean($im,{Center => [10,10]});
329              
330             =cut
331              
332             sub circ_mean {
333             my ($x,$opt) = @_;
334             my ($rad,$sum,$norm,$a1);
335              
336             if (defined $opt) {
337             $rad = indx PDL::rvals($x,$opt);
338             }
339             else {
340             $rad = indx rvals $x;
341             }
342             my $max1 = $rad->max->sclr+1;
343             $sum = zeroes($max1);
344             PDL::indadd $x->flat, $rad->flat, $sum; # this does the real work
345             $norm = zeroes($max1);
346             PDL::indadd pdl(1), $rad->flat, $norm; # equivalent to get norm
347             $sum /= $norm;
348             $a1 = $x->flat;
349             $a1 .= $sum->index($rad->flat);
350              
351             return $x;
352             }
353              
354             #line 437 "lib/PDL/ImageND.pd"
355              
356             =head2 kernctr
357              
358             =for ref
359              
360             `centre' a kernel (auxiliary routine to fftconvolve)
361              
362             =for usage
363              
364             $kernel = kernctr($image,$smallk);
365             fftconvolve($image,$kernel);
366              
367             kernctr centres a small kernel to emulate the behaviour of the direct
368             convolution routines.
369              
370             =cut
371              
372             *kernctr = \&PDL::kernctr;
373              
374             sub PDL::kernctr {
375             # `centre' the kernel, to match kernel & image sizes and
376             # emulate convolve/conv2d. FIX: implement with phase shifts
377             # in fftconvolve, with option tag
378             barf "Must have image & kernel for kernctr" if $#_ != 1;
379             my ($imag, $kern) = @_;
380             my (@ni) = $imag->dims;
381             my (@nk) = $kern->dims;
382             barf "Kernel and image must have same number of dims" if $#ni != $#nk;
383             my ($newk) = zeroes(double,@ni);
384             my ($k,$n,$y,$d,$i,@stri,@strk,@b);
385             for ($i=0; $i <= $#ni; $i++) {
386             $k = $nk[$i];
387             $n = $ni[$i];
388             barf "Kernel must be smaller than image in all dims" if ($n < $k);
389             $d = int(($k-1)/2);
390             $stri[$i][0] = "0:$d,";
391             $strk[$i][0] = (-$d-1).":-1,";
392             $stri[$i][1] = $d == 0 ? '' : ($d-$k+1).':-1,';
393             $strk[$i][1] = $d == 0 ? '' : '0:'.($k-$d-2).',';
394             }
395             # kernel is split between the 2^n corners of the cube
396             my ($nchunk) = 2 << $#ni;
397             CHUNK:
398             for ($i=0; $i < $nchunk; $i++) {
399             my ($stri,$strk);
400             for ($n=0, $y=$i; $n <= $#ni; $n++, $y >>= 1) {
401             next CHUNK if $stri[$n][$y & 1] eq '';
402             $stri .= $stri[$n][$y & 1];
403             $strk .= $strk[$n][$y & 1];
404             }
405             chop ($stri); chop ($strk);
406             (my $t = $newk->slice($stri)) .= $kern->slice($strk);
407             }
408             $newk;
409             }
410             #line 411 "lib/PDL/ImageND.pm"
411              
412              
413             =head2 convolveND
414              
415             =for sig
416              
417             Signature: (k0(); pdl *k; pdl *aa; pdl *a)
418             Types: (sbyte byte short ushort long ulong indx ulonglong longlong
419             float double ldouble)
420              
421             =for ref
422              
423             Speed-optimized convolution with selectable boundary conditions
424              
425             =for usage
426              
427             $new = convolveND($x, $kernel, [ {options} ]);
428              
429             Convolve an array with a kernel, both of which are N-dimensional.
430              
431             If the kernel has fewer dimensions than the array, then the extra array
432             dimensions are broadcasted over. There are options that control the boundary
433             conditions and method used.
434              
435             The kernel's origin is taken to be at the kernel's center. If your
436             kernel has a dimension of even order then the origin's coordinates get
437             rounded up to the next higher pixel (e.g. (1,2) for a 3x4 kernel).
438             This mimics the behavior of the earlier L and
439             L routines, so convolveND is a drop-in
440             replacement for them.
441              
442             The kernel may be any size compared to the image, in any dimension.
443              
444             The kernel and the array are not quite interchangeable (as in mathematical
445             convolution): the code is inplace-aware only for the array itself, and
446             the only allowed boundary condition on the kernel is truncation.
447              
448             convolveND is inplace-aware: say C to modify
449             a variable in-place. You don't reduce the working memory that way -- only
450             the final memory.
451              
452             OPTIONS
453              
454             Options are parsed by PDL::Options, so unique abbreviations are accepted.
455              
456             =over 3
457              
458             =item boundary (default: 'truncate')
459              
460             The boundary condition on the array, which affects any pixel closer
461             to the edge than the half-width of the kernel.
462              
463             The boundary conditions are the same as those accepted by
464             L, because this option is passed directly
465             into L. Useful options are 'truncate' (the
466             default), 'extend', and 'periodic'. You can select different boundary
467             conditions for different axes -- see L for more
468             detail.
469              
470             The (default) truncate option marks all the near-boundary pixels as BAD if
471             you have bad values compiled into your PDL and the array's badflag is set.
472              
473             =item method (default: 'auto')
474              
475             The method to use for the convolution. Acceptable alternatives are
476             'direct', 'fft', or 'auto'. The direct method is an explicit
477             copy-and-multiply operation; the fft method takes the Fourier
478             transform of the input and output kernels. The two methods give the
479             same answer to within double-precision numerical roundoff. The fft
480             method is much faster for large kernels; the direct method is faster
481             for tiny kernels. The tradeoff occurs when the array has about 400x
482             more pixels than the kernel.
483              
484             The default method is 'auto', which chooses direct or fft convolution
485             based on the size of the input arrays.
486              
487             =back
488              
489             NOTES
490              
491             At the moment there's no way to broadcast over kernels. That could/should
492             be fixed.
493              
494             The broadcasting over input is cheesy and should probably be fixed:
495             currently the kernel just gets dummy dimensions added to it to match
496             the input dims. That does the right thing tersely but probably runs slower
497             than a dedicated broadcastloop.
498              
499             The direct copying code uses PP primarily for the generic typing: it includes
500             its own broadcastloops.
501              
502             =pod
503              
504             Broadcasts over its inputs.
505              
506             =for bad
507              
508             C does not process bad values.
509             It will set the bad-value flag of all output ndarrays if the flag is set for any of the input ndarrays.
510              
511             =cut
512              
513              
514              
515              
516              
517 5     5   44 use PDL::Options;
  5         9  
  5         5731  
518              
519             # Perl wrapper conditions the data to make life easier for the PP sub.
520              
521             sub PDL::convolveND {
522 6     6 0 46 my($a0,$k,$opt0) = @_;
523 6         21 my $inplace = $a0->is_inplace;
524 6         23 my $x = $a0->new_or_inplace;
525              
526 6 50       37 barf("convolveND: kernel (".join("x",$k->dims).") has more dims than source (".join("x",$x->dims).")\n")
527             if($x->ndims < $k->ndims);
528              
529             # Coerce stuff all into the same type. Try to make sense.
530             # The trivial conversion leaves dataflow intact (nontrivial conversions
531             # don't), so the inplace code is OK. Non-inplace code: let the existing
532             # PDL code choose what type is best.
533 6         13 my $type;
534 6 50       13 if($inplace) {
535 0         0 $type = $a0->get_datatype;
536             } else {
537 6         15 my $z = $x->flat->index(0) + $k->flat->index(0);
538 6         103 $type = $z->get_datatype;
539             }
540 6         25 $x = $x->convert($type);
541 6         19 $k = $k->convert($type);
542              
543             ## Handle options -- $def is a static variable so it only gets set up once.
544 6         7 our $def;
545 6 100       16 unless(defined($def)) {
546 1         13 $def = PDL::Options->new( {
547             Method=>'a',
548             Boundary=>'t'
549             }
550             );
551 1         6 $def->minmatch(1);
552 1         4 $def->casesens(0);
553             }
554              
555 6         21 my $opt = $def->options(PDL::Options::ifhref($opt0));
556              
557             ###
558             # If the kernel has too few dimensions, we broadcast over the other
559             # dims -- this is the same as supplying the kernel with dummy dims of
560             # order 1, so, er, we do that.
561 6 50       61 $k = $k->dummy($x->dims - 1, 1)
562             if($x->ndims > $k->ndims);
563 6         38 my $kdims = pdl($k->dims);
564              
565             ###
566             # Decide whether to FFT or directly convolve: if we're in auto mode,
567             # choose based on the relative size of the image and kernel arrays.
568             my $fft = ( ($opt->{Method} =~ m/^a/i) ?
569             ( $x->nelem > 2500 and ($x->nelem) <= ($k->nelem * 500) ) :
570 6 50 0     42 ( $opt->{Method} !~ m/^[ds]/i )
571             );
572              
573             ###
574             # Pad the array to include boundary conditions
575 6         21 my $adims = $x->shape;
576 6         29 my $koff = ($kdims/2)->ceil - 1;
577              
578             my $aa = $x->range( -$koff, $adims + $kdims, $opt->{Boundary} )
579 6         53 ->sever;
580              
581 6 100       34 if ($fft) {
582 3         1024 require PDL::FFT;
583              
584 3 50       12 print "convolveND: using FFT method\n" if($PDL::debug);
585              
586             # FFT works best on doubles; do our work there then cast back
587             # at the end.
588 3         12 $aa = double($aa);
589 3         67 $_ = $aa->zeroes for my ($aai, $kk, $kki);
590 3         13 $kk->range( - ($kdims/2)->floor, $kdims, 'p') .= $k;
591 3         45 PDL::fftnd($kk, $kki);
592 3         10 PDL::fftnd($aa, $aai);
593              
594             {
595 3         23 my($ii) = $kk * $aai + $aa * $kki;
  3         14  
596 3         22 $aa = $aa * $kk - $kki * $aai;
597 3         21 $aai .= $ii;
598             }
599              
600 3         1577 PDL::ifftnd($aa,$aai);
601 3         13 $x .= $aa->range( $koff, $adims);
602              
603             } else {
604 3 50       9 print "convolveND: using direct method\n" if($PDL::debug);
605              
606             ### The first argument is a dummy to set $GENERIC.
607 3         11 &PDL::_convolveND_int( $k->flat->index(0), $k, $aa, $x );
608              
609             }
610              
611 6         118 $x;
612             }
613              
614              
615              
616              
617             *convolveND = \&PDL::convolveND;
618              
619              
620              
621              
622              
623              
624             =head2 contour_segments
625              
626             =for sig
627              
628             Signature: (c(); data(m,n); points(d,m,n);
629             [o] segs(d,q=CALC(($SIZE(m)-1)*($SIZE(n)-1)*4)); indx [o] cnt();)
630             Types: (float)
631              
632             =for usage
633              
634             ($segs, $cnt) = contour_segments($c, $data, $points);
635             contour_segments($c, $data, $points, $segs, $cnt); # all arguments given
636             ($segs, $cnt) = $c->contour_segments($data, $points); # method call
637             $c->contour_segments($data, $points, $segs, $cnt);
638              
639             =for ref
640              
641             Finds a contour in given data. Takes 3 ndarrays as input:
642              
643             C<$c> is the contour value (broadcast with this)
644              
645             C<$data> is an [m,n] array of values at each point
646              
647             C<$points> is a list of [d,m,n] points. It should be a grid monotonically
648             increasing with m and n.
649              
650             Returns C<$segs>, and C<$cnt> which is the highest 2nd-dim index in
651             C<$segs> that's defined. The contours are a collection of disconnected
652             line segments rather than a set of closed polygons.
653              
654             The data array represents samples of some field observed on the surface
655             described by points. This uses a variant of the Marching Squares
656             algorithm, though without being data-driven.
657              
658             =pod
659              
660             Broadcasts over its inputs.
661              
662             =for bad
663              
664             C does not process bad values.
665             It will set the bad-value flag of all output ndarrays if the flag is set for any of the input ndarrays.
666              
667             =cut
668              
669              
670              
671              
672             *contour_segments = \&PDL::contour_segments;
673              
674              
675              
676              
677              
678              
679             =head2 contour_polylines
680              
681             =for sig
682              
683             Signature: (c(); data(m,n); points(d,m,n);
684             indx [o] pathendindex(q=CALC(($SIZE(m)-1)*($SIZE(n)-1)*5)); [o] paths(d,q);
685             byte [t] seenmap(m,n))
686             Types: (float)
687              
688             =for ref
689              
690             Finds polylines describing contours in given data. Takes 3 ndarrays as input:
691              
692             C<$c> is the contour value (broadcast with this)
693              
694             C<$data> is an [m,n] array of values at each point
695              
696             C<$points> is a list of [d,m,n] points. It should be a grid monotonically
697             increasing with m and n.
698              
699             Returns C<$pathendindex>, and C<$paths>. Any C<$pathendindex> entries
700             after the pointers to the ends of polylines are negative.
701              
702             =head3 Algorithm
703              
704             Has two modes: scanning, and line-walking. Scanning is done from the
705             top left, along each row. Each point can be considered as, at C:
706              
707             a|b
708             +-+-
709             c|d|e
710              
711             Every potential boundary above, or to the left of (including the bottom
712             boundaries), C has been cleared (marked with a space above).
713              
714             =head4 Boundary detection
715              
716             This is done by first checking both points' coordinates are within
717             bounds, then checking if the boundary is marked seen, then detecting
718             whether the two cells' values cross the contour threshold.
719              
720             =head4 Scanning
721              
722             If detect boundary between C-C, and also C-C, C-C,
723             or C-C, line-walking starts C-C facing south.
724              
725             If not, mark C-C seen.
726              
727             If detect boundary C-C and C-C, line-walking starts C-C
728             facing west.
729              
730             If detect boundary C-C and also C-C or C-C, line-walking
731             starts C-C facing east.
732              
733             If not, mark C-C seen, and continue scanning.
734              
735             =head4 Line-walking
736              
737             The conditions above guarantee that any line started will have at least
738             two points, since two connected "points" (boundaries between two cells)
739             have been detected. The coordinates of the back end of the starting
740             "point" (boundary with direction) are recorded.
741              
742             At each, a line-point is emitted and that "point" is marked seen. The
743             coordinates emitted are linearly interpolated between the coordinates
744             of the two cells similarly to the Marching Squares algorithm.
745              
746             The next "point" is sought, looking in order right, straight ahead, then
747             left. Each one not detected is marked seen. That order means the walked
748             boundary will always turn as much right (go clockwise) as available,
749             thereby guaranteeing enclosing the area, which deals with saddle points.
750              
751             If a next "point" is found, move to that and repeat.
752              
753             If not, then if the front of the ending "point" (boundary plus direction)
754             is identical to the back of the starting point, a final point is emitted
755             to close the shape. Then the polyline is closed by emitting the current
756             point-counter into C.
757              
758             =for usage
759              
760             use PDL;
761             use PDL::ImageND;
762             use PDL::Graphics::Simple;
763             $SIZE = 500;
764             $vals = rvals($SIZE,$SIZE)->divide($SIZE/12.5)->sin;
765             @cntr_threshes = zeroes(9)->xlinvals($vals->minmax)->list;
766             $win = pgswin();
767             $xrange = [0,$vals->dim(0)-1]; $yrange = [0,$vals->dim(1)-1];
768             $win->plot(with=>'image', $vals, {xrange=>$xrange,yrange=>$yrange,j=>1},);
769             for $thresh (@cntr_threshes) {
770             ($pi, $p) = contour_polylines($thresh, $vals, $vals->ndcoords);
771             $pi_max = $pi->max;
772             next if $pi_max < 0;
773             $pi = $pi->where($pi > -1);
774             $p = $p->slice(',0:'.$pi_max);
775             @paths = path_segs($pi, $p->mv(0,-1));
776             $win->oplot(
777             (map +(with=>'lines', $_->dog), @paths),
778             {xrange=>$xrange,yrange=>$yrange,j=>1},
779             );
780             }
781             print "ret> "; <>;
782              
783             =pod
784              
785             Broadcasts over its inputs.
786              
787             =for bad
788              
789             C does not process bad values.
790             It will set the bad-value flag of all output ndarrays if the flag is set for any of the input ndarrays.
791              
792             =cut
793              
794              
795              
796              
797             *contour_polylines = \&PDL::contour_polylines;
798              
799              
800              
801              
802              
803              
804             =head2 path_join
805              
806             =for sig
807              
808             Signature: (e(v=2,n);
809             indx [o] pathendindex(n); indx [o] paths(nout=CALC($SIZE(n)*2));
810             indx [t] highestoutedge(d); indx [t] outedges(d,d); byte [t] hasinward(d);
811             indx [t] sourceids(d);
812             ; PDL_Indx d => d; int directed)
813             Types: (sbyte byte short ushort long ulong indx ulonglong longlong
814             float double ldouble)
815              
816             =for usage
817              
818             ($pathendindex, $paths) = path_join($e, $d); # using default value of directed=1
819             ($pathendindex, $paths) = path_join($e, $d, $directed); # overriding default
820             path_join($e, $pathendindex, $paths, $d, $directed); # all arguments given
821             ($pathendindex, $paths) = $e->path_join($d); # method call
822             ($pathendindex, $paths) = $e->path_join($d, $directed);
823             $e->path_join($pathendindex, $paths, $d, $directed);
824              
825             =for ref
826              
827             Links a (by default directed) graph's edges into paths.
828              
829             The outputs are the indices into C ending each path. Past the last
830             path, the indices are set to -1.
831              
832             =pod
833              
834             Broadcasts over its inputs.
835              
836             =for bad
837              
838             C does not process bad values.
839             It will set the bad-value flag of all output ndarrays if the flag is set for any of the input ndarrays.
840              
841             =cut
842              
843              
844              
845              
846             *path_join = \&PDL::path_join;
847              
848              
849              
850              
851              
852             #line 1126 "lib/PDL/ImageND.pd"
853              
854             =head2 path_segs
855              
856             =for ref
857              
858             Divide a path into segments.
859              
860             =for usage
861              
862             @segments = path_segs($pathindices, $paths);
863              
864             Returns a series of slices of the C, such as those created by
865             L, stopping at the first negative index. Currently does not
866             broadcast.
867              
868             =for example
869              
870             use PDL;
871             use PDL::ImageND;
872             use PDL::Graphics::Simple;
873             $SIZE = 500;
874             $vals = rvals($SIZE,$SIZE)->divide($SIZE/12.5)->sin;
875             @cntr_threshes = zeroes(9)->xlinvals($vals->minmax)->list;
876             $win = pgswin();
877             $xrange = [0,$vals->dim(0)-1]; $yrange = [0,$vals->dim(1)-1];
878             $win->plot(with=>'image', $vals, {xrange=>$xrange,yrange=>$yrange,j=>1},);
879             for $thresh (@cntr_threshes) {
880             my ($segs, $cnt) = contour_segments($thresh, $vals, $vals->ndcoords);
881             my $segscoords = $segs->slice(',0:'.$cnt->max)->clump(-1)->splitdim(0,4);
882             $linesegs = $segscoords->splitdim(0,2);
883             $uniqcoords = $linesegs->uniqvec;
884             next if $uniqcoords->dim(1) < 2;
885             $indexed = vsearchvec($linesegs, $uniqcoords)->uniqvec;
886             @paths = path_segs(path_join($indexed, $uniqcoords->dim(1), 0));
887             @paths = map $uniqcoords->dice_axis(1, $_)->mv(0,-1), @paths;
888             $win->oplot(
889             (map +(with=>'lines', $_->dog), @paths),
890             {xrange=>$xrange,yrange=>$yrange,j=>1},
891             );
892             }
893             print "ret> "; <>;
894              
895             =cut
896              
897             *path_segs = \&PDL::path_segs;
898             sub PDL::path_segs {
899             my ($pi, $p) = @_;
900             my ($startind, @out) = 0;
901             for ($pi->list) {
902             last if $_ < 0;
903             push @out, $p->slice("$startind:$_");
904             $startind = $_ + 1;
905             }
906             @out;
907             }
908             #line 909 "lib/PDL/ImageND.pm"
909              
910              
911             =head2 combcoords
912              
913             =for sig
914              
915             Signature: (x(); y(); z();
916             float [o]coords(tri=3);)
917             Types: (float double)
918              
919             =for usage
920              
921             $coords = combcoords($x, $y, $z);
922             combcoords($x, $y, $z, $coords); # all arguments given
923             $coords = $x->combcoords($y, $z); # method call
924             $x->combcoords($y, $z, $coords);
925              
926             =for ref
927              
928             Combine three coordinates into a single ndarray.
929              
930             Combine x, y and z to a single ndarray the first dimension
931             of which is 3. This routine does dataflow automatically.
932              
933             =pod
934              
935             Broadcasts over its inputs.
936             Creates data-flow by default.
937              
938             =for bad
939              
940             C does not process bad values.
941             It will set the bad-value flag of all output ndarrays if the flag is set for any of the input ndarrays.
942              
943             =cut
944              
945              
946              
947              
948             *combcoords = \&PDL::combcoords;
949              
950              
951              
952              
953              
954              
955             =head2 repulse
956              
957             =for sig
958              
959             Signature: (coords(nc,np); [o]vecs(nc,np); int [t]links(np);
960             double boxsize;
961             int dmult;
962             double a;
963             double b;
964             double c;
965             double d;
966             )
967             Types: (float double)
968              
969             =for usage
970              
971             $vecs = repulse($coords, $boxsize, $dmult, $a, $b, $c, $d);
972             repulse($coords, $vecs, $boxsize, $dmult, $a, $b, $c, $d); # all arguments given
973             $vecs = $coords->repulse($boxsize, $dmult, $a, $b, $c, $d); # method call
974             $coords->repulse($vecs, $boxsize, $dmult, $a, $b, $c, $d);
975              
976             =for ref
977              
978             Repulsive potential for molecule-like constructs.
979              
980             C uses a hash table of cubes to quickly calculate
981             a repulsive force that vanishes at infinity for many
982             objects. For use by the module L.
983             Checks all neighbouring boxes. The formula is:
984              
985             (r = |dist|+d) a*r^-2 + b*r^-1 + c*r^-0.5
986              
987             =pod
988              
989             Broadcasts over its inputs.
990              
991             =for bad
992              
993             C does not process bad values.
994             It will set the bad-value flag of all output ndarrays if the flag is set for any of the input ndarrays.
995              
996             =cut
997              
998              
999              
1000              
1001             *repulse = \&PDL::repulse;
1002              
1003              
1004              
1005              
1006              
1007              
1008             =head2 attract
1009              
1010             =for sig
1011              
1012             Signature: (coords(nc,np);
1013             int from(nl);
1014             int to(nl);
1015             strength(nl);
1016             [o]vecs(nc,np);;
1017             double m;
1018             double ms;
1019             )
1020             Types: (float double)
1021              
1022             =for usage
1023              
1024             $vecs = attract($coords, $from, $to, $strength, $m, $ms);
1025             attract($coords, $from, $to, $strength, $vecs, $m, $ms); # all arguments given
1026             $vecs = $coords->attract($from, $to, $strength, $m, $ms); # method call
1027             $coords->attract($from, $to, $strength, $vecs, $m, $ms);
1028              
1029             =for ref
1030              
1031             Attractive potential for molecule-like constructs.
1032              
1033             C is used to calculate
1034             an attractive force for many
1035             objects, of which some attract each other (in a way
1036             like molecular bonds).
1037             For use by the module L.
1038             For definition of the potential, see the actual function.
1039              
1040             =pod
1041              
1042             Broadcasts over its inputs.
1043              
1044             =for bad
1045              
1046             C does not process bad values.
1047             It will set the bad-value flag of all output ndarrays if the flag is set for any of the input ndarrays.
1048              
1049             =cut
1050              
1051              
1052              
1053              
1054             *attract = \&PDL::attract;
1055              
1056              
1057              
1058              
1059              
1060              
1061              
1062             #line 34 "lib/PDL/ImageND.pd"
1063              
1064             =head1 AUTHORS
1065              
1066             Copyright (C) Karl Glazebrook and Craig DeForest, 1997, 2003
1067             All rights reserved. There is no warranty. You are allowed
1068             to redistribute this software / documentation under certain
1069             conditions. For details, see the file COPYING in the PDL
1070             distribution. If this file is separated from the PDL distribution,
1071             the copyright notice should be included in the file.
1072              
1073             =cut
1074             #line 1075 "lib/PDL/ImageND.pm"
1075              
1076             # Exit with OK status
1077              
1078             1;