2015年6月22日月曜日

数独をPrologで解く

SWI-Prologを入れていろいろ遊んでます。
もともとはIchigo-JamでBASIC書いてるプログラムを、CやPrologで書いて比較するって感じでやってました(これはこれで、今後まとめます)。

ハノイの塔、8-Queen、覆面算(これはBASICで書いてない)、そしてCでは書いたことがある数独を解くプログラム。

超ナイーブに書いたところ、4X4のミニ数独は解けたけど、6X6でかなり時間がかかってしまうことが判明。9X9は多分無理!!!
 →単純に空いているところから数字入れて、入れた場所だけでチェックしてる感じ。

問題になるのは、1マス埋めるごとに、たて、横、そして周辺(ブロックになっている)の3つについて、矛盾が生じないかのチェックをしなければならないのに、していないことでした。
 しょうがないので、たて、横、ブロックのリストを全部もってまわって、埋まっている数字が重なっていないかどうかのチェックのみ入れてみました。

 これでなんとか9X9でも数秒程度で解けるようになりました。はふー。

Cだと、必然的に埋まる場所をチェックして先に値を入れていくのですが、これをPrologで実装するのは大変そうです。アルゴリズムの記述はPrologは苦手なのよね。その代わり、成立する条件だけ書けばよいわけなのですが、それだと遅すぎると。。。

いろいろ調べていたら、SWI-Prologには制約論理言語の拡張があるようでして、それを使うと、制約条件だけ記述して、探索は完全にシステム任せになるようです!

 試してみました。記述が少ない!、しかも早いぞ!!!(笑)

 まぁ、記述が楽になるのでいいのですけど、アルゴリズムの記述もプログラムの楽しみの一つですよねぇ。それがないのは、いいことなんでしょうかね????

 ということで、適当に書いたプログラムを晒してみます。

check,check1,check2,check3なんてあまりに適当すぎてなんですけどね。
check,check1で、問題に数字を割り当てていて、
check2,check3で、割り当てた結果で矛盾が生じていないかどうかをチェックしています。
#ま、みてわかるとも思えませんけど。

あ、実行結果を先につけますが、これだと、元の問題がわからないですねー。あはは。
http://www.conceptispuzzles.com/ja/index.aspx?uri=puzzle/sudoku
ここから問題を拾ってきました。

[2,4,1,3]
[1,3,2,4]
[3,1,4,2]
[4,2,3,1]
true .

[1] 111 ?- solve(6).
[2,5,4,6,3,1]
[6,1,3,5,2,4]
[4,2,6,1,5,3]
[1,3,5,2,4,6]
[5,4,1,3,6,2]
[3,6,2,4,1,5]
true .

[1] 112 ?- solve(10).
[7,4,1,3,6,8,9,2,5]
[3,2,9,7,4,5,6,8,1]
[8,6,5,1,2,9,4,7,3]
[9,8,3,4,1,7,2,5,6]
[6,5,7,2,9,3,8,1,4]
[2,1,4,5,8,6,7,3,9]
[5,9,6,8,3,2,1,4,7]
[4,3,8,6,7,1,5,9,2]
[1,7,2,9,5,4,3,6,8]

true 


------------------------
ここからがプログラム。

solve(N):-
    sudoku(N,X,Y,Z,L),
    check(X,L,[X,Y,Z,L]),
    check(Y,L,[X,Y,Z,L]),
    check(Z,L,[X,Y,Z,L]),
    maplist(writeln,X).

check([],_,_).
check([X|L],L1,ALL) :- 
    check1(X,L1,ALL),
    check(L,L1,ALL).

check1([],[],ALL).
check1([X|L],Y,[A,B,C,List]) :-
    delete(X,Y,L1),

    check2(A,List),
    check2(B,List),
    check2(C,List),
    check1(L,L1,[A,B,C,List]).

delete(X,[X|L],L).
delete(X,[Y|L],[Y|L1]):-
    delete(X,L,L1).

check2([],_):-!.
check2([X|L],L1):-
    check3(X,L1),
    check2(L,L1).

check3([],_):-!.
check3([X|L],L1):-
    var(X),!,check3(L,L1).
check3([X|L],L1):-
    delete(X,L1,L2),

    check3(L,L2).

