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

Posted 2017-06-09 19:09:28 GMT

Common Lisp上から使える論理型言語・DSLを適当に眺めたりしているが、今回はminiKANRENを試してみる。

miniKANRENとは

KANRENはScheme上に実装された論理型・関係型言語で、名前は日本語の関連(relation)に由来するらしい。
元々miniKANRENはそのサブセットだったようだが、今では一つの流派を成しているようだ。

実装がシンプルなので多数の言語の上で稼動する。最近のもので比較的有名なものとしてClojureのcore.logicがある。

Prologと比較すると、より関数型言語との親和性が高かったり、Occur Checkがあったり、基本的にcutはなかったり色々と違うようだ。

Zebraベンチを走らせてみる

Common LispにもminiKANRENは移植されていて、quicklisp経由で導入することができる。

(ql:quickload :kanren-trs)

とりあえず、毎度試しているSWI-Prolog版のZebraベンチのコードをminiKANRENで書いてみた。

(defpackage :k
  (:use :cl :kanren-trs))

(defun memb (item list) (fresh (a d) (conde ((== '() list) +fail+) ((== (cons item d) list)) ((== (cons a d) list) (memb item d)))))

(defun nextto (x y list) (conde ((iright x y list)) ((iright y x list))))

(defun iright (left right list) (fresh (a d r) (conde ((== '() list) +fail+) ((== (cons a '()) list) +fail+) ((== (cons left d) list) (== (cons right r) d)); left d:(right r) ((== (cons a d) list) (iright left right d)))))

(defun replace-_ (tree) (let ((vars '())) (labels ((frob (tree) (typecase tree (null '()) (atom tree) (cons (case (car tree) (_ (let ((s (gensym))) (push s vars) (cons s (frob (cdr tree))))) (otherwise (cons (frob (car tree)) (frob (cdr tree))))))))) (values (frob tree) vars))))

(defmacro fresh* (&body body) (multiple-value-bind (newbody vars) (replace-_ body) `(fresh (,@vars) ,@newbody)))

(defun zebra (h w z) (fresh* (== h `((norwegian ,_ ,_ ,_ ,_) (,_ ,_ ,_ ,_ ,_) (,_ ,_ ,_ milk ,_) (,_ ,_ ,_ ,_ ,_) (,_ ,_ ,_ ,_ ,_))) (memb `(englishman ,_ ,_ ,_ red) h) (memb `(spaniard dog ,_ ,_ ,_) h) (memb `(,_ ,_ ,_ coffee green) h) (memb `(ukrainian ,_ ,_ tea ,_) h) (iright `(,_ ,_ ,_ ,_ ivory) `(,_ ,_ ,_ ,_ green) h) (memb `(,_ snails winston ,_ ,_) h) (memb `(,_ ,_ kools ,_ yellow) h) (nextto `(,_ ,_ chesterfield ,_ ,_) `(,_ fox ,_ ,_ ,_) h) (nextto `(,_ ,_ kools ,_ ,_) `(,_ horse ,_ ,_ ,_) h) (memb `(,_ ,_ luckystrike oj ,_) h) (memb `(japanese ,_ parliaments ,_ ,_) h) (nextto `(norwegian ,_ ,_ ,_ ,_) `(,_ ,_ ,_ ,_ blue) h) (memb `(,w ,_ ,_ water ,_) h) (memb `(,z zebra ,_ ,_ ,_) h)))

KANRENでは匿名関数がサポートされているように見えるが、miniKANRENではサポートされていないらしい。
毎度freshで手書きで指定するのはあまりにも辛いのでfresh*という適当なマクロを書いてみた。なお入れ子での利用は想定していない。

ちなみにマクロで圧縮しないと、下記のようになる。Zebraのように変数が多いとちょっと辛い。

