Require Import ArithRing Div2 Bool Even Setoid Min List Aux Wf_nat.
Require Import Field VectorSpace Kn Grassmann.


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

Lemma grpod_l0_join n x y : x [* 0] y = x ∧ y :> vect n.
Proof.
(* Goal: @Logic.eq (Grassmann.vect p n) (gprod n (E0 (Kn.vn_eparams p n)) x y) (join p n x y) *)
induction n as [|n IH]; simpl; auto.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (let (x1, x2) := x in let (y1, y2) := y in @pair (Grassmann.vect p n) (Grassmann.vect p n) (add p n (gprod n (Kn.genk p n (v0 (K p))) x1 y2) (gprod n (Kn.genk p n (v0 (K p))) (conj p n false x2) y1)) (add p n (gprod n (Kn.genk p n (v0 (K p))) x2 y2) (scal p n (v0 (K p)) (gprod n (Kn.genk p n (v0 (K p))) (conj p n false x1) y1)))) (let (x1, x2) := x in let (y1, y2) := y in @pair (Grassmann.vect p n) (Grassmann.vect p n) (add p n (join p n x1 y2) (join p n (conj p n false x2) y1)) (join p n x2 y2)) *)
destruct x; destruct y; Vfold n; rewrite !IH; Vrm0.
Qed.

Lemma gprodE n l (M1 M2 : vect n.+1) :
  M1 [* l] M2 =
     ( (fst M1) [* snd l] (snd M2)  +  ((snd M1) ^_'f) [* snd l]  (fst M2),
           (snd M1) [* snd l] (snd M2) + 
              fst l .* (((fst M1) ^_'f) [* snd l]  (fst M2))).
Proof. destruct l; destruct M1; destruct M2; simpl; auto. Qed.

Lemma gprod0r n l x : x [* l] 0 = 0 :> vect n.
Proof.
(* Goal: @Logic.eq (Field.K (K1 p)) (prod_scal n l x y) (prod_scal n l y x) *)
induction n as [| n IH]; simpl; try Vfold n; Krm0.
(* Goal: @Logic.eq (Field.K (K1 p)) (let (k, l1) := l in let (y1, y2) := x in addK (K1 p) (prod_scal n l1 (E0 (Grassmann.vn_eparams p n)) y2) (multK (K1 p) k (prod_scal n l1 (E0 (Grassmann.vn_eparams p n)) (conj p n false y1)))) (v0 (K1 p)) *)
destruct l; destruct x; rewrite !IH; Vrm0.
Qed.

Lemma gprod0l n l y : 0 [* l] y = 0 :> vect n.
Proof.
(* Goal: @Logic.eq (Field.K (K1 p)) (prod_scal n l x y) (prod_scal n l y x) *)
induction n as [| n IH]; simpl; try Vfold n; Krm0.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (let (k1, l1) := l in let (y1, y2) := y in @pair (Grassmann.vect p n) (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) (gprod n l1 (E0 (Grassmann.vn_eparams p n)) y2) (gprod n l1 (conj p n false (E0 (Grassmann.vn_eparams p n))) y1)) (addE (Grassmann.vn_eparams p n) (gprod n l1 (E0 (Grassmann.vn_eparams p n)) y2) (scalE (Grassmann.vn_eparams p n) k1 (gprod n l1 (conj p n false (E0 (Grassmann.vn_eparams p n))) y1)))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (E0 (Grassmann.vn_eparams p n)) (E0 (Grassmann.vn_eparams p n))) *)
destruct l; destruct y; rewrite conj0, !IH; Vrm0.
Qed.

Lemma gprodkl n l k y : [k] [* l] y = k .* y :> vect n.
Proof.
(* Goal: @Logic.eq (Field.K (K1 p)) (prod_scal n l x y) (prod_scal n l y x) *)
induction n as [| n IH]; simpl; try Vfold n; Krm0.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (let (k1, l1) := l in let (y1, y2) := y in @pair (Grassmann.vect p n) (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) (gprod n l1 (E0 (Grassmann.vn_eparams p n)) y2) (gprod n l1 (conj p n false (genk p n k)) y1)) (addE (Grassmann.vn_eparams p n) (gprod n l1 (genk p n k) y2) (scalE (Grassmann.vn_eparams p n) k1 (gprod n l1 (conj p n false (E0 (Grassmann.vn_eparams p n))) y1)))) (let (l2, l3) := y in @pair (Grassmann.vect p n) (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) k l2) (scalE (Grassmann.vn_eparams p n) k l3)) *)
destruct l; destruct y; rewrite conj0, conjk, !IH; Vrm0.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) (gprod n k1 (E0 (Grassmann.vn_eparams p n)) v0) (scalE (Grassmann.vn_eparams p n) k v)) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k v0) (scalE (Grassmann.vn_eparams p n) k0 (gprod n k1 (E0 (Grassmann.vn_eparams p n)) v)))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) k v) (scalE (Grassmann.vn_eparams p n) k v0)) *)
repeat rewrite gprod0l; Vrm0.
Qed.

Lemma gprodkr n l k x : (x [* l] [k]) = k .* x :> vect n.
Proof.
(* Goal: @Logic.eq (Field.K (K1 p)) (prod_scal n l x y) (prod_scal n l y x) *)
induction n as [| n IH]; simpl; try Vfold n; Krm0.
(* Goal: @Logic.eq (Field.K (K1 p)) (multK (stype (Grassmann.vn_eparams p n)) k0 k) (multK (K1 p) k k0) *)
rewrite multK_com; auto.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (let (k1, l1) := l in let (x1, x2) := x in @pair (Grassmann.vect p n) (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) (gprod n l1 x1 (genk p n k)) (gprod n l1 (conj p n false x2) (E0 (Grassmann.vn_eparams p n)))) (addE (Grassmann.vn_eparams p n) (gprod n l1 x2 (genk p n k)) (scalE (Grassmann.vn_eparams p n) k1 (gprod n l1 (conj p n false x1) (E0 (Grassmann.vn_eparams p n)))))) (let (l2, l3) := x in @pair (Grassmann.vect p n) (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) k l2) (scalE (Grassmann.vn_eparams p n) k l3)) *)
destruct l; destruct x; repeat rewrite gprod0r; Vrm0.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (gprod n k1 v (genk p n k)) (gprod n k1 v0 (genk p n k))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) k v) (scalE (Grassmann.vn_eparams p n) k v0)) *)
repeat rewrite IH; auto.
Qed.

Lemma gprod_spec1 n l i :
   i < n -> 'e_i [* l] 'e_i =  [projk i l] :> vect n.
Proof.
(* Goal: forall _ : lt i n, @Logic.eq (Grassmann.vect p n) (l_contra n l (gen p n i) (gen p n i)) (genk p n (Kn.proj p n i l)) *)
generalize i; clear i.
(* Goal: @Logic.eq (Field.K (K1 p)) (prod_scal n l x y) (prod_scal n l y x) *)
induction n as [| n IH]; simpl; try Vfold n; Krm0.
(* Goal: forall (i : nat) (_ : lt i O), @Logic.eq (Field.K (Grassmann.K1 p)) (multK (Grassmann.K1 p) (v1 (Grassmann.K1 p)) (v1 (Grassmann.K1 p))) (v0 (K p)) *)
(* Goal: forall (i : nat) (_ : lt i (S n)), @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (let (k, l1) := l in let (x1, x2) := match i with | O => @pair (Grassmann.vect p n) (Grassmann.vect p n) (genk p n (v1 (Grassmann.K1 p))) (E0 (Grassmann.vn_eparams p n)) | S p1 => @pair (Grassmann.vect p n) (Grassmann.vect p n) (E0 (Grassmann.vn_eparams p n)) (gen p n p1) end in let (y1, y2) := match i with | O => @pair (Grassmann.vect p n) (Grassmann.vect p n) (genk p n (v1 (Grassmann.K1 p))) (E0 (Grassmann.vn_eparams p n)) | S p1 => @pair (Grassmann.vect p n) (Grassmann.vect p n) (E0 (Grassmann.vn_eparams p n)) (gen p n p1) end in @pair (Grassmann.vect p n) (Grassmann.vect p n) (l_contra n l1 (conj p n false x2) y1) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (l_contra n l1 (conj p n false x1) y1)) (l_contra n l1 x2 y2))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (E0 (Grassmann.vn_eparams p n)) (genk p n (let (a, l1) := l in match i with | O => a | S k1 => Kn.proj p n k1 l1 end))) *)
intros i HH; contradict HH; auto with arith.
(* Goal: forall (i : nat) (_ : lt i (S n)), @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (let (k1, l1) := l in let (x1, x2) := match i with | O => @pair (Grassmann.vect p n) (Grassmann.vect p n) (genk p n (v1 (Grassmann.K1 p))) (E0 (Grassmann.vn_eparams p n)) | S p1 => @pair (Grassmann.vect p n) (Grassmann.vect p n) (E0 (Grassmann.vn_eparams p n)) (gen p n p1) end in let (y1, y2) := match i with | O => @pair (Grassmann.vect p n) (Grassmann.vect p n) (genk p n (v1 (Grassmann.K1 p))) (E0 (Grassmann.vn_eparams p n)) | S p1 => @pair (Grassmann.vect p n) (Grassmann.vect p n) (E0 (Grassmann.vn_eparams p n)) (gen p n p1) end in @pair (Grassmann.vect p n) (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) (gprod n l1 x1 y2) (gprod n l1 (conj p n false x2) y1)) (addE (Grassmann.vn_eparams p n) (gprod n l1 x2 y2) (scalE (Grassmann.vn_eparams p n) k1 (gprod n l1 (conj p n false x1) y1)))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (E0 (Grassmann.vn_eparams p n)) (genk p n (let (a, l1) := l in match i with | O => a | S k1 => Kn.proj p n k1 l1 end))) *)
destruct l; intros [|i] HH ; simpl; Vfold n.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) (gprod n k0 (genk p n (v1 (Grassmann.K1 p))) (E0 (Grassmann.vn_eparams p n))) (gprod n k0 (conj p n false (E0 (Grassmann.vn_eparams p n))) (genk p n (v1 (Grassmann.K1 p))))) (addE (Grassmann.vn_eparams p n) (gprod n k0 (E0 (Grassmann.vn_eparams p n)) (E0 (Grassmann.vn_eparams p n))) (scalE (Grassmann.vn_eparams p n) k (gprod n k0 (conj p n false (genk p n (v1 (Grassmann.K1 p)))) (genk p n (v1 (Grassmann.K1 p))))))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (E0 (Grassmann.vn_eparams p n)) (genk p n k)) *)
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) (gprod n k0 (E0 (Grassmann.vn_eparams p n)) (gen p n i)) (gprod n k0 (conj p n false (gen p n i)) (E0 (Grassmann.vn_eparams p n)))) (addE (Grassmann.vn_eparams p n) (gprod n k0 (gen p n i) (gen p n i)) (scalE (Grassmann.vn_eparams p n) k (gprod n k0 (conj p n false (E0 (Grassmann.vn_eparams p n))) (E0 (Grassmann.vn_eparams p n)))))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (E0 (Grassmann.vn_eparams p n)) (genk p n (Kn.proj p n i k0))) *)
rewrite conj0, !conjk, !gprodkr, !gprod0r; Vrm0.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (E0 (Grassmann.vn_eparams p n)) (scalE (Grassmann.vn_eparams p n) k (scalE (Grassmann.vn_eparams p n) (v1 (Grassmann.K1 p)) (genk p n (v1 (Grassmann.K1 p)))))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (E0 (Grassmann.vn_eparams p n)) (genk p n k)) *)
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) (gprod n k0 (E0 (Grassmann.vn_eparams p n)) (gen p n i)) (gprod n k0 (conj p n false (gen p n i)) (E0 (Grassmann.vn_eparams p n)))) (addE (Grassmann.vn_eparams p n) (gprod n k0 (gen p n i) (gen p n i)) (scalE (Grassmann.vn_eparams p n) k (gprod n k0 (conj p n false (E0 (Grassmann.vn_eparams p n))) (E0 (Grassmann.vn_eparams p n)))))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (E0 (Grassmann.vn_eparams p n)) (genk p n (Kn.proj p n i k0))) *)
rewrite !scalk; Krm1.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) (gprod n k0 (E0 (Grassmann.vn_eparams p n)) (gen p n i)) (gprod n k0 (conj p n false (gen p n i)) (E0 (Grassmann.vn_eparams p n)))) (addE (Grassmann.vn_eparams p n) (gprod n k0 (gen p n i) (gen p n i)) (scalE (Grassmann.vn_eparams p n) k (gprod n k0 (conj p n false (E0 (Grassmann.vn_eparams p n))) (E0 (Grassmann.vn_eparams p n)))))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (E0 (Grassmann.vn_eparams p n)) (genk p n (Kn.proj p n i k0))) *)
rewrite !gprod0l, !gprod0r; Vrm0.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (E0 (Grassmann.vn_eparams p n)) (gprod n k0 (gen p n i) (gen p n i))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (E0 (Grassmann.vn_eparams p n)) (genk p n (Kn.proj p n i k0))) *)
rewrite !IH; simpl; Krm0; auto with arith.
Qed.

Lemma gprod_spec2 n l i j : i < n -> j < n -> i <> j -> 
  'e_i [* l] 'e_j =  (-(1))%f .* 'e_j [* l] 'e_i :> vect n.
Proof.
(* Goal: forall (_ : lt i n) (_ : lt j n) (_ : not (@Logic.eq nat i j)), @Logic.eq (Grassmann.vect p n) (l_contra n l (gen p n i) (gen p n j)) (E0 (Grassmann.vn_eparams p n)) *)
generalize i j; clear i j.
(* Goal: @Logic.eq (Field.K (K1 p)) (prod_scal n l x y) (prod_scal n l y x) *)
induction n as [| n IH]; simpl; try Vfold n; Krm0.
(* Goal: forall (i j : nat) (_ : lt i O) (_ : lt j O) (_ : not (@Logic.eq nat i j)), @Logic.eq (Field.K (Grassmann.K1 p)) (multK (Grassmann.K1 p) (v1 (Grassmann.K1 p)) (v1 (Grassmann.K1 p))) (v0 (Grassmann.K1 p)) *)
(* Goal: forall (i j : nat) (_ : lt i (S n)) (_ : lt j (S n)) (_ : not (@Logic.eq nat i j)), @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (let (k, l1) := l in let (x1, x2) := match i with | O => @pair (Grassmann.vect p n) (Grassmann.vect p n) (genk p n (v1 (Grassmann.K1 p))) (E0 (Grassmann.vn_eparams p n)) | S p1 => @pair (Grassmann.vect p n) (Grassmann.vect p n) (E0 (Grassmann.vn_eparams p n)) (gen p n p1) end in let (y1, y2) := match j with | O => @pair (Grassmann.vect p n) (Grassmann.vect p n) (genk p n (v1 (Grassmann.K1 p))) (E0 (Grassmann.vn_eparams p n)) | S p1 => @pair (Grassmann.vect p n) (Grassmann.vect p n) (E0 (Grassmann.vn_eparams p n)) (gen p n p1) end in @pair (Grassmann.vect p n) (Grassmann.vect p n) (l_contra n l1 (conj p n false x2) y1) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (l_contra n l1 (conj p n false x1) y1)) (l_contra n l1 x2 y2))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (E0 (Grassmann.vn_eparams p n)) (E0 (Grassmann.vn_eparams p n))) *)
intros i j HH; contradict HH; auto with arith.
(* Goal: forall (i j : nat) (_ : lt i (S n)) (_ : lt j (S n)) (_ : not (@Logic.eq nat i j)), @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (let (k1, l1) := l in let (x1, x2) := match i with | O => @pair (Grassmann.vect p n) (Grassmann.vect p n) (genk p n (v1 (Grassmann.K1 p))) (E0 (Grassmann.vn_eparams p n)) | S p1 => @pair (Grassmann.vect p n) (Grassmann.vect p n) (E0 (Grassmann.vn_eparams p n)) (gen p n p1) end in let (y1, y2) := match j with | O => @pair (Grassmann.vect p n) (Grassmann.vect p n) (genk p n (v1 (Grassmann.K1 p))) (E0 (Grassmann.vn_eparams p n)) | S p1 => @pair (Grassmann.vect p n) (Grassmann.vect p n) (E0 (Grassmann.vn_eparams p n)) (gen p n p1) end in @pair (Grassmann.vect p n) (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) (gprod n l1 x1 y2) (gprod n l1 (conj p n false x2) y1)) (addE (Grassmann.vn_eparams p n) (gprod n l1 x2 y2) (scalE (Grassmann.vn_eparams p n) k1 (gprod n l1 (conj p n false x1) y1)))) (let (l2, l3) := let (k1, l1) := l in let (x1, x2) := match j with | O => @pair (Grassmann.vect p n) (Grassmann.vect p n) (genk p n (v1 (Grassmann.K1 p))) (E0 (Grassmann.vn_eparams p n)) | S p1 => @pair (Grassmann.vect p n) (Grassmann.vect p n) (E0 (Grassmann.vn_eparams p n)) (gen p n p1) end in let (y1, y2) := match i with | O => @pair (Grassmann.vect p n) (Grassmann.vect p n) (genk p n (v1 (Grassmann.K1 p))) (E0 (Grassmann.vn_eparams p n)) | S p1 => @pair (Grassmann.vect p n) (Grassmann.vect p n) (E0 (Grassmann.vn_eparams p n)) (gen p n p1) end in @pair (Grassmann.vect p n) (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) (gprod n l1 x1 y2) (gprod n l1 (conj p n false x2) y1)) (addE (Grassmann.vn_eparams p n) (gprod n l1 x2 y2) (scalE (Grassmann.vn_eparams p n) k1 (gprod n l1 (conj p n false x1) y1))) in @pair (Grassmann.vect p n) (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) (oppK (Grassmann.K1 p) (v1 (Grassmann.K1 p))) l2) (scalE (Grassmann.vn_eparams p n) (oppK (Grassmann.K1 p) (v1 (Grassmann.K1 p))) l3)) *)
destruct l; intros [|i] [|j]; simpl.
(* Goal: forall (_ : lt O (S n)) (_ : lt O (S n)) (_ : not (@Logic.eq nat O O)), @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (let (k, l1) := l in @pair (Grassmann.vect p n) (Grassmann.vect p n) (l_contra n l1 (conj p n false (genk p n (v0 (Grassmann.K1 p)))) (genk p n (v1 (Grassmann.K1 p)))) (add p n (scal p n k (l_contra n l1 (conj p n false (genk p n (v1 (Grassmann.K1 p)))) (genk p n (v1 (Grassmann.K1 p))))) (l_contra n l1 (genk p n (v0 (Grassmann.K1 p))) (genk p n (v0 (Grassmann.K1 p)))))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (genk p n (v0 (Grassmann.K1 p))) (genk p n (v0 (Grassmann.K1 p)))) *)
(* Goal: forall (_ : lt O (S n)) (_ : lt (S j) (S n)) (_ : not (@Logic.eq nat O (S j))), @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (let (k, l1) := l in @pair (Grassmann.vect p n) (Grassmann.vect p n) (l_contra n l1 (conj p n false (genk p n (v0 (Grassmann.K1 p)))) (genk p n (v0 (Grassmann.K1 p)))) (add p n (scal p n k (l_contra n l1 (conj p n false (genk p n (v1 (Grassmann.K1 p)))) (genk p n (v0 (Grassmann.K1 p))))) (l_contra n l1 (genk p n (v0 (Grassmann.K1 p))) (gen p n j)))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (genk p n (v0 (Grassmann.K1 p))) (genk p n (v0 (Grassmann.K1 p)))) *)
(* Goal: forall (_ : lt (S i) (S n)) (_ : lt O (S n)) (_ : not (@Logic.eq nat (S i) O)), @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (let (k, l1) := l in @pair (Grassmann.vect p n) (Grassmann.vect p n) (l_contra n l1 (conj p n false (gen p n i)) (genk p n (v1 (Grassmann.K1 p)))) (add p n (scal p n k (l_contra n l1 (conj p n false (genk p n (v0 (Grassmann.K1 p)))) (genk p n (v1 (Grassmann.K1 p))))) (l_contra n l1 (gen p n i) (genk p n (v0 (Grassmann.K1 p)))))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (genk p n (v0 (Grassmann.K1 p))) (genk p n (v0 (Grassmann.K1 p)))) *)
(* Goal: forall (_ : lt (S i) (S n)) (_ : lt (S j) (S n)) (_ : not (@Logic.eq nat (S i) (S j))), @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (let (k, l1) := l in @pair (Grassmann.vect p n) (Grassmann.vect p n) (l_contra n l1 (conj p n false (gen p n i)) (genk p n (v0 (Grassmann.K1 p)))) (add p n (scal p n k (l_contra n l1 (conj p n false (genk p n (v0 (Grassmann.K1 p)))) (genk p n (v0 (Grassmann.K1 p))))) (l_contra n l1 (gen p n i) (gen p n j)))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (genk p n (v0 (Grassmann.K1 p))) (genk p n (v0 (Grassmann.K1 p)))) *)
intros H1 H2 []; auto.
(* Goal: forall (_ : lt (S i) (S n)) (_ : lt (S j) (S n)) (_ : not (@Logic.eq nat (S i) (S j))), @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (add p n (gprod n k0 (genk p n (v0 (Grassmann.K1 p))) (gen p n j)) (gprod n k0 (conj p n false (gen p n i)) (genk p n (v0 (Grassmann.K1 p))))) (add p n (gprod n k0 (gen p n i) (gen p n j)) (scal p n k (gprod n k0 (conj p n false (genk p n (v0 (Grassmann.K1 p)))) (genk p n (v0 (Grassmann.K1 p))))))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (scal p n (oppK (Grassmann.K1 p) (v1 (Grassmann.K1 p))) (add p n (gprod n k0 (genk p n (v0 (Grassmann.K1 p))) (gen p n i)) (gprod n k0 (conj p n false (gen p n j)) (genk p n (v0 (Grassmann.K1 p)))))) (scal p n (oppK (Grassmann.K1 p) (v1 (Grassmann.K1 p))) (add p n (gprod n k0 (gen p n j) (gen p n i)) (scal p n k (gprod n k0 (conj p n false (genk p n (v0 (Grassmann.K1 p)))) (genk p n (v0 (Grassmann.K1 p)))))))) *)
intros.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (add p n (gprod n k0 (genk p n (v0 (Grassmann.K1 p))) (genk p n (v0 (Grassmann.K1 p)))) (gprod n k0 (conj p n false (gen p n i)) (genk p n (v1 (Grassmann.K1 p))))) (add p n (gprod n k0 (gen p n i) (genk p n (v0 (Grassmann.K1 p)))) (scal p n k (gprod n k0 (conj p n false (genk p n (v0 (Grassmann.K1 p)))) (genk p n (v1 (Grassmann.K1 p))))))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (scal p n (oppK (Grassmann.K1 p) (v1 (Grassmann.K1 p))) (add p n (gprod n k0 (genk p n (v1 (Grassmann.K1 p))) (gen p n i)) (gprod n k0 (conj p n false (genk p n (v0 (Grassmann.K1 p)))) (genk p n (v0 (Grassmann.K1 p)))))) (scal p n (oppK (Grassmann.K1 p) (v1 (Grassmann.K1 p))) (add p n (gprod n k0 (genk p n (v0 (Grassmann.K1 p))) (gen p n i)) (scal p n k (gprod n k0 (conj p n false (genk p n (v1 (Grassmann.K1 p)))) (genk p n (v0 (Grassmann.K1 p)))))))) *)
(* Goal: forall (_ : lt (S i) (S n)) (_ : lt (S j) (S n)) (_ : not (@Logic.eq nat (S i) (S j))), @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (add p n (gprod n k0 (genk p n (v0 (Grassmann.K1 p))) (gen p n j)) (gprod n k0 (conj p n false (gen p n i)) (genk p n (v0 (Grassmann.K1 p))))) (add p n (gprod n k0 (gen p n i) (gen p n j)) (scal p n k (gprod n k0 (conj p n false (genk p n (v0 (Grassmann.K1 p)))) (genk p n (v0 (Grassmann.K1 p))))))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (scal p n (oppK (Grassmann.K1 p) (v1 (Grassmann.K1 p))) (add p n (gprod n k0 (genk p n (v0 (Grassmann.K1 p))) (gen p n i)) (gprod n k0 (conj p n false (gen p n j)) (genk p n (v0 (Grassmann.K1 p)))))) (scal p n (oppK (Grassmann.K1 p) (v1 (Grassmann.K1 p))) (add p n (gprod n k0 (gen p n j) (gen p n i)) (scal p n k (gprod n k0 (conj p n false (genk p n (v0 (Grassmann.K1 p)))) (genk p n (v0 (Grassmann.K1 p)))))))) *)
rewrite !conjk, !gprod0l, !gprod0r; Vfold n; Vrm0.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (gprod n k0 (genk p n (v1 (Grassmann.K1 p))) (gen p n j)) (E0 (Grassmann.vn_eparams p n))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) (oppK (Grassmann.K1 p) (v1 (Grassmann.K1 p))) (gprod n k0 (conj p n false (gen p n j)) (genk p n (v1 (Grassmann.K1 p))))) (E0 (Grassmann.vn_eparams p n))) *)
(* Goal: forall (_ : lt (S i) (S n)) (_ : lt O (S n)) (_ : not (@Logic.eq nat (S i) O)), @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (add p n (gprod n k0 (genk p n (v0 (Grassmann.K1 p))) (genk p n (v0 (Grassmann.K1 p)))) (gprod n k0 (conj p n false (gen p n i)) (genk p n (v1 (Grassmann.K1 p))))) (add p n (gprod n k0 (gen p n i) (genk p n (v0 (Grassmann.K1 p)))) (scal p n k (gprod n k0 (conj p n false (genk p n (v0 (Grassmann.K1 p)))) (genk p n (v1 (Grassmann.K1 p))))))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (scal p n (oppK (Grassmann.K1 p) (v1 (Grassmann.K1 p))) (add p n (gprod n k0 (genk p n (v1 (Grassmann.K1 p))) (gen p n i)) (gprod n k0 (conj p n false (genk p n (v0 (Grassmann.K1 p)))) (genk p n (v0 (Grassmann.K1 p)))))) (scal p n (oppK (Grassmann.K1 p) (v1 (Grassmann.K1 p))) (add p n (gprod n k0 (genk p n (v0 (Grassmann.K1 p))) (gen p n i)) (scal p n k (gprod n k0 (conj p n false (genk p n (v1 (Grassmann.K1 p)))) (genk p n (v0 (Grassmann.K1 p)))))))) *)
(* Goal: forall (_ : lt (S i) (S n)) (_ : lt (S j) (S n)) (_ : not (@Logic.eq nat (S i) (S j))), @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (add p n (gprod n k0 (genk p n (v0 (Grassmann.K1 p))) (gen p n j)) (gprod n k0 (conj p n false (gen p n i)) (genk p n (v0 (Grassmann.K1 p))))) (add p n (gprod n k0 (gen p n i) (gen p n j)) (scal p n k (gprod n k0 (conj p n false (genk p n (v0 (Grassmann.K1 p)))) (genk p n (v0 (Grassmann.K1 p))))))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (scal p n (oppK (Grassmann.K1 p) (v1 (Grassmann.K1 p))) (add p n (gprod n k0 (genk p n (v0 (Grassmann.K1 p))) (gen p n i)) (gprod n k0 (conj p n false (gen p n j)) (genk p n (v0 (Grassmann.K1 p)))))) (scal p n (oppK (Grassmann.K1 p) (v1 (Grassmann.K1 p))) (add p n (gprod n k0 (gen p n j) (gen p n i)) (scal p n k (gprod n k0 (conj p n false (genk p n (v0 (Grassmann.K1 p)))) (genk p n (v0 (Grassmann.K1 p)))))))) *)
rewrite gprodkr, gprodkl, conj_e, <-!scal_multE; Krm1; auto with arith.
(* Goal: forall (_ : lt (S i) (S n)) (_ : lt (S j) (S n)) (_ : not (@Logic.eq nat (S i) (S j))), @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (add p n (gprod n k0 (genk p n (v0 (Grassmann.K1 p))) (gen p n j)) (gprod n k0 (conj p n false (gen p n i)) (genk p n (v0 (Grassmann.K1 p))))) (add p n (gprod n k0 (gen p n i) (gen p n j)) (scal p n k (gprod n k0 (conj p n false (genk p n (v0 (Grassmann.K1 p)))) (genk p n (v0 (Grassmann.K1 p))))))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (scal p n (oppK (Grassmann.K1 p) (v1 (Grassmann.K1 p))) (add p n (gprod n k0 (genk p n (v0 (Grassmann.K1 p))) (gen p n i)) (gprod n k0 (conj p n false (gen p n j)) (genk p n (v0 (Grassmann.K1 p)))))) (scal p n (oppK (Grassmann.K1 p) (v1 (Grassmann.K1 p))) (add p n (gprod n k0 (gen p n j) (gen p n i)) (scal p n k (gprod n k0 (conj p n false (genk p n (v0 (Grassmann.K1 p)))) (genk p n (v0 (Grassmann.K1 p)))))))) *)
intros.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (add p n (gprod n k0 (genk p n (v0 (Grassmann.K1 p))) (genk p n (v0 (Grassmann.K1 p)))) (gprod n k0 (conj p n false (gen p n i)) (genk p n (v1 (Grassmann.K1 p))))) (add p n (gprod n k0 (gen p n i) (genk p n (v0 (Grassmann.K1 p)))) (scal p n k (gprod n k0 (conj p n false (genk p n (v0 (Grassmann.K1 p)))) (genk p n (v1 (Grassmann.K1 p))))))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (scal p n (oppK (Grassmann.K1 p) (v1 (Grassmann.K1 p))) (add p n (gprod n k0 (genk p n (v1 (Grassmann.K1 p))) (gen p n i)) (gprod n k0 (conj p n false (genk p n (v0 (Grassmann.K1 p)))) (genk p n (v0 (Grassmann.K1 p)))))) (scal p n (oppK (Grassmann.K1 p) (v1 (Grassmann.K1 p))) (add p n (gprod n k0 (genk p n (v0 (Grassmann.K1 p))) (gen p n i)) (scal p n k (gprod n k0 (conj p n false (genk p n (v1 (Grassmann.K1 p)))) (genk p n (v0 (Grassmann.K1 p)))))))) *)
(* Goal: forall (_ : lt (S i) (S n)) (_ : lt (S j) (S n)) (_ : not (@Logic.eq nat (S i) (S j))), @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (add p n (gprod n k0 (genk p n (v0 (Grassmann.K1 p))) (gen p n j)) (gprod n k0 (conj p n false (gen p n i)) (genk p n (v0 (Grassmann.K1 p))))) (add p n (gprod n k0 (gen p n i) (gen p n j)) (scal p n k (gprod n k0 (conj p n false (genk p n (v0 (Grassmann.K1 p)))) (genk p n (v0 (Grassmann.K1 p))))))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (scal p n (oppK (Grassmann.K1 p) (v1 (Grassmann.K1 p))) (add p n (gprod n k0 (genk p n (v0 (Grassmann.K1 p))) (gen p n i)) (gprod n k0 (conj p n false (gen p n j)) (genk p n (v0 (Grassmann.K1 p)))))) (scal p n (oppK (Grassmann.K1 p) (v1 (Grassmann.K1 p))) (add p n (gprod n k0 (gen p n j) (gen p n i)) (scal p n k (gprod n k0 (conj p n false (genk p n (v0 (Grassmann.K1 p)))) (genk p n (v0 (Grassmann.K1 p)))))))) *)
rewrite !conjk, !gprod0l, !gprod0r; Vfold n; Vrm0.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (gprod n k0 (conj p n false (gen p n i)) (genk p n (v1 (Grassmann.K1 p)))) (E0 (Grassmann.vn_eparams p n))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) (oppK (Grassmann.K1 p) (v1 (Grassmann.K1 p))) (gprod n k0 (genk p n (v1 (Grassmann.K1 p))) (gen p n i))) (E0 (Grassmann.vn_eparams p n))) *)
(* Goal: forall (_ : lt (S i) (S n)) (_ : lt (S j) (S n)) (_ : not (@Logic.eq nat (S i) (S j))), @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (add p n (gprod n k0 (genk p n (v0 (Grassmann.K1 p))) (gen p n j)) (gprod n k0 (conj p n false (gen p n i)) (genk p n (v0 (Grassmann.K1 p))))) (add p n (gprod n k0 (gen p n i) (gen p n j)) (scal p n k (gprod n k0 (conj p n false (genk p n (v0 (Grassmann.K1 p)))) (genk p n (v0 (Grassmann.K1 p))))))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (scal p n (oppK (Grassmann.K1 p) (v1 (Grassmann.K1 p))) (add p n (gprod n k0 (genk p n (v0 (Grassmann.K1 p))) (gen p n i)) (gprod n k0 (conj p n false (gen p n j)) (genk p n (v0 (Grassmann.K1 p)))))) (scal p n (oppK (Grassmann.K1 p) (v1 (Grassmann.K1 p))) (add p n (gprod n k0 (gen p n j) (gen p n i)) (scal p n k (gprod n k0 (conj p n false (genk p n (v0 (Grassmann.K1 p)))) (genk p n (v0 (Grassmann.K1 p)))))))) *)
rewrite gprodkr, gprodkl, conj_e; auto with arith.
(* Goal: @Logic.eq (VectorSpace.E (Grassmann.vn_eparams p n)) (scalE (Grassmann.vn_eparams p n) k (l_contra n k0 v (conj p n false v1))) (scalE (Grassmann.vn_eparams p n) k (scalE (Grassmann.vn_eparams p n) (oppK (stype (Grassmann.vn_eparams p n)) (Field.v1 (stype (Grassmann.vn_eparams p n)))) (scalE (Grassmann.vn_eparams p n) (oppK (stype (Grassmann.vn_eparams p n)) (Field.v1 (stype (Grassmann.vn_eparams p n)))) (l_contra n k0 v (conj p n false v1))))) *)
rewrite <-!scal_multE; Krm1.
(* Goal: forall (_ : lt (S i) (S n)) (_ : lt (S j) (S n)) (_ : not (@Logic.eq nat (S i) (S j))), @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (add p n (gprod n k0 (genk p n (v0 (Grassmann.K1 p))) (gen p n j)) (gprod n k0 (conj p n false (gen p n i)) (genk p n (v0 (Grassmann.K1 p))))) (add p n (gprod n k0 (gen p n i) (gen p n j)) (scal p n k (gprod n k0 (conj p n false (genk p n (v0 (Grassmann.K1 p)))) (genk p n (v0 (Grassmann.K1 p))))))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (scal p n (oppK (Grassmann.K1 p) (v1 (Grassmann.K1 p))) (add p n (gprod n k0 (genk p n (v0 (Grassmann.K1 p))) (gen p n i)) (gprod n k0 (conj p n false (gen p n j)) (genk p n (v0 (Grassmann.K1 p)))))) (scal p n (oppK (Grassmann.K1 p) (v1 (Grassmann.K1 p))) (add p n (gprod n k0 (gen p n j) (gen p n i)) (scal p n k (gprod n k0 (conj p n false (genk p n (v0 (Grassmann.K1 p)))) (genk p n (v0 (Grassmann.K1 p)))))))) *)
intros.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (add p n (gprod n k0 (genk p n (v0 (Grassmann.K1 p))) (gen p n j)) (gprod n k0 (conj p n false (gen p n i)) (genk p n (v0 (Grassmann.K1 p))))) (add p n (gprod n k0 (gen p n i) (gen p n j)) (scal p n k (gprod n k0 (conj p n false (genk p n (v0 (Grassmann.K1 p)))) (genk p n (v0 (Grassmann.K1 p))))))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (scal p n (oppK (Grassmann.K1 p) (v1 (Grassmann.K1 p))) (add p n (gprod n k0 (genk p n (v0 (Grassmann.K1 p))) (gen p n i)) (gprod n k0 (conj p n false (gen p n j)) (genk p n (v0 (Grassmann.K1 p)))))) (scal p n (oppK (Grassmann.K1 p) (v1 (Grassmann.K1 p))) (add p n (gprod n k0 (gen p n j) (gen p n i)) (scal p n k (gprod n k0 (conj p n false (genk p n (v0 (Grassmann.K1 p)))) (genk p n (v0 (Grassmann.K1 p)))))))) *)
rewrite!gprod0l, !gprod0r; Vfold n; Vrm0.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (E0 (Grassmann.vn_eparams p n)) (l_contra n k0 (gen p n i) (gen p n j))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (genk p n (v0 (Grassmann.K1 p))) (genk p n (v0 (Grassmann.K1 p)))) *)
rewrite IH; auto with arith.
Qed.

