intros.
red in |- *.
generalize dependent B.
induction n.
intros.
exists m.
split; auto with arith.
apply has_n_elements_comp with m C; auto with algebra.
apply Trans with (union (empty A) C); auto with algebra.
apply union_comp; auto with algebra.
apply Sym; auto with algebra.
intros.
red in H.
inversion_clear H.
rename x into Bs.
inversion_clear H1.
red in H2.
assert (has_n_elements n (seq_set (Map_embed (Seqtl Bs)))).
red in |- *.
exists (seq_set_seq (Map_embed (Seqtl Bs))).
split.
change
(eq_part (full (seq_set (Map_embed (Seqtl Bs))))
(seq_set (seq_set_seq (Map_embed (Seqtl Bs)))))
in |- *.
red in |- *.
intro.
simpl in |- *.
split; auto.
intros _.
unfold subtype_image_equal in |- *.
destruct x.
simpl in subtype_prf.
inversion_clear subtype_prf.
exists x.
simpl in |- *.
auto.
red in |- *; red in |- *; intros.
simpl in H3.
red in H3.
destruct i; destruct j.
apply
(H2 (Build_finiteT (lt_n_S _ _ in_range_prf))
(Build_finiteT (lt_n_S _ _ in_range_prf0))); auto with algebra.
simpl in |- *.
simpl in H1.
auto with arith.
generalize (IHn (seq_set (Map_embed (Seqtl Bs))) H1); intro p.
inversion_clear p.
rename x into m'.
inversion_clear H3.
case (classic (in_part (B (head Bs)) C)).
intro.
exists m'.
split.
simpl in |- *; auto with algebra.
apply has_n_elements_comp with m' (union (seq_set (Map_embed (Seqtl Bs))) C);
auto with algebra.
apply Trans with (union (inject_subsets (seq_set Bs)) C); auto with algebra.
2: apply union_comp; auto with algebra.
2: apply Trans with (inject_subsets (full B)); auto with algebra.
apply
Trans
with
(union (union (single (B (head Bs))) (seq_set (Map_embed (Seqtl Bs)))) C).
change
(eq_part (union (seq_set (Map_embed (Seqtl Bs))) C)
(union (union (single (B (head Bs))) (seq_set (Map_embed (Seqtl Bs)))) C))
in |- *.
red in |- *.
intro a; split; intro.
simpl in H6.
inversion_clear H6.
simpl in |- *.
left.
right.
auto.
simpl in |- *.
right.
auto.
simpl in H6.
inversion_clear H6.
inversion_clear H7.
simpl in |- *.
right.
apply in_part_comp_l with (B (head Bs)); auto with algebra.
simpl in |- *.
left; auto.
simpl in |- *.
right; auto.
simpl in |- *; red in |- *; simpl in |- *.
intro a; split; intros.
inversion_clear H6.
inversion_clear H7.
right.
apply in_part_comp_l with (B (head Bs)); auto with algebra.
left.
inversion_clear H6.
destruct x.
assert (in_part (Bs (Build_finiteT (lt_n_S _ _ in_range_prf))) (seq_set Bs)).
simpl in |- *.
exists (Build_finiteT (lt_n_S index n in_range_prf)).
red in |- *; apply Refl.
red in H6; exists (Build_subtype H6).
simpl in |- *.
auto.
right; auto.
inversion_clear H6.
2: right; auto.
left.
inversion_clear H7.
destruct x.
rename subtype_elt into a'.
rename subtype_prf into Ha'.
simpl in Ha'.
inversion_clear Ha'.
red in H7.
destruct x.
destruct index as [| n0].
left.
simpl in H6.
apply Trans with (B a'); auto with algebra.
apply Trans with (subtype_elt (Bs (Build_finiteT in_range_prf)));
auto with algebra.
right.
exists (Build_finiteT (lt_S_n _ _ in_range_prf)).
simpl in H6.
apply Trans with (subtype_elt a'); auto with algebra.
apply Trans with (subtype_elt (Bs (Build_finiteT in_range_prf)));
auto with algebra.
intro.
exists (S m').
split.
simpl in |- *.
auto with arith.
inversion_clear H5.
rename x into BCs.
inversion_clear H6.
assert (forall i, in_part (Map_embed BCs i) (union B C)).
intro.
simpl in |- *.
set (bc := BCs i) in *.
change (in_part (subtype_elt bc) B \/ in_part (subtype_elt bc) C) in |- *.
case bc.
intros a Ha.
simpl in Ha.
inversion_clear Ha.
2: simpl in |- *; right; auto.
left.
inversion_clear H6.
destruct x.
apply
in_part_comp_l
with (subtype_elt (Bs (Build_finiteT (lt_n_S index n in_range_prf))));
auto with algebra.
set (BCs' := cast_map_to_subset H6:seq _ _) in *.
set (b0 := B (head Bs)) in *.
assert (in_part b0 (union B C)).
simpl in |- *.
left.
unfold b0 in |- *.
simpl in |- *.
auto with algebra.
red in H8.
red in |- *.
set (bc0 := Build_subtype H8:union B C) in *.
exists (bc0;; BCs').
split.
simpl in |- *; red in |- *; simpl in |- *.
intro bc; (split; auto); intros _.
unfold subtype_image_equal in |- *.
case (classic (bc =' bc0 in union B C)).
intro.
exists (Build_finiteT (lt_O_Sn m')).
auto with algebra.
intro.
cut (exists i : _, subtype_elt bc =' subtype_elt (BCs i) in A).
intro.
inversion_clear H10.
destruct x.
exists (Build_finiteT (lt_n_S _ _ in_range_prf)).
apply Trans with (subtype_elt (BCs (Build_finiteT in_range_prf)));
auto with algebra.
simpl in |- *.
apply subtype_elt_comp; auto with algebra.
cut (union B C =' seq_set (subtype_elt bc0;; Map_embed BCs) in _).
intro.
simpl in H10.
red in H10.
elim (H10 (subtype_elt bc)).
intros.
clear H10 H12.
assert (in_part (subtype_elt bc) (union B C)); auto with algebra.
generalize (H11 H10); clear H10 H11; intro p.
assert (in_part (subtype_elt bc) (seq_set (Map_embed BCs))).
simpl in p.
inversion_clear p.
destruct x.
destruct index as [| n0].
apply False_ind; auto with algebra.
apply
in_part_comp_l
with (subtype_elt (BCs (Build_finiteT (lt_S_n n0 m' in_range_prf))));
auto with algebra.
simpl in |- *.
exists (Build_finiteT (lt_S_n n0 m' in_range_prf)).
apply Refl.
simpl in H10.
auto.
clear H9 bc BCs' H7 H4 H1 H2 IHn H0 m.
simpl in |- *; red in |- *; simpl in |- *.
intro a; split; intro.
inversion_clear H0.
case (classic (a =' b0 in _)).
intro; exists (Build_finiteT (lt_O_Sn m')); auto.
intro.
cut (in_part a (union (seq_set (Map_embed (Seqtl Bs))) C)).
intro p.
red in p.
assert
(in_part (Build_subtype p:union (seq_set (Map_embed (Seqtl Bs))) C)
(seq_set BCs)).
apply in_part_comp_r with (full (union (seq_set (Map_embed (Seqtl Bs))) C));
auto with algebra.
simpl in H2.
inversion_clear H2.
destruct x.
exists (Build_finiteT (lt_n_S _ _ in_range_prf)).
red in H4; simpl in H4.
apply Trans with (subtype_elt (BCs (Build_finiteT in_range_prf)));
auto with algebra.
simpl in |- *.
left.
red in H1.
set (a' := Build_subtype H1:B) in *.
elim (H a').
simpl in |- *; intros.
generalize (H2 I); clear H2 H4; intro.
inversion_clear H2.
destruct x.
destruct index as [| n0].
apply False_ind; auto with algebra.
apply H0.
red in H4.
apply Trans with (subtype_elt a'); auto with algebra.
apply Trans with (subtype_elt (Bs (Build_finiteT in_range_prf)));
auto with algebra.
unfold b0 in |- *.
simpl in |- *.
apply subtype_elt_comp; auto with algebra.
unfold head in |- *.
exists (Build_finiteT (lt_S_n _ _ in_range_prf)).
red in H4.
apply Trans with (subtype_elt a'); auto with algebra.
apply Trans with (subtype_elt (Bs (Build_finiteT in_range_prf)));
auto with algebra.
assert (in_part a (union (seq_set (Map_embed (Seqtl Bs))) C)).
simpl in |- *; right; auto.
red in H0.
elim (H5 (Build_subtype H0)).
simpl in |- *; intros.
generalize (H2 I); clear H4 H2; intro.
inversion_clear H2.
destruct x.
exists (Build_finiteT (lt_n_S _ _ in_range_prf)).
red in H4; simpl in H4.
apply Trans with (subtype_elt (BCs (Build_finiteT in_range_prf)));
auto with algebra.
inversion_clear H0.
destruct x.
destruct index as [| n0].
left.
apply in_part_comp_l with b0; auto with algebra.
unfold b0 in |- *.
simpl in |- *.
auto with algebra.
set (a'' := BCs (Build_finiteT (lt_S_n n0 m' in_range_prf))) in *.
cut (in_part (subtype_elt a'') B \/ in_part (subtype_elt a'') C).
intros.
inversion_clear H0.
left.
apply in_part_comp_l with (subtype_elt a''); auto with algebra.
right.
apply in_part_comp_l with (subtype_elt a''); auto with algebra.
case a''.
simpl in |- *.
intros.
inversion_clear subtype_prf.
left.
inversion_clear H0.
destruct x.
rename subtype_elt into a'.
apply
in_part_comp_l
with (subtype_elt (Bs (Build_finiteT (lt_n_S index n in_range_prf0))));
auto with algebra.
right; auto.
apply distinct_cons; auto with algebra.
intro.
unfold bc0, BCs' in |- *.
simpl in |- *.
unfold subtype_image_equal in |- *.
simpl in |- *.
unfold b0 in |- *.
simpl in |- *.
set (b := BCs i) in *.
change (~ subtype_elt (head Bs) =' subtype_elt b in _) in |- *.
case b.
intros a Ha; simpl in |- *.
simpl in Ha.
inversion_clear Ha.
inversion_clear H9.
destruct x.
intro; red in H2;
(apply
(H2 (Build_finiteT (lt_O_Sn n)) (Build_finiteT (lt_n_S _ _ in_range_prf)));
auto with algebra).
simpl in |- *.
auto with arith.
simpl in |- *.
red in |- *.
apply Trans with (subtype_elt (head Bs)); auto with algebra.
apply Trans with a; auto with algebra.
intro; apply H3.
unfold b0 in |- *.
apply in_part_comp_l with a; auto with algebra.
Qed.

(* Specifications: *)
Lemma subset_also_has_n_elements_then_it_is_full :
forall (n : Nat) (A : Setoid) (B : part_set A),
has_n_elements n A -> has_n_elements n B -> B =' full A in _.