Konst

この記事はScalaz Advent Calendarの20日目の記事です。

ScalaにはFunction.constという常に一定の値を返す関数があります。

	val one = Function.const(1)_
	one(2) assert_=== 1
	one("hoge") assert_=== 1

view raw const.scala hosted with ❤ by GitHub

この関数を型レベルで表したものがScalazにKonstとして定義されています。

Konst

NaturalTransformationを例にKonstを使ってみます。

	new (List ~> Option) {
	def apply[A](list: List[A]) = list.headOption
	}
	new (List ~> Konst[Int]#Apply) {
	def apply[A](list: List[A]) = list.size
	}
	new (Konst[String]#Apply ~> Konst[Int]#Apply) {
	def apply[A](string: String) = string.size
	}

view raw konst.scala hosted with ❤ by GitHub

あまり使わなさそうですね！
私としてはまだScalaz6にあったPartialApplyの方が便利な気がするのですが。
まあ、型推論がうまくいかなかったり、Unapplyが新しく入ったりしたことが原因にあるのでしょうね。

Scalazのかきかた

@halcat0x15a あれ(´・ω・｀)？じゃあsyntaxの説明記事お願いします！
— Kenji Yoshidaさん (@xuwei_k) 12月 16, 2012

というわけで、Scalaz Advent Calendarの18日目の記事です。

Scalazには多くの型クラスとそのインスタンスが定義されており、それを扱うために、多くの記法が存在します。
この記事では簡単で冗長な記法から、複雑で簡素な記法まで紹介していきます。

インスタンスの取得

implicit valueとして定義されている型クラスのインスタンスは、implicit parameterにより取得が可能です。

そのインスタンスの取得にも様々方法があります。

implicitly

Scala標準ライブラリに定義されている、implicit valueを取得する関数です。

	import std.option._
	val map = Map('foo -> "bar", 'hoge -> "fuga")
	implicitly[Apply[Option]].apply2(map get 'foo, map get 'hoge)(_ + _)

view raw implicitly.scala hosted with ❤ by GitHub

TypeClass

また、Scalazの型クラスにはインスタンスの取得のための関数、TypeClass.applyを使用することができます。

Apply[Option].apply2(map get 'foo, map get 'hoge)(_ + _)

view raw apply.scala hosted with ❤ by GitHub

関数呼び出し

ある型クラスの関数を使用するとき、先ほどのようにインスタンスから直接呼び出すことができます。

	import std.list._
	Bind[List].join(List(List(1, 2), List(3, 4)))

view raw join.scala hosted with ❤ by GitHub

Ops

しかし、明示的に型クラスのインスタンスを取得するのは冗長です。
Scalazではimplicit conversionを用いて、型クラスのインスタンスをもつオブジェクトに対して暗黙の型変換を提供します。

	import scalaz.syntax.bind._
	List(List(1, 2), List(3, 4)).join

view raw ops.scala hosted with ❤ by GitHub

暗黙型変換の他にも、単一のオブジェクトを対象としない型クラスの関数がインポートされます。

	import scalaz.std.anyVal._
	Monoid[Int].zero
	import scalaz.syntax.monoid._
	mzero[Int]

view raw zero.scala hosted with ❤ by GitHub

関数定義

関数を定義するとき、implicit parameterを指定する方法が２つあります。

implicit

1つはimplicitを使う方法です。

	def double[A](a: A)(implicit A: Semigroup[A]) =
	A.append(a, a)

view raw double.scala hosted with ❤ by GitHub

Context Bounds

もう1つ、Context Boundsというものが存在します。

	def doubleCB[A: Semigroup](a: A) =
	Semigroup[A].append(a, a)

view raw contextbounds.scala hosted with ❤ by GitHub

インスタンスを明示的に扱わない場合はContex Boundsで定義した方が良いでしょう。

def doubleCBS[A: Semigroup](a: A) = a |+| a

view raw contextboundsops.scala hosted with ❤ by GitHub

Syntax

大抵の場合の場合はOpsとContex Boundsで短いコードが得られますが、これらを使っても冗長になる場合があります。

	def zeroTrio[A: Monoid] =
	(mzero[A], mzero[A], mzero[A])
	import scalaz.syntax.pointed._
	def nestPoint[M[_]: Pointed, A](a: A) =
	a.point[M].point[M]

view raw morph.scala hosted with ❤ by GitHub

