Section Kn.
(* This is our scalar space with its dimension *)
Variable p : params.
(* The operations for scalar have the exprected properties *)
Hypothesis Hp : fparamsProp p.
(* We recover the usual mathematical notation *)
Notation "'K'" := (K p).
Delimit Scope kn_scope with k.
Open Scope vector_scope.
Open Scope kn_scope.
(* A vector is a list of length n *)
Fixpoint kn (n: nat): Set :=
match n with O => unit | S n1 => (K * kn n1)%type end.
(** We first build the functions of the vector space *)
(* Equality of two vectors as list *)
Fixpoint eq (n : nat) : kn n -> kn n -> bool :=
match n return (kn n -> kn n -> bool) with
| 0%nat => fun a b => true
| S n1 =>
fun l1 l2 =>
let (v1, l3) := l1 in
let (v2, l4) := l2 in
if (v1 ?= v2)%f then eq n1 l3 l4 else false
end.
(* Generate the constant k for the dimension n *)
Fixpoint genk (n: nat) (k: K) {struct n}: (kn n) :=
match n return kn n with 0%nat => tt |
(S n1) => (k, genk n1 k) end.
Notation " [ k ] " := (genk _ k) (at level 10): kn_scope.
(* Adding two vectors as list *)
Fixpoint add (n : nat) : kn n -> kn n -> kn n :=
match n return (kn n -> kn n -> kn n) with
| 0%nat => fun a b => tt
| S n1 =>
fun l1 l2 =>
let (v1, l3) := l1 in
let (v2, l4) := l2 in ((v1 + v2)%f, add n1 l3 l4)
end.
(* Multiplication by a scalar *)
Fixpoint scal (n : nat) (k: K) {struct n}: kn n -> kn n :=
match n return (kn n -> kn n) with
| 0%nat => fun a => tt
| S n1 =>
fun l1 =>
let (v1,l2) := l1 in ((k * v1)%f , scal n1 k l2)
end.
Canonical Structure vn_eparams (n: nat) :=
Build_eparams (kn n) K (genk n 0%f) (eq n) (add n) (scal n).
Definition fn n : vparamsProp (vn_eparams n).
apply Build_vparamsProp; auto.
(* eq Dec *)
induction n as [| n IH]; simpl.
intros [] []; auto.
intros (v1,l1) (v2, l2);
generalize (eqK_dec _ Hp v1 v2); case eqK; intros HH; subst.
generalize (IH l1 l2); unfold eqE; simpl.
case eq; intros HH; subst; auto.
intros HH1; injection HH1; intros; case HH; auto.
intros HH1; injection HH1; intros; case HH; auto.
(* assoc *)
induction n as [| n IH]; simpl; auto.
intros (v1,l3) (v2, l4) (v3, l5); simpl in IH;
rewrite IH, (addK_assoc _ Hp); auto.
(* comm *)
induction n as [| n IH]; simpl; auto.
intros (v1,l3) (v2, l4); simpl in IH;
rewrite (addK_com _ Hp), (IH l3); auto.
(* 0 is  a left neutral element for + *)
induction n as [| n IH]; simpl; auto.
intros []; auto.
intros (l1,l2); simpl in IH; rewrite (addK0l _ Hp), IH; auto.
(* Multiplication by 0 *)
induction n as [| n IH]; simpl; auto.
intros (l1, l2); simpl in IH; rewrite (multK0l _ Hp), IH; auto.
(* Multiplication by 1 *)
induction n as [| n IH]; simpl.
intros []; auto.
intros (l1, l2); simpl in IH; rewrite (multK1l _ Hp), IH; auto.
(* Left addition of the multiplication by a scalar *)
induction n as [| n IH]; simpl; auto.
intros k1 k2 (l1, l2); simpl in IH; rewrite (add_multKl _ Hp), IH; auto.
(* Right addition of the multiplication by a scalar *)
induction n as [| n IH]; simpl; auto.
intros k (l1, l3) (l2, l4); simpl in IH; rewrite (add_multKr _ Hp), IH; auto.
(* Composition of the multiplication by a scalar *)
induction n as [| n IH]; simpl; auto.
intros k1 k2 (k, x); simpl in IH; rewrite (multK_assoc _ Hp), IH; auto.
Qed.
Hint Resolve fn.
Ltac Kfold n :=
change (add n) with (addE (vn_eparams n));
change (scal n) with (scalE (vn_eparams n));
change (genk n 0%f) with (E0 (vn_eparams n)).
(* Conversion from list to kn *)
Fixpoint l2kn (n:nat) (l:list K) {struct l} : kn n:=
match n return kn n with
| 0 => tt
| S n1 => match l with
| nil => genk (S n1) 0%f
| a::l1 =>  (a,l2kn n1 l1)
end
end.
Fixpoint kn2l (n : nat) : kn n -> list K :=
match n return (kn n -> list K) with
| 0 => fun x => nil
| S n1 => fun v => let (a, v1) := v in a :: kn2l n1 v1
end.
Inductive eql_t0 : list K -> list K -> Prop :=
eql_t0N: eql_t0 nil nil
| eql_t0Nl: forall l, eql_t0 l nil -> eql_t0 (0%f :: l) nil
| eql_t0Nr: forall l, eql_t0 nil l -> eql_t0 nil (0%f :: l)
| eql_t0R: forall a l1 l2, eql_t0 l1 l2 -> eql_t0 (a :: l1) (a :: l2).
Hint Constructors eql_t0.
(* Lift a vector of dimension n into a vector of dimension n+1 whose first component is 0 *)
Definition lift (n: nat) (v: kn n) : (kn (S n)) :=  (0%f, v).
(* The base as the list of all the generators *)
Fixpoint base (n : nat) : list (kn n) :=
match n return list (kn n) with
| 0 => nil
| S n1 => ('e_0: kn (S n1)) :: map (lift n1) (base n1)
end.
(* Coordinates for k vector *)
Fixpoint proj (n: nat) k : (kn n) -> K :=
match n return kn n -> K with
| O => fun _ => 0%f
| S n1 => fun l => let (a,l1) := l in
match k with | O => a | S k1 =>
proj n1 k1 l1
end
end.
Fixpoint pscal (n: nat): (kn n) -> (kn n) -> K :=
match n return kn n -> kn n -> K with
| O => fun a b => 0%f
| S n1 => fun l1 l2 => let (a,l3) := l1 in let (b,l4) := l2 in
(a * b + pscal n1 l3 l4)%f
end.
Notation "a  [.]  b" := (pscal _ a b) (at level 40): kn_scope.
(* Our final vector *)
Definition Kn := kn p.
Definition K0 := genk p 0%f.
Definition Keq: Kn -> Kn -> bool := eq p.
Definition Kadd: Kn -> Kn -> Kn := add p.
Definition Kscal: K -> Kn -> Kn := scal p.
Definition Kproj: nat -> Kn -> K := proj p.
Definition Ksprod: Kn -> Kn -> K := pscal p.
Definition Kgen := gen p.
Canonical Structure v_eparams :=
Build_eparams Kn K K0 Keq Kadd Kscal.
Definition f : vparamsProp v_eparams := fn p.
(* Prod of two vectors as list *)
Fixpoint kprod (n : nat) : kn n -> kn n -> kn n :=
match n with
| 0%nat => fun a b => tt
| S n1 =>
fun l1 l2 =>
let (v1, l3) := l1 in
let (v2, l4) := l2 in ((v1 * v2)%f, kprod n1 l3 l4)
end.
Local Notation "a  [*]  b" := (kprod _ a b) (at level 40).

Lemma kprod1r n a : a [*] [1%f] = a :> kn n.