perl – 提取轴上交叉线交点的功能
发布时间：2020-12-16 06:26:34 所属栏目：大数据 来源：网络整理
导读：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
|
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提供了许多方便的函数来计算线段,光线和线的交集,以及操作多边形,计算距离和其他好东西的功能.
在评估任何解决方案时,您应确保它为许多输入(包括边缘情况)生成正确的结果.您的原始代码至少有一个错误(垂直线段的除零错误)…让我们确保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,1] );
is_deeply(
SegmentLineIntersection([ [-1,2],[2,-1],@x_axis ]),'Segment (-1,2),(2,-1) intersects x-axis once at (1,0)'
);
is_deeply(
SegmentLineIntersection([ [-1,@y_axis ]),1],-1) intersects y-axis once at (0,1)'
);
is(
SegmentLineIntersection([ [0,'Horizontal segment above x-axis never intersects x-axis'
);
is(
SegmentLineIntersection([ [1,'Vertical segment to the right of y-axis never intersects y-axis'
);
is(
SegmentLineIntersection([ [0,'Horizontal segment on x-axis returns false (intersects infinite times)'
);
is(
SegmentLineIntersection([ [0,'Vertical segment on y-axis returns false (intersects infinite times)'
);
is_deeply(
SegmentLineIntersection([ [0,'Segment beginning at origin intersects x-axis at (0,0)'
);
is_deeply(
SegmentLineIntersection([ [0,'Segment beginning at origin intersects y-axis at (0,0)'
);
输出： 1..8 ok 1 - Segment (-1,0) ok 2 - Segment (-1,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截距的实现几乎相同.请注意,如果一对段在轴上完全相交,则不会像原始函数那样计为截距.这可能是也可能不是可取的. 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] );
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] ]),[ [0,0] ],'Intersects x-axis at (0,0) and (1,0)'
);
is_deeply(
x_intercepts([ [-1,1] ]),[],"No intercept when segments start or end on x-axis but don't cross it"
);
输出： 1..3 ok 1 - Dies with < 2 points ok 2 - Intersects x-axis at (0,0) ok 3 - No intercept when segments start or end on x-axis but don't cross it 请注意,此实现接受点的单个数组引用,其中点是对双元素数组的引用,而不是x和y坐标的单独数组引用.我认为这更直观一些. （编辑：李大同） 【声明】本站内容均来自网络，其相关言论仅代表作者个人观点，不代表本站立场。若无意侵犯到您的权利，请及时与联系站长删除相关内容! |