Perl中的代码是5.18.2.
sub extract_crossing {
my @x = @{ $_[0] }; my @y = @{ $_[1] };
my @xcross =(); my @ycross =();
for (my $i=0; $i<$#x; $i++) {
my $k = ($y[$i] - $y[$i+1]) / ($x[$i] - $x[$i+1]);
if($y[$i+1] * $y[$i] < 0) {
my $xc = $x[$i+1] - $y[$i+1] / $k;
push(@xcross, $xc);
}
if($x[$i+1] * $x[$i] < 0) {
my $yc = $y[$i+1] - $x[$i+1] * $k;
push(@ycross, $yc);
}
}
return (\@xcross, \@ycross);
}
它成功地提取了x轴和y轴的交叉点.它看起来第一点是两个后续点的乘积是负的.如果是,则与相应的轴相交.
但是,我觉得这个功能无关紧要,因为它是如此基本的操作.
如何使用Perl中的默认工具更好地完成这种提取？
如果List::MoreUtils符合您在评论中所说的 Perl 的“默认工具”之一，Math::Geometry::Planar那么也应该符合资格。Math::Geometry::Planar提供了许多方便的函数来计算线段、射线和直线的交集，以及操作多边形、计算距离和其他功能的函数。
在评估任何解决方案时，您应该确保它为许多输入（包括边缘情况）生成正确的结果。您的原始代码至少有一个错误（垂直线段被零除错误）...让我们确保SegmentLineIntersection按Math::Geometry::Planar预期工作：
use strict;
use warnings;
use Math::Geometry::Planar qw(SegmentLineIntersection);
use Test::More tests => 8;
my @x_axis = ( [0, 0], [1, 0] );
my @y_axis = ( [0, 0], [0, 1] );
is_deeply(
SegmentLineIntersection([ [-1, 2], [2, -1], @x_axis ]),
[1, 0],
'Segment (-1, 2), (2, -1) intersects x-axis once at (1, 0)'
);
is_deeply(
SegmentLineIntersection([ [-1, 2], [2, -1], @y_axis ]),
[0, 1],
'Segment (-1, 2), (2, -1) intersects y-axis once at (0, 1)'
);
is(
SegmentLineIntersection([ [0, 1], [1, 1], @x_axis ]),
0,
'Horizontal segment above x-axis never intersects x-axis'
);
is(
SegmentLineIntersection([ [1, 0], [1, 1], @y_axis ]),
0,
'Vertical segment to the right of y-axis never intersects y-axis'
);
is(
SegmentLineIntersection([ [0, 0], [1, 0], @x_axis ]),
0,
'Horizontal segment on x-axis returns false (intersects infinite times)'
);
is(
SegmentLineIntersection([ [0, 0], [0, 1], @y_axis ]),
0,
'Vertical segment on y-axis returns false (intersects infinite times)'
);
is_deeply(
SegmentLineIntersection([ [0, 0], [1, 1], @x_axis ]),
[0, 0],
'Segment beginning at origin intersects x-axis at (0, 0)'
);
is_deeply(
SegmentLineIntersection([ [0, 0], [1, 1], @y_axis ]),
[0, 0],
'Segment beginning at origin intersects y-axis at (0, 0)'
);
use strict;
use warnings;
use Math::Geometry::Planar qw(SegmentLineIntersection);
use Test::More tests => 8;
my @x_axis = ( [0, 0], [1, 0] );
my @y_axis = ( [0, 0], [0, 1] );
is_deeply(
SegmentLineIntersection([ [-1, 2], [2, -1], @x_axis ]),
[1, 0],
'Segment (-1, 2), (2, -1) intersects x-axis once at (1, 0)'
);
is_deeply(
SegmentLineIntersection([ [-1, 2], [2, -1], @y_axis ]),
[0, 1],
'Segment (-1, 2), (2, -1) intersects y-axis once at (0, 1)'
);
is(
SegmentLineIntersection([ [0, 1], [1, 1], @x_axis ]),
0,
'Horizontal segment above x-axis never intersects x-axis'
);
is(
SegmentLineIntersection([ [1, 0], [1, 1], @y_axis ]),
0,
'Vertical segment to the right of y-axis never intersects y-axis'
);
is(
SegmentLineIntersection([ [0, 0], [1, 0], @x_axis ]),
0,
'Horizontal segment on x-axis returns false (intersects infinite times)'
);
is(
SegmentLineIntersection([ [0, 0], [0, 1], @y_axis ]),
0,
'Vertical segment on y-axis returns false (intersects infinite times)'
);
is_deeply(
SegmentLineIntersection([ [0, 0], [1, 1], @x_axis ]),
[0, 0],
'Segment beginning at origin intersects x-axis at (0, 0)'
);
is_deeply(
SegmentLineIntersection([ [0, 0], [1, 1], @y_axis ]),
[0, 0],
'Segment beginning at origin intersects y-axis at (0, 0)'
);
看起来我们的最后两个测试失败了：显然，一端在一条线上的线段不算作相交（在您的原始算法中也是这种情况）。我不是几何专家，所以我无法评估这是一个错误还是数学上正确的。
以下函数返回多个相连线段的 x 截距。计算 y 轴截距的实现几乎相同。请注意，如果一对线段恰好在轴上相交，则它不会被视为截距，就像在原始函数中一样。这可能是可取的，也可能是不可取的。
use strict;
use warnings;
use Math::Geometry::Planar qw(SegmentLineIntersection);
use Test::Exception;
use Test::More tests => 3;
sub x_intercepts {
my ($points) = @_;
die 'Must pass at least 2 points' unless @$points >= 2;
my @intercepts;
my @x_axis = ( [0, 0], [1, 0] );
foreach my $i (0 .. $#$points - 1) {
my $intersect = SegmentLineIntersection([ @$points[$i, $i + 1], @x_axis ]);
push @intercepts, $intersect if $intersect;
}
return \@intercepts;
}
dies_ok { x_intercepts([ [0, 0] ]) } 'Dies with < 2 points';
is_deeply(
x_intercepts([ [-1, -1], [1, 1], [1, -1] ]),
[ [0, 0], [1, 0] ],
'Intersects x-axis at (0, 0) and (1, 0)'
);
is_deeply(
x_intercepts([ [-1, -1], [0, 0], [1, 1] ]),
[],
"No intercept when segments start or end on x-axis but don't cross it"
);
1..8
ok 1 - Segment (-1, 2), (2, -1) intersects x-axis once at (1, 0)
ok 2 - Segment (-1, 2), (2, -1) intersects y-axis once at (0, 1)
ok 3 - Horizontal segment above x-axis never intersects x-axis
ok 4 - Vertical segment to the right of y-axis never intersects y-axis
ok 5 - Horizontal segment on x-axis returns false (intersects infinite times)
ok 6 - Vertical segment on y-axis returns false (intersects infinite times)
not ok 7 - Segment beginning at origin intersects x-axis at (0, 0)
# Failed test 'Segment beginning at origin intersects x-axis at (0, 0)'
# at geometry line 49.
# Structures begin differing at:
# $got = '0'
# $expected = ARRAY(0x1b1f088)
not ok 8 - Segment beginning at origin intersects y-axis at (0, 0)
# Failed test 'Segment beginning at origin intersects y-axis at (0, 0)'
# at geometry line 55.
# Structures begin differing at:
# $got = '0'
# $expected = ARRAY(0x1b1f010)
# Looks like you failed 2 tests of 8.
请注意，此实现接受点的单个数组引用，其中点是对二元素数组的引用，而不是 x 坐标和 y 坐标的单独数组引用。我认为这更直观一些。