1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
|
# This code is part of Perl distribution Math-Polygon version 2.00.
# The POD got stripped from this file by OODoc version 3.03.
# For contributors see file ChangeLog.
# This software is copyright (c) 2004-2025 by Mark Overmeer.
# This is free software; you can redistribute it and/or modify it under
# the same terms as the Perl 5 programming language system itself.
# SPDX-License-Identifier: Artistic-1.0-Perl OR GPL-1.0-or-later
#oodist: *** DO NOT USE THIS VERSION FOR PRODUCTION ***
#oodist: This file contains OODoc-style documentation which will get stripped
#oodist: during its release in the distribution. You can use this file for
#oodist: testing, however the code of this development version may be broken!
# Algorithm by Dan Sunday
# - http://geometryalgorithms.com/Archive/algorithm_0109/algorithm_0109.htm
# Original contributed implementation in Perl by Jari Turkia.
package Math::Polygon::Convex;{
our $VERSION = '2.00';
}
use parent 'Exporter';
use strict;
use warnings;
use Log::Report 'math-polygon';
use Math::Polygon ();
our @EXPORT = qw/
chainHull_2D
/;
#--------------------
# is_left(): tests if a point is Left|On|Right of an infinite line.
# >0 for P2 left of the line through P0 and P1
# =0 for P2 on the line
# <0 for P2 right of the line
# See: the January 2001 Algorithm on Area of Triangles
# http://geometryalgorithms.com/Archive/algorithm_0101/algorithm_0101.htm
sub is_left($$$)
{ my ($P0, $P1, $P2) = @_;
($P1->[0] - $P0->[0]) * ($P2->[1] - $P0->[1])
- ($P2->[0] - $P0->[0]) * ($P1->[1] - $P0->[1]);
}
sub chainHull_2D(@)
{ my @P = sort { $a->[0] <=> $b->[0] || $a->[1] <=> $b->[1] } @_;
my @H; # output poly
# Get the indices of points with min x-coord and min|max y-coord
my $xmin = $P[0][0];
my ($minmin, $minmax) = (0, 0);
$minmax++ while $minmax < @P-1 && $P[$minmax+1][0]==$xmin;
if($minmax == @P-1) # degenerate case: all x-coords == xmin
{ push @H, $P[$minmin];
push @H, $P[$minmax] if $P[$minmax][1] != $P[$minmin][1];
push @H, $P[$minmin];
return Math::Polygon->new(@H);
}
push @H, $P[$minmin];
# Get the indices of points with max x-coord and min|max y-coord
my $maxmin = my $maxmax = @P-1;
my $xmax = $P[$maxmax][0];
$maxmin-- while $maxmin >= 1 && $P[$maxmin-1][0]==$xmax;
# Compute the lower hull
for(my $i = $minmax+1; $i <= $maxmin; $i++)
{ # the lower line joins P[minmin] with P[maxmin]
# ignore P[i] above or on the lower line
next if $i < $maxmin && is_left($P[$minmin], $P[$maxmin], $P[$i]) >= 0;
pop @H
while @H >= 2 && is_left($H[-2], $H[-1], $P[$i]) < 0;
push @H, $P[$i];
}
push @H, $P[$maxmax]
if $maxmax != $maxmin;
# Next, compute the upper hull on the stack H above the bottom hull
my $bot = @H-1; # the bottom point of the upper hull stack
for(my $i = $maxmin-1; $i >= $minmax; --$i)
{ # the upper line joins P[maxmax] with P[minmax]
# ignore P[i] below or on the upper line
next if $i > $minmax && is_left($P[$maxmax], $P[$minmax], $P[$i]) >= 0;
pop @H
while @H-1 > $bot && is_left($H[-2], $H[-1], $P[$i]) < 0;
push @H, $P[$i];
}
push @H, $P[$minmin]
if $minmax != $minmin; # joining endpoint onto stack
# Remove duplicate points.
for(my $i = @H-1; $i > 1; $i--)
{ splice @H, $i, 1
while $H[$i][0]==$H[$i-1][0] && $H[$i][1]==$H[$i-1][1];
}
Math::Polygon->new(@H);
}
1;
|
