use Perl

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.

#!/usr/bin/perl -w

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
}