Prologで書くオセロ：読み切り編

前回からちょっと間が空きました。

実は、中間評価関数を使った簡単な次の一手を出す部分はすぐに作ってしまいました。これの詳細は後日だします。

今日は、とりあえず動いた完全読み切りの部分です。完全読み切りとは、ゲームの終盤ですべての手を探索して、最も石を多く取れる手を求めることです。

　完全読み切りでは、縦型探索のアルファベータ枝刈りというのが一般的ですが、今回は、アルファベータを行わず、単純に最大値を求めるだけにしました。
　ゲームなので、勝てば良いという意味では、勝てる手を見つけた時点で終了するというのもあります。これも今回入れてません。

上に「とりあえず」って書いたように、まだ手を入れたいところはあるのですけど、まずは動作レポートってことで。

　実行性能ですが、下記の一手目で7,8秒かかっている感じです(Core-M3 1.1GHz、ザクッというと12inch MAC BOOKです）。空きが９箇所なのでかなり遅いです。早くするだけなら２、３倍は軽く早くなると思いますが、所詮はこんなもんですよね。Prologだもん。

Game Playing

[teabn,white,[18,28,81,82,26,36,35,25,24,23,45,56,74,75,63,62,53,44,42,76,78,68,67,57,87,86,85,84,83,58,48,47,38],[37,46,73,34,33,21,32,31,41,51,61,64,65,52,54,43,66,16,15,14,13,55]]

   1  2  3  4  5  6  7  8

1  .  X X X X X  . O

2  .  .   X O X O  . O

3 X O X X O O X O

4 X O X O X X O O

5 X O O O X X O O

6 X O O X O X O O

7  .  .   X O O O .   O

8  O O O O O O O .
 [Coms move,72,-43]


こんな感じになります。白の手番で72が最善手、勝敗は-42なので大敗ですね（笑）。

ここで逆らって72ではなくたとえば77に置いたりすると、次の先手番でこういう評価になります。

[teabn,black,[18,28,81,82,26,36,35,25,24,23,45,56,63,62,53,44,42,78,68,87,86,85,84,83,58,48,38],[77,76,75,74,67,57,47,37,46,73,34,33,21,32,31,41,51,61,64,65,52,54,43,66,16,15,14,13,55]]

    1  2  3 4  5  6  7  8

1  .  X X X X X .  O

2  .    . X O X O .  O

3 X O X X O O X O

4 X O X O X X X O

5 X O O O X X X O

6 X O O X O X X O

7  .   . X X X X X O

8 O O O O O O O  . 
 [Coms move,88,44]


88を取ってさらに１個多く取れるようです。

　プログラムですが、読み切り用に書いた部分の概要を以下に示します。

(1)読み切り用のメイン部分
doYomikiri(Teban,Move,Eval,Black,White)
 Teban:今の手番 (入力)
 Move:最善手(戻り値)
 Eval:評価値（石数の差分、戻り値)
 Black:黒石の置き場所リスト(入力)
 White:白石の置き場所リスト(入力)

・ゲーム終了時は石を数えて、勝敗を確認
・パスの時は、相手の手番で読み切りを継続
・置ける場所がある時は、先読みを実行。以下を呼び出す。
  doYomikiri1(Teban,Black,White,MoveList,Move,Eval,CMove,CEval).


(2)読み切りのサブ：候補手を回して最善手を求める（１）
doYomikiri1(Teban,Black,White,MoveList,Move,Eval,CMove,CEval).
 Teban:今の手番 (入力)
 Black:黒石の置き場所リスト(入力)
 White:白石の置き場所リスト(入力)
 MoveList:石の置ける場所リスト(入力)
 Move:最善手(戻り値)
 Eval:評価値（石数の差分、戻り値)
 CMove:今までの最善手(入力)
 CEval:今までの最高評価値（石数の差分、入力)

・置く場所がなくなったら今までの最善手/評価を返します。
・置ける場所があれば、
　　- 石を置いて、Black , Whiteを更新(Black1,White1)
        - 相手番で読み切りを行う
