Mercurial > hg > Gears > GearsAgda

changeset 541:429ece770187

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
...
author Shinji KONO <kono@ie.u-ryukyu.ac.jp>
date Thu, 11 Jan 2018 15:16:44 +0900
parents 6a4830c5a514
children ee65e69c9b62
files RedBlackTree.agda redBlackTreeTest.agda stackTest.agda
diffstat 3 files changed, 18 insertions(+), 12 deletions(-) [+]
line wrap: on
line diff
--- a/RedBlackTree.agda	Thu Jan 11 11:55:22 2018 +0900
+++ b/RedBlackTree.agda	Thu Jan 11 15:16:44 2018 +0900
@@ -60,8 +60,8 @@
           replaceNode1 s Nothing = next ( record tree { root = Just (record n0 { color = Black}) } )
           replaceNode1 s (Just n1) with compare tree (key n1) (key n0)
           ... | EQ =  next tree
-          ... | GT =  replaceNode tree s ( record n1 { right = Just n0 } ) next
-          ... | LT =  replaceNode tree s ( record n1 { left = Just n0 } ) next
+          ... | GT =  replaceNode tree s ( record n1 { left = Just n0 } ) next
+          ... | LT =  replaceNode tree s ( record n1 { right = Just n0 } ) next
 
 
 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 -> Maybe (Node a k) -> Maybe (Node a k) ->
--- a/redBlackTreeTest.agda	Thu Jan 11 11:55:22 2018 +0900
+++ b/redBlackTreeTest.agda	Thu Jan 11 15:16:44 2018 +0900
@@ -42,7 +42,7 @@
     $ \t -> putTree1 t 2 2 
     $ \t -> getRedBlackTree t 2 
     $ \t x -> check1 x 2 ≡ True  
-test3 = refl
+test3 = {!!} -- refl
 
 -- test4 : putTree1 {_} {_} {ℕ} {ℕ} ( createEmptyRedBlackTreeℕ ℕ {Set Level.zero} ) 1 1 $  \t -> putTree1 t 2 2  $ \t ->
 --   root t ≡ Just (record { key = 1; value = 1; left = Just (record { key = 2 ; value = 2 } ); right = Nothing} )
@@ -50,16 +50,15 @@
 
 
 -- test5 : Maybe (Node ℕ ℕ)
-test5 = putTree1 {_} {_} {ℕ} {ℕ} (createEmptyRedBlackTreeℕ ℕ ) 1 1 
-    $ \t -> putTree1 t 2 2
-    -- $ \t -> putTree1 t 3 3 
-    $ \t ->  clearStack (nodeStack t)
-    $ \s -> findNode1 t s (leafNode 3 3) ( root t )
+test5 = putTree1 {_} {_} {ℕ} {ℕ} (createEmptyRedBlackTreeℕ ℕ ) 4 4 
+    $ \t -> putTree1 t 6 6
+    $ \t0 ->  clearStack (nodeStack t0)
+    $ \s -> findNode1 t0 s (leafNode 3 3) ( root t0 )
     $ \t1 s n1 -> replaceNode t1 s n1 
     $ \t -> getRedBlackTree t 3
-    $ \t x -> SingleLinkedStack.top (stack s)
+    -- $ \t x -> SingleLinkedStack.top (stack s)
     -- $ \t x -> n1
-    -- $ \t x -> root t1
+    $ \t x -> root t
   where
      findNode1 : {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) -> (Maybe (Node a k)) -> (RedBlackTree {n} {m} {t} a k si -> Stack (Node a k) si -> Node a k -> t) -> t
      findNode1 t s n1 Nothing next = next t s n1
--- a/stackTest.agda	Thu Jan 11 11:55:22 2018 +0900
+++ b/stackTest.agda	Thu Jan 11 15:16:44 2018 +0900
@@ -6,6 +6,7 @@
 open import Relation.Binary.PropositionalEquality
 open import Relation.Binary.Core
 open import Data.Nat
+open import Function
 
 
 open SingleLinkedStack
@@ -69,6 +70,12 @@
 testStack07 = pushSingleLinkedStack emptySingleLinkedStack 1 (
    \s -> pushSingleLinkedStack s 2 (\s -> top s))
 
+testStack08 = pushSingleLinkedStack emptySingleLinkedStack 1 
+   $ \s -> pushSingleLinkedStack s 2 
+   $ \s -> pushSingleLinkedStack s 3 
+   $ \s -> pushSingleLinkedStack s 4 
+   $ \s -> pushSingleLinkedStack s 5 
+   $ \s -> top s
 
 ------
 --
@@ -89,8 +96,8 @@
 push->push->pop2 {l} {D} x y s = record { pi1 = refl ; pi2 = refl }
 
 
-id : {n : Level} {A : Set n} -> A -> A
-id a = a
+-- id : {n : Level} {A : Set n} -> A -> A
+-- id a = a
 
 -- push a, n times