#:g1: 「Generatorの勧め」をCommon Lispで

Posted 2018-03-25 09:11:27 GMT

ClojureにTransducers、SchemeにGenerator(SRFI-158/SRFI-121)だそうですが、Common Lispだったらseriesでしょう、ということでCommon Lisp版を書いてみました。

target1が「リスト生成→フィルタリング」、target2が「ジェネレータを使ってストリーム的に処理」するので中間コンスが少なくできる、という内容です。

今回の場合は、そっくりそのままCommon Lisp+seriesで写しとれる感じです。

下準備

;;; scheme
(define size 1000)

;;; cl
(ql:quickload :series)

(defpackage gen (:use :cl :series))

(in-package :gen)

(defconstant size 1000)

target1

;;; scheme
(define (target1)
  (filter (lambda (x) (zero? (mod x 3)))
          (map cdr
               (filter (lambda (x) (odd? (car x)))
                       (map (lambda (x) (cons x (square x)))
                            (iota size))))))

;;; cl
(defun target1 ()
  (remove-if-not (lambda (x) (zerop (mod x 3)))
                 (mapcar #'cdr
                         (remove-if-not (lambda (x) (oddp (car x)))
                                        (mapcar (lambda (x) (cons x (expt x 2)))
                                                (loop :for i :from 0 :repeat size :collect i))))))

target2

(define (target2)
  (generator->list
   (gfilter (lambda (x) (zero? (mod x 3)))
            (gmap cdr
                  (gfilter (lambda (x) (odd? (car x)))
                           (gmap (lambda (x) (cons x (square x)))
                                 (make-iota-generator size)))))))

(defun target2 ()
  (collect 
   (choose-if (lambda (x) (zerop (mod x 3)))
              (map-fn t
                      #'cdr
                      (choose-if (lambda (x) (oddp (car x)))
                                 (map-fn t
                                         (lambda (x) (cons x (expt x 2)))
                                         (scan-range :length size)))))))

target2seriesのリーダーマクロを使えばこんな感じにも書けます。
seriesを使うならこっちが普通かもしれません。

(series::install)

(defun target2/ ()
  (collect 
   (choose-if (lambda (x) (zerop (mod x 3)))
              (#Mcdr (choose-if (lambda (x) (oddp (car x)))
                                (#M(lambda (x) (cons x (expt x 2)))
                                   (scan-range :length size)))))))

implicit-mapを有効にすれば、更に簡潔に書けますが、ソースの字面で若干混乱しそうになるのでお勧めはしません :)

(series::install :implicit-map T)

(defun target2// ()
  (collect 
   (choose-if (lambda (x) (zerop (mod x 3)))
              (cdr (choose-if (lambda (x) (oddp (car x)))
                              ((lambda (x) (cons x (expt x 2)))
                               (scan-range :length size)))))))

target3

ついでにdo職人による極力コンスを排したコードも参加してみます。

(defun target3 ()
  (do* ((x 0 (1+ x))
        (y (expt x 2) (expt x 2))
        (ans (list nil))
        (tem ans))
       ((= size x)
        (cdr ans))
    (when (and (oddp x) (zerop (mod y 3)))
      (setf (cdr tem)
            (setq tem (list y))))))

比較結果

今回はタイムというより無駄なコンスを減らすことができるかがポイントのようです。
なお回数は一万回に増やしてみました。

(defparameter *count* 10000)

(equal (target1) (target2)) → T

(time (dotimes (i *count*) (target1))) #|| Timing the evaluation of (dotimes (i *count*) (target1))

User time = 0.521 System time = 0.000 Elapsed time = 0.508 Allocation = 678292704 bytes 0 Page faults Calls to %EVAL 160036 ||#

(time (dotimes (i *count*) (target2)))

#|| Timing the evaluation of (dotimes (i *count*) (target2))

User time = 0.236 System time = 0.000 Elapsed time = 0.226 Allocation = 198294392 bytes 0 Page faults Calls to %EVAL 160036 ||#

seriesを使ったtarget2方がコンスはtarget1の約29%に縮減し、タイムも倍速くなりました。
(ちなみに、srfi-158では67%の縮減のようです。)

vs do 職人コード

do 職人のtarget3とも比較してみます。

target2と速度はあまり変わりませんが、コンスはさらに縮減できてtarget1の約5%になりました。

(equal (target1) (target3))
→ T

(time (dotimes (i *count*) (target3)))

#|| Timing the evaluation of (dotimes (i *count*) (target3))

User time = 0.213 System time = 0.000 Elapsed time = 0.203 Allocation = 38295784 bytes 0 Page faults Calls to %EVAL 160036 ||#

といっても、途中でnn^2のペア作ってないし卑怯!となってしまうと思うので、中間でペアを作りつつdo職人の結果を目指します。

seriesはストリーム的な書法の他に外部イテレータ的な書き方も可能で、下記のように書いてみました。

なぜこう書くかというと、ペアを作ってペアをばらすのを同一のスコープに収めてdynamic-extent指定し、コンスは無かったことにしたいからで、標準APIのストリーム的な書法ではちょっと難しいです。
(多分ストリームを二本作れば可能)
なおdynamic-extent指定をしなくても多値を使って同様の効果が得られます(がペアを作る縛りなので……)

計測してみると、do職人コードと遜色なくなりました。

(defun target4 ()
  (let ((g (gatherer #'collect)))
    (iterate ((x (scan-range :length size)))
      (let ((x (cons x (expt x 2))))
        (declare (dynamic-extent x))
        (when (oddp (car x))
          (let ((x (cdr x)))
            (when (zerop (mod x 3))
              (next-out g x))))))
    (result-of g)))

(equal (target1) (target4))
→ T

(time (dotimes (i *count*) (target4)))

#||| Timing the evaluation of (dotimes (i *count*) (target4))

User time = 0.232 System time = 0.000 Elapsed time = 0.220 Allocation = 38939848 bytes 0 Page faults Calls to %EVAL 160036 ||#

ちなみに、dynamic-extent指定を削除するとコンスはtarget1並みに増えるようです。

#||
Timing the evaluation of (dotimes (i *count*) (target4))

User time = 0.244 System time = 0.000 Elapsed time = 0.231 Allocation = 198940456 bytes 0 Page faults Calls to %EVAL 160036 ||#

まとめ

遅延リスト、ストリーム、ジェネレータ辺りで何かしようと思ったらseriesも結構使えることがあります。

ただseriesは色々特殊なので、もうちょっと整理された次世代seriesがあったら良いなあという近頃です。


HTML generated by 3bmd in LispWorks 7.0.0

comments powered by Disqus