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] - $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);
}

sub-extract\u交叉{
我的@x=@{$\[0]}；我的@y=@{$\[1]}；
我的@xcross=（）；我的@ycross=（）；
对于（my$i=0；$i这是一种替代解决方案。
问题中的代码每次迭代都会计算
$k
的值，这太频繁了，因为只有在希望将值存储在一个返回数组中时才需要它。
这段代码循环遍历从
0
到
$\x-1
的索引，并利用索引始终存储在
$\u
中这一事实。这样，您就可以进行某种惰性评估。
我也不确定这是否是一个bug，但是在OP中
for
循环的第一次迭代中，比较是
$y[-1]*$y[0]>0
。这段代码不会这样做

use 5.010;              # for the // iterator
sub extract_crossing2 {
  my @x = @{ $_[0] }; my @y = @{ $_[1] };
  my (@xcross, @ycross);
  # "lazily" calculate $k,
  # there is a possibility of division by zero here! maybe catch that 
  # with if (defined $@){…}
  my $get_k = sub {
    eval {($y[$_] - $y[$_+1]) / ($x[$_] - $x[$_+1])}
  };
  foreach (0..$#x-1){
    my $k;        # only gets set if needed
    push @xcross, ($x[$_] - $y[$_]) / ($k  = $get_k->()) if $y[$_] * $y[$_+1] < 0;
    push @ycross, ($y[$_] - $x[$_]) * ($k // $get_k->()) if $x[$_] * $x[$_+1] < 0;
  }
  return \(@xcross, @ycross);
}

对//迭代器使用5.010；#
子提取_交叉2{
我的@x=@{$\[0]}；我的@y=@{$\[1]}；
我的（@xcross，@ycross）；
#“懒散地”计算$k，
#这里有被零除的可能性！也许能抓住它
#使用if（已定义的$@）{…}
我的$get_k=sub{
求值{（$y[$\u1]-$y[$\u1]）/（$x[$\u1]-$x[$\u1]））
};
foreach（0..$#x-1）{
我的$k；#只在需要时设置
如果$y[$\]*$y[$\+1]<0，则按@xcross，（$x[$\]-$y[$\]/（$k=$get\U k->（））；
如果$x[$\]*$x[$\++1]<0，则按@ycross，（$y[$\]-$x[$\]]*（$k/$get\u k->（））；
}
返回\（@xcross，@ycross）；
}

对于
List:：MoreUtils
和
List:：Util
提供的
pair*
例程，可能有一个不错的解决方案

编辑：如前所述，问题代码中可能存在被零除的错误。我没有解决这个错误。
如果
List:：MoreUtils
符合Perl的“默认工具”之一正如您在评论中所说，也应符合要求。
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], [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)'
);

输出：
1..8
ok 1-线段（-1,2）、（2，-1）在（1,0）处与x轴相交一次
ok 2-线段（-1,2）、（2，-1）在（0,1）处与y轴相交一次
ok 3-x轴上方的水平段从不与x轴相交
ok 4-y轴右侧的垂直段从不与y轴相交
ok 5-x轴上的水平段返回false（相交无限次）
ok 6-y轴上的垂直段返回false（与无限次相交）
不正常7-从原点开始的线段在（0,0）处与x轴相交
#“从原点开始的线段与（0，0）处的x轴相交”测试失败
#在几何图形第49行。
#结构开始于：
#$got='0'
#$expected=数组（0x1b1f088）
不正常8-从原点开始的线段在（0,0）处与y轴相交
#“从原点开始的线段在（0，0）处与y轴相交”测试失败
#在几何图形第55行。
#结构开始于：
#$got='0'
#$expected=数组（0x1b1f010）
#看起来你8次考试中有2次没通过。

看起来我们的上两个测试失败了：显然，一端在一条线上的线段不算相交（在原始算法中也是如此）。我不是几何专家，所以我无法评估这是错误还是数学正确

计算多段的截距
以下函数返回多条连接线段的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"
);

使用严格；
使用警告；
使用数学：：几何：：平面qw（线段线交点）；
使用Test：：异常；
使用测试：：更多测试=>3；
次x_拦截{
我的（$points）=@；
除非@$points>=2，否则模具“必须通过至少2分”；
我的@intercepts；
my@x_轴=（[0,0]，[1,0]）；
对于我的$i（0..$#$points-1）{
my$intersect=线段线交点（[@$points[$i，$i+1]，@x_轴]）；
push@intercepts，如果$intersect，则为$intersect；
}
返回\@截取；
}
dies_ok{x_拦截（[[0,0]]）}'以<2点'死亡；
你很深吗(
x_拦截（[-1，-1]，[1，1]，[1，-1]]），
[ [0, 0], [1, 0] ],
'在（0,0）和（1,0）处与x轴相交'
);
你很深吗(
x_拦截（[-1，-1]，[0,0]，[1,1]]），
[],
“当线段在x轴上开始或结束但不与x轴交叉时，无截距”
);

输出：
1..3
ok 1-模具具有<2个点
ok 2-在（0,0）和（1,0）处与x轴相交
ok 3-当线段在x轴上开始或结束，但不与x轴交叉时，无截距

请注意，此实现接受点的单个数组引用，其中点是对两元素数组的引用，而不是对x坐标和y坐标的单独数组引用。我认为这更直观一些。
您希望改进什么？运行时？可读性？以及默认工具是什么？is
List:：MoreUtils
默认工具？此外，如果您没有在圆环上操作，可能会出现错误。您可能希望从一开始循环，或者使用
$i+1
和
$i
而不是
$i
和
$i-1
作为索引，因为您在迭代中得到的结果是否定的，这意味着它从数组的末尾开始。@patrick是的，moreutils是默认的。运行时和可读性都很好。代码中有一些错误。我得到的解决方案与正文中的函数完全不同。成对例程会很好地看到。你能在没有5.010的情况下实现吗