newLISP で On Lisp する...第13章

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

 第13章 コンパイル時の計算処理 です。といっても、newLISP には、コンパイルがありませんけどね。

 まずは、新しいユーティリティ から。
 平均値の例は、こうなります。(defun は、newlisp-utility.lsp に定義してあります)

(defun avg ()
; (avg &rest args) 
  (div (apply add (args)) (length (args))))

(define-macro (avg-m) 
; (avg-m &rest args) 
  (letex (_sum (cons 'add (args))
          _len (length (args)))
    (div _sum _len)))

 試すまでも無いですが、

> (avg 1 2 3 4 5 6)
3.5
> (avg-m 1 2 3 4 5 6)
3.5
> (apply avg (sequence 1 1000))
500.5
> (apply avg-m (sequence 1 1000))
500.5
> (time (apply avg (sequence 0 1000)) 1000)
375
> (time (apply avg-m (sequence 0 1000)) 1000)
531.25
> 

 当たり前ですが、マクロの方が遅くなります。
 次のスクリプトは、(gensym は、newlisp-utility.lsp に定義してあります)

(defun most-of ()
; (most-of &rest args) 
  (let (all 0 hits 0)
    (dolist (a (args))
      (inc all)
      (if a (i+ hits)))
    (> hits (/ all 2)))) 

(define-macro (most-of-m)
; (most-ofm &rest args)
  (let (_temp (gensym)
        _need (/ (length (args)) 2)
        _args (args))
    (letex (_body 
             (cons 'or 
                   (map (fn (_a) (list 'and _a
                                      (list '> (list 'i+ _hits) _need)))
                        _args))
            _hits _temp)
      (let (_hits 0) _body))))

 こんな感じ。
 マクロでは、計算部分が全て(引数分)、letex 内で展開式を作り、_body に収めています。
 これも、動作を見るまでもないですが、例によってマクロは展開式で見てみます(t は、newlisp-utility.lsp に定義してあります)。

> (most-of t nil t t)
true
> (most-of-m true nil true true)
(let (gensym1 0) 
 (or (and true (> (i+ gensym1) 2))
     (and nil  (> (i+ gensym1) 2))
     (and true (> (i+ gensym1) 2)) 
     (and true (> (i+ gensym1) 2))))
> 

 マクロの展開式の方は、出力されたものを見やすく整形しています。
 さて、次のマクロの前に、maplist が newLISP には無いので実装します(hayashi は、newlisp-utility.lsp に定義してあります)。

(defun maplist (f)
  (let ((lsts (args))(res))
    (dotimes (i (apply min (map length lsts)))
      (push (apply f (map (hayashi slice i) lsts)) res -1))
  res))

 と言っても、newlisp-utility.lsp に定義してあります。
 準備が出来たところで、(car、cdr、mklist、null は、newlisp-utility.lsp に定義してあります)

(defun nthmost (n lst)
  (nth n (sort (copy lst) >))) 

(define-macro (nthmost-m n lst)
  (if (and (integer? n) (< n 20))
      (let (_syms (mklist (gensym (i+ n))))
        (letex (_lst lst
                _gen-start (cons 'begin (gen-start '_glst _syms))
                _symsrest _syms
                _nthmost-gen (nthmost-gen '_gi _syms t)
                _lastsym (last _syms))
          (let (_glst _lst)
            (unless ())))
(defun gen-start (glst syms)
    (reverse
      (maplist (fn (_syms)
                   (let (var (gensym))
                     (list 'let (list var (list 'pop glst))
                     (nthmost-gen var (reverse _syms)))))
               (reverse syms))))
(defun nthmost-gen (var vars long?)
  (if (null vars)
      nil
      (let (else (nthmost-gen var (1 vars) long?))
        (if (and (not long?) (null else))
            (list 'setq (vars 0) var)
          (list 'if 
                (list '> var (vars 0))
                (append '(setq)
                         (mappend list (chop (reverse (copy vars)))
                                       (1 (reverse (copy vars))))
                         (list (vars 0))
                         (list var))
                else)))))

 といったところ。
 “On Lisp” 本書の例では、map0-n と gensym で 引数の数+1個の変数を作り出しています。newlisp-utility.lsp に定義してある gensym は、引数の数分だけ変数を作り出す仕様です。そこが違っていますが、展開結果は、同等です。
 例によってマクロは展開式で見てみましょう。

> (nthmost 0 '(2 1 3))
3
> (nthmost 1 '(2 1 3))
2
> (nthmost 2 '(2 1 3))
1
> (nthmost-m 0 '(2 1 3))
(let (_glst '(2 1 3)) 
 (unless ( _gi gensym2) 
    (setq gensym2 _gi) nil))) gensym2)
> (nthmost-m 1 '(2 1 3))
(let (_glst '(2 1 3)) 
 (unless ( gensym8 gensym6) 
     (setq gensym7 gensym6 gensym6 gensym8) 
     (setq gensym7 gensym8)))) 
  (dolist (_gi _glst) 
   (if (> _gi gensym6) 
    (setq gensym7 gensym6 gensym6 _gi) 
    (if (> _gi gensym7) 
     (setq gensym7 _gi) nil)))) gensym7)
> (nthmost-m 2 '(2 1 3))
(let (_glst '(2 1 3)) 
 (unless ( gensym17 gensym13) 
     (setq gensym14 gensym13 gensym13 gensym17) 
     (setq gensym14 gensym17))) 
   (let (gensym16 (pop _glst)) 
    (if (> gensym16 gensym13) 
     (setq gensym15 gensym14 gensym14 gensym13 gensym13 gensym16) 
     (if (> gensym16 gensym14) 
      (setq gensym15 gensym14 gensym14 gensym16) 
      (setq gensym15 gensym16))))) 
  (dolist (_gi _glst) 
   (if (> _gi gensym13) 
    (setq gensym15 gensym14 gensym14 gensym13 gensym13 _gi) 
    (if (> _gi gensym14) 
     (setq gensym15 gensym14 gensym14 _gi) 
     (if (> _gi gensym15) 
      (setq gensym15 _gi) nil))))) gensym15)
> 

 ここまでは、newLISP に、コンパイル機能が無いので、あまり意味がありません。
 そこで、例:Bézier曲線 では、そのままマクロにするのではなく、第6章 ネットワークのコンパイル のように、Bézier曲線計算プログラムをコンパイルして関数を返すマクロにします、、、次回に(笑)。

以上、如何でしょうか?

広告

No comments yet

コメントを残す

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

WordPress.com ロゴ

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

Google+ フォト

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

Twitter 画像

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

Facebook の写真

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

%s と連携中

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