changeset 902:20207255b094

...
author Shinji KONO <kono@ie.u-ryukyu.ac.jp>
date Fri, 31 May 2024 10:46:03 +0900
parents e70abd8f17a9
children d79ffbf8f450
files hoareBinaryTree1.agda
diffstat 1 files changed, 41 insertions(+), 3 deletions(-) [+]
line wrap: on
line diff
--- a/hoareBinaryTree1.agda	Thu May 30 20:11:07 2024 +0900
+++ b/hoareBinaryTree1.agda	Fri May 31 10:46:03 2024 +0900
@@ -280,6 +280,36 @@
 ... | tri≈ ¬a b ¬c = node key₁ value left right
 ... | tri> ¬a ¬b c = right
 
+child-replaced-left :  {n : Level} {A : Set n} {key key₁ : ℕ}  {value : A}  {left right : bt A}  
+   → key < key₁
+   → child-replaced key (node key₁ value left right) ≡ left
+child-replaced-left {n} {A} {key} {key₁} {value} {left} {right} lt = ch00 (node key₁ value left right) refl lt where
+     ch00 : (tree : bt A) → tree ≡ node key₁ value left right → key < key₁ → child-replaced key tree ≡ left
+     ch00 (node key₁ value tree tree₁) refl lt1 with <-cmp key key₁
+     ... | tri< a ¬b ¬c = refl
+     ... | tri≈ ¬a b ¬c = ⊥-elim (¬a lt1)
+     ... | tri> ¬a ¬b c = ⊥-elim (¬a lt1)
+
+child-replaced-right :  {n : Level} {A : Set n} {key key₁ : ℕ}  {value : A}  {left right : bt A}  
+   → key₁ < key
+   → child-replaced key (node key₁ value left right) ≡ right
+child-replaced-right {n} {A} {key} {key₁} {value} {left} {right} lt = ch00 (node key₁ value left right) refl lt where
+     ch00 : (tree : bt A) → tree ≡ node key₁ value left right → key₁ < key → child-replaced key tree ≡ right
+     ch00 (node key₁ value tree tree₁) refl lt1 with <-cmp key key₁
+     ... | tri< a ¬b ¬c = ⊥-elim (¬c lt1)
+     ... | tri≈ ¬a b ¬c = ⊥-elim (¬c lt1)
+     ... | tri> ¬a ¬b c = refl
+
+child-replaced-eq :  {n : Level} {A : Set n} {key key₁ : ℕ}  {value : A}  {left right : bt A}  
+   → key₁ ≡ key
+   → child-replaced key (node key₁ value left right) ≡ node key₁ value left right
+child-replaced-eq {n} {A} {key} {key₁} {value} {left} {right} lt = ch00 (node key₁ value left right) refl lt where
+     ch00 : (tree : bt A) → tree ≡ node key₁ value left right → key₁ ≡ key → child-replaced key tree ≡ node key₁ value left right
+     ch00 (node key₁ value tree tree₁) refl lt1 with <-cmp key key₁
+     ... | tri< a ¬b ¬c = ⊥-elim (¬b (sym lt1))
+     ... | tri≈ ¬a b ¬c = refl
+     ... | tri> ¬a ¬b c = ⊥-elim (¬b (sym lt1))
+
 record replacePR {n : Level} {A : Set n} (key : ℕ) (value : A) (tree repl : bt A ) (stack : List (bt A)) (C : bt A → bt A → List (bt A) → Set n) : Set n where
    field
      tree0 : bt A
@@ -1912,11 +1942,19 @@
           suc (black-depth repl ⊔ black-depth n1) ≡⟨ cong (λ k → suc (k ⊔ black-depth n1)) (sym (RB-repl→eq _ _ (RBI.treerb r) rot)) ⟩
           suc (black-depth (RBI.tree r) ⊔ black-depth n1) ≡⟨ cong (λ k → suc (k ⊔ black-depth n1)) (RBtreeEQ (subst (λ k → RBtreeInvariant k) x rb03)) ⟩
           suc (black-depth n1 ⊔ black-depth n1) ≡⟨ ⊔-idem _ ⟩
-          suc (black-depth n1 ) ≡⟨ ? ⟩
-          suc (black-depth (PG.parent pg)) ≡⟨ ? ⟩
-          suc (black-depth (PG.uncle pg)) ≡⟨ ? ⟩
+          suc (black-depth n1 ) ≡⟨ cong suc (sym (proj2 (red-children-eq x (cong proj1 rb11) rb03 ))) ⟩
+          suc (black-depth (PG.parent pg)) ≡⟨ cong suc (RBtreeEQ (subst (λ k → RBtreeInvariant k) x₁ rb01)) ⟩
+          suc (black-depth (PG.uncle pg)) ≡⟨ to-black-eq (PG.uncle pg) (cong color uneq ) ⟩
           black-depth (to-black (PG.uncle pg)) ∎
              where open ≡-Reasoning
+       rb16 :  (tree : bt (Color ∧ A)) 
+          → tree ≡ node kg vg (PG.parent pg) (PG.uncle pg)
+          → (ti : treeInvariant (node kg vg (PG.parent pg) (PG.uncle pg))) → child-replaced key tree ≡ PG.parent pg
+       rb16 leaf eq ti = ?
+       rb16 (node key₁ value tree tree₁) eq ti with <-cmp key key₁
+       ... | tri< a ¬b ¬c = ?
+       ... | tri≈ ¬a b ¬c = ?
+       ... | tri> ¬a ¬b c = ?
        rb14 : suc (black-depth repl ⊔ black-depth n1) ⊔ black-depth (to-black (PG.uncle pg)) ≡ black-depth (child-replaced key (PG.grand pg))
        rb14 = ?
        rb15 : suc (length (PG.rest pg)) < length stack