vr:
My starting point finder (first horizontal bit on highest line) is *definitely* not a safe way to find a starting point. I knew that, but didn't really think of mentioning it.
Even worse: I was hoping the faults you found with the code was due to the missing entries in the %dirs hash, but some caused a bit of grief. I've got it going a little better, but I'm still
testing it now. I'll post (yet another) version when I get the current kinks out.
One of the test cases with spindles in various directions:
$ perl ~/pm_1204060_b.pl ugly.2
Bounds X:0..13, Y:2..12
Original image (relocated, pixels set to '#'):
: ############## : 0
: # : 1
: # : 2
: ####### : 3
: #### : 4
: #### : 5
: ####### : 6
: ### : 7
: # : 8
: # : 9
: # : 10
: : 11
12345678901234
Found a bit of horizontal top edge at 3, 0
Start point:
: ###+########## : 0
: # : 1
: # : 2
: ####### : 3
: #### : 4
: #### : 5
: ####### : 6
: ### : 7
: # : 8
: # : 9
: # : 10
: : 11
12345678901234
Points rendered on blank canvas:
: yzABPONMLKJI : 0
: v : 1
: u : 2
: tSTUZYX : 3
: s a : 4
: r b : 5
: opql c : 6
: kjd : 7
: i : 8
: h : 9
: g : 10
: : 11
12345678901234
Border points rendered on original polygon:
: yzABPONMLKJI## : 0
: v : 1
: u : 2
: tSTUZYX : 3
: s##a : 4
: r##b : 5
: opql##c : 6
: kjd : 7
: i : 8
: h : 9
: g : 10
: : 11
12345678901234
...roboticus
When your only tool is a hammer, all problems look like your thumb. | [reply]
[d/l] |
OK, this is as good as it's gonna get. Rather, it's as good as I plan on making it. ;^)
Via (not exhaustive) testing, it seems that the best compromise for choosing the starting point is finding the upperleftmost point and pretending I came in from up and left. I've not caused that approach to fail.
Current weaknesses: If you select a different starting point that happens to be on a 'spindle', then it'll terminate early, as it currently stops when it hits it's starting point again. (You can see this by running it without an input file: the rightmost figure will be incomplete.) It could be fixed by going back and finding the set of boundary points, and then stopping instead when the length of the output points matches, but I don't really want to go back and find the boundary points again.
Anyway, I'm done with this pastime, and am moving on to another. I hope it's useful...
use strict;
use warnings;
use Data::Dump 'pp';
my @dirlist = (qw(1 2 3 4 5 6 7 8 1 2 3 4 5 6 7 8));
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' ],
);
###
# 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 ($rPoints, $rStarts) = read_image($FH);
my @pts = @$rPoints;
my @starts;
@starts = @$rStarts unless exists $ENV{ROBO_HIDE_STARTS};
print pp(\@starts), "\n";
#my @pts = read_image($FH);
###
# Find bounds of figure
###
my ($minX, $minY) = (0,0); #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);
my @ximg = copy_array(@original);
my @img = copy_array(@original);
my @points_in_order;
if (@starts) {
for my $ar (@starts) {
($in_dir, $start_x, $start_y) = @$ar;
print "Start ($start_x,$start_y) from dir $in_dir\n";
$ximg[$start_y][$start_x] = '+';
trace_border();
}
}
else {
($in_dir, $start_x, $start_y) = find_start_point(@original);
$ximg[$start_y][$start_x] = '+';
trace_border();
}
print "Start point(s):\n";
print_array(@ximg);
###
# 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
#
# TODO: Turn into a proper function
###
sub trace_border {
print "\n****************** ($start_x, $start_y) <$in_dir>\n";
push @points_in_order, [ $start_x, $start_y ];
my ($x, $y) = ($start_x, $start_y);
my $cnt=0;
do {
++$cnt;
last if $cnt>100;
# Check clockwise arc for next colored pixel
my @dirs = @dirlist[0+$in_dir .. 7+$in_dir];
print "($x,$y) <$in_dir> ", join(", ", @dirs), "\n";
for my $d (@dirs) {
#my ($dx, $dy, $new_in_dir) = @{$dels{$d}};
my ($dx, $dy) = @{$dels{$d}};
my $new_in_dir = $dirlist[4+$d];
my ($tx, $ty) = ($x+$dx, $y+$dy);
next if $tx<0 or $tx>$#{$img[$ty]};
next if $ty<0 or $ty>$#img;
print "\t($dx,$dy) <$new_in_dir> '$img[$ty][$tx]'\n";
#next if $tx < 0 or $ty < 0;
#next if $tx > $maxX-2 or $ty > $maxY-2;
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;
if (! exists $ENV{ROBOT_HIDE_ON_BLANK}) {
$fn_next_border_char = border_char_iterator();
my @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
###
if (!exists $ENV{ROBO_HIDE_ON_ORIG}) {
@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;
my @starts;
while (my $line = <$FH>) {
my @chars = split //, $line;
for my $x (0 .. $#chars) {
if ($chars[$x] !~ /\s/) {
push @points, [ $x, $. ];
}
if ($chars[$x] =~ /[1-8]/) {
push @starts, [ $chars[$x], $x, $. ];
}
}
}
return [@points], [@starts];
}
###
# Seems like using the upperleft most pixel I can find,
# coming in from direction 1 seems pretty robust.
###
sub find_start_point {
my @original = @_;
for my $iy (0 .. $#original-1) {
for my $ix (0 .. $#{$original[0]}-1) {
return '1', $ix, $iy if $original[$iy][$ix] eq '#';
}
}
}
__DATA__
# # # #
# # # #
#### #### #### ####
#### ###2 #### ####
6### #### #### ####
####### ####### ##4#### #####8#
# # # #
# # # #
...roboticus
When your only tool is a hammer, all problems look like your thumb. | [reply]
[d/l] |
