Slash Boxes
NOTE: use Perl; is on undef hiatus. You can read content, but you can't post it. More info will be forthcoming forthcomingly.

All the Perl that's Practical to Extract and Report

use Perl Log In

Log In

[ Create a new account ]

petdance (2468)

AOL IM: petdance (Add Buddy, Send Message)
Yahoo! ID: petdance (Add User, Send Message)

I'm Andy Lester, and I like to test stuff. I also write for the Perl Journal, and do tech edits on books. Sometimes I write code, too.

Journal of petdance (2468)

Tuesday April 29, 2003
10:18 AM

Brute force Hanoi, with inline testing

[ #11905 ]
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) ];

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 );
        print "Move $nmoves: $top from $from to $to\n";

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

The Fine Print: The following comments are owned by whoever posted them. We are not responsible for them in any way.
More | Login | Reply
Loading... please wait.
  • The validation routine should probably keep a hash containing the elements it has seen, and ensure that when a ring is moved from one spike to another that a copy of the ring doesn't get left behind.

    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 b