　　　doYomikiri(Teban,Move,Eval,Black,White)
　　- 最善評価値は相手の最大値なので、符号を入れ替える
　　　相手の勝ちは自分の負けですから。。
　    - 現状での最善手/評価値を更新して、MoveListの残りを試す
　　　doYomikiri2(Teban,Black,White,Rest,Move,Eval,CMove,CEval,SEval,AMove)

(3)読み切りのサブ：最善手/評価値を入れ替えるため
doYomikiri2(Teban,Black,White,Rest,MoveList,Eval,CMove,CEval,SEval,AMove):-
Teban:今の手番 (入力)
 Black:黒石の置き場所リスト(入力)
 White:白石の置き場所リスト(入力)
 MoveList:石の置ける場所リスト(入力)
 Move:最善手(戻り値)
 Eval:評価値（石数の差分、戻り値)
 CMove:今までの最善手(入力)
 CEval:今までの最高評価値（石数の差分、入力)
 SEval:今探索した手の評価値（石数の差分、入力)
AMove:今探索した手(入力)

・今までの最高評価値(Ceval)と探索した手の評価値(SEval)を比較して、入れ替えて
doYomikiri1(Teban,Black,White,MoveList,Move,Eval,CMove,CEval)
　を呼び出します。

   こういうのも、　 () -> ; 的な処理で書いてもいいのですけど、個人的にはこうやって分けちゃうことが多いです。なんとなくPrologでif分的な処理を内部に入れたくないという思いだけなんですけどね。あはは。

　あと、ここで、SEvalが１より大きければ探索を終了するって書き方ができます。とりあえず勝つ手を返すので、処理が（かなり）早くなります。

で、アルファベータにするには、doYomikiri(Teban,Move,Eval,Black,White)でアルファ値とベータ値も入力にして引き回すことになります。ただし、述語の本体でif分書かないといけなくなりますので、今回やったように述語を分けて処理するとか、if分的構文を気分悪いけど突っ込むのか。いやはや、こういうのって苦手ですよね,Prologは。

 もちろんforall的に手と評価値のペア求めて最大値探してもいいんですが（つーかProlog的には綺麗なんだと思う）、それじゃ枝刈りできないですからねぇ（笑）。
　あぁ、やっぱりこういう枝刈りにはなんか向いてない気がします。

時間があったら、下のコードも少し直していきます。行き当たりばったりなので、ちょっと綺麗じゃないです。

中間評価関数は、この機構をそのまま使って、石の数数えるところで評価関数を呼べば、そのまま完成です。オセロの中間評価関数については、何十年も前からいろいろあります。
おまけだけど書いておきます。

・基本は、相手の着手数（盤上で置ける場所）を最小、自分の着手数最大になるようなところを選択していきます。

　相手の選択肢を限定することは、相手が置きたくない場所（次にカドや辺を取られる）に置かせるという意味や、カドを取って辺を伸ばしていくと相手にひっくり返されない場所が増える（相手の着手数が減ります）、さらに自分の選択肢も増えていくという意味があります。

・カドの取り合いには行くつか定石的な手順があるので、そういうのを織り込んでいくこともあります。

　これは、文章だと書きにくい（笑）、たとえば相手にわざとカドを取らせて、大きく取り返すみたいのがあります。


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

countBoard(black,Eval,Black,White):-

    getListSize(Black,BCount),

    getListSize(White,WCount),

    Eval is BCount - WCount.

countBoard(white,Eval,Black,White):-

    getListSize(Black,BCount),

    getListSize(White,WCount),

    Eval is WCount - BCount.

doYomikiri(Teban,0,Eval,Black,White):-

    isGameEnd(Black,White),!,

    countBoard(Teban,Eval,Black,White).

doYomikiri(black,0,Eval,Black,White):-

    isPass(black,Black,White),!,

    doYomikiri(white,_,WEval,Black,White),

    Eval is -1 * WEval.