Lemma gprod_scall n l k x y : (k .* x) [* l] y = k .* (x [* l] y) :> vect n.
Proof.
(* Goal: @Logic.eq (Field.K (K1 p)) (prod_scal n l x y) (prod_scal n l y x) *)
induction n as [| n IH]; simpl; try Vfold n; Krm0.
(* Goal: @Logic.eq (Field.K (K1 p)) (multK (Grassmann.K1 p) (multK (Grassmann.K1 p) k x) y) (multK (Grassmann.K1 p) k (multK (Grassmann.K1 p) x y)) *)
(* Goal: @Logic.eq (Field.K (K1 p)) (let (k0, l1) := l in let (x1, x2) := let (l2, l3) := x in @pair (Grassmann.vect p n) (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) k l2) (scalE (Grassmann.vn_eparams p n) k l3) in let (y1, y2) := y in addK (K1 p) (prod_scal n l1 x2 y2) (multK (K1 p) k0 (prod_scal n l1 x1 (conj p n false y1)))) (multK (Grassmann.K1 p) k (let (k, l1) := l in let (x1, x2) := x in let (y1, y2) := y in addK (K1 p) (prod_scal n l1 x2 y2) (multK (K1 p) k (prod_scal n l1 x1 (conj p n false y1))))) *)
intros; rewrite multK_assoc; auto.
(* Goal: @Logic.eq (Field.K (K1 p)) (let (k0, l1) := l in let (x1, x2) := x in let (y1, y2) := let (l2, l3) := y in @pair (Grassmann.vect p n) (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) k l2) (scalE (Grassmann.vn_eparams p n) k l3) in addK (K1 p) (prod_scal n l1 x2 y2) (multK (K1 p) k0 (prod_scal n l1 x1 (conj p n false y1)))) (multK (Grassmann.K1 p) k (let (k, l1) := l in let (x1, x2) := x in let (y1, y2) := y in addK (K1 p) (prod_scal n l1 x2 y2) (multK (K1 p) k (prod_scal n l1 x1 (conj p n false y1))))) *)
destruct l; destruct x; destruct y; simpl; auto; Vfold n.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) (gprod n k1 (scalE (Grassmann.vn_eparams p n) k v) v2) (gprod n k1 (conj p n false (scalE (Grassmann.vn_eparams p n) k v0)) v1)) (addE (Grassmann.vn_eparams p n) (gprod n k1 (scalE (Grassmann.vn_eparams p n) k v0) v2) (scalE (Grassmann.vn_eparams p n) k0 (gprod n k1 (conj p n false (scalE (Grassmann.vn_eparams p n) k v)) v1)))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) k (addE (Grassmann.vn_eparams p n) (gprod n k1 v v2) (gprod n k1 (conj p n false v0) v1))) (scalE (Grassmann.vn_eparams p n) k (addE (Grassmann.vn_eparams p n) (gprod n k1 v0 v2) (scalE (Grassmann.vn_eparams p n) k0 (gprod n k1 (conj p n false v) v1))))) *)
rewrite !conj_scal, !scal_addEr, !IH, <-!scal_multE; auto.
(* Goal: @Logic.eq (Field.K (K1 p)) (multK (stype (Grassmann.vn_eparams p n)) k0 k) (multK (K1 p) k k0) *)
rewrite multK_com; auto.
Qed.

Lemma gprod_scalr n l k x y : x [* l] (k .* y) = k .* (x [* l] y) :> vect n.
Proof.
(* Goal: @Logic.eq (Field.K (K1 p)) (prod_scal n l x y) (prod_scal n l y x) *)
induction n as [| n IH]; simpl; try Vfold n; Krm0.
(* Goal: @Logic.eq (Field.K (K1 p)) (multK (Grassmann.K1 p) x (multK (Grassmann.K1 p) k y)) (multK (Grassmann.K1 p) k (multK (Grassmann.K1 p) x y)) *)
(* Goal: @Logic.eq (Field.K (K1 p)) (let (k0, l1) := l in let (x1, x2) := x in let (y1, y2) := let (l2, l3) := y in @pair (Grassmann.vect p n) (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) k l2) (scalE (Grassmann.vn_eparams p n) k l3) in addK (K1 p) (prod_scal n l1 x2 y2) (multK (K1 p) k0 (prod_scal n l1 x1 (conj p n false y1)))) (multK (Grassmann.K1 p) k (let (k, l1) := l in let (x1, x2) := x in let (y1, y2) := y in addK (K1 p) (prod_scal n l1 x2 y2) (multK (K1 p) k (prod_scal n l1 x1 (conj p n false y1))))) *)
intros; rewrite multK_swap; auto.
(* Goal: @Logic.eq (Field.K (K1 p)) (let (k0, l1) := l in let (x1, x2) := x in let (y1, y2) := let (l2, l3) := y in @pair (Grassmann.vect p n) (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) k l2) (scalE (Grassmann.vn_eparams p n) k l3) in addK (K1 p) (prod_scal n l1 x2 y2) (multK (K1 p) k0 (prod_scal n l1 x1 (conj p n false y1)))) (multK (Grassmann.K1 p) k (let (k, l1) := l in let (x1, x2) := x in let (y1, y2) := y in addK (K1 p) (prod_scal n l1 x2 y2) (multK (K1 p) k (prod_scal n l1 x1 (conj p n false y1))))) *)
destruct l; destruct x; destruct y; simpl; auto; Vfold n.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) (gprod n k1 v (scalE (Grassmann.vn_eparams p n) k v2)) (gprod n k1 (conj p n false v0) (scalE (Grassmann.vn_eparams p n) k v1))) (addE (Grassmann.vn_eparams p n) (gprod n k1 v0 (scalE (Grassmann.vn_eparams p n) k v2)) (scalE (Grassmann.vn_eparams p n) k0 (gprod n k1 (conj p n false v) (scalE (Grassmann.vn_eparams p n) k v1))))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) k (addE (Grassmann.vn_eparams p n) (gprod n k1 v v2) (gprod n k1 (conj p n false v0) v1))) (scalE (Grassmann.vn_eparams p n) k (addE (Grassmann.vn_eparams p n) (gprod n k1 v0 v2) (scalE (Grassmann.vn_eparams p n) k0 (gprod n k1 (conj p n false v) v1))))) *)
rewrite !scal_addEr, !IH; auto.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (gprod n k1 v v2)) (scalE (Grassmann.vn_eparams p n) k (gprod n k1 (conj p n false v0) v1))) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (gprod n k1 v0 v2)) (scalE (Grassmann.vn_eparams p n) k0 (scalE (Grassmann.vn_eparams p n) k (gprod n k1 (conj p n false v) v1))))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (gprod n k1 v v2)) (scalE (Grassmann.vn_eparams p n) k (gprod n k1 (conj p n false v0) v1))) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (gprod n k1 v0 v2)) (scalE (Grassmann.vn_eparams p n) k (scalE (Grassmann.vn_eparams p n) k0 (gprod n k1 (conj p n false v) v1))))) *)
rewrite <-!scal_multE; auto.
(* Goal: @Logic.eq (Field.K (K1 p)) (multK (stype (Grassmann.vn_eparams p n)) k0 k) (multK (K1 p) k k0) *)
rewrite multK_com; auto.
Qed.

Lemma gprod_addl n l x y z : 
  (x + y) [* l] z = x [* l] z + y [* l] z :> vect n.
Proof.
(* Goal: @Logic.eq (Field.K (K1 p)) (prod_scal n l x y) (prod_scal n l y x) *)
induction n as [| n IH]; simpl; try Vfold n; Krm0.
(* Goal: @Logic.eq (Field.K (K1 p)) (multK (Grassmann.K1 p) (addK (Grassmann.K1 p) x y) z) (addK (K1 p) (multK (Grassmann.K1 p) x z) (multK (Grassmann.K1 p) y z)) *)
(* Goal: @Logic.eq (Field.K (K1 p)) (let (k, l1) := l in let (x1, x2) := let (l3, l5) := x in let (l4, l6) := y in @pair (Grassmann.vect p n) (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) l3 l4) (addE (Grassmann.vn_eparams p n) l5 l6) in let (y1, y2) := z in addK (K1 p) (prod_scal n l1 x2 y2) (multK (K1 p) k (prod_scal n l1 x1 (conj p n false y1)))) (addK (K1 p) (let (k, l1) := l in let (x1, x2) := x in let (y1, y2) := z in addK (K1 p) (prod_scal n l1 x2 y2) (multK (K1 p) k (prod_scal n l1 x1 (conj p n false y1)))) (let (k, l1) := l in let (x1, x2) := y in let (y1, y2) := z in addK (K1 p) (prod_scal n l1 x2 y2) (multK (K1 p) k (prod_scal n l1 x1 (conj p n false y1))))) *)
intros; rewrite add_multKl; auto.
(* Goal: @Logic.eq (Field.K (K1 p)) (let (k, l1) := l in let (x1, x2) := x in let (y1, y2) := let (l3, l5) := y in let (l4, l6) := z in @pair (Grassmann.vect p n) (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) l3 l4) (addE (Grassmann.vn_eparams p n) l5 l6) in addK (K1 p) (prod_scal n l1 x2 y2) (multK (K1 p) k (prod_scal n l1 x1 (conj p n false y1)))) (addK (K1 p) (let (k, l1) := l in let (x1, x2) := x in let (y1, y2) := y in addK (K1 p) (prod_scal n l1 x2 y2) (multK (K1 p) k (prod_scal n l1 x1 (conj p n false y1)))) (let (k, l1) := l in let (x1, x2) := x in let (y1, y2) := z in addK (K1 p) (prod_scal n l1 x2 y2) (multK (K1 p) k (prod_scal n l1 x1 (conj p n false y1))))) *)
destruct l; destruct x; destruct y; destruct z; simpl; Vfold n.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) (gprod n k0 (addE (Grassmann.vn_eparams p n) v v1) v4) (gprod n k0 (conj p n false (addE (Grassmann.vn_eparams p n) v0 v2)) v3)) (addE (Grassmann.vn_eparams p n) (gprod n k0 (addE (Grassmann.vn_eparams p n) v0 v2) v4) (scalE (Grassmann.vn_eparams p n) k (gprod n k0 (conj p n false (addE (Grassmann.vn_eparams p n) v v1)) v3)))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) (addE (Grassmann.vn_eparams p n) (gprod n k0 v v4) (gprod n k0 (conj p n false v0) v3)) (addE (Grassmann.vn_eparams p n) (gprod n k0 v1 v4) (gprod n k0 (conj p n false v2) v3))) (addE (Grassmann.vn_eparams p n) (addE (Grassmann.vn_eparams p n) (gprod n k0 v0 v4) (scalE (Grassmann.vn_eparams p n) k (gprod n k0 (conj p n false v) v3))) (addE (Grassmann.vn_eparams p n) (gprod n k0 v2 v4) (scalE (Grassmann.vn_eparams p n) k (gprod n k0 (conj p n false v1) v3))))) *)
rewrite !conj_add, !IH; auto.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) (addE (Grassmann.vn_eparams p n) (gprod n k0 v v2) (gprod n k0 v v4)) (addE (Grassmann.vn_eparams p n) (gprod n k0 (conj p n false v0) v1) (gprod n k0 (conj p n false v0) v3))) (addE (Grassmann.vn_eparams p n) (addE (Grassmann.vn_eparams p n) (gprod n k0 v0 v2) (gprod n k0 v0 v4)) (scalE (Grassmann.vn_eparams p n) k (addE (Grassmann.vn_eparams p n) (gprod n k0 (conj p n false v) v1) (gprod n k0 (conj p n false v) v3))))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) (addE (Grassmann.vn_eparams p n) (gprod n k0 v v2) (gprod n k0 (conj p n false v0) v1)) (addE (Grassmann.vn_eparams p n) (gprod n k0 v v4) (gprod n k0 (conj p n false v0) v3))) (addE (Grassmann.vn_eparams p n) (addE (Grassmann.vn_eparams p n) (gprod n k0 v0 v2) (scalE (Grassmann.vn_eparams p n) k (gprod n k0 (conj p n false v) v1))) (addE (Grassmann.vn_eparams p n) (gprod n k0 v0 v4) (scalE (Grassmann.vn_eparams p n) k (gprod n k0 (conj p n false v) v3))))) *)
apply f_equal2 with (f := @pair _ _).
(* Goal: @Logic.eq (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) (addE (Grassmann.vn_eparams p n) (join p n (k2g p n v1) M) (contra p n (kprod p n v1 l) M)) (addE (Grassmann.vn_eparams p n) (join p n (k2g p n v2) M) (contra p n (kprod p n v2 l) M))) (addE (Grassmann.vn_eparams p n) (addE (Grassmann.vn_eparams p n) (join p n (k2g p n v1) M) (join p n (k2g p n v2) M)) (addE (Grassmann.vn_eparams p n) (contra p n (kprod p n v1 l) M) (contra p n (kprod p n v2 l) M))) *)
(* Goal: forall (k : Field.K (stype (Kn.vn_eparams p n))) (v : Kn.kn p n) (_ : @Logic.eq (Grassmann.vect p n) (gprod n l (k2g p n v) M) (addE (Grassmann.vn_eparams p n) (join p n (k2g p n v) M) (contra p n (kprod p n v l) M))), @Logic.eq (Grassmann.vect p n) (gprod n l (k2g p n (scalE (Kn.vn_eparams p n) k v)) M) (addE (Grassmann.vn_eparams p n) (join p n (k2g p n (scalE (Kn.vn_eparams p n) k v)) M) (contra p n (kprod p n (scalE (Kn.vn_eparams p n) k v) l) M)) *)
  rewrite !addE_assoc; auto.
(* Goal: @Logic.eq (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (l_contra n k0 v (conj p n false v1))) (l_contra n k0 (conj p n false v0) (conj p n false v2))) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (scalE (Grassmann.vn_eparams p n) (oppK (stype (Grassmann.vn_eparams p n)) (Field.v1 (stype (Grassmann.vn_eparams p n)))) (scalE (Grassmann.vn_eparams p n) (oppK (stype (Grassmann.vn_eparams p n)) (Field.v1 (stype (Grassmann.vn_eparams p n)))) (l_contra n k0 v (conj p n false v1))))) (l_contra n k0 (conj p n false v0) (conj p n false v2))) *)
  apply f_equal2 with (f := addE _); auto.
(* Goal: @Logic.eq (VectorSpace.E (Grassmann.vn_eparams p n)) (addE (Grassmann.vn_eparams p n) (gprod n k0 v v4) (addE (Grassmann.vn_eparams p n) (gprod n k0 (conj p n false v0) v1) (gprod n k0 (conj p n false v0) v3))) (addE (Grassmann.vn_eparams p n) (gprod n k0 (conj p n false v0) v1) (addE (Grassmann.vn_eparams p n) (gprod n k0 v v4) (gprod n k0 (conj p n false v0) v3))) *)
(* Goal: @Logic.eq (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) (addE (Grassmann.vn_eparams p n) (gprod n k0 v0 v2) (gprod n k0 v0 v4)) (scalE (Grassmann.vn_eparams p n) k (addE (Grassmann.vn_eparams p n) (gprod n k0 (conj p n false v) v1) (gprod n k0 (conj p n false v) v3)))) (addE (Grassmann.vn_eparams p n) (addE (Grassmann.vn_eparams p n) (gprod n k0 v0 v2) (scalE (Grassmann.vn_eparams p n) k (gprod n k0 (conj p n false v) v1))) (addE (Grassmann.vn_eparams p n) (gprod n k0 v0 v4) (scalE (Grassmann.vn_eparams p n) k (gprod n k0 (conj p n false v) v3)))) *)
  rewrite addE_swap; auto.
(* Goal: @Logic.eq (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) (addE (Grassmann.vn_eparams p n) (join p n (k2g p n v1) M) (contra p n (kprod p n v1 l) M)) (addE (Grassmann.vn_eparams p n) (join p n (k2g p n v2) M) (contra p n (kprod p n v2 l) M))) (addE (Grassmann.vn_eparams p n) (addE (Grassmann.vn_eparams p n) (join p n (k2g p n v1) M) (join p n (k2g p n v2) M)) (addE (Grassmann.vn_eparams p n) (contra p n (kprod p n v1 l) M) (contra p n (kprod p n v2 l) M))) *)
(* Goal: forall (k : Field.K (stype (Kn.vn_eparams p n))) (v : Kn.kn p n) (_ : @Logic.eq (Grassmann.vect p n) (gprod n l (k2g p n v) M) (addE (Grassmann.vn_eparams p n) (join p n (k2g p n v) M) (contra p n (kprod p n v l) M))), @Logic.eq (Grassmann.vect p n) (gprod n l (k2g p n (scalE (Kn.vn_eparams p n) k v)) M) (addE (Grassmann.vn_eparams p n) (join p n (k2g p n (scalE (Kn.vn_eparams p n) k v)) M) (contra p n (kprod p n (scalE (Kn.vn_eparams p n) k v) l) M)) *)
rewrite !addE_assoc; auto.
(* Goal: @Logic.eq (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (l_contra n k0 v (conj p n false v1))) (l_contra n k0 (conj p n false v0) (conj p n false v2))) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (scalE (Grassmann.vn_eparams p n) (oppK (stype (Grassmann.vn_eparams p n)) (Field.v1 (stype (Grassmann.vn_eparams p n)))) (scalE (Grassmann.vn_eparams p n) (oppK (stype (Grassmann.vn_eparams p n)) (Field.v1 (stype (Grassmann.vn_eparams p n)))) (l_contra n k0 v (conj p n false v1))))) (l_contra n k0 (conj p n false v0) (conj p n false v2))) *)
apply f_equal2 with (f := addE _); auto.
(* Goal: @Logic.eq (VectorSpace.E (Grassmann.vn_eparams p n)) (addE (Grassmann.vn_eparams p n) (gprod n k0 v v4) (addE (Grassmann.vn_eparams p n) (gprod n k0 (conj p n false v0) v1) (gprod n k0 (conj p n false v0) v3))) (addE (Grassmann.vn_eparams p n) (gprod n k0 (conj p n false v0) v1) (addE (Grassmann.vn_eparams p n) (gprod n k0 v v4) (gprod n k0 (conj p n false v0) v3))) *)
(* Goal: @Logic.eq (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) (addE (Grassmann.vn_eparams p n) (gprod n k0 v0 v2) (gprod n k0 v0 v4)) (scalE (Grassmann.vn_eparams p n) k (addE (Grassmann.vn_eparams p n) (gprod n k0 (conj p n false v) v1) (gprod n k0 (conj p n false v) v3)))) (addE (Grassmann.vn_eparams p n) (addE (Grassmann.vn_eparams p n) (gprod n k0 v0 v2) (scalE (Grassmann.vn_eparams p n) k (gprod n k0 (conj p n false v) v1))) (addE (Grassmann.vn_eparams p n) (gprod n k0 v0 v4) (scalE (Grassmann.vn_eparams p n) k (gprod n k0 (conj p n false v) v3)))) *)
  rewrite addE_swap; auto.
(* Goal: @Logic.eq (VectorSpace.E (Grassmann.vn_eparams p n)) (addE (Grassmann.vn_eparams p n) (gprod n k0 v2 v4) (scalE (Grassmann.vn_eparams p n) k (addE (Grassmann.vn_eparams p n) (gprod n k0 (conj p n false v) v3) (gprod n k0 (conj p n false v1) v3)))) (addE (Grassmann.vn_eparams p n) (gprod n k0 v2 v4) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (gprod n k0 (conj p n false v) v3)) (scalE (Grassmann.vn_eparams p n) k (gprod n k0 (conj p n false v1) v3)))) *)
rewrite scal_addEr; auto.
Qed.

Lemma gprod_addr n l x y z :
   x [* l] (y + z) = x [* l] y + x [* l] z :> vect n.
Proof.
(* Goal: @Logic.eq (Field.K (K1 p)) (prod_scal n l x y) (prod_scal n l y x) *)
induction n as [| n IH]; simpl; try Vfold n; Krm0.
(* Goal: @Logic.eq (Field.K (K1 p)) (multK (Grassmann.K1 p) x (addK (Grassmann.K1 p) y z)) (addK (K1 p) (multK (Grassmann.K1 p) x y) (multK (Grassmann.K1 p) x z)) *)
(* Goal: @Logic.eq (Field.K (K1 p)) (let (k, l1) := l in let (x1, x2) := x in let (y1, y2) := let (l3, l5) := y in let (l4, l6) := z in @pair (Grassmann.vect p n) (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) l3 l4) (addE (Grassmann.vn_eparams p n) l5 l6) in addK (K1 p) (prod_scal n l1 x2 y2) (multK (K1 p) k (prod_scal n l1 x1 (conj p n false y1)))) (addK (K1 p) (let (k, l1) := l in let (x1, x2) := x in let (y1, y2) := y in addK (K1 p) (prod_scal n l1 x2 y2) (multK (K1 p) k (prod_scal n l1 x1 (conj p n false y1)))) (let (k, l1) := l in let (x1, x2) := x in let (y1, y2) := z in addK (K1 p) (prod_scal n l1 x2 y2) (multK (K1 p) k (prod_scal n l1 x1 (conj p n false y1))))) *)
intros; rewrite add_multKr; auto.
(* Goal: @Logic.eq (Field.K (K1 p)) (let (k, l1) := l in let (x1, x2) := x in let (y1, y2) := let (l3, l5) := y in let (l4, l6) := z in @pair (Grassmann.vect p n) (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) l3 l4) (addE (Grassmann.vn_eparams p n) l5 l6) in addK (K1 p) (prod_scal n l1 x2 y2) (multK (K1 p) k (prod_scal n l1 x1 (conj p n false y1)))) (addK (K1 p) (let (k, l1) := l in let (x1, x2) := x in let (y1, y2) := y in addK (K1 p) (prod_scal n l1 x2 y2) (multK (K1 p) k (prod_scal n l1 x1 (conj p n false y1)))) (let (k, l1) := l in let (x1, x2) := x in let (y1, y2) := z in addK (K1 p) (prod_scal n l1 x2 y2) (multK (K1 p) k (prod_scal n l1 x1 (conj p n false y1))))) *)
destruct l; destruct x; destruct y; destruct z; simpl; Vfold n.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) (gprod n k0 v (addE (Grassmann.vn_eparams p n) v2 v4)) (gprod n k0 (conj p n false v0) (addE (Grassmann.vn_eparams p n) v1 v3))) (addE (Grassmann.vn_eparams p n) (gprod n k0 v0 (addE (Grassmann.vn_eparams p n) v2 v4)) (scalE (Grassmann.vn_eparams p n) k (gprod n k0 (conj p n false v) (addE (Grassmann.vn_eparams p n) v1 v3))))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) (addE (Grassmann.vn_eparams p n) (gprod n k0 v v2) (gprod n k0 (conj p n false v0) v1)) (addE (Grassmann.vn_eparams p n) (gprod n k0 v v4) (gprod n k0 (conj p n false v0) v3))) (addE (Grassmann.vn_eparams p n) (addE (Grassmann.vn_eparams p n) (gprod n k0 v0 v2) (scalE (Grassmann.vn_eparams p n) k (gprod n k0 (conj p n false v) v1))) (addE (Grassmann.vn_eparams p n) (gprod n k0 v0 v4) (scalE (Grassmann.vn_eparams p n) k (gprod n k0 (conj p n false v) v3))))) *)
rewrite !IH; auto.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) (addE (Grassmann.vn_eparams p n) (gprod n k0 v v2) (gprod n k0 v v4)) (addE (Grassmann.vn_eparams p n) (gprod n k0 (conj p n false v0) v1) (gprod n k0 (conj p n false v0) v3))) (addE (Grassmann.vn_eparams p n) (addE (Grassmann.vn_eparams p n) (gprod n k0 v0 v2) (gprod n k0 v0 v4)) (scalE (Grassmann.vn_eparams p n) k (addE (Grassmann.vn_eparams p n) (gprod n k0 (conj p n false v) v1) (gprod n k0 (conj p n false v) v3))))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) (addE (Grassmann.vn_eparams p n) (gprod n k0 v v2) (gprod n k0 (conj p n false v0) v1)) (addE (Grassmann.vn_eparams p n) (gprod n k0 v v4) (gprod n k0 (conj p n false v0) v3))) (addE (Grassmann.vn_eparams p n) (addE (Grassmann.vn_eparams p n) (gprod n k0 v0 v2) (scalE (Grassmann.vn_eparams p n) k (gprod n k0 (conj p n false v) v1))) (addE (Grassmann.vn_eparams p n) (gprod n k0 v0 v4) (scalE (Grassmann.vn_eparams p n) k (gprod n k0 (conj p n false v) v3))))) *)
apply f_equal2 with (f := @pair _ _).
(* Goal: @Logic.eq (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) (addE (Grassmann.vn_eparams p n) (join p n (k2g p n v1) M) (contra p n (kprod p n v1 l) M)) (addE (Grassmann.vn_eparams p n) (join p n (k2g p n v2) M) (contra p n (kprod p n v2 l) M))) (addE (Grassmann.vn_eparams p n) (addE (Grassmann.vn_eparams p n) (join p n (k2g p n v1) M) (join p n (k2g p n v2) M)) (addE (Grassmann.vn_eparams p n) (contra p n (kprod p n v1 l) M) (contra p n (kprod p n v2 l) M))) *)
(* Goal: forall (k : Field.K (stype (Kn.vn_eparams p n))) (v : Kn.kn p n) (_ : @Logic.eq (Grassmann.vect p n) (gprod n l (k2g p n v) M) (addE (Grassmann.vn_eparams p n) (join p n (k2g p n v) M) (contra p n (kprod p n v l) M))), @Logic.eq (Grassmann.vect p n) (gprod n l (k2g p n (scalE (Kn.vn_eparams p n) k v)) M) (addE (Grassmann.vn_eparams p n) (join p n (k2g p n (scalE (Kn.vn_eparams p n) k v)) M) (contra p n (kprod p n (scalE (Kn.vn_eparams p n) k v) l) M)) *)
  rewrite !addE_assoc; auto.
(* Goal: @Logic.eq (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (l_contra n k0 v (conj p n false v1))) (l_contra n k0 (conj p n false v0) (conj p n false v2))) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (scalE (Grassmann.vn_eparams p n) (oppK (stype (Grassmann.vn_eparams p n)) (Field.v1 (stype (Grassmann.vn_eparams p n)))) (scalE (Grassmann.vn_eparams p n) (oppK (stype (Grassmann.vn_eparams p n)) (Field.v1 (stype (Grassmann.vn_eparams p n)))) (l_contra n k0 v (conj p n false v1))))) (l_contra n k0 (conj p n false v0) (conj p n false v2))) *)
  apply f_equal2 with (f := addE _); auto.
(* Goal: @Logic.eq (VectorSpace.E (Grassmann.vn_eparams p n)) (addE (Grassmann.vn_eparams p n) (gprod n k0 v v4) (addE (Grassmann.vn_eparams p n) (gprod n k0 (conj p n false v0) v1) (gprod n k0 (conj p n false v0) v3))) (addE (Grassmann.vn_eparams p n) (gprod n k0 (conj p n false v0) v1) (addE (Grassmann.vn_eparams p n) (gprod n k0 v v4) (gprod n k0 (conj p n false v0) v3))) *)
(* Goal: @Logic.eq (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) (addE (Grassmann.vn_eparams p n) (gprod n k0 v0 v2) (gprod n k0 v0 v4)) (scalE (Grassmann.vn_eparams p n) k (addE (Grassmann.vn_eparams p n) (gprod n k0 (conj p n false v) v1) (gprod n k0 (conj p n false v) v3)))) (addE (Grassmann.vn_eparams p n) (addE (Grassmann.vn_eparams p n) (gprod n k0 v0 v2) (scalE (Grassmann.vn_eparams p n) k (gprod n k0 (conj p n false v) v1))) (addE (Grassmann.vn_eparams p n) (gprod n k0 v0 v4) (scalE (Grassmann.vn_eparams p n) k (gprod n k0 (conj p n false v) v3)))) *)
  rewrite addE_swap; auto.
(* Goal: @Logic.eq (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) (addE (Grassmann.vn_eparams p n) (join p n (k2g p n v1) M) (contra p n (kprod p n v1 l) M)) (addE (Grassmann.vn_eparams p n) (join p n (k2g p n v2) M) (contra p n (kprod p n v2 l) M))) (addE (Grassmann.vn_eparams p n) (addE (Grassmann.vn_eparams p n) (join p n (k2g p n v1) M) (join p n (k2g p n v2) M)) (addE (Grassmann.vn_eparams p n) (contra p n (kprod p n v1 l) M) (contra p n (kprod p n v2 l) M))) *)
(* Goal: forall (k : Field.K (stype (Kn.vn_eparams p n))) (v : Kn.kn p n) (_ : @Logic.eq (Grassmann.vect p n) (gprod n l (k2g p n v) M) (addE (Grassmann.vn_eparams p n) (join p n (k2g p n v) M) (contra p n (kprod p n v l) M))), @Logic.eq (Grassmann.vect p n) (gprod n l (k2g p n (scalE (Kn.vn_eparams p n) k v)) M) (addE (Grassmann.vn_eparams p n) (join p n (k2g p n (scalE (Kn.vn_eparams p n) k v)) M) (contra p n (kprod p n (scalE (Kn.vn_eparams p n) k v) l) M)) *)
rewrite !addE_assoc; auto.
(* Goal: @Logic.eq (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (l_contra n k0 v (conj p n false v1))) (l_contra n k0 (conj p n false v0) (conj p n false v2))) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (scalE (Grassmann.vn_eparams p n) (oppK (stype (Grassmann.vn_eparams p n)) (Field.v1 (stype (Grassmann.vn_eparams p n)))) (scalE (Grassmann.vn_eparams p n) (oppK (stype (Grassmann.vn_eparams p n)) (Field.v1 (stype (Grassmann.vn_eparams p n)))) (l_contra n k0 v (conj p n false v1))))) (l_contra n k0 (conj p n false v0) (conj p n false v2))) *)
apply f_equal2 with (f := addE _); auto.
(* Goal: @Logic.eq (VectorSpace.E (Grassmann.vn_eparams p n)) (addE (Grassmann.vn_eparams p n) (gprod n k0 v0 v4) (scalE (Grassmann.vn_eparams p n) k (addE (Grassmann.vn_eparams p n) (gprod n k0 (conj p n false v) v1) (gprod n k0 (conj p n false v) v3)))) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (gprod n k0 (conj p n false v) v1)) (addE (Grassmann.vn_eparams p n) (gprod n k0 v0 v4) (scalE (Grassmann.vn_eparams p n) k (gprod n k0 (conj p n false v) v3)))) *)
rewrite addE_swap, scal_addEr; auto.
Qed.

