(** The complement of a relation conserves its proper elements. *)
Program Definition complement_proper
`(mR : Proper (A -> A -> Prop) (RA ==> RA ==> iff) R) :
Proper (RA ==> RA ==> iff) (complement R) := _.
Next Obligation.
(** The [flip] too, actually the [flip] instance is a bit more general. *)
Program Definition flip_proper
`(mor : Proper (A -> B -> C) (RA ==> RB ==> RC) f) :
Proper (RB ==> RA ==> RC) (flip f) := _.
Next Obligation.
(** Every Transitive relation gives rise to a binary morphism on [impl], contravariant in the first argument, covariant in the second. *)
Global Program
Instance trans_contra_co_morphism
`(Transitive A R) : Proper (R --> R ++> impl) R.
Next Obligation.
Proof with auto.
intros R H x y H0 x0 y0 H1 H2.
transitivity x...
transitivity x0...
Qed.
(** Proper declarations for partial applications. *)
Global Program
Instance trans_contra_inv_impl_morphism
`(Transitive A R) {x} : Proper (R --> flip impl) (R x) | 3.
Next Obligation.
Proof with auto.
intros R H x x0 y H0 H1.
transitivity y...
Qed.
Global Program
Instance trans_co_impl_morphism
`(Transitive A R) {x} : Proper (R ++> impl) (R x) | 3.
Next Obligation.
Proof with auto.
intros R H x x0 y H0 H1.
transitivity x0...
Qed.
Global Program
Instance trans_sym_co_inv_impl_morphism
`(PER A R) {x} : Proper (R ++> flip impl) (R x) | 3.
Next Obligation.
Proof with auto.
intros R H x x0 y H0 H1.
transitivity y... symmetry...
Qed.
Global Program Instance trans_sym_contra_impl_morphism
`(PER A R) {x} : Proper (R --> impl) (R x) | 3.
Next Obligation.
Proof with auto.
intros R H x x0 y H0 H1.
transitivity x0... symmetry...
Qed.
Global Program Instance per_partial_app_morphism
`(PER A R) {x} : Proper (R ==> iff) (R x) | 2.
Next Obligation.
Proof with auto.
intros R H x x0 y H0.
split.
- intros ; transitivity x0...
- intros.
transitivity y...
symmetry...
Qed.
(** Every Transitive relation induces a morphism by "pushing" an [R x y] on the left of an [R x z] proof to get an [R y z] goal. *)
Global Program
Instance trans_co_eq_inv_impl_morphism
`(Transitive A R) : Proper (R ==> (@eq A) ==> flip impl) R | 2.
Next Obligation.
Proof with auto.
intros R H x y H0 y0 y1 e H2; destruct e.
transitivity y...
Qed.
(** Every Symmetric and Transitive relation gives rise to an equivariant morphism. *)
Global Program
Instance PER_morphism `(PER A R) : Proper (R ==> R ==> iff) R | 1.
Next Obligation.
Proof with auto.
intros R H x y H0 x0 y0 H1.
split ; intros.
- transitivity x0... transitivity x... symmetry...
- transitivity y... transitivity y0... symmetry...
Qed.

(* Specifications: *)
Lemma symmetric_equiv_flip `(Symmetric A R) : relation_equivalence R (flip R).
Global Instance reflexive_eq_dom_reflexive `{Reflexive B R'}:
Reflexive (respectful (@Logic.eq A) R').