module _ where open import level open import maybe open import eq open import nat open import nat-thms open import bool open import bool-thms open import product open import product-thms open import neq open import empty open import list open import list-thms open import sum ||-l-tt : ∀ (b1 b2 : 𝔹) -> b1 ≡ tt -> b1 || b2 ≡ tt ||-l-tt b1 b2 eq rewrite eq = refl ||-r-tt : ∀ (b1 b2 : 𝔹) -> b2 ≡ tt -> b1 || b2 ≡ tt ||-r-tt b1 b2 eq rewrite eq = ||-tt b1 ||-assoc : ∀ (b1 b2 b3 : 𝔹) -> (b1 || b2) || b3 ≡ b1 || (b2 || b3) ||-assoc tt b2 b3 = refl ||-assoc ff tt b3 = refl ||-assoc ff ff b3 = refl max-comm : ∀ x y -> max x y ≡ max y x max-comm zero zero = refl max-comm zero (suc y) = refl max-comm (suc x) zero = refl max-comm (suc x) (suc y) rewrite max-suc y x | max-suc x y | max-comm x y = refl max-<2' : ∀ {n u} -> n ≤ max u n ≡ tt max-<2' {n} {u} rewrite max-comm u n = max-<1{n}{u} suc-< : ∀ x y -> x < y ≡ tt -> x < suc y ≡ tt suc-< zero zero x 0 < y ≡ ff -> y ≡ 0 <ℕff zero 0 x < y ≡ tt -> suc x < y ≡ ff -> suc x ≡ y <<-tt-ff-≡ zero zero () <<-tt-ff-≡ zero (suc y) x x < y ≡ ff -> suc x < y ≡ tt -> x ≡ y <<-ff-tt-≡ zero zero x x < suc x ≡ tt x max x y ≤ max (suc x) y ≡ tt max-sucr x y with keep (x < y) max-sucr x y | tt , x l ≤ l' ≡ tt -> max l r ≤ max l' r ≡ tt max-mono1 zero zero zero l≤l' = refl max-mono1 zero zero (suc r) l≤l' rewrite =ℕ-refl r = ||-tt (r < r) max-mono1 zero (suc l') zero l≤l' = refl max-mono1 zero (suc l') (suc r) l≤l' = ≤-trans {max zero (suc r)} {max l' (suc r)} {max (suc l') (suc r)} (max-mono1 zero l' (suc r) (0-≤ l')) (max-sucr l' (suc r)) max-mono1 (suc l) zero r () max-mono1 (suc l) (suc l') zero l≤l' = l≤l' max-mono1 (suc l) (suc l') (suc r) l≤l' rewrite max-suc l r | max-suc l' r | max-mono1 l l' r l≤l' = refl maxlbl : ∀ m n -> n < m ≡ tt -> max m n ≡ m maxlbl zero zero n n < m ≡ ff -> min m n ≡ m minubl zero zero n list-member _=ℕ_ ele l1 || list-member _=ℕ_ ele l2 ≡ list-member _=ℕ_ ele (l1 ++ l2) lm++ [] l2 ele = refl lm++ (x :: l1) l2 ele rewrite ||-assoc (ele =ℕ x) (list-member _=ℕ_ ele l1) (list-member _=ℕ_ ele l2) | lm++ l1 l2 ele = refl lm++ff : ∀ l1 l2 ele -> list-member _=ℕ_ ele l1 ≡ ff -> list-member _=ℕ_ ele l2 ≡ ff -> list-member _=ℕ_ ele (l1 ++ l2) ≡ ff lm++ff [] l2 ele _ lml2 = lml2 lm++ff (x :: l1) l2 ele lml1 lml2 rewrite sym (||≡ff₁ {ele =ℕ x} lml1) = lm++ff l1 l2 ele (||≡ff₂ {ele =ℕ x} lml1) lml2 lm++r : ∀ l1 l2 ele -> list-member _=ℕ_ ele l1 ≡ ff -> list-member _=ℕ_ ele l2 ≡ list-member _=ℕ_ ele (l1 ++ l2) lm++r [] l2 ele lml1≡ff = refl lm++r (x :: l1) l2 ele lml1≡ff rewrite sym (||≡ff₁ {ele =ℕ x} lml1≡ff) = lm++r l1 l2 ele (||≡ff₂ lml1≡ff) data BST : ℕ -> ℕ -> Set where leaf : ∀ {n m} -> {n≤m : n ≤ m ≡ tt} -> BST n m node : ∀ {l' l u' u} -> (n : ℕ) -> (left : BST l' n) -> (right : BST n u') -> {l≤l' : l ≤ l' ≡ tt} -> {u'≤u : u' ≤ u ≡ tt} -> BST l u rewritebounds : ∀ l l' u u' -> l ≡ l' -> u ≡ u' -> BST l u -> BST l' u' rewritebounds l l' u u' refl refl bst = bst insert : ∀ {l u} -> BST l u -> (n : ℕ) -> BST (min l n) (max u n) insert {l} {u} (node m left right) n with keep (n < m) insert {l} {u} (node {l'} {u' = u'} m left right {l≤l'} {u'≤u}) n | tt , n BST l u -> ℕ -> 𝔹 lookup leaf m = ff lookup (node n left right) m with n =ℕ m lookup (node n left right) m | tt = tt lookup (node n left right) m | ff with n < m ... | tt = lookup right m ... | ff = lookup left m BSTnums : ∀ {l m : ℕ} -> BST l m -> 𝕃 ℕ BSTnums leaf = [] BSTnums (node n left right) = n :: BSTnums left ++ BSTnums right sameelements : 𝕃 ℕ -> 𝕃 ℕ -> Set sameelements l1 l2 = ∀ (n : ℕ) -> list-member _=ℕ_ n l1 ≡ list-member _=ℕ_ n l2 BSTbounds : ∀ l u -> BST l u -> l ≤ u ≡ tt BSTbounds l u (leaf{n≤m = n≤m}) = n≤m BSTbounds bl bu (node{l}{l'}{u}{u'} n left right{l≤l'}{u'≤u}) = ≤-trans{bl}{u}{bu} (≤-trans {bl}{n}{u} (≤-trans{bl}{l}{n} l≤l' (BSTbounds l n left)) (BSTbounds n u right)) u'≤u outofbounds : ∀ (l u ne : ℕ) -> (b : BST l u) -> ne < l || u < ne ≡ tt -> list-member _=ℕ_ ne (BSTnums b) ≡ ff outofbounds l u ne leaf _ = refl outofbounds l u ne (node{l'}{.l}{u'}{.u} n left right {l≤l'} {u'≤u}) ne (n : ℕ) (b : BST l u) -> lookup b n ≡ list-member _=ℕ_ n (BSTnums b) lookupworks l u ele leaf = refl lookupworks l u ele (node n left right) with keep (n =ℕ ele) lookupworks l u ele (node n left right) | tt , n=ℕele≡tt rewrite =ℕ-sym n ele | n=ℕele≡tt = refl lookupworks bl bu ele (node {l'} {l} {u'} {u} n left right {l≤l'} {u'≤u}) | ff , n=ℕele≡ff rewrite n=ℕele≡ff with keep (n < ele) lookupworks bl bu ele (node {l'} {l} {u'} {u} n left right {l≤l'} {u'≤u}) | ff , n=ℕele≡ff | tt , n (b : BST l u) -> (x : l ≡ l') -> (y : u ≡ u') -> BSTnums (rewritebounds l l' u u' x y b) ≡ BSTnums b BSTnumsrewrite l u l' u' b refl refl = refl tidy-||s : (b1 b2 b3 b4 : 𝔹) -> b1 || b2 || b3 || b4 ≡ b2 || (b1 || b3) || b4 tidy-||s tt tt b3 b4 = refl tidy-||s tt ff b3 b4 = refl tidy-||s ff tt b3 b4 = refl tidy-||s ff ff b3 b4 = refl insertworks : ∀ (l u : ℕ) -> (ele : ℕ) (b : BST l u) -> sameelements (ele :: BSTnums b) (BSTnums (insert b ele)) insertworks l u ele leaf m = refl insertworks l u ele (node{l'}{.l}{u'}{.u} n left right {bl≤l} {u≤bu}) m with keep (ele < n) ... | tt , ele