赤黒木 (11)
とりあえず赤黒木というよりも define-values 云々の解決から。ええと、Gauche ユーザリファレンスの 4.10 定義 に以下な記述がありますね。
まずexprが評価されます。それは与えられたvarと同数の値を 返さなければなりません。続いて各値がvarに順に束縛されます。
4.10 定義より引用
なので以下なソレは
(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))))それぞれ successor が (tmpl right minimum) に、predecessor が (tmpl left maximum) に束縛、ということになるのか。
つうことは successor は以下な定義ということになるんかな。
(define successor
(lambda (node)
(if (not (nil? (right node)))
(minimum (right node))
(let loop ((x node)
(y (parent node)))
(if (and (not (nil? y)) (eq? x (right y)))
(loop y (parent y))
y)))))んーと、この定義ってどーゆー意味かいな。
- 引数な node に右側要素がある場合、右側要素の最小の key な node を戻す
- 右側要素が無い場合、上向きに木をパースして root に達するかカレントな要素が親 node に対して左側要素である要素を戻す
微妙に意味不明 (自分より一つ大きい?)。例えば 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)となってて、削除対象要素が左右に子供を持ってる場合、右手の最小なソレが y にセットされますね。確かに要素が削除される時、右手側の最小のソレと置きかえ、というのが常識的な判断か。
case 6
リトライで。
;; 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 な要素を削除。でも削除後のソレを見るに 2 な要素は 1.5 な要素と置きかわってますね。とりあえずどうなるか順に見ていきます。
む
なんかおかしいな。このままだと delete-fixup! にさえ入らずに
B:0
B:1.5
R:3になってしまう。赤黒てきにも平衡ではないですね。
勘違い
(if (and (black? (left w)) (black? (right w)))
て子供が居ない場合も真なんすね。で、以降何度確認しても
B:0
R:1.5
B:3にしかなりません。一応赤黒木てきには平衡です。トレースのログを以下に。
リトライ
ええと、delete-node! に入る直前の状態が以下で。
B:-3
R:-2
B:-1.5
B:0
B:1.5
R:2
B:3z は R:2 な要素を指してます。で、
(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:0
B:1.5
R:3
B:3になり、z は B:3 を指してる状態になります。次の let で
(let ((x (left* z (not (nil? (left z)))))
(p (parent z)))
- x は B:3 の右の nil を指し (つうか nil)
- p は R: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))p は nil ではないので p の右側要素が nil になります。これで z の切り離し完了。そして z は黒になっちゃってますので、delete-fixup! が呼び出されます。
B:0
B:1.5
R:3上述の通り、p は R:3 な要素で x は nil です (B: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))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))b には #f が格納されます (p の左は nil ではない)。w には一旦 B:1.5 な要素を指すよう設定されてそこは赤ではないので、w はそのまま B:1.5 な要素を指したまま、になるんですね。
(if (and (black? (left w)) (black? (right w)))
(begin (paint-red! w)
(loop p (parent p)))w な要素は子供の要素が居ませんが、逆にそれは子供が両方黒、ということになります。なので then ブロックが評価されていって
- B:1.5 な要素の色が赤になる
- x と p がリセットされる
- x は R:3 な要素を指す
- p は B:0 な要素を指す
ちなみにこの時点での状態が以下。
B:0
R:1.5
R:3これで再度繰り返しの先頭に戻ります。
(let loop ((x x) (p p))
(if (or (nil? p) (red? x))
(unless (nil? x)
(paint-black! x))x は赤で、nil でもありませんので x を黒にして終了。
B:0
R:1.5
B:3むむ。図とは異なりますが赤黒てきには valid です。これ、次に 1.5 消してますが、見事にここでドキュメントと同じ形になるなぁ。
ちなみに
類推ベースですが
- successor は渡した node の key の _次に大きい_ key の要素を取得
- predecessor は渡した node の key の _次に小さい_ key の要素を取得
なのかな、と思ってます。predecessor の中身は確認してません。
とりあえず
一旦アレします。アタマを冷やしてもっかい確認したらナチュラルをぶちカマシてました、という事な可能性が高いな、と思ってますが、もしそうだとしてもひらにご容赦頂ければ幸いです。
むむ
よく考えたら実装は rui さん製だから細かい部分が異なる可能性はあるのか。成程。
