Common LispのScreamerでZebraベンチ — #:g1

Posted 2017-06-13 16:22:44 GMT

Screamerとは古くからあるCommon Lispの非決定性計算のライブラリで、知る人ぞ知るという感じのものだが、現在もQuicklisp経由で簡単に導入することが可能。

(ql:quickloda :screamer)

数年前ScreamerでZebraパズルを記述したものがあったので試してみたが、どうも遅いっぽいなあという漠然とした印象だけ残っていた。
最近Zebraパズルばっかりやっているが、無駄な知見が溜りつつある丁度良いタイミングなので果して本当に遅かったのか確認してみることにした(暇ともいう)

筆者が以前目にしたものは、SBCLの開発で有名な、Nikodemus Siivola氏が書いたものだったらしい。

こちらのコードを少しSWI-Prologのコードっぽくして、計時してみた。

(declaim (optimize (speed 3) (safety 0) (debug 0) (compilation-speed 0)))

(eval-when (:compile-toplevel :load-toplevel :execute) (ql:quickloda :screamer))

(in-package :s)

(defmacro let-integers-betweenv (((min max) var-list) body) `(let ,(loop for i in var-list collect (list i `(an-integer-betweenv ,min ,max))) ,body))

(defun all-differentv (list) ;; Functionally the same as (apply #'/=v list), but faster. (labels ((all-different (x xs) (if (null xs) t (andv (notv (=v x (car xs))) (all-different x (cdr xs)) (all-different (car xs) (cdr xs)))))) (all-different (car list) (cdr list))))

(defun nextto (x y) (let ((d (an-integer-betweenv -1 1))) (assert! (/=v d 0)) (assert! (=v d (-v x y)))))

(defun iright (x y) (assert! (=v x (+v y 1))))

(defun zebra-problem () (let-integers-betweenv ((1 5) (english spaniard japanese ukrainian norwegian red green ivory yellow blue dog snails fox horse zebra kools chesterfield winston luckystrike parliament tea coffee milk oj water z w)) (let ((nationality (list english spaniard japanese ukrainian norwegian)) (color (list red green ivory yellow blue)) (smoke (list kools chesterfield winston luckystrike parliament)) (pet (list zebra dog snails fox horse)) (drink (list water tea coffee milk oj))) (assert! (all-differentv nationality)) (assert! (all-differentv color)) (assert! (all-differentv smoke)) (assert! (all-differentv pet)) (assert! (all-differentv drink)) ;; (assert! (=v norwegian 1)) (assert! (=v milk 3)) (assert! (=v english red)) (assert! (=v spaniard dog)) (iright green ivory) (nextto norwegian blue) (assert! (=v kools yellow)) (assert! (=v green coffee)) (assert! (=v ukrainian tea)) (assert! (=v luckystrike oj)) (assert! (=v japanese parliament)) (assert! (=v winston snails)) (assert! (=v z zebra)) (assert! (=v w water)) (nextto horse kools) (nextto fox chesterfield)

(destructuring-bind (z w &rest result) (one-value (solution (list z w nationality pet drink color smoke) (static-ordering #'linear-force))) (let* ((syms '((english spaniard japanese ukrainian norwegian) (zebra dog snails fox horse) (water tea coffee milk oj) (red green ivory yellow blue) (kools chesterfield winston luckystrike parliament) )) (result (apply #'mapcar #'list (mapcar (lambda (x) (mapcar #'second (sort x #'< :key #'first))) (mapcar (lambda (x y) (mapcar #'list x y)) result syms))))) (list (nth 0 (nth (1- z) result)) (nth 0 (nth (1- w) result)) result))))))

(zebra-problem)(japanese norwegian ((norwegian fox water yellow kools) (ukrainian horse tea blue chesterfield) (english snails milk red winston) (spaniard dog oj ivory luckystrike) (japanese zebra coffee green parliament)))

Allegro CL 8.2 64bitで大体210秒位。オリジナルも大体同じ位のスピードで、assert!の節を関数として括り出しても性能的には問題ないようだ。
ちなみに、LispWorksや、SBCLだと130秒位で終了するので、コードの最適化がSBCLやLispWorksに向けて施されているかもしれない。

;(time (dotimes (i 1000) (zebra-problem)))
; cpu time (non-gc) 197.770000 sec (00:03:17.770000) user, 0.010000 sec system
; cpu time (gc)     12.670000 sec user, 0.000000 sec system
; cpu time (total)  210.440000 sec (00:03:30.440000) user, 0.010000 sec system
; real time  210.561596 sec (00:03:30.561596)
; space allocation:
;  74,892,808 cons cells, 70,951,714,176 other bytes, 0 static bytes)

コードの中身としては、これまでのリスト処理のコードとはちょっと違っていて、各要素に1から5までの数値を割り当て、要求された条件に合う解を見付けてくるようなものになっている。
Prologに比べると変数の初期化等のコード量が多く、その辺りの見通しが少し良くない。

なおオリジナルのコードのコメントによると、もう少し速くなる書き方があるらしい。
20倍位速くなればPAIProlog並ということになるが、ここまで手続的に書いてPAIPrologより遅いとなるとZebraのような問題に限っては、組み込みPrologを使った方が楽で良いなと思ってしまう。

結び

いかつい名前から勝手に超高速なものという印象を持っていたが、Zebraに関しては若干期待外れだった。

Screamerが得意とする問題もあると思うので、得意なものもそのうち確認してみたい。


HTML generated by 3bmd in LispWorks 7.0.0

comments powered by Disqus