Scalaでは返り値の型を指定してもimplicit valueを決定することは出来ないので明示的に型を書く必要があります。
このような場合、Syntaxを使うことで明示的に型を指定する必要がなくなります。

	def zeroTrioS[A](implicit A: Monoid[A]) = {
	import A.monoidSyntax._
	(mzero, mzero, mzero)
	}
	def nestPointS[M[_], A](a: A)(implicit M: Pointed[M]) = {
	import M.pointedSyntax._
	point(point(a))
	}

view raw syntax.scala hosted with ❤ by GitHub

まとめ

短く簡素なコードになるほど、複雑な仕組みが使われていきます。
大抵のものはContex BoundsとOpsで短いコードになるので、積極的に使っていきましょう。
型クラスのインスタンスから直接関数を呼ぶのも良いですが、Syntaxをimportした方が簡素になる場合があることも頭に入れておくと良いでしょう。

JavaFX & Web Start with Clojure

This article is the 5th of JavaFX Advent Calendar and a sequel of Tic-tac-toe with Clojure.

Tic-tac-toe

Since the logic of the game have been made, we only need to implement at the drawing.

Application

As the basis for JavaFX, inherit javafx.application.Application to the main class.

In order to compile the class files of Java, we use the gen-class.

	(ns tic-tac-toe.main
	(:refer-clojure :exclude [==])
	(:use [clojure.core.logic])
	(:require [tic-tac-toe.game :as game])
	(:gen-class
	:extends javafx.application.Application)
	(:import
	[javafx.application Application]
	[javafx.scene Scene Group]
	[javafx.event EventHandler]
	[javafx.scene.canvas Canvas]
	[javafx.scene.shape Rectangle Circle Line]
	[javafx.scene.text Text Font]
	[javafx.scene.paint Color]))

view raw ns.clj hosted with ❤ by GitHub

In the main method calls Application.launch.

	(defn -main [& args]
	(Application/launch tic_tac_toe.main args))

view raw main.clj hosted with ❤ by GitHub

