赤黒木 (9)
今日も朝練。削除のナニはソース未確認なのでちょい時間かかりそげ。
とりあえず
ソースを見つつテストケイスを確認。いっこめは
;; R:-2 => -2 ;; B:-1.5 => -1.5 ;; R:-1 => -1 ;; B:0 => 0 ;; R:1 => 1 ;; B:1.5 => 1.5 ;; R:2 => 2
という状態から key が 2 な node を削除。赤い node はそのまま消しちゃって OK なのか。
;; Deletion. ;; case 1. deleting the leaf red node. ;; R:-2 => -2 ;; B:-1.5 => -1.5 ;; R:-1 => -1 ;; B:0 => 0 ;; R:1 => 1 ;; B:1.5 => 1.5
ええと、rbtree-delete! 手続きの定義ですが
- key が存在して
- かつ、葉でない
時に delete-node! を呼び出す、という保険がかかってます。
(define (rbtree-delete! tree key)
(guarantee-rbtree tree)
(and-let* ((node (get-node tree key))
( (not (nil? node)) ))
(delete-node! tree node)
#t))で、delete-node! が削除対象の 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)これ、削除対象の node の左右両方に node (葉というか nil でない) がぶら下がってるかどうか、という条件なのか。ここでは偽なので詳細スルー。
(let ((x (left* z (not (nil? (left z)))))
(p (parent z)))削除では変数で left* とか right* とかに渡すソレを抽象化できなかったのかな。それは良いのですが、x には key が 2 な node の右側 (左の要素が nil なので) の要素を指す形、p は key が 1.5 な node を指す形になるのかどうか。
で、以降を順に見てみますと
(unless (nil? x)
(set! (parent x) p))
(if (nil? p)
(set! (root-of tree) x)
(set! (left* p (eq? z (left p))) x))
- 削除対象要素の右又は左 (左が存在したら左、という形なので左優先って考えて良いのかどうか) が nil でなければその親を削除対処要素の親にして
- 削除対象要素の親が nil (削除対象要素が root) であれば
- 削除対象要素の右又は左を root にして
- 削除対象要素の親と子のリンクを設定
してますが、ちょっとイメージできない。最後のソレが。ちょっとここはスルーします。以降最後まで順に以下。
(when (black? z)
(delete-fixup! tree x p))
(set! (left z) #f)
(set! (right z) #f)
(set! (parent z) #f))))順に列挙します。
- 削除対象が黒要素なら delete-fixup! という手続きを呼び出してます。ここでは削除対象赤なのでスルー。
- 削除対象要素の各属性を #f にしてます
- left および right および parent
- これ、削除対象要素の親 (p) から削除対象要素へのリンクが残ったままに見えますね
うーん、やっぱ
(if (nil? p)
(set! (root-of tree) x)
(set! (left* p (eq? z (left p))) x))の最後のソレは if なブロックの中にあってはいけない気がしてます。違うかな。あ、下側の set! は else なブロックになるんでした。わははは。
てことは削除対象に関するリンクが全部切れるので OK ですね。
case 8a.
コメントを以下に引用。
;; case 8a. deleting the leaf black node. ;; parent is red, sibling is black.
以下なツリーの key が 1 の要素を削除する模様。
;; R:-3 => -3 ;; B:-2 => -2 ;; R:-1.5 => -1.5 ;; B:-1 => -1 ;; B:0 => 0 ;; B:1 => 1 ;; R:1.5 => 1.5 ;; B:2 => 2 ;; R:3 => 3
コメントにあるように黒要素な末端 node で親は赤です。削除した後は以下になる模様。
;; 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
偏った状態になるので部分木をアレしてますね。left-rotate! になるのかな。ともあれ確認します。let の類で以下な初期設定が行われて
- z は末端 node なのでそのまんま
- x についても同様で z は末端 node なので nil
- p は key が 1.5 な node がセットされる
順に以下がナニ。
- p は nil ではないので p の左は nil になる
- z は赤なので delete-fixup! 手続きが呼び出される
- z の left、right、parent なリンクが #f になる
む、delete-fixup! には x と p が渡されるんですね。
(when (black? z)
(delete-fixup! tree x p))ええと、再度確認しておくと
- x は削除対象 node の左 (左が nil なら右) の要素
- 今は子供の要素は両方 nil なので nil
- p は削除対象 node の親の要素
ということになっているはず。順に見ていきます。
(define (delete-fixup! tree x p)
(let loop ((x x) (p p))
(if (or (nil? p) (red? x))
(unless (nil? x)
(paint-black! x))ありゃ。さっき確認したソレによれば上記 if の条件は偽ですね。つうか
- 親要素が nil (削除対象が root) または
- 削除対象 node の左 (左が nil なら右) の要素が赤
って、削除対象が一人しかいない root だったらどうなるんでしょ。あ、何もしなくて終わるのか。p は nil で x も nil なのか。
ということで、これ以降の部分を確認すれば良いのか。
(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))う、p (削除対象の親 node) の左が x (削除対象 node の左 (左が nil なら右) の node) てあり得るの? って思ったら呼び出し元で設定してますね。
(if (nil? p)
(set! (root-of tree) x)
(set! (left* p (eq? z (left p))) x))つうことは b が false になるのは削除対象 node が root な場合、なのかな。あ、違うか。必ずしも左に、ではありませんね。
む、b はその下の let1 で早くもキいてくるのか。親要素の x じゃない方の要素を w に格納して、それが赤かどうかを判定してますね。
赤でなければ w をそのまま使うのか。ちょっとこのあたりの細かい部分はスルーします。とりあえずトレイスに戻る (何かをヤりかけてハマったorz)。
ええと、上の let1 なネストで b は #t が、w は key が 2 の要素を指している形になるのかどうか。これを前提に以下。
(if (and (black? (left w)) (black? (right w)))
w が指してる要素は子供が片方居ないのでこの条件式は偽になるはず。else なブロックで再び 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 の右は赤なので 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 の色 (赤) に
- p は黒に
- w の右の要素 (key が 3 のソレ) を黒に
で left-rotate! を呼び出しててっぺんを黒にしてますね。部分木の形で表現すると以下な形になってるはずです。
R:1.5
B:2
R:3で p は key が 1.5 の要素をさしてます。色の変更で以下になるのか。
B:1.5
R:2
B:3で、left-rotate! で以下になる、と。
B:1.5 R:2 B:3
現時点で未通過なパスは 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)ここも通っていないか。
(let ((x (left* z (not (nil? (left z)))))
(p (parent z)))
(unless (nil? x)
(set! (parent x) p))x が nil でないケイスというのがあるのかどうか。次は delete-fixup! で
(if (or (nil? p) (red? x))
(unless (nil? x)
(paint-black! x))あるいは w が赤の場合のナニとか
(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))右も左も黒の場合とか
(if (and (black? (left w)) (black? (right w)))
(begin (paint-red! w)
(loop p (parent p)))あと以下の let の中の if の条件が真、というケイスもまだのはず。
(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)まだまだ先は長いな。ちょっと中断。
