partial関数書いてみた

●partial関数

Common Lisp で

*1

(defun partial (f &rest args)
  (lambda (&rest rest-args)
    (apply f (append args rest-args))))

(funcall (partial #'* 2) 10)         ;=> 20
(funcall (partial #'list 1 2) 3 4 5) ;=> (1 2 3 4 5)

一応できてますね。左から順にしか部分適用できませんけれど。

Emacs Lisp で

elisp でも partial の定義は同じなので省略。動作確認してみると...

Debugger entered--Lisp error: (void-variable f)
  (apply (function funcall) f (append args rest-args))
  (lambda (&rest rest-args) (apply (function funcall) f (append args rest-args)))(10)
  funcall((lambda (&rest rest-args) (apply (function funcall) f (append args rest-args))) 10)
  eval((funcall (partial (function *) 2) 10))
  eval-last-sexp-1(nil)
  eval-last-sexp(nil)
  call-interactively(eval-last-sexp nil nil)

嘘つきました。Emacs lisp では静的レキシカルスコープを明示しないとダメ。

(require 'cl)
(defun partial (f &rest args)
  (lexical-let ((f f) (args args))
    (lambda (&rest rest-args)
      (apply f (append args rest-args)))))

(funcall (partial '* 2) 10)         ;=> 20
(funcall (partial 'list 1 2) 3 4 5) ;=> (1 2 3 4 5)

●mapcar と flip で

Common Lisp

(defun flip (f a b)
  (funcall f b a))

(mapcar (partial #'flip #'expt 2) '(1 2 3 4 5))
;;=> (1 4 9 16 25)

高階関数を適用する場合、funcall が不要なのでいい感じ。 #' は慣れれば気にならなくなります。むしろシンボルが関数だと明確になるので好ましいとすら思えてくる。

Emacs Lisp

Emacs Lisp には expt（べき乗）関数ないみたいですね。

(defun expt (n m)
  (cond ((> m 0) (apply '* (make-list m n)))
        ((zerop m) 1)
        (t (/ 1.0 (expt n (- m))))))

(defun flip (f a b)
  (funcall f b a))

(mapcar (partial 'flip 'expt 2) '(1 2 3 4 5))
;;=> (1 4 9 16 25)

●引数の rotate

flip だけだと今イチ使い勝手が悪いので引数のローテーションをさせてみる。
以下、両 lisp 共用

(defun list-rotate-left (n lis)
  (let ((m (mod n (length lis))))
    (append (nthcdr m lis) (subseq lis 0 m))))

(defun args-rotate-left (n f &rest args)
  (if (or (zerop n) (null args))
      (apply f args)
      (apply f (list-rotate-left n args))))

(defun args-rotate-right (n f &rest args)
  (apply #'args-rotate-left (- n) f args))

;; Common Lisp
(args-rotate-left 1 #'list 1 2 3 4 5)  ;=> (2 3 4 5 1)
(args-rotate-right 1 #'list 1 2 3 4 5) ;=> (5 1 2 3 4)
(mapcar (partial #'args-rotate-right 1 #'make-list :initial-element 'X) '(1 2 3 4 5))
;;=> ((X) (X X) (X X X) (X X X X) (X X X X X))

elisp は make-list の仕様が若干ちがう。

;; Emacs Lisp
(args-rotate-left  1 'list 1 2 3 4 5) ;=> (2 3 4 5 1)
(args-rotate-right 1 'list 1 2 3 4 5) ;=> (5 1 2 3 4)
(mapcar (partial 'args-rotate-right 1 'make-list 'X) '(1 2 3 4 5))
;;=> ((X) (X X) (X X X) (X X X X) (X X X X X))

ネーミングセンスなくて短い関数名が思い付かなかった...

●partial をマクロにしてみる (2011/12/31 追記)

マクロの欠点は高階関数を適用できないところ。関数を引数とする関数にマクロは渡せない。だから取りあえず partial は関数にしたんだけど、上の partial の使われかたを見るとマクロでも問題は無さそう。*2書いてみた。

(defmacro partial (f &rest args)
  (let ((rest-args (gensym)))
    `(lambda (&rest ,rest-args)
       (apply ,f ,@args ,rest-args))))

args を,@ で展開できるおかげで rest-args に append しなくてよくなった。その分だけ実行時コストの軽減にはなってるだろう。

*1:最初 apply #'funcall f ... としていましたが apply するなら funcall は不要でした。

*2:mapcar の例では partial そのものに mapcar を適用しているのではなく、partial の作るラムダ関数に mapcar を適用している。それならばマクロであっても大丈夫。「関数を作るマクロ」を作ればいい。

オーバーフローする flatten

エントリータイトル変更しました。
「オーバーフローしない」-->「オーバーフローする」

●On Lisp の flatten はスタック溢れを起す

(defun flatten-a (lis)
  (labels ((rec (x acc)
             (cond
               ((null x) acc)
               ((atom x) (cons x acc))
               (t (rec (car x) (rec (cdr x) acc))))))
    (rec lis nil)))

我が家の環境 (Ubuntu10.04LTS + Clozure CL) だと要素数 ５万３千強でスタックが溢れる。下から２行目の右側の rec 再帰呼出しは返却値をそのまま返さず、他の関数に引数として渡している。しかし実は「他の関数」ではなく、渡している先はこれまた rec なので、これはこれでやっぱり末尾再帰のような気がする。
でも、スタックが溢れる。
※訂正:上記の cond 式の最後の行の２つ rec は、左側だけが末尾再帰扱いのようです。

そもそも Common Lisp では末尾再帰の最適化は仕様に無いらしいけど、でも実際は最適化してくれる処理系もあるとかなんとか...。どっちなんだ。
ぐーぐる先生で調べてみると、こんな記事を見付けた。

• Clozure CLが末尾呼び出しを最適化してくれない @ einblickerの日記

でも、この記事のコメントを見ると、"ちゃんと末尾再帰になっているように見えます" と Shiro さんが書いている。うーん、やはり最適化されると思ってよいのか...な...？

●スタック溢れしない flatten は無いのか？

再びぐーぐると、こんなのがあった。

2009-02-12 今日も Emacs Lisp @ cocoatomo衝動日記より

(defun flatten2 (tree)
  (reverse (flatten-rec tree nil)))

(defun flatten-rec (tree stack)
  (if tree
      (if (atom tree)
	  (cons tree stack)
	(flatten-rec (cdr tree) (flatten-rec (car tree) stack)))
    stack))

この flatten は要素数 100万のリストでもスタック溢れを起すことなく処理してくれる。ということはやはり末尾再帰最適化は行われているということかな。
試みに on Lisp のコードと何が違うのか調べるためコードを変形してみて、驚いた。

;; On Lisp のコード
(defun flatten-a (lis)
  (labels ((rec (x acc)
             (cond
               ((null x) acc)
               ((atom x) (cons x acc))
               (t (rec (car x) (rec (cdr x) acc))))))
    (rec lis nil)))

;; cocoatomo さんのコードを変形したもの
(defun flatten-b (lis)
  (labels ((rec (x acc)
             (cond
               ((null x) acc)
               ((atom x) (cons x acc))
               (t (rec (cdr x) (rec (car x) acc))))))
    (reverse (rec lis nil))))

再帰関数 rec の形は両者ともほとんど同じ。違うのは cond 式の最後の二重再帰呼出しの (car x) と (cdr x) が入れ替っているだけ。たったこれだけの違いで、スタック溢れを回避できている。残念ながらこの理由は、今の僕には理解できない...。
※訂正：flatten-b も末尾再帰ではない。対象リストのネストが深ければスタックオーバーフローになる。

●蛇足。私の書いた flatten

On Lisp の flatten がスタック溢れを起すと知って私が書いたのはこれでした。

(defun flatten-c (lis)
  (flet ((iter (x acc)
           (cond ((null x) acc)
                 ((atom x) (cons x acc))
                 (t (append (flatten-c x) acc)))))
    (reduce #'iter lis
            :initial-value nil
            :from-end t)))

reduce です。高階関数万歳。
Common Lisp には reduce-back も、 reduce-right もありませんが、キーワード引数 :from-end で reduce が右畳込み関数になるんですね。Common Lisp らしいところでしょうか。他にも :start :end で畳込む範囲まで指定できます。そんなの使う場面が思い浮びませんが。
ところでこの reduce 版 flatten も変則的な再帰をしてるように見えます。flatten-c は reduce を call し、reduce が iter をコールして、iter が flatten-c を callしてます。

  flatten-c --> reduce --> iter --> flatten-c --> reduce --> iter --> ...

しかも iter の中の flatten-c 呼出しは末尾再帰の形になっていません。戻値を append にわたしています。
でも、これスタック溢れしないです。
reduce を介することで、単なる再帰呼出とは違うメモリ割当になってるんでしょうか...これもよくわからない。
※訂正：残念ならがこれも flatten-b 同様 スタック溢れます。明らかに末尾再帰ではないので当然ですが...

● 追記

よくよく考えたら、flatten-c と、 flatten-a, b は再帰するタイミングが異っているような気がします。flatten-c も再帰がかさむようなリストに適用すれば、やはりスタック溢れを起すように思えます。
あとで確認する。

● 追記２

確認した。
結論から言うと

• Clozure CL では末尾再帰のループ最適化は行われる。
• 今回書いた flatten-a,b,c はどれも末尾再帰関数とは言えなかった。

テスト用コード

(defun make-flat-list (n)
  (loop for x from 1 to n collect x))

(defun make-deep-list (n)
  (let ((lis 'a))
    (dotimes (k n lis)
      (setq lis (list lis)))))

(defun test1 (n flatten)
  (time (progn
	  (funcall flatten (make-flat-list n))
	  t)))

(defun test2 (n flatten)
  (time (progn
	  (funcall flatten (make-deep-list n))
	  t)))

結果

(test1 100000 #'flatten-a) ;=> オーバーフロー
(test1 100000 #'flatten-b) ;=> OK
(test1 100000 #'flatten-c) ;=> OK

(test2 100000 #'flatten-a) ;=> OK
(test2 100000 #'flatten-b) ;=> オーバーフロー
(test2 100000 #'flatten-c) ;=> オーバーフロー

flatten-a はネストの深いリストに対して有効だが、要素数が多いリストには弱い。
flatten-b,c は要素数が多いリストに対して有効だが、ネストの深いリストには弱い。
結局、次のような再帰の形は末尾再帰とは言えない。

(labels ((rec (x acc)
          ...
      (rec ... (rec ...))))

多重再帰している rec のうち、左側は末尾再帰であり ClozureCL では最適化される。しかし右側の再帰はやはり非末尾再帰扱いのようです。flatten-a は car部の再帰処理が末尾再帰で cdr部の再帰処理は非末尾再帰だったわけです。そのため cdr が深くなるフラットなリストでオーバーフローし、 car部が深くなるディープなリストに強かった。 flatten-b は、car と cdr の記述が逆だったので性質も正反対だった、というわけです。

Clojureでもクリスマスツリーを飾りました

この記事はClojure Advent Calendar 2011の13日目の記事です。一日＋α 遅れましたが。

シーケンス（リスト）でクリスマスツリーが作れるらしいので作ってみました。

●元ネタ

• vallog: クリスマスツリーを飾りました。Lispで。
• パラメトロン計算機: クリスマスツリー講義

●準備

みんな大好き leiningen
project.clj は今回こんな感じです。

(defproject christmas-tree "0.1.0"
  :description "clojure advent calendar"
  :dependencies [[org.clojure/clojure "1.2.1"]
                 [org.clojure/clojure-contrib "1.2.0"]
                 [hiccup "0.3.7"]]
  :jar-name "christmas-tree.jar"
  :uberjar-name "christmas-tree-standalone.jar"
  :main christmas-tree.core)

●木のデータ

データの作り方は単純です。使うのは 0 と 1 だけ。
最初のデータはこれだけです。これを一次（サイズ１）とします。

0 1

二次はこうです。

   10
00 01 11

三次は

    100 101
    010 110
000 001 011 111

n+1 次のデータは n 次のデータから生成します。
n 次のデータの「行」のすべてのブロック*1の末尾に 0 を加えた新たな行と、1 を加えた新な行の２行を作ります。

00 01 11
     ↓
000 010 110
001 011 111

そして、0 を加えた行の先頭の１ブロックを 1 を加えた行の先頭に移動します。

    010 110
000 001 011 111

このような操作を「木」の全ての行に対して行なうことで、次のサイズの木が作られます。
なお操作によって行のブロックが１つもなくなってしまった場合、その行は除去します。

以上の処理を Clojure でシーケンス操作によって作ります。

• データを作るモジュール : christmas-tree.tree

1011 のような数字の連続したブロックを [1 0 1 1] という数値のベクタで表現しています。したがって tree の１行は「ベクタを要素とするシーケンス」、tree 全体では「ベクタを要素とするシーケンスのシーケンス」となります。
christmas-tree.tree/grow-lineで１行分のデータを受け取り、上に書いた操作によって２行にして返します。
christmas-tree.tree/nth-tree は引数 n の次数の tree のデータを返します。この nth-tree の関数の最後の行にある ,,, ですが、Clojure では , は空白文字（スペース）と同じ扱いです。これを利用して「ここに値が挿入されますよ」というマークにしています。Web上で公開されていた Clojure コードで見掛けたのですが -> マクロ利用時などに使うと可読性があがるのでよく使ってます。

ちなみに ブロックをベクタにしたのは、新たな要素を末尾に追加しなければならないからです。「末尾へ追加」は 「conj + ベクタ」が効率的（なはず）です。

(conj [1 0 0] 1) ;=> [1 0 0 1]

では実際に nth-tree を試してみましょう。

(require '[christmas-tree.tree :as tree])
(tree/nth-tree 3)

結果

(([1 0 0] [1 0 1]) ([0 1 0] [1 1 0]) ([0 0 0] [0 0 1] [0 1 1] [1 1 1]))

●整形して出力

インデントを挿入して出力します。

• コンソール出力をするモジュール : christmas-tree.console

christmas-tree.console/print-tree に christmas-tree.tree/nth-tree で作ったデータを与えると、

(require '[christmas-tree.console :as console])
(console/print-tree (tree/nth-tree 4))

こんな風にコンソールに出力されます。（サイズ４の場合です）。

          1010
     1000 1001 1011
          1100
     0100 0101 1101
     0010 0110 1110
0000 0001 0011 0111 1111

木の左側のインデントサイズは、行の左端のブロックをみるだけで決定できるのですが、分りますか？
christmas-tree.tree/make-indentでインデント用のシーケンスを作っています。

●色を付けたい

例えばこんな行の場合

0010 0110 1110	
-*---**---*---

アスタリスクの付いているアイテム*2に色を付けます。つまり隣接する２つのブロックを比較した時、「左のブロックのアイテム 0 が、右ブロックの同じ位置で 1 になっている場合」に、「左ブロックの 0」と「右ブロックの 1」の両方に色を付けます。
簡単そうで意外にややこしいです。

さて、単なる数値であるアイテムに属性情報（色）をつけるため、nth-tree で生成されたデータの全てのアイテムを hash-map に置き換える関数を作ることにしました。
「赤い 0」は {:val 0 :color 'red} のように表現します。

• 属性（色）情報を構築するモジュール : christmas-tree.attr

隣あったブロックを比較するために (partition 2 1) を使っています

(partition 2 1 '(A B C D E F)) ;=> ((A B) (B C) (C D) (D E) (E F))

隣合う要素をペアにしてくれるので、隣接要素の比較に利用できます。ただしこの方法だと、

(->> (partition 2 1 '(A B C D E F))
     (map first))    

 ;=> (A B C D E)  ; F が欠落

というように、先頭や末尾の要素が処理結果に含まれないことがあります。今回もこのケースに該当してしまうのですが、要素の欠落はさせたくない。そういう場合には

(->> (concat '(X) '(A B C D E F) '(X))
     (partition 2 1)
     (map first)
     rest)

;;=>(A B C D E F)

予め計算結果に影響を与えないような値を、処理対象のシーケンスの前後に加えておいて、最後に不要な部分をカットすることで、欠落のないデータを得ることができます。
今回のコードでは christmas-tree.attr/set-line-colors 関数の

(->> (concat [ones] line [zeros])
      to-attrs-from-line
      (partition 2 1)
      (mapcat set-blocks-colors)
      rest ...

という部分がそれにあたります。 concat で line の前後にベクタ（ブロック）を加えてから (partition 2 1) で処理し、最後に rest で余分な先頭をカットしています。
試しに使ってみると...

(require '[christmas-tree.attr :as attr])
(attr/set-tree-colors (tree/nth-tree 3))

結果

((({:val 1} {:val 0})) (({:val 0} {:color red, :val 0}) ({:color red, :val 0} {:color yellow, :val 1}) ({:color yellow, :val 1} {:val 1})))

0 には red, 1 には yellow を付加しています。色付をしないアイテムは {:val 0} のように :color 属性をつけていません。これは {:val 0 :color nil} と同じとみなすことができます。

●html 出力

色情報を付加したので、その情報をもとにレンダリングします。HTMLに吐き出すのがてっとり早い。

• HTML出力するモジュール : christmas-tree.html

hiccup というモジュールを使うと、HTMLのタグをベクタで構築できます。
CSS を ベタ書きでハードコーディングしてるのはよろしくないですが、ともあれこれで色付きのツリーを出力できます。
次のようにすると、標準出力に HTML が出力されます。
christmas_tree.html/print-tree は 全ての要素が hash-map 化された属性つき tree データを引数にとります。

(require '[christmas-tree.html :as html])
(-> (tree/nth-tree 6) attr/set-tree-colors html/print-tree)

ファイルに保存してブラウザで開くと

色がつくと雰囲気がでますね。赤黄の密度も丁度いい感じ。

●コマンドラインツールとして

最後に core.clj を整備しましょう。

• エントリポイント(-main)を含むモジュール : christmas-tree.core

clojure.contrib.command-line/with-command-line はコマンドライン引数の定義をサポートしてくれるマクロです。--help で出力する usage も管理してくれます。
以下は、leiningen での実行例*3。

$ lein run --help

java -jar christmas-tree-standalone.jar [Options]

Options
  --size, -n <arg>     size of tree              [default 4]
  --text, -t           output to text (default)             
  --html, -p           output to html page                  
  --outfile, -o <arg>  output filename                      

<arg> が付いているのが引数をとるオプションです。
例えば

$ lein run -n 8 -p -o hoge.html

とすれば、サイズ8の、tree を hoge.html へ HTMLファイルとして保存します。


clojure.contrib.duck-streams/with-out-writer は動的 binding によって標準出力をファイルへリダイレクトしてくれるマクロです。とりあえず println で標準出力にデータを吐き出す関数を作っておいて、あとでファイル出力に変更する、ということが簡単にできます。

(defn print-hoge
  "標準出力へ出力"
  []
  (println "HOGE"))

(defn write-hoge
  "ファイルへ出力"
  [filename]
  (with-out-writer filename (print-hoge)))

大きなプログラムではもう少しちゃんとアウトプット管理をすべきですが、小さなツールでは便利に使えるとおもいます。コマンドライン引数でのファイル指定と組み合わせるとさらに便利です*4。

おわりに

小さなプログラムの作成をしながら、Clojure ならではのポイントや小さな tips を書いてみようという試みでしたが、如何がでしたでしょうか。Clojurian にとってはあたりまえのことばかりだったと思いますが、初心者や Clojure に興味をもっている方の参考になれば幸です。

以上の全コードは github においてあります。
https://github.com/mnzk/christmas-tree

*1:100 や 101 のような連続した塊を、ここでは「ブロック」と呼びます。

*2:ここではブロック内の要素 0,1 ひとつひとつを「アイテム」と呼びます。

*3:leiningen でプロジェクトを管理している場合、 lein run で -main 関数を実行してくれます。コマンドライン引数もそのままプログラムへ渡してくれます。

*4:引数でファイルが指定されたらそちらへ、指定されなかったら標準出力へといった振分けが簡単にできます。

seq と LazyList

いつもの調子で思い付きで適当なこと言ってますな。後で見返してちょっとまずいと思ったのは「遅延シーケンス」について述べる時 Clojure を念頭に置いてしまっていること。Clojure では「遅延シーケンス」と「遅延リスト」が同じ物のように扱われます。さらにいうと永続的なコレクションさえ遅延シーケンス化されて処理されることもままあり、かなり特殊な仕様なんですよね。

●LazyList <'T>

すこし時間を遡って、

LazyList か...使ったことなかった。調べてみるとまさにこれが私のニーズだった。

一昨日のコードの関数をほんの少し変えただけ。受け取った seq を LazyList.ofSeq で遅延リストにして、あとは List モジュールを使う感覚です。とても簡単。素晴しい。問題となっていた処理速度も早い。
PowerPack に入っているのでコアアセンブリだけで使えないのが唯一の欠点かな。標準に入れるべきだ絶対。

●あえて seq で

seq を使うと何がいけないのか。実はまだ本当のところは理解できていないのですが、どうも seq は操作に気を付かわないと値の再計算が発生してしまうらしい。再計算させないためには「seq の要素を直接取り出さない」のが大事なようです。*1

再び @igetaさん

リンクを引用

// seealso: http://d.hatena.ne.jp/minazoko/20111204/1323007173
 
let distanceOfSameValueElements xs =
    Seq.scan (fun (i,dict) x -> match Map.tryFind x dict with
                                | None   -> i + 1, Map.add x i dict
                                | Some j -> i - j, Map.empty)
             (0, Map.empty)
             xs
    |> Seq.skip 1
    |> Seq.pick (fun (i,dict) -> if Map.isEmpty dict then Some i else None)

seq に対する逐次処理はこのようにシーケンス用の高階関数で要素を順に渡してもらうのがよさそうです。

*1:１回こっきりの処理ならべつにかまいませんが。ループが絡むとまずい。

F# の Project Euler 26 コードを改良した

昨日のエントリの続報です。

F#版改良コード

剰余シーケンス生成関数と、剰余の既出判定関数を一つにまとめました。パフォーマンスに悪影響を与えている疑惑がある 遅延シーケンス操作部分を無くすのが目的です。結果、桁違いに早くなりました。

前回 15 秒以上かかっていたものが、なんと、0.15 秒にまで縮まりました。100倍の高速化！...というか前のものが通常の 1/100 のダメコードだったわけですが。
F# の遅延シーケンスは Clojure と比べて取り扱いが難しいのかもしれません。

F# で Project Euler 26 を解いたら遅かった

問題はこれ : Problem 26

● F# での解答

何故か遅い。うちの環境だと 15秒以上かかる。
ideone.com で試したらやはり同じくらいかかっているようで、タイムアウトでプロセスを kill されてた。
recurringLength に 再帰回数が大きくなるような引数*1を与えると処理に時間がかかっているのがわかる。でも具体的な原因はよくわからない。

● Clojureでの解答

ほぼ同じアルゴリズムで Clojure にも移植してみた。こちらは一瞬で答えがでる。ideone.com では処理時間 0.88 sec でした。

● F# のコードを改良しました

こちらのエントリを御覧下さい

*1:大きい値と言ってもせいぜい数百回なんですけどね...

emacs lisp にも clojure の ->> が欲しいよね

試しに書いてみたんだけど、これはいいかも...

(require 'cl)

(defmacro my:-> (&rest exprs)
  (when exprs
    (reduce
     '(lambda (acc expr)
        (if (listp expr)
            (cons (car expr) (cons acc (cdr expr)))
          (list expr acc)))
     exprs)))

(defmacro my:->> (&rest exprs)
  (when exprs
    (reduce
     '(lambda (acc expr)
        (if (listp expr)
            (append expr (list acc))
          (list expr acc)))
     exprs)))

(defmacro my:flip (f a b)
  `(,f ,b ,a))

実行例

(my:->> (loop for x from 1 to 5 collect x)
        (mapcar '(lambda (x) (* x x)))
        (apply '+)
        (my:flip / 2.0))
;;=> 27.5

(my:->> (my:-> (loop for x from 1 to 50 by 2 collect x)
               (subseq 10 20))
        (mapcar 'number-to-string)
        (reduce '(lambda (acc x) (concat acc "," x))))

;;=> "21,23,25,27,29,31,33,35,37,39"

注意点

lisp-2 の elisp では関数を高階関数に渡す場合クォートが必要で、マクロに渡す場合はクォート不要です。ちょっと紛らわしい。上の例では、 my:flip がマクロなので除算関数 / にはクォートが不要。もし my:flip が関数だったら '/ としなければならない。

なお clojure とは実装が違うので挙動はまったく同じではないです。clojure の -> は無引数だとエラーになりますが、 my:-> はエラーにはならず nil になります。他にも違いがあるかも。