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)).

(* Specifications: *)
(* scal is integral *)
Lemma scal_integral n k (x: kn n) : k .* x = 0 -> k = 0%f \/ x = 0.
Lemma genk_inj n k1 k2 : [k1] = [k2] :> kn n.+1 -> k1 = k2.
Lemma genk0_dec n (x: kn n) :  x = 0 \/ x <> 0.
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.