Lemma conjf_gprod n l (x y: vect n) :
   (x [* l] y) ^_'f = (x ^_'f) [* l] (y ^_'f) :> vect n.
Proof.
(* Goal: @Logic.eq (Field.K (K1 p)) (prod_scal n l x y) (prod_scal n l y x) *)
induction n as [| n IH]; simpl; try Vfold n; Krm0.
(* Goal: @Logic.eq (Field.K (K1 p)) (let (k, l1) := l in let (x1, x2) := x in let (y1, y2) := y in addK (K1 p) (prod_scal n l1 x2 y2) (multK (K1 p) k (prod_scal n l1 x1 (conj p n false y1)))) (let (k, l1) := l in let (x1, x2) := y in let (y1, y2) := x in addK (K1 p) (prod_scal n l1 x2 y2) (multK (K1 p) k (prod_scal n l1 x1 (conj p n false y1)))) *)
destruct l; destruct x; destruct y; simpl; Vfold n.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (conj p n true (addE (Grassmann.vn_eparams p n) (gprod n k0 v v2) (gprod n k0 (conj p n false v0) v1))) (conj p n false (addE (Grassmann.vn_eparams p n) (gprod n k0 v0 v2) (scalE (Grassmann.vn_eparams p n) k (gprod n k0 (conj p n false v) v1))))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) (gprod n k0 (conj p n true v) (conj p n false v2)) (gprod n k0 (conj p n false (conj p n false v0)) (conj p n true v1))) (addE (Grassmann.vn_eparams p n) (gprod n k0 (conj p n false v0) (conj p n false v2)) (scalE (Grassmann.vn_eparams p n) k (gprod n k0 (conj p n false (conj p n true v)) (conj p n true v1))))) *)
rewrite !conj_add, !conjt, !conj_invo, !IH; auto.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) (oppK (stype (Grassmann.vn_eparams p n)) (Field.v1 (stype (Grassmann.vn_eparams p n)))) (gprod n k0 (conj p n false v) (conj p n false v2))) (scalE (Grassmann.vn_eparams p n) (oppK (stype (Grassmann.vn_eparams p n)) (Field.v1 (stype (Grassmann.vn_eparams p n)))) (gprod n k0 (conj p n false (conj p n false v0)) (conj p n false v1)))) (addE (Grassmann.vn_eparams p n) (gprod n k0 (conj p n false v0) (conj p n false v2)) (conj p n false (scalE (Grassmann.vn_eparams p n) k (gprod n k0 (conj p n false v) v1))))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) (gprod n k0 (scalE (Grassmann.vn_eparams p n) (oppK (stype (Grassmann.vn_eparams p n)) (Field.v1 (stype (Grassmann.vn_eparams p n)))) (conj p n false v)) (conj p n false v2)) (gprod n k0 v0 (scalE (Grassmann.vn_eparams p n) (oppK (stype (Grassmann.vn_eparams p n)) (Field.v1 (stype (Grassmann.vn_eparams p n)))) (conj p n false v1)))) (addE (Grassmann.vn_eparams p n) (gprod n k0 (conj p n false v0) (conj p n false v2)) (scalE (Grassmann.vn_eparams p n) k (gprod n k0 (conj p n false (scalE (Grassmann.vn_eparams p n) (oppK (stype (Grassmann.vn_eparams p n)) (Field.v1 (stype (Grassmann.vn_eparams p n)))) (conj p n false v))) (scalE (Grassmann.vn_eparams p n) (oppK (stype (Grassmann.vn_eparams p n)) (Field.v1 (stype (Grassmann.vn_eparams p n)))) (conj p n false v1)))))) *)
rewrite !conj_invo, !conj_scal, !conj_invo, !IH; auto.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) (oppK (stype (Grassmann.vn_eparams p n)) (Field.v1 (stype (Grassmann.vn_eparams p n)))) (gprod n k0 (conj p n false v) (conj p n false v2))) (scalE (Grassmann.vn_eparams p n) (oppK (stype (Grassmann.vn_eparams p n)) (Field.v1 (stype (Grassmann.vn_eparams p n)))) (gprod n k0 v0 (conj p n false v1)))) (addE (Grassmann.vn_eparams p n) (gprod n k0 (conj p n false v0) (conj p n false v2)) (scalE (Grassmann.vn_eparams p n) k (gprod n k0 (conj p n false (conj p n false v)) (conj p n false v1))))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) (gprod n k0 (scalE (Grassmann.vn_eparams p n) (oppK (stype (Grassmann.vn_eparams p n)) (Field.v1 (stype (Grassmann.vn_eparams p n)))) (conj p n false v)) (conj p n false v2)) (gprod n k0 v0 (scalE (Grassmann.vn_eparams p n) (oppK (stype (Grassmann.vn_eparams p n)) (Field.v1 (stype (Grassmann.vn_eparams p n)))) (conj p n false v1)))) (addE (Grassmann.vn_eparams p n) (gprod n k0 (conj p n false v0) (conj p n false v2)) (scalE (Grassmann.vn_eparams p n) k (gprod n k0 (scalE (Grassmann.vn_eparams p n) (oppK (stype (Grassmann.vn_eparams p n)) (Field.v1 (stype (Grassmann.vn_eparams p n)))) v) (scalE (Grassmann.vn_eparams p n) (oppK (stype (Grassmann.vn_eparams p n)) (Field.v1 (stype (Grassmann.vn_eparams p n)))) (conj p n false v1)))))) *)
rewrite !gprod_scall, !gprod_scalr, !conj_invo; auto.
(* Goal: @Logic.eq (VectorSpace.E (Grassmann.vn_eparams p n)) (scalE (Grassmann.vn_eparams p n) k (l_contra n k0 v (conj p n false v1))) (scalE (Grassmann.vn_eparams p n) k (scalE (Grassmann.vn_eparams p n) (oppK (stype (Grassmann.vn_eparams p n)) (Field.v1 (stype (Grassmann.vn_eparams p n)))) (scalE (Grassmann.vn_eparams p n) (oppK (stype (Grassmann.vn_eparams p n)) (Field.v1 (stype (Grassmann.vn_eparams p n)))) (l_contra n k0 v (conj p n false v1))))) *)
rewrite <-!scal_multE; Krm1.
Qed.

Lemma gprod_assoc n l x y z :
  (x [* l] y) [* l] z = x [* l] (y [* l] z) :> vect n.
Proof.
(* Goal: @Logic.eq (Field.K (K1 p)) (prod_scal n l x y) (prod_scal n l y x) *)
induction n as [| n IH]; simpl; try Vfold n; Krm0.
(* Goal: @Logic.eq (Field.K (K1 p)) (multK (Grassmann.K1 p) (multK (Grassmann.K1 p) k x) y) (multK (Grassmann.K1 p) k (multK (Grassmann.K1 p) x y)) *)
(* Goal: @Logic.eq (Field.K (K1 p)) (let (k0, l1) := l in let (x1, x2) := let (l2, l3) := x in @pair (Grassmann.vect p n) (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) k l2) (scalE (Grassmann.vn_eparams p n) k l3) in let (y1, y2) := y in addK (K1 p) (prod_scal n l1 x2 y2) (multK (K1 p) k0 (prod_scal n l1 x1 (conj p n false y1)))) (multK (Grassmann.K1 p) k (let (k, l1) := l in let (x1, x2) := x in let (y1, y2) := y in addK (K1 p) (prod_scal n l1 x2 y2) (multK (K1 p) k (prod_scal n l1 x1 (conj p n false y1))))) *)
intros; rewrite multK_assoc; auto.
(* Goal: @Logic.eq (Field.K (K1 p)) (let (k, l1) := l in let (x1, x2) := x in let (y1, y2) := let (l3, l5) := y in let (l4, l6) := z in @pair (Grassmann.vect p n) (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) l3 l4) (addE (Grassmann.vn_eparams p n) l5 l6) in addK (K1 p) (prod_scal n l1 x2 y2) (multK (K1 p) k (prod_scal n l1 x1 (conj p n false y1)))) (addK (K1 p) (let (k, l1) := l in let (x1, x2) := x in let (y1, y2) := y in addK (K1 p) (prod_scal n l1 x2 y2) (multK (K1 p) k (prod_scal n l1 x1 (conj p n false y1)))) (let (k, l1) := l in let (x1, x2) := x in let (y1, y2) := z in addK (K1 p) (prod_scal n l1 x2 y2) (multK (K1 p) k (prod_scal n l1 x1 (conj p n false y1))))) *)
destruct l; destruct x; destruct y; destruct z; simpl; Vfold n.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) (gprod n k0 (addE (Grassmann.vn_eparams p n) (gprod n k0 v v2) (gprod n k0 (conj p n false v0) v1)) v4) (gprod n k0 (conj p n false (addE (Grassmann.vn_eparams p n) (gprod n k0 v0 v2) (scalE (Grassmann.vn_eparams p n) k (gprod n k0 (conj p n false v) v1)))) v3)) (addE (Grassmann.vn_eparams p n) (gprod n k0 (addE (Grassmann.vn_eparams p n) (gprod n k0 v0 v2) (scalE (Grassmann.vn_eparams p n) k (gprod n k0 (conj p n false v) v1))) v4) (scalE (Grassmann.vn_eparams p n) k (gprod n k0 (conj p n false (addE (Grassmann.vn_eparams p n) (gprod n k0 v v2) (gprod n k0 (conj p n false v0) v1))) v3)))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) (gprod n k0 v (addE (Grassmann.vn_eparams p n) (gprod n k0 v2 v4) (scalE (Grassmann.vn_eparams p n) k (gprod n k0 (conj p n false v1) v3)))) (gprod n k0 (conj p n false v0) (addE (Grassmann.vn_eparams p n) (gprod n k0 v1 v4) (gprod n k0 (conj p n false v2) v3)))) (addE (Grassmann.vn_eparams p n) (gprod n k0 v0 (addE (Grassmann.vn_eparams p n) (gprod n k0 v2 v4) (scalE (Grassmann.vn_eparams p n) k (gprod n k0 (conj p n false v1) v3)))) (scalE (Grassmann.vn_eparams p n) k (gprod n k0 (conj p n false v) (addE (Grassmann.vn_eparams p n) (gprod n k0 v1 v4) (gprod n k0 (conj p n false v2) v3)))))) *)
rewrite !gprod_addl, !gprod_addr, !IH, !gprod_scalr; auto.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) (addE (Grassmann.vn_eparams p n) (gprod n k0 v (gprod n k0 v2 v4)) (gprod n k0 (conj p n false v0) (gprod n k0 v1 v4))) (gprod n k0 (conj p n false (addE (Grassmann.vn_eparams p n) (gprod n k0 v0 v2) (scalE (Grassmann.vn_eparams p n) k (gprod n k0 (conj p n false v) v1)))) v3)) (addE (Grassmann.vn_eparams p n) (addE (Grassmann.vn_eparams p n) (gprod n k0 v0 (gprod n k0 v2 v4)) (gprod n k0 (scalE (Grassmann.vn_eparams p n) k (gprod n k0 (conj p n false v) v1)) v4)) (scalE (Grassmann.vn_eparams p n) k (gprod n k0 (conj p n false (addE (Grassmann.vn_eparams p n) (gprod n k0 v v2) (gprod n k0 (conj p n false v0) v1))) v3)))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) (addE (Grassmann.vn_eparams p n) (gprod n k0 v (gprod n k0 v2 v4)) (scalE (Grassmann.vn_eparams p n) k (gprod n k0 v (gprod n k0 (conj p n false v1) v3)))) (addE (Grassmann.vn_eparams p n) (gprod n k0 (conj p n false v0) (gprod n k0 v1 v4)) (gprod n k0 (conj p n false v0) (gprod n k0 (conj p n false v2) v3)))) (addE (Grassmann.vn_eparams p n) (addE (Grassmann.vn_eparams p n) (gprod n k0 v0 (gprod n k0 v2 v4)) (scalE (Grassmann.vn_eparams p n) k (gprod n k0 v0 (gprod n k0 (conj p n false v1) v3)))) (scalE (Grassmann.vn_eparams p n) k (addE (Grassmann.vn_eparams p n) (gprod n k0 (conj p n false v) (gprod n k0 v1 v4)) (gprod n k0 (conj p n false v) (gprod n k0 (conj p n false v2) v3)))))) *)
rewrite !conj_add, !gprod_addl, gprod_scall, !IH, conj_scal; auto.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) (addE (Grassmann.vn_eparams p n) (gprod n k0 v (gprod n k0 v2 v4)) (gprod n k0 (conj p n false v0) (gprod n k0 v1 v4))) (addE (Grassmann.vn_eparams p n) (gprod n k0 (conj p n false (gprod n k0 v0 v2)) v3) (gprod n k0 (scalE (Grassmann.vn_eparams p n) k (conj p n false (gprod n k0 (conj p n false v) v1))) v3))) (addE (Grassmann.vn_eparams p n) (addE (Grassmann.vn_eparams p n) (gprod n k0 v0 (gprod n k0 v2 v4)) (scalE (Grassmann.vn_eparams p n) k (gprod n k0 (conj p n false v) (gprod n k0 v1 v4)))) (scalE (Grassmann.vn_eparams p n) k (addE (Grassmann.vn_eparams p n) (gprod n k0 (conj p n false (gprod n k0 v v2)) v3) (gprod n k0 (conj p n false (gprod n k0 (conj p n false v0) v1)) v3))))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) (addE (Grassmann.vn_eparams p n) (gprod n k0 v (gprod n k0 v2 v4)) (scalE (Grassmann.vn_eparams p n) k (gprod n k0 v (gprod n k0 (conj p n false v1) v3)))) (addE (Grassmann.vn_eparams p n) (gprod n k0 (conj p n false v0) (gprod n k0 v1 v4)) (gprod n k0 (conj p n false v0) (gprod n k0 (conj p n false v2) v3)))) (addE (Grassmann.vn_eparams p n) (addE (Grassmann.vn_eparams p n) (gprod n k0 v0 (gprod n k0 v2 v4)) (scalE (Grassmann.vn_eparams p n) k (gprod n k0 v0 (gprod n k0 (conj p n false v1) v3)))) (scalE (Grassmann.vn_eparams p n) k (addE (Grassmann.vn_eparams p n) (gprod n k0 (conj p n false v) (gprod n k0 v1 v4)) (gprod n k0 (conj p n false v) (gprod n k0 (conj p n false v2) v3)))))) *)
rewrite !addE_assoc, !gprod_scall, !conjf_gprod, !IH, !conj_invo; auto.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) (oppK (stype (Grassmann.vn_eparams p n)) (Field.v1 (stype (Grassmann.vn_eparams p n)))) (l_contra n k0 v0 (conj p n false v1))) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (l_contra n k0 v (conj p n false v1))) (l_contra n k0 (conj p n false v0) (conj p n false v2)))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) (oppK (stype (Grassmann.vn_eparams p n)) (Field.v1 (stype (Grassmann.vn_eparams p n)))) (l_contra n k0 v0 (conj p n false v1))) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (scalE (Grassmann.vn_eparams p n) (oppK (stype (Grassmann.vn_eparams p n)) (Field.v1 (stype (Grassmann.vn_eparams p n)))) (scalE (Grassmann.vn_eparams p n) (oppK (stype (Grassmann.vn_eparams p n)) (Field.v1 (stype (Grassmann.vn_eparams p n)))) (l_contra n k0 v (conj p n false v1))))) (l_contra n k0 (conj p n false v0) (conj p n false v2)))) *)
apply f_equal2 with (f := @pair _ _); auto.
(* Goal: @Logic.eq (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (l_contra n k0 v (conj p n false v1))) (l_contra n k0 (conj p n false v0) (conj p n false v2))) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (scalE (Grassmann.vn_eparams p n) (oppK (stype (Grassmann.vn_eparams p n)) (Field.v1 (stype (Grassmann.vn_eparams p n)))) (scalE (Grassmann.vn_eparams p n) (oppK (stype (Grassmann.vn_eparams p n)) (Field.v1 (stype (Grassmann.vn_eparams p n)))) (l_contra n k0 v (conj p n false v1))))) (l_contra n k0 (conj p n false v0) (conj p n false v2))) *)
  apply f_equal2 with (f := addE _); auto.
(* Goal: @Logic.eq (VectorSpace.E (Grassmann.vn_eparams p n)) (addE (Grassmann.vn_eparams p n) (gprod n k0 (conj p n false v0) (gprod n k0 v1 v4)) (addE (Grassmann.vn_eparams p n) (gprod n k0 (conj p n false v0) (gprod n k0 (conj p n false v2) v3)) (scalE (Grassmann.vn_eparams p n) k (gprod n k0 v (gprod n k0 (conj p n false v1) v3))))) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (gprod n k0 v (gprod n k0 (conj p n false v1) v3))) (addE (Grassmann.vn_eparams p n) (gprod n k0 (conj p n false v0) (gprod n k0 v1 v4)) (gprod n k0 (conj p n false v0) (gprod n k0 (conj p n false v2) v3)))) *)
(* Goal: @Logic.eq (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) (gprod n k0 v0 (gprod n k0 v2 v4)) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (gprod n k0 (conj p n false v) (gprod n k0 v1 v4))) (scalE (Grassmann.vn_eparams p n) k (addE (Grassmann.vn_eparams p n) (gprod n k0 (conj p n false v) (gprod n k0 (conj p n false v2) v3)) (gprod n k0 v0 (gprod n k0 (conj p n false v1) v3)))))) (addE (Grassmann.vn_eparams p n) (gprod n k0 v0 (gprod n k0 v2 v4)) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (gprod n k0 v0 (gprod n k0 (conj p n false v1) v3))) (scalE (Grassmann.vn_eparams p n) k (addE (Grassmann.vn_eparams p n) (gprod n k0 (conj p n false v) (gprod n k0 v1 v4)) (gprod n k0 (conj p n false v) (gprod n k0 (conj p n false v2) v3)))))) *)
  rewrite <-addE_assoc, addE_com; auto.
(* Goal: @Logic.eq (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (l_contra n k0 v (conj p n false v1))) (l_contra n k0 (conj p n false v0) (conj p n false v2))) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (scalE (Grassmann.vn_eparams p n) (oppK (stype (Grassmann.vn_eparams p n)) (Field.v1 (stype (Grassmann.vn_eparams p n)))) (scalE (Grassmann.vn_eparams p n) (oppK (stype (Grassmann.vn_eparams p n)) (Field.v1 (stype (Grassmann.vn_eparams p n)))) (l_contra n k0 v (conj p n false v1))))) (l_contra n k0 (conj p n false v0) (conj p n false v2))) *)
apply f_equal2 with (f := addE _); auto.
(* Goal: @Logic.eq (VectorSpace.E (Grassmann.vn_eparams p n)) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (gprod n k0 (conj p n false v) (gprod n k0 v1 v4))) (scalE (Grassmann.vn_eparams p n) k (addE (Grassmann.vn_eparams p n) (gprod n k0 (conj p n false v) (gprod n k0 (conj p n false v2) v3)) (gprod n k0 v0 (gprod n k0 (conj p n false v1) v3))))) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (gprod n k0 v0 (gprod n k0 (conj p n false v1) v3))) (scalE (Grassmann.vn_eparams p n) k (addE (Grassmann.vn_eparams p n) (gprod n k0 (conj p n false v) (gprod n k0 v1 v4)) (gprod n k0 (conj p n false v) (gprod n k0 (conj p n false v2) v3))))) *)
rewrite !scal_addEr, <-addE_assoc, addE_com; auto.
Qed.

Lemma gprod_e0 n l (M : vect n.+1 ) :
    'e_0 [* l] M = (snd M, fst l .* fst M).
Proof.
(* Goal: @Logic.eq (Grassmann.vect p (S n)) (gprod (S n) l (gen p (S n) O) M) (@pair ((fix vect (n : nat) : Set := match n with | O => Field.K (Grassmann.K1 p) | S n1 => prod (vect n1) (vect n1) end) n) (VectorSpace.E (Grassmann.vn_eparams p n)) (@snd ((fix vect (n : nat) : Set := match n with | O => Field.K (Grassmann.K1 p) | S n1 => prod (vect n1) (vect n1) end) n) ((fix vect (n : nat) : Set := match n with | O => Field.K (Grassmann.K1 p) | S n1 => prod (vect n1) (vect n1) end) n) M) (scalE (Grassmann.vn_eparams p n) (@fst (Field.K (K p)) ((fix kn (n : nat) : Set := match n with | O => unit | S n1 => prod (Field.K (K p)) (kn n1) end) n) l) (@fst ((fix vect (n : nat) : Set := match n with | O => Field.K (Grassmann.K1 p) | S n1 => prod (vect n1) (vect n1) end) n) ((fix vect (n : nat) : Set := match n with | O => Field.K (Grassmann.K1 p) | S n1 => prod (vect n1) (vect n1) end) n) M))) *)
destruct l; destruct M; simpl; Vfold n.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) (gprod n k0 (genk p n (v1 (Grassmann.K1 p))) v0) (gprod n k0 (conj p n false (E0 (Grassmann.vn_eparams p n))) v)) (addE (Grassmann.vn_eparams p n) (gprod n k0 (E0 (Grassmann.vn_eparams p n)) v0) (scalE (Grassmann.vn_eparams p n) k (gprod n k0 (conj p n false (genk p n (v1 (Grassmann.K1 p)))) v)))) (@pair ((fix vect (n : nat) : Set := match n with | O => Field.K (Grassmann.K1 p) | S n1 => prod (vect n1) (vect n1) end) n) (Grassmann.vect p n) v0 (scalE (Grassmann.vn_eparams p n) k v)) *)
rewrite conj0, !gprod0l, !conjk, !gprodkl, !scalE1; Vrm0.
Qed.

Lemma gprod_ei n l i (M : vect n.+1) :
  i < n ->
    'e_i.+1 [* l] M =
       ((-(1))%f .* ('e_i [* snd l] (fst M)), 'e_i [* snd l] (snd M)).
Proof.
(* Goal: forall _ : lt i n, @Logic.eq (Grassmann.vect p (S n)) (gprod (S n) l (gen p (S n) (S i)) M) (@pair (VectorSpace.E (Grassmann.vn_eparams p n)) (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) (oppK (stype (Grassmann.vn_eparams p n)) (v1 (stype (Grassmann.vn_eparams p n)))) (gprod n (@snd (Field.K (K p)) ((fix kn (n : nat) : Set := match n with | O => unit | S n1 => prod (Field.K (K p)) (kn n1) end) n) l) (gen p n i) (@fst ((fix vect (n : nat) : Set := match n with | O => Field.K (Grassmann.K1 p) | S n1 => prod (vect n1) (vect n1) end) n) ((fix vect (n : nat) : Set := match n with | O => Field.K (Grassmann.K1 p) | S n1 => prod (vect n1) (vect n1) end) n) M))) (gprod n (@snd (Field.K (K p)) ((fix kn (n : nat) : Set := match n with | O => unit | S n1 => prod (Field.K (K p)) (kn n1) end) n) l) (gen p n i) (@snd ((fix vect (n : nat) : Set := match n with | O => Field.K (Grassmann.K1 p) | S n1 => prod (vect n1) (vect n1) end) n) ((fix vect (n : nat) : Set := match n with | O => Field.K (Grassmann.K1 p) | S n1 => prod (vect n1) (vect n1) end) n) M))) *)
destruct l; destruct M; intros HH; simpl; Vfold n.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) (gprod n k0 (E0 (Grassmann.vn_eparams p n)) v0) (gprod n k0 (conj p n false (gen p n i)) v)) (addE (Grassmann.vn_eparams p n) (gprod n k0 (gen p n i) v0) (scalE (Grassmann.vn_eparams p n) k (gprod n k0 (conj p n false (E0 (Grassmann.vn_eparams p n))) v)))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) (oppK (Grassmann.K1 p) (v1 (Grassmann.K1 p))) (gprod n k0 (gen p n i) v)) (gprod n k0 (gen p n i) v0)) *)
rewrite conj0, !gprod0l; Vrm0.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (gprod n k0 (conj p n false (gen p n i)) v) (gprod n k0 (gen p n i) v0)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) (oppK (Grassmann.K1 p) (v1 (Grassmann.K1 p))) (gprod n k0 (gen p n i) v)) (gprod n k0 (gen p n i) v0)) *)
rewrite conj_e, !gprod_scall; auto.
Qed.

Lemma gprodE_ei n l i M :
  i < n ->
  'e_i [* l] M =  'e_i ∧ M + #<('e_i [*] l)%Kn, M># :> vect n.
Proof.
(* Goal: forall _ : lt i n, @Logic.eq (Grassmann.vect p n) (l_contra n l (gen p n i) (gen p n i)) (genk p n (Kn.proj p n i l)) *)
generalize i; clear i.
(* Goal: forall (i : nat) (_ : lt i n), @Logic.eq (Grassmann.vect p n) (gprod n l (gen p n i) M) (addE (Grassmann.vn_eparams p n) (join p n (gen p n i) M) (contra p n (kprod p n (Kn.gen p n i) l) M)) *)
induction n as [|n IH]; intros i Hi.
(* Goal: @Logic.eq (Grassmann.vect p O) (gprod O l (gen p O i) M) (addE (Grassmann.vn_eparams p O) (join p O (gen p O i) M) (contra p O (kprod p O (Kn.gen p O i) l) M)) *)
(* Goal: @Logic.eq (Grassmann.vect p (S n)) (gprod (S n) l (gen p (S n) i) M) (addE (Grassmann.vn_eparams p (S n)) (join p (S n) (gen p (S n) i) M) (contra p (S n) (kprod p (S n) (Kn.gen p (S n) i) l) M)) *)
contradict Hi; auto with arith.
(* Goal: @Logic.eq (Grassmann.vect p (S n)) (gprod (S n) l (gen p (S n) i) M) (addE (Grassmann.vn_eparams p (S n)) (join p (S n) (gen p (S n) i) M) (contra p (S n) (kprod p (S n) (Kn.gen p (S n) i) l) M)) *)
destruct l; destruct M; destruct i as [|i].
(* Goal: @Logic.eq (Grassmann.vect p (S n)) (gprod (S n) (@pair (Field.K (K p)) (Kn.kn p n) k k0) (gen p (S n) O) (@pair (Grassmann.vect p n) (Grassmann.vect p n) v v0)) (addE (Grassmann.vn_eparams p (S n)) (join p (S n) (gen p (S n) O) (@pair (Grassmann.vect p n) (Grassmann.vect p n) v v0)) (contra p (S n) (kprod p (S n) (Kn.gen p (S n) O) (@pair (Field.K (K p)) (Kn.kn p n) k k0)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) v v0))) *)
(* Goal: @Logic.eq (Grassmann.vect p (S n)) (gprod (S n) (@pair (Field.K (K p)) (Kn.kn p n) k k0) (gen p (S n) (S i)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) v v0)) (addE (Grassmann.vn_eparams p (S n)) (join p (S n) (gen p (S n) (S i)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) v v0)) (contra p (S n) (kprod p (S n) (Kn.gen p (S n) (S i)) (@pair (Field.K (K p)) (Kn.kn p n) k k0)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) v v0))) *)
  rewrite join_e0, gprod_e0; simpl; auto; Vfold n.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair ((fix vect (n : nat) : Set := match n with | O => Field.K (Grassmann.K1 p) | S n1 => prod (vect n1) (vect n1) end) n) (Grassmann.vect p n) v0 (scalE (Grassmann.vn_eparams p n) k v)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) v0 (scalE (Grassmann.vn_eparams p n) (oppK (Grassmann.K1 p) (v1 (Grassmann.K1 p))) (contra p n (kprod p n (Kn.genk p n (Field.v0 (K1 p))) k0) v))) (addE (Grassmann.vn_eparams p n) (E0 (Grassmann.vn_eparams p n)) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) (multK (K1 p) (v1 (K1 p)) k) v) (contra p n (kprod p n (Kn.genk p n (Field.v0 (K1 p))) k0) v0)))) *)
(* Goal: @Logic.eq (Grassmann.vect p (S n)) (gprod (S n) (@pair (Field.K (K p)) (Kn.kn p n) k k0) (gen p (S n) (S i)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) v v0)) (addE (Grassmann.vn_eparams p (S n)) (join p (S n) (gen p (S n) (S i)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) v v0)) (contra p (S n) (kprod p (S n) (Kn.gen p (S n) (S i)) (@pair (Field.K (K p)) (Kn.kn p n) k k0)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) v v0))) *)
  rewrite kprod0l, !contra0l; simpl; Vfold n; Vrm0; Krm1.
(* Goal: @Logic.eq (Grassmann.vect p (S n)) (gprod (S n) (@pair (Field.K (K p)) (Kn.kn p n) k k0) (gen p (S n) (S i)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) v v0)) (addE (Grassmann.vn_eparams p (S n)) (join p (S n) (gen p (S n) (S i)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) v v0)) (contra p (S n) (kprod p (S n) (Kn.gen p (S n) (S i)) (@pair (Field.K (K p)) (Kn.kn p n) k k0)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) v v0))) *)
rewrite gprod_ei, join_ei, !IH, scal_addEr; auto with arith.
(* Goal: @Logic.eq (Grassmann.vect p (S n)) (@pair (VectorSpace.E (Grassmann.vn_eparams p n)) (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) (oppK (stype (Grassmann.vn_eparams p n)) (v1 (stype (Grassmann.vn_eparams p n)))) (join p n (gen p n i) (@fst ((fix vect (n : nat) : Set := match n with | O => Field.K (Grassmann.K1 p) | S n1 => prod (vect n1) (vect n1) end) n) ((fix vect (n : nat) : Set := match n with | O => Field.K (Grassmann.K1 p) | S n1 => prod (vect n1) (vect n1) end) n) (@pair (Grassmann.vect p n) (Grassmann.vect p n) v v0)))) (scalE (Grassmann.vn_eparams p n) (oppK (stype (Grassmann.vn_eparams p n)) (v1 (stype (Grassmann.vn_eparams p n)))) (contra p n (kprod p n (Kn.gen p n i) (@snd (Field.K (K p)) ((fix kn (n : nat) : Set := match n with | O => unit | S n1 => prod (Field.K (K p)) (kn n1) end) n) (@pair (Field.K (K p)) (Kn.kn p n) k k0))) (@fst ((fix vect (n : nat) : Set := match n with | O => Field.K (Grassmann.K1 p) | S n1 => prod (vect n1) (vect n1) end) n) ((fix vect (n : nat) : Set := match n with | O => Field.K (Grassmann.K1 p) | S n1 => prod (vect n1) (vect n1) end) n) (@pair (Grassmann.vect p n) (Grassmann.vect p n) v v0))))) (addE (Grassmann.vn_eparams p n) (join p n (gen p n i) (@snd ((fix vect (n : nat) : Set := match n with | O => Field.K (Grassmann.K1 p) | S n1 => prod (vect n1) (vect n1) end) n) ((fix vect (n : nat) : Set := match n with | O => Field.K (Grassmann.K1 p) | S n1 => prod (vect n1) (vect n1) end) n) (@pair (Grassmann.vect p n) (Grassmann.vect p n) v v0))) (contra p n (kprod p n (Kn.gen p n i) (@snd (Field.K (K p)) ((fix kn (n : nat) : Set := match n with | O => unit | S n1 => prod (Field.K (K p)) (kn n1) end) n) (@pair (Field.K (K p)) (Kn.kn p n) k k0))) (@snd ((fix vect (n : nat) : Set := match n with | O => Field.K (Grassmann.K1 p) | S n1 => prod (vect n1) (vect n1) end) n) ((fix vect (n : nat) : Set := match n with | O => Field.K (Grassmann.K1 p) | S n1 => prod (vect n1) (vect n1) end) n) (@pair (Grassmann.vect p n) (Grassmann.vect p n) v v0))))) (addE (Grassmann.vn_eparams p (S n)) (@pair (VectorSpace.E (Grassmann.vn_eparams p n)) (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) (oppK (stype (Grassmann.vn_eparams p n)) (v1 (stype (Grassmann.vn_eparams p n)))) (join p n (gen p n i) (@fst ((fix vect (n : nat) : Set := match n with | O => Field.K (Grassmann.K1 p) | S n1 => prod (vect n1) (vect n1) end) n) ((fix vect (n : nat) : Set := match n with | O => Field.K (Grassmann.K1 p) | S n1 => prod (vect n1) (vect n1) end) n) (@pair (Grassmann.vect p n) (Grassmann.vect p n) v v0)))) (join p n (gen p n i) (@snd ((fix vect (n : nat) : Set := match n with | O => Field.K (Grassmann.K1 p) | S n1 => prod (vect n1) (vect n1) end) n) ((fix vect (n : nat) : Set := match n with | O => Field.K (Grassmann.K1 p) | S n1 => prod (vect n1) (vect n1) end) n) (@pair (Grassmann.vect p n) (Grassmann.vect p n) v v0)))) (contra p (S n) (kprod p (S n) (Kn.gen p (S n) (S i)) (@pair (Field.K (K p)) (Kn.kn p n) k k0)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) v v0))) *)
rewrite contraE; simpl; Vfold n; Krm0; Vrm0.
Qed.

