Mercurial > hg > Gears > GearsAgda

changeset 823:ebee6945c697

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
...
author Shinji KONO <kono@ie.u-ryukyu.ac.jp>
date Sat, 27 Jan 2024 18:24:40 +0900
parents 3f6e13350420
children 7d73749f097e
files hoareBinaryTree1.agda
diffstat 1 files changed, 18 insertions(+), 75 deletions(-) [+]
line wrap: on
line diff
--- a/hoareBinaryTree1.agda	Fri Jan 26 08:54:44 2024 +0900
+++ b/hoareBinaryTree1.agda	Sat Jan 27 18:24:40 2024 +0900
@@ -517,7 +517,7 @@
                (λ p → length (proj1 p)) ⟪ s , ⟪ t , t1 ⟫ ⟫ record { tree0 = tree ; ti = P0 ; si = proj2 P ; ri = R ; ci = lift tt }
        $  λ p P1 loop → replaceP key value  (proj2 (proj2 p)) (proj1 p) P1
             (λ key value {tree1} repl1 stack P2 lt → loop ⟪ stack , ⟪ tree1 , repl1  ⟫ ⟫ P2 lt )
-       $ λ tree repl P → {!!} --exit tree repl ⟪ RTtoTI0 _ _ _ _ (proj1 P) (proj2 P) , proj2 P ⟫
+       $ λ tree repl P → exit tree repl {!!} --exit tree repl ⟪ RTtoTI0 _ _ _ _ (proj1 P) (proj2 P) , proj2 P ⟫
 
 insertTestP1 = insertTreeP leaf 1 1 t-leaf
   $ λ _ x0 P0 → insertTreeP x0 2 1 (proj1 P0)
@@ -867,9 +867,11 @@
 ... | tri≈ ¬a b ¬c = rbi
 ... | tri> ¬a ¬b c = RBtreeRightDown _ _ rbi
 
+-- this is too complacted to extend all arguments at once
+-- 
 RBTtoRBI  : {n : Level} {A : Set n}  → (tree repl : bt (Color ∧ A)) → (key : ℕ) → (value : A) → RBtreeInvariant tree
      → replacedRBTree key value tree repl → RBtreeInvariant repl
-RBTtoRBI  = ?
+RBTtoRBI {_} {A} tree repl key value rbi rlt = ?
 --
 -- create RBT invariant after findRBT, continue to replaceRBT
 --
@@ -901,99 +903,40 @@
         → t ) → t
 rebuildRBT = ?
 
-rotateLeft : {n m : Level} {A : Set n} {t : Set m}
-     → (key : ℕ) → (value : A)
-     → (orig tree : bt (Color ∧ A))
-     → (stack : List (bt (Color ∧ A)))
-     → (r : RBI key value orig tree stack )
-     → (pg : PG (Color ∧ A) tree stack)
-     → (next : (current : bt (Color ∧ A)) → (stack1 : List (bt (Color ∧ A)))
-        → (r : RBI key value orig current stack1 )
-        → length stack1 < length stack  → t )
-     → (exit : (repl : bt (Color ∧ A) ) → (stack1 : List (bt (Color ∧ A)))
-        →  stack1 ≡ (orig ∷ [])
-        →  RBI key value orig repl stack1
-        → t ) → t
-rotateLeft {n} {m} {A} {t} key value = {!!} where
-    rotateLeft1 : t
-    rotateLeft1 with stackToPG {!!} {!!} {!!} {!!}
-    ... | case1 x = {!!} -- {!!} {!!} {!!} {!!} rr
-    ... | case2 (case1 x) = {!!}
-    ... | case2 (case2 pg) = {!!}
-
-rotateRight : {n m : Level} {A : Set n} {t : Set m}
-     → (key : ℕ) → (value : A)
-     → (orig tree : bt (Color ∧ A))
-     → (stack : List (bt (Color ∧ A)))
-     → (r : RBI key value orig tree stack )
-     → (pg : PG (Color ∧ A) tree stack)
-     → (next : (current : bt (Color ∧ A)) → (stack1 : List (bt (Color ∧ A)))
-        → (r : RBI key value orig current stack1 )
-        → length stack1 < length stack  → t )
-     → (exit : (repl : bt (Color ∧ A) ) → (stack1 : List (bt (Color ∧ A)))
-        →  stack1 ≡ (orig ∷ [])
-        →  RBI key value orig repl stack1
-        → t ) → t
-rotateRight {n} {m} {A} {t} key value = {!!} where
-    rotateRight1 : t
-    rotateRight1 with stackToPG {!!} {!!} {!!} {!!}
-    ... | case1 x = {!!}
-    ... | case2 (case1 x) = {!!}
-    ... | case2 (case2 pg) = {!!}
-
-insertCase6 : {n m : Level} {A : Set n} {t : Set m}
-     → (key : ℕ) → (value : A)
-     → (orig tree : bt (Color ∧ A))
-     → (stack : List (bt (Color ∧ A)))
-     → (r : RBI key value orig tree stack )
-     → (pg : PG (Color ∧ A) tree stack)
-     → (next : (tree1 : (bt (Color ∧ A))) →  (stack1 : List (bt (Color ∧ A)))
-        → (r : RBI key value orig tree1 stack1 )
-        → length stack1 < length stack  → t )
-     → (exit : (repl : bt (Color ∧ A) ) → (stack1 : List (bt (Color ∧ A)))
-        →  stack1 ≡ (orig ∷ [])
-        →  RBI key value orig repl stack1
-        → t ) → t
-insertCase6 {n} {m} {A} {t} key value = {!!} where
-    -- check inner repl case
-    --     node-key parent < node-key grand  → rotateRight grand 
-    --     node-key grand  < node-key parent → rotateLeft  grand 
-    insertCase61 : t
-    insertCase61 = ?
-
 insertCase5 : {n m : Level} {A : Set n} {t : Set m}
      → (key : ℕ) → (value : A)
      → (orig tree : bt (Color ∧ A))
      → (stack : List (bt (Color ∧ A)))
      → (r : RBI key value orig tree stack )
      → (pg : PG (Color ∧ A) tree stack)