In the start method implements tic-tac-toe.game.Canvas and register the handler in each panel.

	(defn -start [this stage]
	(let [root (Group.)
	scene (Scene. root)
	children (.getChildren root)
	canvas (reify game/Canvas
	(draw-circle [this panel]
	(.add children
	(Circle. (+ (:x panel) game/radius)
	(+ (:y panel) game/radius)
	game/radius)))
	(draw-cross [this panel]
	(let [{:keys [x y]} panel
	x' (+ x game/panel-size)
	y' (+ y game/panel-size)]
	(doto children
	(.add (Line. x y
	x' y'))
	(.add (Line. x' y
	x y')))))
	(draw-text [this s]
	(.add children
	(doto (Text. 0 game/font-size s)
	(.setFont font)
	(.setFill Color/GRAY)))))]
	(doseq [panel game/panels]
	(.add children
	(doto (Rectangle. (:x panel)
	(:y panel)
	game/panel-size
	game/panel-size)
	(.setFill Color/WHITE)
	(.setStroke Color/BLACK)
	(.setOnMouseClicked (reify EventHandler
	(handle [this event]
	(game/play canvas panel)))))))
	(doto stage
	(.setTitle "Tic Tac Toe")
	(.setScene scene)
	(.setMinHeight game/window-size)
	(.setMinWidth game/window-size)
	(.setResizable false)
	(.show))))

view raw start.clj hosted with ❤ by GitHub

doto is useful when using the GUI library in Clojure.
We can run continuously some methods under the instance.
It is like the instance_eval in Ruby.

Such an interface as EventHandler is obtained an instance by using reify.

Web Start

First, make a standalone jar file with lein2 uberjar.

Then create a jnlp file.

	<?xml version="1.0" encoding="UTF-8"?>
	<jnlp spec="1.0+" xmlns:jfx="http://javafx.com" codebase="http://halcat0x15a.github.com/tic-tac-toe/" href="tic_tac_toe.jnlp">
	<information>
	<title>Tic Tac Toe</title>
	<vendor>baskingcat</vendor>
	<homepage href="http://halcat0x15a.github.com/tic-tac-toe/"/>
	<description>tic tac toe</description>
	<offline-allowed />
	</information>
	<security>
	<all-permissions />
	</security>
	<resources>
	<j2se version="1.7+" />
	<jar href="target/tic-tac-toe-0.1.0-SNAPSHOT-standalone.jar" main="true" />
	</resources>
	<application-desc main-class="tic_tac_toe.main"></application-desc>
	</jnlp>

view raw jnlp.xml hosted with ❤ by GitHub

The all-permissions are needed to run Clojure.

We must make a signature, because it requires all-permissions.

You can make the keystore by keytool, and sign the jar using jarsigner.

keytool -genkey -keystore foo -alias bar
jarsigner -keystore foo target/tic-tac-toe-0.1.0-SNAPSHOT-standalone.jar bar

You can start with Web Start.

If you try on local environment, rewrite the codebase of jnlp file.

Miscellaneous Thoughts

I think that JavaFX is simpler than Swing and we would be able to write the GUI application easily.

But I felt that the Web Start is not suitable for other required language runtime, such as the Scala and Clojure.
Because file size becomes very large.

UndoT

この記事はScalaz Advent Calendarの15日目の記事です。

scalazのcoreのjarに含まれ、独自のパッケージが存在しながらも、全く話題に上がらないundoについて書きます。

scalaz.undo以下にはUndoTとHistoryの2つのデータ型があります。

UndoはHistoryを状態とするStateモナドで、Historyはundo, redoの為のListと、currentのデータを持ちます。

例を作ってみます。

	import scalaz._, Scalaz._
	import scalaz.effect._, IO._
	object Undo extends SafeApp {
	import scalaz.undo._, UndoT._
	override def runc = for {
	(s1, s2) <- (for {
	_ <- hput[IO, String]("hello")
	_ <- hput[IO, String]("world")
	current = UndoT(get[History[String]].lift[IO])
	h1 <- undo[IO, String] >> current
	h2 <- redo[IO, String] >> current
	} yield h1.current -> h2.current).eval("initialize")
	_ <- putStrLn(s1) >> putStrLn(s2)
	} yield ()
	}

view raw undo.scala hosted with ❤ by GitHub

この時、Historyはこのように変遷しています。

History("initialize", Nil, Nil) // eval("initialize")
History("hello", List("initialize"), Nil) // hput("hello")
History("world", List("hello", "initialize"), Nil) // hput("world")
History("hello", List("initialize"), List("world")) // undo
History("world", List("hello", "initialize"), Nil) // redo


これを使っているユーザーがどれだけいるのか気になるところです。

これだけでは物足りないと思ったので、MonadStateについて書こうと思いましたが、UndoTのMonadStateのインスタンスの定義がおかしい気がする。

なので今日はpull requestを投げて終わります。

Codensity

この記事はScalaz Advent Calendarの13日目の記事です。

Codensityについてググると、

The Mother of all Monads

という記事が見つかる。
Codensityは継続モナドとほぼ同じものみたい。

この記事にある例をScalaで書いてみる。

	def i[F[+_]: Monad, A](a: F[A]) = new Codensity[F, A] {
	def apply[B](f: A => F[B]) = a >>= f
	}

view raw i.scala hosted with ❤ by GitHub

Option

	val map = Map('foo -> "bar", 'hoge -> "fuga")
	(for {
	x <- i(map get 'foo)
	y <- i(map get 'hoge)
	} yield x + y).improve assert_=== Some("barfuga")

view raw option.scala hosted with ❤ by GitHub

Disjunction

	type StrDisj[+A] = String \/ A
	(for {
	x <- i[StrDisj, String]((map get 'foo) \/> "foo")
	y <- i[StrDisj, String]((map get 'baz) \/> "baz")
	} yield x + y).improve assert_=== "baz".left

view raw disj.scala hosted with ❤ by GitHub

なるほど。
CodensityがOptionやDisjunctionとして動く。

でもこれってIdTじゃ(ry

Codensityは継続モナドのようなもの、ということで継続らしい例を書いてみる。

iprintで、計算の経過を表示する。

	def iprint[F[+_]: Monad, A](a: F[A]) = new Codensity[F, A] {
	def apply[B](f: A => F[B]) = {
	println(a)
	a >>= f
	}
	}
	(for {
	x <- iprint(map get 'foo)
	y <- iprint(map get 'baz)
	} yield x + y).improve assert_=== None

view raw iprint.scala hosted with ❤ by GitHub

Some(bar)とNoneが表示される。

継続を破棄するbreakを定義し、for式で使ってみる。

	def break[F[+_]: PlusEmpty, A] = new Codensity[F, A] {
	def apply[B](f: A => F[B]) = PlusEmpty[F].empty[B]
	}
	(for {
	x <- iprint(map get 'foo)
	_ <- break[Option, String]
	y <- iprint(map get 'hoge)
	} yield x + y).improve assert_=== None

view raw break.scala hosted with ❤ by GitHub

Some(bar)だけが表示される。

無事、計算が破棄された。

Codensityはあるモナドにおいて計算量を減らせることがわかった。
他にも何か出来そうだが、わたしが思いついたのはこれくらい。

Injectiveを考える

この記事はScalaz Advent Calendarの9日目の記事です。

この記事に書いてあることは役にたたないと思うので、あまり気合を入れて読まないでください。

Injective

Scalazには、Injectively, Injective1 ~ Injective5が定義されている。
よくわからない。

Injectiveをググってみると、どうやら単射のことっぽい。

Injectiveは型パラメータをとる型を型引数にとる。
つまり、種(カインド)が* -> *や、* -> * -> *である型が単射であるいう制約をつけるものではないかと考えた。

とりあえずInjectiveの例を列挙してみる。

List

	def f[M[_]: Injective, A](m: M[A]) = m
	object ListInjective extends Injective[List]
	f(List(0))(ListInjective)

view raw list.scala hosted with ❤ by GitHub

ふつうに定義できる。

type member

Hoge#Fは未定義なので、インスタンスの供給は出来ない。

	trait Hoge {
	type F[A]
	def f[A](a: A): F[A]
	}
	val optionHoge = new Hoge {
	type F[A] = Option[A]
	def f[A](a: A) = Option(a)
	}
	object HogeInjective extends Injective[Hoge#F]
	/* f(optionHoge.f(0))(HogeInjective) */ // Compile Error

view raw member.scala hosted with ❤ by GitHub

dependent method types

	def hogeInjective(hoge: Hoge) = new Injective[hoge.F] {}
	f(optionHoge.f(0))(hogeInjective(optionHoge))

view raw depend.scala hosted with ❤ by GitHub

明示的にインスタンスを渡す必要はあるが、コンパイルすることは可能。


ふむ、よくわからない。

単射にならない型がもしあるのだとしたら、F[_]に対して、ある型Aを渡した時にコンパイルが通らないということだろうか。
ということは、F[_]がとりうる型に対して制約をかければよいということだろう。

次のような例を書いた。

	trait Foo
	trait Bar[F <: Foo]
	/* object BarInjective extends Injective[Bar] */ // Compile Error

view raw injective.scala hosted with ❤ by GitHub

なるほど。
確かに、単射ではないからInjectiveのインスタンスが定義出来ない。

Injectiveの意味がようやく理解できた。

InjectiveはLiskovのコードで使われているが、まあ、よくわからない。
わからなくても、この先困るということもないと思う。

ClojureでJavaFX & Web Start

JavaFX Advent Calendar 2012
5日目の記事です。

三目並べ

Cojureで三目並べの続き。

ここでは三目並べのJavaFX実装について書きます。

ゲームのロジックは作ってあるのであとは描画のところを実装するだけ。

Application

JavaFXの基本として、メインクラスにjavafx.application.Applicationを継承します。

ここではgen-classを使って、Javaのclassファイルにコンパイルします。

	(ns tic-tac-toe.main
	(:refer-clojure :exclude [==])
	(:use [clojure.core.logic])
	(:require [tic-tac-toe.game :as game])
	(:gen-class
	:extends javafx.application.Application)
	(:import
	[javafx.application Application]
	[javafx.scene Scene Group]
	[javafx.event EventHandler]
	[javafx.scene.canvas Canvas]
	[javafx.scene.shape Rectangle Circle Line]
	[javafx.scene.text Text Font]
	[javafx.scene.paint Color]))

view raw ns.clj hosted with ❤ by GitHub

mainメソッドではApplication.launchを呼び出します。

	(defn -main [& args]
	(Application/launch tic_tac_toe.main args))

view raw main.clj hosted with ❤ by GitHub

あとはstartメソッドでtic-tac-toe.game.Canvasを実装し、各パネルにhandlerを登録します。

	(defn -start [this stage]
	(let [root (Group.)
	scene (Scene. root)
	children (.getChildren root)
	canvas (reify game/Canvas
	(draw-circle [this panel]
	(.add children
	(Circle. (+ (:x panel) game/radius)
	(+ (:y panel) game/radius)
	game/radius)))
	(draw-cross [this panel]
	(let [{:keys [x y]} panel
	x' (+ x game/panel-size)
	y' (+ y game/panel-size)]
	(doto children
	(.add (Line. x y
	x' y'))
	(.add (Line. x' y
	x y')))))
	(draw-text [this s]
	(.add children
	(doto (Text. 0 game/font-size s)
	(.setFont font)
	(.setFill Color/GRAY)))))]
	(doseq [panel game/panels]
	(.add children
	(doto (Rectangle. (:x panel)
	(:y panel)
	game/panel-size
	game/panel-size)
	(.setFill Color/WHITE)
	(.setStroke Color/BLACK)
	(.setOnMouseClicked (reify EventHandler
	(handle [this event]
	(game/play canvas panel)))))))
	(doto stage
	(.setTitle "Tic Tac Toe")
	(.setScene scene)
	(.setMinHeight game/window-size)
	(.setMinWidth game/window-size)
	(.setResizable false)
	(.show))))

view raw start.clj hosted with ❤ by GitHub

ClojureでGUIライブラリを使うときに便利なのがdoto。
あるインスタンスのもとで、メソッドを連続して実行することが出来ます。
Rubyのinstance_evalのようなものですね。

EventHandlerなどのインターフェースはreifyを使うことで実体を得られます。

Web Start

JavaFX Script時代にはいくつかWeb Startのアプリケーションを作ったことが
ありましたが、JavaFX 2になってからは初のWeb Startです。

まずは、lein2 uberjarでstandaloneなjarを作ります。
20MBもあるのはClojure+JavaFXのclassファイルが入ってる所為です。

次にjnlpですが、こんな感じになりました。

	<?xml version="1.0" encoding="UTF-8"?>
	<jnlp spec="1.0+" xmlns:jfx="http://javafx.com" codebase="http://halcat0x15a.github.com/tic-tac-toe/" href="tic_tac_toe.jnlp">
	<information>
	<title>Tic Tac Toe</title>
	<vendor>baskingcat</vendor>
	<homepage href="http://halcat0x15a.github.com/tic-tac-toe/"/>
	<description>tic tac toe</description>
	<offline-allowed />
	</information>
	<security>
	<all-permissions />
	</security>
	<resources>
	<j2se version="1.7+" />
	<jar href="target/tic-tac-toe-0.1.0-SNAPSHOT-standalone.jar" main="true" />
	</resources>
	<application-desc main-class="tic_tac_toe.main"></application-desc>
	</jnlp>

view raw jnlp.xml hosted with ❤ by GitHub

all-permissionsになっているのはClojureを実行するためです。
多分JRubyやGroovyでもall-permissionsが必要になるはず。

all-permissionsを要求するので、署名をしなければなりません。
keytoolで適当なkeystoreを作ります。

keytool -genkey -keystore foo -alias bar

fooというファイルが作られるので、jarsignerを使ってjarに署名します。

jarsigner -keystore foo target/tic-tac-toe-0.1.0-SNAPSHOT-standalone.jar bar

これでWeb Startで起動できます。
実際に試す場合はjnlpファイルのcodebaseを

codebase="file:/home/halcat0x15a/tic-tac-toe/"

のように書き替え、

javaws tic_tac_toe.jnlp

で実行可能です。

雑感

このプログラムではたいしたことをしていませんが、JavaFXのおかげで、Swingよりもシンプルで簡単にGUIを書けるようになったと思います。
他のGUIライブラリと比べても、ライブラリの設計は格段に良くなったと感じます。

Web Startは、ScalaやClojureなどのランタイムが他に必要な言語にはあまりむかないのかなと感じました。
プログラム+ライブラリ+ランタイムとなると、かなりファイルサイズが大きくなってしまいます。

ClojureScriptでgoog.graphics

altjs Advent Calendar 2012
5日目の記事です。

三目並べ

Cojureで三目並べの続き。

ここでは三目並べのClojureScriptによる実装について書きます。

ゲームのロジックは作ってあるのであとは描画のところを実装するだけ。

goog.graphics

描画にはgoog.graphicsを使うことにします。

ClojureScriptはGoogle Closure Libraryで実装されており、nsでJavaScriptのライブラリをrequireすることが出来ます。

	(ns tic-tac-toe.main
	(:require [cljs.core.logic :as logic]
	[tic-tac-toe.game :as game]
	[goog.dom :as dom]
	[goog.graphics :as graphics]
	[goog.events.EventType :as event-type]))

view raw ns.clj hosted with ❤ by GitHub

各種定数。

	(def white-fill (graphics/SolidFill. "white"))
	(def gray-fill (graphics/SolidFill. "gray"))
	(def black-fill (graphics/SolidFill. "black"))
	(def black-stroke (graphics/Stroke. 1 "black"))
	(def font (graphics/Font. game/font-size "monospace"))

view raw const.clj hosted with ❤ by GitHub

tic-tac-toe.game.Canvasを実装します。

	(def g (graphics/createGraphics 300 300))
	(def canvas
	(reify game/Canvas
	(draw-circle [this panel]
	(.drawCircle g
	(+ (:x panel) game/radius)
	(+ (:y panel) game/radius)
	game/radius
	nil
	black-fill))
	(draw-cross [this panel]
	(let [{:keys [x y]} panel
	x' (+ x game/panel-size)
	y' (+ y game/panel-size)]
	(doto g
	(.drawPath (doto (graphics/Path.)
	(.moveTo x y)
	(.lineTo x' y'))
	black-stroke
	nil)
	(.drawPath (doto (graphics/Path.)
	(.moveTo x' y)
	(.lineTo x y'))
	black-stroke
	nil))))
	(draw-text [this s]
	(.drawText g s 0 0 game/panel-size game/font-size "left" "top" font nil gray-fill))))

view raw canvas.clj hosted with ❤ by GitHub

main関数を定義します。

	(defn main []
	(doseq [panel game/panels]
	(doto (.drawRect g (:x panel) (:y panel) game/panel-size game/panel-size black-stroke white-fill)
	(.addEventListener event-type/CLICK
	(fn [event]
	(game/play canvas panel)))))
	(.render g (dom/getElement "canvas")))

view raw main.clj hosted with ❤ by GitHub

HTMLはコンパイルされたJavaScriptを読み込み、main関数を呼び出します。

	<!DOCTYPE html>
	<html>
	<head>
	<title>tic tac toe</title>
	<meta http-equiv="Content-Type" content="text/html; charset=UTF-8" />
	<script type="application/javascript" src="main.js"></script>
	</head>
	<body>
	<div id="canvas"></div>
	<script type="application/javascript">
	tic_tac_toe.main.main();
	</script>
	</body>
	</html>

view raw index.html hosted with ❤ by GitHub

これで動いてほしいところですが、cljs.core.logicがバグってるので、コンパイルされた.jsの修正が必要です。
cljs.core.logic.macros._take_STAR_のところをcljs.core.logic._take_STAR_に変更します。

masterでは直ってますが、修正版がpublishされていないのが悲しいですね。

雑感

いままでもClojureScriptについていろいろ書いてますが、やはりClojureは書いてて楽しいです。                                                            
最近はprotocolとrecordとmacroが好みです。                                                                                                           

論理プログラミングで書いたコードがWeb上で動いているのはなかなかおもしろいと思うのですが、コンパイルされたJavaScriptのコードをみるとものすごくカオスです。

Google Closure Compilerによるアシストがあるとはいえ、ファイルサイズは比較的大きくなるので、注意です。

cljsbuildのおかげで、今回のようなJVMとWebの両方で動くようなコードが書けるので、これからClojureScriptを使う人には是非知ってもらいたいものです。

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つの利点でもあると思います。

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

Isomorphism

Scalaz Advent Calendar!

Isomorphism

あるcase classに対してMonoidを定義したいとき、大体のものはTupleのMonoidのインスタンスが使えると思います。
こんなときにIsomorphismMonoidが使えます。

	case class Person(name: String, age: Int)
	object Person {
	type T = (String, Int)
	object PersonTuple extends (Person <=> T) {
	def from = Function.tupled(Person.apply)
	def to = Person.unapply _ >>> (_.get)
	}
	implicit object PersonMonoid extends IsomorphismMonoid[Person, T] {
	def G = Monoid[T]
	def iso = PersonTuple
	}
	}

view raw person.scala hosted with ❤ by GitHub

	scala> import scalaz._, Scalaz._
	import scalaz._
	import Scalaz._
	scala> mzero[Person]
	res0: Person = Person(,0)
	scala> Person("hoge", 2) multiply 3
	res1: Person = Person(hogehogehoge,6)

view raw repl.scala hosted with ❤ by GitHub

Monoid以外の型クラスを定義したい時もこんな感じで使える。

	implicit object PersonShow extends IsomorphismShow[Person, T] {
	def G = Show[T]
	def iso = PersonTuple
	}
	implicit object PersonOrder extends IsomorphismOrder[Person, T] {
	def G = Order[T]
	def iso = PersonTuple
	}

view raw iso.scala hosted with ❤ by GitHub

このように、データ構造が同じもののインスタンスを流用する場合はIsomorphismが使えます。

<=>[A, B]はIso[Function1, A, B]のtype aliasで、to: A => Bとfrom: B => Aを定義します。
IsomorphismMonoidなどの型クラスは、toを使って実装されていることに注意しましょう。