Lemma gprodE_v n l x M :
  'v_x [* l] M = 'v_x ∧ M + #< (x [*] l)%Kn, M ># :> vect n.
Proof.
(* Goal: @Logic.eq (Grassmann.vect p n) (gprod n l (k2g p n x) M) (addE (Grassmann.vn_eparams p n) (join p n (k2g p n x) M) (contra p n (kprod p n x l) M)) *)
pattern x; apply kn_induct; auto.
(* Goal: @Logic.eq (Grassmann.vect p n) (gprod n l (k2g p n (E0 (Kn.vn_eparams p n))) M) (addE (Grassmann.vn_eparams p n) (join p n (k2g p n (E0 (Kn.vn_eparams p n))) M) (contra p n (kprod p n (E0 (Kn.vn_eparams p n)) l) M)) *)
(* Goal: forall (p0 : nat) (_ : lt p0 n), @Logic.eq (Grassmann.vect p n) (gprod n l (k2g p n (Kn.gen p n p0)) M) (addE (Grassmann.vn_eparams p n) (join p n (k2g p n (Kn.gen p n p0)) M) (contra p n (kprod p n (Kn.gen p n p0) l) M)) *)
(* Goal: forall (v1 v2 : Kn.kn p n) (_ : @Logic.eq (Grassmann.vect p n) (gprod n l (k2g p n v1) M) (addE (Grassmann.vn_eparams p n) (join p n (k2g p n v1) M) (contra p n (kprod p n v1 l) M))) (_ : @Logic.eq (Grassmann.vect p n) (gprod n l (k2g p n v2) M) (addE (Grassmann.vn_eparams p n) (join p n (k2g p n v2) M) (contra p n (kprod p n v2 l) M))), @Logic.eq (Grassmann.vect p n) (gprod n l (k2g p n (addE (Kn.vn_eparams p n) v1 v2)) M) (addE (Grassmann.vn_eparams p n) (join p n (k2g p n (addE (Kn.vn_eparams p n) v1 v2)) M) (contra p n (kprod p n (addE (Kn.vn_eparams p n) v1 v2) l) M)) *)
(* Goal: forall (k : Field.K (stype (Kn.vn_eparams p n))) (v : Kn.kn p n) (_ : @Logic.eq (Grassmann.vect p n) (gprod n l (k2g p n v) M) (addE (Grassmann.vn_eparams p n) (join p n (k2g p n v) M) (contra p n (kprod p n v l) M))), @Logic.eq (Grassmann.vect p n) (gprod n l (k2g p n (scalE (Kn.vn_eparams p n) k v)) M) (addE (Grassmann.vn_eparams p n) (join p n (k2g p n (scalE (Kn.vn_eparams p n) k v)) M) (contra p n (kprod p n (scalE (Kn.vn_eparams p n) k v) l) M)) *)
rewrite k2g0, gprod0l, join0l, kprod0l, contra0l; Vrm0.
(* Goal: forall (p0 : nat) (_ : lt p0 n), @Logic.eq (Grassmann.vect p n) (gprod n l (k2g p n (Kn.gen p n p0)) M) (addE (Grassmann.vn_eparams p n) (join p n (k2g p n (Kn.gen p n p0)) M) (contra p n (kprod p n (Kn.gen p n p0) l) M)) *)
(* Goal: forall (v1 v2 : Kn.kn p n) (_ : @Logic.eq (Grassmann.vect p n) (gprod n l (k2g p n v1) M) (addE (Grassmann.vn_eparams p n) (join p n (k2g p n v1) M) (contra p n (kprod p n v1 l) M))) (_ : @Logic.eq (Grassmann.vect p n) (gprod n l (k2g p n v2) M) (addE (Grassmann.vn_eparams p n) (join p n (k2g p n v2) M) (contra p n (kprod p n v2 l) M))), @Logic.eq (Grassmann.vect p n) (gprod n l (k2g p n (addE (Kn.vn_eparams p n) v1 v2)) M) (addE (Grassmann.vn_eparams p n) (join p n (k2g p n (addE (Kn.vn_eparams p n) v1 v2)) M) (contra p n (kprod p n (addE (Kn.vn_eparams p n) v1 v2) l) M)) *)
(* Goal: forall (k : Field.K (stype (Kn.vn_eparams p n))) (v : Kn.kn p n) (_ : @Logic.eq (Grassmann.vect p n) (gprod n l (k2g p n v) M) (addE (Grassmann.vn_eparams p n) (join p n (k2g p n v) M) (contra p n (kprod p n v l) M))), @Logic.eq (Grassmann.vect p n) (gprod n l (k2g p n (scalE (Kn.vn_eparams p n) k v)) M) (addE (Grassmann.vn_eparams p n) (join p n (k2g p n (scalE (Kn.vn_eparams p n) k v)) M) (contra p n (kprod p n (scalE (Kn.vn_eparams p n) k v) l) M)) *)
intros i Hi.
(* Goal: @Logic.eq (Grassmann.vect p n) (gprod n l (k2g p n (Kn.gen p n i)) M) (addE (Grassmann.vn_eparams p n) (join p n (k2g p n (Kn.gen p n i)) M) (contra p n (kprod p n (Kn.gen p n i) l) M)) *)
(* Goal: forall (v1 v2 : Kn.kn p n) (_ : @Logic.eq (Grassmann.vect p n) (gprod n l (k2g p n v1) M) (addE (Grassmann.vn_eparams p n) (join p n (k2g p n v1) M) (contra p n (kprod p n v1 l) M))) (_ : @Logic.eq (Grassmann.vect p n) (gprod n l (k2g p n v2) M) (addE (Grassmann.vn_eparams p n) (join p n (k2g p n v2) M) (contra p n (kprod p n v2 l) M))), @Logic.eq (Grassmann.vect p n) (gprod n l (k2g p n (addE (Kn.vn_eparams p n) v1 v2)) M) (addE (Grassmann.vn_eparams p n) (join p n (k2g p n (addE (Kn.vn_eparams p n) v1 v2)) M) (contra p n (kprod p n (addE (Kn.vn_eparams p n) v1 v2) l) M)) *)
(* Goal: forall (k : Field.K (stype (Kn.vn_eparams p n))) (v : Kn.kn p n) (_ : @Logic.eq (Grassmann.vect p n) (gprod n l (k2g p n v) M) (addE (Grassmann.vn_eparams p n) (join p n (k2g p n v) M) (contra p n (kprod p n v l) M))), @Logic.eq (Grassmann.vect p n) (gprod n l (k2g p n (scalE (Kn.vn_eparams p n) k v)) M) (addE (Grassmann.vn_eparams p n) (join p n (k2g p n (scalE (Kn.vn_eparams p n) k v)) M) (contra p n (kprod p n (scalE (Kn.vn_eparams p n) k v) l) M)) *)
rewrite k2g_unit; auto.
(* Goal: @Logic.eq (Grassmann.vect p n) (gprod n l (gen p n i) M) (addE (Grassmann.vn_eparams p n) (join p n (gen p n i) M) (contra p n (kprod p n (Kn.gen p n i) l) M)) *)
(* Goal: forall (v1 v2 : Kn.kn p n) (_ : @Logic.eq (Grassmann.vect p n) (gprod n l (k2g p n v1) M) (addE (Grassmann.vn_eparams p n) (join p n (k2g p n v1) M) (contra p n (kprod p n v1 l) M))) (_ : @Logic.eq (Grassmann.vect p n) (gprod n l (k2g p n v2) M) (addE (Grassmann.vn_eparams p n) (join p n (k2g p n v2) M) (contra p n (kprod p n v2 l) M))), @Logic.eq (Grassmann.vect p n) (gprod n l (k2g p n (addE (Kn.vn_eparams p n) v1 v2)) M) (addE (Grassmann.vn_eparams p n) (join p n (k2g p n (addE (Kn.vn_eparams p n) v1 v2)) M) (contra p n (kprod p n (addE (Kn.vn_eparams p n) v1 v2) l) M)) *)
(* Goal: forall (k : Field.K (stype (Kn.vn_eparams p n))) (v : Kn.kn p n) (_ : @Logic.eq (Grassmann.vect p n) (gprod n l (k2g p n v) M) (addE (Grassmann.vn_eparams p n) (join p n (k2g p n v) M) (contra p n (kprod p n v l) M))), @Logic.eq (Grassmann.vect p n) (gprod n l (k2g p n (scalE (Kn.vn_eparams p n) k v)) M) (addE (Grassmann.vn_eparams p n) (join p n (k2g p n (scalE (Kn.vn_eparams p n) k v)) M) (contra p n (kprod p n (scalE (Kn.vn_eparams p n) k v) l) M)) *)
apply gprodE_ei; auto.
(* Goal: forall (v1 v2 : Kn.kn p n) (_ : @Logic.eq (Grassmann.vect p n) (gprod n l (k2g p n v1) M) (addE (Grassmann.vn_eparams p n) (join p n (k2g p n v1) M) (contra p n (kprod p n v1 l) M))) (_ : @Logic.eq (Grassmann.vect p n) (gprod n l (k2g p n v2) M) (addE (Grassmann.vn_eparams p n) (join p n (k2g p n v2) M) (contra p n (kprod p n v2 l) M))), @Logic.eq (Grassmann.vect p n) (gprod n l (k2g p n (addE (Kn.vn_eparams p n) v1 v2)) M) (addE (Grassmann.vn_eparams p n) (join p n (k2g p n (addE (Kn.vn_eparams p n) v1 v2)) M) (contra p n (kprod p n (addE (Kn.vn_eparams p n) v1 v2) l) M)) *)
(* Goal: forall (k : Field.K (stype (Kn.vn_eparams p n))) (v : Kn.kn p n) (_ : @Logic.eq (Grassmann.vect p n) (gprod n l (k2g p n v) M) (addE (Grassmann.vn_eparams p n) (join p n (k2g p n v) M) (contra p n (kprod p n v l) M))), @Logic.eq (Grassmann.vect p n) (gprod n l (k2g p n (scalE (Kn.vn_eparams p n) k v)) M) (addE (Grassmann.vn_eparams p n) (join p n (k2g p n (scalE (Kn.vn_eparams p n) k v)) M) (contra p n (kprod p n (scalE (Kn.vn_eparams p n) k v) l) M)) *)
intros v1 v2 Hv1 Hv2.
(* Goal: @Logic.eq (Grassmann.vect p n) (gprod n l (k2g p n (addE (Kn.vn_eparams p n) v1 v2)) M) (addE (Grassmann.vn_eparams p n) (join p n (k2g p n (addE (Kn.vn_eparams p n) v1 v2)) M) (contra p n (kprod p n (addE (Kn.vn_eparams p n) v1 v2) l) M)) *)
(* Goal: forall (k : Field.K (stype (Kn.vn_eparams p n))) (v : Kn.kn p n) (_ : @Logic.eq (Grassmann.vect p n) (gprod n l (k2g p n v) M) (addE (Grassmann.vn_eparams p n) (join p n (k2g p n v) M) (contra p n (kprod p n v l) M))), @Logic.eq (Grassmann.vect p n) (gprod n l (k2g p n (scalE (Kn.vn_eparams p n) k v)) M) (addE (Grassmann.vn_eparams p n) (join p n (k2g p n (scalE (Kn.vn_eparams p n) k v)) M) (contra p n (kprod p n (scalE (Kn.vn_eparams p n) k v) l) M)) *)
rewrite k2g_add, gprod_addl, join_addl, kprod_addl; auto.
(* Goal: @Logic.eq (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) (gprod n l (k2g p n v1) M) (gprod n l (k2g p n v2) M)) (addE (Grassmann.vn_eparams p n) (addE (Grassmann.vn_eparams p n) (join p n (k2g p n v1) M) (join p n (k2g p n v2) M)) (contra p n (addE (Kn.vn_eparams p n) (kprod p n v1 l) (kprod p n v2 l)) M)) *)
(* Goal: forall (k : Field.K (stype (Kn.vn_eparams p n))) (v : Kn.kn p n) (_ : @Logic.eq (Grassmann.vect p n) (gprod n l (k2g p n v) M) (addE (Grassmann.vn_eparams p n) (join p n (k2g p n v) M) (contra p n (kprod p n v l) M))), @Logic.eq (Grassmann.vect p n) (gprod n l (k2g p n (scalE (Kn.vn_eparams p n) k v)) M) (addE (Grassmann.vn_eparams p n) (join p n (k2g p n (scalE (Kn.vn_eparams p n) k v)) M) (contra p n (kprod p n (scalE (Kn.vn_eparams p n) k v) l) M)) *)
rewrite contra_addl; auto.
(* Goal: @Logic.eq (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) (gprod n l (k2g p n v1) M) (gprod n l (k2g p n v2) M)) (addE (Grassmann.vn_eparams p n) (addE (Grassmann.vn_eparams p n) (join p n (k2g p n v1) M) (join p n (k2g p n v2) M)) (addE (Grassmann.vn_eparams p n) (contra p n (kprod p n v1 l) M) (contra p n (kprod p n v2 l) M))) *)
(* Goal: forall (k : Field.K (stype (Kn.vn_eparams p n))) (v : Kn.kn p n) (_ : @Logic.eq (Grassmann.vect p n) (gprod n l (k2g p n v) M) (addE (Grassmann.vn_eparams p n) (join p n (k2g p n v) M) (contra p n (kprod p n v l) M))), @Logic.eq (Grassmann.vect p n) (gprod n l (k2g p n (scalE (Kn.vn_eparams p n) k v)) M) (addE (Grassmann.vn_eparams p n) (join p n (k2g p n (scalE (Kn.vn_eparams p n) k v)) M) (contra p n (kprod p n (scalE (Kn.vn_eparams p n) k v) l) M)) *)
rewrite Hv1, Hv2.
(* Goal: @Logic.eq (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) (addE (Grassmann.vn_eparams p n) (join p n (k2g p n v1) M) (contra p n (kprod p n v1 l) M)) (addE (Grassmann.vn_eparams p n) (join p n (k2g p n v2) M) (contra p n (kprod p n v2 l) M))) (addE (Grassmann.vn_eparams p n) (addE (Grassmann.vn_eparams p n) (join p n (k2g p n v1) M) (join p n (k2g p n v2) M)) (addE (Grassmann.vn_eparams p n) (contra p n (kprod p n v1 l) M) (contra p n (kprod p n v2 l) M))) *)
(* Goal: forall (k : Field.K (stype (Kn.vn_eparams p n))) (v : Kn.kn p n) (_ : @Logic.eq (Grassmann.vect p n) (gprod n l (k2g p n v) M) (addE (Grassmann.vn_eparams p n) (join p n (k2g p n v) M) (contra p n (kprod p n v l) M))), @Logic.eq (Grassmann.vect p n) (gprod n l (k2g p n (scalE (Kn.vn_eparams p n) k v)) M) (addE (Grassmann.vn_eparams p n) (join p n (k2g p n (scalE (Kn.vn_eparams p n) k v)) M) (contra p n (kprod p n (scalE (Kn.vn_eparams p n) k v) l) M)) *)
rewrite !addE_assoc; auto.
(* Goal: @Logic.eq (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (l_contra n k0 v (conj p n false v1))) (l_contra n k0 (conj p n false v0) (conj p n false v2))) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (scalE (Grassmann.vn_eparams p n) (oppK (stype (Grassmann.vn_eparams p n)) (Field.v1 (stype (Grassmann.vn_eparams p n)))) (scalE (Grassmann.vn_eparams p n) (oppK (stype (Grassmann.vn_eparams p n)) (Field.v1 (stype (Grassmann.vn_eparams p n)))) (l_contra n k0 v (conj p n false v1))))) (l_contra n k0 (conj p n false v0) (conj p n false v2))) *)
apply f_equal2 with (f := addE _); auto.
(* Goal: @Logic.eq (VectorSpace.E (Grassmann.vn_eparams p n)) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (l_contra n k0 (conj p n false v) v3)) (addE (Grassmann.vn_eparams p n) (l_contra n k0 v0 v2) (l_contra n k0 v0 v4))) (addE (Grassmann.vn_eparams p n) (l_contra n k0 v0 v2) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (l_contra n k0 (conj p n false v) v3)) (l_contra n k0 v0 v4))) *)
rewrite <-!addE_assoc; auto.
(* Goal: @Logic.eq (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (l_contra n k0 v (conj p n false v1))) (l_contra n k0 (conj p n false v0) (conj p n false v2))) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (scalE (Grassmann.vn_eparams p n) (oppK (stype (Grassmann.vn_eparams p n)) (Field.v1 (stype (Grassmann.vn_eparams p n)))) (scalE (Grassmann.vn_eparams p n) (oppK (stype (Grassmann.vn_eparams p n)) (Field.v1 (stype (Grassmann.vn_eparams p n)))) (l_contra n k0 v (conj p n false v1))))) (l_contra n k0 (conj p n false v0) (conj p n false v2))) *)
apply f_equal2 with (f := addE _); auto.
(* Goal: @Logic.eq (VectorSpace.E (Grassmann.vn_eparams p n)) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (l_contra n k0 (conj p n false v) v3)) (l_contra n k0 v0 v2)) (addE (Grassmann.vn_eparams p n) (l_contra n k0 v0 v2) (scalE (Grassmann.vn_eparams p n) k (l_contra n k0 (conj p n false v) v3))) *)
rewrite addE_com; auto.
(* Goal: forall (k : Field.K (stype (Kn.vn_eparams p n))) (v : Kn.kn p n) (_ : @Logic.eq (Grassmann.vect p n) (gprod n l (k2g p n v) M) (addE (Grassmann.vn_eparams p n) (join p n (k2g p n v) M) (contra p n (kprod p n v l) M))), @Logic.eq (Grassmann.vect p n) (gprod n l (k2g p n (scalE (Kn.vn_eparams p n) k v)) M) (addE (Grassmann.vn_eparams p n) (join p n (k2g p n (scalE (Kn.vn_eparams p n) k v)) M) (contra p n (kprod p n (scalE (Kn.vn_eparams p n) k v) l) M)) *)
intros k v Hv.
(* Goal: @Logic.eq (Grassmann.vect p n) (gprod n l (k2g p n (scalE (Kn.vn_eparams p n) k v)) M) (addE (Grassmann.vn_eparams p n) (join p n (k2g p n (scalE (Kn.vn_eparams p n) k v)) M) (contra p n (kprod p n (scalE (Kn.vn_eparams p n) k v) l) M)) *)
rewrite k2g_scal, gprod_scall, join_scall, kprod_scall, contra_scall; auto.
(* Goal: @Logic.eq (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) k (gprod n l (k2g p n v) M)) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (join p n (k2g p n v) M)) (scalE (Grassmann.vn_eparams p n) k (contra p n (kprod p n v l) M))) *)
rewrite Hv, scal_addEr; auto.
Qed.

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

Lemma rev0 n : 'R[0] = 0 :> vect n.
Proof.
(* Goal: @Logic.eq (Grassmann.vect p n) (rev n (rev n x)) x *)
induction n as [|n IH]; simpl; auto; Vfold n.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (conj p n false (rev n (E0 (Grassmann.vn_eparams p n)))) (rev n (E0 (Grassmann.vn_eparams p n)))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (E0 (Grassmann.vn_eparams p n)) (E0 (Grassmann.vn_eparams p n))) *)
rewrite !IH, conj0; auto.
Qed.

Lemma revk n k : 'R[[k]] = [k] :> vect n.
Proof.
(* Goal: @Logic.eq (Grassmann.vect p n) (rev n (rev n x)) x *)
induction n as [|n IH]; simpl; auto; Vfold n.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (conj p n false (rev n (E0 (Grassmann.vn_eparams p n)))) (rev n (genk p n k))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (E0 (Grassmann.vn_eparams p n)) (genk p n k)) *)
rewrite rev0, !IH, conj0; auto.
Qed.

Lemma rev_scal n k x : 'R[(k .* x)] =  k .* 'R[x] :> vect n.
Proof.
(* Goal: @Logic.eq (Grassmann.vect p n) (rev n (rev n x)) x *)
induction n as [|n IH]; simpl; auto; Vfold n.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (let (x, y) := let (l2, l3) := x in @pair (Grassmann.vect p n) (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) k l2) (scalE (Grassmann.vn_eparams p n) k l3) in @pair (Grassmann.vect p n) (Grassmann.vect p n) (conj p n false (rev n x)) (rev n y)) (let (l2, l3) := let (x, y) := x in @pair (Grassmann.vect p n) (Grassmann.vect p n) (conj p n false (rev n x)) (rev n y) in @pair (Grassmann.vect p n) (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) k l2) (scalE (Grassmann.vn_eparams p n) k l3)) *)
destruct x; rewrite !IH, conj_scal; auto.
Qed.

Lemma rev_add n x y : 'R[x + y] =  'R[x] + 'R[y] :> vect n.
Proof.
(* Goal: @Logic.eq (Grassmann.vect p n) (rev n (rev n x)) x *)
induction n as [|n IH]; simpl; auto; Vfold n.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (let (x, y) := let (x1, x2) := x in let (y1, y2) := y in @pair (Grassmann.vect p n) (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) (join p n x1 y2) (join p n (conj p n false x2) y1)) (join p n x2 y2) in @pair (Grassmann.vect p n) (Grassmann.vect p n) (conj p n false (rev n x)) (rev n y)) (let (x1, x2) := let (x, y) := y in @pair (Grassmann.vect p n) (Grassmann.vect p n) (conj p n false (rev n x)) (rev n y) in let (y1, y2) := let (x, y) := x in @pair (Grassmann.vect p n) (Grassmann.vect p n) (conj p n false (rev n x)) (rev n y) in @pair (Grassmann.vect p n) (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) (join p n x1 y2) (join p n (conj p n false x2) y1)) (join p n x2 y2)) *)
destruct x; destruct y.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (conj p n false (rev n (addE (Grassmann.vn_eparams p n) v v1))) (rev n (addE (Grassmann.vn_eparams p n) v0 v2))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) (conj p n false (rev n v)) (conj p n false (rev n v1))) (addE (Grassmann.vn_eparams p n) (rev n v0) (rev n v2))) *)
rewrite !IH, conj_add; auto.
Qed.

Lemma rev_conj n x : 'R[x ^_'f] = 'R[x]^_'f :> vect n.
Proof.
(* Goal: @Logic.eq (Grassmann.vect p n) (rev n (rev n x)) x *)
induction n as [|n IH]; simpl; auto; Vfold n.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (let (x, y) := let (l2, l3) := x in @pair (Grassmann.vect p n) (Grassmann.vect p n) (conj p n true l2) (conj p n false l3) in @pair (Grassmann.vect p n) (Grassmann.vect p n) (conj p n false (rev n x)) (rev n y)) (let (l2, l3) := let (x, y) := x in @pair (Grassmann.vect p n) (Grassmann.vect p n) (conj p n false (rev n x)) (rev n y) in @pair (Grassmann.vect p n) (Grassmann.vect p n) (conj p n true l2) (conj p n false l3)) *)
destruct x.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (conj p n false (rev n (conj p n true v))) (rev n (conj p n false v0))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (conj p n true (conj p n false (rev n v))) (conj p n false (rev n v0))) *)
rewrite !conjt, <-!IH, !conj_scal, rev_scal; auto.
Qed.

Lemma rev_invo n x : 'R['R[x]] = x :> vect n.
Proof.
(* Goal: @Logic.eq (Grassmann.vect p n) (rev n (rev n x)) x *)
induction n as [|n IH]; simpl; auto; Vfold n.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (let (x, y) := let (x, y) := x in @pair (Grassmann.vect p n) (Grassmann.vect p n) (conj p n false (rev n x)) (rev n y) in @pair (Grassmann.vect p n) (Grassmann.vect p n) (conj p n false (rev n x)) (rev n y)) x *)
destruct x; rewrite !rev_conj, !conj_invo, !IH; auto.
Qed.

Lemma rev_hom  n m x : (m <= n)%nat -> hom p n m x -> 
   'R[x] = ((-(1)) ^ (div2 (m * (m - 1))))%f .* x.
Proof.
(* Goal: forall (_ : le m n) (_ : b2Prop (hom p n m x)), @Logic.eq (Grassmann.vect p n) (rev n x) (scalE (Grassmann.vn_eparams p n) (expK (stype (Grassmann.vn_eparams p n)) (oppK (stype (Grassmann.vn_eparams p n)) (v1 (stype (Grassmann.vn_eparams p n)))) (PeanoNat.Nat.div2 (Nat.mul m (Nat.sub m (S O))))) x) *)
generalize m; clear m.
(* Goal: @Logic.eq (Grassmann.vect p n) (conj p n false (l_contra n l x y)) (l_contra n l (conj p n false x) (conj p n false y)) *)
induction n as [|n IH]; simpl; auto; try Vfold n.
(* Goal: forall (m : nat) (_ : le m O) (_ : b2Prop match m with | O => true | S n => eqK (Grassmann.K1 p) x (v0 (Grassmann.K1 p)) end), @Logic.eq (Field.K (Grassmann.K1 p)) x (multK (Grassmann.K1 p) (expK (Grassmann.K1 p) (oppK (Grassmann.K1 p) (v1 (Grassmann.K1 p))) (PeanoNat.Nat.div2 (Nat.mul m (Nat.sub m (S O))))) x) *)
(* Goal: forall (m : nat) (_ : le m (S n)) (_ : b2Prop (let (l2, l3) := x in andb match m with | O => eq0 p n l2 | S k1 => hom p n k1 l2 end (hom p n m l3))), @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (let (x, y) := x in @pair (Grassmann.vect p n) (Grassmann.vect p n) (conj p n false (rev n x)) (rev n y)) (let (l2, l3) := x in @pair (Grassmann.vect p n) (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) (expK (Grassmann.K1 p) (oppK (Grassmann.K1 p) (v1 (Grassmann.K1 p))) (PeanoNat.Nat.div2 (Nat.mul m (Nat.sub m (S O))))) l2) (scalE (Grassmann.vn_eparams p n) (expK (Grassmann.K1 p) (oppK (Grassmann.K1 p) (v1 (Grassmann.K1 p))) (PeanoNat.Nat.div2 (Nat.mul m (Nat.sub m (S O))))) l3)) *)
intros [|m]; simpl; Krm1.
(* Goal: forall (_ : le (S m) O) (_ : b2Prop (eqK (Grassmann.K1 p) x (v0 (Grassmann.K1 p)))), @Logic.eq (Field.K (Grassmann.K1 p)) x (multK (Grassmann.K1 p) (expK (Grassmann.K1 p) (oppK (Grassmann.K1 p) (v1 (Grassmann.K1 p))) (PeanoNat.Nat.div2 (Nat.add (Nat.sub m O) (Nat.mul m (Nat.sub m O))))) x) *)
(* Goal: forall (m : nat) (_ : le m (S n)) (_ : b2Prop (let (l2, l3) := x in andb match m with | O => eq0 p n l2 | S k1 => hom p n k1 l2 end (hom p n m l3))), @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (let (x, y) := x in @pair (Grassmann.vect p n) (Grassmann.vect p n) (conj p n false (rev n x)) (rev n y)) (let (l2, l3) := x in @pair (Grassmann.vect p n) (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) (expK (Grassmann.K1 p) (oppK (Grassmann.K1 p) (v1 (Grassmann.K1 p))) (PeanoNat.Nat.div2 (Nat.mul m (Nat.sub m (S O))))) l2) (scalE (Grassmann.vn_eparams p n) (expK (Grassmann.K1 p) (oppK (Grassmann.K1 p) (v1 (Grassmann.K1 p))) (PeanoNat.Nat.div2 (Nat.mul m (Nat.sub m (S O))))) l3)) *)
intros HH; contradict HH; auto with arith.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (let (x, y) := let (l2, l3) := x in @pair (Grassmann.vect p n) (Grassmann.vect p n) (conj p n true l2) (conj p n false l3) in @pair (Grassmann.vect p n) (Grassmann.vect p n) (conj p n false (rev n x)) (rev n y)) (let (l2, l3) := let (x, y) := x in @pair (Grassmann.vect p n) (Grassmann.vect p n) (conj p n false (rev n x)) (rev n y) in @pair (Grassmann.vect p n) (Grassmann.vect p n) (conj p n true l2) (conj p n false l3)) *)
intros [|m]; destruct x.
(* Goal: forall (_ : le O (S n)) (_ : b2Prop (andb (eq0 p n v) (hom p n O v0))), @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (conj p n false (rev n v)) (rev n v0)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) (expK (Grassmann.K1 p) (oppK (Grassmann.K1 p) (v1 (Grassmann.K1 p))) (PeanoNat.Nat.div2 (Nat.mul O (Nat.sub O (S O))))) v) (scalE (Grassmann.vn_eparams p n) (expK (Grassmann.K1 p) (oppK (Grassmann.K1 p) (v1 (Grassmann.K1 p))) (PeanoNat.Nat.div2 (Nat.mul O (Nat.sub O (S O))))) v0)) *)
(* Goal: forall (_ : le (S m) (S n)) (_ : b2Prop (andb (hom p n m v) (hom p n (S m) v0))), @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (conj p n false (rev n v)) (rev n v0)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) (expK (Grassmann.K1 p) (oppK (Grassmann.K1 p) (v1 (Grassmann.K1 p))) (PeanoNat.Nat.div2 (Nat.mul (S m) (Nat.sub (S m) (S O))))) v) (scalE (Grassmann.vn_eparams p n) (expK (Grassmann.K1 p) (oppK (Grassmann.K1 p) (v1 (Grassmann.K1 p))) (PeanoNat.Nat.div2 (Nat.mul (S m) (Nat.sub (S m) (S O))))) v0)) *)
  case eq0_spec; simpl; auto.
(* Goal: forall (_ : @Logic.eq (Grassmann.vect p n) v (genk p n (Field.v0 (Grassmann.K1 p)))) (_ : le O (S n)) (_ : b2Prop (hom p n O v0)), @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (conj p n false (rev n v)) (rev n v0)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (scal p n (v1 (Grassmann.K1 p)) v) (scal p n (v1 (Grassmann.K1 p)) v0)) *)
(* Goal: forall (_ : not (@Logic.eq (Grassmann.vect p n) v (genk p n (Field.v0 (Grassmann.K1 p))))) (_ : le O (S n)) (_ : b2Prop false), @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (conj p n false (rev n v)) (rev n v0)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (scal p n (v1 (Grassmann.K1 p)) v) (scal p n (v1 (Grassmann.K1 p)) v0)) *)
(* Goal: forall (_ : le (S m) (S n)) (_ : b2Prop (andb (hom p n m v) (hom p n (S m) v0))), @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (conj p n false (rev n v)) (rev n v0)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) (expK (Grassmann.K1 p) (oppK (Grassmann.K1 p) (v1 (Grassmann.K1 p))) (PeanoNat.Nat.div2 (Nat.mul (S m) (Nat.sub (S m) (S O))))) v) (scalE (Grassmann.vn_eparams p n) (expK (Grassmann.K1 p) (oppK (Grassmann.K1 p) (v1 (Grassmann.K1 p))) (PeanoNat.Nat.div2 (Nat.mul (S m) (Nat.sub (S m) (S O))))) v0)) *)
  intros; subst.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (conj p n false (rev n (genk p n (Field.v0 (Grassmann.K1 p))))) (rev n v0)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (scal p n (v1 (Grassmann.K1 p)) (genk p n (Field.v0 (Grassmann.K1 p)))) (scal p n (v1 (Grassmann.K1 p)) v0)) *)
