現在の閲覧者数:

数独(コピー&ペースト)

http://www.swi-prolog.org/man/clpfd.html
の100%コピペです。
理解できていません。

♪ プログラムコード code

% sudoku.pl

:- use_module(library(clpfd)).


main( N ) :-
        problem(N, Rows), 
        sudoku(Rows), 
        maplist(writeln, Rows).

sudoku(Rows) :-
        length(Rows, 9), maplist(length_(9), Rows),
        append(Rows, Vs), Vs ins 1..9,
        maplist(all_distinct, Rows),
        transpose(Rows, Columns),
        maplist(all_distinct, Columns),
        Rows = [A,B,C,D,E,F,G,H,I],
        blocks(A, B, C), blocks(D, E, F), blocks(G, H, I).

length_(L, Ls) :- length(Ls, L).

blocks([], [], []).
blocks([A,B,C|Bs1], [D,E,F|Bs2], [G,H,I|Bs3]) :-
        all_distinct([A,B,C,D,E,F,G,H,I]),
        blocks(Bs1, Bs2, Bs3).

% 解は1つ。求まります。
problem(1, [[_,_,_,_,_,_,_,_,_],
            [_,_,_,_,_,3,_,8,5],
            [_,_,1,_,2,_,_,_,_],
            [_,_,_,5,_,7,_,_,_],
            [_,_,4,_,_,_,1,_,_],
            [_,9,_,_,_,_,_,_,_],
            [5,_,_,_,_,_,_,7,3],
            [_,_,2,_,1,_,_,_,_],
            [_,_,_,_,4,_,_,_,9]]).

% 解は1つ。求まります。
problem(2, [[_,_,9,_,_,_,_,_,_],
            [_,_,5,_,_,4,_,_,_],
            [_,_,7,_,_,6,_,_,1],
            [4,_,_,_,_,9,_,_,7],
            [2,_,_,_,_,_,_,_,8],
            [3,_,_,6,_,_,_,_,2],
            [7,_,_,2,_,_,4,_,_],
            [_,_,_,8,_,_,9,_,_],
            [_,_,_,_,_,_,2,_,_]]).

% 解が2つの問題
problem(3, [[_,_,5,_,_,_,3,_,_],
            [_,8,_,1,_,7,_,2,_],
            [3,_,_,_,6,_,_,_,9],
            [_,9,_,6,_,3,_,4,_],
            [_,_,1,_,_,_,6,_,_],
            [_,5,_,8,_,2,_,9,_],
            [2,_,_,_,7,_,_,_,5],
            [_,1,_,4,_,5,_,6,_],
            [_,_,4,_,_,_,9,_,_]]).


%  解が無い問題
problem(4, [[_,_,5,_,_,_,3,_,_],
            [_,8,_,1,_,7,_,2,_],
            [3,_,_,_,6,_,_,_,9],
            [_,9,_,6,_,3,_,4,_],
            [_,_,1,_,_,_,6,_,_],
            [_,5,_,8,_,2,_,9,_],
            [2,_,_,_,7,_,_,_,3],
            [_,1,_,4,_,5,_,6,_],
            [_,_,4,_,_,_,9,_,_]]).


q :- halt.


実行例

love:mugenkai% open sudoku.pl                                   [~/love/Sudoku]
love:mugenkai% swipl -qs sudoku.pl                              [~/love/Sudoku]
?- main(1).
[9,8,7,6,5,4,3,2,1]
[2,4,6,1,7,3,9,8,5]
[3,5,1,9,2,8,7,4,6]
[1,2,8,5,3,7,6,9,4]
[6,3,4,8,9,2,1,5,7]
[7,9,5,4,6,1,8,3,2]
[5,1,9,2,8,6,4,7,3]
[4,7,2,3,1,9,5,6,8]
[8,6,3,7,4,5,2,1,9]
true.

?- main(2).
[6,3,9,7,1,2,8,5,4]
[1,2,5,3,8,4,7,6,9]
[8,4,7,9,5,6,3,2,1]
[4,5,8,1,2,9,6,3,7]
[2,7,6,4,3,5,1,9,8]
[3,9,1,6,7,8,5,4,2]
[7,6,3,2,9,1,4,8,5]
[5,1,2,8,4,3,9,7,6]
[9,8,4,5,6,7,2,1,3]
true.

?- main(3).
[1,4,5,2,9,8,3,7,6]
[6,8,9,1,3,7,5,2,4]
[3,2,7,5,6,4,_G87,_G90,9]
[7,9,2,6,5,3,_G117,4,_G123]
[8,3,1,7,4,9,6,5,2]
[4,5,6,8,1,2,7,9,3]
[2,6,8,9,7,1,4,3,5]
[9,1,3,4,8,5,2,6,7]
[5,7,4,3,2,6,9,_G270,_G273]
true.

