Mercurial > hg > GearsTemplate

changeset 542:e3cd5e3a01b8

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
add stack implement
author Shinji KONO <kono@ie.u-ryukyu.ac.jp>
date Fri, 05 Jan 2018 09:31:04 +0900
parents b118ed3ba583
children f63a9a081b61
files src/parallel_execution/RedBlackTree.agda
diffstat 1 files changed, 29 insertions(+), 25 deletions(-) [+]
line wrap: on
line diff
--- a/src/parallel_execution/RedBlackTree.agda	Fri Jan 05 00:01:18 2018 +0900
+++ b/src/parallel_execution/RedBlackTree.agda	Fri Jan 05 09:31:04 2018 +0900
@@ -39,25 +39,29 @@
     color : Color {n}
 open Node
 
-record RedBlackTree {n m : Level } {t : Set m} (a k si : Set n) : Set (m Level.⊔ n) where
+Stak : {n m : Level }  (a k : Set n) (t : Set m ) -> Set (m ⊔ n)
+Stak {n} {m} a k t = Stack {n} {m} (Node a k) {t} (SingleLinkedStack (Node a k))
+open Stack
+
+record RedBlackTree {n m : Level } {t : Set m} (a k : Set n) : Set (m Level.⊔ n) where
   field
     root : Maybe (Node a k)
-    nodeStack : Stack {n} {m} (Node a k) {t} ( SingleLinkedStack (Node a k ) )
+    nodeStack :  Stak a k t 
     compare : k -> k -> CompareResult {n}
 
 open RedBlackTree
 
