Section avl_trees.
Variable B : Set.
(*********************************************************)
(*		Definition bal and avl_tree	  	 *)
Inductive bal : Set :=
| Left_Balanced : bal
| Balanced : bal
| Right_Balanced : bal.
Inductive avl_tree : Set :=
| Avl_Nil : avl_tree
| Avl_Node : Int -> B -> avl_tree -> avl_tree -> bal -> avl_tree.
(*********************************************************)
(*		Definition is_below		  	 *)
Inductive is_below : avl_tree -> Int -> Prop :=
| Below_Nil : forall k0 : Int, is_below Avl_Nil k0
| Below_Node :
forall (k : Int) (d : B) (l r : avl_tree) (b : bal) (k0 : Int),
Less k k0 ->
is_below l k0 -> is_below r k0 -> is_below (Avl_Node k d l r b) k0.
intros.
inversion H; assumption.
Qed.
intros.
inversion H; assumption.
Qed.
intros.
inversion H; assumption.
Qed.
intros t; elim t; clear t.
intros.
apply Below_Nil.
intros k d l ih_l r ih_r b k0 k1 H0 H1.
apply Below_Node.
apply (less_trans k k0 k1).
apply (inv_below_key k d l r b k0 H0).
assumption.
apply (ih_l k0 k1 (inv_below_left k d l r b k0 H0) H1).
apply (ih_r k0 k1 (inv_below_right k d l r b k0 H0) H1).
Qed.
(*********************************************************)
(*		Definition is_above		  	 *)
Inductive is_above : avl_tree -> Int -> Prop :=
| Above_Nil : forall k0 : Int, is_above Avl_Nil k0
| Above_Node :
forall (k : Int) (d : B) (l r : avl_tree) (b : bal) (k0 : Int),
Less k0 k ->
is_above l k0 -> is_above r k0 -> is_above (Avl_Node k d l r b) k0.
intros.
inversion H; assumption.
Qed.
intros.
inversion H; assumption.
Qed.
intros.
inversion H; assumption.
Qed.
intros t; elim t; clear t.
intros.
apply Above_Nil.
intros k d l ih_l r ih_r b k0 k1 H0 H1.
apply Above_Node.
apply (less_trans k1 k0 k H1).
apply (inv_above_key k d l r b k0 H0).
apply (ih_l k0 k1 (inv_above_left k d l r b k0 H0) H1).
apply (ih_r k0 k1 (inv_above_right k d l r b k0 H0) H1).
Qed.
(*********************************************************)
(*		Definition height         	  	 *)
Fixpoint height (t : avl_tree) : nat :=
match t with
| Avl_Nil => 0
| Avl_Node _ _ l r _ => S (max (height l) (height r))
end.
intros t; elim t; clear t.
intros; trivial.
intros k d l ih_l r ih_r b.
simpl in |- *; intro u0;  discriminate u0.
Qed.
(*********************************************************)
(*		Definition is_balanced		  	 *)
Inductive is_balanced (l r : avl_tree) : bal -> Prop :=
| Is_Left_Balanced :
height l = S (height r) -> is_balanced l r Left_Balanced
| Is_Fully_Balanced : height l = height r -> is_balanced l r Balanced
| Is_Right_Balanced :
S (height l) = height r -> is_balanced l r Right_Balanced.
intros.
inversion H; assumption.
Qed.
intros.
inversion H; assumption.
Qed.
intros.
inversion H; assumption.
Qed.
(************************************************************************)
(* lookup                                                               *)
Inductive lookup (key : Int) : avl_tree -> B -> Prop :=
| Lookup_Equal :
forall (d : B) (l r : avl_tree) (b : bal),
lookup key (Avl_Node key d l r b) d
| Lookup_Left :
forall (k : Int) (d : B) (l r : avl_tree) (b : bal) (data : B),
lookup key l data -> lookup key (Avl_Node k d l r b) data
| Lookup_Right :
forall (k : Int) (d : B) (l r : avl_tree) (b : bal) (data : B),
lookup key r data -> lookup key (Avl_Node k d l r b) data.
intros.
inversion H.
Qed.
intros.
inversion_clear H.
left; split; trivial.
right; left; assumption.
right; right; assumption.
Qed.
(*******************************************************)
(* Lemmata about Lookup and below/above                *)
intros key t; elim t; clear t.
intros data k0 lookup_t below_t.
elimtype False.
apply (inv_lookup_nil key data lookup_t).
intros k d l ih_l r ih_r b data k0 lookup_t below_t.
elim (inv_lookup key k d l r b data lookup_t); clear lookup_t; intro u0.
elim u0; clear u0; intros u0 u1.
rewrite <- u0.
apply (inv_below_key k d l r b k0 below_t).
elim u0; clear u0; intro u0.
apply (ih_l data).
assumption.
apply (inv_below_left k d l r b k0 below_t).
apply (ih_r data).
assumption.
apply (inv_below_right k d l r b k0 below_t).
Qed.
intros key t; elim t; clear t.
intros data k0 lookup_t above_t.
elimtype False.
apply (inv_lookup_nil key data lookup_t).
intros k d l ih_l r ih_r b data k0 lookup_t above_t.
elim (inv_lookup key k d l r b data lookup_t); clear lookup_t; intro u0.
elim u0; clear u0; intros u0 u1.
rewrite <- u0.
apply (inv_above_key k d l r b k0 above_t).
elim u0; clear u0; intro u0.
apply (ih_l data).
assumption.
apply (inv_above_left k d l r b k0 above_t).
apply (ih_r data).
assumption.
apply (inv_above_right k d l r b k0 above_t).
Qed.
intros t; elim t; clear t.
intros.
apply Below_Nil.
intros k d l ih_l r ih_r b k0 H.
apply Below_Node.
apply (H k d).
apply Lookup_Equal.
apply ih_l.
intros k1 d0 lookup_l.
apply (H k1 d0).
apply Lookup_Left; assumption.
apply ih_r.
intros k1 d0 lookup_r.
apply (H k1 d0).
apply Lookup_Right; assumption.
Qed.
intros t; elim t; clear t.
intros.
apply Above_Nil.
intros k d l ih_l r ih_r b k0 H.
apply Above_Node.
apply (H k d).
apply Lookup_Equal.
apply ih_l.
intros k1 d0 lookup_l.
apply (H k1 d0).
apply Lookup_Left; assumption.
apply ih_r.
intros k1 d0 lookup_r.
apply (H k1 d0).
apply Lookup_Right; assumption.
Qed.
intros key k d l r b data lookup_t less above_r.
elim (inv_lookup key k d l r b data lookup_t); clear lookup_t; intro u0.
elimtype False.
elim u0; clear u0; intros u0 u1.
apply less_irrefl with key.
rewrite u0 in less.
assumption.
elim u0; clear u0; intro u0.
assumption.
elimtype False.
apply less_irrefl with key.
apply lookup_above_greater with r data; assumption.
Qed.
intros key k d l r b data lookup_t less below_l.
elim (inv_lookup key k d l r b data lookup_t); clear lookup_t; intro u0.
elimtype False.
elim u0; clear u0; intros u0 u1.
apply less_irrefl with key.
rewrite u0 in less.
assumption.
elim u0; clear u0; intro u0.
elimtype False.
apply less_irrefl with key.
apply lookup_below_less with l data; assumption.
assumption.
Qed.
intros key t data lookup_t below_t.
apply less_irrefl with key.
apply lookup_below_less with t data; assumption.
Qed.
intros key t data lookup_t above_t.
apply less_irrefl with key.
apply lookup_above_greater with t data; assumption.
Qed.
(*********************************************************)
(*		Definition is_below_avl		  	 *)
Inductive is_below_avl : avl_tree -> Int -> Prop :=
| Below_Avl_Nil : forall k0 : Int, is_below_avl Avl_Nil k0
| Below_Avl_Node :
forall (k : Int) (d : B) (l r : avl_tree) (b : bal) (k0 : Int),
Less k k0 -> is_below_avl r k0 -> is_below_avl (Avl_Node k d l r b) k0.
intros.
inversion H; assumption.
Qed.
intros.
inversion H; assumption.
Qed.
intros t; elim t; clear t.
intros.
apply Below_Avl_Nil.
intros k d l ih_l r ih_r b k0 k1 H0 H1.
apply Below_Avl_Node.
apply (less_trans k k0 k1).
apply (inv_below_avl_key k d l r b k0 H0).
assumption.
apply (ih_r k0 k1 (inv_below_avl_right k d l r b k0 H0) H1).
Qed.
intros t key; elim t; clear t.
intros.
apply Below_Avl_Nil.
intros k d l ih_l r ih_r b below_t.
apply Below_Avl_Node.
apply (inv_below_key k d l r b key below_t).
apply ih_r.
apply (inv_below_right k d l r b key below_t).
Qed.
(*********************************************************)
(*		Definition is_above_avl		  	 *)
Inductive is_above_avl : avl_tree -> Int -> Prop :=
| Above_Avl_Nil : forall k0 : Int, is_above_avl Avl_Nil k0
| Above_Avl_Node :
forall (k : Int) (d : B) (l r : avl_tree) (b : bal) (k0 : Int),
Less k0 k -> is_above_avl l k0 -> is_above_avl (Avl_Node k d l r b) k0.
intros.
inversion H; assumption.
Qed.
intros.
inversion H; assumption.
Qed.
intros t; elim t; clear t.
intros.
apply Above_Avl_Nil.
intros k d l ih_l r ih_r b k0 k1 H0 H1.
apply Above_Avl_Node.
apply (less_trans k1 k0 k H1).
apply (inv_above_avl_key k d l r b k0 H0).
apply (ih_l k0 k1 (inv_above_avl_left k d l r b k0 H0) H1).
Qed.
intros t key; elim t; clear t.
intros.
apply Above_Avl_Nil.
intros k d l ih_l r ih_r b above_t.
apply Above_Avl_Node.
apply (inv_above_key k d l r b key above_t).
apply ih_l.
apply (inv_above_left k d l r b key above_t).
Qed.
(*****************************************************************)
(*           height_avl                                          *)
Fixpoint height_avl (t : avl_tree) : nat :=
match t with
| Avl_Nil => 0
| Avl_Node _ _ l _ Left_Balanced => S (height_avl l)
| Avl_Node _ _ l _ Balanced => S (height_avl l)
| Avl_Node _ _ _ r Right_Balanced => S (height_avl r)
end.
intros t; elim t; clear t.
intros; trivial.
intros k d l ih_l r ih_r b.
elim b; simpl in |- *; intro u0;  discriminate u0.
Qed.
(*********************************************************)
(*		Definition is_balanced		  	 *)
Inductive is_balanced_avl (l r : avl_tree) : bal -> Prop :=
| Is_Left_Balanced_Avl :
height_avl l = S (height_avl r) -> is_balanced_avl l r Left_Balanced
| Is_Fully_Balanced_Avl :
height_avl l = height_avl r -> is_balanced_avl l r Balanced
| Is_Right_Balanced_Avl :
S (height_avl l) = height_avl r -> is_balanced_avl l r Right_Balanced.
intros.
inversion H; assumption.
Qed.
intros.
inversion H; assumption.
Qed.
intros.
inversion H; assumption.
Qed.
intros l l0 r0 b0 Balanced_l0 height_l.
inversion_clear Balanced_l0.
apply Is_Left_Balanced_Avl.
rewrite height_l; assumption.
apply Is_Fully_Balanced_Avl.
rewrite height_l; assumption.
apply Is_Right_Balanced_Avl.
rewrite height_l; assumption.
Qed.
intros l0 r r0 b0 Balanced_l0 height_r.
inversion_clear Balanced_l0.
apply Is_Left_Balanced_Avl.
rewrite height_r; assumption.
apply Is_Fully_Balanced_Avl.
rewrite height_r; assumption.
apply Is_Right_Balanced_Avl.
rewrite height_r; assumption.
Qed.
(*************************************************)
(*		Definition Avl		  	 *)
(*************************************************)
Inductive is_avl : avl_tree -> Prop :=
| Nil_Is_Avl : is_avl Avl_Nil
| Node_Is_Avl :
forall (k : Int) (d : B) (l r : avl_tree) (b : bal),
is_avl l ->
is_avl r ->
is_balanced_avl l r b ->
is_below_avl l k -> is_above_avl r k -> is_avl (Avl_Node k d l r b).
intros P base step t.
elim t; clear t.
intros; apply base.
intros k d l ih_l r ih_r b avl_t.
apply step.
inversion_clear avl_t; assumption.
apply ih_l.
inversion_clear avl_t; assumption.
inversion_clear avl_t; assumption.
apply ih_r.
inversion_clear avl_t; assumption.
inversion_clear avl_t; assumption.
inversion_clear avl_t; assumption.
inversion_clear avl_t; assumption.
Qed.
intros.
inversion H; assumption.
Qed.
intros.
inversion H; assumption.
Qed.
intros.
inversion H; assumption.
Qed.
intros.
inversion H; assumption.
Qed.
intros.
inversion H; assumption.
Qed.
intros t avl_t.
elim avl_t.
simpl in |- *; trivial.
intros k d l r b avl_l ih_l avl_r ih_r Balanced_t below_l above_r.
clear avl_l avl_r below_l above_r.
simpl in |- *.
rewrite <- ih_l.
rewrite <- ih_r.
clear ih_l ih_r.
inversion_clear Balanced_t.
rewrite H.
rewrite (max_Sn_n (height_avl r)).
trivial.
rewrite H.
rewrite (max_n_n (height_avl r)).
trivial.
rewrite <- H.
rewrite (max_n_Sn (height_avl l)).
trivial.
Qed.
intros l r avl_l avl_r.
intro b; elim b; clear b; intro bal0.
apply Is_Left_Balanced.
rewrite <- (avl_height_avl_height r avl_r).
rewrite <- (avl_height_avl_height l avl_l).
apply inv_left_balanced_avl; assumption.
apply Is_Fully_Balanced.
rewrite <- (avl_height_avl_height r avl_r).
rewrite <- (avl_height_avl_height l avl_l).
apply inv_fully_balanced_avl; assumption.
apply Is_Right_Balanced.
rewrite <- (avl_height_avl_height r avl_r).
rewrite <- (avl_height_avl_height l avl_l).
apply inv_right_balanced_avl; assumption.
Qed.

Lemma is_avl_is_balanced :
forall (l r : avl_tree) (k : Int) (d : B) (b : bal),
is_avl (Avl_Node k d l r b) -> is_balanced l r b.