Re: reordering segments to form a polygon

in reply to reordering segments to form a polygon

perhaps this suits your needs?

use Data::Dumper;
my @r = ( 
  [ 5, 3, 5, 5 ],
  [ 1, 1, 2, 1 ],
  [ 2, 1, 2, 3 ],
  [ 5, 5, 1, 5 ],
  [ 1, 5, 1, 1 ],
  [ 2, 3, 5, 3 ]
);
@x =  sort { $a->[2] <=> $b->[0] || $a->[3] <=> $b->[1] || -1 } @r;
print Dumper(\@x);
__OUTPUT__
[ 1, 5, 1, 1 ]
[ 1, 1, 2, 1 ]
[ 2, 1, 2, 3 ]
[ 2, 3, 5, 3 ]
[ 5, 3, 5, 5 ]
[ 5, 5, 1, 5 ]
[download]

Update: As Jaap found out, it did not work always, so here is my next try:

for my $i (0..$#r) {
  my $p = $i + 1;
  for my $j ($p .. $#r) {
    next unless $r[$i]->[2] == $r[$j]->[0] 
             && $r[$i]->[3] == $r[$j]->[1];
    @r[$p, $j] = @r[$j, $p];
    last;
  }
}
[download]

Boris

Comment on Re: reordering segments to form a polygon Select or Download Code

Replies are listed 'Best First'.
Re^2: reordering segments to form a polygon by Jaap (Curate) on Aug 13, 2004 at 10:37 UTC
Although VERY beautiful, it is incorrect: `#!/cadappl/bin/perl -w -Ilib use strict; my @r = ( [ 5, 3, 5, 5 ], [ 1, 1, 2, 1 ], [ 2, 3, 5, 3 ], [ 5, 5, 1, 5 ], [ 2, 1, 2, 3 ], [ 1, 5, 1, 1 ], ); my @x = sort { $a->[2] <=> $b->[0] \|\| $a->[3] <=> $b->[1] \|\| -1 } @r; foreach (@x) { print "$_->[0],$_->[1],$_->[2],$_->[3]\n"; }` [download] Output: `1,5,1,1 1,1,2,1 2,1,2,3 5,5,1,5 2,3,5,3 5,3,5,5` [download] I changed the order of `@r` to show the error.	[reply] [d/l] [select]

Replies are listed 'Best First'.

Re^2: reordering segments to form a polygon
by Jaap (Curate) on Aug 13, 2004 at 10:37 UTC

#!/cadappl/bin/perl -w -Ilib

use strict;

my @r = ( 
  [ 5, 3, 5, 5 ],
  [ 1, 1, 2, 1 ],
  [ 2, 3, 5, 3 ],
  [ 5, 5, 1, 5 ],
  [ 2, 1, 2, 3 ],
  [ 1, 5, 1, 1 ],
);
my @x = sort { $a->[2] <=> $b->[0] || $a->[3] <=> $b->[1] || -1 } @r;
foreach (@x)
{
        print "$_->[0],$_->[1],$_->[2],$_->[3]\n";
}
[download]

1,5,1,1
1,1,2,1
2,1,2,3
5,5,1,5
2,3,5,3
5,3,5,5
[download]

@r

[reply]
[d/l]
[select]

In Section Seekers of Perl Wisdom