Archive for the ‘mappend’ Tag
CSV ファイルをテーブル表示する（解説編）
前回の “newLISP で GUI する。。。または、CSV ファイルをテーブル表示する。” は、如何だったでしょうか？
今回の解説は、中で使っている、リストから テーブル表示用の HTML文字列を作る関数makeHTMLtable についてです。
(define *header* [text]<!-- generated page -->
<html>
<table border="1">
[/text])
(define tableROW '("<tr>" "</tr>\n"))
(define tableDATA '("<td align=\"right\">" "</td>"))
(define tableHEADER '("<th>" "</th>"))
(define *footer* [text]</table>
</html>
[/text])
(defun addHTMLtag (data tag)
(string (tag 0) data (tag 1)))
(defun makeHTMLtable1 (lst)
(let (html *header*)
(dolist (row lst)
(extend html (tableROW 0))
(dolist (col row)
(extend html (addHTMLtag col (if (string? col) tableHEADER tableDATA))))
(extend html (tableROW 1)))
(extend html *footer*)))
やっていることは、
- 入れ子リストの引数を要素にまで分解
- その要素に補助関数addHTMLtag でタグを付加
- それを extend でつなぎ合わせていく
上記コードは、いかにも手続きですが、動作を見るには、これが一番わかりやすいので（汗）。でも、関数プログラミング言語の newLISP なら、map を使って、関数表記（？）できるはず。
と、言うことで、map と append の合成関数 mappend（Common Lisp にある mapcan の append 版）を使って、dolist を無くてみましょう。
手始めに、
(defun makeHTMLtable2 (lst)
(let (html *header*)
(dolist (row lst)
(extend html (addHTMLtag (mappend (fn (col) (addHTMLtag col (if (string? col) tableHEADER tableDATA))) row)
tableROW)))
(extend html *footer*)))
これで、一番下の dolist が消えました（笑）。
動作は、
> mappend (lambda () (apply append (apply map (args)))) > (setq csv (makeHTMLtable1 sol-sys)) [text]<!-- generated page --> <html> <table border="1"> <tr><th>Planet name</th><th>Equator diameter (earth)</th><th>Mass (earth)</th><th>Orbital radius (AU)</th><th>Orbital period (years)</th><th>Orbital Incline Angle</th><th>Orbital Eccentricity</th><th>Rotation (days)</th><th>Moons</th></tr> <tr><th>Mercury</th><td align="right">0.382</td><td align="right">0.06</td><td align="right">0.387</td><td align="right">0.241</td><td align="right">7</td><td align="right">0.206</td><td align="right">58.6</td><td align="right">0</td></tr> <tr><th>Venus</th><td align="right">0.949</td><td align="right">0.82</td><td align="right">0.72</td><td align="right">0.615</td><td align="right">3.39</td><td align="right">0.0068</td><td align="right">-243</td><td align="right">0</td></tr> <tr><th>Earth</th><td align="right">1</td><td align="right">1</td><td align="right">1</td><td align="right">1</td><td align="right">0</td><td align="right">0.0167</td><td align="right">1</td><td align="right">1</td></tr> <tr><th>Mars</th><td align="right">0.53</td><td align="right">0.11</td><td align="right">1.52</td><td align="right">1.88</td><td align="right">1.85</td><td align="right">0.0934</td><td align="right">1.03</td><td align="right">2</td></tr> <tr><th>Jupiter</th><td align="right">11.2</td><td align="right">318</td><td align="right">5.2</td><td align="right">11.86</td><td align="right">1.31</td><td align="right">0.0484</td><td align="right">0.414</td><td align="right">63</td></tr> <tr><th>Saturn</th><td align="right">9.41</td><td align="right">95</td><td align="right">9.54</td><td align="right">29.46</td><td align="right">2.48</td><td align="right">0.0542</td><td align="right">0.426</td><td align="right">49</td></tr> <tr><th>Uranus</th><td align="right">3.98</td><td align="right">14.6</td><td align="right">19.22</td><td align="right">84.01</td><td align="right">0.77</td><td align="right">0.0472</td><td align="right">-0.718</td><td align="right">27</td></tr> <tr><th>Neptune</th><td align="right">3.81</td><td align="right">17.2</td><td align="right">30.06</td><td align="right">164.8</td><td align="right">1.77</td><td align="right">0.0086</td><td align="right">0.671</td><td align="right">13</td></tr> <tr><th>Pluto</th><td align="right">0.18</td><td align="right">0.002</td><td align="right">39.5</td><td align="right">248.5</td><td align="right">17.1</td><td align="right">0.249</td><td align="right">-6.5</td><td align="right">3</td></tr></table> </html> [/text] > (= csv (make-table2 sol-sys)) true >
さらに、もう一段 dolist を関数化すると、
(defun makeHTMLtable3 (lst)
(addHTMLtag
(mappend (fn (row) (addHTMLtag (mappend (fn (col) (addHTMLtag col (if (string? col) tableHEADER tableDATA)))
row)
tableROW))
lst)
(list *header* *footer*)))
こんな感じ。ここなら、補助関数addHTMLtag を作った甲斐があるというもの（笑）。
動作は、もちろん、
> (= csv (make-table3 sol-sys)) true >
同じです。
まとめとしては、
が使える。
また、要素ごとに処理が複雑に異なるなら、dolist を使う。
こんなところ、、、当たり前か？（笑）
以上、如何でしょうか？
newLISP で On Lisp する．．．第４章（その４）
Filed under: On newLISP | タグ: curryEx, every, map->, map0-n, map1-n, mapa-b, mapcars, mappend, rmapcar, some
コメントを残す newLISP で On Lisp する．．．第４章（その４）
（この blog は、“short short story または 晴耕雨読な日々”からの引越してきたもの。スクリプトは、newLISP V10.2.1 以降で動作するように書き直しています。）
defun 等の newLISP組込関数に無い関数は、特に断らない限り、newlisp-utility.lsp に定義してあります。
第４章 ユーティリティ関数 もいよいよ マッピング です。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)
とすることもできます。整数専用の演算子 +、-、*、/、% の実数用はそれぞれadd、sub、mul、div、mod ですから、予め
(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 の動作を、組込関数sequence と map の組み合わせでも実現できます。
> (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 相当する関数があるのかもしれまんが、約１千個もある関数から見つけ出すのは容易ではありません。
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))))
第４章（その１）で定義したmapcan の extend（nconc の代用）を append に変えただけです。
元はといえば、“On Lisp” 本文にある関数our-mapcan の定義を newLISP風にアレンジしたもの。
それはさておき、第４章（その１）で定義した関数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” の時、気が付かなかったんだか（嘆）、、、
さて、入出力 からの残りは、次回に。
以上、如何でしょうか？
新リスプな日々 