Mercurial > hg > Gears > GearsAgda

annotate RedBlackTree.agda @ 523:8fbc3ef749b6

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
separate Agda
author ryokka
date Fri, 05 Jan 2018 16:39:43 +0900
parents src/parallel_execution/RedBlackTree.agda@f63a9a081b61
children 0696b9846415
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
417
24c98ca207f4 add RedBlackTree.agda
mir3636
parents:
diff changeset
1 module RedBlackTree where
24c98ca207f4 add RedBlackTree.agda
mir3636
parents:
diff changeset
2
24c98ca207f4 add RedBlackTree.agda
mir3636
parents:
diff changeset
3 open import stack
511
044c25475ed4 fix stack.agda
mir3636
parents: 478
diff changeset
4 open import Level
417
24c98ca207f4 add RedBlackTree.agda
mir3636
parents:
diff changeset
5
511
044c25475ed4 fix stack.agda
mir3636
parents: 478
diff changeset
6 record TreeMethods {n m : Level } {a : Set n } {t : Set m } (treeImpl : Set n ) : Set (m Level.⊔ n) where
044c25475ed4 fix stack.agda
mir3636
parents: 478
diff changeset
7 field
044c25475ed4 fix stack.agda
mir3636
parents: 478
diff changeset
8 putImpl : treeImpl -> a -> (treeImpl -> t) -> t
044c25475ed4 fix stack.agda
mir3636
parents: 478
diff changeset
9 getImpl : treeImpl -> (treeImpl -> Maybe a -> t) -> t
044c25475ed4 fix stack.agda
mir3636
parents: 478
diff changeset
10 open TreeMethods
044c25475ed4 fix stack.agda
mir3636
parents: 478
diff changeset
11
044c25475ed4 fix stack.agda
mir3636
parents: 478
diff changeset
12 record Tree {n m : Level } {a : Set n } {t : Set m } (treeImpl : Set n ) : Set (m Level.⊔ n) where
417
24c98ca207f4 add RedBlackTree.agda
mir3636
parents:
diff changeset
13 field
24c98ca207f4 add RedBlackTree.agda
mir3636
parents:
diff changeset
14 tree : treeImpl
513
f2a3acc766b5 fix RedBlackTree.agda
ryokka
parents: 512
diff changeset
15 treeMethods : TreeMethods {n} {m} {a} {t} treeImpl
f2a3acc766b5 fix RedBlackTree.agda
ryokka
parents: 512
diff changeset
16 putTree : a -> (Tree treeImpl -> t) -> t
511
044c25475ed4 fix stack.agda
mir3636
parents: 478
diff changeset
17 putTree d next = putImpl (treeMethods ) tree d (\t1 -> next (record {tree = t1 ; treeMethods = treeMethods} ))
513
f2a3acc766b5 fix RedBlackTree.agda
ryokka
parents: 512
diff changeset
18 getTree : (Tree treeImpl -> Maybe a -> t) -> t
511
044c25475ed4 fix stack.agda
mir3636
parents: 478
diff changeset
19 getTree next = getImpl (treeMethods ) tree (\t1 d -> next (record {tree = t1 ; treeMethods = treeMethods} ) d )
427
07ccd411ad70 fix interface in agda
ryokka
parents: 425
diff changeset
20
478
0223c07c3946 fix stack.agda
ryokka
parents: 428
diff changeset
21 open Tree
0223c07c3946 fix stack.agda
ryokka
parents: 428
diff changeset
22
513
f2a3acc766b5 fix RedBlackTree.agda
ryokka
parents: 512
diff changeset
23 data Color {n : Level } : Set n where
425
ea6353b6c4ef Add findNode to RedBlackTree.agda
innparusu
parents: 417
diff changeset
24 Red : Color
ea6353b6c4ef Add findNode to RedBlackTree.agda
innparusu
parents: 417
diff changeset
25 Black : Color
ea6353b6c4ef Add findNode to RedBlackTree.agda
innparusu
parents: 417
diff changeset
26
512
95865cab040a fix RedBlackTree.agda
mir3636
parents: 511
diff changeset
27 data CompareResult {n : Level } : Set n where
95865cab040a fix RedBlackTree.agda
mir3636
parents: 511
diff changeset
28 LT : CompareResult
95865cab040a fix RedBlackTree.agda
mir3636
parents: 511
diff changeset
29 GT : CompareResult
95865cab040a fix RedBlackTree.agda
mir3636
parents: 511
diff changeset
30 EQ : CompareResult
95865cab040a fix RedBlackTree.agda
mir3636
parents: 511
diff changeset
31
513
f2a3acc766b5 fix RedBlackTree.agda
ryokka
parents: 512
diff changeset
32 record Node {n : Level } (a k : Set n) : Set n where
f2a3acc766b5 fix RedBlackTree.agda
ryokka
parents: 512
diff changeset
33 inductive
425
ea6353b6c4ef Add findNode to RedBlackTree.agda
innparusu
parents: 417
diff changeset
34 field
512
95865cab040a fix RedBlackTree.agda
mir3636
parents: 511
diff changeset
35 key : k
95865cab040a fix RedBlackTree.agda
mir3636
parents: 511
diff changeset
36 value : a
513
f2a3acc766b5 fix RedBlackTree.agda
ryokka
parents: 512
diff changeset
37 right : Maybe (Node a k)
f2a3acc766b5 fix RedBlackTree.agda
ryokka
parents: 512
diff changeset
38 left : Maybe (Node a k)
514
f86da73d611e fix RedBlackTree.agda
ryokka
parents: 513
diff changeset
39 color : Color {n}
512
95865cab040a fix RedBlackTree.agda
mir3636
parents: 511
diff changeset
40 open Node
425
ea6353b6c4ef Add findNode to RedBlackTree.agda
innparusu
parents: 417
diff changeset
41
522
f63a9a081b61 remove implementation from RedBlackTree.aga
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 521
diff changeset
42 record RedBlackTree {n m : Level } {t : Set m} (a k si : Set n) : Set (m Level.⊔ n) where
417
24c98ca207f4 add RedBlackTree.agda
mir3636
parents:
diff changeset
43 field
514
f86da73d611e fix RedBlackTree.agda
ryokka
parents: 513
diff changeset
44 root : Maybe (Node a k)
522
f63a9a081b61 remove implementation from RedBlackTree.aga
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 521
diff changeset
45 nodeStack : Stack {n} {m} (Node a k) {t} si
514
f86da73d611e fix RedBlackTree.agda
ryokka
parents: 513
diff changeset
46 compare : k -> k -> CompareResult {n}
425
ea6353b6c4ef Add findNode to RedBlackTree.agda
innparusu
parents: 417
diff changeset
47
417
24c98ca207f4 add RedBlackTree.agda
mir3636
parents:
diff changeset
48 open RedBlackTree
24c98ca207f4 add RedBlackTree.agda
mir3636
parents:
diff changeset
49
522
f63a9a081b61 remove implementation from RedBlackTree.aga
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 521
diff changeset
50 open Stack
512
95865cab040a fix RedBlackTree.agda
mir3636
parents: 511
diff changeset
51
518
c9f90f573efe add more reblack tree in agda
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 515
diff changeset
52 --
c9f90f573efe add more reblack tree in agda
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 515
diff changeset
53 -- put new node at parent node, and rebuild tree to the top
c9f90f573efe add more reblack tree in agda
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 515
diff changeset
54 --
519
0a723e418b2a add some more directives in agda
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 518
diff changeset
55 {-# TERMINATING #-} -- https://agda.readthedocs.io/en/v2.5.3/language/termination-checking.html
522
f63a9a081b61 remove implementation from RedBlackTree.aga
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 521
diff changeset
56 replaceNode : {n m : Level } {t : Set m } {a k si : Set n} -> RedBlackTree {n} {m} {t} a k si -> Stack (Node a k) si -> Node a k -> Node a k -> (RedBlackTree {n} {m} {t} a k si -> t) -> t
f63a9a081b61 remove implementation from RedBlackTree.aga
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 521
diff changeset
57 replaceNode {n} {m} {t} {a} {k} {si} tree s parent n0 next = popStack s (
518
c9f90f573efe add more reblack tree in agda
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 515
diff changeset
58 \s grandParent -> replaceNode1 s grandParent ( compare tree (key parent) (key n0) ) )
c9f90f573efe add more reblack tree in agda
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 515
diff changeset
59 where
522
f63a9a081b61 remove implementation from RedBlackTree.aga
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 521
diff changeset
60 replaceNode1 : Stack (Node a k) si -> Maybe ( Node a k ) -> CompareResult -> t
518
c9f90f573efe add more reblack tree in agda
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 515
diff changeset
61 replaceNode1 s Nothing LT = next ( record tree { root = Just ( record parent { left = Just n0 ; color = Black } ) } )
c9f90f573efe add more reblack tree in agda
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 515
diff changeset
62 replaceNode1 s Nothing GT = next ( record tree { root = Just ( record parent { right = Just n0 ; color = Black } ) } )
c9f90f573efe add more reblack tree in agda
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 515
diff changeset
63 replaceNode1 s Nothing EQ = next ( record tree { root = Just ( record parent { right = Just n0 ; color = Black } ) } )
c9f90f573efe add more reblack tree in agda
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 515
diff changeset
64 replaceNode1 s (Just grandParent) result with result
c9f90f573efe add more reblack tree in agda
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 515
diff changeset
65 ... | LT = replaceNode tree s grandParent ( record parent { left = Just n0 } ) next
c9f90f573efe add more reblack tree in agda
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 515
diff changeset
66 ... | GT = replaceNode tree s grandParent ( record parent { right = Just n0 } ) next
c9f90f573efe add more reblack tree in agda
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 515
diff changeset
67 ... | EQ = next tree
478
0223c07c3946 fix stack.agda
ryokka
parents: 428
diff changeset
68
522
f63a9a081b61 remove implementation from RedBlackTree.aga
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 521
diff changeset
69 rotateRight : {n m : Level } {t : Set m } {a k si : Set n} -> RedBlackTree {n} {m} {t} a k si -> Stack (Node a k) {t} si -> Node a k -> Node a k -> Node a k -> (RedBlackTree {n} {m} {t} a k si -> t) -> t
f63a9a081b61 remove implementation from RedBlackTree.aga
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 521
diff changeset
70 rotateRight {n} {m} {t} {a} {k} {si} tree s n0 parent grandParent next = {!!}
519
0a723e418b2a add some more directives in agda
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 518
diff changeset
71
522
f63a9a081b61 remove implementation from RedBlackTree.aga
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 521
diff changeset
72 rotateLeft : {n m : Level } {t : Set m } {a k si : Set n} -> RedBlackTree {n} {m} {t} a k si -> Stack (Node a k) {t} si -> Node a k -> Node a k -> Node a k -> (RedBlackTree {n} {m} {t} a k si -> t) -> t
f63a9a081b61 remove implementation from RedBlackTree.aga
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 521
diff changeset
73 rotateLeft {n} {m} {t} {a} {k} {si} tree s n0 parent grandParent next = {!!}
519
0a723e418b2a add some more directives in agda
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 518
diff changeset
74
522
f63a9a081b61 remove implementation from RedBlackTree.aga
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 521
diff changeset
75 insertCase5 : {n m : Level } {t : Set m } {a k si : Set n} -> RedBlackTree {n} {m} {t} a k si -> Stack (Node a k) {t} si -> Node a k -> Node a k -> Node a k -> (RedBlackTree {n} {m} {t} a k si -> t) -> t
f63a9a081b61 remove implementation from RedBlackTree.aga
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 521
diff changeset
76 insertCase5 {n} {m} {t} {a} {k} {si} tree s n0 parent grandParent next = {!!}
519
0a723e418b2a add some more directives in agda
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 518
diff changeset
77
522
f63a9a081b61 remove implementation from RedBlackTree.aga
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 521
diff changeset
78 insertCase4 : {n m : Level } {t : Set m } {a k si : Set n} -> RedBlackTree {n} {m} {t} a k si -> Stack (Node a k) {t} si -> Node a k -> Node a k -> Node a k -> (RedBlackTree {n} {m} {t} a k si -> t) -> t
f63a9a081b61 remove implementation from RedBlackTree.aga
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 521
diff changeset
79 insertCase4 {n} {m} {t} {a} {k} {si} tree s n0 parent grandParent next = {!!}
519
0a723e418b2a add some more directives in agda
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 518
diff changeset
80
0a723e418b2a add some more directives in agda
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 518
diff changeset
81 {-# TERMINATING #-}
522
f63a9a081b61 remove implementation from RedBlackTree.aga
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 521
diff changeset
82 insertNode : {n m : Level } {t : Set m } {a k si : Set n} -> RedBlackTree {n} {m} {t} a k si -> Stack (Node a k) {t} si -> Node a k -> (RedBlackTree {n} {m} {t} a k si -> t) -> t
f63a9a081b61 remove implementation from RedBlackTree.aga
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 521
diff changeset
83 insertNode {n} {m} {t} {a} {k} {si} tree s n0 next = get2Stack s (\ s d1 d2 -> insertCase1 s n0 d1 d2 )
518
c9f90f573efe add more reblack tree in agda
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 515
diff changeset
84 where
522
f63a9a081b61 remove implementation from RedBlackTree.aga
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 521
diff changeset
85 insertCase1 : Stack (Node a k) si -> Node a k -> Maybe (Node a k) -> Maybe (Node a k) -> t -- placed here to allow mutual recursion
519
0a723e418b2a add some more directives in agda
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 518
diff changeset
86 -- http://agda.readthedocs.io/en/v2.5.2/language/mutual-recursion.html
522
f63a9a081b61 remove implementation from RedBlackTree.aga
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 521
diff changeset
87 insertCase3 : Stack (Node a k) si -> Node a k -> Node a k -> Node a k -> t
518
c9f90f573efe add more reblack tree in agda
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 515
diff changeset
88 insertCase3 s n0 parent grandParent with left grandParent | right grandParent
519
0a723e418b2a add some more directives in agda
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 518
diff changeset
89 ... | Nothing | Nothing = insertCase4 tree s n0 parent grandParent next
0a723e418b2a add some more directives in agda
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 518
diff changeset
90 ... | Nothing | Just uncle = insertCase4 tree s n0 parent grandParent next
518
c9f90f573efe add more reblack tree in agda
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 515
diff changeset
91 ... | Just uncle | _ with compare tree ( key uncle ) ( key parent )
519
0a723e418b2a add some more directives in agda
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 518
diff changeset
92 ... | EQ = insertCase4 tree s n0 parent grandParent next
518
c9f90f573efe add more reblack tree in agda
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 515
diff changeset
93 ... | _ with color uncle
c9f90f573efe add more reblack tree in agda
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 515
diff changeset
94 ... | Red = pop2Stack s ( \s p0 p1 -> insertCase1 s (
c9f90f573efe add more reblack tree in agda
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 515
diff changeset
95 record grandParent { color = Red ; left = Just ( record parent { color = Black ; left = Just n0 } ) ; right = Just ( record uncle { color = Black } ) }) p0 p1 )
519
0a723e418b2a add some more directives in agda
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 518
diff changeset
96 ... | Black = insertCase4 tree s n0 parent grandParent next
522
f63a9a081b61 remove implementation from RedBlackTree.aga
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 521
diff changeset
97 insertCase2 : Stack (Node a k) si -> Node a k -> Node a k -> Node a k -> t
518
c9f90f573efe add more reblack tree in agda
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 515
diff changeset
98 insertCase2 s n0 parent grandParent with color parent
c9f90f573efe add more reblack tree in agda
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 515
diff changeset
99 ... | Black = replaceNode tree s grandParent n0 next
c9f90f573efe add more reblack tree in agda
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 515
diff changeset
100 ... | Red = insertCase3 s n0 parent grandParent
c9f90f573efe add more reblack tree in agda
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 515
diff changeset
101 insertCase1 s n0 Nothing Nothing = next tree
c9f90f573efe add more reblack tree in agda
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 515
diff changeset
102 insertCase1 s n0 Nothing (Just grandParent) = replaceNode tree s grandParent n0 next
c9f90f573efe add more reblack tree in agda
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 515
diff changeset
103 insertCase1 s n0 (Just grandParent) Nothing = replaceNode tree s grandParent n0 next
c9f90f573efe add more reblack tree in agda
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 515
diff changeset
104 insertCase1 s n0 (Just parent) (Just grandParent) = insertCase2 s n0 parent grandParent
c9f90f573efe add more reblack tree in agda
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 515
diff changeset
105 where
425
ea6353b6c4ef Add findNode to RedBlackTree.agda
innparusu
parents: 417
diff changeset
106
522
f63a9a081b61 remove implementation from RedBlackTree.aga
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 521
diff changeset
107 findNode : {n m : Level } {a k si : Set n} {t : Set m} -> RedBlackTree {n} {m} {t} a k si -> Stack (Node a k) si -> (Node a k) -> (Node a k) -> (RedBlackTree {n} {m} {t} a k si -> Stack (Node a k) si -> Node a k -> t) -> t
f63a9a081b61 remove implementation from RedBlackTree.aga
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 521
diff changeset
108 findNode {n} {m} {a} {k} {si} {t} tree s n0 n1 next = pushStack s n1 (\ s -> findNode1 s n1)
417
24c98ca207f4 add RedBlackTree.agda
mir3636
parents:
diff changeset
109 where
522
f63a9a081b61 remove implementation from RedBlackTree.aga
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 521
diff changeset
110 findNode2 : Stack (Node a k) si -> (Maybe (Node a k)) -> t
515
54ff7a97aec1 fix findNode in Agda
ryokka
parents: 514
diff changeset
111 findNode2 s Nothing = next tree s n0
54ff7a97aec1 fix findNode in Agda
ryokka
parents: 514
diff changeset
112 findNode2 s (Just n) = findNode tree s n0 n next
522
f63a9a081b61 remove implementation from RedBlackTree.aga
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 521
diff changeset
113 findNode1 : Stack (Node a k) si -> (Node a k) -> t
515
54ff7a97aec1 fix findNode in Agda
ryokka
parents: 514
diff changeset
114 findNode1 s n1 with (compare tree (key n0) (key n1))
54ff7a97aec1 fix findNode in Agda
ryokka
parents: 514
diff changeset
115 ... | EQ = next tree s n0
54ff7a97aec1 fix findNode in Agda
ryokka
parents: 514
diff changeset
116 ... | GT = findNode2 s (right n1)
54ff7a97aec1 fix findNode in Agda
ryokka
parents: 514
diff changeset
117 ... | LT = findNode2 s (left n1)
425
ea6353b6c4ef Add findNode to RedBlackTree.agda
innparusu
parents: 417
diff changeset
118
ea6353b6c4ef Add findNode to RedBlackTree.agda
innparusu
parents: 417
diff changeset
119
518
c9f90f573efe add more reblack tree in agda
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 515
diff changeset
120 leafNode : {n : Level } {a k : Set n} -> k -> a -> Node a k
515
54ff7a97aec1 fix findNode in Agda
ryokka
parents: 514
diff changeset
121 leafNode k1 value = record {
54ff7a97aec1 fix findNode in Agda
ryokka
parents: 514
diff changeset
122 key = k1 ;
54ff7a97aec1 fix findNode in Agda
ryokka
parents: 514
diff changeset
123 value = value ;
54ff7a97aec1 fix findNode in Agda
ryokka
parents: 514
diff changeset
124 right = Nothing ;
54ff7a97aec1 fix findNode in Agda
ryokka
parents: 514
diff changeset
125 left = Nothing ;
54ff7a97aec1 fix findNode in Agda
ryokka
parents: 514
diff changeset
126 color = Black
518
c9f90f573efe add more reblack tree in agda
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 515
diff changeset
127 }
417
24c98ca207f4 add RedBlackTree.agda
mir3636
parents:
diff changeset
128
522
f63a9a081b61 remove implementation from RedBlackTree.aga
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 521
diff changeset
129 putRedBlackTree : {n m : Level } {a k si : Set n} {t : Set m} -> RedBlackTree {n} {m} {t} a k si -> k -> a -> (RedBlackTree {n} {m} {t} a k si -> t) -> t
f63a9a081b61 remove implementation from RedBlackTree.aga
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 521
diff changeset
130 putRedBlackTree {n} {m} {a} {k} {si} {t} tree k1 value next with (root tree)
515
54ff7a97aec1 fix findNode in Agda
ryokka
parents: 514
diff changeset
131 ... | Nothing = next (record tree {root = Just (leafNode k1 value) })
518
c9f90f573efe add more reblack tree in agda
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 515
diff changeset
132 ... | Just n2 = findNode tree (nodeStack tree) (leafNode k1 value) n2 (\ tree1 s n1 -> insertNode tree1 s n1 next)
515
54ff7a97aec1 fix findNode in Agda
ryokka
parents: 514
diff changeset
133
522
f63a9a081b61 remove implementation from RedBlackTree.aga
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 521
diff changeset
134 getRedBlackTree : {n m : Level } {a k si : Set n} {t : Set m} -> RedBlackTree {n} {m} {t} a k si -> k -> (RedBlackTree {n} {m} {t} a k si -> (Maybe (Node a k)) -> t) -> t
f63a9a081b61 remove implementation from RedBlackTree.aga
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 521
diff changeset
135 getRedBlackTree {_} {_} {a} {k} {_} {t} tree k1 cs = checkNode (root tree)
417
24c98ca207f4 add RedBlackTree.agda
mir3636
parents:
diff changeset
136 where
515
54ff7a97aec1 fix findNode in Agda
ryokka
parents: 514
diff changeset
137 checkNode : Maybe (Node a k) -> t
54ff7a97aec1 fix findNode in Agda
ryokka
parents: 514
diff changeset
138 checkNode Nothing = cs tree Nothing
54ff7a97aec1 fix findNode in Agda
ryokka
parents: 514
diff changeset
139 checkNode (Just n) = search n
54ff7a97aec1 fix findNode in Agda
ryokka
parents: 514
diff changeset
140 where
54ff7a97aec1 fix findNode in Agda
ryokka
parents: 514
diff changeset
141 search : Node a k -> t
54ff7a97aec1 fix findNode in Agda
ryokka
parents: 514
diff changeset
142 search n with compare tree k1 (key n)
54ff7a97aec1 fix findNode in Agda
ryokka
parents: 514
diff changeset
143 search n | LT = checkNode (left n)
54ff7a97aec1 fix findNode in Agda
ryokka
parents: 514
diff changeset
144 search n | GT = checkNode (right n)
54ff7a97aec1 fix findNode in Agda
ryokka
parents: 514
diff changeset
145 search n | EQ = cs tree (Just n)