doYomikiri(white,0,Eval,Black,White):-

    isPass(white,Black,White),!,

    doYomikiri(black,_,BEval,Black,White),

    Eval is -1 * BEval.

doYomikiri(Teban,Move,Eval,Black,White):-

    makePutList(Teban,Black,White,MoveList),

    doYomikiri1(Teban,Black,White,MoveList,Move,Eval,0,-100).

doYomikiri1(Teban,Black,White,[],Move,Eval,Move,Eval).

doYomikiri1(black,Black,White,[AMove|Rest],Move,Eval,CMove,CEval) :-

    doMove(black,AMove,Black,White,Black1,White1),

    doYomikiri(white,_,SEval,Black1,White1),

    SEval1 is -1 * SEval,

    doYomikiri2(black,Black,White,Rest,Move,Eval,CMove,CEval,SEval1,AMove).

doYomikiri1(white,Black,White,[AMove|Rest],Move,Eval,CMove,CEval) :-

    doMove(white,AMove,Black,White,Black1,White1),

    doYomikiri(black,_,SEval,Black1,White1),

    SEval1 is -1 * SEval,

    doYomikiri2(white,Black,White,Rest,Move,Eval,CMove,CEval,SEval1,AMove).

doYomikiri2(Teban,Black,White,Rest,Move,Eval,CMove,CEval,SEval,AMove):-

    CEval < SEval,!,

    doYomikiri1(Teban,Black,White,Rest,Move,Eval,AMove,SEval).

doYomikiri2(Teban,Black,White,Rest,Move,Eval,CMove,CEval,SEval,AMove):-

    doYomikiri1(Teban,Black,White,Rest,Move,Eval,CMove,CEval).

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の値によって大文字と小文字を判別します。

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

数独をPrologで解く

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

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

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

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

　これでなんとか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.

IchigoJamの変態BASIC

速度はかなり遅いIchigoJamです。8080の1Mhzより遅いような感じですからね。

ループカウンタを１０００くらい回すと１０秒近くかかります！？

そして、幾つか変態とも呼べる機能があるのです。

そのひとつが、GOTO文の飛び先に式を入れることができるという機能です。

つまり、

GOTO 100

ではなく

A=100

GOTO A

って感じで動いてしまうのです！？？

これを利用して、ハノイの塔をちょろっと書き換えます。

（リストは最後につけます）

なんとなんと、４つあったIF文がたった１つになっちゃいました！！！

この一個も頑張れば減らせそうなんですが、論理演算使ってやるのもどうかな？と思うので、やっていません。

　それにしても、手続きを記述するだけとは言え、IF文一個でハノイの塔って動いちゃうんですねぇ。あひゃひゃ。

　種明かしは、スタックフレームに、次に実行すべき行数を入れて、そこに飛んでいくっていうだけなんです。まぁ、なんかアセンブラで、飛び先を直接書き換えてジャンプするみたいな、本当に低級言語な機能だと思います（褒めてます）。

そして、似たような変態機能がまだあるので、それを使うと、もしかしたら、オセロくらいは作れるかもしれません。こっちの紹介も後日やってみようと思います。

　そうそう、IF文も減ったので、実行速度は通常版より３割か４割くらい早くなりました。でもね、お仕事でこういうプログラム書いちゃダメですよ！！！（笑）

　つーか、書いた本人以外には、理解できないこと間違いなしです！！

解析できた方は、是非とも連絡くださいませ。

10    PRINT"TOWER OF HANOI"

20    A=1:C=0

30    [4]=1000

40    INPUT"LEVEL:",B

50    [5]=B

60    [6]=0

70    [7]=2

80    [8]=1

100  IF[A*5]>1 GOTO 200

140  PRINT [A*5],":",[A*5+1],"->",[A*5+2]

150  C=C+1

160 A=A-1

170 GOTO [A*5+4]

200 [A*5+4]=300

