(* $Id: TupleCSetoids.v,v 1.23 2000/11/10 11:27:35 freek Exp $ *)

(* Obsolete but maintained *)

Require Export finite.

(* CSetoids of homogeneous n-tuples *)

Transparent sym_eq.
Transparent f_equal.

Section BuildTupleCSetoid.
Variable T : CSetoid.
Variable n : nat.

Definition eqs [l,k:(vec T n)]: Prop := (i:(fin n))(l i) [=] (k i).
Definition aps [l,k:(vec T n)]: Prop := (Ex [i:(fin n)](l i) [#] (k i)).

Lemma aps_irreflexive: (irreflexive aps).
Unfold irreflexive aps not; Intros.
Elim H. Intro a. Exact (ap_irreflexive T (x a)).
Qed.

Lemma aps_symmetric: (Symmetric aps).
Unfold symmetric aps; Intros.
Elim H; Intros.
Apply (ex_intro ? ([i:(fin n)](y i)[#](x i)) x0).
Apply (ap_symmetric T); Assumption.
Qed.

Lemma aps_cotransitive: (cotransitive aps).
Unfold cotransitive aps; Intros.
Elim H; Intros.
Elim (ap_cotransitive T ?? H0 (z x0)); Intros.
Left.
  Apply (ex_intro ? [i:(fin n)](x i) [#] (z i) x0);
  Assumption.
Right.
  Apply (ex_intro ? [i:(fin n)](z i) [#] (y i) x0);
  Assumption.
Qed.

Lemma aps_tight: (tight_apart eqs aps).
Unfold tight_apart aps eqs iff; Intros; Split; Intros.
(* => *)
Apply (Proj1 (ap_tight T (x i) (y i))).
Unfold not; Intros; Apply (deMorgan_ex_all H H0).
(* <= *)
Unfold not; Intros h; Elim h; Intros.
Apply (!deMorgan_all_ex ? ([i:(fin n)](x i) [#] (y i))).
Intro i; Exact (Proj2 (ap_tight T (x i) (y i)) (H i)).
Assumption.
Qed.


Definition Build_TupleCSetoid: CSetoid.
Apply (!Build_CSetoid (vec T n) eqs aps).
Apply (Build_is_CSetoid ??? aps_irreflexive aps_symmetric
                            aps_cotransitive aps_tight).
Defined.

End BuildTupleCSetoid.

(* Apply functions componentwise *)
Section TuplingFunctions.
Variables S1, S2, S3 : CSetoid.
Variable f : (CSetoid_fun S1 S2).
Variable g : (CSetoid_bin_fun S1 S2 S3).

Variable n : nat.

Local S1n : CSetoid := (Build_TupleCSetoid S1 n).
Local S2n : CSetoid := (Build_TupleCSetoid S2 n).
Local S3n : CSetoid := (Build_TupleCSetoid S3 n).
Local fn : S1n -> S2n := (mapf f 4!n).
Local gn : S1n -> S2n -> S3n := (map2f g 5!n).

Lemma tuple_fun_well_def: (fun_well_def S1n S2n fn).
Unfold fun_well_def S1n S2n fn. Simpl; Unfold eqs; Intros.
Apply (csf_wd ?? f (x i) (y i)).
Apply (H i).
Qed.

Lemma tuple_fun_strong_ext: (fun_strong_ext S1n S2n fn).
Unfold fun_strong_ext S1n S2n fn. Simpl; Unfold aps; Intros.
Elim H; Intros. Exists x0.
Apply (csf_strext ?? f (x x0) (y x0)).
Assumption.
Qed.

Definition Build_TupleCSetoid_fun: (CSetoid_fun S1n S2n).
Apply (Build_CSetoid_fun S1n S2n fn tuple_fun_well_def tuple_fun_strong_ext).
Defined.

Lemma tuple_bin_fun_well_def: (bin_fun_well_def S1n S2n S3n gn).
Unfold bin_fun_well_def S1n S2n S3n gn. Simpl; Unfold eqs; Intros.
Apply (csbf_wd ??? g (x1 i) (x2 i) (y1 i) (y2 i)).
Apply (H i). Apply (H0 i).
Qed.

Lemma tuple_bin_fun_strong_ext: (bin_fun_strong_ext S1n S2n S3n gn).
Unfold bin_fun_strong_ext S1n S2n S3n gn. Simpl; Unfold aps; Intros.
Elim H; Intros i h.
Elim (csbf_strext ??? g ???? h); Intros.
Left; Exists i; Assumption.
Right; Exists i; Assumption.
Qed.

Definition Build_TupleCSetoid_bin_fun: (CSetoid_bin_fun S1n S2n S3n).
Apply (Build_CSetoid_bin_fun S1n S2n S3n gn
        tuple_bin_fun_well_def tuple_bin_fun_strong_ext).
Defined.

End TuplingFunctions.

(* Inner operations *)
Section TuplingInnerOperations.
Variable S : CSetoid.
Variable f : (CSetoid_un_op S).
Variable g : (CSetoid_bin_op S).

Variable n : nat.

Local Sn : CSetoid := (Build_TupleCSetoid S n).
Local fn : Sn -> Sn := (mapf f 4!n).
Local gn : Sn -> Sn -> Sn := (map2f g 5!n).

Definition Build_TupleCSetoid_un_op : (CSetoid_un_op Sn).
Apply (Build_CSetoid_un_op Sn fn).
Exact (tuple_fun_well_def S S f n).
Exact (tuple_fun_strong_ext S S f n).
Defined.

Definition Build_TupleCSetoid_bin_op: (CSetoid_bin_op Sn).
Apply (Build_CSetoid_bin_op Sn gn).
Exact (tuple_bin_fun_well_def S S S g n).
Exact (tuple_bin_fun_strong_ext S S S g n).
Defined.

Lemma tuple_assoc: (Associative g) -> (Associative gn).
Unfold associative; Simpl; Unfold eqs gn map2f; Intros.
Apply H.
Qed.

Lemma tuple_commutes: (Commutes g) -> (Commutes gn).
Unfold commutes; Simpl; Unfold eqs gn map2f; Intros.
Apply H.
Qed.

End TuplingInnerOperations.

(*
Section TuplingAssocOperations.
Variable S : CSetoid.
Variable g : (CSetoid_bin_op S).
Variable ass : (Associative g).
Variable n : nat.

Local Sn : CSetoid := (Build_TupleCSetoid S n).

Definition Build_TupleCSetoid_bin_op: (CSetoid_bin_op Sn).
Apply (Build_TupleCSetoid_bin_op Sn (Build_TupleCSetoid_bin_op S g n)).
Unfold Build_TupleCSetoid_bin_op.
Definition Build_TupleCSetoid_assoc_op: (CSetoid_assoc_op Sn).
Apply (Build_CSetoid_assoc_op Sn (Build_TupleCSetoid_bin_op S g n)).
Unfold Build_TupleCSetoid_bin_op.
Exact (tuple_assoc S g n (csao_assoc S g)).
Defined.

End TuplingAssocOperations.
*)

(* Outer operations: scalars *)
Section TuplingScalarOperations.
Variable S1,S2 : CSetoid.
Variable f : (CSetoid_outer_op S1 S2).

Variable n : nat.

Local S2n : CSetoid := (Build_TupleCSetoid S2 n).
Local fn : S1 -> S2n -> S2n := [x:S1](mapf (f x) 4!n).

Lemma tuple_scalar_op_well_def: (bin_fun_well_def S1 S2n S2n fn).
Unfold bin_fun_well_def S2n fn. Simpl; Unfold eqs mapf; Intros.
Apply (csoo_wd ?? f x1 x2 (y1 i) (y2 i)).
Assumption.
Apply (H0 i).
Qed.

Lemma tuple_scalar_op_strong_ext: (bin_fun_strong_ext S1 S2n S2n fn).
Unfold bin_fun_strong_ext S2n fn. Simpl; Unfold aps mapf; Intros.
Elim H; Intros i h.
Elim (csoo_strext ?? f ???? h); Intros.
Left; Assumption.
Right; Exists i; Assumption.
Qed.

Definition Build_TupleCSetoid_scalar_op: (CSetoid_outer_op S1 S2n).
Apply (Build_CSetoid_outer_op S1 S2n fn).
Exact tuple_scalar_op_well_def.
Exact tuple_scalar_op_strong_ext.
Defined.

End TuplingScalarOperations.


