CODEWITHSUNDEEP
arraysperl
Flexo - Save the data dump
Flexo - Save the data dump

Reputation: 88711

Reordering pairs in perl array

I have a series of 2-D coordinates being supplied to a perl program from another program. There are 4 of these and they make up a quad, giving 8 numbers in total, e.g:

x1 y1 x2 y2 x3 y3 x4 y4

I want to ensure that they are all specified in the same order, i.e. clockwise or counter clockwise. I already know how to do this and am doing it by looking at the sign of a cross product.

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

Once I've worked out if the order needs to be changed I currently change it using:

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

This works, but I'm fairly sure it's not the nicest way of writing it in perl. Is there a more elegant, "perly" way of writing this change in order? Something that would work for $n 2-D pairs preferably. It's not a simple reverse the elements of an array problem.

Upvotes: 7

Views: 257

Answers (4)

Eugene Yarmash
Eugene Yarmash

Reputation: 149806

The last couple of lines can be rewritten using an array slice:

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

To process an arbitrary number of pairs, you can use List::MoreUtils::natatime

use List::MoreUtils 'natatime';   

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

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

Upvotes: 8

mob
mob

Reputation: 118605

I recently had a similar problem, and settled on this concise algorithm:

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

The first line converts a flat list into a list of coordinate pairs, for example, (0,1,10,11,50,51) ==> ( [0,1], [10,11], [50,51] ).

The second line reverses the order of the pairs and flattens the list again.

Update: Even more concise:

@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;

Upvotes: 2

TLP
TLP

Reputation: 67910

Building on eugene's answer. A way to build the reversed list:

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

Upvotes: 0

Adrian Pronk
Adrian Pronk

Reputation: 13906

For $n 2-D pairs, you'll need a function that returns a list of the new ordering.
For example for $n == 8:

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

Then you can use that in the array-slice:

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

Upvotes: 2

Related Questions