Question

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中的默认工具更好地完成此提取？

Answer 1

这是一种替代解决方案。问题中的代码计算每次迭代$k的值，这种情况经常发生，因为如果要将值存储在其中一个返回数组中，则只需要它。此代码循环遍历从0到$#x-1的索引，并利用索引始终存储在$_中的事实。这样，你就会有某种懒惰的评价。此外，我不确定它是否是一个错误，但在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);
}

pair*和List::MoreUtils提供的List::Util例程可能会有一个很好的解决方案。

编辑：正如ThisSuitIsBlackNot指出的那样，问题代码中可能会出现零错误。我没有解决这个错误。

Answer 2

如果您在评论中说List::MoreUtils符合Perl的“默认工具”之一，Math::Geometry::Planar也符合条件。 Math::Geometry::Planar提供了许多方便的函数来计算线段，光线和线的交集，以及操作多边形，计算距离和其他好东西的功能。

在评估任何解决方案时，您应该确保它为许多输入生成正确的结果，包括边缘情况。您的原始代码至少有一个错误（垂直线段的除零错误）...让我们确保来自Math::Geometry::Planar的{{3}}按预期工作：

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 - 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截距的实现几乎相同。请注意，如果一对段在轴上完全相交，则不会像原始函数那样计为截距。这可能是也可能不合适。

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..3
ok 1 - Dies with < 2 points
ok 2 - Intersects x-axis at (0, 0) and (1, 0)
ok 3 - No intercept when segments start or end on x-axis but don't cross it

请注意，此实现接受点的单个数组引用，其中点是对双元素数组的引用，而不是x和y坐标的单独数组引用。我认为这更直观一些。

用于提取轴上交叉线的交点的功能

2 个答案:

输出：

计算多个段的截距

输出：