#!/usr/bin/perl use Park; use strict; my $p = Park->new; # accept all defaults $p->spoiler1; # place parks in the correct solution $p->bump_and_run; # time 'bump' until completion print $p->str_status; # print some stats print $p->str_grid; # print the grid visually exit(0); #### package Park; use strict; use vars qw/$PARK $BUILDING/; =comments This is an implementation of the November Dr Dobbs puzzle [Dr Ecco's Omniheurist Corner] It implements the park grid, and performs the spreading of development every bump =cut $PARK = 'P'; $BUILDING = 'B'; my $GRID_HEIGHT = 12; my $GRID_WIDTH = 12; sub new { my $class = shift; my %args = (height => $GRID_HEIGHT, width => $GRID_WIDTH, setup => 'default', # default, empty @_); my $self = bless \%args, $class; if ($self->{height} <= 0 || $self->{width} <= 0) { die "Illegal size for height or width"; } # initialize our variables $self->{bumps} = 0; # our count of time $self->{houses} = 0; # count of houses $self->{parks} = 0; # count of parks $self->{parcels} = $self->{height} * $self->{width}; my $grid = []; for (my $i = 0; $i < $self->{height}; $i++) { my $row = []; for (my $j = 0; $j < $self->{width}; $j++) { push @$row, ' '; } push @$grid, $row; } $self->{grid} = $grid; my $setup = delete $self->{setup}; if ($setup eq 'default') { $self->build(3,3); $self->build(3,4); $self->build(9,9); $self->build(8,9); } elsif ($setup ne 'empty') { die "Illegal parameter for setup of '$setup'"; } # else empty return $self; } sub free_parcels { # how many parcels are neither park nor built? my $self = shift; return ($self->{parcels} - $self->{houses} - $self->{parks}); } sub build { # put a building on a lot my $self = shift; my ($x, $y) = @_; $self->{houses}++; # we don't check the previous state return $self->{grid}->[$x]->[$y] = $BUILDING; } sub park { # put a park on a lot my $self = shift; my ($x, $y) = @_; $self->{parks}++; # we don't check the previous state return $self->{grid}->[$x]->[$y] = $PARK; } sub grid { # get the value of a particular spot my $self = shift; my ($x, $y) = @_; if ($x < 0 || $x > ($self->{height} -1) || $y < 0 || $y > ($self->{width} -1)) { return undef; } return $self->{grid}->[$x]->[$y]; } sub str_status { # string of current stats my $self = shift; return sprintf("%d turns, %d parks, %d/%d houses built", $self->{bumps}, $self->{parks}, $self->{houses}, $self->{parcels}, ); } sub str_grid { # string of ASCII grid my $self = shift; my $str = ''; my $bar; for ((-1..$self->{width})) { $bar .= '-'; } $bar .= "\n"; $str .= $bar; for (my $i = 0; $i < $self->{height}; $i++) { $str .= '|'; for (my $j = 0; $j < $self->{width}; $j++) { $str .= $self->grid($i, $j); } $str .= "|\n"; } $str .= $bar; return $str; } sub bump { # increase the time by one, my $self = shift; my @coords; for (my $i = 0; $i < $self->{height}; $i++) { for (my $j = 0; $j < $self->{width}; $j++) { if ($self->needs_building($i, $j)) { push @coords, ($i, $j); } } } while (@coords) { my ($x, $y) = splice(@coords, 0, 2); $self->build($x, $y); } $self->{bumps}++; } sub bump_and_run { # bump until completion my $self = shift; my $last = -1; while ($self->free_parcels != 0 && $self->free_parcels != $last) { $last = $self->free_parcels; $self->bump; } } # This routine could use lots of optimization sub needs_building { # has two neighbors that are built my $self = shift; my ($x, $y) = @_; my $current = $self->grid($x, $y); return 0 if ($current eq $PARK || $current eq $BUILDING); my @coords = ($x , $y + 1, $x - 1, $y + 1, $x + 1, $y + 1, $x + 1, $y, $x - 1, $y, $x , $y - 1, $x - 1, $y - 1, $x + 1, $y - 1, ); my $neighbor_cnt = 0; while (@coords) { my ($i, $j) = splice(@coords, 0, 2); $neighbor_cnt += ($self->grid($i, $j) eq $BUILDING && 1); } return ($neighbor_cnt >= 2 && 1); } sub spoiler1 { # solution to the first (simple) puzzle my $p = shift; $p->park(11, 6); $p->park(10, 5); $p->park(9, 4); $p->park(9, 3); $p->park(9, 2); } 1;