ナイトの交換

今回は、"ナイトの交換" を取り上げます。以前に取り上げた "ナイトの巡歴" では１つのナイトを使いましたが、今回のパズルでは３x４の盤面に６つのナイト (黒３つ、白３つ) を使います。下図の初期盤面 (Start) に配置された黒のナイトと白のナイトを１つずつ動かしながら、その位置を入れ替えて Goal に至る経路を探索するのが今回の問題です。

ナイトの巡歴では、３x４盤面は短時間で探索することができました。今回のナイトの交換は盤面こそ同じで小さいですが、ナイトの数が６個と増えているために、ナイトの巡歴のプログラムを拡張しただけではデータ量が膨大になり行き詰まってしまいます。そこで今回は、先にナイト毎の個別の経路のリストを作成しておき、その組合せによるプログラムとしました。

プログラム

use strict;
my (%route, @mirror);

{ my %move = ('0' => [5, 7], '1' => [6, 8], '2' => [3, 7],
              '3' => [2, 8, 10], '4' => [9, 11], '5' => [0, 6, 10],
              '6' => [1, 5, 11], '7' => [0, 2], '8' => [1, 3, 9],
              '9' => [4, 8], '10' => [3, 5], '11' => [4, 6]);
  my @work = (0, 1, 2); my $limit = 4;
  while (@work) {
    my $work = shift(@work);
    my ($cp) = $work =~ /\b(\d+)$/;
    foreach my $i (@{$move{$cp}}) {
      next if $work =~ /\b$i\b/;
      my $tmp = $work . ':' . $i;
      if ($i == 9 or $i == 10 or $i == 11) {
        my ($key) = $tmp =~ /^(\d+)/;
        push @{$route{$key}}, $tmp;
        $key = 11 - $1;
        push @{$route{$key}}, join(':', map { 11 - $_ } split(/:/, $tmp));
      }
      push @work, $tmp if $tmp =~ tr/:// < $limit;
    }
  }
}

my @order = (0, 1, 2, 9, 10, 11); my @alph = qw(A B C X Y Z);
my @before; my $start = "ABC------XYZ"; my $goal;
comb(0);

sub comb {
  my $no = shift;
  my @list = @_;
  foreach my $item (@{$route{$order[$no]}}) {
    next if join('_', @list, $item) =~ /:(\d+)_.*:\1$/;
    if (@list) {
      my ($flag, $chk);
      foreach my $tmp (@list) {
        if ($tmp =~ tr/:// >= $item =~ tr/://) {
          $chk = join '', map { '(?=.*\b' . $_ . '\b)' } split /:/, $item;
          $flag = $tmp =~ /^$chk/;
          last if $flag;
        } else {
          $chk = join '', map { '(?=.*\b' . $_ . '\b)' } split /:/, $tmp;
          $flag = $item =~ /^$chk/;
          last if $flag;
        }
      }
      next if $flag;
    }
    my @work = @list; push @work, $item;
    if ($no == 5) {
      my $chk = join ' ',
                sort { $a <=> $b }
                map { join ':',
                      map { $_ % 3 == 0 ? $_ + 2 : $_ % 3 == 2 ? $_ -2 : $_ }
                      split /:/ } @work;
      next if grep /$chk/, @mirror;
      push @mirror, join(' ', @work);
      my $n = 0; my @temp;
      foreach (@work) {
        /(\d+)$/;
        push @temp, $1 . $alph[$n];
        $n++;
      }
      @temp = sort { $a <=> $b } @temp;
      s/\d//g foreach @temp;
      $goal = join '', @temp[0, 1, 2], '------', @temp[3, 4, 5];
      s/^(\d+):/!$1!/ foreach (@work);
      @before = ($start);
      search([$start], @work);
    } else {
      comb($no + 1, @work);
    }
  }
}

