Prologで作るオセロ盤

最近はAI(Deep Lerning)のプログラムに囲碁のプロが負けちゃう時代のようです。個人的にはAIって超うさんくさいのであります。囲碁の場合も学習でユニークな評価関数が出来たって話なのか？それとも囲碁特有の解き方が見つかったのかでだいぶ違いがあると思うですよね。AIってなんだろう？？難しいテーマですなぁ。

で、AI言語（古い〜）といえばPrologですので、

　　作ってみたよ。Prologでオセロ盤。使っているのはswi-prologです。

初期状態から打ち手を入れて、ゲーム終了になるまで繰り返します。

あくまでもお試しなので、UIその他は最小限の実装。「待った」はできません。

（ん？Prologで待ったかぁ。やりにくそうだな。ま、打ち手と盤を指すごとに残せばいいのか。）

徐々に追記しますが、とりあえず「ザクッ」っとつくったソースだけ晒します。効率や見た目はそこまでちゃんと詰めてないのはご容赦を。あと、一部デバッグ用のwriteln()が残ってます。ま、表示が汚れますけど、今は気にしない（笑）。

基本の考え方だけ

・盤情報の持ち方

　座標は11,21,....,78,88という２桁の数字にします。本当はA1,...H8ですが、処理をサボるためにこうなってます。

　黒い駒が置いてある座標のリストをBlack,白い駒が置いてある場所のリストをWhiteとして、引っ張り回します。

　play :- play(black,white,[44,55],[45,54]).

　→手番black,(次の手番white), 黒の座標リスト、白の座標リスト

　　を食わせた、初期状態からのプレイはこんな感じです。

　普通だと、8X8の配列にしちゃうところですが、Prologと配列はそんなに相性がよいわけでもなし、インデックスで指せないならこの方がいいんじゃないかと思います。あとは、計算結果を残しておくためのデータベースなんてのは今時必須なのですが、高速に実装する方法を考えないといけない。Cとかなら、ハッシュ使ってO(1)に近い検索ができるけど、２分木じゃO(logn)になっちゃうからなぁ。ハッシュは調べないといかんし、これできないなら、しんどいわな。

・駒の反転　checkput()

　direction(方向リスト)に、ある地点から隣へ移動するために加算する数値をいれてあります。８方向に移動するのは、これを使います。

　　direction([-11,-10,-9,-1,1,9,10,11]).

　　→順に、[左上、上、右上、左、右、左下、下、右下]との駒の距離が入ってます。

　　　盤は8X8ですが、数字的には10増減するごとに上下しますので、ここは注意が必要。

　調べたい座標は、board(座標リスト)から引いてきて、

