(* $Id: CSetoids.v,v 1.90 2000/11/10 11:27:30 freek Exp $ *)

Require Export Basics.

(* Begin_SpecReals *)

(* Tex_Prose
\section{Setoids}
Definition of a constructive setoid,
i.e. a set with an equivalence relation and an apartness relation.
*)

Require Export Relations.

(* End_SpecReals *)


Syntactic Definition Reflexive  := (reflexive ?).

(* Begin_SpecReals *)

Syntactic Definition Symmetric  := (symmetric ?).
Syntactic Definition Transitive := (transitive ?).

Implicit Arguments On.

(* Tex_Prose
\subsection{Relations necessary for Setoids}
\begin{convention}
Let \verb!A : Set!.
\end{convention}
*)
Section Properties_of_relations.
Variable A: Set.

(* Begin_Tex_Verb *)
Definition irreflexive [R:(relation A)] : Prop :=
        (x:A)(not(R x x)).
(* End_Tex_Verb *)

(* Begin_Tex_Verb *)
Definition cotransitive [R:(relation A)] : Prop :=
        (x,y:A)(R x y) -> (z:A)(R x z) \/ (R z y).
(* End_Tex_Verb *)

(* Begin_Tex_Verb *)
Definition tight_apart [eq,R:(relation A)]: Prop :=
        (x,y:A)(not(R x y)) <-> (eq x y).
(* End_Tex_Verb *)

(* Begin_Tex_Verb *)
Definition antisymmetric [R:(relation A)] : Prop :=
        (x,y: A)(R x y) -> (not(R y x)).
(* End_Tex_Verb *)

End Properties_of_relations.
Implicit Arguments Off.

(* Tex_Prose
\subsection{Definition of Setoid}
*)
(* Begin_Tex_Verb *)
Record is_CSetoid [A:Set; eq,ap:(relation A)] : Prop :=
  { ax_ap_irreflexive  : (irreflexive ap);
    ax_ap_symmetric    : (Symmetric ap);
    ax_ap_cotransitive : (cotransitive ap);
    ax_ap_tight        : (tight_apart eq ap)
  }.
(* End_Tex_Verb *)

(* Begin_Tex_Verb *)
Record CSetoid : Type :=
  { cs_crr   :> Set;
    cs_eq    :  (relation cs_crr);
    cs_ap    :  (relation cs_crr);
    cs_proof :  (is_CSetoid cs_crr cs_eq cs_ap)
  }.
(* End_Tex_Verb *)

