(* $Id: vectors.v,v 1.15 2000/11/10 11:27:36 freek Exp $ *)

(* Obsolete but maintained *)

Require Export CSemiGroups.
Require Export PolyList.

Implicit Arguments On.

(* Tex_Prose
\section{Vector Basics}
\subsection{Some List Basics}
\begin{convention}
Let \verb!A! be a Set and \verb!X! be a Setoid.
\end{convention}
*)

Section List_Basics.
Variable A:Set.
Variable X:CSetoid.

(* Begin_Tex_Verb *)
Fixpoint NotIn  [x:X;l:(list X)] : Prop :=
      Cases l of
	nil => True
	| (cons y k) => (x[#]y)/\(NotIn x k) end.
(* End_Tex_Verb *)

(* Begin_Tex_Verb *)
Fixpoint distinct [l:(list X)] : Prop :=
Cases l of nil => True
	| (cons x k) => (NotIn x k)/\(distinct k)
end.
(* End_Tex_Verb *)

(* Tex_prose
\verb!take! takes $i$ and $(l_0, \ldots,l_{n-1})$ and returns
$(l_0,\ldots, l_{i-1})$.
*)
(* Begin_Tex_Verb *)
Fixpoint take [i:nat;l:(list A)] : (list A) :=
	Cases l of
	  nil 	=> (nil A)
	  | (cons x k) => (Cases i of
				O => (nil A)
				| (S j) => (cons x (take j k))
			   end)
	end.
(* End_Tex_Verb *)

(* Tex_prose
\verb!drop! takes $i$ and $(l_0, \ldots,l_{n-1})$ and returns
$(l_i,\ldots, l_{n-1})$.
*)
(* Begin_Tex_Verb *)
Fixpoint drop [i:nat;l:(list A)] : (list A) :=
	Cases l of
	  nil 	=> (nil A)
	  | (cons x k) => (Cases i of
				O => l
				| (S j) =>  (drop j k)
			   end)
	end.
(* End_Tex_Verb *)

(* Tex_Prose
Some preminiaries about list insertion. We insert an element at the end
if the index is too high, so
$\verb!ins_list! r i (l_0,\ldots, l_{n-1}) = (l_0,\ldots, l_{i-1} r l_i,
\ldots,l_{n-1})$
*)

(* Begin_Tex_Verb *)
Fixpoint ins_list [r:A;i:nat;l:(list A)] : (list A) :=
	Cases l of
	  nil 	=> (cons r (nil A))
	  | (cons x k) => (Cases i of
				O => (cons r (cons x k))
				| (S j) => (cons x (ins_list r j k))
			   end)
	end.
(* End_Tex_Verb *)

(* Begin_Tex_Verb *)
Fixpoint ins_end [r:A;l:(list A)] : (list A) :=
	Cases l of
	  nil 	=> (cons r (nil A))
	  | (cons x k) => (cons x (ins_end r k))
	end.
(* End_Tex_Verb *)

(* Begin_Tex_Verb *)
Lemma ins_lth: (r:A; i:nat; l: (list A))
			((length (ins_list r i l)) = (S(length l))).
(* End_Tex_Verb *)
Proof.
Intro r.Induction i.Induction l.Simpl.Auto.
Intros.Simpl.Auto.Intro n.Intro l.
Induction l0.Simpl.Auto.Intros.Simpl.
Rewrite (l l1).Auto.
Qed.

(* list projection `nth' and `ins_list' commute, taking r as a *)
(* default value if i is to high *)

(* Begin_Tex_Verb *)
Lemma nthd_inslist_comm : (i:nat; l:(list A);r:A)
			((nth i (ins_list r i l)r) = r).
(* End_Tex_Verb *)
Proof.
Induction i.Induction l.Unfold ins_list.Unfold nth.Simpl.Auto.
Intros a l0 H.Unfold ins_list.Unfold nth.Simpl.Auto.
Intros.Case l. Simpl.Case n.Auto.Auto.
Intros.Simpl. Apply H.
Qed.

(* Tex_Prose
Taking the $i$th element of a list $l$, given that $l$ has length $n$
and $i< n$.
*)
(* Begin_Tex_Verb *)
Fixpoint nth_list [l:(list A);n:nat] :
                              (i:nat)(lt i n)->(length l)=n ->A :=
<[n:nat;l:(list A)](i:nat)(lt i n)->((length l)=n)->A>
Cases n l of
   O   _           => [i:nat;H:(lt i O);Hl :(length _)=O]
                                        (False_rec A (lt_n_O i H))
|(S n0) nil        => [i:nat;H:(lt i (S n0));Hl :(length (nil A))=(S n0)]
                                        (False_rec A (O_S n0 Hl))
|(S n0)(cons a l0) => [i:nat;H:(lt i (S n0));Hl :(length  (cons a l0))=(S n0)]
(* Distiguish (lt (S i) (S n0)) \/ ((S i)=(S n0)) *)
     (Cases (le_lt_eq_dec (S i) (S n0) H) of
(* x: (lt (S i) (S n0)) *)
     (left x) => (nth_list (lt_S_n i n0 x) (eq_add_S (length l0) n0 Hl))
(* x : ((S i)=(S n0)) *)
     | (right x) => a
     end)
end.
(* End_Tex_Verb *)

(* Dropping one element from a list *)
(* Not taking the length into account *)
(* drop_one i (l_0 ... l_{n_1}) = (l_0 ... l_{i-1} l_{i+1} ... l_{n-1}) *)
Fixpoint drop_one [i:nat;l:(list A)] : (list A) :=
	Cases l of
	  nil 	=> (nil A)
	  | (cons x k) => (Cases i of
				O => k
				| (S j) => (cons x (drop_one j k))
			   end)
	end.

(* Dropping an element shortens the length with 1 *)
Lemma drop_lth: (l: (list A);i,j:nat) ((length l) = (S(plus i j)))->
			((length (drop_one i l)) = (pred(length l))).
Proof.
Induction l. Induction i. Induction j. Intros.Simpl.Auto.Intros.Simpl. Auto.
Intros. Simpl. Auto. Intros a l0 H. Induction i. Intros.Simpl.Auto.
Intros. Simpl. Cut ((length (drop_one n l0))=(pred (length l0))).
Intro H2. Rewrite H2. Simpl in H1. Cut ((length l0)=(S (plus n j))).
Intro H3. Rewrite H3.Auto. Apply eq_add_S. Exact H1.
Apply H with j. Simpl in H1.Apply eq_add_S. Exact H1.
Qed.

(* A VECTOR of type `vect(n)' is a pair of a list l (over carrier A) *)
(* and a proof that (length l) = n *)
(* Ideally this implementation should be hidden in a record *)
(* type (with vect as a possible instantiation), having access only to *)
(* length, project, insert and some properties about these *)

Record vect [n:nat] :Set :=
  { vec     :> (list A);
    lth_prf : (length vec) = n}.

(* Lifting a property P on A to a property on (vect n A) *)
(* saying that P holds for all elements in the vector *)
Definition vect_lift_pred :(P:A->Prop;n:nat)(vect n)->Prop :=
	[P:A->Prop;n:nat;v:(vect n)]
	(!list_rect A [_:(list A)]Prop True [a:A;_:(list A);Z:Prop]((P a)/\Z)
	(vec v)).

(* Inserting an elt r at place i in vector v; default insertion at *)
(* the end *)
(* insert r i [v_0 ... v_{n-1}] = [v_0 ... v_{i-1} r v_i ... v_{n-1}] *)
Definition insert := [r:A; i,n:nat; v:(vect n)]
	(Build_vect (ins_lth r i (vec v))).

(* Projection with default value (`default') *)
(* proj_default i [v_0 ... v_{n-1}] = v_i  *)
Definition proj_default := [i,n:nat;v:(vect n);default:A]
			(nth i (vec v) default).

(* vector projection `proj_default' and `insert' commute, taking r as a *)
(* default value if i is to high *)

Lemma projd_ins_comm : (i,n:nat; v:(vect n);r:A)
			((proj_default i (insert r i v) r) = r).

Proof.
Induction i. Induction n.Intros.Unfold proj_default.Unfold insert.Simpl.
Case (vec v);Simpl;Auto.
Intros.
Unfold proj_default.Unfold insert.Simpl.Case (vec v);Simpl;Auto.
Intros. Unfold proj_default.Unfold insert.Simpl. Apply nthd_inslist_comm.
Qed.

(* Dropping one element from a vector *)
(* drop_one i [v_0 ... v_{n_1}] = [v_0 ... v_{i-1} v_{i+1} ... v_{n-1}] *)
Definition drop_one_vec [i,j:nat;v:(vect (S (plus i j)))] :=
 (Build_vect (drop_lth  (lth_prf v))).


End List_Basics.

Section Vector_MoreBasics.
Variable G: CSemi_grp.
(* Vectors of distinct elements *)
Definition vect_distinct : (n:nat)(vect G n) -> Prop :=
	[n:nat;v:(vect G n)](distinct (vec v)).

(* Variation on `proj_default' *)
(* with default value Zero *)

Definition proj := [i,n:nat;v:(vect G n)]
		(proj_default i v Zero).

(* Sublemma *)
(* list projection `nth' and `ins_list' commute for i small enough *)
(* taking Zero as a default value  *)

Lemma nth_inslist_comm : (l:(list G);n:nat)(le n (length l)) ->
		(i:nat) (le i n )->(r:G)(nth i(ins_list r i l)Zero) = r.

Proof.
Induction l. Intros.Simpl. Cut (O=i). Intro Hi; Rewrite <- Hi;Auto.
Apply le_n_O_eq. Apply le_trans with n. Exact H0.Exact H.
Intros a l0 Hl0. Intros n Hn. Induction i; Intros;Simpl;Auto;
Intros; Simpl;Apply Hl0 with n0. Cut (le (S n0)(S(length l0))).
Intro HS;Apply le_S_n;Exact HS. Apply le_trans with n.
Exact H0.Exact Hn.Auto.
Qed.

(* Lemma, corollary of Sublemma, now for vectors *)
(* vector projection `proj' and `insert' commute for small enough i *)
Lemma proj_ins_comm1 : (i,j:nat; v:(vect G (plus i j));r:G)
			((proj i (insert r i v)) = r).

Proof.
Intros.Unfold proj;Unfold insert.Unfold proj_default. Simpl.
Apply nth_inslist_comm with i. Cut ((length (vec v)) = (plus i j)).
Intro H.Rewrite H. Generalize i.Induction i0.Simpl;Auto. Apply le_O_n.
Intros.Simpl.Apply le_n_S.Exact H0.Exact (lth_prf v).Auto.
Qed.

(* Same Lemma formulated with (le i n) *)
Lemma proj_ins_comm2 : (i,n:nat)(le i n) -> (v:(vect G n);r:G)
			((proj i (insert r i v)) = r).

Proof.
Intros i n Hin.  Cut (n = (plus i (minus n i))). Intro He. Rewrite He.
Intros. Apply proj_ins_comm1.  Apply le_plus_minus. Exact Hin.
Qed.

(* Sublemma *)
(* commutation of `nth i' and `ins_list j' for i<j *)
(* taking Zero as a default value  *)
Lemma nth_inslist_comm2 : (l:(list G);n:nat)(le n (length l)) ->
		(i,j:nat) (le j n)->(lt i j) -> (r:G)
		(nth i(ins_list r j l)Zero) = (nth i l Zero).

Proof.
Induction l. Intros n Hnn. Induction i. Intros.
Unfold nth.Unfold ins_list;Simpl. Cut False.Intro.Contradiction.
Simpl in Hnn. Cut (lt O n). Cut (O = n).Intros. Exact (lt_O_neq n H2 H1).
Apply le_n_O_eq.Exact Hnn. Apply lt_le_trans with j. Assumption.
Assumption.
Intros.Simpl. Case n0.Auto.Auto.
Intros. Cut (j = (S(pred j))).Intro Hj; Rewrite Hj.
Cut (i=O)\/(Ex [p:nat] (i = (S p))).Intro Hi.Elim Hi.
Intro Hie;Rewrite Hie. Unfold ins_list;Unfold nth;Simpl;Auto.
Intro Hie.Elim Hie.Intros. Rewrite H3. Simpl.Apply H with (pred n).
Exact (le_pred ?? H0). Exact (le_pred ?? H1).
Rewrite H3 in H2.Exact (le_pred ?? H2).
Generalize i.Induction i0.Left;Auto.Intros p H3;Right;Exists p;Auto.
Apply S_pred with i. Exact H2.
Qed.

(* Lemma, corollary of Sublemma, now for vectors *)
(* commutation of vector projection `proj' and `insert' for  i<j *)
Lemma proj_ins_comm3 : (i,j,n:nat)(le j n) -> (lt i j) ->
			(v:(vect G n);r:G)
			((proj i (insert r j v)) = (proj i v)).

Proof.
Intros. Unfold proj;Unfold insert;Simpl.
Unfold proj_default. Simpl. Apply nth_inslist_comm2 with n.
Rewrite (lth_prf v).Auto.Exact H.Exact H0.
Qed.

(* Sublemma *)
(* commutation of `nth i' and `ins_list j' for i>j *)
(* taking Zero as a default value  *)
Lemma nth_inslist_comm3 : (l:(list G);n:nat)(le n (length l)) ->
		(i,j:nat) (le i n)->(lt j i) -> (r:G)
		(nth (S i)(ins_list r j l)Zero) = (nth i l Zero).

Proof.
Induction l. Intros n Hnn. Induction i. Intros.
Unfold nth.Unfold ins_list;Simpl. Cut False.Intro.Contradiction.
Simpl in Hnn. Cut (lt O n). Cut (O = n).Intros. Exact (lt_O_neq n H2 H1).
Apply le_n_O_eq.Exact Hnn. Apply lt_le_trans with j. Cut False. Intro.
Contradiction. Exact (lt_n_O j H0). Cut (lt j n). Exact (lt_le_weak j n).
Exact (lt_le_trans j O n H0 H).
Intros. Simpl.Case n0.Auto.Auto.
Intros a l0 H n H0 i.
Intros.Cut (i = (S (pred i))).Intro Hi;Rewrite Hi.
Cut (j=O)\/(Ex [p:nat] (j = (S p))). Intro Hj;Elim Hj.
Intro Hje;Rewrite Hje.
Simpl.Auto. Intro Hex;Elim Hex.Intros.Rewrite H3.Simpl.
Apply H with (pred n). Exact (le_pred ?? H0). Exact (le_pred ?? H1).
Rewrite H3 in H2.Exact (le_pred ?? H2).
Generalize j.Induction j0.Left;Auto.Intros p H3;Right;Exists p;Auto.
Apply S_pred with j. Exact H2.
Qed.

(* Lemma, corollary of Sublemma, now for vectors *)
(* commutation of vector projection `proj' and `insert' for  i>j *)
(* taking Zero as a default value *)
Lemma proj_ins_comm4 : (i,j,n:nat)(le i n) -> (lt j i) ->
			(v:(vect G n);r:G)
			((proj (S i) (insert r j v)) = (proj i v)).

Proof.
Intros. Unfold proj;Unfold insert;Simpl.
Unfold proj_default. Simpl. Apply nth_inslist_comm3 with n.
Rewrite (lth_prf v).Auto.Exact H.Exact H0.
Qed.

(* Lemma drop_ins_comm : (i,j:nat)(v:(vect G (plus i j));r:G)
			((drop_vec (insert r (plus i j) v)) = v).*)


Variable f :(CSetoid_un_op G).

Lemma map_lth : (l:(list G))(n:nat)
		((length l) = n) ->((length (map f l))=n).
Proof.
Induction l. Intros.Simpl.Rewrite <- H;Auto.
Intros. Rewrite <- H0;Simpl. Cut ((length (map (f) l0))=(length l0)).
Intro H1. Rewrite <-H1;Auto.Apply H;Auto.
Qed.


Definition vec_map [n:nat;v:(vect G n)] : (vect G n) :=
	(!Build_vect G n (map f (vec v))(map_lth (lth_prf v))).


End Vector_MoreBasics.


