changeset 740:9ff79715588e

...
author Shinji KONO <kono@ie.u-ryukyu.ac.jp>
date Sun, 23 Apr 2023 14:29:09 +0900
parents 3443703a68cc
children c44edea35126
files hoareBinaryTree1.agda
diffstat 1 files changed, 30 insertions(+), 23 deletions(-) [+]
line wrap: on
line diff
--- a/hoareBinaryTree1.agda	Sat Apr 22 19:15:59 2023 +0900
+++ b/hoareBinaryTree1.agda	Sun Apr 23 14:29:09 2023 +0900
@@ -600,10 +600,14 @@
 rbt-key {n} A (t-node-black key value x x₁ rb rb₁) = just key
 
 data ParentGrand {n : Level} {A : Set n} (self : bt A) : (parent grand : bt A) → Set n where
-    s2-s1p2 : {kp kg : ℕ} {vp vg : A} → {n1 n2 : bt A} {parent : bt A } → parent ≡ node kp vp self n1 → ParentGrand self parent (node kg vg parent n2) 
-    s2-1sp2 : {kp kg : ℕ} {vp vg : A} → {n1 n2 : bt A} {parent : bt A } → parent ≡ node kp vp n1 self → ParentGrand self parent (node kg vg parent n2) 
-    s2-s12p : {kp kg : ℕ} {vp vg : A} → {n1 n2 : bt A} {parent : bt A } → parent ≡ node kp vp self n1 → ParentGrand self parent (node kg vg n2 parent) 
-    s2-1s2p : {kp kg : ℕ} {vp vg : A} → {n1 n2 : bt A} {parent : bt A } → parent ≡ node kp vp n1 self → ParentGrand self parent (node kg vg n2 parent) 
+    s2-s1p2 : {kp kg : ℕ} {vp vg : A} → {n1 n2 : bt A} {parent grand : bt A } 
+        → parent ≡ node kp vp self n1 → grand ≡ node kg vg parent n2 → ParentGrand self parent grand 
+    s2-1sp2 : {kp kg : ℕ} {vp vg : A} → {n1 n2 : bt A} {parent grand : bt A } 
+        → parent ≡ node kp vp n1 self → grand ≡ node kg vg parent n2 → ParentGrand self parent grand 
+    s2-s12p : {kp kg : ℕ} {vp vg : A} → {n1 n2 : bt A} {parent grand : bt A } 
+        → parent ≡ node kp vp self n1 → grand ≡ node kg vg n2 parent → ParentGrand self parent grand 
+    s2-1s2p : {kp kg : ℕ} {vp vg : A} → {n1 n2 : bt A} {parent grand : bt A } 
+        → parent ≡ node kp vp n1 self → grand ≡ node kg vg n2 parent → ParentGrand self parent grand 
 
 data rotatedTree  {n : Level} {A : Set n}  : (before after : bt A ) → Set n where
     rr-node : {t : bt A} → rotatedTree t t
@@ -616,6 +620,24 @@
           → rotatedTree ta ta1 → rotatedTree tb tb1 → rotatedTree tc tc1
           → rotatedTree (node kb vb ta (node ka va tb tc) ) (node ka va (node kb vb ta1 tb1)  tc1) 
 
+record PG {n : Level } (A : Set n) (stack : List (bt A)) : Set n where
+    field
+       self parent grand : bt A
+       pg : ParentGrand self parent grand
+       rest : List (bt A)
+       stack=gp : stack ≡ ( self ∷ parent ∷ grand ∷ rest )
+
+stackToPG : {n : Level} {A : Set n} → {key : ℕ } → (tree orig : bt A )
+           →  (stack : List (bt A)) → stackInvariant key tree orig stack
+           → ( stack ≡ orig ∷ [] ) ∨ ( stack ≡ tree ∷ orig ∷ [] ) ∨ PG A stack
+stackToPG {n} {A} {key} tree .tree .(tree ∷ []) s-nil = case1 refl
+stackToPG {n} {A} {key} tree .(node _ _ _ tree) .(tree ∷ node _ _ _ tree ∷ []) (s-right x s-nil) = case2 (case1 refl)
+stackToPG {n} {A} {key} tree orig (tree ∷ node _ _ _ tree ∷ grand ∷ rest) (s-right {t0} {t1} {t2} {k1} {v1} x (s-right {t3} {t4} {t5} {k2} {v2} x₁ si)) = case2 (case2
+    record { self = tree ; parent = node k1 v1 t2 tree ;  grand = grand ; pg = s2-1s2p  refl ?  ; rest = rest ; stack=gp = refl } )
+stackToPG {n} {A} {key} tree orig .(tree ∷ node _ _ _ tree ∷ _) (s-right x (s-left x₁ si)) = ?
+stackToPG {n} {A} {key} tree orig .(tree ∷ _) (s-left x si) = ?
+
+
 rbsi-len :  {n : Level} {A : Set n} {orig parent grand : bt A}
      → ParentGrand orig parent grand → ℕ
 rbsi-len {n} {A} {s} {p} {g} st = ?
