Mercurial > hg > Gears > GearsAgda

changeset 549:bc3208d510cd

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
add some
author Shinji KONO <kono@ie.u-ryukyu.ac.jp>
date Tue, 16 Jan 2018 17:14:29 +0900
parents c304869ac439
children 2476f7123dc3
files RedBlackTree.agda redBlackTreeTest.agda
diffstat 2 files changed, 38 insertions(+), 23 deletions(-) [+]
line wrap: on
line diff
--- a/RedBlackTree.agda	Sun Jan 14 17:57:38 2018 +0900
+++ b/RedBlackTree.agda	Tue Jan 16 17:14:29 2018 +0900
@@ -166,7 +166,7 @@
     insertCase1 n0 s (Just parent) (Just grandParent) = insertCase2 s n0 parent grandParent
 
 ----
--- find node potition to insert or to delete, the pass will be in the stack
+-- find node potition to insert or to delete, the path will be in the stack
 -- 
 findNode : {n m : Level } {a k : Set n} {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
 findNode {n} {m} {a} {k}  {t} tree s n0 n1 next = pushSingleLinkedStack s n1 (\ s -> findNode1 s n1)
@@ -215,11 +215,17 @@
 ... | equal _ = EQ
 ... | greater _ _ = GT
 
+compare2 : (x y : ℕ ) -> CompareResult {Level.zero}
+compare2 zero zero = EQ
+compare2 (suc _) zero = GT
+compare2  zero (suc _) = LT
+compare2  (suc x) (suc y) = compare2 x y
+
 
 createEmptyRedBlackTreeℕ : { m : Level } (a : Set Level.zero) {t : Set m} -> RedBlackTree {Level.zero} {m} {t} a ℕ 
 createEmptyRedBlackTreeℕ  {m} a {t} = record {
         root = Nothing
      ;  nodeStack = emptySingleLinkedStack
-     ;  compare = compareℕ
+     ;  compare = compare2
    }
  
--- a/redBlackTreeTest.agda	Sun Jan 14 17:57:38 2018 +0900
+++ b/redBlackTreeTest.agda	Tue Jan 16 17:14:29 2018 +0900
@@ -29,13 +29,19 @@
 ...  | equal _ = True
 ...  | _ = False
 
-test1 : putTree1 {_} {_} {ℕ} {ℕ} (createEmptyRedBlackTreeℕ ℕ {Set Level.zero} ) 1 1 ( \t -> getRedBlackTree t 1 ( \t x -> check1 x 1 ≡ True   ))
+check2 : {m : Level } (n : Maybe (Node  ℕ ℕ)) -> ℕ -> Bool {m}
+check2 Nothing _ = False
+check2 (Just n)  x with compare2 (value n)  x
+...  | EQ = True
+...  | _ = False
+
+test1 : putTree1 {_} {_} {ℕ} {ℕ} (createEmptyRedBlackTreeℕ ℕ {Set Level.zero} ) 1 1 ( \t -> getRedBlackTree t 1 ( \t x -> check2 x 1 ≡ True   ))
 test1 = refl
 
 test2 : putTree1 {_} {_} {ℕ} {ℕ} (createEmptyRedBlackTreeℕ ℕ {Set Level.zero} ) 1 1 (
     \t -> putTree1 t 2 2 (
     \t -> getRedBlackTree t 1 (
-    \t x -> check1 x 1 ≡ True   )))
+    \t x -> check2 x 1 ≡ True   )))
 test2 = refl
 
 open ≡-Reasoning
@@ -44,9 +50,9 @@
     $ \t -> putTree1 t 3 3
     $ \t -> putTree1 t 4 4    
     $ \t -> getRedBlackTree t 1
-    $ \t x -> check1 x 1 ≡ True  
+    $ \t x -> check2 x 1 ≡ True  
 test3 = begin
-    check1 (Just (record {key = 1 ; value = 1 ; color = Black ; left = Nothing ; right = Just (leafNode 2 2)})) 1
+    check2 (Just (record {key = 1 ; value = 1 ; color = Black ; left = Nothing ; right = Just (leafNode 2 2)})) 1
   ≡⟨ refl ⟩
     True
   ∎
@@ -94,13 +100,13 @@
     $ \t -> putTree1 t 2 2 (\ t -> root t)
 
 
