広告 プログラミング言語-Perl

9 多次元配列を扱えないPerlで数独を解くサンプルソース

perlでは残念なことに一次元配列しか扱えません。このサンプルソースは連想配列を用いて、疑似的に多次元配列を扱ってみました。

pythonは、多次元配列を扱うのがとても得意です。同様のソースをpythonで作成したら、３倍くらい速かった。

perlの良いところは、数字変数と文字列変数を自動で変換してくれるので、型変換が不要である点でしょうか。

下記サンプルは、必ずUTF-8で保存してから実行してください。

#!/usr/bin/perl

# 数独を解くPerlスクリプト

#perl5.8以降で日本語を扱うので、必ずソースをUTF-8で記載すること。

use strict;
use warnings;
use Encode;
use utf8;

binmode STDIN, ":encoding(cp932)";   # 入力なのに、何故かencoding
binmode STDOUT, ":encoding(cp932)";
binmode STDERR, ":encoding(cp932)";

#　ファイルハンドル<IN>等からの入力時はdecodeが必要
#　ファイルハンドル<OUT>等への出力時はencodeが必要

#===========================
#数独　初期データ

our $debug=0;

my @sudoku=(
0,0,0,5,0,7,0,0,0,
6,0,0,0,0,0,0,0,2,
0,8,4,9,0,2,3,1,0,
9,0,0,1,0,8,0,0,5,
0,0,2,6,0,3,8,0,0,
0,0,0,0,0,0,0,0,0,
1,0,0,2,0,9,0,0,6,
0,4,0,0,0,0,0,7,0,
0,0,0,0,3,0,0,0,0,
);

#my @sudoku=(
#2,0,0,1,0,0,0,7,0,
#5,0,9,0,0,0,0,0,0,
#0,4,0,0,0,9,0,0,6,
#0,0,0,6,0,2,0,0,0,
#1,0,0,0,8,0,3,0,0,
#0,0,0,0,0,0,7,0,4,
#0,0,5,0,0,0,0,0,0,
#0,0,0,0,7,0,0,3,9,
#0,6,0,8,4,0,0,0,0,
#);

#===========================

our $ScriptDir=$0; #実行中のplスクリプトフルパス
$ScriptDir=&de_sjis($ScriptDir);
$ScriptDir=~s/[^\\]+\.pl$//;
&vv('$ScriptDir',$ScriptDir);


our %bd_org=(); #数独の設問のオリジナル
our %kouho_org=(); #各マスで候補となる数字の列（３次元配列）

# bd 初期化（上記の@sudokuから読み込み）

for (my $y=0;$y<=8;$y++) {
    for (my $x=0;$x<=8;$x++) {
        my $key_xy=$x."\t".$y;
        my $num=$sudoku[$x+$y*9];
        $bd_org{$key_xy}=$num;
        print $num;
        if ($num>0) {
            $kouho_org{$key_xy}='';
        } else {
            $kouho_org{$key_xy}='123456789';
        }
    }
    print "\n";
}

print '[Enter -> start!]';
<>;

&loop1(\%bd_org,\%kouho_org); # 再起呼び出し

print '[Finish!]';
<>;

exit;


