ペントミノパズルは、6 x 10 の箱の中に 12 種類のピースを詰め込むパズルです。 各ピースは正方形を５つ繋げた形をしており、裏返したり回転 (90, 180, 270 度) して使うことができます。裏返しても回転しても同じ形状になることもあるので、ピースによって形状数が異なります。 下記の A は横と縦の２形状、B は裏返しても回転しても同じなので１形状、C, E, G, I, K が４形状、D, F, H, J, L が８形状になります。すべての形状は、「ペントミノパズル」で見ることができます。 (ペントミノのピースにはアルファベット名が付けられることがありますが、それとは関係ありません。 単に、プログラムで１文字で扱うのが便利なためです。)
|
ペントミノパズルの解を求めるプログラムは、事前には少し手を出しがたいものがありました。 盤の大きさが 6 x 10 もあり、ピースの数も 12 と多く、それぞれのピースに多くの形状があるからです。 どの程度時間がかかるのか見通すのが難しく、最悪の場合膨大な時間がかかり実行できない可能性があります。 そこで、様子を見るためのプログラムを作ってみました。
use strict; my @cell = '00' .. '59'; # マス目番号 my %board = map { $_ => 0 } @cell; # 盤面の初期化 # 各ピースの形状データ my @piece = (['01:02:03:04', '10:20:30:40'], ['1-1:10:11:20'], ['01:02:10:20', '01:02:12:22', '10:20:21:22', '10:2-2:2-1:20'], ['01:02:10:11', '01:02:11:12', '01:10:11:12', '01:10:11:20', '01:10:11:21', '10:11:20:21', '01:1-1:10:11', '1-1:10:2-1:20'], ['01:11:12:22', '10:11:21:22', '01:1-1:10:2-1', '1-1:10:2-2:2-1'], ['01:11:12:21', '10:11:12:21', '01:1-1:10:20', '1-1:10:11:2-1', '1-1:10:11:21', '1-1:10:20:21', '10:11:2-1:20', '1-2:1-1:10:2-1'], ['01:11:21:22', '10:11:12:22', '01:10:2-1:20', '1-2:1-1:10:2-2'], ['01:02:03:10', '01:02:03:13', '01:10:20:30', '01:11:21:31', '10:11:12:13', '10:20:30:31', '10:20:3-1:30', '1-3:1-2:1-1:10'], ['01:02:11:21', '10:11:12:20', '10:2-1:20:21', '1-2:1-1:10:20'], ['01:02:12:13', '01:11:12:13', '10:11:21:31', '10:20:21:31', '01:02:1-1:10', '1-1:10:2-1:3-1', '10:2-1:20:3-1', '01:1-2:1-1:10'], ['01:02:10:12', '01:10:20:21', '01:11:20:21', '02:10:11:12'], ['01:02:03:11', '01:02:03:12', '10:11:20:30', '10:20:21:30', '1-1:10:11:12', '1-1:10:20:30', '10:2-1:20:30', '1-2:1-1:10:11']); my @alpha = 'A' .. 'L'; # 各ピースにアルファベットの割り当て open OUT, ">pento_all.dat" or die "Can't open pento_all.dat: $!"; search (0 .. $#piece); sub search { my $pos = (grep { $board{$_} eq '0' } @cell)[0]; # 最も若いマス目番号 my ($i, $j) = split //, $pos; # 10 の位と１の位に分割 foreach my $k (@_) { ITEM: foreach my $l (0 .. $#{$piece[$k]}) { my @place = ($pos); foreach my $m (split /:/, $piece[$k]->[$l]) { my $o = $i + substr($m, 0, 1); next ITEM if $o > 6; # 横列盤面外 my $p = $j + substr($m, 1); next ITEM if $p < 0 or $p > 9; # 縦列盤面外 my $place = $o . $p; next ITEM if $board{$place} ne '0'; # 空きマス目ではない push @place, $place; } $board{$_} = $alpha[$k] foreach @place; if (@_ == 1) { print OUT join('', map { $board{$_} } @cell), "\n"; } else { search(grep { $k != $_ } @_); } $board{$_} = 0 foreach @place; } } } close OUT; print time() - $^T, "seconds\n";
プログラムの冒頭では、ピースを置くために 6 x 10 のサイズの盤面を用意します。 それぞれのマス目には、左上が '00' で右下が '59' の番号を付けます。本来は '11' から番号を付けたかったのですが、横のマス目が 10 個あるので '00' からとしています。 盤面を管理するハッシュ %board のキーがマス目番号になり、値は 0 で初期化しておきます。
盤面を用意したので、次はピースの配置方法を考えなければなりません。 まず盤面の空きマス目を１つ選択して、そこにはピースの最上最左 (１番上の列の１番左) の正方形を置くことにします。そして、残る４つのマス目の位置は、計算によって決定します。 下右図の２つのピースの例では、濃い緑のマス目がピースの最上最左の位置、 残る４つの薄い緑が計算によって得られた位置ということになります。
|
@piece 配列には、ピース毎に無名配列を用意し、無名配列の中にすべての形状データを格納しておきます。 形状データは最上最左のマス目を除く残る４つのマス目の計算用で、'01:02:03:04' (上右図の横棒ピース) や '1-1:10:11:2-1' (その下のピース) のような形をしています。'01:02:03:04' の '01' は、最上最左のマス目の位置の 10 の位に 0 を加え、１の位に１を加えます。'02:03:04' も同様の計算をすると、 ４つのマス目の配置位置を得ることができます。'1-1:10:11:2-1' の '1-1' の場合は、最上最左のマス目の位置の 10 の位に１を加え、１の位から１を引くことを意味します。最上最左は最上が優先するので、10 の位は加算のみですが、１の位は減算することもあります。
01:02:03:04 01(0, 1) 02(0+0, 1+1) 03(0+0, 1+2) 04(0+0, 1+3) 05(0+0, 1+4) 1-1:10:11:2-1 23(2, 3) 32(2+1, 3-1) 33(2+1, 3+0) 34(2+1, 3+1) 42(2+2, 3-1)
各ピースは最上最左の正方形の配置位置によって、盤面に収まらないことがあります。計算では横列 (10 の位) が 0 〜 5 の範囲に収まっていることを、縦列 (１の位) が 0 〜 9 の範囲に収まっていることをチェックします。横棒のピースの場合には、１の位が 6 以上のマス目に最上最左の正方形を割り当てると盤面に収まらないことになります。横棒の下のピースの場合は、横列が 0 〜 3 の範囲、縦列が 1 〜 8 の範囲に最上最左の正方形を割り当てる必要があります。
ピースの各正方形がすべて盤面に収まることを確認して、他のピースが置かれていなければ %board ハッシュを更新します。ハッシュの値は、各ピースに割り当てられている 'A' 〜 'L' のアルファベットです。上右図のときの %board ハッシュは、次のようになります (一部省略)。
%board = (00 => 0, 01 => 'A', 02 => 'A', 03 => 'A', 04 => 'A', 05 => 'A', 06 => 0 .....,
10 => 0, .....
20 => 0, 21 => 0, 22 => 'F', 23 => 0, .....
30 => 0, 31 => 'F', 32 => 'F', 33 => 'F', 34 => 0, .....
40 => 0, 41 => 'F', 42 => 0, .....
50 => 0, .....);
盤面への敷き詰めは、再帰サブルーチン search を使ってピースを１つずつ配置していきます。 ここで問題となるのが、どのような順番でマス目を埋めていくかです。 マス目を１つずつ埋めていく場合はマス目番号順に処理できますが、 ペントミノではピースを１つ置くと１度に５マスが埋まってしまいます。 そこで、その都度盤面の１番若いマス目番号を抽出して、そこにピースの最上最左の正方形を置くことにしました。
盤面にピースが置かれていなければ、'00' に最上最左の正方形を配置できるピースを置きます。 プラスのピースは置くことができませんし、他のピースも形状によって置くことができません。 上図の例のように最初に横棒のピースを置いた場合には、次は '05' のマス目が配置対象になります。 そこに、プラスのピースを置いたとすれば、次は '06' のマス目という具合に進めていくと、 盤面全体を埋めることができます。ここで、search サブルーチンのコードを見てみることにしましょう。
sub search {
my $pos = (grep { $board{$_} eq '0' } @cell)[0]; # 最も若い空きマス目番号
my ($i, $j) = split //, $pos; # 10 の位と１の位に分割
foreach my $k (@_) { # 各ピース
ITEM: foreach my $l (0 .. $#{$piece[$k]}) { # 各形状
my @place = ($pos);
foreach my $m (split /:/, $piece[$k]->[$l]) {
my $o = $i + substr($m, 0, 1); next ITEM if $o > 6; # 横列盤面外
my $p = $j + substr($m, 1); next ITEM if $p < 0 or $p > 9; # 縦列盤面外
my $place = $o . $p; next ITEM if $board{$place} ne '0'; # 空きマス目ではない
push @place, $place;
}
$board{$_} = $alpha[$k] foreach @place; # 盤面にピースを置く
if (@_ == 1) { print OUT join('', map { $board{$_} } @cell), "\n"; } # 解をファイルへ
else { search(grep { $k != $_ } @_); } # 再帰呼び出し
$board{$_} = 0 foreach @place; # 盤面からピースを取り除く
}
}
}
search サブルーチンでは、ピースの選択に使う foreach ループが二重になっています。外側のループが各ピース、内側のループが各形状になっていますが、 配置できるのは各形状のうちの１つのみです。そこで、search サブルーチンの再帰呼び出しは内側のループからですが、 引数は外側の引数から現在選択しているピースを除外して渡します。 search サブルーチンでは、すべてのピース、すべての形状の組み合わせを試すことができます。 盤面の敷き詰めに成功したら、１行で１解の形式で pento_all.dat ファイルに書き出します。１行で書き出した解に 10 文字毎に改行を入れると、盤面に配置した状態を得ることができます。
AAAAABCCCHDDDLBBBECHDDFLLBEECHFFFLIEEGHHKFKLIJJGGGKKKIIIJJJG AAAAABCCCHDDDLBBBECHFDDLLBEECHFFFLIEEGHHKFKLIJJGGGKKKIIIJJJG AAAAABCCCHKKKLBBBECHKFKLLBEECHFFFLIEEGHHFDDLIJJGGGDDDIIIJJJG ..... AAAAABCCCH AAAAABCCCH AAAAABCCCH DDDLBBBECH DDDLBBBECH KKKLBBBECH DDFLLBEECH FDDLLBEECH KFKLLBEECH FFFLIEEGHH FFFLIEEGHH FFFLIEEGHH KFKLIJJGGG KFKLIJJGGG FDDLIJJGGG KKKIIIJJJG KKKIIIJJJG DDDIIIJJJG
プログラムの実行は、pento_all.dat への書き出し状況を見ながら進めました。 私の遅いパソコンで実行時間は、54,097 秒 (15h1m37s) かかってしまいました。pento_all.dat に書き出された解の総数は 9,356 で、この数字には意味があります。ペントミノ解の数は 2,339 であることが知られており、この数字のちょうど４倍になっています。盤の大きさ (6 x 10) から、左右対称、上下対称、180 度回転の重複解が含まれていることがわかります。最初のプログラムに、 重複解除外のコード、効率化のためのコードを追加して、パズルの解法コードとしての一応の完成としました。
use strict;
my (@alpha, %piece, %uniq, %symmetry) = 'A' .. 'L';
my @cell = '00' .. '59';
my @mirror = ([map { substr($_,0,1) . (9 - substr($_,1)) } @cell],
[map { (5 - substr($_,0,1)) . substr($_,1) } @cell],
[map { (5 - substr($_,0,1)) . (9 - substr($_,1)) } @cell]);
my @piece = (['01:02:03:04', '10:20:30:40'], ['1-1:10:11:20'],
['01:02:10:20', '01:02:12:22', '10:20:21:22', '10:2-2:2-1:20'],
['01:02:10:11', '01:02:11:12', '01:10:11:12', '01:10:11:20',
'01:10:11:21', '10:11:20:21', '01:1-1:10:11', '1-1:10:2-1:20'],
['01:11:12:22', '10:11:21:22', '01:1-1:10:2-1', '1-1:10:2-2:2-1'],
['01:11:12:21', '10:11:12:21', '01:1-1:10:20', '1-1:10:11:2-1',
'1-1:10:11:21', '1-1:10:20:21', '10:11:2-1:20', '1-2:1-1:10:2-1'],
['01:11:21:22', '10:11:12:22', '01:10:2-1:20', '1-2:1-1:10:2-2'],
['01:02:03:10', '01:02:03:13', '01:10:20:30', '01:11:21:31',
'10:11:12:13', '10:20:30:31', '10:20:3-1:30', '1-3:1-2:1-1:10'],
['01:02:11:21', '10:11:12:20', '10:2-1:20:21', '1-2:1-1:10:20'],
['01:02:12:13', '01:11:12:13', '10:11:21:31', '10:20:21:31',
'01:02:1-1:10', '1-1:10:2-1:3-1', '10:2-1:20:3-1', '01:1-2:1-1:10'],
['01:02:10:12', '01:10:20:21', '01:11:20:21', '02:10:11:12'],
['01:02:03:11', '01:02:03:12', '10:11:20:30', '10:20:21:30',
'1-1:10:11:12', '1-1:10:20:30', '10:2-1:20:30', '1-2:1-1:10:11']);
foreach my $i (0 .. $#piece) {
foreach my $j ( 0 .. $#{$piece[$i]}) {
my @offset = map { [substr($_, 0, 1), substr($_, 1)] } split /:/, $piece[$i]->[$j];
CELL: foreach my $k (@cell) {
my ($m, $n) = split //, $k; my @place = ($k);
foreach my $ref (@offset) {
my $o = $m + $ref->[0]; next CELL if $o > 5;
my $p = $n + $ref->[1]; next CELL if $p < 0 or $p > 9;
push @place, ($o . $p);
}
$piece{$i}->{$j}->{$k} = [@place];
}
}
}
my %board = map { $_ => 0 } @cell;
open OUT ">pentomino.dat" or die "Can't open pentomino.dat: $!";
search (0 .. $#piece);
sub search {
my $pos = (grep { $board{$_} eq '0' } @cell)[0];
foreach my $i (@_) {
my @next_arg = grep { $i != $_ } @_;
next if @next_arg and $next_arg[$#next_arg] == $#next_arg;
ITEM: foreach my $j (0 .. $#{$piece[$i]}) {
next unless exists $piece{$i}->{$j}->{$pos};
foreach my $k (1 .. $#{$piece{$i}->{$j}->{$pos}}) {
next ITEM if $board{$piece{$i}->{$j}->{$pos}->[$k]};
}
$board{$_} = $alpha[$i] foreach @{$piece{$i}->{$j}->{$pos}};
if (@_ == 1) {
if (chk_patt()) {
my $pattern = join '', map { $board{$_} } @cell;
$uniq{$pattern} = 1;
print OUT "$pattern\n";
}
} else {
search(@next_arg) if and symmetry();
}
$board{$_} = 0 foreach @{$piece{$i}->{$j}->{$pos}};
}
}
}
close OUT;
print time() - $^T, "seconds\n";
sub symmetry {
return 1 if join('', @board{'00' .. '09'}) =~ /0/;
return 1 if join('', @board{'10' .. '19'}) =~ /^[A-L]+$/;
my (%tmp_board, $pattern);
@tmp_board{@cell} = @board{@{$mirror[0]}};
$pattern = join '', map { $tmp_board{$_} } @cell;
return 0 if exists $symmetry{$pattern};
$pattern = join '', map { $board{$_} } @cell;
$symmetry{$pattern} = 1;
return 1;
}
sub chk_patt {
my (%tmp_board, $pattern);
@tmp_board{@cell} = @board{@{$mirror[0]}};
$pattern = join '', map { $tmp_board{$_} } @cell;
return 0 if exists $uniq{$pattern};
@tmp_board{@cell} = @board{@{$mirror[1]}};
$pattern = join '', map { $tmp_board{$_} } @cell;
return 0 if exists $uniq{$pattern};
@tmp_board{@cell} = @board{@{$mirror[2]}};
$pattern = join '', map { $tmp_board{$_} } @cell;
return 0 if exists $uniq{$pattern};
return 1;
}前のプログラムでは、最上最左のマス目以外の４つの配置位置を search サブルーチンの中でその都度計算で算出していました。search サブルーチンの呼び出しは膨大な数になるので、 その都度計算するよりもあらかじめ計算しておけば、サブルーチンからは参照だけで済むので速度の改善が見込めます。 次のコードで、@piece 配列をもとに %piece ハッシュを構築します。
foreach my $i (0 .. $#piece) {
foreach my $j ( 0 .. $#{$piece[$i]}) {
my @offset = map { [substr($_, 0, 1), substr($_, 1)] } split /:/, $piece[$i]->[$j];
CELL: foreach my $k (@cell) {
my ($m, $n) = split //, $k; my @place = ($k);
foreach my $ref (@offset) {
my $o = $m + $ref->[0]; next CELL if $o > 5;
my $p = $n + $ref->[1]; next CELL if $p < 0 or $p > 9;
push @place, ($o . $p);
}
$piece{$i}->{$j}->{$k} = [@place];
}
}
}
%piece = (0 => { 0 => { 00 => ['00', '01', '02', '03', '04'], # A ピース(横棒)
01 => ['01', '02', '03', '04', '05'],
.....
54 => ['54', '55', '56', '57', '58'],
55 => ['55', '56', '57', '58', '59'] },
1 => { 00 => ['00', '10', '20', '30', '40'], # A ピース(縦棒)
01 => ['01', '11', '21', '31', '44'],
.....
18 => ['18', '28', '38', '48', '58'],
19 => ['19', '29', '39', '49', '59'] } },
1 => { 0 => { 01 => ['01', '10', '11', '12', '21'], # B ピース(プラス)
.....
%piece ハッシュは、３つのキーを繋いで末尾の無名配列に配置マス目を入れています。 最初のキーがピース、２番目のキーが形状、３番目のキーが盤上のマス目番号になります。 配置不可能なマス目番号は、最初から除外され登録されません。例えば、横棒ピースでは１の位が 6 〜 9 が、縦棒ピースでは 10 の位が 2 〜 5 が、プラスのピースでは１の位の 0, 9 と 10 の位の 4, 5 が除外されます。search サブルーチンでは、exists 関数でマス目キーの存在を確認し、 存在する場合は一度に配置マス目を取得できるようになります。前のプログラムにこのコードを追加するだけで、 54,097 秒 (15h1m37s) かかっていたものが 30,416 秒 (8h26m56s) に減少しました。
前のプログラムで生成された解の数は 9,356 で、ユニーク解、左右対称解、上下対称解、180 度回転解がそれぞれ 2,339 あることになります。何がユニーク解で何が重複解は明確な定義はありませんが、 最初に得られた解をユニーク解であるものとします。ユニーク解は %uniq ハッシュに保存して、後から得られた解をチェックします。盤面の敷き詰めに成功して解が得られたら、 重複解 (左右対称、上下対称、180 度回転) チェック用の一時的な盤面を生成します。 例を挙げてみましょう。
解 左右対称 上下対称 180度回転 AAAAABCCCH HCCCBAAAAA KKKIIIJJJG GJJJIIIKKK DDDLBBBECH HCEBBBLDDD KFKLIJJGGG GGGJJILKFK DDFLLBEECH HCEEBLLFDD FFFLIEEGHH HHGEEILFFF FFFLIEEGHH HHGEEILFFF DDFLLBEECH HCEEBLLFDD KFKLIJJGGG GGGJJILKFK DDDLBBBECH HCEBBBLDDD KKKIIIJJJG GJJJIIIKKK AAAAABCCCH HCCCBAAAAA
my @mirror = ([map { substr($_,0,1) . (9 - substr($_,1)) } @cell], # 左右対称用 (09, 08, ... 01, 00, ...)
[map { (5 - substr($_,0,1)) . substr($_,1) } @cell], # 上下対称用 (50, 51, ... 58, 59, ...)
[map { (5 - substr($_,0,1)) . (9 - substr($_,1)) } @cell]); # 180度回転用 (59, 58, ... 51, 50, ...)
.....
@tmp_board{@cell} = @board{@{$mirror[0 又は 1 又は 2]}};
配列やハッシュでは、スライス代入を利用することによって値を交換できます。@array[0,2] = @array[2,0]; や @hash{'key1','key3'} = @hash{'key3','key1'}; の構文で一部の値の入れ換えができますが、 これが配列やハッシュ全体に及んでも差し支えありません。チェック用の一時的な盤面の生成でも、@mirror に用意してあるキーのリストを使って盤面全体を入れ換えます。解が得られたときの動作は、生成した左右対称、 上下対称、180 度回転のいずれかの解が %uniq に存在するときはスキップし、存在しないときはユニーク解として %uniq に登録することになります。重複解のチェックを付け加えると、出力される解の数は 2,339 となります。
上記の重複解のチェックは、事後のチェックなので実行時間の短縮にはなりません。 時間を短縮するためには、枝刈りをして重複解を発生させないようにする必要があります。 盤面は大筋として上の列から埋めるため、上下対称解と 180 度回転解は途中でチェックしても意味がありません。 そのため、上下対称解と 180 度回転解は事後チェックとし、左右対称解のチェックのみ組み込みました。チェックは symmetry サブルーチンで行います。
sub symmetry {
return 1 if join('', @board{'00' .. '09'}) =~ /0/;
return 1 if join('', @board{'10' .. '19'}) =~ /^[A-L]+$/;
my (%tmp_board, $pattern);
@tmp_board{@cell} = @board{@{$mirror[0]}};
$pattern = join '', map { $tmp_board{$_} } @cell;
return 0 if exists $symmetry{$pattern};
$pattern = join '', map { $board{$_} } @cell;
$symmetry{$pattern} = 1;
return 1;
}
symmetry サブルーチンは、盤面の一番上の列が埋まったときのみチェックします。symmetry の１行目で一番上の列が埋まっていることを確認し、２行目で２列目に空きマス目があることを確認しています。 チェックのコードは、重複解のチェックのコードとほぼ同じになっています。symmetry のチェックを入れれば、事後の左右対称解のチェックを省けると思ったのですが例外がありました。 ごくまれにですが、上の２列が同時に埋まってしまうことがあります。K, B, L, F のピースを順に配置すると、上の図のような盤面になることがあります。次に D を配置すると、symmetry のチェックをすり抜けることになります。残念ですが、事後のチェックも残すことにしました。
| Ｋ | Ｋ | Ｂ | Ｌ | Ｌ | Ｌ | Ｌ | Ｆ | Ｄ | Ｄ |
| Ｋ | Ｂ | Ｂ | Ｂ | Ｌ | Ｆ | Ｆ | Ｆ | Ｄ | Ｄ |
| Ｋ | Ｋ | Ｂ | Ｆ | Ｄ | |||||
２つ目のプログラムの実行時間は、最終的に 17,795 秒 (4h56m35s) になりました。最初のプログラムが 15 時間強でしたので、1/3 弱になったことになります。
２つのプログラムの実行結果として、pento_all.dat (解の数 9,356) と pentomino.dat (解の数 2,339) が作成されます。この２つのファイルを利用して、「ペントミノパズル」の問題を作成しました。pentomino.dat の１つの解にいくつかのピースを配置して、pento_all.dat を検索して一致数を求めます。 一致数が複数でなく１つであれば、その解以外に一致するものがないので問題として成立することになります。
問題を作成している過程で、予想外で驚いたことが１つあります。 盤面に何も置いていない状態からピースを１つ配置しただけで、解が１つしかないものが存在したことです。 何も置いてない状態で解の数が 2,339 あるので、１つ置くだけで単一解になるとは意外でした。 そのうちから、例を２つ紹介しましょう。
上の２つのピース (A と D) は、(左右対称、上下対称、180 度回転解を除外すると) 単一解のある置き方は１つしかありません。その他にも、C のピースで３つの置き方、 H のピースで７つの置き方、L のピースで３つの置き方があり、合計で５ピース 15 の単一解がある置き方があります。 残りの 2,324 (2,339 - 15) では、２つのピースを置けば単一解になるのが 2,106 で、３つのピースが必要になるのが 203 となります。４つ以上のピースが必要になるものはありません。 パズルの出題では最多で５つのピースを配置していますが、解の唯一性の観点からは必要のないピースが含まれていることがあります。
(2012/02/15)