intros k0 d0 l0 r0.
generalize l0; clear l0.
generalize d0; clear d0.
generalize k0; clear k0.
elim r0; clear r0.
(* r0=Avl_Nil *)
intros k0 d0 l0 b0 avl_t0.
apply Del_Max_Spec_Intro with k0 d0 l0.
apply Lookup_Equal.
inversion_clear avl_t0; assumption.
inversion_clear avl_t0; assumption.
trivial.
apply equiv_del_semi_leave; assumption.
right.
inversion_clear avl_t0.
inversion_clear H1.
simpl in |- *; trivial.
simpl in |- *; trivial.
discriminate H4.
(* r0=(Avl_Node kr0 dr0 lr0 rr0 br0) *)
intros kr0 dr0 lr0 ih_lr0 rr0 ih_rr0 br0 k0 d0 l0 b0 avl_t0.
elim (ih_rr0 kr0 dr0 lr0 br0); clear ih_lr0 ih_rr0.
intros k d r lookup_r avl_r below_avl_r lin_r equiv_del_r bal_or_shift.
elim (balance_shrunk_left k0 d0 l0 r b0).
intros t avl_t lin_t equiv_t shrunk_dec.
apply Del_Max_Spec_Intro with k d t.
apply Lookup_Right; assumption.
assumption.
apply below_below_avl.
apply below_equiv_below with (Avl_Node k0 d0 l0 r b0).
cut (Less k0 k).
intro less_k0.
apply Below_Node.
assumption.
apply below_trans with k0.
inversion_clear avl_t0.
apply is_below_avl_is_below; assumption.
assumption.
apply is_below_avl_is_below; assumption.
apply lookup_above_greater with (Avl_Node kr0 dr0 lr0 rr0 br0) d.
assumption.
inversion_clear avl_t0.
apply is_above_avl_is_above; assumption.
assumption.
rewrite lin_t.
simpl in |- *.
rewrite (app_ass (lin_avl l0) ((k0, d0) :: lin_avl r) ((k, d) :: nil)).
simpl in |- *.
rewrite <- lin_r.
trivial.
apply equiv_del_equiv_equiv_del with (Avl_Node k0 d0 l0 r b0).
apply equiv_del_right.
assumption.
apply lookup_above_greater with (Avl_Node kr0 dr0 lr0 rr0 br0) d.
assumption.
inversion_clear avl_t0.
apply is_above_avl_is_above; assumption.
assumption.
apply equiv_sym; assumption.
clear equiv_t avl_t lin_r equiv_del_r below_avl_r lookup_r bal_or_shift.
elim shrunk_dec; clear shrunk_dec.
intros has_notshrunk.
left.
inversion_clear avl_t0.
generalize H1; clear H H0 H1 H2 H3.
inversion_clear has_notshrunk.
rewrite H0; clear H0.
inversion_clear H; simpl in |- *.
trivial.
trivial.
rewrite <- H0; clear H0.
intros Balanced_l; inversion_clear Balanced_l.
rewrite H.
simpl in |- *; trivial.
rewrite H0; simpl in |- *; trivial.
rewrite H0; simpl in |- *; trivial.
intro has_shrunk.
right.
inversion_clear avl_t0.
generalize H1; clear H1 H H0 H2 H3.
inversion_clear has_shrunk; simpl in |- *.
rewrite H0; clear H0.
trivial.
rewrite H0; clear H0.
intros Balanced_l; inversion_clear Balanced_l.
rewrite H0.
simpl in |- *; trivial.
(* side premisses (Elim (balance ...)) *)
inversion_clear avl_t0; assumption.
inversion_clear avl_t0; assumption.
assumption.
apply above_above_avl.
apply above_equiv_del_above with (Avl_Node kr0 dr0 lr0 rr0 br0) k.
inversion_clear avl_t0.
apply is_above_avl_is_above; assumption.
assumption.
elim bal_or_shift; clear bal_or_shift; intros height_r.
left.
apply
hasnot_grown_right__preserves_is_balanced_avl
with (Avl_Node kr0 dr0 lr0 rr0 br0).
inversion_clear avl_t0; assumption.
symmetry  in |- *; assumption.
right.
apply Balanced_shrunk_left_balanced_shift with (Avl_Node kr0 dr0 lr0 rr0 br0).
inversion_clear avl_t0; assumption.
assumption.
(* Side premiss of (Elim ih_rr0) *)
inversion_clear avl_t0; assumption.
Qed.
(**********************************************************************)
Inductive hasnot_shrunk_right (t : avl_tree) (k : Int)
(d : B) (l r : avl_tree) : bal -> Prop :=
| Hasnot_Shrunk_Right_Bal :
forall b : bal,
is_balanced_avl l r b ->
height_avl t = height_avl (Avl_Node k d l r b) ->
hasnot_shrunk_right t k d l r b
| Hasnot_Shrunk_Right_Shift_Balanced :
is_balanced_avl_right_shift l r Balanced ->
height_avl t = S (height_avl r) ->
hasnot_shrunk_right t k d l r Balanced
| Hasnot_Shrunk_Right_Shift_Right :
is_balanced_avl_right_shift l r Right_Balanced ->
height_avl t = S (height_avl r) ->
hasnot_shrunk_right t k d l r Right_Balanced.
Inductive has_shrunk_right (t : avl_tree) (k : Int)
(d : B) (l r : avl_tree) : bal -> Prop :=
| Has_Shrunk_Right_Shift_Left :
is_balanced_avl_right_shift l r Left_Balanced ->
height_avl t = S (height_avl r) ->
has_shrunk_right t k d l r Left_Balanced
| Has_Shrunk_Right_Shift_Right :
is_balanced_avl_right_shift l r Right_Balanced ->
height_avl t = height_avl r ->
has_shrunk_right t k d l r Right_Balanced.
Inductive bal_shrunk_right_spec (k : Int) (d : B) (l r : avl_tree)
(b : bal) : Set :=
Balance_Shrunk_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_shrunk_right t k d l r b} + {has_shrunk_right t k d l r b} ->
bal_shrunk_right_spec k d l r b.

Lemma balance_shrunk_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_shrunk_right_spec k d l r b.