Archive for the ‘map1-n’ Tag

newLISP で On Lisp する...第15章(その1)

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

 第15章 関数を返すマクロ は、関数の構築 から、汎用の関数生成マクロ を実装します。(gensym と labels は newlisp-utility.lsp に定義してあります。)

(define-macro (fn+ expr)
  (rbuild expr)) 

(defun rbuild (expr)
  (if (or (atom? expr) (lambda? expr))
      expr
    (if (= (first expr) 'compose)
        (build-compose (rest expr))
      (build-call (first expr) (rest expr))))) 

(defun build-call (op fns)
  (let (g (gensym))
  (letex (_g g
          _op op
          _fbody (cons op (map (fn (f) (list (rbuild f) g)) fns)))
    (fn (_g) _fbody)))) 

(defun build-compose (fns)
  (let (g (gensym))
    (letex (_g g
            _lbody (labels ((rec (_f)
                              (if _f 
                                  (list (rbuild (first _f))
                                        (rec (rest _f)))
                                g)))
                           (rec fns)))
      (fn (_g) _lbody))))

 newLISP では、fn は、lambda と同じなので、fn+ に改名してあります。
 動作は(oddp は newlisp-utility.lsp に定義してあります)、

> (define int-odd? (fn+ (and integer? oddp)))
(lambda (gensym7) (and (integer? gensym7) (oddp gensym7)))
> (map int-odd? '(2 3 'a))
(nil true nil)
> (define s2i+ (fn+ (compose list ++ int)))
(lambda (gensym9) (list (++ (int gensym9))))
> (map s2i+ '("2" "3" "14"))
((3) (4) (15))
> (define s2i+3 (fn+ (compose (fn (x) (+ 3 x)) int)))
(lambda (gensym10) ((lambda (x) (+ 3 x)) (int gensym10)))
> (map s2i+3 '("2" "3" "14"))
(5 6 17)
> 

 という風に関数が返り、実際に組み合わせの動作をします。newLISP組込int は、Common Lisp の truncate と同じように使えます。
 この関数を使えば、(identity と map1-n は onnewlisp.lsp に定義してあります。)

> (map (fn+ (and integer? oddp)) '(c 3 p 0))
(nil true nil nil)
> (map (fn+ (or integer? symbol?)) '(c 3 p 0.2))
(true true true nil)
> (map1-n (fn+ (if oddp ++ identity)) 6)
(2 2 4 4 6 6)
> (map (fn+ (list -- ++ ++)) '(1 2 3))
((0 1 2) (1 2 3) (2 3 4))
> 

 と、なります。
 newLISP 組込 ++-- は破壊的関数なので、最後の例のような動作をします。
 さて、今までの newlisp-utility.lsp では cdr を rest で置き換えていますが、今回から、次の定義を使います。

(define cdr (fn (lst) (or (rest lst) nil)))

 そして(consp と remove-if は newlisp-utility.lsp に定義してあります)、

> (remove-if (fn+ (or (and integer? oddp) (and consp cdr))) '(1 (a b) c (d) 2 3.4 (e f g)))
(c (d) 2 3.4)
> 

 ちなみに、cdr と newLISP組込rest の違いは、

> (map cdr '((a b) (a) ()))
((b) nil nil)
> (map rest '((a b) (a) ()))
((b) () ())
> 

 そして、newLISP では、nil と 空リスト () は別物なので、上記remove-if の使い方では、cdr が必要です。

 さて、関数を入れ子するよりも

> (fn+ (list (++ int)))
(lambda (gensym14) (list ((lambda (gensym15) (++ (int gensym15))) gensym14)))
> (fn+ (compose list ++ int))
(lambda (gensym16) (list (++ (int gensym16))))
> 

 compose を使った方が簡潔になるというのが、マクロfn+ のポイントでしょうか(笑)。

 ということで、切りが良いので、Cdr 部での再帰 からは、次回に。
 関数版に相当する 第5章 返り値としての関数 と同様、長丁場になります。

 以上、如何でしょうか?

広告

newLISP で On Lisp する...第4章(その4)

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

第4章 ユーティリティ関数 もいよいよ マッピング です。map系関数のうち、map0-n から map-> までは、こうなります。

(defun map0-n (f n) (mapa-b f 0 n))
(defun map1-n (f n) (mapa-b f 1 n))
(defun mapa-b (f a b (step 1))
  (let (result)
    (for (i a b step)
      (push (f i) result -1))
  result))
(defun map-> (f start test-fn succ-fn)
  (let ((i start) (result))
    (until (test-fn i)
      (push (f i) result -1)
      (setq i (succ-fn i)))
  result))

まずは、関数mapa-b から。本文では、制御文do を使っています。以前定義した do を使っても良いのですが、do 文を使ってやっていることは、newLISP組込for に相当するので、それを使っています。もう、何度も書いていますが、newLISP組込push は、挿入位置を前方ではなく後方に出来ます。push の引数の最後の -1 が、その指定です。
では、動作を

> (mapa-b (curry add 1) -2 0 .5)
(-1 -0.5 0 0.5 1)

という具合です。組込関数curry は、以前から紹介しているように newLISP とっておきの関数です(楽)。1 を足すのに + ではなく、組込関数add を使っているのは、+ が整数専用だからです。試しに + を使うと

> (mapa-b (curry + 1) -2 0 .5)
(-1 0 0 1 1)

となります。この仕様がいやだという人は、組込constant を使って、

> (constant (global '+) add)
add
> (mapa-b (curry + 1) -2 0 .5)
(-1 -0.5 0 0.5 1)

とすることもできます。整数専用の演算子 +、-、*、/、% の実数用はそれぞれaddsubmuldivmod ですから、予め

(constant (global '+) add))
(constant (global '-) sub))
(constant (global '*) mul))
(constant (global '/) div))
(constant (global '%) mod))

と設定しておけば、整数・実数を問わず使えるようになります。お好みでどうぞ。数値計算ライブラリの先頭あたりにおいておくと良いかもしれません。
ちなみに、組込for の引数は、最初から、実数が使えたりします(笑)。
話を関数mapa-b に戻します。前に紹介した do を使った場合はこうなります。

(defun mapa-b (f a b (step 1))
  (do ((i a (add i step))
       (result '() result))
      ((> i b) (reverse result))
    (push (f i) result)))

mapa-b さえ出来れば、関数map0-n や map1-n は、簡単!
その前に、newLISPでは、関数mapa-b の動作を、組込関数sequencemap の組み合わせでも実現できます。

> (map (curry add 1) (sequence -2 0 .5))
(-1 -0.5 0 0.5 1)

ですから、mapa-b 関連は、こうも書けます。

(defun map0-n (f n)
  (map f (sequence 0 n 1)))
(defun map1-n (f n)
  (map f (sequence 1 n 1)))
(defun mapa-b (f a b (step 1))
  (map f (sequence a b step)))

もちろん、 map0-n と map1-n に mapa-b を使ってもいいですが、書く手間はあまり変わりません。ならば、わざわざ関数を呼び出すオーバーヘッドを増やす必要はありません。ユーティリティですから(笑)。
多機能の Common Lisp にも、たぶん sequence 相当する関数があるのかもしれまんが、約1千個もある関数から見つけ出すのは容易ではありません。
newLISPなら、すぐ見つかりますけどね(笑)。
newLISP の宣伝はさておき、次は、関数map-> です。
こちらも、do を使わず、newLISP組込の制御文until を使っています。
do を使った場合は、こうなります。

(defun map-> (f start test-fn succ-fn)
  (do ((i start (succ-fn i))
       (result nil result))
      ((test-fn i) (reverse result))
    (push (f i) result)))

そして、関数map-> を使って、関数mapa-b を定義すると、こうなります。

(defun mapa-b (f a b (step 1))
  (map-> f
         a
         (fn (x) (> x b))
         (fn (x) (add x step))))

λ式に、<a href="http://www.newlisp.org/downloads/newlisp_manual.html#fn"fn が使えると楽です。
次は、関数mappend の定義。

(defun mappend ()
  (apply append (apply map (args))))

第4章(その1)で定義したmapcanextend(nconc の代用)を append に変えただけです。
元はといえば、“On Lisp” 本文にある関数our-mapcan の定義を newLISP風にアレンジしたもの。
それはさておき、第4章(その1)で定義した関数nicknames で試してみましょう。

> (mappend nicknames '("a 1" "b 2" "c 3") '())
("1" "2" "3")

さて、関数mapcars は、

(defun mapcars (f)
  (let (lsts (args))
    (let (result)
      (dolist (lst lsts)
        (dolist (obj lst)
          (push (f obj) result -1)))
      result)))

内部変数lsts に使っている args の引数指定は要りません。newLISP組込ですから。上記のように、わざわざ let文 を使って、lsts に束縛する必要もありません。let文をはずして、lsts を (args) に置き換えても動きます。動作はというと、

> (mapcars sqrt '(1 2) '(3 4))
(1 1.414213562 1.732050808 2)

こんなところでしょうか?
マッピング の最後は、関数rmapcar ですが、ここで使っている、関数some は、newLISP にありませんので、先に定義します。

(define-macro (some)
  (letex (_exec (append '(map) (args)))
     (apply or _exec)))

(define-macro (every)
  (letex (_exec (append '(map) (args)))
     (apply and _exec)))

some と every は対でしょうから、ついでに定義してみました。これで、関数rmapcar を定義できます。しかし、この関数での some の使い方では、newLISP組込関数exists で、十分です。

(defun rmapcar (fx)
  (let (lsts (args))
    (labels ((rmaps (f lst)
             (let (res)
               (dolist (x lst)
                 (if (exists atom x)
                     (push (apply f x) res -1)
                   (push (rmaps f (transpose x)) res -1)))
               res)))
      (if (exists atom lsts)
          (apply fx lsts)
        (rmaps fx (transpose lsts))))))

“On Lisp”本文より複雑見えますが、labels を使って、動作を分けたのが味噌。もちろん、labels は、newLISP にはありません。こちらで定義した拙作マクロです。この場合、let を使った内部変数lsts の束縛は必須です。labels内で定義した関数の args と競合しますから(汗)。
動作はというと、

> (rmapcar sqrt '(1 2 (3 4 (5) 6) 7 (8 9)))
(1 1.414213562 (1.732050808 2 (2.236067977) 2.449489743) 2.645751311 (2.828427125 
  3))
> (rmapcar print '(1 2 (3 4 (5) 6) 7 (8 9)))
123456789(1 2 (3 4 (5) 6) 7 (8 9))
> (rmapcar + '(1 (2 (3) 4)) '(10 (20 (30) 40)))
(11 (22 (33) 44))

本文の関数rmapcar と同じように機能します。
また、exists を 先に定義した some に置き換えても動作は同じです。実は、組込exists は、引数のリストを一つしか取れません。それで、some の置き換えにならないのです。上記rmapcar の例では、引数を一つのリストにしていますから、組込exists で十分機能します。ちなみに、every には、組込関数for-all が相当します。引数のリストを一つしか取れないのは、exists と同様です。
この rmapcar は、改良されてはいますが、前回の “On newLISP” とほぼ同じアルゴリズム。
今回は、さらに “On Lisp” と同じアルゴリズムに挑戦します(笑)。

(context 'MAIN:curryEx)
(define-macro (curryEx:curryEx)
  (letex (_func (args 0)
          _arg  (args 1))
    (fn () (apply _func (cons _arg $args)))))
(context MAIN)
(defun rmapcar (f)
  (let (lsts (args))
    (if (exists atom lsts)
        (apply f lsts)
      (apply (curryEx map 
                      (fn () 
                        (apply (curryEx rmapcar f) $args)))
	           lsts))))

マクロcurryEx を定義することで、ほぼ“On Lisp”と同じ記述に持ち込めました(笑)。
動作は、

> (rmapcar + '(1 (2 (3) 4)) '(10 (20 (30) 40)) '(100 (200 (300) 400)))
(111 (222 (333) 444))
> (rmapcar (curry + 1) '(1 (2 (3) 4)))
(2 (3 (4) 5))
> (rmapcar + 1 2 3 4)
10

何故、これで動くのか?
newLISP組込curry で作成した関数は、引数を一個しかもちません。
前回検討時、上記関数のcurryEx を curry にした形で試していました。
結果は、引数一個の例(sqrt)は動くのに、引数が二個の例(+)はうまく動作しなかったのです。それで、組込transpose を使って引数リストを置換し、引数を対応する括弧ごとのリストを作っていたのです。
しかし、今回作成したマクロcurryEx が作る関数は、複数の引数を持つことができます。

> (curry + 1)
(lambda () (+ 1 ($args 0)))
> (curryEx + 1)
(lambda () (apply + (cons 1 $args)))

これで、“On Lisp”のアルゴリズムをそのまま使えるようになりました。
何故、前回の “On newLISP” の時、気が付かなかったんだか(嘆)、、、

さて、入出力 からの残りは、次回に。

以上、如何でしょうか?