(* Tex_Prose
\begin{notation}
\begin{itemize}
\item \verb!cs_eq ? x y! is denoted by \verb!x [=] y!.
\item \verb!cs_ap ? x y! is denoted by \verb!x [#] y!.
\end{itemize}
\end{notation}
*)

Syntactic Definition Cs_eq := (cs_eq ?).

Infix NONA 8 "[=]" Cs_eq.
Syntax constr level 8:
  cs_eq_infix [<<(cs_eq $_ $e1 $e2)>>] ->
    [[<hov 1> $e1:L [0 1] " [=] " $e2:L]].

(* End_SpecReals *)

(* Begin_Tex_Verb *)
Definition cs_neq [S: CSetoid] : (relation S) := [x,y:S](not(x [=] y)).
(* End_Tex_Verb *)

(* Tex_Prose
\begin{notation}
\verb!cs_neq ? x y! is denoted by \verb!x [~=] y!.
\end{notation}
*)
Syntactic Definition Cs_neq := (cs_neq ?).
Infix NONA 8 "[~=]" Cs_neq.
Syntax constr level 8:
  s_neq_infix [<<(cs_neq $_ $e1 $e2)>>] ->
    [[<hov 1> $e1:L [0 1] " [~=] " $e2:L]].

(* Begin_SpecReals *)

Syntactic Definition Cs_ap := (cs_ap ?).
Infix NONA 8 "[#]" Cs_ap.
Syntax constr level 8:
  cs_ap_infix [<<(cs_ap $_ $e1 $e2)>>] ->
    [[<hov 1> $e1:L [0 1] " [#] " $e2:L]].

(* End_SpecReals *)

(* Tex_Prose
\begin{nameconvention}
In the names of lemmas, we refer to \verb! [=]! by \verb!eq!, \verb![~=]! by
\verb!neq!, and \verb![#]! by \verb!ap!.
\end{nameconvention}
*)

(* Tex_Prose
\subsection{Setoid axioms}
We want concrete lemmas that state the axiomatic properties of a setoid.
\begin{convention}
Let \verb!S! be a setoid.
\end{convention}
*)

(* Begin_SpecReals *)

Section CSetoid_axioms.
Variable S : CSetoid.

(* Begin_Tex_Verb *)
Lemma CSetoid_is_CSetoid : (is_CSetoid S (cs_eq S) (cs_ap S)).
(* End_Tex_Verb *)
Proof (cs_proof S).

(* Begin_Tex_Verb *)
Lemma ap_irreflexive : (irreflexive (cs_ap S)).
(* End_Tex_Verb *)
Elim CSetoid_is_CSetoid.
Intros.
Assumption.
Qed.

(* Begin_Tex_Verb *)
Lemma ap_symmetric : (Symmetric (cs_ap S)).
(* End_Tex_Verb *)
Elim CSetoid_is_CSetoid.
Intros.
Assumption.
Qed.

(* Begin_Tex_Verb *)
Lemma ap_cotransitive : (cotransitive (cs_ap S)).
(* End_Tex_Verb *)
Elim CSetoid_is_CSetoid.
Intros.
Assumption.
Qed.

(* Begin_Tex_Verb *)
Lemma ap_tight : (tight_apart (cs_eq S) (cs_ap S)).
(* End_Tex_Verb *)
Elim CSetoid_is_CSetoid.
Intros.
Assumption.
Qed.

End CSetoid_axioms.

(* End_SpecReals *)

(* Tex_Prose
\subsection{Setoid basics}\label{section:setoid-basics}
\begin{convention}
Let \verb!S! be a setoid.
\end{convention}
*)

(* Begin_SpecReals *)

Section CSetoid_basics.
Variable S : CSetoid.

(* End_SpecReals *)

(* Tex_Prose
In `there exists a {\em unique\/}
$a:S$ such that \ldots ', we now mean unique with respect to the
setoid equality. We use \verb!ex_unq! to denote unique existence
*)

(* Begin_Tex_Verb *)
Definition ex_unq := [P:S->Prop]
	(EX x:S | (P x) /\ (y:S)(P y)-> x[=]y).
(* End_Tex_Verb *)

(* Begin_Tex_Verb *)
Lemma eq_reflexive: (Reflexive (cs_eq S)).
(* End_Tex_Verb *)
Red; Intros.
Generalize (ap_tight S x x); Intros.
Generalize (ap_irreflexive S x); Intros.
Tauto. Qed.

(* Begin_Tex_Verb *)
Lemma eq_symmetric: (Symmetric (cs_eq S)).
(* End_Tex_Verb *)
Red; Intros.
Generalize (ap_tight S x y); Intros.
Generalize (ap_tight S y x); Intros.
Generalize (ap_symmetric S y x); Intros.
Tauto. Qed.

(* Begin_Tex_Verb *)
Lemma eq_transitive: (Transitive (cs_eq S)).
(* End_Tex_Verb *)
Red; Intros.
Generalize (ap_tight S x y); Intros.
Generalize (ap_tight S y z); Intros.
Generalize (ap_tight S x z); Intros.
Elim H3; Intros.
Apply H4.
Intro.
Generalize (ap_cotransitive ? ? ? H6 y); Intros.
Tauto. Qed.

(* Tex_Prose
\begin{shortcoming}
The lemma \verb!eq_reflexive! above is convertible to
\verb!eq_reflexive_unfolded! below. We need the second version too,
because the first cannot be applied when an instance of reflexivity is needed.
(``I have complained bitterly about this.'' RP)
\end{shortcoming}

\begin{nameconvention}
If lemma $a$ is just an unfolding of lemma $b$, the name of $a$ is the name
$b$ with the suffix ``\verb!_unfolded!''.
\end{nameconvention}
*)

(* Begin_Tex_Verb *)
Lemma eq_reflexive_unfolded : (x:S)(x [=] x).
(* End_Tex_Verb *)
Proof eq_reflexive.

(* Begin_Tex_Verb *)
Lemma eq_symmetric_unfolded : (x,y:S)(x [=] y)->(y [=] x).
(* End_Tex_Verb *)
Proof eq_symmetric.

(* Begin_Tex_Verb *)
Lemma eq_transitive_unfolded : (x,y,z:S)(x [=] y)->(y [=] z)->(x [=] z).
(* End_Tex_Verb *)
Proof eq_transitive.

(* Begin_SpecReals *)

(* Begin_Tex_Verb *)
Lemma ap_irreflexive_unfolded : (x:S)(~(x[#]x)).
(* End_Tex_Verb *)
Proof (ap_irreflexive S).

(* End_SpecReals *)

(* Begin_Tex_Verb *)
Lemma ap_cotransitive_unfolded : (x,y:S)((x[#]y)->
                                         (z:S)((x[#]z) \/ (z[#]y))).
(* End_Tex_Verb *)
Intros.
Elim (ap_cotransitive ? ? ? H z) ; Auto.
Qed.

(* Begin_Tex_Verb *)
Lemma ap_symmetric_unfolded : (x,y:S)((x[#]y) -> (y[#]x)).
(* End_Tex_Verb *)
Proof (ap_symmetric S).

(* Tex_Prose
\begin{shortcoming}
We would like to write
\[\verb!Lemma eq_equiv_not_ap : (x,y:S)(x [=] y) <-> ~(x [#] y).!\]
In Coq, however, this lemma cannot be easily applied.
Therefore we have to split the lemma into the following two lemmas
\verb!eq_imp_not_ap! and \verb!not_ap_imp_eq!.
\end{shortcoming}
*)

(* Begin_Tex_Verb *)
Lemma eq_imp_not_ap : (x,y:S)(x [=] y) -> ~(x [#] y).
(* End_Tex_Verb *)
Intros x y.
Elim (ap_tight S x y).
Intros H1 H2.
Assumption.
Qed.

(* Begin_Tex_Verb *)
Lemma not_ap_imp_eq : (x,y:S)~(x [#] y) -> (x [=] y).
(* End_Tex_Verb *)
Intros x y.
Elim (ap_tight S x y).
Intros H1 H2.
Assumption.
Qed.

(* Begin_Tex_Verb *)
Lemma neq_imp_notnot_ap : (x,y:S)(x [~=] y) -> ~~(x [#] y).
(* End_Tex_Verb *)
Intros.
Unfold 1 not.
Intro.
Unfold cs_neq in H.
Apply H.
Apply not_ap_imp_eq.
Assumption.
Qed.

(* Begin_Tex_Verb *)
Lemma notnot_ap_imp_neq :  (x,y:S)~~(x [#] y) -> (x [~=] y).
(* End_Tex_Verb *)
Intros.
Unfold cs_neq.
Unfold not.
Intro.
Apply H.
Apply eq_imp_not_ap.
Assumption.
Qed.

(* Begin_Tex_Verb *)
Lemma ap_imp_neq: (x,y:S)(x [#] y)->(x [~=] y).
(* End_Tex_Verb *)
Intros x y H; Red; Red; Intro H1.
Apply (Proj2 (ap_tight S x y) H1 H).
Qed.

(* Begin_Tex_Verb *)
Lemma not_neq_imp_eq : (x,y:S)~(x[~=]y) -> x [=] y.
(* End_Tex_Verb *)
Intros.
Apply not_ap_imp_eq.
Unfold not; Intro.
Elim H.
Apply ap_imp_neq.
Assumption.
Qed.

(* Begin_Tex_Verb *)
Lemma eq_imp_not_neq : (x,y:S)(x [=] y) -> ~(x[~=]y).
(* End_Tex_Verb *)
Unfold cs_neq.
Auto.
Qed.

(* Begin_SpecReals *)

End CSetoid_basics.

(* End_SpecReals *)

(* Tex_Prose
\begin{notation}
\verb!Ex_unq! stands for \verb!ex_unq ?!
\end{notation}
*)
Syntactic Definition Ex_unq := (ex_unq ?).

Hints Resolve eq_reflexive_unfolded : algebra_r.
Hints Resolve eq_symmetric_unfolded : algebra_s.


(* Begin_SpecReals *)

(* Tex_Prose
\subsection{Relations and predicates}
Here we define the notions of well-definedness and strong extensionality
on predicates and relations.

\begin{convention}
Let \verb!S! be a setoid.
\end{convention}

\begin{nameconvention}
\begin{itemize}
\item ``well-defined'' is abbreviated to \verb!well_def! (or \verb!wd!?).
\item ``strongly extensional'' is abbreviated to \verb!strong_ext!
(or \verb!strext!?).
\end{itemize}
\end{nameconvention}
*)
Section CSetoid_relations_and_predicates.
Variable S : CSetoid.

(* End_SpecReals *)

(* Tex_Prose
\subsubsection{Predicates}
\begin{convention}
Let \verb!P! be a predicate on (the carrier of) \verb!S!.
\end{convention}

*)
Section CSetoidPredicates.
Variable P: S -> Prop.

(* Begin_Tex_Verb *)
Definition pred_strong_ext: Prop := (x,y: S)(P x) -> (P y) \/ (x [#] y).
Definition pred_well_def: Prop :=   (x,y: S)(P x) -> (x [=] y) -> (P y).
(* End_Tex_Verb *)

End CSetoidPredicates.

(* Tex_Prose
\subsubsection{Definition of a setoid predicate}
*)
(* Begin_Tex_Verb *)
Record CSetoid_predicate : Type :=
  { csp_pred   :> S -> Prop;
    csp_wd     :  (pred_well_def csp_pred);
    csp_strext :  (pred_strong_ext csp_pred)
  }.
(* End_Tex_Verb *)


(* Begin_SpecReals *)

(* Tex_Prose
\subsubsection{Relation}
\begin{convention}
Let \verb!R! be a relation on (the carrier of) \verb!S!.
\end{convention}
*)
Section CsetoidRelations.
Variable R: S -> S -> Prop.

(* Begin_Tex_Verb *)
Definition rel_well_def_rht: Prop :=
  (x,y,z: S)(R x y) -> (y [=] z) -> (R x z).
Definition rel_well_def_lft: Prop :=
  (x,y,z: S)(R x y) -> (x [=] z) -> (R z y).
Definition rel_strong_ext : Prop :=
  (x1,x2,y1,y2 : S)(R x1 y1) -> (R x2 y2) \/ (x1 [#] x2) \/ (y1 [#] y2).
(* End_Tex_Verb *)

(* End_SpecReals *)

(* Begin_Tex_Verb *)
Definition rel_strong_ext_lft : Prop :=
  (x1,x2,y : S)(R x1 y) -> (R x2 y) \/ (x1 [#] x2).
Definition rel_strong_ext_rht : Prop :=
  (x,y1,y2 : S)(R x y1) -> (R x y2) \/ (y1 [#] y2).
(* End_Tex_Verb *)

(* Begin_Tex_Verb *)
Lemma rel_strext_imp_lftarg: rel_strong_ext -> rel_strong_ext_lft.
(* End_Tex_Verb *)
Proof.
Unfold rel_strong_ext rel_strong_ext_lft; Intros.
Generalize (H x1 x2 y y).
Intros.
Generalize (H1 H0).
Intros.
Elim H2.
Auto.
Intros.
Elim H3.
Auto.
Intro.
Generalize (ap_irreflexive S).
Intros.
Unfold irreflexive in H5.
Generalize (H5 y H4).
Intros.
Contradiction.
Qed.

(* Begin_Tex_Verb *)
Lemma rel_strext_imp_rhtarg: rel_strong_ext -> rel_strong_ext_rht.
(* End_Tex_Verb *)
Unfold rel_strong_ext rel_strong_ext_rht; Intros.
Generalize (H x x y1 y2 H0); Intro.
Elim H1; Intro.
Left.
Assumption.
Elim H2; Intro.
Generalize (ap_irreflexive ? ? H3); Intro.
Elim H4.
Right.
Assumption.
Qed.

(* Begin_Tex_Verb *)
Lemma rel_strextarg_imp_strext:
   rel_strong_ext_rht -> rel_strong_ext_lft -> rel_strong_ext.
(* End_Tex_Verb *)
Unfold rel_strong_ext rel_strong_ext_lft rel_strong_ext_rht; Intros.
Elim (H x1 y1 y2 H1); Intro.
Elim (H0 x1 x2 y2 H2); Intro.
Tauto.
Tauto.
Tauto.
Qed.

(* Begin_SpecReals *)

End CsetoidRelations.

(* Tex_Prose
\subsubsection{Definition of a setoid relation}
*)

(* Tex_Prose
The type of relations over a setoid.
*)
(* Begin_Tex_Verb *)
Record CSetoid_relation : Type :=
  { csr_rel    :> S -> S -> Prop;
    csr_wdr    : (rel_well_def_rht csr_rel);
    csr_wdl    : (rel_well_def_lft csr_rel);
    csr_strext : (rel_strong_ext csr_rel)
  }.
(* End_Tex_Verb *)

(* End_SpecReals *)

(* Begin_Tex_Verb *)
Lemma ap_well_def_rht: (rel_well_def_rht (cs_ap S)).
(* End_Tex_Verb *)
Red; Intros.
Generalize (eq_imp_not_ap ? ? ? H0); Intro.
Elim (ap_cotransitive_unfolded ? ? ? H z); Intro.
Assumption.
Elim H1.
Apply ap_symmetric_unfolded.
Assumption.
Qed.

(* Begin_Tex_Verb *)
Lemma ap_well_def_lft: (rel_well_def_lft (cs_ap S)).
(* End_Tex_Verb *)
Red; Intros.
Generalize (ap_well_def_rht y x z); Intro.
Apply ap_symmetric_unfolded.
Apply H1.
Apply ap_symmetric_unfolded.
Assumption.
Assumption.
Qed.

(* Begin_Tex_Verb *)
Lemma ap_well_def_rht_unfolded:
   (x,y,z:S)(x [#] y) -> (y [=] z) -> (x [#] z).
(* End_Tex_Verb *)
Proof ap_well_def_rht.

(* Begin_Tex_Verb *)
Lemma ap_well_def_lft_unfolded:
   (x,y,z:S)(x [#] y) -> (x [=] z) -> (z [#] y).
(* End_Tex_Verb *)
Proof ap_well_def_lft.

(* Begin_Tex_Verb *)
Lemma ap_strong_ext: (rel_strong_ext (cs_ap S)).
(* End_Tex_Verb *)
Red; Intros.
Case (ap_cotransitive_unfolded ??? H x2); Intro.
Auto.
Case (ap_cotransitive_unfolded ??? H0 y2); Intro.
Auto.
Right; Right.
Apply ap_symmetric_unfolded.
Assumption.
Qed.


(* Begin_Tex_Verb *)
Definition predS_well_def [P:S->Set]: Set := (x,y:S)(P x) -> (x [=] y) -> (P y).
(* End_Tex_Verb *)
(*******
Record Setoid_predicateS : Type :=
  { sp_predS :> S -> Set;
    sp_wdS   :  (predS_well_def sp_predS)
  }.
Definition  predS_strong_ext  [P:(Setoid_predicateS S)] : Set :=
  (x,y: S)(P x) -> (P y) + {(x [#] y)}.
Record CSetoid_predicateS : Type :=
  { csp_predS   :> S -> Prop;
    csp_wd      :  (pred_well_def csp_pred);
    csp_strextS :  (predS_strong_ext csp_predS)
  }.
*************)

(* Begin_SpecReals *)

End CSetoid_relations_and_predicates.

(* End_SpecReals *)

(* Tex_Prose
\subsection{Functions between setoids}
Such functions must preserve the setoid equality
and be strongly extensional w.r.t. the apartness, i.e. e.g.
if \verb!f(x,y) apart f(x1,y1)!, then  \verb!x apart x1 \/ y apart y1!.
For every arity this has to be defined separately.
\begin{convention}
Let \verb!S1!, \verb!S2! and \verb!S3! be setoids.
\end{convention}

First we consider unary functions.
*)

(* Begin_SpecReals *)

Section CSetoid_functions.
Variables S1, S2, S3 : CSetoid.


Section unary_functions.

(* Tex_Prose
In the following two definitions,
\verb!f! is a function from (the carrier of) \verb!S1! to
(the carrier of) \verb!S2!.
*)
Variable  f : S1 -> S2.

(* Begin_Tex_Verb *)
Definition fun_well_def : Prop := (x, y: S1)(x [=] y) -> (f x) [=] (f y).
Definition fun_strong_ext : Prop := (x, y: S1)((f x) [#] (f y)) -> x [#] y.
(* End_Tex_Verb *)

(* End_SpecReals *)

(* Begin_Tex_Verb *)
Lemma fun_strong_ext_imp_well_def : fun_strong_ext -> fun_well_def.
(* End_Tex_Verb *)
Unfold fun_strong_ext.
Unfold fun_well_def.
Intros.
Apply not_ap_imp_eq.
Intro.
Generalize (H ?? H1); Intro.
Generalize (eq_imp_not_ap ??? H0); Intro.
Elim H3; Assumption.
Qed.

(* Begin_SpecReals *)

End unary_functions.

(* Begin_Tex_Verb *)
Record CSetoid_fun : Set :=
  { csf_fun    :> S1 -> S2;
    csf_wd     :  (fun_well_def csf_fun);
    csf_strext :  (fun_strong_ext csf_fun)
  }.
(* End_Tex_Verb *)

(* End_SpecReals *)

(* Begin_Tex_Verb *)
Definition Const_CSetoid_fun : S2 -> CSetoid_fun.
(* End_Tex_Verb *)
Intro c; Apply (Build_CSetoid_fun [x:S1]c); Red; Intros.
(* well def *)
Apply eq_reflexive_unfolded.
(* str ext *)
Elim (ap_irreflexive ?? H).
Defined.

(* Begin_SpecReals *)

Section binary_functions.

(* Tex_Prose
Now we consider binary functions.
In the following two definitions,
\verb!f! is a function from \verb!S1! and \verb!S2! to \verb!S3!.
*)
Variable f : S1 -> S2 -> S3.

(* Begin_Tex_Verb *)
Definition bin_fun_well_def : Prop :=
  (x1, x2: S1)(y1, y2: S2)
   (x1 [=] x2) -> (y1 [=] y2) -> (f x1 y1) [=] (f x2 y2).

Definition bin_fun_strong_ext : Prop :=
  (x1, x2: S1)(y1, y2: S2)
   ((f x1 y1) [#] (f x2 y2)) -> (x1 [#] x2) \/ (y1 [#] y2).
(* End_Tex_Verb *)

(* End_SpecReals *)

(* Begin_Tex_Verb *)
Lemma bin_fun_strong_ext_imp_well_def : bin_fun_strong_ext -> bin_fun_well_def.
(* End_Tex_Verb *)
Unfold bin_fun_strong_ext.
Unfold bin_fun_well_def.
Intros.
Apply not_ap_imp_eq.
Intro.
Generalize (H ???? H2); Intro.
Elim H3; Intro.
Generalize (eq_imp_not_ap ??? H0); Intro.
Elim H5; Assumption.
Generalize (eq_imp_not_ap ??? H1); Intro.
Elim H5; Assumption.
Qed.

(* Begin_SpecReals *)

End binary_functions.

(* Begin_Tex_Verb *)
Record CSetoid_bin_fun : Set :=
  { csbf_fun    :> S1 -> S2 -> S3;
    csbf_wd     :  (bin_fun_well_def csbf_fun);
    csbf_strext :  (bin_fun_strong_ext csbf_fun)
  }.
(* End_Tex_Verb *)


End CSetoid_functions.

(* End_SpecReals *)

Syntactic Definition Fun_well_def := (fun_well_def ??).
Syntactic Definition Fun_strong_ext := (fun_strong_ext ??).

Section unary_function_composition.

(* Tex_Prose
Let \verb!S1!,  \verb!S2! and \verb!S3! be setoids, \verb!f! a
setoid function from \verb!S1! to \verb!S2!, and \verb!g! from \verb!S2!
to \verb!S3! in the following definition of composition.
*)
Variables S1, S2, S3 : CSetoid.
Variable  f : (CSetoid_fun S1 S2).
Variable  g : (CSetoid_fun S2 S3).

(* Begin_Tex_Verb *)
Definition compose_CSetoid_fun: (CSetoid_fun S1 S3).
(* End_Tex_Verb *)
Apply (Build_CSetoid_fun ?? [x:S1](g (f x))).
(* well_def *)
Unfold fun_well_def; Intros.
Apply (csf_wd ?? g). Apply (csf_wd ?? f). Assumption.
(* str_ext *)
Unfold fun_strong_ext; Intros.
Apply (csf_strext ?? f). Apply (csf_strext ?? g). Assumption.
Defined.

End unary_function_composition.


(* Begin_SpecReals *)

(* Tex_Prose
\subsection{The unary and binary (inner) operations on a csetoid.}
An operation is a function with domain(s) and co-domain equal.

\begin{nameconvention}
The word ``unary operation'' is abbreviated to \verb!un_op!;
``binary operation'' is abbreviated to \verb!bin_op!.
\end{nameconvention}

\begin{convention}
Let \verb!S! be a setoid.
\end{convention}
 *)
Section csetoid_inner_ops.
Variable S : CSetoid.

(* Tex_Prose
Properties of binary operations
*)
(* Begin_Tex_Verb *)
Definition commutes [f:S->S->S] : Prop := (x,y: S)(f x y) [=] (f y x).
Definition associative [f:S->S->S]: Prop :=
    (x,y,z:S)(f x (f y z)) [=] (f (f x y) z).
(* End_Tex_Verb *)

(* Tex_Prose
Well-defined unary operations on a setoid.
*)
(* Begin_Tex_Verb *)
Definition un_op_well_def := (fun_well_def S S).
Definition un_op_strong_ext := (fun_strong_ext S S).
(* End_Tex_Verb *)

(* Begin_Tex_Verb *)
Definition CSetoid_un_op : Set := (CSetoid_fun S S).
Definition Build_CSetoid_un_op := (Build_CSetoid_fun S S).
(* End_Tex_Verb *)

(* End_SpecReals *)

(* Begin_Tex_Verb *)
Lemma id_strext : (un_op_strong_ext [x:S]x).
(* End_Tex_Verb *)
Unfold un_op_strong_ext.
Unfold fun_strong_ext.
Intros.
Assumption.
Qed.

(* Begin_Tex_Verb *)
Lemma id_pres_eq : (un_op_well_def [x:S]x).
(* End_Tex_Verb *)
Unfold un_op_well_def.
Unfold fun_well_def.
Intros.
Assumption.
Qed.

(* Begin_Tex_Verb *)
Definition id_un_op := (Build_CSetoid_un_op [x:S]x id_pres_eq id_strext).
(* End_Tex_Verb *)
Identity Coercion un_op_fun: CSetoid_un_op >-> CSetoid_fun.

(* Begin_SpecReals *)

(* Begin_Tex_Verb *)
Definition un_op_strext := (csf_strext S S).
(* End_Tex_Verb *)

(* End_SpecReals *)

(* Begin_Tex_Verb *)
Lemma un_op_wd_unfolded:
  (op:CSetoid_un_op)(x,y:S)(x [=] y) -> (op x) [=] (op y).
(* End_Tex_Verb *)
Proof (csf_wd S S).

(* Begin_Tex_Verb *)
Lemma un_op_strext_unfolded:
  (op:CSetoid_un_op)(x,y:S)((op x) [#] (op y)) -> x [#] y.
(* End_Tex_Verb *)
Exact un_op_strext.
Qed.

(* Tex_Prose
Well-defined binary operations on a setoid.
*)
(* Begin_Tex_Verb *)
Definition bin_op_well_def := (bin_fun_well_def S S S).
Definition bin_op_strong_ext := (bin_fun_strong_ext S S S).
(* End_Tex_Verb *)

(* Begin_SpecReals *)

(* Begin_Tex_Verb *)
Definition CSetoid_bin_op : Set := (CSetoid_bin_fun S S S).
Definition Build_CSetoid_bin_op := (Build_CSetoid_bin_fun S S S).
(* End_Tex_Verb *)

(* End_SpecReals *)

(* Begin_Tex_Verb *)
Definition bin_op_wd := (csbf_wd S S S).
Definition bin_op_strext := (csbf_strext S S S).
(* End_Tex_Verb *)

(* Begin_SpecReals *)

Identity Coercion bin_op_bin_fun: CSetoid_bin_op >-> CSetoid_bin_fun.

(* End_SpecReals *)

(* Begin_Tex_Verb *)
Lemma bin_op_wd_unfolded:
    (op:CSetoid_bin_op)(x1, x2, y1, y2: S)
      (x1 [=] x2) -> (y1 [=] y2) -> (op x1 y1) [=] (op x2 y2).
(* End_Tex_Verb *)
Exact bin_op_wd.
Qed.

(* Begin_Tex_Verb *)
Lemma bin_op_strext_unfolded:
    (op:CSetoid_bin_op)(x1, x2, y1, y2: S)
      ((op x1 y1) [#] (op x2 y2)) -> (x1 [#] x2) \/ (y1 [#] y2).
(* End_Tex_Verb *)
Exact bin_op_strext.
Qed.

(* !! *)
(* Begin_Tex_Verb *)
Lemma bin_op_is_wd_un_op_lft:
    (op:CSetoid_bin_op)(c: S)(un_op_well_def [x:S](op x c)).
(* End_Tex_Verb *)
Proof.
Intros op c. Unfold un_op_well_def. Unfold fun_well_def.
Intros.Apply bin_op_wd_unfolded. Trivial.Apply eq_reflexive_unfolded.
Qed.

(* Begin_Tex_Verb *)
Lemma bin_op_is_wd_un_op_rht:
    (op:CSetoid_bin_op)(c: S)(un_op_well_def [x:S](op c x)).
(* End_Tex_Verb *)
Proof.
Intros op c. Unfold un_op_well_def. Unfold fun_well_def.
Intros.Apply bin_op_wd_unfolded. Apply eq_reflexive_unfolded.Trivial.
Qed.

(* Begin_Tex_Verb *)
Lemma bin_op_is_strext_un_op_lft:
    (op:CSetoid_bin_op)(c: S)(un_op_strong_ext [x:S](op x c)).
(* End_Tex_Verb *)
Proof.
Intros op c. Unfold un_op_strong_ext. Unfold fun_strong_ext.
Intros. Cut (x[#]y)\/(c[#]c). Intro Hv.Elim Hv.Trivial.Intro Hf.Cut False.
Contradiction.Apply (ap_irreflexive_unfolded ? c Hf).
Apply bin_op_strext_unfolded with op.Trivial.
Qed.

(* Begin_Tex_Verb *)
Lemma bin_op_is_strext_un_op_rht:
    (op:CSetoid_bin_op)(c: S)(un_op_strong_ext [x:S](op c x)).
(* End_Tex_Verb *)
Proof.
Intros op c. Unfold un_op_strong_ext. Unfold fun_strong_ext.
Intros. Cut (c[#]c)\/(x[#]y). Intro Hv.Elim Hv.Intro Hf.Cut False.
Contradiction.Apply (ap_irreflexive_unfolded ? c Hf). Trivial.
Apply bin_op_strext_unfolded with op.Trivial.
Qed.

(* Begin_Tex_Verb *)
Definition bin_op2un_op_rht : CSetoid_bin_op->(S)->CSetoid_un_op :=
[op:CSetoid_bin_op; c:(S)]
 (Build_CSetoid_un_op [x:(S)](op c x)
   (bin_op_is_wd_un_op_rht op c) (bin_op_is_strext_un_op_rht op c)).
(* End_Tex_Verb *)

(* Begin_Tex_Verb *)
Definition bin_op2un_op_lft : CSetoid_bin_op->(S)->CSetoid_un_op :=
[op:CSetoid_bin_op; c:(S)]
 (Build_CSetoid_un_op [x:(S)](op x c)
   (bin_op_is_wd_un_op_lft op c) (bin_op_is_strext_un_op_lft op c)).
(* End_Tex_Verb *)

(* Begin_SpecReals *)

End csetoid_inner_ops.

(* End_SpecReals *)

Syntactic Definition Commutes := (commutes ?).

(* Begin_SpecReals *)

Syntactic Definition Associative := (associative ?).

(* End_SpecReals *)

Hints Resolve bin_op_wd_unfolded un_op_wd_unfolded : algebra_c.

(* Tex_Prose
\subsection{The binary outer operations on a csetoid.}
\begin{convention}
Let \verb!S1! and \verb!S2! be setoids.
\end{convention}
 *)

Section csetoid_outer_ops.
Variable S1, S2 : CSetoid.

(* Tex_Prose
Well-defined outer operations on a setoid.
*)
(* Begin_Tex_Verb *)
Definition outer_op_well_def := (bin_fun_well_def S1 S2 S2).
Definition outer_op_strong_ext := (bin_fun_strong_ext S1 S2 S2).

Definition CSetoid_outer_op : Set := (CSetoid_bin_fun S1 S2 S2).
Definition Build_CSetoid_outer_op := (Build_CSetoid_bin_fun S1 S2 S2).
Definition csoo_wd := (csbf_wd S1 S2 S2).
Definition csoo_strext := (csbf_strext S1 S2 S2).
(* End_Tex_Verb *)
Identity Coercion outer_op_bin_fun: CSetoid_outer_op >-> CSetoid_bin_fun.

(* Begin_Tex_Verb *)
Lemma csoo_wd_unfolded:
    (op:CSetoid_outer_op)(x1, x2: S1)(y1, y2: S2)
      (x1 [=] x2) -> (y1 [=] y2) -> (op x1 y1) [=] (op x2 y2).
(* End_Tex_Verb *)
Exact csoo_wd.
Qed.

End csetoid_outer_ops.
Hints Resolve csoo_wd_unfolded : algebra_c.


(* Tex_Prose
\subsection{Combining operations}
\begin{convention}
Let \verb!S1!, \verb!S2! and \verb!S3! be setoids.
\end{convention}
*)
Section CombiningOperations.
Variables S1, S2, S3 : CSetoid.

(* Tex_Prose
In the following definition, we assume \verb!f! is a setoid function from
\verb!S1! to \verb!S2!, and \verb!op! is an unary operation on \verb!S2!.
*)
Section CombiningUnaryOperations.
Variable f : (CSetoid_fun S1 S2).
Variable op : (CSetoid_un_op S2).

(* Tex_Prose
\verb!opOnFun! is the composition \verb!op! after \verb!f!.
*)
(* Begin_Tex_Verb *)
Definition opOnFun: (CSetoid_fun S1 S2).
(* End_Tex_Verb *)
Apply (Build_CSetoid_fun S1 S2 [x:S1](op (f x))).
(* well_def *)
Unfold fun_well_def; Intros.
Apply (csf_wd ?? op (f x) (f y)).
Apply (csf_wd ?? f ?? H).
(* str_ext *)
Unfold fun_strong_ext; Intros.
Apply (csf_strext ?? f x y).
Apply (csf_strext ?? op ?? H).
Defined.

End CombiningUnaryOperations.

End CombiningOperations.

(* Begin_SpecReals *)

(* Tex_Prose
\subsection{Subsetoids}
\begin{convention}
Let \verb!S! be a setoid, and \verb!P! a predicate on the carrier of \verb!S!.
\end{convention}
*)
Section SubCSetoids.
Variable S : CSetoid.
Variable P : S -> Prop.

(* Begin_Tex_Verb *)
Record subcsetoid_crr : Set :=
  { scs_elem :> S;
    scs_prf : (P scs_elem)
  }.
(* End_Tex_Verb *)

(* Begin_Tex_Verb *)
Definition restrict_relation [R:(relation S)]: (relation subcsetoid_crr) :=
  [a, b: subcsetoid_crr]
  Cases a b of
   (Build_subcsetoid_crr x _) (Build_subcsetoid_crr y _) => (R x y)
  end.
(* End_Tex_Verb *)

(* Begin_Tex_Verb *)
Definition subcsetoid_eq: (relation subcsetoid_crr) :=
  (restrict_relation (cs_eq S)).
(* End_Tex_Verb *)

(* Begin_Tex_Verb *)
Definition subcsetoid_ap: (relation subcsetoid_crr) :=
  (restrict_relation (cs_ap S)).
(* End_Tex_Verb *)

(* End_SpecReals *)

(* Begin_Tex_Verb *)
Remark subcsetoid_equiv : (equiv ? subcsetoid_eq).
(* End_Tex_Verb *)
Unfold subcsetoid_eq; Split.
(* reflexive *)
Red; Intros a; Case a.
Intros x s; Red.
Apply (eq_reflexive S).
(* transitive *)
Split.
Red; Intros a b c; Case a.
Intros x s; Case b.
Intros y t; Case c.
Intros z u; Simpl.
Exact (eq_transitive ? x y z).
(* symmetric *)
Red.
Intros a b; Case a.
Intros x s; Case b.
Intros y t; Simpl.
Exact (eq_symmetric ? x y).
Qed.

(* Begin_SpecReals *)

(* Begin_Tex_Verb *)
Lemma subcsetoid_is_CSetoid : (is_CSetoid ? subcsetoid_eq subcsetoid_ap).
(* End_Tex_Verb *)
Apply (Build_is_CSetoid ? subcsetoid_eq subcsetoid_ap).
(* irreflexive *)
Red; Intros. Case x. Unfold not; Intros.
Exact (ap_irreflexive_unfolded S ? H).
(* symmetric *)
Red; Intros x y. Case x. Case y. Intros.
Exact (ap_symmetric S ? ? H).
(* cotransitive *)
Red; Intros x y. Case x. Case y. Intros; Case z. Intros.
Exact (ap_cotransitive S ?? H scs_elem2).
(* tight *)
Red; Intros. Case x. Case y. Intros.
Exact (ap_tight S scs_elem1 scs_elem0).
Qed.

(* Begin_Tex_Verb *)
Definition Build_SubCSetoid : CSetoid :=
  (Build_CSetoid subcsetoid_crr subcsetoid_eq subcsetoid_ap
            subcsetoid_is_CSetoid).
(* End_Tex_Verb *)

(* End_SpecReals *)

(* Tex_Prose
\subsubsection{Subsetoid unary operations}
\begin{convention}
Let \verb!f! be a unary setoid operation on \verb!S!.
\end{convention}
*)
Section SubCSetoid_unary_operations.
Variable f : (CSetoid_un_op S).
(* Begin_Tex_Verb *)
Definition un_op_pres_pred : Prop := (x:S)(P x) -> (P (f x)).
(* End_Tex_Verb *)
(* Tex_Prose
\begin{convention}
Assume \verb!pr : un_op_pres_pred!.
\end{convention}
*)
Variable pr : un_op_pres_pred.

(* Begin_Tex_Verb *)
Definition restr_un_op : subcsetoid_crr -> subcsetoid_crr :=
  [a: subcsetoid_crr]
  Cases a of (Build_subcsetoid_crr x p) =>
              (Build_subcsetoid_crr (f x) (pr x p))
  end.
(* End_Tex_Verb *)

(* Begin_Tex_Verb *)
Lemma restr_un_op_well_def: (un_op_well_def Build_SubCSetoid restr_un_op).
(* End_Tex_Verb *)
Red. Red. Intros x y. Case y. Case x. Intros.
  Exact (un_op_wd_unfolded ? f ?? H).
Qed.

(* Begin_Tex_Verb *)
Lemma restr_un_op_strong_ext: (un_op_strong_ext Build_SubCSetoid restr_un_op).
(* End_Tex_Verb *)
Red. Red. Intros x y. Case y. Case x. Intros.
  Exact (un_op_strext ? f ?? H).
Qed.

(* Begin_Tex_Verb *)
Definition Build_SubCSetoid_un_op: (CSetoid_un_op Build_SubCSetoid) :=
  (Build_CSetoid_un_op Build_SubCSetoid restr_un_op restr_un_op_well_def
                                                       restr_un_op_strong_ext).
(* End_Tex_Verb *)

End SubCSetoid_unary_operations.


(* Tex_Prose
\subsubsection{Subsetoid binary operations}
\begin{convention}
Let \verb!f! be a binary setoid operation on \verb!S!.
\end{convention}
*)
Section SubCSetoid_binary_operations.
Variable f : (CSetoid_bin_op S).
(* Begin_Tex_Verb *)
Definition bin_op_pres_pred : Prop := (x,y:S)(P x) -> (P y) -> (P (f x y)).
(* End_Tex_Verb *)
(* Tex_Prose
\begin{convention}
Assume \verb!un_op_pres_pred!.
\end{convention}
*)
Variable pr : bin_op_pres_pred.

(* Begin_Tex_Verb *)
Definition restr_bin_op [a,b:subcsetoid_crr]: subcsetoid_crr :=
  Cases a b of (Build_subcsetoid_crr x p) (Build_subcsetoid_crr y q) =>
                   (Build_subcsetoid_crr (f x y) (pr x y p q))
  end.
(* End_Tex_Verb *)

(* Begin_Tex_Verb *)
Lemma restr_bin_op_well_def: (bin_op_well_def Build_SubCSetoid restr_bin_op).
(* End_Tex_Verb *)
Red. Red. Intros x1 x2 y1 y2. Case y2. Case y1. Case x2. Case x1. Intros.
  Exact (bin_op_wd ? f ???? H H0).
Qed.

(* Begin_Tex_Verb *)
Lemma restr_bin_op_strong_ext:
                         (bin_op_strong_ext Build_SubCSetoid restr_bin_op).
(* End_Tex_Verb *)
Red. Red. Intros x1 x2 y1 y2. Case y2. Case y1. Case x2. Case x1. Intros.
  Exact (bin_op_strext ? f ???? H).
Qed.

(* Begin_Tex_Verb *)
Definition Build_SubCSetoid_bin_op : (CSetoid_bin_op Build_SubCSetoid) :=
  (Build_CSetoid_bin_op Build_SubCSetoid restr_bin_op restr_bin_op_well_def
                                                    restr_bin_op_strong_ext).
(* End_Tex_Verb *)


(* Begin_Tex_Verb *)
Lemma restr_f_assoc: (Associative f) ->
                     (Associative (Build_SubCSetoid_bin_op)).
(* End_Tex_Verb *)
Intro. Red. Intros x y z. Case z. Case y. Case x. Intros.
Simpl.
Apply H.
Qed.


End SubCSetoid_binary_operations.


(* Begin_SpecReals *)

End SubCSetoids.

(* End_SpecReals *)

(* Tex_Prose
\subsubsection{Miscalleneous}
*)


(* Begin_Tex_Verb *)
Lemma proper_caseZ_diff_CS : (S:CSetoid)(f:nat->nat->S)
              ((m,n,p,q:nat)(plus m q) = (plus n p) -> (f m n) [=] (f p q)) ->
              (m,n:nat)(caseZ_diff `m-n` f) [=] (f m n).
(* End_Tex_Verb *)
Intro CS.
Intros.
Pattern m n.
Apply nat_double_ind.
Intro.
Replace `O-n0` with `-n0`.
Rewrite caseZ_diff_Neg.
Apply eq_reflexive_unfolded.
Simpl.
Reflexivity.
Intros.
Replace `(S n0)-O` with `(S n0)`::Z.
Rewrite caseZ_diff_Pos.
Apply eq_reflexive_unfolded.
Simpl.
Reflexivity.
Intros.
Generalize (H (S n0) (S m0) n0 m0); Intro.
Cut (plus (S n0) m0)=(plus (S m0) n0).
Intro.
Generalize (H1 H2); Intro.
Apply eq_transitive_unfolded with (f n0 m0).
Apply eq_transitive_unfolded with (caseZ_diff `n0-m0` f).
Replace `(S n0)-(S m0)` with `n0-m0`.
Apply eq_reflexive_unfolded.
Repeat Rewrite inj_S.
Omega.
Assumption.
Apply eq_symmetric_unfolded.
Assumption.
Omega.
Qed.

(*
Definition TrueP [S:CSetoid; x:S] : Prop := True.

Lemma test: (S:CSetoid)S->(Build_SubCSetoid S (TrueP ?)).
Intros; Simpl.
***)


(*
egrep 'cs_irref|cs_sym|cs_cotrans| s_refl| s_sym| s_trans|_impl_' *.v | more
grep -e 'cs_irref \| cs_sym' *.v
*)


