После STL под Siemens мне уже ничего не страшно, тебе меня не запугать)))
Попробую немного:
data braun-tree : (n : ℕ) → Set ℓ where
bt-empty : braun-tree 0
bt-node : ∀ {n m : ℕ} →
A → braun-tree n → braun-tree m →
n ≡ m ∨ n ≡ suc m →
braun-tree (suc (n + m))
bt-insert : ∀ {n : ℕ} → A → braun-tree n → braun-tree (suc n)
bt-insert a bt-empty = bt-node a bt-empty bt-empty (inj₁ refl)
bt-insert a (bt-node{n}{m} a' l r p)
rewrite +comm n m with p | if a <A a' then (a , a') else (a' , a)
bt-insert a (bt-node{n}{m} a' l r _) | inj₁ p | (a1 , a2)
rewrite p = (bt-node a1 (bt-insert a2 r) l (inj₂ refl))
bt-insert a (bt-node{n}{m} a' l r _) | inj₂ p | (a1 , a2) =
(bt-node a1 (bt-insert a2 r) l (inj₁ (sym p)))
bt-replace-min : ∀{n : ℕ} → A → braun-tree (suc n) → braun-tree (suc n)
bt-replace-min a (bt-node _ bt-empty bt-empty u) = (bt-node a bt-empty bt-empty u)
bt-replace-min a (bt-node _ bt-empty (bt-node _ _ _ _) (inj₁ ()))
bt-replace-min a (bt-node _ bt-empty (bt-node _ _ _ _) (inj₂ ()))
bt-replace-min a (bt-node _ (bt-node _ _ _ _) bt-empty (inj₁ ()))
bt-replace-min a (bt-node a' (bt-node x l r u) bt-empty (inj₂ y)) with bt-replace-min a (bt-node x l r u) | a <A x
bt-replace-min a (bt-node a' (bt-node x l r u) bt-empty (inj₂ y)) | _ | tt = (bt-node a (bt-node x l r u) bt-empty (inj₂ y))
bt-replace-min a (bt-node a' (bt-node x l r u) bt-empty (inj₂ y)) | rec | ff =
(bt-node x rec bt-empty (inj₂ y))
bt-replace-min a (bt-node a' (bt-node x l r u) (bt-node x' l' r' u') v) with bt-replace-min a (bt-node x l r u) | bt-replace-min a (bt-node x' l' r' u') | a <A x && a <A x'
bt-replace-min a (bt-node a' (bt-node x l r u) (bt-node x' l' r' u') v) | _ | _ | tt =
(bt-node a (bt-node x l r u) (bt-node x' l' r' u') v)
bt-replace-min a (bt-node a' (bt-node x l r u) (bt-node x' l' r' u') v) | rec₁ | rec₂ | ff with x <A x'
bt-replace-min a (bt-node a' (bt-node x l r u) (bt-node x' l' r' u') v) | rec₁ | _ | ff | tt =
(bt-node x rec₁ (bt-node x' l' r' u') v)
bt-replace-min a (bt-node a' (bt-node x l r u) (bt-node x' l' r' u') v) | _ | rec₂ | ff | ff =
(bt-node x' (bt-node x l r u) rec₂ v)
bt-delete-min : ∀ {p : ℕ} → braun-tree (suc p) → braun-tree p
bt-delete-min (bt-node a bt-empty bt-empty u) = bt-empty
bt-delete-min (bt-node a bt-empty (bt-node _ _ _ _) (inj₁ ()))
bt-delete-min (bt-node a bt-empty (bt-node _ _ _ _) (inj₂ ()))
bt-delete-min (bt-node a (bt-node{n'}{m'} a' l' r' u') bt-empty u) rewrite +0 (n' + m') = bt-node a' l' r' u'
bt-delete-min (bt-node a
(bt-node{n}{m} x l1 r1 u1)
(bt-node{n'}{m'} x' l2 r2 u2) u) with bt-delete-min (bt-node x l1 r1 u1)
bt-delete-min (bt-node a
(bt-node{n}{m} x l1 r1 u1)
(bt-node{n'}{m'} x' l2 r2 u2) u) | rec
rewrite +suc(n + m)(n' + m') | +suc n (m + (n' + m'))
| +comm(n + m)(n' + m') =
if (x <A x') then
(bt-node x (bt-node x' l2 r2 u2) rec (lem{n}{m}{n'}{m'} u))
else
(bt-node x' (bt-replace-min x (bt-node x' l2 r2 u2)) rec (lem{n}{m}{n'}{m'} u))
where lem : {n m n' m' : ℕ} → suc (n + m) ≡ suc (n' + m') ∨ suc (n + m) ≡ suc (suc (n' + m')) →
suc (n' + m') ≡ n + m ∨ suc (n' + m') ≡ suc (n + m)
lem{n}{m}{n'}{m'} (inj₁ x) = inj₂ (sym x)
lem (inj₂ y) = inj₁ (sym (suc-inj y))
bt-remove-min : ∀ {p : ℕ} → braun-tree (suc p) → A × braun-tree p
bt-remove-min (bt-node a l r u) = a , bt-delete-min (bt-node a l r u)