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:
I hope you also find this one amusing and/or useful.
use strict;
use warnings;
use Data::Dump 'pp';
###
# Read the image, converting non-space characters into '#'
###
my $FName = shift;
my $FH;
if (defined $FName) {
open $FH, '<', $FName or die "$FName: $!";
}
else {
$FH = \*DATA;
}
my @pts = read_image($FH);
###
# 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 a blank canvas and the original output image
###
my @canvas;
push @canvas, [ (' ') x ($maxX - $minX + 1) ] for 0 .. $maxY-$minY+1;
my @original = copy_array(@canvas);
for my $ar (@pts) {
my ($x, $y) = @$ar;
$x -= $minX;
$y -= $minY;
$original[$y][$x] = '#';
}
print "Original image (relocated, pixels set to '#'):\n";
print_array(@original);
###
# Find a horizonal bit of edge from the top of the picture
# NOTE: NOT ROBUST (it can be fooled).
###
my ($in_dir, $start_x, $start_y) = find_start_point(@original);
print "Found a bit of horizontal top edge at $start_x, $start_y\n";
###
# Build our list or border points by walking clockwise around the
# border of the polygon.
#
# NOTE: find_start_point needs to choose a point and incoming
# direction to let us walk the polygon edge clockwise.
#
# $x, $y - current point on the edge
# $in_dir - the direction we came from
###
my @dirlist = (qw(1 2 3 4 5 6 7 8 1 2 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 @img = copy_array(@original);
my @points_in_order = ( [$start_x, $start_y] );
my ($x, $y) = ($start_x, $start_y);
do {
# Check clockwise arc for next colored pixel
my @dirs = @dirlist[0+$in_dir .. 7+$in_dir];
for my $d (@dirs) {
my ($dx, $dy, $new_in_dir) = @{$dels{$d}};
my ($tx, $ty) = ($x+$dx, $y+$dy);
next if $tx < 0 or $ty < 0;
next if $tx >= $maxX or $ty >= $maxY;
if ($img[$ty][$tx] eq '#') {
($in_dir, $x, $y) = ($new_in_dir, $tx, $ty);
push @points_in_order, [ $x, $y ];
last;
}
}
} until ($x == $start_x and $y == $start_y);
###
# Render the points on a blank canvas
###
my $fn_next_border_char = border_char_iterator();
@img = copy_array(@canvas);
for my $i (0 .. $#points_in_order) {
my ($x,$y) = @{$points_in_order[$i]};
$img[$y][$x] = $fn_next_border_char->();
}
print "\nPoints rendered on blank canvas:\n";
print_array(@img);
###
# Draw 'em on the solid shape, to verify that border is correct
###
@img = copy_array(@original);
$fn_next_border_char = border_char_iterator();
for my $i (0 .. $#points_in_order) {
my ($x,$y) = @{$points_in_order[$i]};
$img[$y][$x] = $fn_next_border_char->();
}
print "\nBorder points rendered on original polygon:\n";
print_array(@img);
sub border_char_iterator {
my $cnt = 0;
my $border_chars = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrst
+uvwxyz";
return sub {
return substr($border_chars, $cnt++%length($border_chars), 1);
}
}
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;
}
sub read_image {
my $FH = shift;
my @points;
while (my $line = <$FH>) {
my @chars = split //, $line;
for my $x (0 .. $#chars) {
if ($chars[$x] !~ /\s/) {
push @points, [ $x, $. ];
}
}
}
return @points;
}
sub find_start_point {
my @original = @_;
for my $iy (0 .. $#original) {
for my $ix (0 .. $#{$original[0]}) {
if ($original[$iy][$ix] eq '#'
and $original[$iy][$ix+1] eq '#'
and $original[$iy+1][$ix] eq '#') {
$start_x = $ix;
$start_y = $iy;
return '8', $ix, $iy;
}
}
}
}
__DATA__
#
########
BBBBBBB ##########
BBBBBBBBBBBBBB##########
BBBBBBB ##########
# ############# #
### ######################
### #######################
#### #######################
##### #######################
###### #######################
########## #######################
#####################################
#####################################
#####################################
##################################
##################################
##################################
#################################
#################################
#################################
################################
################################
################################
##############################
#############################
########################
AAAAAAAA #################
AAAAAAAA #############
AAAAAAAA ######
#####
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.
I hope you also find this one interesting.
