ポケモンGO:卵の検証実験

12月から新しいポケモンが卵から出てくるようになりました。そして、26日からはその出現比率が変更になったようでございます。

　そういう意味ではもう不要かもしれないけど、せっかく実験したので、その結果をレポートしてみます。

卵	孵化した数	新しいポケモン	ヒット率	卵の出現率
2km	19	1	5.3%	18.1%
5km	78	2	2.6%	74.3%
10km	8	3	37.5%	7.6%
合計	105	6	5.7%

孵化装置使いまくって、12/14から12/25までの12日間で105個の卵を孵化させました！

で、新しいポケモンは７種類中５種類出ました。

　ププリン、ピチューX２、ブビィ、エレキッド、ムチュール

です。

　いやぁ、シンドイ話でございます。5kmx78ってことは２週間弱で軽く60kmは歩いたってことになりそうですよ。そして、5.7%という出現率にはちょっと呆れちゃいますね。どんだけ出ないんだって話です。孵化装置なしで毎日卵を１つ孵化させたとして、105日で6体！！ってどんだけって話ですわ。ナイアンテックによる孵化装置課金への罠ですが、これじゃ効率悪くないっすか？

　おまけですが、2km/5km/10kmの出現比率も概ね2/7/1って感じみたいですね。もしかすると2/8.5/0.5くらいかもしれません。

そして、26日から卵の出現率が変化したらしいという情報があります。今日拾った卵ですが、2km/5km/10kmで2/5/4という状況です。11個ではサンプルとしては少なすぎますが、10km卵の出現数が大幅にアップしてます！！！

　けどね、返すまでの距離もだいぶ増えちゃうわけなので、それでカイロスなんか出た日にはもうガッカリですわな。

100個孵化させた時点で課金やめてまったりにしようと思ってたのですが、もしかしたらもう少しだけ課金して、せめて50個くらいはサンプルとってみようかな。

4代目Bluetoothイヤホン

今まで使っていたSONYのMDR-EX31BNがだいぶくたびれてきたので、新しい機種に変えることに。
　同じSONYのMDR-1000にしようかとも思ったのだけど、ヘッドホンタイプを電車の中で使うのにはどうしても抵抗感があるのでござる。おっさんだからね。

　実はノイズキャンセルがついてることが必須なので、機種も絞られてきます。

オーディオテクニカのはその前に使ってたんだけど、断線２回やらかしたので、もうちょっと選びたくない。
BOSEのQC30にしようかとも思ったのだけど、売り切れてしばらくは手に入らないみたい。で、JBLのEVEREST elite100ってのを試そうと思いましたのです。

秋葉原の量販店で現物を確認、アンド試聴。音はすごくよい。ノイズキャンセルがちょっと弱い感じだけど、お買い上げ。

で、実際に試してみると、ノイズキャンセルの効果が弱く今持ってるEX31の方が良く効く感じ。で、イヤーピースの交換を試みてみた。
　EX31のと交換するだけでも効果があるので、SONY製のイヤーピースをM/Lでお買い上げ。でもね、なんか収まりが悪い？？？で、色々調べてCOMPLYのイヤーピースを試してみた。大きさがわからないので最初はLにしてみた。
　これは、昔からある耳栓、潰して耳に入れると形が復元して耳の中でぴったり収まるやつのイヤーピース版。なので、収まりも良く取れにくい。そして遮音性も高い！

　Lだとちょっと大きい感じだったので、Mを試したところいい感じに落ち着きました。

SONYの２種類、COMPLY２種類でなんと8K円くらい消費。馬鹿みたいだけど、これで通勤電車も快適になりそう。

MAC OS vs WINDOWS その２

MacBook(2015)にパラレルズ仕込んでWINDOWS10動かしました。普通にサクサク動いてるよ。これで解決したような気がするです。


　でもって、iPadの新型は発表されなかったので、iPad mini4を狙うか、アンドロイドで行くか思案中。旧式ゲーム機のエミュレータなんかは明らかにアンドロイド。そしてGUIの良さや基本能力の高さはiPadだね。で、７インチの軽さと横幅による使いやすさと、miniとの対比になるね。
　ま、もうしばらく様子見てからかなぁ。iPad Air2もあることだし、無理に乗り換えるのもちょっとね。

やっぱりWINDOWSは・・・

8月くらいからしばらく、メインをWINDOWS10にしてました。
一応マルチウィンドウもできるし、CPU的には2015のMACBOOKより速いかな？って思ってたんだけど、元に戻しちゃいました。てへへ。

　MACのスライドパッドがなんといっても使いやすすぎるのが一番。そしてターミナルも使いやすいしね。

　WINDOWSで使いたいソフトも若干あるので、仮想化でもいれようなかなぁ。できればその時には512GBくらいストレージ領域が欲しいけど。

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

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