|
575
|
1 module RedBlackTree where
|
|
|
2
|
|
|
3
|
|
|
4 open import Level hiding (zero)
|
|
|
5
|
|
|
6 open import Data.Nat hiding (compare)
|
|
|
7 open import Data.Nat.Properties as NatProp
|
|
|
8 open import Data.Maybe
|
|
|
9 open import Data.Bool
|
|
|
10 open import Data.Empty
|
|
|
11
|
|
|
12 open import Relation.Binary
|
|
|
13 open import Relation.Binary.PropositionalEquality
|
|
|
14
|
|
|
15 open import stack
|
|
|
16
|
|
|
17 record TreeMethods {n m : Level } {a : Set n } {t : Set m } (treeImpl : Set n ) : Set (m Level.⊔ n) where
|
|
|
18 field
|
|
|
19 putImpl : treeImpl → a → (treeImpl → t) → t
|
|
|
20 getImpl : treeImpl → (treeImpl → Maybe a → t) → t
|
|
|
21 open TreeMethods
|
|
|
22
|
|
|
23 record Tree {n m : Level } {a : Set n } {t : Set m } (treeImpl : Set n ) : Set (m Level.⊔ n) where
|
|
|
24 field
|
|
|
25 tree : treeImpl
|
|
|
26 treeMethods : TreeMethods {n} {m} {a} {t} treeImpl
|
|
|
27 putTree : a → (Tree treeImpl → t) → t
|
|
|
28 putTree d next = putImpl (treeMethods ) tree d (\t1 → next (record {tree = t1 ; treeMethods = treeMethods} ))
|
|
|
29 getTree : (Tree treeImpl → Maybe a → t) → t
|
|
|
30 getTree next = getImpl (treeMethods ) tree (\t1 d → next (record {tree = t1 ; treeMethods = treeMethods} ) d )
|
|
|
31
|
|
|
32 open Tree
|
|
|
33
|
|
|
34 data Color {n : Level } : Set n where
|
|
|
35 Red : Color
|
|
|
36 Black : Color
|
|
|
37
|
|
|
38
|
|
|
39 record Node {n : Level } (a : Set n) (k : ℕ) : Set n where
|
|
|
40 inductive
|
|
|
41 field
|
|
|
42 key : ℕ
|
|
|
43 value : a
|
|
|
44 right : Maybe (Node a k)
|
|
|
45 left : Maybe (Node a k)
|
|
|
46 color : Color {n}
|
|
|
47 open Node
|
|
|
48
|
|
|
49 record RedBlackTree {n m : Level } {t : Set m} (a : Set n) (k : ℕ) : Set (m Level.⊔ n) where
|
|
|
50 field
|
|
|
51 root : Maybe (Node a k)
|
|
|
52 nodeStack : SingleLinkedStack (Node a k)
|
|
|
53 -- compare : k → k → Tri A B C
|
|
|
54
|
|
|
55 open RedBlackTree
|
|
|
56
|
|
|
57 open SingleLinkedStack
|
|
|
58
|
|
|
59 compTri : ( x y : ℕ ) -> Tri ( x < y ) ( x ≡ y ) ( x > y )
|
|
|
60 compTri = IsStrictTotalOrder.compare (Relation.Binary.StrictTotalOrder.isStrictTotalOrder <-strictTotalOrder)
|
|
|
61 where open import Relation.Binary
|
|
|
62
|
|
|
63 -- put new node at parent node, and rebuild tree to the top
|
|
|
64 --
|
|
|
65 {-# TERMINATING #-} -- https://agda.readthedocs.io/en/v2.5.3/language/termination-checking.html
|
|
|
66 replaceNode : {n m : Level } {t : Set m } {a : Set n} {k : ℕ} → RedBlackTree {n} {m} {t} a k → SingleLinkedStack (Node a k) → Node a k → (RedBlackTree {n} {m} {t} a k → t) → t
|
|
|
67 replaceNode {n} {m} {t} {a} {k} tree s n0 next = popSingleLinkedStack s (
|
|
|
68 \s parent → replaceNode1 s parent)
|
|
|
69 module ReplaceNode where
|
|
|
70 replaceNode1 : SingleLinkedStack (Node a k) → Maybe ( Node a k ) → t
|
|
|
71 replaceNode1 s nothing = next ( record tree { root = just (record n0 { color = Black}) } )
|
|
|
72 replaceNode1 s (just n1) with compTri (key n1) (key n0)
|
|
|
73 replaceNode1 s (just n1) | tri< lt ¬eq ¬gt = replaceNode {n} {m} {t} {a} {k} tree s ( record n1 { value = value n0 ; left = left n0 ; right = right n0 } ) next
|
|
|
74 replaceNode1 s (just n1) | tri≈ ¬lt eq ¬gt = replaceNode {n} {m} {t} {a} {k} tree s ( record n1 { left = just n0 } ) next
|
|
|
75 replaceNode1 s (just n1) | tri> ¬lt ¬eq gt = replaceNode {n} {m} {t} {a} {k} tree s ( record n1 { right = just n0 } ) next
|
|
|
76
|
|
|
77
|
|
|
78 rotateRight : {n m : Level } {t : Set m } {a : Set n} {k : ℕ} → RedBlackTree {n} {m} {t} a k → SingleLinkedStack (Node a k) → Maybe (Node a k) → Maybe (Node a k) →
|
|
|
79 (RedBlackTree {n} {m} {t} a k → SingleLinkedStack (Node a k) → Maybe (Node a k) → Maybe (Node a k) → t) → t
|
|
|
80 rotateRight {n} {m} {t} {a} {k} tree s n0 parent rotateNext = getSingleLinkedStack s (\ s n0 → rotateRight1 {n} {m} {t} {a} {k} tree s n0 parent rotateNext)
|
|
|
81 where
|
|
|
82 rotateRight1 : {n m : Level } {t : Set m } {a : Set n} {k : ℕ} → RedBlackTree {n} {m} {t} a k → SingleLinkedStack (Node a k) → Maybe (Node a k) → Maybe (Node a k) →
|
|
|
83 (RedBlackTree {n} {m} {t} a k → SingleLinkedStack (Node a k) → Maybe (Node a k) → Maybe (Node a k) → t) → t
|
|
|
84 rotateRight1 {n} {m} {t} {a} {k} tree s n0 parent rotateNext with n0
|
|
|
85 ... | nothing = rotateNext tree s nothing n0
|
|
|
86 ... | just n1 with parent
|
|
|
87 ... | nothing = rotateNext tree s (just n1 ) n0
|
|
|
88 ... | just parent1 with left parent1
|
|
|
89 ... | nothing = rotateNext tree s (just n1) nothing
|
|
|
90 ... | just leftParent with compTri (key n1) (key leftParent)
|
|
|
91 rotateRight1 {n} {m} {t} {a} {k} tree s n0 parent rotateNext | just n1 | just parent1 | just leftParent | tri< a₁ ¬b ¬c = rotateNext tree s (just n1) parent
|
|
|
92 rotateRight1 {n} {m} {t} {a} {k} tree s n0 parent rotateNext | just n1 | just parent1 | just leftParent | tri≈ ¬a b ¬c = rotateNext tree s (just n1) parent
|
|
|
93 rotateRight1 {n} {m} {t} {a} {k} tree s n0 parent rotateNext | just n1 | just parent1 | just leftParent | tri> ¬a ¬b c = rotateNext tree s (just n1) parent
|
|
|
94
|
|
|
95
|
|
|
96 rotateLeft : {n m : Level } {t : Set m } {a : Set n} {k : ℕ} → RedBlackTree {n} {m} {t} a k → SingleLinkedStack (Node a k) → Maybe (Node a k) → Maybe (Node a k) →
|
|
|
97 (RedBlackTree {n} {m} {t} a k → SingleLinkedStack (Node a k) → Maybe (Node a k) → Maybe (Node a k) → t) → t
|
|
|
98 rotateLeft {n} {m} {t} {a} {k} tree s n0 parent rotateNext = getSingleLinkedStack s (\ s n0 → rotateLeft1 tree s n0 parent rotateNext)
|
|
|
99 where
|
|
|
100 rotateLeft1 : {n m : Level } {t : Set m } {a : Set n} {k : ℕ} → RedBlackTree {n} {m} {t} a k → SingleLinkedStack (Node a k) → Maybe (Node a k) → Maybe (Node a k) →
|
|
|
101 (RedBlackTree {n} {m} {t} a k → SingleLinkedStack (Node a k) → Maybe (Node a k) → Maybe (Node a k) → t) → t
|
|
|
102 rotateLeft1 {n} {m} {t} {a} {k} tree s n0 parent rotateNext with n0
|
|
|
103 ... | nothing = rotateNext tree s nothing n0
|
|
|
104 ... | just n1 with parent
|
|
|
105 ... | nothing = rotateNext tree s (just n1) nothing
|
|
|
106 ... | just parent1 with right parent1
|
|
|
107 ... | nothing = rotateNext tree s (just n1) nothing
|
|
|
108 ... | just rightParent with compTri (key n1) (key rightParent)
|
|
|
109 rotateLeft1 {n} {m} {t} {a} {k} tree s n0 parent rotateNext | just n1 | just parent1 | just rightParent | tri< a₁ ¬b ¬c = rotateNext tree s (just n1) parent
|
|
|
110 rotateLeft1 {n} {m} {t} {a} {k} tree s n0 parent rotateNext | just n1 | just parent1 | just rightParent | tri≈ ¬a b ¬c = rotateNext tree s (just n1) parent
|
|
|
111 rotateLeft1 {n} {m} {t} {a} {k} tree s n0 parent rotateNext | just n1 | just parent1 | just rightParent | tri> ¬a ¬b c = rotateNext tree s (just n1) parent
|
|
|
112 -- ... | EQ = rotateNext tree s (just n1) parent
|
|
|
113 -- ... | _ = rotateNext tree s (just n1) parent
|
|
|
114
|
|
|
115 {-# TERMINATING #-}
|
|
|
116 insertCase5 : {n m : Level } {t : Set m } {a : Set n} {k : ℕ} → RedBlackTree {n} {m} {t} a k → SingleLinkedStack (Node a k) → Maybe (Node a k) → Node a k → Node a k → (RedBlackTree {n} {m} {t} a k → t) → t
|
|
|
117 insertCase5 {n} {m} {t} {a} {k} tree s n0 parent grandParent next = pop2SingleLinkedStack s (\ s parent grandParent → insertCase51 tree s n0 parent grandParent next)
|
|
|
118 where
|
|
|
119 insertCase51 : {n m : Level } {t : Set m } {a : Set n} {k : ℕ} → RedBlackTree {n} {m} {t} a k → SingleLinkedStack (Node a k) → Maybe (Node a k) → Maybe (Node a k) → Maybe (Node a k) → (RedBlackTree {n} {m} {t} a k → t) → t
|
|
|
120 insertCase51 {n} {m} {t} {a} {k} tree s n0 parent grandParent next with n0
|
|
|
121 ... | nothing = next tree
|
|
|
122 ... | just n1 with parent | grandParent
|
|
|
123 ... | nothing | _ = next tree
|
|
|
124 ... | _ | nothing = next tree
|
|
|
125 ... | just parent1 | just grandParent1 with left parent1 | left grandParent1
|
|
|
126 ... | nothing | _ = next tree
|
|
|
127 ... | _ | nothing = next tree
|
|
|
128 ... | just leftParent1 | just leftGrandParent1
|
|
|
129 with compTri (key n1) (key leftParent1) | compTri (key leftParent1) (key leftGrandParent1)
|
|
|
130 ... | tri≈ ¬a b ¬c | tri≈ ¬a1 b1 ¬c1 = rotateRight tree s n0 parent (\ tree s n0 parent → insertCase5 tree s n0 parent1 grandParent1 next)
|
|
|
131 ... | _ | _ = rotateLeft tree s n0 parent (\ tree s n0 parent → insertCase5 tree s n0 parent1 grandParent1 next)
|
|
|
132 -- ... | EQ | EQ = rotateRight tree s n0 parent (\ tree s n0 parent → insertCase5 tree s n0 parent1 grandParent1 next)
|
|
|
133 -- ... | _ | _ = rotateLeft tree s n0 parent (\ tree s n0 parent → insertCase5 tree s n0 parent1 grandParent1 next)
|
|
|
134
|
|
|
135 insertCase4 : {n m : Level } {t : Set m } {a : Set n} {k : ℕ} → RedBlackTree {n} {m} {t} a k → SingleLinkedStack (Node a k) → Node a k → Node a k → Node a k → (RedBlackTree {n} {m} {t} a k → t) → t
|
|
|
136 insertCase4 {n} {m} {t} {a} {k} tree s n0 parent grandParent next
|
|
|
137 with (right parent) | (left grandParent)
|
|
|
138 ... | nothing | _ = insertCase5 tree s (just n0) parent grandParent next
|
|
|
139 ... | _ | nothing = insertCase5 tree s (just n0) parent grandParent next
|
|
|
140 ... | just rightParent | just leftGrandParent with compTri (key n0) (key rightParent) | compTri (key parent) (key leftGrandParent) -- (key n0) (key rightParent) | (key parent) (key leftGrandParent)
|
|
|
141 -- ... | EQ | EQ = popSingleLinkedStack s (\ s n1 → rotateLeft tree s (left n0) (just grandParent)
|
|
|
142 -- (\ tree s n0 parent → insertCase5 tree s n0 rightParent grandParent next))
|
|
|
143 -- ... | _ | _ = insertCase41 tree s n0 parent grandParent next
|
|
|
144 ... | tri≈ ¬a b ¬c | tri≈ ¬a1 b1 ¬c1 = popSingleLinkedStack s (\ s n1 → rotateLeft tree s (left n0) (just grandParent) (\ tree s n0 parent → insertCase5 tree s n0 rightParent grandParent next))
|
|
|
145 ... | _ | _ = insertCase41 tree s n0 parent grandParent next
|
|
|
146 where
|
|
|
147 insertCase41 : {n m : Level } {t : Set m } {a : Set n} {k : ℕ} → RedBlackTree {n} {m} {t} a k → SingleLinkedStack (Node a k) → Node a k → Node a k → Node a k → (RedBlackTree {n} {m} {t} a k → t) → t
|
|
|
148 insertCase41 {n} {m} {t} {a} {k} tree s n0 parent grandParent next
|
|
|
149 with (left parent) | (right grandParent)
|
|
|
150 ... | nothing | _ = insertCase5 tree s (just n0) parent grandParent next
|
|
|
151 ... | _ | nothing = insertCase5 tree s (just n0) parent grandParent next
|
|
|
152 ... | just leftParent | just rightGrandParent with compTri (key n0) (key leftParent) | compTri (key parent) (key rightGrandParent)
|
|
|
153 ... | tri≈ ¬a b ¬c | tri≈ ¬a1 b1 ¬c1 = popSingleLinkedStack s (\ s n1 → rotateRight tree s (right n0) (just grandParent) (\ tree s n0 parent → insertCase5 tree s n0 leftParent grandParent next))
|
|
|
154 ... | _ | _ = insertCase5 tree s (just n0) parent grandParent next
|
|
|
155 -- ... | EQ | EQ = popSingleLinkedStack s (\ s n1 → rotateRight tree s (right n0) (just grandParent)
|
|
|
156 -- (\ tree s n0 parent → insertCase5 tree s n0 leftParent grandParent next))
|
|
|
157 -- ... | _ | _ = insertCase5 tree s (just n0) parent grandParent next
|
|
|
158
|
|
|
159 colorNode : {n : Level } {a : Set n} {k : ℕ} → Node a k → Color → Node a k
|
|
|
160 colorNode old c = record old { color = c }
|
|
|
161
|
|
|
162 {-# TERMINATING #-}
|
|
|
163 insertNode : {n m : Level } {t : Set m } {a : Set n} {k : ℕ} → RedBlackTree {n} {m} {t} a k → SingleLinkedStack (Node a k) → Node a k → (RedBlackTree {n} {m} {t} a k → t) → t
|
|
|
164 insertNode {n} {m} {t} {a} {k} tree s n0 next = get2SingleLinkedStack s (insertCase1 n0)
|
|
|
165 where
|
|
|
166 insertCase1 : Node a k → SingleLinkedStack (Node a k) → Maybe (Node a k) → Maybe (Node a k) → t -- placed here to allow mutual recursion
|
|
|
167 -- http://agda.readthedocs.io/en/v2.5.2/language/mutual-recursion.html
|
|
|
168 insertCase3 : SingleLinkedStack (Node a k) → Node a k → Node a k → Node a k → t
|
|
|
169 insertCase3 s n0 parent grandParent with left grandParent | right grandParent
|
|
|
170 ... | nothing | nothing = insertCase4 tree s n0 parent grandParent next
|
|
|
171 ... | nothing | just uncle = insertCase4 tree s n0 parent grandParent next
|
|
|
172 ... | just uncle | _ with compTri ( key uncle ) ( key parent )
|
|
|
173 insertCase3 s n0 parent grandParent | just uncle | _ | tri≈ ¬a b ¬c = insertCase4 tree s n0 parent grandParent next
|
|
|
174 insertCase3 s n0 parent grandParent | just uncle | _ | tri< a ¬b ¬c with color uncle
|
|
|
175 insertCase3 s n0 parent grandParent | just uncle | _ | tri< a ¬b ¬c | Red = pop2SingleLinkedStack s ( \s p0 p1 → insertCase1 (
|
|
|
176 record grandParent { color = Red ; left = just ( record parent { color = Black } ) ; right = just ( record uncle { color = Black } ) }) s p0 p1 )
|
|
|
177 insertCase3 s n0 parent grandParent | just uncle | _ | tri< a ¬b ¬c | Black = insertCase4 tree s n0 parent grandParent next
|
|
|
178 insertCase3 s n0 parent grandParent | just uncle | _ | tri> ¬a ¬b c with color uncle
|
|
|
179 insertCase3 s n0 parent grandParent | just uncle | _ | tri> ¬a ¬b c | Red = pop2SingleLinkedStack s ( \s p0 p1 → insertCase1 ( record grandParent { color = Red ; left = just ( record parent { color = Black } ) ; right = just ( record uncle { color = Black } ) }) s p0 p1 )
|
|
|
180 insertCase3 s n0 parent grandParent | just uncle | _ | tri> ¬a ¬b c | Black = insertCase4 tree s n0 parent grandParent next
|
|
|
181 -- ... | EQ = insertCase4 tree s n0 parent grandParent next
|
|
|
182 -- ... | _ with color uncle
|
|
|
183 -- ... | Red = pop2SingleLinkedStack s ( \s p0 p1 → insertCase1 (
|
|
|
184 -- record grandParent { color = Red ; left = just ( record parent { color = Black } ) ; right = just ( record uncle { color = Black } ) }) s p0 p1 )
|
|
|
185 -- ... | Black = insertCase4 tree s n0 parent grandParent next --!!
|
|
|
186 insertCase2 : SingleLinkedStack (Node a k) → Node a k → Node a k → Node a k → t
|
|
|
187 insertCase2 s n0 parent grandParent with color parent
|
|
|
188 ... | Black = replaceNode tree s n0 next
|
|
|
189 ... | Red = insertCase3 s n0 parent grandParent
|
|
|
190 insertCase1 n0 s nothing nothing = next tree
|
|
|
191 insertCase1 n0 s nothing (just grandParent) = next tree
|
|
|
192 insertCase1 n0 s (just parent) nothing = replaceNode tree s (colorNode n0 Black) next
|
|
|
193 insertCase1 n0 s (just parent) (just grandParent) = insertCase2 s n0 parent grandParent
|
|
|
194
|
|
|
195 ----
|
|
|
196 -- find node potition to insert or to delete, the path will be in the stack
|
|
|
197 --
|
|
|
198 findNode : {n m : Level } {a : Set n} {k : ℕ} {t : Set m} → RedBlackTree {n} {m} {t} a k → SingleLinkedStack (Node a k) → (Node a k) → (Node a k) → (RedBlackTree {n} {m} {t} a k → SingleLinkedStack (Node a k) → Node a k → t) → t
|
|
|
199 findNode {n} {m} {a} {k} {t} tree s n0 n1 next = pushSingleLinkedStack s n1 (\ s → findNode1 s n1)
|
|
|
200 module FindNode where
|
|
|
201 findNode2 : SingleLinkedStack (Node a k) → (Maybe (Node a k)) → t
|
|
|
202 findNode2 s nothing = next tree s n0
|
|
|
203 findNode2 s (just n) = findNode tree s n0 n next
|
|
|
204 findNode1 : SingleLinkedStack (Node a k) → (Node a k) → t
|
|
|
205 findNode1 s n1 with (compTri (key n0) (key n1))
|
|
|
206 findNode1 s n1 | tri< a ¬b ¬c = popSingleLinkedStack s ( \s _ → next tree s (record n1 { key = key n1 ; value = value n0 } ) )
|
|
|
207 findNode1 s n1 | tri≈ ¬a b ¬c = findNode2 s (right n1)
|
|
|
208 findNode1 s n1 | tri> ¬a ¬b c = findNode2 s (left n1)
|
|
|
209 -- ... | EQ = popSingleLinkedStack s ( \s _ → next tree s (record n1 { key = key n1 ; value = value n0 } ) )
|
|
|
210 -- ... | GT = findNode2 s (right n1)
|
|
|
211 -- ... | LT = findNode2 s (left n1)
|
|
|
212
|
|
|
213
|
|
|
214
|
|
|
215
|
|
|
216 leafNode : {n : Level } { a : Set n } → a → (k : ℕ) → (Node a k)
|
|
|
217 leafNode v k1 = record { key = k1 ; value = v ; right = nothing ; left = nothing ; color = Red }
|
|
|
218
|
|
|
219 putRedBlackTree : {n m : Level} {t : Set m} {a : Set n} {k : ℕ} → RedBlackTree {n} {m} {t} a k → {!!} → {!!} → (RedBlackTree {n} {m} {t} a k → t) → t
|
|
|
220 putRedBlackTree {n} {m} {t} {a} {k} tree val k1 next with (root tree)
|
|
|
221 putRedBlackTree {n} {m} {t} {a} {k} tree val k1 next | nothing = next (record tree {root = just (leafNode {!!} {!!}) })
|
|
|
222 putRedBlackTree {n} {m} {t} {a} {k} tree val k1 next | just n2 = clearSingleLinkedStack (nodeStack tree) (λ s → findNode tree s (leafNode {!!} {!!}) n2 (λ tree1 s n1 → insertNode tree1 s n1 next))
|
|
|
223 -- putRedBlackTree {n} {m} {t} {a} {k} tree value k1 next with (root tree)
|
|
|
224 -- ... | nothing = next (record tree {root = just (leafNode k1 value) })
|
|
|
225 -- ... | just n2 = clearSingleLinkedStack (nodeStack tree) (\ s → findNode tree s (leafNode k1 value) n2 (\ tree1 s n1 → insertNode tree1 s n1 next))
|
|
|
226
|
|
|
227
|
|
|
228 -- getRedBlackTree : {n m : Level } {t : Set m} {a : Set n} {k : ℕ} → RedBlackTree {n} {m} {t} {A} a k → k → (RedBlackTree {n} {m} {t} {A} a k → (Maybe (Node a k)) → t) → t
|
|
|
229 -- getRedBlackTree {_} {_} {t} {a} {k} tree k1 cs = checkNode (root tree)
|
|
|
230 -- module GetRedBlackTree where -- http://agda.readthedocs.io/en/v2.5.2/language/let-and-where.html
|
|
|
231 -- search : Node a k → t
|
|
|
232 -- checkNode : Maybe (Node a k) → t
|
|
|
233 -- checkNode nothing = cs tree nothing
|
|
|
234 -- checkNode (just n) = search n
|
|
|
235 -- search n with compTri k1 (key n)
|
|
|
236 -- search n | tri< a ¬b ¬c = checkNode (left n)
|
|
|
237 -- search n | tri≈ ¬a b ¬c = cs tree (just n)
|
|
|
238 -- search n | tri> ¬a ¬b c = checkNode (right n)
|
|
|
239
|
|
|
240
|
|
|
241
|
|
|
242 -- compareT : {A B C : Set } → ℕ → ℕ → Tri A B C
|
|
|
243 -- compareT x y with IsStrictTotalOrder.compare (Relation.Binary.StrictTotalOrder.isStrictTotalOrder <-strictTotalOrder) x y
|
|
|
244 -- compareT x y | tri< a ¬b ¬c = tri< {!!} {!!} {!!}
|
|
|
245 -- compareT x y | tri≈ ¬a b ¬c = {!!}
|
|
|
246 -- compareT x y | tri> ¬a ¬b c = {!!}
|
|
|
247 -- -- ... | tri≈ a b c = {!!}
|
|
|
248 -- -- ... | tri< a b c = {!!}
|
|
|
249 -- -- ... | tri> a b c = {!!}
|
|
|
250
|
|
|
251 -- compare2 : (x y : ℕ ) → CompareResult {Level.zero}
|
|
|
252 -- compare2 zero zero = EQ
|
|
|
253 -- compare2 (suc _) zero = GT
|
|
|
254 -- compare2 zero (suc _) = LT
|
|
|
255 -- compare2 (suc x) (suc y) = compare2 x y
|
|
|
256
|
|
|
257 -- -- putUnblanceTree : {n m : Level } {a : Set n} {k : ℕ} {t : Set m} → RedBlackTree {n} {m} {t} {A} a k → k → a → (RedBlackTree {n} {m} {t} {A} a k → t) → t
|
|
|
258 -- -- putUnblanceTree {n} {m} {A} {a} {k} {t} tree k1 value next with (root tree)
|
|
|
259 -- -- ... | nothing = next (record tree {root = just (leafNode k1 value) })
|
|
|
260 -- -- ... | just n2 = clearSingleLinkedStack (nodeStack tree) (λ s → findNode tree s (leafNode k1 value) n2 (λ tree1 s n1 → replaceNode tree1 s n1 next))
|
|
|
261
|
|
|
262 -- -- checkT : {m : Level } (n : Maybe (Node ℕ ℕ)) → ℕ → Bool
|
|
|
263 -- -- checkT nothing _ = false
|
|
|
264 -- -- checkT (just n) x with compTri (value n) x
|
|
|
265 -- -- ... | tri≈ _ _ _ = true
|
|
|
266 -- -- ... | _ = false
|
|
|
267
|
|
|
268 -- -- checkEQ : {m : Level } ( x : ℕ ) -> ( n : Node ℕ ℕ ) -> (value n ) ≡ x -> checkT {m} (just n) x ≡ true
|
|
|
269 -- -- checkEQ x n refl with compTri (value n) x
|
|
|
270 -- -- ... | tri≈ _ refl _ = refl
|
|
|
271 -- -- ... | tri> _ neq gt = ⊥-elim (neq refl)
|
|
|
272 -- -- ... | tri< lt neq _ = ⊥-elim (neq refl)
|
|
|
273
|
|
|
274
|
|
|
275 createEmptyRedBlackTreeℕ : {n m : Level} {t : Set m} (a : Set n) (b : ℕ)
|
|
|
276 → RedBlackTree {n} {m} {t} a b
|
|
|
277 createEmptyRedBlackTreeℕ a b = record {
|
|
|
278 root = nothing
|
|
|
279 ; nodeStack = emptySingleLinkedStack
|
|
|
280 -- ; nodeComp = λ x x₁ → {!!}
|
|
|
281
|
|
|
282 }
|
|
|
283
|
|
|
284 -- ( x y : ℕ ) -> Tri ( x < y ) ( x ≡ y ) ( x > y )
|
|
|
285
|
|
|
286 -- test = (λ x → (createEmptyRedBlackTreeℕ x x)
|
|
|
287
|
|
|
288 ts = createEmptyRedBlackTreeℕ {ℕ} {?} {!!} 0
|
|
|
289
|
|
|
290 -- tes = putRedBlackTree {_} {_} {_} (createEmptyRedBlackTreeℕ {_} {_} {_} 3 3) 2 2 (λ t → t)
|
