在 perl 数组中重新排序对

Question

我有一系列二维坐标从另一个程序提供给 perl 程序。其中有 4 个，它们组成一个四边形，总共给出 8 个数字，例如：

x1 y1 x2 y2 x3 y3 x4 y4

我想确保它们都以相同的顺序指定，即顺时针或逆时针。我已经知道如何做到这一点，并且正在通过查看叉积的符号来做到这一点。

use strict;
use warnings;

my $line = "-0.702083 0.31 -0.676042 -0.323333 0.74375 -0.21 0.695833 0.485";
my @coord = split(/[,\s]+/, $line);

# Vector cross product (Z is 0) to test CW/CCW
my @v1 = (-$coord[2]+$coord[0], -$coord[3]+$coord[1]);
my @v2 = (-$coord[2]+$coord[4], -$coord[3]+$coord[5]);
my $cross = ($v1[0]*$v2[1]) - ($v1[1]*$v2[0]);

一旦我确定了是否需要更改订单，我目前使用以下方式进行更改：

@coord = ($coord[6], $coord[7], $coord[4], $coord[5], 
          $coord[2], $coord[3], $coord[0], $coord[1]) if ($cross < 0);

这可行，但我相当肯定这不是用 perl 编写它的最佳方式。是否有一种更优雅、“perly”的方式来按顺序编写此更改？最好适用于$n 2-D 对的东西。这不是一个简单的反转数组元素的问题。

Answer 1

最后几行可以用数组切片重写：

@coord = @coord[6,7,4,5,2,3,0,1] if $cross < 0;

要处理任意数量的对，可以使用List::MoreUtils::natatime

use List::MoreUtils 'natatime';   

my $it = natatime 2, @coord;
@coord = (); 

while (my @vals = $it->()) {
    unshift @coord, @vals;
}

Answer 2

对于$n 二维对，您需要一个返回新排序列表的函数。
例如$n == 8:

sub reorder {
    my $n = shift;
    return (6,7,4,5,2,3,0,1) if $n == 8;
}

然后你可以在数组切片中使用它：

$n = 8;
@coord = @coord[reorder($n)] if $cross < 0;

Answer 3

我最近也遇到了类似的问题，就选择了这个简洁的算法：

splice @coords, $_, 2, [ $coords[$_],$coords[$_+1] ]  for 0..$#coords/2;
@coords = map { @$_ } reverse @coords;

第一行将平面列表转换为坐标对列表，例如， (0,1,10,11,50,51) ==> ( [0,1], [10,11], [50,51] ).

第二行颠倒了对的顺序并再次展平列表。

---

更新：更简洁：

@coords = @coords[reverse map{$_ ^ 1}0..$#coords] if $cross < 0;

@coords = @coords[map {-$_ ^ 1} 1..@coords] if $cross < 0;

@coords = @coords[map {$_ ^ -1} 1..@coords] if $cross < 0;

Answer 4

以尤金的回答为基础。一种构建反向列表的方法：

my $i = 0; 
unshift @i, $i++, $i++ while ($i <= $#coord); 
@coord = @coord[@i];