Common Lispの埋め込みPrologを試してみる: Zebraベンチ篇 — #:g1

Posted 2016-08-06 07:26:42 GMT

古くからLispで実装されたPrologは多いようです。
処理系として独立しているものからLisp内に埋め込まれたものまで色々あるようですが、Common Lispの埋め込みPrologってどんな感じかなと思い適当にベンチでも取ってみることにしました。

ベンチのお題ですが、Allegro Prologの解説ページにZebra Puzzleを解くという定番ベンチのコードが載っていたので、これで比べてみます。

Zebraパズルとは

Zebraパズルは、Wikipediaの解説ページに詳しいですが、提示される15の条件から、「水を飲んでいる人」と「シマウマの所有者」を推理するものです。

比較する埋め込みPrologについて

今回比較する埋め込みPrologは、

です。

Allegro PrologはAllegro CL 8.2に付属のものですが、元はNorvig先生のPAIPにあるProlog処理系がベースです。
ユーティリティを追加しつつ、かなり最適化しているとのこと。

PAIPROLOGは、PAIPのPrologをまとめたもので、(ql:quickload :paiprolog)で導入できます。

Uranusは、中島秀之先生の知識表現向け言語で、多重世界機構等でPrologを大幅に拡張した言語ですが、S式Prologの仲間でLisp Machine Lispで実装されています。
埋め込みの処理系というよりは単体の処理系ですが、Lispマシン上での利用は、埋め込みProlog的な利用がされていたようで、そのためのインターフェイスもあります。
CMUのAIリポジトリで配布されていますが、ANSI CLでも動くように調整してみました。

なお、まだまだ調整が足りていません。

ベンチ

Allegro Prologのページでは、Zebraを1000回ループした時間を測定していますので、これを基準に計測してみました。

Allegro Prolog

; cpu time (non-gc) 0.850000 sec user, 0.000000 sec system
; cpu time (gc)     0.000000 sec user, 0.000000 sec system
; cpu time (total)  0.850000 sec user, 0.000000 sec system
; real time  0.852126 sec
; space allocation:
;  0 cons cells, 0 other bytes, 0 static bytes

0 cons cellsとは一体。
聞き知るところでは、Allegro Prologの担当者はSteve M. Haflich(smh)氏とのことです。

PAIProlog

; cpu time (non-gc) 11.400000 sec user, 0.000000 sec system
; cpu time (gc)     0.320000 sec user, 0.000000 sec system
; cpu time (total)  11.720000 sec user, 0.000000 sec system
; real time  11.712953 sec
; space allocation:
;  48,220,135 cons cells, 1,920,202,272 other bytes, 0 static bytes

memberが定義されていないので、

(<-- (member ?item (?item . ?)))
(<-  (member ?item (? . ?rest)) (member ?item ?rest))

として定義した他はAllegro Prologと同じです。

Uranus

; cpu time (non-gc) 50.810000 sec user, 0.000000 sec system
; cpu time (gc)     0.270000 sec user, 0.000000 sec system
; cpu time (total)  51.080000 sec user, 0.000000 sec system
; real time  51.080032 sec
; space allocation:
;  501,877,675 cons cells, 450,448,848 other bytes, 0 static bytes

Uranusは色々と調整していますが、

(define nextto
        ((*x *y *list)
         (iright *x *y *list))
        ((*x *y *list)
         (iright *y *x *list)))

(define iright ((*left *right (*left *right . *rest))) ((*left *right (*x . *rest)) (iright *left *right *rest)))

(define zebra ((*h *w *z) ;; Each house is of the form: ;; (house nationality pet cigarette drink house-color) (= *h ((house norwegian ? ? ? ?) ;1,10 ? (house ? ? ? milk ?) ? ?)) ; 9 (member (house englishman ? ? ? red) *h) ; 2 (member (house spaniard dog ? ? ?) *h) ; 3 (member (house ? ? ? coffee green) *h) ; 4 (member (house ukrainian ? ? tea ?) *h) ; 5 (iright (house ? ? ? ? ivory) ; 6 (house ? ? ? ? green) *h) (member (house ? snails winston ? ?) *h) ; 7 (member (house ? ? kools ? yellow) *h) ; 8 (nextto (house ? ? chesterfield ? ?) ;11 (house ? fox ? ? ?) *h) (nextto (house ? ? kools ? ?) ;12 (house ? horse ? ? ?) *h) (member (house ? ? luckystrike oj ?) *h) ;13 (member (house japanese ? parliaments ? ?) *h) ;14 (nextto (house norwegian ? ? ? ?) ;15 (house ? ? ? ? blue) *h) (member (house *w ? ? water ?) *h) ;Q1 (member (house *z zebra ? ? ?) *h) ;Q2 ))