sub loop1
{
    my ($bd_ref,$kouho_ref)=@_;

    #ループ１開始--------------
    do {
        # 候補が１つしかない場合は、BDに埋め込み、候補の絞り込みを繰り返す。
        my %sort_kouho=bd_kouho1_umeru($bd_ref,$kouho_ref);
    
        if (%sort_kouho) { #空でない場合
            # 残った候補リストのチェック
            my $check_kouho_nokori=0;
            my $kouho_len_min='';
            for my $len (sort keys %sort_kouho) {
                if ($len>0) {
                    $check_kouho_nokori+=$len;
                    &vv('$len',$len);
                    &vv('$sort_kouho{$len}',$sort_kouho{$len});
                    if ($kouho_len_min eq '') {
                        $kouho_len_min=$len;
                    }
                }
            }
    
            if ($check_kouho_nokori > 0) {
                # kouho が２つ以上ある場合、BDをバックアップにコピーする（現時点での確定分をバックアップ）
                &vv('=== 複数候補あり ===','');
                &vv('=== 修正前BD ===','');
                &print_kouho($bd_ref,$kouho_ref) if ($debug);

                my %bd_bak=%$bd_ref;
    
                # 最も小さい数字を取り出し、BDに数字を埋める。数字を取り出した後に、kouhoもバックアップ
                my ($key_xy)=split(/\n/,$sort_kouho{$kouho_len_min});
                &vv('$kouho_len_min',$kouho_len_min);
                &vv('$sort_kouho{$kouho_len_min}',$sort_kouho{$kouho_len_min});
                &vv('$key_xy',$key_xy);
                &vv('$kouho_ref->{$key_xy}',$kouho_ref->{$key_xy});

                my $num=chop($kouho_ref->{$key_xy});
                &vv('$num',$num);
                &vv('chop after $kouho{$key_xy}',$kouho_ref->{$key_xy});
                $bd_ref->{$key_xy}=$num;
                my %kouho_bak=%$kouho_ref;
                $kouho_ref->{$key_xy}='';

                &vv('=== 修正後BD ===','');
                &print_kouho($bd_ref,$kouho_ref) if ($debug);
                &vv('=== バックアップBD ===','');
                &print_kouho(\%bd_bak,\%kouho_bak) if ($debug);

                &vv('=== 再起呼び出し ===','');
                my $result=&loop1($bd_ref,$kouho_ref); # 再起呼び出し
                
                if ($result) {
                    # 完成
                    return 1;
                } else {
                    # 完成してないので、ロールバック：BDとkouhoをバックアップから復旧し、ループ１へ戻る
                    &vv('=== ロールバック ===','');
                    %$bd_ref=%bd_bak;
                    %$kouho_ref=%kouho_bak;
                }
            }
        } else {
            # 候補リストがNULL=>これ以上候補なし。
            if (check_sudoku_finish($bd_ref)) {
                print '=== 完成！===',"\n";
                open(OUT,'>sudoku.txt');
                for (my $y=0;$y<=8;$y++) {
                    for (my $x=0;$x<=8;$x++) {
                        my $key_xy=$x."\t".$y;
                        print &en_sjis($bd_ref->{$key_xy},' ');
                        print OUT &en_sjis($bd_ref->{$key_xy},' ');
                    }
                    print "\n";
                    print OUT "\n";
                }
                close(OUT);
                return 1;

            } else {
                print '=== 失敗！===',"\n" if($debug);
                &print_kouho($bd_ref,$kouho_ref) if ($debug);

                return 0;
            }
        }
    
    } while(1);

}


# 数字の候補が１つしか無い場所に、数字を埋めていく。
# ２つ以上候補がある場所は埋めない
sub bd_kouho1_umeru
{
    my ($bd_ref,$kouho_ref)=@_;

    my %sort_kouho=();

    my $loop2_chk=0;
    do {
        # bdを使って、kouho を減らす（x y box）
        &delete_kouho($bd_ref,$kouho_ref);
        &print_kouho($bd_ref,$kouho_ref) if ($debug);

        # kouho の少ない順に並べ替える
        &vv('=== sort kouho1 ===','');
        %sort_kouho=();
        for my $key_xy (keys %$kouho_ref) {
            &vv('$key_xy',$key_xy);
            my $len=length($kouho_ref->{$key_xy});
            &vv('$len',$len);
            if ($len>0) {
                $sort_kouho{$len}.=$key_xy."\n";
            }
        }
        &vv('=== sort kouho2 ===','');

        # kouhoが１つしかない場合（確定）、作業用BDに数値を埋める。$loop2_chk=1とする。（数字を埋めたらループ２に戻る）
        $loop2_chk=0;
        if (defined($sort_kouho{'1'})) {
            for my $key_xy (split(/\n/,$sort_kouho{'1'})) {
                if ($key_xy ne '') {
                    &vv('$key_xy',$key_xy);
                    &vv('$bd_ref->{$key_xy}',$bd_ref->{$key_xy});
                    &vv('$kouho_ref->{$key_xy}',$kouho_ref->{$key_xy});
                    $loop2_chk=1;
                    $bd_ref->{$key_xy}=$kouho_ref->{$key_xy};
                    $kouho_ref->{$key_xy}='';
                }
            }
        }

    } while ($loop2_chk);
    
    return %sort_kouho;
}