(* Goal: forall (_ : not (@Logic.eq (Grassmann.vect p n) v (genk p n (Field.v0 (Grassmann.K1 p))))) (_ : le O (S n)) (_ : b2Prop false), @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (conj p n false (rev n v)) (rev n v0)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (scal p n (v1 (Grassmann.K1 p)) v) (scal p n (v1 (Grassmann.K1 p)) v0)) *)
(* Goal: forall (_ : le (S m) (S n)) (_ : b2Prop (andb (hom p n m v) (hom p n (S m) v0))), @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (conj p n false (rev n v)) (rev n v0)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) (expK (Grassmann.K1 p) (oppK (Grassmann.K1 p) (v1 (Grassmann.K1 p))) (PeanoNat.Nat.div2 (Nat.mul (S m) (Nat.sub (S m) (S O))))) v) (scalE (Grassmann.vn_eparams p n) (expK (Grassmann.K1 p) (oppK (Grassmann.K1 p) (v1 (Grassmann.K1 p))) (PeanoNat.Nat.div2 (Nat.mul (S m) (Nat.sub (S m) (S O))))) v0)) *)
  rewrite rev0, hom0E with (2 := H1), revk, conj0; auto.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (E0 (Grassmann.vn_eparams p n)) (genk p n (const p n v0))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (scal p n (v1 (Grassmann.K1 p)) (genk p n (Field.v0 (Grassmann.K1 p)))) (scal p n (v1 (Grassmann.K1 p)) (genk p n (const p n v0)))) *)
(* Goal: forall (_ : not (@Logic.eq (Grassmann.vect p n) v (genk p n (Field.v0 (Grassmann.K1 p))))) (_ : le O (S n)) (_ : b2Prop false), @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (conj p n false (rev n v)) (rev n v0)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (scal p n (v1 (Grassmann.K1 p)) v) (scal p n (v1 (Grassmann.K1 p)) v0)) *)
(* Goal: forall (_ : le (S m) (S n)) (_ : b2Prop (andb (hom p n m v) (hom p n (S m) v0))), @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (conj p n false (rev n v)) (rev n v0)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) (expK (Grassmann.K1 p) (oppK (Grassmann.K1 p) (v1 (Grassmann.K1 p))) (PeanoNat.Nat.div2 (Nat.mul (S m) (Nat.sub (S m) (S O))))) v) (scalE (Grassmann.vn_eparams p n) (expK (Grassmann.K1 p) (oppK (Grassmann.K1 p) (v1 (Grassmann.K1 p))) (PeanoNat.Nat.div2 (Nat.mul (S m) (Nat.sub (S m) (S O))))) v0)) *)
  rewrite !scalE1; auto.
(* Goal: forall (_ : not (@Logic.eq (Grassmann.vect p n) v (genk p n (Field.v0 (Grassmann.K1 p))))) (_ : le O (S n)) (_ : b2Prop false), @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (conj p n false (rev n v)) (rev n v0)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (scal p n (v1 (Grassmann.K1 p)) v) (scal p n (v1 (Grassmann.K1 p)) v0)) *)
(* Goal: forall (_ : le (S m) (S n)) (_ : b2Prop (andb (hom p n m v) (hom p n (S m) v0))), @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (conj p n false (rev n v)) (rev n v0)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) (expK (Grassmann.K1 p) (oppK (Grassmann.K1 p) (v1 (Grassmann.K1 p))) (PeanoNat.Nat.div2 (Nat.mul (S m) (Nat.sub (S m) (S O))))) v) (scalE (Grassmann.vn_eparams p n) (expK (Grassmann.K1 p) (oppK (Grassmann.K1 p) (v1 (Grassmann.K1 p))) (PeanoNat.Nat.div2 (Nat.mul (S m) (Nat.sub (S m) (S O))))) v0)) *)
intros; discriminate.
(* Goal: forall (_ : le (S m) (S n)) (_ : b2Prop (andb (hom p n m v) (hom p n (S m) v0))), @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (conj p n false (rev n v)) (rev n v0)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) (expK (Grassmann.K1 p) (oppK (Grassmann.K1 p) (v1 (Grassmann.K1 p))) (PeanoNat.Nat.div2 (Nat.mul (S m) (Nat.sub (S m) (S O))))) v) (scalE (Grassmann.vn_eparams p n) (expK (Grassmann.K1 p) (oppK (Grassmann.K1 p) (v1 (Grassmann.K1 p))) (PeanoNat.Nat.div2 (Nat.mul (S m) (Nat.sub (S m) (S O))))) v0)) *)
rewrite andbP.
(* Goal: forall (_ : le (S m) (S n)) (_ : and (b2Prop (hom p n m v)) (b2Prop (hom p n (S m) v0))), @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (conj p n false (rev n v)) (rev n v0)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) (expK (Grassmann.K1 p) (oppK (Grassmann.K1 p) (v1 (Grassmann.K1 p))) (PeanoNat.Nat.div2 (Nat.mul (S m) (Nat.sub (S m) (S O))))) v) (scalE (Grassmann.vn_eparams p n) (expK (Grassmann.K1 p) (oppK (Grassmann.K1 p) (v1 (Grassmann.K1 p))) (PeanoNat.Nat.div2 (Nat.mul (S m) (Nat.sub (S m) (S O))))) v0)) *)
intros HH [HH1 HH2].
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (conj p n false (rev n v)) (rev n v0)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) (expK (Grassmann.K1 p) (oppK (Grassmann.K1 p) (v1 (Grassmann.K1 p))) (PeanoNat.Nat.div2 (Nat.mul (S m) (Nat.sub (S m) (S O))))) v) (scalE (Grassmann.vn_eparams p n) (expK (Grassmann.K1 p) (oppK (Grassmann.K1 p) (v1 (Grassmann.K1 p))) (PeanoNat.Nat.div2 (Nat.mul (S m) (Nat.sub (S m) (S O))))) v0)) *)
assert (HH' : m <= n); auto with arith.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (conj p n false (rev n v)) (rev n v0)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) (expK (Grassmann.K1 p) (oppK (Grassmann.K1 p) (v1 (Grassmann.K1 p))) (PeanoNat.Nat.div2 (Nat.mul (S m) (Nat.sub (S m) (S O))))) v) (scalE (Grassmann.vn_eparams p n) (expK (Grassmann.K1 p) (oppK (Grassmann.K1 p) (v1 (Grassmann.K1 p))) (PeanoNat.Nat.div2 (Nat.mul (S m) (Nat.sub (S m) (S O))))) v0)) *)
case (Lt.le_or_lt m.+1 n); intros HH''.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (conj p n false (rev n v)) (rev n v0)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) (expK (Grassmann.K1 p) (oppK (Grassmann.K1 p) (v1 (Grassmann.K1 p))) (PeanoNat.Nat.div2 (Nat.mul (S m) (Nat.sub (S m) (S O))))) v) (scalE (Grassmann.vn_eparams p n) (expK (Grassmann.K1 p) (oppK (Grassmann.K1 p) (v1 (Grassmann.K1 p))) (PeanoNat.Nat.div2 (Nat.mul (S m) (Nat.sub (S m) (S O))))) v0)) *)
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (conj p n false (rev n v)) (rev n v0)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) (expK (Grassmann.K1 p) (oppK (Grassmann.K1 p) (v1 (Grassmann.K1 p))) (PeanoNat.Nat.div2 (Nat.mul (S m) (Nat.sub (S m) (S O))))) v) (scalE (Grassmann.vn_eparams p n) (expK (Grassmann.K1 p) (oppK (Grassmann.K1 p) (v1 (Grassmann.K1 p))) (PeanoNat.Nat.div2 (Nat.mul (S m) (Nat.sub (S m) (S O))))) v0)) *)
rewrite IH with (2 := HH1); auto with arith.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (conj p n false (scalE (Grassmann.vn_eparams p n) (expK (stype (Grassmann.vn_eparams p n)) (oppK (stype (Grassmann.vn_eparams p n)) (v1 (stype (Grassmann.vn_eparams p n)))) (PeanoNat.Nat.div2 (Nat.mul m (Nat.sub m (S O))))) v)) (rev n v0)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) (expK (Grassmann.K1 p) (oppK (Grassmann.K1 p) (v1 (Grassmann.K1 p))) (PeanoNat.Nat.div2 (Nat.mul (S m) (Nat.sub (S m) (S O))))) v) (scalE (Grassmann.vn_eparams p n) (expK (Grassmann.K1 p) (oppK (Grassmann.K1 p) (v1 (Grassmann.K1 p))) (PeanoNat.Nat.div2 (Nat.mul (S m) (Nat.sub (S m) (S O))))) v0)) *)
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (conj p n false (rev n v)) (rev n v0)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) (expK (Grassmann.K1 p) (oppK (Grassmann.K1 p) (v1 (Grassmann.K1 p))) (PeanoNat.Nat.div2 (Nat.mul (S m) (Nat.sub (S m) (S O))))) v) (scalE (Grassmann.vn_eparams p n) (expK (Grassmann.K1 p) (oppK (Grassmann.K1 p) (v1 (Grassmann.K1 p))) (PeanoNat.Nat.div2 (Nat.mul (S m) (Nat.sub (S m) (S O))))) v0)) *)
rewrite IH with (2 := HH2); auto with arith.
rewrite conj_scal, !conjf_hom  with (2 := HH1); auto.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) (expK (stype (Grassmann.vn_eparams p n)) (oppK (stype (Grassmann.vn_eparams p n)) (v1 (stype (Grassmann.vn_eparams p n)))) (PeanoNat.Nat.div2 (Nat.mul m (Nat.sub m (S O))))) (scalE (Grassmann.vn_eparams p n) (expK (stype (Grassmann.vn_eparams p n)) (oppK (stype (Grassmann.vn_eparams p n)) (v1 (stype (Grassmann.vn_eparams p n)))) m) v)) (E0 (Grassmann.vn_eparams p n))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) (expK (Grassmann.K1 p) (oppK (Grassmann.K1 p) (v1 (Grassmann.K1 p))) (PeanoNat.Nat.div2 (Nat.mul (S m) (Nat.sub (S m) (S O))))) v) (E0 (Grassmann.vn_eparams p n))) *)
rewrite <-scal_multE, <-expK_add; auto.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) (expK (stype (Grassmann.vn_eparams p n)) (oppK (stype (Grassmann.vn_eparams p n)) (v1 (stype (Grassmann.vn_eparams p n)))) (Nat.add (PeanoNat.Nat.div2 (Nat.mul m (Nat.sub m (S O)))) m)) v) (E0 (Grassmann.vn_eparams p n))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) (expK (Grassmann.K1 p) (oppK (Grassmann.K1 p) (v1 (Grassmann.K1 p))) (PeanoNat.Nat.div2 (Nat.mul (S m) (Nat.sub (S m) (S O))))) v) (E0 (Grassmann.vn_eparams p n))) *)
rewrite Plus.plus_comm, div2_prop; simpl; auto.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (scal p n (expK (Grassmann.K1 p) (oppK (Grassmann.K1 p) (v1 (Grassmann.K1 p))) (PeanoNat.Nat.div2 (Nat.add m (Nat.mul m m)))) v) (genk p n (Field.v0 (Grassmann.K1 p)))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (scal p n (expK (Grassmann.K1 p) (oppK (Grassmann.K1 p) (v1 (Grassmann.K1 p))) (PeanoNat.Nat.div2 (Nat.add (Nat.sub m O) (Nat.mul m (Nat.sub m O))))) v) (genk p n (Field.v0 (Grassmann.K1 p)))) *)
rewrite <-!Minus.minus_n_O; simpl; auto.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (conj p n false (rev n v)) (rev n v0)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) (expK (Grassmann.K1 p) (oppK (Grassmann.K1 p) (v1 (Grassmann.K1 p))) (PeanoNat.Nat.div2 (Nat.mul (S m) (Nat.sub (S m) (S O))))) v) (scalE (Grassmann.vn_eparams p n) (expK (Grassmann.K1 p) (oppK (Grassmann.K1 p) (v1 (Grassmann.K1 p))) (PeanoNat.Nat.div2 (Nat.mul (S m) (Nat.sub (S m) (S O))))) v0)) *)
rewrite hom_lt with (3 := HH2); auto with arith.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (conj p n false (rev n v)) (rev n (E0 (Grassmann.vn_eparams p n)))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) (expK (Grassmann.K1 p) (oppK (Grassmann.K1 p) (v1 (Grassmann.K1 p))) (PeanoNat.Nat.div2 (Nat.mul (S m) (Nat.sub (S m) (S O))))) v) (scalE (Grassmann.vn_eparams p n) (expK (Grassmann.K1 p) (oppK (Grassmann.K1 p) (v1 (Grassmann.K1 p))) (PeanoNat.Nat.div2 (Nat.mul (S m) (Nat.sub (S m) (S O))))) (E0 (Grassmann.vn_eparams p n)))) *)
rewrite rev0, IH with (2 := HH1); Vrm0.
rewrite conj_scal, !conjf_hom  with (2 := HH1); auto.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) (expK (stype (Grassmann.vn_eparams p n)) (oppK (stype (Grassmann.vn_eparams p n)) (v1 (stype (Grassmann.vn_eparams p n)))) (PeanoNat.Nat.div2 (Nat.mul m (Nat.sub m (S O))))) (scalE (Grassmann.vn_eparams p n) (expK (stype (Grassmann.vn_eparams p n)) (oppK (stype (Grassmann.vn_eparams p n)) (v1 (stype (Grassmann.vn_eparams p n)))) m) v)) (E0 (Grassmann.vn_eparams p n))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) (expK (Grassmann.K1 p) (oppK (Grassmann.K1 p) (v1 (Grassmann.K1 p))) (PeanoNat.Nat.div2 (Nat.mul (S m) (Nat.sub (S m) (S O))))) v) (E0 (Grassmann.vn_eparams p n))) *)
rewrite <-scal_multE, <-expK_add; auto.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) (expK (stype (Grassmann.vn_eparams p n)) (oppK (stype (Grassmann.vn_eparams p n)) (v1 (stype (Grassmann.vn_eparams p n)))) (Nat.add (PeanoNat.Nat.div2 (Nat.mul m (Nat.sub m (S O)))) m)) v) (E0 (Grassmann.vn_eparams p n))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) (expK (Grassmann.K1 p) (oppK (Grassmann.K1 p) (v1 (Grassmann.K1 p))) (PeanoNat.Nat.div2 (Nat.mul (S m) (Nat.sub (S m) (S O))))) v) (E0 (Grassmann.vn_eparams p n))) *)
rewrite Plus.plus_comm, div2_prop; simpl; auto.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (scal p n (expK (Grassmann.K1 p) (oppK (Grassmann.K1 p) (v1 (Grassmann.K1 p))) (PeanoNat.Nat.div2 (Nat.add m (Nat.mul m m)))) v) (genk p n (Field.v0 (Grassmann.K1 p)))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (scal p n (expK (Grassmann.K1 p) (oppK (Grassmann.K1 p) (v1 (Grassmann.K1 p))) (PeanoNat.Nat.div2 (Nat.add (Nat.sub m O) (Nat.mul m (Nat.sub m O))))) v) (genk p n (Field.v0 (Grassmann.K1 p)))) *)
rewrite <-!Minus.minus_n_O; simpl; auto.
Qed.

Lemma rev_join n x y : 'R[x ∧ y] = 'R[y] ∧ 'R[x] :> vect n.
Proof.
(* Goal: @Logic.eq (Grassmann.vect p n) (conj p n false (l_contra n l x y)) (l_contra n l (conj p n false x) (conj p n false y)) *)
induction n as [|n IH]; simpl; auto; try Vfold n.
(* Goal: @Logic.eq (Field.K (K1 p)) (multK (stype (Grassmann.vn_eparams p n)) k0 k) (multK (K1 p) k k0) *)
rewrite multK_com; auto.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (let (x, y) := let (x1, x2) := x in let (y1, y2) := y in @pair (Grassmann.vect p n) (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) (join p n x1 y2) (join p n (conj p n false x2) y1)) (join p n x2 y2) in @pair (Grassmann.vect p n) (Grassmann.vect p n) (conj p n false (rev n x)) (rev n y)) (let (x1, x2) := let (x, y) := y in @pair (Grassmann.vect p n) (Grassmann.vect p n) (conj p n false (rev n x)) (rev n y) in let (y1, y2) := let (x, y) := x in @pair (Grassmann.vect p n) (Grassmann.vect p n) (conj p n false (rev n x)) (rev n y) in @pair (Grassmann.vect p n) (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) (join p n x1 y2) (join p n (conj p n false x2) y1)) (join p n x2 y2)) *)
destruct x; destruct y.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (conj p n false (rev n (addE (Grassmann.vn_eparams p n) (join p n v v2) (join p n (conj p n false v0) v1)))) (rev n (join p n v0 v2))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) (join p n (conj p n false (rev n v1)) (rev n v0)) (join p n (conj p n false (rev n v2)) (conj p n false (rev n v)))) (join p n (rev n v2) (rev n v0))) *)
rewrite rev_add, !IH, !rev_conj; auto.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (conj p n false (addE (Grassmann.vn_eparams p n) (join p n (rev n v2) (rev n v)) (join p n (rev n v1) (conj p n false (rev n v0))))) (join p n (rev n v2) (rev n v0))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) (join p n (conj p n false (rev n v1)) (rev n v0)) (join p n (conj p n false (rev n v2)) (conj p n false (rev n v)))) (join p n (rev n v2) (rev n v0))) *)
rewrite !conj_add, !conjf_join, !conj_invo; auto.
(* Goal: @Logic.eq (VectorSpace.E (Grassmann.vn_eparams p n)) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (l_contra n k0 (conj p n false v) v3)) (l_contra n k0 v0 v2)) (addE (Grassmann.vn_eparams p n) (l_contra n k0 v0 v2) (scalE (Grassmann.vn_eparams p n) k (l_contra n k0 (conj p n false v) v3))) *)
rewrite addE_com; auto.
Qed.

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

Lemma gprod_all_rev n l : E [* l] 'R[E] = ['P[l]] :> vect n.
Proof.
(* Goal: @Logic.eq (Grassmann.vect p n) (gprod n l (all p n) (rev n (all p n))) (genk p n (prodk n l)) *)
generalize l; clear l.
(* Goal: @Logic.eq (Grassmann.vect p n) (conj p n false (l_contra n l x y)) (l_contra n l (conj p n false x) (conj p n false y)) *)
induction n as [|n IH]; simpl; auto; try Vfold n.
(* Goal: @Logic.eq (Field.K (Grassmann.K1 p)) x (multK (Grassmann.K1 p) x (v1 (Grassmann.K1 p))) *)
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (let (x, y) := x in @pair (Grassmann.vect p n) (Grassmann.vect p n) (dual p n (conj p n false y)) (dual p n x)) (let (x1, x2) := let (x, y) := x in @pair (Grassmann.vect p n) (Grassmann.vect p n) (conj p n false (rev n x)) (rev n y) in @pair (Grassmann.vect p n) (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) (gprod n (Kn.genk p n (v1 (K1 p))) x1 (E0 (Grassmann.vn_eparams p n))) (gprod n (Kn.genk p n (v1 (K1 p))) (conj p n false x2) (all p n))) (addE (Grassmann.vn_eparams p n) (gprod n (Kn.genk p n (v1 (K1 p))) x2 (E0 (Grassmann.vn_eparams p n))) (scalE (Grassmann.vn_eparams p n) (v1 (K1 p)) (gprod n (Kn.genk p n (v1 (K1 p))) (conj p n false x1) (all p n))))) *)
 intros; rewrite multK1r; auto.
(* Goal: forall l : prod (Field.K (K1 p)) (Kn.kn p n), @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (let (k1, l1) := l in @pair (Grassmann.vect p n) (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) (gprod n l1 (all p n) (rev n (E0 (Grassmann.vn_eparams p n)))) (gprod n l1 (conj p n false (E0 (Grassmann.vn_eparams p n))) (conj p n false (rev n (all p n))))) (addE (Grassmann.vn_eparams p n) (gprod n l1 (E0 (Grassmann.vn_eparams p n)) (rev n (E0 (Grassmann.vn_eparams p n)))) (scalE (Grassmann.vn_eparams p n) k1 (gprod n l1 (conj p n false (all p n)) (conj p n false (rev n (all p n))))))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (E0 (Grassmann.vn_eparams p n)) (genk p n (let (a, x1) := l in multK (K1 p) a (prodk n x1)))) *)
intros [a l].
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) (gprod n l (all p n) (rev n (E0 (Grassmann.vn_eparams p n)))) (gprod n l (conj p n false (E0 (Grassmann.vn_eparams p n))) (conj p n false (rev n (all p n))))) (addE (Grassmann.vn_eparams p n) (gprod n l (E0 (Grassmann.vn_eparams p n)) (rev n (E0 (Grassmann.vn_eparams p n)))) (scalE (Grassmann.vn_eparams p n) a (gprod n l (conj p n false (all p n)) (conj p n false (rev n (all p n))))))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (E0 (Grassmann.vn_eparams p n)) (genk p n (multK (K1 p) a (prodk n l)))) *)
rewrite rev0, conj0, !gprod0r, !gprod0l, <-!conjf_gprod; Vrm0.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (E0 (Grassmann.vn_eparams p n)) (scalE (Grassmann.vn_eparams p n) a (conj p n false (gprod n l (all p n) (rev n (all p n)))))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (E0 (Grassmann.vn_eparams p n)) (genk p n (multK (K1 p) a (prodk n l)))) *)
rewrite IH, conjk, scalk; auto.
Qed.

Lemma pseudo_invE n l : 'Pi[l] = 'P[l] .* 'R[E] :> vect n.
Proof.
(* Goal: @Logic.eq (Grassmann.vect p n) (pseudo_inv n l) (scalE (Grassmann.vn_eparams p n) (prodk n l) (rev n (all p n))) *)
unfold pseudo_inv; rewrite gprod_all_rev, gprodkl; auto.
Qed.

