あみだくじ

今回は、誰でも知っている「あみだくじ」を生成するプログラムを取り上げます。まずは、下の図のパズルを考えてみてください。上部の始点と下部の終点は書かれいますが、横線がまったく書かれていません。横線を書き入れて同じ文字同士を結び付けてください、というのが問題です。紙に書いてやってみるとわかりますが、解けるまでにはかなりの時間がかかると思います。１文字だけを結ぶのは簡単なのですが、すべての文字が結び付くような横線の組み合わせを見つけるのは容易ではありません。

このパズルを解く面白い方法があるのですが、それは後ほど紹介することにして、まずは総当たりのプログラムを取り上げます。総当たりのプログラムでは、隣り合う文字の交換という手法が使えます。すべての隣り合う文字の交換を積み上げて、最少の手数 (横線の本数) の正解を１つ見つけるというプログラムです。

総当たりプログラム

use strict;
my $n = 6;    # くじの本数
my $start = join '', ('A' .. 'J')[0 .. $n - 1];
my $goal = shuffle($start);    # 下部のアルファベットの並びを生成
my @amida = ($start);
my %hist = ($start => 0);      # 生成済み文字列のチェックと正解手順作成用

while (@amida) {
  my $str =  shift @amida;
  foreach my $i (0 .. $n - 2) {
    my $work = $str;
    my $char = substr $work, $i, 1, '';
    substr $work, $i + 1, 0, $char;
    next if exists $hist{$work};
    if ($work eq $goal) {
      disp($str, $i);
    } else {
      $hist{$work} = "$str:$i";
      push @amida, $work;
    }
  }
}

