go ahead... be a heretic PerlMonks

### Re: reordering segments to form a polygon

by johnnywang (Priest)
 on Aug 13, 2004 at 18:11 UTC ( #382785=note: print w/replies, xml ) Need Help??

in reply to reordering segments to form a polygon

Just tidy up what others have done, especially the non-closed situation.
```use strict;
my @seg = (
[ 1, 1, 2, 1 ],
[ 5, 5, 1, 5 ],
[ 2, 3, 5, 3 ],
[ 5, 3, 5, 5 ],
[ 2, 1, 2, 3 ],
[ 1, 5, 1, 1 ]);
my %pairs = map{("[\$_->[0],\$_->[1]]","[\$_->[2],\$_->[3]]")} @seg;
my \$start = "[1,1]";
my \$current = \$start;
do{
print \$current,"\n";
\$current = \$pairs{\$current};
}while(defined \$pairs{\$current} && \$current ne \$start)

__OUTPUT__
[1,1]
[2,1]
[2,3]
[5,3]
[5,5]
[1,5]

Replies are listed 'Best First'.
Re^2: reordering segments to form a polygon
by ikegami (Patriarch) on Aug 13, 2004 at 18:42 UTC
I independantly came up with the same thing! but since mine doesn't assume 1,1 exists and since mine detects unconnected polygons, I'll post it.
```# -- input --

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

# -- work --

%lookup = map { join(',', \$_->[0], \$_->[1]) => join(',', \$_->[2], \$_->
+[3]) } @r;

\$start = \$next = (sort(keys(%lookup)))[0];
#\$start = \$next = (keys(%lookup))[0];
do
{
push(@x, [ split(/\,/, \$next) ]);
\$next = \$lookup{\$next};
die("broken!\n") unless defined(\$next);
}
while (\$next ne \$start);

# -- output --

printf("[ %d, %d ]\n", @\$_) foreach (@x);

__END__
output:
[ 1, 1 ]
[ 2, 1 ]
[ 2, 3 ]
[ 5, 3 ]
[ 5, 5 ]
[ 1, 5 ]

time complexity:
O(n)  (without the unneccesary sort)
One thing it doesn't do is detects dots used more than once, so let's fix that:
```%lookup = map { join(',', \$_->[0], \$_->[1]) => join(',', \$_->[2], \$_->
+[3]) } @r;

\$start = \$next = (sort(keys(%lookup)))[0];
#\$start = \$next = (keys(%lookup))[0];
do
{
\$current = \$next;
push(@x, [ split(/,/, \$current) ]);
\$next = \$lookup{\$current};
delete(\$lookup{\$current});
die("broken or repeat!\n") unless defined(\$next);
}
while (\$next ne \$start);

Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: note [id://382785]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others contemplating the Monastery: (4)
As of 2022-12-10 05:26 GMT
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?

No recent polls found

Notices?