　　 空いている(Black,Whiteのmemberでない）場所からスタート。上記の[方向リスト]を足しながら、隣の場所を確認

     - 盤からはみ出たらfalseで終了

     - 自分の駒にあたったとき、途中に相手の駒があればtrue.その数と座標リストを返します。

     - 相手の駒に当たった時、ひっくり返す数をインクリメントして、さらに隣をチェックに行きます。

   

割とあっさり出来たような気がします（３時間くらい）。

さて、このプログラムの詳細もありますが、ここから、コンピューターによる打ち手を求めるプログラムを軽く作ってみるのが本題ですねぇ。

　まずは、中間評価関数を作って先読みなしで打つのを実装して、次に先読み。アルファベータ的ななにかを実装できるんか？それと、最後の数マスでは完全読み切りを作ることが重要かな。この辺りは、速度も気にしないといけないんだけど、今回は、このデータ構造でやれるかどうかを確認してみようと思います。

追記１：

・入力のところがなんか気に入らないですよね。こういうのがどうしてもPrologでオセロ作りたくない気分にさせる要因のひとつかなぁ。

＃こういうのってCで書いた方が楽な気がしてたんですけど、思ったよりさっくりかけた。

＃あとは、すくなくとも、自分より強いプログラムをさっくり記述できたら、Prologの勝ちだな（笑）

＃さて、将棋盤とか作れるのかなぁ？より複雑になるので、もっと真面目に考えないといけなさそうです。

実行結果はこんな感じ、コピペしたらフォントの関係かちょっとずれてますね。うひひ。

---8<------8 p="">

16 ?- play.

Game Playing

[teabn,black,[44,55],[45,54]]

1 2 3 4 5 6 7 8

1 . . . . . . . .

2 . . . . . . . .

3 . . . . . . . .

4 . . . O X . . .

5 . . . X O . . .

6 . . . . . . . .

7 . . . . . . . .

8 . . . . . . . .

Enter Place:53

[[54]]

Game Playing

[teabn,white,[53,54,44,55],[45]]

1 2 3 4 5 6 7 8

1 . . . . . . . .

2 . . . . . . . .

3 . . . . O . . .

4 . . . O O . . .

5 . . . X O . . .

6 . . . . . . . .

7 . . . . . . . .

8 . . . . . . . .

Enter Place:63

[[54]]

Game Playing

[teabn,black,[53,44,55],[63,54,45]]

1 2 3 4 5 6 7 8

1 . . . . . . . .

2 . . . . . . . .

3 . . . . O X . .

4 . . . O X . . .

5 . . . X O . . .

6 . . . . . . . .

7 . . . . . . . .

8 . . . . . . . .

Enter Place:64

[[54]]

Game Playing

[teabn,white,[64,54,53,44,55],[63,45]]

1 2 3 4 5 6 7 8

1 . . . . . . . .

2 . . . . . . . .

3 . . . . O X . .

4 . . . O O O . .

5 . . . X O . . .

6 . . . . . . . .

7 . . . . . . . .

8 . . . . . . . . 

ここからはソースコード

---8<------8 p="">

board([11,21,31,41,51,61,71,81,12,22,32,42,52,62,72,82,13,23,33,43,53,63,73,83,14,24,34,44,54,64,74,84,

       15,25,35,45,55,65,75,85,16,26,36,46,56,66,76,86,17,27,37,47,57,67,77,87,18,28,38,48,58,68,78,88]).

direction([-11,-10,-9,-1,1,9,10,11]).

member(X,[X|L]).

member(X,[_|L]):-member(X,L).

delete(X,[X|L],L).

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

    delete(X,L,L1).

deletelist([],L,L).

deletelist([X|Rest],L,L1):-

    delete(X,L,L2),

    deletelist(Rest,L2,L1).

deletelists([],L,L).

deletelists([X|Rest],L,L1):-

    deletelist(X,L,L2),

    deletelists(Rest,L2,L1).

append([],X,X).

append([A|X],Y,[A|Z]):-

    append(X,Y,Z).

appendlists(Move,[],X,[Move|X]).

appendlists(Move,[L|Rest],List,List1):-

    append(L,List,List2),

    appendlists(Move,Rest,List2,List1).

isGameEnd(Black,White):-

    isPut(black,Black,White,_,_),!,fail.

isGameEnd(Black,White):-

    isPut(white,Black,White,_,_),!,fail.

isGameEnd(Black,White).

isPass(Teban,Black,White):-

    isPut(Teban,Black,White,_,_),!,fail.

isPass(Teban,Black,White).

printBoard(Teban,Black,White) :- 

    writeln([teabn,Teban,Black,White]),

    write('  1 2 3 4 5 6 7 8'),

    board(BD),

    printBoard1(BD,Black,White).

printBoard1([],Black,White).

printBoard1([BD|_],_,_):-

    BD // 10 =:= 1,X1 is BD mod 10,nl,write(X1),write(' '),fail.

printBoard1([BD|Rest],Black,White):-

    member(BD,Black),!,

    write("O "),

    printBoard1(Rest,Black,White).

printBoard1([BD|Rest],Black,White):-

    member(BD,White),!,

    write("X "),

    printBoard1(Rest,Black,White).

printBoard1([BD|Rest],Black,White):-

    write(". "),

    printBoard1(Rest,Black,White).

empty(P,Black,White):-

    not(member(P,Black)),

    not(member(P,White)).

checkput1(Teban,Black,White,X,X1,DX,Num,_):- X1 < 1 ,!,fail. 

checkput1(Teban,Black,White,X,X1,DX,Num,_):- X1 > 88,!,fail.

checkput1(Teban,Black,White,X,X1,DX,Num,_):- (X1 mod 10) =:= 0,!,fail.

checkput1(Teban,Black,White,X,X1,DX,Num,_):- (X1 mod 10) =:= 9,!,fail.

checkput1(Teban,Black,White,X,X1,DX,Num,_):- empty(X1,Black,White),!,fail.

checkput1(black,Black,White,X,X1,DX,0,_)  :- member(X1,Black),!,fail.

checkput1(black,Black,White,X,X1,DX,_,[])  :- member(X1,Black),!.

checkput1(white,Black,White,X,X1,DX,0,_)  :- member(X1,White),!,fail.

checkput1(white,Black,White,X,X1,DX,_,[])  :- member(X1,White),!.

checkput1(Teban,Black,White,X,X1,DX,Num,[X1|List])  :- 

    X2 is X1 + DX,

    Num1 is Num + 1,

    checkput1(Teban,Black,White,X1,X2,DX,Num1,List).

checkput(Teban,Black,White,X,List):- 

    direction(DL),

    member(DX,DL),

    X1 is X + DX ,checkput1(Teban,Black,White,X,X1,DX,0,List).

isPut(Teban,Black,White,X,List):-

    board(P),

    member(X,P),

    empty(X,Black,White),

    checkput(Teban,Black,White,X,List).

makePutList(Teban,Black,White,L):-

    findall(X,isPut(Teban,Black,White,X,List),L).

makeRevList(Teban,Move,Black,White,L):-

    findall(List,checkput(Teban,Black,White,Move,List),L).

doMove(black,Move,Black,White,Black1,White1):-

    makeRevList(black,Move,Black,White,List),

    writeln(List),

    deletelists(List,White,White1),

    appendlists(Move,List,Black,Black1).

doMove(white,Move,Black,White,Black1,White1):-

    makeRevList(white,Move,Black,White,List),

    writeln(List),

    deletelists(List,Black,Black1),

    appendlists(Move,List,White,White1).

   

getMove1(Teban,Move,Black,White):-

    makePutList(Teban,Black,White,List),

    member(Move,List).

getMove(Teban,Move,Black,White):-

    write('\nEnter Place:'),

    readln([Move]),

    getMove1(Teban,Move,Black,White).

getMove(Teban,Move,Black,White):-

    getMove(Teban,Move,Black,White).

play(Teban,Teban1,Black,White) :- 

    isGameEnd(Black,White),writeln('Game END'),

    printBoard(Teban,Black,White),nl.

play(Teban,Teban1,Black,White) :- 

    isPass(Teban,Black,White),!,writeln('Game Pass'),

    play(Teban1,Teban,Black,White).

play(Teban,Teban1,Black,White) :- writeln('Game Playing'),

    printBoard(Teban,Black,White),

    getMove(Teban,Move,Black,White),!,

    doMove(Teban,Move,Black,White,Black1,White1),

    play(Teban1,Teban,Black1,White1).

play :- play(black,white,[44,55],[45,54]).

CodeIQのデスコロ#2にPrologで挑戦してみた。

最近このサイトが面白くて遊んでます。CodeIQデスコロ#2

問題は、abcdefghijklmnopqrstuvwxyzの26文字を50回繰り返して出力するプログラムを書くこと。そしてそのソースコードをできるだけ短くすると。
　ただし、上記のアルファベット列、最初のaを１番目としてx番目の文字を、
・xが素数である
・xの中に「３」が含まれない。(3,13,33,130など、桁の数に３があるとだめ）
という条件を両方とも満たした場合、大文字にして出力します。なので、こんな感じになります。

aBcdEfGhijKlmn.....

最初はCで書いていたのですが、なかなか短くできず最短にはなれないことがわかってきたので、思いっきり日和ってPrologで書いてみました。

p(X,Y):-X>=Y*Y->X mod Y=\=0,p(X,Y+1);X>1.

t(X):-X mod 10=\=3,(X>9->t(X//10);true).

a(1300).

a(X):-Y is X+1,(p(Y,2),t(Y)->C is 65;C is 97),Z is X mod 26+C,format('~c',Z),a(Y).

:-a(0).

こんな感じ。

１行目のp(X,Y)で素数の判定。XがYで割り切れればアウト判定。

　Yの２乗がXより大きい場合は、割り切れないことが確定なのですが、Xが１の場合のみ失敗。

　そうでない場合は、XをYで割った余りが0でなければ、XをY+1で割り切れるかトライする。

って感じで、１行に無理やりまとめてます。ここで、普通はやっちゃいけないのが

  p(X,Y+1) の部分。PrologではY+1と書くと、Y+1を演算した結果を渡すのではなく、+(Y,1)という項をそのまま渡してしまいます。よって、気をつけないととんでもないことになるのですが、文字数を減らすため、わざと項のままつっこんでます。これは、再度呼び出されたp(X,Y）のなかの条件式を評価する時に展開されます。

２行目のt(X)はXに３が含まれているかのテスト。これもかなり論理をいじってます。

　X を１０で割った余りが3でない場合（３で割れたらばfailして失敗）、Xが１０以上であれば、t(X//10)で10で割った値に対してトライします。Xが一桁ならtueで成功と。ここもわざとt(X//10)にして項の評価を後回しにしてます。

最後のa(X)で文字を出していきます。

1300文字出したら終了

1300文字までは、上記条件を満たすかどうかをp(X,Y),t(X)で判定して、満たしていれば大文字にしています。

普通にPrologで書くとこんな感じになると思います。
素数かつ、３を含まない場合には大文字で、そうでなければ小文字で出力。1301まできたら終了。そして、素数判定も、「３」がある判定もある意味、普通に書くとこんな感じでしょうね。

isPrime(1):-!,fail.        //1は特別扱い

isPrime(X):-isPrime1(X,2). //それ以外は２からの数で割り切れるかチェック

isPrime1(X,Y):-X < Y*Y.

isPrime1(X,Y):-X mod Y =:= 0 ,!,fail.

isPrime1(X,Y):-Y1 is Y + 1,

              isPrime1(X,Y1).

isInThree(X) :- X mod 10 =:= 3. //３で割り切れればtrue.

isInThree(X) :- X > 9 , !,      //割り切れない場合、10以上であれば

              X1 is X // 10,    //数を１０で割って、「３」があるかチェック

              isInThree(X1).

answer(1301).

answer(X) :- isPrime(X),

             not(isInThree(X)),

             Z is 65 + (X - 1) mod 26, //文字コードの計算です

             format('~c',Z),

             X1 is X + 1,

             answer(X1).

answer(X) :- Z is 97 + (X - 1) mod 26, //文字コードの計算です

             format('~c',Z),

             X1 is X + 1,

             answer(X1).

:-answer(1).

そして、最短になるまえに挫折した(笑)Cのソースもだしてみます。本当は１行に詰めてるんですが、読みにくいので適当に改行いれてます。

int n,i=1,f;

main(){

 for(;

      i<1301 p="">

      putchar((i++-1)%26+97-f*32)

      )

   for(n=f=i%10!=3&i/10%10!=3&i/100!=3&i>1;

        ++n

        f=i%n&&f

        );

exit(0);

}

for文のなかに初期化やその後の処理を無理やり詰めて、一文字でも短くしようとしています。セコイです。

２つめのforループですが素数判定と３があるかないかを判断しています。素数かつ３が含まれていない場合、f=1。そうでないならf=0として処理を進めます。

　まずfにiの中に３が含まれていれば０、含まれてなければ１となるように値を論理式で求めます。ここで、i=1つまりaの時は素数ではないのでむりやり０にします。そして、for文の処理のところ、f=i%n&&fで素数かどうかを判定しています。nは、iに３が含まれる時やi=1の時に０になっているので、いきなり１で割るかどうかを判定しちゃうのですが、すでにf=0となっているので、結果としては同じになるのです。わかりにくいですね。

　そして、２個目のfor文が終わるとputcharにはいって文字を出します。fの値によって大文字と小文字を判別します。

　まぁ、もっと短くなるようなので、参考程度に。