intros.
red in H, H0.
inversion_clear H; inversion_clear H0.
inversion_clear H.
rename x0 into m.
red in |- *; red in H2.
inversion_clear H2.
inversion_clear H.
rename x into aas.
rename x0 into Aseq.
exists aas.
split; auto.
apply Trans with (seq_set Aseq); auto with algebra.
simpl in |- *; red in |- *; simpl in |- *.
intro a; split; simpl in |- *.
2: simpl in H2; red in H2; simpl in H2.
2: elim (H2 a); auto.
intro.
inversion_clear H.
rename x into i.
cut (exists j : fin n, aas j =' Aseq i in _).
intros.
inversion_clear H.
exists x.
apply Trans with (Aseq i); auto with algebra.
clear H4 a.
generalize (exists_difference H0).
intro; inversion_clear H.
rename x into d.
cut (exists j : fin (m + d), cast_seq aas H4 j =' Aseq i in _).
intro.
inversion_clear H.
rename x into j.
exists (cast_fin j (sym_eq H4)).
apply Trans with (cast_seq aas H4 j); auto with algebra.
set (aas' := cast_seq aas H4) in *.
assert (distinct aas').
unfold aas' in |- *.
apply cast_seq_preserves_distinct; auto with algebra.
assert (included (seq_set aas') (seq_set Aseq)).
simpl in H2; red in H2; simpl in H2.
red in |- *.
simpl in |- *; intros.
inversion_clear H5.
elim (H2 x); auto with algebra.
clearbody aas'.
clear H4 H2 H0 H1 aas n.
move d after m.
fold (distinct Aseq) in H3.
induction m.
apply False_ind; auto with algebra.
case (classic (head aas' =' Aseq i in _)).
intros.
exists (Build_finiteT (lt_O_Sn (m + d))).
apply Trans with (head aas'); auto with algebra.
intros.
elim (H5 (head aas')).
2: unfold head in |- *; simpl in |- *.
2: fold (m + d) in |- *.
2: exists (Build_finiteT (lt_O_Sn (m + d))).
2: apply Refl.
intros j Hj.
assert (distinct (omit Aseq j)).
apply omit_preserves_distinct; auto with algebra.
assert (~ j =' i in fin _).
assert (~ Aseq i =' Aseq j in _).
intro.
apply H0; auto with algebra.
apply Trans with (Aseq j); auto with algebra.
intro; apply H2.
apply (Map_compatible_prf Aseq); auto with algebra.
elim (omit_removes' Aseq H2).
intros i' HAseqi'.
assert (distinct (Seqtl aas')).
apply Seqtl_preserves_distinct; auto with algebra.
generalize (IHm (omit Aseq j) H1 i' (Seqtl aas') H4).
intros.
assert (included (seq_set (Seqtl aas')) (seq_set (omit Aseq j))).
2: specialize (H6 H7).
2: inversion_clear H6.
2: destruct x.
2: exists (Build_finiteT (lt_n_S _ _ in_range_prf)).
2: apply Trans with (Seqtl aas' (Build_finiteT in_range_prf));
auto with algebra.
2: apply Trans with (omit Aseq j i'); auto with algebra.
clear H6.
clear IHm HAseqi' i' H2 H0 i.
cut
(forall p : fin (m + d),
exists q : fin m, Seqtl aas' p =' omit Aseq j q in _).
intro.
red in |- *.
simpl in |- *.
intros a Ha.
inversion_clear Ha.
generalize (H0 x); intro p; inversion_clear p.
exists x0.
apply Trans with (Seqtl aas' x); auto with algebra.
intro.
simpl in |- *.
destruct p.
set (p' := Build_finiteT (lt_n_S index (m + d) in_range_prf)) in *.
assert (~ p' =' Build_finiteT (lt_O_Sn (m + d)) in fin _).
unfold p' in |- *; simpl in |- *.
auto with arith.
assert
(forall k : fin (S m + d), exists l : fin (S m), aas' k =' Aseq l in _).
red in H5.
simpl in H5.
intro.
generalize (H5 (aas' k)); intro.
assert (exists i : finiteT (S (m + d)), aas' k =' aas' i in _).
exists k.
apply Refl.
generalize (H2 H6).
intro.
inversion_clear H7.
exists x.
auto.
generalize (H2 p'); intro.
inversion_clear H6.
rename x into q.
cut (exists q0 : finiteT m, Aseq q =' omit Aseq j q0 in _).
intro.
inversion_clear H6.
exists x.
apply Trans with (Aseq q); auto with algebra.
cut (~ j =' q in _).
intro.
elim (omit_removes' Aseq H6).
intros; exists x; auto.
assert (~ aas' p' =' head aas' in _).
unfold head in |- *.
fold (m + d) in |- *.
apply H; auto with algebra.
assert (~ Aseq q =' head aas' in _).
intro; (apply H6; auto with algebra).
apply Trans with (Aseq q); auto with algebra.
assert (~ Aseq q =' Aseq j in _).
intro; (apply H8; auto with algebra).
apply Trans with (Aseq j); auto with algebra.
intro; (apply H9; auto with algebra).
Qed.

(* Specifications: *)
Lemma inclusion_bounds_elements_from_below :
forall (A : Setoid) (B C : part_set A) (n : Nat),
has_n_elements n B -> included B C -> has_at_least_n_elements n C.