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 }.
intros k d l r b avl_l below_avl_l avl_r above_avl_r.
generalize below_avl_l; clear below_avl_l.
elim avl_l; clear avl_l l.
(* l=Avl_Nil *)
intros below_avl_l height_l.
discriminate height_l.
(* l=(Avl_Node kl dl ll rl bl) *)
intros kl dl ll rl bl.
case bl; clear bl; simpl in |- *.
(* bl=Left_Balanced => single LL-rotation *)
intros avl_ll ih_ll avl_rl ih_rl Balanced_l below_ll above_rl below_avl_l
height_l;  injection height_l; clear height_l ih_ll ih_rl;
intros height_l.
exists (Avl_Node kl dl ll (Avl_Node k d rl r Balanced) Balanced).
repeat apply conj.
inversion_clear below_avl_l.
inversion_clear Balanced_l.
apply Node_Is_Avl; try assumption.
apply Node_Is_Avl; try assumption.
apply Is_Fully_Balanced_Avl.
rewrite height_l in H1.
symmetry  in |- *.
injection H1; trivial.
apply Is_Fully_Balanced_Avl.
simpl in |- *.
assumption.
apply Above_Avl_Node; assumption.
simpl in |- *.
rewrite
(app_ass (lin_avl ll) ((kl, dl) :: lin_avl rl) ((k, d) :: lin_avl r))
.
trivial.
apply equiv_intro; clear avl_ll avl_rl height_l Balanced_l.
intros key data lookup_t.
inversion_clear lookup_t.
apply Lookup_Left; apply Lookup_Equal.
apply Lookup_Left; apply Lookup_Left; assumption.
inversion_clear H.
apply Lookup_Equal.
apply Lookup_Left; apply Lookup_Right; assumption.
apply Lookup_Right; assumption.
intros key data lookup_t0.
inversion_clear lookup_t0.
apply Lookup_Right; apply Lookup_Equal.
inversion_clear H.
apply Lookup_Equal.
apply Lookup_Left; assumption.
apply Lookup_Right; apply Lookup_Left; assumption.
apply Lookup_Right; apply Lookup_Right; assumption.
simpl in |- *; trivial.
(* bl=Balanced => single LL-rotation  *)
intros avl_ll ih_ll avl_rl ih_rl Balanced_l below_ll above_rl below_avl_l
height_l;  injection height_l; clear height_l ih_ll ih_rl;
intros height_l.
exists (Avl_Node kl dl ll (Avl_Node k d rl r Left_Balanced) Right_Balanced).
repeat apply conj.
inversion_clear Balanced_l.
inversion_clear below_avl_l.
apply Node_Is_Avl; try assumption.
apply Node_Is_Avl; try assumption.
apply Is_Left_Balanced_Avl.
rewrite <- height_l.
symmetry  in |- *.
assumption.
apply Is_Right_Balanced_Avl.
simpl in |- *.
rewrite H; trivial.
apply Above_Avl_Node; assumption.
simpl in |- *.
rewrite
(app_ass (lin_avl ll) ((kl, dl) :: lin_avl rl) ((k, d) :: lin_avl r))
.
trivial.
apply equiv_intro; clear avl_ll avl_rl below_avl_l height_l.
intros key data lookup_t.
inversion_clear lookup_t.
apply Lookup_Left; apply Lookup_Equal.
apply Lookup_Left; apply Lookup_Left; assumption.
inversion_clear H.
apply Lookup_Equal.
apply Lookup_Left; apply Lookup_Right; assumption.
apply Lookup_Right; assumption.
intros key data lookup_t0.
inversion_clear lookup_t0.
apply Lookup_Right; apply Lookup_Equal.
inversion_clear H.
apply Lookup_Equal.
apply Lookup_Left; assumption.
apply Lookup_Right; apply Lookup_Left; assumption.
apply Lookup_Right; apply Lookup_Right; assumption.
simpl in |- *.
inversion_clear Balanced_l.
rewrite H; trivial.
(* bl=Right_Balanced => double LR-rotation *)
intros avl_ll ih_ll avl_rl ih_rl; clear ih_ll ih_rl.
elim avl_rl; clear avl_rl rl; simpl in |- *.
intros Balanced_l below_ll above_l below_avl_l height_l.
discriminate height_l.
intros klr dlr llr rlr blr avl_llr ih_llr avl_rlr ih_rlr; clear ih_llr ih_rlr.
intros Balanced_rl below_llr above_rlr Balanced_l below_ll above_lr
below_avl_l height_l.
injection height_l; clear height_l; intros height_l.
exists
(Avl_Node klr dlr
(Avl_Node kl dl ll llr
match blr with
| Left_Balanced => Balanced
| Balanced => Balanced
| Right_Balanced => Left_Balanced
end)
(Avl_Node k d rlr r
match blr with
| Left_Balanced => Right_Balanced
| Balanced => Balanced
| Right_Balanced => Balanced
end) Balanced).
repeat apply conj.
inversion_clear Balanced_l.
inversion_clear above_lr.
inversion_clear below_avl_l.
inversion_clear H3.
apply Node_Is_Avl; try assumption.
apply Node_Is_Avl; try assumption.
clear height_l.
generalize H; clear H.
inversion_clear Balanced_rl; simpl in |- *; intros.
apply Is_Fully_Balanced_Avl.
injection H3; trivial.
apply Is_Fully_Balanced_Avl.
injection H3; trivial.
apply Is_Left_Balanced_Avl.
rewrite <- H in H3.
injection H3; trivial.
apply Node_Is_Avl; try assumption.
generalize height_l; clear height_l.
generalize H; clear H.
inversion_clear Balanced_rl; simpl in |- *; intros.
apply Is_Right_Balanced_Avl.
rewrite <- H.
injection height_l; trivial.
apply Is_Fully_Balanced_Avl.
rewrite <- H.
injection height_l; trivial.
apply Is_Fully_Balanced_Avl.
injection height_l; trivial.
apply Is_Fully_Balanced_Avl.
generalize height_l; clear height_l.
generalize H; clear H.
inversion_clear Balanced_rl; clear blr; simpl in |- *; intros.
rewrite H3.
assumption.
rewrite <- H.
assumption.
assumption.
apply Below_Avl_Node; try assumption.
apply Above_Avl_Node; try assumption.
clear height_l.
simpl in |- *.
rewrite
(app_ass (lin_avl ll) ((kl, dl) :: lin_avl llr)
((klr, dlr) :: lin_avl rlr ++ (k, d) :: lin_avl r))
.
rewrite
(app_ass (lin_avl ll) ((kl, dl) :: lin_avl llr ++ (klr, dlr) :: lin_avl rlr)
((k, d) :: lin_avl r)).
simpl in |- *.
rewrite
(app_ass (lin_avl llr) ((klr, dlr) :: lin_avl rlr) ((k, d) :: lin_avl r))
.
trivial.
apply equiv_intro; clear avl_ll avl_llr avl_rlr below_avl_l height_l.
intros key data lookup_t.
inversion_clear lookup_t.
apply Lookup_Left; apply Lookup_Right; apply Lookup_Equal.
apply Lookup_Left.
inversion_clear H.
apply Lookup_Equal.
apply Lookup_Left; assumption.
apply Lookup_Right; apply Lookup_Left; assumption.
inversion_clear H.
apply Lookup_Equal.
apply Lookup_Left; apply Lookup_Right; apply Lookup_Right; assumption.
apply Lookup_Right; assumption.
intros key data lookup_t0.
inversion_clear lookup_t0.
apply Lookup_Right; apply Lookup_Equal.
inversion_clear H.
apply Lookup_Left; apply Lookup_Equal.
apply Lookup_Left; apply Lookup_Left; assumption.
inversion_clear H0.
apply Lookup_Equal.
apply Lookup_Left; apply Lookup_Right; assumption.
apply Lookup_Right; apply Lookup_Left; assumption.
apply Lookup_Right; apply Lookup_Right; assumption.
clear below_avl_l above_lr below_ll above_rlr below_llr avl_rlr avl_llr.
generalize height_l; clear height_l.
inversion_clear Balanced_l.
generalize H; clear H.
inversion_clear Balanced_rl; clear blr; simpl in |- *; intros.
rewrite H0; trivial.
rewrite H0; trivial.
rewrite H0; trivial.
Qed.
(******************************************************************)
Definition rebalance_right_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 r with
| Avl_Nil => True
| Avl_Node _ _ _ _ Left_Balanced => height_avl t = height_avl r
| Avl_Node _ _ _ _ Balanced => height_avl t = S (height_avl r)
| Avl_Node _ _ _ _ Right_Balanced => height_avl t = height_avl r
end }.
intros k d l r b avl_l below_avl_l avl_r.
elim avl_r; clear avl_r.
(* r=Avl_Nil *)
intros above_avl_r height_r.
discriminate height_r.
(* r=(Avl_Node kr dr lr rr br) *)
intros kr dr lr rr br avl_lr ih_lr avl_rr ih_rr.
clear ih_lr ih_rr.
case br; clear br.
(* br=Left_Balanced => double RL-rotation *)
elim avl_lr; clear avl_lr lr.
simpl in |- *.
intros Balanced_r below_lr above_rr above_avl_r height_r.
discriminate height_r.
intros krl drl lrl rrl brl avl_lrl ih_lrl avl_rrl ih_rrl; clear ih_lrl ih_rrl.
intros Balanced_lr below_lrl above_rrl Balanced_r below_lr above_rr
above_avl_r height_r.
exists
(Avl_Node krl drl
(Avl_Node k d l lrl
match brl with
| Left_Balanced => Balanced
| Balanced => Balanced
| Right_Balanced => Left_Balanced
end)
(Avl_Node kr dr rrl rr
match brl with
| Left_Balanced => Right_Balanced
| Balanced => Balanced
| Right_Balanced => Balanced
end) Balanced).
repeat apply conj.
inversion_clear Balanced_r.
inversion_clear below_lr.
inversion_clear above_avl_r.
inversion_clear H3.
apply Node_Is_Avl; try assumption.
apply Node_Is_Avl; try assumption.
generalize height_r;
clear height_r H5 H4 H2 H1 H0 above_rr above_rrl below_lrl.
generalize H; clear H.
inversion_clear Balanced_lr; clear brl; simpl in |- *; intros.
(* blr=Left_Balanced *)
apply Is_Fully_Balanced_Avl.
injection height_r; trivial.
(* blr=Balanced *)
apply Is_Fully_Balanced_Avl.
injection height_r; trivial.
(* blr=Right_Balanced *)
apply Is_Left_Balanced_Avl.
rewrite H.
injection height_r; trivial.
apply Node_Is_Avl; try assumption.
clear height_r H5 H4 H2 H1 H0 above_rr above_rrl below_lrl.
generalize H; clear H.
inversion_clear Balanced_lr; clear brl; simpl in |- *; intros.
(* brl=Left_Balanced *)
apply Is_Right_Balanced_Avl.
rewrite <- H.
injection H0; trivial.
(* brl=Balanced *)
apply Is_Fully_Balanced_Avl.
rewrite <- H.
injection H0; trivial.
(* brl=Right_Balanced *)
apply Is_Fully_Balanced_Avl.
injection H0; trivial.
apply Is_Fully_Balanced_Avl.
generalize height_r;
clear height_r H5 H4 H2 H1 H0 above_rr above_rrl below_lrl.
generalize H; clear H.
inversion_clear Balanced_lr; clear brl; simpl in |- *; intros.
(* brl=Left_Balanced *)
rewrite <- H0.
injection height_r; clear height_r; intro height_r.
rewrite height_r; trivial.
(* brl=Balanced *)
rewrite <- H.
injection height_r; clear height_r; intro height_r.
rewrite height_r; trivial.
(* brl=Right_Balanced *)
injection height_r; clear height_r; intro height_r.
rewrite height_r; trivial.
apply Below_Avl_Node; assumption.
apply Above_Avl_Node; assumption.
clear height_r above_avl_r above_rr below_lr Balanced_r above_rrl below_lrl
Balanced_lr.
simpl in |- *.
rewrite
(app_ass (lin_avl l) ((k, d) :: lin_avl lrl)
((krl, drl) :: lin_avl rrl ++ (kr, dr) :: lin_avl rr))
.
simpl in |- *.
rewrite
(app_ass (lin_avl lrl) ((krl, drl) :: lin_avl rrl) ((kr, dr) :: lin_avl rr))
.
trivial.
clear height_r above_avl_r above_rr below_lr Balanced_r above_rrl below_lrl
Balanced_lr.
apply equiv_intro.
intros key data lookup_t.
inversion_clear lookup_t.
apply Lookup_Right; apply Lookup_Left; apply Lookup_Equal.
inversion_clear H.
apply Lookup_Equal.
apply Lookup_Left; assumption.
apply Lookup_Right; apply Lookup_Left; apply Lookup_Left; assumption.
inversion_clear H.
apply Lookup_Right; apply Lookup_Equal.
apply Lookup_Right; apply Lookup_Left; apply Lookup_Right; assumption.
apply Lookup_Right; apply Lookup_Right; assumption.
intros key data lookup_t0.
inversion_clear lookup_t0.
apply Lookup_Left; apply Lookup_Equal.
apply Lookup_Left; apply Lookup_Left; assumption.
inversion_clear H.
apply Lookup_Right; apply Lookup_Equal.
inversion_clear H0.
apply Lookup_Equal.
apply Lookup_Left; apply Lookup_Right; assumption.
apply Lookup_Right; apply Lookup_Left; assumption.
apply Lookup_Right; apply Lookup_Right; assumption.
clear above_avl_r above_rr below_lr above_rrl below_lrl.
generalize height_r; clear height_r.
elim brl; simpl in |- *; trivial.
(* br=Balanced *)
simpl in |- *.
intros Balanced_r below_lr above_rr above_avl_r height_r.
exists (Avl_Node kr dr (Avl_Node k d l lr Right_Balanced) rr Left_Balanced).
repeat apply conj.
inversion_clear above_avl_r.
injection height_r; clear height_r; intro height_r.
apply Node_Is_Avl; try assumption.
apply Node_Is_Avl; try assumption.
apply Is_Right_Balanced_Avl.
assumption.
apply Is_Left_Balanced_Avl.
simpl in |- *.
inversion_clear Balanced_r.
rewrite H1; trivial.
apply Below_Avl_Node; assumption.
simpl in |- *.
rewrite
(app_ass (lin_avl l) ((k, d) :: lin_avl lr) ((kr, dr) :: lin_avl rr))
.
trivial.
apply equiv_intro; clear above_avl_r height_r.
intros key data lookup_t.
inversion_clear lookup_t.
apply Lookup_Right; apply Lookup_Equal.
inversion_clear H.
apply Lookup_Equal.
apply Lookup_Left; assumption.
apply Lookup_Right; apply Lookup_Left; assumption.
apply Lookup_Right; apply Lookup_Right; assumption.
intros key data lookup_t0.
inversion_clear lookup_t0.
apply Lookup_Left; apply Lookup_Equal.
apply Lookup_Left; apply Lookup_Left; assumption.
inversion_clear H.
apply Lookup_Equal.
apply Lookup_Left; apply Lookup_Right; assumption.
apply Lookup_Right; assumption.
simpl in |- *.
trivial.
(* br=Right_Balanced *)
simpl in |- *.
intros Balanced_r below_lr above_rr above_avl_r height_r.
injection height_r; clear height_r; intro height_r.
exists (Avl_Node kr dr (Avl_Node k d l lr Balanced) rr Balanced).
repeat apply conj.
inversion_clear above_avl_r.
inversion_clear Balanced_r.
apply Node_Is_Avl; try assumption.
apply Node_Is_Avl; try assumption.
apply Is_Fully_Balanced_Avl.
rewrite <- height_r in H1.
symmetry  in |- *.
injection H1; trivial.
apply Is_Fully_Balanced_Avl.
simpl in |- *.
assumption.
apply Below_Avl_Node; assumption.
simpl in |- *.
rewrite
(app_ass (lin_avl l) ((k, d) :: lin_avl lr) ((kr, dr) :: lin_avl rr))
.
trivial.
apply equiv_intro; clear above_avl_r height_r.
intros key data lookup_t.
inversion_clear lookup_t.
apply Lookup_Right; apply Lookup_Equal.
inversion_clear H.
apply Lookup_Equal.
apply Lookup_Left; assumption.
apply Lookup_Right; apply Lookup_Left; assumption.
apply Lookup_Right; apply Lookup_Right; assumption.
intros key data lookup_t0.
inversion_clear lookup_t0.
apply Lookup_Left; apply Lookup_Equal.
apply Lookup_Left; apply Lookup_Left; assumption.
inversion_clear H.
apply Lookup_Equal.
apply Lookup_Left; apply Lookup_Right; assumption.
apply Lookup_Right; assumption.
simpl in |- *.
rewrite height_r; trivial.
Qed.
(********************************************************************)
Inductive is_balanced_avl_left_shift (l r : avl_tree) : bal -> Prop :=
| Is_Left_Balanced_Avl_Left_Shift :
height_avl l = S (S (height_avl r)) ->
is_balanced_avl_left_shift l r Left_Balanced
| Is_Fully_Balanced_Avl_Left_Shift :
height_avl l = S (height_avl r) ->
is_balanced_avl_left_shift l r Balanced
| Is_Right_Balanced_Avl_Left_Shift :
height_avl l = height_avl r ->
is_balanced_avl_left_shift l r Right_Balanced.
intros l0 l r0 b0 Balanced_l0 height_l.
inversion_clear Balanced_l0.
apply Is_Left_Balanced_Avl_Left_Shift.
rewrite <- H; assumption.
apply Is_Fully_Balanced_Avl_Left_Shift.
rewrite <- H; assumption.
apply Is_Right_Balanced_Avl_Left_Shift.
rewrite <- H; assumption.
Qed.
intros l r b Balanced_l.
inversion_clear Balanced_l; intros Balanced_shift_l;
inversion_clear Balanced_shift_l.
apply n_Sn_false with (S (height_avl r)).
rewrite <- H0.
symmetry  in |- *; assumption.
apply n_Sn_false with (height_avl r).
rewrite <- H0.
symmetry  in |- *; assumption.
apply n_Sn_false with (height_avl l).
rewrite H.
assumption.
Qed.
(********************************************************************)
Inductive is_balanced_avl_right_shift (l r : avl_tree) : bal -> Prop :=
| Is_Left_Balanced_Avl_Right_Shift :
height_avl l = height_avl r ->
is_balanced_avl_right_shift l r Left_Balanced
| Is_Fully_Balanced_Avl_Right_Shift :
S (height_avl l) = height_avl r ->
is_balanced_avl_right_shift l r Balanced
| Is_Right_Balanced_Avl_Right_Shift :
S (S (height_avl l)) = height_avl r ->
is_balanced_avl_right_shift l r Right_Balanced.
intros l0 r r0 b0 Balanced_r0 height_l.
inversion_clear Balanced_r0.
apply Is_Left_Balanced_Avl_Right_Shift.
rewrite H; symmetry  in |- *; assumption.
apply Is_Fully_Balanced_Avl_Right_Shift.
rewrite H; symmetry  in |- *; assumption.
apply Is_Right_Balanced_Avl_Right_Shift.
rewrite H; symmetry  in |- *; assumption.
Qed.
intros l r b Balanced_l.
inversion_clear Balanced_l; intros Balanced_shift_l;
inversion_clear Balanced_shift_l.
apply n_Sn_false with (height_avl r).
rewrite <- H.
symmetry  in |- *; assumption.
apply n_Sn_false with (height_avl l).
rewrite H0.
assumption.
apply n_Sn_false with (S (height_avl l)).
rewrite H0.
assumption.
Qed.
(**********************************************************************)
Inductive hasnot_grown_left (t : avl_tree) (k : Int)
(d : B) (l r : avl_tree) : bal -> Prop :=
| Hasnot_Grown_Left_Bal :
forall b : bal,
is_balanced_avl l r b ->
height_avl t = height_avl (Avl_Node k d l r b) ->
hasnot_grown_left t k d l r b
| Hasnot_Grown_Left_Shift_Left :
is_balanced_avl_left_shift l r Left_Balanced ->
height_avl t = height_avl l ->
hasnot_grown_left t k d l r Left_Balanced
| Hasnot_Grown_Left_Shift_Right :
is_balanced_avl_left_shift l r Right_Balanced ->
height_avl t = S (height_avl l) ->
hasnot_grown_left t k d l r Right_Balanced.
Inductive has_grown_left (t : avl_tree) (k : Int) (d : B)
(l r : avl_tree) : bal -> Prop :=
| Has_Grown_Left_Shift_Left :
is_balanced_avl_left_shift l r Left_Balanced ->
height_avl t = S (height_avl l) ->
has_grown_left t k d l r Left_Balanced
| Has_Grown_Left_Shift_Balanced :
is_balanced_avl_left_shift l r Balanced ->
height_avl t = S (height_avl l) -> has_grown_left t k d l r Balanced.
Inductive bal_grow_left_spec (k : Int) (d : B) (l r : avl_tree)
(b : bal) : Set :=
Balance_Grow_Left_Spec_Intro :
forall 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) ->
{hasnot_grown_left t k d l r b} + {has_grown_left t k d l r b} ->
bal_grow_left_spec k d l r b.
intros k d l r b avl_l below_avl_l avl_r above_avl_r bal_or_shift.
elim bal_or_shift; clear bal_or_shift.
(* l and r is Balanced with respect to b *)
intro Balanced_l.
apply Balance_Grow_Left_Spec_Intro with (Avl_Node k d l r b).
apply Node_Is_Avl; assumption.
trivial.
apply equiv_refl.
left.
apply Hasnot_Grown_Left_Bal.
assumption.
trivial.
(* l and r is'nt Balanced with respect to b *)
elim b; clear b; intros Balanced_shift_l.
(* b=Left_Balanced *)
elim (rebalance_left k d l r Left_Balanced); try assumption.
intros t (avl_t,(lin,(equiv_t,height_t))).
apply Balance_Grow_Left_Spec_Intro with t.
assumption.
assumption.
assumption.
clear lin equiv_t avl_l below_avl_l.
generalize height_t; clear height_t.
generalize Balanced_shift_l; clear Balanced_shift_l.
case l; clear l.
intro u0.
elimtype False.
inversion_clear u0.
discriminate H.
intros kl dl ll rl bl.
elim bl; clear bl; simpl in |- *; intros Balanced_shift_l height_t.
(* bl=Left_Balanced *)
left.
apply Hasnot_Grown_Left_Shift_Left; assumption.
(* bl=Balanced *)
right.
apply Has_Grown_Left_Shift_Left; assumption.
(* bl=Right_Balanced *)
left.
apply Hasnot_Grown_Left_Shift_Left; assumption.
(* side premisses of (Elim (rebalance ... )) *)
inversion_clear Balanced_shift_l; assumption.
(* b=Balanced *)
apply Balance_Grow_Left_Spec_Intro with (Avl_Node k d l r Left_Balanced).
apply Node_Is_Avl; try assumption.
apply Is_Left_Balanced_Avl.
inversion_clear Balanced_shift_l; assumption.
trivial.
apply equiv_refl.
right.
apply Has_Grown_Left_Shift_Balanced.
assumption.
trivial.
(* b=Right_Balanced *)
apply Balance_Grow_Left_Spec_Intro with (Avl_Node k d l r Balanced).
apply Node_Is_Avl; try assumption.
apply Is_Fully_Balanced_Avl.
inversion_clear Balanced_shift_l; assumption.
trivial.
apply equiv_refl.
simpl in |- *.
left.
apply Hasnot_Grown_Left_Shift_Right.
assumption.
trivial.
Qed.
(**********************************************************************)
Inductive hasnot_grown_right (t : avl_tree) (k : Int)
(d : B) (l r : avl_tree) : bal -> Prop :=
| Hasnot_Grown_Right_Bal :
forall b : bal,
is_balanced_avl l r b ->
height_avl t = height_avl (Avl_Node k d l r b) ->
hasnot_grown_right t k d l r b
| Hasnot_Grown_Right_Shift_Left :
is_balanced_avl_right_shift l r Left_Balanced ->
height_avl t = S (height_avl r) ->
hasnot_grown_right t k d l r Left_Balanced
| Hasnot_Grown_Right_Shift_Right :
is_balanced_avl_right_shift l r Right_Balanced ->
height_avl t = height_avl r ->
hasnot_grown_right t k d l r Right_Balanced.
Inductive has_grown_right (t : avl_tree) (k : Int)
(d : B) (l r : avl_tree) : bal -> Prop :=
| Has_Grown_Right_Shift_Balanced :
is_balanced_avl_right_shift l r Balanced ->
height_avl t = S (height_avl r) -> has_grown_right t k d l r Balanced
| Has_Grown_Right_Shift_Right :
is_balanced_avl_right_shift l r Right_Balanced ->
height_avl t = S (height_avl r) ->
has_grown_right t k d l r Right_Balanced.
Inductive bal_grow_right_spec (k : Int) (d : B) (l r : avl_tree)
(b : bal) : Set :=
Balance_Grow_Right_Spec_Intro :
forall 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) ->
{hasnot_grown_right t k d l r b} + {has_grown_right t k d l r b} ->
bal_grow_right_spec k d l r b.

Lemma balance_right :
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 ->
{is_balanced_avl l r b} + {is_balanced_avl_right_shift l r b} ->
bal_grow_right_spec k d l r b.