Section Vect.
(* This is our scalar space with its dimension *)
Variable p : params.
(* The operations for scalar have the expected properties *)
Hypothesis Hp : fparamsProp p.
Delimit Scope g_scope with g.
Open Scope g_scope.
Open Scope vector_scope.
(* We recover the usual mathematical notation *)
Definition K1 := K.
Notation "'K'" := (K1 p) : g_scope.
Notation projk := (Kn.proj p _).
Notation gvp := (Grassmann.vn_eparams p).
Notation "x '∧' y" := (join p _ x y) (at level 40, left associativity).
Notation "x + y" := (addE _ x y).
Notation "k .* x" := (scalE (gvp _) k x).
Notation "k .* x" := (scalE _ k x) : Kn_scope.
Notation vect := (vect p).
Notation "x ^_'f" := (conj p _ false x)  (at level 30).
Notation "'C[ x ]" := (const p _ x).
Notation " [ k ] " := (genk p  _ k%f) (at level 9).
Notation kn := (kn p).
Notation "#< l , x ># " := (contra p _ l x).
Notation "'v_ x" := (k2g  p _ x) (at level 9).
Notation "''e_' i" := (gen p _ i).
Notation "'@ x " := (dual p _ x) (at level 9).
Notation E := (all p _).
Canonical Structure vn_eparams (n : nat) :=
Build_eparams (vect n) K [0] (eq p n) (add p n) (scal p n).
Ltac Vfold n :=
change (VectorSpace.K p) with (K1 p);
change (add p n) with (addE (gvp n));
change (scal p n) with (scalE (gvp n));
change (genk p n 0%f) with (E0 (gvp n)).
Hint Resolve (fn _ Hp).
(* The geometric product (Clifford product)    *)
(* the quadratic form is encoded as the list l *)
Fixpoint gprod (n : nat) : kn n -> vect n -> vect n -> vect n :=
match n return (kn n -> vect n -> vect n -> vect n) with
| 0%nat => fun k x y => (x * y)%f
| S n1 =>
fun l x y =>
let (k1, l1) := l in
let (x1, x2) := x in
let (y1, y2) := y in
(     gprod n1 l1 x1 y2  +      gprod n1 l1 (x2 ^_'f) y1,
gprod n1 l1 x2 y2 + k1 .* gprod n1 l1 (x1 ^_'f) y1)
end.
Notation "a [*  l ]  b " := (gprod _ l a b) (at level 9).
(* reverse of a multivector each basis element is reversed *)
Fixpoint rev n : vect n -> vect n :=
match n return vect n ->  vect n with
|    0 => fun a => a
| S n1 => fun v => let (x,y) := v in (rev n1 x ^_'f, rev n1 y)
end.
Notation "''R[' x ]" := (rev _ x).
(* Definition of the inverse of the pseudoscalar element *)
(* with the geometric product  *)
Definition pseudo_inv n l :=
let a := (E : vect n) in let b := 'R[a] in (a [* l] b) [* l] b.
Notation "''Pi[' l ]" := (pseudo_inv _ l).
(* product of all elements in a vector *)
Fixpoint prodk n : (kn n -> K) :=
match n return kn n -> K with
0 => fun _ => 1%f
| (S n1) => fun x => let (a, x1) := x in (a * prodk n1 x1)%f
end.
Notation "''P[' x ]" := (prodk _ x).
(* Definition of the Clifford dual with the geometric product *)
Definition cdual n l x : vect n := 'P[l] .* (x [* l] 'R[E]).
(* Direct (in terms of binary trees) definition of the Clifford dual *)
Fixpoint cliff_starb n b : kn n -> vect n -> vect n :=
match n return kn n -> vect n ->  vect n with
|    0 => fun _ a => a
| S n1 => fun l v =>
let b1 := negb b in
let (c, l1) := l in
let  (x, y) := v in
((if b then c else (-c)%f) .* cliff_starb n1 b1 l1 y,
(c * c)%f .* cliff_starb n1 b1 l1 x)
end.
(* Actual definition of Clifford dual *)
Definition cliff_star n l := cliff_starb n true l.
(* The left contraction (Dorst inner product) *)
Fixpoint l_contra (n : nat) : kn n -> vect n -> vect n -> vect n :=
match n return (kn n -> vect n -> vect n -> vect n) with
| 0%nat => fun _ x y => (x * y)%f
| S n1 =>
fun l x y =>
let (k, l1) := l in
let (x1, x2) := x in
let (y1, y2) := y in
(l_contra n1 l1 (x2^_'f) y1,
k .*  l_contra n1 l1 (x1^_'f) y1 + l_contra n1 l1 x2 y2)
end.
Notation "x ''L[' l ]  y " := (l_contra _ l x y) (at level 40).
Notation hom := (hom p _).
induction n as [|n IH]; simpl; try Vfold n.
intros; rewrite multK1r; auto.
destruct x; rewrite !gprod0r; Vrm0.
rewrite !IH, rev_conj, conj_invo, scalE1; Vrm0.
Qed.
(* Scalar product, version deduced from prod_scal observing that prod_scal *)
(* computes the sum of the coordinate products and *)
(* that the A*(reverse A) equals to the squared norm *)
Fixpoint prod_scal (n : nat) : kn n -> vect n -> vect n -> K :=
match n return (kn n -> vect n -> vect n -> K) with
| 0%nat => fun _ x y => (x * y)%f
| S n1 =>
fun l x y =>
let (k, l1) := l in
let (x1, x2) := x in
let (y1, y2) := y in
(prod_scal n1 l1 x2 y2 + k * prod_scal n1 l1 x1 (y1 ^_'f))%f
end.
Notation "a '[.'  l ]  b " := (prod_scal _ l a b)
(at level 40).

Lemma conjf_prod_scal n l (x y: vect n) :
(x^_'f) [.l] y = x [.l] (y^_'f).