一个天真的 Perl 版本:
use warnings;
use strict;
my $l = [ [0, 0, 2, 0],
[0, 0, 0, 2],
[0, 2, 2, 2],
[2, 0, 2, 2],
[2, 0, 4, 0],
[2, 2, 4, 2],
[4, 0, 4, 2] ];
my @f;
Segment:
while (my $line = shift @$l) {
for my $set (@f) {
push (@$set, $line), next Segment if is_conn($line, $set);
}
push @f, [$line];
}
for my $set (@f) {
print "\n================\n";
print join(",", @$_), "\n" for @$set;
}
sub is_conn {
my ($line, $set) = (shift, shift);
for my $cand (@$set) {
return 1 if has_same_point($cand, $line);
}
return 0;
}
sub has_same_point {
my ($l1, $l2) = @_;
my @p11 = ($l1->[0], $l1->[1]);
my @p12 = ($l1->[2], $l1->[3]);
my @p21 = ($l2->[0], $l2->[1]);
my @p22 = ($l2->[2], $l2->[3]);
return is_same_point(@p11, @p21) ||
is_same_point(@p12, @p21) ||
is_same_point(@p11, @p22) ||
is_same_point(@p12, @p22);
}
sub is_same_point {
my ($x1, $y1, $x2, $y2) = (@_);
return $x1 == $x2 && $y1 == $y2;
}