#!/usr/bin/perl
use strict;

my $pegs  = shift;
my $disks = shift;

my @pegs = (0, 'A' .. 'Z')[1 .. $pegs];
my %pegs = map { $_ => [] } @pegs;
$pegs{A} = [ 1 .. $disks ];

move($disks, @pegs);

sub move {
    my ($num, $from, $to, @rest) = @_;

    return unless $num;

    if ($num == 1) {
        my $d = shift @{ $pegs{$from} };
        print "$d: $from -> $to\n";
        unshift @{ $pegs{$to} }, $d;
        return;
    }

    $num--;

    for my $i (0 .. $#rest) {
        move( int(($num + $#rest - $i)/@rest),
              $from => $rest[$i],
              @rest[ grep { $_ > $i } 0 .. $#rest ], $to);
    }

    my $d = shift @{ $pegs{$from} };
    print "$d: $from -> $to\n";
    unshift @{ $pegs{$to} }, $d;

    for my $i (reverse 0 .. $#rest) {
        move( int(($num + $#rest - $i)/@rest),
              $rest[$i] => $to,
              @rest[ grep { $_ > $i } 0 .. $#rest ], $from);
    }

}

##</code><code>##

10 disks with 3 pegs: Solved in 1023 moves
10 disks with 4 pegs: Solved in 57 moves
10 disks with 5 pegs: Solved in 35 moves
10 disks with 6 pegs: Solved in 29 moves
10 disks with 7 pegs: Solved in 27 moves
10 disks with 8 pegs: Solved in 25 moves
10 disks with 9 pegs: Solved in 23 moves
10 disks with 10 pegs: Solved in 21 moves
10 disks with 11 pegs: Solved in 19 moves