test(tests/lean/run/tree_height): experiment with wf relation based on the height
This is easier to generate than the subterm relation
This commit is contained in:
parent
dbb3b7c72a
commit
a065c7bf96
1 changed files with 36 additions and 0 deletions
36
tests/lean/run/tree_height.lean
Normal file
36
tests/lean/run/tree_height.lean
Normal file
|
@ -0,0 +1,36 @@
|
|||
import logic data.nat
|
||||
open eq.ops nat
|
||||
|
||||
inductive tree (A : Type) :=
|
||||
leaf : A → tree A,
|
||||
node : tree A → tree A → tree A
|
||||
|
||||
namespace tree
|
||||
|
||||
definition height {A : Type} (t : tree A) : nat :=
|
||||
rec_on t
|
||||
(λ a, zero)
|
||||
(λ t₁ t₂ h₁ h₂, succ (max h₁ h₂))
|
||||
|
||||
definition height_lt {A : Type} : tree A → tree A → Prop :=
|
||||
inv_image lt (@height A)
|
||||
|
||||
definition height_lt.wf (A : Type) : well_founded (@height_lt A) :=
|
||||
inv_image.wf height lt.wf
|
||||
|
||||
theorem height_lt.node_left {A : Type} (t₁ t₂ : tree A) : height_lt t₁ (node t₁ t₂) :=
|
||||
le_imp_lt_succ (left_le_max (height t₁) (height t₂))
|
||||
|
||||
theorem height_lt.node_right {A : Type} (t₁ t₂ : tree A) : height_lt t₂ (node t₁ t₂) :=
|
||||
le_imp_lt_succ (right_le_max (height t₁) (height t₂))
|
||||
|
||||
theorem height_lt.trans {A : Type} : transitive (@height_lt A) :=
|
||||
inv_image.trans lt height @lt_trans
|
||||
|
||||
example : height_lt (leaf 2) (node (leaf 1) (leaf 2)) :=
|
||||
!height_lt.node_right
|
||||
|
||||
example : height_lt (leaf 2) (node (node (leaf 1) (leaf 2)) (leaf 3)) :=
|
||||
height_lt.trans !height_lt.node_right !height_lt.node_left
|
||||
|
||||
end tree
|
Loading…
Reference in a new issue