Section Inclusion.
Variable E : Setoid.
Comments "The relation of belonging is compatible with equality:".
intros A; try assumption.
exact (Pred_compatible_prf (E:=E) (p:=A)).
Qed.
simpl in |- *; unfold eq_part in |- *.
intros x A B H' H'0; try assumption.
elim (H'0 x).
intuition.
Qed.
unfold not in |- *; auto with algebra.
Qed.
Hint Resolve empty_prop: algebra.
unfold full in |- *; simpl in |- *; auto with algebra.
Qed.
Hint Resolve full_prop: algebra.
Definition full_to_set : MAP (full E) E.
apply (Build_Map (Ap:=fun x : full E => full E x)).
red in |- *.
intros x y; try assumption.
elim x.
elim y.
simpl in |- *.
unfold subtype_image_equal in |- *.
simpl in |- *; auto with algebra.
Defined.
Definition set_to_full : MAP E (full E).
apply
(Build_Map (A:=E) (B:=full E)
(Ap:=fun x : E =>
Build_subtype (E:=E) (P:=full E) (subtype_elt:=x) (full_prop x))).
red in |- *.
simpl in |- *; auto with algebra.
Defined.
simpl in |- *; auto with algebra.
red in |- *.
simpl in |- *; auto with algebra.
Qed.
simpl in |- *; auto with algebra.
red in |- *.
simpl in |- *; auto with algebra.
intros x; try assumption.
elim x.
simpl in |- *; auto with algebra.
intros subtype_elt' subtype_prf'; red in |- *.
simpl in |- *; auto with algebra.
Qed.
Comments "The inclusion of parts:".
Definition included (A B : part_set E) : Prop :=
forall x : E, in_part x A -> in_part x B.
Comments "The relation of inclusion is an order relation:".
simpl in |- *; unfold included in |- *; auto with algebra.
Qed.
Hint Resolve included_refl: algebra.
simpl in |- *; unfold eq_part, included in |- *; auto with algebra.
Qed.
simpl in |- *; unfold included in |- *; auto with algebra.
Qed.
Comments "The inclusion relation is compatible with equality:".
simpl in |- *; unfold eq_part, included in |- *.
intros A A' B B' H' H'0 H'1 x H'2; try assumption.
elim (H'0 x); intros H'4 H'5; apply H'4.
lapply (H'1 x); [ intros H'6; apply H'6 | idtac ].
elim (H' x); intros H'6 H'7; apply H'7; auto with algebra.
Qed.
simpl in |- *; unfold eq_part, included in |- *.
intros A B H' x H'0; try assumption.
specialize  H' with (x := x); rename H' into H'1; try exact H'1.
elim H'1; intros H'2 H'3; try exact H'2; clear H'1; auto with algebra.
Qed.
Hint Resolve eq_part_included: algebra.
simpl in |- *; unfold included in |- *; auto with algebra.
intros A x H'; try assumption.
absurd (in_part x (empty E)); auto with algebra.
Qed.
simpl in |- *; unfold included in |- *; auto with algebra.
Qed.
Hint Resolve empty_included full_included: algebra.
Definition inj_part : forall A : part_set E, MAP A E.
intros A; try assumption.
apply (Build_Map (Ap:=fun x : A => subtype_elt x)).
red in |- *.
auto with algebra.
Defined.
intros A; try assumption.
red in |- *.
auto with algebra.
Qed.
Definition inj_part_included :
forall A B : part_set E, included A B -> MAP A B.
intros A B H'; try assumption.
red in H'.
apply
(Build_Map (A:=A) (B:=B)
(Ap:=fun x : A => Build_subtype (H' (A x) (subtype_prf (E:=E) (P:=A) x)))).
red in |- *.
simpl in |- *; auto with algebra.
Defined.
simpl in |- *; auto with algebra.
Qed.
intros A B p; red in |- *.
intros x y; try assumption.
elim x.
elim y.
simpl in |- *; auto with algebra.
Qed.
Definition id_map_parts_equal : forall A B : part_set E, Equal A B -> MAP A B.
intros A B H'; try assumption.
exact (inj_part_included (eq_part_included H')).
Defined.

Lemma id_map_parts_equal_prop :
forall (A B : part_set E) (p : Equal A B) (x : A),
Equal (subtype_elt (id_map_parts_equal p x)) (subtype_elt x).