Proof using.
intros n a ln1 ln2 t l H;
case
height_pred_disj_larger2_aux
with (a := a) (ln1 := ln1) (ln2 := ln2) (1 := H);
auto.
intros [H1| (H1, H2)]; auto.
generalize H1 H2; case ln1; simpl in |- *;
[ intros H3; injection H3; auto with datatypes | idtac ].
intros H0 H4 H5; repeat right; auto.
intros n0 l0; case l0; simpl in |- *; intros; discriminate.
Qed.
Let height_pred_shrink_aux :
forall (n : nat) (ln : list nat) (t : btree A) (l : list (btree A)),
height_pred n ln l t ->
forall l1 l2 ln1 ln2 a b t1 t2,
ln = ln1 ++ a :: b :: ln2 ->
(forall n1 : nat, In n1 ln1 -> n1 < a) ->
(forall n1 : nat, In n1 (b :: ln2) -> n1 <= a) ->
length ln1 = length l1 ->
l = l1 ++ t1 :: t2 :: l2 ->
height_pred n (ln1 ++ pred a :: ln2) (l1 ++ node t1 t2 :: l2) t.
Proof using.
intros n ln t l H; elim H; clear n ln t l H; auto.
intros n t l1 l2 ln1 ln2 a b t1 t2; case ln1;
try (simpl in |- *; intros; discriminate).
intros n0 l0; case l0; try (simpl in |- *; intros; discriminate).
intros n ln1 ln2 t1 t2 l1 l2 H H0 H1 H2 l0 l3 ln0 ln3 a b t0 t3 H3 H4 H5 H6
H7.
cut (length ln1 = length l1);
[ intros Eq2 | apply height_pred_length with (1 := H) ].
cut (length ln2 = length l2);
[ intros Eq3 | apply height_pred_length with (1 := H1) ].
cut (length ln3 = length l3);
[ intros Eq4
| apply plus_reg_l with (length (ln0 ++ a :: b :: nil));
rewrite <- length_app; rewrite app_ass; simpl in |- *;
rewrite <- H3; repeat rewrite length_app; simpl in |- *;
rewrite Eq2; rewrite Eq3; rewrite <- length_app;
rewrite H7; repeat rewrite length_app; simpl in |- *;
repeat rewrite (fun x y => plus_comm x (S y));
simpl in |- *; rewrite plus_comm; auto ].
case app_inv_app2 with (1 := H3); auto.
intros (ln4, Hp1).
cut (ln3 = ln4 ++ ln2);
[ intros E1
| apply app_inv_head with (l1 := ln0 ++ a :: b :: nil);
repeat rewrite app_ass; simpl in |- *; rewrite <- H3;
rewrite Hp1; repeat rewrite app_ass; auto ].
replace (ln0 ++ pred a :: ln3) with ((ln0 ++ pred a :: ln4) ++ ln2);
[ idtac | rewrite app_ass; rewrite E1; auto ].
cut (l3 = first_n l3 (length ln4) ++ l2).
intros HH;
replace (l0 ++ node t0 t3 :: l3) with
((l0 ++ node t0 t3 :: first_n l3 (length ln4)) ++ l2);
[ idtac | pattern l3 at 2 in |- *; rewrite HH; rewrite app_ass; auto ].
apply height_pred_node; auto.
apply H0 with (1 := Hp1); auto.
intros n1 HH1; (apply H5; auto).
simpl in HH1; case HH1; intros H9; try rewrite H9; auto with datatypes.
rewrite E1; auto with datatypes.
apply app_inv_tail with (l1 := l2).
repeat rewrite app_ass; apply trans_equal with (1 := H7); auto.
pattern l3 at 1 in |- *; rewrite HH; auto.
apply sym_equal;
apply trans_equal with (2 := first_n_skip_n_app _ (length ln4) l3).
apply f_equal2 with (f := app (A:=btree A)); auto.
apply trans_equal with (skip_n l2 (length l1 - length l1)).
rewrite <- minus_n_n; simpl in |- *; auto.
rewrite <- skip_n_app1; auto.
rewrite H7.
rewrite <- Eq2; rewrite Hp1.
rewrite skip_n_app1.
rewrite length_app.
rewrite H6; rewrite minus_plus; simpl in |- *; auto.
rewrite <- H6; rewrite length_app; simpl in |- *; auto with arith.
intros [(ln4, HH)| (HH1, HH2)].
cut (ln0 = ln1 ++ ln4);
[ intros E1
| apply app_inv_tail with (l1 := a :: b :: ln3); rewrite <- H3; rewrite HH;
rewrite app_ass; auto ].
cut (l0 = l1 ++ skip_n l0 (length l1)).
intros Eq1; rewrite Eq1; rewrite E1; repeat rewrite app_ass.
apply height_pred_node; auto.
apply H2 with (b := b); auto.
intros n1 H8; apply H4; (rewrite E1; auto with datatypes).
rewrite skip_n_length; rewrite <- Eq2; rewrite <- H6;
rewrite <- skip_n_length; rewrite E1; rewrite skip_n_app2;
auto; rewrite skip_n_id; simpl in |- *; auto.
apply app_inv_head with (l1 := l1).
rewrite <- app_ass; rewrite <- Eq1; auto.
apply sym_equal;
apply trans_equal with (2 := first_n_skip_n_app _ (length l1) l0).
apply f_equal2 with (f := app (A:=btree A)); auto.
apply trans_equal with (first_n (l1 ++ l2) (length l1)).
rewrite first_n_app1; auto; rewrite <- minus_n_n; simpl in |- *;
auto with datatypes.
rewrite H7; rewrite first_n_app2; auto.
rewrite <- H6; rewrite <- Eq2; rewrite E1; rewrite length_app;
auto with arith.
rewrite HH1 in H; case height_pred_disj_larger2 with (1 := H); simpl in |- *;
auto.
intros (n1, (HH3, HH4)); Contradict HH4; auto with arith.
intros [(n1, (HH3, HH4))| ((HH3, (HH4, HH5)), HH6)]; [ case HH3 | idtac ].
case height_pred_larger_strict with (1 := H1) (n1 := b); auto.
rewrite HH2; auto with datatypes.
rewrite <- HH4; intros HH7; Contradict HH7; apply le_not_lt;
auto with arith datatypes.
intros (H8, H9); rewrite HH4; rewrite HH3; simpl in |- *.
cut (l0 = nil); [ intros HM1; rewrite HM1 | idtac ].
cut (ln3 = nil); [ intros HM2; rewrite HM2 | idtac ].
replace l3 with (nil (A:=btree A)); simpl in |- *; auto.
rewrite HH6 in H7; rewrite H9 in H7; rewrite HM1 in H7; simpl in H7;
injection H7.
intros Ht1 Ht2 Ht3; rewrite Ht2; rewrite Ht3; auto.
generalize Eq4; rewrite HM2; case l3; simpl in |- *; auto; intros;
discriminate.
rewrite HH2 in H8; injection H8; auto.
generalize H6; rewrite HH3; case l0; simpl in |- *; auto; intros;
discriminate.
Qed.

(* Specifications: *)
(* A cover can be shrunk at the first maximum of the height while preserving the height list *)
Theorem height_pred_shrink :
forall (n a b : nat) (ln1 ln2 : list nat) (t t1 t2 : btree A)
(l1 l2 : list (btree A)),
height_pred n (ln1 ++ a :: b :: ln2) (l1 ++ t1 :: t2 :: l2) t ->
(forall n1 : nat, In n1 ln1 -> n1 < a) ->
(forall n1 : nat, In n1 (b :: ln2) -> n1 <= a) ->
length ln1 = length l1 ->
height_pred n (ln1 ++ pred a :: ln2) (l1 ++ node t1 t2 :: l2) t.