lean2/tests/lean/run/forest_height.lean

100 lines
4.2 KiB
Text
Raw Normal View History

import data.nat.basic data.sum data.sigma data.bool
open nat sigma
inductive tree (A : Type) : Type :=
node : A → forest A → tree A
with forest : Type :=
nil : forest A,
cons : tree A → forest A → forest A
namespace manual
check tree.rec_on
definition tree.height {A : Type} (t : tree A) : nat :=
tree.rec_on t
(λ (a : A) (f : forest A) (ih : nat), succ ih)
zero
(λ (t : tree A) (f : forest A) (ih₁ : nat) (ih₂ : nat), succ (max ih₁ ih₂))
definition forest.height {A : Type} (f : forest A) : nat :=
forest.rec_on f
(λ (a : A) (f : forest A) (ih : nat), succ ih)
zero
(λ (t : tree A) (f : forest A) (ih₁ : nat) (ih₂ : nat), succ (max ih₁ ih₂))
definition tree_forest (A : Type) := sum (tree A) (forest A)
definition tree_forest_height {A : Type} (t : tree_forest A) : nat :=
sum.rec_on t (λ t, tree.height t) (λ f, forest.height f)
definition tree_forest.subterm {A : Type} : tree_forest A → tree_forest A → Prop :=
inv_image lt tree_forest_height
definition tree_forest.subterm.wf [instance] (A : Type) : well_founded (@tree_forest.subterm A) :=
inv_image.wf tree_forest_height lt.wf
infix [local] `≺`:50 := tree_forest.subterm
definition tree_forest.height_lt.node {A : Type} (a : A) (f : forest A) : sum.inr f ≺ sum.inl (tree.node a f) :=
have aux : forest.height f < tree.height (tree.node a f), from
lt.base (forest.height f),
aux
definition tree_forest.height_lt.cons₁ {A : Type} (t : tree A) (f : forest A) : sum.inl t ≺ sum.inr (forest.cons t f) :=
have aux : tree.height t < forest.height (forest.cons t f), from
lt_succ_of_le (max.left _ _),
aux
definition tree_forest.height_lt.cons₂ {A : Type} (t : tree A) (f : forest A) : sum.inr f ≺ sum.inr (forest.cons t f) :=
have aux : forest.height f < forest.height (forest.cons t f), from
lt_succ_of_le (max.right _ _),
aux
definition kind {A : Type} (t : tree_forest A) : bool :=
sum.cases_on t (λ t, bool.tt) (λ f, bool.ff)
definition map.res {A : Type} (B : Type) (t : tree_forest A) :=
Σ r : tree_forest B, kind r = kind t
set_option find_decl.expensive true
find_decl bool.ff ≠ bool.tt
-- map using well-founded recursion. We could have used the default recursor.
-- this is just a test for the definitional package
definition map.F {A B : Type} (f : A → B) (tf₁ : tree_forest A) : (Π tf₂ : tree_forest A, tf₂ ≺ tf₁ → map.res B tf₂) → map.res B tf₁ :=
sum.cases_on tf₁
(λ t : tree A, tree.cases_on t
(λ a₁ f₁ (r : Π (tf₂ : tree_forest A), tf₂ ≺ sum.inl (tree.node a₁ f₁) → map.res B tf₂),
show map.res B (sum.inl (tree.node a₁ f₁)), from
have rf₁ : map.res B (sum.inr f₁), from r (sum.inr f₁) (tree_forest.height_lt.node a₁ f₁),
have nf₁ : forest B, from sum.cases_on (pr₁ rf₁)
(λf (h : kind (sum.inl f) = kind (sum.inr f₁)), absurd (eq.symm h) bool.ff_ne_tt)
(λf h, f)
(pr₂ rf₁),
sigma.mk (sum.inl (tree.node (f a₁) nf₁)) rfl))
(λ f : forest A, forest.cases_on f
(λ r : Π (tf₂ : tree_forest A), tf₂ ≺ sum.inr (forest.nil A) → map.res B tf₂,
show map.res B (sum.inr (forest.nil A)), from
sigma.mk (sum.inr (forest.nil B)) rfl)
(λ t₁ f₁ (r : Π (tf₂ : tree_forest A), tf₂ ≺ sum.inr (forest.cons t₁ f₁) → map.res B tf₂),
show map.res B (sum.inr (forest.cons t₁ f₁)), from
have rt₁ : map.res B (sum.inl t₁), from r (sum.inl t₁) (tree_forest.height_lt.cons₁ t₁ f₁),
have rf₁ : map.res B (sum.inr f₁), from r (sum.inr f₁) (tree_forest.height_lt.cons₂ t₁ f₁),
have nt₁ : tree B, from sum.cases_on (pr₁ rt₁)
(λ t h, t)
(λ f h, absurd h bool.ff_ne_tt)
(pr₂ rt₁),
have nf₁ : forest B, from sum.cases_on (pr₁ rf₁)
(λf (h : kind (sum.inl f) = kind (sum.inr f₁)), absurd (eq.symm h) bool.ff_ne_tt)
(λf h, f)
(pr₂ rf₁),
sigma.mk (sum.inr (forest.cons nt₁ nf₁)) rfl))
definition map {A B : Type} (f : A → B) (tf : tree_forest A) : map.res B tf :=
well_founded.fix (@map.F A B f) tf
eval map succ (sum.inl (tree.node 2 (forest.cons (tree.node 1 (forest.nil nat)) (forest.nil nat))))
end manual