File Coverage

blib/lib/Math/Polygon/Convex.pm
Criterion Covered Total %
statement 42 46 91.3
branch 8 14 57.1
condition 14 21 66.6
subroutine 7 7 100.0
pod 1 2 50.0
total 72 90 80.0


line stmt bran cond sub pod time code
1             # Copyrights 2004,2006-2016 by [Mark Overmeer].
2             # For other contributors see ChangeLog.
3             # See the manual pages for details on the licensing terms.
4             # Pod stripped from pm file by OODoc 2.02.
5             # Algorithm by Dan Sunday
6             # - http://geometryalgorithms.com/Archive/algorithm_0109/algorithm_0109.htm
7             # Original implementation in Perl by Jari Turkia.
8              
9 1     1   13400 use strict;
  1         1  
  1         24  
10 1     1   3 use warnings;
  1         2  
  1         34  
11              
12             package Math::Polygon::Convex;
13 1     1   4 use vars '$VERSION';
  1         1  
  1         52  
14             $VERSION = '1.05';
15              
16 1     1   3 use base 'Exporter';
  1         0  
  1         85  
17              
18 1     1   324 use Math::Polygon;
  1         1  
  1         396  
19              
20             our @EXPORT = qw/
21             chainHull_2D
22             /;
23              
24              
25             # is_left(): tests if a point is Left|On|Right of an infinite line.
26             # >0 for P2 left of the line through P0 and P1
27             # =0 for P2 on the line
28             # <0 for P2 right of the line
29             # See: the January 2001 Algorithm on Area of Triangles
30             # http://geometryalgorithms.com/Archive/algorithm_0101/algorithm_0101.htm
31              
32             sub is_left($$$)
33 19     19 0 15 { my ($P0, $P1, $P2) = @_;
34              
35 19         68 ($P1->[0] - $P0->[0]) * ($P2->[1] - $P0->[1])
36             - ($P2->[0] - $P0->[0]) * ($P1->[1] - $P0->[1]);
37             }
38              
39             sub chainHull_2D(@)
40 1 50   1 1 17 { my @P = sort { $a->[0] <=> $b->[0] || $a->[1] <=> $b->[1] } @_;
  23         31  
41 1         1 my @H; # output poly
42              
43             # Get the indices of points with min x-coord and min|max y-coord
44 1         2 my $xmin = $P[0][0];
45 1         2 my ($minmin, $minmax) = (0, 0);
46 1   66     12 $minmax++ while $minmax < @P-1 && $P[$minmax+1][0]==$xmin;
47              
48 1 50       4 if($minmax == @P-1) # degenerate case: all x-coords == xmin
49 0         0 { push @H, $P[$minmin];
50 0 0       0 push @H, $P[$minmax] if $P[$minmax][1] != $P[$minmin][1];
51 0         0 push @H, $P[$minmin];
52 0         0 return Math::Polygon->new(@H);
53             }
54              
55 1         2 push @H, $P[$minmin];
56              
57             # Get the indices of points with max x-coord and min|max y-coord
58 1         2 my $maxmin = my $maxmax = @P-1;
59 1         2 my $xmax = $P[$maxmax][0];
60 1   33     6 $maxmin-- while $maxmin >= 1 && $P[$maxmin-1][0]==$xmax;
61              
62             # Compute the lower hull
63 1         3 for(my $i = $minmax+1; $i <= $maxmin; $i++)
64             { # the lower line joins P[minmin] with P[maxmin]
65             # ignore P[i] above or on the lower line
66 8 100 100     17 next if $i < $maxmin
67             && is_left($P[$minmin], $P[$maxmin], $P[$i]) >= 0;
68              
69             pop @H
70 6   100     11 while @H >= 2 && is_left($H[-2], $H[-1], $P[$i]) < 0;
71            
72 6         9 push @H, $P[$i];
73             }
74              
75 1 50       3 push @H, $P[$maxmax]
76             if $maxmax != $maxmin;
77              
78             # Next, compute the upper hull on the stack H above the bottom hull
79 1         1 my $bot = @H-1; # the bottom point of the upper hull stack
80 1         4 for(my $i = $maxmin-1; $i >= $minmax; --$i)
81             { # the upper line joins P[maxmax] with P[minmax]
82             # ignore P[i] below or on the upper line
83 8 100 66     15 next if $i > $minmax
84             && is_left($P[$maxmax], $P[$minmax], $P[$i]) >= 0;
85              
86             pop @H
87 1   33     4 while @H-1 > $bot && is_left($H[-2], $H[-1], $P[$i]) < 0;
88              
89 1         3 push @H, $P[$i];
90             }
91              
92 1 50       3 push @H, $P[$minmin]
93             if $minmax != $minmin; # joining endpoint onto stack
94              
95             # Remove duplicate points.
96 1         8 for(my $i = @H-1; $i > 1; $i--)
97 5   66     16 { splice @H, $i, 1
98             while $H[$i][0]==$H[$i-1][0] && $H[$i][1]==$H[$i-1][1];
99             }
100              
101 1         7 Math::Polygon->new(@H);
102             }
103              
104             1;