stu96art has asked for the wisdom of the Perl Monks concerning the following question:
I come to ya'll once again for a little help with tweaking my code. I was working on making a routine to make the list of vertex that I have, run clockwise if they are not listed that way already. My algorithm is pretty simple: 1) find the largest yvalue, 2) compare the next vertex's xvalue to that of the largest yvalue, 3) roughly, if the difference is positive, then it is clockwise, otherwise reverse the order. Now my code works for most cases, yet it does wrong on a case like:
 ^
 / /
 / 
 

the list comes in going clockwise, but my algorithm changes it because the next xvalue after the greatest yvalue is less than the xvalue of the greatest yvalue. Any help would be much appreciated. Thanks
my ($highest, $hv, $xclock, $negx);
my @backwards;
# MAKE CLOCKWISE *************************************
CLK: for $i (0..$#blocks) {
$highest = 0;
for $j (0..$#{$blocks[$i]}) {
if ($blocks[$i][$j][2] > $highest) {
$highest = $blocks[$i][$j][2];
$hv = $j;
}
}
if ($hv == 0) {
print "zero [$i][$i][$i][$i][$i]\n";
$xclock = $blocks[$i][($hv + 1)][1]  $blocks[$i][$hv][1];
if ($xclock == 0) {
$xclock = $blocks[$i][($hv + 2)][1]  $blocks[$i][$hv][1];
}
$negx = $blocks[$i][$hv][1]  $blocks[$i][($#{$blocks[$i]}  1
+)][1];
print "00000 blk [$i][$hv] clkwise [$xclock], [$negx]\n";
if ($xclock == 0) {
print "xclock 0 \n";
if ($negx < 0) {
print "change xclock 000\n";
@backwards = reverse @{$blocks[$i]};
for $k (0..$#backwards) {
print "xcl0000 [$k][1] $backwards[$k][1]\n";
print "xcl0000 [$k][2] $backwards[$k][2]\n";
}
@{$blocks[$i]} = @backwards;
next CLK;
}
}
if (($xclock < 0) ) {
print "change 000\n";
@backwards = reverse @{$blocks[$i]};
for $k (0..$#backwards) {
print "0000 [$k][1] $backwards[$k][1]\n";
print "0000 [$k][2] $backwards[$k][2]\n";
}
@{$blocks[$i]} = @backwards;
next CLK;
}
}
$xclock = $blocks[$i][($hv + 1)][1]  $blocks[$i][$hv][1];
if ($xclock == 0) {
$xclock = $blocks[$i][($hv + 2)][1]  $blocks[$i][$hv][1];
}
$negx = $blocks[$i][$hv][1]  $blocks[$i][($hv  1)][1];
print "BBBBBBBBBB [$i][$i][$i]\n";
print "blk [$i][$hv] clkwise [$xclock], [$negx]\n";
if (($xclock < 0)  ($negx < 0)) {
print "change reg\n";
@backwards = reverse @{$blocks[$i]};
for $k (0..$#backwards) {
print "[$k][1] $backwards[$k][1]\n";
print "[$k][2] $backwards[$k][2]\n";
}
@{$blocks[$i]} = @backwards;
next CLK;
}
}
Re: Making CLOCKWISE work (off by one)
by tye (Sage) on Feb 21, 2003 at 20:53 UTC

