diff prepaper/src/redBlackTreeTest.agda.replaced @ 0:3dba680da508

init-test
author soto
date Tue, 08 Dec 2020 19:06:49 +0900
parents
children
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/prepaper/src/redBlackTreeTest.agda.replaced	Tue Dec 08 19:06:49 2020 +0900
@@ -0,0 +1,196 @@
+module redBlackTreeTest where
+
+open import RedBlackTree
+open import stack
+open import Level hiding (zero)
+
+open import Data.Nat
+
+open Tree
+open Node
+open RedBlackTree.RedBlackTree
+open Stack
+
+-- tests
+
+putTree1 : {n m : Level } {a k : Set n} {t : Set m} @$\rightarrow$@ RedBlackTree {n} {m} {t} a k @$\rightarrow$@ k @$\rightarrow$@ a @$\rightarrow$@ (RedBlackTree {n} {m} {t} a k @$\rightarrow$@ t) @$\rightarrow$@ t
+putTree1 {n} {m} {a} {k} {t} tree k1 value next with (root tree)
+...                                | Nothing = next (record tree {root = Just (leafNode k1 value) })
+...                                | Just n2  = clearSingleLinkedStack (nodeStack tree) (\ s @$\rightarrow$@ findNode tree s (leafNode k1 value) n2 (\ tree1 s n1 @$\rightarrow$@ replaceNode tree1 s n1 next))
+
+open import Relation.Binary.PropositionalEquality
+open import Relation.Binary.Core
+open import Function
+
+
+check1 : {m : Level } (n : Maybe (Node  @$\mathbb{N}$@ @$\mathbb{N}$@)) @$\rightarrow$@ @$\mathbb{N}$@ @$\rightarrow$@ Bool {m}
+check1 Nothing _ = False
+check1 (Just n)  x with Data.Nat.compare (value n)  x
+...  | equal _ = True
+...  | _ = False
+
+check2 : {m : Level } (n : Maybe (Node  @$\mathbb{N}$@ @$\mathbb{N}$@)) @$\rightarrow$@ @$\mathbb{N}$@ @$\rightarrow$@ Bool {m}
+check2 Nothing _ = False
+check2 (Just n)  x with compare2 (value n)  x
+...  | EQ = True
+...  | _ = False
+
+test1 : putTree1 {_} {_} {@$\mathbb{N}$@} {@$\mathbb{N}$@} (createEmptyRedBlackTree@$\mathbb{N}$@ @$\mathbb{N}$@ {Set Level.zero} ) 1 1 ( \t @$\rightarrow$@ getRedBlackTree t 1 ( \t x @$\rightarrow$@ check2 x 1 @$\equiv$@ True   ))
+test1 = refl
+
+test2 : putTree1 {_} {_} {@$\mathbb{N}$@} {@$\mathbb{N}$@} (createEmptyRedBlackTree@$\mathbb{N}$@ @$\mathbb{N}$@ {Set Level.zero} ) 1 1 (
+    \t @$\rightarrow$@ putTree1 t 2 2 (
+    \t @$\rightarrow$@ getRedBlackTree t 1 (
+    \t x @$\rightarrow$@ check2 x 1 @$\equiv$@ True   )))
+test2 = refl
+
+open @$\equiv$@-Reasoning
+test3 : putTree1 {_} {_} {@$\mathbb{N}$@} {@$\mathbb{N}$@} (createEmptyRedBlackTree@$\mathbb{N}$@ @$\mathbb{N}$@ {Set Level.zero}) 1 1
+    $ \t @$\rightarrow$@ putTree1 t 2 2
+    $ \t @$\rightarrow$@ putTree1 t 3 3
+    $ \t @$\rightarrow$@ putTree1 t 4 4
+    $ \t @$\rightarrow$@ getRedBlackTree t 1
+    $ \t x @$\rightarrow$@ check2 x 1 @$\equiv$@ True
+test3 = begin
+    check2 (Just (record {key = 1 ; value = 1 ; color = Black ; left = Nothing ; right = Just (leafNode 2 2)})) 1
+  @$\equiv$@@$\langle$@ refl @$\rangle$@
+    True
+  @$\blacksquare$@
+
+test31 = putTree1 {_} {_} {@$\mathbb{N}$@} {@$\mathbb{N}$@} (createEmptyRedBlackTree@$\mathbb{N}$@ @$\mathbb{N}$@ ) 1 1
+    $ \t @$\rightarrow$@ putTree1 t 2 2
+    $ \t @$\rightarrow$@ putTree1 t 3 3
+    $ \t @$\rightarrow$@ putTree1 t 4 4
+    $ \t @$\rightarrow$@ getRedBlackTree t 4
+    $ \t x @$\rightarrow$@ x
+
+-- test5 : Maybe (Node @$\mathbb{N}$@ @$\mathbb{N}$@)
+test5 = putTree1 {_} {_} {@$\mathbb{N}$@} {@$\mathbb{N}$@} (createEmptyRedBlackTree@$\mathbb{N}$@ @$\mathbb{N}$@ ) 4 4
+    $ \t @$\rightarrow$@ putTree1 t 6 6
+    $ \t0 @$\rightarrow$@  clearSingleLinkedStack (nodeStack t0)
+    $ \s @$\rightarrow$@ findNode1 t0 s (leafNode 3 3) ( root t0 )
+    $ \t1 s n1 @$\rightarrow$@ replaceNode t1 s n1
+    $ \t @$\rightarrow$@ getRedBlackTree t 3
+    -- $ \t x @$\rightarrow$@ SingleLinkedStack.top (stack s)
+    -- $ \t x @$\rightarrow$@ n1
+    $ \t x @$\rightarrow$@ root t
+  where
+     findNode1 : {n m : Level } {a k : Set n} {t : Set m} @$\rightarrow$@ RedBlackTree {n} {m} {t} a k @$\rightarrow$@ SingleLinkedStack (Node a k) @$\rightarrow$@ (Node a k) @$\rightarrow$@ (Maybe (Node a k)) @$\rightarrow$@ (RedBlackTree {n} {m} {t} a k @$\rightarrow$@ SingleLinkedStack (Node a k) @$\rightarrow$@ Node a k @$\rightarrow$@ t) @$\rightarrow$@ t
+     findNode1 t s n1 Nothing next = next t s n1
+     findNode1 t s n1 ( Just n2 ) next = findNode t s n1 n2 next
+
+-- test51 : putTree1 {_} {_} {@$\mathbb{N}$@} {@$\mathbb{N}$@} {_} {Maybe (Node @$\mathbb{N}$@ @$\mathbb{N}$@)} (createEmptyRedBlackTree@$\mathbb{N}$@ @$\mathbb{N}$@ {Set Level.zero} ) 1 1 $ \t @$\rightarrow$@
+--   putTree1 t 2 2 $ \t @$\rightarrow$@ putTree1 t 3 3 $ \t @$\rightarrow$@ root t @$\equiv$@ Just (record { key = 1; value = 1; left = Just (record { key = 2 ; value = 2 } ); right = Nothing} )
+-- test51 = refl
+
+test6 : Maybe (Node @$\mathbb{N}$@ @$\mathbb{N}$@)
+test6 = root (createEmptyRedBlackTree@$\mathbb{N}$@ {_} @$\mathbb{N}$@ {Maybe (Node @$\mathbb{N}$@ @$\mathbb{N}$@)})
+
+
+test7 : Maybe (Node @$\mathbb{N}$@ @$\mathbb{N}$@)
+test7 = clearSingleLinkedStack (nodeStack tree2) (\ s @$\rightarrow$@ replaceNode tree2 s n2 (\ t @$\rightarrow$@ root t))
+  where
+    tree2 = createEmptyRedBlackTree@$\mathbb{N}$@ {_} @$\mathbb{N}$@ {Maybe (Node @$\mathbb{N}$@ @$\mathbb{N}$@)}
+    k1 = 1
+    n2 = leafNode 0 0
+    value1 = 1
+
+test8 : Maybe (Node @$\mathbb{N}$@ @$\mathbb{N}$@)
+test8 = putTree1 {_} {_} {@$\mathbb{N}$@} {@$\mathbb{N}$@} (createEmptyRedBlackTree@$\mathbb{N}$@ @$\mathbb{N}$@) 1 1
+    $ \t @$\rightarrow$@ putTree1 t 2 2 (\ t @$\rightarrow$@ root t)
+
+
+test9 : putRedBlackTree {_} {_} {@$\mathbb{N}$@} {@$\mathbb{N}$@} (createEmptyRedBlackTree@$\mathbb{N}$@ @$\mathbb{N}$@ {Set Level.zero} ) 1 1 ( \t @$\rightarrow$@ getRedBlackTree t 1 ( \t x @$\rightarrow$@ check2 x 1 @$\equiv$@ True   ))
+test9 = refl
+
+test10 : putRedBlackTree {_} {_} {@$\mathbb{N}$@} {@$\mathbb{N}$@} (createEmptyRedBlackTree@$\mathbb{N}$@ @$\mathbb{N}$@ {Set Level.zero} ) 1 1 (
+    \t @$\rightarrow$@ putRedBlackTree t 2 2 (
+    \t @$\rightarrow$@ getRedBlackTree t 1 (
+    \t x @$\rightarrow$@ check2 x 1 @$\equiv$@ True   )))
+test10 = refl
+
+test11 = putRedBlackTree {_} {_} {@$\mathbb{N}$@} {@$\mathbb{N}$@} (createEmptyRedBlackTree@$\mathbb{N}$@ @$\mathbb{N}$@) 1 1
+    $ \t @$\rightarrow$@ putRedBlackTree t 2 2
+    $ \t @$\rightarrow$@ putRedBlackTree t 3 3
+    $ \t @$\rightarrow$@ getRedBlackTree t 2
+    $ \t x @$\rightarrow$@ root t
+
+
+redBlackInSomeState : { m : Level } (a : Set Level.zero) (n : Maybe (Node a @$\mathbb{N}$@)) {t : Set m} @$\rightarrow$@ RedBlackTree {Level.zero} {m} {t} a @$\mathbb{N}$@
+redBlackInSomeState {m} a n {t} = record { root = n ; nodeStack = emptySingleLinkedStack ; compare = compare2 }
+
+-- compare2 : (x y : @$\mathbb{N}$@ ) @$\rightarrow$@ compareresult
+-- compare2 zero zero = eq
+-- compare2 (suc _) zero = gt
+-- compare2  zero (suc _) = lt
+-- compare2  (suc x) (suc y) = compare2 x y
+
+putTest1Lemma2 : (k : @$\mathbb{N}$@)  @$\rightarrow$@ compare2 k k @$\equiv$@ EQ
+putTest1Lemma2 zero = refl
+putTest1Lemma2 (suc k) = putTest1Lemma2 k
+
+putTest1Lemma1 : (x y : @$\mathbb{N}$@)  @$\rightarrow$@ compare@$\mathbb{N}$@ x y @$\equiv$@ compare2 x y
+putTest1Lemma1 zero    zero    = refl
+putTest1Lemma1 (suc m) zero    = refl
+putTest1Lemma1 zero    (suc n) = refl
+putTest1Lemma1 (suc m) (suc n) with Data.Nat.compare m n
+putTest1Lemma1 (suc .m)           (suc .(Data.Nat.suc m + k)) | less    m k = lemma1  m
+ where
+    lemma1 : (m :  @$\mathbb{N}$@) @$\rightarrow$@ LT  @$\equiv$@ compare2 m (@$\mathbb{N}$@.suc (m + k))
+    lemma1  zero = refl
+    lemma1  (suc y) = lemma1 y
+putTest1Lemma1 (suc .m)           (suc .m)           | equal   m   = lemma1 m
+ where
+    lemma1 : (m :  @$\mathbb{N}$@) @$\rightarrow$@ EQ  @$\equiv$@ compare2 m m
+    lemma1  zero = refl
+    lemma1  (suc y) = lemma1 y
+putTest1Lemma1 (suc .(Data.Nat.suc m + k)) (suc .m)           | greater m k = lemma1 m
+ where
+    lemma1 : (m :  @$\mathbb{N}$@) @$\rightarrow$@ GT  @$\equiv$@ compare2  (@$\mathbb{N}$@.suc (m + k))  m
+    lemma1  zero = refl
+    lemma1  (suc y) = lemma1 y
+
+putTest1Lemma3 : (k : @$\mathbb{N}$@)  @$\rightarrow$@ compare@$\mathbb{N}$@ k k @$\equiv$@ EQ
+putTest1Lemma3 k = trans (putTest1Lemma1 k k) ( putTest1Lemma2 k  )
+
+compareLemma1 : {x  y : @$\mathbb{N}$@}  @$\rightarrow$@ compare2 x y @$\equiv$@ EQ @$\rightarrow$@ x  @$\equiv$@ y
+compareLemma1 {zero} {zero} refl = refl
+compareLemma1 {zero} {suc _} ()
+compareLemma1 {suc _} {zero} ()
+compareLemma1 {suc x} {suc y} eq = cong ( \z @$\rightarrow$@ @$\mathbb{N}$@.suc z ) ( compareLemma1 ( trans lemma2 eq ) )
+   where
+      lemma2 : compare2 (@$\mathbb{N}$@.suc x) (@$\mathbb{N}$@.suc y) @$\equiv$@ compare2 x y
+      lemma2 = refl
+
+
+putTest1 :{ m : Level } (n : Maybe (Node @$\mathbb{N}$@ @$\mathbb{N}$@))
+         @$\rightarrow$@ (k : @$\mathbb{N}$@) (x : @$\mathbb{N}$@)
+         @$\rightarrow$@ putTree1 {_} {_} {@$\mathbb{N}$@} {@$\mathbb{N}$@} (redBlackInSomeState {_} @$\mathbb{N}$@ n {Set Level.zero}) k x
+         (\ t @$\rightarrow$@ getRedBlackTree t k (\ t x1 @$\rightarrow$@ check2 x1 x  @$\equiv$@ True))
+putTest1 n k x with n
+...  | Just n1 = lemma2 ( record { top = Nothing } )
+   where
+     lemma2 : (s : SingleLinkedStack (Node @$\mathbb{N}$@ @$\mathbb{N}$@) ) @$\rightarrow$@ putTree1 (record { root = Just n1 ; nodeStack = s ; compare = compare2 }) k x (@$\lambda$@ t @$\rightarrow$@
+         GetRedBlackTree.checkNode t k (@$\lambda$@ t@$\_{1}$@ x1 @$\rightarrow$@ check2 x1 x @$\equiv$@ True) (root t))
+     lemma2 s with compare2 k (key n1)
+     ... |  EQ = lemma3 {!!}
+        where
+           lemma3 : compare2 k (key n1) @$\equiv$@  EQ @$\rightarrow$@ getRedBlackTree {_} {_} {@$\mathbb{N}$@} {@$\mathbb{N}$@} {Set Level.zero} ( record {  root = Just ( record {
+               key   = key n1 ; value = x ; right = right n1 ; left  = left n1 ; color = Black
+               } ) ; nodeStack = s ; compare = @$\lambda$@ x@$\_{1}$@ y @$\rightarrow$@ compare2 x@$\_{1}$@ y  } ) k ( \ t x1 @$\rightarrow$@ check2 x1 x  @$\equiv$@ True)
+           lemma3 eq with compare2 x x | putTest1Lemma2 x
+           ... | EQ | refl with compare2 k (key n1)  | eq
+           ...              | EQ | refl with compare2 x x | putTest1Lemma2 x
+           ...                    | EQ | refl = refl
+     ... |  GT = {!!}
+     ... |  LT = {!!}
+
+...  | Nothing =  lemma1
+   where
+     lemma1 : getRedBlackTree {_} {_} {@$\mathbb{N}$@} {@$\mathbb{N}$@} {Set Level.zero} ( record {  root = Just ( record {
+               key   = k ; value = x ; right = Nothing ; left  = Nothing ; color = Red
+        } ) ; nodeStack = record { top = Nothing } ; compare = @$\lambda$@ x@$\_{1}$@ y @$\rightarrow$@ compare2 x@$\_{1}$@ y  } ) k
+        ( \ t x1 @$\rightarrow$@ check2 x1 x  @$\equiv$@ True)
+     lemma1 with compare2 k k | putTest1Lemma2 k
+     ... | EQ | refl with compare2 x x | putTest1Lemma2 x
+     ...              | EQ | refl = refl