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.
intros l r k d b avl_t.
apply is_balanced_avl_is_balanced.
apply (inv_is_avl_left k d l r b avl_t).
apply (inv_is_avl_right k d l r b avl_t).
apply (inv_is_avl_is_balanced_avl k d l r b avl_t).
Qed.
intros t avl_t.
elim avl_t; clear avl_t t.
intros; apply Below_Nil.
intros k d l r b avl_l ih_l avl_r ih_r Balanced_t below_l above_r k0
below_avl.
inversion_clear below_avl.
apply Below_Node.
assumption.
apply ih_l.
apply below_avl_trans with k.
assumption.
assumption.
apply ih_r; assumption.
Qed.
intros t avl_t; elim avl_t; clear avl_t t.
intros; apply Above_Nil.
intros k d l r b avl_l ih_l avl_r ih_r Balanced_t below_l above_r k0
above_avl.
clear avl_l avl_r Balanced_t.
inversion_clear above_avl.
apply Above_Node.
assumption.
apply ih_l; assumption.
apply ih_r.
apply above_avl_trans with k.
assumption.
assumption.
Qed.
(***************************************************************)
(*  lookup_avl                                                 *)
intros key k d l r b data avl_t equal lookup_t.
elim (inv_lookup key k d l r b data lookup_t); intro u0.
elim u0; trivial.
elimtype False.
elim u0; clear u0; intro u0.
apply (lookup_below_false key l data u0).
apply is_below_avl_is_below.
apply (inv_is_avl_left k d l r b avl_t).
rewrite (equal_eq key k equal).
apply (inv_is_avl_is_is_below_avl k d l r b avl_t).
apply (lookup_above_false key r data u0).
apply is_above_avl_is_above.
apply (inv_is_avl_right k d l r b avl_t).
rewrite (equal_eq key k equal).
apply (inv_is_avl_is_is_above_avl k d l r b avl_t).
Qed.
intros key k d l r b data avl_t less lookup_t.
elim (inv_lookup key k d l r b data lookup_t); intro u0.
elimtype False.
apply (less_irrefl key).
elim u0; clear u0; intros u0 u1.
rewrite u0 in less.
assumption.
elim u0; clear u0; intro u0.
assumption.
elimtype False.
apply (lookup_above_false key r data u0).
apply is_above_avl_is_above.
apply (inv_is_avl_right k d l r b avl_t).
apply (above_avl_trans r k key).
apply (inv_is_avl_is_is_above_avl k d l r b avl_t).
assumption.
Qed.
intros key k d l r b data avl_t less lookup_t.
elim (inv_lookup key k d l r b data lookup_t); intro u0.
elimtype False.
apply (less_irrefl key).
elim u0; clear u0; intros u0 u1.
rewrite u0 in less.
assumption.
elim u0; clear u0; intro u0.
elimtype False.
apply (lookup_below_false key l data u0).
apply (below_trans l k key).
apply is_below_avl_is_below.
apply (inv_is_avl_left k d l r b avl_t).
apply (inv_is_avl_is_is_below_avl k d l r b avl_t).
assumption.
assumption.
Qed.
intros k1 k t d1 d avl_t.
generalize d; clear d.
generalize d1; clear d1.
generalize k; clear k.
generalize k1; clear k1.
elim avl_t; clear avl_t.
intros.
inversion_clear H.
intros k0 d0 l r b avl_l ih_l avl_r ih_r Balanced_l below_avl_r above_avl_r
k1 k2 d1 d2 lookup_k1.
inversion_clear lookup_k1.
intros lookup_k0 equal_k1.
apply lookup_avl_inv_equal with k2 k0 l r b.
apply Node_Is_Avl; assumption.
apply equal_sym; assumption.
assumption.
intros lookup_k2 equal_k1.
apply ih_l with k1 k2; try assumption.
apply lookup_avl_inv_less with k0 d0 r b.
apply Node_Is_Avl; assumption.
rewrite <- (equal_eq k1 k2 equal_k1).
apply lookup_below_less with l d1.
assumption.
apply is_below_avl_is_below; assumption.
assumption.
intros lookup_k2 equal_k1.
apply ih_r with k1 k2; try assumption.
apply lookup_avl_inv_greater with k0 d0 l b.
apply Node_Is_Avl; assumption.
rewrite <- (equal_eq k1 k2 equal_k1).
apply lookup_above_greater with r d1.
assumption.
apply is_above_avl_is_above; assumption.
assumption.
Qed.
(****************************************************************************)
Inductive lookup_dec_spec (key : Int) (t : avl_tree) : Set :=
| Lookup : forall d : B, lookup key t d -> lookup_dec_spec key t
| Not_Lookup : (forall d : B, ~ lookup key t d) -> lookup_dec_spec key t.
intros key t avl_t; elim avl_t; clear avl_t t.
apply Not_Lookup.
unfold not in |- *; intros d lookup_nil.
apply (inv_lookup_nil key d); assumption.
intros k d l r b avl_l ih_l avl_r ih_r Balanced_t below_l above_r.
elim (equal_dec key k).
intro equal_key_k.
apply Lookup with d.
rewrite (equal_eq key k equal_key_k).
apply Lookup_Equal.
intros not_equal_key_k.
elim (less_dec key k).
intro less_key_k.
elim ih_l; clear ih_r ih_l.
intros d0 lookup_d0.
apply Lookup with d0.
apply Lookup_Left; assumption.
intros not_lookup_d0.
apply Not_Lookup.
unfold not in |- *; intros d0 lookup_d0.
apply (not_lookup_d0 d0).
apply (lookup_avl_inv_less key k d l r b).
apply Node_Is_Avl; assumption.
assumption.
assumption.
intros not_less.
generalize (notequal_notless_greater key k not_equal_key_k not_less).
clear not_equal_key_k not_less.
intros less_k_key.
elim ih_r; clear ih_r ih_l.
intros d0 lookup_d0.
apply Lookup with d0.
apply Lookup_Right; assumption.
intros not_lookup_d0.
apply Not_Lookup.
unfold not in |- *; intros d0 lookup_d0.
apply (not_lookup_d0 d0).
apply (lookup_avl_inv_greater key k d l r b); try assumption.
apply Node_Is_Avl; assumption.
Qed.
(***************************************************************************)
(*  equiv                                                                  *)
Fixpoint lin_avl (t : avl_tree) : list (Int * B) :=
match t with
| Avl_Nil => nil (A:=Int * B)
| Avl_Node k d l r _ => lin_avl l ++ (k, d) :: lin_avl r
end.
Inductive equiv : avl_tree -> avl_tree -> Prop :=
equiv_intro :
forall t0 t1 : avl_tree,
(forall (key : Int) (data : B),
lookup key t0 data -> lookup key t1 data) ->
(forall (key : Int) (data : B),
lookup key t1 data -> lookup key t0 data) ->
equiv t0 t1.
intros.
inversion_clear H.
apply H1.
assumption.
Qed.
intros.
inversion_clear H.
apply H2.
assumption.
Qed.
intros t t0 equiv_t_t0.
inversion_clear equiv_t_t0.
apply equiv_intro.
assumption.
assumption.
Qed.
intros k d l r b b'.
apply equiv_intro.
intros key data lookup_t.
inversion_clear lookup_t.
apply Lookup_Equal.
apply Lookup_Left; assumption.
apply Lookup_Right; assumption.
intros key data lookup_t.
inversion_clear lookup_t.
apply Lookup_Equal.
apply Lookup_Left; assumption.
apply Lookup_Right; assumption.
Qed.
(******************************************************************)
Definition rebalance_left_spec (k : Int) (d : B) (l r : avl_tree)
(b : bal) : Set :=
{ t : avl_tree |
is_avl t /\
lin_avl t = lin_avl (Avl_Node k d l r b) /\
equiv t (Avl_Node k d l r b) /\
match l with
| Avl_Nil => True
| Avl_Node _ _ _ _ Left_Balanced => height_avl t = height_avl l
| Avl_Node _ _ _ _ Balanced => height_avl t = S (height_avl l)
| Avl_Node _ _ _ _ Right_Balanced => height_avl t = height_avl l
end }.

Lemma rebalance_left :
forall (k : Int) (d : B) (l r : avl_tree) (b : bal),
is_avl l ->
is_below_avl l k ->
is_avl r ->
is_above_avl r k ->
height_avl l = S (S (height_avl r)) -> rebalance_left_spec k d l r b.