Last night in my business class, we had the class divvy up into two teams (creative vs. analytical) and solve the Tower Of Hanoi puzzle, using plastic stacking rings for babies. I recused myself from the team, since I knew the trick, although I did try to give hints here and there.
I had about half an hour between the first class and the second, so I cranked out a quick & dirty solver. The very first thing I did, before I implemented any code, was to write verify_spikes() to make sure that I hadn't made any illegal moves. This was a big help with my debugging, as I had a bug that always tried to use the same spike as the empty spike. verify_spikes() caught it for me.
use strict;
use Data::Dumper;
my %spike;
my $ndiscs = shift || 3;
my $nmoves = 0;
$spike{a} = [];
$spike{b} = [];
$spike{c} = [ reverse (1..$ndiscs) ];
#draw_spikes();
verify_spikes();
move( $ndiscs, "c" => "a" );
sub move {
my $height = shift;
my $from = shift;
my $to = shift;
if ( $height > 1 ) {
my $open = open_spike( $from, $to );
#print "Prep: $height from $from to $to via $open\n";
move( $height-1, $from => $open );
move( 1, $from => $to );
move( $height-1, $open => $to );
} else {
my $top = pop @{$spike{$from}};
push( @{$spike{$to}}, $top );
++$nmoves;
print "Move $nmoves: $top from $from to $to\n";
#draw_spikes();
verify_spikes();
}
}
sub draw_spikes {
for my $spike ( 'a'..'c' ) {
my @discs = @{$spike{$spike}};
print "$spike: @discs\n";
}
print "\n";
}
sub open_spike {
my $from = shift or die;
my $to = shift or die;
my %maybe;
@maybe{'a'..'c'} = (1,1,1);
delete $maybe{$from} or die;
delete $maybe{$to} or die;
my @left = keys %maybe;
die "bad left: @left\n" if @left != 1;
return $left[0];
}
sub verify_spikes {
for my $spike ( 'a'..'c' ) {
my $prev = 999;
for my $disc ( @{$spike{$spike}} ) {
if ( $disc > $prev ) {
die "Spike $spike has $disc under $prev\n";
}
$prev = $disc;
} # for discs
} # for spikes
}
I'd tend to use an extra argument specifying the "spare" spike, and a separate function move_top to move a single ring that is on the top of its spike.
This is written into the message, and not tested (sorry about the indenting, even with CODE wrapping it gets thrown away, I've at least forced back the line breaks):
sub move {
my( $c, $from, $to, $spare ) = @_;
if( $c == 1 ) {
move_one( $from, $to );
} else {
move( $c-1, $from, $spare, $to );
move_one( $from, $to );
}
}
sub move_one {
my( $from, $to ) = @_;
my $ring = pop( $spike{$from} )
or die "trying to move from empty ring";
die "trying to move onto a smaller ring"
if $spike{$to}[-1] < $ring;
push $spike{$to}, $ring;
}
