赤黒木 (7)

昨晩へろへろで中途半端な手を止めてたら Shiro さんから適切なツッコミが。
スミマセン。何をチェックしてたかが気になったもので。。とゆーことで朝練でこちら方面確認します。

つうか

確認としては test/treemap.scm のテスツを見つつ rui さんが作られた実装でどーなるか、を確認すれば良いのか。Gauche の C 実装はとりあえずスルーします。つうか SICP 読んでる琉大 ie な方々はこちら方面興味無いかなぁ。
てことで順に確認です。

  ;; Insertion
  ;;  case 0. adding to an empty tree
  ;;    B:0
  (test* "insertion case 0" #t (begin (i 0) (c)))

ここでは rbtree-put! の tree was empty な分岐を通過します。

            ((nil? y)                   ; tree was empty
             (set! (root-of tree)
                   (make <node> :key key :value val :color 'black)))

次は要素を一つ追加。

  ;;  case 2. adding to a black parent.
  ;;    B:0
  ;;      R:1
  (test* "insetrion case 2" #t (begin (i 1) (c)))

まず以下のブロックを通過します。

      (cond ((not (nil? x))
             (cond ((key=? key (ref x 'key))
                    (set! (ref x 'value) val))
                   ((key<? key (ref x 'key))
                    (loop (left x) x))
                   (else (loop (right x) x))))

ここで loop に渡す最初の引数が nil (葉に到達した) または同一 key の node が存在するまで繰り返していることが分かります。

  • 同一 key な node が存在したら値を更新して終わり
  • key の値によって右または左の node を loop に渡す

という形です。で、末端に到達した時点で else なブロックを通過します。ええと、第一引数は nil で、第二引数は nil ではない、という形。

            (else
             (let1 node (make <node> :key key :value val :color 'red :parent y)
               (if (key<? key (ref y 'key))
                 (set! (left y) node)
                 (set! (right y) node))
               (put-fixup! tree node)))))))

で、node なオブジェクトを生成して key の値によって右または左に置いて put-fixup! 手続きを呼び出しています。tree なオブジェクトと生成した node なオブジェクトを渡しているのが分かります。
ちなみに新規作成な node は上記の通り、基本的に_赤_な node ということになります。
で、put-fixup! ですが、ざっくり構造は以下になってます。

(define (put-fixup! tree z)
  (let loop ((z z))
    (when (red? (parent z))
      ;; 親が赤い node の場合の処理 
      ))
  (paint-black! (root-of tree)))

ええと、この case 2. な試験は親 node が黒なのでそのまま tree の root を黒にしておしまい、という形になります。上記の通り、新規追加な node は赤なんですが、追加される時に親 node が黒の場合は回転とか色の変更とかは一切発生しない形になります。
次はちょっと大変かも。

  ;;  case 3&1. adding to a red parent, while uncle is also red.
  ;;        R:-2
  ;;      B:-1
  ;;    B:0
  ;;      B:1
  ;;        R:2
  (test* "insertion case 3&1" #t (begin (i -1 -2 2) (c)))

3 件追加な上、色もかわってますね。ぱっと見回転は入ってないように見えますね。ええと、先に見たとおり、-1 が追加された時点では以下な形になっているはずです。

  ;;      R:-1
  ;;    B:0
  ;;      R:1

で、大変なのはここからでまず -2 な要素が追加。以下な形になって put-fixup! が呼び出されるのかな。

  ;;        R:-2
  ;;      R:-1
  ;;    B:0
  ;;      R:1

順に見ていきます。

(define (put-fixup! tree z)
  (let loop ((z z))
    (when (red? (parent z))
      (let* ((b (eq? (parent z) (left (parent (parent z)))))
             (y (right* (parent (parent z)) b)))

まず、(parent z) は赤ですので、let* が評価されます。新規追加な node の親はそのまた親の左側の要素なので b は真。また、y は key が 1 の要素を指す形になります。

        (if (red? y)
          (begin
            (paint-black! (parent z))
            (unless (nil? y) (paint-black! y))
            (paint-red! (parent (parent z)))
            (loop (parent (parent z))))

y は赤なので

  • 新規追加 node の親を黒に
  • y は nil でないので y も黒に
  • 新規追加 node の親の親 (root な node) を赤に

して root な node を loop に渡します。で、z の親はおりませんので

  (let loop ((z z))
    (when (red? (parent z))

な条件は偽。root の要素を黒にして -2 の追加は終了となって以下な形になりますか。

  ;;        R:-2
  ;;      B:-1
  ;;    B:0
  ;;      B:1

3 歩で末端まで到達できますので大丈夫ですね。ちなみに次の 2 な要素の追加ですが、親 node が黒なのでスルーします。まだ追加するパターンで回転は入っていませんが、次で出てくるのかどうなのか。

  ;;  case 5b. adding to a red parent, while uncle is black.
  ;;           new node is on the right side of parent,
  ;;           while parent is the left side of grandparent.
  ;;           this goes through rotate_left, then rotate_right.
  ;;        R:-2 => -2
  ;;      B:-1 => -1
  ;;    B:0 => 0
  ;;        R:1 => 1
  ;;      B:1.5 => 1.5
  ;;        R:2 => 2
  (test* "insertion case 5b" #t (begin (i 1.5) (c)))

ええと最初は以下な状態なのか。

  ;;        R:-2
  ;;      B:-1
  ;;    B:0
  ;;      B:1  R:1.5
  ;;        R:2

この場合、親はそのまた親の右にあたるので b は偽。親の対面 (そのまた親の左の要素) を y が指すんですが値としては nil ですね。なのでとりあえず以下なブロックが評価されることになるのか。

          (let1 z (if (eq? z (right* (parent z) b))
                    (begin0 (parent z)
                            (left-rotate! tree (parent z) b))
                    z)
            (paint-black! (parent z))
            (paint-red! (parent (parent z)))
            (right-rotate! tree (parent (parent z)) b))))))

たしかこのケイスだといったん left-rotate! で

  ;;      B:1
  ;;        R:1.5
  ;;          R:2

という形にしてから right-rotate! で

  ;;        R:1
  ;;      B:1.5
  ;;        R:2

こんなカンジにしてるはず。とりあえず left-rotate! から確認。呼び出しは以下な形になっています。

                            (left-rotate! tree (parent z) b))

追加した要素の親を第二引数で渡してます。b は偽です。

(define (left-rotate! tree x b)
  (let1 y (right* x b)
    (set! (right* x b) (left* y b))
    (unless (nil? (left* y b))
      (set! (parent (left* y b)) x))
    (set! (parent y) (parent x))

y は key が 1.5 な新規追加要素を指すのか。let1 の直下三行はスルーで良いはず。で、y (key が 1.5) の親は x (key が 2) の親 (key が 1) としてます。
以降は列挙してやれ。

  • x はその親の右側の要素なので x の親の右側要素として y を登録
  • y の右側要素として x を登録
  • x の親要素として y を登録

実装な記述としては以下の部分になります。

    (cond ((nil? (parent x))
           (set! (root-of tree) y))
          ((eq? x (left* (parent x) b))
           (set! (left* (parent x) b) y))
          (else
           (set! (right* (parent x) b) y)))
    (set! (left* y b) x)
    (set! (parent x) y)))

これで以下な形になります。

  ;;      B:1
  ;;        R:1.5
  ;;          R:2

left-rotate! が実行されたら z は key が 2 の要素を指す形になってます。その上で色が変えられます。

            (paint-black! (parent z))
            (paint-red! (parent (parent z)))

これでこうなるのか。

  ;;      R:1
  ;;        B:1.5
  ;;          R:2

で、right-rotate! を経由して left-rotate! が呼び出されるんですが

            (right-rotate! tree (parent (parent z)) b))))))

x には key が 1 の要素、b には真がセットされます。これも面倒になってきたので処理を列挙するのみで。

  • y には key が 1.5 な要素がセット
  • y の親は x の親 (key が 0) がセット
  • x の親 (key が 0) の右側要素として y (key が 1.5) がセット
  • y (key が 1.5) の左要素として x (key が 1) が設定
  • x (key が 1) の親として y (key が 1.5) がセット

で、確かに以下になりますね。

  ;;        R:1
  ;;      B:1.5
  ;;        R:2

冗長でスミマセン。でもやっぱ

    (set! (right* x b) (left* y b))
    (unless (nil? (left* y b))
      (set! (parent (left* y b)) x))

が有効なケイスはここまで出てきていないので、あり得ないケイスなのかどうか。あ、まだ挿入な試験がいくつかありますね。

時間切れ

あと二つくらい挿入なテストがありますが、こちらは別途確認の方向。あとは削除が確認できればざっくり分かった、ってことにできるのかどうか。