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.

Lemma hasnot_grown_right__preserves_is_balanced_avl :
forall (l0 r r0 : avl_tree) (b0 : bal),
is_balanced_avl l0 r0 b0 ->
height_avl r = height_avl r0 -> is_balanced_avl l0 r b0.