(defun zebra* (h w z)
  (declare (optimize (speed 3) (safety 0) (debug 0)))
  (fresh (a1 a2 a3 a4 a5
          b1 b2 b3 b4 b5
          c1 c2 c3 c4 c5
          d1 d2 d3 d4 d5
          e1 e2 e3 e4 e5)
    (== h `((norwegian ,a2 ,a3 ,a4 ,a5)
            (,b1 ,b2 ,b3 ,b4 ,b5)
            (,c1 ,c2 ,c3 milk ,c5)
            (,d1 ,d2 ,d3 ,d4 ,d5)
            (,e1 ,e2 ,e3 ,e4 ,e5)))
    (fresh (t1 t2 t3)
      (memb `(englishman ,t1 ,t2 ,t3 red) h))
    (fresh (t1 t2 t3)
      (memb `(spaniard dog ,t1 ,t2 ,t3) h))
    (fresh (t1 t2 t3)
      (memb `(,t1 ,t2 ,t3 coffee green) h))
    (fresh (t1 t2 t3)
      (memb `(ukrainian ,t1 ,t2 tea ,t3) h))
    (fresh (t1 t2 t3 t4 t5 t6 t7 t8)
      (iright `(,t1 ,t2 ,t3 ,t4 ivory) `(,t5 ,t6 ,t7 ,t8 green) h))
    (fresh (t1 t2 t3)
      (memb `(,t1 snails winston ,t2 ,t3) h))
    (fresh (t1 t2 t3)
      (memb `(,t1 ,t2 kools ,t3 yellow) h))
    (fresh (t1 t2 t3 t4 t5 t6 t7 t8)
      (nextto `(,t5 ,t6 chesterfield ,t7 ,t8) 
              `(,t1 fox ,t2 ,t3 ,t4) h))
    (fresh (t1 t2 t3 t4 t5 t6 t7 t8)
      (nextto `(,t5 ,t6 kools ,t7 ,t8) 
              `(,t1 horse ,t2 ,t3 ,t4) h))
    (fresh (t1 t2 t3)
      (memb `(,t1 ,t2 luckystrike oj ,t3) h))
    (fresh (t1 t2 t3)
      (memb `(japanese ,t1 parliaments ,t2 ,t3) h))
    (fresh (t1 t2 t3 t4 t5 t6 t7 t8)
      (nextto `(norwegian ,t1 ,t2 ,t3 ,t4)
              `(,t5 ,t6 ,t7 ,t8 blue) h))
    (fresh (t1 t2 t3 t4)
      (memb `(,w ,t2 ,t3 water ,t4) h))
    (fresh (t2 t3 t4)
      (memb `(,z zebra ,t2 ,t3 ,t4) h))))

計時

さて、これで、下記のような感じで、いつもと同じAllegro CL 8.2 64bitで1000回繰り返してみた。

(time 
 (dotimes (i 1000)
   (run nil (a)
     (fresh (h w z)
       (zebra h w z)
       (== a (list h w z))))))

; cpu time (non-gc) 216.919057 sec (00:03:36.919057) user, 0.000000 sec system ; cpu time (gc) 23.884974 sec user, 0.000000 sec system ; cpu time (total) 240.804031 sec (00:04:00.804031) user, 0.000000 sec system ; real time 240.977189 sec (00:04:00.977189) ; space allocation: ; 383,627,240 cons cells, 38,243,671,232 other bytes, 0 static bytes

結果は、216秒とかなり遅かった。PAIPrologの約20倍、AZ-Prolog・Allegro Prologと比較すると約250〜300倍遅い。
Common Lispの実装は特に高速化は施されていないのでこんなものなのかもしれない。

ちなみに今回、ウェブ上で散見されるZebraベンチにも色々なバージョンがあることと、述語の並べ方によって10倍以上の速度の違いが生じることがあることに気付いた。
SWI-Prologのベンチでは、家の情報(全体の情報)、水を飲んでいる物、シマウマの所有者の3つの変数を使うが、全体の情報を取得のみの場合もあるようだ。
また、述語の並べ方としては具体的には、

(defun zebra/ (h w z)
  (fresh*
    (== h `((norwegian ,_ ,_ ,_ ,_)
            (,_ ,_ ,_ ,_ ,_)
            (,_ ,_ ,_ milk ,_)
            (,_ ,_ ,_ ,_ ,_)
            (,_ ,_ ,_ ,_ ,_)))
    (iright `(,_ ,_ ,_ ,_ ivory)
            `(,_ ,_ ,_ ,_ green) h)
    (nextto `(norwegian ,_ ,_ ,_ ,_)
            `(,_ ,_ ,_ ,_ blue) h)
    (memb `(englishman ,_ ,_ ,_ red) h)
    (memb `(spaniard dog ,_ ,_ ,_) h)
    (memb `(japanese ,_ parliaments ,_ ,_) h)    
    (memb `(ukrainian ,_ ,_ tea ,_) h)
    (nextto `(,_ ,_ chesterfield ,_ ,_)
            `(,_ fox ,_ ,_ ,_) h)
    (memb `(,_ snails winston ,_ ,_) h)    
    (memb `(,_ ,_ kools ,_ yellow) h)    
    (memb `(,_ ,_ luckystrike oj ,_) h)
    (memb `(,w ,_ ,_ water ,_) h)
    (memb `(,z zebra ,_ ,_ ,_) h)
    (memb `(,_ ,_ ,_ coffee green) h)
    (nextto `(,_ ,_ kools ,_ ,_) 
            `(,_ horse ,_ ,_ ,_) h)))

のような順番で述語を記述すると、約11秒なので20倍程度は速い。
なお、Allegro Prologなどでもこの述語の並びだと10倍程度速くなるようなので、Zebraベンチの場合は述語の並びを揃えないと、うまく比較できないと考えた方が良いようだ。

結び

miniKANRENは親言語とのデータのやりとりも簡単で使い勝手良さそうだ。
miniKANRENといえば、The Reasoned Schemerらしいので、そのうち読んでみたい。


HTML generated by 3bmd in LispWorks 7.0.0

comments powered by Disqus