beanの逆関数unbean

POJO(一般のJavaオブジェクト)をbeanとみなして、プロパティのマップを返してくれる関数 bean がある。

http://clojuredocs.org/clojure_core/clojure.core/bean

beanで作ったマップからオブジェクトに戻したい場合もあると思うので、beanの逆関数 unbean を作ってみた。

(defn bean-setter-code [^Class klass]
  (let [bean-info (java.beans.Introspector/getBeanInfo klass)
        pds (.getPropertyDescriptors bean-info)
        obj-sym (gensym "obj_")
        map-sym (gensym "map_")]
    `(fn [~map-sym]
       (let [~(with-meta obj-sym {:tag (.getName klass)}) (.newInstance ~klass)]
         ~@(for [^java.beans.PropertyDescriptor pd pds
                 :let [method (.getWriteMethod pd)]
                 :when method
                 :let [prop-key (keyword (.getName pd))
                       method-sym (symbol (.getName method))]]
             `(let [v# (get ~map-sym ~prop-key ::nothing)]
                (when-not (= v# ::nothing)
                  (. ~obj-sym ~method-sym v#))))
         ~obj-sym))))

(defn gen-bean-setter [klass]
  (eval (bean-setter-code klass)))

(def get-bean-setter (memoize gen-bean-setter))

(defn unbean [m]
  ((get-bean-setter (:class m)) m))

実行結果はこんな感じ。

user=> (def d (java.util.Date.))
#'user/d
user=> d
#inst "2012-07-28T13:16:02.273-00:00"
user=> (def b (bean d))
#'user/b
user=> b
{:seconds 2, :date 28, :class java.util.Date, :minutes 16, :hours 22, :year 112, :timezoneOffset -540, :month 6, :day 6, :time 1343481362273}
user=> (unbean b)
#inst "2012-07-28T13:16:02.273-00:00"

beanのクラス一つごとに、Fnが一つ定義されるので、たくさんのクラスを扱う場合はPermGenの容量に注意が必要。
(たいていはあんまり考える必要は無いので、unbeanのなかでは普通にmemoizeしている。)

マクロ内の型ヒント

ちなみに、マクロ内の型ヒントはクラスオブジェクトじゃダメで、クラス名のシンボルか文字列じゃないといけないらしい。
いつまでたってもReflection warningが消えてくれない理由がわからなくて、ちょっとハマった。

メタデータを含めたPretty Print

ここから抜粋

https://groups.google.com/forum/?fromgroups#!topic/clojure/5LRmPXutah8

(use 'clojure.pprint)

(defn ppm [obj]
  (let [orig-dispatch *print-pprint-dispatch*]
    (with-pprint-dispatch 
      (fn [o]
        (when (meta o)
          (print "^")
          (orig-dispatch (meta o))
          (pprint-newline :fill))
        (orig-dispatch o))
      (pprint obj))))

Clojureのパーサコンビネータライブラリ fnparse を使う

前記事と似たような話。

プログラミングHaskellの第8章で紹介されているパーサコンビネータと同じようなことができるfnparseというライブラリがClojureにも存在する。パーサコンビネータと言えばScalaのライブラリ(コップ本*1 31章)にもあるが、どれも似たような感じのものだ。

プログラミングHaskell

Scalaスケーラブルプログラミング[コンセプト&コーディング] (Programming in Scala)

fnparseのマニュアル
https://github.com/joshua-choi/fnparse/wiki

準備

Clojure 1.2であればオリジナルのfnparseでいけるが、 Clojure 1.3 版は org.clojars.jpoplett/fnparse にある。

いつもと同じようにLeiningenのプロジェクトを作って、下記のように指定する。

(defproject hogehoge "0.0.1-SNAPSHOT"
  :description "parser combinator"
  :dependencies [[org.clojure/clojure "1.3.0"]
                 [org.clojars.jpoplett/fnparse "2.2.8"]])

$ lein deps

ルール

fnparseは「ルール」という種類の関数と、それを組み合わせて新たなルールを作る「ルールクリエータ」という種類の関数で構成される。

• ルール
  • 引数: [STATE]
    • STATE: { ... :remainder <パース対象の列> }
  • 戻り値: [RESULT NEW-STATE]
    • RESULT: ルールが出す任意の値
    • NEW-STATE: { ... :remainder <パース後の残りの列> }
• ルールクリエータ
  • 引数: [...] (任意)
  • 戻り値: ルール

まずはシンプルなルールから。

> (use 'name.choi.joshua.fnparse)
> (def simple-a (lit \a))
> (simple-a {:remainder [\a \b \c]})
[\a {:remainder (\b \c)}]
> (simple-a {:remainder [\b \c \a]})
nil

このsimple-aは文字\aのみにマッチするパーサだ。litというのがルールクリエータで、第一引数にマッチするパーサを戻り値として返す関数だ。

まず、帰ってきたパーサをsimple-aにバインドする。次に、ルールsimple-aに状態(state)を与えて、戻り値としてパース結果と残りの列を含む状態を得ている。

マッチしない列を与えてやると、nilが返る。(先頭からパースするので、マッチしない。)

\aと\bと\cにマッチするパーサをそれぞれ準備し、順々に適用していけば、最後には残り(remainder)列がnilになる。

> (def simple-a (lit \a))
> (def simple-b (lit \b))
> (def simple-c (lit \c))
> (simple-a {:remainder "abc"}) ;; 文字列は勝手に文字のシーケンスに変わる。
[\a {:remainder (\b \c)}]
> (simple-b (second *1))
[\b {:remainder (\c)}]
> (simple-c (second *1))
[\c {:remainder nil}]

ルールクリエータはlitだけでなく、マッチの条件を示す述語をとるルールクリエータもある。下記は小文字のみにマッチするルールを作っている。

> (def lower (term #(Character/isLowerCase %)))
> (lower {:remainder "abc"})
[\a {:remainder (\b \c)}]

これだと、それぞれの呼出で一文字ずつしかマッチしないが、複数の文字を連続でマッチさせる方法もある。

concはルールクリエータであり、与えられた引数を前から順にマッチさせ、それぞれの結果を順にシーケンスとして返す。
最後まで全部マッチしなければルール全体が失敗し、nilを返す。

> (def axc (conc simple-a lower simple-c))
> (axc {:remainder "abcd"})
[(\a \b \c) {:remainder (\d)}]
> (axc {:remainder "auc"})
[(\a \u \c) {:remainder nil}]
> (axc {:remainder "abbc"})
nil

concのような連接だけでなく、複数のルールから一つを選ぶルールクリエータも存在する。下記のaltは、引数で与えられたルールを順にチェックし、マッチしたものを返す。

> (def choose-abc (alt simple-a simple-b simple-c))
> (def abcs (conc choose-abc choose-abc choose-abc))
> (abcs {:remainder "abcdef"})
[(\a \b \c) {:remainder (\d \e \f)}]
> (abcs {:remainder "cccccc"})
[(\c \c \c) {:remainder (\c \c \c)}]
> (abcs {:remainder "cdcdcd"})
nil

連接(conc)、選択(alt)とくれば次は反復だが、もちろん反復も存在する。反復系のルールクリエータはいくつも存在するので、代表的な一つだけ紹介する。

下記のrep*は、指定されたルールを0以上個できるだけ多くマッチさせる(最長一致)。

> (def abc* (rep* choose-abc))
> (abc* {:remainder "abcdef"})
[[\a \b \c] {:remainder (\d \e \f)}]
> (abc* {:remainder "abcacbaae"})
[[\a \b \c \a \c \b \a \a] {:remainder (\e)}]
> (abc* {:remainder "dcdcd"})
[nil {:remainder "dcdcd"}]

さらにもうひとつ、最もよく使うものとしてcomplexがある。これは基本的にはconcと同じなのだが、それぞれのパース結果を加工することができる。

> (def digit (term #(Character/isDigit %)))
> (def ip-port
    (complex
      [ip (rep+ (alt digit (lit \.)))
       _ (lit \:)
       port (rep+ digit)]
      {:ipaddr (apply str ip) :port (Integer/parseInt (apply str port))}))
> (ip-port {:remainder "192.168.0.1:22"})
[{:ipaddr "192.168.0.1", :port 22} {:remainder nil}]

だいたいこれだけ覚えていれば、文脈自由文法が表現できるはず。

さらに、get-info, set-infoを使うことで、文脈依存文法も扱えるようになるのだが、説明し始めると長くなるので、公式の説明を参照。
https://github.com/joshua-choi/fnparse/wiki

最後に、特殊ルールとルールクリエータの一覧を。

特殊ルール

これはルールクリエータではなく、単なるルールだということに注意。

• anything
  • 一つだけ何にでもマッチする
• emptiness
  • 空の列にマッチし、結果としてnilを返す

ルールクリエータ

• lit a
  • 要素aにマッチする。(aは文字でなくても良い。)
• term p
  • (p a)が真になるようなaにマッチする。
• lit-conc-seq [a b c ...]
  • (conc (lit a) (lit b) (lit c) ...) の省略形
• lit-alt-seq [a b c ...]
  • (alt (lit a) (lit b) (lit c) ...) の省略形
• conc rule1 rule2 ...
  • 連接
• alt rule1 rule2 ...
  • 選択(まずは先に書いたルールでパースし、バックトラックが起こったら次のルールへ行く。)
• rep* rule
  • 反復(0以上、最長一致)
• rep+ rule
  • 反復(1以上、最長一致)
• rep= n rule, rep< n rule , rep<= n rule
  • 最長一致後、長さをチェック
• factor= n rule, factor< n rule, factor<= n rule
  • 最短一致(はじめは0から検査し、バックトラックが起こるたびに1ずつ増やしながら検査する。)
• except match-rule fail-rule
  • match-ruleにマッチする。ただしfail-ruleにもマッチしたら失敗。
• followed-by rule
  • マッチするが、remainderを消費しない。
• opt rule
  • (alt rule emptiness) と同じ。

altとfactor系のルールはバックトラックが頻繁に起こるので、なるべく減らしたほうが速いパーサになるはず。

*1:ずいぶん前に買ったので、古いのしか持ってない。

clojure.core.logicでPrologのような論理型プログラミング

clojure.core.logicというClojureをProlog化するライブラリがある。

Prologとは、論理型プログラミング言語。
下記のサイトで詳しい説明をしている方がいらっしゃるので、論理型言語についての説明は省略。
http://www.geocities.jp/m_hiroi/prolog/

このPrologのようなことが、論理型言語ではなく関数型言語のClojureで、ライブラリ clojure.core.logic をロードするだけでできてしまう。
https://github.com/clojure/core.logic

The Reasoned Schemer という本は、Schemeで論理型プログラミングを実現する内容だが、 clojure.core.logic はこの本の内容をClojureに移植したもの。

The Reasoned Schemer

まずは環境のセットアップでLeiningenを使いますが、このLeiningenの使い方は過去のエントリをご参考に。
http://d.hatena.ne.jp/t2ru/20100123/1264199643

まずは、project.cljに clojure.core.logic を使うように記述し・・・、

(defproject prolog-clojure "1.0.0-SNAPSHOT"
  :description "prolog clojure"
  :dependencies [[org.clojure/clojure "1.3.0"]
                 [org.clojure/core.logic "0.6.7"]])

依存するライブラリをダウンロードしてくる。

$ lein deps

これで準備完了。

簡単な例

早速 src/prolog-clojure/fruits.clj に論理を書いてみる。

(ns prolog-clojure.fruits
  (:refer-clojure :exclude [==]) ;; == がclojure.coreとかぶるので、除外する。
  (:use [clojure.core.logic]))

(defrel shape f s) ;; 果物の形を定義します

(fact shape :apple :sphere)    ;; リンゴは丸い
(fact shape :orange :sphere)   ;; オレンジも丸い
(fact shape :banana :stick)    ;; バナナは棒状
(fact shape :strawberry :cone) ;; イチゴは錐

(defrel color f c) ;; 果物の色を定義します

(fact color :apple :red)      ;; リンゴは赤い
(fact color :orange :orange)  ;; オレンジはオレンジ
(fact color :banana :yellow)  ;; バナナは黄色い
(fact color :strawberry :red) ;; イチゴは赤い

(defn -main []
  (println "丸い果物は？")
  (prn (run* [q]
         (shape q :sphere)))
  (println "赤い果物は？")
  (prn (run* [q]
         (color q :red)))
  (println "丸くて赤い果物は？")
  (prn (run* [q]
         (shape q :sphere)
         (color q :red)))
  (println "丸いか赤い果物は？")
  (prn (run* [q]
         (conde
           [(shape q :sphere)]
           [(color q :red)])))
  )

そして実行。

~/work/prolog-clojure$ lein run -m prolog-clojure.fruits
丸い果物は？
(:apple :orange)
赤い果物は？
(:strawberry :apple)
丸くて赤い果物は？
(:apple)
丸いか赤い果物は？
(:apple :strawberry :orange :apple)
~/work/prolog-clojure$ 

正解！
ifも再帰もループも使っていないのに、答えをちゃんと出してくれました。
appleがかぶっていますが、shapeとcolorの両方探してどちらでも見つかったからです。

このように、事実を書いて問いを入力すれば、計算ロジックは裏で勝手に考えてくれて、ありうる答えを全部出してくれる、というのが論理型プログラミングというやつです。

経路探索問題

さて、では経路探索をやってみましょう。

(ns prolog-clojure.pathsearch
  (:refer-clojure :exclude [==]) ;; == がclojure.coreとかぶるので、除外する。
  (:use [clojure.core.logic]))

;; http://www.geocities.jp/m_hiroi/prolog/prolog06.html
;; の経路探索問題の丸パクリです

(defrel neighbor a b)

;;  H -- I -- J -- K
;;  |    | ／ |
;;  E -- F -- G
;;  | ／ |    |
;;  A -- B -- C -- D

(fact neighbor :a :b) (fact neighbor :a :f) (fact neighbor :a :e)
(fact neighbor :b :f) (fact neighbor :b :c) (fact neighbor :c :d)
(fact neighbor :c :g) (fact neighbor :e :f) (fact neighbor :e :h)
(fact neighbor :f :g) (fact neighbor :f :i) (fact neighbor :f :j)
(fact neighbor :g :j) (fact neighbor :h :i) (fact neighbor :i :j)
(fact neighbor :j :k)

(defn nexto [x y]
  (conde
    [(neighbor x y)]
    [(neighbor y x)]))

(defn noto [x]
  (conda [x fail] [succeed succeed]))

(defne depth-search [node end path ans]
  ([?end ?end _ _] (conso end path ans))
  ([_ _ _ _]
   (fresh [nxt new-path]
     (noto (membero node path))
     (nexto node nxt)
     (conso node path new-path)
     (depth-search nxt end new-path ans))))

(defn -main []
  (println "bの隣は？")
  (prn (run* [q] (nexto :b q)))
  (println "aからkまでのループしない全経路は？")
  (doseq [x (run* [q] (depth-search :a :k [] q))]
    (prn x))
  )

そして実行

~/work/prolog-clojure$ lein run -m prolog-clojure.pathsearch
bの隣は？
(:c :a :f)
aからkまでのループしない全経路は？
(:k :j :g :f :a)
(:k :j :g :c :b :a)
(:k :j :f :b :a)
(:k :j :g :f :b :a)
(:k :j :f :a)
(:k :j :i :h :e :a)
(:k :j :g :f :e :a)
(:k :j :f :g :c :b :a)
(:k :j :f :e :a)
(:k :j :i :f :b :a)
(:k :j :g :c :b :f :a)
(:k :j :g :f :i :h :e :a)
(:k :j :i :f :g :c :b :a)
(:k :j :i :f :a)
(:k :j :f :i :h :e :a)
(:k :j :i :h :e :f :b :a)
(:k :j :i :f :e :a)
(:k :j :i :h :e :f :a)
(:k :j :g :c :b :f :e :a)
(:k :j :i :h :e :f :g :c :b :a)
(:k :j :g :c :b :f :i :h :e :a)
~/work/prolog-clojure$ 

最後に答えをreverseしていないので全部逆順に出ていますが、Prologの場合と同じ答えが出ているはずです。(答えの順序が違うのは、clojure.core.logicの中の探索アルゴリズムがPrologと違ってインターリーブする為です。miniKANRENのcondiと同じ結果になります。)

condaとかcondeとかdefneとか、よくわからないものが出てきましたね。下記にまとめます。

条件系のマクロ

(conde     ;; [場合分け] (The Reasoned Schemerのcondiにあたる)
  [a b c]  ;; a b c が全て成り立つ場合と、
  [d e f]  ;; d e f が全て成り立つ場合と、
  [g h i]) ;; g h i が全て成り立つ場合の結果をそれぞれ出す。

(condu     ;; [選択]
  [a b c]  ;; a b c が全て成り立つならこれを全体の結果とする。
  [d e f]  ;; 上が成り立たず、d e f が全て成り立つならこれを全体の結果とする。
  [g h i]) ;; 上が成り立たず、g h i が全て成り立つならこれを全体の結果とする。

(conda     ;; [条件分岐]
  [a b c]  ;; a が成り立てば、 a b c の結果を全体の結果とする。
  [d e f]  ;; a が成り立たず、d が成り立てば、 d e f の結果を全体の結果とする。
  [g h i]) ;; a と d が成り立たず、g が成り立てば、 g h i の結果を全体の結果とする。

(matche [a b c]
  ([?x ?x ?x] ...) ;; a, b, c が同じ場合にマッチ
  ([?x ?x _] ...)  ;; a, b が同じ場合にマッチ
  ([_ ?x ?x] ...)) ;; b, c が同じ場合にマッチ

(defne funcname [a b c] ...)
;; (defn funcname [a b c] (matche [a b c] ...)) と同じ

;; 下記は同じ関係にある
;; conde  <--> condu  <--> conda
;; matche <--> matchu <--> matcha
;; defne  <--> defnu  <--> defna

その他

fail    ;; 無条件に失敗
succeed ;; 無条件に成功

(== x y)         ;; x と y が同じなら成功
(membero x xs)   ;; リストxsにxが含まれる場合に成功
(conso x rxs xs) ;; (== (cons x rxs) xs) の場合に成功

;; condaとfail, succeedでnotが作れる
(defn noto [x] (conda [x fail] [succeed]))
;; xが成功したら失敗、xが失敗したら成功となる。

;; conduとfail, succeedで、最初の1個だけを出す条件が作れる。
;; The Reasoned Schemer 10-19
(defn onceo [x] (condu [x succeed] [fail]))

GTK-Serverを使ってシェルからGUI

Ubuntu Linux 11.10 でBashからGTKを叩く方法。

環境設定

gtk-serverはパッケージからインストールできないので、ソースから入れる。

$ sudo apt-get install libffi-dev
$ wget http://downloads.sourceforge.net/gtk-server/gtk-server-2.3.1-sr.tar.gz
$ tar xvzf gtk-server-2.3.1-sr.tar.gz
$ cd gtk-server-2.3.1-sr
$ ./configure --prefix=/usr/local
$ make
$ sudo make install

GladeでGUIを編集

GTK-Serverは現時点ではGtkBuilderをサポートしていない。
libgradeのファイルを使う必要がある。

$ sudo apt-get install glade-gtk2
$ glade-gtk2
(GtkBuilderではなく、LibGladeでセーブすること。)

スクリプトを書く

GTK+2に従ってスクリプトを書く。
シグナルを接続するには、gtk_server_connectを使う。

#!/bin/bash -x

PIPE=/tmp/gtksv

gtk() {
	echo $1 > $PIPE
	read RESULT < $PIPE
}

gtk-server -fifo=$PIPE -detach

gtk "gtk_init NULL NULL"

gtk "glade_init"
gtk "glade_xml_new 'hoge.glade' NULL NULL"
REPO=$RESULT
gtk "glade_xml_get_widget $REPO 'window1'"
WIN=$RESULT
gtk "gtk_server_connect $WIN delete-event delwin"
gtk "gtk_widget_show_all $WIN"

while true; do
	gtk "gtk_server_callback WAIT"
	EVENT=$RESULT
	if [ $EVENT = "delwin" ]; then
		gtk "gtk_server_exit"
		exit 0
	fi
done

gtk "gtk_server_exit"
exit 0

遅延シーケンスとwith系マクロの相性の悪さ

(defroutes main-routes
  (GET "/somecsv" []
    (sql/with-connection db
      ;; DBから大量のデータを取って文字列の遅延シーケンスを返す
      (some-table-to-csv-lines ...)
    )))

こういうのを書くと、遅延シーケンスが最後まで計算される前にDBのコネクションがクローズされてしまって、それ以降、未計算の要素を取るとエラーになる。

せっかくRingに遅延シーケンスやストリームが渡せるのに、DBと併用できないのはかなり残念。

Pythonみたいなコルーチンがあればいいんだけど、JavaVMの仕組み上無理そうだ。こういうことをやりたいときは、DBコネクションの管理を手動でやるか、別スレッドを起こしてPipedStreamやSynchronizedQueueでつないでやるしかないのかな。

メッセージ国際化関連のライブラリを作った

Webアプリなどを作るとき、国際化しておくとかっこいい。
java.utilにそういうものをサポートするResourceBundleという仕組みがあり、Clojureから簡単に使えるものを作成。
類似のライブラリは他にもあるが、これはClojure内でResourceBundleの定義が出来ることと、propertiesファイルに日本語がじかに使えるようにしたことが特徴。(普通は、native2asciiで変換が必要。)

Clojarsに上げてあるので、Leiningenでproject.cljにそのまま書いて使えます。

ResourceBundleを使うライブラリ「i18n」

こちらはResourceBundleを簡単に扱えるようにする汎用ライブラリ。

;;;; project.clj
(defproject hellohello
  :dependencies [[jp.taka2ru/i18n "0.0.1"]])

;;;; someprogram.clj
(use 'i18n.core)

;;メッセージを定義(Javaのときと同様、propertiesファイルをクラスパスに置いてもOK)
(gen-resource [:mymessage :ja] ;; [<リソース名> <言語(Locale)>]
  :hello "こんにちは"
  :good-bye "さようなら")

;;メッセージを参照
(... (resource :mymessage :ja :good-bye) ...)

テンプレートエンジンEnliveで国際化するライブラリ「enlive-utils」

テンプレートエンジンEnliveを使ったときに、ページの全テキストを一つのtransformerで一気に置換してくれるのがこちら。

;;;; project.clj
(defproject hellohello
  :dependencies [[jp.taka2ru/enlive-utils "0.0.1-SNAPSHOT"]])

;;;; someprogram.clj
(use 'net.cgrand.enlive-html)
(use 'enlive-utils.core)

;;メッセージを定義
(gen-resource [:mymessage :ja]
  :hello "こんにちは"
  :good-bye "さようなら")

;;テンプレート定義
(deftemplate greeting-page "templates/greeting.html" []
  [:html] (localize-document :mymessage :ja)) ;;←mymessageにある全部を置換

;;テンプレートを使用
(apply str (greeting-page))

templates/greeting.html (クラスパスの通ったところに置いてね)

message属性にメッセージIDを定義。

<html>
  <body>
    <p message="hello">Hello</p>
  </body>
</html>

greeting-pageの出力

message属性が削除され、代わりに中身がメッセージIDに対応する日本語に置換されている。

<html>
  <body>
    <p>こんにちは</p>
  </body>
</html>