赤黒木 (12)
朝練メモ。ちょっと間が空いたのですが続きを。一旦仕切り直しで再開。case 5. からです。最初の状態は以下で
;; B:-3 => -3 ;; B:-2 => -2 ;; B:-1.5 => -1.5 ;; B:0 => 0 ;; R:0.5 => 0.5 ;; B:1 => 1 ;; B:2 => 2 ;; B:2.5 => 2.5 ;; R:3 => 3 ;; B:3.5 => 3.5 ;; R:4 => 4
ここから -3 な要素を削除する模様です。これ、回転の末に root なソレが代わるみたいです。たしかに root 要素を代えるくらい回転させないと駄目そうに見えます。
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)z の子供は両方 nil です。ので z はそのまま。
(let ((x (left* z (not (nil? (left z)))))
(p (parent z)))x は nil で p は key が -2 の要素になります。
(unless (nil? x)
(set! (parent x) p))スルー。
(if (nil? p)
(set! (root-of tree) x)
(set! (left* p (eq? z (left p))) x))(z の親の) p の左側要素は nil になります。
(when (black? z)
(delete-fixup! tree x p))z は黒なので delete-fixup! 手続き突入。回転必須なのでここに入らないとアレですね。x は nil で p は z の親要素を指してます。
(define (delete-fixup! tree x p)
(let loop ((x x) (p p))
(if (or (nil? p) (red? x))
(unless (nil? x)
(paint-black! x))p は nil ではなく、x も赤ではないのでスルー。
(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))ええと、x と p の左は nil なので b は #t ですね。そして p の右側要素は赤ではないので、w は key が -1.5 の要素を指します。
(if (and (black? (left w)) (black? (right w)))
(begin (paint-red! w)
(loop p (parent p)))w の左右は nil で両方黒判定されますので then ブロックが評価されます。w が赤になって親のそのまた親を指す形で loop を呼び出してます。p が key が 0 の root 要素を、x が key が -2 の要素を指してる形。
(if (or (nil? p) (red? x))
(unless (nil? x)
(paint-black! x))条件式は両方偽ですね。
(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))x は p の左側要素なので b は #t になります。w は p の右側要素になるので key が 2 の node ですね。赤ではありません。
(if (and (black? (left w)) (black? (right w)))
(begin (paint-red! w)
(loop p (parent p)))w の右側要素が赤なのでここはスルーですね。
(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)で、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 の色は p が nil でなければ p と同じ色
- p を黒に
- w の右 (key が 3 の要素) を黒に
した上で left-rotate! が呼び出されます。p は root な要素で b は #t です。この時点の tree は以下なイメージ (のはず)。
;; B:-2 => -2 ;; R:-1.5 => -1.5 ;; B:0 => 0 ;; R:0.5 => 0.5 ;; B:1 => 1 ;; B:2 => 2 ;; B:2.5 => 2.5 ;; B:3 => 3 ;; B:3.5 => 3.5 ;; R:4 => 4
順に見ていきます。
(define (left-rotate! tree x b) (let1 y (right* x b)
y には root の右要素 (key が 2) を指します。
(set! (right* x b) (left* y b))
(unless (nil? (left* y b))
(set! (parent (left* y b)) x))
(set! (parent y) (parent x))
- x (root 要素で key が 0) の右を y (root 要素の右要素で key が 2) の左の要素 (key が 1) にしてます
- 逆のリンクも張りかえてます
- そして y の親を x の親にしています。
(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)))で、x は root 要素で親は nil なので y を root にしてますね。これで x と y が交代しました。
(set! (left* y b) x)
(set! (parent x) y)))最後に
- y の左が x
- x の親は y
という形で x - y 間のリンクも張りなおして終了。以下な形になります。
;; B:-2 => -2 ;; R:-1.5 => -1.5 ;; B:0 => 0 ;; R:0.5 => 0.5 ;; B:1 => 1 ;; B:2 => 2 ;; B:2.5 => 2.5 ;; B:3 => 3 ;; B:3.5 => 3.5 ;; R:4 => 4
なんか平衡になってる感。で、delete-node! に戻って z のリンクを全部切って終了なんでしょうか。
(set! (left z) #f)
(set! (right z) #f)
(set! (parent z) #f))))試験のコメントによればこれで当たりですね。
しかしこれ
全部のケイスを通過するよう試験書くのとか超面倒だな。