sub search {
  my $ref = shift;
  my $board = $ref->[0];
  my @routes = @_;
  foreach (@routes) {
    my ($i, $j) = /!(\d+)!(\d+)\b/;
    if (substr($board, $j, 1) eq '-') {
      my @tmp = split //, $board; @tmp[$i, $j] = @tmp[$j, $i];
      my $temp = join '', @tmp;
      next if grep /^$temp$/, @before;
      push @before, $temp;
      if ($temp =~ /$goal/) {
        disp([$temp, $ref]);
        return;
      } else {
        my $route = $_;
        my @work = grep { $_ !~ /^$route$/ } @routes;
        if ($route =~ /^!/) { $route =~ s/!(\d+)!(\d+):?/$1!$2!/; }
        else { $route =~ s/!(\d+)!(\d+):?/:$1!$2!/; }
        push @work, $route unless $route =~ /!$/;
        search([$temp, $ref], @work);
      }
    } elsif (/:\d+!\d+!/ and check($board, @routes)) {
      ($j, $i) = /:(\d+)!(\d+)!/;
      next unless substr($board, $j, 1) eq '-';
      my @tmp = split //, $board; @tmp[$i, $j] = @tmp[$j, $i];
      my $temp = join '', @tmp;
      next if grep /^$temp$/, @before;
      push @before, $temp;
      my $route = $_;
      my @work = grep { $_ !~ /^$route$/ } @routes;
      $route =~ s/:(\d+)!(\d+)!/!$1!$2:/;
      push @work, $route;
      search([$temp, $ref], @work);
    }
  }
}

sub check {
  my $board = shift;
  foreach (@_) {
    /!\d+!(\d+)\b/;
    if (substr($board, $1, 1) eq '-') {
      return 0;
    }
  }
  return 1;
}

sub disp {
  print "$mirror[-1]\n\n";
  my $tmp_ref = shift;
  my @work;
  while ($tmp_ref) {
    my $board;
    ($board, $tmp_ref) = @$tmp_ref;
    unshift @work, $board;
  }
  my ($count, $line1, $line2, $line3, $line4);
  foreach (@work) {
    /(...)(...)(...)(...)/;
    $count++;
    if ($count % 7 != 0 and $count < @work) {
      $line1 .= $1; $line1 .= '      '; $line2 .= $2; $line2 .= '  =>  ';
      $line3 .= $3; $line3 .= '      '; $line4 .= $4; $line4 .= '      ';
    } elsif ($count % 7 == 0 and $count < @work) {
      $line1 .= $1; $line2 .= $2; $line2 .= '  =>  '; $line3 .= $3; $line4 .= $4;
      print "$line1\n$line2\n$line3\n$line4\n\n";
      $line1 = $line2 = $line3 = $line4 = '';
    } else {
      $line1 .= $1; $line2 .= $2; $line3 .= $3; $line4 .= $4;
      print "$line1\n$line2\n$line3\n$line4\n\n";
    }
  }
  print "\n";
}

プログラムの解説

探索に成功した場合を考えると、６つのナイトはそれぞれに個別のルートを持っています。その個別のルートは、他のナイトがない状態で探索したものの中に含まれているはずです。先にすべてのナイトについて個別のルートを求めておき、それを組み合わせて探索すれば正解を得られることになります。この考え方で作成したのが、今回のプログラムです。

今回のプログラムでは、盤面のマス目には 0 から 12 の番号を付けます。また、冒頭の図では、黒のナイトの名前を B、白のナイトの名前を W と同じ名前で扱っていますが、これからは別々の名前で扱うことにします。黒のナイトの名前を A, B, C、白のナイトの名前を X, Y, Z とします。下の図は、盤面の番号及び初期盤面です。

個別ルートの生成

個別のルートは、簡単に求めることができます。始点は１つで、終点は３つの内のいずれかになります。ルートの途中で、同じマス目を２度通ることはできません。次のコードが、個別ルートを生成するコードです。

個別のルートは、ハッシュ %route に格納しておきます。キーは、ルートの始点となる盤面の番号になります。値は、ルートを格納した配列のリファレンスです。生成するルートの長さ (手数) は、$limit で指定します。$limit に 4 を指定すると、4 手以下で終点に至るすべてのルートを生成します。今回のコードでは、A, B, C のルートのみを生成して、そのルートを変換して X, Y, Z のルートを生成しています (なお、A のみのルートを生成して変換すれば、C, X, Z のルートを生成することもできます)。以下は、A と B のすべてのルートです。

個別ルートの組合せの生成

個別ルートを生成したら、次には６つのルートの組合せを comb サブルーチン生成でします。comb サブルーチンの構造は、枝刈り等のコードがありますので複雑に見えますが、実際は至ってシンプルです。

上のコードを実行すると、$limit が 4 の場合には、2916 (3 x 6 x 3 x 3 x 6 x3) の組合せが生成されます。組合せの過程では、次の枝刈りを使って、ダメなものを排除します。

重複解には鏡像解というものがある場合もありますが、今回のパズルでは鏡像ルートというべきものがあります。次の例を、見て下さい。

