simpl in |- *.
unfold subtype_image_equal in |- *; simpl in |- *.
intros.
apply Trans with (subtype_elt (map_between_equal_subsets H x));
auto with algebra.
apply Trans with (subtype_elt (map_between_equal_subsets H' x'));
auto with algebra.
Qed.
(** - This one turns $f:A\to X$ into $A\to Y$ whenever $X='Y$ *)
(** %\label{Maptoequalsubsets}% *)
Definition Map_to_equal_subsets :
forall (A B : Setoid) (X Y : part_set A), X =' Y in _ -> MAP B X -> MAP B Y.
intros.
apply (Build_Map (Ap:=fun b : B => map_between_equal_subsets H (X0 b))).
red in |- *; simpl in |- *; red in |- *.
intros.
unfold map_between_equal_subsets in |- *.
generalize (Map_compatible_prf X0 H0).
case (X0 x); case (X0 y).
simpl in |- *.
auto.
Defined.

(* Specifications: *)
Lemma subtype_elt_eats_Map_to_equal_subsets :
forall (A B : Setoid) (X Y : part_set A) (H : X =' Y in _)
(b : B) (M : Map B X),
subtype_elt (Map_to_equal_subsets H M b) =' subtype_elt (M b) in _.