@@ -659,28 +681,13 @@
         → length stack1 < length stack  → t )
      → (exit : {k1 d1 : ℕ} {c1 : Color} → (repl1 : RBTree A k1 c1 d1 ) → (rot : bt A )
          → (ri : rotatedTree (RB→bt A orig) rot ) → replacedTree key value rot (RB→bt A repl1) → t ) → t
-replaceRBP {n} {m} {A} {t} key value {_} {key1} orig tree stack si next exit = insertCase1 tree stack _ _ refl refl si where
+replaceRBP {n} {m} {A} {t} key value {_} {key1} orig tree stack si next exit = insertCase1 stack _ _ refl refl si where
     insertCase2 : {k0 k1 d0 d1 d2 : ℕ} {c0 c1 c2 : Color} → (tree : RBTree A k0 c0 d0) 
       → (parent : RBTree A k1 c1 d1) → (grand : RBTree A key1 c2 d2) 
       → (stack : List (bt A)) → (tr to : bt A) → RB→bt A grand ≡ tr →  RB→bt A orig ≡ to → (si : stackInvariant key tr to stack ) 
       → (pg : ParentGrand (RB→bt A tree) (RB→bt A parent) tr ) → t
     insertCase2 tree parent grand stack tr to treq toeq si pg = ?
-    insertCase1 : {k1 d1 : ℕ} {c1 : Color } (tree : RBTree A k1 c1 d1)
-       (stack : List (bt A)) → (tr to : bt A) → RB→bt A tree ≡ tr →  RB→bt A orig ≡ to → (si : stackInvariant key tr to stack ) → t
-    insertCase1 (rb-leaf _) .(RB→bt A (rb-leaf _) ∷ []) .(RB→bt A (rb-leaf _)) .(RB→bt A (rb-leaf _)) refl oeq s-nil = ?
-    insertCase1 (rb-leaf _) .(RB→bt A (rb-leaf _) ∷ _) .(RB→bt A (rb-leaf _)) to refl oeq (s-right x si) = ?
-    insertCase1 (rb-leaf _) .(RB→bt A (rb-leaf _) ∷ _) .(RB→bt A (rb-leaf _)) to refl oeq (s-left x si) = ?
-    insertCase1 (rb-single _ value _) .(tr ∷ []) tr .tr req oeq s-nil = ?
-    insertCase1 (rb-single _ value _) .(tr ∷ _) tr to req oeq (s-right x si) = ?
-    insertCase1 (rb-single _ value _) .(tr ∷ _) tr to req oeq (s-left x si) = ?
-    insertCase1 (t-right-red _ value x (rb-leaf _)) stack tr to req oeq si = ?
-    insertCase1 (t-right-red _ value x (rb-single _ value₁ .Black)) stack tr to req oeq si = ?
-    insertCase1 (t-right-red _ value x (t-right-black _ value₁ x₁ tree)) stack tr to req oeq si = ?
-    insertCase1 (t-right-red _ value x (t-left-black _ value₁ x₁ tree)) stack tr to req oeq si = ?
-    insertCase1 (t-right-red _ value x (t-node-black _ value₁ x₁ x₂ tree tree₁)) stack tr to req oeq si = ?
-    insertCase1 (t-right-black _ value x tree) stack tr to req oeq si = ?
-    insertCase1 (t-left-red _ value x tree) stack tr to req oeq si = ?
-    insertCase1 (t-left-black _ value x tree) stack tr to req oeq si = ?
-    insertCase1 (t-node-red _ value x x₁ tree tree₁) stack tr to req oeq si = ?
-    insertCase1 (t-node-black _ value x x₁ tree tree₁) stack tr to req oeq si = ?
+    insertCase1 : (stack : List (bt A)) → (tr to : bt A) → RB→bt A tree ≡ tr →  RB→bt A orig ≡ to → (si : stackInvariant key tr to stack ) → t
+    insertCase1 = ?
 
+