sudoku(4,[[B11,B21,B31,B41],[B12,B22,B32,B42],[B13,B23,B33,B43],[B14,B24,B34,B44]],
       [[B11,B12,B13,B14],[B21,B22,B23,B24],[B31,B32,B33,B34],[B41,B42,B43,B44]],
       [[B11,B21,B12,B22],[B31,B41,B32,B42],[B13,B23,B14,B24],[B33,B43,B34,B44]],
       [1,2,3,4]):-
    B31 is 1,
    B22 is 3,
    B42 is 4,
    B13 is 3,
    B33 is 4,
    B24 is 2.


sudoku(6,[[B11,B21,B31,B41,B51,B61],[B12,B22,B32,B42,B52,B62],[B13,B23,B33,B43,B53,B63],
[B14,B24,B34,B44,B54,B64],[B15,B25,B35,B45,B55,B65],[B16,B26,B36,B46,B56,B66]],

       [[B11,B12,B13,B14,B15,B16],[B21,B22,B23,B24,B25,B26],[B31,B32,B33,B34,B35,B36],
[B41,B42,B43,B44,B45,B46],[B51,B52,B53,B54,B55,B56],[B61,B62,B63,B64,B65,B66]],

       [[B11,B21,B31,B12,B22,B32],[B13,B23,B33,B14,B24,B34],[B15,B25,B35,B16,B26,B36],
[B41,B51,B61,B42,B52,B62],[B43,B53,B63,B44,B54,B64],[B45,B55,B65,B46,B56,B66]],
       [1,2,3,4,5,6]):-
    B11 is 2,
    B61 is 1,
    B22 is 1,
    B52 is 2,
    B33 is 6,
    B43 is 1,
    B34 is 5,
    B44 is 2,
    B25 is 4,
    B55 is 6,
    B16 is 3,
    B66 is 5.

sudoku(10,[[B11,B21,B31,B41,B51,B61,B71,B81,B91],[B12,B22,B32,B42,B52,B62,B72,B82,B92],
[B13,B23,B33,B43,B53,B63,B73,B83,B93],[B14,B24,B34,B44,B54,B64,B74,B84,B94],
[B15,B25,B35,B45,B55,B65,B75,B85,B95],[B16,B26,B36,B46,B56,B66,B76,B86,B96],
[B17,B27,B37,B47,B57,B67,B77,B87,B97],[B18,B28,B38,B48,B58,B68,B78,B88,B98],
[B19,B29,B39,B49,B59,B69,B79,B89,B99] ],

       [[B11,B12,B13,B14,B15,B16,B17,B18,B19],[B21,B22,B23,B24,B25,B26,B27,B28,B29],
[B31,B32,B33,B34,B35,B36,B37,B38,B39],[B41,B42,B43,B44,B45,B46,B47,B48,B49],
[B51,B52,B53,B54,B55,B56,B57,B58,B59],[B61,B62,B63,B64,B65,B66,B67,B68,B69],
[B71,B72,B73,B74,B75,B76,B77,B78,B79],[B81,B82,B83,B84,B85,B86,B87,B88,B89],
[B91,B92,B93,B94,B95,B96,B97,B98,B99] ],

       [
[B11,B21,B31,B12,B22,B32,B13,B23,B33],[B14,B24,B34,B15,B25,B35,B16,B26,B36],
[B17,B27,B37,B18,B28,B38,B19,B29,B39],
[B41,B51,B61,B42,B52,B62,B43,B53,B63],[B44,B54,B64,B45,B55,B65,B46,B56,B66],
[B47,B57,B67,B48,B58,B68,B49,B59,B69],
[B71,B81,B91,B72,B82,B92,B73,B83,B93],[B74,B84,B94,B75,B85,B95,B76,B86,B96],
[B77,B87,B97,B78,B88,B98,B79,B89,B99]
       ],
       [1,2,3,4,5,6,7,8,9]):-
    B41 is 3,
    B51 is 6,
    B71 is 9,
    B22 is 2,
    B82 is 8,
    B13 is 8,
    B43 is 1,
    B63 is 9,
    B34 is 3,
    B54 is 1,
    B74 is 2,
    B94 is 6,
    B15 is 6,
    B95 is 4,
    B16 is 2,
    B36 is 4,
    B56 is 8,
    B76 is 7,
    B47 is 8,
    B67 is 2,
    B97 is 7,
    B28 is 3,
    B88 is 9,
    B39 is 2,
    B59 is 5,
    B69 is 4.