(* 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.

(* OK usual definition and direct definition match *)
Lemma cdual_cliff n l x : cdual n l x = cliff_star n l x.
Proof.
(* Goal: @Logic.eq (Grassmann.vect p n) (cdual n l x) (cliff_star n l x) *)
generalize l x; pattern n; apply lt_wf_ind; clear l x n.
unfold cdual, cliff_star;  intros [|[|n]] IH.
(* Goal: forall (l : Kn.kn p O) (x : Grassmann.vect p O), @Logic.eq (Grassmann.vect p O) (scalE (Grassmann.vn_eparams p O) (prodk O l) (gprod O l x (rev O (all p O)))) (cliff_starb O true l x) *)
(* Goal: forall (l : Kn.kn p (S O)) (x : Grassmann.vect p (S O)), @Logic.eq (Grassmann.vect p (S O)) (scalE (Grassmann.vn_eparams p (S O)) (prodk (S O) l) (gprod (S O) l x (rev (S O) (all p (S O))))) (cliff_starb (S O) true l x) *)
(* Goal: forall (l : Kn.kn p (S (S n))) (x : Grassmann.vect p (S (S n))), @Logic.eq (Grassmann.vect p (S (S n))) (scalE (Grassmann.vn_eparams p (S (S n))) (prodk (S (S n)) l) (gprod (S (S n)) l x (rev (S (S n)) (all p (S (S n)))))) (cliff_starb (S (S n)) true l x) *)
intros l x; simpl; Krm1.
(* Goal: forall (l : Kn.kn p (S O)) (x : Grassmann.vect p (S O)), @Logic.eq (Grassmann.vect p (S O)) (scalE (Grassmann.vn_eparams p (S O)) (prodk (S O) l) (gprod (S O) l x (rev (S O) (all p (S O))))) (cliff_starb (S O) true l x) *)
(* Goal: forall (l : Kn.kn p (S (S n))) (x : Grassmann.vect p (S (S n))), @Logic.eq (Grassmann.vect p (S (S n))) (scalE (Grassmann.vn_eparams p (S (S n))) (prodk (S (S n)) l) (gprod (S (S n)) l x (rev (S (S n)) (all p (S (S n)))))) (cliff_starb (S (S n)) true l x) *)
intros [l1 l2] [x1 x2]; unfold cdual, cliff_star; simpl; Krm1.
(* Goal: @Logic.eq (prod (Field.K (Grassmann.K1 p)) (Field.K (Grassmann.K1 p))) (@pair (Field.K (Grassmann.K1 p)) (Field.K (Grassmann.K1 p)) (multK (Grassmann.K1 p) l1 x2) (multK (Grassmann.K1 p) l1 (multK (Grassmann.K1 p) l1 x1))) (@pair (Field.K (Grassmann.K1 p)) (Field.K (Grassmann.K1 p)) (multK (Grassmann.K1 p) l1 x2) (multK (Grassmann.K1 p) (multK (K p) l1 l1) x1)) *)
(* Goal: forall (l : Kn.kn p (S (S n))) (x : Grassmann.vect p (S (S n))), @Logic.eq (Grassmann.vect p (S (S n))) (scalE (Grassmann.vn_eparams p (S (S n))) (prodk (S (S n)) l) (gprod (S (S n)) l x (rev (S (S n)) (all p (S (S n)))))) (cliff_starb (S (S n)) true l x) *)
rewrite multK_assoc; auto.
(* Goal: forall (l : Kn.kn p (S (S n))) (x : Grassmann.vect p (S (S n))), @Logic.eq (Grassmann.vect p (S (S n))) (scalE (Grassmann.vn_eparams p (S (S n))) (prodk (S (S n)) l) (gprod (S (S n)) l x (rev (S (S n)) (all p (S (S n)))))) (cliff_starb (S (S n)) true l x) *)
intros [a [b l]] [[x1 x2] [x3 x4]].
(* Goal: @Logic.eq (Grassmann.vect p (S (S n))) (scalE (Grassmann.vn_eparams p (S (S n))) (prodk (S (S n)) (@pair (Field.K (K p)) (Kn.kn p (S n)) a (@pair (Field.K (K p)) (Kn.kn p n) b l))) (gprod (S (S n)) (@pair (Field.K (K p)) (Kn.kn p (S n)) a (@pair (Field.K (K p)) (Kn.kn p n) b l)) (@pair (Grassmann.vect p (S n)) (Grassmann.vect p (S n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) x1 x2) (@pair (Grassmann.vect p n) (Grassmann.vect p n) x3 x4)) (rev (S (S n)) (all p (S (S n)))))) (cliff_starb (S (S n)) true (@pair (Field.K (K p)) (Kn.kn p (S n)) a (@pair (Field.K (K p)) (Kn.kn p n) b l)) (@pair (Grassmann.vect p (S n)) (Grassmann.vect p (S n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) x1 x2) (@pair (Grassmann.vect p n) (Grassmann.vect p n) x3 x4))) *)
unfold cdual, cliff_star; simpl; Krm1; Vfold n.
(* Goal: @Logic.eq (prod (prod (Grassmann.vect p n) (Grassmann.vect p n)) (prod (Grassmann.vect p n) (Grassmann.vect p n))) (@pair (prod (Grassmann.vect p n) (Grassmann.vect p n)) (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) (multK (K1 p) a (multK (K1 p) b (prodk n l))) (addE (Grassmann.vn_eparams p n) (addE (Grassmann.vn_eparams p n) (gprod n l x1 (rev n (E0 (Grassmann.vn_eparams p n)))) (gprod n l (conj p n false x2) (conj p n false (rev n (E0 (Grassmann.vn_eparams p n)))))) (addE (Grassmann.vn_eparams p n) (gprod n l (conj p n true x3) (conj p n false (rev n (E0 (Grassmann.vn_eparams p n))))) (gprod n l (conj p n false (conj p n false x4)) (conj p n true (conj p n false (rev n (all p n)))))))) (scalE (Grassmann.vn_eparams p n) (multK (K1 p) a (multK (K1 p) b (prodk n l))) (addE (Grassmann.vn_eparams p n) (addE (Grassmann.vn_eparams p n) (gprod n l x2 (rev n (E0 (Grassmann.vn_eparams p n)))) (scalE (Grassmann.vn_eparams p n) b (gprod n l (conj p n false x1) (conj p n false (rev n (E0 (Grassmann.vn_eparams p n))))))) (addE (Grassmann.vn_eparams p n) (gprod n l (conj p n false x4) (conj p n false (rev n (E0 (Grassmann.vn_eparams p n))))) (scalE (Grassmann.vn_eparams p n) b (gprod n l (conj p n false (conj p n true x3)) (conj p n true (conj p n false (rev n (all p n)))))))))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) (multK (K1 p) a (multK (K1 p) b (prodk n l))) (addE (Grassmann.vn_eparams p n) (addE (Grassmann.vn_eparams p n) (gprod n l x3 (rev n (E0 (Grassmann.vn_eparams p n)))) (gprod n l (conj p n false x4) (conj p n false (rev n (E0 (Grassmann.vn_eparams p n)))))) (scalE (Grassmann.vn_eparams p n) a (addE (Grassmann.vn_eparams p n) (gprod n l (conj p n true x1) (conj p n false (rev n (E0 (Grassmann.vn_eparams p n))))) (gprod n l (conj p n false (conj p n false x2)) (conj p n true (conj p n false (rev n (all p n))))))))) (scalE (Grassmann.vn_eparams p n) (multK (K1 p) a (multK (K1 p) b (prodk n l))) (addE (Grassmann.vn_eparams p n) (addE (Grassmann.vn_eparams p n) (gprod n l x4 (rev n (E0 (Grassmann.vn_eparams p n)))) (scalE (Grassmann.vn_eparams p n) b (gprod n l (conj p n false x3) (conj p n false (rev n (E0 (Grassmann.vn_eparams p n))))))) (scalE (Grassmann.vn_eparams p n) a (addE (Grassmann.vn_eparams p n) (gprod n l (conj p n false x2) (conj p n false (rev n (E0 (Grassmann.vn_eparams p n))))) (scalE (Grassmann.vn_eparams p n) b (gprod n l (conj p n false (conj p n true x1)) (conj p n true (conj p n false (rev n (all p n)))))))))))) (@pair (prod (Grassmann.vect p n) (Grassmann.vect p n)) (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) a (scalE (Grassmann.vn_eparams p n) (oppK (K1 p) b) (cliff_starb n true l x4))) (scalE (Grassmann.vn_eparams p n) a (scalE (Grassmann.vn_eparams p n) (multK (K1 p) b b) (cliff_starb n true l x3)))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) (multK (K1 p) a a) (scalE (Grassmann.vn_eparams p n) (oppK (K1 p) b) (cliff_starb n true l x2))) (scalE (Grassmann.vn_eparams p n) (multK (K1 p) a a) (scalE (Grassmann.vn_eparams p n) (multK (K1 p) b b) (cliff_starb n true l x1))))) *)
rewrite !rev0, !conj0, !gprod0r; Vrm0.
(* Goal: @Logic.eq (prod (prod (Grassmann.vect p n) (Grassmann.vect p n)) (prod (Grassmann.vect p n) (Grassmann.vect p n))) (@pair (prod (Grassmann.vect p n) (Grassmann.vect p n)) (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) (multK (K1 p) a (multK (K1 p) b (prodk n l))) (gprod n l (conj p n false (conj p n false x4)) (conj p n true (conj p n false (rev n (all p n)))))) (scalE (Grassmann.vn_eparams p n) (multK (K1 p) a (multK (K1 p) b (prodk n l))) (scalE (Grassmann.vn_eparams p n) b (gprod n l (conj p n false (conj p n true x3)) (conj p n true (conj p n false (rev n (all p n)))))))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) (multK (K1 p) a (multK (K1 p) b (prodk n l))) (scalE (Grassmann.vn_eparams p n) a (gprod n l (conj p n false (conj p n false x2)) (conj p n true (conj p n false (rev n (all p n))))))) (scalE (Grassmann.vn_eparams p n) (multK (K1 p) a (multK (K1 p) b (prodk n l))) (scalE (Grassmann.vn_eparams p n) a (scalE (Grassmann.vn_eparams p n) b (gprod n l (conj p n false (conj p n true x1)) (conj p n true (conj p n false (rev n (all p n)))))))))) (@pair (prod (Grassmann.vect p n) (Grassmann.vect p n)) (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) a (scalE (Grassmann.vn_eparams p n) (oppK (K1 p) b) (cliff_starb n true l x4))) (scalE (Grassmann.vn_eparams p n) a (scalE (Grassmann.vn_eparams p n) (multK (K1 p) b b) (cliff_starb n true l x3)))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) (multK (K1 p) a a) (scalE (Grassmann.vn_eparams p n) (oppK (K1 p) b) (cliff_starb n true l x2))) (scalE (Grassmann.vn_eparams p n) (multK (K1 p) a a) (scalE (Grassmann.vn_eparams p n) (multK (K1 p) b b) (cliff_starb n true l x1))))) *)
rewrite !conjt, !conj_scal, !conj_invo; auto.
(* Goal: @Logic.eq (prod (prod (Grassmann.vect p n) (Grassmann.vect p n)) (prod (Grassmann.vect p n) (Grassmann.vect p n))) (@pair (prod (Grassmann.vect p n) (Grassmann.vect p n)) (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) (multK (K1 p) a (multK (K1 p) b (prodk n l))) (gprod n l x4 (scalE (Grassmann.vn_eparams p n) (oppK (stype (Grassmann.vn_eparams p n)) (v1 (stype (Grassmann.vn_eparams p n)))) (rev n (all p n))))) (scalE (Grassmann.vn_eparams p n) (multK (K1 p) a (multK (K1 p) b (prodk n l))) (scalE (Grassmann.vn_eparams p n) b (gprod n l (scalE (Grassmann.vn_eparams p n) (oppK (stype (Grassmann.vn_eparams p n)) (v1 (stype (Grassmann.vn_eparams p n)))) x3) (scalE (Grassmann.vn_eparams p n) (oppK (stype (Grassmann.vn_eparams p n)) (v1 (stype (Grassmann.vn_eparams p n)))) (rev n (all p n))))))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) (multK (K1 p) a (multK (K1 p) b (prodk n l))) (scalE (Grassmann.vn_eparams p n) a (gprod n l x2 (scalE (Grassmann.vn_eparams p n) (oppK (stype (Grassmann.vn_eparams p n)) (v1 (stype (Grassmann.vn_eparams p n)))) (rev n (all p n)))))) (scalE (Grassmann.vn_eparams p n) (multK (K1 p) a (multK (K1 p) b (prodk n l))) (scalE (Grassmann.vn_eparams p n) a (scalE (Grassmann.vn_eparams p n) b (gprod n l (scalE (Grassmann.vn_eparams p n) (oppK (stype (Grassmann.vn_eparams p n)) (v1 (stype (Grassmann.vn_eparams p n)))) x1) (scalE (Grassmann.vn_eparams p n) (oppK (stype (Grassmann.vn_eparams p n)) (v1 (stype (Grassmann.vn_eparams p n)))) (rev n (all p n))))))))) (@pair (prod (Grassmann.vect p n) (Grassmann.vect p n)) (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) a (scalE (Grassmann.vn_eparams p n) (oppK (K1 p) b) (cliff_starb n true l x4))) (scalE (Grassmann.vn_eparams p n) a (scalE (Grassmann.vn_eparams p n) (multK (K1 p) b b) (cliff_starb n true l x3)))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) (multK (K1 p) a a) (scalE (Grassmann.vn_eparams p n) (oppK (K1 p) b) (cliff_starb n true l x2))) (scalE (Grassmann.vn_eparams p n) (multK (K1 p) a a) (scalE (Grassmann.vn_eparams p n) (multK (K1 p) b b) (cliff_starb n true l x1))))) *)
rewrite !gprod_scalr, !gprod_scall, <-!scal_multE; auto.
(* Goal: @Logic.eq (prod (prod (Grassmann.vect p n) (Grassmann.vect p n)) (prod (Grassmann.vect p n) (Grassmann.vect p n))) (@pair (prod (Grassmann.vect p n) (Grassmann.vect p n)) (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) (multK (stype (Grassmann.vn_eparams p n)) (multK (K1 p) a (multK (K1 p) b (prodk n l))) (oppK (stype (Grassmann.vn_eparams p n)) (v1 (stype (Grassmann.vn_eparams p n))))) (gprod n l x4 (rev n (all p n)))) (scalE (Grassmann.vn_eparams p n) (multK (stype (Grassmann.vn_eparams p n)) (multK (stype (Grassmann.vn_eparams p n)) (multK (stype (Grassmann.vn_eparams p n)) (multK (K1 p) a (multK (K1 p) b (prodk n l))) b) (oppK (stype (Grassmann.vn_eparams p n)) (v1 (stype (Grassmann.vn_eparams p n))))) (oppK (stype (Grassmann.vn_eparams p n)) (v1 (stype (Grassmann.vn_eparams p n))))) (gprod n l x3 (rev n (all p n))))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) (multK (stype (Grassmann.vn_eparams p n)) (multK (stype (Grassmann.vn_eparams p n)) (multK (K1 p) a (multK (K1 p) b (prodk n l))) a) (oppK (stype (Grassmann.vn_eparams p n)) (v1 (stype (Grassmann.vn_eparams p n))))) (gprod n l x2 (rev n (all p n)))) (scalE (Grassmann.vn_eparams p n) (multK (stype (Grassmann.vn_eparams p n)) (multK (stype (Grassmann.vn_eparams p n)) (multK (stype (Grassmann.vn_eparams p n)) (multK (stype (Grassmann.vn_eparams p n)) (multK (K1 p) a (multK (K1 p) b (prodk n l))) a) b) (oppK (stype (Grassmann.vn_eparams p n)) (v1 (stype (Grassmann.vn_eparams p n))))) (oppK (stype (Grassmann.vn_eparams p n)) (v1 (stype (Grassmann.vn_eparams p n))))) (gprod n l x1 (rev n (all p n)))))) (@pair (prod (Grassmann.vect p n) (Grassmann.vect p n)) (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) (multK (stype (Grassmann.vn_eparams p n)) a (oppK (K1 p) b)) (cliff_starb n true l x4)) (scalE (Grassmann.vn_eparams p n) (multK (stype (Grassmann.vn_eparams p n)) a (multK (K1 p) b b)) (cliff_starb n true l x3))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) (multK (stype (Grassmann.vn_eparams p n)) (multK (K1 p) a a) (oppK (K1 p) b)) (cliff_starb n true l x2)) (scalE (Grassmann.vn_eparams p n) (multK (stype (Grassmann.vn_eparams p n)) (multK (K1 p) a a) (multK (K1 p) b b)) (cliff_starb n true l x1)))) *)
rewrite <-multK_assoc; Krm1.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) (oppK (stype (Grassmann.vn_eparams p n)) (Field.v1 (stype (Grassmann.vn_eparams p n)))) (l_contra n k0 v0 (conj p n false v1))) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (l_contra n k0 v (conj p n false v1))) (l_contra n k0 (conj p n false v0) (conj p n false v2)))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) (oppK (stype (Grassmann.vn_eparams p n)) (Field.v1 (stype (Grassmann.vn_eparams p n)))) (l_contra n k0 v0 (conj p n false v1))) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (scalE (Grassmann.vn_eparams p n) (oppK (stype (Grassmann.vn_eparams p n)) (Field.v1 (stype (Grassmann.vn_eparams p n)))) (scalE (Grassmann.vn_eparams p n) (oppK (stype (Grassmann.vn_eparams p n)) (Field.v1 (stype (Grassmann.vn_eparams p n)))) (l_contra n k0 v (conj p n false v1))))) (l_contra n k0 (conj p n false v0) (conj p n false v2)))) *)
apply f_equal2 with (f := @pair _ _); apply f_equal2 with (f := @pair _ _); auto.
rewrite  opp_multKl, scal_multE, IH; auto.
(* Goal: @Logic.eq (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) (multK (stype (Grassmann.vn_eparams p n)) (multK (K1 p) (multK (K1 p) a b) (prodk n l)) b) (gprod n l x3 (rev n (all p n)))) (scalE (Grassmann.vn_eparams p n) (multK (stype (Grassmann.vn_eparams p n)) a (multK (K1 p) b b)) (cliff_starb n true l x3)) *)
(* Goal: @Logic.eq (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) (oppK (stype (Grassmann.vn_eparams p n)) (multK (stype (Grassmann.vn_eparams p n)) (multK (K1 p) (multK (K1 p) a b) (prodk n l)) a)) (gprod n l x2 (rev n (all p n)))) (scalE (Grassmann.vn_eparams p n) (oppK (K1 p) (multK (K1 p) (multK (K1 p) a a) b)) (cliff_starb n true l x2)) *)
(* Goal: @Logic.eq (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) (multK (stype (Grassmann.vn_eparams p n)) (multK (stype (Grassmann.vn_eparams p n)) (multK (K1 p) (multK (K1 p) a b) (prodk n l)) a) b) (gprod n l x1 (rev n (all p n)))) (scalE (Grassmann.vn_eparams p n) (multK (stype (Grassmann.vn_eparams p n)) (multK (K1 p) a a) (multK (K1 p) b b)) (cliff_starb n true l x1)) *)
rewrite multK_assoc, multK_com with (x := prodk n l); auto.
(* Goal: @Logic.eq (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) (multK (K1 p) a (multK (K1 p) b (multK (K1 p) (multK (stype (Grassmann.vn_eparams p n)) a b) (prodk n l)))) (gprod n l x1 (rev n (all p n)))) (scalE (Grassmann.vn_eparams p n) (multK (K1 p) a (multK (K1 p) a (multK (K1 p) b b))) (cliff_starb n true l x1)) *)
rewrite <-!multK_assoc, scal_multE, IH; auto.
(* Goal: @Logic.eq (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) (multK (stype (Grassmann.vn_eparams p n)) (multK (stype (Grassmann.vn_eparams p n)) (multK (K1 p) (multK (K1 p) a b) (prodk n l)) a) b) (gprod n l x1 (rev n (all p n)))) (scalE (Grassmann.vn_eparams p n) (multK (stype (Grassmann.vn_eparams p n)) (multK (K1 p) a a) (multK (K1 p) b b)) (cliff_starb n true l x1)) *)
rewrite !multK_assoc; auto.
(* Goal: @Logic.eq (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) (multK (K1 p) a (multK (K1 p) b (multK (K1 p) (prodk n l) (multK (stype (Grassmann.vn_eparams p n)) a b)))) (gprod n l x1 (rev n (all p n)))) (scalE (Grassmann.vn_eparams p n) (multK (K1 p) a (multK (K1 p) a (multK (K1 p) b b))) (cliff_starb n true l x1)) *)
rewrite multK_com with (x := prodk n l); auto.
(* Goal: @Logic.eq (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) (oppK (stype (Grassmann.vn_eparams p n)) (multK (K1 p) a (multK (K1 p) b (multK (K1 p) a (prodk n l))))) (gprod n l x2 (rev n (all p n)))) (scalE (Grassmann.vn_eparams p n) (oppK (K1 p) (multK (K1 p) a (multK (K1 p) a b))) (cliff_starb n true l x2)) *)
(* Goal: @Logic.eq (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) (multK (stype (Grassmann.vn_eparams p n)) (multK (stype (Grassmann.vn_eparams p n)) (multK (K1 p) (multK (K1 p) a b) (prodk n l)) a) b) (gprod n l x1 (rev n (all p n)))) (scalE (Grassmann.vn_eparams p n) (multK (stype (Grassmann.vn_eparams p n)) (multK (K1 p) a a) (multK (K1 p) b b)) (cliff_starb n true l x1)) *)
rewrite <-!multK_assoc, opp_multKl, scal_multE, IH; auto.
(* Goal: @Logic.eq (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) (multK (stype (Grassmann.vn_eparams p n)) (multK (stype (Grassmann.vn_eparams p n)) (multK (K1 p) (multK (K1 p) a b) (prodk n l)) a) b) (gprod n l x1 (rev n (all p n)))) (scalE (Grassmann.vn_eparams p n) (multK (stype (Grassmann.vn_eparams p n)) (multK (K1 p) a a) (multK (K1 p) b b)) (cliff_starb n true l x1)) *)
rewrite !multK_assoc; auto.
(* Goal: @Logic.eq (Grassmann.vect p n) (scalE (vn_eparams n) (multK (stype (Grassmann.vn_eparams p n)) (multK (K p) a (multK (K p) b a)) b) (cliff_starb n true l x1)) (scalE (Grassmann.vn_eparams p n) (multK (K1 p) (multK (K1 p) (multK (K1 p) a a) b) b) (cliff_starb n true l x1)) *)
rewrite multK_com with (x := b); auto.
(* Goal: @Logic.eq (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) (multK (stype (Grassmann.vn_eparams p n)) (multK (stype (Grassmann.vn_eparams p n)) (multK (K1 p) (multK (K1 p) a b) (prodk n l)) a) b) (gprod n l x1 (rev n (all p n)))) (scalE (Grassmann.vn_eparams p n) (multK (stype (Grassmann.vn_eparams p n)) (multK (K1 p) a a) (multK (K1 p) b b)) (cliff_starb n true l x1)) *)
rewrite !multK_assoc; auto.
(* Goal: @Logic.eq (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) (multK (K1 p) a (multK (K1 p) b (multK (K1 p) (prodk n l) (multK (stype (Grassmann.vn_eparams p n)) a b)))) (gprod n l x1 (rev n (all p n)))) (scalE (Grassmann.vn_eparams p n) (multK (K1 p) a (multK (K1 p) a (multK (K1 p) b b))) (cliff_starb n true l x1)) *)
rewrite multK_com with (x := prodk n l); auto.
(* Goal: @Logic.eq (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) (multK (K1 p) a (multK (K1 p) b (multK (K1 p) (multK (stype (Grassmann.vn_eparams p n)) a b) (prodk n l)))) (gprod n l x1 (rev n (all p n)))) (scalE (Grassmann.vn_eparams p n) (multK (K1 p) a (multK (K1 p) a (multK (K1 p) b b))) (cliff_starb n true l x1)) *)
rewrite <-!multK_assoc, scal_multE, IH; auto.
(* Goal: @Logic.eq (Grassmann.vect p n) (scalE (vn_eparams n) (multK (stype (Grassmann.vn_eparams p n)) (multK (stype (Grassmann.vn_eparams p n)) (multK (K1 p) a b) a) b) (cliff_starb n true l x1)) (scalE (Grassmann.vn_eparams p n) (multK (K1 p) (multK (K1 p) (multK (K1 p) a a) b) b) (cliff_starb n true l x1)) *)
rewrite multK_assoc with (z := a); auto.
(* Goal: @Logic.eq (Grassmann.vect p n) (scalE (vn_eparams n) (multK (stype (Grassmann.vn_eparams p n)) (multK (K p) a (multK (K p) b a)) b) (cliff_starb n true l x1)) (scalE (Grassmann.vn_eparams p n) (multK (K1 p) (multK (K1 p) (multK (K1 p) a a) b) b) (cliff_starb n true l x1)) *)
rewrite multK_com with (x := b); auto.
(* Goal: @Logic.eq (Grassmann.vect p n) (scalE (vn_eparams n) (multK (stype (Grassmann.vn_eparams p n)) (multK (K p) a (multK (K p) a b)) b) (cliff_starb n true l x1)) (scalE (Grassmann.vn_eparams p n) (multK (K1 p) (multK (K1 p) (multK (K1 p) a a) b) b) (cliff_starb n true l x1)) *)
rewrite <-!multK_assoc; auto.
Qed.

(* 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 _).

Lemma l_contra_addl n l x y z :
   (x + y) 'L[l] z = x 'L[l] z +  y 'L[l] z :> vect n.
Proof.
(* Goal: @Logic.eq (Grassmann.vect p n) (conj p n false (l_contra n l x y)) (l_contra n l (conj p n false x) (conj p n false y)) *)
induction n as [|n IH]; simpl; auto; try Vfold n.
(* Goal: @Logic.eq (Field.K (K1 p)) (multK (Grassmann.K1 p) (addK (Grassmann.K1 p) x y) z) (addK (K1 p) (multK (Grassmann.K1 p) x z) (multK (Grassmann.K1 p) y z)) *)
(* Goal: @Logic.eq (Field.K (K1 p)) (let (k, l1) := l in let (x1, x2) := let (l3, l5) := x in let (l4, l6) := y in @pair (Grassmann.vect p n) (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) l3 l4) (addE (Grassmann.vn_eparams p n) l5 l6) in let (y1, y2) := z in addK (K1 p) (prod_scal n l1 x2 y2) (multK (K1 p) k (prod_scal n l1 x1 (conj p n false y1)))) (addK (K1 p) (let (k, l1) := l in let (x1, x2) := x in let (y1, y2) := z in addK (K1 p) (prod_scal n l1 x2 y2) (multK (K1 p) k (prod_scal n l1 x1 (conj p n false y1)))) (let (k, l1) := l in let (x1, x2) := y in let (y1, y2) := z in addK (K1 p) (prod_scal n l1 x2 y2) (multK (K1 p) k (prod_scal n l1 x1 (conj p n false y1))))) *)
intros; rewrite add_multKl; auto.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (let (k, l1) := l in let (x1, x2) := let (x1, x2) := x in let (y1, y2) := y in @pair (Grassmann.vect p n) (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) (join p n x1 y2) (join p n (conj p n false x2) y1)) (join p n x2 y2) in let (y1, y2) := z in @pair (Grassmann.vect p n) (Grassmann.vect p n) (l_contra n l1 (conj p n false x2) y1) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (l_contra n l1 (conj p n false x1) y1)) (l_contra n l1 x2 y2))) (let (k, l1) := l in let (x1, x2) := x in let (y1, y2) := let (k0, l2) := l in let (x3, x4) := y in let (y1, y2) := z in @pair (Grassmann.vect p n) (Grassmann.vect p n) (l_contra n l2 (conj p n false x4) y1) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k0 (l_contra n l2 (conj p n false x3) y1)) (l_contra n l2 x4 y2)) in @pair (Grassmann.vect p n) (Grassmann.vect p n) (l_contra n l1 (conj p n false x2) y1) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (l_contra n l1 (conj p n false x1) y1)) (l_contra n l1 x2 y2))) *)
destruct l; destruct x; destruct y; destruct z.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (l_contra n k0 (conj p n false (addE (Grassmann.vn_eparams p n) v0 v2)) v3) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (l_contra n k0 (conj p n false (addE (Grassmann.vn_eparams p n) v v1)) v3)) (l_contra n k0 (addE (Grassmann.vn_eparams p n) v0 v2) v4))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) (l_contra n k0 (conj p n false v0) v3) (l_contra n k0 (conj p n false v2) v3)) (addE (Grassmann.vn_eparams p n) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (l_contra n k0 (conj p n false v) v3)) (l_contra n k0 v0 v4)) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (l_contra n k0 (conj p n false v1) v3)) (l_contra n k0 v2 v4)))) *)
rewrite conj_add, conj_add, !IH; auto.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) (oppK (stype (Grassmann.vn_eparams p n)) (Field.v1 (stype (Grassmann.vn_eparams p n)))) (l_contra n k0 v0 (conj p n false v1))) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (l_contra n k0 v (conj p n false v1))) (l_contra n k0 (conj p n false v0) (conj p n false v2)))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) (oppK (stype (Grassmann.vn_eparams p n)) (Field.v1 (stype (Grassmann.vn_eparams p n)))) (l_contra n k0 v0 (conj p n false v1))) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (scalE (Grassmann.vn_eparams p n) (oppK (stype (Grassmann.vn_eparams p n)) (Field.v1 (stype (Grassmann.vn_eparams p n)))) (scalE (Grassmann.vn_eparams p n) (oppK (stype (Grassmann.vn_eparams p n)) (Field.v1 (stype (Grassmann.vn_eparams p n)))) (l_contra n k0 v (conj p n false v1))))) (l_contra n k0 (conj p n false v0) (conj p n false v2)))) *)
apply f_equal2 with (f := @pair _ _); auto.
(* Goal: @Logic.eq (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (addE (Grassmann.vn_eparams p n) (l_contra n k0 (conj p n false v) v1) (l_contra n k0 (conj p n false v) v3))) (addE (Grassmann.vn_eparams p n) (l_contra n k0 v0 v2) (l_contra n k0 v0 v4))) (addE (Grassmann.vn_eparams p n) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (l_contra n k0 (conj p n false v) v1)) (l_contra n k0 v0 v2)) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (l_contra n k0 (conj p n false v) v3)) (l_contra n k0 v0 v4))) *)
rewrite !scal_addEr, !addE_assoc; auto.
(* Goal: @Logic.eq (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (l_contra n k0 v (conj p n false v1))) (l_contra n k0 (conj p n false v0) (conj p n false v2))) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (scalE (Grassmann.vn_eparams p n) (oppK (stype (Grassmann.vn_eparams p n)) (Field.v1 (stype (Grassmann.vn_eparams p n)))) (scalE (Grassmann.vn_eparams p n) (oppK (stype (Grassmann.vn_eparams p n)) (Field.v1 (stype (Grassmann.vn_eparams p n)))) (l_contra n k0 v (conj p n false v1))))) (l_contra n k0 (conj p n false v0) (conj p n false v2))) *)
apply f_equal2 with (f := addE _); auto.
(* Goal: @Logic.eq (VectorSpace.E (Grassmann.vn_eparams p n)) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (l_contra n k0 (conj p n false v) v3)) (addE (Grassmann.vn_eparams p n) (l_contra n k0 v0 v2) (l_contra n k0 v0 v4))) (addE (Grassmann.vn_eparams p n) (l_contra n k0 v0 v2) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (l_contra n k0 (conj p n false v) v3)) (l_contra n k0 v0 v4))) *)
rewrite <-!addE_assoc; auto.
(* Goal: @Logic.eq (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (l_contra n k0 v (conj p n false v1))) (l_contra n k0 (conj p n false v0) (conj p n false v2))) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (scalE (Grassmann.vn_eparams p n) (oppK (stype (Grassmann.vn_eparams p n)) (Field.v1 (stype (Grassmann.vn_eparams p n)))) (scalE (Grassmann.vn_eparams p n) (oppK (stype (Grassmann.vn_eparams p n)) (Field.v1 (stype (Grassmann.vn_eparams p n)))) (l_contra n k0 v (conj p n false v1))))) (l_contra n k0 (conj p n false v0) (conj p n false v2))) *)
apply f_equal2 with (f := addE _); auto.
(* Goal: @Logic.eq (VectorSpace.E (Grassmann.vn_eparams p n)) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (l_contra n k0 (conj p n false v) v3)) (l_contra n k0 v0 v2)) (addE (Grassmann.vn_eparams p n) (l_contra n k0 v0 v2) (scalE (Grassmann.vn_eparams p n) k (l_contra n k0 (conj p n false v) v3))) *)
rewrite addE_com; auto.
Qed.

Lemma l_contra_addr n l x y z :
   x 'L[l] (y + z) = x 'L[l] y + x 'L[l] z :> vect n.
Proof.
(* Goal: @Logic.eq (Grassmann.vect p n) (conj p n false (l_contra n l x y)) (l_contra n l (conj p n false x) (conj p n false y)) *)
induction n as [|n IH]; simpl; auto; try Vfold n.
(* Goal: @Logic.eq (Field.K (K1 p)) (multK (Grassmann.K1 p) x (addK (Grassmann.K1 p) y z)) (addK (K1 p) (multK (Grassmann.K1 p) x y) (multK (Grassmann.K1 p) x z)) *)
(* Goal: @Logic.eq (Field.K (K1 p)) (let (k, l1) := l in let (x1, x2) := x in let (y1, y2) := let (l3, l5) := y in let (l4, l6) := z in @pair (Grassmann.vect p n) (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) l3 l4) (addE (Grassmann.vn_eparams p n) l5 l6) in addK (K1 p) (prod_scal n l1 x2 y2) (multK (K1 p) k (prod_scal n l1 x1 (conj p n false y1)))) (addK (K1 p) (let (k, l1) := l in let (x1, x2) := x in let (y1, y2) := y in addK (K1 p) (prod_scal n l1 x2 y2) (multK (K1 p) k (prod_scal n l1 x1 (conj p n false y1)))) (let (k, l1) := l in let (x1, x2) := x in let (y1, y2) := z in addK (K1 p) (prod_scal n l1 x2 y2) (multK (K1 p) k (prod_scal n l1 x1 (conj p n false y1))))) *)
intros; rewrite add_multKr; auto.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (let (k, l1) := l in let (x1, x2) := let (x1, x2) := x in let (y1, y2) := y in @pair (Grassmann.vect p n) (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) (join p n x1 y2) (join p n (conj p n false x2) y1)) (join p n x2 y2) in let (y1, y2) := z in @pair (Grassmann.vect p n) (Grassmann.vect p n) (l_contra n l1 (conj p n false x2) y1) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (l_contra n l1 (conj p n false x1) y1)) (l_contra n l1 x2 y2))) (let (k, l1) := l in let (x1, x2) := x in let (y1, y2) := let (k0, l2) := l in let (x3, x4) := y in let (y1, y2) := z in @pair (Grassmann.vect p n) (Grassmann.vect p n) (l_contra n l2 (conj p n false x4) y1) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k0 (l_contra n l2 (conj p n false x3) y1)) (l_contra n l2 x4 y2)) in @pair (Grassmann.vect p n) (Grassmann.vect p n) (l_contra n l1 (conj p n false x2) y1) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (l_contra n l1 (conj p n false x1) y1)) (l_contra n l1 x2 y2))) *)
destruct l; destruct x; destruct y; destruct z.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (l_contra n k0 (conj p n false v0) (addE (Grassmann.vn_eparams p n) v1 v3)) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (l_contra n k0 (conj p n false v) (addE (Grassmann.vn_eparams p n) v1 v3))) (l_contra n k0 v0 (addE (Grassmann.vn_eparams p n) v2 v4)))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) (l_contra n k0 (conj p n false v0) v1) (l_contra n k0 (conj p n false v0) v3)) (addE (Grassmann.vn_eparams p n) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (l_contra n k0 (conj p n false v) v1)) (l_contra n k0 v0 v2)) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (l_contra n k0 (conj p n false v) v3)) (l_contra n k0 v0 v4)))) *)
rewrite !IH.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) (oppK (stype (Grassmann.vn_eparams p n)) (Field.v1 (stype (Grassmann.vn_eparams p n)))) (l_contra n k0 v0 (conj p n false v1))) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (l_contra n k0 v (conj p n false v1))) (l_contra n k0 (conj p n false v0) (conj p n false v2)))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) (oppK (stype (Grassmann.vn_eparams p n)) (Field.v1 (stype (Grassmann.vn_eparams p n)))) (l_contra n k0 v0 (conj p n false v1))) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (scalE (Grassmann.vn_eparams p n) (oppK (stype (Grassmann.vn_eparams p n)) (Field.v1 (stype (Grassmann.vn_eparams p n)))) (scalE (Grassmann.vn_eparams p n) (oppK (stype (Grassmann.vn_eparams p n)) (Field.v1 (stype (Grassmann.vn_eparams p n)))) (l_contra n k0 v (conj p n false v1))))) (l_contra n k0 (conj p n false v0) (conj p n false v2)))) *)
apply f_equal2 with (f := @pair _ _); auto.
(* Goal: @Logic.eq (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (addE (Grassmann.vn_eparams p n) (l_contra n k0 (conj p n false v) v1) (l_contra n k0 (conj p n false v) v3))) (addE (Grassmann.vn_eparams p n) (l_contra n k0 v0 v2) (l_contra n k0 v0 v4))) (addE (Grassmann.vn_eparams p n) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (l_contra n k0 (conj p n false v) v1)) (l_contra n k0 v0 v2)) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (l_contra n k0 (conj p n false v) v3)) (l_contra n k0 v0 v4))) *)
rewrite !scal_addEr, !addE_assoc; auto.
(* Goal: @Logic.eq (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (l_contra n k0 v (conj p n false v1))) (l_contra n k0 (conj p n false v0) (conj p n false v2))) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (scalE (Grassmann.vn_eparams p n) (oppK (stype (Grassmann.vn_eparams p n)) (Field.v1 (stype (Grassmann.vn_eparams p n)))) (scalE (Grassmann.vn_eparams p n) (oppK (stype (Grassmann.vn_eparams p n)) (Field.v1 (stype (Grassmann.vn_eparams p n)))) (l_contra n k0 v (conj p n false v1))))) (l_contra n k0 (conj p n false v0) (conj p n false v2))) *)
apply f_equal2 with (f := addE _); auto.
(* Goal: @Logic.eq (VectorSpace.E (Grassmann.vn_eparams p n)) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (l_contra n k0 (conj p n false v) v3)) (addE (Grassmann.vn_eparams p n) (l_contra n k0 v0 v2) (l_contra n k0 v0 v4))) (addE (Grassmann.vn_eparams p n) (l_contra n k0 v0 v2) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (l_contra n k0 (conj p n false v) v3)) (l_contra n k0 v0 v4))) *)
rewrite <-!addE_assoc; auto.
(* Goal: @Logic.eq (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (l_contra n k0 v (conj p n false v1))) (l_contra n k0 (conj p n false v0) (conj p n false v2))) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (scalE (Grassmann.vn_eparams p n) (oppK (stype (Grassmann.vn_eparams p n)) (Field.v1 (stype (Grassmann.vn_eparams p n)))) (scalE (Grassmann.vn_eparams p n) (oppK (stype (Grassmann.vn_eparams p n)) (Field.v1 (stype (Grassmann.vn_eparams p n)))) (l_contra n k0 v (conj p n false v1))))) (l_contra n k0 (conj p n false v0) (conj p n false v2))) *)
apply f_equal2 with (f := addE _); auto.
(* Goal: @Logic.eq (VectorSpace.E (Grassmann.vn_eparams p n)) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (l_contra n k0 (conj p n false v) v3)) (l_contra n k0 v0 v2)) (addE (Grassmann.vn_eparams p n) (l_contra n k0 v0 v2) (scalE (Grassmann.vn_eparams p n) k (l_contra n k0 (conj p n false v) v3))) *)
rewrite addE_com; auto.
Qed.

Lemma l_contra_scall n l k x y : 
   (k .* x) 'L[l] y = k .* (x 'L[l] y) :> vect n.
Proof.
(* Goal: @Logic.eq (Grassmann.vect p n) (conj p n false (l_contra n l x y)) (l_contra n l (conj p n false x) (conj p n false y)) *)
induction n as [|n IH]; simpl; auto; try Vfold n.
(* Goal: @Logic.eq (Field.K (K1 p)) (multK (Grassmann.K1 p) (multK (Grassmann.K1 p) k x) y) (multK (Grassmann.K1 p) k (multK (Grassmann.K1 p) x y)) *)
(* Goal: @Logic.eq (Field.K (K1 p)) (let (k0, l1) := l in let (x1, x2) := let (l2, l3) := x in @pair (Grassmann.vect p n) (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) k l2) (scalE (Grassmann.vn_eparams p n) k l3) in let (y1, y2) := y in addK (K1 p) (prod_scal n l1 x2 y2) (multK (K1 p) k0 (prod_scal n l1 x1 (conj p n false y1)))) (multK (Grassmann.K1 p) k (let (k, l1) := l in let (x1, x2) := x in let (y1, y2) := y in addK (K1 p) (prod_scal n l1 x2 y2) (multK (K1 p) k (prod_scal n l1 x1 (conj p n false y1))))) *)
intros; rewrite multK_assoc; auto.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (let (x, y) := let (x1, x2) := x in let (y1, y2) := y in @pair (Grassmann.vect p n) (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) (join p n x1 y2) (join p n (conj p n false x2) y1)) (join p n x2 y2) in @pair (Grassmann.vect p n) (Grassmann.vect p n) (conj p n false (rev n x)) (rev n y)) (let (x1, x2) := let (x, y) := y in @pair (Grassmann.vect p n) (Grassmann.vect p n) (conj p n false (rev n x)) (rev n y) in let (y1, y2) := let (x, y) := x in @pair (Grassmann.vect p n) (Grassmann.vect p n) (conj p n false (rev n x)) (rev n y) in @pair (Grassmann.vect p n) (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) (join p n x1 y2) (join p n (conj p n false x2) y1)) (join p n x2 y2)) *)
destruct l; destruct x; destruct y.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (l_contra n k1 (conj p n false (scalE (Grassmann.vn_eparams p n) k v0)) v1) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k0 (l_contra n k1 (conj p n false (scalE (Grassmann.vn_eparams p n) k v)) v1)) (l_contra n k1 (scalE (Grassmann.vn_eparams p n) k v0) v2))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) k (l_contra n k1 (conj p n false v0) v1)) (scalE (Grassmann.vn_eparams p n) k (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k0 (l_contra n k1 (conj p n false v) v1)) (l_contra n k1 v0 v2)))) *)
rewrite !conj_scal, !IH, scal_addEr, <-!scal_multE; auto.
(* Goal: @Logic.eq (Field.K (K1 p)) (multK (stype (Grassmann.vn_eparams p n)) k0 k) (multK (K1 p) k k0) *)
rewrite multK_com; auto.
Qed.

Lemma l_contra_scalr n l k x y :
   x 'L[l] (k .* y) = k .* (x 'L[l] y) :> vect n.
Proof.
(* Goal: @Logic.eq (Grassmann.vect p n) (conj p n false (l_contra n l x y)) (l_contra n l (conj p n false x) (conj p n false y)) *)
induction n as [|n IH]; simpl; auto; try Vfold n.
(* Goal: @Logic.eq (Field.K (K1 p)) (multK (Grassmann.K1 p) x (multK (Grassmann.K1 p) k y)) (multK (Grassmann.K1 p) k (multK (Grassmann.K1 p) x y)) *)
(* Goal: @Logic.eq (Field.K (K1 p)) (let (k0, l1) := l in let (x1, x2) := x in let (y1, y2) := let (l2, l3) := y in @pair (Grassmann.vect p n) (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) k l2) (scalE (Grassmann.vn_eparams p n) k l3) in addK (K1 p) (prod_scal n l1 x2 y2) (multK (K1 p) k0 (prod_scal n l1 x1 (conj p n false y1)))) (multK (Grassmann.K1 p) k (let (k, l1) := l in let (x1, x2) := x in let (y1, y2) := y in addK (K1 p) (prod_scal n l1 x2 y2) (multK (K1 p) k (prod_scal n l1 x1 (conj p n false y1))))) *)
intros; rewrite multK_swap; auto.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (let (x, y) := let (x1, x2) := x in let (y1, y2) := y in @pair (Grassmann.vect p n) (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) (join p n x1 y2) (join p n (conj p n false x2) y1)) (join p n x2 y2) in @pair (Grassmann.vect p n) (Grassmann.vect p n) (conj p n false (rev n x)) (rev n y)) (let (x1, x2) := let (x, y) := y in @pair (Grassmann.vect p n) (Grassmann.vect p n) (conj p n false (rev n x)) (rev n y) in let (y1, y2) := let (x, y) := x in @pair (Grassmann.vect p n) (Grassmann.vect p n) (conj p n false (rev n x)) (rev n y) in @pair (Grassmann.vect p n) (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) (join p n x1 y2) (join p n (conj p n false x2) y1)) (join p n x2 y2)) *)
destruct l; destruct x; destruct y.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (l_contra n k1 (conj p n false v0) (scalE (Grassmann.vn_eparams p n) k v1)) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k0 (l_contra n k1 (conj p n false v) (scalE (Grassmann.vn_eparams p n) k v1))) (l_contra n k1 v0 (scalE (Grassmann.vn_eparams p n) k v2)))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) k (l_contra n k1 (conj p n false v0) v1)) (scalE (Grassmann.vn_eparams p n) k (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k0 (l_contra n k1 (conj p n false v) v1)) (l_contra n k1 v0 v2)))) *)
rewrite !IH, scal_addEr, <-!scal_multE; auto.
(* Goal: @Logic.eq (Field.K (K1 p)) (multK (stype (Grassmann.vn_eparams p n)) k0 k) (multK (K1 p) k k0) *)
rewrite multK_com; auto.
Qed.