のようなものをファイルに書いて、

(defun ura-load (file)
  (let ((*package* (find-package :uranus-user))
        (*readtable* (copy-readtable ura:uranus-readtable)))
    (set-macro-character #\? (lambda (s c)
                               (declare (ignore s c))
                               (gensym "*"))
                         T)
    (with-open-file (in file)
      (loop :for xpr := (read in nil in)
            :until (eq xpr in)
            :do (ura:toplevel-execute xpr)))))

で読み込んでいます。
Uranusでは?が匿名変数ですが、マッチの結果が違ってくるので、?をリーダーマクロとしてgensymで一意の変数を生成しています。
ドライバーは、

(defun ura-zebra-benchmark (&optional (n 1000))
  (declare (optimize (speed 3) (safety 0)))
  (let (rt0 rt1)
    (time (loop initially (setf rt0 (get-internal-run-time))
              repeat n do (result '(do (zebra *houses *water-drinker *zebra-owner)
                                       (cut)     ; Stop once answer is found.  
                                                 ; This appears to be
                                                 ; what other implementations do, 
                                                 ; e.g. time/1 in
                                                 ; SWI Prolog.
                                    ))
                finally (setf rt1 (get-internal-run-time))))
    (destructuring-bind (zebra houses water-drinker zebra-owner)
                        (result '(zebra *houses *water-drinker *zebra-owner))
      (declare (ignore zebra))
      (values (/ (* n 12825) (/ (- rt1 rt0) 1000.0)) ; real time 
                                                     ; is milliseconds
              zebra-owner water-drinker houses))))

です。
Prologの世界とLispの世界を行き来するオーバーヘッドが大きそうなので、ループもProlog側で回すようなものも書いて比較してみましたが、ほぼ同じ結果でした。

SWI-Prolog

% 12,848,838 inferences, 1.422 CPU in 1.422 seconds (100% CPU, 9035334 Lips)

Allegro Prologのページのコードで計測したものです。

AZ-Prolog

---Module Name(Iterate)----   C-Code     ByteCode   Interpreter
-----------------------------+----------+----------+-----------
zebra(1000) :                  0.710 Sec  0.800 Sec  1.530 Sec

AZ-Prologは、「ISO/DEC-10 Prolog」に準拠した、世界最速級の処理性能を誇る論理型言語Prolog処理系とのことなので比較してみました。
商用処理系ですが、無償で個人利用可能です。素晴しい!
AZ-PrologのベンチマークにZebraがあるので1000回繰り返すように調整して計測しました。
C-CodeというのはCにトランスレートしたものを実行した速度のようです。

順位とタイム

順位 処理系 タイム(秒)
1 AZ-Prolog 0.710 1
2 Allegro Prolog 0.852 1.2
3 SWI-Prolog 1.422 2
4 PAIProlog 11.712 16.5
5 Uranus 51.080 71.9

参考までに単体のProlog処理系とも比較してみましたが、世界最速級のAZ-Prologと比べてもAllegro Prologは良い線を行ってそうです。
Allegro Prologの元になったPAIPrologですが、タイムは約13倍になっています。
他のベンチもちょっと試してみたりしていますが、大体10〜40倍位違うようなので、かなりの最適化が施されているようです。

UranusはS式Prologとして構文が良い感じなのと、面白い機構があるので速度とは別に深追いしてみたい所です。

まとめ

このベンチに限っては、ですが、Allegro PrologがメジャーなProlog並の速度が出ているのに驚きです。
とはいえ、Prolog側で繰り返しを書くと簡単にスタックオーバーフローになってしまう等、使い方に工夫が必要そうです(PAIPrologも同じく)
今後、別のベンチの結果も書いて行こうかなと思っています。

LispWorksにもCommon Prologというものがあり本格的なProlog処理系っぽいのですが、Enterprise Editionでしか利用できないので残念ながら試せていません。
しかし、OPS5をベースにした前向き推論と、Prologベースの後ろ向き推論を組み合わせることが可能で、さらにCommon Lispのクラスとも融合しつつMOPの論理言語版ともいえそうなMRP(Metarule Protocol)というものを持ち、デバッグ機能も充実しているらしいです。

試してみたい!


HTML generated by 3bmd in LispWorks 7.0.0

comments powered by Disqus