view redBlackTreeTest.agda @ 674:b17821aeeed8

close this
author Shinji KONO <kono@ie.u-ryukyu.ac.jp>
date Tue, 23 Nov 2021 13:42:57 +0900
parents 7bacba816277
children
line wrap: on
line source

module redBlackTreeTest where

open import Level hiding (zero) renaming ( suc to succ )

open import Data.Empty
open import Data.List
open import Data.Maybe
open import Data.Bool
open import Data.Nat
open import Data.Nat.Properties  as NatProp

open import Relation.Nullary
open import Relation.Binary

open import Algebra

open import RedBlackTree
open import stack

open Tree
open Node
open RedBlackTree.RedBlackTree
open Stack

-- tests

putTree1 : {n m : Level } {a k : Set n} {t : Set m} → RedBlackTree {n} {m} {t} a k → k → a → ((RedBlackTree {n} {m} {t} a k) → t) → 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 → findNode tree s (leafNode k1 value) n2 (λ  tree1 s n1 → replaceNode tree1 s n1 next))

open import Relation.Binary.PropositionalEquality
open import Relation.Binary.Core
open import Function


-- check1 : {m : Level } (n : Maybe (Node  ℕ ℕ)) → ℕ → Bool
-- check1 nothing _ = false
-- check1 (just n)  x with Data.Nat.compare (value n)  x
-- ...  | equal _ = true
-- ...  | _ = false

check2 : {m : Level } (n : Maybe (Node  ℕ ℕ)) → ℕ → Bool
check2 nothing _ = false
check2 (just n)  x with compare2 (value n)  x
...  | EQ = true
...  | _ = false

test1 : {m : Level} {A B C : Set} → putTree1 {Level.zero} {succ Level.zero} {ℕ} {ℕ} (createEmptyRedBlackTreeℕ {!!} {!!} ) 1 1 ( λ t → getRedBlackTree t 1 ( λ t x → check2 {m} x 1 ≡ true ))
test1 = {!!}

-- test2 : {m : Level} → putTree1 {_} {_} {ℕ} {ℕ} (createEmptyRedBlackTreeℕ ℕ {Set Level.zero} ) 1 1 (
--     λ t → putTree1 t 2 2 (
--     λ t → getRedBlackTree t 1 (
--     λ t x → check2 {m} x 1 ≡ true   )))
-- test2 = refl

-- open ≡-Reasoning
-- test3 : {m : Level} → putTree1 {_} {_} {ℕ} {ℕ} (createEmptyRedBlackTreeℕ ℕ {Set Level.zero}) 1 1
--     $ λ t → putTree1 t 2 2
--     $ λ t → putTree1 t 3 3
--     $ λ t → putTree1 t 4 4
--     $ λ t → getRedBlackTree t 1
--     $ λ t x → check2 {m} x 1 ≡ true
-- test3 {m} = begin
--     check2 {m} (just (record {key = 1 ; value = 1 ; color = Black ; left = nothing ; right = just (leafNode 2 2)})) 1
--   ≡⟨ refl ⟩
--     true
--   ∎

-- test31 = putTree1 {_} {_} {ℕ} {ℕ} (createEmptyRedBlackTreeℕ ℕ ) 1 1
--     $ λ t → putTree1 t 2 2
--     $ λ t → putTree1 t 3 3
--     $ λ t → putTree1 t 4 4
--     $ λ t → getRedBlackTree t 4
--     $ λ t x → x