Lemma l_contra_0l n l y : 0 'L[l] y = 0 :> vect n.
Proof.
(* Goal: @Logic.eq (Grassmann.vect p n) (conj p n false (l_contra n l x y)) (l_contra n l (conj p n false x) (conj p n false y)) *)
induction n as [|n IH]; simpl; auto; try Vfold n.
(* Goal: @Logic.eq (Field.K (Grassmann.K1 p)) (multK (Grassmann.K1 p) (v0 (Grassmann.K1 p)) y) (v0 (Grassmann.K1 p)) *)
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (let (k, l1) := l in let (y1, y2) := y in @pair (Grassmann.vect p n) (Grassmann.vect p n) (l_contra n l1 (conj p n false (E0 (Grassmann.vn_eparams p n))) y1) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (l_contra n l1 (conj p n false (E0 (Grassmann.vn_eparams p n))) y1)) (l_contra n l1 (E0 (Grassmann.vn_eparams p n)) y2))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (E0 (Grassmann.vn_eparams p n)) (E0 (Grassmann.vn_eparams p n))) *)
intros; rewrite multK0l; auto.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (let (k0, l1) := l in let (y1, y2) := y in @pair (Grassmann.vect p n) (Grassmann.vect p n) (l_contra n l1 (conj p n false (genk p n k)) y1) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k0 (l_contra n l1 (conj p n false (E0 (Grassmann.vn_eparams p n))) y1)) (l_contra n l1 (genk p n k) y2))) (let (l2, l3) := y in @pair (Grassmann.vect p n) (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) k l2) (scalE (Grassmann.vn_eparams p n) k l3)) *)
destruct l; destruct y.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (l_contra n k0 (conj p n false (E0 (Grassmann.vn_eparams p n))) v) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (l_contra n k0 (conj p n false (E0 (Grassmann.vn_eparams p n))) v)) (l_contra n k0 (E0 (Grassmann.vn_eparams p n)) v0))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (E0 (Grassmann.vn_eparams p n)) (E0 (Grassmann.vn_eparams p n))) *)
rewrite !conj0, !IH; Vrm0.
Qed.

Lemma l_contra_0r n l x : x 'L[l] 0 = 0 :> vect n.
Proof.
(* Goal: @Logic.eq (Grassmann.vect p n) (conj p n false (l_contra n l x y)) (l_contra n l (conj p n false x) (conj p n false y)) *)
induction n as [|n IH]; simpl; auto; try Vfold n.
(* Goal: @Logic.eq (Field.K (Grassmann.K1 p)) (multK (Grassmann.K1 p) x (v0 (Grassmann.K1 p))) (v0 (Grassmann.K1 p)) *)
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (let (k, l1) := l in let (x1, x2) := x in @pair (Grassmann.vect p n) (Grassmann.vect p n) (l_contra n l1 (conj p n false x2) (E0 (Grassmann.vn_eparams p n))) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (l_contra n l1 (conj p n false x1) (E0 (Grassmann.vn_eparams p n)))) (l_contra n l1 x2 (E0 (Grassmann.vn_eparams p n))))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (E0 (Grassmann.vn_eparams p n)) (E0 (Grassmann.vn_eparams p n))) *)
intros; rewrite multK0r; auto.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (let (x, y) := let (l2, l3) := x in @pair (Grassmann.vect p n) (Grassmann.vect p n) (conj p n true l2) (conj p n false l3) in @pair (Grassmann.vect p n) (Grassmann.vect p n) (conj p n false (rev n x)) (rev n y)) (let (l2, l3) := let (x, y) := x in @pair (Grassmann.vect p n) (Grassmann.vect p n) (conj p n false (rev n x)) (rev n y) in @pair (Grassmann.vect p n) (Grassmann.vect p n) (conj p n true l2) (conj p n false l3)) *)
destruct l; destruct x.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (l_contra n k0 (conj p n false v0) (E0 (Grassmann.vn_eparams p n))) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (l_contra n k0 (conj p n false v) (E0 (Grassmann.vn_eparams p n)))) (l_contra n k0 v0 (E0 (Grassmann.vn_eparams p n))))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (E0 (Grassmann.vn_eparams p n)) (E0 (Grassmann.vn_eparams p n))) *)
rewrite !IH; Vrm0.
Qed.

Lemma l_contra_kl n l k y : [k] 'L[l] y =  k .* y :> vect n.
Proof.
(* Goal: @Logic.eq (Grassmann.vect p n) (conj p n false (l_contra n l x y)) (l_contra n l (conj p n false x) (conj p n false y)) *)
induction n as [|n IH]; simpl; auto; try Vfold n.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (let (k0, l1) := l in let (y1, y2) := y in @pair (Grassmann.vect p n) (Grassmann.vect p n) (l_contra n l1 (conj p n false (genk p n k)) y1) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k0 (l_contra n l1 (conj p n false (E0 (Grassmann.vn_eparams p n))) y1)) (l_contra n l1 (genk p n k) y2))) (let (l2, l3) := y in @pair (Grassmann.vect p n) (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) k l2) (scalE (Grassmann.vn_eparams p n) k l3)) *)
destruct l; destruct y.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (l_contra n k1 (conj p n false (genk p n k)) v) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k0 (l_contra n k1 (conj p n false (E0 (Grassmann.vn_eparams p n))) v)) (l_contra n k1 (genk p n k) v0))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) k v) (scalE (Grassmann.vn_eparams p n) k v0)) *)
rewrite !conj0, !conjk, !l_contra_0l, !IH; Vrm0.
Qed.

Lemma l_contra_kr n l k x : x 'L[l] [k] =  ['C[x] * k] :> vect n.
Proof.
(* Goal: @Logic.eq (Grassmann.vect p n) (conj p n false (l_contra n l x y)) (l_contra n l (conj p n false x) (conj p n false y)) *)
induction n as [|n IH]; simpl; auto; try Vfold n.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (let (x, y) := let (l2, l3) := x in @pair (Grassmann.vect p n) (Grassmann.vect p n) (conj p n true l2) (conj p n false l3) in @pair (Grassmann.vect p n) (Grassmann.vect p n) (conj p n false (rev n x)) (rev n y)) (let (l2, l3) := let (x, y) := x in @pair (Grassmann.vect p n) (Grassmann.vect p n) (conj p n false (rev n x)) (rev n y) in @pair (Grassmann.vect p n) (Grassmann.vect p n) (conj p n true l2) (conj p n false l3)) *)
destruct l; destruct x.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (l_contra n k1 (conj p n false v0) (E0 (Grassmann.vn_eparams p n))) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k0 (l_contra n k1 (conj p n false v) (E0 (Grassmann.vn_eparams p n)))) (l_contra n k1 v0 (genk p n k)))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (E0 (Grassmann.vn_eparams p n)) (genk p n (multK (Grassmann.K1 p) (const p n v0) k))) *)
rewrite !l_contra_0r, !IH; Vrm0.
Qed.

Lemma l_contra_joinl n l x y z :
  (x ∧ y) 'L[l] z = x 'L[l] (y 'L[l] z) :> vect n.
Proof.
(* Goal: @Logic.eq (Grassmann.vect p n) (conj p n false (l_contra n l x y)) (l_contra n l (conj p n false x) (conj p n false y)) *)
induction n as [|n IH]; simpl; auto; try Vfold n.
(* Goal: @Logic.eq (Field.K (K1 p)) (multK (Grassmann.K1 p) (multK (Grassmann.K1 p) k x) y) (multK (Grassmann.K1 p) k (multK (Grassmann.K1 p) x y)) *)
(* Goal: @Logic.eq (Field.K (K1 p)) (let (k0, l1) := l in let (x1, x2) := let (l2, l3) := x in @pair (Grassmann.vect p n) (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) k l2) (scalE (Grassmann.vn_eparams p n) k l3) in let (y1, y2) := y in addK (K1 p) (prod_scal n l1 x2 y2) (multK (K1 p) k0 (prod_scal n l1 x1 (conj p n false y1)))) (multK (Grassmann.K1 p) k (let (k, l1) := l in let (x1, x2) := x in let (y1, y2) := y in addK (K1 p) (prod_scal n l1 x2 y2) (multK (K1 p) k (prod_scal n l1 x1 (conj p n false y1))))) *)
intros; rewrite multK_assoc; auto.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (let (k, l1) := l in let (x1, x2) := let (x1, x2) := x in let (y1, y2) := y in @pair (Grassmann.vect p n) (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) (join p n x1 y2) (join p n (conj p n false x2) y1)) (join p n x2 y2) in let (y1, y2) := z in @pair (Grassmann.vect p n) (Grassmann.vect p n) (l_contra n l1 (conj p n false x2) y1) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (l_contra n l1 (conj p n false x1) y1)) (l_contra n l1 x2 y2))) (let (k, l1) := l in let (x1, x2) := x in let (y1, y2) := let (k0, l2) := l in let (x3, x4) := y in let (y1, y2) := z in @pair (Grassmann.vect p n) (Grassmann.vect p n) (l_contra n l2 (conj p n false x4) y1) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k0 (l_contra n l2 (conj p n false x3) y1)) (l_contra n l2 x4 y2)) in @pair (Grassmann.vect p n) (Grassmann.vect p n) (l_contra n l1 (conj p n false x2) y1) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (l_contra n l1 (conj p n false x1) y1)) (l_contra n l1 x2 y2))) *)
destruct l; destruct x; destruct y; destruct z.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (l_contra n k0 (conj p n false (join p n v0 v2)) v3) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (l_contra n k0 (conj p n false (addE (Grassmann.vn_eparams p n) (join p n v v2) (join p n (conj p n false v0) v1))) v3)) (l_contra n k0 (join p n v0 v2) v4))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (l_contra n k0 (conj p n false v0) (l_contra n k0 (conj p n false v2) v3)) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (l_contra n k0 (conj p n false v) (l_contra n k0 (conj p n false v2) v3))) (l_contra n k0 v0 (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (l_contra n k0 (conj p n false v1) v3)) (l_contra n k0 v2 v4))))) *)
rewrite !conj_add, !conjf_join, !l_contra_addl, !l_contra_addr; auto.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (l_contra n k0 (join p n (conj p n false v0) (conj p n false v2)) v3) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (addE (Grassmann.vn_eparams p n) (l_contra n k0 (join p n (conj p n false v) (conj p n false v2)) v3) (l_contra n k0 (join p n (conj p n false (conj p n false v0)) (conj p n false v1)) v3))) (l_contra n k0 (join p n v0 v2) v4))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (l_contra n k0 (conj p n false v0) (l_contra n k0 (conj p n false v2) v3)) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (l_contra n k0 (conj p n false v) (l_contra n k0 (conj p n false v2) v3))) (addE (Grassmann.vn_eparams p n) (l_contra n k0 v0 (scalE (Grassmann.vn_eparams p n) k (l_contra n k0 (conj p n false v1) v3))) (l_contra n k0 v0 (l_contra n k0 v2 v4))))) *)
rewrite !IH, !scal_addEr, !l_contra_scalr; auto.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (l_contra n k0 (conj p n false v0) (l_contra n k0 (conj p n false v2) v3)) (addE (Grassmann.vn_eparams p n) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (l_contra n k0 (conj p n false v) (l_contra n k0 (conj p n false v2) v3))) (scalE (Grassmann.vn_eparams p n) k (l_contra n k0 (conj p n false (conj p n false v0)) (l_contra n k0 (conj p n false v1) v3)))) (l_contra n k0 v0 (l_contra n k0 v2 v4)))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (l_contra n k0 (conj p n false v0) (l_contra n k0 (conj p n false v2) v3)) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (l_contra n k0 (conj p n false v) (l_contra n k0 (conj p n false v2) v3))) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (l_contra n k0 v0 (l_contra n k0 (conj p n false v1) v3))) (l_contra n k0 v0 (l_contra n k0 v2 v4))))) *)
rewrite !conj_invo, <-!addE_assoc; auto.
Qed.

Lemma l_contra_ei n l i :
   i < n -> 'e_i 'L[l] 'e_i = [projk i l] :> vect n.
Proof.
(* Goal: forall _ : lt i n, @Logic.eq (Grassmann.vect p n) (l_contra n l (gen p n i) (gen p n i)) (genk p n (Kn.proj p n i l)) *)
generalize i; clear i.
(* Goal: @Logic.eq (Grassmann.vect p n) (conj p n false (l_contra n l x y)) (l_contra n l (conj p n false x) (conj p n false y)) *)
induction n as [|n IH]; simpl; auto; try Vfold n.
(* Goal: forall (i : nat) (_ : lt i O), @Logic.eq (Field.K (Grassmann.K1 p)) (multK (Grassmann.K1 p) (v1 (Grassmann.K1 p)) (v1 (Grassmann.K1 p))) (v0 (K p)) *)
(* Goal: forall (i : nat) (_ : lt i (S n)), @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (let (k, l1) := l in let (x1, x2) := match i with | O => @pair (Grassmann.vect p n) (Grassmann.vect p n) (genk p n (v1 (Grassmann.K1 p))) (E0 (Grassmann.vn_eparams p n)) | S p1 => @pair (Grassmann.vect p n) (Grassmann.vect p n) (E0 (Grassmann.vn_eparams p n)) (gen p n p1) end in let (y1, y2) := match i with | O => @pair (Grassmann.vect p n) (Grassmann.vect p n) (genk p n (v1 (Grassmann.K1 p))) (E0 (Grassmann.vn_eparams p n)) | S p1 => @pair (Grassmann.vect p n) (Grassmann.vect p n) (E0 (Grassmann.vn_eparams p n)) (gen p n p1) end in @pair (Grassmann.vect p n) (Grassmann.vect p n) (l_contra n l1 (conj p n false x2) y1) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (l_contra n l1 (conj p n false x1) y1)) (l_contra n l1 x2 y2))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (E0 (Grassmann.vn_eparams p n)) (genk p n (let (a, l1) := l in match i with | O => a | S k1 => Kn.proj p n k1 l1 end))) *)
intros i HH; contradict HH; auto with arith.
(* Goal: forall (i : nat) (_ : lt i (S n)), @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (let (k, l1) := l in let (x1, x2) := match i with | O => @pair (Grassmann.vect p n) (Grassmann.vect p n) (genk p n (v1 (Grassmann.K1 p))) (E0 (Grassmann.vn_eparams p n)) | S p1 => @pair (Grassmann.vect p n) (Grassmann.vect p n) (E0 (Grassmann.vn_eparams p n)) (gen p n p1) end in let (y1, y2) := match i with | O => @pair (Grassmann.vect p n) (Grassmann.vect p n) (genk p n (v1 (Grassmann.K1 p))) (E0 (Grassmann.vn_eparams p n)) | S p1 => @pair (Grassmann.vect p n) (Grassmann.vect p n) (E0 (Grassmann.vn_eparams p n)) (gen p n p1) end in @pair (Grassmann.vect p n) (Grassmann.vect p n) (l_contra n l1 (conj p n false x2) y1) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (l_contra n l1 (conj p n false x1) y1)) (l_contra n l1 x2 y2))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (E0 (Grassmann.vn_eparams p n)) (genk p n (let (a, l1) := l in match i with | O => a | S k1 => Kn.proj p n k1 l1 end))) *)
intros [|i] HH; rewrite !conj0; auto.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (let (k, l1) := l in @pair (Grassmann.vect p n) (Grassmann.vect p n) (l_contra n l1 (conj p n false (gen p n i)) (E0 (Grassmann.vn_eparams p n))) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (l_contra n l1 (E0 (Grassmann.vn_eparams p n)) (E0 (Grassmann.vn_eparams p n)))) (l_contra n l1 (gen p n i) (gen p n i)))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (E0 (Grassmann.vn_eparams p n)) (genk p n (let (_, l1) := l in Kn.proj p n i l1))) *)
destruct l.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (l_contra n k0 (E0 (Grassmann.vn_eparams p n)) (genk p n (v1 (Grassmann.K1 p)))) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (l_contra n k0 (conj p n false (genk p n (v1 (Grassmann.K1 p)))) (genk p n (v1 (Grassmann.K1 p))))) (l_contra n k0 (E0 (Grassmann.vn_eparams p n)) (E0 (Grassmann.vn_eparams p n))))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (E0 (Grassmann.vn_eparams p n)) (genk p n k)) *)
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (let (k, l1) := l in @pair (Grassmann.vect p n) (Grassmann.vect p n) (l_contra n l1 (conj p n false (gen p n i)) (E0 (Grassmann.vn_eparams p n))) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (l_contra n l1 (E0 (Grassmann.vn_eparams p n)) (E0 (Grassmann.vn_eparams p n)))) (l_contra n l1 (gen p n i) (gen p n i)))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (E0 (Grassmann.vn_eparams p n)) (genk p n (let (_, l1) := l in Kn.proj p n i l1))) *)
rewrite !l_contra_0l, !conjk, !l_contra_kl, !scalE1; Vrm0.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (E0 (Grassmann.vn_eparams p n)) (scalE (Grassmann.vn_eparams p n) k (genk p n (v1 (Grassmann.K1 p))))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (E0 (Grassmann.vn_eparams p n)) (genk p n k)) *)
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (let (k, l1) := l in @pair (Grassmann.vect p n) (Grassmann.vect p n) (l_contra n l1 (conj p n false (gen p n i)) (E0 (Grassmann.vn_eparams p n))) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (l_contra n l1 (E0 (Grassmann.vn_eparams p n)) (E0 (Grassmann.vn_eparams p n)))) (l_contra n l1 (gen p n i) (gen p n i)))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (E0 (Grassmann.vn_eparams p n)) (genk p n (let (_, l1) := l in Kn.proj p n i l1))) *)
rewrite scalk; simpl; intros; Krm1.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (let (k, l1) := l in @pair (Grassmann.vect p n) (Grassmann.vect p n) (l_contra n l1 (conj p n false (gen p n i)) (E0 (Grassmann.vn_eparams p n))) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (l_contra n l1 (E0 (Grassmann.vn_eparams p n)) (E0 (Grassmann.vn_eparams p n)))) (l_contra n l1 (gen p n i) (gen p n i)))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (E0 (Grassmann.vn_eparams p n)) (genk p n (let (_, l1) := l in Kn.proj p n i l1))) *)
destruct l.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (l_contra n k0 (conj p n false (gen p n i)) (E0 (Grassmann.vn_eparams p n))) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (l_contra n k0 (E0 (Grassmann.vn_eparams p n)) (E0 (Grassmann.vn_eparams p n)))) (l_contra n k0 (gen p n i) (gen p n i)))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (E0 (Grassmann.vn_eparams p n)) (genk p n (Kn.proj p n i k0))) *)
rewrite !l_contra_0l, !l_contra_0r, !IH; auto with arith; Vrm0.
Qed.

Lemma l_contra_eij n l i j :
   i < n -> j < n -> i <> j -> 'e_i 'L[l] 'e_j =  0 :> vect n.
Proof.
(* Goal: forall (_ : lt i n) (_ : lt j n) (_ : not (@Logic.eq nat i j)), @Logic.eq (Grassmann.vect p n) (l_contra n l (gen p n i) (gen p n j)) (E0 (Grassmann.vn_eparams p n)) *)
generalize i j; clear i j.
(* Goal: @Logic.eq (Grassmann.vect p n) (conj p n false (l_contra n l x y)) (l_contra n l (conj p n false x) (conj p n false y)) *)
induction n as [|n IH]; simpl; auto; try Vfold n.
(* Goal: forall (i j : nat) (_ : lt i O) (_ : lt j O) (_ : not (@Logic.eq nat i j)), @Logic.eq (Field.K (Grassmann.K1 p)) (multK (Grassmann.K1 p) (v1 (Grassmann.K1 p)) (v1 (Grassmann.K1 p))) (v0 (Grassmann.K1 p)) *)
(* Goal: forall (i j : nat) (_ : lt i (S n)) (_ : lt j (S n)) (_ : not (@Logic.eq nat i j)), @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (let (k, l1) := l in let (x1, x2) := match i with | O => @pair (Grassmann.vect p n) (Grassmann.vect p n) (genk p n (v1 (Grassmann.K1 p))) (E0 (Grassmann.vn_eparams p n)) | S p1 => @pair (Grassmann.vect p n) (Grassmann.vect p n) (E0 (Grassmann.vn_eparams p n)) (gen p n p1) end in let (y1, y2) := match j with | O => @pair (Grassmann.vect p n) (Grassmann.vect p n) (genk p n (v1 (Grassmann.K1 p))) (E0 (Grassmann.vn_eparams p n)) | S p1 => @pair (Grassmann.vect p n) (Grassmann.vect p n) (E0 (Grassmann.vn_eparams p n)) (gen p n p1) end in @pair (Grassmann.vect p n) (Grassmann.vect p n) (l_contra n l1 (conj p n false x2) y1) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (l_contra n l1 (conj p n false x1) y1)) (l_contra n l1 x2 y2))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (E0 (Grassmann.vn_eparams p n)) (E0 (Grassmann.vn_eparams p n))) *)
intros i j HH; contradict HH; auto with arith.
(* Goal: forall (i j : nat) (_ : lt i (S n)) (_ : lt j (S n)) (_ : not (@Logic.eq nat i j)), @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (let (k, l1) := l in let (x1, x2) := match i with | O => @pair (Grassmann.vect p n) (Grassmann.vect p n) (genk p n (v1 (Grassmann.K1 p))) (E0 (Grassmann.vn_eparams p n)) | S p1 => @pair (Grassmann.vect p n) (Grassmann.vect p n) (E0 (Grassmann.vn_eparams p n)) (gen p n p1) end in let (y1, y2) := match j with | O => @pair (Grassmann.vect p n) (Grassmann.vect p n) (genk p n (v1 (Grassmann.K1 p))) (E0 (Grassmann.vn_eparams p n)) | S p1 => @pair (Grassmann.vect p n) (Grassmann.vect p n) (E0 (Grassmann.vn_eparams p n)) (gen p n p1) end in @pair (Grassmann.vect p n) (Grassmann.vect p n) (l_contra n l1 (conj p n false x2) y1) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (l_contra n l1 (conj p n false x1) y1)) (l_contra n l1 x2 y2))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (E0 (Grassmann.vn_eparams p n)) (E0 (Grassmann.vn_eparams p n))) *)
intros [|i] [|j]; simpl; auto.
(* Goal: forall (_ : lt O (S n)) (_ : lt O (S n)) (_ : not (@Logic.eq nat O O)), @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (let (k, l1) := l in @pair (Grassmann.vect p n) (Grassmann.vect p n) (l_contra n l1 (conj p n false (genk p n (v0 (Grassmann.K1 p)))) (genk p n (v1 (Grassmann.K1 p)))) (add p n (scal p n k (l_contra n l1 (conj p n false (genk p n (v1 (Grassmann.K1 p)))) (genk p n (v1 (Grassmann.K1 p))))) (l_contra n l1 (genk p n (v0 (Grassmann.K1 p))) (genk p n (v0 (Grassmann.K1 p)))))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (genk p n (v0 (Grassmann.K1 p))) (genk p n (v0 (Grassmann.K1 p)))) *)
(* Goal: forall (_ : lt O (S n)) (_ : lt (S j) (S n)) (_ : not (@Logic.eq nat O (S j))), @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (let (k, l1) := l in @pair (Grassmann.vect p n) (Grassmann.vect p n) (l_contra n l1 (conj p n false (genk p n (v0 (Grassmann.K1 p)))) (genk p n (v0 (Grassmann.K1 p)))) (add p n (scal p n k (l_contra n l1 (conj p n false (genk p n (v1 (Grassmann.K1 p)))) (genk p n (v0 (Grassmann.K1 p))))) (l_contra n l1 (genk p n (v0 (Grassmann.K1 p))) (gen p n j)))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (genk p n (v0 (Grassmann.K1 p))) (genk p n (v0 (Grassmann.K1 p)))) *)
(* Goal: forall (_ : lt (S i) (S n)) (_ : lt O (S n)) (_ : not (@Logic.eq nat (S i) O)), @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (let (k, l1) := l in @pair (Grassmann.vect p n) (Grassmann.vect p n) (l_contra n l1 (conj p n false (gen p n i)) (genk p n (v1 (Grassmann.K1 p)))) (add p n (scal p n k (l_contra n l1 (conj p n false (genk p n (v0 (Grassmann.K1 p)))) (genk p n (v1 (Grassmann.K1 p))))) (l_contra n l1 (gen p n i) (genk p n (v0 (Grassmann.K1 p)))))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (genk p n (v0 (Grassmann.K1 p))) (genk p n (v0 (Grassmann.K1 p)))) *)
(* Goal: forall (_ : lt (S i) (S n)) (_ : lt (S j) (S n)) (_ : not (@Logic.eq nat (S i) (S j))), @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (let (k, l1) := l in @pair (Grassmann.vect p n) (Grassmann.vect p n) (l_contra n l1 (conj p n false (gen p n i)) (genk p n (v0 (Grassmann.K1 p)))) (add p n (scal p n k (l_contra n l1 (conj p n false (genk p n (v0 (Grassmann.K1 p)))) (genk p n (v0 (Grassmann.K1 p))))) (l_contra n l1 (gen p n i) (gen p n j)))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (genk p n (v0 (Grassmann.K1 p))) (genk p n (v0 (Grassmann.K1 p)))) *)
intros H1 H2 []; auto.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (let (k, l1) := l in @pair (Grassmann.vect p n) (Grassmann.vect p n) (l_contra n l1 (conj p n false (gen p n i)) (E0 (Grassmann.vn_eparams p n))) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (l_contra n l1 (E0 (Grassmann.vn_eparams p n)) (E0 (Grassmann.vn_eparams p n)))) (l_contra n l1 (gen p n i) (gen p n i)))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (E0 (Grassmann.vn_eparams p n)) (genk p n (let (_, l1) := l in Kn.proj p n i l1))) *)
intros; destruct l.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (l_contra n k0 (conj p n false (genk p n (v0 (Grassmann.K1 p)))) (genk p n (v0 (Grassmann.K1 p)))) (add p n (scal p n k (l_contra n k0 (conj p n false (genk p n (v1 (Grassmann.K1 p)))) (genk p n (v0 (Grassmann.K1 p))))) (l_contra n k0 (genk p n (v0 (Grassmann.K1 p))) (gen p n j)))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (genk p n (v0 (Grassmann.K1 p))) (genk p n (v0 (Grassmann.K1 p)))) *)
(* Goal: forall (_ : lt (S i) (S n)) (_ : lt O (S n)) (_ : not (@Logic.eq nat (S i) O)), @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (let (k, l1) := l in @pair (Grassmann.vect p n) (Grassmann.vect p n) (l_contra n l1 (conj p n false (gen p n i)) (genk p n (v1 (Grassmann.K1 p)))) (add p n (scal p n k (l_contra n l1 (conj p n false (genk p n (v0 (Grassmann.K1 p)))) (genk p n (v1 (Grassmann.K1 p))))) (l_contra n l1 (gen p n i) (genk p n (v0 (Grassmann.K1 p)))))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (genk p n (v0 (Grassmann.K1 p))) (genk p n (v0 (Grassmann.K1 p)))) *)
(* Goal: forall (_ : lt (S i) (S n)) (_ : lt (S j) (S n)) (_ : not (@Logic.eq nat (S i) (S j))), @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (let (k, l1) := l in @pair (Grassmann.vect p n) (Grassmann.vect p n) (l_contra n l1 (conj p n false (gen p n i)) (genk p n (v0 (Grassmann.K1 p)))) (add p n (scal p n k (l_contra n l1 (conj p n false (genk p n (v0 (Grassmann.K1 p)))) (genk p n (v0 (Grassmann.K1 p))))) (l_contra n l1 (gen p n i) (gen p n j)))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (genk p n (v0 (Grassmann.K1 p))) (genk p n (v0 (Grassmann.K1 p)))) *)
rewrite !conj0, !conjk, !l_contra_0l, !l_contra_0r; Vrm0.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (let (k, l1) := l in @pair (Grassmann.vect p n) (Grassmann.vect p n) (l_contra n l1 (conj p n false (gen p n i)) (E0 (Grassmann.vn_eparams p n))) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (l_contra n l1 (E0 (Grassmann.vn_eparams p n)) (E0 (Grassmann.vn_eparams p n)))) (l_contra n l1 (gen p n i) (gen p n i)))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (E0 (Grassmann.vn_eparams p n)) (genk p n (let (_, l1) := l in Kn.proj p n i l1))) *)
intros; destruct l.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (l_contra n k0 (conj p n false (gen p n i)) (genk p n (v0 (Grassmann.K1 p)))) (add p n (scal p n k (l_contra n k0 (conj p n false (genk p n (v0 (Grassmann.K1 p)))) (genk p n (v0 (Grassmann.K1 p))))) (l_contra n k0 (gen p n i) (gen p n j)))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (genk p n (v0 (Grassmann.K1 p))) (genk p n (v0 (Grassmann.K1 p)))) *)
rewrite !conj0, !l_contra_0l, !l_contra_0r; Vrm0.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (l_contra n k0 (conj p n false (gen p n i)) (genk p n (v1 (Grassmann.K1 p)))) (E0 (Grassmann.vn_eparams p n))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (genk p n (v0 (Grassmann.K1 p))) (genk p n (v0 (Grassmann.K1 p)))) *)
(* Goal: forall (_ : lt (S i) (S n)) (_ : lt (S j) (S n)) (_ : not (@Logic.eq nat (S i) (S j))), @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (let (k, l1) := l in @pair (Grassmann.vect p n) (Grassmann.vect p n) (l_contra n l1 (conj p n false (gen p n i)) (genk p n (v0 (Grassmann.K1 p)))) (add p n (scal p n k (l_contra n l1 (conj p n false (genk p n (v0 (Grassmann.K1 p)))) (genk p n (v0 (Grassmann.K1 p))))) (l_contra n l1 (gen p n i) (gen p n j)))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (genk p n (v0 (Grassmann.K1 p))) (genk p n (v0 (Grassmann.K1 p)))) *)
rewrite !l_contra_kr, const_hom with (k := 1); Krm0.
(* Goal: b2Prop (Grassmann.hom p n (S O) (conj p n false (gen p n i))) *)
(* Goal: forall (_ : lt (S i) (S n)) (_ : lt (S j) (S n)) (_ : not (@Logic.eq nat (S i) (S j))), @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (let (k, l1) := l in @pair (Grassmann.vect p n) (Grassmann.vect p n) (l_contra n l1 (conj p n false (gen p n i)) (genk p n (v0 (Grassmann.K1 p)))) (add p n (scal p n k (l_contra n l1 (conj p n false (genk p n (v0 (Grassmann.K1 p)))) (genk p n (v0 (Grassmann.K1 p))))) (l_contra n l1 (gen p n i) (gen p n j)))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (genk p n (v0 (Grassmann.K1 p))) (genk p n (v0 (Grassmann.K1 p)))) *)
apply conj_hom; auto.
(* Goal: b2Prop (Grassmann.hom p n (S O) (gen p n i)) *)
(* Goal: forall (_ : lt (S i) (S n)) (_ : lt (S j) (S n)) (_ : not (@Logic.eq nat (S i) (S j))), @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (let (k, l1) := l in @pair (Grassmann.vect p n) (Grassmann.vect p n) (l_contra n l1 (conj p n false (gen p n i)) (genk p n (v0 (Grassmann.K1 p)))) (add p n (scal p n k (l_contra n l1 (conj p n false (genk p n (v0 (Grassmann.K1 p)))) (genk p n (v0 (Grassmann.K1 p))))) (l_contra n l1 (gen p n i) (gen p n j)))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (genk p n (v0 (Grassmann.K1 p))) (genk p n (v0 (Grassmann.K1 p)))) *)
apply hom1e; auto with arith.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (let (k, l1) := l in @pair (Grassmann.vect p n) (Grassmann.vect p n) (l_contra n l1 (conj p n false (gen p n i)) (E0 (Grassmann.vn_eparams p n))) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (l_contra n l1 (E0 (Grassmann.vn_eparams p n)) (E0 (Grassmann.vn_eparams p n)))) (l_contra n l1 (gen p n i) (gen p n i)))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (E0 (Grassmann.vn_eparams p n)) (genk p n (let (_, l1) := l in Kn.proj p n i l1))) *)
intros; destruct l.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (l_contra n k0 (conj p n false (gen p n i)) (genk p n (v0 (Grassmann.K1 p)))) (add p n (scal p n k (l_contra n k0 (conj p n false (genk p n (v0 (Grassmann.K1 p)))) (genk p n (v0 (Grassmann.K1 p))))) (l_contra n k0 (gen p n i) (gen p n j)))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (genk p n (v0 (Grassmann.K1 p))) (genk p n (v0 (Grassmann.K1 p)))) *)
rewrite !conj0, !l_contra_0l, !l_contra_0r; Vrm0.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (E0 (Grassmann.vn_eparams p n)) (l_contra n k0 (gen p n i) (gen p n j))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (genk p n (v0 (Grassmann.K1 p))) (genk p n (v0 (Grassmann.K1 p)))) *)
rewrite IH; auto with arith.
Qed.

