changeset 729:5599bd559f3e

...
author Shinji KONO <kono@ie.u-ryukyu.ac.jp>
date Tue, 11 Apr 2023 19:08:39 +0900
parents 0786c97b4919
children dbef4bd0f69b
files hoareBinaryTree1.agda
diffstat 1 files changed, 50 insertions(+), 25 deletions(-) [+]
line wrap: on
line diff
--- a/hoareBinaryTree1.agda	Mon Apr 10 19:15:34 2023 +0900
+++ b/hoareBinaryTree1.agda	Tue Apr 11 19:08:39 2023 +0900
@@ -57,7 +57,7 @@
 --  stack always contains original top at end
 --
 data stackInvariant {n : Level} {A : Set n}  (key : ℕ) : (top orig : bt A) → (stack  : List (bt A)) → Set n where
-    s-single :  {tree0 : bt A} → stackInvariant key tree0 tree0 (tree0 ∷ [])
+    s-nil :  {tree0 : bt A} → stackInvariant key tree0 tree0 (tree0 ∷ [])
     s-right :  {tree tree0 tree₁ : bt A} → {key₁ : ℕ } → {v1 : A } → {st : List (bt A)} 
         → key₁ < key  →  stackInvariant key (node key₁ v1 tree₁ tree) tree0 st → stackInvariant key tree tree0 (tree ∷ st)
     s-left :  {tree₁ tree0 tree : bt A} → {key₁ : ℕ } → {v1 : A } → {st : List (bt A)} 
@@ -94,22 +94,22 @@
 stack-last (x ∷ s) = stack-last s
 
 stackInvariantTest1 : stackInvariant 4 treeTest2 treeTest1 ( treeTest2 ∷ treeTest1 ∷ [] )
-stackInvariantTest1 = s-right (add< 3) (s-single  )
+stackInvariantTest1 = s-right (add< 3) (s-nil  )
 
 si-property0 :  {n : Level} {A : Set n} {key : ℕ} {tree tree0 : bt A} → {stack  : List (bt A)} →  stackInvariant key tree tree0 stack → ¬ ( stack ≡ [] )
-si-property0  (s-single  ) ()
+si-property0  (s-nil  ) ()
 si-property0  (s-right x si) ()
 si-property0  (s-left x si) ()
 
 si-property1 :  {n : Level} {A : Set n} {key : ℕ} {tree tree0 tree1 : bt A} → {stack  : List (bt A)} →  stackInvariant key tree tree0 (tree1 ∷ stack)
    → tree1 ≡ tree
-si-property1 (s-single   ) = refl
+si-property1 (s-nil   ) = refl
 si-property1 (s-right _  si) = refl
 si-property1 (s-left _  si) = refl
 
 si-property-last :  {n : Level} {A : Set n}  (key : ℕ) (tree tree0 : bt A) → (stack  : List (bt A)) →  stackInvariant key tree tree0 stack
    → stack-last stack ≡ just tree0
-si-property-last key t t0 (t ∷ [])  (s-single )  = refl
+si-property-last key t t0 (t ∷ [])  (s-nil )  = refl
 si-property-last key t t0 (.t ∷ x ∷ st) (s-right _ si ) with  si-property1 si
 ... | refl = si-property-last key x t0 (x ∷ st)   si
 si-property-last key t t0 (.t ∷ x ∷ st) (s-left _ si ) with  si-property1  si
@@ -129,7 +129,7 @@
 
 stackTreeInvariant : {n  : Level} {A : Set n} (key : ℕ) (sub tree : bt A) → (stack : List (bt A))
    →  treeInvariant tree → stackInvariant key sub tree stack  → treeInvariant sub
-stackTreeInvariant {_} {A} key sub tree (sub ∷ []) ti (s-single  ) = ti
+stackTreeInvariant {_} {A} key sub tree (sub ∷ []) ti (s-nil  ) = ti
 stackTreeInvariant {_} {A} key sub tree (sub ∷ st) ti (s-right _ si ) = ti-right (si1 si) where
    si1 : {tree₁ : bt A} → {key₁ : ℕ} → {v1 : A} →  stackInvariant key (node key₁ v1 tree₁ sub ) tree st → treeInvariant  (node key₁ v1 tree₁ sub )
    si1 {tree₁ }  {key₁ }  {v1 }  si = stackTreeInvariant  key (node key₁ v1 tree₁ sub ) tree st ti si
