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.

In reply to Re^5: Polygon Creation -- Request for Algorithm Suggestions by roboticus
in thread Polygon Creation -- Request for Algorithm Suggestions by golux

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.