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.

(* Specifications: *)
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).