@@ -515,7 +515,7 @@
 insertTreeP : {n m : Level} {A : Set n} {t : Set m} → (tree : bt A) → (key : ℕ) → (value : A) → treeInvariant tree
      → (exit : (tree repl : bt A) → treeInvariant repl ∧ replacedTree key value tree repl → t ) → t
 insertTreeP {n} {m} {A} {t} tree key value P0 exit =
-   TerminatingLoopS (bt A ∧ List (bt A) ) {λ p → treeInvariant (proj1 p) ∧ stackInvariant key (proj1 p) tree (proj2 p) } (λ p → bt-depth (proj1 p)) ⟪ tree , tree ∷ [] ⟫  ⟪ P0 , s-single ⟫
+   TerminatingLoopS (bt A ∧ List (bt A) ) {λ p → treeInvariant (proj1 p) ∧ stackInvariant key (proj1 p) tree (proj2 p) } (λ p → bt-depth (proj1 p)) ⟪ tree , tree ∷ [] ⟫  ⟪ P0 , s-nil ⟫
        $ λ p P loop → findP key (proj1 p)  tree (proj2 p) P (λ t s P1 lt → loop ⟪ t ,  s  ⟫ P1 lt ) 
        $ λ t s P C → replaceNodeP key value t C (proj1 P)
        $ λ t1 P1 R → TerminatingLoopS (List (bt A) ∧ bt A ∧ bt A )
@@ -564,7 +564,7 @@
        → RBTree A key₁ Black (suc d)
 
 data rbstackInvariant {n : Level} {A : Set n}  {key : ℕ} {c : Color} {d : ℕ} (orig : RBTree A key c d ) : (key₁ : ℕ ) → Set n where
-    s-single :  rbstackInvariant orig key
+    s-nil :  rbstackInvariant orig key
     s-right :  {key₁ key₂ : ℕ} → {c1 : Color} {d1 : ℕ} → key₁ < key₂  →  (top : RBTree A key₁ c1 d1) 
         → rbstackInvariant orig key₁ → rbstackInvariant orig key
     s-left :   {key₁ key₂ : ℕ} → {c1 : Color} {d1 : ℕ} → key₂ < key₁  →  (top : RBTree A key₁ c1 d1) 
@@ -572,7 +572,7 @@
 
 rbsi-len :  {n : Level} {A : Set n}  {key : ℕ} {c : Color} {d : ℕ} (orig : RBTree A key c d ) {key₁ : ℕ } 
      → rbstackInvariant orig key₁ → ℕ
-rbsi-len orig s-single = 0
+rbsi-len orig s-nil = 0
 rbsi-len orig (s-right x top ri) = suc (rbsi-len orig ri)
 rbsi-len orig (s-left x top ri)  = suc (rbsi-len orig ri)
 
@@ -620,23 +620,48 @@
 findRBP {n} {m} {A} {t} key tree (t-node-red _ value x x₁ tree1 tree2) si next exit = ?
 findRBP {n} {m} {A} {t} key tree (t-node-black _ value x x₁ tree1 tree2) si next exit = ?
 
-record ReplaceRBT {n : Level} {A : Set n} (key : ℕ) (value : A) {key1 key2 d1 d2 : ℕ} {c1 c2 : Color}
-     (tree : RBTree A key1 c1 d1) (repl : RBTree A key2 c2 d2)   : Set n where
-   field
-     key0 d0 : ℕ
-     c0 : Color
-     orig : RBTree A key0 c0 d0
-     si : rbstackInvariant orig key0
-     ri : replacedTree key value (RB→bt A tree) (RB→bt A repl)
-   si-len : ℕ
-   si-len = rbsi-len orig si
+insertCase5 : {n m : Level} {A : Set n} {t : Set m}
+     → (key : ℕ) → (value : A) → {key0 key1 key2 d0 d1 d2 : ℕ} {c0 c1 c2 : Color}  
+     → (orig : RBTree A key1 c1 d1 ) → (tree : RBTree A key1 c1 d1 ) ( repl : RBTree A key2 c2 d2 )
+     → (si : rbstackInvariant orig key1)
+     → (ri : replacedTree key value (RB→bt A tree) (RB→bt A repl))
+     → (next : ℕ → A → {k1 k2 d1 d2 : ℕ} {c1 c2 : Color} → (tree1 : RBTree A k1 c1 d1 ) (repl1 : RBTree A k2 c2 d2 ) 
+         → (si1 : rbstackInvariant orig k1)
+         → (ri : replacedTree key value (RB→bt A tree1) (RB→bt A repl1))
+         → rbsi-len orig si1 < rbsi-len orig si → t )
+     → (exit : {k1 k2 d1 d2 : ℕ} {c1 c2 : Color} (tree1 : RBTree A k1 c1 d1 ) → (repl1 : RBTree A k2 c2 d2 ) 
+         → (ri : replacedTree key value (RB→bt A orig) (RB→bt A repl1))
+         → t ) → t
+insertCase5 {n} {m} {A} {t} key value orig tree repl si ri next exit = ? where
+    rotateRight : ?
+    rotateRight = ?
+    rotateLeft : ?
+    rotateLeft = ?
+    insertCase51 : (key1 : ℕ)  (si : rbstackInvariant orig key1)  → t
+    insertCase51 = ?
 
 replaceRBP : {n m : Level} {A : Set n} {t : Set m}
