changeset 601:803c423c2855

modify
author ryokka
date Wed, 04 Mar 2020 19:00:29 +0900
parents 016a8deed93d
children 0dbbcab02864
files hoareBinaryTree.agda
diffstat 1 files changed, 92 insertions(+), 128 deletions(-) [+]
line wrap: on
line diff
--- a/hoareBinaryTree.agda	Wed Mar 04 17:51:05 2020 +0900
+++ b/hoareBinaryTree.agda	Wed Mar 04 19:00:29 2020 +0900
@@ -61,11 +61,6 @@
   N :  (key : ℕ) →
     (ltree : bt A ) → (rtree : bt A ) → bt A
 
-
--- data bt-path {n : Level} (A : Set n) : Set n where
---   bt-left  : (key : ℕ) → (bt A )  → bt-path A
---   bt-right : (key : ℕ) → (bt A ) → bt-path A
-
 data bt-path' {n : Level} (A : Set n) : Set n where
   left  : (bt A) → bt-path' A
   right : (bt A) → bt-path' A
@@ -76,9 +71,98 @@
 tree->key {n} L = zero
 tree->key {n} (N key tree tree₁) = key
 
--- path2tree : {n : Level} {A : Set n} → (bt-path' {n} A) → bt A
--- path2tree {n} {A} (left x) = x
--- path2tree {n} {A} (right x) = x
+node-ex : {n : Level} {A : Set n} → bt A
+node-ex {n} {A} = (N zero (L) (L))
+
+ex : {n : Level} {A : Set n} → bt A
+ex {n} {A} = (N {n} {A} 8 (N 6 (N 2 (N 1 L L) (N 3 L L)) (N 7 L L)) (N 9 L L))
+
+exLR : {n : Level} {A : Set n} → bt A
+exLR {n} {A} = (N {n} {A} 4 (N 2 L (N 3 L L)) (N 5 L L))
+
+exRL : {n : Level} {A : Set n} → bt A
+exRL {n} {A} = (N {n} {A} 3 L (N 5 (N 4 L L) L))
+
+leaf-ex : {n : Level} {A : Set n} → bt A
+leaf-ex {n} {A} = L
+
+
+findLoopInv : {n m : Level} {A : Set n} {t : Set m}  →  (orig : bt A) → (modify : bt A )
+  → (stack : List (bt-path' A)) → Set n
+findLoopInv {n} {m} {A} {t} tree mtree [] = tree ≡ mtree
+findLoopInv {n} {m} {A} {t} tree mtree (left L ∷ st) = mtree ≡ (L)
+findLoopInv {n} {m} {A} {t} tree mtree (right L ∷ st) = mtree ≡ (L)
+findLoopInv {n} {m} {A} {t} tree mtree (left (N key x x₁) ∷ st) = mtree ≡ x
+findLoopInv {n} {m} {A} {t} tree mtree (right (N key x x₁) ∷ st) = mtree ≡ x₁
+
+
+hightMerge : {n m : Level} {A : Set n} {t : Set m} → (l r : ℕ) → (ℕ → t) → t
+hightMerge lh rh next with <-cmp lh rh
+hightMerge lh rh next | tri< a ¬b ¬c = next rh
+hightMerge lh rh next | tri≈ ¬a b ¬c = next lh
+hightMerge lh rh next | tri> ¬a ¬b c = next lh
+
+
+isHightL : {n m : Level} {A : Set n} {t : Set m} → bt A → (ℕ → t) → t
+isHightL L next = next zero
+isHightL {n} {_} {A} (N key tree tree₁) next = isHightL tree λ x → next (suc x)
+
+isHightR : {n m : Level} {A : Set n} {t : Set m} → bt A → (ℕ → t) → t
+isHightR L next = next zero
+isHightR {n} {_} {A} (N key tree tree₁) next = isHightR tree₁ λ x → next (suc x)
+
+isHight : {n m : Level} {A : Set n} {t : Set m} → bt A → (ℕ → t) → t
+isHight L next = next zero
+isHight {n} {_} {A} tr@(N key tree tree₁) next = isHightL tr (λ lh → isHightR tr λ rh → hightMerge {n} {_} {A} (suc lh) (suc rh) next)
+
+treeHight : {n m : Level} {A : Set n} {t : Set m} → bt A → (ℕ → t) → t
+treeHight L next = next zero
+treeHight {n} {_} {A} (N key tree tree₁) next = isHight tree (λ lh → isHight tree₁ (λ rh → hightMerge {n} {_} {A} (lh) (rh) next))
+
+rhight : {n : Level} {A : Set n}  → bt A → ℕ
+rhight L = zero
+rhight (N key tree tree₁) with <-cmp (rhight tree) (rhight tree₁)
+rhight (N key tree tree₁) | tri< a ¬b ¬c = suc (rhight tree₁)
+rhight (N key tree tree₁) | tri≈ ¬a b ¬c = suc (rhight tree₁)
+rhight (N key tree tree₁) | tri> ¬a ¬b c = suc (rhight tree)
+
+leaf≠node : {n : Level} {A : Set n} {a : ℕ} {l r : bt A} →  ((N {n} {A} a l r) ≡ L) → ⊥
+leaf≠node ()
+
+leafIsNoHight : {n : Level} {A : Set n} (tree : bt A) → tree ≡ L → (treeHight tree (λ x → x) ≡ 0)
+leafIsNoHight L refl = refl
+
+
+hight-tree : {n : Level} {A : Set n} {k : ℕ} {l r : bt A} → ℕ → (tree : bt A) → Set n
+hight-tree zero tree = tree ≡ L
+hight-tree {n} {A} {k} {l} {r} (suc h) tree = tree ≡ (N k l r)
+
+
+hightIsNotLeaf : {n : Level} {A : Set n} (h : ℕ) → (tree : bt A) → (0 ≡ treeHight tree (λ x → x)) →  (tree ≡ L)
+hightIsNotLeaf h tree eq = {!!}
+
+-- leaf≡0 : {n : Level} {A : Set n} (tree : bt A) → (rhight tree ≡ 0) → tree ≡ L
+-- leaf≡0 L _ = refl
+
+-- find-function sepalate "next", "loop"
+find-hoare-next : {n m : Level} {A : Set n} {t : Set m} → (key : ℕ) → (tree mt : bt A ) → (st : List (bt-path' A)) → (findLoopInv {n} {m} {A} {t} tree mt st)
+  → (next : (nt : bt A) → (ns : List (bt-path' A)) → (findLoopInv {n} {m} {A} {t} tree nt ns) → t )
+  → (exit : (nt : bt A) → (ns : List (bt-path' A)) → (nt ≡ L) ∨ (key ≡ tree->key nt) → t ) → t
+find-hoare-next key leaf@(L) mt st eq _ exit = exit leaf st (case1 refl)
+find-hoare-next key (N key₁ tree tree₁) mt st eq next exit with <-cmp key key₁
+find-hoare-next key node@(N key₁ tree tree₁) mt st eq _ exit | tri≈ ¬a b ¬c = exit node st (case2 b)
+find-hoare-next key node@(N key₁ tree tree₁) mt st eq next _ | tri< a ¬b ¬c = next tree ((left node) ∷ st) refl
+find-hoare-next key node@(N key₁ tree tree₁) mt st eq next _ | tri> ¬a ¬b c = next tree₁ ((right node) ∷ st) refl
+
+find-hoare-loop : {n m : Level} {A : Set n} {t : Set m} → (hight key : ℕ) → (tree mt : bt A ) → (st : List (bt-path' A)) → (findLoopInv {n} {m} {A} {t} tree mt st)
+  → (exit : (nt : bt A) → (ns : List (bt-path' A)) →  (nt ≡ L) ∨ (key ≡ tree->key nt) → t) → t
+find-hoare-loop zero key tree mt st eq exit with key ≟ (tree->key tree)
+find-hoare-loop zero key tree mt st eq exit | yes p = exit tree st (case2 p)
+find-hoare-loop zero key tree mt st eq exit | no ¬p = exit tree st (case1 {!!})
+
+find-hoare-loop (suc h) key otr lf@(L) st eq exit = exit lf st (case1 refl)
+find-hoare-loop (suc h) key otr tr@(N key₁ tree tree₁) st eq exit = find-hoare-next key otr tr st eq ((λ tr1 st1 eq → find-hoare-loop h key otr tr1 st1 eq exit)) exit
+
 
 
 -- bt-find : {n m : Level} {A : Set n} {t : Set m} → (key : ℕ) → (tree : bt A  ) → List (bt-path A)
@@ -116,126 +200,6 @@
 -- find-loop (suc h) key lf@(L) st exit = exit lf st
 -- find-loop (suc h) key tr@(N key₁ tree tree₁) st exit = find-next key tr st ((λ tr1 st1 → find-loop h key tr1 st1 exit)) exit
 
-
-
-node-ex : {n : Level} {A : Set n} → bt A
-node-ex {n} {A} = (N zero (L) (L))
-
-ex : {n : Level} {A : Set n} → bt A
-ex {n} {A} = (N {n} {A} 8 (N 6 (N 2 (N 1 L L) (N 3 L L)) (N 7 L L)) (N 9 L L))
-
-exLR : {n : Level} {A : Set n} → bt A
-exLR {n} {A} = (N {n} {A} 4 (N 2 L (N 3 L L)) (N 5 L L))
-
-exRL : {n : Level} {A : Set n} → bt A
-exRL {n} {A} = (N {n} {A} 3 L (N 5 (N 4 L L) L))
-
-
-
-
-leaf-ex : {n : Level} {A : Set n} → bt A
-leaf-ex {n} {A} = L
-
-
-
-
-
-
-findLoopInv : {n m : Level} {A : Set n} {t : Set m}  →  (orig : bt A) → (modify : bt A )
-  → (stack : List (bt-path' A)) → Set n
--- findLoopInv {n} {m} {A} {t} tree mtree [] = tree ≡ mtree
--- findLoopInv {n} {m} {A} {t} tree mtree (left (L) ∷ st) = mtree ≡ (L)
--- findLoopInv {n} {m} {A} {t} tree mtree (right (L) ∷ st) = mtree ≡ (L)
-findLoopInv {n} {m} {A} {t} tree mtree [] = tree ≡ mtree
-findLoopInv {n} {m} {A} {t} tree mtree (left L ∷ st) = mtree ≡ (L)
-findLoopInv {n} {m} {A} {t} tree mtree (right L ∷ st) = mtree ≡ (L)
-findLoopInv {n} {m} {A} {t} tree mtree (left (N key x x₁) ∷ st) = mtree ≡ x
-findLoopInv {n} {m} {A} {t} tree mtree (right (N key x x₁) ∷ st) = mtree ≡ x₁
-
-
-
-
-
-
-
-
-
-hightMerge : {n m : Level} {A : Set n} {t : Set m} → (l r : ℕ) → (ℕ → t) → t
-hightMerge lh rh next with <-cmp lh rh
-hightMerge lh rh next | tri< a ¬b ¬c = next rh
-hightMerge lh rh next | tri≈ ¬a b ¬c = next lh
-hightMerge lh rh next | tri> ¬a ¬b c = next lh
-
-isHightL : {n m : Level} {A : Set n} {t : Set m} → bt A → (ℕ → t) → t
-isHightL L next = next zero
-isHightL {n} {_} {A} (N key tree tree₁) next = isHightL tree λ x → next (suc x)
-
-isHightR : {n m : Level} {A : Set n} {t : Set m} → bt A → (ℕ → t) → t
-isHightR L next = next zero
-isHightR {n} {_} {A} (N key tree tree₁) next = isHightR tree₁ λ x → next (suc x)
-
-isHight : {n m : Level} {A : Set n} {t : Set m} → bt A → (ℕ → t) → t
-isHight L next = next zero
-isHight {n} {_} {A} tr@(N key tree tree₁) next = isHightL tr (λ lh → isHightR tr λ rh → hightMerge {n} {_} {A} (suc lh) (suc rh) next)
-
-
-treeHight : {n m : Level} {A : Set n} {t : Set m} → bt A → (ℕ → t) → t
-treeHight L next = next zero
-treeHight {n} {_} {A} (N key tree tree₁) next = isHight tree (λ lh → isHight tree₁ (λ rh → hightMerge {n} {_} {A} (lh) (rh) next))
-
-rhight : {n : Level} {A : Set n}  → bt A → ℕ
-rhight L = zero
-rhight (N key tree tree₁) with <-cmp (rhight tree) (rhight tree₁)
-rhight (N key tree tree₁) | tri< a ¬b ¬c = suc (rhight tree₁)
-rhight (N key tree tree₁) | tri≈ ¬a b ¬c = suc (rhight tree₁)
-rhight (N key tree tree₁) | tri> ¬a ¬b c = suc (rhight tree)
-
-leaf≠node : {n : Level} {A : Set n} {a : ℕ} {l r : bt A} →  ((N {n} {A} a l r) ≡ L) → ⊥
-leaf≠node ()
-
-leafIsNoHight : {n : Level} {A : Set n} (tree : bt A) → tree ≡ L → (treeHight tree (λ x → x) ≡ 0)
-leafIsNoHight L refl = refl
-
-
-
-hight-tree : {n : Level} {A : Set n} {k : ℕ} {l r : bt A} → ℕ → (tree : bt A) → Set n
-hight-tree zero tree = tree ≡ L
-hight-tree {n} {A} {k} {l} {r} (suc h) tree = tree ≡ (N k l r)
-
-
-hightIsNotLeaf : {n : Level} {A : Set n} (h : ℕ) → (tree : bt A) → (h ≡ 0 ) ∧ (h ≡ treeHight tree (λ x → x)) →  (tree ≡ L)
-hightIsNotLeaf .0 tree record { proj1 = refl ; proj2 = p2 } = {!!}
-
--- leaf≡0 : {n : Level} {A : Set n} (tree : bt A) → (rhight tree ≡ 0) → tree ≡ L
--- leaf≡0 L _ = refl
-
-
-
-
-
-
-
-
-
-find-hoare-next : {n m : Level} {A : Set n} {t : Set m} → (key : ℕ) → (tree mt : bt A ) → (st : List (bt-path' A)) → (findLoopInv {n} {m} {A} {t} tree mt st)
-  → (next : (nt : bt A) → (ns : List (bt-path' A)) → (findLoopInv {n} {m} {A} {t} tree nt ns) → t )
-  → (exit : (nt : bt A) → (ns : List (bt-path' A)) → (nt ≡ L) ∨ (key ≡ tree->key nt) → t ) → t
-find-hoare-next key leaf@(L) mt st eq _ exit = exit leaf st (case1 refl)
-find-hoare-next key (N key₁ tree tree₁) mt st eq next exit with <-cmp key key₁
-find-hoare-next key node@(N key₁ tree tree₁) mt st eq _ exit | tri≈ ¬a b ¬c = exit node st (case2 b)
-find-hoare-next key node@(N key₁ tree tree₁) mt st eq next _ | tri< a ¬b ¬c = next tree ((left node) ∷ st) refl
-find-hoare-next key node@(N key₁ tree tree₁) mt st eq next _ | tri> ¬a ¬b c = next tree₁ ((right node) ∷ st) refl
-
-find-hoare-loop : {n m : Level} {A : Set n} {t : Set m} → (hight key : ℕ) → (tree mt : bt A ) → (st : List (bt-path' A)) → (findLoopInv {n} {m} {A} {t} tree mt st)
-  → (exit : (nt : bt A) → (ns : List (bt-path' A)) →  (nt ≡ L) ∨ (key ≡ tree->key nt) → t) → t
-find-hoare-loop zero key tree mt st eq exit with key ≟ (tree->key tree)
-find-hoare-loop zero key tree mt st eq exit | yes p = exit tree st (case2 p)
-find-hoare-loop zero key tree mt st eq exit | no ¬p = exit tree st (case1 {!!})
-
-find-hoare-loop (suc h) key otr lf@(L) st eq exit = exit lf st (case1 refl)
-find-hoare-loop (suc h) key otr tr@(N key₁ tree tree₁) st eq exit = find-hoare-next key otr tr st {!!} ((λ tr1 st1 eq → find-hoare-loop h key otr tr1 st1 {!!} exit)) exit
-
-
 -- bt-replace : {n m : Level} {A : Set n} {t : Set m} → (key : ℕ) → bt A → List (bt-path A) → (bt A → t ) → t
 -- bt-replace {n} {m} {A} {t} ikey otree stack next = bt-replace0 otree where
 --     bt-replace1 : bt A → List (bt-path A) → t