perl – 提取轴上交叉线交点的功能

概述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] 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中的SegmentLineIntersection按预期工作：

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..8ok 1 - Segment (-1,0)ok 2 - Segment (-1,1)ok 3 - Horizontal segment above x-axis never intersects x-axisok 4 - Vertical segment to the right of y-axis never intersects y-axisok 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..3ok 1 - DIEs with < 2 pointsok 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坐标的单独数组引用.我认为这更直观一些.

总结

以上是内存溢出为你收集整理的perl – 提取轴上交叉线交点的功能全部内容，希望文章能够帮你解决perl – 提取轴上交叉线交点的功能所遇到的程序开发问题。

如果觉得内存溢出网站内容还不错，欢迎将内存溢出网站推荐给程序员好友。