#各マスの候補となる数列の整理（候補にならない数字を削除）
sub delete_kouho
{
    my ($bd_ref,$kouho_ref)=@_;
    for (my $y=0;$y<=8;$y++) {
        for (my $x=0;$x<=8;$x++) {
            my $key_xy=$x."\t".$y;
            my $num=$bd_ref->{$key_xy};

            if ($num >0) {
                # X軸方向に削除
                for (my $xx=0;$xx<=8;$xx++) {
                    my $key_xxy=$xx."\t".$y;
                    $kouho_ref->{$key_xxy}=~s/$num//;
                }
                # Y軸方向に削除
                for (my $yy=0;$yy<=8;$yy++) {
                    my $key_xyy=$x."\t".$yy;
                    $kouho_ref->{$key_xyy}=~s/$num//;
                }
                # 周囲を削除
                for (my $xx=0;$xx<=2;$xx++) {
                    for (my $yy=0;$yy<=2;$yy++) {
                        my $key_box=(int($x/3)*3+$xx)."\t".(int($y/3)*3+$yy);
                        $kouho_ref->{$key_box}=~s/$num//;
                    }
                }
            }
        }
    }
}

#各マスの候補となる数列の表示
sub print_kouho
{
    my ($bd_ref,$kouho_ref)=@_;
    for (my $y=0;$y<=8;$y++) {
        for (my $x=0;$x<=8;$x++) {
            my $key_xy=$x."\t".$y;
            print $bd_ref->{$key_xy},':',substr($kouho_ref->{$key_xy}.'          ',0,10);
        }
        print "\n";
    }

}


# 与えられたbdの正当性をチェックし、完成していたらtrueを返す。
sub check_sudoku_finish
{
    my ($bd_ref)=@_;
    my %chk_box=();
    my @chk_x=();
    my @chk_y=();
    
    for (my $y=0;$y<=8;$y++) {
        for (my $x=0;$x<=8;$x++) {
            my $key_xy=$x."\t".$y;
            my $key_xy3=int($x/3)."\t".int($y/3);
            my $c=$bd_ref->{$key_xy}."\t";
            $chk_box{$key_xy3}.=$c;
            $chk_x[$y].=$c;
            $chk_y[$x].=$c;
#            print $c,' ';
        }
#        print "\n";
    }

    my $chk_f=0;
    for (my $i=0;$i<=8;$i++) {
        $chk_f+=&check_str($chk_x[$i]);
        $chk_f+=&check_str($chk_y[$i]);
    }
    for my $key (keys %chk_box) {
        $chk_f+=&check_str($chk_box{$key});
    }
    if ($chk_f > 0) {
        return 0;
    }

    #find!!
    return 1;
}

#Tab区切り文字列で、123456789全て存在するなら0、そうでなければ1
sub check_str
{
    my($str)=@_;
    my $chk_str=join('',sort(split(/\t/,$str)));
    if ($chk_str eq '123456789') {
        return 0;
    }
    return 1;
}

#----------------------------------
sub en_sjis
{
    my ($buf)=@_;
    encode('cp932',$buf);
}

sub de_sjis
{
    my ($buf)=@_;
    decode('cp932',$buf);
}

sub en_utf8
{
    my ($buf)=@_;
    encode('utf-8',$buf);
}

sub de_utf8
{
    my ($buf)=@_;
    decode('utf-8',$buf);
}
sub en_euc
{
    my ($buf)=@_;
    encode('euc-jp',$buf);
}

sub de_euc
{
    my ($buf)=@_;
    decode('euc-jp',$buf);
}

sub vv
{
    my($Name,$Value)=@_;
    if($debug) {
        print $Name.'=['.$Value.']',"\n";
    }
}

ソースは必ずUTF-8に変換しよう（解説ページへ）

「cmd.exe」で「perl スクリプト名.pl」で実行（解説ページへ）

-プログラミング言語-Perl