GambolでZebraベンチ — #:g1

Posted 2017-06-28 13:06:26 GMT

Gambolとは、FROLICというCommon Lisp実装のS式Prologを拡張したものからProlog部分を抜き出したものらしい。

導入は、Quicklisp経由で、

(ql:quickload :gambol)

とすれば導入できる。

とりあえず、PrologのCommon Lisp実装を見付けたらZebraパズルでベンチをとってみることにしているので、早速いつもの組み合わせでベンチをとってみることにした。
(Allegro CL 8.2 64bit / Intel(R) Xeon(R) CPU E3-1230 v3 @ 3.30GHz)

なお、gambolだと色々試しているうちに定義が混ざるので定義の度にリセットするようなマクロを書いた。
また、gambolでは、匿名変数は??の筈だが、??だとどうも上手く動かないので、#?というリーダーマクロで一意なシンボルを生成した。

(cl:in-package :cl-user)

(eval-when (:compile-toplevel :load-toplevel :execute) (ql:quickload :gambol))

(defpackage :gambol-zebra (:use :cl :gambol))

(in-package :gambol-zebra)

(eval-when (:execute :compile-toplevel :load-toplevel) (defvar *gambol-zebra-readtable* (copy-readtable nil)) (set-dispatch-macro-character #\# #\? (lambda (s c a) (declare (ignore s c a)) (gensym "?")) *gambol-zebra-readtable*) (setq *readtable* *gambol-zebra-readtable*))

(defmacro define-predicate (name &body clauses) `(progn (clear-rules '(,name)) ,@(mapcar (lambda (c) `(*- ,@c)) clauses)))

(define-predicate member ((member ?item (?item . #?))) ((member ?item (#? . ?rest)) (member ?item ?rest)))

(define-predicate nextto ((nextto ?x ?y ?list) (iright ?x ?y ?list)) ((nextto ?x ?y ?list) (iright ?y ?x ?list)))

(define-predicate iright ((iright ?left ?right (?left ?right . ?rest))) ((iright ?left ?right (?x . ?rest)) (iright ?left ?right ?rest)))

(define-predicate zebra ((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 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 (pl-solve-one '((zebra ?h ?w ?z))) :finally (setf rt1 (get-internal-run-time)))) (multiple-value-call #'values (/ (* n 12825) (/ (- rt1 rt0) 1000.0)) (values-list (pl-solve-one '((zebra ?h ?w ?z)))))))

結果

結果は、82秒とPAIPrologの8倍遅い結果となった。
SBCLだと18秒、LispWorksだと30秒程度なので、Allegro CLと相性が良くないのかもしれない。
また、Allegro CLとLispWorksでは、スタックが溢れるので、

#+allegro (sys:set-stack-cushion nil)
#+lispworks (setq sys:*stack-overflow-behaviour* nil)

等と処置する必要があるかもしれない。

(gambol-zebra::zebra-benchmark 1000)
; cpu time (non-gc) 44.780000 sec user, 0.000000 sec system
; cpu time (gc)     38.100000 sec user, 0.000000 sec system
; cpu time (total)  82.880000 sec (00:01:22.880000) user, 0.000000 sec system
; real time  82.874676 sec (00:01:22.874676)
; space allocation:
;  263,790,840 cons cells, 9,367,684,480 other bytes, 0 static bytes
154741.8
→ (?h
   (house norwegian fox kools water yellow)
   (house ukrainian horse chesterfield tea blue)
   (house englishman snails winston milk red)
   (house spaniard dog luckystrike oj ivory)
   (house japanese zebra parliaments coffee green)) 
  (?w . norwegian) 
  (?z . japanese) 

結び

PrologのCommon Lisp実装は他にも結構あるらしいので、見付けたらZebraパズルを試していきたい。


HTML generated by 3bmd in LispWorks 7.0.0

comments powered by Disqus