赤黒木 (10)

gauche

帰宅後も赤黒木。イキオイがついてしまって止まらない。
次は case 8b. same, except left/right swapped という試験。以下の状態から

  ;;          R:-3 => -3
  ;;        B:-2 => -2
  ;;      R:-1.5 => -1.5
  ;;        B:-1 => -1
  ;;    B:0 => 0
  ;;        B:1.5 => 1.5
  ;;      R:2 => 2
  ;;        B:3 => 3

key が -1 な node を削除しています。直前のヤツの逆版なのかな。復習も兼ねて順に確認。まず delete-node! 手続きから。

(define (delete-node! tree z)
  (let1 z (if (and (not (nil? (left z))) (not (nil? (right z))))
            (let1 y (successor z)
              (set! (ref z 'key) (ref y 'key))
              (set! (ref z 'value) (ref y 'value))
              y)
            z)

key が -1 な node は子供ナシなので z はそのまま削除対象 node です。

    (let ((x (left* z (not (nil? (left z)))))
          (p (parent z)))
  • z の左 node は nil なので右を、なのですがこちらも無いので x は nil
  • z の親 node は key が -1.5 な node で p はこれを指すよう設定

で、

      (unless (nil? x)
        (set! (parent x) p))

x は nil なのでスルー。

      (if (nil? p)
        (set! (root-of tree) x)
        (set! (left* p (eq? z (left p))) x))

p は nil ではないので p の 右 (key が -1 な要素は p の右) が x (nil) を指すよう設定されます。

      (when (black? z)
        (delete-fixup! tree x p))

削除対象が黒だと delete-fixup! が呼び出されます。以降は削除対象 node の属性の設定ですね。

      (set! (left z) #f)
      (set! (right z) #f)
      (set! (parent z) #f))))

delete-fixup! 確認します。x は nil で p は削除対象の親 node である key が -1.5 なソレ。色は赤です。

(define (delete-fixup! tree x p)
  (let loop ((x x) (p p))
    (if (or (nil? p) (red? x))
      (unless (nil? x)
        (paint-black! x))

x は nil なので then ブロックはスルーで。

      (let1 b (eq? x (left p))
        (let1 w (let1 w (right* p b)
                  (if (red? w)
                    (begin (paint-black! w)
                           (paint-red! p)
                           (left-rotate! tree p b)
                           (right* p b))
                    w))
  • ここでは b は #f ですね (p の左要素は nil ではない)。
  • 最初の w は p の左要素 (key が -2)
  • key が -2 な要素の色は黒です

ということで w は key が -2 の要素を指してる状態で以下なのかな。

          (if (and (black? (left w)) (black? (right w)))
            (begin (paint-red! w)
                   (loop p (parent p)))

key が -2 な要素は左の要素は赤だし右の要素は nil なので文句無しに else なブロックが、という事になります。

            (let1 w (if (black? (right* w b))
                      (begin (unless (nil? (left* w b))
                               (paint-black! (left* w b)))
                             (paint-red! w)
                             (right-rotate! tree w b)
                             (right* p b))
                      w)

このあたりキツいな。

  • b は #f なので w の左は key が -3 ですが色が赤

ということで w はそのままか。後は以下を云々なのか。

              (set! (ref w 'color)
                    (if (nil? p) 'black (ref p 'color)))
              (paint-black! p)
              (paint-black! (right* w b))
              (left-rotate! tree p b)
              (paint-black! (root-of tree)))))))))

ええと、

  • w (key が -2 の要素) の色を p (key が -1.5 の要素) の色 (赤) に
  • p (key が -1.5 の要素) の色を黒に
  • w の左 (key が -3 の要素) の色を黒に

して left-rotate! を呼び出して root の色を黒にしてます。なんとなく結論は見えてますが left-rotate! を確認。

(define (left-rotate! tree x b)
  (let1 y (right* x b)
    (set! (right* x b) (left* y b))
  • x (key が -1.5 の要素) の左 (b は #f) を y の保管
    • これは key が -2 の要素になるのか
  • x の左の要素を y (key が -2 の要素) の右 (は nil) を指すよう設定
    (unless (nil? (left* y b))
      (set! (parent (left* y b)) x))

y (key が -2 の要素) の右は nil なのでスルー

    (set! (parent y) (parent x))
  • key が -2 の要素の親は key が -1.5 の要素の親にする
    • y から見ると y の親は root になる
    (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)))

ええと、root の要素の左が y (key が -2 の要素) になりますね。

    (set! (left* y b) x)
    (set! (parent x) y)))
  • y (key:-2) の右に x (key:-1.5) を設定
  • x (key:-1.5) の親は y (key:-1.5)

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

  ;;        B:-3 => -3
  ;;      R:-2 => -2
  ;;        B:-1.5 => -1.5
  ;;    B:0 => 0
  ;;        B:1.5 => 1.5
  ;;      R:2 => 2
  ;;        B:3 => 3

case 6

次行きます。以下とのこと。

  ;;   case 6.  deleting red node w/ both children
  ;;            In our implementation, the node is first replaced by
  ;;            its previous node until we get a single-child case,
  ;;            then the balancing is applied.  In this particular case
  ;;            it degenerates to the deletion of a black node whose
  ;;            parent is red and whose sibling is black.

むむ、良く分からんな。以下な状態から

  ;;        B:-3 => -3
  ;;      R:-2 => -2
  ;;        B:-1.5 => -1.5
  ;;    B:0 => 0
  ;;        B:1.5 => 1.5
  ;;      R:2 => 2
  ;;        B:3 => 3

key が 2 な要素を削除する模様です。確認します。これは delete-node! で

  (let1 z (if (and (not (nil? (left z))) (not (nil? (right z))))
            (let1 y (successor z)
              (set! (ref z 'key) (ref y 'key))
              (set! (ref z 'value) (ref y 'value))
              y)
            z)

な if の条件式が真になるパターンかな。つうことは successor という手続きが何なのかを確認せねば。ということで以下を見つけたんですが

(define-values (successor predecessor)
  (let1 tmpl (lambda (dir proc)
               (lambda (node)
                 (if (not (nil? (dir node)))
                   (proc (dir node))
                   (let loop ((x node)
                              (y (parent node)))
                     (if (and (not (nil? y)) (eq? x (dir y)))
                       (loop y (parent y))
                       y)))))
    (values (tmpl right minimum) (tmpl left maximum))))

ええと、define-values とかその引数はスルーで。戻される多値は手続きの、なのかな。む、これは

  • successor に (tmpl right minimum) が割り当てられて
  • predeccessor に (tmpl left maximum) が割り当てられる

という理解で良いのかどうか。それぞれ node を引数に、な手続きです。

とりあえづ

今日はもう限界気味。明日の #geektable では赤黒木の話はできんか残念。