Lemma l_contra_conj n l x y :
   (x 'L[l] y)^_'f = (x^_'f) 'L[l] (y^_'f) :> vect n.
Proof.
(* Goal: @Logic.eq (Grassmann.vect p n) (conj p n false (l_contra n l x y)) (l_contra n l (conj p n false x) (conj p n false y)) *)
induction n as [|n IH]; simpl; auto; try Vfold n.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (let (x, y) := let (x1, x2) := x in let (y1, y2) := y in @pair (Grassmann.vect p n) (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) (join p n x1 y2) (join p n (conj p n false x2) y1)) (join p n x2 y2) in @pair (Grassmann.vect p n) (Grassmann.vect p n) (conj p n false (rev n x)) (rev n y)) (let (x1, x2) := let (x, y) := y in @pair (Grassmann.vect p n) (Grassmann.vect p n) (conj p n false (rev n x)) (rev n y) in let (y1, y2) := let (x, y) := x in @pair (Grassmann.vect p n) (Grassmann.vect p n) (conj p n false (rev n x)) (rev n y) in @pair (Grassmann.vect p n) (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) (join p n x1 y2) (join p n (conj p n false x2) y1)) (join p n x2 y2)) *)
destruct l; destruct x; destruct y.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (conj p n true (l_contra n k0 (conj p n false v0) v1)) (conj p n false (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (l_contra n k0 (conj p n false v) v1)) (l_contra n k0 v0 v2)))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (l_contra n k0 (conj p n false (conj p n false v0)) (conj p n true v1)) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (l_contra n k0 (conj p n false (conj p n true v)) (conj p n true v1))) (l_contra n k0 (conj p n false v0) (conj p n false v2)))) *)
rewrite !conjt, !conj_invo, !conj_scal; auto.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) (oppK (stype (Grassmann.vn_eparams p n)) (Field.v1 (stype (Grassmann.vn_eparams p n)))) (conj p n false (l_contra n k0 (conj p n false v0) v1))) (conj p n false (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (l_contra n k0 (conj p n false v) v1)) (l_contra n k0 v0 v2)))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (l_contra n k0 v0 (scalE (Grassmann.vn_eparams p n) (oppK (stype (Grassmann.vn_eparams p n)) (Field.v1 (stype (Grassmann.vn_eparams p n)))) (conj p n false v1))) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (l_contra n k0 (scalE (Grassmann.vn_eparams p n) (oppK (stype (Grassmann.vn_eparams p n)) (Field.v1 (stype (Grassmann.vn_eparams p n)))) (conj p n false (conj p n false v))) (scalE (Grassmann.vn_eparams p n) (oppK (stype (Grassmann.vn_eparams p n)) (Field.v1 (stype (Grassmann.vn_eparams p n)))) (conj p n false v1)))) (l_contra n k0 (conj p n false v0) (conj p n false v2)))) *)
rewrite !l_contra_scalr, !l_contra_scall, !conj_invo; auto.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) (oppK (stype (Grassmann.vn_eparams p n)) (Field.v1 (stype (Grassmann.vn_eparams p n)))) (conj p n false (l_contra n k0 (conj p n false v0) v1))) (conj p n false (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (l_contra n k0 (conj p n false v) v1)) (l_contra n k0 v0 v2)))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) (oppK (stype (Grassmann.vn_eparams p n)) (Field.v1 (stype (Grassmann.vn_eparams p n)))) (l_contra n k0 v0 (conj p n false v1))) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (scalE (Grassmann.vn_eparams p n) (oppK (stype (Grassmann.vn_eparams p n)) (Field.v1 (stype (Grassmann.vn_eparams p n)))) (scalE (Grassmann.vn_eparams p n) (oppK (stype (Grassmann.vn_eparams p n)) (Field.v1 (stype (Grassmann.vn_eparams p n)))) (l_contra n k0 v (conj p n false v1))))) (l_contra n k0 (conj p n false v0) (conj p n false v2)))) *)
rewrite !conj_add, !conj_scal, !IH, !conj_invo; auto.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) (oppK (stype (Grassmann.vn_eparams p n)) (Field.v1 (stype (Grassmann.vn_eparams p n)))) (l_contra n k0 v0 (conj p n false v1))) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (l_contra n k0 v (conj p n false v1))) (l_contra n k0 (conj p n false v0) (conj p n false v2)))) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) (oppK (stype (Grassmann.vn_eparams p n)) (Field.v1 (stype (Grassmann.vn_eparams p n)))) (l_contra n k0 v0 (conj p n false v1))) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (scalE (Grassmann.vn_eparams p n) (oppK (stype (Grassmann.vn_eparams p n)) (Field.v1 (stype (Grassmann.vn_eparams p n)))) (scalE (Grassmann.vn_eparams p n) (oppK (stype (Grassmann.vn_eparams p n)) (Field.v1 (stype (Grassmann.vn_eparams p n)))) (l_contra n k0 v (conj p n false v1))))) (l_contra n k0 (conj p n false v0) (conj p n false v2)))) *)
apply f_equal2 with (f := @pair _ _); auto.
(* Goal: @Logic.eq (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (l_contra n k0 v (conj p n false v1))) (l_contra n k0 (conj p n false v0) (conj p n false v2))) (addE (Grassmann.vn_eparams p n) (scalE (Grassmann.vn_eparams p n) k (scalE (Grassmann.vn_eparams p n) (oppK (stype (Grassmann.vn_eparams p n)) (Field.v1 (stype (Grassmann.vn_eparams p n)))) (scalE (Grassmann.vn_eparams p n) (oppK (stype (Grassmann.vn_eparams p n)) (Field.v1 (stype (Grassmann.vn_eparams p n)))) (l_contra n k0 v (conj p n false v1))))) (l_contra n k0 (conj p n false v0) (conj p n false v2))) *)
apply f_equal2 with (f := addE _); auto.
(* Goal: @Logic.eq (VectorSpace.E (Grassmann.vn_eparams p n)) (scalE (Grassmann.vn_eparams p n) k (l_contra n k0 v (conj p n false v1))) (scalE (Grassmann.vn_eparams p n) k (scalE (Grassmann.vn_eparams p n) (oppK (stype (Grassmann.vn_eparams p n)) (Field.v1 (stype (Grassmann.vn_eparams p n)))) (scalE (Grassmann.vn_eparams p n) (oppK (stype (Grassmann.vn_eparams p n)) (Field.v1 (stype (Grassmann.vn_eparams p n)))) (l_contra n k0 v (conj p n false v1))))) *)
rewrite <-!scal_multE; Krm1.
Qed.

(* Retrieve the Hodge dual from geometric product *)
(* when the quadratic form is nul *)
(* Thanks to Lounesto: Clifford Algebra and Spinors *)
Lemma dualE n x : '@x = 'R[x] [* [1%f]%Kn] E :> vect n.
(* Goal: @Logic.eq (Grassmann.vect p n) (dual p n x) (gprod n (Kn.genk p n (v1 (K p))) (rev n x) (all p n)) *)
induction n as [|n IH]; simpl; try Vfold n.
(* Goal: @Logic.eq (Field.K (Grassmann.K1 p)) x (multK (Grassmann.K1 p) x (v1 (Grassmann.K1 p))) *)
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (let (x, y) := x in @pair (Grassmann.vect p n) (Grassmann.vect p n) (dual p n (conj p n false y)) (dual p n x)) (let (x1, x2) := let (x, y) := x in @pair (Grassmann.vect p n) (Grassmann.vect p n) (conj p n false (rev n x)) (rev n y) in @pair (Grassmann.vect p n) (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) (gprod n (Kn.genk p n (v1 (K1 p))) x1 (E0 (Grassmann.vn_eparams p n))) (gprod n (Kn.genk p n (v1 (K1 p))) (conj p n false x2) (all p n))) (addE (Grassmann.vn_eparams p n) (gprod n (Kn.genk p n (v1 (K1 p))) x2 (E0 (Grassmann.vn_eparams p n))) (scalE (Grassmann.vn_eparams p n) (v1 (K1 p)) (gprod n (Kn.genk p n (v1 (K1 p))) (conj p n false x1) (all p n))))) *)
intros; rewrite multK1r; auto.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (let (x, y) := x in @pair (Grassmann.vect p n) (Grassmann.vect p n) (dual p n (conj p n false y)) (dual p n x)) (let (x1, x2) := let (x, y) := x in @pair (Grassmann.vect p n) (Grassmann.vect p n) (conj p n false (rev n x)) (rev n y) in @pair (Grassmann.vect p n) (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) (gprod n (Kn.genk p n (v1 (K1 p))) x1 (E0 (Grassmann.vn_eparams p n))) (gprod n (Kn.genk p n (v1 (K1 p))) (conj p n false x2) (all p n))) (addE (Grassmann.vn_eparams p n) (gprod n (Kn.genk p n (v1 (K1 p))) x2 (E0 (Grassmann.vn_eparams p n))) (scalE (Grassmann.vn_eparams p n) (v1 (K1 p)) (gprod n (Kn.genk p n (v1 (K1 p))) (conj p n false x1) (all p n))))) *)
destruct x; rewrite !gprod0r; Vrm0.
(* Goal: @Logic.eq (prod (Grassmann.vect p n) (Grassmann.vect p n)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (dual p n (conj p n false v0)) (dual p n v)) (@pair (Grassmann.vect p n) (Grassmann.vect p n) (gprod n (Kn.genk p n (v1 (K1 p))) (conj p n false (rev n v0)) (all p n)) (scalE (Grassmann.vn_eparams p n) (v1 (K1 p)) (gprod n (Kn.genk p n (v1 (K1 p))) (conj p n false (conj p n false (rev n v))) (all p n)))) *)
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 prod_scal0r n l (x : vect n) : x [.l] 0 = 0%f.
Proof.
(* Goal: @Logic.eq (Field.K (K1 p)) (prod_scal n l x y) (prod_scal n l y x) *)
induction n as [| n IH]; simpl; try Vfold n; Krm0.
(* Goal: @Logic.eq (Field.K (K1 p)) (let (k, l1) := l in let (x1, x2) := x in addK (K1 p) (prod_scal n l1 x2 (E0 (Grassmann.vn_eparams p n))) (multK (K1 p) k (prod_scal n l1 x1 (conj p n false (E0 (Grassmann.vn_eparams p n)))))) (v0 (K1 p)) *)
destruct l; destruct x; rewrite conj0, !IH; Krm0.
Qed.

Lemma prod_scal0l n l (x : vect n) : 0 [.l] x = 0%f.
Proof.
(* Goal: @Logic.eq (Field.K (K1 p)) (prod_scal n l x y) (prod_scal n l y x) *)
induction n as [| n IH]; simpl; try Vfold n; Krm0.
(* Goal: @Logic.eq (Field.K (K1 p)) (let (k, l1) := l in let (y1, y2) := x in addK (K1 p) (prod_scal n l1 (E0 (Grassmann.vn_eparams p n)) y2) (multK (K1 p) k (prod_scal n l1 (E0 (Grassmann.vn_eparams p n)) (conj p n false y1)))) (v0 (K1 p)) *)
destruct l; destruct x; rewrite !IH; Vrm0.
Qed.

Lemma prod_scal_scall n l k (x y : vect n) : 
  (k .* x) [.l] y = (k * (x [.l] y))%f.
Proof.
(* Goal: @Logic.eq (Field.K (K1 p)) (prod_scal n l x y) (prod_scal n l y x) *)
induction n as [| n IH]; simpl; try Vfold n; Krm0.
(* Goal: @Logic.eq (Field.K (K1 p)) (multK (Grassmann.K1 p) (multK (Grassmann.K1 p) k x) y) (multK (Grassmann.K1 p) k (multK (Grassmann.K1 p) x y)) *)
(* Goal: @Logic.eq (Field.K (K1 p)) (let (k0, l1) := l in let (x1, x2) := let (l2, l3) := x in @pair (Grassmann.vect p n) (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) k l2) (scalE (Grassmann.vn_eparams p n) k l3) in let (y1, y2) := y in addK (K1 p) (prod_scal n l1 x2 y2) (multK (K1 p) k0 (prod_scal n l1 x1 (conj p n false y1)))) (multK (Grassmann.K1 p) k (let (k, l1) := l in let (x1, x2) := x in let (y1, y2) := y in addK (K1 p) (prod_scal n l1 x2 y2) (multK (K1 p) k (prod_scal n l1 x1 (conj p n false y1))))) *)
intros; rewrite multK_assoc; auto.
(* Goal: @Logic.eq (Field.K (K1 p)) (let (k0, l1) := l in let (x1, x2) := x in let (y1, y2) := let (l2, l3) := y in @pair (Grassmann.vect p n) (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) k l2) (scalE (Grassmann.vn_eparams p n) k l3) in addK (K1 p) (prod_scal n l1 x2 y2) (multK (K1 p) k0 (prod_scal n l1 x1 (conj p n false y1)))) (multK (Grassmann.K1 p) k (let (k, l1) := l in let (x1, x2) := x in let (y1, y2) := y in addK (K1 p) (prod_scal n l1 x2 y2) (multK (K1 p) k (prod_scal n l1 x1 (conj p n false y1))))) *)
destruct l; destruct x; destruct y; simpl; auto; Vfold n.
(* Goal: @Logic.eq (Field.K (K1 p)) (addK (K1 p) (prod_scal n k1 (scalE (Grassmann.vn_eparams p n) k v0) v2) (multK (K1 p) k0 (prod_scal n k1 (scalE (Grassmann.vn_eparams p n) k v) (conj p n false v1)))) (multK (Grassmann.K1 p) k (addK (K1 p) (prod_scal n k1 v0 v2) (multK (K1 p) k0 (prod_scal n k1 v (conj p n false v1))))) *)
rewrite !IH, add_multKr, <-!multK_assoc; auto.
(* Goal: @Logic.eq (Field.K (K1 p)) (addK (K1 p) (prod_scal n k0 v2 v0) (multK (K1 p) k (prod_scal n k0 v (conj p n false v1)))) (addK (K1 p) (prod_scal n k0 v2 v0) (multK (K1 p) k (prod_scal n k0 v1 (conj p n false v)))) *)
apply f_equal2 with (f := addK _); auto.
(* Goal: @Logic.eq (Field.K (K1 p)) (multK (stype (Grassmann.vn_eparams p n)) (multK (stype (Grassmann.vn_eparams p n)) k0 k) (prod_scal n k1 v (conj p n false v1))) (multK (K1 p) (multK (K1 p) k k0) (prod_scal n k1 v (conj p n false v1))) *)
apply f_equal2 with (f := multK _); auto.
(* Goal: @Logic.eq (Field.K (K1 p)) (multK (stype (Grassmann.vn_eparams p n)) k0 k) (multK (K1 p) k k0) *)
rewrite multK_com; auto.
Qed.

Lemma prod_scal_scalr n l k (x y : vect n) : 
  x [.l] (k .* y) = (k * (x [.l] y))%f.
Proof.
(* Goal: @Logic.eq (Field.K (K1 p)) (prod_scal n l x y) (prod_scal n l y x) *)
induction n as [| n IH]; simpl; try Vfold n; Krm0.
(* Goal: @Logic.eq (Field.K (K1 p)) (multK (Grassmann.K1 p) x (multK (Grassmann.K1 p) k y)) (multK (Grassmann.K1 p) k (multK (Grassmann.K1 p) x y)) *)
(* Goal: @Logic.eq (Field.K (K1 p)) (let (k0, l1) := l in let (x1, x2) := x in let (y1, y2) := let (l2, l3) := y in @pair (Grassmann.vect p n) (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) k l2) (scalE (Grassmann.vn_eparams p n) k l3) in addK (K1 p) (prod_scal n l1 x2 y2) (multK (K1 p) k0 (prod_scal n l1 x1 (conj p n false y1)))) (multK (Grassmann.K1 p) k (let (k, l1) := l in let (x1, x2) := x in let (y1, y2) := y in addK (K1 p) (prod_scal n l1 x2 y2) (multK (K1 p) k (prod_scal n l1 x1 (conj p n false y1))))) *)
intros; rewrite multK_swap; auto.
(* Goal: @Logic.eq (Field.K (K1 p)) (let (k0, l1) := l in let (x1, x2) := x in let (y1, y2) := let (l2, l3) := y in @pair (Grassmann.vect p n) (Grassmann.vect p n) (scalE (Grassmann.vn_eparams p n) k l2) (scalE (Grassmann.vn_eparams p n) k l3) in addK (K1 p) (prod_scal n l1 x2 y2) (multK (K1 p) k0 (prod_scal n l1 x1 (conj p n false y1)))) (multK (Grassmann.K1 p) k (let (k, l1) := l in let (x1, x2) := x in let (y1, y2) := y in addK (K1 p) (prod_scal n l1 x2 y2) (multK (K1 p) k (prod_scal n l1 x1 (conj p n false y1))))) *)
destruct l; destruct x; destruct y; simpl; auto; Vfold n.
(* Goal: @Logic.eq (Field.K (K1 p)) (addK (K1 p) (prod_scal n k1 v0 (scalE (Grassmann.vn_eparams p n) k v2)) (multK (K1 p) k0 (prod_scal n k1 v (conj p n false (scalE (Grassmann.vn_eparams p n) k v1))))) (multK (Grassmann.K1 p) k (addK (K1 p) (prod_scal n k1 v0 v2) (multK (K1 p) k0 (prod_scal n k1 v (conj p n false v1))))) *)
rewrite conj_scal, !IH, add_multKr, <-!multK_assoc; auto.
(* Goal: @Logic.eq (Field.K (K1 p)) (addK (K1 p) (prod_scal n k0 v2 v0) (multK (K1 p) k (prod_scal n k0 v (conj p n false v1)))) (addK (K1 p) (prod_scal n k0 v2 v0) (multK (K1 p) k (prod_scal n k0 v1 (conj p n false v)))) *)
apply f_equal2 with (f := addK _); auto.
(* Goal: @Logic.eq (Field.K (K1 p)) (multK (stype (Grassmann.vn_eparams p n)) (multK (stype (Grassmann.vn_eparams p n)) k0 k) (prod_scal n k1 v (conj p n false v1))) (multK (K1 p) (multK (K1 p) k k0) (prod_scal n k1 v (conj p n false v1))) *)
apply f_equal2 with (f := multK _); auto.
(* Goal: @Logic.eq (Field.K (K1 p)) (multK (stype (Grassmann.vn_eparams p n)) k0 k) (multK (K1 p) k k0) *)
rewrite multK_com; auto.
Qed.

Lemma prod_scal_addl n l (x y z : vect n) : 
  (x + y) [.l] z = (x [.l] z + y [.l] z)%f.
Proof.
(* Goal: @Logic.eq (Field.K (K1 p)) (prod_scal n l x y) (prod_scal n l y x) *)
induction n as [| n IH]; simpl; try Vfold n; Krm0.
(* Goal: @Logic.eq (Field.K (K1 p)) (multK (Grassmann.K1 p) (addK (Grassmann.K1 p) x y) z) (addK (K1 p) (multK (Grassmann.K1 p) x z) (multK (Grassmann.K1 p) y z)) *)
(* Goal: @Logic.eq (Field.K (K1 p)) (let (k, l1) := l in let (x1, x2) := let (l3, l5) := x in let (l4, l6) := y in @pair (Grassmann.vect p n) (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) l3 l4) (addE (Grassmann.vn_eparams p n) l5 l6) in let (y1, y2) := z in addK (K1 p) (prod_scal n l1 x2 y2) (multK (K1 p) k (prod_scal n l1 x1 (conj p n false y1)))) (addK (K1 p) (let (k, l1) := l in let (x1, x2) := x in let (y1, y2) := z in addK (K1 p) (prod_scal n l1 x2 y2) (multK (K1 p) k (prod_scal n l1 x1 (conj p n false y1)))) (let (k, l1) := l in let (x1, x2) := y in let (y1, y2) := z in addK (K1 p) (prod_scal n l1 x2 y2) (multK (K1 p) k (prod_scal n l1 x1 (conj p n false y1))))) *)
intros; rewrite add_multKl; auto.
(* Goal: @Logic.eq (Field.K (K1 p)) (let (k, l1) := l in let (x1, x2) := x in let (y1, y2) := let (l3, l5) := y in let (l4, l6) := z in @pair (Grassmann.vect p n) (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) l3 l4) (addE (Grassmann.vn_eparams p n) l5 l6) in addK (K1 p) (prod_scal n l1 x2 y2) (multK (K1 p) k (prod_scal n l1 x1 (conj p n false y1)))) (addK (K1 p) (let (k, l1) := l in let (x1, x2) := x in let (y1, y2) := y in addK (K1 p) (prod_scal n l1 x2 y2) (multK (K1 p) k (prod_scal n l1 x1 (conj p n false y1)))) (let (k, l1) := l in let (x1, x2) := x in let (y1, y2) := z in addK (K1 p) (prod_scal n l1 x2 y2) (multK (K1 p) k (prod_scal n l1 x1 (conj p n false y1))))) *)
destruct l; destruct x; destruct y; destruct z; simpl; Vfold n.
(* Goal: @Logic.eq (Field.K (K1 p)) (addK (K1 p) (prod_scal n k0 (addE (Grassmann.vn_eparams p n) v0 v2) v4) (multK (K1 p) k (prod_scal n k0 (addE (Grassmann.vn_eparams p n) v v1) (conj p n false v3)))) (addK (K1 p) (addK (K1 p) (prod_scal n k0 v0 v4) (multK (K1 p) k (prod_scal n k0 v (conj p n false v3)))) (addK (K1 p) (prod_scal n k0 v2 v4) (multK (K1 p) k (prod_scal n k0 v1 (conj p n false v3))))) *)
rewrite !IH, !addK_assoc; auto.
(* Goal: @Logic.eq (Field.K (K1 p)) (addK (K1 p) (prod_scal n k0 v2 v0) (multK (K1 p) k (prod_scal n k0 v (conj p n false v1)))) (addK (K1 p) (prod_scal n k0 v2 v0) (multK (K1 p) k (prod_scal n k0 v1 (conj p n false v)))) *)
apply f_equal2 with (f := addK _); auto.
(* Goal: @Logic.eq (Field.K (K1 p)) (addK (K1 p) (prod_scal n k0 v0 v4) (multK (K1 p) k (addK (K1 p) (prod_scal n k0 v (conj p n false v1)) (prod_scal n k0 v (conj p n false v3))))) (addK (K1 p) (multK (K1 p) k (prod_scal n k0 v (conj p n false v1))) (addK (K1 p) (prod_scal n k0 v0 v4) (multK (K1 p) k (prod_scal n k0 v (conj p n false v3))))) *)
rewrite addK_com, add_multKr, !addK_assoc; auto.
(* Goal: @Logic.eq (Field.K (K1 p)) (addK (K1 p) (prod_scal n k0 v2 v0) (multK (K1 p) k (prod_scal n k0 v (conj p n false v1)))) (addK (K1 p) (prod_scal n k0 v2 v0) (multK (K1 p) k (prod_scal n k0 v1 (conj p n false v)))) *)
apply f_equal2 with (f := addK _); auto.
(* Goal: @Logic.eq (Field.K (K1 p)) (addK (K1 p) (multK (K1 p) k (prod_scal n k0 v (conj p n false v3))) (prod_scal n k0 v0 v4)) (addK (K1 p) (prod_scal n k0 v0 v4) (multK (K1 p) k (prod_scal n k0 v (conj p n false v3)))) *)
rewrite addK_com; auto.
Qed.

Lemma prod_scal_addr n l (x y z : vect n) : 
  x [.l] (y + z) =  (x [.l] y + x [.l] z)%f.
Proof.
(* Goal: @Logic.eq (Field.K (K1 p)) (prod_scal n l x y) (prod_scal n l y x) *)
induction n as [| n IH]; simpl; try Vfold n; Krm0.
(* Goal: @Logic.eq (Field.K (K1 p)) (multK (Grassmann.K1 p) x (addK (Grassmann.K1 p) y z)) (addK (K1 p) (multK (Grassmann.K1 p) x y) (multK (Grassmann.K1 p) x z)) *)
(* Goal: @Logic.eq (Field.K (K1 p)) (let (k, l1) := l in let (x1, x2) := x in let (y1, y2) := let (l3, l5) := y in let (l4, l6) := z in @pair (Grassmann.vect p n) (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) l3 l4) (addE (Grassmann.vn_eparams p n) l5 l6) in addK (K1 p) (prod_scal n l1 x2 y2) (multK (K1 p) k (prod_scal n l1 x1 (conj p n false y1)))) (addK (K1 p) (let (k, l1) := l in let (x1, x2) := x in let (y1, y2) := y in addK (K1 p) (prod_scal n l1 x2 y2) (multK (K1 p) k (prod_scal n l1 x1 (conj p n false y1)))) (let (k, l1) := l in let (x1, x2) := x in let (y1, y2) := z in addK (K1 p) (prod_scal n l1 x2 y2) (multK (K1 p) k (prod_scal n l1 x1 (conj p n false y1))))) *)
intros; rewrite add_multKr; auto.
(* Goal: @Logic.eq (Field.K (K1 p)) (let (k, l1) := l in let (x1, x2) := x in let (y1, y2) := let (l3, l5) := y in let (l4, l6) := z in @pair (Grassmann.vect p n) (Grassmann.vect p n) (addE (Grassmann.vn_eparams p n) l3 l4) (addE (Grassmann.vn_eparams p n) l5 l6) in addK (K1 p) (prod_scal n l1 x2 y2) (multK (K1 p) k (prod_scal n l1 x1 (conj p n false y1)))) (addK (K1 p) (let (k, l1) := l in let (x1, x2) := x in let (y1, y2) := y in addK (K1 p) (prod_scal n l1 x2 y2) (multK (K1 p) k (prod_scal n l1 x1 (conj p n false y1)))) (let (k, l1) := l in let (x1, x2) := x in let (y1, y2) := z in addK (K1 p) (prod_scal n l1 x2 y2) (multK (K1 p) k (prod_scal n l1 x1 (conj p n false y1))))) *)
destruct l; destruct x; destruct y; destruct z; simpl; Vfold n.
(* Goal: @Logic.eq (Field.K (K1 p)) (addK (K1 p) (prod_scal n k0 v0 (addE (Grassmann.vn_eparams p n) v2 v4)) (multK (K1 p) k (prod_scal n k0 v (conj p n false (addE (Grassmann.vn_eparams p n) v1 v3))))) (addK (K1 p) (addK (K1 p) (prod_scal n k0 v0 v2) (multK (K1 p) k (prod_scal n k0 v (conj p n false v1)))) (addK (K1 p) (prod_scal n k0 v0 v4) (multK (K1 p) k (prod_scal n k0 v (conj p n false v3))))) *)
rewrite conj_add, !IH, !addK_assoc; auto.
(* Goal: @Logic.eq (Field.K (K1 p)) (addK (K1 p) (prod_scal n k0 v2 v0) (multK (K1 p) k (prod_scal n k0 v (conj p n false v1)))) (addK (K1 p) (prod_scal n k0 v2 v0) (multK (K1 p) k (prod_scal n k0 v1 (conj p n false v)))) *)
apply f_equal2 with (f := addK _); auto.
(* Goal: @Logic.eq (Field.K (K1 p)) (addK (K1 p) (prod_scal n k0 v0 v4) (multK (K1 p) k (addK (K1 p) (prod_scal n k0 v (conj p n false v1)) (prod_scal n k0 v (conj p n false v3))))) (addK (K1 p) (multK (K1 p) k (prod_scal n k0 v (conj p n false v1))) (addK (K1 p) (prod_scal n k0 v0 v4) (multK (K1 p) k (prod_scal n k0 v (conj p n false v3))))) *)
rewrite addK_com, add_multKr, !addK_assoc; auto.
(* Goal: @Logic.eq (Field.K (K1 p)) (addK (K1 p) (prod_scal n k0 v2 v0) (multK (K1 p) k (prod_scal n k0 v (conj p n false v1)))) (addK (K1 p) (prod_scal n k0 v2 v0) (multK (K1 p) k (prod_scal n k0 v1 (conj p n false v)))) *)
apply f_equal2 with (f := addK _); auto.
(* Goal: @Logic.eq (Field.K (K1 p)) (addK (K1 p) (multK (K1 p) k (prod_scal n k0 v (conj p n false v3))) (prod_scal n k0 v0 v4)) (addK (K1 p) (prod_scal n k0 v0 v4) (multK (K1 p) k (prod_scal n k0 v (conj p n false v3)))) *)
rewrite addK_com; auto.
Qed.

Lemma conjf_prod_scal n l (x y: vect n) :
   (x^_'f) [.l] y = x [.l] (y^_'f).
Proof.
(* Goal: @Logic.eq (Field.K (K1 p)) (prod_scal n l x y) (prod_scal n l y x) *)
induction n as [| n IH]; simpl; try Vfold n; Krm0.
(* Goal: @Logic.eq (Field.K (K1 p)) (let (k, l1) := l in let (x1, x2) := x in let (y1, y2) := y in addK (K1 p) (prod_scal n l1 x2 y2) (multK (K1 p) k (prod_scal n l1 x1 (conj p n false y1)))) (let (k, l1) := l in let (x1, x2) := y in let (y1, y2) := x in addK (K1 p) (prod_scal n l1 x2 y2) (multK (K1 p) k (prod_scal n l1 x1 (conj p n false y1)))) *)
destruct l; destruct x; destruct y; simpl; Vfold n.
(* Goal: @Logic.eq (Field.K (K1 p)) (addK (K1 p) (prod_scal n k0 (conj p n false v0) v2) (multK (K1 p) k (prod_scal n k0 (conj p n true v) (conj p n false v1)))) (addK (K1 p) (prod_scal n k0 v0 (conj p n false v2)) (multK (K1 p) k (prod_scal n k0 v (conj p n false (conj p n true v1))))) *)
rewrite !conjt, !conj_scal, !prod_scal_scall, !prod_scal_scalr, !IH; auto.
Qed.

Lemma prod_scal_sym n l (x y: vect n) :
   x [.l] y = y [.l] x.
Proof.
(* Goal: @Logic.eq (Field.K (K1 p)) (prod_scal n l x y) (prod_scal n l y x) *)
induction n as [| n IH]; simpl; try Vfold n; Krm0.
(* Goal: @Logic.eq (Field.K (K1 p)) (multK (stype (Grassmann.vn_eparams p n)) k0 k) (multK (K1 p) k k0) *)
intros; rewrite multK_com; auto.
(* Goal: @Logic.eq (Field.K (K1 p)) (let (k, l1) := l in let (x1, x2) := x in let (y1, y2) := y in addK (K1 p) (prod_scal n l1 x2 y2) (multK (K1 p) k (prod_scal n l1 x1 (conj p n false y1)))) (let (k, l1) := l in let (x1, x2) := y in let (y1, y2) := x in addK (K1 p) (prod_scal n l1 x2 y2) (multK (K1 p) k (prod_scal n l1 x1 (conj p n false y1)))) *)
destruct l; destruct x; destruct y; simpl; Vfold n.
(* Goal: @Logic.eq (Field.K (K1 p)) (multK (K1 p) k (prod_scal n k0 v (conj p n false v1))) (multK (K1 p) k (prod_scal n k0 v1 (conj p n false v))) *)
rewrite IH.
(* Goal: @Logic.eq (Field.K (K1 p)) (addK (K1 p) (prod_scal n k0 v2 v0) (multK (K1 p) k (prod_scal n k0 v (conj p n false v1)))) (addK (K1 p) (prod_scal n k0 v2 v0) (multK (K1 p) k (prod_scal n k0 v1 (conj p n false v)))) *)
apply f_equal2 with (f := addK _); auto.
(* Goal: @Logic.eq (Field.K (K1 p)) (multK (K1 p) k (prod_scal n k0 v (conj p n false v1))) (multK (K1 p) k (prod_scal n k0 v1 (conj p n false v))) *)
rewrite IH.
(* Goal: @Logic.eq (Field.K (K1 p)) (multK (K1 p) k (prod_scal n k0 (conj p n false v1) v)) (multK (K1 p) k (prod_scal n k0 v1 (conj p n false v))) *)
rewrite conjf_prod_scal; auto.
Qed.

End Vect.