?- main(4).
false.

?- 

♪♪♪プログラムコードを解読してみます。

% sudoku.pl

% 有限領域上(FD)の制約(CLP)ライブラリ(Library)モジュール(Module)
:- use_module(library(clpfd)).


main( N ) :-
        problem(N, Rows),       % N 番目の 問題
        sudoku(Rows),           % 数独を解く
        maplist(writeln, Rows). % 答えの表示

% maplist / 2 の例
% maplist( writeln, [1,2,3] ). は、
% writeln(1), writeln(2), writeln(3). と同じです。
% maplist(writeln, Rows). は、行ごとに表示します。

sudoku(Rows) :-
        length(Rows, 9), maplist(length_(9), Rows),
        
        % length(Rows, 9) は、9個の行を作成します。
        % maplist(length_(9), Rows) は、行ごとの要素を作成します。
        % ここで、length_(9) は、length( R, 9) で9個の要素。
        
        append(Rows, Vs), Vs ins 1..9,
        
        % append / 2 は、Rows:リストのリストを結合して、Vs:81要素のリストを作る。
        % そして個々の要素は、1から9の範囲の整数が割り当てられる。
        
        maplist(all_distinct, Rows),
        % 行ごとに all_different/1(すべて違っている)を適用する。
        
        transpose(Rows, Columns),
        % 行列 を行リストのリスト表現から列リストのリスト表現へ変換する
        % 例
        % ?- transpose([[1,2,3],[4,5,6],[7,8,9]], Ts).
        % Ts = [[1, 4, 7], [2, 5, 8], [3, 6, 9]].
        
        maplist(all_distinct, Columns),
        
        % 列ごとに all_different/1(すべて違っている)を適用する。
        
        Rows = [A,B,C,D,E,F,G,H,I],
        
        % ここの A,B,C,D,E,F,G,H,I は行を指す。
        % 1行目=A, 2行目=B,....9行目=I
        
        blocks(A, B, C), blocks(D, E, F), blocks(G, H, I).
        
        % 1~3行            4~6行            7~9行
        
length_(L, Ls) :- length(Ls, L).

blocks([], [], []).
blocks([A,B,C|Bs1], [D,E,F|Bs2], [G,H,I|Bs3]) :-
        
        % ここの A,B,C,D,E,F,G,H,I は 要素 を指す。
        
        all_distinct([A,B,C,D,E,F,G,H,I]),
        
        % ブロックごとに all_different/1(すべて違っている)を適用する。
        
        blocks(Bs1, Bs2, Bs3).
        
        % 次の要素ブロックへ

% 解は1つ。求まります。
problem(1, [[_,_,_,_,_,_,_,_,_],
            [_,_,_,_,_,3,_,8,5],
            [_,_,1,_,2,_,_,_,_],
            [_,_,_,5,_,7,_,_,_],
            [_,_,4,_,_,_,1,_,_],
            [_,9,_,_,_,_,_,_,_],
            [5,_,_,_,_,_,_,7,3],
            [_,_,2,_,1,_,_,_,_],
            [_,_,_,_,4,_,_,_,9]]).

% 解は1つ。求まります。
problem(2, [[_,_,9,_,_,_,_,_,_],
            [_,_,5,_,_,4,_,_,_],
            [_,_,7,_,_,6,_,_,1],
            [4,_,_,_,_,9,_,_,7],
            [2,_,_,_,_,_,_,_,8],
            [3,_,_,6,_,_,_,_,2],
            [7,_,_,2,_,_,4,_,_],
            [_,_,_,8,_,_,9,_,_],
            [_,_,_,_,_,_,2,_,_]]).

% 解が2つの問題
problem(3, [[_,_,5,_,_,_,3,_,_],
            [_,8,_,1,_,7,_,2,_],
            [3,_,_,_,6,_,_,_,9],
            [_,9,_,6,_,3,_,4,_],
            [_,_,1,_,_,_,6,_,_],
            [_,5,_,8,_,2,_,9,_],
            [2,_,_,_,7,_,_,_,5],
            [_,1,_,4,_,5,_,6,_],
            [_,_,4,_,_,_,9,_,_]]).


%  解が無い問題
problem(4, [[_,_,5,_,_,_,3,_,_],
            [_,8,_,1,_,7,_,2,_],
            [3,_,_,_,6,_,_,_,9],
            [_,9,_,6,_,3,_,4,_],
            [_,_,1,_,_,_,6,_,_],
            [_,5,_,8,_,2,_,9,_],
            [2,_,_,_,7,_,_,_,3],
            [_,1,_,4,_,5,_,6,_],
            [_,_,4,_,_,_,9,_,_]]).


q :- halt.



inserted by FC2 system