Mercurial > hg > Gears > GearsAgda
changeset 911:ce13b8ffc4dd
...
author | Shinji KONO <kono@ie.u-ryukyu.ac.jp> |
---|---|
date | Sun, 02 Jun 2024 12:29:26 +0900 |
parents | e587d7a1634f |
children | e4a185896b7e |
files | hoareBinaryTree1.agda |
diffstat | 1 files changed, 36 insertions(+), 4 deletions(-) [+] |
line wrap: on
line diff
--- a/hoareBinaryTree1.agda Sun Jun 02 03:36:07 2024 +0900 +++ b/hoareBinaryTree1.agda Sun Jun 02 12:29:26 2024 +0900 @@ -1964,14 +1964,46 @@ replaceRBP1 : t replaceRBP1 with RBI.state r ... | rebuild ceq bdepth-eq rot = rebuildCase orig refl ceq bdepth-eq rot - ... | top-black eq rot = exit repl stack ? r + ... | top-black eq rot = exit repl stack (trans eq (cong (λ k → k ∷ []) rb00)) r where + rb00 : RBI.tree r ≡ orig + rb00 with si-property-last _ _ _ _ (subst (λ k → stackInvariant key (RBI.tree r) orig k) (eq) (RBI.si r)) + ... | refl = refl ... | rotate repl-red pdepth-eq rot with stackToPG (RBI.tree r) orig stack (RBI.si r) ... | case1 eq = exit repl stack eq r -- no stack, replace top node ... | case2 (case1 eq) = insertCase12 orig refl eq rot (case1 repl-red) (RBI.si r) -- one level stack, orig is parent of repl ... | case2 (case2 pg) with color (PG.parent pg) in pcolor - ... | Black = rebuildCase orig refl ? pdepth-eq rot where - rb00 : color (RBI.tree r) ≡ color repl -- we cannot prove this - rb00 = black-children-color (RBI.origrb r) rot + ... | Black = insertCase1 where + rb00 : (pg : PG (Color ∧ A) (RBI.tree r) stack) → stackInvariant key (RBI.tree r) orig (RBI.tree r ∷ PG.parent pg ∷ PG.grand pg ∷ PG.rest pg) + rb00 pg = subst (λ k → stackInvariant key (RBI.tree r) orig k) (PG.stack=gp pg) (RBI.si r) + treerb : (pg : PG (Color ∧ A) (RBI.tree r) stack) → RBtreeInvariant (PG.parent pg) + treerb pg = PGtoRBinvariant1 _ orig (RBI.origrb r) _ (popStackInvariant _ _ _ _ _ (rb00 pg)) + rb08 : (pg : PG (Color ∧ A) (RBI.tree r) stack) → treeInvariant (PG.parent pg) + rb08 pg = siToTreeinvariant _ _ _ _ (RBI.origti r) (popStackInvariant _ _ _ _ _ (rb00 pg)) + insertCase1 : t + insertCase1 with PG.pg pg + ... | s2-s1p2 {kp} {kg} {vp} {vg} {n1} {n2} x x₁ = next rb01 (PG.parent pg ∷ PG.grand pg ∷ PG.rest pg) record { + tree = PG.parent pg + ; ¬leaf = subst (λ k → ¬ (k ≡ leaf)) (sym x) (λ ()) + ; origti = RBI.origti r + ; origrb = RBI.origrb r + ; treerb = treerb pg + ; replrb = ? + ; si = popStackInvariant _ _ _ _ _ (rb00 pg) + ; state = rebuild ? rb05 (subst (λ k → replacedRBTree key value k (node kp vp repl n1) ) (sym x) (rb02 rb04 )) + } ? where + rb01 : bt (Color ∧ A) + rb01 = node kp vp repl n1 + rb03 : key < kp + rb03 = ? + rb04 : ⟪ Black , proj2 vp ⟫ ≡ vp + rb04 = ? + rb02 : ⟪ Black , proj2 vp ⟫ ≡ vp → replacedRBTree key value (node kp vp (RBI.tree r) n1) (node kp vp repl n1) + rb02 eq = subst (λ k → replacedRBTree key value (node kp k (RBI.tree r) n1) (node kp k repl n1)) eq (rbr-black-left repl-red rb03 rot ) + rb05 : black-depth rb01 ≡ black-depth (PG.parent pg) + rb05 = ? + ... | s2-1sp2 {kp} {kg} {vp} {vg} {n1} {n2} x x₁ = ? + ... | s2-s12p {kp} {kg} {vp} {vg} {n1} {n2} x x₁ = ? + ... | s2-1s2p {kp} {kg} {vp} {vg} {n1} {n2} x x₁ = ? ... | Red with PG.uncle pg in uneq ... | leaf = {!!} -- insertCase5 ... | node key₁ ⟪ Black , value₁ ⟫ t₁ t₂ = {!!} -- insertCase5