Re^5: Polygon Creation -- Request for Algorithm Suggestions

golux:

Here's a "walk the outline" thing. The gist of it is that we have a little state machine that will walk the border for us. The machine wants to follow the border such that it keeps the interior of the polygon on the right hand side. It tracks $x and $y as the current border point, and $in_dir is the direction it came from. Then it looks up the preferred directions to look for the next point.

Other than your starting point list, I ignored your code. (Not that there's anything wrong with your code, but I just wanted to start from scratch.) As such, you'll probably want to rework it a good bit.

Frequently when I get some code together, I'll clean it up before posting, but I'll leave it in it's current form for you, ugly debugging traces and all! (Though I left out your original point data to save 100+ lines.) There are a few things I'd clean up if I felt like looking at it any further, but I'll leave it as an exercise for the reader. Ping me if there are any details you'd like clarified.

$ cat pm_1204060.pl
use strict;
use warnings;
use Data::Dump 'pp';

my @pts = (
    . . . your original point list elided for brevity . . .
);

# Find bounds of figure
my ($minX, $minY) = (999999999,999999999);
my ($maxX, $maxY) = (-$minX, -$minY);
for my $ar (@pts) {
    my ($x,$y) = @$ar;
    $minX = $x if $x < $minX; $maxX = $x if $x > $maxX;
    $minY = $y if $y < $minY; $maxY = $y if $y > $maxY;
}
print "Bounds X:$minX..$maxX, Y:$minY..$maxY\n";

# Build image
my @img;
push @img, [ (' ') x ($maxX - $minX + 1) ] for 0 .. $maxY-$minY+1;
for my $ar (@pts) {
    my ($x, $y) = @$ar;
    $x -= $minX;
    $y -= $minY;
    $img[$y][$x] = '#';
}

print_array(@img);

my @img2 = copy_array(@img);

# Annihilate the interior
for my $y (1 .. $#img-1) {
    for my $x (1 .. $#{$img[$y]}-1) {
        next unless $img[$y][$x] eq '#';
        next if $img[$y-1][$x] ne '#';
        next if $img[$y+1][$x] ne '#';
        next if $img[$y][$x-1] ne '#';
        next if $img[$y][$x+1] ne '#';
        $img2[$y][$x] = '.';
    }
}

print_array(@img2);

# Find a horizonal bit of edge from the top of the picture
# (so we can ensure that the interior of the image is on the right)
my ($x, $y);
OUTER:
for my $iy (0 .. $#img2) {
    for my $ix (0 .. $#{$img2[0]}) {
        if ($img2[$iy][$ix] eq '#'
                and $img2[$iy][$ix+1] eq '#'
                and $img2[$iy+1][$ix] eq '.') {
            $x = $ix;
            $y = $iy;
            last OUTER;
        }
    }
}

print "Found a bit of horizontal top edge at $x, $y\n";

# We've found a bit of horizontal edge, and we're proceeding in
# the +X direction, and we know the interior of the polygon is on
# the right hand side.
#
# So we'll build a simple state machine that walks the edge.
#
# $x, $y  - current point on the edge
# $in_dir - the direction we came from
#
# For each incoming direction, build a list of possible 'next points'
# in the preferred order (assuming that interior of polygon is on
# the right-hand side):

my %dirs = (
    # IN   [ preferred output directions ]
    '1' => [qw( 3 4 5 6 7 8 2 )],
    '2' => [qw( 3 4 5 6 7 8 1 )],
    '3' => [qw( 4 5 6 7 8 1 2 )],
    '4' => [qw( 5 6 7 8 1 2 3 )],
    '5' => [qw( 6 7 8 1 2 3 4 )],
    '6' => [qw( 7 8 1 2 3 4 5 )],
    '7' => [qw( 1 2 3 4 5 6 )],
    '8' => [qw( 3 4 5 6 7 )],
);

my %dels = (
    # IN   [ dx, dy, new_in_dir ]
    '1' => [ -1, -1, '5' ],
    '2' => [  0, -1, '6' ],
    '3' => [  1, -1, '7' ],
    '4' => [  1,  0, '8' ],
    '5' => [  1,  1, '1' ],
    '6' => [  0,  1, '2' ],
    '7' => [ -1,  1, '3' ],
    '8' => [ -1,  0, '4' ],
);

# Follow the border
my @points_in_order;

my $in_dir = '8';
$img[$y][$x] = '*';
push @points_in_order, [$x, $y];

my $cnt = 0;
@img = copy_array(@img2);
OUTER2:
while (1) {
    my @dirs = @{$dirs{$in_dir}};
    for my $d (@dirs) {
        my ($dx, $dy, $new_in_dir) = @{$dels{$d}};
        print "indir $in_dir  ($new_in_dir: $dx, $dy)\n";
        if ($img[$y+$dy][$x+$dx] eq '#') {
            ++$cnt;
            $in_dir = $new_in_dir;
            $y += $dy;
            $x += $dx;
            $img[$y][$x] = chr(65 + $cnt%26);
            print "  ($x,$y) $img[$y][$x]  $in_dir\n";
            push @points_in_order, [ $x, $y ];
            next OUTER2;
        }
    }
    print "Can't find anywhere to go! ('$in_dir': $x, $y)\n";
    last OUTER2;
}

print_array(@img);

print "Points in CW order around the boundary:\n",
    pp(\@points_in_order), "\n";

sub print_array {
    print "\n";
    my @array = @_;
    for my $i (0 .. $#array) {
        print ": ", join("", @{$array[$i]}), " : ", sprintf("% 3u",$i)
+, "\n";
    }
    print "  ";
    print substr("1234567890"x20, 0, scalar(@{$array[0]})), "\n\n";
}

sub copy_array {
    my @array = @_;
    my @ret;
    for my $ar (@array) {
        push @ret, [ @$ar ];
    }
    return @ret;
}
[download]

...roboticus

When your only tool is a hammer, all problems look like your thumb.

Comment on Re^5: Polygon Creation -- Request for Algorithm Suggestions Download Code

Replies are listed 'Best First'.
Re^6: Polygon Creation -- Request for Algorithm Suggestions by golux (Chaplain) on Nov 23, 2017 at 00:41 UTC
Thanks, roboticus, I'm going to study your code, and I'll let you know how I fare. It's an interesting idea, that of tracking the current direction and then resolving to a "preferred" direction. Plus, I chuckled at your "I ignored your code. ...", followed by your disclaimer so I wouldn't feel bad. I'll sometimes do the same -- avoid reading the existing code so I don't get any preconceptions :-) say substr+lc crypt(qw $i3 SI$),4,5	[reply]
Re^7: Polygon Creation -- Request for Algorithm Suggestions by golux (Chaplain) on Nov 24, 2017 at 19:57 UTC
An update: roboticus, yours is the method I ultimately went with; thank you again for a great answer. Your solution seemed both the simplest and quickest to implement. Another Update: Going back to my original CGI script, I determined your algorithm wasn't quite enough. There are cases when the set of points have not yet been used up, and yet the next point cannot be found, because it's not close enough to the last one. The solution for this seems to be to simply return the closest point not yet used. I've made that change to `Shape.pm` below. I abstracted your code into a couple of methods which are now part of my Shape.pm module. The test harness `test.pl` now simply looks like this: #!/usr/bin/perl ############### ## Libraries ## ############### use strict; use warnings; use Data::Dumper::Concise; use Function::Parameters; use lib "."; use Shape; ################## ## Main Program ## ################## my $pts = assign_points(); my $sh = Shape->new($pts, 1); my $outline = $sh->outline; printf "[Resulting Outline]\n"; foreach my $a_point (@$outline) { printf "[%s],", join(',', @$a_point); } print "\n"; ################# ## Subroutines ## ################# fun assign_points() { return [ [527,83],[527,84],[526,84],[525,84],[524,84],[523,84],[522,84] +, # ... Many more points -- see the original code ... ]; } [download] Here is my resulting `Shape.pm`: Read more... (15 kB) say substr+lc crypt(qw $i3 SI$),4,5	[reply] [d/l] [select]
Re^8: Polygon Creation -- Request for Algorithm Suggestions by huck (Prior) on Nov 24, 2017 at 20:22 UTC
I too was interested in that method, but the numbers kept "throwing" me, so i changed it to my %dirs = ( # IN [ preferred output directions ] # '1' => [qw( 3 4 5 6 7 8 2 )], # '2' => [qw( 3 4 5 6 7 8 1 )], # '3' => [qw( 4 5 6 7 8 1 2 )], # '4' => [qw( 5 6 7 8 1 2 3 )], # '5' => [qw( 6 7 8 1 2 3 4 )], # '6' => [qw( 7 8 1 2 3 4 5 )], # '7' => [qw( 1 2 3 4 5 6 )], # '8' => [qw( 3 4 5 6 7 )], 'nw' => [qw( ne e se s sw w n )], 'n' => [qw( ne e se s sw w nw )], 'ne' => [qw( e se s sw w nw n )], 'e' => [qw( se s sw w nw n ne )], 'se' => [qw( s sw w nw n ne e )], 's' => [qw( sw w nw n ne e se )], 'sw' => [qw( nw n ne e se s )], 'w' => [qw( ne e se s sw )], ); my %dels = ( # IN [ dx, dy, new_in_dir ] #nw '1' => [ -1, -1, '5' ], #n '2' => [ 0, -1, '6' ], #ne '3' => [ 1, -1, '7' ], #e '4' => [ 1, 0, '8' ], #se '5' => [ 1, 1, '1' ], #s '6' => [ 0, 1, '2' ], #sw '7' => [ -1, 1, '3' ], #w '8' => [ -1, 0, '4' ], 'nw' => [ -1, -1, 'se' ], 'n' => [ 0, -1, 's' ], 'ne' => [ 1, -1, 'sw' ], 'e' => [ 1, 0, 'w' ], 'se' => [ 1, 1, 'nw' ], 's' => [ 0, 1, 'n' ], 'sw' => [ -1, 1, 'ne' ], 'w' => [ -1, 0, 'e' ], ); [download] With a `my $in_dir = 'w';` to start it off. in_dir is the direction you came from, while the states are named in the direction they "look" To watch it work i changed the outer2 loop to OUTER2: while (1) { my @dirs = @{$dirs{$in_dir}}; my $orig_dir=$in_dir; my $tests=''; for my $d (@dirs) { my ($dx, $dy, $new_in_dir) = @{$dels{$d}}; $tests.= sprintf(" %2s",$d); if (($img[$y+$dy][$x+$dx]//' ') eq '#') { ++$cnt; $in_dir = $new_in_dir; $y += $dy; $x += $dx; $img[$y][$x] = chr(65 + $cnt%26); print '' .' indir '.sprintf("%2s",$orig_dir) .' to ' .sprintf("%2s",$in_dir) .' code ' .$img[$y][$x] .' path ' .sprintf('%24s',$tests) ." ($x,$y)\n"; push @points_in_order, [ $x, $y ]; next OUTER2; } } print "Can't find anywhere to go! ('$in_dir': $x, $y)\n"; last OUTER2; } [download] which gives me output like Found a bit of horizontal top edge at 22, 1 indir w to w code B path ne e (23,1) indir w to w code C path ne e (24,1) indir w to w code D path ne e (25,1) indir w to w code E path ne e (26,1) indir w to w code F path ne e (27,1) indir w to w code G path ne e (28,1) indir w to sw code H path ne (29,0) indir sw to n code I path nw n ne e se s (29,1) indir n to n code J path ne e se s (29,2) indir n to n code K path ne e se s (29,3) indir n to n code L path ne e se s (29,4) indir n to nw code M path ne e se (30,5) indir nw to w code N path ne e (31,5) indir w to nw code O path ne e se (32,6) indir nw to w code P path ne e (33,6) indir w to w code Q path ne e (34,6) indir w to w code R path ne e (35,6) indir w to w code S path ne e (36,6) indir w to w code T path ne e (37,6) indir w to w code U path ne e (38,6) indir w to sw code V path ne (39,5) indir sw to n code W path nw n ne e se s (39,6) indir n to n code X path ne e se s (39,7) indir n to n code Y path ne e se s (39,8) indir n to n code Z path ne e se s (39,9) indir n to n code A path ne e se s (39,10) indir n to n code B path ne e se s (39,11) indir n to n code C path ne e se s (39,12) indir n to n code D path ne e se s (39,13) indir n to n code E path ne e se s (39,14) indir n to n code F path ne e se s (39,15) indir n to n code G path ne e se s (39,16) indir n to n code H path ne e se s (39,17) indir n to n code I path ne e se s (39,18) indir n to n code J path ne e se s (39,19) indir n to n code K path ne e se s (39,20) indir n to n code L path ne e se s (39,21) indir n to n code M path ne e se s (39,22) indir n to n code N path ne e se s (39,23) indir n to ne code O path ne e se s sw (38,24) indir ne to n code P path e se s (38,25) indir n to n code Q path ne e se s (38,26) indir n to n code R path ne e se s (38,27) indir n to n code S path ne e se s (38,28) indir n to ne code T path ne e se s sw (37,29) indir ne to ne code U path e se s sw (36,30) indir ne to e code V path e se s sw w (35,30) indir e to e code W path se s sw w (34,30) indir e to e code X path se s sw w (33,30) indir e to e code Y path se s sw w (32,30) indir e to s code Z path se s sw w nw n (32,29) indir s to se code A path sw w nw (31,28) indir se to e code B path s sw w (30,28) indir e to e code C path se s sw w (29,28) indir e to e code D path se s sw w (28,28) indir e to e code E path se s sw w (27,28) indir e to e code F path se s sw w (26,28) indir e to se code G path se s sw w nw (25,27) indir se to e code H path s sw w (24,27) indir e to e code I path se s sw w (23,27) indir e to e code J path se s sw w (22,27) indir e to se code K path se s sw w nw (21,26) indir se to e code L path s sw w (20,26) indir e to e code M path se s sw w (19,26) indir e to e code N path se s sw w (18,26) indir e to e code O path se s sw w (17,26) indir e to e code P path se s sw w (16,26) indir e to e code Q path se s sw w (15,26) indir e to se code R path se s sw w nw (14,25) indir se to e code S path s sw w (13,25) indir e to e code T path se s sw w (12,25) indir e to e code U path se s sw w (11,25) indir e to e code V path se s sw w (10,25) indir e to se code W path se s sw w nw (9,24) indir se to se code X path s sw w nw (8,23) indir se to s code Y path s sw w nw n (8,22) indir s to s code Z path sw w nw n (8,21) indir s to se code A path sw w nw (7,20) indir se to s code B path s sw w nw n (7,19) indir s to s code C path sw w nw n (7,18) indir s to se code D path sw w nw (6,17) indir se to s code E path s sw w nw n (6,16) indir s to s code F path sw w nw n (6,15) indir s to se code G path sw w nw (5,14) indir se to e code H path s sw w (4,14) indir e to e code I path se s sw w (3,14) indir e to s code J path se s sw w nw n (3,13) indir s to s code K path sw w nw n (3,12) indir s to s code L path sw w nw n (3,11) indir s to s code M path sw w nw n (3,10) indir s to se code N path sw w nw (2,9) indir se to se code O path s sw w nw (1,8) indir se to se code P path s sw w nw (0,7) indir se to s code Q path s sw w nw n (0,6) indir s to sw code R path sw w nw n ne (1,5) indir sw to nw code S path nw n ne e se (2,6) indir nw to n code T path ne e se s (2,7) indir n to nw code U path ne e se (3,8) indir nw to w code V path ne e (4,8) indir w to nw code W path ne e se (5,9) indir nw to w code X path ne e (6,9) indir w to nw code Y path ne e se (7,10) indir nw to w code Z path ne e (8,10) indir w to nw code A path ne e se (9,11) indir nw to w code B path ne e (10,11) indir w to w code C path ne e (11,11) indir w to w code D path ne e (12,11) indir w to nw code E path ne e se (13,12) indir nw to w code F path ne e (14,12) indir w to w code G path ne e (15,12) indir w to w code H path ne e (16,12) indir w to sw code I path ne (17,11) indir sw to s code J path nw n (17,10) indir s to s code K path sw w nw n (17,9) indir s to s code L path sw w nw n (17,8) indir s to s code M path sw w nw n (17,7) indir s to sw code N path sw w nw n ne (18,6) indir sw to sw code O path nw n ne (19,5) indir sw to sw code P path nw n ne (20,4) indir sw to s code Q path nw n (20,3) indir s to s code R path sw w nw n (20,2) indir s to w code S path sw w nw n ne e (21,2) indir w to sw code T path ne (22,1) Can't find anywhere to go! ('sw': 22, 1) [download] I found this much easier to follow.	[reply] [d/l] [select]
Re^9: Polygon Creation -- Request for Algorithm Suggestions by roboticus (Chancellor) on Nov 25, 2017 at 00:05 UTC
Re^8: Polygon Creation -- Request for Algorithm Suggestions by roboticus (Chancellor) on Nov 24, 2017 at 23:59 UTC
golux: I'm glad it was useful to you. While perusing your implementation, I noticed that I didn't fully fill out the `%dirs` map. I don't think I bothered to mention it, but the way it works is that from each step, it sweeps an arc clockwise based on the current point and the location it arrived from. That's the reason that it wants the bulk of the polygon on the right-hand side. If you wanted to put the bulk of the polygon on the left hand side, you'd simply reverse the arc direction on the lists. Since you indicated that it was interesting, I implemented some of the bits I thought up while enjoying Thanksgiving, and spent a little time cleaning up some of the ugly parts and removed some of the hacky bits: The hack I most wanted to remove was the part where I edited the polygon while building the points-in-order list. That prevens the algorithm from working on sections a single pixel thick, since it couldn't traverse both directions in that case. Next, I removed the part where I removed the interior, as I no longer needed it. If you want to remove the interior, you can do as the current version does, and simply render the in-order list on a blank canvas. Finally, I removed the ugly %dirs thing. Since we're just tracing an arc based on the incoming direction, I built a list that wrapped around nearly twice, and used the incoming direction to select the starting point of the list. I hope you also find this one amusing and/or useful. Read more... (7 kB) The output of the current version shows an example of a thin section, and shows also that it will only look at a single connected polygon. If you want to handle disjoint point sets, you should be able to do so simply by finding a starting point on each chunk, and looping over them. $ perl ~/pm_1204060_b.pl Bounds X:1..40, Y:1..31 Original image (relocated, pixels set to '#'): : # : 0 : ######## : 1 : ####### ########## : 2 : ######################## : 3 : ####### ########## : 4 : # ############# # : 5 : ### ###################### : 6 : ### ####################### : 7 : #### ####################### : 8 : ##### ####################### : 9 : ###### ####################### : 10 : ########## ####################### : 11 : ##################################### : 12 : ##################################### : 13 : ##################################### : 14 : ################################## : 15 : ################################## : 16 : ################################## : 17 : ################################# : 18 : ################################# : 19 : ################################# : 20 : ################################ : 21 : ################################ : 22 : ################################ : 23 : ############################## : 24 : ############################# : 25 : ######################## : 26 : ######## ################# : 27 : ######## ############# : 28 : ######## ###### : 29 : ##### : 30 : : 31 1234567890123456789012345678901234567890 Found a bit of horizontal top edge at 22, 1 Points rendered on blank canvas: : H : 0 : tBCDEFGI : 1 : efghijk rs J : 2 : d lmnopq K : 3 : cbaZYXW P L : 4 : r O MN V : 5 : q s N OPQRSTUW : 6 : p t M X : 7 : o uv L Y : 8 : n wx K Z : 9 : m yz J a : 10 : l ABCD I b : 11 : k EFGH c : 12 : j d : 13 : ihg e : 14 : f f : 15 : e g : 16 : d h : 17 : c i : 18 : b j : 19 : a k : 20 : Z l : 21 : Y m : 22 : X n : 23 : W o : 24 : VUTSR p : 25 : QPONMLK q : 26 : JIHG r : 27 : FEDCBA s : 28 : z t : 29 : yxwvu : 30 : : 31 1234567890123456789012345678901234567890 Border points rendered on original polygon: : H : 0 : tBCDEFGI : 1 : efghijk rs#######J : 2 : d#######lmnopq#########K : 3 : cbaZYXW P########L : 4 : r O##########MN V : 5 : q#s N#############OPQRSTUW : 6 : p#t M#####################X : 7 : o#uv L#####################Y : 8 : n##wx K#####################Z : 9 : m###yz J#####################a : 10 : l#####ABCD I#####################b : 11 : k#########EFGH######################c : 12 : j###################################d : 13 : ihg#################################e : 14 : f################################f : 15 : e################################g : 16 : d################################h : 17 : c###############################i : 18 : b###############################j : 19 : a###############################k : 20 : Z##############################l : 21 : Y##############################m : 22 : X##############################n : 23 : W############################o : 24 : VUTSR#######################p : 25 : QPONMLK################q : 26 : ######## JIHG############r : 27 : ######## FEDCBA######s : 28 : ######## z####t : 29 : yxwvu : 30 : : 31 1234567890123456789012345678901234567890 [download] I hope you also find this one interesting. Update: Now that I look at it, I could remove the new_in_dir entry from the %dirs hash, and just look it up from @dirlist, like `$new_in_dir = @dirlist[4+$in_dir];`. ...roboticus When your only tool is a hammer, all problems look like your thumb.	[reply] [d/l] [select]
Re^8: Polygon Creation -- Request for Algorithm Suggestions by vr (Curate) on Nov 24, 2017 at 23:54 UTC
Hi, just a note: looks like algorithm fails with "spikes" or "whiskers" i.e. single pixel protrusions, kind of: `fun assign_points() { # ....... # .#...... # .#...... # .####... # .####... # .####... # .######. # .#...... # .#...... # ........ return [ [1,1], [1,2], [1,3],[2,3],[3,3],[4,3], [1,4],[2,4],[3,4],[4,4], [1,5],[2,5],[3,5],[4,5], [1,6],[2,6],[3,6],[4,6],[5,6],[6,6], [1,7], [1,8], ]; }` [download] And: `012345 : # : 0 : # : 1 : #### : 2 : #### : 3 : #### : 4 : ###### : 5 : # : 6 : # : 7 Type [CR] 012345 : # : 0 : # : 1 : #### : 2 : #oo# : 3 : #oo# : 4 : ###### : 5 : # : 6 : # : 7 Type [CR] 012345 : # : 0 : # : 1 : ##AB : 2 : # C : 3 : # D : 4 : ####EF : 5 : # : 6 : # : 7 Type [CR] [Resulting Outline] [1,2],[2,2],[3,2],[3,3],[3,4],[4,5],[5,5],` [download] I thought polyline must retreat its steps along such protrusions, cf. output from my program: `........ .0...... .1...... .2765... .3..4... .4..3... .589012. .6...... .7...... ........` [download] Plus, not sure if it's safe to always hope for horizontal AND "interior on the right if moving CW" edge present -- circles, ~~upside-down~~ triangles, etc. -- but, it's your application and you know what input to expect. Edit:About triangles. + Not sure about the rule. But simple 3x3 triangle fails.	[reply] [d/l] [select]
Re^9: Polygon Creation -- Request for Algorithm Suggestions by roboticus (Chancellor) on Nov 25, 2017 at 01:06 UTC
Re^10: Polygon Creation -- Request for Algorithm Suggestions by roboticus (Chancellor) on Nov 26, 2017 at 19:22 UTC