newLISP で On Lisp する...第13章(続き)

(この blog は、“short short story または 晴耕雨読な日々”からの引越してきたもの。スクリプトは、newLISP V10.2.1 以降で動作するように書き直しています。
defun 等の newLISP組込関数に無い関数は、特に断らない限り、newlisp-utility.lsp に定義してあります。)

 第13章 コンパイル時の計算処理例:Bézier曲線 です。
、そのままマクロにするのではなく、第6章 ネットワーク のコンパイルのように、Bézier曲線計算プログラムをコンパイルして関数を返すマクロにします。ついでに比較用の通常関数も用意します(笑)。

 先ずは、関数版から、

(define (genbez-f x0 y0 x1 y1 x2 y2 x3 y3)
  (let (_gx0 x0 _gy0 y0 _gx1 x1 _gy1 y1 _gx3 x3 _gy3 y3)
      (let (cx (mul (sub _gx1 _gx0) 3)
            cy (mul (sub _gy1 _gy0) 3)
            px (mul (sub x2 _gx1) 3)
            py (mul (sub y2 _gy1) 3))
        (let (bx (sub px cx)
              by (sub py cy)
              ax (sub _gx3 px _gx0)
              ay (sub _gy3 py _gy0))
          (setf (*pts* 0 0) _gx0 (*pts* 0 1) _gy0)
          (map (fn (n) (letn (u (mul n *du*)
                              u2 (mul u u)
                              u3 (pow u 3))
                             (setf (*pts* n 0)
                                   (add (mul ax u3)
                                        (mul bx u2)
                                        (mul cx u)
                                        _gx0)
                                   (*pts* n 1)
                                   (add (mul ay u3)
                                        (mul by u2)
                                        (mul cy u)
                                        _gy0))))
                           (sequence 1 (i- *segs*)))
          (setf (*pts* *segs* 0) _gx3
                (*pts* *segs* 1) _gy3)))))

 本書のマクロと、ほとんど一緒です。
 そして、コンパイルした関数を返すマクロです。

(define-macro (make-genbez)
  (letex (_vars (flat (transpose
                        (list '(_gx0 _gy0 _gx1 _gy1  _gx2 _gy2 _gx3 _gy3)
                              '(x0 y0 x1 y1 x2 y2 x3 y3))))
          _body (cons 'begin 
          (map (fn (n) (letn (u  (mul n *du*)
                              u2 (mul u u)
                              u3 (pow u 3))
                             (list 'setf (list '*pts* n 0)
                                         (list 'add (list 'mul 'ax u3)
                                                    (list 'mul 'bx u2)
                                                    (list 'mul 'cx u)
                                                    '_gx0)
                                         (list '*pts* n 1)
                                         (list 'add (list 'mul 'ay u3)
                                                    (list 'mul 'by u2)
                                                    (list 'mul 'cy u)
                                                    '_gy0))))
                           (sequence 1 (i- *segs*)))))
  (fn (x0 y0 x1 y1 x2 y2 x3 y3)
    (let _vars
      (let (cx (mul (sub _gx1 _gx0) 3)
            cy (mul (sub _gy1 _gy0) 3)
            px (mul (sub _gx2 _gx1) 3)
            py (mul (sub _gy2 _gy1) 3))
        (let (bx (sub px cx)
              by (sub py cy)
              ax (sub _gx3 px _gx0)
              ay (sub _gy3 py _gy0))
          (setf (*pts* 0 0) _gx0 (*pts* 0 1) _gy0)
          _body
          (setf (*pts* *segs* 0) _gx3
                (*pts* *segs* 1) _gy3)))))))

 戻り値の展開式はλ式になっていますので、こうやって使います。

(setq f (make-genbez))

 では、計算時間を比較して見てみましょう。

> (define *segs* 20)
20
> (define *du* (div (i- 0) *segs*))
-0.05
> (define *pts* (array (i+ *segs*) 2))
((nil nil) (nil nil) (nil nil) (nil nil) (nil nil) (nil nil) (nil nil) (nil nil) 
 (nil nil) 
 (nil nil) 
 (nil nil) 
 (nil nil) 
 (nil nil) 
 (nil nil) 
 (nil nil) 
 (nil nil) 
 (nil nil) 
 (nil nil) 
 (nil nil) 
 (nil nil) 
 (nil nil))
> (setq f (make-genbez))
(lambda (x0 y0 x1 y1 x2 y2 x3 y3) 
 (let (_gx0 x0 _gy0 y0 _gx1 x1 _gy1 y1 _gx2 x2 _gy2 y2 _gx3 x3 _gy3 y3) 
  (let ((cx (mul (sub _gx1 _gx0) 3)) (cy (mul (sub _gy1 _gy0) 3)) (px (mul (sub _gx2 
       _gx1) 3)) 
    (py (mul (sub _gy2 _gy1) 3))) 
   (let ((bx (sub px cx)) (by (sub py cy)) (ax (sub _gx3 px _gx0)) (ay (sub _gy3 
       py _gy0))) 
    (setf (*pts* 0 0) _gx0 (*pts* 0 1) _gy0) 
    (begin 
     (setf (*pts* 1 0) (add (mul ax -0.000125) (mul bx 0.0025) (mul cx -0.05) _gx0) 
      (*pts* 1 1) 
      (add (mul ay -0.000125) (mul by 0.0025) (mul cy -0.05) _gy0)) 
     (setf (*pts* 2 0) (add (mul ax -0.001) (mul bx 0.01) (mul cx -0.1) _gx0) (*pts* 
       2 1) 
      (add (mul ay -0.001) (mul by 0.01) (mul cy -0.1) _gy0)) 
          :
      (途中略)
          :
     (setf (*pts* 18 0) (add (mul ax -0.729) (mul bx 0.81) (mul cx -0.9) _gx0) (*pts* 
       18 1) 
      (add (mul ay -0.729) (mul by 0.81) (mul cy -0.9) _gy0)) 
     (setf (*pts* 19 0) (add (mul ax -0.857375) (mul bx 0.9025) (mul cx -0.95) _gx0) 
      (*pts* 19 1) 
      (add (mul ay -0.857375) (mul by 0.9025) (mul cy -0.95) _gy0))) 
    (setf (*pts* *segs* 0) _gx3 (*pts* *segs* 1) _gy3)))))
> (time (genbez-f 0 0 1 1 2 1 3 0) 1000)
187.5
> (time (f 0 0 1 1 2 1 3 0) 1000)
62.5
> 

 計算時間がほぼ 1/3 になりました。コンパイルしたかいがあります(笑)。
 しかし、以前は、ほぼ半分だったのですが、、、newLISP 内部も最適化されている?

 さて、第13章 コンパイル時の計算処理 のまとめです。

  • newLISP には、コンパイル機能がありません。
  • 従って、newLISP では、計算処理をコンパイル時にずらす手法は、そのままでは、あまり意味がありません。
  • しかし、newLISP でも、計算処理をコンパイル時にずらす手法を使って展開した式を関数化すれば、計算時間を削減できます。

以上、如何でしょうか?

広告

No comments yet

コメントを残す

以下に詳細を記入するか、アイコンをクリックしてログインしてください。

WordPress.com ロゴ

WordPress.com アカウントを使ってコメントしています。 ログアウト /  変更 )

Google フォト

Google アカウントを使ってコメントしています。 ログアウト /  変更 )

Twitter 画像

Twitter アカウントを使ってコメントしています。 ログアウト /  変更 )

Facebook の写真

Facebook アカウントを使ってコメントしています。 ログアウト /  変更 )

%s と連携中

%d人のブロガーが「いいね」をつけました。