バレーボール関係で埋まりかけた連休の合間を見て、数独を解くPerlスクリプトを書いたので、ネタにしようと思う。（自宅サーバネタはまた間に合わなかった）
Wikipedia：数独
上記URLに画像が紹介されている一番ポピュラーな縦9マス横9マスの問題の場合、各列には1～9の数字が1つだけ入り、各行にも1～9の数字が1つだけ入る。更に3×3の正方形内にも1～9の数字が独立して入る。この3つのルールに違反しない数字を書くマスに埋めていくのが数独だ。間違った数字を入れてしまうとどこかで矛盾が生じてしまい、全マスに数字を収められなくなってしまう。逆を取れば、全マスに数字を収められればそれが正解となる。
今回作成したスクリプトは、まず最初のマスに適当に数字を入れ、次のマスへ移動する。そこでも適当に数字を入れる。入れられる数字が無かった場合、1つ前のマスに戻り別の数字を入れ、また次のマスへ移動し、入れられる数字があれば入れていく。これを全マスに数字を収められるまで繰り返していく。いわゆるバックトラックという手法になる。（芸が無いと言えばそれまでだが）
スクリプトは以下のように使用する。
perl sudoku.pl question.txt
「question.txt」（ファイル名は任意）には、空きマスは「0」として空白区切りで下記のように問題を記述する。
0 0 3 5 1 2 0 0 0
0 1 0 0 4 0 3 2 0
6 0 0 0 8 0 0 4 0
3 0 0 0 0 4 0 0 6
1 4 9 0 0 0 7 8 5
5 0 0 9 0 0 0 0 4
0 3 0 0 9 0 0 0 2
0 5 8 0 3 0 0 1 0
0 0 0 1 2 5 8 0 0
これを実行し問題を解くことが出来た場合、空きマスの「0」が数字に書き換えられた「question-answer.txt」が生成される。
4 7 3 5 1 2 9 6 8
8 1 5 6 4 9 3 2 7
6 9 2 3 8 7 5 4 1
3 2 7 8 5 4 1 9 6
1 4 9 2 6 3 7 8 5
5 8 6 9 7 1 2 3 4
7 3 1 4 9 8 6 5 2
2 5 8 7 3 6 4 1 9
9 6 4 1 2 5 8 7 3
例では9×9の問題を使用しているが、もっと大きな問題でも解くことができる（はず）。問題に無理がある場合はもちろん失敗してしまう。問題があっているのに失敗することは無いが、あったらごめんなさい。
ここをクリックでコードの表示・非表示を切り替える。
use strict;
use FileHandle;
our @cells = ('');
our $maxnum;
our $blockbasenum;
our @chkblock;
our @chkrow;
our @chkcol;
my $fh = new FileHandle;
my $fquestion = $ARGV[0];
if(!(-f $fquestion)){
print "$fquestionは存在しないか、ファイルじゃないよ。\n";
exit 0;
}
open($fh, $fquestion) || die;
while(<$fh>){
chomp;
push @cells, ['',split(/ /, $_)];
}
close($fh);
$maxnum = @{$cells[1]} - 1;
$blockbasenum = sqrt($maxnum);
foreach my $num (1..$maxnum){
$chkrow[$num] = [];
$chkcol[$num] = [];
$chkblock[$num] = [];
}
for(my $row = 1; $row <= $maxnum; $row++){
$chkrow[$row] = [grep($_ != 0, @{$cells[$row]})];
for(my $col = 1; $col <= $maxnum; $col++){
if($cells[$row]->[$col] != 0){
push @{$chkcol[$col]}, $cells[$row]->[$col];
push @{$chkblock[&GetBlockNo($col, $row)]}, $cells[$row]->[$col];
}
}
}
if(&SetNumberInCell(1, 1) == 0){
$fquestion .= '-answer.txt' if($fquestion !~ s|^(.+)(\.[^.]+)|$1-answer$2|);
open($fh, ">$fquestion") || die;
for(my $row = 1; $row <= $maxnum; $row++){
for(my $col = 1; $col <= $maxnum; $col++){
my $num = $cells[$row]->[$col];
print $fh ' ' x (length($maxnum) - length($num)), $num, " ";
}
print $fh "\n";
}
close($fh);
print "完了しました。\n";
}else{
print "失敗しました。\n";
}
exit 0;
sub SetNumberInCell{
my ($col, $row) = @_;
my ($ncol, $nrow);
if($cells[$row]->[$col] != 0){
($ncol, $nrow) = &GetNextCell($col, $row);
return ($ncol == -1 && $nrow == -1) ? 0 : &SetNumberInCell($ncol, $nrow) ;
}else{
foreach my $num (&GetNumberList($col, $row)){
$cells[$row]->[$col] = $num;
push @{$chkrow[$row]}, $num;
push @{$chkcol[$col]}, $num;
push @{$chkblock[&GetBlockNo($col, $row)]}, $num;
($ncol, $nrow) = &GetNextCell($col, $row);
last if($ncol == -1 && $nrow == -1);
if(&SetNumberInCell($ncol, $nrow) == 0){
last;
}else{
$cells[$row]->[$col] = 0;
pop @{$chkrow[$row]};
pop @{$chkcol[$col]};
pop @{$chkblock[&GetBlockNo($col, $row)]};
}
}
return ($cells[$row]->[$col] != 0) ? 0 : 1;
}
}
sub GetNumberList{
my ($col, $row) = @_;
my %num;
@num{
@{$chkrow[$row]},
@{$chkcol[$col]},
@{$chkblock[&GetBlockNo($col, $row)]}
} = ();
return grep(!(exists $num{$_}), 1..$maxnum);
}
sub GetBlockNo{
my ($col, $row) = @_;
return (int(($col - 1) / $blockbasenum) * $blockbasenum) + int(($row - 1) / $blockbasenum) + 1
}
sub GetNextCell{
my ($col, $row) = @_;
if($col == $maxnum && $row == $maxnum){
# 次セル無し
$col = -1;
$row = -1;
}elsif($row == $maxnum){
# 次列
$col++;
$row = 1;
}else{
# 次行
$row++;
}
return ($col, $row);
}
需要は無いだろうけど、ダウンロードは下記からどうぞ。
ダウンロード
バグがあった場合は、ぜひご連絡を。
今度はイラストロジックを解くスクリプトにでも挑戦してみようかなと思う。