You just need to compare the X values between $hv1 and $hv+1 instead of between $hv and $hv+1. That is, you don't care whether the line segment that starts at the "top" goes to the left or the right of vertical, but instead whether it goes to the left or right of the line segment that ends at the "top".
[ Update: No, that won't work quite right either. If the rightoftop line segment is longer than the leftoftop line segment then the rightoftop could still end with an X coordinate that is to the left of the leftoftop line segments X coordinate. As Thelonius says, you want to compare slopes. You can probably reduce the equations so that you don't have to worry about dividing by zero and testing for multiple cases. Let me think about that...
Here is what I came up with:
my $b = $blocks[$i];
my $pv = $hv  1;
$pv = $#$b if $pv < 0;
my $nv = $hv + 1;
$nv = 0 if $#$b < $nv;
for my $v ( $pv, $hv, $nv ) {
$v = $b>[$v];
}
my $na= atan2( $nv>[_X]  $hv>[_X], $nv>[_Y]  $hv>[_Y] );
my $pa= atan2( $pv>[_X]  $hv>[_X], $pv>[_Y]  $hv>[_Y] );
if( $na < $pa ) {
# Not clockwise:
]
You could simplify your code a lot with a simple:
my $pv = $hv  1;
$pv = $#{$blocks[$i]} if $pv < 0;
and then merging your two big blocks of code into one block.
You could also make your code a lot easier to understand if you did something like:
sub _X() { 1 }
sub _Y() { 2 }
so that you could write
if ($blocks[$i][$j][_Y] > $highest) {
(or use constant if you prefer).
And after those changes, having $xclock == 0 would mean that you have two lines that lie on top of each other (at the "top" of your "polygon"), which should probably just be considered an error.
 tye  [reply] [d/l] [select] 
Re: Making CLOCKWISE work
by BrowserUk (Patriarch) on Feb 21, 2003 at 23:15 UTC

Hey stu69art, good luck with your search for an alternative algorithm. Here are a few testcases that you can use to verify your results that covers most of the cases you might encounter. Let us know how you get on:)
#! perl slw
use strict;
sub direction{
local($_, @_= @_);
push @_, $_[0];
$_+= $a>[0]*$b>[1]$a>[1]*$b>[0] while ($a,$b)=(shift,$_[0]),
+@_;
$_ < 0;
}
=pod
 .
 /.\
 // \\
// 
\\ _
 \\ //
 \v/
+v
=cut
my @inflectiveC = ([0,3],[3,6],[5,4],[4,4],[3,5],[1,3],[3,1],[4,2],[5,
+2],[3,0]);
print direction(@inflectiveC) ? 'Clockwise' : 'Not clockwise';
my @inflectiveA = reverse @inflectiveC;
print direction(@inflectiveA) ? 'Clockwise' : 'Not clockwise';
my @mirroredXC = reverse map{ [ 0  $_>[0], $_>[1]] } @inflectiveC;
print direction(@mirroredXC) ? 'Clockwise' : 'Not clockwise';
my @mirroredXA = map{ [ 0  $_>[0], $_>[1]] } @inflectiveC;
print direction(@mirroredXA) ? 'Clockwise' : 'Not clockwise';
my @mirroredYC = reverse map{ [$_>[0], 0  $_>[1]] } @inflectiveC;
print direction(@mirroredXC) ? 'Clockwise' : 'Not clockwise';
my @mirroredYA = map{ [$_>[0], 0  $_>[1]] } @inflectiveC;
print direction(@mirroredXA) ? 'Clockwise' : 'Not clockwise';
Examine what is said, not who speaks.
1) When a distinguished but elderly scientist states that something is possible, he is almost certainly right. When he states that something is impossible, he is very probably wrong.
2) The only way of discovering the limits of the possible is to venture a little way past them into the impossible
3) Any sufficiently advanced technology is indistinguishable from magic.
Arthur C. Clarke.
 [reply] [d/l] 
Re: Making CLOCKWISE work
by atcroft (Abbot) on Feb 21, 2003 at 20:17 UTC

Just looking at the figure, and assigning a few points to create a similar closed figure {(0,0), (25,15), (30,20), (35,15), (30,10), (30,0)}, I think the issue you are having is because you're changing orientations as you follow the vectors around the figure. Using the numbers above, you have the following directional vectors {(25i+15j), (5i+5j), (5i5j), (5i5j), (0i10j), (30i+0j)}. When you progress from point (35,15) to (30,10) to (30,0), you actually swing counterclockwise on the figure, before making a clockwise swing back to the start point. This would seem to be the cause of your issue.
If I recall enough from my classes in algorithms, there are algorithms from graph theory regarding directional paths and determining if they cross themselves. Sadly, I am not where I can look them up at the moment to point you to a particular one.
I hope this helps, or that other monks can either add more detail, or point out that I am incorrect and point us both in the correct direction.
 [reply] 
Re: Making CLOCKWISE work
by tall_man (Parson) on Feb 21, 2003 at 21:51 UTC

stu96art, I'm a bit peeved that you decided to "roll your own" clockwise tester after we gave you good algorithm ideas in the other thread. Comparing a couple of the verticies (or even vector slopes) won't work in general for concave polygons.
You could use the routine in Re: Re: Clockwise or Counterclockwise and solve this problem easily. It's the same algorithm as GreenTheoremTest without the extra object calls.  [reply] 
Re: Making CLOCKWISE work
by Thelonius (Priest) on Feb 21, 2003 at 20:30 UTC

I think that you need to compare slope, not xcoordinates, and you'll probably have to break into cases of zero, positive negative, and infinite slope. E.g. if both slopes are positive, the clockwise one is the one with the smaller slope. If both slopes are zero, pick the one with the smaller xcoordinate, etc.
 [reply] 
Re: Making CLOCKWISE work
by extremely (Priest) on Feb 21, 2003 at 23:43 UTC

What are you going to do if there are only 3 points and they are in a line? How would you handle this case where there are 9 points?
 ...
 ...
 ...


$you = new YOU;
honk() if $you>love(perl)  [reply] [d/l] 