210 A=A+1

220 [A*5]=[(A-1)*5]-1

230 [A*5+1]=[(A-1)*5+1]

240 [A*5+2]=[(A-1)*5+3]

250 [A*5+3]=[(A-1)*5+2]

260 GOTO 100

300 PRINT [A*5],":",[A*5+1],"->",[A*5+2]

310 C=C+1

320 [A*5+4]=160

330 A=A+1

340 [A*5]=[(A-1)*5]-1

350 [A*5+1]=[(A-1)*5+3]

360 [A*5+2]=[(A-1)*5+2]

370 [A*5+3]=[(A-1)*5+1]

380 GOTO 100

1000 PRINT"TOTAL:",C

1010 END

IchigoJamでプログラム書いてみた

教育用ワンボード？コンピュター、IchigoJamです。

使える言語はBASICのサブセット。変数はA-Zの26個の整数型と[0]-[99]の100個の整数型１次元配列。
　メモリは公称4kByteですが、メインが1K,そしてセーブエリアが1KX３つです。

BASIC自体が高校の頃以来なので、とても懐かしい！

そして、なぜか「ハノイの塔」を解くプログラムを書いてみた。
ハノイの塔は、Cとか再帰的呼び出しができる言語の特徴を説明するのに使われるわけなのですが、再帰っておいしいの？？って感じのBASICで書いてみます。

　とはいいつつつも、再帰以外の解法を考えるのが面倒なので、古の、再帰呼び出しを自分でコントロールするBASICプログラムです。

塔には0,1,2とIDを振って、そこに置かれる円盤は、数字のIDが付いているものとして、円盤を動かす操作をプリントすることで解法を出力することにします。たとえば、円盤１を０から２へ動かすのは

1:0->2

とします。
　できたプログラムを動かすとこんな感じです。

　

再帰的呼び出しをコントロールするのには、１次元配列をつかって、ローカルスタックフレームを作ります。
　ナイーブに作ったリストはこんな感じ。

10    PRINT"TOWER OF HANOI"

20    A=1

30    C=0

40    INPUT"LEVEL:",B

50    [5]=B

60    [6]=0

70    [7]=2

80    [8]=1

90    [9]=0

100  IF A<1 1000="" goto="" p="">

110  IF[A*5+4]=2 GOTO 500

120  IF[A*5+4]=1 GOTO 300

130  IF[A*5]>1 GOTO 200

140  PRINT [A*5],":",[A*5+1],"->",[A*5+2]

150  C=C+1

160  A=A-1

170 GOTO 100

200 [A*5+4]=1

210 A=A+1

220 [A*5]=[(A-1)*5]-1

230 [A*5+1]=[(A-1)*5+1]

240 [A*5+2]=[(A-1)*5+3]

250 [A*5+3]=[(A-1)*5+2]

260 [A*5+4]=0

270 GOTO 100

300 PRINT [A*5],":",[A*5+1],"->",[A*5+2]

310 C=C+1

320 [A*5+4]=2

330 A=A+1

340 [A*5]=[(A-1)*5]-1

350 [A*5+1]=[(A-1)*5+3]

360 [A*5+2]=[(A-1)*5+2]

370 [A*5+3]=[(A-1)*5+1]

380 [A*5+4]=0

390 GOTO 100

500 A=A-1

510 GOTO 100

1000 PRINT"TOTAL:",C

1010 END

ゲームマーケット2015

こどもの日にあったゲームマーケットです。
会場はビッグサイトの西2会場。L字型になっていてとにかく広い。前回より通路スペースやテーブルの間がゆったりしています。準備中なのでガラガラの状態がこれです。

ブースはこんな感じです。

開始３０分で会場は凄い人。かなり広いはずなのに。。。あっとう間にこんな感じ。

プレイエリアも常に回転中で、こんな感じ。

ほとんど休みなしで、他のブースはちょっとみただけで終了しちゃいました。

毎回、人数は増えているみたいです。次もこないとね。