+     → color (PG.uncle pg) ≡ Black → color (PG.parent pg) ≡ Red
      → (next : (tree1 : (bt (Color ∧ A))) →  (stack1 : List (bt (Color ∧ A)))
         → (r : RBI key value orig tree1 stack1 )
-        → length stack1 < length stack  → t )
-     → (exit : (repl : bt (Color ∧ A) ) → (stack1 : List (bt (Color ∧ A)))
-        →  stack1 ≡ (orig ∷ [])
-        →  RBI key value orig repl stack1
-        → t ) → t
-insertCase5 {n} {m} {A} {t} key value orig tree stack r pg next exit = {!!} where
+        → length stack1 < length stack  → t ) → t
+insertCase5 {n} {m} {A} {t} key value orig tree stack r pg cu=b cp=r next = {!!} where
     -- check inner repl case
     --     node-key parent < node-key repl < node-key grand  → rotateLeft  parent    then insertCase6
     --     node-key grand  < node-key repl < node-key parent → rotateRight parent    then insertCase6
     --     else insertCase6
     insertCase51 : (tree1 grand : bt (Color ∧ A)) → tree1 ≡ tree → grand ≡ PG.grand pg → t
     insertCase51 leaf grand teq geq = ?    -- can't happen
-    insertCase51 (node key value tree1 tree2) leaf teq geq = ?    -- can't happen
-    insertCase51 (node key value tree1 tree2) (node key₁ value₁ grand grand₁) teq geq with <-cmp key key₁
+    insertCase51 (node kr vr rleft rright) leaf teq geq = ?    -- can't happen
+    insertCase51 (node kr vr rleft rright) (node kg vg grand grand₁) teq geq with <-cmp kr kg
     ... | tri< a ¬b ¬c = ? where
           insertCase511 : (parent : bt (Color ∧ A)) → parent ≡ PG.parent pg → t
           insertCase511 leaf peq = ? -- can't happen
           insertCase511 (node key₂ ⟪ co , value ⟫ n1 n2) peq with <-cmp key key₂
-          ... | tri< a ¬b ¬c = insertCase6 key value orig ? stack ? pg ? ?
+          ... | tri< a ¬b ¬c = next ? ? ? ?
           ... | tri≈ ¬a b ¬c = ? -- can't happen
-          ... | tri> ¬a ¬b c = ? --- rotareRight → insertCase6 key value orig ? stack ? pg next exit
+          ... | tri> ¬a ¬b c = next ? ? ? ? --- rotareRight → insertCase6 key value orig ? stack ? pg next exit
     ... | tri≈ ¬a b ¬c = ? -- can't happen
-    ... | tri> ¬a ¬b c = ?
-
-
+    ... | tri> ¬a ¬b c = ? where
+          insertCase511 : (parent : bt (Color ∧ A)) → parent ≡ PG.parent pg → t
+          insertCase511 leaf peq = ? -- can't happen
+          insertCase511 (node key₂ ⟪ co , value ⟫ n1 n2) peq with <-cmp key key₂
+          ... | tri< a ¬b ¬c = next ? ? ? ? --- rotareLeft → insertCase6 key value orig ? stack ? pg next exit
+          ... | tri≈ ¬a b ¬c = ? -- can't happen
+          ... | tri> ¬a ¬b c = next ? ? ? ?
 
 --
 -- replaced node increase blackdepth, so we need tree rotate