perl - 提取轴上交叉线的交点的函数

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

如 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)'
);

输出:

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 坐标的单独数组引用。我认为这更直观一些。