Code Aquarium

minazoko's blog -*- 水底のブログ -*-

(Gauche)バブルソート

今読んでいる数学ガールガロア理論バブルソートにちょっとだけ触れていました。
考えてみるとバブルソートは何となく概要を知っている程度で、実装した記憶がありません。振り返るとバブルのつもりが結局挿入ソート的な物を書いて終わってることが多いような気がします。

そこで正式なバブルソートというものを調べてみました。
今回は、ベクタに適用すると、in place で破壊的にソートする関数を作ります。

1.二重ループでバブルソート

(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を移動することで「チェックが必要な未確定領域」を狭めてゆき、未確定領域内で末尾から先頭へ向かって「泡」が移動するようなイメージです。

オプショナルな第二引数は2つ要素をとり、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を、次でも使いまわします。

2.インデックスのリストを作る

隣接要素の大小比較と交換がバブルソートの本質、と書きましたが対象要素のインデックスの移動にも特徴があります。
他の多くの実用的なソートアルゴリズムではステップごとにその時点でのコレクション内のデータの状態を判定し、次に比較する要素を決定します。対象データの並びによって比較の順序が変わるのが普通です。
しかしバブルソートは、与えられたデータの内容にはお構いなしにいつも同じ順に処理していきます。インデックスの取る値に影響を与えるのはただ一つ、ソート対象のベクタのサイズだけです。
試しに、既に作ったバブルソート関数内にこんなトレス用の一行を加え実行します。

      (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

挿入したトレス出力処理が「今何度目のループか」を意識していないため一続きのリストになってしまったのです。この一本のインデックスリストを手に入れることができれば、あとはそれに沿って比較・交換をすることでバブルソートになります。

インデックスをリストアップしてから1ループで処理

(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という1本のリストさえできれば、その後の for-each はとても単純になります。i-listの中身は、同じ要素数ベクタなら常に同じなので、繰り返しソートする場合には i-listを保存しておいて何度も使いまわせまます。
cut はラムダと部分適用のあいのこのようなマクロです。 <> が引数を受け取るプレースホルダになり、

(cut iota <> last-index -1)

(lambda (x) (iota x last-index -1))

に展開されます。

3. 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版にしただけですね。構造はまったく同じです。

*1:ベクタの要素がすべて同じ型か、互いに比較可能な型である必要はあります