Clojureで三目並べ

Lisp Advent Calendar 2012
6日目の記事です。

三目並べ

ここでは三目並べソルバについて書きます。

tic tac toe

三目並べ、すなわち◯×ゲームです。
小学生の頃とかやってました。
このゲームは両者が最善を尽せば必ず引分けになるゲームで、その最善手もわかりやすいので他人とやってもだいたいドローになります。

この三目並べで盤面から次の手を返すプログラムを、ClojureとClojureScriptの両方で動くように作成します。

core.logic

今回は論理プログラミングでこのパズルを解きます。

最初にnamespaceですが、ClojureとClojureScriptの両方で動かす為に、多少の黒魔術があります。

	(ns tic-tac-toe.core
	(:refer-clojure :exclude [==])
	;*CLJSBUILD-REMOVE*;(:use-macros [cljs.core.logic.macros :only [defna matcha conda conde fresh project ==]])
	)
	;*CLJSBUILD-REMOVE*;(comment
	(use '[clojure.core.logic :only [defna matcha conda conde fresh project ==]])
	;*CLJSBUILD-REMOVE*;)

view raw ns.clj hosted with ❤ by GitHub

;*CLJSBUILD-REMOVE*;はcljsbuildがビルド時に削除してくれるコメントです。
core.logicがclj版とcljs版で違うnamespaceを使っているのでこうなっています。

盤面で、空いているところはnilとします。
not-nil?という述語を作るために、!=を使いたいところですがcljs版に存在しないのでprojectを使います。

	(defn not-nil? [m]
	(project [m] (== (nil? m) false)))

view raw not-nil.clj hosted with ❤ by GitHub

projectはcore.logicで使われている変数にあたるものから値を取り出します。

盤面が空いていたらコマを置く述語write。

	(defna write [s m q]
	([s nil q] (== q s)))

view raw write.clj hosted with ❤ by GitHub

コマが2連続で続いていたら自分であろうと相手であろうと決着します。
そのため、コマを優先して置く述語checkを定義します。

	(defn check [s
	m1 m2 m3
	q1 q2 q3]
	(matcha [m1 m2 m3]
	([m nil m] (conda [(not-nil? m) (== q2 s)]))
	([nil m m] (conda [(not-nil? m) (== q1 s)]))
	([m m nil] (conda [(not-nil? m) (== q3 s)]))))

view raw check.clj hosted with ❤ by GitHub

これで補助の述語の定義は終りです。
あとは愚直に盤面を検査します。

	(defn play [q s
	m11 m12 m13
	m21 m22 m23
	m31 m32 m33]
	(fresh [q11 q12 q13
	q21 q22 q23
	q31 q32 q33]
	(== q [q11 q12 q13
	q21 q22 q23
	q31 q32 q33])
	(conda [(check s m21 m22 m23 q21 q22 q23)]
	[(check s m12 m22 m32 q12 q22 q32)]
	[(check s m11 m12 m13 q11 q12 q13)]
	[(check s m31 m32 m33 q31 q32 q33)]
	[(check s m11 m21 m31 q11 q21 q31)]
	[(check s m13 m23 m33 q13 q23 q33)]
	[(check s m11 m22 m33 q11 q22 q33)]
	[(check s m13 m22 m31 q13 q22 q31)]
	[(write s m22 q22)]
	[(write s m12 q12)]
	[(write s m21 q21)]
	[(write s m23 q23)]
	[(write s m32 q32)]
	[(write s m11 q11)]
	[(write s m13 q13)]
	[(write s m31 q31)]
	[(write s m33 q33)])))

view raw play.clj hosted with ❤ by GitHub

checkやwriteの順番を並べ変えると強くなったり弱くなったりします。
ここではなるべく中心にコマを置くように書いています。

盤面から次の手を返す述語が定義できました。
もう1つ、ゲームが終了したか調べる述語も定義します。

	(defna complete [b m1 m2 m3]
	([b s s s] (== b s)))
	(defn end [q
	m11 m12 m13
	m21 m22 m23
	m31 m32 m33]
	(conde [(complete q m11 m12 m13)]
	[(complete q m21 m22 m23)]
	[(complete q m31 m32 m33)]
	[(complete q m11 m21 m31)]
	[(complete q m12 m22 m32)]
	[(complete q m13 m23 m33)]
	[(complete q m11 m22 m33)]
	[(complete q m13 m22 m31)]))

view raw end.clj hosted with ❤ by GitHub

実際の使い方はこんな感じ。

	(run* [q] (play q :x
	:o nil :x
	:x :o nil
	:o :o :x))
	; ([_.0 :x _.1
	; _.2 _.3 _.4
	; _.5 _.6 _.7])
	(run* [q] (end q
	:o :x :x
	:o :x :o
	:o :o :x))
	; (:o)

view raw result.clj hosted with ❤ by GitHub

敵味方の区別をつけていないので思った通りの手が返ってきていませんが、勝てないというのもつまらないのでこのままにします(手抜き)。

これらの関数を使い、ゲームのロジックを書きます。

	(ns tic-tac-toe.game
	(:require [tic-tac-toe.core :as core])
	;*CLJSBUILD-REMOVE*;(:use-macros [cljs.core.logic.macros :only [run*]])
	)
	;*CLJSBUILD-REMOVE*;(comment
	(use '[clojure.core.logic :only [run*]])
	;*CLJSBUILD-REMOVE*;)
	(def number 3)
	(def window-size (* number 100))
	(def panel-size (/ window-size number))
	(def font-size (/ window-size 5))
	(def radius (/ panel-size 2))
	(defrecord Panel [x y sym])
	(defprotocol Canvas
	(draw-circle [this panel])
	(draw-cross [this panel])
	(draw-text [this text]))
	(defprotocol Symbol
	(draw [this canvas panel]))
	(def o
	(reify Symbol
	(draw [this canvas panel]
	(draw-circle canvas panel))))
	(def x
	(reify Symbol
	(draw [this canvas panel]
	(draw-cross canvas panel))))
	(def finish? (atom false))
	(def panels
	(for [x (range number) y (range number)]
	(Panel. (* x panel-size)
	(* y panel-size)
	(atom nil))))
	(defn syms []
	(map (comp deref :sym) panels))
	(defn finish [canvas s]
	(draw-text canvas s)
	(reset! finish? true))
	(defn write [canvas panel sym]
	(when-not @finish?
	(reset! (:sym panel) sym)
	(draw sym canvas panel)
	(if-let [result (first (run* [q] (apply core/end q o (syms))))]
	(if (= result o)
	(finish canvas "Win")
	(finish canvas "Lose"))
	(when (every? (comp not nil?) (syms))
	(finish canvas "Draw")))))
	(defn play [canvas panel]
	(when-not @(:sym panel)
	(doto canvas
	(write panel o)
	(write (-> (run* [q] (apply core/play q x (syms)))
	first
	(zipmap panels)
	(get x))
	x))))

view raw game.clj hosted with ❤ by GitHub

Canvasプロトコルを実装し、play関数を各パネルをクリックした時のhandlerとして登録することで動きます。

JavaFXによる実装とgoog.graphicsによる実装を書きました。

雑感

core.logicによる論理プログラミングは慣れていないせいか、とても頭をつかいました。
完成したコードは愚直だけれど分かり易いものになりました。
こういった書き方が出来ることが論理プログラミングの1つの利点でもあると思います。

ゲームのロジックに関してはあまり綺麗に書けなかったのですが、各ライブラリと協調できるうまい書き方を知りたいものです。