-- -- test5 : Maybe (Node ℕ ℕ)
-- test5 = putTree1 {_} {_} {ℕ} {ℕ} (createEmptyRedBlackTreeℕ ℕ ) 4 4
--     $ λ t → putTree1 t 6 6
--     $ λ t0 →  clearSingleLinkedStack (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 → n1
--     $ λ t x → root t
--   where
--      findNode1 : {n m : Level } {a k : Set n} {t : Set m} → RedBlackTree {n} {m} {t} a k → SingleLinkedStack (Node a k) → (Node a k) → (Maybe (Node a k)) → (RedBlackTree {n} {m} {t} a k → SingleLinkedStack (Node a k) → Node a k → t) → 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 {_} {_} {ℕ} {ℕ} {_} {Maybe (Node ℕ ℕ)} (createEmptyRedBlackTreeℕ ℕ {Set Level.zero} ) 1 1 $ λ t →
-- --   putTree1 t 2 2 $ λ t → putTree1 t 3 3 $ λ t → root t ≡ just (record { key = 1; value = 1; left = just (record { key = 2 ; value = 2 } ); right = nothing} )
-- -- test51 = refl

-- test6 : Maybe (Node ℕ ℕ)
-- test6 = root (createEmptyRedBlackTreeℕ {_} ℕ {Maybe (Node ℕ ℕ)})


-- test7 : Maybe (Node ℕ ℕ)
-- test7 = clearSingleLinkedStack (nodeStack tree2) (λ  s → replaceNode tree2 s n2 (λ  t → root t))
--   where
--     tree2 = createEmptyRedBlackTreeℕ {_} ℕ {Maybe (Node ℕ ℕ)}
--     k1 = 1
--     n2 = leafNode 0 0
--     value1 = 1

-- test8 : Maybe (Node ℕ ℕ)
-- test8 = putTree1 {_} {_} {ℕ} {ℕ} (createEmptyRedBlackTreeℕ ℕ) 1 1
--     $ λ t → putTree1 t 2 2 (λ  t → root t)


-- test9 : {m : Level} → putRedBlackTree {_} {_} {ℕ} {ℕ} (createEmptyRedBlackTreeℕ ℕ {Set Level.zero} ) 1 1 ( λ t → getRedBlackTree t 1 ( λ t x → check2 {m} x 1 ≡ true   ))
-- test9 = refl

-- test10 : {m : Level} → putRedBlackTree {_} {_} {ℕ} {ℕ} (createEmptyRedBlackTreeℕ ℕ {Set Level.zero} ) 1 1 (
--     λ t → putRedBlackTree t 2 2 (
--     λ t → getRedBlackTree t 1 (
--     λ t x → check2 {m} x 1 ≡ true   )))
-- test10 = refl

-- test11 = putRedBlackTree {_} {_} {ℕ} {ℕ} (createEmptyRedBlackTreeℕ ℕ) 1 1
--     $ λ t → putRedBlackTree t 2 2
--     $ λ t → putRedBlackTree t 3 3
--     $ λ t → getRedBlackTree t 2
--     $ λ t x → root t


compTri :  ( x y : ℕ ) ->  Tri  (x < y) ( x ≡ y )  ( x > y )
compTri = IsStrictTotalOrder.compare (Relation.Binary.StrictTotalOrder.isStrictTotalOrder <-strictTotalOrder)
   where open import  Relation.Binary

checkT : {m : Level } (n : Maybe (Node  ℕ ℕ)) → ℕ → Bool
checkT nothing _ = false
checkT (just n) x with compTri (value n)  x
...  | tri≈ _ _ _ = true
...  | _ = false

checkEQ :  {m : Level }  ( x :  ℕ ) -> ( n : Node  ℕ ℕ ) -> (value n )  ≡ x  -> checkT {m} (just n) x ≡ true
checkEQ x n refl with compTri (value n)  x
... |  tri≈ _ refl _ = refl
... |  tri> _ neq gt =  ⊥-elim (neq refl)
... |  tri< lt neq _ =  ⊥-elim (neq refl)

-- checkEQ' :  {m : Level }  ( x y :  ℕ ) -> ( eq : x ≡ y  ) -> ( x ≟ y ) ≡ yes eq
-- checkEQ' x y refl with  x ≟ y
-- ... | yes refl = refl
-- ... | no neq = ⊥-elim ( neq refl )

---  search -> checkEQ
---  findNode -> search

redBlackInSomeState : { m : Level } (a : Set Level.zero) (n : Maybe (Node a ℕ)) {t : Set m} {A B C : Set Level.zero } → RedBlackTree {Level.zero} {m} {t} {A} {B} {C} a ℕ
redBlackInSomeState {m} a n {t} = record { root = n ; nodeStack = emptySingleLinkedStack ; nodeComp = λ x x₁ → {!!} } -- record { root = n ; nodeStack = emptySingleLinkedStack ; compare = compTri }


open stack.SingleLinkedStack
open stack.Element


insertP :  { a : Set } { t : Set } {P : Set }   → ( f : ( a  → t )  → t )  ( g : a  → t ) ( g' :  P  → a  → t )
   → ( p : P )
   → ( g ≡ g' p )
   →  f ( λ x → g' p x ) ≡ f ( λ x → g x )  
insertP f g g' p refl = refl


{-# TERMINATING #-}
inStack : {l : Level} (n : Node ℕ ℕ) (s : SingleLinkedStack (Node ℕ ℕ) ) → Bool
inStack {l} n s with ( top s )
... | nothing = true
... | just n1 with  compTri (key n) (key (datum n1))
...            | tri> _ neq _ =  inStack {l} n ( record { top = next n1 } )
...            | tri< _ neq _ =  inStack {l} n ( record { top = next n1 } )
...            | tri≈  _ refl _  = false

record StackTreeInvariant  ( n : Node ℕ ℕ )
<<<<<<< working copy
        ( s : SingleLinkedStack (Node  ℕ ℕ) )  : Set where
||||||| base
        ( s : SingleLinkedStack (Node  ℕ ℕ) ) ( t : RedBlackTree ℕ ℕ ) : Set where
=======
        ( s : SingleLinkedStack (Node ℕ ℕ) ) ( t : RedBlackTree ℕ ℕ ) : Set where
>>>>>>> destination
  field
<<<<<<< working copy
    -- sti : replaceNode t s n $ λ  t1 → getRedBlackTree t1 (key n) (λ  t2 x1 → checkT x1 (value n)  ≡ True)
    notInStack : inStack n s ≡ True  → ⊥
||||||| base
    sti : replaceNode t s n $ λ  t1 → getRedBlackTree t1 (key n) (λ  t2 x1 → checkT x1 (value n)  ≡ True)
    notInStack : inStack n s ≡ True  → ⊥
=======
    sti : {m : Level} → replaceNode t s n $ λ  t1 → getRedBlackTree t1 (key n) (λ  t2 x1 → checkT {m} x1 (value n)  ≡ true)
    notInStack : {m : Level} → inStack {m} n s ≡ true  → ⊥
>>>>>>> destination

open StackTreeInvariant

<<<<<<< working copy
putTest1 : (n : Maybe (Node ℕ ℕ))
         → (k : ℕ) (x : ℕ)
         → putTree1 {_} {_} {ℕ} {ℕ} (redBlackInSomeState {_} ℕ n {Set Level.zero}) k x
           (λ  t → getRedBlackTree t k (λ  t x1 → checkT x1 x  ≡ True)) 
putTest1 n k x with n
...  | Just n1 = lemma0
   where
     tree0 : (n1 : Node  ℕ ℕ) (s : SingleLinkedStack (Node ℕ ℕ) ) → RedBlackTree ℕ ℕ
     tree0 n1 s = record { root = Just n1 ; nodeStack = s ; compare = compareT }
     lemma2 : (n1 : Node  ℕ ℕ) (s : SingleLinkedStack (Node ℕ ℕ) ) → StackTreeInvariant (leafNode k x) s 
         → findNode (tree0 n1 s) s (leafNode k x) n1 (λ  tree1 s n1 → replaceNode tree1 s n1
              (λ  t → getRedBlackTree t k (λ  t x1 → checkT x1 x  ≡ True)))
     lemma2 n1 s STI with compTri k (key n1)
     ... |  tri> le eq gt with (right n1) 
     ...                  | Just rightNode = {!!} -- ( lemma2 rightNode  ( record { top = Just ( cons n1 (top s)  ) }   )  (record {notInStack = {!!}  } ) )
     ...                  | Nothing with compTri k k
     ...                           | tri≈  _ refl _ = {!!}
     ...                           | tri< _ neq _ =  ⊥-elim (neq refl)
     ...                           | tri> _ neq _ =  ⊥-elim (neq refl)
     lemma2 n1 s STI |  tri< le eq gt = {!!}
     lemma2 n1 s STI |  tri≈ le refl gt = lemma5 s ( tree0 n1 s ) n1
        where 
           lemma5 :  (s : SingleLinkedStack (Node ℕ ℕ) )  → ( t :  RedBlackTree  ℕ ℕ  ) → ( n :  Node ℕ ℕ  ) → popSingleLinkedStack ( record { top = Just (cons n (SingleLinkedStack.top s)) }  )
                   ( \ s1  _ -> (replaceNode (tree0 n1 s1) s1 (record n1 { key = k ; value = x } ) (λ t → 
                      GetRedBlackTree.checkNode t (key n1) (λ t₁ x1 → checkT x1 x ≡ True) (root t))) )
           lemma5 s t n with (top s)
           ...          | Just n2  with compTri k k
           ...            | tri< _ neq _ =  ⊥-elim (neq refl)
           ...            | tri> _ neq _ =  ⊥-elim (neq refl)
           ...            | tri≈  _ refl _  =  ⊥-elim ( (notInStack STI)  {!!} )
           lemma5 s t n | Nothing with compTri k k
           ...            | tri≈  _ refl _  = checkEQ x _ refl
           ...            | tri< _ neq _ =  ⊥-elim (neq refl)
           ...            | tri> _ neq _ =  ⊥-elim (neq refl)
     lemma0 : clearSingleLinkedStack (record {top = Nothing}) (\s → findNode (tree0 n1 s) s (leafNode k x) n1 (λ  tree1 s n1 → replaceNode tree1 s n1
              (λ  t → getRedBlackTree t k (λ  t x1 → checkT x1 x  ≡ True))))
     lemma0 = lemma2 n1 (record {top = Nothing}) ( record { notInStack = {!!} } )
...  | 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 → compareT x₁ y  } ) k
        ( λ  t x1 → checkT x1 x  ≡ True) 
     lemma1 with compTri k k 
     ... | tri≈  _ refl _ = checkEQ x _ refl
     ... | tri< _ neq _ =  ⊥-elim (neq refl)
     ... | tri> _ neq _ =  ⊥-elim (neq refl)
||||||| base
putTest1 : (n : Maybe (Node ℕ ℕ))
         → (k : ℕ) (x : ℕ)
         → putTree1 {_} {_} {ℕ} {ℕ} (redBlackInSomeState {_} ℕ n {Set Level.zero}) k x
           (λ  t → getRedBlackTree t k (λ  t x1 → checkT x1 x  ≡ True)) 
putTest1 n k x with n
...  | Just n1 = lemma0
   where
     tree0 : (s : SingleLinkedStack (Node ℕ ℕ) ) → RedBlackTree ℕ ℕ
     tree0 s = record { root = Just n1 ; nodeStack = s ; compare = compareT }
     lemma2 : (s : SingleLinkedStack (Node ℕ ℕ) ) → StackTreeInvariant (leafNode k x) s (tree0 s)
         → findNode (tree0 s) s (leafNode k x) n1 (λ  tree1 s n1 → replaceNode tree1 s n1
              (λ  t → getRedBlackTree t k (λ  t x1 → checkT x1 x  ≡ True)))
     lemma2 s STI with compTri k (key n1)
     ... |  tri≈ le refl gt = lemma5 s ( tree0 s ) n1
        where 
           lemma5 :  (s : SingleLinkedStack (Node ℕ ℕ) )  → ( t :  RedBlackTree  ℕ ℕ  ) → ( n :  Node ℕ ℕ  ) → popSingleLinkedStack ( record { top = Just (cons n (SingleLinkedStack.top s)) }  )
                   ( \ s1  _ -> (replaceNode (tree0 s1) s1 (record n1 { key = k ; value = x } ) (λ t → 
                      GetRedBlackTree.checkNode t (key n1) (λ t₁ x1 → checkT x1 x ≡ True) (root t))) )
           lemma5 s t n with (top s)
           ...          | Just n2  with compTri k k
           ...            | tri< _ neq _ =  ⊥-elim (neq refl)
           ...            | tri> _ neq _ =  ⊥-elim (neq refl)
           ...            | tri≈  _ refl _  =  ⊥-elim ( (notInStack STI)  {!!} )
           lemma5 s t n | Nothing with compTri k k
           ...            | tri≈  _ refl _  = checkEQ x _ refl
           ...            | tri< _ neq _ =  ⊥-elim (neq refl)
           ...            | tri> _ neq _ =  ⊥-elim (neq refl)
     ... |  tri> le eq gt = sti ( record { sti = {!!} ; notInStack = {!!}  } )
     ... |  tri< le eq gt = {!!}
     lemma0 : clearSingleLinkedStack (record {top = Nothing}) (\s → findNode (tree0 s) s (leafNode k x) n1 (λ  tree1 s n1 → replaceNode tree1 s n1
              (λ  t → getRedBlackTree t k (λ  t x1 → checkT x1 x  ≡ True))))
     lemma0 = lemma2 (record {top = Nothing}) ( record { sti = {!!}  ; notInStack = {!!} } )
...  | 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 → compareT x₁ y  } ) k
        ( λ  t x1 → checkT x1 x  ≡ True) 
     lemma1 with compTri k k 
     ... | tri≈  _ refl _ = checkEQ x _ refl
     ... | tri< _ neq _ =  ⊥-elim (neq refl)
     ... | tri> _ neq _ =  ⊥-elim (neq refl)
=======

-- testn :  {!!}
-- testn  =  putTree1 {_} {_} {ℕ} {ℕ} (createEmptyRedBlackTreeℕ ℕ) 2 2
--   $ λ t → putTree1 t 1 1
--   $ λ t → putTree1 t 3 3 (λ ta → record {root = root ta ; nodeStack = nodeStack ta })


-- List と Node で書こうとしたがなんだかんだListに直したほうが楽そうだった

nullNode = (record {key = 0 ; value = 0 ; right = nothing ; left = nothing ; color = Red})

-- treeTotal : { m : Level } {t : Set m} → ( s : List ℕ ) → ( tr : (Node ℕ ℕ) ) → (List ℕ → t) → t
-- treeTotal {m} {t} s tr next with (left tr) | (right tr)
-- treeTotal {m} {t} s tr next | nothing | nothing = next ((key tr) ∷ [])
-- treeTotal {m} {t} s tr next | nothing | just x = treeTotal {m} {t} s x (λ li → next ((key tr) ∷ li))
-- treeTotal {m} {t} s tr next | just x | nothing = treeTotal {m} {t} s x (λ li → next ((key tr) ∷ li))
-- treeTotal {m} {t} s tr next | just x | just x₁ = treeTotal {m} {t} s x (λ li1 → treeTotal {m} {t} s x₁ (λ li2 → next (s ++ li1 ++ li2)))
treeTotal : { n m : Level } {a : Set n} {t : Set m} → ( s : List a ) → ( tr : (Node a a) ) → List a
treeTotal {n} {m} {a} {t} s tr with (left tr) | (right tr)
treeTotal {n} {m} {a} {t} s tr | nothing | nothing = (key tr) ∷ []
treeTotal {n} {m} {a} {t} s tr | nothing | just x = (key tr) ∷ (treeTotal {n} {m} {a} {t} s x)
treeTotal {n} {m} {a} {t} s tr | just x | nothing = (key tr) ∷ (treeTotal {n} {m} {a} {t} s x)
treeTotal {n} {m} {a} {t} s tr | just x | just x₁ = s ++ ((key tr) ∷ (treeTotal {n} {m} {a} {t} s x) ++ (treeTotal {n} {m} {a} {t} s x₁))


-- treeTotalA : { m : Level } {t : Set m} → ( s : List ℕ ) → ( tr : (Node ℕ ℕ) ) → List ℕ

-- (treeTotal {_} {ℕ} ([]) (Data.Maybe.fromMaybe nullNode (root (putTree1 {_} {_} {ℕ} {ℕ} testn 5 5 {!!}))))

-- exput : (treeTotal {_} {ℕ} (5 ∷ []) (Data.Maybe.fromMaybe nullNode (root (createEmptyRedBlackTreeℕ ℕ))) (λ total → {!!})) ≡ {!!}
-- exput = {!!}


-- aaa = (treeTotal {_} {_} {ℕ} {_} (5 ∷ []) ((record { key = 4 ; value = 4 ; right = just (leafNode 6 6) ; left = just (leafNode 3 3) ; color = Black })))


-- fuga = putTree1 {_} {_} {ℕ} {ℕ} (record {root = just (record { key = 4 ; value = 4 ; right = just (leafNode 6 6) ; left = just (leafNode 3 3) ; color = Black }) ; nodeStack = ( record {top = nothing}) ; compare = (λ x x₁ → EQ) }) 5 5 (λ aaa → aaa )

-- nontree ++ 2 :: []

-- piyo =  putTree1 {_} {_} {ℕ} {ℕ} (createEmptyRedBlackTreeℕ ℕ) 2 2 ( λ t1 → findNode t1 (record {top = nothing}) (leafNode 2 2) (Data.Maybe.fromMaybe nullNode (root t1)) (λ tree stack node → {!!}))


-- exn2l : {!!} ≡ (treeTotal {_} {ℕ} ([]) (putTree1 {_} {_} {ℕ} {ℕ} {!!} 5 5 (λ t → {!!}))) -- (treeTotal {_} {ℕ} (5 ∷ []) (Data.Maybe.fromMaybe nullNode (root testn)))
-- exn2l = refl





-- record FS {n m : Level } {a : Set n} {t : Set m} (oldTotal : List a) ( s : List a ) ( tr : (Node a a) ) : Set where
--   field
--     total : treeTotal {n} {m} {a} {t} s tr ≡ oldTotal
-- -- usage = FS.total -- relation

-- data P { n m : Level } { t : Set m } : Set where
--   P₀ : (old : List ℕ) ( s : List ℕ ) → (tr : (Node ℕ ℕ) ) → FS {m} {t} old s tr → P



-- ttt = putTree1 {_} {_} {ℕ} {ℕ}

-- record TreeInterface {n m : Level } {a : Set n } {t : Set m } (treeImpl : Set n ) : Set n where
--   field
--     tree : treeImpl
--     list : List ℕ
--     node : Node ℕ ℕ
--     putTreeHoare : (FS {_} {ℕ} list list node) → putTree1 {!!} {!!} {!!} {!!}

stack2list : {n m : Level} {t : Set m} {a : Set n} → (s : SingleLinkedStack a) → List a
stack2list stack with top stack
stack2list stack | just x = (datum x) ∷ (elm2list {_} {_} {ℕ} x)
  where
    elm2list : {n m : Level} {t : Set m} {a : Set n} → (elm : (Element a)) → List a
    elm2list el with next el
    elm2list el | just x = (datum el) ∷ (elm2list {_} {_} {ℕ} x)
    elm2list el | nothing = (datum el) ∷ []
stack2list stack | nothing = []


-- list2element : {n m : Level} {t : Set m} {a : Set n} → (l : List a) → Maybe (Element a)
-- list2element [] = nothing
-- list2element (x ∷ l) = just (cons x (list2element {_} {_} {ℕ} l))

-- ltest = list2element (1 ∷ 2 ∷ 3 ∷ [])

list2stack : {n m : Level} {t : Set m} {a : Set n} {st : SingleLinkedStack a} → (l : List a)  → SingleLinkedStack a
list2stack {n} {m} {t} {a} {s} (x ∷ l)  = pushSingleLinkedStack s x (λ s1 → list2stack {n} {m} {t} {a} {s1} l )
list2stack {n} {m} {t} {a} {s} [] = s



-- stest = list2stack (1 ∷ 2 ∷ 3 ∷ [])

open Node

exfind : { m : Level } { t : Set m} → (dt : ℕ) → (node : (Node ℕ ℕ))  → (st : List ℕ) →  findNode {_} {_} {ℕ} {ℕ} (redBlackInSomeState ℕ (just node)) (emptySingleLinkedStack) (leafNode dt dt) (node) (λ t1 st1 n1 → (( treeTotal {_} {m} {ℕ} {t} (dt ∷ st) (node) ) ≡ ( treeTotal {_} {m} {ℕ} {t} (dt ∷ st) (node) ) ))
exfind dt node st with left node | right node
exfind dt node st | just x | just x₁ = {!!}
exfind dt node st | just x | nothing = {!!}
exfind dt node st | nothing | just x = {!!}
exfind dt node st | nothing | nothing with (compTri dt (key node))
exfind dt node st | nothing | nothing | tri< a ¬b ¬c = {!!}
exfind dt node st | nothing | nothing | tri≈ ¬a b ¬c = {!!}
exfind dt node st | nothing | nothing | tri> ¬a ¬b c = {!!}

-- exput : (ni : ℕ) → (tn : Node ℕ ℕ) → (ts : List ℕ) → (treeTotal {_} {ℕ} (ni ∷ ts) tn)
--                  ≡ (treeTotal {_} {ℕ} (ts) (Data.Maybe.fromMaybe nullNode (root (putTree1 {_} {_} {ℕ} {ℕ} (record { root = just tn } ) ni ni (λ tt → tt)))))
-- exput datum node [] with (right node) | (left node)
-- exput datum node [] | nothing | nothing = {!!}
-- exput datum node [] | just x | just x₁ = {!!}
-- exput datum node [] | just x | nothing = {!!}
-- exput datum node [] | nothing | just x = {!!}
-- exput datum node (x ∷ stack₁) = {!!}


-- proofTree : {n m : Level} {t : Set m} {a : Set n} (old stackl : List ℕ) → (node : Node ℕ ℕ) → (FS {_} {ℕ} old stackl node) → (tree : RedBlackTree ℕ ℕ) → (key : ℕ) → findNode  {{!!}} {{!!}} {{!!}} {{!!}} tree (list2stack {!!} (record {top = nothing})) (leafNode key key) node (λ tree1 stack1 datum → {!!})
-- -- -- -- putTree1 tree key key (λ t → (FS {_} {ℕ} old stackl (Data.Maybe.fromMaybe nullNode (root tree))) )
-- proofTree old stack node fs t k = {!!}

-- FS は 証明そのものになると思ってたけど実は違いそう
-- oldTotal と 現在の node, stack の組み合わせを比較する
-- oldTotal はどうやって作る? ><
-- treeTotal は list と node を受け取って それの total を出すのでそれで作る(list に put するデータなどを入れることで適当に作れる)

-- p : {n m : Level} {t : Set m} {a : Set n} → ( s : SingleLinkedStack ℕ )  ( tr : (Node ℕ ℕ) ) ( tree : RedBlackTree ℕ ℕ ) (k : ℕ) →  (FS (treeTotal (k ∷ (stack2list s)) tr) (stack2list s) tr) → putTree1 tree k k (λ atree  → FS (treeTotal (stack2list s) (Data.Maybe.fromMaybe (tr) (root atree))) {!!} {!!})
-- p stack node tree key = {!!}

-- tt = (FS {_} {ℕ} [] [] (Data.Maybe.fromMaybe nullNode (root (createEmptyRedBlackTreeℕ {_} ℕ {ℕ}))))

-- ttt : (a : P) → P
-- ttt a = P₀ {!!} {!!} (record { key = {!!} ; value = {!!} ; right = {!!} ; left = {!!} ; color = {!!} }) (record { total = {!!} })


-- FS では stack tree をあわせた整合性を示したい
-- そのためには...?
-- stack は前の node (というか一段上)が入ってる
-- tree は現在の node がある


 --   tr(Node ℕ ℕ)      s (List (Node))
 --     3                  []
 --    / \
 --   2   5
 --  /   / \
 -- 1   4   6

 --   search 6 (6 > 3)
 --   tr(Node ℕ ℕ)      s (List (Node))
 --     5                 just (node (1 2 nothing) 3 (4 5 6)
 --    / \                 []
 --   4   6

--   search 6 (6 > 5)
--   tr(Node ℕ ℕ)      s (List (Node))
--       6              just (node (4 5 6))
--                      just (node (1 2 nothing) 3 (4 5 6)
--                       []

-- just 6 → true みたいな感じ

-- stack に node ごと入れるのは間違い…?
-- 一応非破壊な感じがする(新しく作り直してる)
-- どう釣り合いをとるか

-- stack+tree : {n m : Level} {t : Set m} → List (Node ℕ ℕ) → Node ℕ ℕ → Node ℕ ℕ → (Maybe (Node ℕ ℕ) → t) → t
-- stack+tree {n} stack mid org = st stack mid org where
-- st : List (Node ℕ ℕ) → Node ℕ ℕ → Node ℕ ℕ → Maybe (Node ℕ ℕ)
-- st [] _ _ = nothing
-- st (x ∷ []) n n1 with Data.Nat.compare (key x) (key org) | Data.Nat.compare (value x) (value org)
-- st (x ∷ []) n n1 | equal .(key x) | equal .(value x) = just org
-- st (x ∷ []) n n1 | _ | _ = nothing
-- st (x ∷ a)  n n1 with st a n n1
-- st (x ∷ a) n n1 | just x₁ = {!!}
-- st (x ∷ a) n n1 | nothing = nothing


-- stack+tree : {n m : Level} {t : Set m} → List (Node ℕ ℕ) → Node ℕ ℕ → Node ℕ ℕ → (Maybe (Node ℕ ℕ) → t) → t
-- stack+tree {n} stack mid org cg = st stack mid org
--   where
--            st : List (Node ℕ ℕ) → Node ℕ ℕ → Node ℕ ℕ → Maybe (Node ℕ ℕ)
--            st [] _ _ = nothing
--            st (x ∷ []) n n1 with Data.Nat.compare (key x) (key org) | Data.Nat.compare (value x) (value org)
--            st (x ∷ []) n n1 | equal .(key x) | equal .(value x) = just org
--            st (x ∷ []) n n1 | _ | _ = nothing
--            st (x ∷ a)  n n1 with st a n n1
--            st (x ∷ a) n n1 | just x₁ = {!!}
--            st (x ∷ a) n n1 | nothing = nothing

-- findNodePush : {n : Level}  → (stack : List (Node ℕ ℕ)) → (mid : Node ℕ ℕ) → (org : Node ℕ ℕ) → stack+tree stack mid org ≡ just ?
--                → ? {return (? ∷ stack),mid'} → stack+tree (? ∷ stack) (mid') org ≡ just ?
-- findNodePush 

-- stack+tree が just だって言えたらよい
-- {}2 は orig の どっちかのNode

>>>>>>> destination