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.

Lemma is_left_balanced_is_left_balanced_left_shift :
forall (l0 l r0 : avl_tree) (b0 : bal),
is_balanced_avl l0 r0 b0 ->
height_avl l = S (height_avl l0) -> is_balanced_avl_left_shift l r0 b0.