Mercurial > hg > Gears > GearsAgda

annotate src/parallel_execution/RedBlackTree.agda @ 518:c9f90f573efe

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
add more reblack tree in agda
author Shinji KONO <kono@ie.u-ryukyu.ac.jp>
date Thu, 04 Jan 2018 23:15:32 +0900
parents 54ff7a97aec1
children 0a723e418b2a
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
514
f86da73d611e fix RedBlackTree.agda
ryokka
parents: 513
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)
515
54ff7a97aec1 fix findNode in Agda
ryokka
parents: 514
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
512
95865cab040a fix RedBlackTree.agda
mir3636
parents: 511
diff changeset
50 open Stack
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 --
c9f90f573efe add more reblack tree in agda
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 515
diff changeset
55 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
c9f90f573efe add more reblack tree in agda
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 515
diff changeset
56 replaceNode {n} {m} {t} {a} {k} {si} tree s parent n0 next = popStack s (
c9f90f573efe add more reblack tree in agda
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 515
diff changeset
57 \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
58 where
c9f90f573efe add more reblack tree in agda
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 515
diff changeset
59 replaceNode1 : Stack (Node a k) si -> Maybe ( Node a k ) -> CompareResult -> t
c9f90f573efe add more reblack tree in agda
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 515
diff changeset
60 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
61 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
62 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
63 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
64 ... | 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
65 ... | 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
66 ... | EQ = next tree
478
0223c07c3946 fix stack.agda
ryokka
parents: 428
diff changeset
67
515
54ff7a97aec1 fix findNode in Agda
ryokka
parents: 514
diff changeset
68 insertNode : {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 -> (RedBlackTree {n} {m} {t} a k si -> t) -> t
518
c9f90f573efe add more reblack tree in agda
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 515
diff changeset
69 insertNode {n} {m} {t} {a} {k} {si} tree s n0 next = get2Stack s (\ s d1 d2 -> insertCase1 s n0 d1 d2 )
c9f90f573efe add more reblack tree in agda
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 515
diff changeset
70 where
c9f90f573efe add more reblack tree in agda
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 515
diff changeset
71 insertCase1 : Stack (Node a k) si -> Node a k -> Maybe (Node a k) -> Maybe (Node a k) -> t -- placed here to allo mutual recursion
c9f90f573efe add more reblack tree in agda
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 515
diff changeset
72 insertCase3 : Stack (Node a k) si -> Node a k -> Node a k -> Node a k -> t
c9f90f573efe add more reblack tree in agda
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 515
diff changeset
73 insertCase3 s n0 parent grandParent with left grandParent | right grandParent
c9f90f573efe add more reblack tree in agda
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 515
diff changeset
74 ... | Nothing | Nothing = {!!} -- insertCase4
c9f90f573efe add more reblack tree in agda
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 515
diff changeset
75 ... | Nothing | Just uncle = {!!} -- insertCase4
c9f90f573efe add more reblack tree in agda
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 515
diff changeset
76 ... | Just uncle | _ with compare tree ( key uncle ) ( key parent )
c9f90f573efe add more reblack tree in agda
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 515
diff changeset
77 ... | EQ = {!!} -- insertCase4
c9f90f573efe add more reblack tree in agda
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 515
diff changeset
78 ... | _ with color uncle
c9f90f573efe add more reblack tree in agda
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 515
diff changeset
79 ... | 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
80 record grandParent { color = Red ; left = Just ( record parent { color = Black ; left = Just n0 } ) ; right = Just ( record uncle { color = Black } ) }) p0 p1 )
c9f90f573efe add more reblack tree in agda
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 515
diff changeset
81 ... | Black = {!!} -- insertCase4
c9f90f573efe add more reblack tree in agda
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 515
diff changeset
82 insertCase2 : Stack (Node a k) si -> Node a k -> Node a k -> Node a k -> t
c9f90f573efe add more reblack tree in agda
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 515
diff changeset
83 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
84 ... | 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
85 ... | 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
86 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
87 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
88 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
89 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
90 where
425
ea6353b6c4ef Add findNode to RedBlackTree.agda
innparusu
parents: 417
diff changeset
91
515
54ff7a97aec1 fix findNode in Agda
ryokka
parents: 514
diff changeset
92 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
54ff7a97aec1 fix findNode in Agda
ryokka
parents: 514
diff changeset
93 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
94 where
515
54ff7a97aec1 fix findNode in Agda
ryokka
parents: 514
diff changeset
95 findNode2 : Stack (Node a k) si -> (Maybe (Node a k)) -> t
54ff7a97aec1 fix findNode in Agda
ryokka
parents: 514
diff changeset
96 findNode2 s Nothing = next tree s n0
54ff7a97aec1 fix findNode in Agda
ryokka
parents: 514
diff changeset
97 findNode2 s (Just n) = findNode tree s n0 n next
54ff7a97aec1 fix findNode in Agda
ryokka
parents: 514
diff changeset
98 findNode1 : Stack (Node a k) si -> (Node a k) -> t
54ff7a97aec1 fix findNode in Agda
ryokka
parents: 514
diff changeset
99 findNode1 s n1 with (compare tree (key n0) (key n1))
54ff7a97aec1 fix findNode in Agda
ryokka
parents: 514
diff changeset
100 ... | EQ = next tree s n0
54ff7a97aec1 fix findNode in Agda
ryokka
parents: 514
diff changeset
101 ... | GT = findNode2 s (right n1)
54ff7a97aec1 fix findNode in Agda
ryokka
parents: 514
diff changeset
102 ... | LT = findNode2 s (left n1)
425
ea6353b6c4ef Add findNode to RedBlackTree.agda
innparusu
parents: 417
diff changeset
103
ea6353b6c4ef Add findNode to RedBlackTree.agda
innparusu
parents: 417
diff changeset
104
518
c9f90f573efe add more reblack tree in agda
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 515
diff changeset
105 leafNode : {n : Level } {a k : Set n} -> k -> a -> Node a k
515
54ff7a97aec1 fix findNode in Agda
ryokka
parents: 514
diff changeset
106 leafNode k1 value = record {
54ff7a97aec1 fix findNode in Agda
ryokka
parents: 514
diff changeset
107 key = k1 ;
54ff7a97aec1 fix findNode in Agda
ryokka
parents: 514
diff changeset
108 value = value ;
54ff7a97aec1 fix findNode in Agda
ryokka
parents: 514
diff changeset
109 right = Nothing ;
54ff7a97aec1 fix findNode in Agda
ryokka
parents: 514
diff changeset
110 left = Nothing ;
54ff7a97aec1 fix findNode in Agda
ryokka
parents: 514
diff changeset
111 color = Black
518
c9f90f573efe add more reblack tree in agda
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 515
diff changeset
112 }
417
24c98ca207f4 add RedBlackTree.agda
mir3636
parents:
diff changeset
113
515
54ff7a97aec1 fix findNode in Agda
ryokka
parents: 514
diff changeset
114 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
54ff7a97aec1 fix findNode in Agda
ryokka
parents: 514
diff changeset
115 putRedBlackTree {n} {m} {a} {k} {si} {t} tree k1 value next with (root tree)
54ff7a97aec1 fix findNode in Agda
ryokka
parents: 514
diff changeset
116 ... | 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
117 ... | 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
118
54ff7a97aec1 fix findNode in Agda
ryokka
parents: 514
diff changeset
119 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
54ff7a97aec1 fix findNode in Agda
ryokka
parents: 514
diff changeset
120 getRedBlackTree {_} {_} {a} {k} {_} {t} tree k1 cs = checkNode (root tree)
417
24c98ca207f4 add RedBlackTree.agda
mir3636
parents:
diff changeset
121 where
515
54ff7a97aec1 fix findNode in Agda
ryokka
parents: 514
diff changeset
122 checkNode : Maybe (Node a k) -> t
54ff7a97aec1 fix findNode in Agda
ryokka
parents: 514
diff changeset
123 checkNode Nothing = cs tree Nothing
54ff7a97aec1 fix findNode in Agda
ryokka
parents: 514
diff changeset
124 checkNode (Just n) = search n
54ff7a97aec1 fix findNode in Agda
ryokka
parents: 514
diff changeset
125 where
54ff7a97aec1 fix findNode in Agda
ryokka
parents: 514
diff changeset
126 search : Node a k -> t
54ff7a97aec1 fix findNode in Agda
ryokka
parents: 514
diff changeset
127 search n with compare tree k1 (key n)
54ff7a97aec1 fix findNode in Agda
ryokka
parents: 514
diff changeset
128 search n | LT = checkNode (left n)
54ff7a97aec1 fix findNode in Agda
ryokka
parents: 514
diff changeset
129 search n | GT = checkNode (right n)
54ff7a97aec1 fix findNode in Agda
ryokka
parents: 514
diff changeset
130 search n | EQ = cs tree (Just n)