-     → (key : ℕ) → (value : A) → {key1 key2 d1 d2 : ℕ} {c1 c2 : Color}  → (tree : RBTree A key1 c1 d1 ) ( repl : RBTree A key2 c2 d2 )
-     → (RR : ReplaceRBT key value tree repl  )
-     → (next : ℕ → A → {k1 k2 d1 d2 : ℕ} {c1 c2 : Color} → (tree1 : RBTree A k1 c1 d1 ) (repl : RBTree A k2 c2 d2 ) → (RR1 : ReplaceRBT key value tree1 repl ) 
-         → ReplaceRBT.si-len RR1 < ReplaceRBT.si-len RR    → t )
-     → (exit : {k1 k2 d1 d2 : ℕ} {c1 c2 : Color} (tree1 : RBTree A k1 c1 d1 ) → (repl : RBTree A k2 c2 d2 ) → t ) → t
-replaceRBP = ?
+     → (key : ℕ) → (value : A) → {key0 key1 key2 d0 d1 d2 : ℕ} {c0 c1 c2 : Color}  
+     → (orig : RBTree A key1 c1 d1 ) → (tree : RBTree A key1 c1 d1 ) ( repl : RBTree A key2 c2 d2 )
+     → (si : rbstackInvariant orig key1)
+     → (ri : replacedTree key value (RB→bt A tree) (RB→bt A repl))
+     → (next : {k1 k2 d1 d2 : ℕ} {c1 c2 : Color} (tree1 : RBTree A k1 c1 d1 ) → (repl1 : RBTree A k2 c2 d2 ) 
+         → (ri : replacedTree key value (RB→bt A orig) (RB→bt A repl1))
+         → t ) → t
+replaceRBP {n} {m} {A} {t} key value orig tree repl si ri next = ? where
+    insertCase4 : (key1 : ℕ) → (si : rbstackInvariant orig key1) → (parent : RBTree A ? ? ?) → (grand : RBTree A ? ? ?) → t
+    insertCase4 = ?
+    insertCase3 : (key1 : ℕ) → (si : rbstackInvariant orig key1) → (parent : RBTree A ? ? ?) → (grand : RBTree A ? ? ?) → t
+    insertCase3 = ?
+    insertCase2 : (key1 : ℕ) → (si : rbstackInvariant orig key1) → (parent : RBTree A ? ? ?) → (grand : RBTree A ? ? ?) → t
+    insertCase2 key1 si parent grand = ?
+    replaceRBP1 : (key1 : ℕ)  (si : rbstackInvariant orig key1)  → t
+    replaceRBP1 key1 s-nil = ?
+    replaceRBP1 key1 (s-right {key₁} {key₂} x top s-nil) = ?
+    replaceRBP1 key1 (s-right {key₁} {key₂} x top (s-right {key₃} {key₄} x₁ top₁ si)) = insertCase2 key₃ si ? ?
+    replaceRBP1 key1 (s-right {key₁} {key₂} x top (s-left {key₃} {key₄} x₁ top₁ si)) = ?
+    replaceRBP1 key1 (s-left {key₁} {key₂} x top s-nil) = ?
+    replaceRBP1 key1 (s-left {key₁} {key₂} x top (s-right {key₃} {key₄} x₁ top₁ si)) = ?
+    replaceRBP1 key1 (s-left {key₁} {key₂} x top (s-left {key₃} {key₄} x₁ top₁ si)) = ?