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:
package Shape;
#=============#
## Libraries ##
#=============#
use strict;
use warnings;
use feature qw( say );
use Data::Dumper::Concise;
use Function::Parameters;
#===============#
## Constructor ##
#===============#
method new($proto: $a_points = [ ], $b_debug = 0) {
my $self = {
points => $a_points,
debug => $b_debug,
};
bless $self, $proto;
$self->_find_extrema();
$self->{image} = $self->_construct_image();
return $self;
}
#==================#
## Public methods ##
#==================#
#=============#
## Accessors ##
#=============#
method debug() { return $self->{debug} }
method points() { return $self->{points} }
method image() { return $self->{image} }
method extrema() { return @{$self->{extrema}} }
#
# outline()
#
# Returns the outline of the shape, constructing it first if necessar
+y.
#
method outline() {
if (!$self->{outline}) {
$self->remove_interior;
my ($x, $y) = $self->find_horizontal_edge();
$self->_find_outline($x, $y);
}
return $self->{outline};
}
#
# prune_interior_points()
#
# Removes points within the interior of the shape.
#
# Such points are defined as being bordered on all 4 sides
# (excluding diagonals) by other points in the shape.
#
# For example, the points '#' in the shape on the left would be
# pruned to produce the shape on the right (where 'o' stands for
# a point which has been pruned, so is actually no longer present
# in the shape):
#
# . . . . . . . . . . . . . . . . . . . . . . . .
# . . . # . . . . . . . . . . . # . . . . . . . .
# . . # # # . . . . . . . . . # o # . . . . . . .
# . . . # # # # # # # # . . . . # o # # # # # # .
# . . # # # # # # # # . . . . # o o o o o o # . .
# . # # # # # # # # . . . . # # o o o o o # . . .
# . . . # # # # # # # # . . . . # o o o o o # # .
# . . . . # # # # # . . . . . . . # # # # # . . .
# . . . . . . . . # # . . . . . . . . . . # # . .
# . . . . . . . . . . . . . . . . . . . . . . . .
#
method prune_interior_points() {
my $a_pruned = [ ];
my $a_points = $self->points;
for (my $i = 0; $i < @$a_points; $i++) {
my $a_pt = $a_points->[$i];
my ($x, $y) = @$a_pt;
if (!$self->_point_is_surrounded($x, $y, $a_points)) {
push @$a_pruned, [ $x, $y ];
}
}
return $self->{points} = $a_pruned;
}
#
# show_points()
#
# Creates a simple ascii display of the points in the shape
#
method show_points($label = "Shape") {
my $a_points = $self->points;
my ($minx, $miny, $maxx, $maxy) = $self->extrema();
my $width = $maxx - $minx + 1;
my $height = $maxy - $miny + 1;
my $N = @$a_points;
say "\n[$label: $N points]";
# Create a blank shape
my $shape = [ ];
for (my $y = 0; $y < $height + 2; $y++) {
my $row = $shape->[$y] = [ ];
for (my $x = 0; $x < $width + 2; $x++) {
$row->[$x] = 0;
}
}
# Fill in the points for the current shape
for (my $i = 0; $i < @$a_points; $i++) {
my $a_point = $a_points->[$i];
my ($x, $y) = @$a_point;
$y = $y - $miny + 1;
$x = $x - $minx + 1;
my $row = $shape->[$y];
$row->[$x] = 1;
}
# Display the resulting shape
for (my $y = 0; $y < $height + 2; $y++) {
my $row = $shape->[$y];
my $line = join("", map { $_? '#': '.' } @$row);
say $line;
}
}
method clone_image($a_image = $self->image) {
my $a_clone = [ ];
for (my $i = 0; $i < @$a_image; $i++) {
my $a_row = $a_image->[$i];
push @$a_clone, [ @$a_row ];
}
return $a_clone;
}
method remove_interior() {
my $a_image = $self->image;
my $a_new = $self->clone_image($a_image);
my $height = @$a_image;
my $width = @{$a_image->[0]};
# Temporarily mark interior points
for (my $y = 1; $y < $height; $y++) {
for (my $x = 1; $x < $width; $x++) {
if ($self->_is_interior_point($x, $y, $a_image)) {
$a_new->[$y][$x] = 'o';
}
}
}
$self->debug and $self->_print_image($a_new);
$self->{image} = $a_new;
}
method find_horizontal_edge($a_image = $self->image) {
my $height = @$a_image;
my $width = @{$a_image->[0]};
for (my $y = 0; $y < $height - 1; $y++) {
for (my $x = 0; $x < $width - 1; $x++) {
my $pt0 = $a_image->[$y][$x] || ' ';
my $pt1 = $a_image->[$y][$x+1] || ' ';
my $pt2 = $a_image->[$y+1][$x] || ' ';
if ($pt0 eq '#' and $pt1 eq '#' and $pt2 eq 'o') {
return ( $x, $y );
}
}
}
$self->_fatal("Unable to find a horizontal outer edge");
}
#===================#
## Private methods ##
#===================#
method _debug($msg) {
$self->{debug} or return;
say $msg;
}
method _fatal($msg) {
my $lnum = (caller)[2];
die "(Shape.pm) FATAL[$lnum]: $msg\n";
}
#
# _point_is_surrounded($x, $y, $a_points)
#
# Given a point ($x, $y), returns nonzero iff that point is bounded
# on all 4 sides (excluding diagonals) by other points.
#
method _point_is_surrounded($x, $y, $a_points = $self->points) {
my $nneighbors = 0;
for (my $i = 0; $i < @$a_points; $i++) {
my $a_pt = $a_points->[$i];
my ($x1, $y1) = @$a_pt;
my $dx = abs($x1 - $x);
my $dy = abs($y1 - $y);
if ((1 == $dx and 0 == $dy) or (0 == $dx and 1 == $dy)) {
++$nneighbors;
}
}
return (4 == $nneighbors)? 1: 0;
}
#
# _is_interior_point($x, $y, $a_image)
#
# Given a point ($x, $y) and an image $a_image, returns nonzero iff t
+hat
# point in the image is surrounded on all 4 sides (excluding diagonal
+s)
# by other points.
#
method _is_interior_point($x, $y, $a_image = $self->image) {
(($a_image->[$y][$x] || ' ') eq '#') or return 0;
(($a_image->[$y-1][$x] || ' ') eq '#') or return 0;
(($a_image->[$y+1][$x] || ' ') eq '#') or return 0;
(($a_image->[$y][$x-1] || ' ') eq '#') or return 0;
(($a_image->[$y][$x+1] || ' ') eq '#') or return 0;
return 1;
}
#
# _construct_image()
#
# Creates the 2-dimensional image defined by the shape's points.
#
method _construct_image() {
my ($minx, $miny, $maxx, $maxy) = $self->extrema();
my $height = $maxy - $miny + 1;
my $width = $maxx - $minx + 1;
my $a_image = [ ];
for (my $i = 0; $i < $height; $i++) {
push @$a_image, [ (' ') x $width ];
}
my $a_points = $self->points;
for my $a_pt (@$a_points) {
my ($x, $y) = @$a_pt;
$a_image->[$y - $miny][$x - $minx] = '#';
}
$self->debug and $self->_print_image($a_image);
return $a_image;
}
method _print_image($a_image = $self->image) {
print "\n";
my $a_line0 = $a_image->[0];
my $width = @$a_line0;
print " ";
for (my $i = 0; $i < $width; $i++) {
printf "%d", $i % 10;
}
print "\n";
for (my $i = 0; $i < @$a_image; $i++) {
my $a_line = $a_image->[$i] || 0;
$a_line or $self->fatal("Image[$i] is NOT an array");
printf ": %s : % 3u\n", join("", @$a_line), $i;
}
print "Type [CR]"; <STDIN>;
return;
}
#
# _find_extrema
#
# Finds the bounding box, represented by the Min (X, Y) and Max (X, Y
+)
# points for the shape.
#
method _find_extrema() {
my $a_points = $self->points;
my ($minx, $miny, $maxx, $maxy);
for (my $i = 0; $i < @$a_points; $i++) {
my ($x, $y) = @{$a_points->[$i]};
defined($x) or $self->_fatal("Undefined X");
defined($y) or $self->_fatal("Undefined Y");
if (0 == $i) {
$minx = $maxx = $x;
$miny = $maxy = $y;
}
($x < $minx) and $minx = $x;
($y < $miny) and $miny = $y;
($x > $maxx) and $maxx = $x;
($y > $maxy) and $maxy = $y;
}
my $a_extrema = $self->{extrema} = [ $minx, $miny, $maxx, $maxy ];
return @$a_extrema;
}
#
# _find_outline($x, $y, $a_image)
#
# Given a horizontal edge point ($x, $y) and an optional image $a_imag
+e,
# constructs the outline of the shape by walking around it, choosing t
+he
# best direction each time.
#
# Thanks to roboticus from perlmonks for the original algorithm.
# Ref: http://perlmonks.com/?node_id=1204093
#
# Roboticus writes:
# 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
##
method _find_outline($x, $y, $a_image = $self->image) {
# Get the extrema of the shape
my ($minx, $miny, $maxx, $maxy) = $self->_find_extrema;
# Follow the border
my $a_outline = [[ $x + $minx, $y + $miny ]];
my $in_dir = '8';
my $cnt = 0;
my $npts = 0; # Total points in image
# Discard interior points, which are no longer needed
for (my $y = 0; $y < @$a_image; $y++) {
my $a_row = $a_image->[$y];
for (my $x = 0; $x < @$a_row; $x++) {
($a_row->[$x] =~ /[ox]/) and $a_row->[$x] = ' ';
($a_row->[$x] eq '#') and ++$npts;
}
}
while (1) {
my $sym = chr(65 + $cnt++ % 26);
$in_dir = $self->_new_dir($a_image, $npts, \$x, \$y, $in_dir,
+$sym);
if (!$in_dir) {
$npts or last;
$self->debug and $self->_print_image($a_image);
$self->_fatal("There were $npts unused points");
}
push @$a_outline, [ $x + $minx, $y + $miny ];
--$npts;
}
$self->debug and $self->_print_image($a_image);
$self->{outline} = $a_outline;
}
#
# This method is also based on the algorithm by roboticus from perlmon
+ks
#
# The direction code maps to the following directions:
#
# 6
# 5 ^ 7
# \ | /
# \ | /
# 4 <--- o ---> 8
# / | \
# / | \
# 3 v 1
# 2
#
##
method _new_dir($a_image, $npts, $s_x, $s_y, $in_dir, $sym) {
my $height = @$a_image;
my $width = @{$a_image->[0]};
# Input dirction mapped to preferred output direction
my $h_dirs = {
'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 )],
};
# Delta X, Y and new input direction IN [ dx, dy, newdir ]
my $h_deltas = {
'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' ],
};
my $a_dirs = $h_dirs->{$in_dir};
for my $dir (@$a_dirs) {
my ($dx, $dy, $newdir) = @{$h_deltas->{$dir}};
my ($x1, $y1) = ($$s_x + $dx, $$s_y + $dy);
if ($x1 >= 0 and $y1 >= 0 and $x1 < $width and $y1 < $height)
+{
my $pixel = $a_image->[$y1][$x1] || ' ';
if ($pixel eq '#') {
$$s_x += $dx;
$$s_y += $dy;
$a_image->[$$s_y][$$s_x] = $sym;
return $newdir;
}
}
}
# If there are still unused points in the image, just pick
# the closest point and use that.
##
($npts > 0) and return $self->_closest_point($a_image, $s_x, $s_y,
+ $sym);
return 0;
}
method _distance($x0, $y0, $x1, $y1) {
return sqrt(($y1 - $y0) ** 2 + ($x1 - $x0) ** 2);
}
method _closest_point($a_image, $s_x, $s_y, $sym) {
my $mindist = 9999;
my ($x1, $y1);
for (my $y = 0; $y < @$a_image; $y++) {
my $a_row = $a_image->[$y];
for (my $x = 0; $x < @$a_row; $x++) {
($x == $$s_x and $y == $$s_y) and next;
my $pixel = $a_image->[$y][$x] || ' ';
if ($pixel eq '#') {
my $newdist = $self->_distance($x, $y, $$s_x, $$s_y);
if ($newdist < $mindist) {
($mindist, $x1, $y1) = ($newdist, $x, $y);
}
}
}
}
my $dx = $x1 - $$s_x;
my $dy = $y1 - $$s_y;
$$s_x = $x1;
$$s_y = $y1;
$a_image->[$$s_y][$$s_x] = '*';
(0 == $dx) and return ($dy < 0)? 6: 2; # North or South
(0 == $dy) and return ($dx < 0)? 4: 8; # West or East
($dx < 0) and return ($dy < 0)? 5: 3; # Northwest or Southwest
($dx > 0) and return ($dy < 0)? 7: 1; # Northeast or Southeast
return 0;
}
1;