-open Stack
+
 
 --
 -- put new node at parent node, and rebuild tree to the top
 --
 {-# TERMINATING #-}   -- https://agda.readthedocs.io/en/v2.5.3/language/termination-checking.html
-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
-replaceNode {n} {m} {t} {a} {k} {si} tree s parent n0 next = popStack s (
+replaceNode : {n m : Level } {t : Set m } {a k : Set n} -> RedBlackTree {n} {m} {t} a k  -> Stak a k t -> Node a k -> Node a k -> (RedBlackTree {n} {m} {t} a k  -> t) -> t
+replaceNode {n} {m} {t} {a} {k} tree s parent n0 next = popStack s (
       \s grandParent -> replaceNode1 s grandParent ( compare tree (key parent) (key n0) ) )
   where
-        replaceNode1 : Stack (Node a k) si -> Maybe ( Node a k ) -> CompareResult -> t
+        replaceNode1 : Stak a k t -> Maybe ( Node a k ) -> CompareResult -> t
         replaceNode1 s Nothing LT = next ( record tree { root = Just ( record parent { left = Just n0 ; color = Black } ) } )   
         replaceNode1 s Nothing GT = next ( record tree { root = Just ( record parent { right = Just n0 ; color = Black } ) } )   
         replaceNode1 s Nothing EQ = next ( record tree { root = Just ( record parent { right = Just n0 ; color = Black } ) } )   
@@ -66,25 +70,25 @@
         ... | GT =  replaceNode tree s grandParent ( record parent { right = Just n0 } ) next
         ... | EQ =  next tree 
 
-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
-rotateRight {n} {m} {t} {a} {k} {si} tree s n0 parent grandParent next = {!!}
+rotateRight : {n m : Level } {t : Set m } {a k : Set n} -> RedBlackTree {n} {m} {t} a k -> Stak a k t -> Node a k -> Node a k -> Node a k -> (RedBlackTree {n} {m} {t} a k -> t) -> t
+rotateRight {n} {m} {t} {a} {k}  tree s n0 parent grandParent next = {!!}
 
-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
-rotateLeft {n} {m} {t} {a} {k} {si} tree s n0 parent grandParent next = {!!}
+rotateLeft : {n m : Level } {t : Set m } {a k : Set n} -> RedBlackTree {n} {m} {t} a k -> Stak a k t -> Node a k -> Node a k -> Node a k -> (RedBlackTree {n} {m} {t} a k -> t) -> t
+rotateLeft {n} {m} {t} {a} {k}  tree s n0 parent grandParent next = {!!}
 
-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
-insertCase5 {n} {m} {t} {a} {k} {si} tree s n0 parent grandParent next = {!!}
+insertCase5 : {n m : Level } {t : Set m } {a k : Set n} -> RedBlackTree {n} {m} {t} a k -> Stak a k t -> Node a k -> Node a k -> Node a k -> (RedBlackTree {n} {m} {t} a k -> t) -> t
+insertCase5 {n} {m} {t} {a} {k}  tree s n0 parent grandParent next = {!!}
 
-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
-insertCase4 {n} {m} {t} {a} {k} {si} tree s n0 parent grandParent next = {!!}
+insertCase4 : {n m : Level } {t : Set m } {a k : Set n} -> RedBlackTree {n} {m} {t} a k -> Stak a k t -> Node a k -> Node a k -> Node a k -> (RedBlackTree {n} {m} {t} a k -> t) -> t
+insertCase4 {n} {m} {t} {a} {k}  tree s n0 parent grandParent next = {!!}
 
 {-# TERMINATING #-}
-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
-insertNode {n} {m} {t} {a} {k} {si} tree s n0 next = get2Stack s (\ s d1 d2 -> insertCase1 s n0 d1 d2 )
+insertNode : {n m : Level } {t : Set m } {a k : Set n} -> RedBlackTree {n} {m} {t} a k -> Stak a k t -> Node a k -> (RedBlackTree {n} {m} {t} a k -> t) -> t
+insertNode {n} {m} {t} {a} {k}  tree s n0 next = get2Stack s (\ s d1 d2 -> insertCase1 s n0 d1 d2 )
    where
-    insertCase1 : Stack (Node a k) si -> Node a k -> Maybe (Node a k) -> Maybe (Node a k) -> t    -- placed here to allow mutual recursion
+    insertCase1 : Stack (Node a k) (SingleLinkedStack (Node a k)) -> Node a k -> Maybe (Node a k) -> Maybe (Node a k) -> t    -- placed here to allow mutual recursion
           -- http://agda.readthedocs.io/en/v2.5.2/language/mutual-recursion.html
-    insertCase3 : Stack (Node a k) si -> Node a k -> Node a k -> Node a k -> t
+    insertCase3 : Stak a k t -> Node a k -> Node a k -> Node a k -> t
     insertCase3 s n0 parent grandParent with left grandParent | right grandParent
     ... | Nothing | Nothing = insertCase4 tree s n0 parent grandParent next
     ... | Nothing | Just uncle  = insertCase4 tree s n0 parent grandParent next
@@ -94,7 +98,7 @@
     ...                           | Red = pop2Stack s ( \s p0 p1 -> insertCase1 s ( 
            record grandParent { color = Red ; left = Just ( record parent { color = Black ; left = Just n0 } )  ; right = Just ( record uncle { color = Black } ) }) p0 p1 )
     ...                           | Black = insertCase4 tree s n0 parent grandParent next
-    insertCase2 : Stack (Node a k) si -> Node a k -> Node a k -> Node a k -> t
+    insertCase2 : Stak a k t -> Node a k -> Node a k -> Node a k -> t
     insertCase2 s n0 parent grandParent with color parent
     ... | Black = replaceNode tree s grandParent n0 next
     ... | Red = insertCase3 s n0 parent grandParent
@@ -104,13 +108,13 @@
     insertCase1 s n0 (Just parent) (Just grandParent) = insertCase2 s n0 parent grandParent
       where
 
-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
-findNode {n} {m} {a} {k} {si} {t} tree s n0 n1 next = pushStack s n1 (\ s -> findNode1 s n1)
+findNode : {n m : Level } {a k : Set n} {t : Set m} -> RedBlackTree {n} {m} {t} a k -> Stak a k t -> (Node a k) -> (Node a k) -> (RedBlackTree {n} {m} {t} a k -> Stak a k t -> Node a k -> t) -> t
+findNode {n} {m} {a} {k}  {t} tree s n0 n1 next = pushStack s n1 (\ s -> findNode1 s n1)
   where
-    findNode2 : Stack (Node a k) si -> (Maybe (Node a k)) -> t
+    findNode2 : Stak a k t -> (Maybe (Node a k)) -> t
     findNode2 s Nothing = next tree s n0
     findNode2 s (Just n) = findNode tree s n0 n next
-    findNode1 : Stack (Node a k) si -> (Node a k)  -> t
+    findNode1 : Stak a k t -> (Node a k)  -> t
     findNode1 s n1 with (compare tree (key n0) (key n1))
     ...                                | EQ = next tree s n0 
     ...                                | GT = findNode2 s (right n1)
@@ -126,12 +130,12 @@
     color = Black 
   }
 
-putRedBlackTree : {n m : Level } {a k : Set n} {t : Set m} -> RedBlackTree a k (SingleLinkedStack (Node a k)) -> k -> a -> (RedBlackTree a k (SingleLinkedStack (Node a k)) -> t) -> t
+putRedBlackTree : {n m : Level } {a k : Set n} {t : Set m} -> RedBlackTree a k  -> k -> a -> (RedBlackTree a k  -> t) -> t
 putRedBlackTree {n} {m} {a} {k}  {t} tree k1 value next with (root tree)
 ...                                | Nothing = next (record tree {root = Just (leafNode k1 value) })
 ...                                | Just n2  = findNode tree (nodeStack tree) (leafNode k1 value) n2 (\ tree1 s n1 -> insertNode tree1 s n1 next)
 
-getRedBlackTree : {n m : Level } {a k : Set n} {t : Set m} -> RedBlackTree {n} {m} {t} a k (SingleLinkedStack (Node a k)) -> k -> (RedBlackTree a k (SingleLinkedStack (Node a k)) -> (Maybe (Node a k)) -> t) -> t
+getRedBlackTree : {n m : Level } {a k : Set n} {t : Set m} -> RedBlackTree {n} {m} {t} a k  -> k -> (RedBlackTree a k  -> (Maybe (Node a k)) -> t) -> t
 getRedBlackTree {_} {_} {a} {k} {t} tree k1 cs = checkNode (root tree)
   where
     checkNode : Maybe (Node a k) -> t