sub disp {    # 正解表示用のサブルーチン
  my ($key, @result) = @_;
  while ($key ne $start) {
    unshift @result, (split /:/, $hist{$key})[1];
    $key = (split /:/, $hist{$key})[0];
  }
  print join(' ', split //, $start), "\n";
  while (@result) {
    my $line= join '', ("| ") x ($n - 1), "|\n";
    my @disp_idx = (0);
    foreach my $i (1 .. $#result) {
      push @disp_idx, $i unless grep { abs($result[$i] - $result[$_]) < 2 } 0 .. $i - 1;
    }
    substr($line, $result[$_] * 2 + 1, 1, '-') foreach @disp_idx;
    print $line;
    splice @result, $_, 1 foreach reverse @disp_idx;
  }
  print join(' ', split //, $goal), "\n"; exit;
}

sub shuffle {    # ゴールのアルファベットの並びを生成
  my @list = split //, $_[0];
  foreach my $i (reverse(0 .. $#list)) {
    my $j = int rand $i + 1;
    my $separate = join '', sort @list[$j, $i + 1 .. $#list];
    redo if $i and $start =~ /^$separate/;
    push @list, splice(@list, $j, 1);
  }
  return join('', @list);
}

プログラムの解説は、くじの本数が６本の場合を例に進めいていきます。プログラムではまず $n にくじの本数を設定して、下部のゴールのアルファベットを shuffle サブルーチンを呼び出すことでランダムに生成します。ここで注意を要する点は、ゴールのアルファベットがグループ化して分離してしまうことがあることです。下の図が分離した１例で、左から３本目と４本目の縦線の間に横線が必要ありません。こうなるとくじ６本のあみだくじとは言えず、単に３本のあみだくじを２つ並べただけになってしまいます。

アルファベットの分離をチェックするには、左から１文字置く毎に並び順は別にして A から連続したアルファベットになっていないことを確認します。上の例では３文字置いた段階で A, B, C が使われているのでダメということになり、もう１度３文字目を選び直すことになります。このチェックは、最後の文字を除いて行っていきます。

ゴールの文字列が決定したら、初期の文字列 "ABCDEF" からゴールの文字列になるまで、総当たりで隣接する文字の交換を行います。今回の総当たりのプログラムでは、幅優先探索 (または横優先探索) と呼ばれる手法を使っています。初期文字列 "ABCDEF" には、５個所で文字の交換ができる位置があります。それぞれの位置で文字を交換したら、交換した文字列間に横線を引きます。

隣接する文字列の交換は、while ループと２つの変数 (配列 @amida とハッシュ %hist) を使って進めていきます。配列 @amida には、最初は初期文字列のみ入れておきます。while ループでは @amida から先頭の要素を取り出し、文字列の交換したものを末尾に追加していきます。@amida には手数順に順番に入れられるので、正解が見つかったときにそれが最短手数であることが保証されます。

%hist は、生成した文字列を記録するハッシュです。キーに生成した文字列、値は生成元の文字列と交換位置 (横線の位置) をコロンで結んだものを記録します。%hist に登録するのは最短手数で生成されたものだけで、チェックしてすでに存在する場合は登録をスキップします。

隣接する文字の交換を繰り返していくと、やがていずれはゴールの文字列に到達します。ゴールに到達したら、%hist から正解手順の横線のリストを取得します。仮にゴールの文字列が "DEAFBC" だとすると、@result は (2, 1, 0, 3, 2, 1, 4, 3) となり、このリストを１行に１つずつ横線を書くと、以下のような図になります。

スタートのアルファベットとゴールのアルファベットが結び付けられていて、正解であることに間違いはありません。しかし、上の図には、改良の余地があります。D と E の間の１本目の横線は、２行目に移動することができます。また、D と E の間の１本目の横線を上に移動すると、その下にある横線やまわりの横線も上に移動することができます。同じ行に複数の横線を書くには、先頭の要素と一緒に書ける要素を２番目以降の要素から探すことになります。結論から書くと、それぞれの要素の前に自分自身と同じ数字や両隣の数字がないものが一緒に書ける横線になります。以下に示しているように、太字で示しているものが同じ行に書ける横線です。横線を書いたら太字の要素を @result から削除して、同じことを @result の要素がなくなるまで繰り返します。

総当たりのプログラムは、横線の本数が多くなると時間がかかり実行できなくなります。くじの本数が９本くらいまではそれほど時間がかかるものはありませんが、10 本では横線の数が 20 本を超えるものも多くなり、20 本で 22 秒、28 本で 58 秒とそれなりの時間がかかるようになります。

別の解法プログラム

ここから、冒頭で約束した別の解き方を紹介しましょう。この節のプログラムでは、くじの本数が 20 本や 30 本であっても楽に正解を求めることができます。まず、下図の例のように、始点の各文字を数値化します。各数値は各文字の位置関係を表したもので、終点の位置から始点の位置を引いて求めます。A を例にすると、 index($goal, 'A') - index($start, 'A') で求めることができる数値です。別の言い方をすると、他の各文字に関係なく必要とされる横線の最小限の数です。

各文字を数値化したら、その数値を見ながら隣接する文字を交換して横線を引いていきます。文字の交換には、次のような規則を設けて適用します。

上の規則は私が考えたものですが、うまくいくのか紙に書いて試したのが下の例で、文字を交換しながら横線を引いている様子です。処理の流れは、矢印が示しているように下から上になります。末尾に、交換可能個所を表示しています。交換可能個所が複数ある場合は、太字で示してある文字が含まれる文字間の交換が優先されます。該当の個所に横線を引いたら、赤字で示しているように文字を交換して数値を更新します。なお、横線を引く順番は、それぞれの横線の中央に書いています。すべての横線を引き終わると、各文字は終点の位置に移動し、数値はすべて 0 になります。

たった１つのケースですが、うまくいったのでコード化してみることにしました。プログラムでは while ループを利用して、数値がすべて 0 になるまで隣接する文字の交換を行います。なお、ゴールの文字列を生成する部分や結果を表示するところは前節のプログラムと同じですので、異なっている部分のみ説明することにします。

 1:  use strict;
 2:  my $n = 6;    # くじの本数: max 52
 3:  my $start = join '', ('A' .. 'Z', 'a' .. 'z')[0 .. $n - 1];
 4:  my $goal = shuffle($start);
 5:  my @diff = map { [index($goal, $_) - index($start, $_), index($start, $_)] } split //, $start;
 6:  @diff = sort { abs($b->[0]) <=> abs($a->[0]) } @diff;
 7:  my @result;
 8:
 9:  while ($diff[0]->[0] != 0) {
10:    my $ref = shift @diff;
11:    my ($pair) = $ref->[0] > 0 ? grep { $_->[1] == $ref->[1] + 1 } @diff
12:                               : grep { $_->[1] == $ref->[1] - 1 } @diff;
13:    if (($ref->[0] > 0 and $pair->[0] > 0) or ($ref->[0] < 0 and $pair->[0] < 0)) {
14:      push @diff, $ref;
15:      next;
16:    }
17:    push @result, ($ref->[0] > 0 ? $ref->[1] : $ref->[1] - 1);
18:    if ($ref->[0] > 0) {
19:      --$ref->[0]; ++$ref->[1];
20:      ++$pair->[0]; --$pair->[1];
21:    } else {
22:      ++$ref->[0]; --$ref->[1];
23:      --$pair->[0]; ++$pair->[1];
24:    }
25:    @diff = sort { abs($b->[0]) <=> abs($a->[0]) } @diff, $ref;
26:  }
27:
28:  print "(", join(', ', @result), ")\n";
29:  print join(' ', split //, $start), "\n";
30:  while (@result) {
31:    my $str= join '', ("| ") x ($n - 1), "|\n";
32:    my @disp_idx = (0);
33:    foreach my $i (1 .. $#result) {
34:      push @disp_idx, $i unless grep { abs($result[$i] - $result[$_]) < 2 } 0 .. $i - 1;
35:    }
36:    substr($str, $result[$_] * 2 + 1, 1, '-') foreach @disp_idx;
37:    print $str;
38:    splice @result, $_, 1 foreach reverse @disp_idx;
39:  }
40:  print join(' ', split //, $goal), "\n";
41:
42:  sub shuffle {
43:    my @list = split //, $_[0];
44:    foreach my $i (reverse(0 .. $#list)) {
45:      my $j = int rand $i + 1;
46:      my $separate = join '', sort @list[$j, $i + 1 .. $#list];
47:      redo if $i and $start =~ /^$separate/;
48:      push @list, splice(@list, $j, 1);
49:    }
50:    return join('', @list);
51:  }

Line 5: 各文字を数値化して配列に収める

$start と $goal の文字列から、各文字ごとに数値化します。文字別に無名配列を用意し、$goal の位置から $start の位置を引いた値と、$start での文字の位置を格納しておきます。ゴールの文字列が "FBDEAC" の場合に、最初に生成される @diff 配列は次のようになります。

@diff = ([4, 0], [0, 1], [3, 2], [-1, 3], [-1, 4], [-5, 5]);

Line 6, 25: @diff を数値順に並び替える

生成直後の @diff 配列は A, B, C, ... の文字順に並んでいますが、ここで数値 (絶対値) 順に並べ替えるので、以降は無名配列の中の数値を操作することになります。その際に重要な役割を果たすのが、無名配列の中の２番目の数値です。

ソート後: @diff = ([-5, 5], [4, 0], [3, 2], [-1, 3], [-1, 4], [0, 1]);

0   1   2   3   4   5
|---|   |---|   |---|
| 0 |   | 2 |   | 4 |
|   |---|   |---|   |
|   | 1 |   | 3 |   |

縦線と横線の位置には、上図のように番号が付けられています。無名配列の２番目の数字は、無名配列の現在の位置を表します。while ループの中で、横線を引く相手を見つける際や横線を引く際に利用します。

Line 9: 各無名配列の数値が 0 になるまで繰り返す

while ループの目的は、すべての無名配列の第１要素の数値を 0 にすることです。while の条件部では、@diff 配列の最初の無名配列の数値が 0 であるか否かをチェックします。Line 7 と Line 25 で数値順にソートしているので、最初の無名配列の数値をチェックするだけですべての無名配列の数値が 0 になっていることを確認することができます。

Line 10 ～ 16: 横線の引ける縦線のペアを選び出す

@diff 配列の先頭の数値の一番大きな無名配列を取り出して $ref にセットします。$ref の第１要素が正の場合は右隣の無名配列を、負の場合は左隣の無名配列を $pair にセットします。なお、$ref と $pair が同じ符号 (正と正、負と負) のときには、横線を引くことができないのでこの手続きをやり直します。

Line 17 ～ 24: 隣接する $ref と $pair を交換する

$ref と $pair を交換したら、まず横線の位置を @result に格納しておきます。$ref の第１引数が正の場合は第２引数、負の場合は第２引数から１を引いた値が横線の位置となります。次に、交換した $ref と $pair のそれぞれの配列の要素を更新します。右に移動した配列は、第１要素から１をマイナスして第２要素に１プラスします。左に移動した配列は、逆の操作をします。

プログラムでのくじの本数は、アルファベットの大文字と小文字を合わせた 52 本を最大値としています。最大値の 52 本でプログラムを実行しても、ほとんど待たずに結果を表示します。横線の数が最小値になっているかという疑問に対しては、くじの本数が多いものついては証明できないのですが、くじの本数が 9 本以下では前節のプログラムで検証してみると横線の数は最小値になっています。下図は、くじの本数を 20 本としたときの出力の一例です。横線の数は 76 になっています。