split; [ try assumption | idtac ].
red in |- *.
unfold subtype_image_equal in |- *; unfold app_rel in |- *; simpl in |- *;
auto with algebra.
red in |- *.
split; [ try assumption | idtac ].
red in |- *.
unfold subtype_image_equal in |- *; unfold app_rel in |- *; simpl in |- *;
auto with algebra.
intros x y z H' H'0; try assumption.
apply Trans with (i y); auto with algebra.
red in |- *.
unfold subtype_image_equal in |- *; unfold app_rel in |- *; simpl in |- *;
auto with algebra.
Qed.
Definition subtype_image_set : Setoid := Build_Setoid subtype_image_equiv.
End Subtype.
Section Part_type.
Comments "We define now a general structure for this kind of subset:".
Variable E : Setoid.
Record subtype_image : Type :=
{subtype_image_carrier : Type;
subtype_image_inj :> subtype_image_carrier -> E}.
Definition set_of_subtype_image (S : subtype_image) :=
subtype_image_set (subtype_image_inj (s:=S)).
Comments "Parts of" E "will be nothing more than predicates on" E
" which are compatible with equality:".
Definition pred_compatible (P : E -> Prop) : Prop :=
forall x y : E, P x -> Equal y x -> (P y:Prop).
Record Predicate : Type :=
{Pred_fun : E -> Prop; Pred_compatible_prf : pred_compatible Pred_fun:Prop}.
Variable P : Predicate.
Comments "The type of elements of the subset defined by" P
"is the following:".
Record subtype : Type :=
{subtype_elt : E; subtype_prf : Pred_fun P subtype_elt:Prop}.
Comments "Then elements of subsets are composed of an element of" E
"and a proof that they verify the predicate" "given by" P.
Comments "We can now define the subset of" E "defined by the predicate" P ":".
Definition part :=
Build_subtype_image (subtype_image_carrier:=subtype) subtype_elt.
End Part_type.
Comments "We can see a subset as a set with these coercions:".
Coercion set_of_subtype_image : subtype_image >-> Setoid.
Coercion part : Predicate >-> subtype_image.
Comments "We define" (in_part x A) "for elements of" E ":".
Definition in_part (E : Setoid) (x : E) (A : Predicate E) := Pred_fun A x.
Section Part_set.
Variable E : Setoid.
Comments "The equality between parts of" E ":".
Definition eq_part (A B : Predicate E) : Prop :=
forall x : E, (in_part x A -> in_part x B) /\ (in_part x B -> in_part x A).
Let eq_part_equiv : equivalence eq_part.
red in |- *.
split; [ try assumption | idtac ].
red in |- *.
unfold eq_part, app_rel in |- *; simpl in |- *.
intuition.
red in |- *.
split; [ try assumption | idtac ].
red in |- *.
unfold eq_part, app_rel in |- *; simpl in |- *.
intros x y z H' H'0 x0; try assumption.
elim (H'0 x0); intros H'2 H'3; try exact H'2.
elim (H' x0); intros H'1 H'4; try exact H'1.
intuition.
red in |- *.
unfold eq_part, app_rel in |- *; simpl in |- *.
intros x y H' x0; try assumption.
elim (H' x0); intros H'2 H'3; try exact H'2.
intuition.
Qed.
Comments "We define the set" (part_set E) "of all parts of" E
", with its equality:".
Definition part_set : Setoid := Build_Setoid eq_part_equiv.
Comments "The empty part" (empty E) ":".
Hint Unfold pred_compatible: algebra.
Definition empty : part_set.
apply (Build_Predicate (E:=E) (Pred_fun:=fun x : E => False)).
auto with algebra.
Defined.
Comments "And the full part:".
Definition full : part_set.
apply (Build_Predicate (E:=E) (Pred_fun:=fun x : E => True)).
auto with algebra.
Defined.
End Part_set.
Hint Unfold pred_compatible: algebra.
Section Inclusion.
Variable E : Setoid.
Comments "The relation of belonging is compatible with equality:".

(* Specifications: *)
Lemma in_part_comp_l :
forall (A : part_set E) (x y : E), in_part x A -> Equal y x -> in_part y A.