１行目のルートを鏡に写すと、その下の行のように見えるはずです。厳密には重複解と言えるかどうかは分かりませんが、一応除外することにしました。鏡像ルートを生成するコードは、次の通りです。

鏡像ルートは、左の列 (0, 3, 6, 9) に 2 をプラスし、中央の列 (1, 4, 7, 10) はそのままにし、右の列 (2, 5, 8, 11) に 2 をマイナスすると得られます。$chk を生成するコードは、続けて書いてしまうと分かりづらいため、シュウォーツ変換風に書いてみました。@work の内容が上の３行目のときには、$chk は１行目と同じになります。１行目はすでに @mirror に格納されているので、スキップされます。

以上のチェックを通過したら、search を呼び出すための準備をします。準備としては、ゴール配置盤面の生成、現在地点の設定、配列 @before の初期化があります。まずゴール配置盤面ですが、配列 @work から次のコードで生成します。

配列 @work が (0:5:10, 1:6:11, 2:3:8:9, 9:8:1, 10:3:2, 11:6:5:0) のときに、先頭から A, B, C, X, Y, Z の経路になります。また、その末尾の数字は終点です。末尾の数字と名前を繋げて数値でソートすると、(0Z, 1X, 2Y, 9C, 10A, 11B) となります。これで、数字を削除すればゴール配置盤面を作成することができます。

ここまでは各ナイトのルートは、0:5:10 のようにになっていますが、ここで現在地点を設定します。現在地点は、最初は初期配置盤面ですので、始点になります。現在地点は、! (感嘆符) で数字を囲みます。現在地点の設定をした後の @work は、(!0!5:10, !1!6:11, !2!3:8:9, !9!8:1, !10!:3:2, !11!6:5:0) のようになります。配列 @before は、search サブルーチンを呼び出す毎に初期化します。

これでいよいよ search サブルーチンを呼び出して、探索することになります。search サブルーチンに渡す引数は、初期配置盤面と各ナイトのルートを格納した配列 @work になります。

経路の探索

search サブルーチンでは再帰呼び出しを使って、各ナイトをルートの始点から終点に向けて１つずつ動かしていきます。この探索では、盤面の配置と各ナイトの現在地点の２つのデータを管理します。２つのデータの変化の様子は、次のようになります。

上のように１つのナイトのルートを１つ進めたら、盤面の配置を更新するとともに、ナイトの現在地点も更新します。このようにして、ナイトの動きのすべての組合せを調べてゴールを探索するのですが、残念ながらそれだけでは正解を得られない場合があります (もちろん、正解を得られる場合もあります)。ここで、最短手数の正解を示します。

６つのナイトのルートの手数の合計は 14 ですが、正解の手数は 16 になっています。このことは、各ナイトのルートを１手ずつ始点から終点まで進めても正解を得られない場合があることを示しています。最初の正解例では C の動きが 2 -> 3 -> 8 -> 3 -> 8 -> 9 なっていて、次の正解例では Z の動きが 11 -> 6 -> 5 -> 6 -> 5 -> 0 になっています。この "一時退避" の現象は、パズルとしては面白い動きですが、プログラムを作る上では非常に厄介な問題です。そこで、以下のルールでプログラムに組み込んでみました。

次は、同一配置のチェックについて述べます。このパズルでは、手順前後による同一配置の盤面がたくさん発生します。この同一配置をチェックするために探索の過程で生じた配置は、すべて配列 @before に保存しておき、以前に探索済みのときはそこで打ち切るようにしています。

上の２つの例は、ナイトを動かす順番が違うだけで同じ盤面になったものです。1) では２つ、2) では６つの手順前後による同一配置が発生します。同一配置は、最初に現れたときだけ探索して、２番目以降はそこで探索を打ち切ります。

今回のパズルでは、スタートからゴールまでのすべての盤面配置を記憶しておく必要があります。盤面配置データの管理方法は、以前取り上げた "ナイトの巡歴" と同じですので参照下さい。探索に成功して正解が得られたら、disp サブルーチンを呼び出して表示します。disp サブルーチンは、易しいので解説は省略します。以下は $limit を 4 にしたときの、プログラムの実行結果です。なお、$limit を 3 にしたときには、最初の１つだけ表示されます。

最後に、長い手数 (最長?) の正解です。それぞれのナイトの手数が７手かかり、一度一時退避がありますので 44 手かかっています。