in reply to Re: reordering segments to form a polygon
in thread reordering segments to form a polygon
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.
One thing it doesn't do is detects dots used more than once, so let's fix that:# -- 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)
%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);
|
---|
In Section
Seekers of Perl Wisdom