ifマクロ
Gaucheでifマクロを書いてみた。
マクロ名は if だとアレなので %if とする。
当然ながら if case cond といった分岐用特殊形式の使用は禁止。
else無指定への対応すると煩雑になるので２つに分けています。
(define-macro (%__if test then else) `((assoc-ref `((#t . ,(^() ,then)) (#f . ,(^() ,else))) (boolean ,test)))) (define-macro (%if test then . else) `($ %__if ,test ,then ,($ %__if (null? else) (undefined) (car else))))
thenとelseの式をサンクにするので名前付letの再帰は上手くいかないかな、と思いましたが大丈夫でした。
(let loop ((n 10) (acc 1)) (%if (zero? n) acc (loop (- n 1) (* acc n)))) ;; ループ呼び出しがサンクになってる。 ;;=> 3628800
ちなみにClojureで同様にしてrecurをサンクにすると上手くいきませんでした。recurのジャンプ先がloopではなくサンクを作っている fn になってしまうからですね。
(Gauche)バブルソート
今読んでいる数学ガールガロア理論がバブルソートにちょっとだけ触れていました。
考えてみるとバブルソートは何となく概要を知っている程度で、実装した記憶がありません。振り返るとバブルのつもりが結局挿入ソート的な物を書いて終わってることが多いような気がします。
そこで正式なバブルソートというものを調べてみました。
今回は、ベクタに適用すると、in place で破壊的にソートする関数を作ります。
１．二重ループでバブルソート
(define (vector-bubble-sort! vec :optional (swap? default-swap?)) (define len (vector-length vec)) (do ((head 0 (+ head 1))) ((>= head (- len 1)) vec) (do ((i (- len 1) (- i 1)) (k (- len 2) (- k 1))) ((<= i head)) (let ((vi (ref vec i)) (vk (ref vec k))) (when (swap? vk vi) (set! (ref vec i) vk) (set! (ref vec k) vi))))))
オーソドックスな二重ループです。
二重ループの外側のカウンタ head は配列先頭からインクリメント、内側のカウンター i kは配列の末尾からデクリメントしてゆくのが一般的のようです。headを移動することで「チェックが必要な未確定領域」を狭めてゆき、未確定領域内で末尾から先頭へ向かって「泡」が移動するようなイメージです。
オプショナルな第二引数は２つ要素をとり、swapすべきかどうか判定する関数です。
デフォルト定義はこうです、
(define default-swap? (.$ positive? compare))
.$ は compose 関数。つまりcompareしてpositive?判定する合成関数を作っています。compareは（多分）genericな関数なので、こう定義しておけばいろんなデータ型に対応できます。*1
実行
gosh> (vector-bubble-sort! #(2 7 1 8 2 8)) #(1 2 2 7 8 8) gosh> (vector-bubble-sort! #(2 7 1 8 2 8) >) #(1 2 2 7 8 8) gosh> (vector-bubble-sort! #(2 7 1 8 2 8) <) #(8 8 7 2 2 1)
判定関数が「成り立つときにswapする」ので、ソート後の並びは判定関数の向きと逆方向になります。組み込みの sort関数とは挙動が反対です。
分割
冒頭の関数を少し変形し、二つの関数に分割します。
;; ループを行う部分 (define (vector-bubble-sort! vec :optional (swap? default-swap?)) (define len (vector-length vec)) (do ((head 0 (+ head 1))) ((>= head (- len 1)) vec) (do ((i (- len 1) (- i 1))) ((<= i head)) (swap!-with-next-if swap? vec i))))
;; 判定と交換を行う部分 (define (swap!-with-next-if swap? v i) (let* ((k (- i 1)) (vk (ref v k)) (vi (ref v i))) (when (swap? vk vi) (set! (ref v i) vk) (set! (ref v k) vi))))
swap!-with-next-if はインデックス i の要素とその隣の要素を比較、交換します。隣(next)は一つ前(k)の要素を意味します。隣接要素の大小比較と交換。バブルソートの本質的な部分です。
この swap!-with-next-ifを、次でも使いまわします。
２．インデックスのリストを作る
隣接要素の大小比較と交換がバブルソートの本質、と書きましたが対象要素のインデックスの移動にも特徴があります。
他の多くの実用的なソートアルゴリズムではステップごとにその時点でのコレクション内のデータの状態を判定し、次に比較する要素を決定します。対象データの並びによって比較の順序が変わるのが普通です。
しかしバブルソートは、与えられたデータの内容にはお構いなしにいつも同じ順に処理していきます。インデックスの取る値に影響を与えるのはただ一つ、ソート対象のベクタのサイズだけです。
試しに、既に作ったバブルソート関数内にこんなトレス用の一行を加え実行します。
(format #t "~a " i)
4要素
gosh> (vector-bubble-sort! #(1 2 3 4)) 3 2 1 3 2 3 #(1 2 3 4) gosh> (vector-bubble-sort! #(1 9 0 1)) 3 2 1 3 2 3 #(0 1 1 9) gosh> (vector-bubble-sort! #(1 9 -100 1)) 3 2 1 3 2 3 #(-100 1 1 9)
5要素
gosh> (vector-bubble-sort! #(1 2 3 2 1)) 4 3 2 1 4 3 2 4 3 4 #(1 1 2 2 3) gosh> (vector-bubble-sort! #(9 9 9 9 9)) 4 3 2 1 4 3 2 4 3 4 #(9 9 9 9 9) gosh> (vector-bubble-sort! #(7 6 5 4 3)) 4 3 2 1 4 3 2 4 3 4 #(3 4 5 6 7)
要素数が同じであれば、インデックスの値の推移も同じであることが分かります。
ところで、これらのインデックスの並びは periodic なインデックス変化をflattenしたものです。
(4 3 2 1) (4 3 2) (4 3) (4) ↓ 4 3 2 1 4 3 2 4 3 4
挿入したトレス出力処理が「今何度目のループか」を意識していないため一続きのリストになってしまったのです。この一本のインデックスリストを手に入れることができれば、あとはそれに沿って比較・交換をすることでバブルソートになります。
インデックスをリストアップしてから１ループで処理
(use srfi-1) ; unfold (define (lis:vector-bubble-sort! vec :optional (swap? default-swap?)) (begin0 vec (let* ((last-index (- (vector-length vec) 1)) (i-list ($ concatenate $ unfold (.$ not positive?) (cut iota <> last-index -1) (cut - <> 1) last-index))) (for-each (pa$ swap!-with-next-if swap? vec) i-list))))
i-listを作る処理は実質的には二重ループですが、i-listという１本のリストさえできれば、その後の for-each はとても単純になります。i-listの中身は、同じ要素数のベクタなら常に同じなので、繰り返しソートする場合には i-listを保存しておいて何度も使いまわせまます。
cut はラムダと部分適用のあいのこのようなマクロです。 <> が引数を受け取るプレースホルダになり、
(cut iota <> last-index -1)
は
(lambda (x) (iota x last-index -1))
に展開されます。
３. listの代わりにgeneratorを使う
バブルソートをこの形にするとリストじゃなくても「リストのようにシーケンシャルにデータを提供する何か」があれば同じことができます。あらかじめすべてのインデックスをリストに作りこむのはメモリの無駄だ、と思うならリストの代わりにジェネレータにするとよいでしょう。
(use gauche.generator) (define (gen:vector-bubble-sort! vec :optional (swap? default-swap?)) (begin0 vec (let* ((last-index (- (vector-length vec) 1)) (i-gen ($ gconcatenate $ gunfold (.$ not positive?) (cut giota <> last-index -1) (cut - <> 1) last-index))) (generator-for-each (pa$ swap!-with-next-if swap? vec) i-gen))))
一部の関数をgenerator版にしただけですね。構造はまったく同じです。
(Gauche) sort における #"|a|" の(?) 謎挙動
[追記] 本件、早々に突っ込みをいただきました。
@mnzktw #"|a|" は只の定数文字列"|a|"になるので、比較関数が引数に関わらず定数値を返しているためだと思います。多分意図したのは #"~|a|" じゃないでしょうか。
— Kilo Kawai (@anohana) 2014, 10月 11#"|a|" ではなく、 #"~|a|" または #"~a" とするのが正解。ただの書式記憶違いでした。
以下、元記事。
feature identifierの列挙の方法を教えてもらったので弄ってたら謎の挙動に遭遇。
srfiで始まる定義済みシンボルを抽出。
(use r7rs) (import scheme.base) (define features-srfi (filter (.$ #/srfi/ x->string) (features)))
ソート
(sort features-srfi (^[a b] (string<? #"|a|" #"|b|")))
評価
(srfi-0 srfi-1 srfi-2 srfi-4 srfi-5 srfi-6 srfi-7 srfi-8 srfi-9 srfi-10 srfi-11 srfi-13 srfi-14 srfi-16 srfi-17 srfi-18 srfi-19 srfi-22 srfi-23 srfi-25 srfi-26 srfi-27 srfi-28 srfi-29 srfi-30 srfi-31 srfi-34 srfi-35 srfi-36 srfi-37 srfi-38 srfi-39 srfi-40 srfi-42 srfi-43 srfi-45 srfi-55 srfi-61 srfi-62 srfi-87 srfi-95 srfi-98 srfi-99 srfi-106)
綺麗に並びすぎじゃないですか？
だって、こうすると、
(sort features-srfi (^[a b] (string<? (x->string a) (x->string b))))
(srfi-0 srfi-1 srfi-10 srfi-106 srfi-11 srfi-13 srfi-14 srfi-16 srfi-17 srfi-18 srfi-19 srfi-2 srfi-22 srfi-23 srfi-25 srfi-26 srfi-27 srfi-28 srfi-29 srfi-30 srfi-31 srfi-34 srfi-35 srfi-36 srfi-37 srfi-38 srfi-39 srfi-4 srfi-40 srfi-42 srfi-43 srfi-45 srfi-5 srfi-55 srfi-6 srfi-61 srfi-62 srfi-7 srfi-8 srfi-87 srfi-9 srfi-95 srfi-98 srfi-99)
そうそう、文字列で比較してるからこうなるハズ...
ちなみにこれだと、
(sort '(srfi-8 srfi-9 srfi-10 srfi-11) (^[a b] (string<? #"|a|" #"|b|")))
(srfi-11 srfi-10 srfi-9 srfi-8)
あ、そうなるんだ... あれぇ？
参考までにうちの環境
(gauche.ces.utf8 gauche.sys.setenv gauche.sys.nanosleep gauche.sys.select gauche gauche-0.9.4 gauche.os.windows gauche-windows r7rs exact-closed ieee-float full-unicode ratios windows little-endian gauche.sys.threads gauche.sys.wthreads gauche.net.tls gauche.net.tls.axtls ... )
