赤黒木 (16)
昨日のソレは大嘘で下記から B:1 を削除してから
;; B:-1.5 => -1.5 ;; R:-1 => -1 ;; B:-0.5 => -0.5 ;; B:0 => 0 ;; B:1 => 1 ;; B:2 => 2 ;; B:2.5 => 2.5 ;; B:3 => 3 ;; B:3.5 => 3.5 ;; R:4 => 4
B:2 および B:-1 を削除せねば、な模様。
頑張って最後までいけるのかどうなのか。とりあえず B:1 を削除してみます。
(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)B:1 は子供は居ないので z はそのまま。
(let ((x (left* z (not (nil? (left z)))))
(p (parent z)))x は z の右側の nil で、p は B:0 の要素。
(unless (nil? x)
(set! (parent x) p))スルー。
(if (nil? p)
(set! (root-of tree) x)
(set! (left* p (eq? z (left p))) x))p は nil ではないので、p の右側要素は x (nil) なリンク作成。
(when (black? z)
(delete-fixup! tree x p))z は黒なので delete-fixup! します。
(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))ええと、p の左は x でないので b は #f になります。で、w は p の左 (R:-1) がセットされますがこれ、赤ですね。部分木ですが以下になるのかな。
B:-1.5
B:-1
B:-0.5
R:0
B:1left-rotate! に渡される p は上で言うと R:0 で b は #f です。
(let1 y (right* x b)
x は p です。左の要素なので B:-1 を y で参照。
(set! (right* x b) (left* y b))
ええと、x (R:0) の左側を y (B:-1) の右要素に、なリンク設定。
(unless (nil? (left* y b))
(set! (parent (left* y b)) x))y の右要素は nil ではないので逆のリンクも設定します。
(set! (parent y) (parent x))
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 の親からのリンクを y に設定してます。最後に
(set! (left* y b) x)
(set! (parent x) y)))y の右を x にして x の親を y にして以下な部分木になると思われます。
B:-1.5
B:-1
B:-0.5
R:0
B:1
B:2どうも left-rotate! きちんと整理できていない。こうなった上で、delete-fixup! に戻って以下。
(right* p b))
ええと、p は R:0 な要素なので左の B:-0.5 が w になる模様。
(if (and (black? (left w)) (black? (right w)))
(begin (paint-red! w)
(loop p (parent p)))w は末端要素なので両方の子供が黒。w (B:-0.5) が赤になって p の親 (B:-1) を渡して繰り返し。
(let loop ((x x) (p p))
(if (or (nil? p) (red? x))
(unless (nil? x)
(paint-black! x))ええと、x は (R:0) の要素で p は (B:-1) な要素なのか。そして x が赤で nil でないので x が黒く塗られて終了。最後に削除対象から伸びるリンクを切って終わり。
(set! (left z) #f)
(set! (right z) #f)
(set! (parent z) #f))))tree は以下になっているはず。
;; B:-1.5 => -1.5 ;; B:-1 => -1 ;; R:-0.5 => -0.5 ;; B:0 => 0 ;; B:2 => 2 ;; B:2.5 => 2.5 ;; B:3 => 3 ;; B:3.5 => 3.5 ;; R:4 => 4
平衡になってるはず。しかし凄いな。で、ここから root な 2 を削除して次に -1 な要素を削除、なのか。
とりあえず 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)B:2 な z は両方子供が居ますので y は B:2.5 な要素へのリンクになるのか。で、root な要素は 2.5 てことになり、z は元々 B:2.5 な要素へのリンクになります。
(let ((x (left* z (not (nil? (left z)))))
(p (parent z)))z には子供は居ないので x は nil (右側要素) で p は B:3 な要素を指す形になります。
(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))ええと、B:2.5 なソレは B:3 の左要素になってて親からそこへのリンクが切れます。
(when (black? z)
(delete-fixup! tree x p))z は黒なので delete-fixup! が呼び出されるのか。
(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 の左なので b は #t です。そして w は一旦 B:3.5 な要素を指す形になりますが、そのままで w にセットされる模様。
(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 の右側要素が赤なので 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 の右を黒 (R:4 -> B:4)
で、left-rotate! して root を黒にしてます。left-rotate! 直前は以下なカンジ。
B:2
B:3
B:3.5
B:4p は B:3 を指してて b は #t です。
(let1 y (right* x b)
y は B:3.5 な要素を指します。
(set! (right* x b) (left* y b))
x の右が y の左 (nil) に。
(unless (nil? (left* y b))
(set! (parent (left* y b)) x))y の左は nil なのでスルー。
(set! (parent y) (parent x))
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 の親の子供が y になります。
(set! (left* y b) x)
(set! (parent x) y)))最後に y の左の要素が x になって逆のリンクも設定。
B:2.5
B:3
B:3.5
B:4こうなった上で root が黒にされて削除対象から伸びるリンクを切って終了。tree は以下になるのかな。
B:-1.5
B:-1
R:-0.5
B:0
B:2.5
B:3
B:3.5
B:4平衡ですね。次に消されるのが B:-1 ですか。再度順に確認。
(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 は両方に子供が居ます。B:0 と置きかえ、になるのか。あ、違うや R:-0.5 だ。で、z は R:-0.5 な要素を指すのか。
(let ((x (left* z (not (nil? (left z)))))
(p (parent z)))z は末端要素なので x は nil、p は B:0 な要素を指すのか。
(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))B:0 な要素の左は nil になる。R:-0.5 な要素は切り離されました。そして
(when (black? z)
(delete-fixup! tree x p))そして z が赤なのでこのまま終わってしまうorz
とほほ
これ、手動じゃ無理だ。rui さん実装を load して一つづつ確認した方が良さげ。つうか use util.rbtree してみたんですがローカルなナニが load されていないな。
で
gosh な REPL で色々試してるんですが rbtree.scm が実は使えていないことが判明してます。
む
できた。やっぱ最初のヤリ方で良かったみたいなんですが
$ gosh
gosh> (add-load-path ".")
("." "/usr/share/gauche-0.9/site/lib" "/usr/share/gauche-0.9/0.9.1/lib" "/usr/share/gauche/site/lib" "/usr/share/gauche/0.9/lib")
gosh> (use util.rbtree)
#<undef>
gosh> <rbtree>
#<class <rbtree>>
gosh> 試験で make-tree-map 使っているのがアレな模様。これはヤラれた状態なのかな。あー試験は関係ないよね。とりあえずもっかい仕切り直ししますorz
