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 }.

(* Specifications: *)
Lemma rebalance_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 ->
S (S (height_avl l)) = height_avl r -> rebalance_right_spec k d l r b.