-test9 : putRedBlackTree {_} {_} {ℕ} {ℕ} (createEmptyRedBlackTreeℕ ℕ {Set Level.zero} ) 1 1 ( \t -> getRedBlackTree t 1 ( \t x -> check1 x 1 ≡ True   ))
+test9 : putRedBlackTree {_} {_} {ℕ} {ℕ} (createEmptyRedBlackTreeℕ ℕ {Set Level.zero} ) 1 1 ( \t -> getRedBlackTree t 1 ( \t x -> check2 x 1 ≡ True   ))
 test9 = refl
 
 test10 : putRedBlackTree {_} {_} {ℕ} {ℕ} (createEmptyRedBlackTreeℕ ℕ {Set Level.zero} ) 1 1 (
     \t -> putRedBlackTree t 2 2 (
     \t -> getRedBlackTree t 1 (
-    \t x -> check1 x 1 ≡ True   )))
+    \t x -> check2 x 1 ≡ True   )))
 test10 = refl
 
 test11 = putRedBlackTree {_} {_} {ℕ} {ℕ} (createEmptyRedBlackTreeℕ ℕ) 1 1 
@@ -111,13 +117,13 @@
 
 
 redBlackInSomeState :{ m : Level } (a : Set Level.zero) (n : Maybe (Node a ℕ)) {t : Set m} -> RedBlackTree {Level.zero} {m} {t} a ℕ 
-redBlackInSomeState {m} a n {t} = record { root = n ; nodeStack = emptySingleLinkedStack ; compare = compareℕ }
+redBlackInSomeState {m} a n {t} = record { root = n ; nodeStack = emptySingleLinkedStack ; compare = compare2 }
 
-compare2 : (x y : ℕ ) -> CompareResult {Level.zero}
-compare2 zero zero = EQ
-compare2 (suc _) zero = GT
-compare2  zero (suc _) = LT
-compare2  (suc x) (suc y) = compare2 x y
+-- compare2 : (x y : ℕ ) -> CompareResult {Level.zero}
+-- compare2 zero zero = EQ
+-- compare2 (suc _) zero = GT
+-- compare2  zero (suc _) = LT
+-- compare2  (suc x) (suc y) = compare2 x y
 
 putTest1Lemma2 : (k : ℕ)  -> compare2 k k ≡ EQ
 putTest1Lemma2 zero = refl
@@ -147,21 +153,24 @@
 putTest1Lemma3 : (k : ℕ)  -> compareℕ k k ≡ EQ
 putTest1Lemma3 k = trans (putTest1Lemma1 k k) ( putTest1Lemma2 k  ) 
 
+compareLemma1 : (x  y : ℕ)  -> compareℕ x y ≡ EQ -> x  ≡ y
+compareLemma1 x y eq with compareℕ x y  | eq 
+... | EQ | refl = ?
+
 
 putTest1 :{ m : Level } (n : Maybe (Node ℕ ℕ))
          -> (k : ℕ) (x : ℕ) 
          -> putTree1 {_} {_} {ℕ} {ℕ} (redBlackInSomeState {_} ℕ n {Set Level.zero}) k x
-         (\ t -> getRedBlackTree t k (\ t x1 -> check1 x1 x  ≡ True)) 
+         (\ t -> getRedBlackTree t k (\ t x1 -> check2 x1 x  ≡ True)) 
 putTest1 n k x with n
 ...  | Just n1 = {!!}
-...  | Nothing = {!!}
+...  | Nothing =  lemma1  
+   where 
+     lemma1 : getRedBlackTree {_} {_} {ℕ} {ℕ} {Set Level.zero} ( record {  root = Just ( record {
+               key   = k ; value = x ; right = Nothing ; left  = Nothing ; color = Red 
+        } ) ; nodeStack = record { top = Nothing } ; compare = λ x₁ y → compare2 x₁ y  } ) k
+        ( \ t x1 -> check2 x1 x  ≡ True) 
+     lemma1 = {!!}
 
 
--- with Data.Nat.compare k (key (leafNode k x))
--- ...            | Data.Nat.equal _ = ?
 
--- begin
---     ?
---   ≡⟨ ? ⟩
---     True
---   ∎