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

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 "'kn'" := (kn p).
Notation projk := (proj p).

Ltac Kfold n :=
     change (Kn.add p n) with (addE (Kn.vn_eparams p n));
     change (Kn.scal p n) with (scalE (Kn.vn_eparams p n));
     change (Kn.genk p n 0%f) with (E0 (Kn.vn_eparams p n)).

(* A vector is a full-binary tree of hight n *)
Fixpoint vect (n: nat): Set := 
  match n with O => K | S n1 => (vect n1 * vect n1)%type end.

(* Equality over two trees: Equality on leaves *)
Fixpoint eq (n : nat) : vect n -> vect n -> bool :=
  match n return (vect n -> vect n -> bool) with
  | 0%nat => fun a b => (a ?= b)%f
  | S n1 =>
      fun l1 l2 =>
      let (l3, l5) := l1 in
      let (l4, l6) := l2 in 
      if eq n1 l3 l4 then eq n1 l5 l6 else false
  end.

(* Adding two trees: adding its leaves *)
Fixpoint add (n : nat) : vect n -> vect n -> vect n :=
  match n return (vect n -> vect n -> vect n) with
  | 0%nat => fun a b => (a + b)%f
  | S n1 =>
      fun l1 l2 =>
      let (l3, l5) := l1 in
      let (l4, l6) := l2 in (add n1 l3 l4, add n1 l5 l6)
  end.

(* Generate the constant k for the dimension n *)
Fixpoint genk (n: nat) (k: K) {struct n}: (vect n) :=
   match n return vect n with 0%nat => k | n1.+1 => (genk n1 0%f, genk n1 k) end.
Notation " [ k ] " := (genk _ k%f) (at level 9): g_scope.
Arguments genk _ _%field_scope.

(* Multiplication by a scalar *)
Fixpoint scal (n : nat) (k: K) {struct n}: vect n -> vect n :=
  match n return (vect n -> vect n) with
  | 0%nat => fun a => (k * a)%f
  | S n1 =>
      fun l1 =>
      let (l2, l3) := l1 in (scal n1 k l2, scal n1 k l3)
  end.

Canonical Structure vn_eparams (n: nat) :=
  Build_eparams (vect n) K [0] (eq n) (add n) (scal n).

Definition fn n : vparamsProp (vn_eparams n).
(* Goal: vparamsProp (vn_eparams n) *)
apply Build_vparamsProp; auto.
(* Equality *)
(* Goal: forall (b : bool) (k : nat) (_ : b2Prop (hom n k x)), b2Prop (hom n k (dconj n b x)) *)
induction n as [| n IH]; simpl.
(* Goal: forall x y : Field.K (K1 p), if eqK (K1 p) x y then @Logic.eq (Field.K (K1 p)) x y else not (@Logic.eq (Field.K (K1 p)) x y) *)
(* Goal: forall x y : prod (vect n) (vect n), if let (l3, l5) := x in let (l4, l6) := y in if eq n l3 l4 then eq n l5 l6 else false then @Logic.eq (prod (vect n) (vect n)) x y else not (@Logic.eq (prod (vect n) (vect n)) x y) *)
(* Goal: forall x y z : E (vn_eparams n), @Logic.eq (E (vn_eparams n)) (addE (vn_eparams n) (addE (vn_eparams n) x y) z) (addE (vn_eparams n) x (addE (vn_eparams n) y z)) *)
(* Goal: forall x y : E (vn_eparams n), @Logic.eq (E (vn_eparams n)) (addE (vn_eparams n) x y) (addE (vn_eparams n) y x) *)
(* Goal: forall x : E (vn_eparams n), @Logic.eq (E (vn_eparams n)) (addE (vn_eparams n) (E0 (vn_eparams n)) x) x *)
(* Goal: forall x : E (vn_eparams n), @Logic.eq (E (vn_eparams n)) (scalE (vn_eparams n) (v0 (stype (vn_eparams n))) x) (E0 (vn_eparams n)) *)
(* Goal: forall x : E (vn_eparams n), @Logic.eq (E (vn_eparams n)) (scalE (vn_eparams n) (v1 (stype (vn_eparams n))) x) x *)
(* Goal: forall (k1 k2 : Field.K (stype (vn_eparams n))) (x : E (vn_eparams n)), @Logic.eq (E (vn_eparams n)) (scalE (vn_eparams n) (addK (stype (vn_eparams n)) k1 k2) x) (addE (vn_eparams n) (scalE (vn_eparams n) k1 x) (scalE (vn_eparams n) k2 x)) *)
(* Goal: forall (k : Field.K (stype (vn_eparams n))) (x y : E (vn_eparams n)), @Logic.eq (E (vn_eparams n)) (scalE (vn_eparams n) k (addE (vn_eparams n) x y)) (addE (vn_eparams n) (scalE (vn_eparams n) k x) (scalE (vn_eparams n) k y)) *)
(* Goal: forall (k1 k2 : Field.K (stype (vn_eparams n))) (x : E (vn_eparams n)), @Logic.eq (E (vn_eparams n)) (scalE (vn_eparams n) (multK (stype (vn_eparams n)) k1 k2) x) (scalE (vn_eparams n) k1 (scalE (vn_eparams n) k2 x)) *)
  intros x y; apply eqK_dec; auto.
(* Goal: forall x y : prod (vect n) (vect n), if let (l3, l5) := x in let (l4, l6) := y in if eq n l3 l4 then eq n l5 l6 else false then @Logic.eq (prod (vect n) (vect n)) x y else not (@Logic.eq (prod (vect n) (vect n)) x y) *)
(* Goal: forall x y z : E (vn_eparams n), @Logic.eq (E (vn_eparams n)) (addE (vn_eparams n) (addE (vn_eparams n) x y) z) (addE (vn_eparams n) x (addE (vn_eparams n) y z)) *)
(* Goal: forall x y : E (vn_eparams n), @Logic.eq (E (vn_eparams n)) (addE (vn_eparams n) x y) (addE (vn_eparams n) y x) *)
(* Goal: forall x : E (vn_eparams n), @Logic.eq (E (vn_eparams n)) (addE (vn_eparams n) (E0 (vn_eparams n)) x) x *)
(* Goal: forall x : E (vn_eparams n), @Logic.eq (E (vn_eparams n)) (scalE (vn_eparams n) (v0 (stype (vn_eparams n))) x) (E0 (vn_eparams n)) *)
(* Goal: forall x : E (vn_eparams n), @Logic.eq (E (vn_eparams n)) (scalE (vn_eparams n) (v1 (stype (vn_eparams n))) x) x *)
(* Goal: forall (k1 k2 : Field.K (stype (vn_eparams n))) (x : E (vn_eparams n)), @Logic.eq (E (vn_eparams n)) (scalE (vn_eparams n) (addK (stype (vn_eparams n)) k1 k2) x) (addE (vn_eparams n) (scalE (vn_eparams n) k1 x) (scalE (vn_eparams n) k2 x)) *)
(* Goal: forall (k : Field.K (stype (vn_eparams n))) (x y : E (vn_eparams n)), @Logic.eq (E (vn_eparams n)) (scalE (vn_eparams n) k (addE (vn_eparams n) x y)) (addE (vn_eparams n) (scalE (vn_eparams n) k x) (scalE (vn_eparams n) k y)) *)
(* Goal: forall (k1 k2 : Field.K (stype (vn_eparams n))) (x : E (vn_eparams n)), @Logic.eq (E (vn_eparams n)) (scalE (vn_eparams n) (multK (stype (vn_eparams n)) k1 k2) x) (scalE (vn_eparams n) k1 (scalE (vn_eparams n) k2 x)) *)
intros (l3,l5) (l4, l6); simpl in IH; generalize (IH l3 l4); case eq.
(* Goal: forall _ : @Logic.eq (vect n) l3 l4, if eq n l5 l6 then @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) l3 l5) (@pair (vect n) (vect n) l4 l6) else not (@Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) l3 l5) (@pair (vect n) (vect n) l4 l6)) *)
(* Goal: forall _ : not (@Logic.eq (vect n) l3 l4), not (@Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) l3 l5) (@pair (vect n) (vect n) l4 l6)) *)
(* Goal: forall x y z : E (vn_eparams n), @Logic.eq (E (vn_eparams n)) (addE (vn_eparams n) (addE (vn_eparams n) x y) z) (addE (vn_eparams n) x (addE (vn_eparams n) y z)) *)
(* Goal: forall x y : E (vn_eparams n), @Logic.eq (E (vn_eparams n)) (addE (vn_eparams n) x y) (addE (vn_eparams n) y x) *)
(* Goal: forall x : E (vn_eparams n), @Logic.eq (E (vn_eparams n)) (addE (vn_eparams n) (E0 (vn_eparams n)) x) x *)
(* Goal: forall x : E (vn_eparams n), @Logic.eq (E (vn_eparams n)) (scalE (vn_eparams n) (v0 (stype (vn_eparams n))) x) (E0 (vn_eparams n)) *)
(* Goal: forall x : E (vn_eparams n), @Logic.eq (E (vn_eparams n)) (scalE (vn_eparams n) (v1 (stype (vn_eparams n))) x) x *)
(* Goal: forall (k1 k2 : Field.K (stype (vn_eparams n))) (x : E (vn_eparams n)), @Logic.eq (E (vn_eparams n)) (scalE (vn_eparams n) (addK (stype (vn_eparams n)) k1 k2) x) (addE (vn_eparams n) (scalE (vn_eparams n) k1 x) (scalE (vn_eparams n) k2 x)) *)
(* Goal: forall (k : Field.K (stype (vn_eparams n))) (x y : E (vn_eparams n)), @Logic.eq (E (vn_eparams n)) (scalE (vn_eparams n) k (addE (vn_eparams n) x y)) (addE (vn_eparams n) (scalE (vn_eparams n) k x) (scalE (vn_eparams n) k y)) *)
(* Goal: forall (k1 k2 : Field.K (stype (vn_eparams n))) (x : E (vn_eparams n)), @Logic.eq (E (vn_eparams n)) (scalE (vn_eparams n) (multK (stype (vn_eparams n)) k1 k2) x) (scalE (vn_eparams n) k1 (scalE (vn_eparams n) k2 x)) *)
  generalize (IH l5 l6); case eq; intros HH1 HH2; subst; auto.
(* Goal: not (@Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (E0 (vn_eparams n)) l2) (@pair (vect n) (vect n) (genk n (v0 (K1 p))) (genk n (v0 (K1 p))))) *)
(* Goal: forall _ : not (@Logic.eq (vect n) l1 (E0 (vn_eparams n))), not (@Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) l1 l2) (@pair (vect n) (vect n) (genk n (v0 (K1 p))) (genk n (v0 (K1 p))))) *)
  intros HH3; case HH1; injection HH3; auto.
(* Goal: forall (_ : not (@Logic.eq (vect n) (one_factor n k2 v) (E0 (vn_eparams n)))) (_ : @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (genk n (Field.v0 (K1 p))) (one_factor n k2 v)) (@pair (vect n) (vect n) (genk n (Field.v0 (K1 p))) (genk n (Field.v0 (K1 p))))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) v v0) (@pair (vect n) (vect n) (genk n (Field.v0 (K1 p))) (genk n (Field.v0 (K1 p)))) *)
intros HH1 HH2; case HH1; injection HH2; auto.
(* Addition is associative *)
(* Goal: forall (b : bool) (k : nat) (_ : b2Prop (hom n k x)), b2Prop (hom n k (dconj n b x)) *)
induction n as [| n IH]; simpl.
(* Goal: forall x y z : Field.K (K1 p), @Logic.eq (Field.K (K1 p)) (addK (K1 p) (addK (K1 p) x y) z) (addK (K1 p) x (addK (K1 p) y z)) *)
(* Goal: forall x y z : prod (vect n) (vect n), @Logic.eq (prod (vect n) (vect n)) (let (l3, l5) := let (l3, l5) := x in let (l4, l6) := y in @pair (vect n) (vect n) (add n l3 l4) (add n l5 l6) in let (l4, l6) := z in @pair (vect n) (vect n) (add n l3 l4) (add n l5 l6)) (let (l3, l5) := x in let (l4, l6) := let (l4, l6) := y in let (l7, l8) := z in @pair (vect n) (vect n) (add n l4 l7) (add n l6 l8) in @pair (vect n) (vect n) (add n l3 l4) (add n l5 l6)) *)
(* Goal: forall x y : E (vn_eparams n), @Logic.eq (E (vn_eparams n)) (addE (vn_eparams n) x y) (addE (vn_eparams n) y x) *)
(* Goal: forall x : E (vn_eparams n), @Logic.eq (E (vn_eparams n)) (addE (vn_eparams n) (E0 (vn_eparams n)) x) x *)
(* Goal: forall x : E (vn_eparams n), @Logic.eq (E (vn_eparams n)) (scalE (vn_eparams n) (v0 (stype (vn_eparams n))) x) (E0 (vn_eparams n)) *)
(* Goal: forall x : E (vn_eparams n), @Logic.eq (E (vn_eparams n)) (scalE (vn_eparams n) (v1 (stype (vn_eparams n))) x) x *)
(* Goal: forall (k1 k2 : Field.K (stype (vn_eparams n))) (x : E (vn_eparams n)), @Logic.eq (E (vn_eparams n)) (scalE (vn_eparams n) (addK (stype (vn_eparams n)) k1 k2) x) (addE (vn_eparams n) (scalE (vn_eparams n) k1 x) (scalE (vn_eparams n) k2 x)) *)
(* Goal: forall (k : Field.K (stype (vn_eparams n))) (x y : E (vn_eparams n)), @Logic.eq (E (vn_eparams n)) (scalE (vn_eparams n) k (addE (vn_eparams n) x y)) (addE (vn_eparams n) (scalE (vn_eparams n) k x) (scalE (vn_eparams n) k y)) *)
(* Goal: forall (k1 k2 : Field.K (stype (vn_eparams n))) (x : E (vn_eparams n)), @Logic.eq (E (vn_eparams n)) (scalE (vn_eparams n) (multK (stype (vn_eparams n)) k1 k2) x) (scalE (vn_eparams n) k1 (scalE (vn_eparams n) k2 x)) *)
  intros x y z; rewrite (addK_assoc _ Hp); auto.
(* Goal: forall x y z : prod (vect n) (vect n), @Logic.eq (prod (vect n) (vect n)) (let (l3, l5) := let (l3, l5) := x in let (l4, l6) := y in @pair (vect n) (vect n) (add n l3 l4) (add n l5 l6) in let (l4, l6) := z in @pair (vect n) (vect n) (add n l3 l4) (add n l5 l6)) (let (l3, l5) := x in let (l4, l6) := let (l4, l6) := y in let (l7, l8) := z in @pair (vect n) (vect n) (add n l4 l7) (add n l6 l8) in @pair (vect n) (vect n) (add n l3 l4) (add n l5 l6)) *)
(* Goal: forall x y : E (vn_eparams n), @Logic.eq (E (vn_eparams n)) (addE (vn_eparams n) x y) (addE (vn_eparams n) y x) *)
(* Goal: forall x : E (vn_eparams n), @Logic.eq (E (vn_eparams n)) (addE (vn_eparams n) (E0 (vn_eparams n)) x) x *)
(* Goal: forall x : E (vn_eparams n), @Logic.eq (E (vn_eparams n)) (scalE (vn_eparams n) (v0 (stype (vn_eparams n))) x) (E0 (vn_eparams n)) *)
(* Goal: forall x : E (vn_eparams n), @Logic.eq (E (vn_eparams n)) (scalE (vn_eparams n) (v1 (stype (vn_eparams n))) x) x *)
(* Goal: forall (k1 k2 : Field.K (stype (vn_eparams n))) (x : E (vn_eparams n)), @Logic.eq (E (vn_eparams n)) (scalE (vn_eparams n) (addK (stype (vn_eparams n)) k1 k2) x) (addE (vn_eparams n) (scalE (vn_eparams n) k1 x) (scalE (vn_eparams n) k2 x)) *)
(* Goal: forall (k : Field.K (stype (vn_eparams n))) (x y : E (vn_eparams n)), @Logic.eq (E (vn_eparams n)) (scalE (vn_eparams n) k (addE (vn_eparams n) x y)) (addE (vn_eparams n) (scalE (vn_eparams n) k x) (scalE (vn_eparams n) k y)) *)
(* Goal: forall (k1 k2 : Field.K (stype (vn_eparams n))) (x : E (vn_eparams n)), @Logic.eq (E (vn_eparams n)) (scalE (vn_eparams n) (multK (stype (vn_eparams n)) k1 k2) x) (scalE (vn_eparams n) k1 (scalE (vn_eparams n) k2 x)) *)
intros (l3,l5) (l4, l6) (l7, l8); simpl in IH; rewrite !IH; auto.
(* Addition is commutative *)
(* Goal: forall (b : bool) (k : nat) (_ : b2Prop (hom n k x)), b2Prop (hom n k (dconj n b x)) *)
induction n as [| n IH]; simpl.
(* Goal: forall x y : Field.K (K1 p), @Logic.eq (Field.K (K1 p)) (addK (K1 p) x y) (addK (K1 p) y x) *)
(* Goal: forall x y : prod (vect n) (vect n), @Logic.eq (prod (vect n) (vect n)) (let (l3, l5) := x in let (l4, l6) := y in @pair (vect n) (vect n) (add n l3 l4) (add n l5 l6)) (let (l3, l5) := y in let (l4, l6) := x in @pair (vect n) (vect n) (add n l3 l4) (add n l5 l6)) *)
(* Goal: forall x : E (vn_eparams n), @Logic.eq (E (vn_eparams n)) (addE (vn_eparams n) (E0 (vn_eparams n)) x) x *)
(* Goal: forall x : E (vn_eparams n), @Logic.eq (E (vn_eparams n)) (scalE (vn_eparams n) (v0 (stype (vn_eparams n))) x) (E0 (vn_eparams n)) *)
(* Goal: forall x : E (vn_eparams n), @Logic.eq (E (vn_eparams n)) (scalE (vn_eparams n) (v1 (stype (vn_eparams n))) x) x *)
(* Goal: forall (k1 k2 : Field.K (stype (vn_eparams n))) (x : E (vn_eparams n)), @Logic.eq (E (vn_eparams n)) (scalE (vn_eparams n) (addK (stype (vn_eparams n)) k1 k2) x) (addE (vn_eparams n) (scalE (vn_eparams n) k1 x) (scalE (vn_eparams n) k2 x)) *)
(* Goal: forall (k : Field.K (stype (vn_eparams n))) (x y : E (vn_eparams n)), @Logic.eq (E (vn_eparams n)) (scalE (vn_eparams n) k (addE (vn_eparams n) x y)) (addE (vn_eparams n) (scalE (vn_eparams n) k x) (scalE (vn_eparams n) k y)) *)
(* Goal: forall (k1 k2 : Field.K (stype (vn_eparams n))) (x : E (vn_eparams n)), @Logic.eq (E (vn_eparams n)) (scalE (vn_eparams n) (multK (stype (vn_eparams n)) k1 k2) x) (scalE (vn_eparams n) k1 (scalE (vn_eparams n) k2 x)) *)
  intros x y; rewrite (addK_com _ Hp); auto.
(* Goal: forall x y : prod (vect n) (vect n), @Logic.eq (prod (vect n) (vect n)) (let (l3, l5) := x in let (l4, l6) := y in @pair (vect n) (vect n) (add n l3 l4) (add n l5 l6)) (let (l3, l5) := y in let (l4, l6) := x in @pair (vect n) (vect n) (add n l3 l4) (add n l5 l6)) *)
(* Goal: forall x : E (vn_eparams n), @Logic.eq (E (vn_eparams n)) (addE (vn_eparams n) (E0 (vn_eparams n)) x) x *)
(* Goal: forall x : E (vn_eparams n), @Logic.eq (E (vn_eparams n)) (scalE (vn_eparams n) (v0 (stype (vn_eparams n))) x) (E0 (vn_eparams n)) *)
(* Goal: forall x : E (vn_eparams n), @Logic.eq (E (vn_eparams n)) (scalE (vn_eparams n) (v1 (stype (vn_eparams n))) x) x *)
(* Goal: forall (k1 k2 : Field.K (stype (vn_eparams n))) (x : E (vn_eparams n)), @Logic.eq (E (vn_eparams n)) (scalE (vn_eparams n) (addK (stype (vn_eparams n)) k1 k2) x) (addE (vn_eparams n) (scalE (vn_eparams n) k1 x) (scalE (vn_eparams n) k2 x)) *)
(* Goal: forall (k : Field.K (stype (vn_eparams n))) (x y : E (vn_eparams n)), @Logic.eq (E (vn_eparams n)) (scalE (vn_eparams n) k (addE (vn_eparams n) x y)) (addE (vn_eparams n) (scalE (vn_eparams n) k x) (scalE (vn_eparams n) k y)) *)
(* Goal: forall (k1 k2 : Field.K (stype (vn_eparams n))) (x : E (vn_eparams n)), @Logic.eq (E (vn_eparams n)) (scalE (vn_eparams n) (multK (stype (vn_eparams n)) k1 k2) x) (scalE (vn_eparams n) k1 (scalE (vn_eparams n) k2 x)) *)
intros (l3,l5) (l4, l6); simpl in IH; rewrite (IH l3), (IH l5); auto.
(* 0 is  a left neutral element for + *)
(* Goal: forall (b : bool) (k : nat) (_ : b2Prop (hom n k x)), b2Prop (hom n k (dconj n b x)) *)
induction n as [| n IH]; simpl.
(* Goal: forall x : Field.K (K1 p), @Logic.eq (Field.K (K1 p)) (addK (K1 p) (v0 (K1 p)) x) x *)
(* Goal: forall x : prod (vect n) (vect n), @Logic.eq (prod (vect n) (vect n)) (let (l4, l6) := x in @pair (vect n) (vect n) (add n (genk n (v0 (K1 p))) l4) (add n (genk n (v0 (K1 p))) l6)) x *)
(* Goal: forall x : E (vn_eparams n), @Logic.eq (E (vn_eparams n)) (scalE (vn_eparams n) (v0 (stype (vn_eparams n))) x) (E0 (vn_eparams n)) *)
(* Goal: forall x : E (vn_eparams n), @Logic.eq (E (vn_eparams n)) (scalE (vn_eparams n) (v1 (stype (vn_eparams n))) x) x *)
(* Goal: forall (k1 k2 : Field.K (stype (vn_eparams n))) (x : E (vn_eparams n)), @Logic.eq (E (vn_eparams n)) (scalE (vn_eparams n) (addK (stype (vn_eparams n)) k1 k2) x) (addE (vn_eparams n) (scalE (vn_eparams n) k1 x) (scalE (vn_eparams n) k2 x)) *)
(* Goal: forall (k : Field.K (stype (vn_eparams n))) (x y : E (vn_eparams n)), @Logic.eq (E (vn_eparams n)) (scalE (vn_eparams n) k (addE (vn_eparams n) x y)) (addE (vn_eparams n) (scalE (vn_eparams n) k x) (scalE (vn_eparams n) k y)) *)
(* Goal: forall (k1 k2 : Field.K (stype (vn_eparams n))) (x : E (vn_eparams n)), @Logic.eq (E (vn_eparams n)) (scalE (vn_eparams n) (multK (stype (vn_eparams n)) k1 k2) x) (scalE (vn_eparams n) k1 (scalE (vn_eparams n) k2 x)) *)
  intros x; rewrite (addK0l _ Hp); auto.
(* Goal: forall x : prod (vect n) (vect n), @Logic.eq (prod (vect n) (vect n)) (let (l2, l3) := x in @pair (vect n) (vect n) (scal n (v1 (K1 p)) l2) (scal n (v1 (K1 p)) l3)) x *)
(* Goal: forall (k1 k2 : Field.K (stype (vn_eparams n))) (x : E (vn_eparams n)), @Logic.eq (E (vn_eparams n)) (scalE (vn_eparams n) (addK (stype (vn_eparams n)) k1 k2) x) (addE (vn_eparams n) (scalE (vn_eparams n) k1 x) (scalE (vn_eparams n) k2 x)) *)
(* Goal: forall (k : Field.K (stype (vn_eparams n))) (x y : E (vn_eparams n)), @Logic.eq (E (vn_eparams n)) (scalE (vn_eparams n) k (addE (vn_eparams n) x y)) (addE (vn_eparams n) (scalE (vn_eparams n) k x) (scalE (vn_eparams n) k y)) *)
(* Goal: forall (k1 k2 : Field.K (stype (vn_eparams n))) (x : E (vn_eparams n)), @Logic.eq (E (vn_eparams n)) (scalE (vn_eparams n) (multK (stype (vn_eparams n)) k1 k2) x) (scalE (vn_eparams n) k1 (scalE (vn_eparams n) k2 x)) *)
intros (l1,l2); simpl in IH; rewrite IH, IH; auto.
(* Multiplication by 0 *)
(* Goal: forall (b : bool) (k : nat) (_ : b2Prop (hom n k x)), b2Prop (hom n k (dconj n b x)) *)
induction n as [| n IH]; simpl.
(* Goal: forall x : Field.K (K1 p), @Logic.eq (Field.K (K1 p)) (multK (K1 p) (v0 (K1 p)) x) (v0 (K1 p)) *)
(* Goal: forall x : prod (vect n) (vect n), @Logic.eq (prod (vect n) (vect n)) (let (l2, l3) := x in @pair (vect n) (vect n) (scal n (v0 (K1 p)) l2) (scal n (v0 (K1 p)) l3)) (@pair (vect n) (vect n) (genk n (v0 (K1 p))) (genk n (v0 (K1 p)))) *)
(* Goal: forall x : E (vn_eparams n), @Logic.eq (E (vn_eparams n)) (scalE (vn_eparams n) (v1 (stype (vn_eparams n))) x) x *)
(* Goal: forall (k1 k2 : Field.K (stype (vn_eparams n))) (x : E (vn_eparams n)), @Logic.eq (E (vn_eparams n)) (scalE (vn_eparams n) (addK (stype (vn_eparams n)) k1 k2) x) (addE (vn_eparams n) (scalE (vn_eparams n) k1 x) (scalE (vn_eparams n) k2 x)) *)
(* Goal: forall (k : Field.K (stype (vn_eparams n))) (x y : E (vn_eparams n)), @Logic.eq (E (vn_eparams n)) (scalE (vn_eparams n) k (addE (vn_eparams n) x y)) (addE (vn_eparams n) (scalE (vn_eparams n) k x) (scalE (vn_eparams n) k y)) *)
(* Goal: forall (k1 k2 : Field.K (stype (vn_eparams n))) (x : E (vn_eparams n)), @Logic.eq (E (vn_eparams n)) (scalE (vn_eparams n) (multK (stype (vn_eparams n)) k1 k2) x) (scalE (vn_eparams n) k1 (scalE (vn_eparams n) k2 x)) *)
  intros x; rewrite (multK0l _ Hp); auto.
(* Goal: forall x : prod (vect n) (vect n), @Logic.eq (prod (vect n) (vect n)) (let (l2, l3) := x in @pair (vect n) (vect n) (scal n (v1 (K1 p)) l2) (scal n (v1 (K1 p)) l3)) x *)
(* Goal: forall (k1 k2 : Field.K (stype (vn_eparams n))) (x : E (vn_eparams n)), @Logic.eq (E (vn_eparams n)) (scalE (vn_eparams n) (addK (stype (vn_eparams n)) k1 k2) x) (addE (vn_eparams n) (scalE (vn_eparams n) k1 x) (scalE (vn_eparams n) k2 x)) *)
(* Goal: forall (k : Field.K (stype (vn_eparams n))) (x y : E (vn_eparams n)), @Logic.eq (E (vn_eparams n)) (scalE (vn_eparams n) k (addE (vn_eparams n) x y)) (addE (vn_eparams n) (scalE (vn_eparams n) k x) (scalE (vn_eparams n) k y)) *)
(* Goal: forall (k1 k2 : Field.K (stype (vn_eparams n))) (x : E (vn_eparams n)), @Logic.eq (E (vn_eparams n)) (scalE (vn_eparams n) (multK (stype (vn_eparams n)) k1 k2) x) (scalE (vn_eparams n) k1 (scalE (vn_eparams n) k2 x)) *)
intros (l1, l2); simpl in IH; rewrite IH, IH; auto.
(* Multiplication by 1 *)
(* Goal: forall (b : bool) (k : nat) (_ : b2Prop (hom n k x)), b2Prop (hom n k (dconj n b x)) *)
induction n as [| n IH]; simpl.
(* Goal: forall x : Field.K (K1 p), @Logic.eq (Field.K (K1 p)) (multK (K1 p) (v1 (K1 p)) x) x *)
(* Goal: forall x : prod (vect n) (vect n), @Logic.eq (prod (vect n) (vect n)) (let (l2, l3) := x in @pair (vect n) (vect n) (scal n (v1 (K1 p)) l2) (scal n (v1 (K1 p)) l3)) x *)
(* Goal: forall (k1 k2 : Field.K (stype (vn_eparams n))) (x : E (vn_eparams n)), @Logic.eq (E (vn_eparams n)) (scalE (vn_eparams n) (addK (stype (vn_eparams n)) k1 k2) x) (addE (vn_eparams n) (scalE (vn_eparams n) k1 x) (scalE (vn_eparams n) k2 x)) *)
(* Goal: forall (k : Field.K (stype (vn_eparams n))) (x y : E (vn_eparams n)), @Logic.eq (E (vn_eparams n)) (scalE (vn_eparams n) k (addE (vn_eparams n) x y)) (addE (vn_eparams n) (scalE (vn_eparams n) k x) (scalE (vn_eparams n) k y)) *)
(* Goal: forall (k1 k2 : Field.K (stype (vn_eparams n))) (x : E (vn_eparams n)), @Logic.eq (E (vn_eparams n)) (scalE (vn_eparams n) (multK (stype (vn_eparams n)) k1 k2) x) (scalE (vn_eparams n) k1 (scalE (vn_eparams n) k2 x)) *)
  intros x; rewrite (multK1l _ Hp); auto.
(* Goal: forall x : prod (vect n) (vect n), @Logic.eq (prod (vect n) (vect n)) (let (l2, l3) := x in @pair (vect n) (vect n) (scal n (v1 (K1 p)) l2) (scal n (v1 (K1 p)) l3)) x *)
(* Goal: forall (k1 k2 : Field.K (stype (vn_eparams n))) (x : E (vn_eparams n)), @Logic.eq (E (vn_eparams n)) (scalE (vn_eparams n) (addK (stype (vn_eparams n)) k1 k2) x) (addE (vn_eparams n) (scalE (vn_eparams n) k1 x) (scalE (vn_eparams n) k2 x)) *)
(* Goal: forall (k : Field.K (stype (vn_eparams n))) (x y : E (vn_eparams n)), @Logic.eq (E (vn_eparams n)) (scalE (vn_eparams n) k (addE (vn_eparams n) x y)) (addE (vn_eparams n) (scalE (vn_eparams n) k x) (scalE (vn_eparams n) k y)) *)
(* Goal: forall (k1 k2 : Field.K (stype (vn_eparams n))) (x : E (vn_eparams n)), @Logic.eq (E (vn_eparams n)) (scalE (vn_eparams n) (multK (stype (vn_eparams n)) k1 k2) x) (scalE (vn_eparams n) k1 (scalE (vn_eparams n) k2 x)) *)
intros (l1, l2); simpl in IH; rewrite IH, IH; auto.
(* Left addition of the multiplication by a scalar *)
(* Goal: forall (b : bool) (k : nat) (_ : b2Prop (hom n k x)), b2Prop (hom n k (dconj n b x)) *)
induction n as [| n IH]; simpl.
(* Goal: forall k1 k2 x : Field.K (K1 p), @Logic.eq (Field.K (K1 p)) (multK (K1 p) (addK (K1 p) k1 k2) x) (addK (K1 p) (multK (K1 p) k1 x) (multK (K1 p) k2 x)) *)
(* Goal: forall (k1 k2 : Field.K (K1 p)) (x : prod (vect n) (vect n)), @Logic.eq (prod (vect n) (vect n)) (let (l2, l3) := x in @pair (vect n) (vect n) (scal n (addK (K1 p) k1 k2) l2) (scal n (addK (K1 p) k1 k2) l3)) (let (l3, l5) := let (l2, l3) := x in @pair (vect n) (vect n) (scal n k1 l2) (scal n k1 l3) in let (l4, l6) := let (l2, l4) := x in @pair (vect n) (vect n) (scal n k2 l2) (scal n k2 l4) in @pair (vect n) (vect n) (add n l3 l4) (add n l5 l6)) *)
(* Goal: forall (k : Field.K (stype (vn_eparams n))) (x y : E (vn_eparams n)), @Logic.eq (E (vn_eparams n)) (scalE (vn_eparams n) k (addE (vn_eparams n) x y)) (addE (vn_eparams n) (scalE (vn_eparams n) k x) (scalE (vn_eparams n) k y)) *)
(* Goal: forall (k1 k2 : Field.K (stype (vn_eparams n))) (x : E (vn_eparams n)), @Logic.eq (E (vn_eparams n)) (scalE (vn_eparams n) (multK (stype (vn_eparams n)) k1 k2) x) (scalE (vn_eparams n) k1 (scalE (vn_eparams n) k2 x)) *)
  intros k x y; rewrite (add_multKl _ Hp); auto.
(* Goal: forall (k1 k2 : Field.K (K1 p)) (x : prod (vect n) (vect n)), @Logic.eq (prod (vect n) (vect n)) (let (l2, l3) := x in @pair (vect n) (vect n) (scal n (multK (K1 p) k1 k2) l2) (scal n (multK (K1 p) k1 k2) l3)) (let (l2, l3) := let (l2, l3) := x in @pair (vect n) (vect n) (scal n k2 l2) (scal n k2 l3) in @pair (vect n) (vect n) (scal n k1 l2) (scal n k1 l3)) *)
intros k1 k2 (l1, l2); simpl in IH; rewrite IH, IH; auto.
(* Right addition of the multiplication by a scalar *)
(* Goal: forall (b : bool) (k : nat) (_ : b2Prop (hom n k x)), b2Prop (hom n k (dconj n b x)) *)
induction n as [| n IH]; simpl.
(* Goal: forall k x y : Field.K (K1 p), @Logic.eq (Field.K (K1 p)) (multK (K1 p) k (addK (K1 p) x y)) (addK (K1 p) (multK (K1 p) k x) (multK (K1 p) k y)) *)
(* Goal: forall (k : Field.K (K1 p)) (x y : prod (vect n) (vect n)), @Logic.eq (prod (vect n) (vect n)) (let (l2, l3) := let (l3, l5) := x in let (l4, l6) := y in @pair (vect n) (vect n) (add n l3 l4) (add n l5 l6) in @pair (vect n) (vect n) (scal n k l2) (scal n k l3)) (let (l3, l5) := let (l2, l3) := x in @pair (vect n) (vect n) (scal n k l2) (scal n k l3) in let (l4, l6) := let (l2, l4) := y in @pair (vect n) (vect n) (scal n k l2) (scal n k l4) in @pair (vect n) (vect n) (add n l3 l4) (add n l5 l6)) *)
(* Goal: forall (k1 k2 : Field.K (stype (vn_eparams n))) (x : E (vn_eparams n)), @Logic.eq (E (vn_eparams n)) (scalE (vn_eparams n) (multK (stype (vn_eparams n)) k1 k2) x) (scalE (vn_eparams n) k1 (scalE (vn_eparams n) k2 x)) *)
  intros k x y; rewrite (add_multKr _ Hp); auto.
(* Goal: forall (k : Field.K (K1 p)) (x y : prod (vect n) (vect n)), @Logic.eq (prod (vect n) (vect n)) (let (l2, l3) := let (l3, l5) := x in let (l4, l6) := y in @pair (vect n) (vect n) (add n l3 l4) (add n l5 l6) in @pair (vect n) (vect n) (scal n k l2) (scal n k l3)) (let (l3, l5) := let (l2, l3) := x in @pair (vect n) (vect n) (scal n k l2) (scal n k l3) in let (l4, l6) := let (l2, l4) := y in @pair (vect n) (vect n) (scal n k l2) (scal n k l4) in @pair (vect n) (vect n) (add n l3 l4) (add n l5 l6)) *)
(* Goal: forall (k1 k2 : Field.K (stype (vn_eparams n))) (x : E (vn_eparams n)), @Logic.eq (E (vn_eparams n)) (scalE (vn_eparams n) (multK (stype (vn_eparams n)) k1 k2) x) (scalE (vn_eparams n) k1 (scalE (vn_eparams n) k2 x)) *)
intros k (l1, l3) (l2, l4); simpl in IH; rewrite IH, IH; auto.
(* Composition of the multiplication by a scalar *)
(* Goal: forall (b : bool) (k : nat) (_ : b2Prop (hom n k x)), b2Prop (hom n k (dconj n b x)) *)
induction n as [| n IH]; simpl.
(* Goal: forall k1 k2 x : Field.K (K1 p), @Logic.eq (Field.K (K1 p)) (multK (K1 p) (multK (K1 p) k1 k2) x) (multK (K1 p) k1 (multK (K1 p) k2 x)) *)
(* Goal: forall (k1 k2 : Field.K (K1 p)) (x : prod (vect n) (vect n)), @Logic.eq (prod (vect n) (vect n)) (let (l2, l3) := x in @pair (vect n) (vect n) (scal n (multK (K1 p) k1 k2) l2) (scal n (multK (K1 p) k1 k2) l3)) (let (l2, l3) := let (l2, l3) := x in @pair (vect n) (vect n) (scal n k2 l2) (scal n k2 l3) in @pair (vect n) (vect n) (scal n k1 l2) (scal n k1 l3)) *)
  intros x y z; rewrite (multK_assoc _ Hp); auto.
(* Goal: forall (k1 k2 : Field.K (K1 p)) (x : prod (vect n) (vect n)), @Logic.eq (prod (vect n) (vect n)) (let (l2, l3) := x in @pair (vect n) (vect n) (scal n (multK (K1 p) k1 k2) l2) (scal n (multK (K1 p) k1 k2) l3)) (let (l2, l3) := let (l2, l3) := x in @pair (vect n) (vect n) (scal n k2 l2) (scal n k2 l3) in @pair (vect n) (vect n) (scal n k1 l2) (scal n k1 l3)) *)
intros k1 k2 (l1, l2); simpl in IH; rewrite IH, IH; auto.
Qed.

Hint Resolve fn.

Notation "1" := ([1]): g_scope.

Ltac Vfold n :=
     change (add n) with (addE (vn_eparams n));
     change (scal n) with (scalE (vn_eparams n));
     change (genk n 0) with (E0 (vn_eparams n)).

Hint Rewrite multK0l multK0r oppK0 addK0l addK0r 
             addE0r addE0l scalE0r scalE0l: GRm0.

Ltac Grm0 := autorewrite with GRm0; auto.

(* Subtraction  *)
Fixpoint sub (n : nat) : vect n -> vect n -> vect n :=
  match n return (vect n -> vect n -> vect n) with
  | 0%nat => fun a b => (a + (- b))%f
  | S n1 =>
      fun v1 v2 =>
      let (x1, y1) := v1 in
      let (x2, y2) := v2 in (sub n1 x1 x2, sub n1 y1 y2)
  end.

Notation "x - y" := (sub _ x y): g_scope.

Lemma sub_add n (v1 v2: vect n) : v1 - v2 = v1 + (-(1)).* v2.
Proof.
(* Goal: forall (k1 k2 : nat) (_ : b2Prop (hom n k1 x)) (_ : b2Prop (hom n (S O) y)) (_ : b2Prop (hom n k2 z)), @Logic.eq (vect n) (meet n (join n x y) z) (addE (vn_eparams n) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n (S (Nat.add k1 k2)))) (meet n x (join n y z))) (join n (meet n x z) y)) *)
induction n as [| n IH]; simpl; try Vfold n.
(* Goal: @Logic.eq (Field.K (K1 p)) (oppK (K1 p) k) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) k) *)
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (genk n (oppK (K1 p) k))) (@pair (vect n) (vect n) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (E0 (vn_eparams n))) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (genk n k))) *)
rewrite <-opp_multKl, multK1l; auto.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (let (x1, y1) := v1 in let (x2, y2) := v2 in @pair (vect n) (vect n) (sub n x1 x2) (sub n y1 y2)) (let (l3, l5) := v1 in let (l4, l6) := let (l2, l4) := v2 in @pair (vect n) (vect n) (scalE (vn_eparams n) (oppK (K1 p) (Field.v1 (K1 p))) l2) (scalE (vn_eparams n) (oppK (K1 p) (Field.v1 (K1 p))) l4) in @pair (vect n) (vect n) (addE (vn_eparams n) l3 l4) (addE (vn_eparams n) l5 l6)) *)
destruct v1; destruct v2; rewrite !IH; auto.
Qed.

Lemma sub0l n (v: vect n) : 0 - v = (-(1)) .* v.
Proof. rewrite sub_add; Grm0. Qed.

Hint Rewrite sub0l: GRm0.

Lemma sub0r n (v: vect n) : v - 0 = v.
Proof. rewrite sub_add; Grm0. Qed.

Hint Rewrite sub0r: GRm0.

(* Some properties of constants *)
Lemma injk n k1 k2 : [k1] = [k2] :> vect n -> k1 = k2.
Proof.
(* Goal: @Logic.eq (vect n) (k2g n (E0 (Kn.vn_eparams p n))) (E0 (vn_eparams n)) *)
induction n as [| n IH]; simpl; auto.
(* Goal: forall _ : @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (genk n (v0 (K1 p))) (genk n k1)) (@pair (vect n) (vect n) (genk n (v0 (K1 p))) (genk n k2)), @Logic.eq (Field.K (K1 p)) k1 k2 *)
intros HH; injection HH; auto.
Qed.

Lemma oppk n k : [-k] = (-(1)).* [k] :> vect n.
Proof.
(* Goal: forall (k1 k2 : nat) (_ : b2Prop (hom n k1 x)) (_ : b2Prop (hom n (S O) y)) (_ : b2Prop (hom n k2 z)), @Logic.eq (vect n) (meet n (join n x y) z) (addE (vn_eparams n) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n (S (Nat.add k1 k2)))) (meet n x (join n y z))) (join n (meet n x z) y)) *)
induction n as [| n IH]; simpl; try Vfold n.
(* Goal: @Logic.eq (Field.K (K1 p)) (oppK (K1 p) k) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) k) *)
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (genk n (oppK (K1 p) k))) (@pair (vect n) (vect n) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (E0 (vn_eparams n))) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (genk n k))) *)
rewrite <- opp_multKl, multK1l; auto.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (scalE (vn_eparams n) k1 (E0 (vn_eparams n))) (scalE (vn_eparams n) k1 (genk n k2))) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (genk n (multK (K1 p) k1 k2))) *)
rewrite scalE0r, IH; auto.
Qed.

Lemma genkE n k : [k] = k .* 1 :> vect n.
Proof.
(* Goal: @Logic.eq (vect n) (genk n k) (scalE (vn_eparams n) k (genk n (v1 (K1 p)))) *)
induction n as [| n IH]; simpl; Krm1; try Vfold n.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (genk n k)) (@pair (vect n) (vect n) (scalE (vn_eparams n) k (E0 (vn_eparams n))) (scalE (vn_eparams n) k (genk n (v1 (K1 p))))) *)
rewrite IH, scalE0r; auto.
Qed.

Lemma deck0 n (x: vect n):  x = 0 \/ x <> 0.
Proof.
(* Goal: @Logic.eq (vect n) (k2g n (E0 (Kn.vn_eparams p n))) (E0 (vn_eparams n)) *)
induction n as [| n IH]; simpl; auto.
(* Goal: or (@Logic.eq (Field.K (K1 p)) x (v0 (K1 p))) (not (@Logic.eq (Field.K (K1 p)) x (v0 (K1 p)))) *)
(* Goal: or (@Logic.eq (prod (vect n) (vect n)) x (@pair (vect n) (vect n) (genk n (v0 (K1 p))) (genk n (v0 (K1 p))))) (not (@Logic.eq (prod (vect n) (vect n)) x (@pair (vect n) (vect n) (genk n (v0 (K1 p))) (genk n (v0 (K1 p)))))) *)
generalize (eqK_dec _ Hp x 0%f).
(* Goal: forall _ : if eqK (K p) x (v0 (K p)) then @Logic.eq (Field.K (K p)) x (v0 (K p)) else not (@Logic.eq (Field.K (K p)) x (v0 (K p))), or (@Logic.eq (Field.K (K1 p)) x (v0 (K1 p))) (not (@Logic.eq (Field.K (K1 p)) x (v0 (K1 p)))) *)
(* Goal: or (@Logic.eq (prod (vect n) (vect n)) x (@pair (vect n) (vect n) (genk n (v0 (K1 p))) (genk n (v0 (K1 p))))) (not (@Logic.eq (prod (vect n) (vect n)) x (@pair (vect n) (vect n) (genk n (v0 (K1 p))) (genk n (v0 (K1 p)))))) *)
case eqK; auto.
(* Goal: or (@Logic.eq (prod (vect n) (vect n)) x (@pair (vect n) (vect n) (genk n (v0 (K1 p))) (genk n (v0 (K1 p))))) (not (@Logic.eq (prod (vect n) (vect n)) x (@pair (vect n) (vect n) (genk n (v0 (K1 p))) (genk n (v0 (K1 p)))))) *)
destruct x as (x1, x2).
(* Goal: or (@Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) x1 x2) (@pair (vect n) (vect n) (genk n (v0 (K1 p))) (genk n (v0 (K1 p))))) (not (@Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) x1 x2) (@pair (vect n) (vect n) (genk n (v0 (K1 p))) (genk n (v0 (K1 p)))))) *)
case (IH x1); auto; intros H1; subst.
(* Goal: or (@Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (E0 (vn_eparams n)) x2) (@pair (vect n) (vect n) (genk n (v0 (K1 p))) (genk n (v0 (K1 p))))) (not (@Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (E0 (vn_eparams n)) x2) (@pair (vect n) (vect n) (genk n (v0 (K1 p))) (genk n (v0 (K1 p)))))) *)
(* Goal: or (@Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) x1 x2) (@pair (vect n) (vect n) (genk n (v0 (K1 p))) (genk n (v0 (K1 p))))) (not (@Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) x1 x2) (@pair (vect n) (vect n) (genk n (v0 (K1 p))) (genk n (v0 (K1 p)))))) *)
case (IH x2); auto; intros H1; subst; auto.
(* Goal: or (@Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) x1 x2) (@pair (vect n) (vect n) (genk n (v0 (K1 p))) (genk n (v0 (K1 p))))) (not (@Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) x1 x2) (@pair (vect n) (vect n) (genk n (v0 (K1 p))) (genk n (v0 (K1 p)))))) *)
right; intro HH; case H1; injection HH; auto.
(* Goal: or (@Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) x1 x2) (@pair (vect n) (vect n) (genk n (v0 (K1 p))) (genk n (v0 (K1 p))))) (not (@Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) x1 x2) (@pair (vect n) (vect n) (genk n (v0 (K1 p))) (genk n (v0 (K1 p)))))) *)
right; intro HH; case H1; injection HH; auto.
Qed.

(* Generate the p element of the base in dimension n *)
Fixpoint gen (n: nat) (p: nat) {struct n} : vect n :=
  match n return vect n with 0 => 1%f | S n1 =>
    match p with
      0 => (genk n1 1%f, genk n1 0%f)
    | S p1 =>  (genk n1 0%f, gen n1 p1) 
    end
  end.

Notation "''e_' p" := (gen _ p) (at level 8, format "''e_' p"): g_scope.

Lemma inj_e n p1 p2 : p1 < n -> p2 < n ->
  'e_p1 = 'e_p2 :> vect n -> p1 = p2.
Proof.
(* Goal: forall (_ : lt p1 n) (_ : lt p2 n) (_ : @Logic.eq (vect n) (gen n p1) (gen n p2)), @Logic.eq nat p1 p2 *)
generalize p1 p2; clear p1 p2.
(* Goal: @Logic.eq (vect n) (dual n (join n v1 v2)) (meet n (dual n v1) (dual n v2)) *)
induction n as [| n IH]; auto.
(* Goal: forall (p1 p2 : nat) (_ : lt p1 O) (_ : lt p2 O) (_ : @Logic.eq (vect O) (gen O p1) (gen O p2)), @Logic.eq nat p1 p2 *)
(* Goal: forall (p1 p2 : nat) (_ : lt p1 (S n)) (_ : lt p2 (S n)) (_ : @Logic.eq (vect (S n)) (gen (S n) p1) (gen (S n) p2)), @Logic.eq nat p1 p2 *)
intros p1 p2 HH; contradict HH; auto with arith.
intros [|p1]; intros [|p2]; simpl; auto;
 try (intros _ _ HH; injection HH; intros _ HH1;
  case (one_diff_zero _ Hp); apply (injk n); auto).
(* Goal: forall (_ : lt (S p1) (S n)) (_ : lt (S p2) (S n)) (_ : @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (genk n (v0 (K1 p))) (gen n p1)) (@pair (vect n) (vect n) (genk n (v0 (K1 p))) (gen n p2))), @Logic.eq nat (S p1) (S p2) *)
intros H1 H2 HH; injection HH; intros HH1.
(* Goal: @Logic.eq nat (S p1) (S p2) *)
rewrite (IH p1 p2); auto with arith.
Qed.


(* Get the constant part of a vector *)
Fixpoint const (n: nat): (vect n) -> K :=
  match n return vect n -> K with 
  | O => fun a => a
  | S n1 => fun l => let (l1,l2) := l in const n1 l2
  end.

Notation "'C[ x ]" := (const _ x).

Lemma const0 n : 'C[ 0: vect n ] = 0%f.
Proof. induction n as [| n IH]; simpl; auto. Qed.

Hint Rewrite const0: GRm0.

Lemma constk n k : 'C[[k]: vect n] = k.
Proof. induction n as [| n IH]; simpl; auto. Qed.

Lemma const_scal n k (x: vect n): 'C[k .* x] = (k * 'C[x])%f.
Proof.
(* Goal: @Logic.eq (vect n) (meet n x (scalE (vn_eparams n) k y)) (scalE (vn_eparams n) k (meet n x y)) *)
induction n as [| n IH]; simpl; try Vfold n; auto.
(* Goal: @Logic.eq (list (Field.K (K1 p))) (let (_, l2) := x in proj n O l2) (@cons (Field.K (K1 p)) (let (_, l2) := x in const n l2) (@nil (Field.K (K1 p)))) *)
destruct x; rewrite IH; auto.
Qed.

Lemma const_add n (x1 x2: vect n): 'C[x1 + x2] = ('C[x1] + 'C[x2])%f.
Proof.
(* Goal: @Logic.eq (vect n) (meet n x (scalE (vn_eparams n) k y)) (scalE (vn_eparams n) k (meet n x y)) *)
induction n as [| n IH]; simpl; try Vfold n; auto.
(* Goal: @Logic.eq (Field.K (K1 p)) (let (_, l2) := let (l3, l5) := x1 in let (l4, l6) := x2 in @pair (vect n) (vect n) (addE (vn_eparams n) l3 l4) (addE (vn_eparams n) l5 l6) in const n l2) (addK (K1 p) (let (_, l2) := x1 in const n l2) (let (_, l2) := x2 in const n l2)) *)
destruct x1; destruct x2; rewrite IH; auto.
Qed.

(* Equality to zero: Equality to zero on leaves *)
Fixpoint eq0 (n : nat) : vect n -> bool :=
  match n return (vect n -> bool) with
  | 0%nat => fun a => (a ?= 0)%f
  | S n1 =>
      fun l1 =>
      let (l2, l3) := l1 in
      if eq0 n1 l2 then eq0 n1 l3 else false
  end.

Notation "x ?= 0" := (eq0 _ x) (at level 70): g_scope.

(* Equality to zero *)
Lemma eq0_dec n (x: vect n) : if x ?= 0 then x = 0 else x <> 0.
Proof.
(* Goal: forall (b : bool) (k : nat) (_ : b2Prop (hom n k x)), b2Prop (hom n k (dconj n b x)) *)
induction n as [| n IH]; simpl.
(* Goal: if eqK (K1 p) x (v0 (K1 p)) then @Logic.eq (Field.K (K1 p)) x (v0 (K1 p)) else not (@Logic.eq (Field.K (K1 p)) x (v0 (K1 p))) *)
(* Goal: if let (l2, l3) := x in if eq0 n l2 then eq0 n l3 else false then @Logic.eq (prod (vect n) (vect n)) x (@pair (vect n) (vect n) (genk n (v0 (K1 p))) (genk n (v0 (K1 p)))) else not (@Logic.eq (prod (vect n) (vect n)) x (@pair (vect n) (vect n) (genk n (v0 (K1 p))) (genk n (v0 (K1 p))))) *)
  apply eqK_dec; auto.
(* Goal: if let (l2, l3) := x in if eq0 n l2 then eq0 n l3 else false then @Logic.eq (prod (vect n) (vect n)) x (@pair (vect n) (vect n) (genk n (v0 (K1 p))) (genk n (v0 (K1 p)))) else not (@Logic.eq (prod (vect n) (vect n)) x (@pair (vect n) (vect n) (genk n (v0 (K1 p))) (genk n (v0 (K1 p))))) *)
destruct x as [l1 l2]; generalize (IH l1); case eq0.
(* Goal: forall _ : @Logic.eq (vect n) l1 (E0 (vn_eparams n)), if eq0 n l2 then @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) l1 l2) (@pair (vect n) (vect n) (genk n (v0 (K1 p))) (genk n (v0 (K1 p)))) else not (@Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) l1 l2) (@pair (vect n) (vect n) (genk n (v0 (K1 p))) (genk n (v0 (K1 p))))) *)
(* Goal: forall _ : not (@Logic.eq (vect n) l1 (E0 (vn_eparams n))), not (@Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) l1 l2) (@pair (vect n) (vect n) (genk n (v0 (K1 p))) (genk n (v0 (K1 p))))) *)
  generalize (IH l2); case eq0; intros HH1 HH2; subst; auto.
(* Goal: not (@Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (E0 (vn_eparams n)) l2) (@pair (vect n) (vect n) (genk n (v0 (K1 p))) (genk n (v0 (K1 p))))) *)
(* Goal: forall _ : not (@Logic.eq (vect n) l1 (E0 (vn_eparams n))), not (@Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) l1 l2) (@pair (vect n) (vect n) (genk n (v0 (K1 p))) (genk n (v0 (K1 p))))) *)
  intros HH3; case HH1; injection HH3; auto.
(* Goal: forall (_ : not (@Logic.eq (vect n) (one_factor n k2 v) (E0 (vn_eparams n)))) (_ : @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (genk n (Field.v0 (K1 p))) (one_factor n k2 v)) (@pair (vect n) (vect n) (genk n (Field.v0 (K1 p))) (genk n (Field.v0 (K1 p))))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) v v0) (@pair (vect n) (vect n) (genk n (Field.v0 (K1 p))) (genk n (Field.v0 (K1 p)))) *)
intros HH1 HH2; case HH1; injection HH2; auto.
Qed.

Lemma eq0_spec n (x: vect n) : eq_Spec x 0 (x ?= 0).
Proof. generalize (eq0_dec n x); case eq0; intros; constructor; auto. Qed.

Lemma eq0I n : ((0: vect n) ?= 0) = true.
Proof.
(* Goal: forall (b : bool) (k : nat) (_ : b2Prop (hom n k x)), b2Prop (hom n k (dconj n b x)) *)
induction n as [| n IH]; simpl.
(* Goal: @Logic.eq bool (eqK (K1 p) (v0 (K1 p)) (v0 (K1 p))) true *)
(* Goal: @Logic.eq bool (if eq0 n (genk n (v0 (K1 p))) then eq0 n (genk n (v0 (K1 p))) else false) true *)
case eqK_spec; auto.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (genk n (v0 (K p))) (k2g n (Kn.genk p n (v0 (K p))))) (@pair (vect n) (vect n) (genk n (v0 (K1 p))) (genk n (v0 (K1 p)))) *)
simpl in IH; rewrite IH; auto.
Qed.

Lemma en_def n : 'e_n = 1 :> vect n.
Proof.
(* Goal: @Logic.eq (vect n) (k2g n (E0 (Kn.vn_eparams p n))) (E0 (vn_eparams n)) *)
induction n as [| n IH]; simpl; auto.
(* Goal: @Logic.eq (vect n) (meet n (meet n v v1) v3) (meet n v (meet n v1 v3)) *)
(* Goal: @Logic.eq (vect n) (addE (vn_eparams n) (meet n (meet n v v1) v4) (meet n (addE (vn_eparams n) (meet n v v2) (meet n v0 (dconj n false v1))) (dconj n false v3))) (addE (vn_eparams n) (meet n v (addE (vn_eparams n) (meet n v1 v4) (meet n v2 (dconj n false v3)))) (meet n v0 (dconj n false (meet n v1 v3)))) *)
rewrite IH; auto.
Qed.

Lemma addk n k1 k2 : [k1] + [k2] = [k1 + k2] :> vect n.
Proof.
(* Goal: @Logic.eq (vect n) (dual n (addE (vn_eparams n) v1 v2)) (addE (vn_eparams n) (dual n v1) (dual n v2)) *)
induction n as [|n IH]; simpl; auto; Vfold n.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (addE (vn_eparams n) (E0 (vn_eparams n)) (E0 (vn_eparams n))) (addE (vn_eparams n) (genk n k1) (genk n k2))) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (genk n (addK (K1 p) k1 k2))) *)
rewrite !IH; Vrm0.
Qed.

(* scal is integral *)
Lemma scal_integral n k (x: vect n) : k .* x = 0 -> k = 0%f \/ x = 0.
Proof.
(* Goal: forall (b : bool) (k : nat) (_ : b2Prop (hom n k x)), b2Prop (hom n k (dconj n b x)) *)
induction n as [| n IH]; simpl.
(* Goal: forall _ : @Logic.eq (Field.K (K1 p)) (multK (K1 p) k x) (v0 (K1 p)), or (@Logic.eq (Field.K (K1 p)) k (v0 (K1 p))) (@Logic.eq (Field.K (K1 p)) x (v0 (K1 p))) *)
(* Goal: forall _ : @Logic.eq (prod (vect n) (vect n)) (let (l2, l3) := x in @pair (vect n) (vect n) (scal n k l2) (scal n k l3)) (@pair (vect n) (vect n) (genk n (v0 (K1 p))) (genk n (v0 (K1 p)))), or (@Logic.eq (Field.K (K1 p)) k (v0 (K1 p))) (@Logic.eq (prod (vect n) (vect n)) x (@pair (vect n) (vect n) (genk n (v0 (K1 p))) (genk n (v0 (K1 p))))) *)
  intros; apply (multK_integral _ Hp k); auto.
(* Goal: forall _ : @Logic.eq (prod (vect n) (vect n)) (let (l2, l3) := x in @pair (vect n) (vect n) (scal n k l2) (scal n k l3)) (@pair (vect n) (vect n) (genk n (v0 (K1 p))) (genk n (v0 (K1 p)))), or (@Logic.eq (Field.K (K1 p)) k (v0 (K1 p))) (@Logic.eq (prod (vect n) (vect n)) x (@pair (vect n) (vect n) (genk n (v0 (K1 p))) (genk n (v0 (K1 p))))) *)
destruct x; intros HH; injection HH; intros HH1 HH2.
(* Goal: or (@Logic.eq (Field.K (K1 p)) k (Field.v0 (K1 p))) (@Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) v v0) (@pair (vect n) (vect n) (genk n (Field.v0 (K1 p))) (genk n (Field.v0 (K1 p))))) *)
case (IH _ _ HH1); case (IH _ _ HH2); auto.
(* Goal: forall (_ : @Logic.eq (vect n) v (E0 (vn_eparams n))) (_ : @Logic.eq (vect n) v0 (E0 (vn_eparams n))), or (@Logic.eq (Field.K (K1 p)) k (Field.v0 (K1 p))) (@Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) v v0) (@pair (vect n) (vect n) (genk n (Field.v0 (K1 p))) (genk n (Field.v0 (K1 p))))) *)
intros; right; apply f_equal2 with (f := @pair (vect n) (vect n)); auto.
Qed.

(* Multiplication of a constant *)
Lemma scalk n k1 k2 : k1 .* [k2] = [k1 * k2] :> vect n.
Proof.
(* Goal: @Logic.eq (vect n) (k2g n (E0 (Kn.vn_eparams p n))) (E0 (vn_eparams n)) *)
induction n as [| n IH]; simpl; auto.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (scal n k1 (genk n (v0 (K1 p)))) (scal n k1 (genk n k2))) (@pair (vect n) (vect n) (genk n (v0 (K1 p))) (genk n (multK (K1 p) k1 k2))) *)
generalize IH; Vfold n; clear IH; intros IH.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (scalE (vn_eparams n) k1 (E0 (vn_eparams n))) (scalE (vn_eparams n) k1 (genk n k2))) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (genk n (multK (K1 p) k1 k2))) *)
rewrite scalE0r, IH; auto.
Qed.

(* Homogeneity *)
Fixpoint hom (n k : nat) {struct n} : vect n -> bool :=
  match n return (vect n -> bool) with
  | 0%nat => fun a => match k with O => true | S _ => a ?= 0 end
  | S n1 =>
      fun l1 =>
       let (l2, l3) := l1 in
       (match k with O => l2 ?= 0 | S k1 => hom n1 k1 l2 end) && hom n1 k l3
  end.

Lemma homk0 n k : hom n k 0.
Proof.
(* Goal: forall _ : @In (vect n) v (base n k), or (@Logic.eq (vect n) (join n v (dual n v)) (all n)) (@Logic.eq (vect n) (join n v (dual n v)) (scalE (vn_eparams n) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (all n))) *)
generalize k; clear k.
(* Goal: @Logic.eq (vect n) (k2g n (E0 (Kn.vn_eparams p n))) (E0 (vn_eparams n)) *)
induction n as [|n IH]; simpl; auto.
(* Goal: forall k : nat, b2Prop match k with | O => true | S n => eqK (K1 p) (v0 (K1 p)) (v0 (K1 p)) end *)
(* Goal: forall k : nat, b2Prop (andb match k with | O => eq0 n (genk n (v0 (K1 p))) | S k1 => hom n k1 (genk n (v0 (K1 p))) end (hom n k (genk n (v0 (K1 p))))) *)
  intros [|k]; auto; rewrite eqKI; auto.
(* Goal: forall k : nat, @Logic.eq nat (@length (Field.K (K1 p)) match k with | O => @cons (Field.K (K1 p)) x (@nil (Field.K (K1 p))) | S n => @nil (Field.K (K1 p)) end) (@length (Field.K (K1 p)) match k with | O => @cons (Field.K (K1 p)) (v1 (K1 p)) (@nil (Field.K (K1 p))) | S n => @nil (Field.K (K1 p)) end) *)
(* Goal: forall k : nat, @Logic.eq nat (@length (Field.K (K1 p)) (let (l1, l2) := x in match k with | O => proj n k l2 | S k1 => @app (Field.K (K1 p)) (proj n k1 l1) (proj n k l2) end)) (@length (prod (vect n) (vect n)) match k with | O => @map (vect n) (prod (vect n) (vect n)) (lift n) (base n k) | S k1 => @app (prod (vect n) (vect n)) (@map (vect n) (prod (vect n) (vect n)) (dlift n) (base n k1)) (@map (vect n) (prod (vect n) (vect n)) (lift n) (base n k)) end) *)
intros [|k]; auto.
(* Goal: b2Prop (andb (eq0 n (genk n (v0 (K1 p)))) (hom n O (genk n (v0 (K1 p))))) *)
(* Goal: b2Prop (andb (hom n k (genk n (v0 (K1 p)))) (hom n (S k) (genk n (v0 (K1 p))))) *)
  rewrite eq0I; simpl; auto.
(* Goal: and (b2Prop (fortho n v0 (conj n (negb b) v1))) (b2Prop (fortho n v0 (conj n b v2))) *)
rewrite !IH; auto.
Qed.

Hint Resolve homk0.

Lemma hom0K n k : hom n 0 [k].
Proof.
(* Goal: @Logic.eq (vect n) (k2g n (E0 (Kn.vn_eparams p n))) (E0 (vn_eparams n)) *)
induction n as [|n IH]; simpl; auto.
(* Goal: forall _ : @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (genk n (Field.v0 (K1 p))) (if eq0 n (one_factor n k2 v) then one_factor n (S k2) v0 else one_factor n k2 v)) (@pair (vect n) (vect n) (genk n (Field.v0 (K1 p))) (genk n (Field.v0 (K1 p)))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) v v0) (@pair (vect n) (vect n) (genk n (Field.v0 (K1 p))) (genk n (Field.v0 (K1 p)))) *)
case eq0_spec; auto.
(* Goal: forall (_ : not (@Logic.eq (list (vect n)) (@nil (vect n)) (@nil (vect n)))) (_ : forall (x : vect n) (_ : @In (vect n) x (@nil (vect n))), b2Prop (hom n (S O) x)), cbl n (@nil (vect n)) (Nat.pred (@length (vect n) (@nil (vect n)))) (joinl n (@nil (vect n))) *)
(* Goal: forall (_ : not (@Logic.eq (list (vect n)) (@cons (vect n) a l) (@nil (vect n)))) (_ : forall (x : vect n) (_ : @In (vect n) x (@cons (vect n) a l)), b2Prop (hom n (S O) x)), cbl n (@cons (vect n) a l) (Nat.pred (@length (vect n) (@cons (vect n) a l))) (joinl n (@cons (vect n) a l)) *)
intros HH; case HH; auto.
Qed.

Hint Resolve hom0K.

Lemma const_hom n k x : hom n k x -> 0 < k -> 'C[x] = 0%f.
Proof.
(* Goal: forall _ : @In (vect n) v (base n k), or (@Logic.eq (vect n) (join n v (dual n v)) (all n)) (@Logic.eq (vect n) (join n v (dual n v)) (scalE (vn_eparams n) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (all n))) *)
generalize k; clear k.
(* Goal: forall (k : nat) (_ : not (@Logic.eq (E (vn_eparams n)) x (E0 (vn_eparams n)))) (_ : b2Prop (hom n k x)), @Logic.eq nat (first_deg n x) k *)
induction n as [|n IH]; intros [|k]; simpl; auto.
(* Goal: forall (_ : b2Prop (let (l2, l3) := x in andb (eq0 n l2) (hom n O l3))) (_ : lt O O), @Logic.eq (Field.K (K1 p)) (let (_, l2) := x in const n l2) (v0 (K1 p)) *)
(* Goal: forall (_ : b2Prop (let (l2, l3) := x in andb (hom n k l2) (hom n (S k) l3))) (_ : lt O (S k)), @Logic.eq (Field.K (K1 p)) (let (_, l2) := x in const n l2) (v0 (K1 p)) *)
intros _ H; contradict H; auto with arith.
(* Goal: forall _ : b2Prop (eqK (K1 p) x (v0 (K1 p))), @Logic.eq (Field.K (K1 p)) x (v0 (K1 p)) *)
(* Goal: forall (_ : not (@Logic.eq (prod (vect n) (vect n)) x (@pair (vect n) (vect n) (genk n (v0 (K1 p))) (genk n (v0 (K1 p)))))) (_ : b2Prop (let (l2, l3) := x in andb (hom n O l2) (hom n (S O) l3))), @Logic.eq (prod (vect n) (vect n)) (let (x11, x12) := x in if eq0 n x12 then @pair (vect n) (vect n) (genk n (v0 (K1 p))) (scal n (invK (K1 p) (const n x11)) (genk n (v0 (K1 p)))) else @pair (vect n) (vect n) (factor n x12 (add n (scal n (const n x11) (factor n x12 (genk n k))) (scal n (oppK (K1 p) (v1 (K1 p))) (genk n (v0 (K1 p)))))) (factor n x12 (genk n k))) (@pair (vect n) (vect n) (genk n (v0 (K1 p))) (genk n (v0 (K1 p)))) *)
case eqK_spec; auto; intros; discriminate.
(* Goal: forall (_ : b2Prop (let (l2, l3) := x in andb (eq0 n l2) (hom n O l3))) (_ : lt O O), @Logic.eq (Field.K (K1 p)) (let (_, l2) := x in const n l2) (v0 (K1 p)) *)
(* Goal: forall (_ : b2Prop (let (l2, l3) := x in andb (hom n k l2) (hom n (S k) l3))) (_ : lt O (S k)), @Logic.eq (Field.K (K1 p)) (let (_, l2) := x in const n l2) (v0 (K1 p)) *)
intros _ H; contradict H; auto with arith.
(* Goal: forall (_ : b2Prop (let (l2, l3) := x in andb (hom n k l2) (hom n (S k) l3))) (_ : lt O (S k)), @Logic.eq (Field.K (K1 p)) (let (_, l2) := x in const n l2) (v0 (K1 p)) *)
destruct x; rewrite andbP; intros (H1,H2) _.
(* Goal: @Logic.eq (Field.K (K1 p)) (const n v0) (Field.v0 (K1 p)) *)
apply (IH _ k.+1); auto with arith.
Qed.

Lemma hom0E n (x: vect n) : hom n 0 x -> x = ['C[x]].
Proof.
(* Goal: @Logic.eq (vect n) (k2g n (E0 (Kn.vn_eparams p n))) (E0 (vn_eparams n)) *)
induction n as [| n IH]; simpl; auto.
(* Goal: forall _ : b2Prop (let (l2, l3) := x in andb (eq0 n l2) (hom n O l3)), @Logic.eq (prod (vect n) (vect n)) x (@pair (vect n) (vect n) (genk n (v0 (K1 p))) (genk n (let (_, l2) := x in const n l2))) *)
destruct x; case eq0_spec; try (intros; discriminate).
(* Goal: forall (_ : @Logic.eq (vect n) v (E0 (vn_eparams n))) (_ : b2Prop (andb true (hom n O v0))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) v v0) (@pair (vect n) (vect n) (genk n (Field.v0 (K1 p))) (genk n (const n v0))) *)
intros H H2; rewrite H, <-IH; auto.
Qed.

Lemma hom1e n i : i < n -> hom n 1 'e_i.
Proof.
(* Goal: forall _ : lt i n, @Logic.eq (vect n) (k2g n (Kn.gen p n i)) (gen n i) *)
generalize i; clear i.
(* Goal: @Logic.eq (vect n) (k2g n (E0 (Kn.vn_eparams p n))) (E0 (vn_eparams n)) *)
induction n as [|n IH]; simpl; auto.
(* Goal: forall (i : nat) (_ : lt i O), b2Prop (eqK (K1 p) (v1 (K1 p)) (v0 (K1 p))) *)
(* Goal: forall (i : nat) (_ : lt i (S n)), b2Prop (let (l2, l3) := match i with | O => @pair (vect n) (vect n) (genk n (v1 (K1 p))) (genk n (v0 (K1 p))) | S p1 => @pair (vect n) (vect n) (genk n (v0 (K1 p))) (gen n p1) end in andb (hom n O l2) (hom n (S O) l3)) *)
  intros k HH; contradict HH; auto with arith.
(* Goal: forall (i : nat) (_ : lt i (S n)), b2Prop (let (l2, l3) := match i with | O => @pair (vect n) (vect n) (genk n (v1 (K1 p))) (genk n (v0 (K1 p))) | S p1 => @pair (vect n) (vect n) (genk n (v0 (K1 p))) (gen n p1) end in andb (hom n O l2) (hom n (S O) l3)) *)
intros [|k]; simpl; rewrite hom0K; intros HH.
(* Goal: b2Prop (andb true (hom n (S O) (genk n (v0 (K1 p))))) *)
(* Goal: b2Prop (andb true (hom n (S O) (gen n k))) *)
apply homk0.
(* Goal: b2Prop (andb true (hom n (S O) (gen n k))) *)
apply IH; auto with arith.
Qed.

Lemma homE n k1 k2 (x: vect n) : 
  hom n k1 x -> hom n k2 x -> k1 = k2 \/ x = 0.
Proof.
(* Goal: forall (_ : b2Prop (hom n k1 x)) (_ : b2Prop (hom n k2 x)), or (@Logic.eq nat k1 k2) (@Logic.eq (vect n) x (E0 (vn_eparams n))) *)
assert (aux: forall n k1 k2, hom n k1.+1 [k2] -> k2 = 0%f).
(* Goal: forall (n k1 : nat) (k2 : Field.K (K1 p)) (_ : b2Prop (hom n (S k1) (genk n k2))), @Logic.eq (Field.K (K1 p)) k2 (v0 (K1 p)) *)
(* Goal: forall (_ : b2Prop (hom n k1 x)) (_ : b2Prop (hom n k2 x)), or (@Logic.eq nat k1 k2) (@Logic.eq (vect n) x (E0 (vn_eparams n))) *)
  intros n1; elim n1; simpl; auto; clear n1.
(* Goal: forall _ : b2Prop (eqK (K1 p) x (v0 (K1 p))), @Logic.eq (Field.K (K1 p)) x (v0 (K1 p)) *)
(* Goal: forall (_ : not (@Logic.eq (prod (vect n) (vect n)) x (@pair (vect n) (vect n) (genk n (v0 (K1 p))) (genk n (v0 (K1 p)))))) (_ : b2Prop (let (l2, l3) := x in andb (hom n O l2) (hom n (S O) l3))), @Logic.eq (prod (vect n) (vect n)) (let (x11, x12) := x in if eq0 n x12 then @pair (vect n) (vect n) (genk n (v0 (K1 p))) (scal n (invK (K1 p) (const n x11)) (genk n (v0 (K1 p)))) else @pair (vect n) (vect n) (factor n x12 (add n (scal n (const n x11) (factor n x12 (genk n k))) (scal n (oppK (K1 p) (v1 (K1 p))) (genk n (v0 (K1 p)))))) (factor n x12 (genk n k))) (@pair (vect n) (vect n) (genk n (v0 (K1 p))) (genk n (v0 (K1 p)))) *)
  intros _ k4; case eqK_spec; auto; intros; discriminate.
(* Goal: forall (n : nat) (_ : forall (k1 : nat) (k2 : Field.K (K1 p)) (_ : b2Prop (hom n (S k1) (genk n k2))), @Logic.eq (Field.K (K1 p)) k2 (v0 (K1 p))) (k1 : nat) (k2 : Field.K (K1 p)) (_ : b2Prop (andb (hom n k1 (genk n (v0 (K1 p)))) (hom n (S k1) (genk n k2)))), @Logic.eq (Field.K (K1 p)) k2 (v0 (K1 p)) *)
(* Goal: forall (_ : b2Prop (hom n k1 x)) (_ : b2Prop (hom n k2 x)), or (@Logic.eq nat k1 k2) (@Logic.eq (vect n) x (E0 (vn_eparams n))) *)
  intros n1 IH k3 k4.
(* Goal: forall _ : b2Prop (andb (hom n1 k3 (genk n1 (v0 (K1 p)))) (hom n1 (S k3) (genk n1 k4))), @Logic.eq (Field.K (K1 p)) k4 (v0 (K1 p)) *)
(* Goal: forall (_ : b2Prop (hom n k1 x)) (_ : b2Prop (hom n k2 x)), or (@Logic.eq nat k1 k2) (@Logic.eq (vect n) x (E0 (vn_eparams n))) *)
  rewrite homk0; intros HH; apply (IH _ _ HH).
(* Goal: forall (_ : b2Prop (hom n k1 x)) (_ : b2Prop (hom n k2 x)), or (@Logic.eq nat k1 k2) (@Logic.eq (vect n) x (E0 (vn_eparams n))) *)
generalize k1 k2 x; clear k1 k2 x.
(* Goal: forall (k1 k2 : nat) (x : vect n) (_ : b2Prop (hom n k1 x)) (_ : b2Prop (hom n k2 x)), or (@Logic.eq nat k1 k2) (@Logic.eq (vect n) x (E0 (vn_eparams n))) *)
elim n; simpl; auto; clear n.
intros [|k1] [|k2]; auto;
  try (intros x; case eqK_spec; auto; intros; discriminate).
(* Goal: forall (n : nat) (_ : forall (k1 k2 : nat) (x : vect n) (_ : b2Prop (hom n k1 x)) (_ : b2Prop (hom n k2 x)), or (@Logic.eq nat k1 k2) (@Logic.eq (vect n) x (genk n (v0 (K1 p))))) (k1 k2 : nat) (x : prod (vect n) (vect n)) (_ : b2Prop (let (l2, l3) := x in andb match k1 with | O => eq0 n l2 | S k3 => hom n k3 l2 end (hom n k1 l3))) (_ : b2Prop (let (l2, l3) := x in andb match k2 with | O => eq0 n l2 | S k3 => hom n k3 l2 end (hom n k2 l3))), or (@Logic.eq nat k1 k2) (@Logic.eq (prod (vect n) (vect n)) x (@pair (vect n) (vect n) (genk n (v0 (K1 p))) (genk n (v0 (K1 p))))) *)
intros n IH [|k1] [|k2] (x1, x2); auto.
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (eq0 n x1) (hom n O x2))), or (@Logic.eq nat (S k1) O) (@Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) x1 x2) (@pair (vect n) (vect n) (genk n (v0 (K1 p))) (genk n (v0 (K1 p))))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n k2 x1) (hom n (S k2) x2))), or (@Logic.eq nat (S k1) (S k2)) (@Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) x1 x2) (@pair (vect n) (vect n) (genk n (v0 (K1 p))) (genk n (v0 (K1 p))))) *)
case eq0_spec; try (intros; discriminate).
rewrite !andbP; intros  H (_,H1) (_,H2).
(* Goal: or (@Logic.eq nat (S k1) O) (@Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) x1 x2) (@pair (vect n) (vect n) (genk n (v0 (K1 p))) (genk n (v0 (K1 p))))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n k2 x1) (hom n (S k2) x2))), or (@Logic.eq nat (S k1) (S k2)) (@Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) x1 x2) (@pair (vect n) (vect n) (genk n (v0 (K1 p))) (genk n (v0 (K1 p))))) *)
case (IH _ _ _ H1 H2); intros; subst; auto.
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (eq0 n x1) (hom n O x2))), or (@Logic.eq nat (S k1) O) (@Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) x1 x2) (@pair (vect n) (vect n) (genk n (v0 (K1 p))) (genk n (v0 (K1 p))))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n k2 x1) (hom n (S k2) x2))), or (@Logic.eq nat (S k1) (S k2)) (@Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) x1 x2) (@pair (vect n) (vect n) (genk n (v0 (K1 p))) (genk n (v0 (K1 p))))) *)
case eq0_spec; try (intros; discriminate).
rewrite !andbP; intros  H (_,H1) (_,H2).
(* Goal: or (@Logic.eq nat (S k1) O) (@Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) x1 x2) (@pair (vect n) (vect n) (genk n (v0 (K1 p))) (genk n (v0 (K1 p))))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n k2 x1) (hom n (S k2) x2))), or (@Logic.eq nat (S k1) (S k2)) (@Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) x1 x2) (@pair (vect n) (vect n) (genk n (v0 (K1 p))) (genk n (v0 (K1 p))))) *)
case (IH _ _ _ H1 H2); intros; subst; auto.
rewrite !andbP; intros  (H1,H2) (H3,H4).
(* Goal: or (@Logic.eq nat (S k1) (S k2)) (@Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) x1 x2) (@pair (vect n) (vect n) (genk n (v0 (K1 p))) (genk n (v0 (K1 p))))) *)
case (IH _ _ _ H1 H3); intros; subst; auto.
(* Goal: or (@Logic.eq nat (S k1) (S k2)) (@Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (genk n (v0 (K1 p))) x2) (@pair (vect n) (vect n) (genk n (v0 (K1 p))) (genk n (v0 (K1 p))))) *)
case (IH _ _ _ H2 H4); intros; subst; auto.
Qed.

Lemma hom_lt n k v : n < k -> hom n k v -> v = 0.
Proof.
(* Goal: forall _ : @In (vect n) v (base n k), or (@Logic.eq (vect n) (join n v (dual n v)) (all n)) (@Logic.eq (vect n) (join n v (dual n v)) (scalE (vn_eparams n) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (all n))) *)
generalize k; clear k.
induction n as [| n IH]; intros [|k]; simpl; auto;
  try (intros HH; contradict HH; auto with arith; fail).
(* Goal: forall _ : b2Prop (eqK (K1 p) x (v0 (K1 p))), @Logic.eq (Field.K (K1 p)) x (v0 (K1 p)) *)
(* Goal: forall (_ : not (@Logic.eq (prod (vect n) (vect n)) x (@pair (vect n) (vect n) (genk n (v0 (K1 p))) (genk n (v0 (K1 p)))))) (_ : b2Prop (let (l2, l3) := x in andb (hom n O l2) (hom n (S O) l3))), @Logic.eq (prod (vect n) (vect n)) (let (x11, x12) := x in if eq0 n x12 then @pair (vect n) (vect n) (genk n (v0 (K1 p))) (scal n (invK (K1 p) (const n x11)) (genk n (v0 (K1 p)))) else @pair (vect n) (vect n) (factor n x12 (add n (scal n (const n x11) (factor n x12 (genk n k))) (scal n (oppK (K1 p) (v1 (K1 p))) (genk n (v0 (K1 p)))))) (factor n x12 (genk n k))) (@pair (vect n) (vect n) (genk n (v0 (K1 p))) (genk n (v0 (K1 p)))) *)
case eqK_spec; auto; intros; discriminate.
(* Goal: forall (_ : lt (S n) (S k)) (_ : b2Prop (let (l2, l3) := v in andb (hom n k l2) (hom n (S k) l3))), @Logic.eq (prod (vect n) (vect n)) v (@pair (vect n) (vect n) (genk n (v0 (K1 p))) (genk n (v0 (K1 p)))) *)
destruct v as [x y]; intros H1; rewrite andbP; intros (H2, H3).
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) x y) (@pair (vect n) (vect n) (genk n (v0 (K1 p))) (genk n (v0 (K1 p)))) *)
rewrite (IH x k), (IH y k.+1); auto with arith.
Qed.

Lemma add_hom n k (x y: vect n) : 
  hom n k x -> hom n k y -> hom n k (x + y).
Proof.
(* Goal: forall _ : @In (vect n) v (base n k), or (@Logic.eq (vect n) (join n v (dual n v)) (all n)) (@Logic.eq (vect n) (join n v (dual n v)) (scalE (vn_eparams n) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (all n))) *)
generalize k; clear k.
(* Goal: forall (k1 k2 : nat) (_ : b2Prop (hom n k1 x)) (_ : b2Prop (hom n (S O) y)) (_ : b2Prop (hom n k2 z)), @Logic.eq (vect n) (meet n (join n x y) z) (addE (vn_eparams n) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n (S (Nat.add k1 k2)))) (meet n x (join n y z))) (join n (meet n x z) y)) *)
induction n as [| n IH]; simpl; try (Vfold n).
(* Goal: forall (k : nat) (_ : b2Prop match k with | O => true | S n => eqK (K1 p) x (v0 (K1 p)) end) (_ : b2Prop match k with | O => true | S n => eqK (K1 p) y (v0 (K1 p)) end), b2Prop match k with | O => true | S n => eqK (K1 p) (addK (K1 p) x y) (v0 (K1 p)) end *)
(* Goal: forall (k : nat) (_ : b2Prop (let (l2, l3) := x in andb match k with | O => eq0 n l2 | S k1 => hom n k1 l2 end (hom n k l3))) (_ : b2Prop (let (l2, l3) := y in andb match k with | O => eq0 n l2 | S k1 => hom n k1 l2 end (hom n k l3))), b2Prop (let (l2, l3) := let (l3, l5) := x in let (l4, l6) := y in @pair (vect n) (vect n) (addE (vn_eparams n) l3 l4) (addE (vn_eparams n) l5 l6) in andb match k with | O => eq0 n l2 | S k1 => hom n k1 l2 end (hom n k l3)) *)
  intros k; case k; auto.
(* Goal: forall (_ : nat) (_ : b2Prop (eqK (K1 p) x (v0 (K1 p)))) (_ : b2Prop (eqK (K1 p) y (v0 (K1 p)))), b2Prop (eqK (K1 p) (addK (K1 p) x y) (v0 (K1 p))) *)
(* Goal: forall (k : nat) (_ : b2Prop (let (l2, l3) := x in andb match k with | O => eq0 n l2 | S k1 => hom n k1 l2 end (hom n k l3))) (_ : b2Prop (let (l2, l3) := y in andb match k with | O => eq0 n l2 | S k1 => hom n k1 l2 end (hom n k l3))), b2Prop (let (l2, l3) := let (l3, l5) := x in let (l4, l6) := y in @pair (vect n) (vect n) (addE (vn_eparams n) l3 l4) (addE (vn_eparams n) l5 l6) in andb match k with | O => eq0 n l2 | S k1 => hom n k1 l2 end (hom n k l3)) *)
  intros _; case eqK_spec; auto; intros Hx HH; try discriminate HH.
(* Goal: forall _ : b2Prop (eqK (K1 p) y (v0 (K1 p))), b2Prop (eqK (K1 p) (addK (K1 p) x y) (v0 (K1 p))) *)
(* Goal: forall (k : nat) (_ : b2Prop (let (l2, l3) := x in andb match k with | O => eq0 n l2 | S k1 => hom n k1 l2 end (hom n k l3))) (_ : b2Prop (let (l2, l3) := y in andb match k with | O => eq0 n l2 | S k1 => hom n k1 l2 end (hom n k l3))), b2Prop (let (l2, l3) := let (l3, l5) := x in let (l4, l6) := y in @pair (vect n) (vect n) (addE (vn_eparams n) l3 l4) (addE (vn_eparams n) l5 l6) in andb match k with | O => eq0 n l2 | S k1 => hom n k1 l2 end (hom n k l3)) *)
  case eqK_spec; auto; intros Hy HH1; try discriminate HH1.
(* Goal: b2Prop (eqK (K1 p) (addK (K1 p) x y) (v0 (K1 p))) *)
(* Goal: forall (k : nat) (_ : b2Prop (let (l2, l3) := x in andb match k with | O => eq0 n l2 | S k1 => hom n k1 l2 end (hom n k l3))) (_ : b2Prop (let (l2, l3) := y in andb match k with | O => eq0 n l2 | S k1 => hom n k1 l2 end (hom n k l3))), b2Prop (let (l2, l3) := let (l3, l5) := x in let (l4, l6) := y in @pair (vect n) (vect n) (addE (vn_eparams n) l3 l4) (addE (vn_eparams n) l5 l6) in andb match k with | O => eq0 n l2 | S k1 => hom n k1 l2 end (hom n k l3)) *)
  rewrite Hx; rewrite Hy; rewrite addK0l; auto.
(* Goal: forall _ : b2Prop (eqK (K1 p) M (v0 (K1 p))), b2Prop (eqK (K1 p) (v0 (K1 p)) (v0 (K1 p))) *)
(* Goal: forall _ : b2Prop (let (l2, l3) := M in andb (hom n O l2) (hom n (S O) l3)), b2Prop (let (l2, l3) := let (k, lf1) := lf in let (l2, l3) := M in @pair (vect n) (vect n) (scal n (oppK (K1 p) (v1 (K1 p))) (contra n lf1 l2)) (add n (scal n k l2) (contra n lf1 l3)) in andb (eq0 n l2) (hom n O l3)) *)
(* Goal: forall _ : b2Prop (let (l2, l3) := M in andb (hom n (S k1) l2) (hom n (S (S k1)) l3)), b2Prop (let (l2, l3) := let (k, lf1) := lf in let (l2, l3) := M in @pair (vect n) (vect n) (scal n (oppK (K1 p) (v1 (K1 p))) (contra n lf1 l2)) (add n (scal n k l2) (contra n lf1 l3)) in andb (hom n k1 l2) (hom n (S k1) l3)) *)
  rewrite eqKI; auto.
intros [| k]; destruct x; destruct y; rewrite !andbP;
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
  intros (H1, H2) (H3, H4); split; auto.
generalize H1 H3; do 2 (case eq0_spec; try (intros; discriminate));
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
  intros; subst; rewrite addE0l; auto.
Qed.

Hint Resolve add_hom.

Lemma scal_hom n k1 k2 (x: vect n) : 
  hom n k1 x -> hom n k1 (k2 .* x).
Proof.
(* Goal: forall _ : b2Prop (hom n k1 x), b2Prop (hom n k1 (scalE (vn_eparams n) k2 x)) *)
generalize k1; clear k1.
(* Goal: forall (k1 k2 : nat) (_ : b2Prop (hom n k1 x)) (_ : b2Prop (hom n (S O) y)) (_ : b2Prop (hom n k2 z)), @Logic.eq (vect n) (meet n (join n x y) z) (addE (vn_eparams n) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n (S (Nat.add k1 k2)))) (meet n x (join n y z))) (join n (meet n x z) y)) *)
induction n as [| n IH]; simpl; try (Vfold n).
(* Goal: forall (k1 : nat) (_ : b2Prop match k1 with | O => true | S n => eqK (K1 p) x (v0 (K1 p)) end), b2Prop match k1 with | O => true | S n => eqK (K1 p) (multK (K1 p) k2 x) (v0 (K1 p)) end *)
(* Goal: forall (k1 : nat) (_ : b2Prop (let (l2, l3) := x in andb match k1 with | O => eq0 n l2 | S k2 => hom n k2 l2 end (hom n k1 l3))), b2Prop (let (l2, l3) := let (l2, l3) := x in @pair (vect n) (vect n) (scalE (vn_eparams n) k2 l2) (scalE (vn_eparams n) k2 l3) in andb match k1 with | O => eq0 n l2 | S k2 => hom n k2 l2 end (hom n k1 l3)) *)
  intros k1; case k1; auto.
(* Goal: b2Prop false *)
  intros _;  case eqK_spec; auto; intros Hx HH; try discriminate.
(* Goal: b2Prop (eqK (K1 p) (multK (K1 p) k2 x) (v0 (K1 p))) *)
(* Goal: forall (k1 : nat) (_ : b2Prop (let (l2, l3) := x in andb match k1 with | O => eq0 n l2 | S k2 => hom n k2 l2 end (hom n k1 l3))), b2Prop (let (l2, l3) := let (l2, l3) := x in @pair (vect n) (vect n) (scalE (vn_eparams n) k2 l2) (scalE (vn_eparams n) k2 l3) in andb match k1 with | O => eq0 n l2 | S k2 => hom n k2 l2 end (hom n k1 l3)) *)
  rewrite Hx; rewrite multK0r, eqKI; auto.
intros [| k]; destruct x; rewrite !andbP; 
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
  intros (H1, H2); split; auto.
generalize H1; case eq0_spec; try (intros; discriminate);
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
  intros; subst; rewrite scalE0r, eq0I; auto.
Qed.

Hint Resolve scal_hom.

(* Get homogeneity part *)
Fixpoint get_hom (n m : nat) {struct n} : vect n -> vect n :=
  match n return (vect n -> vect n) with
  | 0%nat => fun a => match m with O => a | S _ => 0 end
  | S n1 =>
      fun l1 =>
       let (l2, l3) := l1 in
       ((match m with O => [0] 
                 | S m1 => get_hom n1 m1 l2
         end), get_hom n1 m l3)
  end.

Lemma get_hom0 n m : get_hom n m [0] = [0].
Proof.
generalize m; clear m; induction n as [|n IH]; 
(* Goal: and (b2Prop (fortho n v0 (conj n (negb b) v1))) (b2Prop (fortho n v0 (conj n b v2))) *)
  intros [|m]; simpl; auto; rewrite !IH; auto.
Qed.

Lemma get_homk0 n k: get_hom n 0 [k] = [k].
Proof.
(* Goal: and (b2Prop (fortho n v0 (conj n (negb b) v1))) (b2Prop (fortho n v0 (conj n b v2))) *)
induction n as [|n IH];  simpl; auto; rewrite !IH; auto.
Qed.

Lemma get_homkS n m k: get_hom n m.+1 [k] = [0].
Proof.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
induction n as [|n IH];  simpl; auto; rewrite !IH, ?get_hom0; auto.
Qed.

Lemma get_hom_ei n m i :  i < n ->
  get_hom n m 'e_i = match m with 1 => 'e_i | _ => [0] end.
Proof.
(* Goal: forall _ : lt i n, @Logic.eq (vect n) (get_hom n m (gen n i)) match m with | O => genk n (v0 (K1 p)) | S (O as n0) => gen n i | S (S n1 as n0) => genk n (v0 (K1 p)) end *)
generalize m i; clear m i; induction n as [|n IH].
(* Goal: forall (m i : nat) (_ : lt i O), @Logic.eq (vect O) (get_hom O m (gen O i)) match m with | O => genk O (v0 (K1 p)) | S (O as n) => gen O i | S (S n0 as n) => genk O (v0 (K1 p)) end *)
(* Goal: forall (m i : nat) (_ : lt i (S n)), @Logic.eq (vect (S n)) (get_hom (S n) m (gen (S n) i)) match m with | O => genk (S n) (v0 (K1 p)) | S (O as n0) => gen (S n) i | S (S n1 as n0) => genk (S n) (v0 (K1 p)) end *)
intros m i HH; contradict HH; auto with arith.
(* Goal: forall (m i : nat) (_ : lt i (S n)), @Logic.eq (vect (S n)) (get_hom (S n) m (gen (S n) i)) match m with | O => genk (S n) (v0 (K1 p)) | S (O as n0) => gen (S n) i | S (S n1 as n0) => genk (S n) (v0 (K1 p)) end *)
intros [|[|m]] [|i] H; simpl; rewrite ?get_hom0; auto.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (conj n (negb b) (E0 (vn_eparams n))) (conj n b (gen n i))) (if b then @pair (vect n) (vect n) (E0 (vn_eparams n)) (gen n i) else @pair (vect n) (vect n) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (E0 (vn_eparams n))) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (gen n i))) *)
rewrite IH; auto with arith.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (get_hom n O (genk n (v1 (K1 p)))) (genk n (v0 (K1 p)))) (@pair (vect n) (vect n) (genk n (v1 (K1 p))) (genk n (v0 (K1 p)))) *)
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (genk n (v0 (K1 p))) (get_hom n (S O) (gen n i))) (@pair (vect n) (vect n) (genk n (v0 (K1 p))) (gen n i)) *)
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (get_hom n (S m) (genk n (v1 (K1 p)))) (genk n (v0 (K1 p)))) (@pair (vect n) (vect n) (genk n (v0 (K1 p))) (genk n (v0 (K1 p)))) *)
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (genk n (v0 (K1 p))) (get_hom n (S (S m)) (gen n i))) (@pair (vect n) (vect n) (genk n (v0 (K1 p))) (genk n (v0 (K1 p)))) *)
rewrite get_homk0; auto.
(* Goal: @Logic.eq (list (prod (vect n) (vect n))) (@app (prod (vect n) (vect n)) (@map (vect n) (prod (vect n) (vect n)) (dlift n) (base n k)) (@map (vect n) (prod (vect n) (vect n)) (lift n) (base n (S k)))) (@nil (prod (vect n) (vect n))) *)
rewrite !IH; auto with arith.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (get_hom n (S m) (genk n (v1 (K1 p)))) (genk n (v0 (K1 p)))) (@pair (vect n) (vect n) (genk n (v0 (K1 p))) (genk n (v0 (K1 p)))) *)
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (genk n (v0 (K1 p))) (get_hom n (S (S m)) (gen n i))) (@pair (vect n) (vect n) (genk n (v0 (K1 p))) (genk n (v0 (K1 p)))) *)
rewrite get_homkS; auto.
(* Goal: @Logic.eq (list (prod (vect n) (vect n))) (@app (prod (vect n) (vect n)) (@map (vect n) (prod (vect n) (vect n)) (dlift n) (base n k)) (@map (vect n) (prod (vect n) (vect n)) (lift n) (base n (S k)))) (@nil (prod (vect n) (vect n))) *)
rewrite !IH; auto with arith.
Qed.

Lemma get_hom_scal n m k x : 
  get_hom n m (k .* x) = k .* get_hom n m x.
Proof.
generalize m x; clear m x; induction n as [|n IH]; 
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (addE (vn_eparams n) (join n (genk n k) (dual n (genk n h))) (join n (conj n false (k2g n x)) (dual n (conj n false (k2g n y))))) (join n (k2g n x) (dual n (genk n h)))) (@pair (vect n) (vect n) (scalE (vn_eparams n) (addK (K p) (multK (K p) k h) (pscal p n x y)) (all n)) (scalE (vn_eparams n) (addK (K p) (multK (K p) k h) (pscal p n x y)) (E0 (vn_eparams n)))) *)
  intros [|m]; simpl; Krm0; intros [x y]; Vfold n; rewrite ?IH; Vrm0.
Qed.

Lemma get_hom_add n m x y : 
  get_hom n m (x + y) = get_hom n m x + get_hom n m y.
Proof.
generalize m x y; clear m x y; induction n as [|n IH]; 
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (addE (vn_eparams n) (join n (genk n k) (dual n (genk n h))) (join n (conj n false (k2g n x)) (dual n (conj n false (k2g n y))))) (join n (k2g n x) (dual n (genk n h)))) (@pair (vect n) (vect n) (scalE (vn_eparams n) (addK (K p) (multK (K p) k h) (pscal p n x y)) (all n)) (scalE (vn_eparams n) (addK (K p) (multK (K p) k h) (pscal p n x y)) (E0 (vn_eparams n)))) *)
  intros [|m]; simpl; Krm0; intros [x1 x2] [y1 y2]; Vfold n; rewrite ?IH; Vrm0.
Qed.

Lemma get_hom_up n m x : n < m -> get_hom n m x = [0].
Proof.
(* Goal: forall _ : lt n m, @Logic.eq (vect n) (get_hom n m x) (genk n (v0 (K1 p))) *)
generalize m; clear m; induction n as [| n IH]; intros m Hnm.
(* Goal: @Logic.eq (vect O) (get_hom O m x) (genk O (v0 (K1 p))) *)
(* Goal: @Logic.eq (vect (S n)) (get_hom (S n) m x) (genk (S n) (v0 (K1 p))) *)
destruct m; simpl; auto; contradict Hnm; auto with arith.
(* Goal: @Logic.eq (vect (S n)) (get_hom (S n) m x) (genk (S n) (v0 (K1 p))) *)
destruct m as [|m]; simpl; auto.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (let (_, l3) := x in @pair (vect n) (vect n) (genk n (v0 (K1 p))) (get_hom n O l3)) (@pair (vect n) (vect n) (genk n (v0 (K1 p))) (genk n (v0 (K1 p)))) *)
(* Goal: @Logic.eq (prod (vect n) (vect n)) (let (l2, l3) := x in @pair (vect n) (vect n) (get_hom n m l2) (get_hom n (S m) l3)) (@pair (vect n) (vect n) (genk n (v0 (K1 p))) (genk n (v0 (K1 p)))) *)
contradict Hnm; auto with arith.
(* Goal: @Logic.eq (list (prod (vect n) (vect n))) (@app (prod (vect n) (vect n)) (@map (vect n) (prod (vect n) (vect n)) (dlift n) (base n k)) (@map (vect n) (prod (vect n) (vect n)) (lift n) (base n (S k)))) (@nil (prod (vect n) (vect n))) *)
destruct x as [x1 x2]; rewrite !IH; auto with arith.
Qed.

Fixpoint sum (n : nat) (f: (nat -> vect n)) (m : nat) {struct m} :
    vect n :=
  match m with
  | 0%nat => f 0%nat
  | S m1 => f m + sum n f m1
  end.

Lemma sumEl n f m : 
  sum n f m.+1 = f 0%nat + sum n (fun m => f m.+1) m.
Proof.
(* Goal: @Logic.eq (vect n) (sum n f (S m)) (addE (vn_eparams n) (f O) (sum n (fun m : nat => f (S m)) m)) *)
induction m as [|m IH]; simpl; Vfold n.
(* Goal: @Logic.eq (vect n) (addE (vn_eparams n) (meet n v4 (dconj n false v1)) (meet n v3 v2)) (addE (vn_eparams n) (meet n v3 v2) (meet n v4 (dconj n false v1))) *)
rewrite addE_com; auto.
(* Goal: @Logic.eq (vect n) (addE (vn_eparams n) (f (S (S m))) (addE (vn_eparams n) (f (S m)) (sum n f m))) (addE (vn_eparams n) (f O) (addE (vn_eparams n) (f (S (S m))) (sum n (fun m : nat => f (S m)) m))) *)
rewrite addE_swap with (x1 := f 0%nat); auto.
(* Goal: @Logic.eq (vect n) (addE (vn_eparams n) (f (S (S m))) (addE (vn_eparams n) (f (S m)) (sum n f m))) (addE (vn_eparams n) (f (S (S m))) (addE (vn_eparams n) (f O) (sum n (fun m : nat => f (S m)) m))) *)
rewrite <-IH; simpl; auto.
Qed.

Lemma sumEr n f m : sum n f m.+1 = f m.+1 + sum n f m.
Proof. simpl; auto. Qed.

Lemma sum_ext (n : nat) (f1 f2: (nat -> vect n)) (m : nat) :
  sum n.+1 (fun m => (f1 m, f2 m)) m = (sum n f1 m, sum n f2 m).
Proof.
(* Goal: @Logic.eq (vect n) (mcontra n (@cons (kn p n) a l) x) (mcontra n l (contra n a x)) *)
induction m as [|m IH]; simpl; auto.
(* Goal: @Logic.eq (vect n) (meet n (meet n v v1) v3) (meet n v (meet n v1 v3)) *)
(* Goal: @Logic.eq (vect n) (addE (vn_eparams n) (meet n (meet n v v1) v4) (meet n (addE (vn_eparams n) (meet n v v2) (meet n v0 (dconj n false v1))) (dconj n false v3))) (addE (vn_eparams n) (meet n v (addE (vn_eparams n) (meet n v1 v4) (meet n v2 (dconj n false v3)))) (meet n v0 (dconj n false (meet n v1 v3)))) *)
rewrite IH; auto.
Qed.

Lemma get_hom_sum n (x : vect n) :
   x = sum n (fun m => get_hom n m x) n.
Proof.
(* Goal: @Logic.eq (vect n) (k2g n (E0 (Kn.vn_eparams p n))) (E0 (vn_eparams n)) *)
induction n as [|n IH]; simpl; auto.
(* Goal: @Logic.eq (prod (vect n) (vect n)) x (let (l3, l5) := let (l2, l3) := x in @pair (vect n) (vect n) (get_hom n n l2) (get_hom n (S n) l3) in let (l4, l6) := sum (S n) (fun m : nat => let (l2, l4) := x in @pair (vect n) (vect n) match m with | O => genk n (v0 (K1 p)) | S m1 => get_hom n m1 l2 end (get_hom n m l4)) n in @pair (vect n) (vect n) (add n l3 l4) (add n l5 l6)) *)
destruct x as [x y]; simpl.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) x y) (let (l4, l6) := sum (S n) (fun m : nat => @pair (vect n) (vect n) match m with | O => genk n (v0 (K1 p)) | S m1 => get_hom n m1 x end (get_hom n m y)) n in @pair (vect n) (vect n) (add n (get_hom n n x) l4) (add n (get_hom n (S n) y) l6)) *)
rewrite sum_ext.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) x y) (@pair (vect n) (vect n) (add n (get_hom n n x) (sum n (fun m : nat => match m with | O => genk n (v0 (K1 p)) | S m1 => get_hom n m1 x end) n)) (add n (get_hom n (S n) y) (sum n (fun m : nat => get_hom n m y) n))) *)
rewrite <-(IH y).
change (get_hom n n x) with
       ((fun m : nat => match m with
                      | 0 => [0]
                      | m1.+1 => get_hom n m1 x
                      end) n.+1).
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) x y) (@pair (vect n) (vect n) (add n ((fun m : nat => match m with | O => genk n (v0 (K1 p)) | S m1 => get_hom n m1 x end) (S n)) (sum n (fun m : nat => match m with | O => genk n (v0 (K1 p)) | S m1 => get_hom n m1 x end) n)) (add n (get_hom n (S n) y) y)) *)
Vfold n; rewrite <-sumEr, sumEl; Vrm0.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) x y) (@pair (vect n) (vect n) (sum n (fun m : nat => get_hom n m x) n) (addE (vn_eparams n) (get_hom n (S n) y) y)) *)
rewrite <-IH, get_hom_up; Vrm0.
Qed.

Lemma hom_get_hom n (x : vect n) m : hom n m (get_hom n m x).
Proof.
(* Goal: @Logic.eq (vect n) (k2g n (E0 (Kn.vn_eparams p n))) (E0 (vn_eparams n)) *)
generalize m; induction n as [|n IH]; simpl; auto.
(* Goal: forall _ : or (not (b2Prop true)) (@ex (vect n) (fun i : vect n => and (@In (vect n) i l) (not (b2Prop (hom n (S O) i))))), @ex (vect n) (fun i : vect n => and (@In (vect n) i l) (not (b2Prop (hom n (S O) i)))) *)
intros []; auto.
(* Goal: forall _ : b2Prop (eqK (K1 p) M (v0 (K1 p))), b2Prop (eqK (K1 p) (v0 (K1 p)) (v0 (K1 p))) *)
(* Goal: forall _ : b2Prop (let (l2, l3) := M in andb (hom n O l2) (hom n (S O) l3)), b2Prop (let (l2, l3) := let (k, lf1) := lf in let (l2, l3) := M in @pair (vect n) (vect n) (scal n (oppK (K1 p) (v1 (K1 p))) (contra n lf1 l2)) (add n (scal n k l2) (contra n lf1 l3)) in andb (eq0 n l2) (hom n O l3)) *)
(* Goal: forall _ : b2Prop (let (l2, l3) := M in andb (hom n (S k1) l2) (hom n (S (S k1)) l3)), b2Prop (let (l2, l3) := let (k, lf1) := lf in let (l2, l3) := M in @pair (vect n) (vect n) (scal n (oppK (K1 p) (v1 (K1 p))) (contra n lf1 l2)) (add n (scal n k l2) (contra n lf1 l3)) in andb (hom n k1 l2) (hom n (S k1) l3)) *)
rewrite eqKI; auto.
(* Goal: forall m : nat, b2Prop (let (l2, l3) := let (l2, l3) := x in @pair (vect n) (vect n) match m with | O => genk n (v0 (K1 p)) | S m1 => get_hom n m1 l2 end (get_hom n m l3) in andb match m with | O => eq0 n l2 | S k1 => hom n k1 l2 end (hom n m l3)) *)
intros [|m1]; destruct x as [x1 x2].
(* Goal: b2Prop (andb (eq0 n (genk n (v0 (K1 p)))) (hom n O (get_hom n O x2))) *)
(* Goal: b2Prop (andb (hom n m1 (get_hom n m1 x1)) (hom n (S m1) (get_hom n (S m1) x2))) *)
rewrite eq0I, IH; auto.
(* Goal: and (b2Prop (fortho n v0 (conj n (negb b) v1))) (b2Prop (fortho n v0 (conj n b v2))) *)
rewrite !IH; auto.
Qed.

(* First degre that is used to guess if a vector is homegene *)
Fixpoint first_deg (n : nat) {struct n} : vect n -> nat :=
  match n return (vect n -> nat) with
  | 0%nat => fun a => 0%nat
  | S n1 =>
      fun l1 =>
      let (l2, l3) := l1 in
      if l2 ?= 0 then first_deg n1 l3 else S (first_deg n1 l2)
  end.

Lemma first_deg0 n : first_deg n 0 = 0%nat.
Proof.
(* Goal: @Logic.eq (vect n) (k2g n (E0 (Kn.vn_eparams p n))) (E0 (vn_eparams n)) *)
induction n as [| n IH]; simpl; auto.
(* Goal: b2Prop (eq0 n (E0 (vn_eparams n))) *)
(* Goal: forall (_ : not (@Logic.eq (vect n) v0 (E0 (vn_eparams n)))) (_ : b2Prop (andb (fortho n v0 v1) (fortho n v0 v2))) (_ : b2Prop (andb (fortho n v0 v3) (fortho n v0 v4))), b2Prop (andb (fortho n v0 (addE (vn_eparams n) (join n v1 v4) (join n (conj n false v2) v3))) (fortho n v0 (join n v2 v4))) *)
rewrite eq0I; auto.
Qed.

Lemma first_deg0i n v : first_deg n v = 0%nat -> hom n 0 v.
Proof.
(* Goal: @Logic.eq (vect n) (k2g n (E0 (Kn.vn_eparams p n))) (E0 (vn_eparams n)) *)
induction n as [| n IH]; simpl; auto.
(* Goal: forall _ : @Logic.eq nat (let (l2, l3) := v in if eq0 n l2 then first_deg n l3 else S (first_deg n l2)) O, b2Prop (let (l2, l3) := v in andb (eq0 n l2) (hom n O l3)) *)
destruct v.
(* Goal: @Logic.eq (vect n) (mcontra n (@cons (kn p n) a l) x) (mcontra n l (contra n a x)) *)
case eq0_spec; intros H1 H2; simpl; auto.
(* Goal: b2Prop false *)
discriminate.
Qed.

Lemma hom_first_deg n k x : x <> 0 -> hom n k x -> first_deg n x = k.
Proof.
(* Goal: forall _ : @In (vect n) v (base n k), or (@Logic.eq (vect n) (join n v (dual n v)) (all n)) (@Logic.eq (vect n) (join n v (dual n v)) (scalE (vn_eparams n) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (all n))) *)
generalize k; clear k.
(* Goal: @Logic.eq (vect n) (mcontra n (@cons (kn p n) a l) x) (mcontra n l (contra n a x)) *)
induction n as [| n IH]; intros [|k]; simpl; auto.
(* Goal: forall (_ : not (@Logic.eq (Field.K (K1 p)) x1 (v0 (K1 p)))) (_ : b2Prop (eqK (K1 p) x1 (v0 (K1 p)))) (_ : b2Prop (eqK (K1 p) x2 (v0 (K1 p)))), b2Prop false *)
(* Goal: forall (_ : not (@Logic.eq (prod (vect n) (vect n)) x1 (@pair (vect n) (vect n) (E0 (vn_eparams n)) (E0 (vn_eparams n))))) (_ : b2Prop (let (l2, l3) := x1 in andb (hom n O l2) (hom n (S O) l3))) (_ : b2Prop (let (l2, l3) := x2 in andb (hom n O l2) (hom n (S O) l3))), b2Prop (let (_, x12) := x1 in let (x21, x22) := let (l3, l5) := x2 in let (l4, l6) := let (l2, l4) := x1 in @pair (vect n) (vect n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (let (x13, x14) := x1 in let (x21, x22) := x2 in if eq0 n x14 then multK (K1 p) (invK (K1 p) (const n x13)) (const n x21) else fget n x14 x22)) l2) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (let (x13, x14) := x1 in let (x21, x22) := x2 in if eq0 n x14 then multK (K1 p) (invK (K1 p) (const n x13)) (const n x21) else fget n x14 x22)) l4) in @pair (vect n) (vect n) (addE (vn_eparams n) l3 l4) (addE (vn_eparams n) l5 l6) in if eq0 n x12 then eq0 n x21 else andb (fortho n x12 x21) (fortho n x12 x22)) *)
case eqK_spec; auto; try (intros; discriminate).
(* Goal: forall (_ : @Logic.eq (Field.K (K1 p)) x1 (v0 (K1 p))) (_ : not (@Logic.eq (Field.K (K1 p)) x1 (v0 (K1 p)))) (_ : @Logic.eq (Field.K (K1 p)) (multK (K1 p) x1 x2) (v0 (K1 p))) (_ : b2Prop true) (_ : b2Prop (eqK (K1 p) x2 (v0 (K1 p)))), b2Prop match k with | O => true | S n => eqK (K1 p) (multK (K1 p) x2 (invK (K1 p) x1)) (v0 (K1 p)) end *)
(* Goal: forall (_ : not (@Logic.eq (prod (vect n) (vect n)) x1 (@pair (vect n) (vect n) (E0 (vn_eparams n)) (E0 (vn_eparams n))))) (_ : @Logic.eq (prod (vect n) (vect n)) (let (x1, x3) := x1 in let (y1, y2) := x2 in @pair (vect n) (vect n) (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x3) y1)) (join n x3 y2)) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (E0 (vn_eparams n)))) (_ : b2Prop (let (l2, l3) := x1 in andb (hom n O l2) (hom n (S O) l3))) (_ : b2Prop (let (l2, l3) := x2 in andb (hom n k l2) (hom n (S k) l3))), b2Prop (let (l2, l3) := let (x11, x12) := x1 in let (x21, x22) := x2 in if eq0 n x12 then @pair (vect n) (vect n) (E0 (vn_eparams n)) (scalE (vn_eparams n) (invK (K1 p) (const n x11)) x21) else @pair (vect n) (vect n) (factor n x12 (addE (vn_eparams n) (scalE (vn_eparams n) (const n x11) (factor n x12 x22)) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) x21))) (factor n x12 x22) in andb match k with | O => eq0 n l2 | S k1 => hom n k1 l2 end (hom n k l3)) *)
intros H1 H2; case H2; auto.
(* Goal: forall (_ : not (@Logic.eq (prod (vect n) (vect n)) x (@pair (vect n) (vect n) (genk n (v0 (K1 p))) (genk n (v0 (K1 p)))))) (_ : b2Prop (let (l2, l3) := x in andb (eq0 n l2) (hom n O l3))), @Logic.eq nat (let (l2, l3) := x in if eq0 n l2 then first_deg n l3 else S (first_deg n l2)) O *)
(* Goal: forall (_ : not (@Logic.eq (prod (vect n) (vect n)) x (@pair (vect n) (vect n) (genk n (v0 (K1 p))) (genk n (v0 (K1 p)))))) (_ : b2Prop (let (l2, l3) := x in andb (hom n k l2) (hom n (S k) l3))), @Logic.eq nat (let (l2, l3) := x in if eq0 n l2 then first_deg n l3 else S (first_deg n l2)) (S k) *)
destruct x; case eq0_spec; intros Hx Hy; subst; try (discriminate).
(* Goal: forall _ : b2Prop (andb true (hom n O v0)), @Logic.eq nat (first_deg n v0) O *)
(* Goal: forall (_ : not (@Logic.eq (prod (vect n) (vect n)) x (@pair (vect n) (vect n) (genk n (v0 (K1 p))) (genk n (v0 (K1 p)))))) (_ : b2Prop (let (l2, l3) := x in andb (hom n k l2) (hom n (S k) l3))), @Logic.eq nat (let (l2, l3) := x in if eq0 n l2 then first_deg n l3 else S (first_deg n l2)) (S k) *)
rewrite andbP; intros (_, H1); apply IH; auto.
(* Goal: not (@Logic.eq (E (vn_eparams n)) v0 (E0 (vn_eparams n))) *)
(* Goal: forall (_ : not (@Logic.eq (prod (vect n) (vect n)) x (@pair (vect n) (vect n) (genk n (v0 (K1 p))) (genk n (v0 (K1 p)))))) (_ : b2Prop (let (l2, l3) := x in andb (hom n k l2) (hom n (S k) l3))), @Logic.eq nat (let (l2, l3) := x in if eq0 n l2 then first_deg n l3 else S (first_deg n l2)) (S k) *)
intros H2; case Hy; subst; auto.
(* Goal: forall (_ : not (@Logic.eq (prod (vect n) (vect n)) x (@pair (vect n) (vect n) (genk n (v0 (K1 p))) (genk n (v0 (K1 p)))))) (_ : b2Prop (let (l2, l3) := x in andb (hom n k l2) (hom n (S k) l3))), @Logic.eq nat (let (l2, l3) := x in if eq0 n l2 then first_deg n l3 else S (first_deg n l2)) (S k) *)
try (rewrite andbP; intros (H1,_); discriminate).
(* Goal: forall (_ : not (@Logic.eq (prod (vect n) (vect n)) x (@pair (vect n) (vect n) (genk n (v0 (K1 p))) (genk n (v0 (K1 p)))))) (_ : b2Prop (let (l2, l3) := x in andb (hom n k l2) (hom n (S k) l3))), @Logic.eq nat (let (l2, l3) := x in if eq0 n l2 then first_deg n l3 else S (first_deg n l2)) (S k) *)
destruct x; rewrite andbP; case eq0_spec; intros Hx Hy (H1,H2).
(* Goal: @Logic.eq nat (first_deg n v0) (S k) *)
(* Goal: @Logic.eq nat (S (first_deg n v)) (S k) *)
apply IH; auto; intros H3; case Hy; subst; auto.
(* Goal: @Logic.eq nat (S (first_deg n v)) (S k) *)
rewrite (IH _ k); auto.
Qed.

(* Lift a vector of dimension n into a vector of dimension n+1 whose
   first component is 0 *)
Definition lift (n: nat) (v: vect n) : (vect n.+1) :=  ((0: vect n), v).

Notation " x ^'l " := (lift _ x) (at level 9, format "x ^'l"): g_scope.

(* Lift of generator of the base *)
Lemma gen_lift n i : 'e_i.+1 = 'e_i^'l :> vect n.+1.
Proof. auto. Qed.

(* Lift on constant *)
Lemma lift_k n k : [k] = [k]^'l :> vect n.+1.
Proof. auto. Qed.

(* Lift on add *)
Lemma lift_add n x y : (x + y)^'l = x^'l + y^'l :> vect n.+1.
Proof. unfold lift; simpl; Vfold n; rewrite addE0l; auto. Qed.

(* Lift on scalar multiplication *)
Lemma lift_scal n (k: K) x :  (k .* x)^'l = k .* x^'l :> vect n.+1.
Proof. unfold lift; simpl; Vfold n; rewrite scalE0r; auto. Qed.

(* Lift on the multiple product *)
Lemma lift_mprod (n: nat) (ks: list K) vs : ks *X* map (lift n) vs = 
  (ks *X* vs)^'l.
Proof.
(* Goal: @Logic.eq (E (vn_eparams (S n))) (mprod (vn_eparams (S n)) ks (@map (vect n) (vect (S n)) (dlift n) vs)) (dlift n (mprod (vn_eparams n) ks vs)) *)
generalize vs; clear vs.
(* Goal: forall vs : list (vect n), @Logic.eq (E (vn_eparams (S n))) (mprod (vn_eparams (S n)) ks (@map (vect n) (vect (S n)) (dlift n) vs)) (dlift n (mprod (vn_eparams n) ks vs)) *)
induction ks as [| k ks IH].
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
  intros vs; rewrite !mprod0l; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros [| v vs]; simpl; try rewrite mprod0r; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite (mprod_S (vn_eparams n.+1)); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite mprod_S; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite IH, lift_add, lift_scal; auto.
Qed.

Lemma lift_cbl n l (x: vect n) :
  cbl _ l x -> cbl _ (map (lift n) l) x^'l.
Proof.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros H; elim H; clear x H; auto.
(* Goal: cbl (vn_eparams (S n)) (@map (vect n) (vect (S n)) (lift n) l) (lift n (E0 (vn_eparams n))) *)
(* Goal: forall (v : E (vn_eparams n)) (_ : @In (E (vn_eparams n)) v l), cbl (vn_eparams (S n)) (@map (vect n) (vect (S n)) (lift n) l) (lift n v) *)
(* Goal: forall (x y : E (vn_eparams n)) (_ : cbl (vn_eparams n) l x) (_ : cbl (vn_eparams (S n)) (@map (vect n) (vect (S n)) (lift n) l) (lift n x)) (_ : cbl (vn_eparams n) l y) (_ : cbl (vn_eparams (S n)) (@map (vect n) (vect (S n)) (lift n) l) (lift n y)), cbl (vn_eparams (S n)) (@map (vect n) (vect (S n)) (lift n) l) (lift n (addE (vn_eparams n) x y)) *)
(* Goal: forall (k : Field.K (stype (vn_eparams n))) (x : E (vn_eparams n)) (_ : cbl (vn_eparams n) l x) (_ : cbl (vn_eparams (S n)) (@map (vect n) (vect (S n)) (lift n) l) (lift n x)), cbl (vn_eparams (S n)) (@map (vect n) (vect (S n)) (lift n) l) (lift n (scalE (vn_eparams n) k x)) *)
apply cbl0.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros v Hv; apply cbl_in; apply in_map; auto.
(* Goal: forall (x y : E (vn_eparams n)) (_ : cbl (vn_eparams n) l x) (_ : cbl (vn_eparams (S n)) (@map (vect n) (vect (S n)) (lift n) l) (lift n x)) (_ : cbl (vn_eparams n) l y) (_ : cbl (vn_eparams (S n)) (@map (vect n) (vect (S n)) (lift n) l) (lift n y)), cbl (vn_eparams (S n)) (@map (vect n) (vect (S n)) (lift n) l) (lift n (addE (vn_eparams n) x y)) *)
(* Goal: forall (k : Field.K (stype (vn_eparams n))) (x : E (vn_eparams n)) (_ : cbl (vn_eparams n) l x) (_ : cbl (vn_eparams (S n)) (@map (vect n) (vect (S n)) (lift n) l) (lift n x)), cbl (vn_eparams (S n)) (@map (vect n) (vect (S n)) (lift n) l) (lift n (scalE (vn_eparams n) k x)) *)
intros x y H1x H2x H1y H2y.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite lift_add; apply cbl_add; auto.
(* Goal: forall (k : Field.K (stype (vn_eparams n))) (x : E (vn_eparams n)) (_ : cbl (vn_eparams n) l x) (_ : cbl (vn_eparams (S n)) (@map (vect n) (vect (S n)) (lift n) l) (lift n x)), cbl (vn_eparams (S n)) (@map (vect n) (vect (S n)) (lift n) l) (lift n (scalE (vn_eparams n) k x)) *)
intros k x H1x H2x.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite lift_scal; apply cbl_scal; auto.
Qed.

Lemma lift_inj n (x1 x2: vect n) : x1^'l = x2^'l -> x1 = x2.
Proof.
(* Goal: forall _ : @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (genk n (v0 (K1 p))) (genk n k1)) (@pair (vect n) (vect n) (genk n (v0 (K1 p))) (genk n k2)), @Logic.eq (Field.K (K1 p)) k1 k2 *)
destruct n as [| n]; simpl; intros HH; injection HH; auto.
Qed.

(* Dual lift*)
Definition dlift (n: nat) (v: vect n) : (vect n.+1) := (v,(0: vect n)).

Notation "x ^'dl" := (dlift _ x) (at level 9, format "x ^'dl" ): g_scope.

Lemma dlift_add n x y : (x + y)^'dl = x^'dl + y^'dl :> vect n.+1.
Proof. unfold dlift; simpl; Vfold n; rewrite addE0l; auto. Qed.

Lemma dlift_scal n (k: K) x : (k .* x)^'dl = k .* x^'dl :> vect n.+1.
Proof. unfold dlift; simpl; Vfold n; rewrite scalE0r; auto. Qed.

Lemma dlift_mprod (n: nat) (ks: list K) vs :
   ks *X* map (dlift n) vs = (ks *X* vs)^'dl.
Proof.
(* Goal: @Logic.eq (E (vn_eparams (S n))) (mprod (vn_eparams (S n)) ks (@map (vect n) (vect (S n)) (dlift n) vs)) (dlift n (mprod (vn_eparams n) ks vs)) *)
generalize vs; clear vs.
(* Goal: forall vs : list (vect n), @Logic.eq (E (vn_eparams (S n))) (mprod (vn_eparams (S n)) ks (@map (vect n) (vect (S n)) (dlift n) vs)) (dlift n (mprod (vn_eparams n) ks vs)) *)
induction ks as [| k ks IH].
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
  intros vs; rewrite !mprod0l; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros [| v vs]; simpl; try rewrite mprod0r; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite (mprod_S (vn_eparams n.+1)); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite mprod_S; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite  IH, dlift_add, dlift_scal; auto.
Qed.

(* Coordinates for k vector *)
Fixpoint proj (n: nat) k: (vect n) -> (list K) :=
  match n return vect n -> list  K with 
  | O => fun a  =>
          match k with | O => a::nil | _ => nil end
  | S n1 => fun l => let (l1,l2) := l in 
          match k with | O => proj n1 k l2 | S k1 => 
           (proj n1 k1 l1 ++ proj n1 k l2)%list
          end
  end.

Lemma proj0 n x : proj n 0 x = 'C[x]:: nil.
Proof.
(* Goal: @Logic.eq (vect n) (k2g n (E0 (Kn.vn_eparams p n))) (E0 (vn_eparams n)) *)
induction n as [| n IH]; simpl; auto.
(* Goal: @Logic.eq (list (Field.K (K1 p))) (let (_, l2) := x in proj n O l2) (@cons (Field.K (K1 p)) (let (_, l2) := x in const n l2) (@nil (Field.K (K1 p)))) *)
destruct x; rewrite IH; auto.
Qed.

Lemma proj_hom0_eq n x y : 
  hom n 0 x -> hom n 0 y ->
  nth 0 (proj n 0 x) 0%f = nth 0 (proj n 0 y) 0%f ->  x = y.
Proof.
(* Goal: @Logic.eq (vect n) (k2g n (E0 (Kn.vn_eparams p n))) (E0 (vn_eparams n)) *)
induction n as [| n IH]; simpl; auto.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (let (x1, y1) := x in let (x2, y2) := let (l2, l3) := y in @pair (vect n) (vect n) (scalE (vn_eparams n) k l2) (scalE (vn_eparams n) k l3) in @pair (vect n) (vect n) (meet n x1 x2) (addE (vn_eparams n) (meet n x1 y2) (meet n y1 (dconj n false x2)))) (let (l2, l3) := let (x1, y1) := x in let (x2, y2) := y in @pair (vect n) (vect n) (meet n x1 x2) (addE (vn_eparams n) (meet n x1 y2) (meet n y1 (dconj n false x2))) in @pair (vect n) (vect n) (scalE (vn_eparams n) k l2) (scalE (vn_eparams n) k l3)) *)
destruct x; destruct y.
(* Goal: forall (_ : b2Prop (andb (eq0 n v) (hom n O v0))) (_ : b2Prop (andb (eq0 n v1) (hom n O v2))) (_ : @Logic.eq (Field.K (K1 p)) (@nth (Field.K (K1 p)) O (proj n O v0) (Field.v0 (K1 p))) (@nth (Field.K (K1 p)) O (proj n O v2) (Field.v0 (K1 p)))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) v v0) (@pair (vect n) (vect n) v1 v2) *)
do 2 (case eq0_spec; try (intros; discriminate)).
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros; subst; apply f_equal2 with (f := @pair _ _); auto.
Qed.

Lemma proj_lt n m x : n < m -> proj n m x = nil.
Proof.
(* Goal: forall _ : lt n m, @Logic.eq (list (Field.K (K1 p))) (proj n m x) (@nil (Field.K (K1 p))) *)
generalize m; clear m.
(* Goal: @Logic.eq (vect n) (k2g n (E0 (Kn.vn_eparams p n))) (E0 (vn_eparams n)) *)
induction n as [| n IH]; simpl; auto.
(* Goal: forall (m : nat) (_ : lt O m), @Logic.eq (list (Field.K (K1 p))) match m with | O => @cons (Field.K (K1 p)) x (@nil (Field.K (K1 p))) | S n => @nil (Field.K (K1 p)) end (@nil (Field.K (K1 p))) *)
(* Goal: forall (m : nat) (_ : lt (S n) m), @Logic.eq (list (Field.K (K1 p))) (let (l1, l2) := x in match m with | O => proj n m l2 | S k1 => @app (Field.K (K1 p)) (proj n k1 l1) (proj n m l2) end) (@nil (Field.K (K1 p))) *)
intros [] H; auto; contradict H; auto with arith.
(* Goal: @Logic.eq (list (prod (vect n) (vect n))) (@app (prod (vect n) (vect n)) (@map (vect n) (prod (vect n) (vect n)) (dlift n) (base n k)) (@map (vect n) (prod (vect n) (vect n)) (lift n) (base n (S k)))) (@nil (prod (vect n) (vect n))) *)
intros [| m] H; destruct x; rewrite !IH; auto with arith.
Qed.

Lemma proj_homn_eq n x y : 
  hom n n x -> hom n n y ->
  nth 0 (proj n n x) 0%f = nth 0 (proj n n y) 0%f ->  x = y.
Proof.
(* Goal: @Logic.eq (vect n) (k2g n (E0 (Kn.vn_eparams p n))) (E0 (vn_eparams n)) *)
induction n as [| n IH]; simpl; auto.
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n k2 x1) (hom n (S k2) x2))), or (@Logic.eq nat (S k1) (S k2)) (@Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) x1 x2) (@pair (vect n) (vect n) (genk n (v0 (K1 p))) (genk n (v0 (K1 p))))) *)
destruct x; destruct y; rewrite !andbP; intros (H1,H2) (H3,H4).
(* Goal: forall _ : @Logic.eq (Field.K (K1 p)) (@nth (Field.K (K1 p)) O (@app (Field.K (K1 p)) (proj n n v) (proj n (S n) v0)) (Field.v0 (K1 p))) (@nth (Field.K (K1 p)) O (@app (Field.K (K1 p)) (proj n n v1) (proj n (S n) v2)) (Field.v0 (K1 p))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) v v0) (@pair (vect n) (vect n) v1 v2) *)
rewrite hom_lt with (2:= H2); auto with arith.
(* Goal: forall _ : @Logic.eq (Field.K (K1 p)) (@nth (Field.K (K1 p)) O (@app (Field.K (K1 p)) (proj n n v) (proj n (S n) (E0 (vn_eparams n)))) (Field.v0 (K1 p))) (@nth (Field.K (K1 p)) O (@app (Field.K (K1 p)) (proj n n v1) (proj n (S n) v2)) (Field.v0 (K1 p))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) v (E0 (vn_eparams n))) (@pair (vect n) (vect n) v1 v2) *)
rewrite hom_lt with (2:= H4); auto with arith.
(* Goal: forall _ : @Logic.eq (Field.K (K1 p)) (@nth (Field.K (K1 p)) O (@app (Field.K (K1 p)) (proj n n v) (proj n (S n) (E0 (vn_eparams n)))) (Field.v0 (K1 p))) (@nth (Field.K (K1 p)) O (@app (Field.K (K1 p)) (proj n n v1) (proj n (S n) (E0 (vn_eparams n)))) (Field.v0 (K1 p))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) v (E0 (vn_eparams n))) (@pair (vect n) (vect n) v1 (E0 (vn_eparams n))) *)
rewrite !(proj_lt n n.+1), <-!app_nil_end; auto with arith.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros H; rewrite (IH _ _ H1 H3); auto.
Qed.

Fixpoint all (n: nat): vect n :=
  match n return vect n with
  | 0 => 1
  | S n1 => (all n1, 0: vect n1)
  end.

Notation "'E'" := (all _).
 
Lemma all_hom n : hom n n E.
Proof.
(* Goal: @Logic.eq (vect n) (k2g n (E0 (Kn.vn_eparams p n))) (E0 (vn_eparams n)) *)
induction n as [| n IH]; simpl; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite IH, homk0; auto.
Qed.

Hint Resolve all_hom.


(* Base of k vector *)
Fixpoint base (n: nat) k:list (vect n) :=
  match n return list (vect n) with 
  | O =>  match k with | O => 1%f::nil | _ => nil end
  | S n1 => 
          match k with | O => 
                     map (lift n1) (base n1 k) | S k1 => 
           (map (dlift n1) (base n1 k1) ++ 
            map (lift n1) (base n1 k))%list
          end
  end.

Lemma proj_base_length n (x: vect n) k : 
  length (proj n k x) = length (base n k).
Proof.
(* Goal: forall _ : @In (vect n) v (base n k), or (@Logic.eq (vect n) (join n v (dual n v)) (all n)) (@Logic.eq (vect n) (join n v (dual n v)) (scalE (vn_eparams n) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (all n))) *)
generalize k; clear k.
(* Goal: forall (b : bool) (k : nat) (_ : b2Prop (hom n k x)), b2Prop (hom n k (dconj n b x)) *)
induction n as [| n IH]; simpl.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros [| k]; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros [| k]; destruct x; rewrite ?map_length; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite !app_length, !map_length, !IH; auto.
Qed.

Lemma base0 n : base n 0 = 'e_n::nil.
Proof.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
induction n as [| n IH]; simpl; rewrite ?IH; auto.
Qed.

Lemma base_lt_nil m n : m < n -> base m n = nil.
Proof.
(* Goal: forall _ : lt m n, @Logic.eq (list (vect m)) (base m n) (@nil (vect m)) *)
generalize n; clear n.
induction m as [| m IH]; intros [| n]; simpl; auto;
  try (intros HH; contradict HH; auto with arith; fail).
(* Goal: @Logic.eq (list (prod (vect n) (vect n))) (@app (prod (vect n) (vect n)) (@map (vect n) (prod (vect n) (vect n)) (dlift n) (base n k)) (@map (vect n) (prod (vect n) (vect n)) (lift n) (base n (S k)))) (@nil (prod (vect n) (vect n))) *)
intros Hm; rewrite !IH; auto with arith.
Qed.

Lemma base_n n : base n n = all n::nil.
Proof.
(* Goal: @Logic.eq (vect n) (k2g n (E0 (Kn.vn_eparams p n))) (E0 (vn_eparams n)) *)
induction n as [| n IH]; simpl; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite IH, base_lt_nil; auto.
Qed.

Lemma base_length n k : length (base n k) = bin n k.
Proof.
(* Goal: forall _ : @In (vect n) v (base n k), or (@Logic.eq (vect n) (join n v (dual n v)) (all n)) (@Logic.eq (vect n) (join n v (dual n v)) (scalE (vn_eparams n) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (all n))) *)
generalize k; clear k.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
induction n as [| n IH]; simpl base; intros [| k]; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite base0; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite app_length, !map_length, !IH, bin_def, Plus.plus_comm; auto.
Qed.

Lemma base_lift n k :  incl (map (lift n) (base n k)) (base n.+1 k).
Proof.
(* Goal: forall _ : @In (vect n) v (base n k), or (@Logic.eq (vect n) (join n v (dual n v)) (all n)) (@Logic.eq (vect n) (join n v (dual n v)) (scalE (vn_eparams n) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (all n))) *)
generalize k; clear k.
(* Goal: forall k : nat, @incl (vect (S n)) (@map (vect n) (vect (S n)) (lift n) (base n k)) (base (S n) k) *)
induction n as [| n IH]; intros [| k]; simpl; auto with datatypes.
Qed.

Lemma base_hom n k v : k <= n -> In v (base n k) -> hom n k v.
Proof.
(* Goal: forall _ : @In (vect n) v (base n k), or (@Logic.eq (vect n) (join n v (dual n v)) (all n)) (@Logic.eq (vect n) (join n v (dual n v)) (scalE (vn_eparams n) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (all n))) *)
generalize k; clear k.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
induction n as [| n IH]; simpl; intros [| k]; auto.
(* Goal: forall (_ : le (S k) O) (_ : @In (Field.K (K1 p)) v (@nil (Field.K (K1 p)))), b2Prop (eqK (K1 p) v (v0 (K1 p))) *)
(* Goal: forall (_ : le O (S n)) (_ : @In (prod (vect n) (vect n)) v (@map (vect n) (prod (vect n) (vect n)) (lift n) (base n O))), b2Prop (let (l2, l3) := v in andb (eq0 n l2) (hom n O l3)) *)
(* Goal: forall (_ : le (S k) (S n)) (_ : @In (prod (vect n) (vect n)) v (@app (prod (vect n) (vect n)) (@map (vect n) (prod (vect n) (vect n)) (dlift n) (base n k)) (@map (vect n) (prod (vect n) (vect n)) (lift n) (base n (S k))))), b2Prop (let (l2, l3) := v in andb (hom n k l2) (hom n (S k) l3)) *)
intros HH; contradict HH; auto with arith.
(* Goal: forall (_ : le O (S n)) (_ : @In (prod (vect n) (vect n)) v (@map (vect n) (prod (vect n) (vect n)) (lift n) (base n O))), b2Prop (let (l2, l3) := v in andb (eq0 n l2) (hom n O l3)) *)
(* Goal: forall (_ : le (S k) (S n)) (_ : @In (prod (vect n) (vect n)) v (@app (prod (vect n) (vect n)) (@map (vect n) (prod (vect n) (vect n)) (dlift n) (base n k)) (@map (vect n) (prod (vect n) (vect n)) (lift n) (base n (S k))))), b2Prop (let (l2, l3) := v in andb (hom n k l2) (hom n (S k) l3)) *)
destruct v as [v1 v2].
(* Goal: forall (_ : le O (S n)) (_ : @In (prod (vect n) (vect n)) (@pair (vect n) (vect n) v1 v2) (@map (vect n) (prod (vect n) (vect n)) (lift n) (base n O))), b2Prop (andb (eq0 n v1) (hom n O v2)) *)
(* Goal: forall (_ : le (S k) (S n)) (_ : @In (prod (vect n) (vect n)) v (@app (prod (vect n) (vect n)) (@map (vect n) (prod (vect n) (vect n)) (dlift n) (base n k)) (@map (vect n) (prod (vect n) (vect n)) (lift n) (base n (S k))))), b2Prop (let (l2, l3) := v in andb (hom n k l2) (hom n (S k) l3)) *)
rewrite base0, en_def; simpl.
(* Goal: forall (_ : le O (S n)) (_ : or (@Logic.eq (prod (vect n) (vect n)) (lift n (genk n (Field.v1 (K1 p)))) (@pair (vect n) (vect n) v1 v2)) False), b2Prop (andb (eq0 n v1) (hom n O v2)) *)
(* Goal: forall (_ : le (S k) (S n)) (_ : @In (prod (vect n) (vect n)) v (@app (prod (vect n) (vect n)) (@map (vect n) (prod (vect n) (vect n)) (dlift n) (base n k)) (@map (vect n) (prod (vect n) (vect n)) (lift n) (base n (S k))))), b2Prop (let (l2, l3) := v in andb (hom n k l2) (hom n (S k) l3)) *)
intros _ [H1|[]]; injection H1; intros; subst.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite eq0I, hom0K; auto.
(* Goal: forall (_ : le (S k) (S n)) (_ : @In (prod (vect n) (vect n)) v (@app (prod (vect n) (vect n)) (@map (vect n) (prod (vect n) (vect n)) (dlift n) (base n k)) (@map (vect n) (prod (vect n) (vect n)) (lift n) (base n (S k))))), b2Prop (let (l2, l3) := v in andb (hom n k l2) (hom n (S k) l3)) *)
intros HH; case (Lt.le_lt_or_eq k n); auto with arith; intros H1 H2; subst.
case (in_app_or _ _ _ H2); rewrite in_map_iff;
  intros (v1, ([],Hv1)); simpl.
(* Goal: b2Prop (andb (hom n k v1) (hom n (S k) (genk n (v0 (K1 p))))) *)
(* Goal: b2Prop (andb (hom n k (genk n (v0 (K1 p)))) (hom n (S k) v1)) *)
(* Goal: b2Prop (let (l2, l3) := v in andb (hom n n l2) (hom n (S n) l3)) *)
rewrite IH, homk0; auto with arith.
(* Goal: b2Prop (andb (hom n k (genk n (v0 (K1 p)))) (hom n (S k) v1)) *)
(* Goal: b2Prop (let (l2, l3) := v in andb (hom n n l2) (hom n (S n) l3)) *)
rewrite homk0, IH; auto with arith.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite base_n, base_lt_nil in H2; auto.
(* Goal: b2Prop (let (l2, l3) := v in andb (hom n n l2) (hom n (S n) l3)) *)
simpl in H2; case H2; intros []; simpl.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite all_hom, homk0; auto.
Qed.

Lemma proj_homk n (x: vect n) k : 
  hom n k x -> proj n k x *X* base n k = x.
Proof.
(* Goal: forall _ : @In (vect n) v (base n k), or (@Logic.eq (vect n) (join n v (dual n v)) (all n)) (@Logic.eq (vect n) (join n v (dual n v)) (scalE (vn_eparams n) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (all n))) *)
generalize k; clear k.
(* Goal: forall (b : bool) (k : nat) (_ : b2Prop (hom n k x)), b2Prop (hom n k (dconj n b x)) *)
induction n as [| n IH]; simpl.
(* Goal: forall (k : nat) (_ : b2Prop match k with | O => true | S n => eqK (K1 p) x (v0 (K1 p)) end), @Logic.eq (Field.K (K1 p)) (mprod (vn_eparams O) match k with | O => @cons (Field.K (K1 p)) x (@nil (Field.K (K1 p))) | S n => @nil (Field.K (K1 p)) end match k with | O => @cons (Field.K (K1 p)) (v1 (K1 p)) (@nil (Field.K (K1 p))) | S n => @nil (Field.K (K1 p)) end) x *)
(* Goal: forall (k : nat) (_ : b2Prop (let (l2, l3) := x in andb match k with | O => eq0 n l2 | S k1 => hom n k1 l2 end (hom n k l3))), @Logic.eq (prod (vect n) (vect n)) (mprod (vn_eparams (S n)) (let (l1, l2) := x in match k with | O => proj n k l2 | S k1 => @app (Field.K (K1 p)) (proj n k1 l1) (proj n k l2) end) match k with | O => @map (vect n) (prod (vect n) (vect n)) (lift n) (base n k) | S k1 => @app (prod (vect n) (vect n)) (@map (vect n) (prod (vect n) (vect n)) (dlift n) (base n k1)) (@map (vect n) (prod (vect n) (vect n)) (lift n) (base n k)) end) x *)
intros [| k] Hx.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite (mprod_S (vn_eparams 0)); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
    rewrite mprod0l, addE0r; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
    simpl; rewrite multK1r; auto.
(* Goal: @Logic.eq (Field.K (K1 p)) (mprod (vn_eparams O) (@nil (Field.K (K1 p))) (@nil (Field.K (K1 p)))) x *)
(* Goal: forall (k : nat) (_ : b2Prop (let (l2, l3) := x in andb match k with | O => eq0 n l2 | S k1 => hom n k1 l2 end (hom n k l3))), @Logic.eq (prod (vect n) (vect n)) (mprod (vn_eparams (S n)) (let (l1, l2) := x in match k with | O => proj n k l2 | S k1 => @app (Field.K (K1 p)) (proj n k1 l1) (proj n k l2) end) match k with | O => @map (vect n) (prod (vect n) (vect n)) (lift n) (base n k) | S k1 => @app (prod (vect n) (vect n)) (@map (vect n) (prod (vect n) (vect n)) (dlift n) (base n k1)) (@map (vect n) (prod (vect n) (vect n)) (lift n) (base n k)) end) x *)
  rewrite mprod0r.
(* Goal: @Logic.eq bool (eqK (K1 p) (v0 (K1 p)) (v0 (K1 p))) true *)
(* Goal: @Logic.eq bool (if eq0 n (genk n (v0 (K1 p))) then eq0 n (genk n (v0 (K1 p))) else false) true *)
generalize Hx; case eqK_spec; auto.
(* Goal: b2Prop false *)
intros; discriminate.
(* Goal: forall (k : nat) (_ : b2Prop (let (l2, l3) := x in andb match k with | O => eq0 n l2 | S k1 => hom n k1 l2 end (hom n k l3))), @Logic.eq (prod (vect n) (vect n)) (mprod (vn_eparams (S n)) (let (l1, l2) := x in match k with | O => proj n k l2 | S k1 => @app (Field.K (K1 p)) (proj n k1 l1) (proj n k l2) end) match k with | O => @map (vect n) (prod (vect n) (vect n)) (lift n) (base n k) | S k1 => @app (prod (vect n) (vect n)) (@map (vect n) (prod (vect n) (vect n)) (dlift n) (base n k1)) (@map (vect n) (prod (vect n) (vect n)) (lift n) (base n k)) end) x *)
intros [|k ]; destruct x.
(* Goal: forall _ : b2Prop (andb (eq0 n v) (hom n O v0)), @Logic.eq (prod (vect n) (vect n)) (mprod (vn_eparams (S n)) (proj n O v0) (@map (vect n) (prod (vect n) (vect n)) (lift n) (base n O))) (@pair (vect n) (vect n) v v0) *)
(* Goal: forall _ : b2Prop (andb (hom n k v) (hom n (S k) v0)), @Logic.eq (prod (vect n) (vect n)) (mprod (vn_eparams (S n)) (@app (Field.K (K1 p)) (proj n k v) (proj n (S k) v0)) (@app (prod (vect n) (vect n)) (@map (vect n) (prod (vect n) (vect n)) (dlift n) (base n k)) (@map (vect n) (prod (vect n) (vect n)) (lift n) (base n (S k))))) (@pair (vect n) (vect n) v v0) *)
case eq0_spec; intros Hx Hx1; try discriminate; subst.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite lift_mprod, IH; auto.
(* Goal: forall _ : @Logic.eq (E (vn_eparams n)) v (joinl n (decomposek n (first_deg n v) v)), decomposable n (decomposek n (first_deg n v) v) v *)
(* Goal: forall _ : not (@Logic.eq (E (vn_eparams n)) v (joinl n (decomposek n (first_deg n v) v))), not (is_decomposable n v) *)
(* Goal: not (is_decomposable n v) *)
intros HH.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite (mprod_app (vn_eparams n.+1)); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite  !lift_mprod, !dlift_mprod, !IH; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
simpl; Vfold n; rewrite addE0l, addE0r; auto.
(* Goal: b2Prop false *)
generalize HH; case hom; auto; intros; discriminate.
(* Goal: b2Prop false *)
generalize HH; case hom; auto; intros; discriminate.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite map_length, proj_base_length; auto.
Qed.

Lemma base_free n k : free _ (base n k).
Proof.
(* Goal: forall _ : @In (vect n) v (base n k), or (@Logic.eq (vect n) (join n v (dual n v)) (all n)) (@Logic.eq (vect n) (join n v (dual n v)) (scalE (vn_eparams n) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (all n))) *)
generalize k; clear k.
(* Goal: @Logic.eq (vect n) (k2g n (E0 (Kn.vn_eparams p n))) (E0 (vn_eparams n)) *)
induction n as [| n IH]; simpl; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros [|k] [|x [|]]; simpl; try (intros; discriminate); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite (mprod_S (vn_eparams 0)); auto.
(* Goal: @Logic.eq (vect n) (mcontra n (@cons (kn p n) a l) x) (mcontra n l (contra n a x)) *)
  (* rewrite !mprod_S, !mprod0r, !addE0r; simpl; auto. *)
(* Goal: @Logic.eq (vect n) (mcontra n (@cons (kn p n) a l) x) (mcontra n l (contra n a x)) *)
  rewrite  !mprod0r, !addE0r; simpl; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite multK1r; auto; intros _ HH k [HH1 | []]; subst; auto.
(* Goal: forall (_ : @Logic.eq nat O O) (_ : @Logic.eq (Field.K (K1 p)) (mprod (vn_eparams O) (@nil (Field.K (K1 p))) (@nil (Field.K (K1 p)))) (v0 (K1 p))) (k : Field.K (K1 p)) (_ : False), @Logic.eq (Field.K (K1 p)) k (v0 (K1 p)) *)
(* Goal: forall k : nat, free (vn_eparams (S n)) match k with | O => @map (vect n) (prod (vect n) (vect n)) (lift n) (base n k) | S k1 => @app (prod (vect n) (vect n)) (@map (vect n) (prod (vect n) (vect n)) (dlift n) (base n k1)) (@map (vect n) (prod (vect n) (vect n)) (lift n) (base n k)) end *)
intros _ _ k1 HH; case HH.
(* Goal: forall k : nat, free (vn_eparams (S n)) match k with | O => @map (vect n) (prod (vect n) (vect n)) (lift n) (base n k) | S k1 => @app (prod (vect n) (vect n)) (@map (vect n) (prod (vect n) (vect n)) (dlift n) (base n k1)) (@map (vect n) (prod (vect n) (vect n)) (lift n) (base n k)) end *)
intros [| k].
(* Goal: free (vn_eparams (S n)) (@map (vect n) (prod (vect n) (vect n)) (lift n) (base n O)) *)
(* Goal: free (vn_eparams (S n)) (@app (prod (vect n) (vect n)) (@map (vect n) (prod (vect n) (vect n)) (dlift n) (base n k)) (@map (vect n) (prod (vect n) (vect n)) (lift n) (base n (S k)))) *)
rewrite base0; intros [| x []]; try (intros; discriminate); simpl.
(* Goal: forall _ : lt O (S (S n)), @Logic.eq (prod (vect (S n)) (vect (S n))) (joinl (S (S n)) (@app (prod (vect (S n)) (vect (S n))) (@map (vect (S n)) (prod (vect (S n)) (vect (S n))) (dlift (S n)) (base (S n) O)) (@map (vect (S n)) (prod (vect (S n)) (vect (S n))) (lift (S n)) (base (S n) (S O))))) (@pair (vect (S n)) (vect (S n)) (all (S n)) (genk (S n) (v0 (K1 p)))) *)
intros _.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite (mprod_S (vn_eparams n.+1)); auto.
(* Goal: forall (_ : @Logic.eq (prod (vect n) (vect n)) (addE (vn_eparams (S n)) (scalE (vn_eparams (S n)) x (lift n (gen n n))) (mprod (vn_eparams (S n)) (@nil (Field.K (K1 p))) (@nil (prod (vect n) (vect n))))) (@pair (vect n) (vect n) (genk n (v0 (K1 p))) (genk n (v0 (K1 p))))) (k : Field.K (K1 p)) (_ : or (@Logic.eq (Field.K (K1 p)) x k) False), @Logic.eq (Field.K (K1 p)) k (v0 (K1 p)) *)
(* Goal: free (vn_eparams (S n)) (@app (prod (vect n) (vect n)) (@map (vect n) (prod (vect n) (vect n)) (dlift n) (base n k)) (@map (vect n) (prod (vect n) (vect n)) (lift n) (base n (S k)))) *)
rewrite mprod0r; simpl; auto; Vfold n.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite en_def, scalE0r, addE0l, addE0r, scalk, multK1r; auto.
(* Goal: forall (_ : @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (genk n x)) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (E0 (vn_eparams n)))) (k : Field.K (K1 p)) (_ : or (@Logic.eq (Field.K (K1 p)) x k) False), @Logic.eq (Field.K (K1 p)) k (v0 (K1 p)) *)
(* Goal: free (vn_eparams (S n)) (@app (prod (vect n) (vect n)) (@map (vect n) (prod (vect n) (vect n)) (dlift n) (base n k)) (@map (vect n) (prod (vect n) (vect n)) (lift n) (base n (S k)))) *)
intros HH; injection HH; intros HH1 k [HK | []]; subst.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply injk with (1 := HH1); auto.
(* Goal: free (vn_eparams (S n)) (@app (prod (vect n) (vect n)) (@map (vect n) (prod (vect n) (vect n)) (dlift n) (base n k)) (@map (vect n) (prod (vect n) (vect n)) (lift n) (base n (S k)))) *)
intros l; rewrite app_length, !map_length.
(* Goal: forall (_ : @Logic.eq nat (@length (Field.K (stype (vn_eparams (S n)))) l) (Nat.add (@length (vect n) (base n k)) (@length (vect n) (base n (S k))))) (_ : @Logic.eq (E (vn_eparams (S n))) (mprod (vn_eparams (S n)) l (@app (prod (vect n) (vect n)) (@map (vect n) (prod (vect n) (vect n)) (dlift n) (base n k)) (@map (vect n) (prod (vect n) (vect n)) (lift n) (base n (S k))))) (E0 (vn_eparams (S n)))) (k : Field.K (stype (vn_eparams (S n)))) (_ : @In (Field.K (stype (vn_eparams (S n)))) k l), @Logic.eq (Field.K (stype (vn_eparams (S n)))) k (v0 (stype (vn_eparams (S n)))) *)
intros H1 H2 k1 Hk1.
(* Goal: @Logic.eq (Field.K (stype (vn_eparams (S n)))) k1 (v0 (stype (vn_eparams (S n)))) *)
case (list_split _ _ _ _ H1); intros l1 (l2, (Hl1, (Hl2, Hl3))); subst.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite mprod_app, lift_mprod, dlift_mprod in H2; try rewrite map_length; auto.
(* Goal: @Logic.eq (Field.K (stype (vn_eparams (S n)))) k1 (v0 (stype (vn_eparams (S n)))) *)
injection H2; Vfold n; rewrite addE0r, addE0l; auto; intros He1 He2.
(* Goal: @Logic.eq (Field.K (stype (vn_eparams (S n)))) k1 (v0 (stype (vn_eparams (S n)))) *)
case (in_app_or _ _ _ Hk1); intros H3.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply (IH k l1); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply (IH k.+1 l2); auto.
Qed.

(* Each generator is in the base *)
Lemma e_in_base1 n i : i < n -> In 'e_i (base n 1).
Proof.
(* Goal: forall _ : lt i n, @Logic.eq (vect n) (k2g n (Kn.gen p n i)) (gen n i) *)
generalize i; clear i.
(* Goal: forall (i : nat) (_ : lt i n), @In (vect n) (gen n i) (base n (S O)) *)
induction n as [| n IH].
(* Goal: forall (i : nat) (_ : lt i O), @In (vect O) (gen O i) (base O (S O)) *)
(* Goal: forall (i : nat) (_ : lt i (S n)), @In (vect (S n)) (gen (S n) i) (base (S n) (S O)) *)
  intros p1 Hp1; absurd (p1 < 0); auto with arith.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros [| p1] Hp1; simpl; Vfold n; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply in_or_app; left; auto.
(* Goal: @In (prod (vect n) (vect n)) (@pair (vect n) (vect n) (genk n (v1 (K1 p))) (E0 (vn_eparams n))) (@map (vect n) (prod (vect n) (vect n)) (dlift n) (base n O)) *)
(* Goal: @In (prod (vect n) (vect n)) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (gen n p1)) (@app (prod (vect n) (vect n)) (@map (vect n) (prod (vect n) (vect n)) (dlift n) (base n O)) (@map (vect n) (prod (vect n) (vect n)) (lift n) (base n (S O)))) *)
change (1: vect n, 0: vect n) with (dlift n (1)).
(* Goal: @Logic.eq (vect n) (mcontra n (@cons (kn p n) a l) x) (mcontra n l (contra n a x)) *)
rewrite base0, en_def; simpl; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply in_or_app; right; auto.
(* Goal: @In (prod (vect n) (vect n)) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (gen n p1)) (@map (vect n) (prod (vect n) (vect n)) (lift n) (base n (S O))) *)
change (0: vect n, 'e_p1: vect n) with ('e_p1^'l:vect n.+1).
(* Goal: lt (Nat.add O k2) n *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (eq0 n y1) (hom n O y2))) (_ : lt (Nat.add (S k1) O) (S n)), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n x1 y1) (addE (vn_eparams n) (meet n x1 y2) (meet n x2 (dconj n false y1)))) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (E0 (vn_eparams n))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n k2 y1) (hom n (S k2) y2))) (_ : lt (Nat.add (S k1) (S k2)) (S n)), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n x1 y1) (addE (vn_eparams n) (meet n x1 y2) (meet n x2 (dconj n false y1)))) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (E0 (vn_eparams n))) *)
refine (in_map _ _ _ _);  auto with arith.
Qed.

(* An element of the base is a generator *)
Lemma e_in_base1_ex n v : 
  In v (base n 1) -> exists p1, p1 < n /\ v = 'e_p1.
Proof.
(* Goal: forall _ : @Logic.eq (E (vn_eparams n)) v (joinl n (decomposek n (first_deg n v) v)), decomposable n (decomposek n (first_deg n v) v) v *)
(* Goal: forall _ : not (@Logic.eq (E (vn_eparams n)) v (joinl n (decomposek n (first_deg n v) v))), not (is_decomposable n v) *)
(* Goal: not (is_decomposable n v) *)
induction n as [| n IH]; intros HH.
(* Goal: @ex nat (fun p1 : nat => and (lt p1 O) (@Logic.eq (vect O) v (gen O p1))) *)
(* Goal: @ex nat (fun p1 : nat => and (lt p1 (S n)) (@Logic.eq (vect (S n)) v (gen (S n) p1))) *)
  inversion HH.
(* Goal: @ex nat (fun p1 : nat => and (lt p1 (S n)) (@Logic.eq (vect (S n)) v (gen (S n) p1))) *)
destruct v as [vv1 vv2].
case (in_app_or _ _ _ HH); rewrite in_map_iff;
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
  intros (v, (Hv1, Hv2)); injection Hv1; intros H1 H2; subst; auto.
(* Goal: @ex nat (fun p1 : nat => and (lt p1 (S n)) (@Logic.eq (vect (S n)) (@pair (vect n) (vect n) vv1 (genk n (v0 (K1 p)))) (gen (S n) p1))) *)
(* Goal: @ex nat (fun p1 : nat => and (lt p1 (S n)) (@Logic.eq (vect (S n)) (@pair (vect n) (vect n) (genk n (v0 (K1 p))) vv2) (gen (S n) p1))) *)
exists 0%nat; split; auto with arith.
(* Goal: @Logic.eq (vect (S n)) (@pair (vect n) (vect n) vv1 (genk n (v0 (K1 p)))) (gen (S n) O) *)
(* Goal: @ex nat (fun p1 : nat => and (lt p1 (S n)) (@Logic.eq (vect (S n)) (@pair (vect n) (vect n) (genk n (v0 (K1 p))) vv2) (gen (S n) p1))) *)
rewrite base0, en_def in Hv2.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
simpl in Hv2; case Hv2; intros HH1; subst; auto.
(* Goal: @Logic.eq (vect (S n)) (@pair (vect n) (vect n) vv1 (genk n (v0 (K1 p)))) (gen (S n) O) *)
(* Goal: @ex nat (fun p1 : nat => and (lt p1 (S n)) (@Logic.eq (vect (S n)) (@pair (vect n) (vect n) (genk n (v0 (K1 p))) vv2) (gen (S n) p1))) *)
case HH1.
(* Goal: @ex nat (fun p1 : nat => and (lt p1 (S n)) (@Logic.eq (vect (S n)) (@pair (vect n) (vect n) (genk n (v0 (K1 p))) vv2) (gen (S n) p1))) *)
case (IH _ Hv2); auto; intros p1 (H1p1, H2p1).
(* Goal: @ex nat (fun p1 : nat => and (lt p1 (S n)) (@Logic.eq (vect (S n)) (@pair (vect n) (vect n) (genk n (v0 (K1 p))) vv2) (gen (S n) p1))) *)
exists p1.+1; split; subst; auto with arith.
Qed.

(* The length of the base is n *)
Lemma base1_length n : length (base n 1) = n.
Proof. rewrite base_length, bin_1; auto. Qed.

Lemma base1_S n:
  base n.+1 1 = ('e_0: vect n.+1) :: map (lift n) (base n 1).
Proof. simpl; unfold dlift; simpl; rewrite base0, en_def; simpl; auto. Qed.

Lemma base_nil n k : n < k -> base n k = nil.
Proof.
(* Goal: forall _ : @In (vect n) v (base n k), or (@Logic.eq (vect n) (join n v (dual n v)) (all n)) (@Logic.eq (vect n) (join n v (dual n v)) (scalE (vn_eparams n) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (all n))) *)
generalize k; clear k.
induction n as [| n IH]; intros [| k] H; simpl; auto;
  try (contradict H; auto with arith; fail).
(* Goal: @Logic.eq (list (prod (vect n) (vect n))) (@app (prod (vect n) (vect n)) (@map (vect n) (prod (vect n) (vect n)) (dlift n) (base n k)) (@map (vect n) (prod (vect n) (vect n)) (lift n) (base n (S k)))) (@nil (prod (vect n) (vect n))) *)
rewrite !IH; auto with arith.
Qed.

Lemma cbl1_hom1_equiv n (x: vect n) : cbl _ (base n 1) x <-> hom n 1 x.
Proof.
(* Goal: iff (cbl (vn_eparams n) (base n (S O)) x) (b2Prop (hom n (S O) x)) *)
split; intros Hx; elim Hx.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite homk0; auto.
(* Goal: forall (v : E (vn_eparams n)) (_ : @In (E (vn_eparams n)) v (base n (S O))), b2Prop (hom n (S O) v) *)
(* Goal: forall (x y : E (vn_eparams n)) (_ : cbl (vn_eparams n) (base n (S O)) x) (_ : b2Prop (hom n (S O) x)) (_ : cbl (vn_eparams n) (base n (S O)) y) (_ : b2Prop (hom n (S O) y)), b2Prop (hom n (S O) (addE (vn_eparams n) x y)) *)
(* Goal: forall (k : Field.K (stype (vn_eparams n))) (x : E (vn_eparams n)) (_ : cbl (vn_eparams n) (base n (S O)) x) (_ : b2Prop (hom n (S O) x)), b2Prop (hom n (S O) (scalE (vn_eparams n) k x)) *)
(* Goal: cbl (vn_eparams n) (base n (S O)) x *)
intros v Hv.
(* Goal: b2Prop (hom n (S O) v) *)
(* Goal: forall (x y : E (vn_eparams n)) (_ : cbl (vn_eparams n) (base n (S O)) x) (_ : b2Prop (hom n (S O) x)) (_ : cbl (vn_eparams n) (base n (S O)) y) (_ : b2Prop (hom n (S O) y)), b2Prop (hom n (S O) (addE (vn_eparams n) x y)) *)
(* Goal: forall (k : Field.K (stype (vn_eparams n))) (x : E (vn_eparams n)) (_ : cbl (vn_eparams n) (base n (S O)) x) (_ : b2Prop (hom n (S O) x)), b2Prop (hom n (S O) (scalE (vn_eparams n) k x)) *)
(* Goal: cbl (vn_eparams n) (base n (S O)) x *)
case (e_in_base1_ex _ _ Hv); intros i (Hi, Hei); subst.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply hom1e; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros y1 y2 _ Hy1 _ Hy2; apply add_hom; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros k y _ Hy; apply scal_hom; auto.
(* Goal: cbl (vn_eparams n) (base n (S O)) x *)
rewrite <- (proj_homk _ _ _ Hx).
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply mprod_cbl; auto.
Qed.

Lemma cblk_homk_equiv n k (x: vect n): cbl _ (base n k) x <-> hom n k x.
Proof.
(* Goal: forall _ : @In (vect n) v (base n k), or (@Logic.eq (vect n) (join n v (dual n v)) (all n)) (@Logic.eq (vect n) (join n v (dual n v)) (scalE (vn_eparams n) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (all n))) *)
generalize k; clear k.
(* Goal: @Logic.eq (vect n) (k2g n (E0 (Kn.vn_eparams p n))) (E0 (vn_eparams n)) *)
induction n as [| n IH]; simpl; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros [| k]; split; intros H; auto.
(* Goal: cbl (vn_eparams O) (@cons (Field.K (K1 p)) (v1 (K1 p)) (@nil (Field.K (K1 p)))) x *)
(* Goal: b2Prop (eqK (K1 p) x (v0 (K1 p))) *)
(* Goal: cbl (vn_eparams O) (@nil (Field.K (K1 p))) x *)
(* Goal: forall k : nat, iff (cbl (vn_eparams (S n)) match k with | O => @map (vect n) (prod (vect n) (vect n)) (lift n) (base n k) | S k1 => @app (prod (vect n) (vect n)) (@map (vect n) (prod (vect n) (vect n)) (dlift n) (base n k1)) (@map (vect n) (prod (vect n) (vect n)) (lift n) (base n k)) end x) (b2Prop (let (l2, l3) := x in andb match k with | O => eq0 n l2 | S k1 => hom n k1 l2 end (hom n k l3))) *)
replace x with (x .* 1: vect 0).
(* Goal: cbl (vn_eparams n) (base n (S O)) (scalE (vn_eparams n) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) b) *)
(* Goal: @ex (Field.K (stype (vn_eparams n))) (fun k : Field.K (stype (vn_eparams n)) => @ex (list (vect n)) (fun l0 : list (vect n) => and (forall (v : vect n) (_ : @In (vect n) v l0), b2Prop (hom n (S O) v)) (@Logic.eq (E (vn_eparams n)) (joinl n (@cons (E (vn_eparams n)) b l)) (scalE (vn_eparams n) k (joinl n (@cons (E (vn_eparams n)) (mprod (vn_eparams n) (@cons (Field.K (stype (vn_eparams n))) a ll) (@cons (E (vn_eparams n)) b l)) l0)))))) *)
apply cbl_scal.
(* Goal: cbl n (@cons (vect n) a (@cons (vect n) b l)) (Nat.add (S O) (Nat.pred (@length (vect n) (@cons (vect n) b l)))) (join n a (joinl n (@cons (vect n) b l))) *)
(* Goal: not (@Logic.eq (list (vect n)) (@cons (vect n) b l) (@nil (vect n))) *)
constructor; auto with datatypes.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite scalk, multK1r; auto.
(* Goal: b2Prop (eqK (K1 p) x (v0 (K1 p))) *)
(* Goal: cbl (vn_eparams O) (@nil (Field.K (K1 p))) x *)
(* Goal: forall k : nat, iff (cbl (vn_eparams (S n)) match k with | O => @map (vect n) (prod (vect n) (vect n)) (lift n) (base n k) | S k1 => @app (prod (vect n) (vect n)) (@map (vect n) (prod (vect n) (vect n)) (dlift n) (base n k1)) (@map (vect n) (prod (vect n) (vect n)) (lift n) (base n k)) end x) (b2Prop (let (l2, l3) := x in andb match k with | O => eq0 n l2 | S k1 => hom n k1 l2 end (hom n k l3))) *)
elim H.
(* Goal: forall _ : b2Prop (eqK (K1 p) M (v0 (K1 p))), b2Prop (eqK (K1 p) (v0 (K1 p)) (v0 (K1 p))) *)
(* Goal: forall _ : b2Prop (let (l2, l3) := M in andb (hom n O l2) (hom n (S O) l3)), b2Prop (let (l2, l3) := let (k, lf1) := lf in let (l2, l3) := M in @pair (vect n) (vect n) (scal n (oppK (K1 p) (v1 (K1 p))) (contra n lf1 l2)) (add n (scal n k l2) (contra n lf1 l3)) in andb (eq0 n l2) (hom n O l3)) *)
(* Goal: forall _ : b2Prop (let (l2, l3) := M in andb (hom n (S k1) l2) (hom n (S (S k1)) l3)), b2Prop (let (l2, l3) := let (k, lf1) := lf in let (l2, l3) := M in @pair (vect n) (vect n) (scal n (oppK (K1 p) (v1 (K1 p))) (contra n lf1 l2)) (add n (scal n k l2) (contra n lf1 l3)) in andb (hom n k1 l2) (hom n (S k1) l3)) *)
rewrite eqKI; auto.
(* Goal: forall (v : E (vn_eparams O)) (_ : @In (E (vn_eparams O)) v (@nil (Field.K (K1 p)))), b2Prop (eqK (K1 p) v (v0 (K1 p))) *)
(* Goal: forall (x y : E (vn_eparams O)) (_ : cbl (vn_eparams O) (@nil (Field.K (K1 p))) x) (_ : b2Prop (eqK (K1 p) x (v0 (K1 p)))) (_ : cbl (vn_eparams O) (@nil (Field.K (K1 p))) y) (_ : b2Prop (eqK (K1 p) y (v0 (K1 p)))), b2Prop (eqK (K1 p) (addE (vn_eparams O) x y) (v0 (K1 p))) *)
(* Goal: forall (k : Field.K (stype (vn_eparams O))) (x : E (vn_eparams O)) (_ : cbl (vn_eparams O) (@nil (Field.K (K1 p))) x) (_ : b2Prop (eqK (K1 p) x (v0 (K1 p)))), b2Prop (eqK (K1 p) (scalE (vn_eparams O) k x) (v0 (K1 p))) *)
(* Goal: cbl (vn_eparams O) (@nil (Field.K (K1 p))) x *)
(* Goal: forall k : nat, iff (cbl (vn_eparams (S n)) match k with | O => @map (vect n) (prod (vect n) (vect n)) (lift n) (base n k) | S k1 => @app (prod (vect n) (vect n)) (@map (vect n) (prod (vect n) (vect n)) (dlift n) (base n k1)) (@map (vect n) (prod (vect n) (vect n)) (lift n) (base n k)) end x) (b2Prop (let (l2, l3) := x in andb match k with | O => eq0 n l2 | S k1 => hom n k1 l2 end (hom n k l3))) *)
intros v [].
(* Goal: forall (x y : E (vn_eparams O)) (_ : cbl (vn_eparams O) (@nil (Field.K (K1 p))) x) (_ : b2Prop (eqK (K1 p) x (v0 (K1 p)))) (_ : cbl (vn_eparams O) (@nil (Field.K (K1 p))) y) (_ : b2Prop (eqK (K1 p) y (v0 (K1 p)))), b2Prop (eqK (K1 p) (addE (vn_eparams O) x y) (v0 (K1 p))) *)
(* Goal: forall (k : Field.K (stype (vn_eparams O))) (x : E (vn_eparams O)) (_ : cbl (vn_eparams O) (@nil (Field.K (K1 p))) x) (_ : b2Prop (eqK (K1 p) x (v0 (K1 p)))), b2Prop (eqK (K1 p) (scalE (vn_eparams O) k x) (v0 (K1 p))) *)
(* Goal: cbl (vn_eparams O) (@nil (Field.K (K1 p))) x *)
(* Goal: forall k : nat, iff (cbl (vn_eparams (S n)) match k with | O => @map (vect n) (prod (vect n) (vect n)) (lift n) (base n k) | S k1 => @app (prod (vect n) (vect n)) (@map (vect n) (prod (vect n) (vect n)) (dlift n) (base n k1)) (@map (vect n) (prod (vect n) (vect n)) (lift n) (base n k)) end x) (b2Prop (let (l2, l3) := x in andb match k with | O => eq0 n l2 | S k1 => hom n k1 l2 end (hom n k l3))) *)
intros x1 y1 _; do 2 (case eqK_spec; auto; intros HH; subst; try (intros; discriminate)).
(* Goal: forall _ : b2Prop (eqK (K1 p) M (v0 (K1 p))), b2Prop (eqK (K1 p) (v0 (K1 p)) (v0 (K1 p))) *)
(* Goal: forall _ : b2Prop (let (l2, l3) := M in andb (hom n O l2) (hom n (S O) l3)), b2Prop (let (l2, l3) := let (k, lf1) := lf in let (l2, l3) := M in @pair (vect n) (vect n) (scal n (oppK (K1 p) (v1 (K1 p))) (contra n lf1 l2)) (add n (scal n k l2) (contra n lf1 l3)) in andb (eq0 n l2) (hom n O l3)) *)
(* Goal: forall _ : b2Prop (let (l2, l3) := M in andb (hom n (S k1) l2) (hom n (S (S k1)) l3)), b2Prop (let (l2, l3) := let (k, lf1) := lf in let (l2, l3) := M in @pair (vect n) (vect n) (scal n (oppK (K1 p) (v1 (K1 p))) (contra n lf1 l2)) (add n (scal n k l2) (contra n lf1 l3)) in andb (hom n k1 l2) (hom n (S k1) l3)) *)
Vrm0; rewrite eqKI; auto.
intros k1 x1 _; case eqK_spec; auto; intros HH HH1; subst; Vrm0;
(* Goal: forall _ : b2Prop (eqK (K1 p) M (v0 (K1 p))), b2Prop (eqK (K1 p) (v0 (K1 p)) (v0 (K1 p))) *)
(* Goal: forall _ : b2Prop (let (l2, l3) := M in andb (hom n O l2) (hom n (S O) l3)), b2Prop (let (l2, l3) := let (k, lf1) := lf in let (l2, l3) := M in @pair (vect n) (vect n) (scal n (oppK (K1 p) (v1 (K1 p))) (contra n lf1 l2)) (add n (scal n k l2) (contra n lf1 l3)) in andb (eq0 n l2) (hom n O l3)) *)
(* Goal: forall _ : b2Prop (let (l2, l3) := M in andb (hom n (S k1) l2) (hom n (S (S k1)) l3)), b2Prop (let (l2, l3) := let (k, lf1) := lf in let (l2, l3) := M in @pair (vect n) (vect n) (scal n (oppK (K1 p) (v1 (K1 p))) (contra n lf1 l2)) (add n (scal n k l2) (contra n lf1 l3)) in andb (hom n k1 l2) (hom n (S k1) l3)) *)
  try discriminate; rewrite eqKI; auto.
(* Goal: b2Prop false *)
generalize H; case eqK_spec; auto; intros; subst; try discriminate.
(* Goal: cbl (vn_eparams O) (@nil (Field.K (K1 p))) (v0 (K1 p)) *)
(* Goal: forall k : nat, iff (cbl (vn_eparams (S n)) match k with | O => @map (vect n) (prod (vect n) (vect n)) (lift n) (base n k) | S k1 => @app (prod (vect n) (vect n)) (@map (vect n) (prod (vect n) (vect n)) (dlift n) (base n k1)) (@map (vect n) (prod (vect n) (vect n)) (lift n) (base n k)) end x) (b2Prop (let (l2, l3) := x in andb match k with | O => eq0 n l2 | S k1 => hom n k1 l2 end (hom n k l3))) *)
constructor.
(* Goal: forall _ : @Logic.eq (E (vn_eparams n)) v (joinl n (decomposek n (first_deg n v) v)), decomposable n (decomposek n (first_deg n v) v) v *)
(* Goal: forall _ : not (@Logic.eq (E (vn_eparams n)) v (joinl n (decomposek n (first_deg n v) v))), not (is_decomposable n v) *)
(* Goal: not (is_decomposable n v) *)
intros [| k]; destruct x as [x y]; split; intros HH.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
case (cbl_map_inv _ _ (lift n) id id) with (5 := HH); auto.
(* Goal: forall x y : E (vn_eparams n), @Logic.eq (E (vn_eparams (S n))) (lift n (addE (vn_eparams n) x y)) (addE (vn_eparams (S n)) (lift n x) (lift n y)) *)
(* Goal: forall (k : Field.K (stype (vn_eparams n))) (x : E (vn_eparams n)), @Logic.eq (E (vn_eparams (S n))) (lift n (scalE (vn_eparams n) k x)) (scalE (vn_eparams (S n)) (@id (Field.K (stype (vn_eparams n))) k) (lift n x)) *)
(* Goal: cbl (vn_eparams n) (base n (S k)) y *)
(* Goal: @Logic.eq (E (vn_eparams (S n))) (addE (vn_eparams (S n)) (dlift n x) (lift n y)) (@pair (vect n) (vect n) x y) *)
intros; apply (lift_add n).
(* Goal: forall (k : Field.K (stype (vn_eparams n))) (x : E (vn_eparams n)), @Logic.eq (E (vn_eparams (S n))) (lift n (scalE (vn_eparams n) k x)) (scalE (vn_eparams (S n)) (@id (Field.K (stype (vn_eparams n))) k) (lift n x)) *)
(* Goal: cbl (vn_eparams n) (base n (S k)) y *)
(* Goal: @Logic.eq (E (vn_eparams (S n))) (addE (vn_eparams (S n)) (dlift n x) (lift n y)) (@pair (vect n) (vect n) x y) *)
intros; apply (lift_scal n).
(* Goal: forall (x0 : E (vn_eparams n)) (_ : and (cbl (vn_eparams n) (base n O) x0) (@Logic.eq (E (vn_eparams (S n))) (@pair (vect n) (vect n) x y) (lift n x0))), b2Prop (andb (eq0 n x) (hom n O y)) *)
(* Goal: cbl (vn_eparams (S n)) (@map (vect n) (prod (vect n) (vect n)) (lift n) (base n O)) (@pair (vect n) (vect n) x y) *)
(* Goal: b2Prop (andb (hom n k x) (hom n (S k) y)) *)
(* Goal: cbl (vn_eparams (S n)) (@app (prod (vect n) (vect n)) (@map (vect n) (prod (vect n) (vect n)) (dlift n) (base n k)) (@map (vect n) (prod (vect n) (vect n)) (lift n) (base n (S k)))) (@pair (vect n) (vect n) x y) *)
intros x1 (H1x1, H2x1); injection H2x1; intros; subst.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite eq0I; simpl; rewrite <- IH; auto.
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (eq0 n x1) (hom n O x2))), or (@Logic.eq nat (S k1) O) (@Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) x1 x2) (@pair (vect n) (vect n) (genk n (v0 (K1 p))) (genk n (v0 (K1 p))))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n k2 x1) (hom n (S k2) x2))), or (@Logic.eq nat (S k1) (S k2)) (@Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) x1 x2) (@pair (vect n) (vect n) (genk n (v0 (K1 p))) (genk n (v0 (K1 p))))) *)
generalize HH; case eq0_spec; try (intros; discriminate).
(* Goal: forall (_ : @Logic.eq (vect n) x (E0 (vn_eparams n))) (_ : b2Prop (andb true (hom n O y))), cbl (vn_eparams (S n)) (@map (vect n) (prod (vect n) (vect n)) (lift n) (base n O)) (@pair (vect n) (vect n) x y) *)
(* Goal: b2Prop (andb (hom n k x) (hom n (S k) y)) *)
(* Goal: cbl (vn_eparams (S n)) (@app (prod (vect n) (vect n)) (@map (vect n) (prod (vect n) (vect n)) (dlift n) (base n k)) (@map (vect n) (prod (vect n) (vect n)) (lift n) (base n (S k)))) (@pair (vect n) (vect n) x y) *)
intros H1 H2; subst.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply cbl_map with (f := lift n) (g:= id); auto.
(* Goal: forall x y : E (vn_eparams n), @Logic.eq (E (vn_eparams (S n))) (lift n (addE (vn_eparams n) x y)) (addE (vn_eparams (S n)) (lift n x) (lift n y)) *)
(* Goal: forall (k : Field.K (stype (vn_eparams n))) (x : E (vn_eparams n)), @Logic.eq (E (vn_eparams (S n))) (lift n (scalE (vn_eparams n) k x)) (scalE (vn_eparams (S n)) (@id (Field.K (stype (vn_eparams n))) k) (lift n x)) *)
(* Goal: cbl (vn_eparams n) (base n (S k)) y *)
(* Goal: @Logic.eq (E (vn_eparams (S n))) (addE (vn_eparams (S n)) (dlift n x) (lift n y)) (@pair (vect n) (vect n) x y) *)
intros; apply (lift_add n).
(* Goal: forall (k : Field.K (stype (vn_eparams n))) (x : E (vn_eparams n)), @Logic.eq (E (vn_eparams (S n))) (lift n (scalE (vn_eparams n) k x)) (scalE (vn_eparams (S n)) (@id (Field.K (stype (vn_eparams n))) k) (lift n x)) *)
(* Goal: cbl (vn_eparams n) (base n (S k)) y *)
(* Goal: @Logic.eq (E (vn_eparams (S n))) (addE (vn_eparams (S n)) (dlift n x) (lift n y)) (@pair (vect n) (vect n) x y) *)
intros; apply (lift_scal n).
(* Goal: @Logic.eq (vect n) (meet n (meet n v v1) v3) (meet n v (meet n v1 v3)) *)
(* Goal: @Logic.eq (vect n) (addE (vn_eparams n) (meet n (meet n v v1) v4) (meet n (addE (vn_eparams n) (meet n v v2) (meet n v0 (dconj n false v1))) (dconj n false v3))) (addE (vn_eparams n) (meet n v (addE (vn_eparams n) (meet n v1 v4) (meet n v2 (dconj n false v3)))) (meet n v0 (dconj n false (meet n v1 v3)))) *)
rewrite IH; auto.
(* Goal: b2Prop (andb (hom n k x) (hom n (S k) y)) *)
(* Goal: cbl (vn_eparams (S n)) (@app (prod (vect n) (vect n)) (@map (vect n) (prod (vect n) (vect n)) (dlift n) (base n k)) (@map (vect n) (prod (vect n) (vect n)) (lift n) (base n (S k)))) (@pair (vect n) (vect n) x y) *)
rewrite andbP; rewrite <-!IH.
(* Goal: and (cbl (vn_eparams n) (base n k) x) (cbl (vn_eparams n) (base n (S k)) y) *)
(* Goal: cbl (vn_eparams (S n)) (@app (prod (vect n) (vect n)) (@map (vect n) (prod (vect n) (vect n)) (dlift n) (base n k)) (@map (vect n) (prod (vect n) (vect n)) (lift n) (base n (S k)))) (@pair (vect n) (vect n) x y) *)
generalize HH; clear HH.
(* Goal: forall _ : cbl (vn_eparams (S n)) (@app (prod (vect n) (vect n)) (@map (vect n) (prod (vect n) (vect n)) (dlift n) (base n k)) (@map (vect n) (prod (vect n) (vect n)) (lift n) (base n (S k)))) (@pair (vect n) (vect n) x y), and (cbl (vn_eparams n) (base n k) x) (cbl (vn_eparams n) (base n (S k)) y) *)
(* Goal: cbl (vn_eparams (S n)) (@app (prod (vect n) (vect n)) (@map (vect n) (prod (vect n) (vect n)) (dlift n) (base n k)) (@map (vect n) (prod (vect n) (vect n)) (lift n) (base n (S k)))) (@pair (vect n) (vect n) x y) *)
generalize (base n k) (base n k.+1); intros l1 l2.
assert (He: exists l3, l3 = (map
 (dlift n) l1 ++ map (lift n) l2)%list).
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
exists (map (dlift n) l1 ++ map (lift n) l2)%list; auto.
(* Goal: forall _ : @Logic.eq (E (vn_eparams n)) v (joinl n (decomposek n (first_deg n v) v)), decomposable n (decomposek n (first_deg n v) v) v *)
(* Goal: forall _ : not (@Logic.eq (E (vn_eparams n)) v (joinl n (decomposek n (first_deg n v) v))), not (is_decomposable n v) *)
(* Goal: not (is_decomposable n v) *)
intros HH.
(* Goal: and (cbl (vn_eparams n) l1 x) (cbl (vn_eparams n) l2 y) *)
(* Goal: cbl (vn_eparams (S n)) (@app (prod (vect n) (vect n)) (@map (vect n) (prod (vect n) (vect n)) (dlift n) (base n k)) (@map (vect n) (prod (vect n) (vect n)) (lift n) (base n (S k)))) (@pair (vect n) (vect n) x y) *)
change (cbl (vn_eparams n) l1 (fst (x, y)) /\ cbl (vn_eparams n) l2 (snd (x, y))).
(* Goal: and (cbl (vn_eparams n) l1 (@fst (vect n) (vect n) (@pair (vect n) (vect n) x y))) (cbl (vn_eparams n) l2 (@snd (vect n) (vect n) (@pair (vect n) (vect n) x y))) *)
(* Goal: cbl (vn_eparams (S n)) (@app (prod (vect n) (vect n)) (@map (vect n) (prod (vect n) (vect n)) (dlift n) (base n k)) (@map (vect n) (prod (vect n) (vect n)) (lift n) (base n (S k)))) (@pair (vect n) (vect n) x y) *)
case He; intros l3 Hl3; simpl in Hl3; rewrite <-Hl3 in HH; generalize Hl3.
(* Goal: forall _ : @Logic.eq (list (prod (vect n) (vect n))) l3 (@app (prod (vect n) (vect n)) (@map (vect n) (prod (vect n) (vect n)) (dlift n) l1) (@map (vect n) (prod (vect n) (vect n)) (lift n) l2)), and (cbl (vn_eparams n) l1 (@fst (vect n) (vect n) (@pair (vect n) (vect n) x y))) (cbl (vn_eparams n) l2 (@snd (vect n) (vect n) (@pair (vect n) (vect n) x y))) *)
(* Goal: cbl (vn_eparams (S n)) (@app (prod (vect n) (vect n)) (@map (vect n) (prod (vect n) (vect n)) (dlift n) (base n k)) (@map (vect n) (prod (vect n) (vect n)) (lift n) (base n (S k)))) (@pair (vect n) (vect n) x y) *)
elim HH; clear HH Hl3.
(* Goal: cbl (vn_eparams O) (@nil (Field.K (K1 p))) (v0 (K1 p)) *)
(* Goal: forall k : nat, iff (cbl (vn_eparams (S n)) match k with | O => @map (vect n) (prod (vect n) (vect n)) (lift n) (base n k) | S k1 => @app (prod (vect n) (vect n)) (@map (vect n) (prod (vect n) (vect n)) (dlift n) (base n k1)) (@map (vect n) (prod (vect n) (vect n)) (lift n) (base n k)) end x) (b2Prop (let (l2, l3) := x in andb match k with | O => eq0 n l2 | S k1 => hom n k1 l2 end (hom n k l3))) *)
intros; split; constructor.
(* Goal: forall (v : E (vn_eparams (S n))) (_ : @In (E (vn_eparams (S n))) v l3) (_ : @Logic.eq (list (prod (vect n) (vect n))) l3 (@app (prod (vect n) (vect n)) (@map (vect n) (prod (vect n) (vect n)) (dlift n) l1) (@map (vect n) (prod (vect n) (vect n)) (lift n) l2))), and (cbl (vn_eparams n) l1 (@fst (vect n) (vect n) v)) (cbl (vn_eparams n) l2 (@snd (vect n) (vect n) v)) *)
(* Goal: forall (x y : E (vn_eparams (S n))) (_ : cbl (vn_eparams (S n)) l3 x) (_ : forall _ : @Logic.eq (list (prod (vect n) (vect n))) l3 (@app (prod (vect n) (vect n)) (@map (vect n) (prod (vect n) (vect n)) (dlift n) l1) (@map (vect n) (prod (vect n) (vect n)) (lift n) l2)), and (cbl (vn_eparams n) l1 (@fst (vect n) (vect n) x)) (cbl (vn_eparams n) l2 (@snd (vect n) (vect n) x))) (_ : cbl (vn_eparams (S n)) l3 y) (_ : forall _ : @Logic.eq (list (prod (vect n) (vect n))) l3 (@app (prod (vect n) (vect n)) (@map (vect n) (prod (vect n) (vect n)) (dlift n) l1) (@map (vect n) (prod (vect n) (vect n)) (lift n) l2)), and (cbl (vn_eparams n) l1 (@fst (vect n) (vect n) y)) (cbl (vn_eparams n) l2 (@snd (vect n) (vect n) y))) (_ : @Logic.eq (list (prod (vect n) (vect n))) l3 (@app (prod (vect n) (vect n)) (@map (vect n) (prod (vect n) (vect n)) (dlift n) l1) (@map (vect n) (prod (vect n) (vect n)) (lift n) l2))), and (cbl (vn_eparams n) l1 (@fst (vect n) (vect n) (addE (vn_eparams (S n)) x y))) (cbl (vn_eparams n) l2 (@snd (vect n) (vect n) (addE (vn_eparams (S n)) x y))) *)
(* Goal: forall (k : Field.K (stype (vn_eparams (S n)))) (x : E (vn_eparams (S n))) (_ : cbl (vn_eparams (S n)) l3 x) (_ : forall _ : @Logic.eq (list (prod (vect n) (vect n))) l3 (@app (prod (vect n) (vect n)) (@map (vect n) (prod (vect n) (vect n)) (dlift n) l1) (@map (vect n) (prod (vect n) (vect n)) (lift n) l2)), and (cbl (vn_eparams n) l1 (@fst (vect n) (vect n) x)) (cbl (vn_eparams n) l2 (@snd (vect n) (vect n) x))) (_ : @Logic.eq (list (prod (vect n) (vect n))) l3 (@app (prod (vect n) (vect n)) (@map (vect n) (prod (vect n) (vect n)) (dlift n) l1) (@map (vect n) (prod (vect n) (vect n)) (lift n) l2))), and (cbl (vn_eparams n) l1 (@fst (vect n) (vect n) (scalE (vn_eparams (S n)) k x))) (cbl (vn_eparams n) l2 (@snd (vect n) (vect n) (scalE (vn_eparams (S n)) k x))) *)
(* Goal: cbl (vn_eparams (S n)) (@app (prod (vect n) (vect n)) (@map (vect n) (prod (vect n) (vect n)) (dlift n) (base n k)) (@map (vect n) (prod (vect n) (vect n)) (lift n) (base n (S k)))) (@pair (vect n) (vect n) x y) *)
simpl; intros (x1, y1) H1 H2; subst.
case (in_app_or _ _ _ H1); rewrite in_map_iff; intros (v, (H1v, H2v));
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
  injection H1v; intros; subst; split; constructor; auto.
(* Goal: forall (x y : E (vn_eparams (S n))) (_ : cbl (vn_eparams (S n)) l3 x) (_ : forall _ : @Logic.eq (list (prod (vect n) (vect n))) l3 (@app (prod (vect n) (vect n)) (@map (vect n) (prod (vect n) (vect n)) (dlift n) l1) (@map (vect n) (prod (vect n) (vect n)) (lift n) l2)), and (cbl (vn_eparams n) l1 (@fst (vect n) (vect n) x)) (cbl (vn_eparams n) l2 (@snd (vect n) (vect n) x))) (_ : cbl (vn_eparams (S n)) l3 y) (_ : forall _ : @Logic.eq (list (prod (vect n) (vect n))) l3 (@app (prod (vect n) (vect n)) (@map (vect n) (prod (vect n) (vect n)) (dlift n) l1) (@map (vect n) (prod (vect n) (vect n)) (lift n) l2)), and (cbl (vn_eparams n) l1 (@fst (vect n) (vect n) y)) (cbl (vn_eparams n) l2 (@snd (vect n) (vect n) y))) (_ : @Logic.eq (list (prod (vect n) (vect n))) l3 (@app (prod (vect n) (vect n)) (@map (vect n) (prod (vect n) (vect n)) (dlift n) l1) (@map (vect n) (prod (vect n) (vect n)) (lift n) l2))), and (cbl (vn_eparams n) l1 (@fst (vect n) (vect n) (addE (vn_eparams (S n)) x y))) (cbl (vn_eparams n) l2 (@snd (vect n) (vect n) (addE (vn_eparams (S n)) x y))) *)
(* Goal: forall (k : Field.K (stype (vn_eparams (S n)))) (x : E (vn_eparams (S n))) (_ : cbl (vn_eparams (S n)) l3 x) (_ : forall _ : @Logic.eq (list (prod (vect n) (vect n))) l3 (@app (prod (vect n) (vect n)) (@map (vect n) (prod (vect n) (vect n)) (dlift n) l1) (@map (vect n) (prod (vect n) (vect n)) (lift n) l2)), and (cbl (vn_eparams n) l1 (@fst (vect n) (vect n) x)) (cbl (vn_eparams n) l2 (@snd (vect n) (vect n) x))) (_ : @Logic.eq (list (prod (vect n) (vect n))) l3 (@app (prod (vect n) (vect n)) (@map (vect n) (prod (vect n) (vect n)) (dlift n) l1) (@map (vect n) (prod (vect n) (vect n)) (lift n) l2))), and (cbl (vn_eparams n) l1 (@fst (vect n) (vect n) (scalE (vn_eparams (S n)) k x))) (cbl (vn_eparams n) l2 (@snd (vect n) (vect n) (scalE (vn_eparams (S n)) k x))) *)
(* Goal: cbl (vn_eparams (S n)) (@app (prod (vect n) (vect n)) (@map (vect n) (prod (vect n) (vect n)) (dlift n) (base n k)) (@map (vect n) (prod (vect n) (vect n)) (lift n) (base n (S k)))) (@pair (vect n) (vect n) x y) *)
simpl; intros (x1,x2) (y1, y2) Hx1 H1 H2 H3 H4; Vfold n.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
split; auto; simpl fst; simpl snd; apply cbl_add; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
case H1; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
case H3; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
case H1; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
case H3; auto.
(* Goal: forall (k : Field.K (stype (vn_eparams (S n)))) (x : E (vn_eparams (S n))) (_ : cbl (vn_eparams (S n)) l3 x) (_ : forall _ : @Logic.eq (list (prod (vect n) (vect n))) l3 (@app (prod (vect n) (vect n)) (@map (vect n) (prod (vect n) (vect n)) (dlift n) l1) (@map (vect n) (prod (vect n) (vect n)) (lift n) l2)), and (cbl (vn_eparams n) l1 (@fst (vect n) (vect n) x)) (cbl (vn_eparams n) l2 (@snd (vect n) (vect n) x))) (_ : @Logic.eq (list (prod (vect n) (vect n))) l3 (@app (prod (vect n) (vect n)) (@map (vect n) (prod (vect n) (vect n)) (dlift n) l1) (@map (vect n) (prod (vect n) (vect n)) (lift n) l2))), and (cbl (vn_eparams n) l1 (@fst (vect n) (vect n) (scalE (vn_eparams (S n)) k x))) (cbl (vn_eparams n) l2 (@snd (vect n) (vect n) (scalE (vn_eparams (S n)) k x))) *)
(* Goal: cbl (vn_eparams (S n)) (@app (prod (vect n) (vect n)) (@map (vect n) (prod (vect n) (vect n)) (dlift n) (base n k)) (@map (vect n) (prod (vect n) (vect n)) (lift n) (base n (S k)))) (@pair (vect n) (vect n) x y) *)
simpl; intros k1 (x1, x2) Hx1 H1 H2.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
split; auto; simpl fst; simpl snd; apply cbl_scal; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
case H1; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
case H1; auto.
(* Goal: cbl (vn_eparams (S n)) (@app (prod (vect n) (vect n)) (@map (vect n) (prod (vect n) (vect n)) (dlift n) (base n k)) (@map (vect n) (prod (vect n) (vect n)) (lift n) (base n (S k)))) (@pair (vect n) (vect n) x y) *)
rewrite andbP in HH; case HH; intros HH1 HH2.
(* Goal: cbl (vn_eparams (S n)) (@app (prod (vect n) (vect n)) (@map (vect n) (prod (vect n) (vect n)) (dlift n) (base n k)) (@map (vect n) (prod (vect n) (vect n)) (lift n) (base n (S k)))) (@pair (vect n) (vect n) x y) *)
replace (x,y) with (dlift n x + lift n y).
(* Goal: cbl (vn_eparams (S n)) (@app (prod (vect n) (vect n)) (@map (vect n) (prod (vect n) (vect n)) (dlift n) (base n k)) (@map (vect n) (prod (vect n) (vect n)) (lift n) (base n (S k)))) (addE (vn_eparams (S n)) (dlift n x) (lift n y)) *)
(* Goal: @Logic.eq (E (vn_eparams (S n))) (addE (vn_eparams (S n)) (dlift n x) (lift n y)) (@pair (vect n) (vect n) x y) *)
apply cbl_add.
(* Goal: cbl (vn_eparams (S n)) (@app (prod (vect n) (vect n)) (@map (vect n) (prod (vect n) (vect n)) (dlift n) (base n k)) (@map (vect n) (prod (vect n) (vect n)) (lift n) (base n (S k)))) (dlift n x) *)
(* Goal: cbl (vn_eparams (S n)) (@app (prod (vect n) (vect n)) (@map (vect n) (prod (vect n) (vect n)) (dlift n) (base n k)) (@map (vect n) (prod (vect n) (vect n)) (lift n) (base n (S k)))) (lift n y) *)
(* Goal: @Logic.eq (E (vn_eparams (S n))) (addE (vn_eparams (S n)) (dlift n x) (lift n y)) (@pair (vect n) (vect n) x y) *)
apply cbl_incl with (l1 := map (dlift n) (base n k)); auto with datatypes.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply cbl_map with (f := dlift n) (g:= id); auto.
(* Goal: forall x y : E (vn_eparams n), @Logic.eq (E (vn_eparams (S n))) (dlift n (addE (vn_eparams n) x y)) (addE (vn_eparams (S n)) (dlift n x) (dlift n y)) *)
(* Goal: forall (k : Field.K (stype (vn_eparams n))) (x : E (vn_eparams n)), @Logic.eq (E (vn_eparams (S n))) (dlift n (scalE (vn_eparams n) k x)) (scalE (vn_eparams (S n)) (@id (Field.K (stype (vn_eparams n))) k) (dlift n x)) *)
(* Goal: cbl (vn_eparams n) (base n k) x *)
(* Goal: cbl (vn_eparams (S n)) (@app (prod (vect n) (vect n)) (@map (vect n) (prod (vect n) (vect n)) (dlift n) (base n k)) (@map (vect n) (prod (vect n) (vect n)) (lift n) (base n (S k)))) (lift n y) *)
(* Goal: @Logic.eq (E (vn_eparams (S n))) (addE (vn_eparams (S n)) (dlift n x) (lift n y)) (@pair (vect n) (vect n) x y) *)
intros; apply (dlift_add n).
(* Goal: forall (k : Field.K (stype (vn_eparams n))) (x : E (vn_eparams n)), @Logic.eq (E (vn_eparams (S n))) (dlift n (scalE (vn_eparams n) k x)) (scalE (vn_eparams (S n)) (@id (Field.K (stype (vn_eparams n))) k) (dlift n x)) *)
(* Goal: cbl (vn_eparams n) (base n k) x *)
(* Goal: cbl (vn_eparams (S n)) (@app (prod (vect n) (vect n)) (@map (vect n) (prod (vect n) (vect n)) (dlift n) (base n k)) (@map (vect n) (prod (vect n) (vect n)) (lift n) (base n (S k)))) (lift n y) *)
(* Goal: @Logic.eq (E (vn_eparams (S n))) (addE (vn_eparams (S n)) (dlift n x) (lift n y)) (@pair (vect n) (vect n) x y) *)
intros; apply (dlift_scal n).
(* Goal: @Logic.eq (vect n) (meet n (meet n v v1) v3) (meet n v (meet n v1 v3)) *)
(* Goal: @Logic.eq (vect n) (addE (vn_eparams n) (meet n (meet n v v1) v4) (meet n (addE (vn_eparams n) (meet n v v2) (meet n v0 (dconj n false v1))) (dconj n false v3))) (addE (vn_eparams n) (meet n v (addE (vn_eparams n) (meet n v1 v4) (meet n v2 (dconj n false v3)))) (meet n v0 (dconj n false (meet n v1 v3)))) *)
rewrite IH; auto.
(* Goal: cbl (vn_eparams (S n)) (@app (prod (vect n) (vect n)) (@map (vect n) (prod (vect n) (vect n)) (dlift n) (base n k)) (@map (vect n) (prod (vect n) (vect n)) (lift n) (base n (S k)))) (lift n y) *)
(* Goal: @Logic.eq (E (vn_eparams (S n))) (addE (vn_eparams (S n)) (dlift n x) (lift n y)) (@pair (vect n) (vect n) x y) *)
apply cbl_incl with (l1 := map (lift n) (base n k.+1)); auto with datatypes.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply cbl_map with (f := lift n) (g:= id); auto.
(* Goal: forall x y : E (vn_eparams n), @Logic.eq (E (vn_eparams (S n))) (lift n (addE (vn_eparams n) x y)) (addE (vn_eparams (S n)) (lift n x) (lift n y)) *)
(* Goal: forall (k : Field.K (stype (vn_eparams n))) (x : E (vn_eparams n)), @Logic.eq (E (vn_eparams (S n))) (lift n (scalE (vn_eparams n) k x)) (scalE (vn_eparams (S n)) (@id (Field.K (stype (vn_eparams n))) k) (lift n x)) *)
(* Goal: cbl (vn_eparams n) (base n (S k)) y *)
(* Goal: @Logic.eq (E (vn_eparams (S n))) (addE (vn_eparams (S n)) (dlift n x) (lift n y)) (@pair (vect n) (vect n) x y) *)
intros; apply (lift_add n).
(* Goal: forall (k : Field.K (stype (vn_eparams n))) (x : E (vn_eparams n)), @Logic.eq (E (vn_eparams (S n))) (lift n (scalE (vn_eparams n) k x)) (scalE (vn_eparams (S n)) (@id (Field.K (stype (vn_eparams n))) k) (lift n x)) *)
(* Goal: cbl (vn_eparams n) (base n (S k)) y *)
(* Goal: @Logic.eq (E (vn_eparams (S n))) (addE (vn_eparams (S n)) (dlift n x) (lift n y)) (@pair (vect n) (vect n) x y) *)
intros; apply (lift_scal n).
(* Goal: @Logic.eq (vect n) (meet n (meet n v v1) v3) (meet n v (meet n v1 v3)) *)
(* Goal: @Logic.eq (vect n) (addE (vn_eparams n) (meet n (meet n v v1) v4) (meet n (addE (vn_eparams n) (meet n v v2) (meet n v0 (dconj n false v1))) (dconj n false v3))) (addE (vn_eparams n) (meet n v (addE (vn_eparams n) (meet n v1 v4) (meet n v2 (dconj n false v3)))) (meet n v0 (dconj n false (meet n v1 v3)))) *)
rewrite IH; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
simpl; Vfold n; Vrm0; auto.
Qed.

Lemma cbl_base1_split n x :
 cbl _ (base n.+1 1) x -> exists k, exists y, cbl _ (base n 1) y /\ x = ([k], y).
Proof.
(* Goal: forall _ : cbl (vn_eparams (S n)) (base (S n) (S O)) x, @ex (Field.K (K1 p)) (fun k : Field.K (K1 p) => @ex (E (vn_eparams n)) (fun y : E (vn_eparams n) => and (cbl (vn_eparams n) (base n (S O)) y) (@Logic.eq (E (vn_eparams (S n))) x (@pair (vect n) (E (vn_eparams n)) (genk n k) y)))) *)
intros H; elim H; clear x H.
(* Goal: cbl (vn_eparams (S n)) (@map (vect n) (vect (S n)) (lift n) l) (lift n (E0 (vn_eparams n))) *)
(* Goal: forall (v : E (vn_eparams n)) (_ : @In (E (vn_eparams n)) v l), cbl (vn_eparams (S n)) (@map (vect n) (vect (S n)) (lift n) l) (lift n v) *)
(* Goal: forall (x y : E (vn_eparams n)) (_ : cbl (vn_eparams n) l x) (_ : cbl (vn_eparams (S n)) (@map (vect n) (vect (S n)) (lift n) l) (lift n x)) (_ : cbl (vn_eparams n) l y) (_ : cbl (vn_eparams (S n)) (@map (vect n) (vect (S n)) (lift n) l) (lift n y)), cbl (vn_eparams (S n)) (@map (vect n) (vect (S n)) (lift n) l) (lift n (addE (vn_eparams n) x y)) *)
(* Goal: forall (k : Field.K (stype (vn_eparams n))) (x : E (vn_eparams n)) (_ : cbl (vn_eparams n) l x) (_ : cbl (vn_eparams (S n)) (@map (vect n) (vect (S n)) (lift n) l) (lift n x)), cbl (vn_eparams (S n)) (@map (vect n) (vect (S n)) (lift n) l) (lift n (scalE (vn_eparams n) k x)) *)
exists (0%f); exists (0: vect n); split; auto; apply cbl0.
(* Goal: forall (v : E (vn_eparams (S n))) (_ : @In (E (vn_eparams (S n))) v (base (S n) (S O))), @ex (Field.K (K1 p)) (fun k : Field.K (K1 p) => @ex (E (vn_eparams n)) (fun y : E (vn_eparams n) => and (cbl (vn_eparams n) (base n (S O)) y) (@Logic.eq (E (vn_eparams (S n))) v (@pair (vect n) (E (vn_eparams n)) (genk n k) y)))) *)
(* Goal: forall (x y : E (vn_eparams (S n))) (_ : cbl (vn_eparams (S n)) (base (S n) (S O)) x) (_ : @ex (Field.K (K1 p)) (fun k : Field.K (K1 p) => @ex (E (vn_eparams n)) (fun y0 : E (vn_eparams n) => and (cbl (vn_eparams n) (base n (S O)) y0) (@Logic.eq (E (vn_eparams (S n))) x (@pair (vect n) (E (vn_eparams n)) (genk n k) y0))))) (_ : cbl (vn_eparams (S n)) (base (S n) (S O)) y) (_ : @ex (Field.K (K1 p)) (fun k : Field.K (K1 p) => @ex (E (vn_eparams n)) (fun y0 : E (vn_eparams n) => and (cbl (vn_eparams n) (base n (S O)) y0) (@Logic.eq (E (vn_eparams (S n))) y (@pair (vect n) (E (vn_eparams n)) (genk n k) y0))))), @ex (Field.K (K1 p)) (fun k : Field.K (K1 p) => @ex (E (vn_eparams n)) (fun y0 : E (vn_eparams n) => and (cbl (vn_eparams n) (base n (S O)) y0) (@Logic.eq (E (vn_eparams (S n))) (addE (vn_eparams (S n)) x y) (@pair (vect n) (E (vn_eparams n)) (genk n k) y0)))) *)
(* Goal: forall (k : Field.K (stype (vn_eparams (S n)))) (x : E (vn_eparams (S n))) (_ : cbl (vn_eparams (S n)) (base (S n) (S O)) x) (_ : @ex (Field.K (K1 p)) (fun k0 : Field.K (K1 p) => @ex (E (vn_eparams n)) (fun y : E (vn_eparams n) => and (cbl (vn_eparams n) (base n (S O)) y) (@Logic.eq (E (vn_eparams (S n))) x (@pair (vect n) (E (vn_eparams n)) (genk n k0) y))))), @ex (Field.K (K1 p)) (fun k0 : Field.K (K1 p) => @ex (E (vn_eparams n)) (fun y : E (vn_eparams n) => and (cbl (vn_eparams n) (base n (S O)) y) (@Logic.eq (E (vn_eparams (S n))) (scalE (vn_eparams (S n)) k x) (@pair (vect n) (E (vn_eparams n)) (genk n k0) y)))) *)
intros v; rewrite base1_S; simpl In.
(* Goal: forall _ : or (not (and (b2Prop b) (b2Prop (hom n (S O) a)))) (@ex (vect n) (fun i : vect n => and (@In (vect n) i l) (not (b2Prop (hom n (S O) i))))), or (not (b2Prop b)) (@ex (vect n) (fun i : vect n => and (or (@Logic.eq (vect n) a i) (@In (vect n) i l)) (not (b2Prop (hom n (S O) i))))) *)
(* Goal: if @fold_left bool (vect n) (fun (c : bool) (x : vect n) => andb c (hom n (S O) x)) l true then forall (i : vect n) (_ : @In (vect n) i l), b2Prop (hom n (S O) i) else @ex (vect n) (fun i : vect n => and (@In (vect n) i l) (not (b2Prop (hom n (S O) i)))) *)
intros [H1 | H1].
(* Goal: cbl (vn_eparams (S n)) (@map (vect n) (vect (S n)) (lift n) l) (lift n (E0 (vn_eparams n))) *)
(* Goal: forall (v : E (vn_eparams n)) (_ : @In (E (vn_eparams n)) v l), cbl (vn_eparams (S n)) (@map (vect n) (vect (S n)) (lift n) l) (lift n v) *)
(* Goal: forall (x y : E (vn_eparams n)) (_ : cbl (vn_eparams n) l x) (_ : cbl (vn_eparams (S n)) (@map (vect n) (vect (S n)) (lift n) l) (lift n x)) (_ : cbl (vn_eparams n) l y) (_ : cbl (vn_eparams (S n)) (@map (vect n) (vect (S n)) (lift n) l) (lift n y)), cbl (vn_eparams (S n)) (@map (vect n) (vect (S n)) (lift n) l) (lift n (addE (vn_eparams n) x y)) *)
(* Goal: forall (k : Field.K (stype (vn_eparams n))) (x : E (vn_eparams n)) (_ : cbl (vn_eparams n) l x) (_ : cbl (vn_eparams (S n)) (@map (vect n) (vect (S n)) (lift n) l) (lift n x)), cbl (vn_eparams (S n)) (@map (vect n) (vect (S n)) (lift n) l) (lift n (scalE (vn_eparams n) k x)) *)
exists (1%f: K); exists (0: vect n); split; auto; apply cbl0.
(* Goal: @ex (Field.K (K1 p)) (fun k : Field.K (K1 p) => @ex (E (vn_eparams n)) (fun y : E (vn_eparams n) => and (cbl (vn_eparams n) (base n (S O)) y) (@Logic.eq (E (vn_eparams (S n))) v (@pair (vect n) (E (vn_eparams n)) (genk n k) y)))) *)
(* Goal: forall (x y : E (vn_eparams (S n))) (_ : cbl (vn_eparams (S n)) (base (S n) (S O)) x) (_ : @ex (Field.K (K1 p)) (fun k : Field.K (K1 p) => @ex (E (vn_eparams n)) (fun y0 : E (vn_eparams n) => and (cbl (vn_eparams n) (base n (S O)) y0) (@Logic.eq (E (vn_eparams (S n))) x (@pair (vect n) (E (vn_eparams n)) (genk n k) y0))))) (_ : cbl (vn_eparams (S n)) (base (S n) (S O)) y) (_ : @ex (Field.K (K1 p)) (fun k : Field.K (K1 p) => @ex (E (vn_eparams n)) (fun y0 : E (vn_eparams n) => and (cbl (vn_eparams n) (base n (S O)) y0) (@Logic.eq (E (vn_eparams (S n))) y (@pair (vect n) (E (vn_eparams n)) (genk n k) y0))))), @ex (Field.K (K1 p)) (fun k : Field.K (K1 p) => @ex (E (vn_eparams n)) (fun y0 : E (vn_eparams n) => and (cbl (vn_eparams n) (base n (S O)) y0) (@Logic.eq (E (vn_eparams (S n))) (addE (vn_eparams (S n)) x y) (@pair (vect n) (E (vn_eparams n)) (genk n k) y0)))) *)
(* Goal: forall (k : Field.K (stype (vn_eparams (S n)))) (x : E (vn_eparams (S n))) (_ : cbl (vn_eparams (S n)) (base (S n) (S O)) x) (_ : @ex (Field.K (K1 p)) (fun k0 : Field.K (K1 p) => @ex (E (vn_eparams n)) (fun y : E (vn_eparams n) => and (cbl (vn_eparams n) (base n (S O)) y) (@Logic.eq (E (vn_eparams (S n))) x (@pair (vect n) (E (vn_eparams n)) (genk n k0) y))))), @ex (Field.K (K1 p)) (fun k0 : Field.K (K1 p) => @ex (E (vn_eparams n)) (fun y : E (vn_eparams n) => and (cbl (vn_eparams n) (base n (S O)) y) (@Logic.eq (E (vn_eparams (S n))) (scalE (vn_eparams (S n)) k x) (@pair (vect n) (E (vn_eparams n)) (genk n k0) y)))) *)
rewrite in_map_iff in H1; case H1; intros y [H1y H2y].
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
exists (0%f); exists y; split; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply cbl_in; auto.
intros x y _ (k1,(y1, (H1y1, H2y1))) _ (k2,(y2, (H1y2, H2y2)));
  subst x y.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
exists (k1 + k2)%f; exists (y1 + y2); split; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply cbl_add; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
simpl; Vfold n; rewrite addk; auto.
(* Goal: forall (k : Field.K (stype (vn_eparams (S n)))) (x : E (vn_eparams (S n))) (_ : cbl (vn_eparams (S n)) (base (S n) (S O)) x) (_ : @ex (Field.K (K1 p)) (fun k0 : Field.K (K1 p) => @ex (E (vn_eparams n)) (fun y : E (vn_eparams n) => and (cbl (vn_eparams n) (base n (S O)) y) (@Logic.eq (E (vn_eparams (S n))) x (@pair (vect n) (E (vn_eparams n)) (genk n k0) y))))), @ex (Field.K (K1 p)) (fun k0 : Field.K (K1 p) => @ex (E (vn_eparams n)) (fun y : E (vn_eparams n) => and (cbl (vn_eparams n) (base n (S O)) y) (@Logic.eq (E (vn_eparams (S n))) (scalE (vn_eparams (S n)) k x) (@pair (vect n) (E (vn_eparams n)) (genk n k0) y)))) *)
intros k x _ (k1, (y, (H1y, H2y))); subst x.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
exists (k*k1)%f; exists ((k: K) .* y); split; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply cbl_scal; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
simpl; Vfold n; rewrite scalk; auto.
Qed.

Lemma cbl_base1_list_split n l:
 (forall x, In x l -> cbl _ (base n.+1 1) x) -> 
   exists lk, exists ly,
    (forall i, In i lk -> (fst i) <> 0%f) /\
    (forall i, In i lk -> cbl _ (base n 1) (snd i)) /\
    (forall i, In i ly -> cbl _ (base n 1) i) /\
    perm l ((map (fun x => ([fst x],(snd x))) lk) ++ map (lift n) ly).
Proof.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
induction l as [| a l1 IH]; auto.
(* Goal: forall _ : forall (x : E (vn_eparams (S n))) (_ : @In (E (vn_eparams (S n))) x (@nil (E (vn_eparams (S n))))), cbl (vn_eparams (S n)) (base (S n) (S O)) x, @ex (list (prod (Field.K (K1 p)) (E (vn_eparams n)))) (fun lk : list (prod (Field.K (K1 p)) (E (vn_eparams n))) => @ex (list (E (vn_eparams n))) (fun ly : list (E (vn_eparams n)) => and (forall (i : prod (Field.K (K1 p)) (E (vn_eparams n))) (_ : @In (prod (Field.K (K1 p)) (E (vn_eparams n))) i lk), not (@Logic.eq (Field.K (K1 p)) (@fst (Field.K (K1 p)) (E (vn_eparams n)) i) (v0 (K1 p)))) (and (forall (i : prod (Field.K (K1 p)) (E (vn_eparams n))) (_ : @In (prod (Field.K (K1 p)) (E (vn_eparams n))) i lk), cbl (vn_eparams n) (base n (S O)) (@snd (Field.K (K1 p)) (E (vn_eparams n)) i)) (and (forall (i : E (vn_eparams n)) (_ : @In (E (vn_eparams n)) i ly), cbl (vn_eparams n) (base n (S O)) i) (@perm (E (vn_eparams (S n))) (@nil (E (vn_eparams (S n)))) (@app (prod (vect n) (E (vn_eparams n))) (@map (prod (Field.K (K1 p)) (E (vn_eparams n))) (prod (vect n) (E (vn_eparams n))) (fun x : prod (Field.K (K1 p)) (E (vn_eparams n)) => @pair (vect n) (E (vn_eparams n)) (genk n (@fst (Field.K (K1 p)) (E (vn_eparams n)) x)) (@snd (Field.K (K1 p)) (E (vn_eparams n)) x)) lk) (@map (vect n) (vect (S n)) (lift n) ly))))))) *)
(* Goal: forall _ : forall (x : E (vn_eparams (S n))) (_ : @In (E (vn_eparams (S n))) x (@cons (E (vn_eparams (S n))) a l1)), cbl (vn_eparams (S n)) (base (S n) (S O)) x, @ex (list (prod (Field.K (K1 p)) (E (vn_eparams n)))) (fun lk : list (prod (Field.K (K1 p)) (E (vn_eparams n))) => @ex (list (E (vn_eparams n))) (fun ly : list (E (vn_eparams n)) => and (forall (i : prod (Field.K (K1 p)) (E (vn_eparams n))) (_ : @In (prod (Field.K (K1 p)) (E (vn_eparams n))) i lk), not (@Logic.eq (Field.K (K1 p)) (@fst (Field.K (K1 p)) (E (vn_eparams n)) i) (v0 (K1 p)))) (and (forall (i : prod (Field.K (K1 p)) (E (vn_eparams n))) (_ : @In (prod (Field.K (K1 p)) (E (vn_eparams n))) i lk), cbl (vn_eparams n) (base n (S O)) (@snd (Field.K (K1 p)) (E (vn_eparams n)) i)) (and (forall (i : E (vn_eparams n)) (_ : @In (E (vn_eparams n)) i ly), cbl (vn_eparams n) (base n (S O)) i) (@perm (E (vn_eparams (S n))) (@cons (E (vn_eparams (S n))) a l1) (@app (prod (vect n) (E (vn_eparams n))) (@map (prod (Field.K (K1 p)) (E (vn_eparams n))) (prod (vect n) (E (vn_eparams n))) (fun x : prod (Field.K (K1 p)) (E (vn_eparams n)) => @pair (vect n) (E (vn_eparams n)) (genk n (@fst (Field.K (K1 p)) (E (vn_eparams n)) x)) (@snd (Field.K (K1 p)) (E (vn_eparams n)) x)) lk) (@map (vect n) (vect (S n)) (lift n) ly))))))) *)
intros; exists (@nil (K * vect n)); exists (@nil (vect n)); repeat split.
(* Goal: @ex nat (fun p1 : nat => and (lt p1 O) (@Logic.eq (vect O) v (gen O p1))) *)
(* Goal: @ex nat (fun p1 : nat => and (lt p1 (S n)) (@Logic.eq (vect (S n)) v (gen (S n) p1))) *)
intros i HH; inversion HH.
(* Goal: @ex nat (fun p1 : nat => and (lt p1 O) (@Logic.eq (vect O) v (gen O p1))) *)
(* Goal: @ex nat (fun p1 : nat => and (lt p1 (S n)) (@Logic.eq (vect (S n)) v (gen (S n) p1))) *)
intros i HH; inversion HH.
(* Goal: @ex nat (fun p1 : nat => and (lt p1 O) (@Logic.eq (vect O) v (gen O p1))) *)
(* Goal: @ex nat (fun p1 : nat => and (lt p1 (S n)) (@Logic.eq (vect (S n)) v (gen (S n) p1))) *)
intros i HH; inversion HH.
(* Goal: @perm (E (vn_eparams (S n))) (@nil (E (vn_eparams (S n)))) (@app (prod (vect n) (E (vn_eparams n))) (@map (prod (Field.K (K1 p)) (E (vn_eparams n))) (prod (vect n) (E (vn_eparams n))) (fun x : prod (Field.K (K1 p)) (E (vn_eparams n)) => @pair (vect n) (E (vn_eparams n)) (genk n (@fst (Field.K (K1 p)) (E (vn_eparams n)) x)) (@snd (Field.K (K1 p)) (E (vn_eparams n)) x)) (@nil (prod (Field.K (K1 p)) (vect n)))) (@map (vect n) (vect (S n)) (lift n) (@nil (vect n)))) *)
(* Goal: forall _ : forall (x : E (vn_eparams (S n))) (_ : @In (E (vn_eparams (S n))) x (@cons (E (vn_eparams (S n))) a l1)), cbl (vn_eparams (S n)) (base (S n) (S O)) x, @ex (list (prod (Field.K (K1 p)) (E (vn_eparams n)))) (fun lk : list (prod (Field.K (K1 p)) (E (vn_eparams n))) => @ex (list (E (vn_eparams n))) (fun ly : list (E (vn_eparams n)) => and (forall (i : prod (Field.K (K1 p)) (E (vn_eparams n))) (_ : @In (prod (Field.K (K1 p)) (E (vn_eparams n))) i lk), not (@Logic.eq (Field.K (K1 p)) (@fst (Field.K (K1 p)) (E (vn_eparams n)) i) (v0 (K1 p)))) (and (forall (i : prod (Field.K (K1 p)) (E (vn_eparams n))) (_ : @In (prod (Field.K (K1 p)) (E (vn_eparams n))) i lk), cbl (vn_eparams n) (base n (S O)) (@snd (Field.K (K1 p)) (E (vn_eparams n)) i)) (and (forall (i : E (vn_eparams n)) (_ : @In (E (vn_eparams n)) i ly), cbl (vn_eparams n) (base n (S O)) i) (@perm (E (vn_eparams (S n))) (@cons (E (vn_eparams (S n))) a l1) (@app (prod (vect n) (E (vn_eparams n))) (@map (prod (Field.K (K1 p)) (E (vn_eparams n))) (prod (vect n) (E (vn_eparams n))) (fun x : prod (Field.K (K1 p)) (E (vn_eparams n)) => @pair (vect n) (E (vn_eparams n)) (genk n (@fst (Field.K (K1 p)) (E (vn_eparams n)) x)) (@snd (Field.K (K1 p)) (E (vn_eparams n)) x)) lk) (@map (vect n) (vect (S n)) (lift n) ly))))))) *)
simpl map; apply perm_id.
(* Goal: forall _ : forall (x : E (vn_eparams (S n))) (_ : @In (E (vn_eparams (S n))) x (@cons (E (vn_eparams (S n))) a l1)), cbl (vn_eparams (S n)) (base (S n) (S O)) x, @ex (list (prod (Field.K (K1 p)) (E (vn_eparams n)))) (fun lk : list (prod (Field.K (K1 p)) (E (vn_eparams n))) => @ex (list (E (vn_eparams n))) (fun ly : list (E (vn_eparams n)) => and (forall (i : prod (Field.K (K1 p)) (E (vn_eparams n))) (_ : @In (prod (Field.K (K1 p)) (E (vn_eparams n))) i lk), not (@Logic.eq (Field.K (K1 p)) (@fst (Field.K (K1 p)) (E (vn_eparams n)) i) (v0 (K1 p)))) (and (forall (i : prod (Field.K (K1 p)) (E (vn_eparams n))) (_ : @In (prod (Field.K (K1 p)) (E (vn_eparams n))) i lk), cbl (vn_eparams n) (base n (S O)) (@snd (Field.K (K1 p)) (E (vn_eparams n)) i)) (and (forall (i : E (vn_eparams n)) (_ : @In (E (vn_eparams n)) i ly), cbl (vn_eparams n) (base n (S O)) i) (@perm (E (vn_eparams (S n))) (@cons (E (vn_eparams (S n))) a l1) (@app (prod (vect n) (E (vn_eparams n))) (@map (prod (Field.K (K1 p)) (E (vn_eparams n))) (prod (vect n) (E (vn_eparams n))) (fun x : prod (Field.K (K1 p)) (E (vn_eparams n)) => @pair (vect n) (E (vn_eparams n)) (genk n (@fst (Field.K (K1 p)) (E (vn_eparams n)) x)) (@snd (Field.K (K1 p)) (E (vn_eparams n)) x)) lk) (@map (vect n) (vect (S n)) (lift n) ly))))))) *)
intros Hi.
(* Goal: @ex (list (prod (Field.K (K1 p)) (E (vn_eparams n)))) (fun lk : list (prod (Field.K (K1 p)) (E (vn_eparams n))) => @ex (list (E (vn_eparams n))) (fun ly : list (E (vn_eparams n)) => and (forall (i : prod (Field.K (K1 p)) (E (vn_eparams n))) (_ : @In (prod (Field.K (K1 p)) (E (vn_eparams n))) i lk), not (@Logic.eq (Field.K (K1 p)) (@fst (Field.K (K1 p)) (E (vn_eparams n)) i) (v0 (K1 p)))) (and (forall (i : prod (Field.K (K1 p)) (E (vn_eparams n))) (_ : @In (prod (Field.K (K1 p)) (E (vn_eparams n))) i lk), cbl (vn_eparams n) (base n (S O)) (@snd (Field.K (K1 p)) (E (vn_eparams n)) i)) (and (forall (i : E (vn_eparams n)) (_ : @In (E (vn_eparams n)) i ly), cbl (vn_eparams n) (base n (S O)) i) (@perm (E (vn_eparams (S n))) (@cons (E (vn_eparams (S n))) a l1) (@app (prod (vect n) (E (vn_eparams n))) (@map (prod (Field.K (K1 p)) (E (vn_eparams n))) (prod (vect n) (E (vn_eparams n))) (fun x : prod (Field.K (K1 p)) (E (vn_eparams n)) => @pair (vect n) (E (vn_eparams n)) (genk n (@fst (Field.K (K1 p)) (E (vn_eparams n)) x)) (@snd (Field.K (K1 p)) (E (vn_eparams n)) x)) lk) (@map (vect n) (vect (S n)) (lift n) ly))))))) *)
case IH; auto with datatypes.
(* Goal: forall (x : list (prod (Field.K (K1 p)) (E (vn_eparams n)))) (_ : @ex (list (E (vn_eparams n))) (fun ly : list (E (vn_eparams n)) => and (forall (i : prod (Field.K (K1 p)) (E (vn_eparams n))) (_ : @In (prod (Field.K (K1 p)) (E (vn_eparams n))) i x), not (@Logic.eq (Field.K (K1 p)) (@fst (Field.K (K1 p)) (E (vn_eparams n)) i) (v0 (K1 p)))) (and (forall (i : prod (Field.K (K1 p)) (E (vn_eparams n))) (_ : @In (prod (Field.K (K1 p)) (E (vn_eparams n))) i x), cbl (vn_eparams n) (base n (S O)) (@snd (Field.K (K1 p)) (E (vn_eparams n)) i)) (and (forall (i : E (vn_eparams n)) (_ : @In (E (vn_eparams n)) i ly), cbl (vn_eparams n) (base n (S O)) i) (@perm (E (vn_eparams (S n))) l1 (@app (prod (vect n) (E (vn_eparams n))) (@map (prod (Field.K (K1 p)) (E (vn_eparams n))) (prod (vect n) (E (vn_eparams n))) (fun x0 : prod (Field.K (K1 p)) (E (vn_eparams n)) => @pair (vect n) (E (vn_eparams n)) (genk n (@fst (Field.K (K1 p)) (E (vn_eparams n)) x0)) (@snd (Field.K (K1 p)) (E (vn_eparams n)) x0)) x) (@map (vect n) (vect (S n)) (lift n) ly))))))), @ex (list (prod (Field.K (K1 p)) (E (vn_eparams n)))) (fun lk : list (prod (Field.K (K1 p)) (E (vn_eparams n))) => @ex (list (E (vn_eparams n))) (fun ly : list (E (vn_eparams n)) => and (forall (i : prod (Field.K (K1 p)) (E (vn_eparams n))) (_ : @In (prod (Field.K (K1 p)) (E (vn_eparams n))) i lk), not (@Logic.eq (Field.K (K1 p)) (@fst (Field.K (K1 p)) (E (vn_eparams n)) i) (v0 (K1 p)))) (and (forall (i : prod (Field.K (K1 p)) (E (vn_eparams n))) (_ : @In (prod (Field.K (K1 p)) (E (vn_eparams n))) i lk), cbl (vn_eparams n) (base n (S O)) (@snd (Field.K (K1 p)) (E (vn_eparams n)) i)) (and (forall (i : E (vn_eparams n)) (_ : @In (E (vn_eparams n)) i ly), cbl (vn_eparams n) (base n (S O)) i) (@perm (E (vn_eparams (S n))) (@cons (E (vn_eparams (S n))) a l1) (@app (prod (vect n) (E (vn_eparams n))) (@map (prod (Field.K (K1 p)) (E (vn_eparams n))) (prod (vect n) (E (vn_eparams n))) (fun x0 : prod (Field.K (K1 p)) (E (vn_eparams n)) => @pair (vect n) (E (vn_eparams n)) (genk n (@fst (Field.K (K1 p)) (E (vn_eparams n)) x0)) (@snd (Field.K (K1 p)) (E (vn_eparams n)) x0)) lk) (@map (vect n) (vect (S n)) (lift n) ly))))))) *)
intros lk (ly, (H1ly, (H2ly, (H3ly, H4ly)))).
(* Goal: @ex (list (prod (Field.K (K1 p)) (E (vn_eparams n)))) (fun lk : list (prod (Field.K (K1 p)) (E (vn_eparams n))) => @ex (list (E (vn_eparams n))) (fun ly : list (E (vn_eparams n)) => and (forall (i : prod (Field.K (K1 p)) (E (vn_eparams n))) (_ : @In (prod (Field.K (K1 p)) (E (vn_eparams n))) i lk), not (@Logic.eq (Field.K (K1 p)) (@fst (Field.K (K1 p)) (E (vn_eparams n)) i) (v0 (K1 p)))) (and (forall (i : prod (Field.K (K1 p)) (E (vn_eparams n))) (_ : @In (prod (Field.K (K1 p)) (E (vn_eparams n))) i lk), cbl (vn_eparams n) (base n (S O)) (@snd (Field.K (K1 p)) (E (vn_eparams n)) i)) (and (forall (i : E (vn_eparams n)) (_ : @In (E (vn_eparams n)) i ly), cbl (vn_eparams n) (base n (S O)) i) (@perm (E (vn_eparams (S n))) (@cons (E (vn_eparams (S n))) a l1) (@app (prod (vect n) (E (vn_eparams n))) (@map (prod (Field.K (K1 p)) (E (vn_eparams n))) (prod (vect n) (E (vn_eparams n))) (fun x : prod (Field.K (K1 p)) (E (vn_eparams n)) => @pair (vect n) (E (vn_eparams n)) (genk n (@fst (Field.K (K1 p)) (E (vn_eparams n)) x)) (@snd (Field.K (K1 p)) (E (vn_eparams n)) x)) lk) (@map (vect n) (vect (S n)) (lift n) ly))))))) *)
case (cbl_base1_split n a); auto with datatypes.
(* Goal: forall (x : Field.K (K1 p)) (_ : @ex (E (vn_eparams n)) (fun y : E (vn_eparams n) => and (cbl (vn_eparams n) (base n (S O)) y) (@Logic.eq (E (vn_eparams (S n))) a (@pair (vect n) (E (vn_eparams n)) (genk n x) y)))), @ex (list (prod (Field.K (K1 p)) (E (vn_eparams n)))) (fun lk : list (prod (Field.K (K1 p)) (E (vn_eparams n))) => @ex (list (E (vn_eparams n))) (fun ly : list (E (vn_eparams n)) => and (forall (i : prod (Field.K (K1 p)) (E (vn_eparams n))) (_ : @In (prod (Field.K (K1 p)) (E (vn_eparams n))) i lk), not (@Logic.eq (Field.K (K1 p)) (@fst (Field.K (K1 p)) (E (vn_eparams n)) i) (v0 (K1 p)))) (and (forall (i : prod (Field.K (K1 p)) (E (vn_eparams n))) (_ : @In (prod (Field.K (K1 p)) (E (vn_eparams n))) i lk), cbl (vn_eparams n) (base n (S O)) (@snd (Field.K (K1 p)) (E (vn_eparams n)) i)) (and (forall (i : E (vn_eparams n)) (_ : @In (E (vn_eparams n)) i ly), cbl (vn_eparams n) (base n (S O)) i) (@perm (E (vn_eparams (S n))) (@cons (E (vn_eparams (S n))) a l1) (@app (prod (vect n) (E (vn_eparams n))) (@map (prod (Field.K (K1 p)) (E (vn_eparams n))) (prod (vect n) (E (vn_eparams n))) (fun x0 : prod (Field.K (K1 p)) (E (vn_eparams n)) => @pair (vect n) (E (vn_eparams n)) (genk n (@fst (Field.K (K1 p)) (E (vn_eparams n)) x0)) (@snd (Field.K (K1 p)) (E (vn_eparams n)) x0)) lk) (@map (vect n) (vect (S n)) (lift n) ly))))))) *)
intros k (y, (H1y, H2y)); subst a.
(* Goal: @ex (list (prod (Field.K (K1 p)) (E (vn_eparams n)))) (fun lk : list (prod (Field.K (K1 p)) (E (vn_eparams n))) => @ex (list (E (vn_eparams n))) (fun ly : list (E (vn_eparams n)) => and (forall (i : prod (Field.K (K1 p)) (E (vn_eparams n))) (_ : @In (prod (Field.K (K1 p)) (E (vn_eparams n))) i lk), not (@Logic.eq (Field.K (K1 p)) (@fst (Field.K (K1 p)) (E (vn_eparams n)) i) (v0 (K1 p)))) (and (forall (i : prod (Field.K (K1 p)) (E (vn_eparams n))) (_ : @In (prod (Field.K (K1 p)) (E (vn_eparams n))) i lk), cbl (vn_eparams n) (base n (S O)) (@snd (Field.K (K1 p)) (E (vn_eparams n)) i)) (and (forall (i : E (vn_eparams n)) (_ : @In (E (vn_eparams n)) i ly), cbl (vn_eparams n) (base n (S O)) i) (@perm (E (vn_eparams (S n))) (@cons (E (vn_eparams (S n))) (@pair (vect n) (E (vn_eparams n)) (genk n k) y) l1) (@app (prod (vect n) (E (vn_eparams n))) (@map (prod (Field.K (K1 p)) (E (vn_eparams n))) (prod (vect n) (E (vn_eparams n))) (fun x : prod (Field.K (K1 p)) (E (vn_eparams n)) => @pair (vect n) (E (vn_eparams n)) (genk n (@fst (Field.K (K1 p)) (E (vn_eparams n)) x)) (@snd (Field.K (K1 p)) (E (vn_eparams n)) x)) lk) (@map (vect n) (vect (S n)) (lift n) ly))))))) *)
generalize (eqK_dec _ Hp k 0%f); case eqK; intros Hk; try subst k.
(* Goal: @ex (list (prod (Field.K (K1 p)) (E (vn_eparams n)))) (fun lk : list (prod (Field.K (K1 p)) (E (vn_eparams n))) => @ex (list (E (vn_eparams n))) (fun ly : list (E (vn_eparams n)) => and (forall (i : prod (Field.K (K1 p)) (E (vn_eparams n))) (_ : @In (prod (Field.K (K1 p)) (E (vn_eparams n))) i lk), not (@Logic.eq (Field.K (K1 p)) (@fst (Field.K (K1 p)) (E (vn_eparams n)) i) (v0 (K1 p)))) (and (forall (i : prod (Field.K (K1 p)) (E (vn_eparams n))) (_ : @In (prod (Field.K (K1 p)) (E (vn_eparams n))) i lk), cbl (vn_eparams n) (base n (S O)) (@snd (Field.K (K1 p)) (E (vn_eparams n)) i)) (and (forall (i : E (vn_eparams n)) (_ : @In (E (vn_eparams n)) i ly), cbl (vn_eparams n) (base n (S O)) i) (@perm (E (vn_eparams (S n))) (@cons (E (vn_eparams (S n))) (@pair (vect n) (E (vn_eparams n)) (genk n (v0 (K p))) y) l1) (@app (prod (vect n) (E (vn_eparams n))) (@map (prod (Field.K (K1 p)) (E (vn_eparams n))) (prod (vect n) (E (vn_eparams n))) (fun x : prod (Field.K (K1 p)) (E (vn_eparams n)) => @pair (vect n) (E (vn_eparams n)) (genk n (@fst (Field.K (K1 p)) (E (vn_eparams n)) x)) (@snd (Field.K (K1 p)) (E (vn_eparams n)) x)) lk) (@map (vect n) (vect (S n)) (lift n) ly))))))) *)
(* Goal: @ex (list (prod (Field.K (K1 p)) (E (vn_eparams n)))) (fun lk : list (prod (Field.K (K1 p)) (E (vn_eparams n))) => @ex (list (E (vn_eparams n))) (fun ly : list (E (vn_eparams n)) => and (forall (i : prod (Field.K (K1 p)) (E (vn_eparams n))) (_ : @In (prod (Field.K (K1 p)) (E (vn_eparams n))) i lk), not (@Logic.eq (Field.K (K1 p)) (@fst (Field.K (K1 p)) (E (vn_eparams n)) i) (v0 (K1 p)))) (and (forall (i : prod (Field.K (K1 p)) (E (vn_eparams n))) (_ : @In (prod (Field.K (K1 p)) (E (vn_eparams n))) i lk), cbl (vn_eparams n) (base n (S O)) (@snd (Field.K (K1 p)) (E (vn_eparams n)) i)) (and (forall (i : E (vn_eparams n)) (_ : @In (E (vn_eparams n)) i ly), cbl (vn_eparams n) (base n (S O)) i) (@perm (E (vn_eparams (S n))) (@cons (E (vn_eparams (S n))) (@pair (vect n) (E (vn_eparams n)) (genk n k) y) l1) (@app (prod (vect n) (E (vn_eparams n))) (@map (prod (Field.K (K1 p)) (E (vn_eparams n))) (prod (vect n) (E (vn_eparams n))) (fun x : prod (Field.K (K1 p)) (E (vn_eparams n)) => @pair (vect n) (E (vn_eparams n)) (genk n (@fst (Field.K (K1 p)) (E (vn_eparams n)) x)) (@snd (Field.K (K1 p)) (E (vn_eparams n)) x)) lk) (@map (vect n) (vect (S n)) (lift n) ly))))))) *)
exists lk; exists (y::ly); repeat split; auto with datatypes.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
simpl; intros i1 [Hi1 | Hi1]; try subst i1; auto.
apply perm_trans with 
  (2 := perm_cons_app _ y^'l (map (fun x => ([fst x], snd x)) lk)
                 (map (lift n) ly)).
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
simpl; apply perm_skip; auto.
(* Goal: @ex (list (prod (Field.K (K1 p)) (E (vn_eparams n)))) (fun lk : list (prod (Field.K (K1 p)) (E (vn_eparams n))) => @ex (list (E (vn_eparams n))) (fun ly : list (E (vn_eparams n)) => and (forall (i : prod (Field.K (K1 p)) (E (vn_eparams n))) (_ : @In (prod (Field.K (K1 p)) (E (vn_eparams n))) i lk), not (@Logic.eq (Field.K (K1 p)) (@fst (Field.K (K1 p)) (E (vn_eparams n)) i) (v0 (K1 p)))) (and (forall (i : prod (Field.K (K1 p)) (E (vn_eparams n))) (_ : @In (prod (Field.K (K1 p)) (E (vn_eparams n))) i lk), cbl (vn_eparams n) (base n (S O)) (@snd (Field.K (K1 p)) (E (vn_eparams n)) i)) (and (forall (i : E (vn_eparams n)) (_ : @In (E (vn_eparams n)) i ly), cbl (vn_eparams n) (base n (S O)) i) (@perm (E (vn_eparams (S n))) (@cons (E (vn_eparams (S n))) (@pair (vect n) (E (vn_eparams n)) (genk n k) y) l1) (@app (prod (vect n) (E (vn_eparams n))) (@map (prod (Field.K (K1 p)) (E (vn_eparams n))) (prod (vect n) (E (vn_eparams n))) (fun x : prod (Field.K (K1 p)) (E (vn_eparams n)) => @pair (vect n) (E (vn_eparams n)) (genk n (@fst (Field.K (K1 p)) (E (vn_eparams n)) x)) (@snd (Field.K (K1 p)) (E (vn_eparams n)) x)) lk) (@map (vect n) (vect (S n)) (lift n) ly))))))) *)
exists ((k,y)::lk); exists ly; repeat split; auto with datatypes.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
simpl; intros i1 [Hi1 | Hi1]; try subst i1; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
simpl; intros i1 [Hi1 | Hi1]; try subst i1; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
simpl; apply perm_skip; auto.
Qed.

(* Ad-hoc inductive principe for vectors of degree k *)
Lemma hom_induct n k (P: vect n -> Prop) :
  P 0 -> (forall v, In v (base n k) -> P v) ->
     (forall v1 v2, P v1 -> P v2 -> P (v1 + v2)) ->
     (forall k v, P v -> P (k .* v)) ->
     (forall v, hom n k v -> P v).
Proof.
(* Goal: forall (_ : P (E0 (vn_eparams n))) (_ : forall (v : vect n) (_ : @In (vect n) v (base n k)), P v) (_ : forall (v1 v2 : vect n) (_ : P v1) (_ : P v2), P (addE (vn_eparams n) v1 v2)) (_ : forall (k : Field.K (stype (vn_eparams n))) (v : vect n) (_ : P v), P (scalE (vn_eparams n) k v)) (v : vect n) (_ : b2Prop (hom n k v)), P v *)
intros H1 H2 H3 H4 v.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite <-cblk_homk_equiv; intros HH; elim HH; auto.
Qed.
   
(* Ad-hoc conjugate function in order to define the product *)
Fixpoint conj (n : nat) (b: bool) {struct n}: vect n -> vect n :=
  match n return (vect n -> vect n) with
  | 0%nat => fun a => if b then (- a)%f else a
  | S n1 =>
      fun l1 =>
      let (l2, l3) := l1 in (conj n1 (negb b) l2, conj n1 b l3)
  end.

Notation "x ^_ b" := (conj _ b x)  (at level 30).
Notation "x ^_'t" := (conj _ true x)  (at level 30).
Notation "x ^_'f" := (conj _ false x)  (at level 30).

(* Conjugate behave well with the sum *)
Lemma conj_add n b (x y: vect n) : (x + y) ^_ b = x ^_ b + y ^_ b.
Proof.
(* Goal: @Logic.eq (Field.K (K1 p)) (const n (dconj n b x)) (if b then multK (K1 p) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (S n)) (const n x) else multK (K1 p) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) n) (const n x)) *)
generalize b; clear b.
(* Goal: forall (b : bool) (k : nat) (_ : b2Prop (hom n k x)), b2Prop (hom n k (dconj n b x)) *)
induction n as [| n IH]; simpl.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
  intros []; auto; rewrite opp_addK; auto.
(* Goal: forall b : bool, @Logic.eq (prod (vect n) (vect n)) (let (l2, l3) := let (l3, l5) := x in let (l4, l6) := y in @pair (vect n) (vect n) (add n l3 l4) (add n l5 l6) in @pair (vect n) (vect n) (conj n (negb b) l2) (conj n b l3)) (let (l3, l5) := let (l2, l3) := x in @pair (vect n) (vect n) (conj n (negb b) l2) (conj n b l3) in let (l4, l6) := let (l2, l4) := y in @pair (vect n) (vect n) (conj n (negb b) l2) (conj n b l4) in @pair (vect n) (vect n) (add n l3 l4) (add n l5 l6)) *)
destruct x; destruct y; intros b; Vfold n.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite IH, IH; auto.
Qed.

(* Conjugate is involutive *)
Lemma conj_invo n b (x: vect n) : x ^_ b ^_ b = x.
Proof.
(* Goal: @Logic.eq (Field.K (K1 p)) (const n (dconj n b x)) (if b then multK (K1 p) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (S n)) (const n x) else multK (K1 p) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) n) (const n x)) *)
generalize b; clear b.
(* Goal: forall (b : bool) (k : nat) (_ : b2Prop (hom n k x)), b2Prop (hom n k (dconj n b x)) *)
induction n as [| n IH]; simpl.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
  intros []; auto; rewrite opp_oppK; auto.
(* Goal: and (b2Prop (fortho n v0 (conj n (negb b) v1))) (b2Prop (fortho n v0 (conj n b v2))) *)
intros vv; destruct x; rewrite !IH; auto.
Qed.

(* Conjugate of 0 is 0 *)
Lemma conj0 n b : 0 ^_ b = (0 : vect n).
Proof.
(* Goal: @Logic.eq (Field.K (K1 p)) (const n (dconj n b x)) (if b then multK (K1 p) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (S n)) (const n x) else multK (K1 p) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) n) (const n x)) *)
generalize b; clear b.
(* Goal: forall (b : bool) (k : nat) (_ : b2Prop (hom n k x)), b2Prop (hom n k (dconj n b x)) *)
induction n as [| n IH]; simpl.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros []; auto; rewrite oppK0; auto.
(* Goal: @Logic.eq (vect n) (meet n (meet n v v1) v3) (meet n v (meet n v1 v3)) *)
(* Goal: @Logic.eq (vect n) (addE (vn_eparams n) (meet n (meet n v v1) v4) (meet n (addE (vn_eparams n) (meet n v v2) (meet n v0 (dconj n false v1))) (dconj n false v3))) (addE (vn_eparams n) (meet n v (addE (vn_eparams n) (meet n v1 v4) (meet n v2 (dconj n false v3)))) (meet n v0 (dconj n false (meet n v1 v3)))) *)
intros b; rewrite IH; rewrite IH; auto.
Qed.

Hint Rewrite conj0: GRm0.

(* Conjugate of k is -k *)
Lemma conjk n b k : [k] ^_ b=  if b then [-k] else ([k]: vect n).
Proof.
(* Goal: @Logic.eq (vect n) (meet n x (scalE (vn_eparams n) k y)) (scalE (vn_eparams n) k (meet n x y)) *)
induction n as [| n IH]; simpl; try Vfold n; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
destruct b; auto; rewrite IH, conj0; auto.
Qed.

(* removing negation *)
Lemma conj_neg n b (v: vect n) : v ^_ (negb b) = (-(1)) .*  (v ^_ b).
Proof.
(* Goal: @Logic.eq (vect n) (mcontra n (@cons (kn p n) a l) x) (mcontra n l (contra n a x)) *)
induction n as [| n IH];simpl; auto.
(* Goal: @Logic.eq (Field.K (K1 p)) (if negb b then oppK (K1 p) v else v) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (if b then oppK (K1 p) v else v)) *)
(* Goal: @Logic.eq (prod (vect n) (vect n)) (let (l2, l3) := v in @pair (vect n) (vect n) (conj n (negb (negb b)) l2) (conj n (negb b) l3)) (let (l2, l3) := let (l2, l3) := v in @pair (vect n) (vect n) (conj n (negb b) l2) (conj n b l3) in @pair (vect n) (vect n) (scal n (oppK (K1 p) (v1 (K1 p))) l2) (scal n (oppK (K1 p) (v1 (K1 p))) l3)) *)
destruct b; simpl; Krm1.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (let (l2, l3) := v in @pair (vect n) (vect n) (conj n (negb (negb b)) l2) (conj n (negb b) l3)) (let (l2, l3) := let (l2, l3) := v in @pair (vect n) (vect n) (conj n (negb b) l2) (conj n b l3) in @pair (vect n) (vect n) (scal n (oppK (K1 p) (v1 (K1 p))) l2) (scal n (oppK (K1 p) (v1 (K1 p))) l3)) *)
destruct v; Vfold n.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite negb_involutive, !IH, <-scal_multE; Krm1; rewrite scalE1; auto.
Qed.

(* removing conj_true *)
Lemma conjt n (v: vect n) : v ^_'t = (-(1)) .*  (v ^_'f).
Proof. apply (conj_neg n false). Qed.

(* Conjugate of a generator g is -g *)
Lemma conj_e n b i : i < n ->
  'e_i ^_ b = if b then ('e_i: vect n) else (- (1)).* 'e_i.
Proof.
(* Goal: forall _ : lt i n, @Logic.eq (vect n) (k2g n (Kn.gen p n i)) (gen n i) *)
generalize i; clear i.
(* Goal: forall (k1 k2 : nat) (_ : b2Prop (hom n k1 x)) (_ : b2Prop (hom n (S O) y)) (_ : b2Prop (hom n k2 z)), @Logic.eq (vect n) (meet n (join n x y) z) (addE (vn_eparams n) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n (S (Nat.add k1 k2)))) (meet n x (join n y z))) (join n (meet n x z) y)) *)
induction n as [| n IH]; simpl; try (Vfold n).
(* Goal: forall (i : nat) (_ : lt i O), @Logic.eq (Field.K (K1 p)) (if b then oppK (K1 p) (v1 (K1 p)) else v1 (K1 p)) (if b then v1 (K1 p) else multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (v1 (K1 p))) *)
(* Goal: forall (i : nat) (_ : lt i (S n)), @Logic.eq (prod (vect n) (vect n)) (let (l2, l3) := match i with | O => @pair (vect n) (vect n) (genk n (v1 (K1 p))) (E0 (vn_eparams n)) | S p1 => @pair (vect n) (vect n) (E0 (vn_eparams n)) (gen n p1) end in @pair (vect n) (vect n) (conj n (negb b) l2) (conj n b l3)) (if b then match i with | O => @pair (vect n) (vect n) (genk n (v1 (K1 p))) (E0 (vn_eparams n)) | S p1 => @pair (vect n) (vect n) (E0 (vn_eparams n)) (gen n p1) end else let (l2, l3) := match i with | O => @pair (vect n) (vect n) (genk n (v1 (K1 p))) (E0 (vn_eparams n)) | S p1 => @pair (vect n) (vect n) (E0 (vn_eparams n)) (gen n p1) end in @pair (vect n) (vect n) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) l2) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) l3)) *)
  intros i H; absurd (i < 0); auto with arith.
(* Goal: forall (i : nat) (_ : lt i (S n)), @Logic.eq (prod (vect n) (vect n)) (let (l2, l3) := match i with | O => @pair (vect n) (vect n) (genk n (v1 (K1 p))) (E0 (vn_eparams n)) | S p1 => @pair (vect n) (vect n) (E0 (vn_eparams n)) (gen n p1) end in @pair (vect n) (vect n) (conj n (negb b) l2) (conj n b l3)) (if b then match i with | O => @pair (vect n) (vect n) (genk n (v1 (K1 p))) (E0 (vn_eparams n)) | S p1 => @pair (vect n) (vect n) (E0 (vn_eparams n)) (gen n p1) end else let (l2, l3) := match i with | O => @pair (vect n) (vect n) (genk n (v1 (K1 p))) (E0 (vn_eparams n)) | S p1 => @pair (vect n) (vect n) (E0 (vn_eparams n)) (gen n p1) end in @pair (vect n) (vect n) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) l2) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) l3)) *)
intros [| i] H.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
  rewrite conj0, scalE0r, conjk; case b; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
  rewrite scalk, multK1r; auto.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (conj n (negb b) (E0 (vn_eparams n))) (conj n b (gen n i))) (if b then @pair (vect n) (vect n) (E0 (vn_eparams n)) (gen n i) else @pair (vect n) (vect n) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (E0 (vn_eparams n))) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (gen n i))) *)
rewrite IH; auto with arith.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite conj0, scalE0r; case b; auto.
Qed.

(* Conjugate behaves well with scalar multiplication *)
Lemma conj_scal n b k (x: vect n) : (k .* x) ^_ b = k .* x ^_ b.
Proof.
(* Goal: @Logic.eq (Field.K (K1 p)) (const n (dconj n b x)) (if b then multK (K1 p) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (S n)) (const n x) else multK (K1 p) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) n) (const n x)) *)
generalize b; clear b.
(* Goal: forall (k1 k2 : nat) (_ : b2Prop (hom n k1 x)) (_ : b2Prop (hom n (S O) y)) (_ : b2Prop (hom n k2 z)), @Logic.eq (vect n) (meet n (join n x y) z) (addE (vn_eparams n) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n (S (Nat.add k1 k2)))) (meet n x (join n y z))) (join n (meet n x z) y)) *)
induction n as [| n IH]; simpl; try Vfold n.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
  intros []; auto; rewrite opp_multKr; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros []; destruct x; rewrite IH, IH; auto.
Qed.

Lemma conj_hom n b k (x: vect n) : hom n k x -> hom n k (x ^_ b).
Proof.
(* Goal: forall _ : b2Prop (hom n k x), b2Prop (hom n k (dconj n b x)) *)
generalize b k; clear b k.
(* Goal: forall (b : bool) (k : nat) (_ : b2Prop (hom n k x)), b2Prop (hom n k (dconj n b x)) *)
induction n as [| n IH]; simpl.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
  intros [|] [|k]; auto.
(* Goal: b2Prop false *)
  case eqK_spec; auto; intros HH HH1; try discriminate.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
  rewrite HH, oppK0, eqKI; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros b [|k]; destruct x; rewrite !andbP; intros (H1, H2); split; auto.
(* Goal: b2Prop false *)
generalize H1; case eq0_spec; intros Hx1 HH; try discriminate.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
  rewrite Hx1, conj0, eq0I; auto.
Qed.

Hint Resolve conj_hom.

Lemma conjf_hom n k (M: vect n) : hom n k M -> M ^_'f = (- (1))^k .* M.
Proof.
(* Goal: forall _ : @In (vect n) v (base n k), or (@Logic.eq (vect n) (join n v (dual n v)) (all n)) (@Logic.eq (vect n) (join n v (dual n v)) (scalE (vn_eparams n) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (all n))) *)
generalize k; clear k.
(* Goal: forall (k : nat) (_ : b2Prop (hom n k M)), @Logic.eq (vect n) (dconj n false M) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n k)) M) *)
induction n as [| n IH];simpl; auto; try Vfold n.
(* Goal: forall (k : nat) (_ : b2Prop match k with | O => true | S n => eqK (K1 p) M (v0 (K1 p)) end), @Logic.eq (Field.K (K1 p)) M (multK (K1 p) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k) M) *)
(* Goal: forall (k : nat) (_ : b2Prop (let (l2, l3) := M in andb match k with | O => eq0 n l2 | S k1 => hom n k1 l2 end (hom n k l3))), @Logic.eq (prod (vect n) (vect n)) (let (l2, l3) := M in @pair (vect n) (vect n) (dconj n false l2) (dconj n true l3)) (let (l2, l3) := M in @pair (vect n) (vect n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n k))) l2) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n k))) l3)) *)
intros [|k] H; simpl; Krm1.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
generalize H; case eqK_spec; try (intros; discriminate); auto.
(* Goal: forall (_ : @Logic.eq (Field.K (K1 p)) M (v0 (K1 p))) (_ : b2Prop true), @Logic.eq (Field.K (K1 p)) M (oppK (K1 p) (multK (K1 p) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k) M)) *)
(* Goal: forall (k : nat) (_ : b2Prop (let (l2, l3) := M in andb match k with | O => eq0 n l2 | S k1 => hom n k1 l2 end (hom n k l3))), @Logic.eq (prod (vect n) (vect n)) (let (l2, l3) := M in @pair (vect n) (vect n) (conj n true l2) (conj n false l3)) (let (l2, l3) := M in @pair (vect n) (vect n) (scalE (vn_eparams n) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k) l2) (scalE (vn_eparams n) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k) l3)) *)
intros H1; rewrite H1; Krm0.
intros [| k]; destruct M; rewrite andbP; intros (HM1, HM2);
  rewrite conjt; simpl; Vfold n; Krm1.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
generalize HM1; case eq0_spec; try (intros; discriminate); auto.
(* Goal: forall (_ : @Logic.eq (vect n) v (E0 (vn_eparams n))) (_ : b2Prop true), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (dconj n false v) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (dconj n false v0))) (@pair (vect n) (vect n) (scalE (vn_eparams n) (oppK (K1 p) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n O))) v) (scalE (vn_eparams n) (oppK (K1 p) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n O))) v0)) *)
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (dconj n false v) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (dconj n false v0))) (@pair (vect n) (vect n) (scalE (vn_eparams n) (oppK (K1 p) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S k)))) v) (scalE (vn_eparams n) (oppK (K1 p) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S k)))) v0)) *)
intros H1; rewrite H1, (IH _ _ HM2); simpl; Vfold n; Krm1.
(* Goal: forall _ : b2Prop true, @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (conj n false (E0 (vn_eparams n)))) (scalE (vn_eparams n) (v1 (K1 p)) v0)) (@pair (vect n) (vect n) (scalE (vn_eparams n) (v1 (K1 p)) (E0 (vn_eparams n))) (scalE (vn_eparams n) (v1 (K1 p)) v0)) *)
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (conj n false v)) (conj n false v0)) (@pair (vect n) (vect n) (scalE (vn_eparams n) (oppK (K1 p) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k)) v) (scalE (vn_eparams n) (oppK (K1 p) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k)) v0)) *)
rewrite conj0; Vrm0.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (conj n false v)) (conj n false v0)) (@pair (vect n) (vect n) (scalE (vn_eparams n) (oppK (K1 p) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k)) v) (scalE (vn_eparams n) (oppK (K1 p) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k)) v0)) *)
rewrite (IH _ _ HM1), (IH _ _ HM2).
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) k) v)) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (S k)) v0)) (@pair (vect n) (vect n) (scalE (vn_eparams n) (oppK (K1 p) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k)) v) (scalE (vn_eparams n) (oppK (K1 p) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k)) v0)) *)
simpl; Vfold n; rewrite <-!scal_multE; Krm1.
Qed.

Lemma conjt_hom n k (M: vect n) : hom n k M -> M ^_'t = (- (1))^k.+1 .* M.
Proof.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros HH; rewrite conjt, (conjf_hom n k); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
simpl; Vfold n; rewrite scal_multE; auto.
Qed.

Lemma conj_const n b (x: vect n) : 'C[x ^_ b] = if b then (-'C[x])%f else 'C[x].
Proof.
(* Goal: @Logic.eq (Field.K (K1 p)) (const n (dconj n b x)) (if b then multK (K1 p) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (S n)) (const n x) else multK (K1 p) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) n) (const n x)) *)
generalize b; clear b.
(* Goal: @Logic.eq (vect n) (k2g n (E0 (Kn.vn_eparams p n))) (E0 (vn_eparams n)) *)
induction n as [|n IH]; simpl; auto.
(* Goal: @Logic.eq (list (Field.K (K1 p))) (let (_, l2) := x in proj n O l2) (@cons (Field.K (K1 p)) (let (_, l2) := x in const n l2) (@nil (Field.K (K1 p)))) *)
intros []; destruct x; rewrite IH; auto.
Qed.                      

(* We can swap add-hoc conjugate *)
Lemma conj_swap n b1 b2 (x: vect n) : x ^_ b2 ^_ b1 =  x ^_ b1 ^_ b2.
Proof.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
case b1; case b2; rewrite ?conjt, ?conj_scal, !conj_invo; auto.
Qed.

(* Conjugate of 0 is 0 *)
Lemma conj_all n b: (E  ^_ b) = 
   (if b then (-((-(1))^ n))%f else ((-(1))^ n)%f) .* E :> vect n.
Proof.
(* Goal: @Logic.eq (Field.K (K1 p)) (const n (dconj n b x)) (if b then multK (K1 p) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (S n)) (const n x) else multK (K1 p) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) n) (const n x)) *)
generalize b; clear b.
(* Goal: @Logic.eq (vect n) (mcontra n (@cons (kn p n) a l) x) (mcontra n l (contra n a x)) *)
induction n as [| n Hrec]; simpl; auto.
(* Goal: forall b : bool, @Logic.eq (Field.K (K1 p)) (if b then oppK (K1 p) (v1 (K1 p)) else v1 (K1 p)) (multK (K1 p) (if b then oppK (K1 p) (v1 (K1 p)) else v1 (K1 p)) (v1 (K1 p))) *)
(* Goal: forall b : bool, @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (conj n (negb b) (all n)) (conj n b (genk n (v0 (K1 p))))) (@pair (vect n) (vect n) (scal n (if b then oppK (K1 p) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) n)) else multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) n)) (all n)) (scal n (if b then oppK (K1 p) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) n)) else multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) n)) (genk n (v0 (K1 p))))) *)
intros b; Krm1.
intros b; repeat rewrite Hrec;
  case b; simpl; auto; rewrite conj0; Vfold n; Vrm0.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (scalE (vn_eparams n) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) n) (all n)) (E0 (vn_eparams n))) (@pair (vect n) (vect n) (scalE (vn_eparams n) (oppK (K1 p) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) n))) (all n)) (E0 (vn_eparams n))) *)
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (scalE (vn_eparams n) (oppK (K1 p) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) n)) (all n)) (E0 (vn_eparams n))) (@pair (vect n) (vect n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) n)) (all n)) (E0 (vn_eparams n))) *)
rewrite <-opp_multK1l; Krm1.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite <-opp_multK1l; auto.
Qed.

(* We are now ready to define our multiplication *)
Fixpoint join (n : nat) : vect n -> vect n -> vect n :=
  match n return (vect n -> vect n -> vect n) with
  | 0%nat => fun x y => (x * y)%f
  | S n1 =>
      fun x y =>
      let (x1, x2) := x in
      let (y1, y2) := y in (join n1 x1 y2 + join n1 (x2 ^_'f) y1, 
                             join n1 x2 y2)
  end.

(* Unicode u2228 *)
Notation "x '∨' y" := (join _ x y) (at level 40, left associativity): type_scope.

(* (k.x) \/  y = k. (x \/ y) *)
Lemma join_scall n k (x y : vect n) : k .* x ∨ y = k .* (x ∨ y).
Proof.
(* Goal: forall (k1 k2 : nat) (_ : b2Prop (hom n k1 x)) (_ : b2Prop (hom n (S O) y)) (_ : b2Prop (hom n k2 z)), @Logic.eq (vect n) (meet n (join n x y) z) (addE (vn_eparams n) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n (S (Nat.add k1 k2)))) (meet n x (join n y z))) (join n (meet n x z) y)) *)
induction n as [| n IH]; simpl; try Vfold n.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite multK_assoc; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
destruct x; destruct y; rewrite scal_addEr, conj_scal, !IH; auto.
Qed.

Lemma join0 (v1 v2: vect 0) : v1 ∨ v2 = (v1 ∨ v2)%f.
Proof. auto. Qed.

(* 0 \/ x = 0 *)
Lemma join0l n (x : vect n) : 0 ∨ x = 0.
Proof.
(* Goal: forall (k1 k2 : nat) (_ : b2Prop (hom n k1 x)) (_ : b2Prop (hom n (S O) y)) (_ : b2Prop (hom n k2 z)), @Logic.eq (vect n) (meet n (join n x y) z) (addE (vn_eparams n) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n (S (Nat.add k1 k2)))) (meet n x (join n y z))) (join n (meet n x z) y)) *)
induction n as [| n IH]; simpl; try Vfold n.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
  rewrite multK0l; auto.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (let (y1, y2) := x in @pair (vect n) (vect n) (addE (vn_eparams n) (join n (E0 (vn_eparams n)) y2) (join n (conj n false (E0 (vn_eparams n))) y1)) (join n (E0 (vn_eparams n)) y2)) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (E0 (vn_eparams n))) *)
destruct x; rewrite IH, conj0, IH; Vrm0.
Qed.

Hint Rewrite join0l: GRm0.

(* x \/ 0  = 0 *)
Lemma join0r n (x : vect n) : x ∨ 0 = 0.
Proof.
(* Goal: forall (k1 k2 : nat) (_ : b2Prop (hom n k1 x)) (_ : b2Prop (hom n (S O) y)) (_ : b2Prop (hom n k2 z)), @Logic.eq (vect n) (meet n (join n x y) z) (addE (vn_eparams n) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n (S (Nat.add k1 k2)))) (meet n x (join n y z))) (join n (meet n x z) y)) *)
induction n as [| n IH]; simpl; try Vfold n.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
  rewrite multK0r; auto.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (addE (vn_eparams n) (E0 (vn_eparams n)) (E0 (vn_eparams n))) (addE (vn_eparams n) (genk n k1) (genk n k2))) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (genk n (addK (K1 p) k1 k2))) *)
destruct x; rewrite !IH; Vrm0.
Qed.

Hint Rewrite join0r: GRm0.

Lemma joinkl n k (x : vect n) : [k] ∨ x = k .* x.
Proof.
(* Goal: @Logic.eq (vect n) (dual n (addE (vn_eparams n) v1 v2)) (addE (vn_eparams n) (dual n v1) (dual n v2)) *)
induction n as [| n IH]; simpl; auto; Vfold n.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
destruct x; rewrite IH, conjk, join0l, addE0l, IH; auto.
Qed.

(* x ∨ 1 = 1 *)
Lemma joinkr n k (x : vect n) : x ∨ [k] = k .* x.
Proof.
(* Goal: forall (k : nat) (_ : b2Prop (hom n k M)), @Logic.eq (vect n) (dconj n false M) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n k)) M) *)
induction n as [| n IH]; simpl; auto; try Vfold n.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite multK_com; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
destruct x; rewrite !IH, join0r, addE0r; auto.
Qed.

(* 1 \/ x  = x *)
Lemma join1l n (x : vect n) : 1 ∨ x = x.
Proof. rewrite joinkl, scalE1; auto. Qed.

(* x \/ 1 = 1 *)
Lemma join1r n (x : vect n) : x ∨ 1 = x.
Proof. intros; rewrite joinkr, scalE1; auto. Qed.

Lemma join_alll n (x: vect n) : all n ∨ x = 'C[x] .* all n.
Proof.
(* Goal: forall (k1 k2 : nat) (_ : b2Prop (hom n k1 x)) (_ : b2Prop (hom n (S O) y)) (_ : b2Prop (hom n k2 z)), @Logic.eq (vect n) (meet n (join n x y) z) (addE (vn_eparams n) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n (S (Nat.add k1 k2)))) (meet n x (join n y z))) (join n (meet n x z) y)) *)
induction n as [| n IH]; simpl; try Vfold n.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
simpl; rewrite multK_com; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
destruct x; rewrite conj0, !join0l, addE0r, IH; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
simpl; Vfold n; rewrite scalE0r; auto.
Qed.

Lemma join_allr n (x: vect n) : x ∨ all n = 'C[x] .* all n.
Proof.
(* Goal: @Logic.eq (vect n) (dual n (addE (vn_eparams n) v1 v2)) (addE (vn_eparams n) (dual n v1) (dual n v2)) *)
induction n as [| n IH]; simpl; auto; Vfold n.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
destruct x; rewrite !join0r, addE0l, IH; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
simpl; Vfold n; rewrite scalE0r, conj_const; auto.
Qed.

Lemma join_allhr k n x : hom n k x -> 0 < k -> x ∨ E = 0.
Proof.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros Hh Hl; rewrite join_allr, (const_hom n k), scalE0l; auto.
Qed.

Lemma join_allhl k n x : hom n k x -> 0 < k -> E ∨ x = 0.
Proof.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros Hh Hl; rewrite join_alll, (const_hom n k), scalE0l; auto.
Qed.

(* x \/ (k.y) = k. (x \/ y) *)
Lemma join_scalr n k (x y : vect n) : x ∨ (k .* y) = k .* (x ∨ y).
Proof.
(* Goal: forall (k1 k2 : nat) (_ : b2Prop (hom n k1 x)) (_ : b2Prop (hom n (S O) y)) (_ : b2Prop (hom n k2 z)), @Logic.eq (vect n) (meet n (join n x y) z) (addE (vn_eparams n) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n (S (Nat.add k1 k2)))) (meet n x (join n y z))) (join n (meet n x z) y)) *)
induction n as [| n IH]; simpl; try Vfold n.
  rewrite (multK_com _ Hp x), (multK_com _ Hp x), 
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
                        multK_assoc; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
destruct x; destruct y; apply f_equal2 with (f := @pair _ _); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite IH, IH, <- scal_addEr; auto.
Qed.

Lemma joink n k1 k2 : [k1] ∨ [k2] = [k1 * k2] :> vect n.
Proof. rewrite joinkl, <- scalk; auto. Qed.

Lemma join_e0 n (M : vect n.+1) : 'e_0 ∨ M = (snd M, [0]).
Proof.
(* Goal: @Logic.eq (vect (S n)) (join (S n) (gen (S n) O) M) (@pair ((fix vect (n : nat) : Set := match n with | O => Field.K (K1 p) | S n1 => prod (vect n1) (vect n1) end) n) (vect n) (@snd ((fix vect (n : nat) : Set := match n with | O => Field.K (K1 p) | S n1 => prod (vect n1) (vect n1) end) n) ((fix vect (n : nat) : Set := match n with | O => Field.K (K1 p) | S n1 => prod (vect n1) (vect n1) end) n) M) (genk n (v0 (K1 p)))) *)
destruct M; simpl; Vfold n.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (addE (vn_eparams n) (join n (genk n (v1 (K1 p))) v0) (join n (conj n false (E0 (vn_eparams n))) v)) (join n (E0 (vn_eparams n)) v0)) (@pair ((fix vect (n : nat) : Set := match n with | O => Field.K (K1 p) | S n1 => prod (vect n1) (vect n1) end) n) (vect n) v0 (E0 (vn_eparams n))) *)
rewrite conj0, !join0l, joinkl, scalE1; Vrm0.
Qed.

Lemma join_ei n i (M : vect n.+1) : i < n ->
  'e_i.+1 ∨ M =  ((-(1))%f .* ('e_i ∨ fst M), 'e_i ∨ snd M).
Proof.
(* Goal: @Logic.eq (vect (S n)) (join (S n) (gen (S n) O) M) (@pair ((fix vect (n : nat) : Set := match n with | O => Field.K (K1 p) | S n1 => prod (vect n1) (vect n1) end) n) (vect n) (@snd ((fix vect (n : nat) : Set := match n with | O => Field.K (K1 p) | S n1 => prod (vect n1) (vect n1) end) n) ((fix vect (n : nat) : Set := match n with | O => Field.K (K1 p) | S n1 => prod (vect n1) (vect n1) end) n) M) (genk n (v0 (K1 p)))) *)
intros HH; destruct M; simpl; Vfold n.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (addE (vn_eparams n) (join n (E0 (vn_eparams n)) v0) (join n (conj n false (gen n i)) v)) (join n (gen n i) v0)) (@pair (vect n) (vect n) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (join n (gen n i) v)) (join n (gen n i) v0)) *)
rewrite join0l, conj_e, join_scall; Vrm0.
Qed.

(* g_i \/ g_j + g_j \/ g_i = 0 *)
Lemma join_es n i j : 
   i < n -> j < n -> 'e_ i ∨ 'e_ j + 'e_ j ∨ 'e_ i = (0: vect n).
Proof.
(* Goal: forall (_ : lt i n) (_ : lt j n), @Logic.eq (E (vn_eparams n)) (addE (vn_eparams n) (join n (gen n i) (gen n j)) (join n (gen n j) (gen n i))) (E0 (vn_eparams n) : vect n) *)
generalize i j; clear i j.
(* Goal: forall (k1 k2 : nat) (_ : b2Prop (hom n k1 x)) (_ : b2Prop (hom n (S O) y)) (_ : b2Prop (hom n k2 z)), @Logic.eq (vect n) (meet n (join n x y) z) (addE (vn_eparams n) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n (S (Nat.add k1 k2)))) (meet n x (join n y z))) (join n (meet n x z) y)) *)
induction n as [| n IH]; simpl; try Vfold n.
(* Goal: forall (i j : nat) (_ : lt i O) (_ : lt j O), @Logic.eq (Field.K (K1 p)) (addK (K1 p) (multK (K1 p) (v1 (K1 p)) (v1 (K1 p))) (multK (K1 p) (v1 (K1 p)) (v1 (K1 p)))) (v0 (K1 p)) *)
(* Goal: forall (i j : nat) (_ : lt i (S n)) (_ : lt j (S n)), @Logic.eq (prod (vect n) (vect n)) (let (l3, l5) := let (x1, x2) := match i with | O => @pair (vect n) (vect n) (genk n (v1 (K1 p))) (E0 (vn_eparams n)) | S p1 => @pair (vect n) (vect n) (E0 (vn_eparams n)) (gen n p1) end in let (y1, y2) := match j with | O => @pair (vect n) (vect n) (genk n (v1 (K1 p))) (E0 (vn_eparams n)) | S p1 => @pair (vect n) (vect n) (E0 (vn_eparams n)) (gen n p1) end in @pair (vect n) (vect n) (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) (join n x2 y2) in let (l4, l6) := let (x1, x2) := match j with | O => @pair (vect n) (vect n) (genk n (v1 (K1 p))) (E0 (vn_eparams n)) | S p1 => @pair (vect n) (vect n) (E0 (vn_eparams n)) (gen n p1) end in let (y1, y2) := match i with | O => @pair (vect n) (vect n) (genk n (v1 (K1 p))) (E0 (vn_eparams n)) | S p1 => @pair (vect n) (vect n) (E0 (vn_eparams n)) (gen n p1) end in @pair (vect n) (vect n) (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) (join n x2 y2) in @pair (vect n) (vect n) (addE (vn_eparams n) l3 l4) (addE (vn_eparams n) l5 l6)) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (E0 (vn_eparams n))) *)
  intros i j H; absurd (i < 0); auto with arith.
(* Goal: forall (i j : nat) (_ : lt i (S n)) (_ : lt j (S n)), @Logic.eq (prod (vect n) (vect n)) (let (l3, l5) := let (x1, x2) := match i with | O => @pair (vect n) (vect n) (genk n (v1 (K1 p))) (E0 (vn_eparams n)) | S p1 => @pair (vect n) (vect n) (E0 (vn_eparams n)) (gen n p1) end in let (y1, y2) := match j with | O => @pair (vect n) (vect n) (genk n (v1 (K1 p))) (E0 (vn_eparams n)) | S p1 => @pair (vect n) (vect n) (E0 (vn_eparams n)) (gen n p1) end in @pair (vect n) (vect n) (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) (join n x2 y2) in let (l4, l6) := let (x1, x2) := match j with | O => @pair (vect n) (vect n) (genk n (v1 (K1 p))) (E0 (vn_eparams n)) | S p1 => @pair (vect n) (vect n) (E0 (vn_eparams n)) (gen n p1) end in let (y1, y2) := match i with | O => @pair (vect n) (vect n) (genk n (v1 (K1 p))) (E0 (vn_eparams n)) | S p1 => @pair (vect n) (vect n) (E0 (vn_eparams n)) (gen n p1) end in @pair (vect n) (vect n) (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) (join n x2 y2) in @pair (vect n) (vect n) (addE (vn_eparams n) l3 l4) (addE (vn_eparams n) l5 l6)) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (E0 (vn_eparams n))) *)
intros [|i] [|j].
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
   rewrite join0l, join0r, conj0, join0l, addE0r, addE0r; auto.
(* Goal: forall (_ : b2Prop (hom n k1 x)) (_ : not (@Logic.eq nat n k1)), @Logic.eq (vect n) (meet n x (genk n k2)) (E0 (vn_eparams n)) *)
intros H1 H2.
   rewrite join0l, join0r, join1r, join1l, join0l, addE0l,
(* Goal: lt (Nat.add O k2) n *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (eq0 n y1) (hom n O y2))) (_ : lt (Nat.add (S k1) O) (S n)), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n x1 y1) (addE (vn_eparams n) (meet n x1 y2) (meet n x2 (dconj n false y1)))) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (E0 (vn_eparams n))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n k2 y1) (hom n (S k2) y2))) (_ : lt (Nat.add (S k1) (S k2)) (S n)), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n x1 y1) (addE (vn_eparams n) (meet n x1 y2) (meet n x2 (dconj n false y1)))) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (E0 (vn_eparams n))) *)
           addE0r, join0r, addE0r, conj_e; simpl; auto with arith.
   Vfold n; pattern (gen n j) at 1;  
   replace (gen n j) with (1.* (gen n j)) by (rewrite scalE1; auto).
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
   rewrite <- scal_addEl, oppKr, scalE0l; auto.
(* Goal: forall (_ : b2Prop (hom n k1 x)) (_ : not (@Logic.eq nat n k1)), @Logic.eq (vect n) (meet n x (genk n k2)) (E0 (vn_eparams n)) *)
intros H1 H2.
   rewrite join0l, join0r, join1r, join1l, join0l, addE0l, addE0r,
(* Goal: lt (Nat.add O k2) n *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (eq0 n y1) (hom n O y2))) (_ : lt (Nat.add (S k1) O) (S n)), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n x1 y1) (addE (vn_eparams n) (meet n x1 y2) (meet n x2 (dconj n false y1)))) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (E0 (vn_eparams n))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n k2 y1) (hom n (S k2) y2))) (_ : lt (Nat.add (S k1) (S k2)) (S n)), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n x1 y1) (addE (vn_eparams n) (meet n x1 y2) (meet n x2 (dconj n false y1)))) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (E0 (vn_eparams n))) *)
           join0r, addE0r, conj_e; simpl; auto with arith.
   Vfold n; pattern (gen n i) at 2;  
   replace (gen n i) with (1.* (gen n i)) by (rewrite scalE1; auto).
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
   rewrite <- scal_addEl, oppKl, scalE0l; auto.
(* Goal: forall (_ : b2Prop (hom n k1 x)) (_ : not (@Logic.eq nat n k1)), @Logic.eq (vect n) (meet n x (genk n k2)) (E0 (vn_eparams n)) *)
intros H1 H2.
rewrite join0l, join0r, IH; try rewrite join0l;
(* Goal: lt (Nat.add O k2) n *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (eq0 n y1) (hom n O y2))) (_ : lt (Nat.add (S k1) O) (S n)), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n x1 y1) (addE (vn_eparams n) (meet n x1 y2) (meet n x2 (dconj n false y1)))) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (E0 (vn_eparams n))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n k2 y1) (hom n (S k2) y2))) (_ : lt (Nat.add (S k1) (S k2)) (S n)), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n x1 y1) (addE (vn_eparams n) (meet n x1 y2) (meet n x2 (dconj n false y1)))) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (E0 (vn_eparams n))) *)
  try rewrite join0r; try rewrite addE0l; try rewrite addE0l; auto with arith.
Qed.

(* g_i \/ g_i = 0 *)
Lemma join_e n i : i < n -> 'e_ i ∨ 'e_ i = (0 : vect n).
Proof.
(* Goal: forall _ : lt i n, @Logic.eq (vect n) (k2g n (Kn.gen p n i)) (gen n i) *)
generalize i; clear i.
(* Goal: forall (k1 k2 : nat) (_ : b2Prop (hom n k1 x)) (_ : b2Prop (hom n (S O) y)) (_ : b2Prop (hom n k2 z)), @Logic.eq (vect n) (meet n (join n x y) z) (addE (vn_eparams n) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n (S (Nat.add k1 k2)))) (meet n x (join n y z))) (join n (meet n x z) y)) *)
induction n as [| n IH]; simpl; try Vfold n.
(* Goal: forall (i : nat) (_ : lt i O), @Logic.eq (Field.K (K1 p)) (multK (K1 p) (v1 (K1 p)) (v1 (K1 p))) (v0 (K1 p)) *)
(* Goal: forall (i : nat) (_ : lt i (S n)), @Logic.eq (prod (vect n) (vect n)) (let (x1, x2) := match i with | O => @pair (vect n) (vect n) (genk n (v1 (K1 p))) (E0 (vn_eparams n)) | S p1 => @pair (vect n) (vect n) (E0 (vn_eparams n)) (gen n p1) end in let (y1, y2) := match i with | O => @pair (vect n) (vect n) (genk n (v1 (K1 p))) (E0 (vn_eparams n)) | S p1 => @pair (vect n) (vect n) (E0 (vn_eparams n)) (gen n p1) end in @pair (vect n) (vect n) (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) (join n x2 y2)) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (E0 (vn_eparams n))) *)
  intros i Hi; absurd (i < 0); auto with arith.
(* Goal: forall (i : nat) (_ : lt i (S n)), @Logic.eq (prod (vect n) (vect n)) (let (x1, x2) := match i with | O => @pair (vect n) (vect n) (genk n (v1 (K1 p))) (E0 (vn_eparams n)) | S p1 => @pair (vect n) (vect n) (E0 (vn_eparams n)) (gen n p1) end in let (y1, y2) := match i with | O => @pair (vect n) (vect n) (genk n (v1 (K1 p))) (E0 (vn_eparams n)) | S p1 => @pair (vect n) (vect n) (E0 (vn_eparams n)) (gen n p1) end in @pair (vect n) (vect n) (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) (join n x2 y2)) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (E0 (vn_eparams n))) *)
intros [|i] Hi.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
 rewrite join0l, join0r, addE0l, conj0, join0l; auto.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (addE (vn_eparams n) (join n (E0 (vn_eparams n)) (gen n i)) (join n (conj n false (gen n i)) (E0 (vn_eparams n)))) (join n (gen n i) (gen n i))) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (E0 (vn_eparams n))) *)
rewrite IH, join0l, join0r, addE0l; auto with arith.
Qed.

(* (x + y) \/ z = (x \/ z) + (y \/ z) *)
Lemma join_addl n (x y z : vect n) : (x + y) ∨ z = x ∨ z + y ∨ z.
Proof.
(* Goal: forall (k1 k2 : nat) (_ : b2Prop (hom n k1 x)) (_ : b2Prop (hom n (S O) y)) (_ : b2Prop (hom n k2 z)), @Logic.eq (vect n) (meet n (join n x y) z) (addE (vn_eparams n) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n (S (Nat.add k1 k2)))) (meet n x (join n y z))) (join n (meet n x z) y)) *)
induction n as [| n IH]; simpl; try Vfold n.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply (add_multKl p); auto.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (let (x1, y1) := let (x1, y1) := x in let (x2, y2) := y in @pair (vect n) (vect n) (meet n x1 x2) (addE (vn_eparams n) (meet n x1 y2) (meet n y1 (dconj n false x2))) in let (x2, y2) := z in @pair (vect n) (vect n) (meet n x1 x2) (addE (vn_eparams n) (meet n x1 y2) (meet n y1 (dconj n false x2)))) (let (x1, y1) := x in let (x2, y2) := let (x2, y2) := y in let (x3, y3) := z in @pair (vect n) (vect n) (meet n x2 x3) (addE (vn_eparams n) (meet n x2 y3) (meet n y2 (dconj n false x3))) in @pair (vect n) (vect n) (meet n x1 x2) (addE (vn_eparams n) (meet n x1 y2) (meet n y1 (dconj n false x2)))) *)
destruct x; destruct y; destruct z.
(* Goal: @Logic.eq (vect n) (meet n (meet n v v1) v3) (meet n v (meet n v1 v3)) *)
(* Goal: @Logic.eq (vect n) (addE (vn_eparams n) (meet n (meet n v v1) v4) (meet n (addE (vn_eparams n) (meet n v v2) (meet n v0 (dconj n false v1))) (dconj n false v3))) (addE (vn_eparams n) (meet n v (addE (vn_eparams n) (meet n v1 v4) (meet n v2 (dconj n false v3)))) (meet n v0 (dconj n false (meet n v1 v3)))) *)
apply f_equal2 with (f := @pair _ _); rewrite IH; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite conj_add, !addE_assoc; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply f_equal2 with (f := add n); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite IH, addE_com, !addE_assoc; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply f_equal2 with (f := add n); auto.
(* Goal: @Logic.eq (vect n) (addE (vn_eparams n) (meet n v4 (dconj n false v1)) (meet n v3 v2)) (addE (vn_eparams n) (meet n v3 v2) (meet n v4 (dconj n false v1))) *)
rewrite addE_com; auto.
Qed.

(* z \/ (x + y) = (z \/ x) + (z \/ y) *)
Lemma join_addr n (x y z : vect n) : z ∨ (x + y) = z ∨ x + z ∨ y.
Proof.
(* Goal: forall (k1 k2 : nat) (_ : b2Prop (hom n k1 x)) (_ : b2Prop (hom n (S O) y)) (_ : b2Prop (hom n k2 z)), @Logic.eq (vect n) (meet n (join n x y) z) (addE (vn_eparams n) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n (S (Nat.add k1 k2)))) (meet n x (join n y z))) (join n (meet n x z) y)) *)
induction n as [| n IH]; simpl; try Vfold n.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros; apply (add_multKr p); auto.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (let (x1, y1) := let (x1, y1) := x in let (x2, y2) := y in @pair (vect n) (vect n) (meet n x1 x2) (addE (vn_eparams n) (meet n x1 y2) (meet n y1 (dconj n false x2))) in let (x2, y2) := z in @pair (vect n) (vect n) (meet n x1 x2) (addE (vn_eparams n) (meet n x1 y2) (meet n y1 (dconj n false x2)))) (let (x1, y1) := x in let (x2, y2) := let (x2, y2) := y in let (x3, y3) := z in @pair (vect n) (vect n) (meet n x2 x3) (addE (vn_eparams n) (meet n x2 y3) (meet n y2 (dconj n false x3))) in @pair (vect n) (vect n) (meet n x1 x2) (addE (vn_eparams n) (meet n x1 y2) (meet n y1 (dconj n false x2)))) *)
destruct x; destruct y; destruct z.
(* Goal: @Logic.eq (vect n) (meet n (meet n v v1) v3) (meet n v (meet n v1 v3)) *)
(* Goal: @Logic.eq (vect n) (addE (vn_eparams n) (meet n (meet n v v1) v4) (meet n (addE (vn_eparams n) (meet n v v2) (meet n v0 (dconj n false v1))) (dconj n false v3))) (addE (vn_eparams n) (meet n v (addE (vn_eparams n) (meet n v1 v4) (meet n v2 (dconj n false v3)))) (meet n v0 (dconj n false (meet n v1 v3)))) *)
apply f_equal2 with (f := @pair _ _); rewrite IH; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite !addE_assoc; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply f_equal2 with (f := add n); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite IH, addE_com,!addE_assoc; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply f_equal2 with (f := add n); auto.
(* Goal: @Logic.eq (vect n) (addE (vn_eparams n) (meet n v4 (dconj n false v1)) (meet n v3 v2)) (addE (vn_eparams n) (meet n v3 v2) (meet n v4 (dconj n false v1))) *)
rewrite addE_com; auto.
Qed.

Lemma conjf_join n (x y: vect n) : (x ∨ y) ^_'f =  x ^_'f ∨ y ^_'f.
Proof.
(* Goal: @Logic.eq (vect n) (conj n false (join n x y)) (join n (conj n false x) (conj n false y)) *)
induction n as [| n IH]; auto; simpl; Vfold n.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (let (x1, y1) := x in let (x2, y2) := let (l2, l3) := y in @pair (vect n) (vect n) (scalE (vn_eparams n) k l2) (scalE (vn_eparams n) k l3) in @pair (vect n) (vect n) (meet n x1 x2) (addE (vn_eparams n) (meet n x1 y2) (meet n y1 (dconj n false x2)))) (let (l2, l3) := let (x1, y1) := x in let (x2, y2) := y in @pair (vect n) (vect n) (meet n x1 x2) (addE (vn_eparams n) (meet n x1 y2) (meet n y1 (dconj n false x2))) in @pair (vect n) (vect n) (scalE (vn_eparams n) k l2) (scalE (vn_eparams n) k l3)) *)
destruct x; destruct y.
rewrite conj_add, IH, !conjt, !IH, conj_invo, !join_scall,
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
        !join_scalr; auto.
Qed.

(* We are now ready to prove associativity ! *)
Lemma join_assoc n (x y z : vect n) : x ∨ y ∨ z = x ∨ (y ∨ z).
Proof.
(* Goal: forall (k1 k2 : nat) (_ : b2Prop (hom n k1 x)) (_ : b2Prop (hom n (S O) y)) (_ : b2Prop (hom n k2 z)), @Logic.eq (vect n) (meet n (join n x y) z) (addE (vn_eparams n) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n (S (Nat.add k1 k2)))) (meet n x (join n y z))) (join n (meet n x z) y)) *)
induction n as [| n IH]; simpl; try Vfold n.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite multK_assoc; auto.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (let (x1, y1) := let (x1, y1) := x in let (x2, y2) := y in @pair (vect n) (vect n) (meet n x1 x2) (addE (vn_eparams n) (meet n x1 y2) (meet n y1 (dconj n false x2))) in let (x2, y2) := z in @pair (vect n) (vect n) (meet n x1 x2) (addE (vn_eparams n) (meet n x1 y2) (meet n y1 (dconj n false x2)))) (let (x1, y1) := x in let (x2, y2) := let (x2, y2) := y in let (x3, y3) := z in @pair (vect n) (vect n) (meet n x2 x3) (addE (vn_eparams n) (meet n x2 y3) (meet n y2 (dconj n false x3))) in @pair (vect n) (vect n) (meet n x1 x2) (addE (vn_eparams n) (meet n x1 y2) (meet n y1 (dconj n false x2)))) *)
destruct x; destruct y; destruct z.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
apply f_equal2 with (f := @pair _ _).
(* Goal: @Logic.eq (vect n) (meet n (meet n v v1) v3) (meet n v (meet n v1 v3)) *)
(* Goal: @Logic.eq (vect n) (addE (vn_eparams n) (meet n (meet n v v1) v4) (meet n (addE (vn_eparams n) (meet n v v2) (meet n v0 (dconj n false v1))) (dconj n false v3))) (addE (vn_eparams n) (meet n v (addE (vn_eparams n) (meet n v1 v4) (meet n v2 (dconj n false v3)))) (meet n v0 (dconj n false (meet n v1 v3)))) *)
  2: rewrite IH; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite join_addr, join_addl, !addE_assoc; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
repeat apply f_equal2 with (f := add n); auto.
rewrite <- IH.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply f_equal2 with (f := join n); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite conjf_join; auto.
Qed. 

(* Anti-commutativity is stable by linear combination *)
Lemma cbl_join_com n (vs: list (vect n)) :
  (forall x y, In x vs -> In y vs -> y ∨ x = (- (1)).* (x ∨ y)) ->
  forall x y, cbl _ vs x -> cbl _ vs y -> y ∨ x = (- (1)).* (x ∨ y).
Proof.
(* Goal: forall (_ : forall (x y : vect n) (_ : @In (vect n) x vs) (_ : @In (vect n) y vs), @Logic.eq (vect n) (join n y x) (scalE (vn_eparams n) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (join n x y))) (x y : E (vn_eparams n)) (_ : cbl (vn_eparams n) vs x) (_ : cbl (vn_eparams n) vs y), @Logic.eq (vect n) (join n y x) (scalE (vn_eparams n) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (join n x y)) *)
intros H x y Hx; elim Hx; clear x Hx.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros; rewrite join0l; rewrite join0r; rewrite scalE0r; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros vx Hvx Hy; elim Hy; clear y Hy; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite join0l, join0r, scalE0r; auto.
intros x y Hx Hx1 Hy Hy1; rewrite join_addl, Hx1, Hy1, <- scal_addEr,
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
                                  join_addr; auto.
(* Goal: forall (k : Field.K (stype (vn_eparams n))) (x : E (vn_eparams n)) (_ : cbl (vn_eparams n) vs x) (_ : @Logic.eq (vect n) (join n x vx) (scalE (vn_eparams n) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (join n vx x))), @Logic.eq (vect n) (join n (scalE (vn_eparams n) k x) vx) (scalE (vn_eparams n) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (join n vx (scalE (vn_eparams n) k x))) *)
(* Goal: forall (x y0 : E (vn_eparams n)) (_ : cbl (vn_eparams n) vs x) (_ : forall _ : cbl (vn_eparams n) vs y, @Logic.eq (vect n) (join n y x) (scalE (vn_eparams n) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (join n x y))) (_ : cbl (vn_eparams n) vs y0) (_ : forall _ : cbl (vn_eparams n) vs y, @Logic.eq (vect n) (join n y y0) (scalE (vn_eparams n) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (join n y0 y))) (_ : cbl (vn_eparams n) vs y), @Logic.eq (vect n) (join n y (addE (vn_eparams n) x y0)) (scalE (vn_eparams n) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (join n (addE (vn_eparams n) x y0) y)) *)
(* Goal: forall (k : Field.K (stype (vn_eparams n))) (x : E (vn_eparams n)) (_ : cbl (vn_eparams n) vs x) (_ : forall _ : cbl (vn_eparams n) vs y, @Logic.eq (vect n) (join n y x) (scalE (vn_eparams n) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (join n x y))) (_ : cbl (vn_eparams n) vs y), @Logic.eq (vect n) (join n y (scalE (vn_eparams n) k x)) (scalE (vn_eparams n) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (join n (scalE (vn_eparams n) k x) y)) *)
intros k x Hx Hx1.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
  rewrite join_scall, Hx1, <- scal_multE, join_scalr, <- scal_multE, multK_com; auto.
(* Goal: forall (x y0 : E (vn_eparams n)) (_ : cbl (vn_eparams n) vs x) (_ : forall _ : cbl (vn_eparams n) vs y, @Logic.eq (vect n) (join n y x) (scalE (vn_eparams n) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (join n x y))) (_ : cbl (vn_eparams n) vs y0) (_ : forall _ : cbl (vn_eparams n) vs y, @Logic.eq (vect n) (join n y y0) (scalE (vn_eparams n) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (join n y0 y))) (_ : cbl (vn_eparams n) vs y), @Logic.eq (vect n) (join n y (addE (vn_eparams n) x y0)) (scalE (vn_eparams n) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (join n (addE (vn_eparams n) x y0) y)) *)
(* Goal: forall (k : Field.K (stype (vn_eparams n))) (x : E (vn_eparams n)) (_ : cbl (vn_eparams n) vs x) (_ : forall _ : cbl (vn_eparams n) vs y, @Logic.eq (vect n) (join n y x) (scalE (vn_eparams n) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (join n x y))) (_ : cbl (vn_eparams n) vs y), @Logic.eq (vect n) (join n y (scalE (vn_eparams n) k x)) (scalE (vn_eparams n) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (join n (scalE (vn_eparams n) k x) y)) *)
intros x y1 Hx Hxrec Hy1 Hy1rec Hy.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite join_addr, Hxrec, Hy1rec; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite <- scal_addEr, join_addl; auto.
(* Goal: forall (k : Field.K (stype (vn_eparams n))) (x : E (vn_eparams n)) (_ : cbl (vn_eparams n) vs x) (_ : forall _ : cbl (vn_eparams n) vs y, @Logic.eq (vect n) (join n y x) (scalE (vn_eparams n) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (join n x y))) (_ : cbl (vn_eparams n) vs y), @Logic.eq (vect n) (join n y (scalE (vn_eparams n) k x)) (scalE (vn_eparams n) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (join n (scalE (vn_eparams n) k x) y)) *)
intros k x Hx Hxrec Hy.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite join_scalr, Hxrec, <- scal_multE, join_scall, <- scal_multE, multK_com; auto.
Qed.

(* Anti-commutativity is true for the base *)
Lemma cbl_base_join_com n x y :
 cbl _ (base n 1) x -> cbl _ (base n 1) y ->  y ∨ x = (- (1)).* (x ∨ y).
Proof.
(* Goal: forall (_ : cbl (vn_eparams n) (base n (S O)) x) (_ : cbl (vn_eparams n) (base n (S O)) y), @Logic.eq (vect n) (join n y x) (scalE (vn_eparams n) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (join n x y)) *)
apply (cbl_join_com n).
(* Goal: forall (x y : vect n) (_ : @In (vect n) x (base n (S O))) (_ : @In (vect n) y (base n (S O))), @Logic.eq (vect n) (join n y x) (scalE (vn_eparams n) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (join n x y)) *)
intros x1 y1 Hx Hy.
(* Goal: @Logic.eq (vect n) (join n x x) (E0 (vn_eparams n)) *)
case (e_in_base1_ex _ _ Hx); intros i (Hi, Hi1).
(* Goal: @Logic.eq (vect n) (join n y x) (scalE (vn_eparams n) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (join n x y)) *)
(* Goal: forall (x : vect n) (_ : @In (vect n) x (base n (S O))), @Logic.eq (vect n) (join n x x) (E0 (vn_eparams n)) *)
case (e_in_base1_ex _ _ Hy); intros j (Hj, Hj1).
(* Goal: @Logic.eq (vect n) (join n y x) (scalE (vn_eparams n) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (join n x y)) *)
(* Goal: forall (x : vect n) (_ : @In (vect n) x (base n (S O))), @Logic.eq (vect n) (join n x x) (E0 (vn_eparams n)) *)
rewrite Hi1; rewrite Hj1.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite <- (addE0l (vn_eparams n)); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
 rewrite <- (join_es n j i), addE_assoc, scal_addE0, addE0r; auto.
Qed.

(* x*x = 0 is stable by linear combination *)
Lemma cbl_join_id n vs : 
  (forall x y, In x vs -> In y vs -> join n y x = (- (1)).* (x ∨ y)) ->
  (forall x, In x vs -> x ∨ x = 0) -> forall x, cbl _ vs x -> x ∨ x = 0.
Proof.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros H H1 x Hx; elim Hx; clear x Hx; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros; rewrite join0l; auto.
(* Goal: forall (x y : E (vn_eparams n)) (_ : cbl (vn_eparams n) vs x) (_ : @Logic.eq (vect n) (join n x x) (E0 (vn_eparams n))) (_ : cbl (vn_eparams n) vs y) (_ : @Logic.eq (vect n) (join n y y) (E0 (vn_eparams n))), @Logic.eq (vect n) (join n (addE (vn_eparams n) x y) (addE (vn_eparams n) x y)) (E0 (vn_eparams n)) *)
(* Goal: forall (k : Field.K (stype (vn_eparams n))) (x : E (vn_eparams n)) (_ : cbl (vn_eparams n) vs x) (_ : @Logic.eq (vect n) (join n x x) (E0 (vn_eparams n))), @Logic.eq (vect n) (join n (scalE (vn_eparams n) k x) (scalE (vn_eparams n) k x)) (E0 (vn_eparams n)) *)
intros x y Hx Hxrec Hy Hyrec.
rewrite join_addr, join_addl, 
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
        join_addl, Hxrec, Hyrec, addE0l, addE0r; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite (cbl_join_com _ _ H x), addE_com, scal_addE0;  auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros k x Hx IH; rewrite join_scall, join_scalr, IH, scalE0r, scalE0r; auto.
Qed.

(* x*x = 0 is true for the base *)
Lemma cbl_base_join_id n x : cbl _ (base n 1) x -> x ∨ x = 0.
Proof.
(* Goal: forall _ : cbl (vn_eparams n) (base n (S O)) x, @Logic.eq (vect n) (join n x x) (E0 (vn_eparams n)) *)
intros Hx; apply (cbl_join_id n (base n 1)); auto; clear x Hx.
(* Goal: forall (x y : vect n) (_ : @In (vect n) x (base n (S O))) (_ : @In (vect n) y (base n (S O))), @Logic.eq (vect n) (join n y x) (scalE (vn_eparams n) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (join n x y)) *)
(* Goal: forall (x : vect n) (_ : @In (vect n) x (base n (S O))), @Logic.eq (vect n) (join n x x) (E0 (vn_eparams n)) *)
intros x y Hx Hy.
(* Goal: @Logic.eq (vect n) (join n x x) (E0 (vn_eparams n)) *)
case (e_in_base1_ex _ _ Hx); intros i (Hi, Hi1).
(* Goal: @Logic.eq (vect n) (join n y x) (scalE (vn_eparams n) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (join n x y)) *)
(* Goal: forall (x : vect n) (_ : @In (vect n) x (base n (S O))), @Logic.eq (vect n) (join n x x) (E0 (vn_eparams n)) *)
case (e_in_base1_ex _ _ Hy); intros j (Hj, Hj1).
(* Goal: @Logic.eq (vect n) (join n y x) (scalE (vn_eparams n) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (join n x y)) *)
(* Goal: forall (x : vect n) (_ : @In (vect n) x (base n (S O))), @Logic.eq (vect n) (join n x x) (E0 (vn_eparams n)) *)
rewrite Hi1; rewrite Hj1.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite <- (addE0l (vn_eparams n)), <- (join_es n j i), addE_assoc, scal_addE0, addE0r; auto.
(* Goal: forall (x : vect n) (_ : @In (vect n) x (base n (S O))), @Logic.eq (vect n) (join n x x) (E0 (vn_eparams n)) *)
intros x Hx.
(* Goal: @Logic.eq (vect n) (join n x x) (E0 (vn_eparams n)) *)
case (e_in_base1_ex _ _ Hx); intros i (Hi, Hi1).
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite Hi1, join_e; auto.
Qed.

Lemma join_hom1_id n x : hom n 1 x -> x ∨ x = 0.
Proof.
(* Goal: forall _ : b2Prop (hom n (S O) x), @Logic.eq (vect n) (join n x x) (E0 (vn_eparams n)) *)
rewrite <-cbl1_hom1_equiv.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros; apply cbl_base_join_id; auto.
Qed.

(* Lift for the production *)
Lemma lift_join n x y : lift n (x ∨ y) = lift n x ∨ lift n y.
Proof.
(* Goal: @Logic.eq (vect (S n)) (lift n (join n x y)) (join (S n) (lift n x) (lift n y)) *)
unfold lift; simpl; try Vfold n.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite join0l, addE0l, join0r; auto.
Qed.

Lemma join_hom n k1 k2 (x y: vect n) : 
  hom n k1 x -> hom n k2 y -> hom n (k1 + k2) (x ∨ y).
Proof.
(* Goal: forall (_ : b2Prop (hom n k1 x)) (_ : b2Prop (hom n (S O) y)) (_ : b2Prop (hom n k2 z)), @Logic.eq (vect n) (meet n (join n x y) z) (addE (vn_eparams n) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n (S (Nat.add k1 k2)))) (meet n x (join n y z))) (join n (meet n x z) y)) *)
generalize k1 k2; clear k1 k2.
(* Goal: forall (k1 k2 : nat) (_ : b2Prop (hom n k1 x)) (_ : b2Prop (hom n (S O) y)) (_ : b2Prop (hom n k2 z)), @Logic.eq (vect n) (meet n (join n x y) z) (addE (vn_eparams n) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n (S (Nat.add k1 k2)))) (meet n x (join n y z))) (join n (meet n x z) y)) *)
induction n as [| n IH]; simpl; try Vfold n.
(* Goal: @Logic.eq (vect n) (mcontra n (@cons (kn p n) a l) x) (mcontra n l (contra n a x)) *)
  intros [|k1] [|k2]; simpl; auto.
(* Goal: b2Prop false *)
  intros _; case eqK_spec; auto; intros HH HH1; try discriminate.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
    rewrite HH, multK0r, eqKI; auto.
(* Goal: b2Prop false *)
  case eqK_spec; auto; intros HH HH1 _; try discriminate.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
    rewrite HH, multK0l, eqKI; auto.
(* Goal: b2Prop false *)
  intros _; case eqK_spec; auto; intros HH HH1; try discriminate.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
    rewrite HH, multK0r, eqKI; auto.
intros [|k1] [|k2];
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (dual n (conj n false (genk n k))) (dual n (genk n (v0 (K1 p))))) (@pair (vect n) (vect n) (scal n k (all n)) (scal n k (genk n (v0 (K1 p))))) *)
    destruct x as [x1 x2]; destruct y as [y1 y2]; simpl; auto; Vfold n.
case eq0_spec; case eq0_spec; try (intros; discriminate);
  intros HH1 HH2; subst.
(* Goal: forall (_ : b2Prop (andb true (hom n O x2))) (_ : b2Prop (andb true (hom n O y2))), b2Prop (andb (eq0 n (addE (vn_eparams n) (join n (E0 (vn_eparams n)) y2) (join n (conj n false x2) (E0 (vn_eparams n))))) (hom n O (join n x2 y2))) *)
(* Goal: forall (_ : b2Prop (andb (eq0 n x1) (hom n O x2))) (_ : b2Prop (andb (hom n k2 y1) (hom n (S k2) y2))), b2Prop (andb (hom n k2 (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1))) (hom n (S k2) (join n x2 y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (eq0 n y1) (hom n O y2))), b2Prop (andb (hom n (Nat.add k1 O) (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1))) (hom n (S (Nat.add k1 O)) (join n x2 y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n k2 y1) (hom n (S k2) y2))), b2Prop (andb (hom n (Nat.add k1 (S k2)) (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1))) (hom n (S (Nat.add k1 (S k2))) (join n x2 y2))) *)
  rewrite join0l, join0r, addE0l, eq0I; auto; intros HH1 HH2.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
  rewrite (hom0E _ _ HH1), (hom0E _ _ HH2), joink, hom0K; auto.
case eq0_spec; try (intros; discriminate);
  intros HH1 HH2 HH3; subst.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
  rewrite join0l, addE0l; auto.
(* Goal: b2Prop (andb (hom n k2 (join n (conj n false x2) y1)) (hom n (S k2) (join n x2 y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (eq0 n y1) (hom n O y2))), b2Prop (andb (hom n (Nat.add k1 O) (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1))) (hom n (S (Nat.add k1 O)) (join n x2 y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n k2 y1) (hom n (S k2) y2))), b2Prop (andb (hom n (Nat.add k1 (S k2)) (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1))) (hom n (S (Nat.add k1 (S k2))) (join n x2 y2))) *)
  generalize (IH x2 y1 0%nat k2.+1 HH2).
(* Goal: forall _ : forall _ : b2Prop (hom n (S k2) y1), b2Prop (hom n (Nat.add O (S k2)) (join n x2 y1)), b2Prop (andb (hom n k2 (join n (conj n false x2) y1)) (hom n (S k2) (join n x2 y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (eq0 n y1) (hom n O y2))), b2Prop (andb (hom n (Nat.add k1 O) (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1))) (hom n (S (Nat.add k1 O)) (join n x2 y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n k2 y1) (hom n (S k2) y2))), b2Prop (andb (hom n (Nat.add k1 (S k2)) (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1))) (hom n (S (Nat.add k1 (S k2))) (join n x2 y2))) *)
  intros HH4.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
  rewrite (IH _ _ 0%nat k2); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
  apply (IH _ _ 0%nat k2.+1); auto.
(* Goal: b2Prop false *)
  generalize HH3; case hom; auto; intros; discriminate.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
  generalize HH3; case hom; auto.
case eq0_spec; try (intros; discriminate);
  intros HH1 HH2 HH3; subst.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
  rewrite join0r, addE0r, <- plus_n_O; auto.
(* Goal: b2Prop (andb (hom n k1 (join n x1 y2)) (hom n (S k1) (join n x2 y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n k2 y1) (hom n (S k2) y2))), b2Prop (andb (hom n (Nat.add k1 (S k2)) (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1))) (hom n (S (Nat.add k1 (S k2))) (join n x2 y2))) *)
  pattern k1 at 1; rewrite (plus_n_O k1).
(* Goal: @Logic.eq (vect n) (meet n (meet n v v1) v3) (meet n v (meet n v1 v3)) *)
(* Goal: @Logic.eq (vect n) (addE (vn_eparams n) (meet n (meet n v v1) v4) (meet n (addE (vn_eparams n) (meet n v v2) (meet n v0 (dconj n false v1))) (dconj n false v3))) (addE (vn_eparams n) (meet n v (addE (vn_eparams n) (meet n v1 v4) (meet n v2 (dconj n false v3)))) (meet n v0 (dconj n false (meet n v1 v3)))) *)
  rewrite IH; auto.
  rewrite  (plus_n_O k1.+1).
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
  apply IH; auto.
(* Goal: b2Prop false *)
  generalize HH2; case hom; auto; intros; discriminate.
(* Goal: b2Prop false *)
  generalize HH2; case hom; auto; intros; discriminate.
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n k2 y1) (hom n (S k2) y2))), b2Prop (andb (hom n (Nat.add k1 (S k2)) (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1))) (hom n (S (Nat.add k1 (S k2))) (join n x2 y2))) *)
intros HH1 HH2.
(* Goal: b2Prop (andb (hom n (Nat.add k1 (S k2)) (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1))) (hom n (S (Nat.add k1 (S k2))) (join n x2 y2))) *)
assert (Hx1: hom n k1 x1).
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
  generalize HH1; case hom; auto.
(* Goal: b2Prop (andb (hom n (Nat.add k1 (S k2)) (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1))) (hom n (S (Nat.add k1 (S k2))) (join n x2 y2))) *)
assert (Hx2: hom n k1.+1 x2).
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
  generalize HH1; rewrite Hx1; auto.
(* Goal: b2Prop (andb (hom n (Nat.add k1 (S k2)) (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1))) (hom n (S (Nat.add k1 (S k2))) (join n x2 y2))) *)
assert (Hy1: hom n k2 y1).
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
  generalize HH2; case hom; auto.
(* Goal: b2Prop (andb (hom n (Nat.add k1 (S k2)) (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1))) (hom n (S (Nat.add k1 (S k2))) (join n x2 y2))) *)
assert (Hy2: hom n k2.+1 y2).
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
  generalize HH2; rewrite Hy1; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite add_hom; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply (IH _ _ k1.+1 k2.+1); auto.
(* Goal: b2Prop (hom n (Nat.add k1 (S k2)) (join n (conj n false x2) y1)) *)
rewrite <- Plus.plus_Snm_nSm.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply IH; auto.
Qed.

Hint Resolve join_hom.

Lemma join_big n k1 k2 (x y : vect n) : 
  hom n k1 x -> hom n k2 y -> n < k1 + k2 -> x ∨ y = 0.
Proof. intros Hx Hy Hlt; apply hom_lt with (k1 + k2)%nat; auto. Qed.

Lemma const_join n (x y: vect n): 'C[x ∨ y] = ('C[x] * 'C[y])%f.
Proof.
(* Goal: @Logic.eq (Field.K (K1 p)) (const n (join n x y)) (multK (K1 p) (const n x) (const n y)) *)
induction n as [| n IH]; auto; simpl; try Vfold n.
(* Goal: @Logic.eq (vect n) (mcontra n (@cons (kn p n) a l) x) (mcontra n l (contra n a x)) *)
destruct x; destruct y; simpl; auto.
Qed.

Lemma lift_decomp n (x y: vect n) : (x, y) = 'e_0 ∨ x^'l + y^'l.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
Proof.  simpl; Vfold n; rewrite conj0, !join0l, !addE0r, addE0l, join1l; auto.
Qed.

(* Base as product *)
Lemma base_in n k x: In x (base n k.+1) -> 
    exists i, exists y, x = 'e_i ∨ y /\ In y (base n k). 
Proof.
(* Goal: forall _ : @In (vect n) v (base n k), or (@Logic.eq (vect n) (join n v (dual n v)) (all n)) (@Logic.eq (vect n) (join n v (dual n v)) (scalE (vn_eparams n) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (all n))) *)
generalize k; clear k.
(* Goal: forall (b : bool) (k : nat) (_ : b2Prop (hom n k x)), b2Prop (hom n k (dconj n b x)) *)
induction n as [| n IH]; simpl.
(* Goal: forall (k : nat) (_ : False), @ex nat (fun _ : nat => @ex (Field.K (K1 p)) (fun y : Field.K (K1 p) => and (@Logic.eq (Field.K (K1 p)) x (multK (K1 p) (v1 (K1 p)) y)) (@In (Field.K (K1 p)) y match k with | O => @cons (Field.K (K1 p)) (v1 (K1 p)) (@nil (Field.K (K1 p))) | S n => @nil (Field.K (K1 p)) end))) *)
(* Goal: forall (k : nat) (_ : @In (prod (vect n) (vect n)) x (@app (prod (vect n) (vect n)) (@map (vect n) (prod (vect n) (vect n)) (dlift n) (base n k)) (@map (vect n) (prod (vect n) (vect n)) (lift n) (base n (S k))))), @ex nat (fun i : nat => @ex (prod (vect n) (vect n)) (fun y : prod (vect n) (vect n) => and (@Logic.eq (prod (vect n) (vect n)) x (let (x1, x2) := match i with | O => @pair (vect n) (vect n) (genk n (v1 (K1 p))) (genk n (v0 (K1 p))) | S p1 => @pair (vect n) (vect n) (genk n (v0 (K1 p))) (gen n p1) end in let (y1, y2) := y in @pair (vect n) (vect n) (add n (join n x1 y2) (join n (conj n false x2) y1)) (join n x2 y2))) (@In (prod (vect n) (vect n)) y match k with | O => @map (vect n) (prod (vect n) (vect n)) (lift n) (base n k) | S k1 => @app (prod (vect n) (vect n)) (@map (vect n) (prod (vect n) (vect n)) (dlift n) (base n k1)) (@map (vect n) (prod (vect n) (vect n)) (lift n) (base n k)) end))) *)
intros k [].
(* Goal: forall (k : nat) (_ : @In (prod (vect n) (vect n)) x (@app (prod (vect n) (vect n)) (@map (vect n) (prod (vect n) (vect n)) (dlift n) (base n k)) (@map (vect n) (prod (vect n) (vect n)) (lift n) (base n (S k))))), @ex nat (fun i : nat => @ex (prod (vect n) (vect n)) (fun y : prod (vect n) (vect n) => and (@Logic.eq (prod (vect n) (vect n)) x (let (x1, x2) := match i with | O => @pair (vect n) (vect n) (genk n (v1 (K1 p))) (genk n (v0 (K1 p))) | S p1 => @pair (vect n) (vect n) (genk n (v0 (K1 p))) (gen n p1) end in let (y1, y2) := y in @pair (vect n) (vect n) (add n (join n x1 y2) (join n (conj n false x2) y1)) (join n x2 y2))) (@In (prod (vect n) (vect n)) y match k with | O => @map (vect n) (prod (vect n) (vect n)) (lift n) (base n k) | S k1 => @app (prod (vect n) (vect n)) (@map (vect n) (prod (vect n) (vect n)) (dlift n) (base n k1)) (@map (vect n) (prod (vect n) (vect n)) (lift n) (base n k)) end))) *)
intros [| k] HH; destruct x as [x1 x2].
case (in_app_or _ _ _ HH); rewrite in_map_iff;
  intros (x, (H1x, H2x)); injection H1x; intros; subst.
(* Goal: @ex nat (fun i : nat => @ex (prod (vect n) (vect n)) (fun y : prod (vect n) (vect n) => and (@Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) x1 (genk n (v0 (K1 p)))) (let (x1, x2) := match i with | O => @pair (vect n) (vect n) (genk n (v1 (K1 p))) (genk n (v0 (K1 p))) | S p1 => @pair (vect n) (vect n) (genk n (v0 (K1 p))) (gen n p1) end in let (y1, y2) := y in @pair (vect n) (vect n) (add n (join n x1 y2) (join n (conj n false x2) y1)) (join n x2 y2))) (@In (prod (vect n) (vect n)) y (@app (prod (vect n) (vect n)) (@map (vect n) (prod (vect n) (vect n)) (dlift n) (base n k)) (@map (vect n) (prod (vect n) (vect n)) (lift n) (base n (S k))))))) *)
(* Goal: @ex nat (fun i : nat => @ex (prod (vect n) (vect n)) (fun y : prod (vect n) (vect n) => and (@Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (genk n (v0 (K1 p))) x2) (let (x1, x2) := match i with | O => @pair (vect n) (vect n) (genk n (v1 (K1 p))) (genk n (v0 (K1 p))) | S p1 => @pair (vect n) (vect n) (genk n (v0 (K1 p))) (gen n p1) end in let (y1, y2) := y in @pair (vect n) (vect n) (add n (join n x1 y2) (join n (conj n false x2) y1)) (join n x2 y2))) (@In (prod (vect n) (vect n)) y (@app (prod (vect n) (vect n)) (@map (vect n) (prod (vect n) (vect n)) (dlift n) (base n k)) (@map (vect n) (prod (vect n) (vect n)) (lift n) (base n (S k))))))) *)
exists 0%nat; exists (lift n x1); simpl; split; Vfold n.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) x1 (E0 (vn_eparams n))) (@pair (vect n) (vect n) (addE (vn_eparams n) (join n (genk n (v1 (K1 p))) x1) (join n (conj n false (E0 (vn_eparams n))) (E0 (vn_eparams n)))) (join n (E0 (vn_eparams n)) x1)) *)
(* Goal: @In (prod (vect n) (vect n)) (lift n x1) (@app (prod (vect n) (vect n)) (@map (vect n) (prod (vect n) (vect n)) (dlift n) (base n k)) (@map (vect n) (prod (vect n) (vect n)) (lift n) (base n (S k)))) *)
(* Goal: @ex nat (fun i : nat => @ex (prod (vect n) (vect n)) (fun y : prod (vect n) (vect n) => and (@Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (genk n (v0 (K1 p))) x2) (let (x1, x2) := match i with | O => @pair (vect n) (vect n) (genk n (v1 (K1 p))) (genk n (v0 (K1 p))) | S p1 => @pair (vect n) (vect n) (genk n (v0 (K1 p))) (gen n p1) end in let (y1, y2) := y in @pair (vect n) (vect n) (add n (join n x1 y2) (join n (conj n false x2) y1)) (join n x2 y2))) (@In (prod (vect n) (vect n)) y (@app (prod (vect n) (vect n)) (@map (vect n) (prod (vect n) (vect n)) (dlift n) (base n k)) (@map (vect n) (prod (vect n) (vect n)) (lift n) (base n (S k))))))) *)
rewrite join0l, join0r, join1l, addE0r; auto .
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply in_map; auto.
(* Goal: @ex nat (fun i : nat => @ex (prod (vect n) (vect n)) (fun y : prod (vect n) (vect n) => and (@Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (genk n (v0 (K1 p))) x2) (let (x1, x2) := match i with | O => @pair (vect n) (vect n) (genk n (v1 (K1 p))) (genk n (v0 (K1 p))) | S p1 => @pair (vect n) (vect n) (genk n (v0 (K1 p))) (gen n p1) end in let (y1, y2) := y in @pair (vect n) (vect n) (add n (join n x1 y2) (join n (conj n false x2) y1)) (join n x2 y2))) (@In (prod (vect n) (vect n)) y (@map (vect n) (prod (vect n) (vect n)) (lift n) (base n O))))) *)
(* Goal: @ex nat (fun i : nat => @ex (prod (vect n) (vect n)) (fun y : prod (vect n) (vect n) => and (@Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) x1 x2) (let (x1, x2) := match i with | O => @pair (vect n) (vect n) (genk n (v1 (K1 p))) (genk n (v0 (K1 p))) | S p1 => @pair (vect n) (vect n) (genk n (v0 (K1 p))) (gen n p1) end in let (y1, y2) := y in @pair (vect n) (vect n) (add n (join n x1 y2) (join n (conj n false x2) y1)) (join n x2 y2))) (@In (prod (vect n) (vect n)) y (@app (prod (vect n) (vect n)) (@map (vect n) (prod (vect n) (vect n)) (dlift n) (base n k)) (@map (vect n) (prod (vect n) (vect n)) (lift n) (base n (S k))))))) *)
case (IH x2 0%nat); auto; intros i (y, (H1y, H2y)).
(* Goal: @ex nat (fun i : nat => @ex (prod (vect n) (vect n)) (fun y : prod (vect n) (vect n) => and (@Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (genk n (v0 (K1 p))) x2) (let (x1, x2) := match i with | O => @pair (vect n) (vect n) (genk n (v1 (K1 p))) (genk n (v0 (K1 p))) | S p1 => @pair (vect n) (vect n) (genk n (v0 (K1 p))) (gen n p1) end in let (y1, y2) := y in @pair (vect n) (vect n) (add n (join n x1 y2) (join n (conj n false x2) y1)) (join n x2 y2))) (@In (prod (vect n) (vect n)) y (@app (prod (vect n) (vect n)) (@map (vect n) (prod (vect n) (vect n)) (dlift n) (base n k)) (@map (vect n) (prod (vect n) (vect n)) (lift n) (base n (S k))))))) *)
exists (1 + i)%nat; exists (lift n y); simpl; split; Vfold n.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (E0 (vn_eparams n)) x2) (@pair (vect n) (vect n) (addE (vn_eparams n) (join n (E0 (vn_eparams n)) y) (join n (conj n false (gen n i)) (E0 (vn_eparams n)))) (join n (gen n i) y)) *)
(* Goal: @In (prod (vect n) (vect n)) (lift n y) (@app (prod (vect n) (vect n)) (@map (vect n) (prod (vect n) (vect n)) (dlift n) (base n k)) (@map (vect n) (prod (vect n) (vect n)) (lift n) (base n (S k)))) *)
rewrite join0l, join0r, addE0r, H1y; auto .
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply in_map; auto.
case (in_app_or _ _ _ HH); rewrite in_map_iff;
  intros (x, (H1x, H2x)); injection H1x; intros; subst.
(* Goal: @ex nat (fun i : nat => @ex (prod (vect n) (vect n)) (fun y : prod (vect n) (vect n) => and (@Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) x1 (genk n (v0 (K1 p)))) (let (x1, x2) := match i with | O => @pair (vect n) (vect n) (genk n (v1 (K1 p))) (genk n (v0 (K1 p))) | S p1 => @pair (vect n) (vect n) (genk n (v0 (K1 p))) (gen n p1) end in let (y1, y2) := y in @pair (vect n) (vect n) (add n (join n x1 y2) (join n (conj n false x2) y1)) (join n x2 y2))) (@In (prod (vect n) (vect n)) y (@app (prod (vect n) (vect n)) (@map (vect n) (prod (vect n) (vect n)) (dlift n) (base n k)) (@map (vect n) (prod (vect n) (vect n)) (lift n) (base n (S k))))))) *)
(* Goal: @ex nat (fun i : nat => @ex (prod (vect n) (vect n)) (fun y : prod (vect n) (vect n) => and (@Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (genk n (v0 (K1 p))) x2) (let (x1, x2) := match i with | O => @pair (vect n) (vect n) (genk n (v1 (K1 p))) (genk n (v0 (K1 p))) | S p1 => @pair (vect n) (vect n) (genk n (v0 (K1 p))) (gen n p1) end in let (y1, y2) := y in @pair (vect n) (vect n) (add n (join n x1 y2) (join n (conj n false x2) y1)) (join n x2 y2))) (@In (prod (vect n) (vect n)) y (@app (prod (vect n) (vect n)) (@map (vect n) (prod (vect n) (vect n)) (dlift n) (base n k)) (@map (vect n) (prod (vect n) (vect n)) (lift n) (base n (S k))))))) *)
exists 0%nat; exists (lift n x1); simpl; split; Vfold n.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) x1 (E0 (vn_eparams n))) (@pair (vect n) (vect n) (addE (vn_eparams n) (join n (genk n (v1 (K1 p))) x1) (join n (conj n false (E0 (vn_eparams n))) (E0 (vn_eparams n)))) (join n (E0 (vn_eparams n)) x1)) *)
(* Goal: @In (prod (vect n) (vect n)) (lift n x1) (@app (prod (vect n) (vect n)) (@map (vect n) (prod (vect n) (vect n)) (dlift n) (base n k)) (@map (vect n) (prod (vect n) (vect n)) (lift n) (base n (S k)))) *)
(* Goal: @ex nat (fun i : nat => @ex (prod (vect n) (vect n)) (fun y : prod (vect n) (vect n) => and (@Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (genk n (v0 (K1 p))) x2) (let (x1, x2) := match i with | O => @pair (vect n) (vect n) (genk n (v1 (K1 p))) (genk n (v0 (K1 p))) | S p1 => @pair (vect n) (vect n) (genk n (v0 (K1 p))) (gen n p1) end in let (y1, y2) := y in @pair (vect n) (vect n) (add n (join n x1 y2) (join n (conj n false x2) y1)) (join n x2 y2))) (@In (prod (vect n) (vect n)) y (@app (prod (vect n) (vect n)) (@map (vect n) (prod (vect n) (vect n)) (dlift n) (base n k)) (@map (vect n) (prod (vect n) (vect n)) (lift n) (base n (S k))))))) *)
rewrite join0l, join0r, join1l, addE0r; auto .
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply in_or_app; right; apply in_map; auto.
(* Goal: @ex nat (fun i : nat => @ex (prod (vect n) (vect n)) (fun y : prod (vect n) (vect n) => and (@Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (genk n (v0 (K1 p))) x2) (let (x1, x2) := match i with | O => @pair (vect n) (vect n) (genk n (v1 (K1 p))) (genk n (v0 (K1 p))) | S p1 => @pair (vect n) (vect n) (genk n (v0 (K1 p))) (gen n p1) end in let (y1, y2) := y in @pair (vect n) (vect n) (add n (join n x1 y2) (join n (conj n false x2) y1)) (join n x2 y2))) (@In (prod (vect n) (vect n)) y (@app (prod (vect n) (vect n)) (@map (vect n) (prod (vect n) (vect n)) (dlift n) (base n k)) (@map (vect n) (prod (vect n) (vect n)) (lift n) (base n (S k))))))) *)
case (IH x2 k.+1%nat); auto; intros i (y, (H1y, H2y)).
(* Goal: @ex nat (fun i : nat => @ex (prod (vect n) (vect n)) (fun y : prod (vect n) (vect n) => and (@Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (genk n (v0 (K1 p))) x2) (let (x1, x2) := match i with | O => @pair (vect n) (vect n) (genk n (v1 (K1 p))) (genk n (v0 (K1 p))) | S p1 => @pair (vect n) (vect n) (genk n (v0 (K1 p))) (gen n p1) end in let (y1, y2) := y in @pair (vect n) (vect n) (add n (join n x1 y2) (join n (conj n false x2) y1)) (join n x2 y2))) (@In (prod (vect n) (vect n)) y (@app (prod (vect n) (vect n)) (@map (vect n) (prod (vect n) (vect n)) (dlift n) (base n k)) (@map (vect n) (prod (vect n) (vect n)) (lift n) (base n (S k))))))) *)
exists (1 + i)%nat; exists (lift n y); simpl; split; Vfold n.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (E0 (vn_eparams n)) x2) (@pair (vect n) (vect n) (addE (vn_eparams n) (join n (E0 (vn_eparams n)) y) (join n (conj n false (gen n i)) (E0 (vn_eparams n)))) (join n (gen n i) y)) *)
(* Goal: @In (prod (vect n) (vect n)) (lift n y) (@app (prod (vect n) (vect n)) (@map (vect n) (prod (vect n) (vect n)) (dlift n) (base n k)) (@map (vect n) (prod (vect n) (vect n)) (lift n) (base n (S k)))) *)
rewrite join0l, join0r, addE0r, H1y; auto .
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply in_or_app; right; apply in_map; auto.
Qed.

(* given a list of vectors produce the list of all products *)
Fixpoint all_prods (n: nat) (vs: list (vect n)) {struct vs} : list (vect n) :=
  match vs with
    nil => 1 :: nil
  | v::vs1 => let vs1 := all_prods n vs1 in 
                (map (join n v) vs1 ++ vs1)%list
  end.

(* 1 is the only element of empty product *)
Lemma all_prods_nil n : all_prods n nil = 1 :: nil.
Proof. auto. Qed.

(* Recursive definition of all products *)
Lemma all_prods_cons n v vs : 
  all_prods n (v :: vs) = (map (join n v) (all_prods n vs) ++ (all_prods n vs))%list.
Proof. auto. Qed.

(* 1 is always in the list of all products *)
Lemma all_prods1 n vs : In (1) (all_prods n vs).
Proof. induction vs as [| v vs IH]; simpl; auto with datatypes. Qed.

(* The initial vectors are in the list of all products *)
Lemma all_prods_id n vs : incl vs (all_prods n vs).
Proof.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
induction vs as [| v vs IH]; intros x; simpl In; auto.
(* Goal: forall _ : or (@Logic.eq (vect n) v x) (@In (vect n) x vs), @In (vect n) x (@app (vect n) (@map (vect n) (vect n) (join n v) (all_prods n vs)) (all_prods n vs)) *)
intros [H1 | H1]; auto with datatypes.
(* Goal: @In (vect n) x (@app (vect n) (@map (vect n) (vect n) (join n v) (all_prods n vs)) (all_prods n vs)) *)
apply in_or_app; left; rewrite <- H1.
(* Goal: @In (vect n) v (@map (vect n) (vect n) (join n v) (all_prods n vs)) *)
pattern v at 1; rewrite <- (join1r n v); apply in_map.
(* Goal: @In (vect n) (genk n (v1 (K1 p))) (all_prods n vs) *)
apply all_prods1.
Qed.

(* If n is the length of the list of vectors,
      2^n is the length of the list of all products *)
Lemma all_prods_length n vs : 
  length (all_prods n vs) = exp 2 (length vs).
Proof.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
induction vs as [| v vs IH]; simpl all_prods; auto.
(* Goal: @Logic.eq nat (@length (vect n) (@app (vect n) (@map (vect n) (vect n) (join n v) (all_prods n vs)) (all_prods n vs))) (exp (S (S O)) (@length (vect n) (@cons (vect n) v vs))) *)
rewrite app_length; rewrite map_length; rewrite IH.
(* Goal: @Logic.eq nat (Nat.add (exp (S (S O)) (@length (vect n) vs)) (exp (S (S O)) (@length (vect n) vs))) (exp (S (S O)) (@length (vect n) (@cons (vect n) v vs))) *)
simpl length; rewrite expS; simpl; auto with arith.
Qed.

(* Lift of all products *)
Lemma all_prods_lift n vs :
  all_prods n.+1 (map (lift n) vs) = map (lift n) (all_prods n vs).
Proof.
(* Goal: @Logic.eq (list (vect (S n))) (all_prods (S n) (@map (vect n) (vect (S n)) (lift n) vs)) (@map (vect n) (vect (S n)) (lift n) (all_prods n vs)) *)
induction vs as [| v vs IH].
(* Goal: @Logic.eq (vect n) (mcontra n (@cons (kn p n) a l) x) (mcontra n l (contra n a x)) *)
simpl; auto.
(* Goal: @Logic.eq (list (vect (S n))) (all_prods (S n) (@map (vect n) (vect (S n)) (lift n) (@cons (vect n) v vs))) (@map (vect n) (vect (S n)) (lift n) (all_prods n (@cons (vect n) v vs))) *)
simpl map; rewrite (all_prods_cons n.+1).
(* Goal: @Logic.eq (list (vect (S n))) (@app (vect (S n)) (@map (vect (S n)) (vect (S n)) (join (S n) (lift n v)) (all_prods (S n) (@map (vect n) (prod (vect n) (vect n)) (lift n) vs))) (all_prods (S n) (@map (vect n) (prod (vect n) (vect n)) (lift n) vs))) (@map (vect n) (prod (vect n) (vect n)) (lift n) (@app (vect n) (@map (vect n) (vect n) (join n v) (all_prods n vs)) (all_prods n vs))) *)
change (vect n * vect n)%type with (vect n.+1).
(* Goal: @Logic.eq (list (vect (S n))) (@app (vect (S n)) (@map (vect (S n)) (vect (S n)) (join (S n) (lift n v)) (all_prods (S n) (@map (vect n) (vect (S n)) (lift n) vs))) (all_prods (S n) (@map (vect n) (vect (S n)) (lift n) vs))) (@map (vect n) (vect (S n)) (lift n) (@app (vect n) (@map (vect n) (vect n) (join n v) (all_prods n vs)) (all_prods n vs))) *)
rewrite map_app; rewrite IH.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply f_equal2 with (f := @app (vect n.+1)); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
elim all_prods; auto.
(* Goal: forall (a : vect n) (l : list (vect n)) (_ : @Logic.eq (list (vect (S n))) (@map (vect (S n)) (vect (S n)) (join (S n) (lift n v)) (@map (vect n) (vect (S n)) (lift n) l)) (@map (vect n) (vect (S n)) (lift n) (@map (vect n) (vect n) (join n v) l))), @Logic.eq (list (vect (S n))) (@map (vect (S n)) (vect (S n)) (join (S n) (lift n v)) (@map (vect n) (vect (S n)) (lift n) (@cons (vect n) a l))) (@map (vect n) (vect (S n)) (lift n) (@map (vect n) (vect n) (join n v) (@cons (vect n) a l))) *)
intros a l IH1.
assert (map_cons: forall (A B: Type) (f: A -> B) a l, 
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
                     map f (a:: l) = f a :: map f l); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite !map_cons, IH1, lift_join; auto.
Qed.

Lemma all_prods_hom n vs :
  (forall i, In i vs -> exists k, hom n k i) ->
  (forall i, In i (all_prods n vs) -> exists k, hom n k i).
Proof.
(* Goal: forall (_ : forall (i : vect n) (_ : @In (vect n) i vs), @ex nat (fun k : nat => b2Prop (hom n k i))) (i : vect n) (_ : @In (vect n) i (all_prods n vs)), @ex nat (fun k : nat => b2Prop (hom n k i)) *)
induction vs as [| v vs IH]; simpl.
(* Goal: forall (_ : forall (i : vect n) (_ : False), @ex nat (fun k : nat => b2Prop (hom n k i))) (i : vect n) (_ : or (@Logic.eq (vect n) (genk n (v1 (K1 p))) i) False), @ex nat (fun k : nat => b2Prop (hom n k i)) *)
(* Goal: forall (_ : forall (i : vect n) (_ : or (@Logic.eq (vect n) v i) (@In (vect n) i vs)), @ex nat (fun k : nat => b2Prop (hom n k i))) (i : vect n) (_ : @In (vect n) i (@app (vect n) (@map (vect n) (vect n) (join n v) (all_prods n vs)) (all_prods n vs))), @ex nat (fun k : nat => b2Prop (hom n k i)) *)
intros _ i [[]|[]]; exists 0%nat; apply hom0K.
(* Goal: forall _ : forall (x : E (vn_eparams (S n))) (_ : @In (E (vn_eparams (S n))) x (@cons (E (vn_eparams (S n))) a l1)), cbl (vn_eparams (S n)) (base (S n) (S O)) x, @ex (list (prod (Field.K (K1 p)) (E (vn_eparams n)))) (fun lk : list (prod (Field.K (K1 p)) (E (vn_eparams n))) => @ex (list (E (vn_eparams n))) (fun ly : list (E (vn_eparams n)) => and (forall (i : prod (Field.K (K1 p)) (E (vn_eparams n))) (_ : @In (prod (Field.K (K1 p)) (E (vn_eparams n))) i lk), not (@Logic.eq (Field.K (K1 p)) (@fst (Field.K (K1 p)) (E (vn_eparams n)) i) (v0 (K1 p)))) (and (forall (i : prod (Field.K (K1 p)) (E (vn_eparams n))) (_ : @In (prod (Field.K (K1 p)) (E (vn_eparams n))) i lk), cbl (vn_eparams n) (base n (S O)) (@snd (Field.K (K1 p)) (E (vn_eparams n)) i)) (and (forall (i : E (vn_eparams n)) (_ : @In (E (vn_eparams n)) i ly), cbl (vn_eparams n) (base n (S O)) i) (@perm (E (vn_eparams (S n))) (@cons (E (vn_eparams (S n))) a l1) (@app (prod (vect n) (E (vn_eparams n))) (@map (prod (Field.K (K1 p)) (E (vn_eparams n))) (prod (vect n) (E (vn_eparams n))) (fun x : prod (Field.K (K1 p)) (E (vn_eparams n)) => @pair (vect n) (E (vn_eparams n)) (genk n (@fst (Field.K (K1 p)) (E (vn_eparams n)) x)) (@snd (Field.K (K1 p)) (E (vn_eparams n)) x)) lk) (@map (vect n) (vect (S n)) (lift n) ly))))))) *)
intros H i Hi; case (in_app_or _ _ _ Hi); clear Hi; intros Hi.
(* Goal: @ex nat (fun k : nat => b2Prop (hom n k i)) *)
(* Goal: @ex nat (fun k : nat => b2Prop (hom n k i)) *)
rewrite in_map_iff in Hi; case Hi; intros v1 (H1v,H2v); subst.
(* Goal: @ex nat (fun k : nat => b2Prop (hom n k (join n v v1))) *)
(* Goal: @ex nat (fun k : nat => b2Prop (hom n k i)) *)
assert (H1: forall i, In i vs -> exists k : nat, hom n k i); auto with datatypes.
(* Goal: @ex nat (fun k : nat => b2Prop (hom n k (join n v v1))) *)
(* Goal: @ex nat (fun k : nat => b2Prop (hom n k i)) *)
case (H v); auto; intros k1 Hk1.
(* Goal: @ex nat (fun k : nat => b2Prop (hom n k (join n v v1))) *)
(* Goal: @ex nat (fun k : nat => b2Prop (hom n k i)) *)
case (IH H1 v1); auto; intros k2 Hk2.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
exists (k1 + k2)%nat; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply IH; auto.
Qed.

(* Turn a vector in a list of scalar to be used for multiple product *)
Fixpoint v2l (n: nat) : vect n -> list K :=
  match n return vect n -> list K with
    O => fun k => k :: nil
  | S n1 => fun x => let (x1, x2) := x in
                      (v2l n1 x1 ++ v2l n1 x2)%list
  end.

(* The length is 2^n *)
Lemma v2l_length n v : length (v2l n v) = exp 2 n.
Proof.
(* Goal: @Logic.eq (vect n) (dual n (join n v1 v2)) (meet n (dual n v1) (dual n v2)) *)
induction n as [| n IH]; auto.
(* Goal: @Logic.eq nat (@length (Field.K (K1 p)) (v2l (S n) v)) (exp (S (S O)) (S n)) *)
simpl; destruct v; rewrite app_length; rewrite IH; rewrite IH.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
case n; auto.
Qed.

(* Every vector is a multiple product of all products of the base *)
Lemma mprod_2l n (v: vect n) :  v2l n v *X*  all_prods n (base n 1) = v.
Proof.
(* Goal: forall (i : nat) (_ : lt i n), @In (vect n) (gen n i) (base n (S O)) *)
induction n as [| n IH].
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
unfold mprod; simpl; rewrite multK1r; auto; rewrite addK0r; auto.
assert (UUn := fn n); assert (UUsn := fn n.+1).
simpl vect; destruct v as [x1 x2].
simpl v2l; simpl base; rewrite base0, en_def; simpl app; unfold dlift.
 rewrite (all_prods_cons n.+1).
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite mprod_app; auto.
2: rewrite v2l_length, map_length, all_prods_length, map_length, 
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
   base_length; auto.
rewrite (all_prods_lift n), (lift_mprod n), IH, map_map.
replace 
 ((v2l n x1) *X*
    (map (fun x : vect n => ((1: vect n, 0: vect n): vect n.+1) ∨ lift n x) (all_prods n (base n 1))))
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
with (x1, 0: vect n); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
simpl; Vfold n; rewrite addE0l, addE0r; auto.
change ((1: vect n, 0: vect n): vect n.+1) with ('e_0: vect n.+1).
assert (H: forall l,
  map (fun x : vect n =>  'e_0 ∨ (lift n x)) l =
   map (fun x => (x, genk n 0)) l).
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
induction l as [| a l Hlrec]; simpl; Vfold n; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply f_equal2 with (f := @cons (vect n.+1)); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite join1l, conj0, join0l, addE0r, join0l; auto.
rewrite H; clear H.
assert (H: forall l1 (l2: list (vect n)),
  mprod (vn_eparams n.+1) l1 (map (fun x => (x, genk n 0)) l2) =
  (mprod (vn_eparams n) l1 l2, genk n 0)).
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
induction l1 as [| a l1 Hlrec]; intros [| b l2]; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
simpl map; rewrite (mprod_S), Hlrec; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
simpl; Vfold n; rewrite scalE0r, addE0l, mprod_S; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite H, IH; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite bin_1; auto.
Qed.

(* Every vector is a linear combination of all products of the base *)
Lemma cbl_all_prods n v : cbl _ (all_prods _ (base n 1)) v.
Proof. rewrite <- (mprod_2l n v); apply mprod_cbl; auto. Qed.

(* All products of the base are free *)
Lemma all_prods_free n: free _ (all_prods _ (base n 1)).
Proof.
induction n as [| n IH]; intros ks.
simpl; case ks; try (intros; discriminate).
intros k1 [| k2 l]; try (intros; discriminate); simpl.
unfold mprod; simpl.
rewrite multK1r; auto; rewrite addK0r; auto; intros _ H k.
rewrite H; intros [H1 | H1]; auto; case H1.
rewrite base1_S; simpl.
rewrite app_length, map_length, (all_prods_lift n), map_length; intros Hk1.
case (list_split _ _ _ _ Hk1).
intros l1 (l2, (Hl1, (Hl2, Hl3))).
rewrite Hl1.
unfold base, all_prods; fold base; fold all_prods.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite (mprod_app (vn_eparams n.+1)); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
2: rewrite map_length, map_length; auto.
rewrite map_map.
assert (H1: forall l,
  map (fun x : vect n => join n.+1 (gen n.+1 0) (lift n x)) l =
   map (fun x => (x, genk n 0)) l).
(* Goal: @Logic.eq (vect n) (mcontra n (@cons (kn p n) a l) x) (mcontra n l (contra n a x)) *)
induction l as [| a l Hlrec]; simpl; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply f_equal2 with (f := @cons (vect n.+1)); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
Vfold n; rewrite join1l, conj0, join0l, addE0r, join0l; auto.
rewrite H1; clear H1.
assert (H1: forall (l1: list K) (l2: list (vect n)),
  mprod (vn_eparams n.+1) l1 (map (fun x => (x, genk n 0)) l2) =
  (l1 *X* l2, genk n 0)).
clear l1 l2 Hl1 Hl2 Hl3.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
induction l1 as [| a l1 Hlrec]; intros [| b l2]; auto.
(* Goal: @Logic.eq (vect (S n)) (dual (S n) (join (S n) v1 v2)) (meet (S n) (dual (S n) v1) (dual (S n) v2)) *)
simpl; Vfold n.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite (mprod_S (vn_eparams n.+1)); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite (mprod_S (vn_eparams n)); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite Hlrec; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
simpl; Vfold n; rewrite scalE0r, addE0l; auto.
rewrite H1, lift_mprod.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
simpl; Vfold n; rewrite addE0l, addE0r; auto.
intros HH; injection HH; clear HH; intros HH1 HH2 k Hk.
case (in_app_or _ _ _ Hk); intros Hl.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply (IH l1); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply (IH l2); auto.
Qed.

(* Ad-hoc inductive principes for vectors *)
Lemma vect_induct n (P: vect n -> Prop) :
  P (1: vect n) -> (forall v, In v (base n 1) -> P v) ->
     (forall v1 v2, P v1 -> P v2 -> P (v1 ∨ v2)) ->
     (forall v1 v2, P v1 -> P v2 -> P (v1 + v2)) ->
     (forall k v, P v -> P (k .* v)) ->
     (forall v, P v).
Proof.
(* Goal: forall (_ : P (genk n (v1 (K1 p)) : vect n)) (_ : forall (v : vect n) (_ : @In (vect n) v (base n (S O))), P v) (_ : forall (v1 v2 : vect n) (_ : P v1) (_ : P v2), P (join n v1 v2)) (_ : forall (v1 v2 : vect n) (_ : P v1) (_ : P v2), P (addE (vn_eparams n) v1 v2)) (_ : forall (k : Field.K (stype (vn_eparams n))) (v : vect n) (_ : P v), P (scalE (vn_eparams n) k v)) (v : vect n), P v *)
intros H1 H2 H3 H4 H5 v.
(* Goal: P v *)
generalize (cbl_all_prods n v); intros HH; elim HH; auto; clear v HH.
(* Goal: P (E0 (vn_eparams n)) *)
(* Goal: forall (v : E (vn_eparams n)) (_ : @In (E (vn_eparams n)) v (all_prods n (base n (S O)))), P v *)
generalize (H5 0%f (1)); Vrm0.
(* Goal: forall (v : E (vn_eparams n)) (_ : @In (E (vn_eparams n)) v (all_prods n (base n (S O)))), P v *)
generalize (incl_refl (base n 1)).
(* Goal: forall (_ : @incl (vect n) (base n (S O)) (base n (S O))) (v : E (vn_eparams n)) (_ : @In (E (vn_eparams n)) v (all_prods n (base n (S O)))), P v *)
generalize (base n 1) at 1 3.
(* Goal: forall (l : list (vect n)) (_ : @incl (vect n) l (base n (S O))) (v : E (vn_eparams n)) (_ : @In (E (vn_eparams n)) v (all_prods n l)), P v *)
intros l; induction l as [| a l IH]; simpl.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros _ v [H6|[]]; subst; auto.
(* Goal: forall (_ : @incl (vect n) (@cons (vect n) a l) (base n (S O))) (v : vect n) (_ : @In (vect n) v (@app (vect n) (@map (vect n) (vect n) (join n a) (all_prods n l)) (all_prods n l))), P v *)
intros Hu1 v Ha.
(* Goal: P v *)
assert (Ht: incl l (base n 1)) by (intros u; auto with datatypes).
(* Goal: P v *)
case (in_app_or _ _ _ Ha); intros Hb; auto with datatypes.
(* Goal: @Logic.eq (vect n) (mcontra n (@cons (kn p n) a l) x) (mcontra n l (contra n a x)) *)
generalize IH Hb; elim (all_prods n l); simpl; auto.
(* Goal: forall (a0 : vect n) (l0 : list (vect n)) (_ : forall (_ : forall (_ : @incl (vect n) l (base n (S O))) (v : vect n) (_ : @In (vect n) v l0), P v) (_ : @In (vect n) v (@map (vect n) (vect n) (join n a) l0)), P v) (_ : forall (_ : @incl (vect n) l (base n (S O))) (v : vect n) (_ : or (@Logic.eq (vect n) a0 v) (@In (vect n) v l0)), P v) (_ : or (@Logic.eq (vect n) (join n a a0) v) (@In (vect n) v (@map (vect n) (vect n) (join n a) l0))), P v *)
intros a1 l1 IH1 H1i [H2i|H2i]; subst; auto with datatypes.
Qed.

Lemma vect_hom_induct n (P: vect n -> Prop) :
  (forall k v, hom n k v -> P v) ->
  (forall v1 v2, P v1 -> P v2 -> P (v1 + v2)) ->
     (forall v, P v).
Proof.
(* Goal: forall (_ : forall (k : nat) (v : vect n) (_ : b2Prop (hom n k v)), P v) (_ : forall (v1 v2 : vect n) (_ : P v1) (_ : P v2), P (addE (vn_eparams n) v1 v2)) (v : vect n), P v *)
intros H1 H2 v.
(* Goal: P v *)
rewrite <-mprod_2l.
(* Goal: P (mprod (vn_eparams n) (v2l n v) (all_prods n (base n (S O)))) *)
assert (F1: forall i, In i (all_prods n (base n 1)) -> exists k, hom n k i).
(* Goal: forall (i : vect n) (_ : @In (vect n) i (all_prods n (base n (S O)))), @ex nat (fun k : nat => b2Prop (hom n k i)) *)
(* Goal: P (mprod (vn_eparams n) (v2l n v) (all_prods n (base n (S O)))) *)
apply all_prods_hom; intros i Hi; exists 1%nat.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite <-cbl1_hom1_equiv; constructor; auto.
generalize (v2l n v); 
(* Goal: @Logic.eq (vect n) (mcontra n (@cons (kn p n) a l) x) (mcontra n l (contra n a x)) *)
  induction (all_prods n (base n 1)) as [|a2 l2 IH]; simpl; auto.
(* Goal: b2Prop (andb true (hom n (S O) (genk n (v0 (K1 p))))) *)
(* Goal: b2Prop (andb true (hom n (S O) (gen n k))) *)
intros l; rewrite mprod0r; apply (H1 0%nat); apply homk0.
(* Goal: forall l : list (Field.K (K1 p)), P (mprod (vn_eparams n) l (@cons (vect n) a2 l2)) *)
intros [|a1 l1].
(* Goal: b2Prop (andb true (hom n (S O) (genk n (v0 (K1 p))))) *)
(* Goal: b2Prop (andb true (hom n (S O) (gen n k))) *)
rewrite mprod0l; apply (H1 0%nat); apply homk0.
(* Goal: P (mprod (vn_eparams n) (@cons (Field.K (K1 p)) a1 l1) (@cons (vect n) a2 l2)) *)
rewrite mprod_S; auto; apply H2; auto with datatypes.
(* Goal: P (scalE (vn_eparams n) a1 a2) *)
case (F1 a2); auto with datatypes; intros k Hk.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply (H1 k); auto.
Qed.
   
(* Iterated product of a list of vectors *)
Fixpoint joinl n (l: list (vect n)) := match l with
| nil => 0
| a::nil => a
| a::l => a ∨ joinl n l
end.

Lemma joinl0 n : joinl n nil = 0.
Proof. auto. Qed.

Hint Rewrite joinl0 : GRm0.

Lemma joinl1 n x : joinl n (x::nil) = x.
Proof. auto. Qed.

Lemma joinlS n x l : l <> nil -> joinl n (x::l) = x ∨ joinl n l.
Proof. destruct l; auto; intros []; auto. Qed.

Lemma joinl_scal n k (a: vect n) l : 
   joinl _ (k .* a::l) = k .* joinl _ (a::l).
Proof.
(* Goal: @ex (list (E (vn_eparams n))) (fun l0 : list (E (vn_eparams n)) => decomposable n l0 (factor n x (scalE (vn_eparams n) k1 (joinl n (@cons (E (vn_eparams n)) x l))))) *)
case (list_case _ l); intros Hl.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite Hl; simpl; Vfold n; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite !joinlS, join_scall; auto.
Qed.

Lemma joinl_app n l1 l2 :
  l1 <> nil -> l2 <> nil -> joinl n (l1 ++ l2)%list = joinl n l1 ∨ joinl n l2.
(* Goal: forall (_ : not (@Logic.eq (list (vect n)) l1 (@nil (vect n)))) (_ : not (@Logic.eq (list (vect n)) l2 (@nil (vect n)))), @Logic.eq (E (vn_eparams n)) (joinl n (@app (vect n) l1 l2)) (join n (joinl n l1) (joinl n l2)) *)
induction l1 as [| a1 l1 IH].
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros H; case H; auto.
(* Goal: forall (_ : not (@Logic.eq (list (vect n)) (@cons (vect n) a1 l1) (@nil (vect n)))) (_ : not (@Logic.eq (list (vect n)) l2 (@nil (vect n)))), @Logic.eq (E (vn_eparams n)) (joinl n (@app (vect n) (@cons (vect n) a1 l1) l2)) (join n (joinl n (@cons (vect n) a1 l1)) (joinl n l2)) *)
intros _ Hl2.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
case (list_case _ l1); intros; subst; simpl app; rewrite joinlS; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite joinlS, IH, join_assoc; auto.
(* Goal: not (@Logic.eq (list (vect n)) (@app (vect n) l1 l2) (@nil (vect n))) *)
destruct l1; auto; try (intros; discriminate).
Qed.

Lemma joinl_base1_perm n l1 l2 :
 perm l1 l2 ->
 (forall x, In x l1 -> cbl _ (base n 1) x) ->
  (joinl n l1 = joinl n l2) \/ (joinl n l1 = (-(1)).* joinl n l2) .
Proof.
(* Goal: forall (_ : @perm (E (vn_eparams n)) l1 l2) (_ : forall (x : E (vn_eparams n)) (_ : @In (E (vn_eparams n)) x l1), cbl (vn_eparams n) (base n (S O)) x), or (@Logic.eq (E (vn_eparams n)) (joinl n l1) (joinl n l2)) (@Logic.eq (E (vn_eparams n)) (joinl n l1) (scalE (vn_eparams n) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (joinl n l2))) *)
intros H; elim H; simpl; auto; clear l1 l2 H; try Vfold n.
(* Goal: forall (a b : vect n) (l : list (vect n)) (_ : forall (x : vect n) (_ : or (@Logic.eq (vect n) a x) (or (@Logic.eq (vect n) b x) (@In (vect n) x l))), cbl (vn_eparams n) (base n (S O)) x), or (@Logic.eq (vect n) (join n a match l with | nil => b | cons v l0 => join n b (joinl n l) end) (join n b match l with | nil => a | cons v l0 => join n a (joinl n l) end)) (@Logic.eq (vect n) (join n a match l with | nil => b | cons v l0 => join n b (joinl n l) end) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (join n b match l with | nil => a | cons v l0 => join n a (joinl n l) end))) *)
(* Goal: forall (a : vect n) (l1 l2 : list (vect n)) (_ : @perm (vect n) l1 l2) (_ : forall _ : forall (x : vect n) (_ : @In (vect n) x l1), cbl (vn_eparams n) (base n (S O)) x, or (@Logic.eq (vect n) (joinl n l1) (joinl n l2)) (@Logic.eq (vect n) (joinl n l1) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (joinl n l2)))) (_ : forall (x : vect n) (_ : or (@Logic.eq (vect n) a x) (@In (vect n) x l1)), cbl (vn_eparams n) (base n (S O)) x), or (@Logic.eq (vect n) match l1 with | nil => a | cons v l0 => join n a (joinl n l1) end match l2 with | nil => a | cons v l0 => join n a (joinl n l2) end) (@Logic.eq (vect n) match l1 with | nil => a | cons v l0 => join n a (joinl n l1) end (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) match l2 with | nil => a | cons v l0 => join n a (joinl n l2) end)) *)
(* Goal: forall (l1 l2 l3 : list (vect n)) (_ : @perm (vect n) l1 l2) (_ : forall _ : forall (x : vect n) (_ : @In (vect n) x l1), cbl (vn_eparams n) (base n (S O)) x, or (@Logic.eq (vect n) (joinl n l1) (joinl n l2)) (@Logic.eq (vect n) (joinl n l1) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (joinl n l2)))) (_ : @perm (vect n) l2 l3) (_ : forall _ : forall (x : vect n) (_ : @In (vect n) x l2), cbl (vn_eparams n) (base n (S O)) x, or (@Logic.eq (vect n) (joinl n l2) (joinl n l3)) (@Logic.eq (vect n) (joinl n l2) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (joinl n l3)))) (_ : forall (x : vect n) (_ : @In (vect n) x l1), cbl (vn_eparams n) (base n (S O)) x), or (@Logic.eq (vect n) (joinl n l1) (joinl n l3)) (@Logic.eq (vect n) (joinl n l1) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (joinl n l3))) *)
intros a b [|c l] IH; right.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite <-cbl_base_join_com; auto.
rewrite <-join_assoc, <-(join_assoc _ b), (cbl_base_join_com _ b),
        !join_assoc, !join_scall;  auto with datatypes.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite join_assoc; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros a [|a1 l1] [|b1 l2] Hl; auto.
(* Goal: b2Prop false *)
assert (HH:= perm_length _ _ _ Hl); discriminate.
(* Goal: b2Prop false *)
assert (HH:= perm_length _ _ _ Hl); discriminate.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros H1 H2; case H1; auto; intros H3; rewrite H3; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite join_scalr; auto.
(* Goal: forall (l1 l2 l3 : list (vect n)) (_ : @perm (vect n) l1 l2) (_ : forall _ : forall (x : vect n) (_ : @In (vect n) x l1), cbl (vn_eparams n) (base n (S O)) x, or (@Logic.eq (vect n) (joinl n l1) (joinl n l2)) (@Logic.eq (vect n) (joinl n l1) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (joinl n l2)))) (_ : @perm (vect n) l2 l3) (_ : forall _ : forall (x : vect n) (_ : @In (vect n) x l2), cbl (vn_eparams n) (base n (S O)) x, or (@Logic.eq (vect n) (joinl n l2) (joinl n l3)) (@Logic.eq (vect n) (joinl n l2) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (joinl n l3)))) (_ : forall (x : vect n) (_ : @In (vect n) x l1), cbl (vn_eparams n) (base n (S O)) x), or (@Logic.eq (vect n) (joinl n l1) (joinl n l3)) (@Logic.eq (vect n) (joinl n l1) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (joinl n l3))) *)
intros l1 l2 l3 Hp1 HH1 Hp2 HH2 H1.
(* Goal: or (@Logic.eq (vect n) (joinl n l1) (joinl n l3)) (@Logic.eq (vect n) (joinl n l1) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (joinl n l3))) *)
assert (H2: forall x, In x l2 -> cbl _ (base n 1) x).
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros x Hx; apply H1; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply perm_in with (1 := perm_sym _ _ _ Hp1); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
case HH1; auto; intros HH3; rewrite HH3; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
case HH2; auto; intros HH4; rewrite HH4; auto.
(* Goal: or (@Logic.eq (vect n) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (joinl n l3))) (joinl n l3)) (@Logic.eq (vect n) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (joinl n l3))) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (joinl n l3))) *)
left.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite <- scal_multE, multK_m1_m1, scalE1; auto.
Qed.

Lemma joinl0_base1_perm n l1 l2 : perm l1 l2 ->
 (forall x, In x l1 -> cbl _ (base n 1) x) -> joinl n l1 = 0 -> joinl n l2 = 0.
Proof.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros H1 H2 H3; case (joinl_base1_perm n l1 l2); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros HH; rewrite <-HH; auto.
(* Goal: forall _ : @Logic.eq (E (vn_eparams n)) v (joinl n (decomposek n (first_deg n v) v)), decomposable n (decomposek n (first_deg n v) v) v *)
(* Goal: forall _ : not (@Logic.eq (E (vn_eparams n)) v (joinl n (decomposek n (first_deg n v) v))), not (is_decomposable n v) *)
(* Goal: not (is_decomposable n v) *)
intros HH.
rewrite <- (scalE0r _ (fn n) (-(1))%f), <- H3, HH,
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
        <- scal_multE, multK_m1_m1, scalE1; auto.
Qed.

Lemma lift_joinl n l : lift n (joinl n l) = joinl n.+1 (map (lift n) l).
Proof.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
elim l; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros a l1 IH; case (list_case _ l1); intros H1; subst; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
simpl map; rewrite ?joinl0, ?joinl1, ?joinlS; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite lift_join, IH; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
destruct l1; simpl; try (intros; discriminate); case H1; auto.
Qed.

Lemma joinl_hom1 n l :
 (forall x, In x l -> hom n 1 x) -> hom n (length l) (joinl n l).
Proof.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
elim l; auto.
(* Goal: b2Prop (andb true (hom n (S O) (genk n (v0 (K1 p))))) *)
(* Goal: b2Prop (andb true (hom n (S O) (gen n k))) *)
intros; simpl; apply homk0.
(* Goal: forall (a : vect n) (l : list (vect n)) (_ : forall _ : forall (x : vect n) (_ : @In (vect n) x l), b2Prop (hom n (S O) x), b2Prop (hom n (@length (vect n) l) (joinl n l))) (_ : forall (x : vect n) (_ : @In (vect n) x (@cons (vect n) a l)), b2Prop (hom n (S O) x)), b2Prop (hom n (@length (vect n) (@cons (vect n) a l)) (joinl n (@cons (vect n) a l))) *)
intros a l1 IH H1.
(* Goal: b2Prop (hom n (@length (vect n) (@cons (vect n) a l1)) (joinl n (@cons (vect n) a l1))) *)
case (list_case _ l1); intros Hl1.
(* Goal: b2Prop (hom n (@length (vect n) (@cons (vect n) a l1)) (joinl n (@cons (vect n) a l1))) *)
(* Goal: b2Prop (hom n (@length (vect n) (@cons (vect n) a l1)) (joinl n (@cons (vect n) a l1))) *)
subst; simpl; auto with datatypes.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite joinlS; auto.
(* Goal: b2Prop (hom n (@length (vect n) (@cons (vect n) a l1)) (join n a (joinl n l1))) *)
change (length (a::l1)) with (1 + length l1)%nat.
(* Goal: b2Prop (hom n (Nat.add (S O) (@length (vect n) l1)) (join n a (joinl n l1))) *)
apply join_hom; auto with datatypes.
Qed.

Hint Resolve joinl_hom1.

Lemma joinl_swap n (a b: vect n) l: 
 cbl _ (base n 1) a ->  cbl _ (base n 1) b ->
   joinl _ (a::b::l) = (-(1)).* joinl _ (b::a::l).
Proof.
(* Goal: forall (_ : cbl (vn_eparams n) (base n (S O)) a) (_ : cbl (vn_eparams n) (base n (S O)) b), @Logic.eq (E (vn_eparams n)) (joinl n (@cons (vect n) a (@cons (vect n) b l))) (scalE (vn_eparams n) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (joinl n (@cons (vect n) b (@cons (vect n) a l)))) *)
intros Ha Hb.
(* Goal: @ex (list (E (vn_eparams n))) (fun l0 : list (E (vn_eparams n)) => decomposable n l0 (factor n x (scalE (vn_eparams n) k1 (joinl n (@cons (E (vn_eparams n)) x l))))) *)
case (list_case _ l); intros Hl.
(* Goal: @Logic.eq (vect (S n)) (dual (S n) (join (S n) v1 v2)) (meet (S n) (dual (S n) v1) (dual (S n) v2)) *)
rewrite Hl; simpl; Vfold n.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply cbl_base_join_com; auto.
rewrite !joinlS, <-join_assoc, (cbl_base_join_com n b),
        !join_scall, !join_assoc; 
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
  try (intros; discriminate); auto.
Qed.

Lemma joinl_top n (a: vect n) l1 l2 : 
 (forall i, In i (a :: l1) -> cbl _ (base n 1) i) ->
   joinl _ (l1 ++ (a::l2)) = (-(1))^length l1 .* joinl _ (a:: (l1 ++ l2)%list).
Proof.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
induction l1 as [| b l1 IH]; intros Hl2; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
simpl app; simpl expK; rewrite scalE1; auto.
simpl app; simpl expK;  
  rewrite joinlS, IH, join_scalr, <-joinlS, multK_com,
          scal_multE, joinl_swap; auto with datatypes.
(* Goal: forall (i : vect n) (_ : @In (vect n) i (@cons (vect n) a l1)), cbl (vn_eparams n) (base n (S O)) i *)
simpl In; intros i [[]|Hi]; auto with datatypes.
Qed.


Lemma joinl_all n : 0 < n -> joinl n (base n 1) = E.
Proof.
(* Goal: @Logic.eq (vect n) (k2g n (E0 (Kn.vn_eparams p n))) (E0 (vn_eparams n)) *)
induction n as [|n IH]; simpl; auto.
(* Goal: forall _ : lt O O, @Logic.eq (Field.K (K1 p)) (v0 (K1 p)) (v1 (K1 p)) *)
(* Goal: forall _ : lt O (S n), @Logic.eq (prod (vect n) (vect n)) (joinl (S n) (@app (prod (vect n) (vect n)) (@map (vect n) (prod (vect n) (vect n)) (dlift n) (base n O)) (@map (vect n) (prod (vect n) (vect n)) (lift n) (base n (S O))))) (@pair (vect n) (vect n) (all n) (genk n (v0 (K1 p)))) *)
intros H; contradict H; auto with arith.
(* Goal: forall _ : lt O (S n), @Logic.eq (prod (vect n) (vect n)) (joinl (S n) (@app (prod (vect n) (vect n)) (@map (vect n) (prod (vect n) (vect n)) (dlift n) (base n O)) (@map (vect n) (prod (vect n) (vect n)) (lift n) (base n (S O))))) (@pair (vect n) (vect n) (all n) (genk n (v0 (K1 p)))) *)
destruct n as [|n].
(* Goal: @Logic.eq (vect n) (mcontra n (@cons (kn p n) a l) x) (mcontra n l (contra n a x)) *)
simpl; auto.
(* Goal: forall _ : lt O (S (S n)), @Logic.eq (prod (vect (S n)) (vect (S n))) (joinl (S (S n)) (@app (prod (vect (S n)) (vect (S n))) (@map (vect (S n)) (prod (vect (S n)) (vect (S n))) (dlift (S n)) (base (S n) O)) (@map (vect (S n)) (prod (vect (S n)) (vect (S n))) (lift (S n)) (base (S n) (S O))))) (@pair (vect (S n)) (vect (S n)) (all (S n)) (genk (S n) (v0 (K1 p)))) *)
intros _.
(* Goal: @Logic.eq (prod (vect (S n)) (vect (S n))) (joinl (S (S n)) (@app (prod (vect (S n)) (vect (S n))) (@map (vect (S n)) (prod (vect (S n)) (vect (S n))) (dlift (S n)) (base (S n) O)) (@map (vect (S n)) (prod (vect (S n)) (vect (S n))) (lift (S n)) (base (S n) (S O))))) (@pair (vect (S n)) (vect (S n)) (all (S n)) (genk (S n) (v0 (K1 p)))) *)
rewrite joinl_app, <-lift_joinl, IH; auto with arith.
(* Goal: @Logic.eq (prod (vect (S n)) (vect (S n))) (join (S (S n)) (joinl (S (S n)) (@map (vect (S n)) (prod (vect (S n)) (vect (S n))) (dlift (S n)) (base (S n) O))) (lift (S n) (all (S n)))) (@pair (vect (S n)) (vect (S n)) (all (S n)) (genk (S n) (v0 (K1 p)))) *)
(* Goal: not (@Logic.eq (list (vect (S (S n)))) (@map (vect (S n)) (prod (vect (S n)) (vect (S n))) (dlift (S n)) (base (S n) O)) (@nil (vect (S (S n))))) *)
(* Goal: not (@Logic.eq (list (vect (S (S n)))) (@map (vect (S n)) (prod (vect (S n)) (vect (S n))) (lift (S n)) (base (S n) (S O))) (@nil (vect (S (S n))))) *)
rewrite base0; simpl; Vfold n; Grm0.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite en_def, conjk, joinkl, scalE1; auto.
(* Goal: b2Prop false *)
rewrite base0; intros; discriminate.
(* Goal: b2Prop false *)
simpl; rewrite base0; intros; discriminate.
Qed.

Definition is_vector n v := cbl _ (base n 1) v.

Definition is_vector_space n l := forall x, In x l -> is_vector n x.

Lemma joinl0_mprod n M : M <> nil -> is_vector_space n M ->
   joinl n M = 0 ->
   exists lk, exists i, length lk = length M /\ In i lk /\ i <> 0%f /\ lk *X* M = 0.
Proof.
(* Goal: @Logic.eq (vect n) (mcontra n (@app (kn p n) l1 l2) M) (mcontra n l2 (mcontra n l1 M)) *)
generalize M; clear M.
(* Goal: forall (b : bool) (k : nat) (_ : b2Prop (hom n k x)), b2Prop (hom n k (dconj n b x)) *)
induction n as [| n IH]; simpl.
intros l Hd Hl Hp1.
assert (forall a, In a l -> (a: vect 0) = 0).
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros a H1; apply (cbl0_inv _ (fn 0)); apply Hl; auto.
 exists (map (fun x => (1%f)) l); exists (1%f); repeat split.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite map_length; auto.
(* Goal: @Logic.eq (vect n) (mcontra n (@cons (kn p n) a l) x) (mcontra n l (contra n a x)) *)
destruct l; simpl; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply one_diff_zero; auto.
(* Goal: @Logic.eq (vect n) (mcontra n (@cons (kn p n) a l) x) (mcontra n l (contra n a x)) *)
clear Hd Hl Hp1; induction l as [|a l IH]; simpl; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite  (mprod_S (vn_eparams 0)); auto.
rewrite (H a); Vrm0; auto with datatypes.
intros l Hl Hd Hprod; unfold is_vector in Hl.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
case (cbl_base1_list_split n l); auto.
intros lx (ly, (H1ly, (H2ly, (H3ly, H4ly)))).
match type of H4ly with perm _ ?X => set (l1 := (X: list (vect n.+1))) in H4ly end.
assert (Hl1: exists lk, exists i,
    length lk = length l1 /\ In i lk /\ i <> 0%f /\ lk *X* l1 = 0).
2: case Hl1; intros lk (i, (H1i, (H2i, (H3i, H4i)))).
2: assert (Hlk: length lk = length l).
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
2: rewrite H1i; apply perm_length; apply perm_sym; auto.
2: case (mprod_perm _ (fn n.+1) _ _ _ (perm_sym _ _ _  H4ly) H1i); intros lk2 (H1lk2, H2lk2).
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
2: exists lk2; exists i; repeat split; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
2: rewrite <- Hlk; apply perm_length; apply perm_sym; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
2: apply perm_in with (1 := H1lk2); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
2: rewrite <-H2lk2; auto.
assert (HH: l1 <> nil).
generalize (perm_length _ _ _ H4ly) Hl.
(* Goal: b2Prop false *)
case l; case l1; auto; intros; discriminate.
assert (HH1:= joinl0_base1_perm n.+1 _ _ H4ly Hd Hprod).
generalize HH HH1; unfold l1; generalize (refl_equal (length lx)) ly H1ly H2ly H3ly.
pattern lx at -2; generalize (length lx); intros n1; generalize lx.
induction n1 as [| n1 IH1]; clear lx l1 l Hl Hd Hprod ly H1ly H2ly H3ly H4ly HH HH1. 
  intros [| a [| b lx]] HH ly H1ly H2ly H3ly H4ly H5ly.
2: discriminate HH.
2: discriminate HH.
case (list_case _ ly); intros Hly; subst.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
case H4ly; auto.
case (IH ly); auto; clear HH.
(* Goal: forall _ : @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (genk n (v0 (K1 p))) (genk n k1)) (@pair (vect n) (vect n) (genk n (v0 (K1 p))) (genk n k2)), @Logic.eq (Field.K (K1 p)) k1 k2 *)
generalize H5ly; simpl; rewrite <-(lift_joinl n); intros HH; injection HH; auto.
intros ly1 (i, (H1i, (H2i, (H3i, H4i)))).
(* Goal: @Logic.eq (vect n) (mcontra n (@cons (kn p n) a l) x) (mcontra n l (contra n a x)) *)
exists ly1; exists i; repeat split; simpl; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite map_length; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite (lift_mprod n); rewrite H4i; auto.
intros [| a [| b lx]]; try (intros; discriminate).
intros HH ly H1y H2y H3y H4y H5y; injection HH; intros; subst n1; clear HH.
generalize H5y; simpl map.
case (list_case _ ly); intros Hly; subst.
intros HH; injection HH; intros.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
case (H1y a); auto with datatypes; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply injk with n; auto.
(* Goal: @Logic.eq (vect n) (mcontra n (@cons (kn p n) a l) x) (mcontra n l (contra n a x)) *)
rewrite joinl_app; auto; simpl; auto.
(* Goal: @Logic.eq (vect (S n)) (dual (S n) (join (S n) v1 v2)) (meet (S n) (dual (S n) v1) (dual (S n) v2)) *)
rewrite <-(lift_joinl n); simpl; Vfold n.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite join0r, addE0r; auto.
replace (@fst (Field.K K) (vect n) a) with ((fst a  * 1)%f) by (rewrite multK1r; auto).
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite <- scalk, join_scall, join1l; auto.
intros HH; injection HH; clear HH; intros _ HH.
case (scal_integral _ _ _ HH); intros HH1.
case (H1y a); auto with datatypes.
case (IH ly); auto; try split.
intros ly1 (i1, (H1i1, (H2i1, (H3i1, H4i1)))).
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
exists (0%f::ly1); exists i1; repeat split; simpl; Vfold n; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite map_length; simpl in H1i1; rewrite H1i1; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite (mprod_S (vn_eparams n.+1)), scalE0l, addE0l; auto.

(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite (lift_mprod n), H4i1; auto.
(* Goal: b2Prop false *)
intros; discriminate.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
destruct ly; try (intros; discriminate); case Hly; auto.
intros Hl ly1 H1ly H2ly H3ly H4ly H5ly.
pose (x1 := fst a .* snd b + (- (fst b)).* snd a).
pose (mk_v:= fun x : K * vect n => ([fst x], snd x) : vect n.+1).
assert (Hx1: lift n x1 = ((fst a) .* (mk_v b) + (- (fst b)).* mk_v a)).
(* Goal: @Logic.eq (vect (S n)) (dual (S n) (join (S n) v1 v2)) (meet (S n) (dual (S n) v1) (dual (S n) v2)) *)
  unfold x1; simpl; Vfold n.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
  rewrite !scalk, addk, multK_com, <-opp_multKl, oppKr; auto.
assert (Halx: length (a :: lx) = n1).
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
generalize Hl; simpl; intros HH1; injection HH1; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
case (IH1 _ Halx (x1::ly1)); auto.
simpl; intros i [Hi | Hi]; try subst i; apply H1ly; auto with datatypes.
simpl; intros i [Hi | Hi]; try subst i; apply H2ly; auto with datatypes.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
simpl; intros i [Hi | Hi]; try subst i; auto.
unfold x1; apply cbl_add; apply cbl_scal; apply H2ly; auto with datatypes.
(* Goal: b2Prop false *)
intros HH; discriminate.
simpl map.
assert (Hmk: forall b, mk_v b = (fst b) .* (gen n.+1 0) +
                        lift n (snd b)).
(* Goal: @Logic.eq (vect (S n)) (dual (S n) (join (S n) v1 v2)) (meet (S n) (dual (S n) v1) (dual (S n) v2)) *)
  intros (vv, bb); unfold mk_v; simpl; Vfold n.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
  rewrite addE0r, scalE0r, addE0l, scalk, multK1r; auto.
assert (F1: cbl (vn_eparams n.+1) (base n.+1 1) (mk_v a)).
rewrite Hmk.
apply cbl_add; try apply cbl_scal; auto with datatypes.
constructor; apply (e_in_base1 n.+1 0); auto with arith.
apply cbl_incl with (l1 := map (lift n) (base n 1)); simpl; auto with datatypes.
apply lift_cbl; auto with datatypes.
assert (F2: cbl (vn_eparams n.+1) (base n.+1 1) (lift n x1)).
apply cbl_incl with (l1 := map (lift n) (base n 1)); simpl; auto with datatypes.
apply lift_cbl; auto with datatypes.
apply cbl_add; apply cbl_scal; auto with datatypes.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite joinl_top; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
simpl app; rewrite joinl_swap; auto.
rewrite Hx1.
assert (F3: forall a k1 k2 b l, cbl _ (base n.+1 1) a ->
 joinl n.+1 (a::(k1 .* b + k2 .* a)::l) = k1 .* joinl n.+1 (a::b ::l)).
intros a1 k1 k2 a2 l H.
(* Goal: @Logic.eq (E (vn_eparams n)) (joinl n (@cons (E (vn_eparams n)) b l)) (scalE (vn_eparams n) (invK (stype (vn_eparams n)) a) (joinl n (@cons (E (vn_eparams n)) (mprod (vn_eparams n) (@cons (Field.K (stype (vn_eparams n))) a ll) (@cons (E (vn_eparams n)) b l)) l))) *)
case (list_case _ l); intros Hll.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
subst; apply trans_equal with  (a1 ∨ (k1 .* a2 + k2 .* a1)); auto.
rewrite join_addr, !join_scalr, cbl_base_join_id; Vrm0.
rewrite !joinlS; auto; try (intros; discriminate).
rewrite <-join_assoc, join_addr, !join_scalr, cbl_base_join_id; Vrm0.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite join_scall, <-!join_assoc; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite F3; auto.
generalize H5ly; unfold mk_v; simpl; intros HH; rewrite HH; Vfold n; Vrm0.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
simpl In; intros i [[]|[[]|H]]; auto.
rewrite in_map_iff in H; case H.
intros x [[] Hx].
generalize (Hmk x); unfold mk_v; intros HH; rewrite HH.
apply cbl_add; try apply cbl_scal; auto with datatypes.
constructor; apply (e_in_base1 n.+1 0); auto with arith.
apply cbl_incl with (l1 := map (lift n) (base n 1)); simpl; auto with datatypes.
apply lift_cbl; auto with datatypes.
simpl map;
intros ly2 (i2, (H1ly2, (H2ly2, (H3ly3, H3ly4)))).
case (length_split _ _ _ _ _ _ _ H1ly2).
intros k1 (k2, (lk1, (lk2, (Hlk1, (Hlk2, Hlk3))))).
generalize (eqK_dec _ Hp k2 0%f); case eqK; intros Hk2.
*
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
exists (k1::0%f::lk1++lk2)%list; exists i2; repeat split; auto.
generalize Hlk2 Hlk3; simpl; clear Hlk2 Hlk3; intros Hlk2 Hlk3.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite !app_length, Hlk2, Hlk3; auto.
generalize H2ly2; rewrite Hlk1; simpl.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros [HH | HH]; auto.
case (in_app_or  _ _ _ HH); auto with datatypes.
simpl; intros [HH1 | HH2]; try subst; auto with datatypes.
generalize H3ly4; rewrite Hlk1, Hk2; simpl.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite !(mprod_S (vn_eparams n.+1)), !(mprod_app (vn_eparams n.+1)), !(mprod_S (vn_eparams n.+1)); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite !scalE0l, !addE0l; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite (scalE0l (vn_eparams n.+1)); auto. rewrite addE0l; auto. 
*
exists ((k1+-(k2 * fst b))%f::(k2 * fst a)%f::lk1++lk2)%list; 
  exists (k2 * fst a)%f; repeat split; auto with datatypes.
generalize Hlk2 Hlk3; simpl; clear Hlk2 Hlk3; intros Hlk2 Hlk3.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite !app_length, Hlk2, Hlk3; auto.
intros HH; case (multK_integral _ Hp _ _ HH); intros HH1; auto with datatypes.
case (H1ly a); auto with datatypes.
rewrite <- H3ly4; rewrite Hlk1; simpl.
rewrite Hx1, !(mprod_S (vn_eparams n.+1)), !(mprod_app (vn_eparams n.+1)), !(mprod_S (vn_eparams n.+1)), !scal_addEr,
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
        !scal_addEl, !addE_assoc; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply f_equal2 with (f := add n.+1); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite addE_com,!addE_assoc, addE_com, !addE_assoc; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply f_equal2 with (f := add n.+1); auto.
(* Goal: @Logic.eq (vect n) (addE (vn_eparams n) (addE (vn_eparams n) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (join n (contra n lf M1) M4)) (scalE (vn_eparams n) (oppK (K1 p) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) (join n M1 (contra n lf M4)))) (addE (vn_eparams n) (scalE (vn_eparams n) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1) (join n (contra n lf M2) M3)) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (join n M2 (contra n lf M3))))) (addE (vn_eparams n) (addE (vn_eparams n) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (join n (contra n lf M1) M4)) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (stype (vn_eparams n)) k (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) (join n M1 M3)) (scalE (vn_eparams n) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1) (join n (contra n lf M2) M3)))) (addE (vn_eparams n) (addE (vn_eparams n) (scalE (vn_eparams n) (oppK (K1 p) (multK (K1 p) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1) k)) (join n M1 M3)) (scalE (vn_eparams n) (oppK (K1 p) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) (join n M1 (contra n lf M4)))) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (join n M2 (contra n lf M3))))) *)
(* Goal: @Logic.eq (vect n) (addE (vn_eparams n) (addE (vn_eparams n) (scalE (vn_eparams n) k (join n M1 M4)) (scalE (vn_eparams n) (oppK (K1 p) (multK (K1 p) k (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1))) (join n M2 M3))) (addE (vn_eparams n) (join n (contra n lf M2) M4) (scalE (vn_eparams n) (oppK (K1 p) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) (join n M2 (contra n lf M4))))) (addE (vn_eparams n) (addE (vn_eparams n) (scalE (vn_eparams n) k (join n M1 M4)) (join n (contra n lf M2) M4)) (addE (vn_eparams n) (scalE (vn_eparams n) (oppK (K1 p) (multK (K1 p) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1) k)) (join n M2 M3)) (scalE (vn_eparams n) (oppK (K1 p) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) (join n M2 (contra n lf M4))))) *)
apply sym_equal.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite addE_com, !addE_assoc, addE_com, !addE_assoc; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply f_equal2 with (f := add n.+1); auto.
(* Goal: @Logic.eq (vect n) (addE (vn_eparams n) (addE (vn_eparams n) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (join n (contra n lf M1) M4)) (scalE (vn_eparams n) (oppK (K1 p) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) (join n M1 (contra n lf M4)))) (addE (vn_eparams n) (scalE (vn_eparams n) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1) (join n (contra n lf M2) M3)) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (join n M2 (contra n lf M3))))) (addE (vn_eparams n) (addE (vn_eparams n) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (join n (contra n lf M1) M4)) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (stype (vn_eparams n)) k (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) (join n M1 M3)) (scalE (vn_eparams n) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1) (join n (contra n lf M2) M3)))) (addE (vn_eparams n) (addE (vn_eparams n) (scalE (vn_eparams n) (oppK (K1 p) (multK (K1 p) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1) k)) (join n M1 M3)) (scalE (vn_eparams n) (oppK (K1 p) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) (join n M1 (contra n lf M4)))) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (join n M2 (contra n lf M3))))) *)
(* Goal: @Logic.eq (vect n) (addE (vn_eparams n) (addE (vn_eparams n) (scalE (vn_eparams n) k (join n M1 M4)) (scalE (vn_eparams n) (oppK (K1 p) (multK (K1 p) k (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1))) (join n M2 M3))) (addE (vn_eparams n) (join n (contra n lf M2) M4) (scalE (vn_eparams n) (oppK (K1 p) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) (join n M2 (contra n lf M4))))) (addE (vn_eparams n) (addE (vn_eparams n) (scalE (vn_eparams n) k (join n M1 M4)) (join n (contra n lf M2) M4)) (addE (vn_eparams n) (scalE (vn_eparams n) (oppK (K1 p) (multK (K1 p) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1) k)) (join n M2 M3)) (scalE (vn_eparams n) (oppK (K1 p) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) (join n M2 (contra n lf M4))))) *)
apply sym_equal.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite addE_com, <-!scal_multE, opp_multKr; auto.
Qed.

Lemma cbl_joinl0_mprod n M x : is_vector_space n M ->  
  cbl _ M x -> joinl n (x::M) = 0.
Proof.
intros H1 H2; elim H2; clear x H2.
(* Goal: b2Prop false *)
destruct M; auto; rewrite joinlS, join0l; auto; intros; discriminate.
intros v.
generalize H1; elim M; auto with datatypes.
intros _ HH; case HH.
intros a l1 IH Hc; simpl In; intros [H3 | H3]; try subst.
(* Goal: b2Prop (hom n (@length (vect n) (@cons (vect n) a l1)) (joinl n (@cons (vect n) a l1))) *)
case (list_case _ l1); intros Hl1.
rewrite Hl1; simpl; rewrite cbl_base_join_id; try apply Hc; auto with datatypes.
rewrite !joinlS, <-join_assoc, cbl_base_join_id, join0l; try apply Hc; auto with datatypes.
rewrite !joinlS; try (intros; discriminate).
2: intros HH; subst; case H3.
rewrite <-join_assoc, (cbl_base_join_com n a), join_scall,
        join_assoc, <-joinlS; try apply Hc; auto with datatypes.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
generalize IH; simpl; intros HH; rewrite HH; Vfold n; auto.
rewrite join0r; Vrm0.
intros i Hi; apply Hc; auto with datatypes.
intros HH; subst; case H3.
intros x y _ Hx _ Hy.
case (list_case _ M); intros Hl; subst.
simpl in Hx,Hy |- *; Vfold n; rewrite Hx, Hy; Vrm0.
rewrite joinlS, join_addl, <-!joinlS; Vrm0.
generalize Hx Hy; simpl; intros Hx1 Hx2; rewrite Hx1, Hx2; Vfold n; Vrm0.
intros k x Hc Hpr.
case (list_case _ M); intros Hl; subst.
generalize Hpr; simpl; Vfold n; intros Hpr1.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
simpl; Vfold n; rewrite Hpr1, scalE0r; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite joinlS, join_scall, <-joinlS; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
generalize Hpr; simpl; intros Hpr1; rewrite Hpr1; Vfold n; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite scalE0r; auto.
Qed.

(* M is decomposable and l is its decomposition *)
Definition decomposable n l M := is_vector_space n l /\ M = joinl n l.

Lemma decomp_cbl n M l x : is_vector n x ->
  decomposable n l M -> M <> 0 -> (x ∨ M = 0 <-> cbl _ l x). 
Proof.
(* Goal: forall (_ : is_vector n x) (_ : decomposable n l M) (_ : not (@Logic.eq (E (vn_eparams n)) M (E0 (vn_eparams n)))), iff (@Logic.eq (vect n) (join n x M) (E0 (vn_eparams n))) (cbl (vn_eparams n) l x) *)
intros Hx [Hn HM] Hdiff; subst; split; intros H1.
(* Goal: cbl (vn_eparams n) l x *)
(* Goal: @Logic.eq (vect n) (join n x (joinl n l)) (E0 (vn_eparams n)) *)
assert (Hd: l <> nil) by (intros HH; case Hdiff; subst; auto).
(* Goal: cbl (vn_eparams n) l x *)
(* Goal: @Logic.eq (vect n) (join n x (joinl n l)) (E0 (vn_eparams n)) *)
case (joinl0_mprod n (x::l)); auto with datatypes.
(* Goal: is_vector_space n (@cons (E (vn_eparams n)) x l) *)
(* Goal: @Logic.eq (E (vn_eparams n)) (joinl n (@cons (E (vn_eparams n)) x l)) (E0 (vn_eparams n)) *)
(* Goal: forall (x0 : list (Field.K (stype (vn_eparams n)))) (_ : @ex (Field.K (stype (vn_eparams n))) (fun i : Field.K (stype (vn_eparams n)) => and (@Logic.eq nat (@length (Field.K (stype (vn_eparams n))) x0) (@length (E (vn_eparams n)) (@cons (E (vn_eparams n)) x l))) (and (@In (Field.K (stype (vn_eparams n))) i x0) (and (not (@Logic.eq (Field.K (stype (vn_eparams n))) i (v0 (stype (vn_eparams n))))) (@Logic.eq (E (vn_eparams n)) (mprod (vn_eparams n) x0 (@cons (E (vn_eparams n)) x l)) (E0 (vn_eparams n))))))), cbl (vn_eparams n) l x *)
(* Goal: @Logic.eq (vect n) (join n x (joinl n l)) (E0 (vn_eparams n)) *)
simpl; intros x1 [Hx1 | Hx1]; subst; auto with datatypes.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite joinlS; auto; intros HH1; case Hdiff; rewrite HH1; auto.
(* Goal: b2Prop false *)
intros [| k lk] (i, (H1lk, (H2lk, (H3lk, H4lk)))); try discriminate.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
generalize (eqK_dec _ Hp k 0%f); case eqK; intros Hk; subst; auto.
(* Goal: cbl (vn_eparams n) l x *)
(* Goal: cbl (vn_eparams n) l x *)
(* Goal: @Logic.eq (vect n) (join n x (joinl n l)) (E0 (vn_eparams n)) *)
generalize H4lk.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite (mprod_S (vn_eparams n)); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite (scalE0l (vn_eparams n)); auto.
(* Goal: forall _ : @Logic.eq (E (vn_eparams n)) v (joinl n (decomposek n (first_deg n v) v)), decomposable n (decomposek n (first_deg n v) v) v *)
(* Goal: forall _ : not (@Logic.eq (E (vn_eparams n)) v (joinl n (decomposek n (first_deg n v) v))), not (is_decomposable n v) *)
(* Goal: not (is_decomposable n v) *)
rewrite  addE0l; auto; intros HH.
(* Goal: cbl (vn_eparams n) l x *)
(* Goal: cbl (vn_eparams n) l x *)
(* Goal: @Logic.eq (vect n) (join n x (joinl n l)) (E0 (vn_eparams n)) *)
simpl in H2lk; case H2lk; clear H2lk; intros H2lk; subst.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
case H3lk; auto.
(* Goal: cbl (vn_eparams n) l x *)
(* Goal: cbl (vn_eparams n) l x *)
(* Goal: @Logic.eq (vect n) (join n x (joinl n l)) (E0 (vn_eparams n)) *)
case Hdiff; injection H1lk.
(* Goal: forall _ : @Logic.eq nat (@length (Field.K (K1 p)) lk) (@length (vect n) l), @Logic.eq (E (vn_eparams n)) (joinl n l) (E0 (vn_eparams n)) *)
(* Goal: cbl (vn_eparams n) l x *)
(* Goal: @Logic.eq (vect n) (join n x (joinl n l)) (E0 (vn_eparams n)) *)
generalize l Hn Hd HH H2lk; clear l H4lk H1lk Hdiff H1 Hd Hn HH H2lk.
(* Goal: @Logic.eq (vect n) (mcontra n (@cons (kn p n) a l) x) (mcontra n l (contra n a x)) *)
elim lk; simpl; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros l; case l; intros; try discriminate; auto.
(* Goal: forall (a : Field.K (K1 p)) (l : list (Field.K (K1 p))) (_ : forall (l0 : list (vect n)) (_ : is_vector_space n l0) (_ : not (@Logic.eq (list (vect n)) l0 (@nil (vect n)))) (_ : @Logic.eq (vect n) (mprod (vn_eparams n) l l0) (genk n (v0 (K1 p)))) (_ : @In (Field.K (K1 p)) i l) (_ : @Logic.eq nat (@length (Field.K (K1 p)) l) (@length (vect n) l0)), @Logic.eq (vect n) (joinl n l0) (genk n (v0 (K1 p)))) (l0 : list (vect n)) (_ : is_vector_space n l0) (_ : not (@Logic.eq (list (vect n)) l0 (@nil (vect n)))) (_ : @Logic.eq (vect n) (mprod (vn_eparams n) (@cons (Field.K (K1 p)) a l) l0) (genk n (v0 (K1 p)))) (_ : or (@Logic.eq (Field.K (K1 p)) a i) (@In (Field.K (K1 p)) i l)) (_ : @Logic.eq nat (S (@length (Field.K (K1 p)) l)) (@length (vect n) l0)), @Logic.eq (vect n) (joinl n l0) (genk n (v0 (K1 p))) *)
(* Goal: cbl (vn_eparams n) l x *)
(* Goal: @Logic.eq (vect n) (join n x (joinl n l)) (E0 (vn_eparams n)) *)
intros a l IH [| b l1] H1l1 H2l1.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
case H2l1; auto.
(* Goal: forall (_ : @Logic.eq (vect n) (mprod (vn_eparams n) (@cons (Field.K (K1 p)) a l) (@cons (vect n) b l1)) (genk n (v0 (K1 p)))) (_ : or (@Logic.eq (Field.K (K1 p)) a i) (@In (Field.K (K1 p)) i l)) (_ : @Logic.eq nat (S (@length (Field.K (K1 p)) l)) (@length (vect n) (@cons (vect n) b l1))), @Logic.eq (vect n) (joinl n (@cons (vect n) b l1)) (genk n (v0 (K1 p))) *)
(* Goal: cbl (vn_eparams n) l x *)
(* Goal: @Logic.eq (vect n) (join n x (joinl n l)) (E0 (vn_eparams n)) *)
generalize (eqK_dec _ Hp a 0%f); case eqK; intros Ha; simpl in Ha.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite (mprod_S (vn_eparams n)), Ha, (scalE0l (vn_eparams n)), addE0l; auto.
(* Goal: forall (_ : @Logic.eq (vect n) (mprod (vn_eparams n) l l1) (genk n (v0 (K1 p)))) (_ : or (@Logic.eq (Field.K (K1 p)) (v0 (K p)) i) (@In (Field.K (K1 p)) i l)) (_ : @Logic.eq nat (S (@length (Field.K (K1 p)) l)) (@length (vect n) (@cons (vect n) b l1))), @Logic.eq (vect n) (joinl n (@cons (vect n) b l1)) (genk n (v0 (K1 p))) *)
(* Goal: forall (_ : @Logic.eq (vect n) (mprod (vn_eparams n) (@cons (Field.K (K1 p)) a l) (@cons (vect n) b l1)) (genk n (v0 (K1 p)))) (_ : or (@Logic.eq (Field.K (K1 p)) a i) (@In (Field.K (K1 p)) i l)) (_ : @Logic.eq nat (S (@length (Field.K (K1 p)) l)) (@length (vect n) (@cons (vect n) b l1))), @Logic.eq (vect n) (joinl n (@cons (vect n) b l1)) (genk n (v0 (K1 p))) *)
(* Goal: cbl (vn_eparams n) l x *)
(* Goal: @Logic.eq (vect n) (join n x (joinl n l)) (E0 (vn_eparams n)) *)
intros HH [HH1 | HH1]; try (case H3lk; auto; fail).
(* Goal: forall _ : @Logic.eq nat (S (@length (Field.K (K1 p)) l)) (@length (vect n) (@cons (vect n) b l1)), @Logic.eq (vect n) (joinl n (@cons (vect n) b l1)) (genk n (v0 (K1 p))) *)
(* Goal: forall (_ : @Logic.eq (vect n) (mprod (vn_eparams n) (@cons (Field.K (K1 p)) a l) (@cons (vect n) b l1)) (genk n (v0 (K1 p)))) (_ : or (@Logic.eq (Field.K (K1 p)) a i) (@In (Field.K (K1 p)) i l)) (_ : @Logic.eq nat (S (@length (Field.K (K1 p)) l)) (@length (vect n) (@cons (vect n) b l1))), @Logic.eq (vect n) (joinl n (@cons (vect n) b l1)) (genk n (v0 (K1 p))) *)
(* Goal: cbl (vn_eparams n) l x *)
(* Goal: @Logic.eq (vect n) (join n x (joinl n l)) (E0 (vn_eparams n)) *)
intros HH2; injection HH2; clear HH2; intros HH2.
(* Goal: cbl n (@cons (vect n) a (@cons (vect n) b l)) (Nat.pred (@length (vect n) (@cons (vect n) a (@cons (vect n) b l)))) (joinl n (@cons (vect n) a (@cons (vect n) b l))) *)
rewrite joinlS.
(* Goal: @Logic.eq (vect n) (join n b (joinl n l1)) (genk n (v0 (K1 p))) *)
(* Goal: not (@Logic.eq (list (vect n)) l1 (@nil (vect n))) *)
(* Goal: forall (_ : @Logic.eq (vect n) (mprod (vn_eparams n) (@cons (Field.K (K1 p)) a l) (@cons (vect n) b l1)) (genk n (v0 (K1 p)))) (_ : or (@Logic.eq (Field.K (K1 p)) a i) (@In (Field.K (K1 p)) i l)) (_ : @Logic.eq nat (S (@length (Field.K (K1 p)) l)) (@length (vect n) (@cons (vect n) b l1))), @Logic.eq (vect n) (joinl n (@cons (vect n) b l1)) (genk n (v0 (K1 p))) *)
(* Goal: cbl (vn_eparams n) l x *)
(* Goal: @Logic.eq (vect n) (join n x (joinl n l)) (E0 (vn_eparams n)) *)
rewrite IH; auto with datatypes.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite join0r; auto.
(* Goal: is_vector_space n l1 *)
(* Goal: not (@Logic.eq (list (vect n)) l1 (@nil (vect n))) *)
(* Goal: not (@Logic.eq (list (vect n)) l1 (@nil (vect n))) *)
(* Goal: forall (_ : @Logic.eq (vect n) (mprod (vn_eparams n) (@cons (Field.K (K1 p)) a l) (@cons (vect n) b l1)) (genk n (v0 (K1 p)))) (_ : or (@Logic.eq (Field.K (K1 p)) a i) (@In (Field.K (K1 p)) i l)) (_ : @Logic.eq nat (S (@length (Field.K (K1 p)) l)) (@length (vect n) (@cons (vect n) b l1))), @Logic.eq (vect n) (joinl n (@cons (vect n) b l1)) (genk n (v0 (K1 p))) *)
(* Goal: cbl (vn_eparams n) l x *)
(* Goal: @Logic.eq (vect n) (join n x (joinl n l)) (E0 (vn_eparams n)) *)
intros i1 Hi1; apply H1l1; auto with datatypes.
(* Goal: not (@Logic.eq (list (vect n)) l1 (@nil (vect n))) *)
(* Goal: forall (_ : @Logic.eq (vect n) (mprod (vn_eparams n) (@cons (Field.K (K1 p)) a l) (@cons (vect n) b l1)) (genk n (v0 (K1 p)))) (_ : or (@Logic.eq (Field.K (K1 p)) a i) (@In (Field.K (K1 p)) i l)) (_ : @Logic.eq nat (S (@length (Field.K (K1 p)) l)) (@length (vect n) (@cons (vect n) b l1))), @Logic.eq (vect n) (joinl n (@cons (vect n) b l1)) (genk n (v0 (K1 p))) *)
(* Goal: cbl (vn_eparams n) l x *)
(* Goal: @Logic.eq (vect n) (join n x (joinl n l)) (E0 (vn_eparams n)) *)
intros HH3; subst.
(* Goal: @Logic.eq (vect (S n)) (@pair (vect n) (vect n) vv1 (genk n (v0 (K1 p)))) (gen (S n) O) *)
(* Goal: @ex nat (fun p1 : nat => and (lt p1 (S n)) (@Logic.eq (vect (S n)) (@pair (vect n) (vect n) (genk n (v0 (K1 p))) vv2) (gen (S n) p1))) *)
destruct l; try discriminate; case HH1.
(* Goal: not (@Logic.eq (list (vect n)) l1 (@nil (vect n))) *)
(* Goal: forall (_ : @Logic.eq (vect n) (mprod (vn_eparams n) (@cons (Field.K (K1 p)) a l) (@cons (vect n) b l1)) (genk n (v0 (K1 p)))) (_ : or (@Logic.eq (Field.K (K1 p)) a i) (@In (Field.K (K1 p)) i l)) (_ : @Logic.eq nat (S (@length (Field.K (K1 p)) l)) (@length (vect n) (@cons (vect n) b l1))), @Logic.eq (vect n) (joinl n (@cons (vect n) b l1)) (genk n (v0 (K1 p))) *)
(* Goal: cbl (vn_eparams n) l x *)
(* Goal: @Logic.eq (vect n) (join n x (joinl n l)) (E0 (vn_eparams n)) *)
intros HH3; subst.
(* Goal: @Logic.eq (vect (S n)) (@pair (vect n) (vect n) vv1 (genk n (v0 (K1 p)))) (gen (S n) O) *)
(* Goal: @ex nat (fun p1 : nat => and (lt p1 (S n)) (@Logic.eq (vect (S n)) (@pair (vect n) (vect n) (genk n (v0 (K1 p))) vv2) (gen (S n) p1))) *)
destruct l; try discriminate; case HH1.
(* Goal: forall (_ : @Logic.eq (vect n) (mprod (vn_eparams n) (@cons (Field.K (K1 p)) a l) (@cons (vect n) b l1)) (genk n (v0 (K1 p)))) (_ : or (@Logic.eq (Field.K (K1 p)) a i) (@In (Field.K (K1 p)) i l)) (_ : @Logic.eq nat (S (@length (Field.K (K1 p)) l)) (@length (vect n) (@cons (vect n) b l1))), @Logic.eq (vect n) (joinl n (@cons (vect n) b l1)) (genk n (v0 (K1 p))) *)
(* Goal: cbl (vn_eparams n) l x *)
(* Goal: @Logic.eq (vect n) (join n x (joinl n l)) (E0 (vn_eparams n)) *)
intros HH1.
assert (HxL: b = (-(a^-1)).* (l *X* l1)).
(* Goal: forall _ : @Logic.eq (E (vn_eparams n)) v (joinl n (decomposek n (first_deg n v) v)), decomposable n (decomposek n (first_deg n v) v) v *)
(* Goal: forall _ : not (@Logic.eq (E (vn_eparams n)) v (joinl n (decomposek n (first_deg n v) v))), not (is_decomposable n v) *)
(* Goal: not (is_decomposable n v) *)
generalize HH1; rewrite mprod_S; auto; intros HH.
rewrite <- (addE0l _  (fn n) (l *X* l1)); rewrite <- (scal_addE0 _ (fn n) (a .* b)).
rewrite (addE_com _ (fn n) (a.*b)); rewrite addE_assoc, HH, addE0r,
         <-!scal_multE, <-!opp_multKr, <-!opp_multKl, multK1r, multK_com, invKl,
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
         opp_oppK, scalE1; auto.
generalize H1l1 IH HxL; case l; case l1; try (intros; discriminate);
 clear l l1 HxL HH1 H1l1 H2l1 IH.
(* Goal: forall (_ : is_vector_space n (@cons (vect n) b (@nil (vect n)))) (_ : forall (l : list (vect n)) (_ : is_vector_space n l) (_ : not (@Logic.eq (list (vect n)) l (@nil (vect n)))) (_ : @Logic.eq (vect n) (mprod (vn_eparams n) (@nil (Field.K (K1 p))) l) (genk n (v0 (K1 p)))) (_ : @In (Field.K (K1 p)) i (@nil (Field.K (K1 p)))) (_ : @Logic.eq nat (@length (Field.K (K1 p)) (@nil (Field.K (K1 p)))) (@length (vect n) l)), @Logic.eq (vect n) (joinl n l) (genk n (v0 (K1 p)))) (_ : @Logic.eq (vect n) b (scalE (vn_eparams n) (oppK (K1 p) (invK (K1 p) a)) (mprod (vn_eparams n) (@nil (Field.K (K1 p))) (@nil (vect n))))) (_ : or (@Logic.eq (Field.K (K1 p)) a i) (@In (Field.K (K1 p)) i (@nil (Field.K (K1 p))))) (_ : @Logic.eq nat (S (@length (Field.K (K1 p)) (@nil (Field.K (K1 p))))) (@length (vect n) (@cons (vect n) b (@nil (vect n))))), @Logic.eq (vect n) (joinl n (@cons (vect n) b (@nil (vect n)))) (genk n (v0 (K1 p))) *)
(* Goal: forall (v : vect n) (l : list (vect n)) (k : Field.K (K1 p)) (l0 : list (Field.K (K1 p))) (_ : is_vector_space n (@cons (vect n) b (@cons (vect n) v l))) (_ : forall (l1 : list (vect n)) (_ : is_vector_space n l1) (_ : not (@Logic.eq (list (vect n)) l1 (@nil (vect n)))) (_ : @Logic.eq (vect n) (mprod (vn_eparams n) (@cons (Field.K (K1 p)) k l0) l1) (genk n (v0 (K1 p)))) (_ : @In (Field.K (K1 p)) i (@cons (Field.K (K1 p)) k l0)) (_ : @Logic.eq nat (@length (Field.K (K1 p)) (@cons (Field.K (K1 p)) k l0)) (@length (vect n) l1)), @Logic.eq (vect n) (joinl n l1) (genk n (v0 (K1 p)))) (_ : @Logic.eq (vect n) b (scalE (vn_eparams n) (oppK (K1 p) (invK (K1 p) a)) (mprod (vn_eparams n) (@cons (Field.K (K1 p)) k l0) (@cons (vect n) v l)))) (_ : or (@Logic.eq (Field.K (K1 p)) a i) (@In (Field.K (K1 p)) i (@cons (Field.K (K1 p)) k l0))) (_ : @Logic.eq nat (S (@length (Field.K (K1 p)) (@cons (Field.K (K1 p)) k l0))) (@length (vect n) (@cons (vect n) b (@cons (vect n) v l)))), @Logic.eq (vect n) (joinl n (@cons (vect n) b (@cons (vect n) v l))) (genk n (v0 (K1 p))) *)
(* Goal: cbl (vn_eparams n) l x *)
(* Goal: @Logic.eq (vect n) (join n x (joinl n l)) (E0 (vn_eparams n)) *)
intros H1l1 IH.
(* Goal: forall (_ : @Logic.eq (vect n) b (scalE (vn_eparams n) (oppK (K1 p) (invK (K1 p) a)) (mprod (vn_eparams n) (@nil (Field.K (K1 p))) (@nil (vect n))))) (_ : or (@Logic.eq (Field.K (K1 p)) a i) (@In (Field.K (K1 p)) i (@nil (Field.K (K1 p))))) (_ : @Logic.eq nat (S (@length (Field.K (K1 p)) (@nil (Field.K (K1 p))))) (@length (vect n) (@cons (vect n) b (@nil (vect n))))), @Logic.eq (vect n) (joinl n (@cons (vect n) b (@nil (vect n)))) (genk n (v0 (K1 p))) *)
(* Goal: forall (v : vect n) (l : list (vect n)) (k : Field.K (K1 p)) (l0 : list (Field.K (K1 p))) (_ : is_vector_space n (@cons (vect n) b (@cons (vect n) v l))) (_ : forall (l1 : list (vect n)) (_ : is_vector_space n l1) (_ : not (@Logic.eq (list (vect n)) l1 (@nil (vect n)))) (_ : @Logic.eq (vect n) (mprod (vn_eparams n) (@cons (Field.K (K1 p)) k l0) l1) (genk n (v0 (K1 p)))) (_ : @In (Field.K (K1 p)) i (@cons (Field.K (K1 p)) k l0)) (_ : @Logic.eq nat (@length (Field.K (K1 p)) (@cons (Field.K (K1 p)) k l0)) (@length (vect n) l1)), @Logic.eq (vect n) (joinl n l1) (genk n (v0 (K1 p)))) (_ : @Logic.eq (vect n) b (scalE (vn_eparams n) (oppK (K1 p) (invK (K1 p) a)) (mprod (vn_eparams n) (@cons (Field.K (K1 p)) k l0) (@cons (vect n) v l)))) (_ : or (@Logic.eq (Field.K (K1 p)) a i) (@In (Field.K (K1 p)) i (@cons (Field.K (K1 p)) k l0))) (_ : @Logic.eq nat (S (@length (Field.K (K1 p)) (@cons (Field.K (K1 p)) k l0))) (@length (vect n) (@cons (vect n) b (@cons (vect n) v l)))), @Logic.eq (vect n) (joinl n (@cons (vect n) b (@cons (vect n) v l))) (genk n (v0 (K1 p))) *)
(* Goal: cbl (vn_eparams n) l x *)
(* Goal: @Logic.eq (vect n) (join n x (joinl n l)) (E0 (vn_eparams n)) *)
unfold mprod; simpl; Vfold n; rewrite scalE0r; auto; intros HH2; rewrite HH2.
(* Goal: forall (v : vect n) (l : list (vect n)) (k : Field.K (K1 p)) (l0 : list (Field.K (K1 p))) (_ : is_vector_space n (@cons (vect n) b (@cons (vect n) v l))) (_ : forall (l1 : list (vect n)) (_ : is_vector_space n l1) (_ : not (@Logic.eq (list (vect n)) l1 (@nil (vect n)))) (_ : @Logic.eq (vect n) (mprod (vn_eparams n) (@cons (Field.K (K1 p)) k l0) l1) (genk n (v0 (K1 p)))) (_ : @In (Field.K (K1 p)) i (@cons (Field.K (K1 p)) k l0)) (_ : @Logic.eq nat (@length (Field.K (K1 p)) (@cons (Field.K (K1 p)) k l0)) (@length (vect n) l1)), @Logic.eq (vect n) (joinl n l1) (genk n (v0 (K1 p)))) (_ : @Logic.eq (vect n) b (scalE (vn_eparams n) (oppK (K1 p) (invK (K1 p) a)) (mprod (vn_eparams n) (@cons (Field.K (K1 p)) k l0) (@cons (vect n) v l)))) (_ : or (@Logic.eq (Field.K (K1 p)) a i) (@In (Field.K (K1 p)) i (@cons (Field.K (K1 p)) k l0))) (_ : @Logic.eq nat (S (@length (Field.K (K1 p)) (@cons (Field.K (K1 p)) k l0))) (@length (vect n) (@cons (vect n) b (@cons (vect n) v l)))), @Logic.eq (vect n) (joinl n (@cons (vect n) b (@cons (vect n) v l))) (genk n (v0 (K1 p))) *)
(* Goal: cbl (vn_eparams n) l x *)
(* Goal: @Logic.eq (vect n) (join n x (joinl n l)) (E0 (vn_eparams n)) *)
intros a1 l1 b1 l H2l1 IH HxL _ Hl.
(* Goal: @Logic.eq (vect n) (joinl n (@cons (vect n) b (@cons (vect n) a1 l1))) (genk n (v0 (K1 p))) *)
(* Goal: cbl (vn_eparams n) l x *)
(* Goal: @Logic.eq (vect n) (join n x (joinl n l)) (E0 (vn_eparams n)) *)
apply (cbl_joinl0_mprod n (a1::l1)); auto with datatypes.
(* Goal: is_vector_space n (@cons (vect n) a1 l1) *)
(* Goal: cbl (vn_eparams n) (@cons (vect n) a1 l1) b *)
(* Goal: cbl (vn_eparams n) l x *)
(* Goal: @Logic.eq (vect n) (join n x (joinl n l)) (E0 (vn_eparams n)) *)
intros i1; simpl; intros [[]|Hi]; apply H2l1; auto with datatypes.
(* Goal: cbl (vn_eparams n) (base n (S O)) (scalE (vn_eparams n) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) b) *)
(* Goal: @ex (Field.K (stype (vn_eparams n))) (fun k : Field.K (stype (vn_eparams n)) => @ex (list (vect n)) (fun l0 : list (vect n) => and (forall (v : vect n) (_ : @In (vect n) v l0), b2Prop (hom n (S O) v)) (@Logic.eq (E (vn_eparams n)) (joinl n (@cons (E (vn_eparams n)) b l)) (scalE (vn_eparams n) k (joinl n (@cons (E (vn_eparams n)) (mprod (vn_eparams n) (@cons (Field.K (stype (vn_eparams n))) a ll) (@cons (E (vn_eparams n)) b l)) l0)))))) *)
rewrite HxL; apply cbl_scal.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply mprod_cbl; auto.
assert (HxL: x = (-(k^-1)).* (lk *X* l)).
(* Goal: forall _ : @Logic.eq (E (vn_eparams n)) v (joinl n (decomposek n (first_deg n v) v)), decomposable n (decomposek n (first_deg n v) v) v *)
(* Goal: forall _ : not (@Logic.eq (E (vn_eparams n)) v (joinl n (decomposek n (first_deg n v) v))), not (is_decomposable n v) *)
(* Goal: not (is_decomposable n v) *)
generalize H4lk; rewrite mprod_S; auto; intros HH.
rewrite <- (addE0l _ (fn n) (lk *X* l)), <- (scal_addE0 _  (fn n) (k .* x)).
rewrite (addE_com _  (fn n) (k.*x)), addE_assoc, HH, addE0r,
        <-!scal_multE, <-!opp_multKr, <-!opp_multKl,
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
        multK1r, multK_com, invKl, opp_oppK, scalE1; auto.
(* Goal: cbl (vn_eparams n) (base n (S O)) (scalE (vn_eparams n) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) b) *)
(* Goal: @ex (Field.K (stype (vn_eparams n))) (fun k : Field.K (stype (vn_eparams n)) => @ex (list (vect n)) (fun l0 : list (vect n) => and (forall (v : vect n) (_ : @In (vect n) v l0), b2Prop (hom n (S O) v)) (@Logic.eq (E (vn_eparams n)) (joinl n (@cons (E (vn_eparams n)) b l)) (scalE (vn_eparams n) k (joinl n (@cons (E (vn_eparams n)) (mprod (vn_eparams n) (@cons (Field.K (stype (vn_eparams n))) a ll) (@cons (E (vn_eparams n)) b l)) l0)))))) *)
rewrite HxL; apply cbl_scal.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply mprod_cbl; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite <-joinlS; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply (cbl_joinl0_mprod n l x); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros HH; case Hdiff; rewrite HH; auto.
Qed.

Lemma hom1_decomposable n x : hom n 1 x -> decomposable n (x::nil) x.
Proof.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros H; split; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros y; simpl; intros [[]|[]]; red; rewrite cbl1_hom1_equiv; auto.
Qed.

Lemma decomp_hom n (l: list (vect n)) M : decomposable n l M -> hom n (length l) M.
Proof.
(* Goal: forall _ : decomposable n l M, b2Prop (hom n (@length (vect n) l) M) *)
intros (H1, H2); subst.
(* Goal: b2Prop (hom n (@length (vect n) l) (joinl n l)) *)
assert (HH: forall a, In a l -> hom n 1 a).
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros a Ha; rewrite <- cbl1_hom1_equiv; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
generalize (H1 a Ha); auto.
(* Goal: b2Prop (hom n (@length (vect n) l) (joinl n l)) *)
clear H1; induction l as [| a l1 IH].
(* Goal: b2Prop (hom n (@length (vect n) (@nil (vect n))) (joinl n (@nil (vect n)))) *)
(* Goal: b2Prop (hom n (@length (vect n) (@cons (vect n) a l1)) (joinl n (@cons (vect n) a l1))) *)
simpl; apply hom0K.
(* Goal: b2Prop (hom n (@length (vect n) (@cons (vect n) a l1)) (joinl n (@cons (vect n) a l1))) *)
case (list_case _ l1); intros H1.
(* Goal: b2Prop (hom n (@length (vect n) (@cons (vect n) a l1)) (joinl n (@cons (vect n) a l1))) *)
(* Goal: b2Prop (hom n (@length (vect n) (@cons (vect n) a l1)) (joinl n (@cons (vect n) a l1))) *)
subst; simpl; auto with datatypes.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite joinlS; auto.
(* Goal: b2Prop (hom n (@length (vect n) (@cons (vect n) a l1)) (join n a (joinl n l1))) *)
change (length (a::l1)) with (1 + length l1)%nat; auto with datatypes.
Qed.

(* The linear form is defined by its finger print on the base *)

Fixpoint contra (n : nat) {struct n}: kn n -> vect n -> vect n :=
  match n return (kn n -> vect n -> vect n) with
  | 0%nat => fun k a => 0
  | S n1 =>
      fun lf l1 =>
      let (k, lf1) := lf in
      let (l2, l3) := l1 in 
         ((- (1)).* (contra n1 lf1 l2),  (k : K) .* l2 + contra n1 lf1 l3)
  end.

Notation "#< l , x ># " := (contra _ l x) (format "#< l ,  x >#").

Lemma contraE n l (M : vect n.+1) :
  #<l, M ># =
      ((- (1))%f.* #< snd l, fst M>#,  (fst l : K) .* fst M + #<snd l, snd M>#).
Proof. destruct l; destruct M; auto. Qed.

Lemma contra0r n lf : #<lf, 0># = (0: vect n).
Proof.
(* Goal: @Logic.eq (vect n) (contra n lf (E0 (vn_eparams n))) (E0 (vn_eparams n) : vect n) *)
induction n as [| n IH]; simpl; Grm0; Vfold n.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (let (k, lf1) := lf in @pair (vect n) (vect n) (scal n (oppK (K1 p) (v1 (K1 p))) (contra n lf1 (genk n (v0 (K1 p))))) (add n (scal n k (genk n (v0 (K1 p)))) (contra n lf1 (genk n i)))) (@pair (vect n) (vect n) (genk n (v0 (K1 p))) (genk n (v0 (K1 p)))) *)
destruct lf; rewrite IH; Grm0.
Qed.

Hint Rewrite contra0r: GRm0.

Lemma contra0l n (x:vect n) : #<0, x># = 0.
Proof.
(* Goal: @Logic.eq (vect n) (k2g n (E0 (Kn.vn_eparams p n))) (E0 (vn_eparams n)) *)
induction n as [|n IH]; simpl; auto.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (let (x1, y1) := x in @pair (vect n) (vect n) (meet n x1 (E0 (vn_eparams n))) (addE (vn_eparams n) (meet n x1 (genk n (v1 (K1 p)))) (meet n y1 (dconj n false (E0 (vn_eparams n)))))) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (genk n (let (_, l2) := let (x, y) := x in @pair (vect n) (vect n) (dual n (conj n false y)) (dual n x) in const n l2))) *)
destruct x.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (dual n (conj n false (genk n k))) (dual n (genk n (v0 (K1 p))))) (@pair (vect n) (vect n) (scal n k (all n)) (scal n k (genk n (v0 (K1 p))))) *)
Vfold n.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n (Kn.genk p n (Field.v0 (K p))) v)) (addE (vn_eparams n) (scalE (vn_eparams n) (Field.v0 (K p)) v) (contra n (Kn.genk p n (Field.v0 (K p))) v0))) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (E0 (vn_eparams n))) *)
Vfold n; repeat rewrite IH; Grm0.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite (scalE0l (vn_eparams n)); auto.
Qed.

Lemma contrak n i lf : #<lf, [i]># = 0 :> vect n.
Proof.
(* Goal: @Logic.eq (vect n) (k2g n (E0 (Kn.vn_eparams p n))) (E0 (vn_eparams n)) *)
induction n as [| n IH]; simpl; auto.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (let (k, lf1) := lf in @pair (vect n) (vect n) (scal n (oppK (K1 p) (v1 (K1 p))) (contra n lf1 (genk n (v0 (K1 p))))) (add n (scal n k (genk n (v0 (K1 p)))) (contra n lf1 (genk n i)))) (@pair (vect n) (vect n) (genk n (v0 (K1 p))) (genk n (v0 (K1 p)))) *)
destruct lf; rewrite IH; Grm0.
Qed.

Lemma contra_e n i lf : i < n -> #<lf, 'e_i># = [projk _ i lf] :> vect n.
Proof.
(* Goal: forall _ : lt i n, @Logic.eq (vect n) (k2g n (Kn.gen p n i)) (gen n i) *)
generalize i; clear i.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (dual n (conj n false (genk n k))) (dual n (genk n (v0 (K1 p))))) (@pair (vect n) (vect n) (scal n k (all n)) (scal n k (genk n (v0 (K1 p))))) *)
induction n as [| n IH]; intros i; simpl; auto; try Vfold n.
(* Goal: forall _ : lt i (S n), @Logic.eq (prod (vect n) (vect n)) (let (k, lf1) := lf in let (l2, l3) := match i with | O => @pair (vect n) (vect n) (genk n (v1 (K1 p))) (E0 (vn_eparams n)) | S p1 => @pair (vect n) (vect n) (E0 (vn_eparams n)) (gen n p1) end in @pair (vect n) (vect n) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf1 l2)) (addE (vn_eparams n) (scalE (vn_eparams n) k l2) (contra n lf1 l3))) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (genk n (let (a, l1) := lf in match i with | O => a | S k1 => Kn.proj p n k1 l1 end))) *)
destruct lf; destruct i as [| i]; Grm0.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n (E0 (vn_eparams n)) y2) (join n (genk n (const n x2)) (genk n (const n y1)))) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n (E0 (vn_eparams n)) y2) (join n (genk n (const n x2)) (genk n (const n y1)))) z2) (addE (vn_eparams n) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n (S (Nat.add O k2)))) (meet n (genk n (const n x2)) (join n y2 (dconj n false z1)))) (join n (meet n (genk n (const n x2)) (dconj n false z1)) y2)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add O (S k2)))))) (meet n (E0 (vn_eparams n)) (addE (vn_eparams n) (join n (genk n (const n y1)) z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n (E0 (vn_eparams n)) z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) z2) (meet n (genk n (const n x2)) (dconj n false z1)))) (genk n (const n y1))))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add O (S k2)))))) (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) (join n y2 z2)) (meet n (genk n (const n x2)) (dconj n false (addE (vn_eparams n) (join n (genk n (const n y1)) z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) z2) (meet n (genk n (const n x2)) (dconj n false z1))) y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (eq0 n z1) (hom n O z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (hom n k2 z1) (hom n (S k2) z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
  rewrite contrak; Grm0;  simpl; Vfold n; Grm0.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
  rewrite scalk, multK1r; auto.
(* Goal: forall _ : lt (S i) (S n), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (contra n k0 (gen n i))) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (genk n (Kn.proj p n i k0))) *)
intros HH; assert (HH1: i < n); auto with arith.
(* Goal: @Logic.eq (vect n) (mcontra n (@cons (kn p n) a l) x) (mcontra n l (contra n a x)) *)
rewrite IH; simpl; auto.
Qed.

Lemma contra_scalr n k lf (x: vect n) : #< lf, k .* x ># = k .* #< lf , x >#.
Proof.
(* Goal: forall (k : nat) (_ : b2Prop (hom n k M)), @Logic.eq (vect n) (dconj n false M) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n k)) M) *)
induction n as [| n IH]; simpl; auto; try Vfold n.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
  intros; rewrite multK0r; auto.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (let (x1, y1) := x in @pair (vect n) (vect n) (meet n x1 (E0 (vn_eparams n))) (addE (vn_eparams n) (meet n x1 (genk n (v1 (K1 p)))) (meet n y1 (dconj n false (E0 (vn_eparams n)))))) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (genk n (let (_, l2) := let (x, y) := x in @pair (vect n) (vect n) (dual n (conj n false y)) (dual n x) in const n l2))) *)
destruct lf; destruct x.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite IH, IH, scal_addEr, <-! scal_multE; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
repeat rewrite (fun x => (multK_com p x k)); auto.
Qed.

Lemma contra_addr n lf (x y: vect n) : #< lf, x + y ># = #< lf, x ># + #< lf,  y >#.
Proof.
(* Goal: forall (k : nat) (_ : b2Prop (hom n k M)), @Logic.eq (vect n) (dconj n false M) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n k)) M) *)
induction n as [| n IH]; simpl; auto; try Vfold n.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
  intros; rewrite addK0r; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
destruct lf; destruct x; destruct y; rewrite !IH, !scal_addEr; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply f_equal2 with (f := @pair _ _); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite <-! addE_assoc; try apply f_equal2 with (f := add n); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite !addE_assoc; try apply f_equal2 with (f := add n); auto.
(* Goal: @Logic.eq (vect n) (addE (vn_eparams n) (meet n v4 (dconj n false v1)) (meet n v3 v2)) (addE (vn_eparams n) (meet n v3 v2) (meet n v4 (dconj n false v1))) *)
rewrite addE_com; auto.
Qed.

Lemma contra_scall n (k : K) (x : kn n)  (M : vect n) :
 #< (scalE (Kn.vn_eparams p n) k x), M># = k .* #<x, M>#.
Proof.
(* Goal: forall _ : b2Prop (hom n (S O) x), @ex (kn p n) (fun y : kn p n => @Logic.eq (vect n) x (k2g n y)) *)
induction n as [|n IH]; simpl; Krm0.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (let (k, lf1) := let (v1, l2) := x in @pair (Field.K (K p)) (kn p n) (multK (K p) k v1) (Kn.scal p n k l2) in let (l2, l3) := M in @pair (vect n) (vect n) (scal n (oppK (K1 p) (v1 (K1 p))) (contra n lf1 l2)) (add n (scal n k l2) (contra n lf1 l3))) (let (l2, l3) := let (k, lf1) := x in let (l2, l3) := M in @pair (vect n) (vect n) (scal n (oppK (K1 p) (v1 (K1 p))) (contra n lf1 l2)) (add n (scal n k l2) (contra n lf1 l3)) in @pair (vect n) (vect n) (scal n k l2) (scal n k l3)) *)
destruct x as [k1 x1]; destruct M as [M1 M2]; Vfold n; Kfold n.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite !IH, scal_addEr, <-!scal_multE, multK_com; auto.
Qed.

Lemma contra_addl n (x y : kn n) (M : vect n) :
 #< x + y, M ># =  #< x, M ># + #<y, M >#.
Proof.
(* Goal: forall _ : b2Prop (hom n (S O) x), @ex (kn p n) (fun y : kn p n => @Logic.eq (vect n) x (k2g n y)) *)
induction n as [|n IH]; simpl; Krm0.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (let (k, lf1) := let (v1, l3) := x in let (v2, l4) := y in @pair (Field.K (K p)) (kn p n) (addK (K p) v1 v2) (Kn.add p n l3 l4) in let (l2, l3) := M in @pair (vect n) (vect n) (scal n (oppK (K1 p) (v1 (K1 p))) (contra n lf1 l2)) (add n (scal n k l2) (contra n lf1 l3))) (let (l3, l5) := let (k, lf1) := x in let (l2, l3) := M in @pair (vect n) (vect n) (scal n (oppK (K1 p) (v1 (K1 p))) (contra n lf1 l2)) (add n (scal n k l2) (contra n lf1 l3)) in let (l4, l6) := let (k, lf1) := y in let (l2, l4) := M in @pair (vect n) (vect n) (scal n (oppK (K1 p) (v1 (K1 p))) (contra n lf1 l2)) (add n (scal n k l2) (contra n lf1 l4)) in @pair (vect n) (vect n) (add n l3 l4) (add n l5 l6)) *)
destruct x as [a x1]; destruct y as [b y1]; destruct M as [M1 M2].
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (scal n (oppK (K1 p) (v1 (K1 p))) (contra n (Kn.add p n x1 y1) M1)) (add n (scal n (addK (K p) a b) M1) (contra n (Kn.add p n x1 y1) M2))) (@pair (vect n) (vect n) (add n (scal n (oppK (K1 p) (v1 (K1 p))) (contra n x1 M1)) (scal n (oppK (K1 p) (v1 (K1 p))) (contra n y1 M1))) (add n (add n (scal n a M1) (contra n x1 M2)) (add n (scal n b M1) (contra n y1 M2)))) *)
Vfold n; Kfold n.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite !IH, scal_addEr, (scal_addEl (vn_eparams n)); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply f_equal2 with (f := @pair _ _); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite !addE_assoc; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply f_equal2 with (f := addE _); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite addE_swap; auto.
Qed.

Lemma contra_conj n lf b (x: vect n) : #< lf, x ^_ b ># = #< lf, x ># ^_ (negb b).
Proof.
(* Goal: @Logic.eq (Field.K (K1 p)) (const n (dconj n b x)) (if b then multK (K1 p) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (S n)) (const n x) else multK (K1 p) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) n) (const n x)) *)
generalize b; clear b.
(* Goal: forall (b : bool) (k : nat) (_ : b2Prop (hom n k x)), b2Prop (hom n k (dconj n b x)) *)
induction n as [| n IH]; simpl.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
  intros  [|]; try rewrite oppK0; auto.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (dual n (conj n false (genk n k))) (dual n (genk n (v0 (K1 p))))) (@pair (vect n) (vect n) (scal n k (all n)) (scal n k (genk n (v0 (K1 p))))) *)
destruct lf; intros b; destruct x; rewrite IH, IH; Vfold n.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite conj_add, conj_scal, conj_scal; auto.
Qed.

Lemma contra_hom n lf k M : hom n k.+1 M -> hom n k #<lf , M>#.
Proof.
(* Goal: forall _ : @In (vect n) v (base n k), or (@Logic.eq (vect n) (join n v (dual n v)) (all n)) (@Logic.eq (vect n) (join n v (dual n v)) (scalE (vn_eparams n) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (all n))) *)
generalize k; clear k.
(* Goal: @Logic.eq (vect n) (mcontra n (@cons (kn p n) a l) x) (mcontra n l (contra n a x)) *)
induction n as [| n IH]; simpl; intros [|k1]; simpl; auto.
(* Goal: forall _ : b2Prop (eqK (K1 p) M (v0 (K1 p))), b2Prop (eqK (K1 p) (v0 (K1 p)) (v0 (K1 p))) *)
(* Goal: forall _ : b2Prop (let (l2, l3) := M in andb (hom n O l2) (hom n (S O) l3)), b2Prop (let (l2, l3) := let (k, lf1) := lf in let (l2, l3) := M in @pair (vect n) (vect n) (scal n (oppK (K1 p) (v1 (K1 p))) (contra n lf1 l2)) (add n (scal n k l2) (contra n lf1 l3)) in andb (eq0 n l2) (hom n O l3)) *)
(* Goal: forall _ : b2Prop (let (l2, l3) := M in andb (hom n (S k1) l2) (hom n (S (S k1)) l3)), b2Prop (let (l2, l3) := let (k, lf1) := lf in let (l2, l3) := M in @pair (vect n) (vect n) (scal n (oppK (K1 p) (v1 (K1 p))) (contra n lf1 l2)) (add n (scal n k l2) (contra n lf1 l3)) in andb (hom n k1 l2) (hom n (S k1) l3)) *)
 rewrite eqKI; auto.
(* Goal: forall _ : b2Prop (let (l2, l3) := M in andb (hom n O l2) (hom n (S O) l3)), b2Prop (let (l2, l3) := let (k, lf1) := lf in let (l2, l3) := M in @pair (vect n) (vect n) (scal n (oppK (K1 p) (v1 (K1 p))) (contra n lf1 l2)) (add n (scal n k l2) (contra n lf1 l3)) in andb (eq0 n l2) (hom n O l3)) *)
(* Goal: forall _ : b2Prop (let (l2, l3) := M in andb (hom n (S k1) l2) (hom n (S (S k1)) l3)), b2Prop (let (l2, l3) := let (k, lf1) := lf in let (l2, l3) := M in @pair (vect n) (vect n) (scal n (oppK (K1 p) (v1 (K1 p))) (contra n lf1 l2)) (add n (scal n k l2) (contra n lf1 l3)) in andb (hom n k1 l2) (hom n (S k1) l3)) *)
intros H; destruct lf.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
destruct M as [M1 M2]; try rewrite eq0I; rewrite ?homk0; auto.
(* Goal: b2Prop (andb (eq0 n (scal n (oppK (K1 p) (v1 (K1 p))) (contra n k0 M1))) (hom n O (add n (scal n k M1) (contra n k0 M2)))) *)
(* Goal: forall _ : b2Prop (let (l2, l3) := M in andb (hom n (S k1) l2) (hom n (S (S k1)) l3)), b2Prop (let (l2, l3) := let (k, lf1) := lf in let (l2, l3) := M in @pair (vect n) (vect n) (scal n (oppK (K1 p) (v1 (K1 p))) (contra n lf1 l2)) (add n (scal n k l2) (contra n lf1 l3)) in andb (hom n k1 l2) (hom n (S k1) l3)) *)
assert (Hm1: hom n 0 M1); [generalize H; case hom; auto | idtac].
(* Goal: b2Prop (andb (eq0 n (scal n (oppK (K1 p) (v1 (K1 p))) (contra n k0 M1))) (hom n O (add n (scal n k M1) (contra n k0 M2)))) *)
(* Goal: forall _ : b2Prop (let (l2, l3) := M in andb (hom n (S k1) l2) (hom n (S (S k1)) l3)), b2Prop (let (l2, l3) := let (k, lf1) := lf in let (l2, l3) := M in @pair (vect n) (vect n) (scal n (oppK (K1 p) (v1 (K1 p))) (contra n lf1 l2)) (add n (scal n k l2) (contra n lf1 l3)) in andb (hom n k1 l2) (hom n (S k1) l3)) *)
assert (Hm2: hom n 1 M2); [generalize H; repeat (case hom; auto) | clear H].
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (dual n (conj n false (genk n k))) (dual n (genk n (v0 (K1 p))))) (@pair (vect n) (vect n) (scal n k (all n)) (scal n k (genk n (v0 (K1 p))))) *)
  rewrite (hom0E _ _ Hm1); Vfold n.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
  rewrite contrak, scalE0r, eq0I,  add_hom; auto; apply scal_hom; apply hom0K; auto.
(* Goal: forall _ : b2Prop (let (l2, l3) := M in andb (hom n (S k1) l2) (hom n (S (S k1)) l3)), b2Prop (let (l2, l3) := let (k, lf1) := lf in let (l2, l3) := M in @pair (vect n) (vect n) (scal n (oppK (K1 p) (v1 (K1 p))) (contra n lf1 l2)) (add n (scal n k l2) (contra n lf1 l3)) in andb (hom n k1 l2) (hom n (S k1) l3)) *)
destruct lf; destruct M as [M1 M2]; intros H.
(* Goal: b2Prop (andb (hom n k1 (scal n (oppK (K1 p) (v1 (K1 p))) (contra n k0 M1))) (hom n (S k1) (add n (scal n k M1) (contra n k0 M2)))) *)
assert (Hm1: hom n k1.+1 M1); [generalize H; case hom; auto | idtac].
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
assert (Hm2: hom n k1.+2 M2); [generalize H; repeat (case hom; auto) | clear H]; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
Vfold n; rewrite scal_hom, add_hom; auto.
Qed.

Hint Resolve contra_hom.

Lemma contra_hom0 n lf M : hom n 0 M -> #<lf , M># = 0.
Proof. intros H; rewrite (hom0E _ _ H); apply contrak. Qed.

Lemma contra_id n lf (M: vect n) : #<lf, #< lf, M>#  ># = 0.
Proof.
(* Goal: @Logic.eq (vect n) (dual n (addE (vn_eparams n) v1 v2)) (addE (vn_eparams n) (dual n v1) (dual n v2)) *)
induction n as [| n IH]; simpl; auto; Vfold n.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (let (k, lf1) := lf in let (l2, l3) := let (k0, lf2) := lf in let (l2, l3) := M in @pair (vect n) (vect n) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf2 l2)) (addE (vn_eparams n) (scalE (vn_eparams n) k0 l2) (contra n lf2 l3)) in @pair (vect n) (vect n) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf1 l2)) (addE (vn_eparams n) (scalE (vn_eparams n) k l2) (contra n lf1 l3))) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (E0 (vn_eparams n))) *)
destruct lf; destruct M.
rewrite !contra_addr, !contra_scalr, !IH, !scalE0r, addE0r,
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
        <-scal_addEr, addE_com, scal_addE0, scalE0r; auto.
Qed.

Lemma contra_swap n lf1 lf2 (M: vect n) :
  #<lf1, #< lf2, M>#  ># = (-(1)).*  #<lf2, #< lf1, M>#  >#.
Proof.
(* Goal: forall (k : nat) (_ : b2Prop (hom n k M)), @Logic.eq (vect n) (dconj n false M) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n k)) M) *)
induction n as [| n IH]; simpl; auto; try Vfold n.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite multK0r; auto.
destruct lf1 as [k1 lf1]; destruct lf2 as [k2  lf2]; destruct M.
rewrite !contra_scalr, !contra_addr, !(IH _ lf2), !contra_scalr,
        !scal_addEr, !scalE_opp, !opp_oppK, !scalE1,
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
        <-!scal_multE, <-!opp_multKl, !multK1l, addE_swap; auto.
Qed.

Fixpoint v2k (n : nat) : vect n -> kn n :=
  match n return vect n -> kn n  with
  | O => fun v : vect 0 => tt
  | S n1  => fun v => let (v1,v2) := v in
             ('C[v1], v2k n1 v2)
  end.

Lemma contra_const n lf M : hom n 1 M -> 
  #<lf, M># = [(lf [.] v2k n M)%Kn].
Proof.
(* Goal: forall _ : b2Prop (hom n (S O) x), @ex (kn p n) (fun y : kn p n => @Logic.eq (vect n) x (k2g n y)) *)
induction n as [| n IH]; simpl; Krm0.
(* Goal: forall _ : b2Prop (let (l2, l3) := M in andb (hom n O l2) (hom n (S O) l3)), @Logic.eq (prod (vect n) (vect n)) (let (k, lf1) := lf in let (l2, l3) := M in @pair (vect n) (vect n) (scal n (oppK (K1 p) (v1 (K1 p))) (contra n lf1 l2)) (add n (scal n k l2) (contra n lf1 l3))) (@pair (vect n) (vect n) (genk n (v0 (K1 p))) (genk n (let (a, l3) := lf in let (b, l4) := let (v1, v2) := M in @pair (Field.K (K1 p)) (kn p n) (const n v1) (v2k n v2) in addK (K p) (multK (K p) a b) (pscal p n l3 l4)))) *)
destruct lf; destruct M as [M1 M2]; intros HM12.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (scal n (oppK (K1 p) (v1 (K1 p))) (contra n k0 M1)) (add n (scal n k M1) (contra n k0 M2))) (@pair (vect n) (vect n) (genk n (v0 (K1 p))) (genk n (addK (K p) (multK (K p) k (const n M1)) (pscal p n k0 (v2k n M2))))) *)
assert (HM1: hom n 0 M1) by (generalize HM12; case hom; auto).
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (scal n (oppK (K1 p) (v1 (K1 p))) (contra n k0 M1)) (add n (scal n k M1) (contra n k0 M2))) (@pair (vect n) (vect n) (genk n (v0 (K1 p))) (genk n (addK (K p) (multK (K p) k (const n M1)) (pscal p n k0 (v2k n M2))))) *)
assert (HM2: hom n 1 M2) by (generalize HM12; rewrite HM1; case hom; auto).
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (dual n (conj n false (genk n k))) (dual n (genk n (v0 (K1 p))))) (@pair (vect n) (vect n) (scal n k (all n)) (scal n k (genk n (v0 (K1 p))))) *)
rewrite (hom0E _ _ HM1); Vfold n.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite contrak, scalE0r, IH; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply f_equal2 with (f := @pair _ _); auto.
(* Goal: @Logic.eq (vect n) (mcontra n (@cons (kn p n) a l) x) (mcontra n l (contra n a x)) *)
rewrite <-addk, <-joink, joinkl, <-!hom0E; simpl; auto.
Qed.

Lemma contra_join n lf k1 k2 M1 M2 : hom n k1 M1 -> hom n k2 M2 ->
  #<lf, M1 ∨ M2># = #<lf, M1># ∨ M2 + ((- (1))^k1).* M1 ∨ #<lf, M2>#.
Proof.
(* Goal: forall (_ : b2Prop (hom n k1 M1)) (_ : b2Prop (hom n k2 M2)), @Logic.eq (vect n) (contra n lf (join n M1 M2)) (addE (vn_eparams n) (join n (contra n lf M1) M2) (join n (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) k1) M1) (contra n lf M2))) *)
generalize lf k1 k2; clear lf k1 k2.
(* Goal: forall (k : nat) (_ : b2Prop (hom n k M)), @Logic.eq (vect n) (dconj n false M) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n k)) M) *)
induction n as [| n IH]; simpl; auto; try Vfold n.
(* Goal: forall (_ : unit) (k1 k2 : nat) (_ : b2Prop match k1 with | O => true | S n => eqK (K1 p) M1 (v0 (K1 p)) end) (_ : b2Prop match k2 with | O => true | S n => eqK (K1 p) M2 (v0 (K1 p)) end), @Logic.eq (Field.K (K1 p)) (v0 (K1 p)) (addK (K1 p) (multK (K1 p) (v0 (K1 p)) M2) (multK (K1 p) (multK (K1 p) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1) M1) (v0 (K1 p)))) *)
(* Goal: forall (lf : prod (Field.K (K p)) (kn p n)) (k1 k2 : nat) (_ : b2Prop (let (l2, l3) := M1 in andb match k1 with | O => eq0 n l2 | S k3 => hom n k3 l2 end (hom n k1 l3))) (_ : b2Prop (let (l2, l3) := M2 in andb match k2 with | O => eq0 n l2 | S k3 => hom n k3 l2 end (hom n k2 l3))), @Logic.eq (prod (vect n) (vect n)) (let (k, lf1) := lf in let (l2, l3) := let (x1, x2) := M1 in let (y1, y2) := M2 in @pair (vect n) (vect n) (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) (join n x2 y2) in @pair (vect n) (vect n) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf1 l2)) (addE (vn_eparams n) (scalE (vn_eparams n) k l2) (contra n lf1 l3))) (let (l3, l5) := let (x1, x2) := let (k, lf1) := lf in let (l2, l3) := M1 in @pair (vect n) (vect n) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf1 l2)) (addE (vn_eparams n) (scalE (vn_eparams n) k l2) (contra n lf1 l3)) in let (y1, y2) := M2 in @pair (vect n) (vect n) (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) (join n x2 y2) in let (l4, l6) := let (x1, x2) := let (l2, l4) := M1 in @pair (vect n) (vect n) (scalE (vn_eparams n) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1) l2) (scalE (vn_eparams n) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1) l4) in let (y1, y2) := let (k, lf1) := lf in let (l2, l4) := M2 in @pair (vect n) (vect n) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf1 l2)) (addE (vn_eparams n) (scalE (vn_eparams n) k l2) (contra n lf1 l4)) in @pair (vect n) (vect n) (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) (join n x2 y2) in @pair (vect n) (vect n) (addE (vn_eparams n) l3 l4) (addE (vn_eparams n) l5 l6)) *)
intros lf [| k1] [| k2]; Grm0.
intros [k lf] [| k1] [| k2]; destruct M2 as [M3 M4]; destruct M1 as [M1 M2]; 
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n (E0 (vn_eparams n)) y2) (join n (genk n (const n x2)) (genk n (const n y1)))) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n (E0 (vn_eparams n)) y2) (join n (genk n (const n x2)) (genk n (const n y1)))) z2) (addE (vn_eparams n) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n (S (Nat.add O k2)))) (meet n (genk n (const n x2)) (join n y2 (dconj n false z1)))) (join n (meet n (genk n (const n x2)) (dconj n false z1)) y2)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add O (S k2)))))) (meet n (E0 (vn_eparams n)) (addE (vn_eparams n) (join n (genk n (const n y1)) z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n (E0 (vn_eparams n)) z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) z2) (meet n (genk n (const n x2)) (dconj n false z1)))) (genk n (const n y1))))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add O (S k2)))))) (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) (join n y2 z2)) (meet n (genk n (const n x2)) (dconj n false (addE (vn_eparams n) (join n (genk n (const n y1)) z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) z2) (meet n (genk n (const n x2)) (dconj n false z1))) y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (eq0 n z1) (hom n O z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (hom n k2 z1) (hom n (S k2) z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
  simpl expK; Grm0.
(* Goal: forall (_ : b2Prop (andb (eq0 n M1) (hom n O M2))) (_ : b2Prop (andb (hom n k2 M3) (hom n (S k2) M4))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf (addE (vn_eparams n) (join n M1 M4) (join n (conj n false M2) M3)))) (addE (vn_eparams n) (scalE (vn_eparams n) k (addE (vn_eparams n) (join n M1 M4) (join n (conj n false M2) M3))) (contra n lf (join n M2 M4)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (addE (vn_eparams n) (join n (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf M1)) M4) (join n (conj n false (addE (vn_eparams n) (scalE (vn_eparams n) k M1) (contra n lf M2))) M3)) (addE (vn_eparams n) (join n (scalE (vn_eparams n) (v1 (K1 p)) M1) (addE (vn_eparams n) (scalE (vn_eparams n) k M3) (contra n lf M4))) (join n (conj n false (scalE (vn_eparams n) (v1 (K1 p)) M2)) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf M3))))) (addE (vn_eparams n) (join n (addE (vn_eparams n) (scalE (vn_eparams n) k M1) (contra n lf M2)) M4) (join n (scalE (vn_eparams n) (v1 (K1 p)) M2) (addE (vn_eparams n) (scalE (vn_eparams n) k M3) (contra n lf M4))))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 M1) (hom n (S k1) M2))) (_ : b2Prop (andb (eq0 n M3) (hom n O M4))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf (addE (vn_eparams n) (join n M1 M4) (join n (conj n false M2) M3)))) (addE (vn_eparams n) (scalE (vn_eparams n) k (addE (vn_eparams n) (join n M1 M4) (join n (conj n false M2) M3))) (contra n lf (join n M2 M4)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (addE (vn_eparams n) (join n (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf M1)) M4) (join n (conj n false (addE (vn_eparams n) (scalE (vn_eparams n) k M1) (contra n lf M2))) M3)) (addE (vn_eparams n) (join n (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) M1) (addE (vn_eparams n) (scalE (vn_eparams n) k M3) (contra n lf M4))) (join n (conj n false (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) M2)) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf M3))))) (addE (vn_eparams n) (join n (addE (vn_eparams n) (scalE (vn_eparams n) k M1) (contra n lf M2)) M4) (join n (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) M2) (addE (vn_eparams n) (scalE (vn_eparams n) k M3) (contra n lf M4))))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 M1) (hom n (S k1) M2))) (_ : b2Prop (andb (hom n k2 M3) (hom n (S k2) M4))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf (addE (vn_eparams n) (join n M1 M4) (join n (conj n false M2) M3)))) (addE (vn_eparams n) (scalE (vn_eparams n) k (addE (vn_eparams n) (join n M1 M4) (join n (conj n false M2) M3))) (contra n lf (join n M2 M4)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (addE (vn_eparams n) (join n (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf M1)) M4) (join n (conj n false (addE (vn_eparams n) (scalE (vn_eparams n) k M1) (contra n lf M2))) M3)) (addE (vn_eparams n) (join n (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) M1) (addE (vn_eparams n) (scalE (vn_eparams n) k M3) (contra n lf M4))) (join n (conj n false (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) M2)) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf M3))))) (addE (vn_eparams n) (join n (addE (vn_eparams n) (scalE (vn_eparams n) k M1) (contra n lf M2)) M4) (join n (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) M2) (addE (vn_eparams n) (scalE (vn_eparams n) k M3) (contra n lf M4))))) *)
case eq0_spec; try (intros; discriminate); intros HH HM2; subst; Grm0.
(* Goal: forall _ : b2Prop (andb (eq0 n M3) (hom n O M4)), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf (join n (conj n false M2) M3))) (addE (vn_eparams n) (scalE (vn_eparams n) k (join n (conj n false M2) M3)) (contra n lf (join n M2 M4)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (join n (conj n false (contra n lf M2)) M3) (join n (conj n false (scalE (vn_eparams n) (v1 (K1 p)) M2)) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf M3)))) (addE (vn_eparams n) (join n (contra n lf M2) M4) (join n (scalE (vn_eparams n) (v1 (K1 p)) M2) (addE (vn_eparams n) (scalE (vn_eparams n) k M3) (contra n lf M4))))) *)
(* Goal: forall (_ : b2Prop (andb (eq0 n M1) (hom n O M2))) (_ : b2Prop (andb (hom n k2 M3) (hom n (S k2) M4))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf (addE (vn_eparams n) (join n M1 M4) (join n (conj n false M2) M3)))) (addE (vn_eparams n) (scalE (vn_eparams n) k (addE (vn_eparams n) (join n M1 M4) (join n (conj n false M2) M3))) (contra n lf (join n M2 M4)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (addE (vn_eparams n) (join n (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf M1)) M4) (join n (conj n false (addE (vn_eparams n) (scalE (vn_eparams n) k M1) (contra n lf M2))) M3)) (addE (vn_eparams n) (join n (scalE (vn_eparams n) (v1 (K1 p)) M1) (addE (vn_eparams n) (scalE (vn_eparams n) k M3) (contra n lf M4))) (join n (conj n false (scalE (vn_eparams n) (v1 (K1 p)) M2)) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf M3))))) (addE (vn_eparams n) (join n (addE (vn_eparams n) (scalE (vn_eparams n) k M1) (contra n lf M2)) M4) (join n (scalE (vn_eparams n) (v1 (K1 p)) M2) (addE (vn_eparams n) (scalE (vn_eparams n) k M3) (contra n lf M4))))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 M1) (hom n (S k1) M2))) (_ : b2Prop (andb (eq0 n M3) (hom n O M4))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf (addE (vn_eparams n) (join n M1 M4) (join n (conj n false M2) M3)))) (addE (vn_eparams n) (scalE (vn_eparams n) k (addE (vn_eparams n) (join n M1 M4) (join n (conj n false M2) M3))) (contra n lf (join n M2 M4)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (addE (vn_eparams n) (join n (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf M1)) M4) (join n (conj n false (addE (vn_eparams n) (scalE (vn_eparams n) k M1) (contra n lf M2))) M3)) (addE (vn_eparams n) (join n (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) M1) (addE (vn_eparams n) (scalE (vn_eparams n) k M3) (contra n lf M4))) (join n (conj n false (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) M2)) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf M3))))) (addE (vn_eparams n) (join n (addE (vn_eparams n) (scalE (vn_eparams n) k M1) (contra n lf M2)) M4) (join n (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) M2) (addE (vn_eparams n) (scalE (vn_eparams n) k M3) (contra n lf M4))))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 M1) (hom n (S k1) M2))) (_ : b2Prop (andb (hom n k2 M3) (hom n (S k2) M4))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf (addE (vn_eparams n) (join n M1 M4) (join n (conj n false M2) M3)))) (addE (vn_eparams n) (scalE (vn_eparams n) k (addE (vn_eparams n) (join n M1 M4) (join n (conj n false M2) M3))) (contra n lf (join n M2 M4)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (addE (vn_eparams n) (join n (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf M1)) M4) (join n (conj n false (addE (vn_eparams n) (scalE (vn_eparams n) k M1) (contra n lf M2))) M3)) (addE (vn_eparams n) (join n (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) M1) (addE (vn_eparams n) (scalE (vn_eparams n) k M3) (contra n lf M4))) (join n (conj n false (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) M2)) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf M3))))) (addE (vn_eparams n) (join n (addE (vn_eparams n) (scalE (vn_eparams n) k M1) (contra n lf M2)) M4) (join n (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) M2) (addE (vn_eparams n) (scalE (vn_eparams n) k M3) (contra n lf M4))))) *)
case eq0_spec; try (intros; discriminate); intros HH HM3; subst; Grm0.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (contra n lf (join n M2 M4))) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (addE (vn_eparams n) (join n (contra n lf M2) M4) (join n (scalE (vn_eparams n) (v1 (K1 p)) M2) (contra n lf M4)))) *)
(* Goal: forall (_ : b2Prop (andb (eq0 n M1) (hom n O M2))) (_ : b2Prop (andb (hom n k2 M3) (hom n (S k2) M4))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf (addE (vn_eparams n) (join n M1 M4) (join n (conj n false M2) M3)))) (addE (vn_eparams n) (scalE (vn_eparams n) k (addE (vn_eparams n) (join n M1 M4) (join n (conj n false M2) M3))) (contra n lf (join n M2 M4)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (addE (vn_eparams n) (join n (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf M1)) M4) (join n (conj n false (addE (vn_eparams n) (scalE (vn_eparams n) k M1) (contra n lf M2))) M3)) (addE (vn_eparams n) (join n (scalE (vn_eparams n) (v1 (K1 p)) M1) (addE (vn_eparams n) (scalE (vn_eparams n) k M3) (contra n lf M4))) (join n (conj n false (scalE (vn_eparams n) (v1 (K1 p)) M2)) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf M3))))) (addE (vn_eparams n) (join n (addE (vn_eparams n) (scalE (vn_eparams n) k M1) (contra n lf M2)) M4) (join n (scalE (vn_eparams n) (v1 (K1 p)) M2) (addE (vn_eparams n) (scalE (vn_eparams n) k M3) (contra n lf M4))))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 M1) (hom n (S k1) M2))) (_ : b2Prop (andb (eq0 n M3) (hom n O M4))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf (addE (vn_eparams n) (join n M1 M4) (join n (conj n false M2) M3)))) (addE (vn_eparams n) (scalE (vn_eparams n) k (addE (vn_eparams n) (join n M1 M4) (join n (conj n false M2) M3))) (contra n lf (join n M2 M4)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (addE (vn_eparams n) (join n (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf M1)) M4) (join n (conj n false (addE (vn_eparams n) (scalE (vn_eparams n) k M1) (contra n lf M2))) M3)) (addE (vn_eparams n) (join n (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) M1) (addE (vn_eparams n) (scalE (vn_eparams n) k M3) (contra n lf M4))) (join n (conj n false (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) M2)) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf M3))))) (addE (vn_eparams n) (join n (addE (vn_eparams n) (scalE (vn_eparams n) k M1) (contra n lf M2)) M4) (join n (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) M2) (addE (vn_eparams n) (scalE (vn_eparams n) k M3) (contra n lf M4))))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 M1) (hom n (S k1) M2))) (_ : b2Prop (andb (hom n k2 M3) (hom n (S k2) M4))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf (addE (vn_eparams n) (join n M1 M4) (join n (conj n false M2) M3)))) (addE (vn_eparams n) (scalE (vn_eparams n) k (addE (vn_eparams n) (join n M1 M4) (join n (conj n false M2) M3))) (contra n lf (join n M2 M4)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (addE (vn_eparams n) (join n (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf M1)) M4) (join n (conj n false (addE (vn_eparams n) (scalE (vn_eparams n) k M1) (contra n lf M2))) M3)) (addE (vn_eparams n) (join n (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) M1) (addE (vn_eparams n) (scalE (vn_eparams n) k M3) (contra n lf M4))) (join n (conj n false (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) M2)) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf M3))))) (addE (vn_eparams n) (join n (addE (vn_eparams n) (scalE (vn_eparams n) k M1) (contra n lf M2)) M4) (join n (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) M2) (addE (vn_eparams n) (scalE (vn_eparams n) k M3) (contra n lf M4))))) *)
assert (Hk24 := join_hom _ _ _ _ _ HM2 HM3).
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (contra n lf (join n M2 M4))) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (addE (vn_eparams n) (join n (contra n lf M2) M4) (join n (scalE (vn_eparams n) (v1 (K1 p)) M2) (contra n lf M4)))) *)
(* Goal: forall (_ : b2Prop (andb (eq0 n M1) (hom n O M2))) (_ : b2Prop (andb (hom n k2 M3) (hom n (S k2) M4))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf (addE (vn_eparams n) (join n M1 M4) (join n (conj n false M2) M3)))) (addE (vn_eparams n) (scalE (vn_eparams n) k (addE (vn_eparams n) (join n M1 M4) (join n (conj n false M2) M3))) (contra n lf (join n M2 M4)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (addE (vn_eparams n) (join n (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf M1)) M4) (join n (conj n false (addE (vn_eparams n) (scalE (vn_eparams n) k M1) (contra n lf M2))) M3)) (addE (vn_eparams n) (join n (scalE (vn_eparams n) (v1 (K1 p)) M1) (addE (vn_eparams n) (scalE (vn_eparams n) k M3) (contra n lf M4))) (join n (conj n false (scalE (vn_eparams n) (v1 (K1 p)) M2)) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf M3))))) (addE (vn_eparams n) (join n (addE (vn_eparams n) (scalE (vn_eparams n) k M1) (contra n lf M2)) M4) (join n (scalE (vn_eparams n) (v1 (K1 p)) M2) (addE (vn_eparams n) (scalE (vn_eparams n) k M3) (contra n lf M4))))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 M1) (hom n (S k1) M2))) (_ : b2Prop (andb (eq0 n M3) (hom n O M4))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf (addE (vn_eparams n) (join n M1 M4) (join n (conj n false M2) M3)))) (addE (vn_eparams n) (scalE (vn_eparams n) k (addE (vn_eparams n) (join n M1 M4) (join n (conj n false M2) M3))) (contra n lf (join n M2 M4)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (addE (vn_eparams n) (join n (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf M1)) M4) (join n (conj n false (addE (vn_eparams n) (scalE (vn_eparams n) k M1) (contra n lf M2))) M3)) (addE (vn_eparams n) (join n (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) M1) (addE (vn_eparams n) (scalE (vn_eparams n) k M3) (contra n lf M4))) (join n (conj n false (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) M2)) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf M3))))) (addE (vn_eparams n) (join n (addE (vn_eparams n) (scalE (vn_eparams n) k M1) (contra n lf M2)) M4) (join n (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) M2) (addE (vn_eparams n) (scalE (vn_eparams n) k M3) (contra n lf M4))))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 M1) (hom n (S k1) M2))) (_ : b2Prop (andb (hom n k2 M3) (hom n (S k2) M4))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf (addE (vn_eparams n) (join n M1 M4) (join n (conj n false M2) M3)))) (addE (vn_eparams n) (scalE (vn_eparams n) k (addE (vn_eparams n) (join n M1 M4) (join n (conj n false M2) M3))) (contra n lf (join n M2 M4)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (addE (vn_eparams n) (join n (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf M1)) M4) (join n (conj n false (addE (vn_eparams n) (scalE (vn_eparams n) k M1) (contra n lf M2))) M3)) (addE (vn_eparams n) (join n (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) M1) (addE (vn_eparams n) (scalE (vn_eparams n) k M3) (contra n lf M4))) (join n (conj n false (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) M2)) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf M3))))) (addE (vn_eparams n) (join n (addE (vn_eparams n) (scalE (vn_eparams n) k M1) (contra n lf M2)) M4) (join n (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) M2) (addE (vn_eparams n) (scalE (vn_eparams n) k M3) (contra n lf M4))))) *)
rewrite (hom0E _ _ Hk24), (hom0E _ _ HM2), (hom0E _ _ HM3), !contrak; Grm0.
(* Goal: forall (_ : b2Prop (andb (eq0 n M1) (hom n O M2))) (_ : b2Prop (andb (hom n k2 M3) (hom n (S k2) M4))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf (addE (vn_eparams n) (join n M1 M4) (join n (conj n false M2) M3)))) (addE (vn_eparams n) (scalE (vn_eparams n) k (addE (vn_eparams n) (join n M1 M4) (join n (conj n false M2) M3))) (contra n lf (join n M2 M4)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (addE (vn_eparams n) (join n (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf M1)) M4) (join n (conj n false (addE (vn_eparams n) (scalE (vn_eparams n) k M1) (contra n lf M2))) M3)) (addE (vn_eparams n) (join n (scalE (vn_eparams n) (v1 (K1 p)) M1) (addE (vn_eparams n) (scalE (vn_eparams n) k M3) (contra n lf M4))) (join n (conj n false (scalE (vn_eparams n) (v1 (K1 p)) M2)) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf M3))))) (addE (vn_eparams n) (join n (addE (vn_eparams n) (scalE (vn_eparams n) k M1) (contra n lf M2)) M4) (join n (scalE (vn_eparams n) (v1 (K1 p)) M2) (addE (vn_eparams n) (scalE (vn_eparams n) k M3) (contra n lf M4))))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 M1) (hom n (S k1) M2))) (_ : b2Prop (andb (eq0 n M3) (hom n O M4))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf (addE (vn_eparams n) (join n M1 M4) (join n (conj n false M2) M3)))) (addE (vn_eparams n) (scalE (vn_eparams n) k (addE (vn_eparams n) (join n M1 M4) (join n (conj n false M2) M3))) (contra n lf (join n M2 M4)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (addE (vn_eparams n) (join n (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf M1)) M4) (join n (conj n false (addE (vn_eparams n) (scalE (vn_eparams n) k M1) (contra n lf M2))) M3)) (addE (vn_eparams n) (join n (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) M1) (addE (vn_eparams n) (scalE (vn_eparams n) k M3) (contra n lf M4))) (join n (conj n false (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) M2)) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf M3))))) (addE (vn_eparams n) (join n (addE (vn_eparams n) (scalE (vn_eparams n) k M1) (contra n lf M2)) M4) (join n (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) M2) (addE (vn_eparams n) (scalE (vn_eparams n) k M3) (contra n lf M4))))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 M1) (hom n (S k1) M2))) (_ : b2Prop (andb (hom n k2 M3) (hom n (S k2) M4))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf (addE (vn_eparams n) (join n M1 M4) (join n (conj n false M2) M3)))) (addE (vn_eparams n) (scalE (vn_eparams n) k (addE (vn_eparams n) (join n M1 M4) (join n (conj n false M2) M3))) (contra n lf (join n M2 M4)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (addE (vn_eparams n) (join n (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf M1)) M4) (join n (conj n false (addE (vn_eparams n) (scalE (vn_eparams n) k M1) (contra n lf M2))) M3)) (addE (vn_eparams n) (join n (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) M1) (addE (vn_eparams n) (scalE (vn_eparams n) k M3) (contra n lf M4))) (join n (conj n false (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) M2)) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf M3))))) (addE (vn_eparams n) (join n (addE (vn_eparams n) (scalE (vn_eparams n) k M1) (contra n lf M2)) M4) (join n (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) M2) (addE (vn_eparams n) (scalE (vn_eparams n) k M3) (contra n lf M4))))) *)
case eq0_spec; try (intros; discriminate); intros HH HM2; subst; Grm0.
(* Goal: forall _ : b2Prop (andb (hom n k2 M3) (hom n (S k2) M4)), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf (join n (conj n false M2) M3))) (addE (vn_eparams n) (scalE (vn_eparams n) k (join n (conj n false M2) M3)) (contra n lf (join n M2 M4)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (join n (conj n false (contra n lf M2)) M3) (join n (conj n false (scalE (vn_eparams n) (v1 (K1 p)) M2)) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf M3)))) (addE (vn_eparams n) (join n (contra n lf M2) M4) (join n (scalE (vn_eparams n) (v1 (K1 p)) M2) (addE (vn_eparams n) (scalE (vn_eparams n) k M3) (contra n lf M4))))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 M1) (hom n (S k1) M2))) (_ : b2Prop (andb (eq0 n M3) (hom n O M4))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf (addE (vn_eparams n) (join n M1 M4) (join n (conj n false M2) M3)))) (addE (vn_eparams n) (scalE (vn_eparams n) k (addE (vn_eparams n) (join n M1 M4) (join n (conj n false M2) M3))) (contra n lf (join n M2 M4)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (addE (vn_eparams n) (join n (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf M1)) M4) (join n (conj n false (addE (vn_eparams n) (scalE (vn_eparams n) k M1) (contra n lf M2))) M3)) (addE (vn_eparams n) (join n (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) M1) (addE (vn_eparams n) (scalE (vn_eparams n) k M3) (contra n lf M4))) (join n (conj n false (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) M2)) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf M3))))) (addE (vn_eparams n) (join n (addE (vn_eparams n) (scalE (vn_eparams n) k M1) (contra n lf M2)) M4) (join n (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) M2) (addE (vn_eparams n) (scalE (vn_eparams n) k M3) (contra n lf M4))))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 M1) (hom n (S k1) M2))) (_ : b2Prop (andb (hom n k2 M3) (hom n (S k2) M4))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf (addE (vn_eparams n) (join n M1 M4) (join n (conj n false M2) M3)))) (addE (vn_eparams n) (scalE (vn_eparams n) k (addE (vn_eparams n) (join n M1 M4) (join n (conj n false M2) M3))) (contra n lf (join n M2 M4)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (addE (vn_eparams n) (join n (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf M1)) M4) (join n (conj n false (addE (vn_eparams n) (scalE (vn_eparams n) k M1) (contra n lf M2))) M3)) (addE (vn_eparams n) (join n (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) M1) (addE (vn_eparams n) (scalE (vn_eparams n) k M3) (contra n lf M4))) (join n (conj n false (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) M2)) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf M3))))) (addE (vn_eparams n) (join n (addE (vn_eparams n) (scalE (vn_eparams n) k M1) (contra n lf M2)) M4) (join n (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) M2) (addE (vn_eparams n) (scalE (vn_eparams n) k M3) (contra n lf M4))))) *)
rewrite (hom0E _ _ HM2).
repeat ((rewrite conjk || rewrite scalE1 || rewrite joinkl ||
         rewrite contra_scalr || rewrite contrak); Grm0).
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (scalE (vn_eparams n) (const n M4) (contra n lf M1))) (addE (vn_eparams n) (scalE (vn_eparams n) k (scalE (vn_eparams n) (const n M4) M1)) (scalE (vn_eparams n) (const n M4) (contra n lf M2)))) (@pair (vect n) (vect n) (scalE (vn_eparams n) (const n M4) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf M1))) (scalE (vn_eparams n) (const n M4) (addE (vn_eparams n) (scalE (vn_eparams n) k M1) (contra n lf M2)))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 M1) (hom n (S k1) M2))) (_ : b2Prop (andb (hom n k2 M3) (hom n (S k2) M4))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf (addE (vn_eparams n) (join n M1 M4) (join n (conj n false M2) M3)))) (addE (vn_eparams n) (scalE (vn_eparams n) k (addE (vn_eparams n) (join n M1 M4) (join n (conj n false M2) M3))) (contra n lf (join n M2 M4)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (addE (vn_eparams n) (join n (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf M1)) M4) (join n (conj n false (addE (vn_eparams n) (scalE (vn_eparams n) k M1) (contra n lf M2))) M3)) (addE (vn_eparams n) (join n (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) M1) (addE (vn_eparams n) (scalE (vn_eparams n) k M3) (contra n lf M4))) (join n (conj n false (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) M2)) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf M3))))) (addE (vn_eparams n) (join n (addE (vn_eparams n) (scalE (vn_eparams n) k M1) (contra n lf M2)) M4) (join n (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) M2) (addE (vn_eparams n) (scalE (vn_eparams n) k M3) (contra n lf M4))))) *)
repeat ((rewrite scal_addEr || rewrite <- scal_multE); auto).
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite multK_com, (multK_com _ Hp k); auto.
(* Goal: forall _ : @Logic.eq (E (vn_eparams n)) v (joinl n (decomposek n (first_deg n v) v)), decomposable n (decomposek n (first_deg n v) v) v *)
(* Goal: forall _ : not (@Logic.eq (E (vn_eparams n)) v (joinl n (decomposek n (first_deg n v) v))), not (is_decomposable n v) *)
(* Goal: not (is_decomposable n v) *)
intros HH.
(* Goal: forall _ : b2Prop (andb (eq0 n M3) (hom n O M4)), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf (addE (vn_eparams n) (join n M1 M4) (join n (conj n false M2) M3)))) (addE (vn_eparams n) (scalE (vn_eparams n) k (addE (vn_eparams n) (join n M1 M4) (join n (conj n false M2) M3))) (contra n lf (join n M2 M4)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (addE (vn_eparams n) (join n (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf M1)) M4) (join n (conj n false (addE (vn_eparams n) (scalE (vn_eparams n) k M1) (contra n lf M2))) M3)) (addE (vn_eparams n) (join n (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) M1) (addE (vn_eparams n) (scalE (vn_eparams n) k M3) (contra n lf M4))) (join n (conj n false (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) M2)) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf M3))))) (addE (vn_eparams n) (join n (addE (vn_eparams n) (scalE (vn_eparams n) k M1) (contra n lf M2)) M4) (join n (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) M2) (addE (vn_eparams n) (scalE (vn_eparams n) k M3) (contra n lf M4))))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 M1) (hom n (S k1) M2))) (_ : b2Prop (andb (hom n k2 M3) (hom n (S k2) M4))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf (addE (vn_eparams n) (join n M1 M4) (join n (conj n false M2) M3)))) (addE (vn_eparams n) (scalE (vn_eparams n) k (addE (vn_eparams n) (join n M1 M4) (join n (conj n false M2) M3))) (contra n lf (join n M2 M4)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (addE (vn_eparams n) (join n (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf M1)) M4) (join n (conj n false (addE (vn_eparams n) (scalE (vn_eparams n) k M1) (contra n lf M2))) M3)) (addE (vn_eparams n) (join n (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) M1) (addE (vn_eparams n) (scalE (vn_eparams n) k M3) (contra n lf M4))) (join n (conj n false (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) M2)) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf M3))))) (addE (vn_eparams n) (join n (addE (vn_eparams n) (scalE (vn_eparams n) k M1) (contra n lf M2)) M4) (join n (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) M2) (addE (vn_eparams n) (scalE (vn_eparams n) k M3) (contra n lf M4))))) *)
case eq0_spec; try (intros; discriminate); intros HH1 HM3; subst; Grm0.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf (join n M1 M4))) (addE (vn_eparams n) (scalE (vn_eparams n) k (join n M1 M4)) (contra n lf (join n M2 M4)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (join n (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf M1)) M4) (join n (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) M1) (contra n lf M4))) (addE (vn_eparams n) (join n (addE (vn_eparams n) (scalE (vn_eparams n) k M1) (contra n lf M2)) M4) (join n (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) M2) (contra n lf M4)))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 M1) (hom n (S k1) M2))) (_ : b2Prop (andb (hom n k2 M3) (hom n (S k2) M4))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf (addE (vn_eparams n) (join n M1 M4) (join n (conj n false M2) M3)))) (addE (vn_eparams n) (scalE (vn_eparams n) k (addE (vn_eparams n) (join n M1 M4) (join n (conj n false M2) M3))) (contra n lf (join n M2 M4)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (addE (vn_eparams n) (join n (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf M1)) M4) (join n (conj n false (addE (vn_eparams n) (scalE (vn_eparams n) k M1) (contra n lf M2))) M3)) (addE (vn_eparams n) (join n (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) M1) (addE (vn_eparams n) (scalE (vn_eparams n) k M3) (contra n lf M4))) (join n (conj n false (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) M2)) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf M3))))) (addE (vn_eparams n) (join n (addE (vn_eparams n) (scalE (vn_eparams n) k M1) (contra n lf M2)) M4) (join n (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) M2) (addE (vn_eparams n) (scalE (vn_eparams n) k M3) (contra n lf M4))))) *)
rewrite (hom0E _ _ HM3).
repeat ((rewrite conjk || rewrite scalE1 || rewrite joinkl ||
         rewrite joinkr ||rewrite contra_scalr || rewrite contrak); Grm0).
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (scalE (vn_eparams n) (const n M4) (contra n lf M1))) (addE (vn_eparams n) (scalE (vn_eparams n) k (scalE (vn_eparams n) (const n M4) M1)) (scalE (vn_eparams n) (const n M4) (contra n lf M2)))) (@pair (vect n) (vect n) (scalE (vn_eparams n) (const n M4) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf M1))) (scalE (vn_eparams n) (const n M4) (addE (vn_eparams n) (scalE (vn_eparams n) k M1) (contra n lf M2)))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 M1) (hom n (S k1) M2))) (_ : b2Prop (andb (hom n k2 M3) (hom n (S k2) M4))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf (addE (vn_eparams n) (join n M1 M4) (join n (conj n false M2) M3)))) (addE (vn_eparams n) (scalE (vn_eparams n) k (addE (vn_eparams n) (join n M1 M4) (join n (conj n false M2) M3))) (contra n lf (join n M2 M4)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (addE (vn_eparams n) (join n (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf M1)) M4) (join n (conj n false (addE (vn_eparams n) (scalE (vn_eparams n) k M1) (contra n lf M2))) M3)) (addE (vn_eparams n) (join n (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) M1) (addE (vn_eparams n) (scalE (vn_eparams n) k M3) (contra n lf M4))) (join n (conj n false (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) M2)) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf M3))))) (addE (vn_eparams n) (join n (addE (vn_eparams n) (scalE (vn_eparams n) k M1) (contra n lf M2)) M4) (join n (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) M2) (addE (vn_eparams n) (scalE (vn_eparams n) k M3) (contra n lf M4))))) *)
repeat ((rewrite scal_addEr || rewrite <- scal_multE); auto).
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite multK_com, (multK_com _ Hp k); auto.
(* Goal: forall (_ : b2Prop (andb (hom n k1 M1) (hom n (S k1) M2))) (_ : b2Prop (andb (hom n k2 M3) (hom n (S k2) M4))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf (addE (vn_eparams n) (join n M1 M4) (join n (conj n false M2) M3)))) (addE (vn_eparams n) (scalE (vn_eparams n) k (addE (vn_eparams n) (join n M1 M4) (join n (conj n false M2) M3))) (contra n lf (join n M2 M4)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (addE (vn_eparams n) (join n (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf M1)) M4) (join n (conj n false (addE (vn_eparams n) (scalE (vn_eparams n) k M1) (contra n lf M2))) M3)) (addE (vn_eparams n) (join n (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) M1) (addE (vn_eparams n) (scalE (vn_eparams n) k M3) (contra n lf M4))) (join n (conj n false (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) M2)) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf M3))))) (addE (vn_eparams n) (join n (addE (vn_eparams n) (scalE (vn_eparams n) k M1) (contra n lf M2)) M4) (join n (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) M2) (addE (vn_eparams n) (scalE (vn_eparams n) k M3) (contra n lf M4))))) *)
intros HM1 HM2.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf (addE (vn_eparams n) (join n M1 M4) (join n (conj n false M2) M3)))) (addE (vn_eparams n) (scalE (vn_eparams n) k (addE (vn_eparams n) (join n M1 M4) (join n (conj n false M2) M3))) (contra n lf (join n M2 M4)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (addE (vn_eparams n) (join n (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf M1)) M4) (join n (conj n false (addE (vn_eparams n) (scalE (vn_eparams n) k M1) (contra n lf M2))) M3)) (addE (vn_eparams n) (join n (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) M1) (addE (vn_eparams n) (scalE (vn_eparams n) k M3) (contra n lf M4))) (join n (conj n false (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) M2)) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf M3))))) (addE (vn_eparams n) (join n (addE (vn_eparams n) (scalE (vn_eparams n) k M1) (contra n lf M2)) M4) (join n (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) M2) (addE (vn_eparams n) (scalE (vn_eparams n) k M3) (contra n lf M4))))) *)
assert (F1: hom n k1 M1) by (generalize HM1; case hom; auto).
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf (addE (vn_eparams n) (join n M1 M4) (join n (conj n false M2) M3)))) (addE (vn_eparams n) (scalE (vn_eparams n) k (addE (vn_eparams n) (join n M1 M4) (join n (conj n false M2) M3))) (contra n lf (join n M2 M4)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (addE (vn_eparams n) (join n (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf M1)) M4) (join n (conj n false (addE (vn_eparams n) (scalE (vn_eparams n) k M1) (contra n lf M2))) M3)) (addE (vn_eparams n) (join n (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) M1) (addE (vn_eparams n) (scalE (vn_eparams n) k M3) (contra n lf M4))) (join n (conj n false (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) M2)) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf M3))))) (addE (vn_eparams n) (join n (addE (vn_eparams n) (scalE (vn_eparams n) k M1) (contra n lf M2)) M4) (join n (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) M2) (addE (vn_eparams n) (scalE (vn_eparams n) k M3) (contra n lf M4))))) *)
assert (F2: hom n k1.+1 M2) by (generalize HM1; case hom; auto; intros; discriminate).
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf (addE (vn_eparams n) (join n M1 M4) (join n (conj n false M2) M3)))) (addE (vn_eparams n) (scalE (vn_eparams n) k (addE (vn_eparams n) (join n M1 M4) (join n (conj n false M2) M3))) (contra n lf (join n M2 M4)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (addE (vn_eparams n) (join n (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf M1)) M4) (join n (conj n false (addE (vn_eparams n) (scalE (vn_eparams n) k M1) (contra n lf M2))) M3)) (addE (vn_eparams n) (join n (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) M1) (addE (vn_eparams n) (scalE (vn_eparams n) k M3) (contra n lf M4))) (join n (conj n false (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) M2)) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf M3))))) (addE (vn_eparams n) (join n (addE (vn_eparams n) (scalE (vn_eparams n) k M1) (contra n lf M2)) M4) (join n (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) M2) (addE (vn_eparams n) (scalE (vn_eparams n) k M3) (contra n lf M4))))) *)
assert (F3: hom n k2 M3) by (generalize HM2; case hom; auto).
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf (addE (vn_eparams n) (join n M1 M4) (join n (conj n false M2) M3)))) (addE (vn_eparams n) (scalE (vn_eparams n) k (addE (vn_eparams n) (join n M1 M4) (join n (conj n false M2) M3))) (contra n lf (join n M2 M4)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (addE (vn_eparams n) (join n (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf M1)) M4) (join n (conj n false (addE (vn_eparams n) (scalE (vn_eparams n) k M1) (contra n lf M2))) M3)) (addE (vn_eparams n) (join n (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) M1) (addE (vn_eparams n) (scalE (vn_eparams n) k M3) (contra n lf M4))) (join n (conj n false (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) M2)) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf M3))))) (addE (vn_eparams n) (join n (addE (vn_eparams n) (scalE (vn_eparams n) k M1) (contra n lf M2)) M4) (join n (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) M2) (addE (vn_eparams n) (scalE (vn_eparams n) k M3) (contra n lf M4))))) *)
assert (F4: hom n k2.+1 M4) by (generalize HM2; case hom; auto; intros; discriminate).
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf (addE (vn_eparams n) (join n M1 M4) (join n (conj n false M2) M3)))) (addE (vn_eparams n) (scalE (vn_eparams n) k (addE (vn_eparams n) (join n M1 M4) (join n (conj n false M2) M3))) (contra n lf (join n M2 M4)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (addE (vn_eparams n) (join n (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf M1)) M4) (join n (conj n false (addE (vn_eparams n) (scalE (vn_eparams n) k M1) (contra n lf M2))) M3)) (addE (vn_eparams n) (join n (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) M1) (addE (vn_eparams n) (scalE (vn_eparams n) k M3) (contra n lf M4))) (join n (conj n false (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) M2)) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf M3))))) (addE (vn_eparams n) (join n (addE (vn_eparams n) (scalE (vn_eparams n) k M1) (contra n lf M2)) M4) (join n (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) M2) (addE (vn_eparams n) (scalE (vn_eparams n) k M3) (contra n lf M4))))) *)
clear HM1 HM2.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite !contra_addr, (conjf_hom n k1.+1 M2), join_scall, conj_add; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
repeat (rewrite conj_scal || rewrite contra_scalr || rewrite scal_addE_r); auto.
rewrite (IH M1 M4  lf k1 k2.+1); auto; simpl expK.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (addE (vn_eparams n) (addE (vn_eparams n) (join n (contra n lf M1) M4) (join n (scalE (vn_eparams n) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1) M1) (contra n lf M4))) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) (contra n lf (join n M2 M3))))) (addE (vn_eparams n) (scalE (vn_eparams n) k (addE (vn_eparams n) (join n M1 M4) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) (join n M2 M3)))) (contra n lf (join n M2 M4)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (addE (vn_eparams n) (join n (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf M1)) M4) (join n (addE (vn_eparams n) (scalE (vn_eparams n) k (conj n false M1)) (conj n false (contra n lf M2))) M3)) (addE (vn_eparams n) (join n (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) M1) (addE (vn_eparams n) (scalE (vn_eparams n) k M3) (contra n lf M4))) (join n (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) (conj n false M2)) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf M3))))) (addE (vn_eparams n) (join n (addE (vn_eparams n) (scalE (vn_eparams n) k M1) (contra n lf M2)) M4) (join n (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) M2) (addE (vn_eparams n) (scalE (vn_eparams n) k M3) (contra n lf M4))))) *)
rewrite (IH M2 M3 lf k1.+1 k2); auto; simpl expK.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (addE (vn_eparams n) (addE (vn_eparams n) (join n (contra n lf M1) M4) (join n (scalE (vn_eparams n) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1) M1) (contra n lf M4))) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) (addE (vn_eparams n) (join n (contra n lf M2) M3) (join n (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) M2) (contra n lf M3)))))) (addE (vn_eparams n) (scalE (vn_eparams n) k (addE (vn_eparams n) (join n M1 M4) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) (join n M2 M3)))) (contra n lf (join n M2 M4)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (addE (vn_eparams n) (join n (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf M1)) M4) (join n (addE (vn_eparams n) (scalE (vn_eparams n) k (conj n false M1)) (conj n false (contra n lf M2))) M3)) (addE (vn_eparams n) (join n (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) M1) (addE (vn_eparams n) (scalE (vn_eparams n) k M3) (contra n lf M4))) (join n (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) (conj n false M2)) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf M3))))) (addE (vn_eparams n) (join n (addE (vn_eparams n) (scalE (vn_eparams n) k M1) (contra n lf M2)) M4) (join n (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) M2) (addE (vn_eparams n) (scalE (vn_eparams n) k M3) (contra n lf M4))))) *)
rewrite (IH M2 M4 lf k1.+1 k2.+1); auto; simpl expK.
repeat (rewrite scal_addEr || rewrite join_addr || rewrite join_addl ||
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
        rewrite join_scall || rewrite join_scalr); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite (conjf_hom n k1 M1); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite (conjf_hom n k1 #<lf, M2 >#); try apply contra_hom; auto.
rewrite (conjf_hom n k1.+1 M2); auto; simpl expK; 
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
  rewrite !join_scall, <-!scal_multE; Krm1; auto.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
apply f_equal2 with (f := @pair _ _).
(* Goal: @Logic.eq (vect n) (addE (vn_eparams n) (addE (vn_eparams n) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (join n (contra n lf M1) M4)) (scalE (vn_eparams n) (oppK (K1 p) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) (join n M1 (contra n lf M4)))) (addE (vn_eparams n) (scalE (vn_eparams n) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1) (join n (contra n lf M2) M3)) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (join n M2 (contra n lf M3))))) (addE (vn_eparams n) (addE (vn_eparams n) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (join n (contra n lf M1) M4)) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (stype (vn_eparams n)) k (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) (join n M1 M3)) (scalE (vn_eparams n) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1) (join n (contra n lf M2) M3)))) (addE (vn_eparams n) (addE (vn_eparams n) (scalE (vn_eparams n) (oppK (K1 p) (multK (K1 p) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1) k)) (join n M1 M3)) (scalE (vn_eparams n) (oppK (K1 p) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) (join n M1 (contra n lf M4)))) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (join n M2 (contra n lf M3))))) *)
(* Goal: @Logic.eq (vect n) (addE (vn_eparams n) (addE (vn_eparams n) (scalE (vn_eparams n) k (join n M1 M4)) (scalE (vn_eparams n) (oppK (K1 p) (multK (K1 p) k (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1))) (join n M2 M3))) (addE (vn_eparams n) (join n (contra n lf M2) M4) (scalE (vn_eparams n) (oppK (K1 p) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) (join n M2 (contra n lf M4))))) (addE (vn_eparams n) (addE (vn_eparams n) (scalE (vn_eparams n) k (join n M1 M4)) (join n (contra n lf M2) M4)) (addE (vn_eparams n) (scalE (vn_eparams n) (oppK (K1 p) (multK (K1 p) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1) k)) (join n M2 M3)) (scalE (vn_eparams n) (oppK (K1 p) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) (join n M2 (contra n lf M4))))) *)
apply sym_equal.
do 8 (rewrite ?addE_assoc; auto; 
  ((apply f_equal2 with (f := addE (vn_eparams n)); auto); [idtac])
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
 || rewrite addE_com; auto); rewrite multK_com; auto.
(* Goal: @Logic.eq (E (vn_eparams n)) (addE (vn_eparams n) (scalE (vn_eparams n) (oppK (K1 p) (multK (K1 p) k (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1))) (join n M1 M3)) (addE (vn_eparams n) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (join n M2 (contra n lf M3))) (scalE (vn_eparams n) (multK (stype (vn_eparams n)) k (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) (join n M1 M3)))) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (join n M2 (contra n lf M3))) *)
(* Goal: @Logic.eq (vect n) (addE (vn_eparams n) (addE (vn_eparams n) (scalE (vn_eparams n) k (join n M1 M4)) (scalE (vn_eparams n) (oppK (K1 p) (multK (K1 p) k (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1))) (join n M2 M3))) (addE (vn_eparams n) (join n (contra n lf M2) M4) (scalE (vn_eparams n) (oppK (K1 p) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) (join n M2 (contra n lf M4))))) (addE (vn_eparams n) (addE (vn_eparams n) (scalE (vn_eparams n) k (join n M1 M4)) (join n (contra n lf M2) M4)) (addE (vn_eparams n) (scalE (vn_eparams n) (oppK (K1 p) (multK (K1 p) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1) k)) (join n M2 M3)) (scalE (vn_eparams n) (oppK (K1 p) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k1)) (join n M2 (contra n lf M4))))) *)
rewrite addE_com, addE_assoc, <- scal_addEl, oppKr; Grm0.
repeat (rewrite ?addE_assoc; auto; 
  ((apply f_equal2 with (f := addE (vn_eparams n)); auto); [idtac])
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
 || rewrite addE_com; auto); rewrite multK_com; auto.
Qed.

(* Anti-commutativity for homegeonous vectors, generalization of  cbl_base_prod_com  *)
Lemma join_hom_com n k1 k2 x y :
 hom n k1 x -> hom n k2 y ->  y ∨ x = ((- (1)) ^(k1 * k2)).* (x ∨ y).
Proof.
(* Goal: forall (_ : b2Prop (hom n k1 x)) (_ : b2Prop (hom n (S O) y)) (_ : b2Prop (hom n k2 z)), @Logic.eq (vect n) (meet n (join n x y) z) (addE (vn_eparams n) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n (S (Nat.add k1 k2)))) (meet n x (join n y z))) (join n (meet n x z) y)) *)
generalize k1 k2; clear k1 k2.
(* Goal: forall (k1 k2 : nat) (_ : b2Prop (hom n k1 x)) (_ : b2Prop (hom n (S O) y)) (_ : b2Prop (hom n k2 z)), @Logic.eq (vect n) (meet n (join n x y) z) (addE (vn_eparams n) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n (S (Nat.add k1 k2)))) (meet n x (join n y z))) (join n (meet n x z) y)) *)
induction n as [| n IH]; simpl; try Vfold n.
(* Goal: forall (k1 k2 : nat) (_ : b2Prop match k1 with | O => true | S n => eqK (K1 p) x (v0 (K1 p)) end) (_ : b2Prop match k2 with | O => true | S n => eqK (K1 p) y (v0 (K1 p)) end), @Logic.eq (Field.K (K1 p)) (multK (K1 p) y x) (multK (K1 p) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.mul k1 k2)) (multK (K1 p) x y)) *)
(* Goal: forall (k1 k2 : nat) (_ : b2Prop (let (l2, l3) := x in andb match k1 with | O => eq0 n l2 | S k3 => hom n k3 l2 end (hom n k1 l3))) (_ : b2Prop (let (l2, l3) := y in andb match k2 with | O => eq0 n l2 | S k3 => hom n k3 l2 end (hom n k2 l3))), @Logic.eq (prod (vect n) (vect n)) (let (x1, x2) := y in let (y1, y2) := x in @pair (vect n) (vect n) (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) (join n x2 y2)) (let (l2, l3) := let (x1, x2) := x in let (y1, y2) := y in @pair (vect n) (vect n) (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) (join n x2 y2) in @pair (vect n) (vect n) (scalE (vn_eparams n) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.mul k1 k2)) l2) (scalE (vn_eparams n) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.mul k1 k2)) l3)) *)
intros [|k1] [|k2] Hk1 Hk2; simpl expK.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite multK1l, multK_com; auto.
(* Goal: b2Prop false *)
generalize Hk2; case eqK_spec; auto; intros; subst; Krm0; discriminate.
(* Goal: b2Prop false *)
generalize Hk1; case eqK_spec; auto; intros; subst; Krm0; discriminate.
(* Goal: b2Prop false *)
generalize Hk1; case eqK_spec; auto; intros; subst; Krm0; discriminate.
intros [|k1] [|k2] Hk1 Hk2; simpl expK; 
  destruct x as [x1 x2]; destruct y as [y1 y2];
  try (generalize Hk1; case eq0_spec; intros; subst; Grm0; try discriminate);
  try (generalize Hk2; case eq0_spec; intros; subst; Grm0; try discriminate).
(* Goal: @Logic.eq (vect (S n)) (dual (S n) (join (S n) v1 v2)) (meet (S n) (dual (S n) v1) (dual (S n) v2)) *)
rewrite (hom0E n x2), (hom0E n y2); auto; simpl; Vfold n.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite scalE1, !joink, multK_com; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite (hom0E n x2), conjk, !joinkl, !joinkr, !scalE1; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite (hom0E n y2), <-!mult_n_O, conjk, !joinkl, !joinkr, !scalE1; auto.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (addE (vn_eparams n) (join n y1 x2) (join n (conj n false y2) x1)) (join n y2 x2)) (@pair (vect n) (vect n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add k2 (Nat.mul k1 (S k2))))) (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1))) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add k2 (Nat.mul k1 (S k2))))) (join n x2 y2))) *)
assert (Hh1: hom n k1 x1) by (generalize Hk1; case hom; auto).
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (addE (vn_eparams n) (join n y1 x2) (join n (conj n false y2) x1)) (join n y2 x2)) (@pair (vect n) (vect n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add k2 (Nat.mul k1 (S k2))))) (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1))) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add k2 (Nat.mul k1 (S k2))))) (join n x2 y2))) *)
assert (Hh2: hom n k1.+1 x2) by (generalize Hk1; case hom; intros; auto; discriminate).
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (addE (vn_eparams n) (join n y1 x2) (join n (conj n false y2) x1)) (join n y2 x2)) (@pair (vect n) (vect n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add k2 (Nat.mul k1 (S k2))))) (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1))) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add k2 (Nat.mul k1 (S k2))))) (join n x2 y2))) *)
assert (Hh3: hom n k2 y1) by (generalize Hk2; case hom; auto).
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (addE (vn_eparams n) (join n y1 x2) (join n (conj n false y2) x1)) (join n y2 x2)) (@pair (vect n) (vect n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add k2 (Nat.mul k1 (S k2))))) (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1))) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add k2 (Nat.mul k1 (S k2))))) (join n x2 y2))) *)
assert (Hh4: hom n k2.+1 y2) by (generalize Hk2; case hom; intros; auto; discriminate).
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite (conjf_hom _ k2.+1), join_scall, (conjf_hom _ k1.+1), join_scall; auto.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
apply f_equal2 with (f := @pair _ _).
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite  addE_com, scal_addEr; auto.
(* Goal: @Logic.eq (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (S k2)) (join n y2 x1)) (join n y1 x2)) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add k2 (Nat.mul k1 (S k2))))) (join n x1 y2)) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add k2 (Nat.mul k1 (S k2))))) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (S k1)) (join n x2 y1)))) *)
(* Goal: @Logic.eq (vect n) (join n y2 x2) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add k2 (Nat.mul k1 (S k2))))) (join n x2 y2)) *)
apply f_equal2 with (f := add n).
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite (IH _ _ k1 k2.+1); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
simpl expK; rewrite !expK_add, !scal_multE; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite (IH _ _ k1.+1 k2); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
simpl expK; rewrite <-mult_n_Sm, !expK_add, <-!scal_multE; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply f_equal2 with (f := scal n); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite (multK_com _ Hp (- (1))%f), !multK_assoc; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite <- (multK_assoc _ Hp (- (1))%f), multK_m1_m1, multK1l, expK2m1, multK1r; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite (IH _ _ k1.+1 k2.+1); auto.
Qed.

Lemma join_hom_odd n k x : (1+1 <> (0: K))%f -> hom n k x -> odd k -> x ∨ x = 0.
Proof.
intros H2 Hx Hk.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
case (scalE_integral _ (fn n) (1 + 1)%f (x ∨ x)); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
2: intros; case H2; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite scal_addEl, scalE1; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
pattern (x ∨ x) at 2; rewrite (join_hom_com n k k x x); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite expKm1_odd, scal_addE0; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply odd_mult; auto.
Qed.

Lemma join_hom_id n k x : hom n k x -> odd k ->  x ∨ x = 0.
Proof.
(* Goal: forall _ : @In (vect n) v (base n k), or (@Logic.eq (vect n) (join n v (dual n v)) (all n)) (@Logic.eq (vect n) (join n v (dual n v)) (scalE (vn_eparams n) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (all n))) *)
generalize k; clear k.
(* Goal: forall (k1 k2 : nat) (_ : b2Prop (hom n k1 x)) (_ : b2Prop (hom n (S O) y)) (_ : b2Prop (hom n k2 z)), @Logic.eq (vect n) (meet n (join n x y) z) (addE (vn_eparams n) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n (S (Nat.add k1 k2)))) (meet n x (join n y z))) (join n (meet n x z) y)) *)
induction n as [| n IH]; simpl; try Vfold n.
(* Goal: forall (k : nat) (_ : b2Prop match k with | O => true | S n => eqK (K1 p) x (v0 (K1 p)) end) (_ : odd k), @Logic.eq (Field.K (K1 p)) (multK (K1 p) x x) (v0 (K1 p)) *)
(* Goal: forall (k : nat) (_ : b2Prop (let (l2, l3) := x in andb match k with | O => eq0 n l2 | S k1 => hom n k1 l2 end (hom n k l3))) (_ : odd k), @Logic.eq (prod (vect n) (vect n)) (let (x1, x2) := x in let (y1, y2) := x in @pair (vect n) (vect n) (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) (join n x2 y2)) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (E0 (vn_eparams n))) *)
intros [|k] Hk; simpl expK.
(* Goal: @ex nat (fun p1 : nat => and (lt p1 O) (@Logic.eq (vect O) v (gen O p1))) *)
(* Goal: @ex nat (fun p1 : nat => and (lt p1 (S n)) (@Logic.eq (vect (S n)) v (gen (S n) p1))) *)
intros HH; inversion HH.
(* Goal: b2Prop false *)
generalize Hk; case eqK_spec; intros; subst; Krm0; discriminate.
(* Goal: forall (k : nat) (_ : b2Prop (let (l2, l3) := x in andb match k with | O => eq0 n l2 | S k1 => hom n k1 l2 end (hom n k l3))) (_ : odd k), @Logic.eq (prod (vect n) (vect n)) (let (x1, x2) := x in let (y1, y2) := x in @pair (vect n) (vect n) (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) (join n x2 y2)) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (E0 (vn_eparams n))) *)
intros [|k]; destruct x as [x y]; rewrite andbP; intros (Hk1,Hk2).
(* Goal: @ex nat (fun p1 : nat => and (lt p1 O) (@Logic.eq (vect O) v (gen O p1))) *)
(* Goal: @ex nat (fun p1 : nat => and (lt p1 (S n)) (@Logic.eq (vect (S n)) v (gen (S n) p1))) *)
intros HH; inversion HH.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros Ho; rewrite (IH _ k.+1); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite conjf_hom with (k := S k); auto.
rewrite expKm1_odd, join_scall, (join_hom_com n k k.+1 x y),
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
        expKm1_even, scalE1, scal_addE0; auto.
(* Goal: even (Nat.mul k (S k)) *)
apply even_mult_l.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply odd_plus_even_inv_r with 1%nat; auto; repeat constructor; auto.
Qed.

Lemma is_vector_space_swap n x l :
  is_vector_space n l -> In x l ->
  exists l1, is_vector_space n (x::l1) /\ joinl n l = joinl n (x::l1).
Proof.
(* Goal: forall (_ : is_vector_space n l) (_ : @In (E (vn_eparams n)) x l), @ex (list (E (vn_eparams n))) (fun l1 : list (E (vn_eparams n)) => and (is_vector_space n (@cons (E (vn_eparams n)) x l1)) (@Logic.eq (E (vn_eparams n)) (joinl n l) (joinl n (@cons (E (vn_eparams n)) x l1)))) *)
induction l as [|y l IH].
(* Goal: forall (_ : is_vector_space n (@nil (E (vn_eparams n)))) (_ : @In (E (vn_eparams n)) x (@nil (E (vn_eparams n)))), @ex (list (E (vn_eparams n))) (fun l1 : list (E (vn_eparams n)) => and (is_vector_space n (@cons (E (vn_eparams n)) x l1)) (@Logic.eq (E (vn_eparams n)) (joinl n (@nil (E (vn_eparams n)))) (joinl n (@cons (E (vn_eparams n)) x l1)))) *)
(* Goal: forall (_ : is_vector_space n (@cons (E (vn_eparams n)) y l)) (_ : @In (E (vn_eparams n)) x (@cons (E (vn_eparams n)) y l)), @ex (list (E (vn_eparams n))) (fun l1 : list (E (vn_eparams n)) => and (is_vector_space n (@cons (E (vn_eparams n)) x l1)) (@Logic.eq (E (vn_eparams n)) (joinl n (@cons (E (vn_eparams n)) y l)) (joinl n (@cons (E (vn_eparams n)) x l1)))) *)
intros _ [].
(* Goal: forall (_ : is_vector_space n (@cons (E (vn_eparams n)) y l)) (_ : @In (E (vn_eparams n)) x (@cons (E (vn_eparams n)) y l)), @ex (list (E (vn_eparams n))) (fun l1 : list (E (vn_eparams n)) => and (is_vector_space n (@cons (E (vn_eparams n)) x l1)) (@Logic.eq (E (vn_eparams n)) (joinl n (@cons (E (vn_eparams n)) y l)) (joinl n (@cons (E (vn_eparams n)) x l1)))) *)
simpl In; intros Hs [[] | Hxy].
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
exists l; auto.
(* Goal: @ex (list (E (vn_eparams n))) (fun l1 : list (E (vn_eparams n)) => and (is_vector_space n (@cons (E (vn_eparams n)) x l1)) (@Logic.eq (E (vn_eparams n)) (joinl n (@cons (E (vn_eparams n)) y l)) (joinl n (@cons (E (vn_eparams n)) x l1)))) *)
assert (F1: is_vector_space n l).
(* Goal: is_vector_space n l *)
(* Goal: @ex (list (E (vn_eparams n))) (fun l1 : list (E (vn_eparams n)) => and (is_vector_space n (@cons (E (vn_eparams n)) x l1)) (@Logic.eq (E (vn_eparams n)) (joinl n (@cons (E (vn_eparams n)) y l)) (joinl n (@cons (E (vn_eparams n)) x l1)))) *)
intros u Hu; apply Hs; auto with datatypes.
(* Goal: @ex (list (E (vn_eparams n))) (fun l1 : list (E (vn_eparams n)) => and (is_vector_space n (@cons (E (vn_eparams n)) x l1)) (@Logic.eq (E (vn_eparams n)) (joinl n (@cons (E (vn_eparams n)) y l)) (joinl n (@cons (E (vn_eparams n)) x l1)))) *)
case (IH F1 Hxy); intros l1 (H1l1,H2l1).
exists ((-(1)) .* y::l1); split.
(* Goal: is_vector_space n (@cons (E (vn_eparams n)) x (@cons (E (vn_eparams n)) (scalE (vn_eparams n) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) y) l1)) *)
(* Goal: @Logic.eq (E (vn_eparams n)) (joinl n (@cons (E (vn_eparams n)) y l)) (joinl n (@cons (E (vn_eparams n)) x (@cons (E (vn_eparams n)) (scalE (vn_eparams n) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) y) l1))) *)
intros u; simpl; intros [Hu|[Hu|Hu]]; subst.
(* Goal: is_vector n u *)
(* Goal: @Logic.eq (E (vn_eparams n)) (joinl n (@cons (E (vn_eparams n)) y l)) (joinl n (@cons (E (vn_eparams n)) x (@cons (E (vn_eparams n)) (scalE (vn_eparams n) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) y) l1))) *)
apply H1l1; auto with datatypes.
(* Goal: is_vector n (scal n (oppK (K1 p) (v1 (K1 p))) y) *)
(* Goal: is_vector n u *)
(* Goal: @Logic.eq (E (vn_eparams n)) (joinl n (@cons (E (vn_eparams n)) y l)) (joinl n (@cons (E (vn_eparams n)) x (@cons (E (vn_eparams n)) (scalE (vn_eparams n) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) y) l1))) *)
apply VectorSpace.cbl_scal; apply Hs; auto with datatypes.
(* Goal: is_vector n u *)
(* Goal: @Logic.eq (E (vn_eparams n)) (joinl n (@cons (E (vn_eparams n)) y l)) (joinl n (@cons (E (vn_eparams n)) x (@cons (E (vn_eparams n)) (scalE (vn_eparams n) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) y) l1))) *)
apply H1l1; auto with datatypes.
(* Goal: @Logic.eq (E (vn_eparams n)) (joinl n (@cons (E (vn_eparams n)) y l)) (joinl n (@cons (E (vn_eparams n)) x (@cons (E (vn_eparams n)) (scalE (vn_eparams n) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) y) l1))) *)
rewrite joinlS, H2l1.
(* Goal: @Logic.eq (E (vn_eparams n)) (join n y (joinl n (@cons (E (vn_eparams n)) x l1))) (joinl n (@cons (E (vn_eparams n)) x (@cons (E (vn_eparams n)) (scalE (vn_eparams n) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) y) l1))) *)
(* Goal: not (@Logic.eq (list (vect n)) l (@nil (vect n))) *)
destruct l1 as [|z l1].
(* Goal: @Logic.eq (vect (S n)) (dual (S n) (join (S n) v1 v2)) (meet (S n) (dual (S n) v1) (dual (S n) v2)) *)
simpl; Vfold n.
(* Goal: @Logic.eq (vect n) (join n y x) (join n x (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) y)) *)
(* Goal: @Logic.eq (E (vn_eparams n)) (join n y (joinl n (@cons (E (vn_eparams n)) x (@cons (E (vn_eparams n)) z l1)))) (joinl n (@cons (E (vn_eparams n)) x (@cons (E (vn_eparams n)) (scalE (vn_eparams n) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) y) (@cons (E (vn_eparams n)) z l1)))) *)
(* Goal: not (@Logic.eq (list (vect n)) l (@nil (vect n))) *)
rewrite join_hom_com with (k1 := 1%nat) (k2 := 1%nat).
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
simpl expK; Krm1; rewrite join_scalr; auto.
(* Goal: is_vector n u *)
(* Goal: @Logic.eq (E (vn_eparams n)) (joinl n (@cons (E (vn_eparams n)) y l)) (joinl n (@cons (E (vn_eparams n)) x (@cons (E (vn_eparams n)) (scalE (vn_eparams n) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) y) l1))) *)
rewrite <-cbl1_hom1_equiv; apply H1l1; auto with datatypes.
(* Goal: b2Prop (hom n (S O) y) *)
(* Goal: not (@Logic.eq (list (vect n)) (@cons (E (vn_eparams n)) z l1) (@nil (vect n))) *)
(* Goal: not (@Logic.eq (list (vect n)) l (@nil (vect n))) *)
rewrite <-cbl1_hom1_equiv; apply Hs; auto with datatypes.
(* Goal: @Logic.eq (E (vn_eparams n)) (join n y (joinl n (@cons (E (vn_eparams n)) x (@cons (E (vn_eparams n)) z l1)))) (joinl n (@cons (E (vn_eparams n)) x (@cons (E (vn_eparams n)) (scalE (vn_eparams n) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) y) (@cons (E (vn_eparams n)) z l1)))) *)
(* Goal: not (@Logic.eq (list (vect n)) l (@nil (vect n))) *)
rewrite joinlS, <-join_assoc.
(* Goal: @Logic.eq (E (vn_eparams n)) (join n (join n y x) (joinl n (@cons (E (vn_eparams n)) z l1))) (joinl n (@cons (E (vn_eparams n)) x (@cons (E (vn_eparams n)) (scalE (vn_eparams n) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) y) (@cons (E (vn_eparams n)) z l1)))) *)
(* Goal: not (@Logic.eq (list (vect n)) (@cons (E (vn_eparams n)) z l1) (@nil (vect n))) *)
(* Goal: not (@Logic.eq (list (vect n)) l (@nil (vect n))) *)
rewrite join_hom_com with (k1 := 1%nat) (k2 := 1%nat) (x:= x).
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
simpl expK; Krm1; rewrite <-join_scalr, join_assoc; auto.
(* Goal: is_vector n u *)
(* Goal: @Logic.eq (E (vn_eparams n)) (joinl n (@cons (E (vn_eparams n)) y l)) (joinl n (@cons (E (vn_eparams n)) x (@cons (E (vn_eparams n)) (scalE (vn_eparams n) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) y) l1))) *)
rewrite <-cbl1_hom1_equiv; apply H1l1; auto with datatypes.
(* Goal: b2Prop (hom n (S O) y) *)
(* Goal: not (@Logic.eq (list (vect n)) (@cons (E (vn_eparams n)) z l1) (@nil (vect n))) *)
(* Goal: not (@Logic.eq (list (vect n)) l (@nil (vect n))) *)
rewrite <-cbl1_hom1_equiv; apply Hs; auto with datatypes.
(* Goal: b2Prop false *)
intros HH; discriminate.
(* Goal: not (@Logic.eq (list (vect n)) l (@nil (vect n))) *)
destruct l as [|z l].
(* Goal: not (@Logic.eq (list (vect n)) (@nil (E (vn_eparams n))) (@nil (vect n))) *)
(* Goal: not (@Logic.eq (list (vect n)) (@cons (E (vn_eparams n)) z l) (@nil (vect n))) *)
case Hxy.
(* Goal: b2Prop false *)
intros HH; discriminate.
Qed.

(* This function will be only call with first vector is hom 1 *)
Fixpoint factor n: (vect n) -> (vect n) -> vect n :=
  match n return vect n -> vect n -> vect n with
  | O => fun x1 x2 => (x2 * x1^-1)%f
  | S n1 =>
        fun x1 x2 =>
        let (x11, x12) := x1 in
        let (x21, x22) := x2 in
        if x12 ?= 0 then
        (* if x<> 0 then x11 <> 0 *) 
        ((0: vect n1), ('C[x11]^-1).* x21: vect n1) else
        let x32 := factor n1 x12 x22 in
          (* We have x12 ∨ x32 = x22 *)
             (* let x31 such that x12 /\ x31 = x11 ∨ x32 - x21                            *)
             (* (x11,x12) /\ (x31,x32) = (x11 /\ x32 - x12 /\ x31, x12 /\ x32) (x21, x22) *)
             (factor n1 x12 (add n1 (('C[x11]) .* x32: vect n1) (scal n1 (-(1))%f  x21: vect n1))
               , x32)
   end.

Lemma factor0 n x : factor n x 0 = 0.
Proof.
(* Goal: @Logic.eq (vect n) (k2g n (E0 (Kn.vn_eparams p n))) (E0 (vn_eparams n)) *)
induction n as [| n IH]; simpl; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite multK0l; auto.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (let (x11, x12) := x in if eq0 n x12 then @pair (vect n) (vect n) (genk n (v0 (K1 p))) (scal n (invK (K1 p) (const n x11)) (genk n (v0 (K1 p)))) else @pair (vect n) (vect n) (factor n x12 (add n (scal n (const n x11) (factor n x12 (genk n (v0 (K1 p))))) (scal n (oppK (K1 p) (v1 (K1 p))) (genk n (v0 (K1 p)))))) (factor n x12 (genk n (v0 (K1 p))))) (@pair (vect n) (vect n) (genk n (v0 (K1 p))) (genk n (v0 (K1 p)))) *)
destruct x; case eq0_spec; intros Hx2; subst; Vfold n; Grm0.
(* Goal: @Logic.eq (vect n) (meet n (meet n v v1) v3) (meet n v (meet n v1 v3)) *)
(* Goal: @Logic.eq (vect n) (addE (vn_eparams n) (meet n (meet n v v1) v4) (meet n (addE (vn_eparams n) (meet n v v2) (meet n v0 (dconj n false v1))) (dconj n false v3))) (addE (vn_eparams n) (meet n v (addE (vn_eparams n) (meet n v1 v4) (meet n v2 (dconj n false v3)))) (meet n v0 (dconj n false (meet n v1 v3)))) *)
rewrite IH; Grm0; rewrite IH; auto.
Qed.

Lemma factor_scal n k x M : factor n x (k .* M) = k .* factor n x M.
Proof.
(* Goal: forall (b : bool) (k : nat) (_ : b2Prop (hom n k x)), b2Prop (hom n k (dconj n b x)) *)
induction n as [| n IH]; simpl.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite multK_assoc; auto.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (let (x11, x12) := x in let (x21, x22) := let (l2, l3) := M in @pair (vect n) (vect n) (scal n k l2) (scal n k l3) in if eq0 n x12 then @pair (vect n) (vect n) (genk n (v0 (K1 p))) (scal n (invK (K1 p) (const n x11)) x21) else @pair (vect n) (vect n) (factor n x12 (add n (scal n (const n x11) (factor n x12 x22)) (scal n (oppK (K1 p) (v1 (K1 p))) x21))) (factor n x12 x22)) (let (l2, l3) := let (x11, x12) := x in let (x21, x22) := M in if eq0 n x12 then @pair (vect n) (vect n) (genk n (v0 (K1 p))) (scal n (invK (K1 p) (const n x11)) x21) else @pair (vect n) (vect n) (factor n x12 (add n (scal n (const n x11) (factor n x12 x22)) (scal n (oppK (K1 p) (v1 (K1 p))) x21))) (factor n x12 x22) in @pair (vect n) (vect n) (scal n k l2) (scal n k l3)) *)
destruct x as [x1 x2]; destruct M as [M1 M2].
(* Goal: @Logic.eq (prod (vect n) (vect n)) (if eq0 n x2 then @pair (vect n) (vect n) (genk n (v0 (K1 p))) (scal n (invK (K1 p) (const n x1)) (scal n k M1)) else @pair (vect n) (vect n) (factor n x2 (add n (scal n (const n x1) (factor n x2 (scal n k M2))) (scal n (oppK (K1 p) (v1 (K1 p))) (scal n k M1)))) (factor n x2 (scal n k M2))) (let (l2, l3) := if eq0 n x2 then @pair (vect n) (vect n) (genk n (v0 (K1 p))) (scal n (invK (K1 p) (const n x1)) M1) else @pair (vect n) (vect n) (factor n x2 (add n (scal n (const n x1) (factor n x2 M2)) (scal n (oppK (K1 p) (v1 (K1 p))) M1))) (factor n x2 M2) in @pair (vect n) (vect n) (scal n k l2) (scal n k l3)) *)
case eq0_spec; intros Hx2; subst; Vfold n; Grm0.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite <-!scal_multE, multK_com; auto.
(* Goal: @Logic.eq (vect n) (meet n (meet n v v1) v3) (meet n v (meet n v1 v3)) *)
(* Goal: @Logic.eq (vect n) (addE (vn_eparams n) (meet n (meet n v v1) v4) (meet n (addE (vn_eparams n) (meet n v v2) (meet n v0 (dconj n false v1))) (dconj n false v3))) (addE (vn_eparams n) (meet n v (addE (vn_eparams n) (meet n v1 v4) (meet n v2 (dconj n false v3)))) (meet n v0 (dconj n false (meet n v1 v3)))) *)
apply f_equal2 with (f := @pair _ _); rewrite IH; auto.
(* Goal: @Logic.eq (vect n) (factor n x2 (addE (vn_eparams n) (scalE (vn_eparams n) (const n x1) (scalE (vn_eparams n) k (factor n x2 M2))) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (scalE (vn_eparams n) k M1)))) (scalE (vn_eparams n) k (factor n x2 (addE (vn_eparams n) (scalE (vn_eparams n) (const n x1) (factor n x2 M2)) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) M1)))) *)
apply sym_equal; rewrite <-IH.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite scal_addEr, !(scalE_swap _ (fn n) k); auto.
Qed.

Lemma factor_id n x : x <> 0 -> hom n 1 x -> factor n x x = 1.
Proof.
(* Goal: forall (k : nat) (_ : b2Prop (hom n k M)), @Logic.eq (vect n) (dconj n false M) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n k)) M) *)
induction n as [| n IH]; simpl; auto; try Vfold n.
(* Goal: b2Prop false *)
intros H; case eqK_spec; intros; auto; case H; auto; discriminate.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (let (x1, y1) := x in @pair (vect n) (vect n) (meet n x1 (E0 (vn_eparams n))) (addE (vn_eparams n) (meet n x1 (genk n (v1 (K1 p)))) (meet n y1 (dconj n false (E0 (vn_eparams n)))))) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (genk n (let (_, l2) := let (x, y) := x in @pair (vect n) (vect n) (dual n (conj n false y)) (dual n x) in const n l2))) *)
intros Hd; destruct x.
(* Goal: forall _ : b2Prop (andb (hom n O v) (hom n (S O) v0)), @Logic.eq (prod (vect n) (vect n)) (if eq0 n v0 then @pair (vect n) (vect n) (E0 (vn_eparams n)) (scalE (vn_eparams n) (invK (K1 p) (const n v)) v) else @pair (vect n) (vect n) (factor n v0 (addE (vn_eparams n) (scalE (vn_eparams n) (const n v) (factor n v0 v0)) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) v))) (factor n v0 v0)) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (genk n (v1 (K1 p)))) *)
rewrite !andbP; intros (Hx1, Hx2).
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite (hom0E _ _ Hx1), !constk, !scalk, <-opp_multKl, multK1l; auto.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (if eq0 n v0 then @pair (vect n) (vect n) (E0 (vn_eparams n)) (genk n (multK (stype (vn_eparams n)) (invK (K1 p) (const n v)) (const n v))) else @pair (vect n) (vect n) (factor n v0 (addE (vn_eparams n) (scalE (vn_eparams n) (const n v) (factor n v0 v0)) (genk n (oppK (K1 p) (const n v))))) (factor n v0 v0)) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (genk n (v1 (K1 p)))) *)
case eq0_spec; intros H1x2; subst.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (genk n (multK (stype (vn_eparams n)) (invK (K1 p) (const n v)) (const n v)))) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (genk n (v1 (K1 p)))) *)
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (factor n v0 (addE (vn_eparams n) (scalE (vn_eparams n) (const n v) (factor n v0 v0)) (genk n (oppK (K1 p) (const n v))))) (factor n v0 v0)) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (genk n (v1 (K1 p)))) *)
rewrite invKr; auto; intros Hk1; case Hd.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) v (E0 (vn_eparams n))) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (E0 (vn_eparams n))) *)
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (factor n v0 (addE (vn_eparams n) (scalE (vn_eparams n) (const n v) (factor n v0 v0)) (genk n (oppK (K1 p) (const n v))))) (factor n v0 v0)) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (genk n (v1 (K1 p)))) *)
rewrite (hom0E _ _ Hx1), Hk1; Grm0.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite IH, scalk, multK1r, addk, oppKr, factor0; auto.
Qed.

Lemma factor_hom0E n x1 x2 : x1 <> 0 ->  hom n 1 x1 -> hom n 0 x2 ->
  factor n x1 (x1 ∨ x2) = x2.
Proof.
(* Goal: forall (_ : not (@Logic.eq (E (vn_eparams n)) x1 (E0 (vn_eparams n)))) (_ : b2Prop (hom n (S O) x1)) (_ : b2Prop (hom n O x2)), @Logic.eq (vect n) (factor n x1 (join n x1 x2)) x2 *)
intros Hx1 H1x1 Hx2.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite (hom0E _ _ Hx2), joinkr, factor_scal, factor_id, scalk, multK1r; auto.
Qed.

Lemma factor_factor n x1 x2 : hom n 1 x1 -> x1 <> 0 ->  
  x1 ∨ x2 = 0 -> x2 = x1 ∨ factor n x1 x2.
Proof.
(* Goal: forall (k : nat) (_ : b2Prop (hom n k M)), @Logic.eq (vect n) (dconj n false M) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n k)) M) *)
induction n as [| n IH]; simpl; auto; try Vfold n.
(* Goal: forall (_ : not (@Logic.eq (Field.K (K1 p)) x1 (v0 (K1 p)))) (_ : b2Prop (eqK (K1 p) x1 (v0 (K1 p)))) (_ : b2Prop (eqK (K1 p) x2 (v0 (K1 p)))), b2Prop false *)
(* Goal: forall (_ : not (@Logic.eq (prod (vect n) (vect n)) x1 (@pair (vect n) (vect n) (E0 (vn_eparams n)) (E0 (vn_eparams n))))) (_ : b2Prop (let (l2, l3) := x1 in andb (hom n O l2) (hom n (S O) l3))) (_ : b2Prop (let (l2, l3) := x2 in andb (hom n O l2) (hom n (S O) l3))), b2Prop (let (_, x12) := x1 in let (x21, x22) := let (l3, l5) := x2 in let (l4, l6) := let (l2, l4) := x1 in @pair (vect n) (vect n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (let (x13, x14) := x1 in let (x21, x22) := x2 in if eq0 n x14 then multK (K1 p) (invK (K1 p) (const n x13)) (const n x21) else fget n x14 x22)) l2) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (let (x13, x14) := x1 in let (x21, x22) := x2 in if eq0 n x14 then multK (K1 p) (invK (K1 p) (const n x13)) (const n x21) else fget n x14 x22)) l4) in @pair (vect n) (vect n) (addE (vn_eparams n) l3 l4) (addE (vn_eparams n) l5 l6) in if eq0 n x12 then eq0 n x21 else andb (fortho n x12 x21) (fortho n x12 x22)) *)
case eqK_spec; auto; try (intros; discriminate).
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros H1 _ H2; case H2; auto.
(* Goal: forall (_ : b2Prop (let (l2, l3) := x1 in andb (hom n O l2) (hom n (S O) l3))) (_ : not (@Logic.eq (prod (vect n) (vect n)) x1 (@pair (vect n) (vect n) (E0 (vn_eparams n)) (E0 (vn_eparams n))))) (_ : @Logic.eq (prod (vect n) (vect n)) (let (x1, x3) := x1 in let (y1, y2) := x2 in @pair (vect n) (vect n) (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x3) y1)) (join n x3 y2)) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (E0 (vn_eparams n)))), @Logic.eq (prod (vect n) (vect n)) x2 (let (x3, x4) := x1 in let (y1, y2) := let (x11, x12) := x1 in let (x21, x22) := x2 in if eq0 n x12 then @pair (vect n) (vect n) (E0 (vn_eparams n)) (scalE (vn_eparams n) (invK (K1 p) (const n x11)) x21) else @pair (vect n) (vect n) (factor n x12 (addE (vn_eparams n) (scalE (vn_eparams n) (const n x11) (factor n x12 x22)) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) x21))) (factor n x12 x22) in @pair (vect n) (vect n) (addE (vn_eparams n) (join n x3 y2) (join n (conj n false x4) y1)) (join n x4 y2)) *)
destruct x2 as [x3 x4]; destruct x1 as [x1 x2].
(* Goal: forall (_ : b2Prop (andb (hom n O x1) (hom n (S O) x2))) (_ : not (@Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) x1 x2) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (E0 (vn_eparams n))))) (_ : @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (addE (vn_eparams n) (join n x1 x4) (join n (conj n false x2) x3)) (join n x2 x4)) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (E0 (vn_eparams n)))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) x3 x4) (let (y1, y2) := if eq0 n x2 then @pair (vect n) (vect n) (E0 (vn_eparams n)) (scalE (vn_eparams n) (invK (K1 p) (const n x1)) x3) else @pair (vect n) (vect n) (factor n x2 (addE (vn_eparams n) (scalE (vn_eparams n) (const n x1) (factor n x2 x4)) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) x3))) (factor n x2 x4) in @pair (vect n) (vect n) (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) (join n x2 y2)) *)
rewrite !andbP; intros (Hu1, Hu2) H3.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite (hom0E _ _ Hu1), constk; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite !joinkl, (conjf_hom _ _ _ Hu2); simpl expK; rewrite multK1r; auto.
(* Goal: forall _ : @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (const n x1) x4) (join n (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) x2) x3)) (join n x2 x4)) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (E0 (vn_eparams n))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) x3 x4) (let (y1, y2) := if eq0 n x2 then @pair (vect n) (vect n) (E0 (vn_eparams n)) (scalE (vn_eparams n) (invK (K1 p) (const n x1)) x3) else @pair (vect n) (vect n) (factor n x2 (addE (vn_eparams n) (scalE (vn_eparams n) (const n x1) (factor n x2 x4)) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) x3))) (factor n x2 x4) in @pair (vect n) (vect n) (addE (vn_eparams n) (join n (genk n (const n x1)) y2) (join n (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) x2) y1)) (join n x2 y2)) *)
case eq0_spec; intros He2; subst.
(* Goal: forall _ : @Logic.eq (E (vn_eparams n)) v (joinl n (decomposek n (first_deg n v) v)), decomposable n (decomposek n (first_deg n v) v) v *)
(* Goal: forall _ : not (@Logic.eq (E (vn_eparams n)) v (joinl n (decomposek n (first_deg n v) v))), not (is_decomposable n v) *)
(* Goal: not (is_decomposable n v) *)
Grm0; intros HH; injection HH; clear HH; intros HH.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
case (scalE_integral _ (fn n) _ _ HH); clear HH; intros HH; subst; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
case H3; rewrite (hom0E _ _ Hu1), HH; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite joinkl, <- scal_multE, invKl, scalE1; Grm0; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros HH; case H3; rewrite (hom0E _ _ Hu1), HH; auto.
(* Goal: forall _ : @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (const n x1) x4) (join n (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) x2) x3)) (join n x2 x4)) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (E0 (vn_eparams n))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) x3 x4) (@pair (vect n) (vect n) (addE (vn_eparams n) (join n (genk n (const n x1)) (factor n x2 x4)) (join n (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) x2) (factor n x2 (addE (vn_eparams n) (scalE (vn_eparams n) (const n x1) (factor n x2 x4)) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) x3))))) (join n x2 (factor n x2 x4))) *)
intros HH; injection HH; Vfold n; intros Hr1 Hr2.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) x3 x4) (@pair (vect n) (vect n) (addE (vn_eparams n) (join n (genk n (const n x1)) (factor n x2 x4)) (join n (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) x2) (factor n x2 (addE (vn_eparams n) (scalE (vn_eparams n) (const n x1) (factor n x2 x4)) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) x3))))) (join n x2 (factor n x2 x4))) *)
assert (H1: x2 ∨ factor n x2 x4 = x4).
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite <-IH; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply f_equal2 with (f := @pair _ _); auto.
rewrite joinkl, join_scall, <-IH, scal_addEr, <-addE_assoc,
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
        scal_addE0, addE0l, <-scal_multE, multK_m1_m1, scalE1; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite join_addr, !join_scalr, H1, <-join_scall; auto.
Qed.

Lemma factork n x k : x <> 0 -> hom n 1 x -> factor n x [k] = 0.
Proof.
(* Goal: forall (b : bool) (k : nat) (_ : b2Prop (hom n k x)), b2Prop (hom n k (dconj n b x)) *)
induction n as [| n IH]; simpl.
intros  H1 H2; case H1; generalize H2.
(* Goal: forall _ : b2Prop (eqK (K1 p) x (v0 (K1 p))), @Logic.eq (Field.K (K1 p)) x (v0 (K1 p)) *)
(* Goal: forall (_ : not (@Logic.eq (prod (vect n) (vect n)) x (@pair (vect n) (vect n) (genk n (v0 (K1 p))) (genk n (v0 (K1 p)))))) (_ : b2Prop (let (l2, l3) := x in andb (hom n O l2) (hom n (S O) l3))), @Logic.eq (prod (vect n) (vect n)) (let (x11, x12) := x in if eq0 n x12 then @pair (vect n) (vect n) (genk n (v0 (K1 p))) (scal n (invK (K1 p) (const n x11)) (genk n (v0 (K1 p)))) else @pair (vect n) (vect n) (factor n x12 (add n (scal n (const n x11) (factor n x12 (genk n k))) (scal n (oppK (K1 p) (v1 (K1 p))) (genk n (v0 (K1 p)))))) (factor n x12 (genk n k))) (@pair (vect n) (vect n) (genk n (v0 (K1 p))) (genk n (v0 (K1 p)))) *)
case eqK_spec; auto; intros; discriminate.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (dual n (conj n false (genk n k))) (dual n (genk n (v0 (K1 p))))) (@pair (vect n) (vect n) (scal n k (all n)) (scal n k (genk n (v0 (K1 p))))) *)
intros Hx; destruct x; rewrite andbP; intros (H1,H2); Vfold n.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (if eq0 n v0 then @pair (vect n) (vect n) (E0 (vn_eparams n)) (scalE (vn_eparams n) (invK (K1 p) (const n v)) (E0 (vn_eparams n))) else @pair (vect n) (vect n) (factor n v0 (addE (vn_eparams n) (scalE (vn_eparams n) (const n v) (factor n v0 (genk n k))) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (E0 (vn_eparams n))))) (factor n v0 (genk n k))) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (E0 (vn_eparams n))) *)
case eq0_spec; Grm0; intros H3.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (factor n v0 (scalE (vn_eparams n) (const n v) (factor n v0 (genk n k)))) (factor n v0 (genk n k))) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (E0 (vn_eparams n))) *)
rewrite IH; Grm0.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite factor0; auto.
Qed.

Lemma factor0_hom0 n x1 x2 : x1 <> 0 -> hom n 1 x1 -> hom n 0 x2 -> 
  factor n x1 x2 = 0.
Proof.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros H1 H2 H3; rewrite (hom0E _ _ H3); apply factork; auto.
Qed.

Lemma factor_hom n k x1 x2 : x1 <> 0 -> x1 ∨ x2 = 0 -> 
  hom n 1 x1 -> hom n k.+1 x2 -> hom n k (factor n x1 x2).
Proof.
(* Goal: forall _ : @In (vect n) v (base n k), or (@Logic.eq (vect n) (join n v (dual n v)) (all n)) (@Logic.eq (vect n) (join n v (dual n v)) (scalE (vn_eparams n) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (all n))) *)
generalize k; clear k.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (dual n (conj n false (genk n k))) (dual n (genk n (v0 (K1 p))))) (@pair (vect n) (vect n) (scal n k (all n)) (scal n k (genk n (v0 (K1 p))))) *)
induction n as [| n IH]; intros k; simpl; auto; try Vfold n.
(* Goal: forall (_ : not (@Logic.eq (Field.K (K1 p)) x1 (v0 (K1 p)))) (_ : b2Prop (eqK (K1 p) x1 (v0 (K1 p)))) (_ : b2Prop (eqK (K1 p) x2 (v0 (K1 p)))), b2Prop false *)
(* Goal: forall (_ : not (@Logic.eq (prod (vect n) (vect n)) x1 (@pair (vect n) (vect n) (E0 (vn_eparams n)) (E0 (vn_eparams n))))) (_ : b2Prop (let (l2, l3) := x1 in andb (hom n O l2) (hom n (S O) l3))) (_ : b2Prop (let (l2, l3) := x2 in andb (hom n O l2) (hom n (S O) l3))), b2Prop (let (_, x12) := x1 in let (x21, x22) := let (l3, l5) := x2 in let (l4, l6) := let (l2, l4) := x1 in @pair (vect n) (vect n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (let (x13, x14) := x1 in let (x21, x22) := x2 in if eq0 n x14 then multK (K1 p) (invK (K1 p) (const n x13)) (const n x21) else fget n x14 x22)) l2) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (let (x13, x14) := x1 in let (x21, x22) := x2 in if eq0 n x14 then multK (K1 p) (invK (K1 p) (const n x13)) (const n x21) else fget n x14 x22)) l4) in @pair (vect n) (vect n) (addE (vn_eparams n) l3 l4) (addE (vn_eparams n) l5 l6) in if eq0 n x12 then eq0 n x21 else andb (fortho n x12 x21) (fortho n x12 x22)) *)
case eqK_spec; auto; try (intros; discriminate).
(* Goal: forall (_ : @Logic.eq (Field.K (K1 p)) x1 (v0 (K1 p))) (_ : not (@Logic.eq (Field.K (K1 p)) x1 (v0 (K1 p)))) (_ : @Logic.eq (Field.K (K1 p)) (multK (K1 p) x1 x2) (v0 (K1 p))) (_ : b2Prop true) (_ : b2Prop (eqK (K1 p) x2 (v0 (K1 p)))), b2Prop match k with | O => true | S n => eqK (K1 p) (multK (K1 p) x2 (invK (K1 p) x1)) (v0 (K1 p)) end *)
(* Goal: forall (_ : not (@Logic.eq (prod (vect n) (vect n)) x1 (@pair (vect n) (vect n) (E0 (vn_eparams n)) (E0 (vn_eparams n))))) (_ : @Logic.eq (prod (vect n) (vect n)) (let (x1, x3) := x1 in let (y1, y2) := x2 in @pair (vect n) (vect n) (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x3) y1)) (join n x3 y2)) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (E0 (vn_eparams n)))) (_ : b2Prop (let (l2, l3) := x1 in andb (hom n O l2) (hom n (S O) l3))) (_ : b2Prop (let (l2, l3) := x2 in andb (hom n k l2) (hom n (S k) l3))), b2Prop (let (l2, l3) := let (x11, x12) := x1 in let (x21, x22) := x2 in if eq0 n x12 then @pair (vect n) (vect n) (E0 (vn_eparams n)) (scalE (vn_eparams n) (invK (K1 p) (const n x11)) x21) else @pair (vect n) (vect n) (factor n x12 (addE (vn_eparams n) (scalE (vn_eparams n) (const n x11) (factor n x12 x22)) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) x21))) (factor n x12 x22) in andb match k with | O => eq0 n l2 | S k1 => hom n k1 l2 end (hom n k l3)) *)
intros H1 H2; case H2; auto.
intros H Heq; destruct x2 as [x3 x4]; destruct x1 as [x1 x2];
     rewrite !andbP; intros (Hu1,Hu2) (Hu3, Hu4).
(* Goal: b2Prop (let (l2, l3) := if eq0 n x2 then @pair (vect n) (vect n) (E0 (vn_eparams n)) (scalE (vn_eparams n) (invK (K1 p) (const n x1)) x3) else @pair (vect n) (vect n) (factor n x2 (addE (vn_eparams n) (scalE (vn_eparams n) (const n x1) (factor n x2 x4)) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) x3))) (factor n x2 x4) in andb match k with | O => eq0 n l2 | S k1 => hom n k1 l2 end (hom n k l3)) *)
case eq0_spec; intros Hx2; subst.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
destruct k as [| k]; rewrite ?eq0I, ?homk0, scal_hom; auto.
(* Goal: b2Prop (andb match k with | O => eq0 n (factor n x2 (addE (vn_eparams n) (scalE (vn_eparams n) (const n x1) (factor n x2 x4)) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) x3))) | S k1 => hom n k1 (factor n x2 (addE (vn_eparams n) (scalE (vn_eparams n) (const n x1) (factor n x2 x4)) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) x3))) end (hom n k (factor n x2 x4))) *)
 injection Heq; Vfold n; rewrite (hom0E _ _ Hu1).
rewrite conjf_hom with (1 := Hu2); simpl expK; 
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
  rewrite multK1r, joinkl; auto.
(* Goal: forall (_ : @Logic.eq (vect n) (join n x2 x4) (E0 (vn_eparams n))) (_ : @Logic.eq (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (const n x1) x4) (join n (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) x2) x3)) (E0 (vn_eparams n))), b2Prop (andb match k with | O => eq0 n (factor n x2 (addE (vn_eparams n) (scalE (vn_eparams n) (const n (genk n (const n x1))) (factor n x2 x4)) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) x3))) | S k1 => hom n k1 (factor n x2 (addE (vn_eparams n) (scalE (vn_eparams n) (const n (genk n (const n x1))) (factor n x2 x4)) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) x3))) end (hom n k (factor n x2 x4))) *)
intros Heq1 Heq2.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite constk; auto.
(* Goal: b2Prop (andb match k with | O => eq0 n (factor n x2 (addE (vn_eparams n) (scalE (vn_eparams n) (const n x1) (factor n x2 x4)) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) x3))) | S k1 => hom n k1 (factor n x2 (addE (vn_eparams n) (scalE (vn_eparams n) (const n x1) (factor n x2 x4)) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) x3))) end (hom n k (factor n x2 x4))) *)
simpl in x3.
assert (Heq3: x2 ∨ ('C[x1] .* factor n x2 x4 + (- (1)).* (x3 : vect n)) = 0).
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
  rewrite join_addr, !join_scalr, <-factor_factor, <-join_scall; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
destruct k as [| k]; rewrite andbP; split; auto.
(* Goal: b2Prop (eq0 n (E0 (vn_eparams n))) *)
(* Goal: forall (_ : not (@Logic.eq (vect n) v0 (E0 (vn_eparams n)))) (_ : b2Prop (andb (fortho n v0 v1) (fortho n v0 v2))) (_ : b2Prop (andb (fortho n v0 v3) (fortho n v0 v4))), b2Prop (andb (fortho n v0 (addE (vn_eparams n) (join n v1 v4) (join n (conj n false v2) v3))) (fortho n v0 (join n v2 v4))) *)
rewrite factor0_hom0; try rewrite eq0I; auto.
Qed.

Lemma factor_add n k x1 x2 x3 : x1 <> 0 ->
  hom n 1 x1 -> hom n k.+1 x2 -> hom n k.+1 x3 ->
  x1 ∨ x2 = 0 -> x1 ∨ x3 = 0 ->
  factor n x1 (x2 + x3) = factor n x1 x2 + factor n x1 x3.
Proof.
(* Goal: forall _ : @In (vect n) v (base n k), or (@Logic.eq (vect n) (join n v (dual n v)) (all n)) (@Logic.eq (vect n) (join n v (dual n v)) (scalE (vn_eparams n) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (all n))) *)
generalize k; clear k.
(* Goal: @Logic.eq (vect n) (k2g n (E0 (Kn.vn_eparams p n))) (E0 (vn_eparams n)) *)
induction n as [| n IH]; simpl; auto.
(* Goal: b2Prop false *)
intros k H; case eqK_spec; auto; intros H1 H2; case H; auto; discriminate.
intros k; destruct x1 as [x11 x12]; destruct x2 as [y11 y12];
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (dual n (conj n false (genk n k))) (dual n (genk n (v0 (K1 p))))) (@pair (vect n) (vect n) (scal n k (all n)) (scal n k (genk n (v0 (K1 p))))) *)
  destruct x3 as [z11 z12]; rewrite !andbP; Vfold n.
(* Goal: forall (_ : not (@Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) x11 x12) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (E0 (vn_eparams n))))) (_ : and (b2Prop (hom n O x11)) (b2Prop (hom n (S O) x12))) (_ : and (b2Prop (hom n k y11)) (b2Prop (hom n (S k) y12))) (_ : and (b2Prop (hom n k z11)) (b2Prop (hom n (S k) z12))) (_ : @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (addE (vn_eparams n) (join n x11 y12) (join n (conj n false x12) y11)) (join n x12 y12)) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (E0 (vn_eparams n)))) (_ : @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (addE (vn_eparams n) (join n x11 z12) (join n (conj n false x12) z11)) (join n x12 z12)) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (E0 (vn_eparams n)))), @Logic.eq (prod (vect n) (vect n)) (if eq0 n x12 then @pair (vect n) (vect n) (E0 (vn_eparams n)) (scalE (vn_eparams n) (invK (K1 p) (const n x11)) (addE (vn_eparams n) y11 z11)) else @pair (vect n) (vect n) (factor n x12 (addE (vn_eparams n) (scalE (vn_eparams n) (const n x11) (factor n x12 (addE (vn_eparams n) y12 z12))) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (addE (vn_eparams n) y11 z11)))) (factor n x12 (addE (vn_eparams n) y12 z12))) (let (l3, l5) := if eq0 n x12 then @pair (vect n) (vect n) (E0 (vn_eparams n)) (scalE (vn_eparams n) (invK (K1 p) (const n x11)) y11) else @pair (vect n) (vect n) (factor n x12 (addE (vn_eparams n) (scalE (vn_eparams n) (const n x11) (factor n x12 y12)) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) y11))) (factor n x12 y12) in let (l4, l6) := if eq0 n x12 then @pair (vect n) (vect n) (E0 (vn_eparams n)) (scalE (vn_eparams n) (invK (K1 p) (const n x11)) z11) else @pair (vect n) (vect n) (factor n x12 (addE (vn_eparams n) (scalE (vn_eparams n) (const n x11) (factor n x12 z12)) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) z11))) (factor n x12 z12) in @pair (vect n) (vect n) (addE (vn_eparams n) l3 l4) (addE (vn_eparams n) l5 l6)) *)
fold vect in x11, x12, y11, y12, z11, z12.
(* Goal: forall (_ : not (@Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) x11 x12) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (E0 (vn_eparams n))))) (_ : and (b2Prop (hom n O x11)) (b2Prop (hom n (S O) x12))) (_ : and (b2Prop (hom n k y11)) (b2Prop (hom n (S k) y12))) (_ : and (b2Prop (hom n k z11)) (b2Prop (hom n (S k) z12))) (_ : @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (addE (vn_eparams n) (join n x11 y12) (join n (conj n false x12) y11)) (join n x12 y12)) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (E0 (vn_eparams n)))) (_ : @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (addE (vn_eparams n) (join n x11 z12) (join n (conj n false x12) z11)) (join n x12 z12)) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (E0 (vn_eparams n)))), @Logic.eq (prod (vect n) (vect n)) (if eq0 n x12 then @pair (vect n) (vect n) (E0 (vn_eparams n)) (scalE (vn_eparams n) (invK (K1 p) (const n x11)) (addE (vn_eparams n) y11 z11)) else @pair (vect n) (vect n) (factor n x12 (addE (vn_eparams n) (scalE (vn_eparams n) (const n x11) (factor n x12 (addE (vn_eparams n) y12 z12))) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (addE (vn_eparams n) y11 z11)))) (factor n x12 (addE (vn_eparams n) y12 z12))) (let (l3, l5) := if eq0 n x12 then @pair (vect n) (vect n) (E0 (vn_eparams n)) (scalE (vn_eparams n) (invK (K1 p) (const n x11)) y11) else @pair (vect n) (vect n) (factor n x12 (addE (vn_eparams n) (scalE (vn_eparams n) (const n x11) (factor n x12 y12)) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) y11))) (factor n x12 y12) in let (l4, l6) := if eq0 n x12 then @pair (vect n) (vect n) (E0 (vn_eparams n)) (scalE (vn_eparams n) (invK (K1 p) (const n x11)) z11) else @pair (vect n) (vect n) (factor n x12 (addE (vn_eparams n) (scalE (vn_eparams n) (const n x11) (factor n x12 z12)) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) z11))) (factor n x12 z12) in @pair (vect n) (vect n) (addE (vn_eparams n) l3 l4) (addE (vn_eparams n) l5 l6)) *)
intros H1 (H2,H3) (H4, H5) (H6, H7) HH1 HH2.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (if eq0 n x12 then @pair (vect n) (vect n) (E0 (vn_eparams n)) (scalE (vn_eparams n) (invK (K1 p) (const n x11)) (addE (vn_eparams n) y11 z11)) else @pair (vect n) (vect n) (factor n x12 (addE (vn_eparams n) (scalE (vn_eparams n) (const n x11) (factor n x12 (addE (vn_eparams n) y12 z12))) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (addE (vn_eparams n) y11 z11)))) (factor n x12 (addE (vn_eparams n) y12 z12))) (let (l3, l5) := if eq0 n x12 then @pair (vect n) (vect n) (E0 (vn_eparams n)) (scalE (vn_eparams n) (invK (K1 p) (const n x11)) y11) else @pair (vect n) (vect n) (factor n x12 (addE (vn_eparams n) (scalE (vn_eparams n) (const n x11) (factor n x12 y12)) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) y11))) (factor n x12 y12) in let (l4, l6) := if eq0 n x12 then @pair (vect n) (vect n) (E0 (vn_eparams n)) (scalE (vn_eparams n) (invK (K1 p) (const n x11)) z11) else @pair (vect n) (vect n) (factor n x12 (addE (vn_eparams n) (scalE (vn_eparams n) (const n x11) (factor n x12 z12)) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) z11))) (factor n x12 z12) in @pair (vect n) (vect n) (addE (vn_eparams n) l3 l4) (addE (vn_eparams n) l5 l6)) *)
injection HH1; injection HH2; Vfold n; intros Eq1 Eq2 Eq3 Eq4; clear HH1 HH2.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (if eq0 n x12 then @pair (vect n) (vect n) (E0 (vn_eparams n)) (scalE (vn_eparams n) (invK (K1 p) (const n x11)) (addE (vn_eparams n) y11 z11)) else @pair (vect n) (vect n) (factor n x12 (addE (vn_eparams n) (scalE (vn_eparams n) (const n x11) (factor n x12 (addE (vn_eparams n) y12 z12))) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (addE (vn_eparams n) y11 z11)))) (factor n x12 (addE (vn_eparams n) y12 z12))) (let (l3, l5) := if eq0 n x12 then @pair (vect n) (vect n) (E0 (vn_eparams n)) (scalE (vn_eparams n) (invK (K1 p) (const n x11)) y11) else @pair (vect n) (vect n) (factor n x12 (addE (vn_eparams n) (scalE (vn_eparams n) (const n x11) (factor n x12 y12)) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) y11))) (factor n x12 y12) in let (l4, l6) := if eq0 n x12 then @pair (vect n) (vect n) (E0 (vn_eparams n)) (scalE (vn_eparams n) (invK (K1 p) (const n x11)) z11) else @pair (vect n) (vect n) (factor n x12 (addE (vn_eparams n) (scalE (vn_eparams n) (const n x11) (factor n x12 z12)) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) z11))) (factor n x12 z12) in @pair (vect n) (vect n) (addE (vn_eparams n) l3 l4) (addE (vn_eparams n) l5 l6)) *)
rewrite (hom0E _ _ H2), !constk.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (if eq0 n x12 then @pair (vect n) (vect n) (E0 (vn_eparams n)) (scalE (vn_eparams n) (invK (K1 p) (const n x11)) (addE (vn_eparams n) y11 z11)) else @pair (vect n) (vect n) (factor n x12 (addE (vn_eparams n) (scalE (vn_eparams n) (const n x11) (factor n x12 (addE (vn_eparams n) y12 z12))) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (addE (vn_eparams n) y11 z11)))) (factor n x12 (addE (vn_eparams n) y12 z12))) (let (l3, l5) := if eq0 n x12 then @pair (vect n) (vect n) (E0 (vn_eparams n)) (scalE (vn_eparams n) (invK (K1 p) (const n x11)) y11) else @pair (vect n) (vect n) (factor n x12 (addE (vn_eparams n) (scalE (vn_eparams n) (const n x11) (factor n x12 y12)) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) y11))) (factor n x12 y12) in let (l4, l6) := if eq0 n x12 then @pair (vect n) (vect n) (E0 (vn_eparams n)) (scalE (vn_eparams n) (invK (K1 p) (const n x11)) z11) else @pair (vect n) (vect n) (factor n x12 (addE (vn_eparams n) (scalE (vn_eparams n) (const n x11) (factor n x12 z12)) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) z11))) (factor n x12 z12) in @pair (vect n) (vect n) (addE (vn_eparams n) l3 l4) (addE (vn_eparams n) l5 l6)) *)
case eq0_spec; intros Hex12; subst; Vfold n; Grm0.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite scal_addEr; auto.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (factor n x12 (addE (vn_eparams n) (scalE (vn_eparams n) (const n x11) (factor n x12 (addE (vn_eparams n) y12 z12))) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (addE (vn_eparams n) y11 z11)))) (factor n x12 (addE (vn_eparams n) y12 z12))) (@pair (vect n) (vect n) (addE (vn_eparams n) (factor n x12 (addE (vn_eparams n) (scalE (vn_eparams n) (const n x11) (factor n x12 y12)) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) y11))) (factor n x12 (addE (vn_eparams n) (scalE (vn_eparams n) (const n x11) (factor n x12 z12)) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) z11)))) (addE (vn_eparams n) (factor n x12 y12) (factor n x12 z12))) *)
simpl in y12.
assert (Hf: 
  factor n x12 (y12 + z12) = factor n x12 y12 + factor n x12 z12).
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
   apply IH with (k := k); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply f_equal2 with (f := @pair _ _); auto.
(* Goal: @Logic.eq (vect n) (factor n x12 (addE (vn_eparams n) (scalE (vn_eparams n) (const n x11) (factor n x12 (addE (vn_eparams n) y12 z12))) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (addE (vn_eparams n) y11 z11)))) (addE (vn_eparams n) (factor n x12 (addE (vn_eparams n) (scalE (vn_eparams n) (const n x11) (factor n x12 y12)) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) y11))) (factor n x12 (addE (vn_eparams n) (scalE (vn_eparams n) (const n x11) (factor n x12 z12)) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) z11)))) *)
rewrite Hf.
assert (Heq: forall kk (xx yy zz tt: vect n),
            (kk .* (xx + yy) + (-(1)).* (zz + tt) = 
            (kk .* xx + (-(1)).* zz) + (kk .* yy + (-(1)).* tt))).
(* Goal: forall (kk : Field.K (stype (vn_eparams n))) (xx yy zz tt : vect n), @Logic.eq (E (vn_eparams n)) (addE (vn_eparams n) (scalE (vn_eparams n) kk (addE (vn_eparams n) xx yy)) (scalE (vn_eparams n) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (addE (vn_eparams n) zz tt))) (addE (vn_eparams n) (addE (vn_eparams n) (scalE (vn_eparams n) kk xx) (scalE (vn_eparams n) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) zz)) (addE (vn_eparams n) (scalE (vn_eparams n) kk yy) (scalE (vn_eparams n) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) tt))) *)
(* Goal: @Logic.eq (vect n) (factor n x12 (addE (vn_eparams n) (scalE (vn_eparams n) (const n x11) (addE (vn_eparams n) (factor n x12 y12) (factor n x12 z12))) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (addE (vn_eparams n) y11 z11)))) (addE (vn_eparams n) (factor n x12 (addE (vn_eparams n) (scalE (vn_eparams n) (const n x11) (factor n x12 y12)) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) y11))) (factor n x12 (addE (vn_eparams n) (scalE (vn_eparams n) (const n x11) (factor n x12 z12)) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) z11)))) *)
intros kk xx yy zz tt.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite !scal_addEr, !addE_assoc; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply f_equal2 with (f := add n); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite addE_com, !addE_assoc; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply f_equal2 with (f := add n); auto.
(* Goal: @Logic.eq (vect n) (addE (vn_eparams n) (meet n v4 (dconj n false v1)) (meet n v3 v2)) (addE (vn_eparams n) (meet n v3 v2) (meet n v4 (dconj n false v1))) *)
rewrite addE_com; auto.
(* Goal: @Logic.eq (vect n) (factor n x12 (addE (vn_eparams n) (scalE (vn_eparams n) (const n x11) (addE (vn_eparams n) (factor n x12 y12) (factor n x12 z12))) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (addE (vn_eparams n) y11 z11)))) (addE (vn_eparams n) (factor n x12 (addE (vn_eparams n) (scalE (vn_eparams n) (const n x11) (factor n x12 y12)) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) y11))) (factor n x12 (addE (vn_eparams n) (scalE (vn_eparams n) (const n x11) (factor n x12 z12)) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) z11)))) *)
rewrite Heq; clear Heq.
(* Goal: @Logic.eq (vect n) (factor n x12 (addE (vn_eparams n) (addE (vn_eparams n) (scalE (vn_eparams n) (const n x11) (factor n x12 y12)) (scalE (vn_eparams n) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) y11)) (addE (vn_eparams n) (scalE (vn_eparams n) (const n x11) (factor n x12 z12)) (scalE (vn_eparams n) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) z11)))) (addE (vn_eparams n) (factor n x12 (addE (vn_eparams n) (scalE (vn_eparams n) (const n x11) (factor n x12 y12)) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) y11))) (factor n x12 (addE (vn_eparams n) (scalE (vn_eparams n) (const n x11) (factor n x12 z12)) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) z11)))) *)
destruct k as [| k].
assert (Hv1: x12 ∨ ('C[x11] .* factor n x12 y12 + (- (1)).* y11) = 0).
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
  rewrite join_addr, !join_scalr, <-factor_factor, <-join_scall; auto.
(* Goal: @Logic.eq (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (const n x11) y12) (join n (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) x12) y11)) (E0 (vn_eparams n)) *)
(* Goal: @Logic.eq (vect n) (join n x12 (addE (vn_eparams n) (scalE (vn_eparams n) (const n x11) (factor n x12 z12)) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) z11))) (E0 (vn_eparams n)) *)
  generalize Eq4; pattern x11 at 1; rewrite (hom0E _ _ H2), joinkl.
  rewrite conjf_hom with (1 := H3); simpl expK;
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
  rewrite multK1r; auto.
assert (Hv2: x12 ∨ ('C[x11] .* factor n x12 z12 + (- (1)).* z11) = 0).
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
  rewrite join_addr, !join_scalr, <-factor_factor, <-join_scall; auto.
(* Goal: @Logic.eq (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (const n x11) z12) (join n (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) x12) z11)) (E0 (vn_eparams n)) *)
  generalize Eq2; pattern x11 at 1; rewrite (hom0E _ _ H2), joinkl.
  rewrite conjf_hom with (1 := H3); simpl expK;
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
  rewrite multK1r; auto.
rewrite !factor0_hom0; Grm0;
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
  apply add_hom; try apply scal_hom; try apply factor_hom; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply add_hom; try apply scal_hom; try apply factor_hom; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply add_hom; try apply scal_hom; try apply factor_hom; auto.
apply IH with (k := k); auto;
  try apply add_hom; try apply scal_hom; 
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
  try apply factor_hom; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite join_addr, !join_scalr, <-factor_factor, <-join_scall; auto.
(* Goal: @Logic.eq (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (const n x11) y12) (join n (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) x12) y11)) (E0 (vn_eparams n)) *)
(* Goal: @Logic.eq (vect n) (join n x12 (addE (vn_eparams n) (scalE (vn_eparams n) (const n x11) (factor n x12 z12)) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) z11))) (E0 (vn_eparams n)) *)
generalize Eq4; pattern x11 at 1; rewrite (hom0E _ _ H2), joinkl.
rewrite conjf_hom with (1 := H3); simpl expK;
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
  rewrite multK1r; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite join_addr, !join_scalr, <-factor_factor, <-join_scall; auto.
(* Goal: @Logic.eq (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (const n x11) z12) (join n (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) x12) z11)) (E0 (vn_eparams n)) *)
generalize Eq2; pattern x11 at 1; rewrite (hom0E _ _ H2), joinkl.
rewrite conjf_hom with (1 := H3); simpl expK;
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
  rewrite multK1r; auto.
Qed.

(* Orthogonalité for factorisation, i.e. condition for factorisation to be idempotent *)
Fixpoint fortho n : (vect n) -> (vect n) -> bool :=
  match n return vect n -> vect n -> bool with
  | O => fun x1 x2 => false
  | S n1 =>
        fun x1 x2 =>
        let (x11, x12) := x1 in
        let (x21, x22) := x2 in
        if x12 ?= 0 then x21 ?= 0 else  fortho n1 x12 x21 && fortho n1 x12 x22
   end.

Lemma fortho0 n : 0 < n -> fortho n 0 0.
Proof.
(* Goal: forall _ : lt O n, b2Prop (fortho n (E0 (vn_eparams n)) (E0 (vn_eparams n))) *)
intros H; destruct n; simpl.
(* Goal: b2Prop false *)
(* Goal: b2Prop (if eq0 n (genk n (v0 (K1 p))) then eq0 n (genk n (v0 (K1 p))) else andb (fortho n (genk n (v0 (K1 p))) (genk n (v0 (K1 p)))) (fortho n (genk n (v0 (K1 p))) (genk n (v0 (K1 p))))) *)
contradict H; auto with arith.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite !eq0I; auto.
Qed.

Lemma fortho_refl n x : fortho n x x -> x = 0.
Proof.
(* Goal: forall (b : bool) (k : nat) (_ : b2Prop (hom n k x)), b2Prop (hom n k (dconj n b x)) *)
induction n as [|n IH]; simpl.
(* Goal: b2Prop false *)
intros H; discriminate.
(* Goal: forall _ : b2Prop (let (_, x12) := x in let (x21, x22) := x in if eq0 n x12 then eq0 n x21 else andb (fortho n x12 x21) (fortho n x12 x22)), @Logic.eq (prod (vect n) (vect n)) x (@pair (vect n) (vect n) (genk n (v0 (K1 p))) (genk n (v0 (K1 p)))) *)
destruct x; case eq0_spec.
(* Goal: b2Prop false *)
case eq0_spec; intros; subst; auto; discriminate.
(* Goal: forall (_ : not (@Logic.eq (vect n) v0 (E0 (vn_eparams n)))) (_ : b2Prop (andb (fortho n v0 v) (fortho n v0 v0))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) v v0) (@pair (vect n) (vect n) (genk n (Field.v0 (K1 p))) (genk n (Field.v0 (K1 p)))) *)
intro Hx1; rewrite andbP; intros (Hx2x1, Hx1x2).
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
case Hx1; apply IH; auto.
Qed. 

Lemma forthok n k1 k2 (v: vect n) : v <> 0 -> hom n k1.+1 v -> fortho n v [k2].
Proof.
(* Goal: forall (_ : b2Prop (hom n k1 x)) (_ : b2Prop (hom n (S O) y)) (_ : b2Prop (hom n k2 z)), @Logic.eq (vect n) (meet n (join n x y) z) (addE (vn_eparams n) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n (S (Nat.add k1 k2)))) (meet n x (join n y z))) (join n (meet n x z) y)) *)
generalize k1 k2; clear k1 k2.
(* Goal: forall (k : nat) (_ : b2Prop (hom n k M)), @Logic.eq (vect n) (dconj n false M) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n k)) M) *)
induction n as [| n IH]; simpl; auto; try Vfold n.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros _ _; case eqK_spec; auto; intros H1 H2; subst; auto; case H2; auto.
(* Goal: forall _ : @Logic.eq (E (vn_eparams n)) v (joinl n (decomposek n (first_deg n v) v)), decomposable n (decomposek n (first_deg n v) v) v *)
(* Goal: forall _ : not (@Logic.eq (E (vn_eparams n)) v (joinl n (decomposek n (first_deg n v) v))), not (is_decomposable n v) *)
(* Goal: not (is_decomposable n v) *)
intros k k1; destruct v; rewrite andbP; intros HH.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
case eq0_spec; intros HH2; subst; auto.
(* Goal: b2Prop (eq0 n (E0 (vn_eparams n))) *)
(* Goal: forall (_ : not (@Logic.eq (vect n) v0 (E0 (vn_eparams n)))) (_ : b2Prop (andb (fortho n v0 v1) (fortho n v0 v2))) (_ : b2Prop (andb (fortho n v0 v3) (fortho n v0 v4))), b2Prop (andb (fortho n v0 (addE (vn_eparams n) (join n v1 v4) (join n (conj n false v2) v3))) (fortho n v0 (join n v2 v4))) *)
rewrite eq0I; auto.
(* Goal: forall _ : and (b2Prop (hom n k v)) (b2Prop (hom n (S k) v0)), b2Prop (andb (fortho n v0 (E0 (vn_eparams n))) (fortho n v0 (genk n k1))) *)
intros (H1, H2).
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite (IH _ k), (IH _ k 0%f); auto.
Qed.

Lemma fortho_scal n k v1 v2 : fortho n v1 v2 -> fortho n v1 (k .* v2).
Proof.
(* Goal: forall (k : nat) (_ : b2Prop (hom n k M)), @Logic.eq (vect n) (dconj n false M) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n k)) M) *)
induction n as [| n IH]; simpl; auto; try Vfold n.
(* Goal: forall _ : @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (genk n (Field.v0 (K1 p))) (if eq0 n (one_factor n k2 v) then one_factor n (S k2) v0 else one_factor n k2 v)) (@pair (vect n) (vect n) (genk n (Field.v0 (K1 p))) (genk n (Field.v0 (K1 p)))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) v v0) (@pair (vect n) (vect n) (genk n (Field.v0 (K1 p))) (genk n (Field.v0 (K1 p)))) *)
destruct v1; destruct v2; case eq0_spec; auto.
(* Goal: forall (_ : @Logic.eq (vect n) v0 (E0 (vn_eparams n))) (_ : b2Prop (eq0 n v1)), b2Prop (eq0 n (scalE (vn_eparams n) k v1)) *)
(* Goal: forall (_ : not (@Logic.eq (vect n) v0 (E0 (vn_eparams n)))) (_ : b2Prop (andb (fortho n v0 v1) (fortho n v0 v2))), b2Prop (andb (fortho n v0 (scalE (vn_eparams n) k v1)) (fortho n v0 (scalE (vn_eparams n) k v2))) *)
case eq0_spec; auto; intros; subst; try discriminate; Grm0.
(* Goal: b2Prop (eq0 n (E0 (vn_eparams n))) *)
(* Goal: forall (_ : not (@Logic.eq (vect n) v0 (E0 (vn_eparams n)))) (_ : b2Prop (andb (fortho n v0 v1) (fortho n v0 v2))) (_ : b2Prop (andb (fortho n v0 v3) (fortho n v0 v4))), b2Prop (andb (fortho n v0 (addE (vn_eparams n) (join n v1 v4) (join n (conj n false v2) v3))) (fortho n v0 (join n v2 v4))) *)
rewrite eq0I; auto.
(* Goal: forall (_ : not (@Logic.eq (vect n) v0 (E0 (vn_eparams n)))) (_ : b2Prop (andb (fortho n v0 v1) (fortho n v0 v2))), b2Prop (andb (fortho n v0 (scalE (vn_eparams n) k v1)) (fortho n v0 (scalE (vn_eparams n) k v2))) *)
rewrite andbP; intros Hy1 (Hr1, Hr2).
(* Goal: and (b2Prop (fortho n v0 (conj n (negb b) v1))) (b2Prop (fortho n v0 (conj n b v2))) *)
rewrite !IH; auto.
Qed.

Lemma fortho_add n v1 v2 v3 : 
  fortho n v1 v2 -> fortho n v1 v3 -> fortho n v1 (v2 + v3).
Proof.
(* Goal: forall (k : nat) (_ : b2Prop (hom n k M)), @Logic.eq (vect n) (dconj n false M) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n k)) M) *)
induction n as [| n IH]; simpl; auto; try Vfold n.
(* Goal: forall (_ : b2Prop (let (_, x12) := v1 in let (x21, x22) := v2 in if eq0 n x12 then eq0 n x21 else andb (fortho n x12 x21) (fortho n x12 x22))) (_ : b2Prop (let (_, x12) := v1 in let (x21, x22) := v3 in if eq0 n x12 then eq0 n x21 else andb (fortho n x12 x21) (fortho n x12 x22))), b2Prop (let (_, x12) := v1 in let (x21, x22) := let (x1, x2) := v2 in let (y1, y2) := v3 in @pair (vect n) (vect n) (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) (join n x2 y2) in if eq0 n x12 then eq0 n x21 else andb (fortho n x12 x21) (fortho n x12 x22)) *)
destruct v1; destruct v2; destruct v3.
(* Goal: forall (_ : b2Prop (if eq0 n v0 then eq0 n v1 else andb (fortho n v0 v1) (fortho n v0 v2))) (_ : b2Prop (if eq0 n v0 then eq0 n v3 else andb (fortho n v0 v3) (fortho n v0 v4))), b2Prop (if eq0 n v0 then eq0 n (addE (vn_eparams n) (join n v1 v4) (join n (conj n false v2) v3)) else andb (fortho n v0 (addE (vn_eparams n) (join n v1 v4) (join n (conj n false v2) v3))) (fortho n v0 (join n v2 v4))) *)
case eq0_spec.
  do 2 (case eq0_spec; auto; try (intros; discriminate));
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n (E0 (vn_eparams n)) y2) (join n (genk n (const n x2)) (genk n (const n y1)))) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n (E0 (vn_eparams n)) y2) (join n (genk n (const n x2)) (genk n (const n y1)))) z2) (addE (vn_eparams n) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n (S (Nat.add O k2)))) (meet n (genk n (const n x2)) (join n y2 (dconj n false z1)))) (join n (meet n (genk n (const n x2)) (dconj n false z1)) y2)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add O (S k2)))))) (meet n (E0 (vn_eparams n)) (addE (vn_eparams n) (join n (genk n (const n y1)) z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n (E0 (vn_eparams n)) z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) z2) (meet n (genk n (const n x2)) (dconj n false z1)))) (genk n (const n y1))))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add O (S k2)))))) (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) (join n y2 z2)) (meet n (genk n (const n x2)) (dconj n false (addE (vn_eparams n) (join n (genk n (const n y1)) z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) z2) (meet n (genk n (const n x2)) (dconj n false z1))) y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (eq0 n z1) (hom n O z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (hom n k2 z1) (hom n (S k2) z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
  intros; subst; Grm0.
(* Goal: b2Prop (eq0 n (E0 (vn_eparams n))) *)
(* Goal: forall (_ : not (@Logic.eq (vect n) v0 (E0 (vn_eparams n)))) (_ : b2Prop (andb (fortho n v0 v1) (fortho n v0 v2))) (_ : b2Prop (andb (fortho n v0 v3) (fortho n v0 v4))), b2Prop (andb (fortho n v0 (addE (vn_eparams n) (join n v1 v4) (join n (conj n false v2) v3))) (fortho n v0 (join n v2 v4))) *)
  rewrite eq0I; auto.
(* Goal: forall (_ : not (@Logic.eq (vect n) v0 (E0 (vn_eparams n)))) (_ : b2Prop (andb (fortho n v0 v1) (fortho n v0 v2))) (_ : b2Prop (andb (fortho n v0 v3) (fortho n v0 v4))), b2Prop (andb (fortho n v0 (addE (vn_eparams n) (join n v1 v4) (join n (conj n false v2) v3))) (fortho n v0 (join n v2 v4))) *)
rewrite andbP, andbP; intros Hy1 (H1, H2) (H3, H4).
(* Goal: and (b2Prop (fortho n v0 (conj n (negb b) v1))) (b2Prop (fortho n v0 (conj n b v2))) *)
rewrite !IH; auto.
Qed.

Lemma fortho_conj n b v1 v2 : fortho n v1 v2 -> fortho n v1 (v2 ^_ b).
Proof.
(* Goal: @Logic.eq (Field.K (K1 p)) (const n (dconj n b x)) (if b then multK (K1 p) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (S n)) (const n x) else multK (K1 p) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) n) (const n x)) *)
generalize b; clear b.
(* Goal: forall (k : nat) (_ : b2Prop (hom n k M)), @Logic.eq (vect n) (dconj n false M) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n k)) M) *)
induction n as [| n IH]; simpl; auto; try Vfold n.
(* Goal: forall (b : bool) (_ : b2Prop (let (_, x12) := v1 in let (x21, x22) := v2 in if eq0 n x12 then eq0 n x21 else andb (fortho n x12 x21) (fortho n x12 x22))), b2Prop (let (_, x12) := v1 in let (x21, x22) := let (l2, l3) := v2 in @pair (vect n) (vect n) (conj n (negb b) l2) (conj n b l3) in if eq0 n x12 then eq0 n x21 else andb (fortho n x12 x21) (fortho n x12 x22)) *)
intros b; destruct v1; destruct v2.
(* Goal: forall (_ : b2Prop (if eq0 n v0 then eq0 n v1 else andb (fortho n v0 v1) (fortho n v0 v2))) (_ : b2Prop (if eq0 n v0 then eq0 n v3 else andb (fortho n v0 v3) (fortho n v0 v4))), b2Prop (if eq0 n v0 then eq0 n (addE (vn_eparams n) (join n v1 v4) (join n (conj n false v2) v3)) else andb (fortho n v0 (addE (vn_eparams n) (join n v1 v4) (join n (conj n false v2) v3))) (fortho n v0 (join n v2 v4))) *)
case eq0_spec.
  case eq0_spec; auto; try (intros; discriminate);
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n (E0 (vn_eparams n)) y2) (join n (genk n (const n x2)) (genk n (const n y1)))) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n (E0 (vn_eparams n)) y2) (join n (genk n (const n x2)) (genk n (const n y1)))) z2) (addE (vn_eparams n) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n (S (Nat.add O k2)))) (meet n (genk n (const n x2)) (join n y2 (dconj n false z1)))) (join n (meet n (genk n (const n x2)) (dconj n false z1)) y2)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add O (S k2)))))) (meet n (E0 (vn_eparams n)) (addE (vn_eparams n) (join n (genk n (const n y1)) z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n (E0 (vn_eparams n)) z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) z2) (meet n (genk n (const n x2)) (dconj n false z1)))) (genk n (const n y1))))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add O (S k2)))))) (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) (join n y2 z2)) (meet n (genk n (const n x2)) (dconj n false (addE (vn_eparams n) (join n (genk n (const n y1)) z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) z2) (meet n (genk n (const n x2)) (dconj n false z1))) y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (eq0 n z1) (hom n O z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (hom n k2 z1) (hom n (S k2) z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
  intros; subst; Grm0.
(* Goal: b2Prop (eq0 n (E0 (vn_eparams n))) *)
(* Goal: forall (_ : not (@Logic.eq (vect n) v0 (E0 (vn_eparams n)))) (_ : b2Prop (andb (fortho n v0 v1) (fortho n v0 v2))) (_ : b2Prop (andb (fortho n v0 v3) (fortho n v0 v4))), b2Prop (andb (fortho n v0 (addE (vn_eparams n) (join n v1 v4) (join n (conj n false v2) v3))) (fortho n v0 (join n v2 v4))) *)
  rewrite eq0I; auto.
(* Goal: forall (_ : not (@Logic.eq (vect n) v0 (E0 (vn_eparams n)))) (_ : b2Prop (andb (fortho n v0 v1) (fortho n v0 v2))), b2Prop (andb (fortho n v0 (conj n (negb b) v1)) (fortho n v0 (conj n b v2))) *)
rewrite andbP, andbP; intros Hy1 (H1, H2).
(* Goal: and (b2Prop (fortho n v0 (conj n (negb b) v1))) (b2Prop (fortho n v0 (conj n b v2))) *)
rewrite !IH; auto.
Qed.

Lemma fortho_join n v1 v2 v3 : 
  fortho n v1 v2 -> fortho n v1 v3 -> fortho n v1 (v2 ∨ v3).
Proof.
(* Goal: @Logic.eq (vect n) (dual n (addE (vn_eparams n) v1 v2)) (addE (vn_eparams n) (dual n v1) (dual n v2)) *)
induction n as [| n IH]; simpl; auto; Vfold n.
(* Goal: forall (_ : b2Prop (let (_, x12) := v1 in let (x21, x22) := v2 in if eq0 n x12 then eq0 n x21 else andb (fortho n x12 x21) (fortho n x12 x22))) (_ : b2Prop (let (_, x12) := v1 in let (x21, x22) := v3 in if eq0 n x12 then eq0 n x21 else andb (fortho n x12 x21) (fortho n x12 x22))), b2Prop (let (_, x12) := v1 in let (x21, x22) := let (x1, x2) := v2 in let (y1, y2) := v3 in @pair (vect n) (vect n) (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) (join n x2 y2) in if eq0 n x12 then eq0 n x21 else andb (fortho n x12 x21) (fortho n x12 x22)) *)
destruct v1; destruct v2; destruct v3.
(* Goal: forall (_ : b2Prop (if eq0 n v0 then eq0 n v1 else andb (fortho n v0 v1) (fortho n v0 v2))) (_ : b2Prop (if eq0 n v0 then eq0 n v3 else andb (fortho n v0 v3) (fortho n v0 v4))), b2Prop (if eq0 n v0 then eq0 n (addE (vn_eparams n) (join n v1 v4) (join n (conj n false v2) v3)) else andb (fortho n v0 (addE (vn_eparams n) (join n v1 v4) (join n (conj n false v2) v3))) (fortho n v0 (join n v2 v4))) *)
case eq0_spec.
  do 2 (case eq0_spec; auto; try (intros; discriminate));
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n (E0 (vn_eparams n)) y2) (join n (genk n (const n x2)) (genk n (const n y1)))) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n (E0 (vn_eparams n)) y2) (join n (genk n (const n x2)) (genk n (const n y1)))) z2) (addE (vn_eparams n) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n (S (Nat.add O k2)))) (meet n (genk n (const n x2)) (join n y2 (dconj n false z1)))) (join n (meet n (genk n (const n x2)) (dconj n false z1)) y2)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add O (S k2)))))) (meet n (E0 (vn_eparams n)) (addE (vn_eparams n) (join n (genk n (const n y1)) z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n (E0 (vn_eparams n)) z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) z2) (meet n (genk n (const n x2)) (dconj n false z1)))) (genk n (const n y1))))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add O (S k2)))))) (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) (join n y2 z2)) (meet n (genk n (const n x2)) (dconj n false (addE (vn_eparams n) (join n (genk n (const n y1)) z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) z2) (meet n (genk n (const n x2)) (dconj n false z1))) y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (eq0 n z1) (hom n O z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (hom n k2 z1) (hom n (S k2) z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
  intros; subst; Grm0.
(* Goal: b2Prop (eq0 n (E0 (vn_eparams n))) *)
(* Goal: forall (_ : not (@Logic.eq (vect n) v0 (E0 (vn_eparams n)))) (_ : b2Prop (andb (fortho n v0 v1) (fortho n v0 v2))) (_ : b2Prop (andb (fortho n v0 v3) (fortho n v0 v4))), b2Prop (andb (fortho n v0 (addE (vn_eparams n) (join n v1 v4) (join n (conj n false v2) v3))) (fortho n v0 (join n v2 v4))) *)
  rewrite eq0I; auto.
(* Goal: forall (_ : not (@Logic.eq (vect n) v0 (E0 (vn_eparams n)))) (_ : b2Prop (andb (fortho n v0 v1) (fortho n v0 v2))) (_ : b2Prop (andb (fortho n v0 v3) (fortho n v0 v4))), b2Prop (andb (fortho n v0 (addE (vn_eparams n) (join n v1 v4) (join n (conj n false v2) v3))) (fortho n v0 (join n v2 v4))) *)
rewrite andbP, andbP; intros Hy1 (H1, H2) (H3, H4).
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite fortho_add, !IH; auto.
(* Goal: @Logic.eq (vect n) (meet n (meet n v v1) v3) (meet n v (meet n v1 v3)) *)
(* Goal: @Logic.eq (vect n) (addE (vn_eparams n) (meet n (meet n v v1) v4) (meet n (addE (vn_eparams n) (meet n v v2) (meet n v0 (dconj n false v1))) (dconj n false v3))) (addE (vn_eparams n) (meet n v (addE (vn_eparams n) (meet n v1 v4) (meet n v2 (dconj n false v3)))) (meet n v0 (dconj n false (meet n v1 v3)))) *)
rewrite IH; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite fortho_conj; auto.
Qed.

Lemma fortho_joinl n k v l : v <> 0 -> hom n k.+1 v -> 
  (forall v1, In v1 l -> fortho n v v1) -> fortho n v (joinl n l).
Proof.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros Hv Hhv; induction l as [| a l IH]; simpl; try Vfold n; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros; apply (forthok n k 0%f); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros; destruct l; auto.
(* Goal: b2Prop (fortho n v (join n a (joinl n (@cons (vect n) v0 l)))) *)
apply fortho_join; auto with datatypes.
Qed.

(* Here we are *)
Lemma factor_ortho n x1 x2 : x1 <> 0 -> hom n 1 x1 -> 
    fortho n x1 x2 -> factor n x1 (x1 ∨ x2) = x2.
Proof.
(* Goal: forall (k : nat) (_ : b2Prop (hom n k M)), @Logic.eq (vect n) (dconj n false M) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n k)) M) *)
induction n as [| n IH]; simpl; auto; try Vfold n.
(* Goal: @Logic.eq bool (eqK (K1 p) (v0 (K1 p)) (v0 (K1 p))) true *)
(* Goal: @Logic.eq bool (if eq0 n (genk n (v0 (K1 p))) then eq0 n (genk n (v0 (K1 p))) else false) true *)
intros H1 H2; case H1; generalize H2; case eqK_spec; auto.
(* Goal: b2Prop false *)
intros; discriminate.
(* Goal: forall (_ : b2Prop (if eq0 n v0 then eq0 n v1 else andb (fortho n v0 v1) (fortho n v0 v2))) (_ : b2Prop (if eq0 n v0 then eq0 n v3 else andb (fortho n v0 v3) (fortho n v0 v4))), b2Prop (if eq0 n v0 then eq0 n (addE (vn_eparams n) (join n v1 v4) (join n (conj n false v2) v3)) else andb (fortho n v0 (addE (vn_eparams n) (join n v1 v4) (join n (conj n false v2) v3))) (fortho n v0 (join n v2 v4))) *)
destruct x2 as [y1 y2]; destruct x1 as [x1 x2]; case eq0_spec.
rewrite andbP; case eq0_spec; intros Hx2 Hy1 HH (HH1,HH2) Ht;
(* Goal: b2Prop false *)
  subst; Grm0; try discriminate.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (factor n x2 (addE (vn_eparams n) (scalE (vn_eparams n) (const n x1) y2) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1))))) y2) (@pair (vect n) (vect n) y1 y2) *)
pattern x1 at 2; rewrite (hom0E _ _ HH1).
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite joinkl, <-scal_multE, invKr, scalE1; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros HH3; case HH; rewrite (hom0E _ _ HH1), HH3; auto.
(* Goal: b2Prop false *)
rewrite andbP, andbP; intros Hy1 HH (HH1,HH2) (Ht1, Ht2); try discriminate.
(* Goal: @Logic.eq (vect n) (meet n (meet n v v1) v3) (meet n v (meet n v1 v3)) *)
(* Goal: @Logic.eq (vect n) (addE (vn_eparams n) (meet n (meet n v v1) v4) (meet n (addE (vn_eparams n) (meet n v v2) (meet n v0 (dconj n false v1))) (dconj n false v3))) (addE (vn_eparams n) (meet n v (addE (vn_eparams n) (meet n v1 v4) (meet n v2 (dconj n false v3)))) (meet n v0 (dconj n false (meet n v1 v3)))) *)
rewrite IH; auto.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (factor n x2 (addE (vn_eparams n) (scalE (vn_eparams n) (const n x1) y2) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1))))) y2) (@pair (vect n) (vect n) y1 y2) *)
pattern x1 at 2; rewrite (hom0E _ _ HH1).
rewrite joinkl, scal_addEr, <-scal_multE,
        <-addE_assoc, <-scal_addEl, <-opp_multKl, multK1l, oppKr;
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n (E0 (vn_eparams n)) y2) (join n (genk n (const n x2)) (genk n (const n y1)))) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n (E0 (vn_eparams n)) y2) (join n (genk n (const n x2)) (genk n (const n y1)))) z2) (addE (vn_eparams n) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n (S (Nat.add O k2)))) (meet n (genk n (const n x2)) (join n y2 (dconj n false z1)))) (join n (meet n (genk n (const n x2)) (dconj n false z1)) y2)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add O (S k2)))))) (meet n (E0 (vn_eparams n)) (addE (vn_eparams n) (join n (genk n (const n y1)) z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n (E0 (vn_eparams n)) z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) z2) (meet n (genk n (const n x2)) (dconj n false z1)))) (genk n (const n y1))))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add O (S k2)))))) (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) (join n y2 z2)) (meet n (genk n (const n x2)) (dconj n false (addE (vn_eparams n) (join n (genk n (const n y1)) z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) z2) (meet n (genk n (const n x2)) (dconj n false z1))) y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (eq0 n z1) (hom n O z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (hom n k2 z1) (hom n (S k2) z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
  Grm0.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (factor n x2 (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (join n (conj n false x2) y1))) y2) (@pair (vect n) (vect n) y1 y2) *)
rewrite factor_scal, (conjf_hom _ _ _ HH2); simpl expK.
rewrite multK1r, join_scall, factor_scal, IH, <-scal_multE,
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
        multK_m1_m1, scalE1; auto.
Qed.

(* Getting the canceling factor for fortho *)
Fixpoint fget n : (vect n) -> (vect n) -> K :=
  match n return vect n -> vect n -> K with
  | O => fun x1 x2 => 0%f
  | S n1 =>
        fun x1 x2 =>
        let (x11, x12) := x1 in
        let (x21, x22) := x2 in
        if x12 ?= 0 then (('C[x11])^-1 * 'C[x21])%f else fget n1 x12 x22
   end.

Lemma fget_scal n k x1 x2 : fget n x1 (k .* x2) = (k *  fget n x1 x2)%f.
Proof.
(* Goal: @Logic.eq (Field.K (K1 p)) (fget n x1 (scalE (vn_eparams n) k x2)) (multK (stype (vn_eparams n)) k (fget n x1 x2)) *)
induction n as [| n IH]; simpl; auto; try Vfold n; Krm0.
(* Goal: forall _ : @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (genk n (Field.v0 (K1 p))) (if eq0 n (one_factor n k2 v) then one_factor n (S k2) v0 else one_factor n k2 v)) (@pair (vect n) (vect n) (genk n (Field.v0 (K1 p))) (genk n (Field.v0 (K1 p)))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) v v0) (@pair (vect n) (vect n) (genk n (Field.v0 (K1 p))) (genk n (Field.v0 (K1 p)))) *)
destruct x1; destruct x2; case eq0_spec; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite const_scal, <-!multK_assoc, (multK_com _ Hp k); auto.
Qed.

Lemma fortho_fget n x1 x2 : x1 <> 0 -> hom n 1 x1 -> hom n 1 x2 ->
    fortho n x1 (x2 + (-(1) * fget n x1 x2)%f .* x1).
Proof.
(* Goal: forall (k : nat) (_ : b2Prop (hom n k M)), @Logic.eq (vect n) (dconj n false M) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n k)) M) *)
induction n as [| n IH]; simpl; auto; try Vfold n.
(* Goal: forall (_ : not (@Logic.eq (Field.K (K1 p)) x1 (v0 (K1 p)))) (_ : b2Prop (eqK (K1 p) x1 (v0 (K1 p)))) (_ : b2Prop (eqK (K1 p) x2 (v0 (K1 p)))), b2Prop false *)
(* Goal: forall (_ : not (@Logic.eq (prod (vect n) (vect n)) x1 (@pair (vect n) (vect n) (E0 (vn_eparams n)) (E0 (vn_eparams n))))) (_ : b2Prop (let (l2, l3) := x1 in andb (hom n O l2) (hom n (S O) l3))) (_ : b2Prop (let (l2, l3) := x2 in andb (hom n O l2) (hom n (S O) l3))), b2Prop (let (_, x12) := x1 in let (x21, x22) := let (l3, l5) := x2 in let (l4, l6) := let (l2, l4) := x1 in @pair (vect n) (vect n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (let (x13, x14) := x1 in let (x21, x22) := x2 in if eq0 n x14 then multK (K1 p) (invK (K1 p) (const n x13)) (const n x21) else fget n x14 x22)) l2) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (let (x13, x14) := x1 in let (x21, x22) := x2 in if eq0 n x14 then multK (K1 p) (invK (K1 p) (const n x13)) (const n x21) else fget n x14 x22)) l4) in @pair (vect n) (vect n) (addE (vn_eparams n) l3 l4) (addE (vn_eparams n) l5 l6) in if eq0 n x12 then eq0 n x21 else andb (fortho n x12 x21) (fortho n x12 x22)) *)
case eqK_spec; auto; try (intros; discriminate).
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros HH HH1; case HH1; auto.
(* Goal: forall (_ : not (@Logic.eq (prod (vect n) (vect n)) x1 (@pair (vect n) (vect n) (E0 (vn_eparams n)) (E0 (vn_eparams n))))) (_ : b2Prop (let (l2, l3) := x1 in andb (hom n O l2) (hom n (S O) l3))) (_ : b2Prop (let (l2, l3) := x2 in andb (hom n O l2) (hom n (S O) l3))), b2Prop (let (_, x12) := x1 in let (x21, x22) := let (l3, l5) := x2 in let (l4, l6) := let (l2, l4) := x1 in @pair (vect n) (vect n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (let (x13, x14) := x1 in let (x21, x22) := x2 in if eq0 n x14 then multK (K1 p) (invK (K1 p) (const n x13)) (const n x21) else fget n x14 x22)) l2) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (let (x13, x14) := x1 in let (x21, x22) := x2 in if eq0 n x14 then multK (K1 p) (invK (K1 p) (const n x13)) (const n x21) else fget n x14 x22)) l4) in @pair (vect n) (vect n) (addE (vn_eparams n) l3 l4) (addE (vn_eparams n) l5 l6) in if eq0 n x12 then eq0 n x21 else andb (fortho n x12 x21) (fortho n x12 x22)) *)
destruct x2 as [y1 y2]; destruct x1 as [x1 x2].
(* Goal: forall (_ : not (@Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) x1 x2) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (E0 (vn_eparams n))))) (_ : b2Prop (andb (hom n O x1) (hom n (S O) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))), b2Prop (if eq0 n x2 then eq0 n (addE (vn_eparams n) y1 (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (if eq0 n x2 then multK (K1 p) (invK (K1 p) (const n x1)) (const n y1) else fget n x2 y2)) x1)) else andb (fortho n x2 (addE (vn_eparams n) y1 (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (if eq0 n x2 then multK (K1 p) (invK (K1 p) (const n x1)) (const n y1) else fget n x2 y2)) x1))) (fortho n x2 (addE (vn_eparams n) y2 (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (if eq0 n x2 then multK (K1 p) (invK (K1 p) (const n x1)) (const n y1) else fget n x2 y2)) x2)))) *)
intros HH; rewrite !andbP; intros (H1, H2) (H3, H4).
(* Goal: b2Prop (if eq0 n x2 then eq0 n (addE (vn_eparams n) y1 (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (if eq0 n x2 then multK (K1 p) (invK (K1 p) (const n x1)) (const n y1) else fget n x2 y2)) x1)) else andb (fortho n x2 (addE (vn_eparams n) y1 (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (if eq0 n x2 then multK (K1 p) (invK (K1 p) (const n x1)) (const n y1) else fget n x2 y2)) x1))) (fortho n x2 (addE (vn_eparams n) y2 (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (if eq0 n x2 then multK (K1 p) (invK (K1 p) (const n x1)) (const n y1) else fget n x2 y2)) x2)))) *)
pattern x1 at 2 4; rewrite (hom0E _ _ H1).
(* Goal: b2Prop (if eq0 n x2 then eq0 n (addE (vn_eparams n) y1 (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (if eq0 n x2 then multK (K1 p) (invK (K1 p) (const n x1)) (const n y1) else fget n x2 y2)) (genk n (const n x1)))) else andb (fortho n x2 (addE (vn_eparams n) y1 (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (if eq0 n x2 then multK (K1 p) (invK (K1 p) (const n x1)) (const n y1) else fget n x2 y2)) (genk n (const n x1))))) (fortho n x2 (addE (vn_eparams n) y2 (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (if eq0 n x2 then multK (K1 p) (invK (K1 p) (const n x1)) (const n y1) else fget n x2 y2)) x2)))) *)
pattern y1 at 1 3; rewrite (hom0E _ _ H3).
(* Goal: b2Prop (if eq0 n x2 then eq0 n (addE (vn_eparams n) (genk n (const n y1)) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (if eq0 n x2 then multK (K1 p) (invK (K1 p) (const n x1)) (const n y1) else fget n x2 y2)) (genk n (const n x1)))) else andb (fortho n x2 (addE (vn_eparams n) (genk n (const n y1)) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (if eq0 n x2 then multK (K1 p) (invK (K1 p) (const n x1)) (const n y1) else fget n x2 y2)) (genk n (const n x1))))) (fortho n x2 (addE (vn_eparams n) y2 (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (if eq0 n x2 then multK (K1 p) (invK (K1 p) (const n x1)) (const n y1) else fget n x2 y2)) x2)))) *)
case eq0_spec; intros H5; subst.
rewrite !scalk, addk, (multK_com _ Hp ('C[x1]^-1)%f), !multK_assoc,
        invKr, multK1r; Krm1.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite oppKr, eq0I; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros HH1; case HH; rewrite (hom0E _ _ H1), HH1; auto.
(* Goal: b2Prop (andb (fortho n x2 (addE (vn_eparams n) (genk n (const n y1)) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (fget n x2 y2)) (genk n (const n x1))))) (fortho n x2 (addE (vn_eparams n) y2 (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (fget n x2 y2)) x2)))) *)
rewrite andbP; split.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply fortho_add; try apply fortho_genk; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
repeat apply fortho_scal; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply forthok with 0%nat; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
repeat apply fortho_scal; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply forthok with 0%nat; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply IH; auto.
Qed.

Lemma joinl_addmult n (f: vect n -> vect n -> K) x l :
hom n 1 x -> (forall i, In i l -> hom n 1 i) ->
x ∨ joinl n l = x ∨ joinl n (map (fun y => (y + (f x y) .* x)) l).
Proof.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros Hk1 Hl; induction l as [| a l IH]; auto.
(* Goal: @Logic.eq (E (vn_eparams n)) (joinl n (@cons (E (vn_eparams n)) b l)) (scalE (vn_eparams n) (invK (stype (vn_eparams n)) a) (joinl n (@cons (E (vn_eparams n)) (mprod (vn_eparams n) (@cons (Field.K (stype (vn_eparams n))) a ll) (@cons (E (vn_eparams n)) b l)) l))) *)
case (list_case _ l); intros Hll.
(* Goal: @Logic.eq (vect (S n)) (dual (S n) (join (S n) v1 v2)) (meet (S n) (dual (S n) v1) (dual (S n) v2)) *)
subst; simpl; Vfold n.
(* Goal: @Logic.eq (vect n) (join n x a) (join n x (addE (vn_eparams n) a (scalE (vn_eparams n) (f x a) x))) *)
(* Goal: @Logic.eq (vect n) (join n x (joinl n (@cons (vect n) a l))) (join n x (joinl n (@map (E (vn_eparams n)) (E (vn_eparams n)) (fun y : E (vn_eparams n) => addE (vn_eparams n) y (scalE (vn_eparams n) (f x y) x)) (@cons (vect n) a l)))) *)
rewrite join_addr, !join_scalr, join_hom1_id; Grm0.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (dual n (conj n false (genk n k))) (dual n (genk n (v0 (K1 p))))) (@pair (vect n) (vect n) (scal n k (all n)) (scal n k (genk n (v0 (K1 p))))) *)
simpl map; rewrite !joinlS; auto; Vfold n.
(* Goal: @Logic.eq (vect n) (join n x (join n a (joinl n l))) (join n x (join n (addE (vn_eparams n) a (scalE (vn_eparams n) (f x a) x)) (joinl n (@map (vect n) (vect n) (fun y : vect n => addE (vn_eparams n) y (scalE (vn_eparams n) (f x y) x)) l)))) *)
(* Goal: not (@Logic.eq (list (vect n)) (@map (vect n) (vect n) (fun y : vect n => addE (vn_eparams n) y (scalE (vn_eparams n) (f x y) x)) l) (@nil (vect n))) *)
rewrite <-!join_assoc, join_addr, !join_scalr, join_hom1_id; Grm0.
(* Goal: @Logic.eq (vect n) (join n (join n x a) (joinl n l)) (join n (join n x a) (joinl n (@map (vect n) (vect n) (fun y : vect n => addE (vn_eparams n) y (scalE (vn_eparams n) (f x y) x)) l))) *)
(* Goal: not (@Logic.eq (list (vect n)) (@map (vect n) (vect n) (fun y : vect n => addE (vn_eparams n) y (scalE (vn_eparams n) (f x y) x)) l) (@nil (vect n))) *)
rewrite (join_hom_com n 1 1 a x); auto with datatypes.
(* Goal: @Logic.eq (vect n) (join n (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.mul (S O) (S O))) (join n a x)) (joinl n l)) (join n (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.mul (S O) (S O))) (join n a x)) (joinl n (@map (vect n) (vect n) (fun y : vect n => addE (vn_eparams n) y (scalE (vn_eparams n) (f x y) x)) l))) *)
(* Goal: not (@Logic.eq (list (vect n)) (@map (vect n) (vect n) (fun y : vect n => addE (vn_eparams n) y (scalE (vn_eparams n) (f x y) x)) l) (@nil (vect n))) *)
rewrite !join_scall, !join_assoc, IH; auto with datatypes.
(* Goal: b2Prop false *)
destruct l; auto; intros HH; discriminate.
Qed.

Lemma mprod_hom n k l1 l2 :
  (forall i, In i l2 -> hom n k i) -> hom n k (l1 *X* l2).
Proof.
(* Goal: forall _ : forall (i : vect n) (_ : @In (vect n) i l2), b2Prop (hom n k i), b2Prop (hom n k (mprod (vn_eparams n) l1 l2)) *)
generalize k l2; clear k l2.
(* Goal: forall (k : nat) (l2 : list (vect n)) (_ : forall (i : vect n) (_ : @In (vect n) i l2), b2Prop (hom n k i)), b2Prop (hom n k (mprod (vn_eparams n) l1 l2)) *)
induction l1 as [| a l1 IH].
(* Goal: b2Prop (andb true (hom n (S O) (genk n (v0 (K1 p))))) *)
(* Goal: b2Prop (andb true (hom n (S O) (gen n k))) *)
intros; rewrite mprod0l; apply homk0.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros k [| b l2] H; auto.
(* Goal: b2Prop (andb true (hom n (S O) (genk n (v0 (K1 p))))) *)
(* Goal: b2Prop (andb true (hom n (S O) (gen n k))) *)
rewrite mprod0r; apply homk0.
(* Goal: b2Prop (hom n k (mprod (vn_eparams n) (@cons (Field.K (stype (vn_eparams n))) a l1) (@cons (vect n) b l2))) *)
rewrite mprod_S; auto with datatypes.
Qed.

Hint Resolve mprod_hom.

Definition is_decomposable n M := exists l, decomposable n l M.

Lemma joinl_factor n x M : x <> 0 -> hom n 1 x ->
  is_decomposable n M -> x ∨ M = 0 ->
    exists k, exists l, (forall v, In v l -> hom n 1 v) /\ M = k .* joinl n (x::l).
Proof.
(* Goal: forall (_ : not (@Logic.eq (E (vn_eparams n)) x (E0 (vn_eparams n)))) (_ : b2Prop (hom n (S O) x)) (_ : is_decomposable n M) (_ : @Logic.eq (vect n) (join n x M) (E0 (vn_eparams n))), @ex (Field.K (stype (vn_eparams n))) (fun k : Field.K (stype (vn_eparams n)) => @ex (list (vect n)) (fun l : list (vect n) => and (forall (v : vect n) (_ : @In (vect n) v l), b2Prop (hom n (S O) v)) (@Logic.eq (E (vn_eparams n)) M (scalE (vn_eparams n) k (joinl n (@cons (E (vn_eparams n)) x l)))))) *)
intros Hx Hhx (l, Hl) HxM.
(* Goal: @ex (Field.K (stype (vn_eparams n))) (fun k : Field.K (stype (vn_eparams n)) => @ex (list (vect n)) (fun l : list (vect n) => and (forall (v : vect n) (_ : @In (vect n) v l), b2Prop (hom n (S O) v)) (@Logic.eq (E (vn_eparams n)) M (scalE (vn_eparams n) k (joinl n (@cons (E (vn_eparams n)) x l)))))) *)
case (eqE_spec _ (fn n) M 0); intros HM.
(* Goal: @ex (Field.K (stype (vn_eparams n))) (fun k : Field.K (stype (vn_eparams n)) => @ex (list (vect n)) (fun l : list (vect n) => and (forall (v : vect n) (_ : @In (vect n) v l), b2Prop (hom n (S O) v)) (@Logic.eq (E (vn_eparams n)) M (scalE (vn_eparams n) k (joinl n (@cons (E (vn_eparams n)) x l)))))) *)
(* Goal: @ex (Field.K (stype (vn_eparams n))) (fun k : Field.K (stype (vn_eparams n)) => @ex (list (vect n)) (fun l : list (vect n) => and (forall (v : vect n) (_ : @In (vect n) v l), b2Prop (hom n (S O) v)) (@Logic.eq (E (vn_eparams n)) M (scalE (vn_eparams n) k (joinl n (@cons (E (vn_eparams n)) x l)))))) *)
exists 0%f; exists (x::nil); split; Grm0.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
simpl; intros v [Hv | []]; subst; auto.
(* Goal: @ex (Field.K (stype (vn_eparams n))) (fun k : Field.K (stype (vn_eparams n)) => @ex (list (vect n)) (fun l : list (vect n) => and (forall (v : vect n) (_ : @In (vect n) v l), b2Prop (hom n (S O) v)) (@Logic.eq (E (vn_eparams n)) M (scalE (vn_eparams n) k (joinl n (@cons (E (vn_eparams n)) x l)))))) *)
assert (Hv: is_vector n x).
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
red; rewrite cbl1_hom1_equiv; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite (decomp_cbl _ _ _ _ Hv Hl) in HxM; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
case cbl_mprod with (2 := HxM); auto.
(* Goal: forall (x0 : list (Field.K (stype (vn_eparams n)))) (_ : and (@Logic.eq nat (@length (Field.K (stype (vn_eparams n))) x0) (@length (E (vn_eparams n)) l)) (@Logic.eq (E (vn_eparams n)) x (mprod (vn_eparams n) x0 l))), @ex (Field.K (stype (vn_eparams n))) (fun k : Field.K (stype (vn_eparams n)) => @ex (list (vect n)) (fun l : list (vect n) => and (forall (v : vect n) (_ : @In (vect n) v l), b2Prop (hom n (S O) v)) (@Logic.eq (E (vn_eparams n)) M (scalE (vn_eparams n) k (joinl n (@cons (E (vn_eparams n)) x l)))))) *)
intros ll (H1ll, H2ll); subst.
(* Goal: @ex (Field.K (stype (vn_eparams n))) (fun k : Field.K (stype (vn_eparams n)) => @ex (list (vect n)) (fun l0 : list (vect n) => and (forall (v : vect n) (_ : @In (vect n) v l0), b2Prop (hom n (S O) v)) (@Logic.eq (E (vn_eparams n)) M (scalE (vn_eparams n) k (joinl n (@cons (E (vn_eparams n)) (mprod (vn_eparams n) ll l) l0)))))) *)
case Hl; intros Hu1 HU2; subst.
(* Goal: @ex (Field.K (stype (vn_eparams n))) (fun k : Field.K (stype (vn_eparams n)) => @ex (list (vect n)) (fun l0 : list (vect n) => and (forall (v : vect n) (_ : @In (vect n) v l0), b2Prop (hom n (S O) v)) (@Logic.eq (E (vn_eparams n)) (joinl n l) (scalE (vn_eparams n) k (joinl n (@cons (E (vn_eparams n)) (mprod (vn_eparams n) ll l) l0)))))) *)
assert (Hu4: forall x, In x l -> hom n 1 x).
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros x H1x; rewrite <-cbl1_hom1_equiv; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply Hu1; auto.
(* Goal: @ex (Field.K (stype (vn_eparams n))) (fun k : Field.K (stype (vn_eparams n)) => @ex (list (vect n)) (fun l0 : list (vect n) => and (forall (v : vect n) (_ : @In (vect n) v l0), b2Prop (hom n (S O) v)) (@Logic.eq (E (vn_eparams n)) (joinl n l) (scalE (vn_eparams n) k (joinl n (@cons (E (vn_eparams n)) (mprod (vn_eparams n) ll l) l0)))))) *)
generalize l H1ll Hx Hu4; elim ll; clear ll l Hx Hhx H1ll HxM Hl Hv Hu1 Hu4 HM.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros l Hl HH; case HH; auto.
(* Goal: b2Prop false *)
intros a ll IH [|b l] Hl H1 H2; try discriminate.
(* Goal: @ex (Field.K (stype (vn_eparams n))) (fun k : Field.K (stype (vn_eparams n)) => @ex (list (vect n)) (fun l0 : list (vect n) => and (forall (v : vect n) (_ : @In (vect n) v l0), b2Prop (hom n (S O) v)) (@Logic.eq (E (vn_eparams n)) (joinl n (@cons (E (vn_eparams n)) b l)) (scalE (vn_eparams n) k (joinl n (@cons (E (vn_eparams n)) (mprod (vn_eparams n) (@cons (Field.K (stype (vn_eparams n))) a ll) (@cons (E (vn_eparams n)) b l)) l0)))))) *)
case (eqK_spec _ Hp a 0%f); intros H4; subst.
(* Goal: @ex (Field.K (stype (vn_eparams n))) (fun k : Field.K (stype (vn_eparams n)) => @ex (list (vect n)) (fun l0 : list (vect n) => and (forall (v : vect n) (_ : @In (vect n) v l0), b2Prop (hom n (S O) v)) (@Logic.eq (E (vn_eparams n)) (joinl n (@cons (E (vn_eparams n)) b l)) (scalE (vn_eparams n) k (joinl n (@cons (E (vn_eparams n)) (mprod (vn_eparams n) (@cons (Field.K (stype (vn_eparams n))) (v0 (K p)) ll) (@cons (E (vn_eparams n)) b l)) l0)))))) *)
(* Goal: @ex (Field.K (stype (vn_eparams n))) (fun k : Field.K (stype (vn_eparams n)) => @ex (list (vect n)) (fun l0 : list (vect n) => and (forall (v : vect n) (_ : @In (vect n) v l0), b2Prop (hom n (S O) v)) (@Logic.eq (E (vn_eparams n)) (joinl n (@cons (E (vn_eparams n)) b l)) (scalE (vn_eparams n) k (joinl n (@cons (E (vn_eparams n)) (mprod (vn_eparams n) (@cons (Field.K (stype (vn_eparams n))) a ll) (@cons (E (vn_eparams n)) b l)) l0)))))) *)
rewrite mprod_S; Grm0.
(* Goal: @ex (Field.K (stype (vn_eparams n))) (fun k : Field.K (stype (vn_eparams n)) => @ex (list (vect n)) (fun l0 : list (vect n) => and (forall (v : vect n) (_ : @In (vect n) v l0), b2Prop (hom n (S O) v)) (@Logic.eq (E (vn_eparams n)) (joinl n (@cons (E (vn_eparams n)) b l)) (scalE (vn_eparams n) k (joinl n (@cons (E (vn_eparams n)) (addE (vn_eparams n) (scalE (vn_eparams n) (v0 (K p)) b) (mprod (vn_eparams n) ll l)) l0)))))) *)
(* Goal: @ex (Field.K (stype (vn_eparams n))) (fun k : Field.K (stype (vn_eparams n)) => @ex (list (vect n)) (fun l0 : list (vect n) => and (forall (v : vect n) (_ : @In (vect n) v l0), b2Prop (hom n (S O) v)) (@Logic.eq (E (vn_eparams n)) (joinl n (@cons (E (vn_eparams n)) b l)) (scalE (vn_eparams n) k (joinl n (@cons (E (vn_eparams n)) (mprod (vn_eparams n) (@cons (Field.K (stype (vn_eparams n))) a ll) (@cons (E (vn_eparams n)) b l)) l0)))))) *)
case (IH l); auto with datatypes.
(* Goal: not (@Logic.eq (E (vn_eparams n)) (mprod (vn_eparams n) ll l) (E0 (vn_eparams n))) *)
(* Goal: forall (x : Field.K (stype (vn_eparams n))) (_ : @ex (list (vect n)) (fun l0 : list (vect n) => and (forall (v : vect n) (_ : @In (vect n) v l0), b2Prop (hom n (S O) v)) (@Logic.eq (E (vn_eparams n)) (joinl n l) (scalE (vn_eparams n) x (joinl n (@cons (E (vn_eparams n)) (mprod (vn_eparams n) ll l) l0)))))), @ex (Field.K (stype (vn_eparams n))) (fun k : Field.K (stype (vn_eparams n)) => @ex (list (vect n)) (fun l0 : list (vect n) => and (forall (v : vect n) (_ : @In (vect n) v l0), b2Prop (hom n (S O) v)) (@Logic.eq (E (vn_eparams n)) (joinl n (@cons (E (vn_eparams n)) b l)) (scalE (vn_eparams n) k (joinl n (@cons (E (vn_eparams n)) (addE (vn_eparams n) (scalE (vn_eparams n) (v0 (K p)) b) (mprod (vn_eparams n) ll l)) l0)))))) *)
(* Goal: @ex (Field.K (stype (vn_eparams n))) (fun k : Field.K (stype (vn_eparams n)) => @ex (list (vect n)) (fun l0 : list (vect n) => and (forall (v : vect n) (_ : @In (vect n) v l0), b2Prop (hom n (S O) v)) (@Logic.eq (E (vn_eparams n)) (joinl n (@cons (E (vn_eparams n)) b l)) (scalE (vn_eparams n) k (joinl n (@cons (E (vn_eparams n)) (mprod (vn_eparams n) (@cons (Field.K (stype (vn_eparams n))) a ll) (@cons (E (vn_eparams n)) b l)) l0)))))) *)
intros HH; case H1; rewrite mprod_S, HH; Grm0.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite (scalE0l (vn_eparams n)); auto.
(* Goal: forall (x : Field.K (stype (vn_eparams n))) (_ : @ex (list (vect n)) (fun l0 : list (vect n) => and (forall (v : vect n) (_ : @In (vect n) v l0), b2Prop (hom n (S O) v)) (@Logic.eq (E (vn_eparams n)) (joinl n l) (scalE (vn_eparams n) x (joinl n (@cons (E (vn_eparams n)) (mprod (vn_eparams n) ll l) l0)))))), @ex (Field.K (stype (vn_eparams n))) (fun k : Field.K (stype (vn_eparams n)) => @ex (list (vect n)) (fun l0 : list (vect n) => and (forall (v : vect n) (_ : @In (vect n) v l0), b2Prop (hom n (S O) v)) (@Logic.eq (E (vn_eparams n)) (joinl n (@cons (E (vn_eparams n)) b l)) (scalE (vn_eparams n) k (joinl n (@cons (E (vn_eparams n)) (addE (vn_eparams n) (scalE (vn_eparams n) (v0 (K p)) b) (mprod (vn_eparams n) ll l)) l0)))))) *)
(* Goal: @ex (Field.K (stype (vn_eparams n))) (fun k : Field.K (stype (vn_eparams n)) => @ex (list (vect n)) (fun l0 : list (vect n) => and (forall (v : vect n) (_ : @In (vect n) v l0), b2Prop (hom n (S O) v)) (@Logic.eq (E (vn_eparams n)) (joinl n (@cons (E (vn_eparams n)) b l)) (scalE (vn_eparams n) k (joinl n (@cons (E (vn_eparams n)) (mprod (vn_eparams n) (@cons (Field.K (stype (vn_eparams n))) a ll) (@cons (E (vn_eparams n)) b l)) l0)))))) *)
intros k (l1, (H1l1, H2l1)).
exists k%f; exists ((-(1)).* b::l1); split.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
simpl; intros v [Hv|Hv]; subst; auto.
(* Goal: b2Prop (hom n (S O) (scal n (oppK (K1 p) (v1 (K1 p))) b)) *)
(* Goal: @Logic.eq (E (vn_eparams n)) (joinl n (@cons (E (vn_eparams n)) b l)) (scalE (vn_eparams n) k (joinl n (@cons (E (vn_eparams n)) (addE (vn_eparams n) (scalE (vn_eparams n) (v0 (K p)) b) (mprod (vn_eparams n) ll l)) (@cons (E (vn_eparams n)) (scalE (vn_eparams n) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) b) l1)))) *)
(* Goal: @ex (Field.K (stype (vn_eparams n))) (fun k : Field.K (stype (vn_eparams n)) => @ex (list (vect n)) (fun l0 : list (vect n) => and (forall (v : vect n) (_ : @In (vect n) v l0), b2Prop (hom n (S O) v)) (@Logic.eq (E (vn_eparams n)) (joinl n (@cons (E (vn_eparams n)) b l)) (scalE (vn_eparams n) k (joinl n (@cons (E (vn_eparams n)) (mprod (vn_eparams n) (@cons (Field.K (stype (vn_eparams n))) a ll) (@cons (E (vn_eparams n)) b l)) l0)))))) *)
Vfold n; apply scal_hom; auto with datatypes.
(* Goal: @Logic.eq (E (vn_eparams n)) (joinl n (@cons (E (vn_eparams n)) b l)) (scalE (vn_eparams n) k (joinl n (@cons (E (vn_eparams n)) (addE (vn_eparams n) (scalE (vn_eparams n) (v0 (K p)) b) (mprod (vn_eparams n) ll l)) (@cons (E (vn_eparams n)) (scalE (vn_eparams n) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) b) l1)))) *)
(* Goal: @ex (Field.K (stype (vn_eparams n))) (fun k : Field.K (stype (vn_eparams n)) => @ex (list (vect n)) (fun l0 : list (vect n) => and (forall (v : vect n) (_ : @In (vect n) v l0), b2Prop (hom n (S O) v)) (@Logic.eq (E (vn_eparams n)) (joinl n (@cons (E (vn_eparams n)) b l)) (scalE (vn_eparams n) k (joinl n (@cons (E (vn_eparams n)) (mprod (vn_eparams n) (@cons (Field.K (stype (vn_eparams n))) a ll) (@cons (E (vn_eparams n)) b l)) l0)))))) *)
rewrite joinl_swap, joinlS, joinlS, H2l1.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite join_scall, <-(scal_multE _ (fn n) (-(1))%f); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite multK_m1_m1, scalE1, join_scalr; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite (scalE0l (vn_eparams n)); auto. rewrite (addE0l (vn_eparams n)); auto.
(* Goal: b2Prop false *)
intros HH; discriminate.
(* Goal: b2Prop false *)
intros HH; subst; destruct ll; try discriminate.
(* Goal: @ex (Field.K (stype (vn_eparams n))) (fun k : Field.K (stype (vn_eparams n)) => @ex (list (vect n)) (fun l0 : list (vect n) => and (forall (v : vect n) (_ : @In (vect n) v l0), b2Prop (hom n (S O) v)) (@Logic.eq (E (vn_eparams n)) (joinl n (@cons (E (vn_eparams n)) b l)) (scalE (vn_eparams n) k (joinl n (@cons (E (vn_eparams n)) (mprod (vn_eparams n) (@cons (Field.K (stype (vn_eparams n))) (v0 (K p)) ll) (@cons (E (vn_eparams n)) b l)) l0)))))) *)
(* Goal: @ex (Field.K (stype (vn_eparams n))) (fun k : Field.K (stype (vn_eparams n)) => @ex (list (vect n)) (fun l0 : list (vect n) => and (forall (v : vect n) (_ : @In (vect n) v l0), b2Prop (hom n (S O) v)) (@Logic.eq (E (vn_eparams n)) (joinl n (@cons (E (vn_eparams n)) b l)) (scalE (vn_eparams n) k (joinl n (@cons (E (vn_eparams n)) (mprod (vn_eparams n) (@cons (Field.K (stype (vn_eparams n))) a ll) (@cons (E (vn_eparams n)) b l)) l0)))))) *)
case H1; rewrite mprod_S; Grm0.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite (scalE0l (vn_eparams n)); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply cbl_trans with l; auto.
(* Goal: forall (i : E (vn_eparams n)) (_ : @In (E (vn_eparams n)) i l), cbl (vn_eparams n) (base n (S O)) i *)
(* Goal: cbl (vn_eparams n) l (addE (vn_eparams n) (scalE (vn_eparams n) (v0 (K p)) b) (mprod (vn_eparams n) ll l)) *)
(* Goal: cbl (vn_eparams n) (base n (S O)) (scalE (vn_eparams n) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) b) *)
(* Goal: @ex (Field.K (stype (vn_eparams n))) (fun k : Field.K (stype (vn_eparams n)) => @ex (list (vect n)) (fun l0 : list (vect n) => and (forall (v : vect n) (_ : @In (vect n) v l0), b2Prop (hom n (S O) v)) (@Logic.eq (E (vn_eparams n)) (joinl n (@cons (E (vn_eparams n)) b l)) (scalE (vn_eparams n) k (joinl n (@cons (E (vn_eparams n)) (mprod (vn_eparams n) (@cons (Field.K (stype (vn_eparams n))) a ll) (@cons (E (vn_eparams n)) b l)) l0)))))) *)
intros; rewrite cbl1_hom1_equiv; auto with datatypes.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite (scalE0l (vn_eparams n)); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite addE0l; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply mprod_cbl; auto.
(* Goal: cbl (vn_eparams n) (base n (S O)) (scalE (vn_eparams n) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) b) *)
(* Goal: @ex (Field.K (stype (vn_eparams n))) (fun k : Field.K (stype (vn_eparams n)) => @ex (list (vect n)) (fun l0 : list (vect n) => and (forall (v : vect n) (_ : @In (vect n) v l0), b2Prop (hom n (S O) v)) (@Logic.eq (E (vn_eparams n)) (joinl n (@cons (E (vn_eparams n)) b l)) (scalE (vn_eparams n) k (joinl n (@cons (E (vn_eparams n)) (mprod (vn_eparams n) (@cons (Field.K (stype (vn_eparams n))) a ll) (@cons (E (vn_eparams n)) b l)) l0)))))) *)
apply cbl_scal.
(* Goal: cbl (vn_eparams n) (base n (S O)) b *)
(* Goal: @ex (Field.K (stype (vn_eparams n))) (fun k : Field.K (stype (vn_eparams n)) => @ex (list (vect n)) (fun l0 : list (vect n) => and (forall (v : vect n) (_ : @In (vect n) v l0), b2Prop (hom n (S O) v)) (@Logic.eq (E (vn_eparams n)) (joinl n (@cons (E (vn_eparams n)) b l)) (scalE (vn_eparams n) k (joinl n (@cons (E (vn_eparams n)) (mprod (vn_eparams n) (@cons (Field.K (stype (vn_eparams n))) a ll) (@cons (E (vn_eparams n)) b l)) l0)))))) *)
rewrite cbl1_hom1_equiv; auto with datatypes.
(* Goal: @ex (Field.K (stype (vn_eparams n))) (fun k : Field.K (stype (vn_eparams n)) => @ex (list (vect n)) (fun l0 : list (vect n) => and (forall (v : vect n) (_ : @In (vect n) v l0), b2Prop (hom n (S O) v)) (@Logic.eq (E (vn_eparams n)) (joinl n (@cons (E (vn_eparams n)) b l)) (scalE (vn_eparams n) k (joinl n (@cons (E (vn_eparams n)) (mprod (vn_eparams n) (@cons (Field.K (stype (vn_eparams n))) a ll) (@cons (E (vn_eparams n)) b l)) l0)))))) *)
exists (a^-1)%f; exists l; split; auto with datatypes.
(* Goal: @Logic.eq (E (vn_eparams n)) (joinl n (@cons (E (vn_eparams n)) b l)) (scalE (vn_eparams n) (invK (stype (vn_eparams n)) a) (joinl n (@cons (E (vn_eparams n)) (mprod (vn_eparams n) (@cons (Field.K (stype (vn_eparams n))) a ll) (@cons (E (vn_eparams n)) b l)) l))) *)
case (list_case _ l); intros Hll.
(* Goal: @Logic.eq (E (vn_eparams n)) (joinl n (@cons (E (vn_eparams n)) b l)) (scalE (vn_eparams n) (invK (stype (vn_eparams n)) a) (joinl n (@cons (E (vn_eparams n)) (mprod (vn_eparams n) (@cons (Field.K (stype (vn_eparams n))) a ll) (@cons (E (vn_eparams n)) b l)) l))) *)
(* Goal: @Logic.eq (E (vn_eparams n)) (joinl n (@cons (E (vn_eparams n)) b l)) (scalE (vn_eparams n) (invK (stype (vn_eparams n)) a) (joinl n (@cons (E (vn_eparams n)) (mprod (vn_eparams n) (@cons (Field.K (stype (vn_eparams n))) a ll) (@cons (E (vn_eparams n)) b l)) l))) *)
rewrite Hll; simpl; Vfold n; rewrite mprod_S, mprod0r; Grm0.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite <-scal_multE, invKr, scalE1; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite mprod_S, !joinlS, join_addl, scal_addEr; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite join_scall, <-scal_multE, invKr, scalE1; auto.
replace (ll *X* l ∨ joinl n l) with (0: vect n); Grm0.
(* Goal: @Logic.eq (vect n) (E0 (vn_eparams n)) (join n (mprod (vn_eparams n) ll l) (joinl n l)) *)
injection Hl.
(* Goal: forall _ : @Logic.eq nat (@length (Field.K (K1 p)) ll) (@length (vect n) l), @Logic.eq (vect n) (E0 (vn_eparams n)) (join n (mprod (vn_eparams n) ll l) (joinl n l)) *)
generalize ll H2; elim l; clear l ll IH Hl H1 H2 Hll.
(* Goal: forall (ll : list (Field.K (stype (vn_eparams n)))) (_ : forall (x : E (vn_eparams n)) (_ : @In (E (vn_eparams n)) x (@cons (E (vn_eparams n)) b (@nil (E (vn_eparams n))))), b2Prop (hom n (S O) x)) (_ : @Logic.eq nat (@length (Field.K (K1 p)) ll) (@length (vect n) (@nil (E (vn_eparams n))))), @Logic.eq (vect n) (E0 (vn_eparams n)) (join n (mprod (vn_eparams n) ll (@nil (E (vn_eparams n)))) (joinl n (@nil (E (vn_eparams n))))) *)
(* Goal: forall (a : E (vn_eparams n)) (l : list (E (vn_eparams n))) (_ : forall (ll : list (Field.K (stype (vn_eparams n)))) (_ : forall (x : E (vn_eparams n)) (_ : @In (E (vn_eparams n)) x (@cons (E (vn_eparams n)) b l)), b2Prop (hom n (S O) x)) (_ : @Logic.eq nat (@length (Field.K (K1 p)) ll) (@length (vect n) l)), @Logic.eq (vect n) (E0 (vn_eparams n)) (join n (mprod (vn_eparams n) ll l) (joinl n l))) (ll : list (Field.K (stype (vn_eparams n)))) (_ : forall (x : E (vn_eparams n)) (_ : @In (E (vn_eparams n)) x (@cons (E (vn_eparams n)) b (@cons (E (vn_eparams n)) a l))), b2Prop (hom n (S O) x)) (_ : @Logic.eq nat (@length (Field.K (K1 p)) ll) (@length (vect n) (@cons (E (vn_eparams n)) a l))), @Logic.eq (vect n) (E0 (vn_eparams n)) (join n (mprod (vn_eparams n) ll (@cons (E (vn_eparams n)) a l)) (joinl n (@cons (E (vn_eparams n)) a l))) *)
intros; rewrite mprod0r; Grm0.
(* Goal: forall (a : E (vn_eparams n)) (l : list (E (vn_eparams n))) (_ : forall (ll : list (Field.K (stype (vn_eparams n)))) (_ : forall (x : E (vn_eparams n)) (_ : @In (E (vn_eparams n)) x (@cons (E (vn_eparams n)) b l)), b2Prop (hom n (S O) x)) (_ : @Logic.eq nat (@length (Field.K (K1 p)) ll) (@length (vect n) l)), @Logic.eq (vect n) (E0 (vn_eparams n)) (join n (mprod (vn_eparams n) ll l) (joinl n l))) (ll : list (Field.K (stype (vn_eparams n)))) (_ : forall (x : E (vn_eparams n)) (_ : @In (E (vn_eparams n)) x (@cons (E (vn_eparams n)) b (@cons (E (vn_eparams n)) a l))), b2Prop (hom n (S O) x)) (_ : @Logic.eq nat (@length (Field.K (K1 p)) ll) (@length (vect n) (@cons (E (vn_eparams n)) a l))), @Logic.eq (vect n) (E0 (vn_eparams n)) (join n (mprod (vn_eparams n) ll (@cons (E (vn_eparams n)) a l)) (joinl n (@cons (E (vn_eparams n)) a l))) *)
intros a1 l1 IH ll H1 H2.
(* Goal: @Logic.eq (vect n) (E0 (vn_eparams n)) (join n (mprod (vn_eparams n) ll (@cons (E (vn_eparams n)) a1 l1)) (joinl n (@cons (E (vn_eparams n)) a1 l1))) *)
destruct ll as [| b1 ll].
(* Goal: @Logic.eq (vect n) (E0 (vn_eparams n)) (join n (mprod (vn_eparams n) (@nil (Field.K (stype (vn_eparams n)))) (@cons (E (vn_eparams n)) a1 l1)) (joinl n (@cons (E (vn_eparams n)) a1 l1))) *)
(* Goal: @Logic.eq (vect n) (E0 (vn_eparams n)) (join n (mprod (vn_eparams n) (@cons (Field.K (stype (vn_eparams n))) b1 ll) (@cons (E (vn_eparams n)) a1 l1)) (joinl n (@cons (E (vn_eparams n)) a1 l1))) *)
rewrite mprod0l; Grm0.
(* Goal: @Logic.eq (vect n) (E0 (vn_eparams n)) (join n (mprod (vn_eparams n) (@cons (Field.K (stype (vn_eparams n))) b1 ll) (@cons (E (vn_eparams n)) a1 l1)) (joinl n (@cons (E (vn_eparams n)) a1 l1))) *)
case (list_case _ l1); intros Hll1.
(* Goal: @Logic.eq (vect n) (E0 (vn_eparams n)) (join n (mprod (vn_eparams n) (@cons (Field.K (stype (vn_eparams n))) b1 ll) (@cons (E (vn_eparams n)) a1 l1)) (joinl n (@cons (E (vn_eparams n)) a1 l1))) *)
(* Goal: @Logic.eq (vect n) (E0 (vn_eparams n)) (join n (mprod (vn_eparams n) (@cons (Field.K (stype (vn_eparams n))) b1 ll) (@cons (E (vn_eparams n)) a1 l1)) (joinl n (@cons (E (vn_eparams n)) a1 l1))) *)
rewrite Hll1; simpl; Vfold n; rewrite mprod_S, mprod0r; Grm0.
(* Goal: @Logic.eq (vect n) (E0 (vn_eparams n)) (join n (scalE (vn_eparams n) b1 a1) a1) *)
(* Goal: @Logic.eq (vect n) (E0 (vn_eparams n)) (join n (mprod (vn_eparams n) (@cons (Field.K (stype (vn_eparams n))) b1 ll) (@cons (E (vn_eparams n)) a1 l1)) (joinl n (@cons (E (vn_eparams n)) a1 l1))) *)
rewrite join_scall, join_hom1_id; Grm0; auto with datatypes.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite mprod_S, joinlS, join_addl; auto.
(* Goal: @Logic.eq (vect n) (E0 (vn_eparams n)) (addE (vn_eparams n) (join n (scalE (vn_eparams n) b1 a1) (join n a1 (joinl n l1))) (join n (mprod (vn_eparams n) ll l1) (join n a1 (joinl n l1)))) *)
rewrite join_scall, <-join_assoc, join_hom1_id; Grm0; auto with datatypes.
(* Goal: @Logic.eq (vect n) (E0 (vn_eparams n)) (join n (mprod (vn_eparams n) ll l1) (join n a1 (joinl n l1))) *)
rewrite <- join_assoc.
rewrite (join_hom_com n 1 1 a1 (ll *X* l1)); auto with datatypes.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite join_scall, join_assoc, <- IH; Grm0; auto.
(* Goal: forall (x : E (vn_eparams n)) (_ : @In (E (vn_eparams n)) x (@cons (E (vn_eparams n)) b l1)), b2Prop (hom n (S O) x) *)
simpl; intros x [Hx|Hx]; subst; auto with datatypes.
Qed.

Lemma decomposable_factor n k x M : x <> 0 -> hom n 1 x -> hom n k.+2 M ->
  is_decomposable n M -> x ∨ M = 0 -> is_decomposable n (factor n x M).
Proof.
(* Goal: forall (_ : not (@Logic.eq (E (vn_eparams n)) x (E0 (vn_eparams n)))) (_ : b2Prop (hom n (S O) x)) (_ : b2Prop (hom n (S (S k)) M)) (_ : is_decomposable n M) (_ : @Logic.eq (vect n) (join n x M) (E0 (vn_eparams n))), is_decomposable n (factor n x M) *)
intros Hx Hhx HhM HM HxM.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
case (joinl_factor n x M); auto.
(* Goal: forall (x0 : Field.K (stype (vn_eparams n))) (_ : @ex (list (vect n)) (fun l : list (vect n) => and (forall (v : vect n) (_ : @In (vect n) v l), b2Prop (hom n (S O) v)) (@Logic.eq (E (vn_eparams n)) M (scalE (vn_eparams n) x0 (joinl n (@cons (E (vn_eparams n)) x l)))))), is_decomposable n (factor n x M) *)
intros k1 (l, (H1l, H2l)); subst; red.
(* Goal: @ex (list (E (vn_eparams n))) (fun l0 : list (E (vn_eparams n)) => decomposable n l0 (factor n x (scalE (vn_eparams n) k1 (joinl n (@cons (E (vn_eparams n)) x l))))) *)
case (list_case _ l); intros Hl.
(* Goal: @ex (list (E (vn_eparams n))) (fun l0 : list (E (vn_eparams n)) => decomposable n l0 (factor n x (scalE (vn_eparams n) k1 (joinl n (@cons (E (vn_eparams n)) x l))))) *)
(* Goal: @ex (list (E (vn_eparams n))) (fun l0 : list (E (vn_eparams n)) => decomposable n l0 (factor n x (scalE (vn_eparams n) k1 (joinl n (@cons (E (vn_eparams n)) x l))))) *)
subst; simpl joinl.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite factor_scal, factor_id; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
case (homE n 1 k.+2 (k1 .* x)); try (intros; discriminate); auto.
(* Goal: forall _ : @Logic.eq (vect n) (scalE (vn_eparams n) k1 x) (E0 (vn_eparams n)), @ex (list (E (vn_eparams n))) (fun l : list (E (vn_eparams n)) => decomposable n l (scalE (vn_eparams n) k1 (genk n (v1 (K1 p))))) *)
(* Goal: @ex (list (E (vn_eparams n))) (fun l0 : list (E (vn_eparams n)) => decomposable n l0 (factor n x (scalE (vn_eparams n) k1 (joinl n (@cons (E (vn_eparams n)) x l))))) *)
intros HH1; case (scalE_integral _ (fn n) _ _ HH1); intros HH2; subst; Grm0.
(* Goal: @ex (list (E (vn_eparams n))) (fun l : list (E (vn_eparams n)) => decomposable n l (E0 (vn_eparams n))) *)
(* Goal: @ex (list (E (vn_eparams n))) (fun l : list (E (vn_eparams n)) => decomposable n l (scalE (vn_eparams n) k1 (genk n (v1 (K1 p))))) *)
(* Goal: @ex (list (E (vn_eparams n))) (fun l0 : list (E (vn_eparams n)) => decomposable n l0 (factor n x (scalE (vn_eparams n) k1 (joinl n (@cons (E (vn_eparams n)) x l))))) *)
exists (x::x::nil).
(* Goal: iff (b2Prop (hom n k (joinl n l))) (and (b2Prop (hom n k (joinl n l))) (@ex (list (vect n)) (fun l0 : list (vect n) => and (@Logic.eq (vect n) (joinl n l) (joinl n l0)) (forall (y : vect n) (_ : @In (vect n) y l0), b2Prop (hom n (S O) y))))) *)
(* Goal: forall _ : not (is_decomposable n x), iff (b2Prop false) (and (b2Prop (hom n k x)) (@ex (list (vect n)) (fun l : list (vect n) => and (@Logic.eq (vect n) x (joinl n l)) (forall (y : vect n) (_ : @In (vect n) y l), b2Prop (hom n (S O) y))))) *)
split.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
simpl; intros x1 [H1| [H1 | H1]]; subst; red; rewrite cbl1_hom1_equiv; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
simpl joinl; rewrite join_hom1_id; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
case Hx; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite joinlS, factor_scal; auto. 
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite (joinl_addmult n (fun x y => (-(1) * ((fget n x y)))%f)); auto.
(* Goal: @ex (list (E (vn_eparams n))) (fun l0 : list (E (vn_eparams n)) => decomposable n l0 (scalE (vn_eparams n) k1 (factor n x (join n x (joinl n (@map (E (vn_eparams n)) (E (vn_eparams n)) (fun y : E (vn_eparams n) => addE (vn_eparams n) y (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (fget n x y)) x)) l)))))) *)
destruct l as [| a l].
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
case Hl; auto. 
exists (map (fun y : vn_eparams n => y + (- (1) * fget n x y)%f .* x) (k1 .* a::l)).
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
split; auto.
(* Goal: is_vector_space n (@map (E (vn_eparams n)) (E (vn_eparams n)) (fun y : E (vn_eparams n) => addE (vn_eparams n) y (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (fget n x y)) x)) (@cons (E (vn_eparams n)) (scalE (vn_eparams n) k1 a) l)) *)
(* Goal: @Logic.eq (E (vn_eparams n)) (scalE (vn_eparams n) k1 (factor n x (join n x (joinl n (@map (E (vn_eparams n)) (E (vn_eparams n)) (fun y : E (vn_eparams n) => addE (vn_eparams n) y (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (fget n x y)) x)) (@cons (vect n) a l)))))) (joinl n (@map (E (vn_eparams n)) (E (vn_eparams n)) (fun y : E (vn_eparams n) => addE (vn_eparams n) y (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (fget n x y)) x)) (@cons (E (vn_eparams n)) (scalE (vn_eparams n) k1 a) l))) *)
simpl map; intros x1; simpl In; Vfold n; intros [Hx1|Hx1]; auto with datatypes.
(* Goal: is_vector n x1 *)
(* Goal: is_vector n x1 *)
(* Goal: @Logic.eq (E (vn_eparams n)) (scalE (vn_eparams n) k1 (factor n x (join n x (joinl n (@map (E (vn_eparams n)) (E (vn_eparams n)) (fun y : E (vn_eparams n) => addE (vn_eparams n) y (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (fget n x y)) x)) (@cons (vect n) a l)))))) (joinl n (@map (E (vn_eparams n)) (E (vn_eparams n)) (fun y : E (vn_eparams n) => addE (vn_eparams n) y (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (fget n x y)) x)) (@cons (E (vn_eparams n)) (scalE (vn_eparams n) k1 a) l))) *)
red; rewrite cbl1_hom1_equiv, <-Hx1, add_hom; auto with datatypes.
(* Goal: is_vector n x1 *)
(* Goal: @Logic.eq (E (vn_eparams n)) (scalE (vn_eparams n) k1 (factor n x (join n x (joinl n (@map (E (vn_eparams n)) (E (vn_eparams n)) (fun y : E (vn_eparams n) => addE (vn_eparams n) y (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (fget n x y)) x)) (@cons (vect n) a l)))))) (joinl n (@map (E (vn_eparams n)) (E (vn_eparams n)) (fun y : E (vn_eparams n) => addE (vn_eparams n) y (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (fget n x y)) x)) (@cons (E (vn_eparams n)) (scalE (vn_eparams n) k1 a) l))) *)
rewrite in_map_iff in Hx1; case Hx1; intros x2 ([], H2x2).
(* Goal: is_vector n (addE (vn_eparams n) x2 (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (fget n x x2)) x)) *)
(* Goal: @Logic.eq (E (vn_eparams n)) (scalE (vn_eparams n) k1 (factor n x (join n x (joinl n (@map (E (vn_eparams n)) (E (vn_eparams n)) (fun y : E (vn_eparams n) => addE (vn_eparams n) y (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (fget n x y)) x)) (@cons (vect n) a l)))))) (joinl n (@map (E (vn_eparams n)) (E (vn_eparams n)) (fun y : E (vn_eparams n) => addE (vn_eparams n) y (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (fget n x y)) x)) (@cons (E (vn_eparams n)) (scalE (vn_eparams n) k1 a) l))) *)
red; rewrite cbl1_hom1_equiv, add_hom; auto with datatypes.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (dual n (conj n false (genk n k))) (dual n (genk n (v0 (K1 p))))) (@pair (vect n) (vect n) (scal n k (all n)) (scal n k (genk n (v0 (K1 p))))) *)
simpl map; Vfold n.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite factor_ortho; auto.
rewrite <-joinl_scal, scal_addEr, scal_multE, scalE_swap, <-!scal_multE,
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
        fget_scal, multK_assoc; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply fortho_joinl with 0%nat; auto.
(* Goal: forall (v2 : vect n) (_ : @In (vect n) v2 (@cons (vect n) (addE (vn_eparams n) a (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (fget n x a)) x)) (@map (vect n) (vect n) (fun y : vect n => addE (vn_eparams n) y (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (fget n x y)) x)) l))), b2Prop (fortho n x v2) *)
intros v2 Hv2; case in_inv with (1 := Hv2).
(* Goal: forall _ : @Logic.eq (vect n) (addE (vn_eparams n) a (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (fget n x a)) x)) v2, b2Prop (fortho n x v2) *)
(* Goal: forall _ : @In (vect n) v2 (@map (vect n) (vect n) (fun y : vect n => addE (vn_eparams n) y (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (fget n x y)) x)) l), b2Prop (fortho n x v2) *)
intros Hv3; subst.
(* Goal: b2Prop (fortho n x (addE (vn_eparams n) v3 (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (fget n x v3)) x))) *)
apply fortho_fget; auto with datatypes.
(* Goal: forall _ : @In (vect n) v2 (@map (vect n) (vect n) (fun y : vect n => addE (vn_eparams n) y (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (fget n x y)) x)) l), b2Prop (fortho n x v2) *)
rewrite in_map_iff; intros (v3, ([], H2v3)).
(* Goal: b2Prop (fortho n x (addE (vn_eparams n) v3 (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (fget n x v3)) x))) *)
apply fortho_fget; auto with datatypes.
Qed.

(* A factor of a special degre *)
Fixpoint one_factor (n: nat) k : vect n -> vect n :=
  match n return vect n -> vect n with 
  | O => fun a  => a 
  | S n1 => fun l =>
          match k with 
          | O => l
          | S k1 => 
            let (l1,l2) := l in
            let r := one_factor n1 k1 l1 in  
            (0:vect n1, if r ?= 0 then one_factor n1 k l2 else r)
          end
  end.

Lemma one_factor0 n k : one_factor n k 0 = 0.
Proof.
(* Goal: @Logic.eq (vect n) (one_factor n k (E0 (vn_eparams n))) (E0 (vn_eparams n)) *)
generalize k; induction n as [| n IH]; simpl; auto; clear k.
(* Goal: and (b2Prop (fortho n v0 (conj n (negb b) v1))) (b2Prop (fortho n v0 (conj n b v2))) *)
intros k; case k; simpl; auto; intros n0; case eq0_spec; rewrite !IH; auto.
Qed.

Lemma one_factor_hom n k1 k2 (x: vect n) :
 k2 < k1 -> hom n k1 x -> hom n (k1 - k2) (one_factor n k2 x).
Proof.
(* Goal: forall (_ : b2Prop (hom n k1 x)) (_ : b2Prop (hom n (S O) y)) (_ : b2Prop (hom n k2 z)), @Logic.eq (vect n) (meet n (join n x y) z) (addE (vn_eparams n) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n (S (Nat.add k1 k2)))) (meet n x (join n y z))) (join n (meet n x z) y)) *)
generalize k1 k2; clear k1 k2.
(* Goal: @Logic.eq (vect n) (k2g n (E0 (Kn.vn_eparams p n))) (E0 (vn_eparams n)) *)
induction n as [| n IH]; simpl; auto.
(* Goal: forall (k1 k2 : nat) (_ : lt k2 k1) (_ : b2Prop match k1 with | O => true | S n => eqK (K1 p) x (v0 (K1 p)) end), b2Prop match Nat.sub k1 k2 with | O => true | S n => eqK (K1 p) x (v0 (K1 p)) end *)
(* Goal: forall (k1 k2 : nat) (_ : lt k2 k1) (_ : b2Prop (let (l2, l3) := x in andb match k1 with | O => eq0 n l2 | S k3 => hom n k3 l2 end (hom n k1 l3))), b2Prop (let (l2, l3) := match k2 with | O => x | S k3 => let (l1, l2) := x in @pair (vect n) (vect n) (genk n (v0 (K1 p))) (if eq0 n (one_factor n k3 l1) then one_factor n k2 l2 else one_factor n k3 l1) end in andb match Nat.sub k1 k2 with | O => eq0 n l2 | S k3 => hom n k3 l2 end (hom n (Nat.sub k1 k2) l3)) *)
intros [|k1][|k2]; auto with arith.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros _ H; rewrite H; case minus; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros [| k1] [|k2] Heq; destruct x; rewrite andbP; intros (Ho1,Ho2); auto.
(* Goal: b2Prop (andb match Nat.sub O (S k2) with | O => eq0 n (genk n (Field.v0 (K1 p))) | S k1 => hom n k1 (genk n (Field.v0 (K1 p))) end (hom n (Nat.sub O (S k2)) (if eq0 n (one_factor n k2 v) then one_factor n (S k2) v0 else one_factor n k2 v))) *)
(* Goal: b2Prop (andb match Nat.sub (S k1) O with | O => eq0 n v | S k1 => hom n k1 v end (hom n (Nat.sub (S k1) O) v0)) *)
(* Goal: b2Prop (andb match Nat.sub (S k1) (S k2) with | O => eq0 n (genk n (Field.v0 (K1 p))) | S k1 => hom n k1 (genk n (Field.v0 (K1 p))) end (hom n (Nat.sub (S k1) (S k2)) (if eq0 n (one_factor n k2 v) then one_factor n (S k2) v0 else one_factor n k2 v))) *)
contradict Heq; auto with arith.
(* Goal: b2Prop (andb match Nat.sub O (S k2) with | O => eq0 n (genk n (Field.v0 (K1 p))) | S k1 => hom n k1 (genk n (Field.v0 (K1 p))) end (hom n (Nat.sub O (S k2)) (if eq0 n (one_factor n k2 v) then one_factor n (S k2) v0 else one_factor n k2 v))) *)
(* Goal: b2Prop (andb match Nat.sub (S k1) O with | O => eq0 n v | S k1 => hom n k1 v end (hom n (Nat.sub (S k1) O) v0)) *)
(* Goal: b2Prop (andb match Nat.sub (S k1) (S k2) with | O => eq0 n (genk n (Field.v0 (K1 p))) | S k1 => hom n k1 (genk n (Field.v0 (K1 p))) end (hom n (Nat.sub (S k1) (S k2)) (if eq0 n (one_factor n k2 v) then one_factor n (S k2) v0 else one_factor n k2 v))) *)
contradict Heq; auto with arith.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
simpl; rewrite Ho1, Ho2; auto.
(* Goal: b2Prop (andb match Nat.sub (S k1) (S k2) with | O => eq0 n (genk n (Field.v0 (K1 p))) | S k1 => hom n k1 (genk n (Field.v0 (K1 p))) end (hom n (Nat.sub (S k1) (S k2)) (if eq0 n (one_factor n k2 v) then one_factor n (S k2) v0 else one_factor n k2 v))) *)
generalize (minus_match k2.+1 k1.+1); case_eq (k1.+1 - k2.+1)%nat.
(* Goal: forall (_ : @Logic.eq nat (Nat.sub (S k1) (S k2)) O) (_ : le (S k1) (S k2)), b2Prop (andb (eq0 n (genk n (Field.v0 (K1 p)))) (hom n O (if eq0 n (one_factor n k2 v) then one_factor n (S k2) v0 else one_factor n k2 v))) *)
(* Goal: forall (n0 : nat) (_ : @Logic.eq nat (Nat.sub (S k1) (S k2)) (S n0)) (_ : lt (S k2) (S k1)), b2Prop (andb (hom n n0 (genk n (Field.v0 (K1 p)))) (hom n (S n0) (if eq0 n (one_factor n k2 v) then one_factor n (S k2) v0 else one_factor n k2 v))) *)
intros _ H1; contradict H1; auto with arith.
(* Goal: forall (n0 : nat) (_ : @Logic.eq nat (Nat.sub (S k1) (S k2)) (S n0)) (_ : lt (S k2) (S k1)), b2Prop (andb (hom n n0 (genk n (Field.v0 (K1 p)))) (hom n (S n0) (if eq0 n (one_factor n k2 v) then one_factor n (S k2) v0 else one_factor n k2 v))) *)
intros n1 Hn1 _; rewrite <-Hn1.
(* Goal: b2Prop (andb (hom n n1 (genk n (Field.v0 (K1 p)))) (hom n (Nat.sub (S k1) (S k2)) (if eq0 n (one_factor n k2 v) then one_factor n (S k2) v0 else one_factor n k2 v))) *)
case eq0_spec; intros H1; try (case eq0_spec; intros H2).
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite homk0, IH; auto.
(* Goal: b2Prop (andb (hom n n1 (genk n (Field.v0 (K1 p)))) (hom n (Nat.sub (S k1) (S k2)) (one_factor n k2 v))) *)
rewrite homk0.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (conj n (negb b) (E0 (vn_eparams n))) (conj n b (gen n i))) (if b then @pair (vect n) (vect n) (E0 (vn_eparams n)) (gen n i) else @pair (vect n) (vect n) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (E0 (vn_eparams n))) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (gen n i))) *)
simpl; rewrite IH; auto with arith.
Qed.

Hint Resolve one_factor_hom.
 
Lemma one_factor_zero n k1 k2 (x: vect n) :
 k2 < k1 -> hom n k1 x -> one_factor n k2 x = 0 -> x = 0.
Proof.
(* Goal: forall (_ : b2Prop (hom n k1 x)) (_ : b2Prop (hom n (S O) y)) (_ : b2Prop (hom n k2 z)), @Logic.eq (vect n) (meet n (join n x y) z) (addE (vn_eparams n) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n (S (Nat.add k1 k2)))) (meet n x (join n y z))) (join n (meet n x z) y)) *)
generalize k1 k2; clear k1 k2.
(* Goal: @Logic.eq (vect n) (k2g n (E0 (Kn.vn_eparams p n))) (E0 (vn_eparams n)) *)
induction n as [| n IH]; simpl; auto.
intros [|k1][|k2] Hk1k2; destruct x; auto;
   try (contradict Hk1k2; auto with arith; fail).
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite andbP; intros (Ho1,Ho2); auto.
(* Goal: forall _ : @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (genk n (Field.v0 (K1 p))) (if eq0 n (one_factor n k2 v) then one_factor n (S k2) v0 else one_factor n k2 v)) (@pair (vect n) (vect n) (genk n (Field.v0 (K1 p))) (genk n (Field.v0 (K1 p)))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) v v0) (@pair (vect n) (vect n) (genk n (Field.v0 (K1 p))) (genk n (Field.v0 (K1 p)))) *)
assert (Hl : k2 < k1) by auto with arith.
(* Goal: forall _ : @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (genk n (Field.v0 (K1 p))) (if eq0 n (one_factor n k2 v) then one_factor n (S k2) v0 else one_factor n k2 v)) (@pair (vect n) (vect n) (genk n (Field.v0 (K1 p))) (genk n (Field.v0 (K1 p)))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) v v0) (@pair (vect n) (vect n) (genk n (Field.v0 (K1 p))) (genk n (Field.v0 (K1 p)))) *)
case eq0_spec; auto.
(* Goal: forall (_ : @Logic.eq (vect n) (one_factor n k2 v) (E0 (vn_eparams n))) (_ : @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (genk n (Field.v0 (K1 p))) (one_factor n (S k2) v0)) (@pair (vect n) (vect n) (genk n (Field.v0 (K1 p))) (genk n (Field.v0 (K1 p))))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) v v0) (@pair (vect n) (vect n) (genk n (Field.v0 (K1 p))) (genk n (Field.v0 (K1 p)))) *)
(* Goal: forall (_ : not (@Logic.eq (vect n) (one_factor n k2 v) (E0 (vn_eparams n)))) (_ : @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (genk n (Field.v0 (K1 p))) (one_factor n k2 v)) (@pair (vect n) (vect n) (genk n (Field.v0 (K1 p))) (genk n (Field.v0 (K1 p))))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) v v0) (@pair (vect n) (vect n) (genk n (Field.v0 (K1 p))) (genk n (Field.v0 (K1 p)))) *)
intro Hv.
rewrite (IH _ _ _  Hl Ho1 Hv).
(* Goal: forall _ : @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (genk n (Field.v0 (K1 p))) (one_factor n (S k2) v0)) (@pair (vect n) (vect n) (genk n (Field.v0 (K1 p))) (genk n (Field.v0 (K1 p)))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (E0 (vn_eparams n)) v0) (@pair (vect n) (vect n) (genk n (Field.v0 (K1 p))) (genk n (Field.v0 (K1 p)))) *)
(* Goal: forall (_ : not (@Logic.eq (vect n) (one_factor n k2 v) (E0 (vn_eparams n)))) (_ : @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (genk n (Field.v0 (K1 p))) (one_factor n k2 v)) (@pair (vect n) (vect n) (genk n (Field.v0 (K1 p))) (genk n (Field.v0 (K1 p))))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) v v0) (@pair (vect n) (vect n) (genk n (Field.v0 (K1 p))) (genk n (Field.v0 (K1 p)))) *)
intros HH; injection HH; intros Hv0.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite (IH _ _ _  Hk1k2 Ho2 Hv0); auto.
(* Goal: forall (_ : not (@Logic.eq (vect n) (one_factor n k2 v) (E0 (vn_eparams n)))) (_ : @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (genk n (Field.v0 (K1 p))) (one_factor n k2 v)) (@pair (vect n) (vect n) (genk n (Field.v0 (K1 p))) (genk n (Field.v0 (K1 p))))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) v v0) (@pair (vect n) (vect n) (genk n (Field.v0 (K1 p))) (genk n (Field.v0 (K1 p)))) *)
intros HH1 HH2; case HH1; injection HH2; auto.
Qed.

(* Iterated contraction *)

Definition mcontra n (ll: list (kn n)) (x: vect n) :=
  fold_left (fun x l => #<l,x>#) ll x.

Notation "#<< l , x >>#" := (mcontra _ l x).

Lemma mcontra_nil n (x: vect n) : #<<nil, x>># = x.
Proof. simpl; auto. Qed.

Lemma mcontra_cons n (x: vect n) a l : #<<a::l, x>># = #<<l, #<a,x>#>>#.
Proof. simpl; auto. Qed.

Lemma mcontra_app n l1 l2 (M: vect n) :  
  #<< l1 ++ l2, M>># = #<<l2, #<<l1, M>>#>>#.
Proof.
(* Goal: @Logic.eq (vect n) (mcontra n (@app (kn p n) l1 l2) M) (mcontra n l2 (mcontra n l1 M)) *)
generalize M; clear M.
induction l1 as [| l l1 IH]; simpl; intros; 
(* Goal: @Logic.eq (vect n) (meet n (meet n v v1) v3) (meet n v (meet n v1 v3)) *)
(* Goal: @Logic.eq (vect n) (addE (vn_eparams n) (meet n (meet n v v1) v4) (meet n (addE (vn_eparams n) (meet n v v2) (meet n v0 (dconj n false v1))) (dconj n false v3))) (addE (vn_eparams n) (meet n v (addE (vn_eparams n) (meet n v1 v4) (meet n v2 (dconj n false v3)))) (meet n v0 (dconj n false (meet n v1 v3)))) *)
 try rewrite IH; auto.
Qed.

Lemma mcontra0 n lfs : #<< lfs, 0 >># = (0: vect n).
Proof.
(* Goal: @Logic.eq (vect n) (mcontra n (@cons (kn p n) a l) x) (mcontra n l (contra n a x)) *)
induction lfs as [| lf lfs IH]; simpl; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
Vfold n; rewrite contra0r, IH; auto.
Qed.

Hint Rewrite mcontra0: GRm0.

Lemma mcontra_id n a l (M: vect n) : #<< a::a::l, M>># = 0.
Proof. simpl; rewrite contra_id, mcontra0; auto. Qed.

Lemma mcontrak n lfs i : lfs <> nil -> #<< lfs, [i] >># = (0: vect n).
Proof.
(* Goal: forall _ : @Logic.eq (E (vn_eparams n)) v (joinl n (decomposek n (first_deg n v) v)), decomposable n (decomposek n (first_deg n v) v) v *)
(* Goal: forall _ : not (@Logic.eq (E (vn_eparams n)) v (joinl n (decomposek n (first_deg n v) v))), not (is_decomposable n v) *)
(* Goal: not (is_decomposable n v) *)
induction lfs as [| lf lfs IH]; simpl; intros HH.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
case HH; auto.
(* Goal: @Logic.eq (vect n) (mcontra n lfs (contra n lf (genk n i))) (genk n (v0 (K1 p))) *)
destruct lfs as [|lf1 lfs].
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite mcontra_nil, contrak; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite contrak, mcontra0; auto.
Qed.

Lemma mcontra_scal n k lfs (x: vect n) : #<< lfs, k .* x >># = k .* #<< lfs , x >>#.
Proof.
(* Goal: @Logic.eq (vect (S n)) (mcontra (S n) (@map (kn p n) (kn p (S n)) (Kn.lift p n) lfs1) (lift n x)) (lift n (mcontra n lfs1 x)) *)
generalize x; clear x.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
induction lfs as [| lf lfs IH]; simpl; Vfold n; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros; rewrite contra_scalr, IH; auto.
Qed.

Lemma mcontra_swap n a b l (M: vect n) :  
  #<< a::b::l, M>># = (-(1)).*  #<<b::a::l, M>>#.
Proof.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
simpl; Vfold n; rewrite contra_swap, mcontra_scal; auto.
Qed.

Lemma mcontra_add n lfs (x y: vect n) :
  #<< lfs, x + y >># = #<< lfs, x >># + #<< lfs,  y >>#.
Proof.
(* Goal: @Logic.eq (vect n) (mcontra n lfs (addE (vn_eparams n) x y)) (addE (vn_eparams n) (mcontra n lfs x) (mcontra n lfs y)) *)
generalize x y; clear x y.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
induction lfs as [| lf lfs IH]; simpl; intros; Vfold n; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite contra_addr, IH; auto.
Qed.

Lemma mcontra_conj n lfs b (x: vect n) : 
  #<<lfs, x ^_ b >># = #<< lfs, x >># ^_ (iter negb (length lfs) b).
Proof.
(* Goal: @Logic.eq (vect n) (mcontra n lfs (conj n b x)) (conj n (@iter bool negb (@length (kn p n) lfs) b) (mcontra n lfs x)) *)
generalize b x; clear b x.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
induction lfs as [| lf lfs IH]; simpl; Vfold n; intros b x; auto.
(* Goal: @Logic.eq (vect n) (mcontra n lfs (contra n lf (conj n b x))) (conj n (negb (@iter bool negb (@length (kn p n) lfs) b)) (mcontra n lfs (contra n lf x))) *)
rewrite contra_conj, IH.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply f_equal2 with (f := conj n); auto.
(* Goal: @Logic.eq (vect n) (mcontra n (@cons (kn p n) a l) x) (mcontra n l (contra n a x)) *)
clear IH; induction (length lfs) as [| m IH]; simpl; auto.
(* Goal: @Logic.eq (vect n) (meet n (meet n v v1) v3) (meet n v (meet n v1 v3)) *)
(* Goal: @Logic.eq (vect n) (addE (vn_eparams n) (meet n (meet n v v1) v4) (meet n (addE (vn_eparams n) (meet n v v2) (meet n v0 (dconj n false v1))) (dconj n false v3))) (addE (vn_eparams n) (meet n v (addE (vn_eparams n) (meet n v1 v4) (meet n v2 (dconj n false v3)))) (meet n v0 (dconj n false (meet n v1 v3)))) *)
rewrite IH; auto.
Qed.

Lemma mcontra_hom n k (x: vect n) l :
  hom n k x -> hom n (k - length l) #<<l, x>>#.
Proof.
generalize k x; clear k x; induction l as [| a l IH];
  intros k x Hx; simpl.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite <- Minus.minus_n_O; auto.
(* Goal: b2Prop (hom n (Nat.sub k (S (@length (kn p n) l))) (mcontra n l (contra n a x))) *)
destruct k as [| k]; simpl.
(* Goal: b2Prop (hom n O (mcontra n l (contra n a x))) *)
(* Goal: b2Prop (hom n (Nat.sub k (@length (kn p n) l)) (mcontra n l (contra n a x))) *)
rewrite (hom0E _ _ Hx), contra_hom0; Grm0.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply IH; auto.
Qed.

Hint Resolve mcontra_hom.

Lemma mcontra_hom0 n lfs M : lfs <> nil -> hom n 0 M -> #<<lfs , M>># = 0.
Proof.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros H H1; rewrite (hom0E _ _ H1); apply mcontrak; auto.
Qed.

Notation liftk := (Kn.lift p).

Lemma lift_contra n lf1 x : #< liftk n lf1, lift n x ># = lift n #<lf1, x>#.
Proof.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
induction n as [| n IH]; simpl; Krm0; auto.
(* Goal: @Logic.eq (prod (prod (vect n) (vect n)) (prod (vect n) (vect n))) (@pair (prod (vect n) (vect n)) (prod (vect n) (vect n)) (let (l2, l3) := let (k, lf1) := lf1 in @pair (vect n) (vect n) (scal n (oppK (K1 p) (v1 (K1 p))) (contra n lf1 (genk n (v0 (K1 p))))) (add n (scal n k (genk n (v0 (K1 p)))) (contra n lf1 (genk n (v0 (K1 p))))) in @pair (vect n) (vect n) (scal n (oppK (K1 p) (v1 (K1 p))) l2) (scal n (oppK (K1 p) (v1 (K1 p))) l3)) (let (l4, l6) := let (k, lf1) := lf1 in let (l2, l3) := x in @pair (vect n) (vect n) (scal n (oppK (K1 p) (v1 (K1 p))) (contra n lf1 l2)) (add n (scal n k l2) (contra n lf1 l3)) in @pair (vect n) (vect n) (add n (scal n (v0 (K p)) (genk n (v0 (K1 p)))) l4) (add n (scal n (v0 (K p)) (genk n (v0 (K1 p)))) l6))) (lift (S n) (let (k, lf1) := lf1 in let (l2, l3) := x in @pair (vect n) (vect n) (scal n (oppK (K1 p) (v1 (K1 p))) (contra n lf1 l2)) (add n (scal n k l2) (contra n lf1 l3)))) *)
destruct lf1; destruct x; Vfold n; Vrm0.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (mcontra (S n) (@map (kn p n) (prod (Field.K (K p)) (kn p n)) (Kn.lift p n) lfs) (@pair (vect n) (vect n) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf (E0 (vn_eparams n)))) (contra n lf x))) (lift n (mcontra n lfs (contra n lf x))) *)
rewrite contra0r; Vrm0.
Qed.

Lemma lift_mcontra n lfs1 x :
  #<< map (liftk n) lfs1, lift n x >># = lift n #<<lfs1, x>>#.
Proof.
(* Goal: @Logic.eq (vect (S n)) (mcontra (S n) (@map (kn p n) (kn p (S n)) (Kn.lift p n) lfs1) (lift n x)) (lift n (mcontra n lfs1 x)) *)
generalize x; clear x.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
induction lfs1 as [| lf lfs IH]; simpl; Vfold n; auto.
(* Goal: forall x : vect n, @Logic.eq (prod (vect n) (vect n)) (mcontra (S n) (@map (kn p n) (prod (Field.K (K p)) (kn p n)) (Kn.lift p n) lfs) (@pair (vect n) (vect n) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf (E0 (vn_eparams n)))) (addE (vn_eparams n) (scalE (vn_eparams n) (v0 (K p)) (E0 (vn_eparams n))) (contra n lf x)))) (lift n (mcontra n lfs (contra n lf x))) *)
intros x; simpl; Vfold n; Vrm0.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (mcontra (S n) (@map (kn p n) (prod (Field.K (K p)) (kn p n)) (Kn.lift p n) lfs) (@pair (vect n) (vect n) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n lf (E0 (vn_eparams n)))) (contra n lf x))) (lift n (mcontra n lfs (contra n lf x))) *)
rewrite contra0r; Vrm0.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (mcontra (S n) (@map (kn p n) (prod (Field.K (K p)) (kn p n)) (Kn.lift p n) lfs) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (contra n lf x))) (lift n (mcontra n lfs (contra n lf x))) *)
apply (IH #<lf, x>#).
Qed.

Lemma mcontra_one_factor n k1 k2 (x: vect n) :
  k2 < k1 -> hom n k1 x -> 
 exists lfs, length lfs = k2 /\ #<<lfs , x>># = one_factor n k2 x.
Proof.
(* Goal: forall (_ : b2Prop (hom n k1 x)) (_ : b2Prop (hom n (S O) y)) (_ : b2Prop (hom n k2 z)), @Logic.eq (vect n) (meet n (join n x y) z) (addE (vn_eparams n) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n (S (Nat.add k1 k2)))) (meet n x (join n y z))) (join n (meet n x z) y)) *)
generalize k1 k2; clear k1 k2.
(* Goal: @Logic.eq (vect n) (k2g n (E0 (Kn.vn_eparams p n))) (E0 (vn_eparams n)) *)
induction n as [| n IH]; simpl; auto.
(* Goal: forall (k1 k2 : nat) (_ : lt k2 k1) (_ : b2Prop match k1 with | O => true | S n => eqK (K1 p) x (v0 (K1 p)) end), @ex (list unit) (fun lfs : list unit => and (@Logic.eq nat (@length unit lfs) k2) (@Logic.eq (Field.K (K1 p)) (mcontra O lfs x) x)) *)
(* Goal: forall (k1 k2 : nat) (_ : lt k2 k1) (_ : b2Prop (let (l2, l3) := x in andb match k1 with | O => eq0 n l2 | S k3 => hom n k3 l2 end (hom n k1 l3))), @ex (list (prod (Field.K (K p)) (kn p n))) (fun lfs : list (prod (Field.K (K p)) (kn p n)) => and (@Logic.eq nat (@length (prod (Field.K (K p)) (kn p n)) lfs) k2) (@Logic.eq (prod (vect n) (vect n)) (mcontra (S n) lfs x) match k2 with | O => x | S k3 => let (l1, l2) := x in @pair (vect n) (vect n) (genk n (v0 (K1 p))) (if eq0 n (one_factor n k3 l1) then one_factor n k2 l2 else one_factor n k3 l1) end)) *)
intros [| k1] k2 Hlt.
(* Goal: forall _ : b2Prop (andb (eq0 n v) (hom n O v0)), @ex (list (prod (Field.K (K p)) (kn p n))) (fun lfs : list (prod (Field.K (K p)) (kn p n)) => and (@Logic.eq nat (@length (prod (Field.K (K p)) (kn p n)) lfs) k2) (@Logic.eq (prod (vect n) (vect n)) (mcontra (S n) lfs (@pair (vect n) (vect n) v v0)) match k2 with | O => @pair (vect n) (vect n) v v0 | S k1 => @pair (vect n) (vect n) (genk n (Field.v0 (K1 p))) (if eq0 n (one_factor n k1 v) then one_factor n k2 v0 else one_factor n k1 v) end)) *)
(* Goal: forall _ : b2Prop (andb (hom n k1 v) (hom n (S k1) v0)), @ex (list (prod (Field.K (K p)) (kn p n))) (fun lfs : list (prod (Field.K (K p)) (kn p n)) => and (@Logic.eq nat (@length (prod (Field.K (K p)) (kn p n)) lfs) k2) (@Logic.eq (prod (vect n) (vect n)) (mcontra (S n) lfs (@pair (vect n) (vect n) v v0)) match k2 with | O => @pair (vect n) (vect n) v v0 | S k1 => @pair (vect n) (vect n) (genk n (Field.v0 (K1 p))) (if eq0 n (one_factor n k1 v) then one_factor n k2 v0 else one_factor n k1 v) end)) *)
contradict Hlt; auto with arith.
(* Goal: forall _ : b2Prop (eqK (K1 p) x (v0 (K1 p))), @ex (list unit) (fun lfs : list unit => and (@Logic.eq nat (@length unit lfs) k2) (@Logic.eq (Field.K (K1 p)) (mcontra O lfs x) x)) *)
(* Goal: forall (k1 k2 : nat) (_ : lt k2 k1) (_ : b2Prop (let (l2, l3) := x in andb match k1 with | O => eq0 n l2 | S k3 => hom n k3 l2 end (hom n k1 l3))), @ex (list (prod (Field.K (K p)) (kn p n))) (fun lfs : list (prod (Field.K (K p)) (kn p n)) => and (@Logic.eq nat (@length (prod (Field.K (K p)) (kn p n)) lfs) k2) (@Logic.eq (prod (vect n) (vect n)) (mcontra (S n) lfs x) match k2 with | O => x | S k3 => let (l1, l2) := x in @pair (vect n) (vect n) (genk n (v0 (K1 p))) (if eq0 n (one_factor n k3 l1) then one_factor n k2 l2 else one_factor n k3 l1) end)) *)
case eqK_spec; auto; intros Hx; subst; try (intros; discriminate).
(* Goal: forall _ : b2Prop true, @ex (list unit) (fun lfs : list unit => and (@Logic.eq nat (@length unit lfs) k2) (@Logic.eq (Field.K (K1 p)) (mcontra O lfs (v0 (K1 p))) (v0 (K1 p)))) *)
(* Goal: forall (k1 k2 : nat) (_ : lt k2 k1) (_ : b2Prop (let (l2, l3) := x in andb match k1 with | O => eq0 n l2 | S k3 => hom n k3 l2 end (hom n k1 l3))), @ex (list (prod (Field.K (K p)) (kn p n))) (fun lfs : list (prod (Field.K (K p)) (kn p n)) => and (@Logic.eq nat (@length (prod (Field.K (K p)) (kn p n)) lfs) k2) (@Logic.eq (prod (vect n) (vect n)) (mcontra (S n) lfs x) match k2 with | O => x | S k3 => let (l1, l2) := x in @pair (vect n) (vect n) (genk n (v0 (K1 p))) (if eq0 n (one_factor n k3 l1) then one_factor n k2 l2 else one_factor n k3 l1) end)) *)
exists (iter (cons tt) k2 nil); split; clear Hlt.
(* Goal: @Logic.eq (vect n) (mcontra n (@cons (kn p n) a l) x) (mcontra n l (contra n a x)) *)
induction k2 as [| k2 IH1]; simpl; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite mcontra0; auto.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (let (x1, y1) := x in @pair (vect n) (vect n) (meet n x1 (E0 (vn_eparams n))) (addE (vn_eparams n) (meet n x1 (genk n (v1 (K1 p)))) (meet n y1 (dconj n false (E0 (vn_eparams n)))))) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (genk n (let (_, l2) := let (x, y) := x in @pair (vect n) (vect n) (dual n (conj n false y)) (dual n x) in const n l2))) *)
intros [| k1] k2 Hlt; destruct x.
(* Goal: forall _ : b2Prop (andb (eq0 n v) (hom n O v0)), @ex (list (prod (Field.K (K p)) (kn p n))) (fun lfs : list (prod (Field.K (K p)) (kn p n)) => and (@Logic.eq nat (@length (prod (Field.K (K p)) (kn p n)) lfs) k2) (@Logic.eq (prod (vect n) (vect n)) (mcontra (S n) lfs (@pair (vect n) (vect n) v v0)) match k2 with | O => @pair (vect n) (vect n) v v0 | S k1 => @pair (vect n) (vect n) (genk n (Field.v0 (K1 p))) (if eq0 n (one_factor n k1 v) then one_factor n k2 v0 else one_factor n k1 v) end)) *)
(* Goal: forall _ : b2Prop (andb (hom n k1 v) (hom n (S k1) v0)), @ex (list (prod (Field.K (K p)) (kn p n))) (fun lfs : list (prod (Field.K (K p)) (kn p n)) => and (@Logic.eq nat (@length (prod (Field.K (K p)) (kn p n)) lfs) k2) (@Logic.eq (prod (vect n) (vect n)) (mcontra (S n) lfs (@pair (vect n) (vect n) v v0)) match k2 with | O => @pair (vect n) (vect n) v v0 | S k1 => @pair (vect n) (vect n) (genk n (Field.v0 (K1 p))) (if eq0 n (one_factor n k1 v) then one_factor n k2 v0 else one_factor n k1 v) end)) *)
contradict Hlt; auto with arith.
(* Goal: forall _ : b2Prop (andb (hom n O x1) (hom n (S O) x2)), @ex (prod (Field.K (K p)) (kn p n)) (fun y : prod (Field.K (K p)) (kn p n) => @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) x1 x2) (let (k, v1) := y in @pair (vect n) (vect n) (genk n k) (k2g n v1))) *)
rewrite andbP; intros (Hx1, Hx2).
(*
case eq0_spec; intros H0x1; try (case eq0_spec; intros H1x2); subst.
exists (iter (cons nil) k2 nil); split; clear Hlt.
(* Goal: @Logic.eq (vect n) (mcontra n (@cons (kn p n) a l) x) (mcontra n l (contra n a x)) *)
induction k2 as [| k2 IH1]; simpl; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite mcontra0; auto.
*)
(* Goal: cbl n l k2 (join n v (contra n lf x)) *)
(* Goal: forall (k : nat) (x : vect n) (_ : cbl n l (S k) x), cbl n l k (contra n lf x) *)
destruct k2 as [| k2].
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
exists nil; auto.
(* Goal: @ex (list (prod (Field.K (K p)) (kn p n))) (fun lfs : list (prod (Field.K (K p)) (kn p n)) => and (@Logic.eq nat (@length (prod (Field.K (K p)) (kn p n)) lfs) (S k2)) (@Logic.eq (prod (vect n) (vect n)) (mcontra (S n) lfs (@pair (vect n) (vect n) v v0)) (@pair (vect n) (vect n) (genk n (Field.v0 (K1 p))) (if eq0 n (one_factor n k2 v) then one_factor n (S k2) v0 else one_factor n k2 v)))) *)
case eq0_spec; intros H1x2.
(* Goal: @ex (list (prod (Field.K (K p)) (kn p n))) (fun lfs : list (prod (Field.K (K p)) (kn p n)) => and (@Logic.eq nat (@length (prod (Field.K (K p)) (kn p n)) lfs) (S k2)) (@Logic.eq (prod (vect n) (vect n)) (mcontra (S n) lfs (@pair (vect n) (vect n) v v0)) (@pair (vect n) (vect n) (genk n (Field.v0 (K1 p))) (one_factor n (S k2) v0)))) *)
(* Goal: @ex (list (prod (Field.K (K p)) (kn p n))) (fun lfs : list (prod (Field.K (K p)) (kn p n)) => and (@Logic.eq nat (@length (prod (Field.K (K p)) (kn p n)) lfs) (S k2)) (@Logic.eq (prod (vect n) (vect n)) (mcontra (S n) lfs (@pair (vect n) (vect n) v v0)) (@pair (vect n) (vect n) (genk n (Field.v0 (K1 p))) (one_factor n k2 v)))) *)
case (IH _ _ _ Hlt Hx2); intros lf1.
(* Goal: forall _ : and (@Logic.eq nat (@length (kn p n) lf1) (S k2)) (@Logic.eq (vect n) (mcontra n lf1 v0) (one_factor n (S k2) v0)), @ex (list (prod (Field.K (K p)) (kn p n))) (fun lfs : list (prod (Field.K (K p)) (kn p n)) => and (@Logic.eq nat (@length (prod (Field.K (K p)) (kn p n)) lfs) (S k2)) (@Logic.eq (prod (vect n) (vect n)) (mcontra (S n) lfs (@pair (vect n) (vect n) v v0)) (@pair (vect n) (vect n) (genk n (Field.v0 (K1 p))) (one_factor n (S k2) v0)))) *)
(* Goal: @ex (list (prod (Field.K (K p)) (kn p n))) (fun lfs : list (prod (Field.K (K p)) (kn p n)) => and (@Logic.eq nat (@length (prod (Field.K (K p)) (kn p n)) lfs) (S k2)) (@Logic.eq (prod (vect n) (vect n)) (mcontra (S n) lfs (@pair (vect n) (vect n) v v0)) (@pair (vect n) (vect n) (genk n (Field.v0 (K1 p))) (one_factor n k2 v)))) *)
intros (Hlf1, H1lf1).
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
exists (map (liftk n) lf1); split; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite map_length; auto.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (mcontra (S n) (@map (kn p n) (kn p (S n)) (Kn.lift p n) lf1) (@pair (vect n) (vect n) v v0)) (@pair (vect n) (vect n) (genk n (Field.v0 (K1 p))) (one_factor n (S k2) v0)) *)
(* Goal: @ex (list (prod (Field.K (K p)) (kn p n))) (fun lfs : list (prod (Field.K (K p)) (kn p n)) => and (@Logic.eq nat (@length (prod (Field.K (K p)) (kn p n)) lfs) (S k2)) (@Logic.eq (prod (vect n) (vect n)) (mcontra (S n) lfs (@pair (vect n) (vect n) v v0)) (@pair (vect n) (vect n) (genk n (Field.v0 (K1 p))) (one_factor n k2 v)))) *)
rewrite one_factor_zero with (k1 := k1) (3 := H1x2); auto with arith.
generalize lift_mcontra; unfold lift; intros HH1;
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
 rewrite HH1, H1lf1; auto.
(* Goal: @ex (list (prod (Field.K (K p)) (kn p n))) (fun lfs : list (prod (Field.K (K p)) (kn p n)) => and (@Logic.eq nat (@length (prod (Field.K (K p)) (kn p n)) lfs) (S k2)) (@Logic.eq (prod (vect n) (vect n)) (mcontra (S n) lfs (@pair (vect n) (vect n) v v0)) (@pair (vect n) (vect n) (genk n (Field.v0 (K1 p))) (one_factor n k2 v)))) *)
case (IH _ _ _ (Lt.lt_S_n _ _ Hlt) Hx1).
intros lfs1  (H1lfs1, H2lfs1).
exists ((1%f, 0):: (map (liftk n) lfs1 : list (K * kn n))); simpl; Vfold n; split.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite map_length; auto.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (mcontra (S n) (@map (kn p n) (prod (Field.K (K p)) (kn p n)) (Kn.lift p n) lfs1) (@pair (vect n) (vect n) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (contra n (Kn.genk p n (Field.v0 (K p))) v)) (addE (vn_eparams n) (scalE (vn_eparams n) (v1 (K1 p)) v) (contra n (Kn.genk p n (Field.v0 (K p))) v0)))) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (one_factor n k2 v)) *)
rewrite !contra0l, scalE1; Vrm0.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (mcontra (S n) (@map (kn p n) (prod (Field.K (K p)) (kn p n)) (Kn.lift p n) lfs1) (@pair (vect n) (vect n) (E0 (vn_eparams n)) v)) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (one_factor n k2 v)) *)
rewrite <- H2lfs1.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply (lift_mcontra n); auto.
Qed.

Inductive cbl n (l: list (vect n)): nat -> (vect n) -> Prop :=
| cbl_in: forall v, In v l -> cbl n l 0%nat v
| cbl_add: forall k x y, cbl n l k x -> cbl n l k y -> cbl n l k (x + y)
| cbl_scal: forall k k1 x, cbl n l k x -> cbl n l k (k1 .* x)
| cbl_join: forall k v x, In v l -> cbl n l k x -> cbl n l k.+1 (v ∨ x).

Lemma cbl_cons n (a: vect n) l k x : cbl n l k x -> cbl n (a::l) k x.
Proof.
intros H; elim H; simpl; auto with arith;
(* Goal: cbl n (@cons (vect n) a (@cons (vect n) b l)) (Nat.add (S O) (Nat.pred (@length (vect n) (@cons (vect n) b l)))) (join n a (joinl n (@cons (vect n) b l))) *)
(* Goal: not (@Logic.eq (list (vect n)) (@cons (vect n) b l) (@nil (vect n))) *)
  intros; constructor; auto with datatypes.
Qed.

Lemma joinl_join n l (v: vect n) : 
  (forall x, In x l -> hom n 1 x) -> In v l -> v ∨ joinl n l = 0.
Proof.
(* Goal: forall (_ : forall (x : vect n) (_ : @In (vect n) x l), b2Prop (hom n (S O) x)) (_ : @In (vect n) v l), @Logic.eq (vect n) (join n v (joinl n l)) (E0 (vn_eparams n)) *)
intros Hv Hivl; rewrite <-joinlS.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply (cbl_joinl0_mprod n); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros i Hi; red; rewrite cbl1_hom1_equiv; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
constructor; auto.
(* Goal: not (@Logic.eq (list (vect n)) l (@nil (vect n))) *)
intros Hl; subst; case Hivl.
Qed.

Lemma cbl_joinl n (l: list (vect n)) :
  l <> nil -> (forall x, In x l -> hom n 1 x) -> cbl n l (pred (length l)) (joinl n l).
Proof.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
induction l as [| a l IH]; auto.
(* Goal: forall (_ : not (@Logic.eq (list (vect n)) (@nil (vect n)) (@nil (vect n)))) (_ : forall (x : vect n) (_ : @In (vect n) x (@nil (vect n))), b2Prop (hom n (S O) x)), cbl n (@nil (vect n)) (Nat.pred (@length (vect n) (@nil (vect n)))) (joinl n (@nil (vect n))) *)
(* Goal: forall (_ : not (@Logic.eq (list (vect n)) (@cons (vect n) a l) (@nil (vect n)))) (_ : forall (x : vect n) (_ : @In (vect n) x (@cons (vect n) a l)), b2Prop (hom n (S O) x)), cbl n (@cons (vect n) a l) (Nat.pred (@length (vect n) (@cons (vect n) a l))) (joinl n (@cons (vect n) a l)) *)
intros HH; case HH; auto.
(* Goal: forall (_ : not (@Logic.eq (list (vect n)) (@cons (vect n) a l) (@nil (vect n)))) (_ : forall (x : vect n) (_ : @In (vect n) x (@cons (vect n) a l)), b2Prop (hom n (S O) x)), cbl n (@cons (vect n) a l) (Nat.pred (@length (vect n) (@cons (vect n) a l))) (joinl n (@cons (vect n) a l)) *)
intros _ H1.
(* Goal: cbl n (@cons (vect n) a l) (Nat.pred (@length (vect n) (@cons (vect n) a l))) (joinl n (@cons (vect n) a l)) *)
destruct l as [| b l].
(* Goal: cbl n (@cons (vect n) a (@cons (vect n) b l)) (Nat.add (S O) (Nat.pred (@length (vect n) (@cons (vect n) b l)))) (join n a (joinl n (@cons (vect n) b l))) *)
(* Goal: not (@Logic.eq (list (vect n)) (@cons (vect n) b l) (@nil (vect n))) *)
simpl pred; rewrite joinl1; constructor; auto with datatypes.
(* Goal: cbl n (@cons (vect n) a (@cons (vect n) b l)) (Nat.pred (@length (vect n) (@cons (vect n) a (@cons (vect n) b l)))) (joinl n (@cons (vect n) a (@cons (vect n) b l))) *)
rewrite joinlS.
(* Goal: cbl n (@cons (vect n) a (@cons (vect n) b l)) (Nat.pred (@length (vect n) (@cons (vect n) a (@cons (vect n) b l)))) (join n a (joinl n (@cons (vect n) b l))) *)
(* Goal: not (@Logic.eq (list (vect n)) (@cons (vect n) b l) (@nil (vect n))) *)
change (pred(length (a::b :: l))) with (1 + (pred (length (b :: l))))%nat.
(* Goal: cbl n (@cons (vect n) a (@cons (vect n) b l)) (Nat.add (S O) (Nat.pred (@length (vect n) (@cons (vect n) b l)))) (join n a (joinl n (@cons (vect n) b l))) *)
(* Goal: not (@Logic.eq (list (vect n)) (@cons (vect n) b l) (@nil (vect n))) *)
constructor; auto with datatypes.
(* Goal: cbl n (@cons (vect n) a (@cons (vect n) b l)) (Nat.pred (@length (vect n) (@cons (vect n) b l))) (joinl n (@cons (vect n) b l)) *)
(* Goal: not (@Logic.eq (list (vect n)) (@cons (vect n) b l) (@nil (vect n))) *)
apply cbl_cons; apply IH; auto with datatypes.
(* Goal: b2Prop false *)
intros; discriminate.
Qed.

Lemma cbl_joinl0 n (l: list (vect n)) k x :
  (forall x, In x l -> hom n 1 x) -> cbl n l k x -> x ∨ joinl n l = 0.
Proof.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros Hl HH; elim HH; clear x HH; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros; apply joinl_join; auto.
(* Goal: forall (k : nat) (x y : vect n) (_ : cbl n l k x) (_ : @Logic.eq (vect n) (join n x (joinl n l)) (E0 (vn_eparams n))) (_ : cbl n l k y) (_ : @Logic.eq (vect n) (join n y (joinl n l)) (E0 (vn_eparams n))), @Logic.eq (vect n) (join n (addE (vn_eparams n) x y) (joinl n l)) (E0 (vn_eparams n)) *)
(* Goal: forall (k : nat) (k1 : Field.K (stype (vn_eparams n))) (x : vect n) (_ : cbl n l k x) (_ : @Logic.eq (vect n) (join n x (joinl n l)) (E0 (vn_eparams n))), @Logic.eq (vect n) (join n (scalE (vn_eparams n) k1 x) (joinl n l)) (E0 (vn_eparams n)) *)
(* Goal: forall (k : nat) (v x : vect n) (_ : @In (vect n) v l) (_ : cbl n l k x) (_ : @Logic.eq (vect n) (join n x (joinl n l)) (E0 (vn_eparams n))), @Logic.eq (vect n) (join n (join n v x) (joinl n l)) (E0 (vn_eparams n)) *)
intros k1 x y Hx Hmx Hy Hmy.
(* Goal: @Logic.eq (vect n) (join n (addE (vn_eparams n) x y) (joinl n l)) (E0 (vn_eparams n)) *)
(* Goal: forall (k : nat) (k1 : Field.K (stype (vn_eparams n))) (x : vect n) (_ : cbl n l k x) (_ : @Logic.eq (vect n) (join n x (joinl n l)) (E0 (vn_eparams n))), @Logic.eq (vect n) (join n (scalE (vn_eparams n) k1 x) (joinl n l)) (E0 (vn_eparams n)) *)
(* Goal: forall (k : nat) (v x : vect n) (_ : @In (vect n) v l) (_ : cbl n l k x) (_ : @Logic.eq (vect n) (join n x (joinl n l)) (E0 (vn_eparams n))), @Logic.eq (vect n) (join n (join n v x) (joinl n l)) (E0 (vn_eparams n)) *)
 rewrite join_addl, Hmx, Hmy; Vrm0.
(* Goal: forall (k : nat) (k1 : Field.K (stype (vn_eparams n))) (x : vect n) (_ : cbl n l k x) (_ : @Logic.eq (vect n) (join n x (joinl n l)) (E0 (vn_eparams n))), @Logic.eq (vect n) (join n (scalE (vn_eparams n) k1 x) (joinl n l)) (E0 (vn_eparams n)) *)
(* Goal: forall (k : nat) (v x : vect n) (_ : @In (vect n) v l) (_ : cbl n l k x) (_ : @Logic.eq (vect n) (join n x (joinl n l)) (E0 (vn_eparams n))), @Logic.eq (vect n) (join n (join n v x) (joinl n l)) (E0 (vn_eparams n)) *)
intros k1 k2 x Hx Hmx; rewrite join_scall, Hmx; Vrm0.
(* Goal: forall (k : nat) (v x : vect n) (_ : @In (vect n) v l) (_ : cbl n l k x) (_ : @Logic.eq (vect n) (join n x (joinl n l)) (E0 (vn_eparams n))), @Logic.eq (vect n) (join n (join n v x) (joinl n l)) (E0 (vn_eparams n)) *)
intros k1 v x Hl1 Hx Hmx.
(* Goal: @Logic.eq (vect n) (join n (join n v x) (joinl n l)) (E0 (vn_eparams n)) *)
rewrite join_assoc, Hmx; Grm0.
Qed.

Lemma cbl_hom n (l: list (vect n)) k x :
  (forall x, In x l -> hom n 1 x) -> cbl n l k x -> hom n k.+1 x.
Proof.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros Hl HH; elim HH; clear x HH; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros k1 v x Hv Hvc Hmx; apply (join_hom n 1 k1.+1); auto.
Qed.

Lemma cbl_contra n (l: list (vect n)) lf k x :
  (forall x, In x l -> hom n 1 x) -> cbl n l k.+1 x -> cbl n l k #<lf, x>#.
Proof.
(* Goal: forall (_ : forall (x : vect n) (_ : @In (vect n) x l), b2Prop (hom n (S O) x)) (_ : cbl n l (S k) x), cbl n l k (contra n lf x) *)
intros Hl; generalize k x; clear k x.
assert (H: forall (k k1 : nat) (x : vect n), cbl n l k x -> 
                k = k1.+1 ->  cbl n l k1 #<lf, x >#).
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros k k1 x HH; generalize k1; elim HH; clear x HH k; auto.
(* Goal: b2Prop false *)
intros; discriminate.
(* Goal: forall (k : nat) (x y : vect n) (_ : cbl n l k x) (_ : forall (k1 : nat) (_ : @Logic.eq nat k (S k1)), cbl n l k1 (contra n lf x)) (_ : cbl n l k y) (_ : forall (k1 : nat) (_ : @Logic.eq nat k (S k1)), cbl n l k1 (contra n lf y)) (k1 : nat) (_ : @Logic.eq nat k (S k1)), cbl n l k1 (contra n lf (addE (vn_eparams n) x y)) *)
(* Goal: forall (k : nat) (k1 : Field.K (stype (vn_eparams n))) (x : vect n) (_ : cbl n l k x) (_ : forall (k2 : nat) (_ : @Logic.eq nat k (S k2)), cbl n l k2 (contra n lf x)) (k2 : nat) (_ : @Logic.eq nat k (S k2)), cbl n l k2 (contra n lf (scalE (vn_eparams n) k1 x)) *)
(* Goal: forall (k : nat) (v x : vect n) (_ : @In (vect n) v l) (_ : cbl n l k x) (_ : forall (k1 : nat) (_ : @Logic.eq nat k (S k1)), cbl n l k1 (contra n lf x)) (k1 : nat) (_ : @Logic.eq nat (S k) (S k1)), cbl n l k1 (contra n lf (join n v x)) *)
(* Goal: forall (k : nat) (x : vect n) (_ : cbl n l (S k) x), cbl n l k (contra n lf x) *)
intros k x y Hx IHx Hy IHy k2 Hk2; subst.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite contra_addr; apply cbl_add; auto.
(* Goal: forall (k : nat) (k1 : Field.K (stype (vn_eparams n))) (x : vect n) (_ : cbl n l k x) (_ : forall (k2 : nat) (_ : @Logic.eq nat k (S k2)), cbl n l k2 (contra n lf x)) (k2 : nat) (_ : @Logic.eq nat k (S k2)), cbl n l k2 (contra n lf (scalE (vn_eparams n) k1 x)) *)
(* Goal: forall (k : nat) (v x : vect n) (_ : @In (vect n) v l) (_ : cbl n l k x) (_ : forall (k1 : nat) (_ : @Logic.eq nat k (S k1)), cbl n l k1 (contra n lf x)) (k1 : nat) (_ : @Logic.eq nat (S k) (S k1)), cbl n l k1 (contra n lf (join n v x)) *)
(* Goal: forall (k : nat) (x : vect n) (_ : cbl n l (S k) x), cbl n l k (contra n lf x) *)
intros k k2 x Hx IHx k3 Hk3; subst.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite contra_scalr; apply cbl_scal; auto.
(* Goal: forall (k : nat) (v x : vect n) (_ : @In (vect n) v l) (_ : cbl n l k x) (_ : forall (k1 : nat) (_ : @Logic.eq nat k (S k1)), cbl n l k1 (contra n lf x)) (k1 : nat) (_ : @Logic.eq nat (S k) (S k1)), cbl n l k1 (contra n lf (join n v x)) *)
(* Goal: forall (k : nat) (x : vect n) (_ : cbl n l (S k) x), cbl n l k (contra n lf x) *)
intros k v x Hv Hx IHx k2 HH; injection HH; intros HH1; subst.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
assert (Hm1: hom n 1 v) by auto.
(* Goal: cbl n l k2 (contra n lf (join n v x)) *)
(* Goal: forall (k : nat) (x : vect n) (_ : cbl n l (S k) x), cbl n l k (contra n lf x) *)
assert (Hmx: hom n k2.+1 x) by (apply cbl_hom with l; auto).
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite (contra_join n lf 1 k2.+1); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply cbl_add; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite contra_const, joinkl; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply cbl_scal; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite join_scall; apply cbl_scal; auto.
(* Goal: cbl n l k2 (join n v (contra n lf x)) *)
(* Goal: forall (k : nat) (x : vect n) (_ : cbl n l (S k) x), cbl n l k (contra n lf x) *)
destruct k2 as [| k2].
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite contra_const, joinkr; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply cbl_scal; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply cbl_in; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply cbl_join; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros k x HH; apply H with k.+1; auto.
Qed.

Lemma cbl_mcontra n (l: list (vect n)) lfs k x :
  length lfs <= k ->
  (forall x, In x l -> hom n 1 x) -> cbl n l k x -> cbl n l (k - length lfs) #<<lfs, x>>#.
Proof.
(* Goal: forall (_ : le (@length (kn p n) lfs) k) (_ : forall (x : vect n) (_ : @In (vect n) x l), b2Prop (hom n (S O) x)) (_ : cbl n l k x), cbl n l (Nat.sub k (@length (kn p n) lfs)) (mcontra n lfs x) *)
intros Hk HH; generalize k x Hk; clear k x Hk.
induction lfs as [| lf lfs IH]; simpl; intros [| k] x Hk;
(* Goal: @Logic.eq (vect n) (mcontra n (@cons (kn p n) a l) x) (mcontra n l (contra n a x)) *)
  try (contradict Hk; auto with arith; fail); simpl; auto.
(* Goal: b2Prop (andb true (hom n (S O) (gen n k))) *)
intros H1; apply IH; auto with arith.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
destruct k as [| k]; apply cbl_contra; auto.
Qed.

Lemma decomp_one_factor_hom n (l: list (vect n)) M : l <> nil ->
 decomposable n l M -> hom n 1 (one_factor n (pred (length l)) M).
Proof.
(* Goal: forall (_ : not (@Logic.eq (list (vect n)) l (@nil (vect n)))) (_ : decomposable n l M), b2Prop (hom n (S O) (one_factor n (Nat.pred (@length (vect n) l)) M)) *)
intros Hd H.
(* Goal: @Logic.eq (vect n) (join n (one_factor n (Nat.pred (@length (vect n) l)) M) M) (E0 (vn_eparams n)) *)
assert (Hhm:= decomp_hom n l M H).
(* Goal: @Logic.eq (vect n) (join n (one_factor n (Nat.pred (@length (vect n) l)) M) M) (E0 (vn_eparams n)) *)
case H; intros H1 H2; subst; clear H.
(* Goal: b2Prop (hom n (S O) (one_factor n (Nat.pred (@length (vect n) l)) (joinl n l))) *)
assert (Hl: pred (length l) < length l).
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
destruct l; simpl; auto with arith; case Hd; auto.
(* Goal: @Logic.eq (vect n) (join n (one_factor n (Nat.pred (@length (vect n) l)) (joinl n l)) (joinl n l)) (E0 (vn_eparams n)) *)
assert (Hh: forall x, In x l -> hom n 1 x).
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros a Ha; rewrite <- cbl1_hom1_equiv; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply H1; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
case (mcontra_one_factor n (length l) (pred (length l)) (joinl n l)); auto.
(* Goal: forall (x : list (kn p n)) (_ : and (@Logic.eq nat (@length (kn p n) x) (Nat.pred (@length (vect n) l))) (@Logic.eq (vect n) (mcontra n x (joinl n l)) (one_factor n (Nat.pred (@length (vect n) l)) (joinl n l)))), cbl n l O (one_factor n (Nat.pred (@length (vect n) l)) (joinl n l)) *)
intros ll (H1ll,H2ll); rewrite <-H2ll.
(* Goal: b2Prop (hom n (S O) (mcontra n ll (joinl n l))) *)
replace 1%nat with (length l - length ll)%nat.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply mcontra_hom; auto.
(* Goal: @Logic.eq nat (Nat.sub (@length (vect n) l) (@length (kn p n) ll)) (S O) *)
rewrite H1ll; destruct l; simpl length; auto with arith.
intros; simpl length; simpl pred; 
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
  rewrite <- Minus.minus_Sn_m, <-Minus.minus_n_n; auto.
Qed.

Lemma decomp_one_factor0 n (l: list (vect n)) M :
 decomposable n l M -> one_factor n (pred (length l)) M = 0 -> M = 0.
Proof.
(* Goal: forall (_ : b2Prop (hom n k1 x)) (_ : not (@Logic.eq nat n k1)), @Logic.eq (vect n) (meet n x (genk n k2)) (E0 (vn_eparams n)) *)
intros H1 H2.
(* Goal: @Logic.eq (E (vn_eparams n)) M (E0 (vn_eparams n)) *)
case (list_case _ l); intros H; subst.
(* Goal: @Logic.eq (vect n) (mcontra n (@cons (kn p n) a l) x) (mcontra n l (contra n a x)) *)
case H1; simpl; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply one_factor_zero with (k1 := length l) (3 := H2); auto.
(* Goal: lt (Nat.pred (@length (vect n) l)) (@length (vect n) l) *)
(* Goal: b2Prop (hom n (@length (vect n) l) M) *)
destruct l; simpl; auto with arith.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
case H; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply decomp_hom; auto.
Qed.

Lemma decomp_one_factor_join n (l: list (vect n)) M :
 decomposable n l M -> one_factor n (pred (length l)) M ∨ M = 0.
Proof.
(* Goal: forall _ : @Logic.eq (vect n) (E0 (vn_eparams n)) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (S (Nat.add n (S k2)))) (join n x (meet n y z))), @Logic.eq (vect n) (join n x (meet n y z)) (E0 (vn_eparams n)) *)
intros H.
(* Goal: @Logic.eq (vect n) (join n (one_factor n (Nat.pred (@length (vect n) l)) M) M) (E0 (vn_eparams n)) *)
case (list_case _ l); intros Hl; subst.
(* Goal: @Logic.eq (vect n) (join n (one_factor n (Nat.pred (@length (vect n) (@nil (vect n)))) M) M) (E0 (vn_eparams n)) *)
(* Goal: @Logic.eq (vect n) (join n (one_factor n (Nat.pred (@length (vect n) l)) M) M) (E0 (vn_eparams n)) *)
case H; simpl; auto; intros _ H1; rewrite H1; Grm0.
(* Goal: @Logic.eq (vect n) (join n (one_factor n (Nat.pred (@length (vect n) l)) M) M) (E0 (vn_eparams n)) *)
assert (Hhm:= decomp_hom n l M H).
(* Goal: @Logic.eq (vect n) (join n (one_factor n (Nat.pred (@length (vect n) l)) M) M) (E0 (vn_eparams n)) *)
case H; intros H1 H2; subst; clear H.
(* Goal: @Logic.eq (vect n) (join n (one_factor n (Nat.pred (@length (vect n) l)) (joinl n l)) (joinl n l)) (E0 (vn_eparams n)) *)
assert (Hl1: pred (length l) < length l).
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
destruct l; simpl; auto with arith; case Hl; auto.
(* Goal: @Logic.eq (vect n) (join n (one_factor n (Nat.pred (@length (vect n) l)) (joinl n l)) (joinl n l)) (E0 (vn_eparams n)) *)
assert (Hh: forall x, In x l -> hom n 1 x).
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros a Ha; rewrite <- cbl1_hom1_equiv; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply H1; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply cbl_joinl0 with (k := 0%nat); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
case (mcontra_one_factor n (length l) (pred (length l)) (joinl n l)); auto.
(* Goal: forall (x : list (kn p n)) (_ : and (@Logic.eq nat (@length (kn p n) x) (Nat.pred (@length (vect n) l))) (@Logic.eq (vect n) (mcontra n x (joinl n l)) (one_factor n (Nat.pred (@length (vect n) l)) (joinl n l)))), cbl n l O (one_factor n (Nat.pred (@length (vect n) l)) (joinl n l)) *)
intros ll (H1ll,H2ll); rewrite <-H2ll.
(* Goal: cbl n l O (mcontra n ll (joinl n l)) *)
replace 0%nat with (pred (length l) - length ll)%nat.
(* Goal: cbl n l (Nat.sub (Nat.pred (@length (vect n) l)) (@length (kn p n) ll)) (mcontra n ll (joinl n l)) *)
(* Goal: @Logic.eq nat (Nat.sub (Nat.pred (@length (vect n) l)) (@length (kn p n) ll)) O *)
apply cbl_mcontra; try rewrite H1ll; auto with arith.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply cbl_joinl; auto.
(* Goal: @Logic.eq nat (Nat.sub (Nat.pred (@length (vect n) l)) (@length (kn p n) ll)) O *)
rewrite H1ll; auto with arith.
Qed.

Fixpoint decomposek (n: nat) k (v: vect n) {struct k} : list (vect n) :=
  match k with 
  | O => nil 
  | S O => v::nil 
  | S k1 => let v1 := one_factor n k1 v in
            v1::decomposek n k1 (factor n v1 v)
  end.

Lemma decomposekSS (n: nat) k (v: vect n) :
  decomposek n k.+2 v =  
    one_factor n k.+1 v::
       decomposek n k.+1 (factor n (one_factor n k.+1 v) v).
Proof. auto. Qed.

Lemma decomposek_cor n k v : 
v <> 0 -> is_decomposable n v -> hom n k v -> decomposable n (decomposek n k v) v.
Proof.
(* Goal: forall (_ : not (@Logic.eq (E (vn_eparams n)) v (E0 (vn_eparams n)))) (_ : is_decomposable n v) (_ : b2Prop (hom n k v)), decomposable n (decomposek n k v) v *)
generalize v; clear v.
(* Goal: forall (v : E (vn_eparams n)) (_ : not (@Logic.eq (E (vn_eparams n)) v (E0 (vn_eparams n)))) (_ : is_decomposable n v) (_ : b2Prop (hom n k v)), decomposable n (decomposek n k v) v *)
induction k as [|k IH].
(* Goal: forall (v : E (vn_eparams n)) (_ : not (@Logic.eq (E (vn_eparams n)) v (E0 (vn_eparams n)))) (_ : is_decomposable n v) (_ : b2Prop (hom n O v)), decomposable n (decomposek n O v) v *)
(* Goal: forall (v : E (vn_eparams n)) (_ : not (@Logic.eq (E (vn_eparams n)) v (E0 (vn_eparams n)))) (_ : is_decomposable n v) (_ : b2Prop (hom n (S k) v)), decomposable n (decomposek n (S k) v) v *)
intros v Hv (l, Hl) H1.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
case (homE n 0 (length l) v); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply decomp_hom; auto.
(* Goal: b2Prop false *)
destruct l; simpl; auto; intros; discriminate.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros; subst; split; auto.
(* Goal: is_vector_space n (@nil (vect n)) *)
(* Goal: decomposable n (decomposek n (first_deg n v) v) v *)
(* Goal: forall _ : not (@Logic.eq (E (vn_eparams n)) v (joinl n (decomposek n (first_deg n v) v))), not (is_decomposable n v) *)
(* Goal: not (is_decomposable n v) *)
intros i [].
(* Goal: @Logic.eq (vect n) (factor n x12 (addE (vn_eparams n) (addE (vn_eparams n) (scalE (vn_eparams n) (const n x11) (factor n x12 y12)) (scalE (vn_eparams n) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) y11)) (addE (vn_eparams n) (scalE (vn_eparams n) (const n x11) (factor n x12 z12)) (scalE (vn_eparams n) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) z11)))) (addE (vn_eparams n) (factor n x12 (addE (vn_eparams n) (scalE (vn_eparams n) (const n x11) (factor n x12 y12)) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) y11))) (factor n x12 (addE (vn_eparams n) (scalE (vn_eparams n) (const n x11) (factor n x12 z12)) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) z11)))) *)
intros v Hv H1 H2; destruct k as [| k].
(* Goal: decomposable n (decomposek n (S (S k)) v) v *)
repeat split; try (intros; discriminate).
(* Goal: is_vector_space n (decomposek n (S O) v) *)
(* Goal: decomposable n (decomposek n (S (S k)) v) v *)
simpl; intros x [[]|[]].
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
red; rewrite cbl1_hom1_equiv; auto.
(* Goal: decomposable n (decomposek n (S (S k)) v) v *)
case H1; intros l Hl.
(* Goal: decomposable n (decomposek n (S (S k)) v) v *)
assert (F1: one_factor n k.+1 v ∨ v = 0).
(* Goal: @Logic.eq (vect n) (join n (one_factor n (S k) v) v) (E0 (vn_eparams n)) *)
(* Goal: decomposable n (decomposek n (S (S k)) v) v *)
replace k.+1 with (pred (length l)).
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply decomp_one_factor_join; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
case (homE n (length l) k.+2 v); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply decomp_hom; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros HH1; rewrite HH1; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros HH1; case Hv; auto.
(* Goal: decomposable n (decomposek n (S (S k)) v) v *)
assert (F2: hom n 1 (one_factor n k.+1 v)).
(* Goal: b2Prop (hom n (S O) (one_factor n (S k) v)) *)
(* Goal: decomposable n (decomposek n (S (S k)) v) v *)
replace 1%nat with (k.+2 - k.+1)%nat.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply one_factor_hom; auto.
(* Goal: @Logic.eq nat (Nat.sub (S (S k)) (S k)) (S O) *)
(* Goal: decomposable n (decomposek n (S (S k)) v) v *)
rewrite <-Minus.minus_Sn_m, <-Minus.minus_n_n; auto with arith.
(* Goal: decomposable n (decomposek n (S (S k)) v) v *)
assert (F3: v = one_factor n k.+1 v ∨ factor n (one_factor n k.+1 v) v).
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
simpl; apply factor_factor; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros HH; case Hv; apply (one_factor_zero n k.+2 k.+1); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
case (IH (factor n (one_factor n k.+1 v) v)); auto.
(* Goal: not (@Logic.eq (E (vn_eparams n)) (one_factor n (S k) v) (E0 (vn_eparams n))) *)
(* Goal: forall (_ : is_vector_space n (decomposek n (S k) (factor n (one_factor n (S k) v) v))) (_ : @Logic.eq (E (vn_eparams n)) (factor n (one_factor n (S k) v) v) (joinl n (decomposek n (S k) (factor n (one_factor n (S k) v) v)))), decomposable n (decomposek n (S (S k)) v) v *)
intros HH; case Hv; rewrite F3, HH; Grm0.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply decomposable_factor with k; auto.
(* Goal: not (@Logic.eq (E (vn_eparams n)) (one_factor n (S k) v) (E0 (vn_eparams n))) *)
(* Goal: forall (_ : is_vector_space n (decomposek n (S k) (factor n (one_factor n (S k) v) v))) (_ : @Logic.eq (E (vn_eparams n)) (factor n (one_factor n (S k) v) v) (joinl n (decomposek n (S k) (factor n (one_factor n (S k) v) v)))), decomposable n (decomposek n (S (S k)) v) v *)
intros HH; case Hv; rewrite F3, HH; Grm0.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply factor_hom; auto.
(* Goal: not (@Logic.eq (E (vn_eparams n)) (one_factor n (S k) v) (E0 (vn_eparams n))) *)
(* Goal: forall (_ : is_vector_space n (decomposek n (S k) (factor n (one_factor n (S k) v) v))) (_ : @Logic.eq (E (vn_eparams n)) (factor n (one_factor n (S k) v) v) (joinl n (decomposek n (S k) (factor n (one_factor n (S k) v) v)))), decomposable n (decomposek n (S (S k)) v) v *)
intros HH; case Hv; rewrite F3, HH; Grm0.
(* Goal: forall (_ : is_vector_space n (decomposek n (S k) (factor n (one_factor n (S k) v) v))) (_ : @Logic.eq (E (vn_eparams n)) (factor n (one_factor n (S k) v) v) (joinl n (decomposek n (S k) (factor n (one_factor n (S k) v) v)))), decomposable n (decomposek n (S (S k)) v) v *)
intros Hr1 Hr2.
(* Goal: decomposable n (decomposek n (S (S k)) v) v *)
repeat split; try (intros; discriminate).
(* Goal: is_vector_space n (decomposek n (S (S k)) v) *)
(* Goal: @Logic.eq (E (vn_eparams n)) v (joinl n (decomposek n (S (S k)) v)) *)
intros x Hx; case (in_inv Hx); intros H1x.
(* Goal: is_vector n x *)
(* Goal: is_vector n x *)
(* Goal: @Logic.eq (E (vn_eparams n)) v (joinl n (decomposek n (S (S k)) v)) *)
rewrite <-H1x.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
red; rewrite cbl1_hom1_equiv; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply Hr1; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite decomposekSS, joinlS, <-Hr2; auto.
(* Goal: b2Prop false *)
destruct k; simpl; intros; discriminate.
Qed.

Definition all_hom1 n l := fold_left (fun c x => c && hom n 1 x) l true.

Lemma all_hom1_cor n l :
 if all_hom1 n l then forall i, In i l -> hom n 1 i else 
     exists i, In i l /\ ~ hom n 1 i.
Proof.
(* Goal: if all_hom1 n l then forall (i : vect n) (_ : @In (vect n) i l), b2Prop (hom n (S O) i) else @ex (vect n) (fun i : vect n => and (@In (vect n) i l) (not (b2Prop (hom n (S O) i)))) *)
unfold all_hom1.
assert (F1: forall b,
   if fold_left (fun c x => c && hom n 1 x) l b
   then b /\ forall i : vect n, In i l -> hom n 1 i
   else ~b \/ exists i, In i l /\ ~ hom n 1 i).
(* Goal: forall b : bool, if @fold_left bool (vect n) (fun (c : bool) (x : vect n) => andb c (hom n (S O) x)) l b then and (b2Prop b) (forall (i : vect n) (_ : @In (vect n) i l), b2Prop (hom n (S O) i)) else or (not (b2Prop b)) (@ex (vect n) (fun i : vect n => and (@In (vect n) i l) (not (b2Prop (hom n (S O) i))))) *)
(* Goal: if @fold_left bool (vect n) (fun (c : bool) (x : vect n) => andb c (hom n (S O) x)) l true then forall (i : vect n) (_ : @In (vect n) i l), b2Prop (hom n (S O) i) else @ex (vect n) (fun i : vect n => and (@In (vect n) i l) (not (b2Prop (hom n (S O) i)))) *)
induction l as [| a l IH]; simpl.
(* Goal: forall _ : or (not (b2Prop true)) (@ex (vect n) (fun i : vect n => and (@In (vect n) i l) (not (b2Prop (hom n (S O) i))))), @ex (vect n) (fun i : vect n => and (@In (vect n) i l) (not (b2Prop (hom n (S O) i)))) *)
intros []; auto.
(* Goal: is_vector_space n (@nil (vect n)) *)
(* Goal: decomposable n (decomposek n (first_deg n v) v) v *)
(* Goal: forall _ : not (@Logic.eq (E (vn_eparams n)) v (joinl n (decomposek n (first_deg n v) v))), not (is_decomposable n v) *)
(* Goal: not (is_decomposable n v) *)
split; auto; intros i [].
(* Goal: b2Prop false *)
left; intros; discriminate.
(* Goal: forall b : bool, if @fold_left bool (vect n) (fun (c : bool) (x : vect n) => andb c (hom n (S O) x)) l (andb b (hom n (S O) a)) then and (b2Prop b) (forall (i : vect n) (_ : or (@Logic.eq (vect n) a i) (@In (vect n) i l)), b2Prop (hom n (S O) i)) else or (not (b2Prop b)) (@ex (vect n) (fun i : vect n => and (or (@Logic.eq (vect n) a i) (@In (vect n) i l)) (not (b2Prop (hom n (S O) i))))) *)
(* Goal: if @fold_left bool (vect n) (fun (c : bool) (x : vect n) => andb c (hom n (S O) x)) l true then forall (i : vect n) (_ : @In (vect n) i l), b2Prop (hom n (S O) i) else @ex (vect n) (fun i : vect n => and (@In (vect n) i l) (not (b2Prop (hom n (S O) i)))) *)
intros b; generalize (IH (b && hom n 1 a)).
match goal with |- context[fold_left ?X ?Y ?Z] =>
  case (fold_left X Y Z); auto
end; rewrite andbP.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros ((H1,H2),H3); split; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros i [[]|Hi]; auto.
(* Goal: forall _ : or (not (and (b2Prop b) (b2Prop (hom n (S O) a)))) (@ex (vect n) (fun i : vect n => and (@In (vect n) i l) (not (b2Prop (hom n (S O) i))))), or (not (b2Prop b)) (@ex (vect n) (fun i : vect n => and (or (@Logic.eq (vect n) a i) (@In (vect n) i l)) (not (b2Prop (hom n (S O) i))))) *)
(* Goal: if @fold_left bool (vect n) (fun (c : bool) (x : vect n) => andb c (hom n (S O) x)) l true then forall (i : vect n) (_ : @In (vect n) i l), b2Prop (hom n (S O) i) else @ex (vect n) (fun i : vect n => and (@In (vect n) i l) (not (b2Prop (hom n (S O) i)))) *)
intros [H1 | H1].
(* Goal: or (not (b2Prop b)) (@ex (vect n) (fun i : vect n => and (or (@Logic.eq (vect n) a i) (@In (vect n) i l)) (not (b2Prop (hom n (S O) i))))) *)
(* Goal: or (not (b2Prop b)) (@ex (vect n) (fun i : vect n => and (or (@Logic.eq (vect n) a i) (@In (vect n) i l)) (not (b2Prop (hom n (S O) i))))) *)
(* Goal: if @fold_left bool (vect n) (fun (c : bool) (x : vect n) => andb c (hom n (S O) x)) l true then forall (i : vect n) (_ : @In (vect n) i l), b2Prop (hom n (S O) i) else @ex (vect n) (fun i : vect n => and (@In (vect n) i l) (not (b2Prop (hom n (S O) i)))) *)
case_eq (hom n 1 a); intros Ha.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
left; intros Hb; case H1; auto.
(* Goal: or (not (b2Prop b)) (@ex (vect n) (fun i : vect n => and (or (@Logic.eq (vect n) a i) (@In (vect n) i l)) (not (b2Prop (hom n (S O) i))))) *)
(* Goal: or (not (b2Prop b)) (@ex (vect n) (fun i : vect n => and (or (@Logic.eq (vect n) a i) (@In (vect n) i l)) (not (b2Prop (hom n (S O) i))))) *)
(* Goal: if @fold_left bool (vect n) (fun (c : bool) (x : vect n) => andb c (hom n (S O) x)) l true then forall (i : vect n) (_ : @In (vect n) i l), b2Prop (hom n (S O) i) else @ex (vect n) (fun i : vect n => and (@In (vect n) i l) (not (b2Prop (hom n (S O) i)))) *)
right; exists a; split; auto; rewrite Ha.
(* Goal: b2Prop false *)
intros; discriminate.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
case H1; intros i [H1i H2i]; right; exists i; split; auto.
(* Goal: if @fold_left bool (vect n) (fun (c : bool) (x : vect n) => andb c (hom n (S O) x)) l true then forall (i : vect n) (_ : @In (vect n) i l), b2Prop (hom n (S O) i) else @ex (vect n) (fun i : vect n => and (@In (vect n) i l) (not (b2Prop (hom n (S O) i)))) *)
generalize (F1 true).
match goal with |- context[fold_left ?X ?Y ?Z] =>
  case (fold_left X Y Z); auto
(* Goal: forall _ : or (not (b2Prop true)) (@ex (vect n) (fun i : vect n => and (@In (vect n) i l) (not (b2Prop (hom n (S O) i))))), @ex (vect n) (fun i : vect n => and (@In (vect n) i l) (not (b2Prop (hom n (S O) i)))) *)
end. intros []; auto.  intros []; auto. contradict H; auto.
Qed.

Definition decompose n (v: vect n) : option (list (vect n)) := 
  let d := first_deg n v in
  let l := decomposek n d v in
  if all_hom1 n l then
      if v ?= joinl n l then Some l else None
  else None.

Lemma  decompose_cor n v : 
   match decompose n v with
   | None => ~ is_decomposable n v
   | Some l => decomposable n l v
   end.
Proof.
(* Goal: match decompose n v with | Some l => decomposable n l v | None => not (is_decomposable n v) end *)
unfold decompose.
match goal with |- context[all_hom1 ?X ?Y] =>
  generalize (all_hom1_cor X Y); case (all_hom1 X Y);
  intros Hi
end.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
case eqE_spec; auto.
(* Goal: forall _ : @Logic.eq (E (vn_eparams n)) v (joinl n (decomposek n (first_deg n v) v)), decomposable n (decomposek n (first_deg n v) v) v *)
(* Goal: forall _ : not (@Logic.eq (E (vn_eparams n)) v (joinl n (decomposek n (first_deg n v) v))), not (is_decomposable n v) *)
(* Goal: not (is_decomposable n v) *)
intros HH.
(* Goal: decomposable n (decomposek n (first_deg n v) v) v *)
(* Goal: forall _ : not (@Logic.eq (E (vn_eparams n)) v (joinl n (decomposek n (first_deg n v) v))), not (is_decomposable n v) *)
(* Goal: not (is_decomposable n v) *)
case (eqE_spec _ (fn n) v 0); intros Hv.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite Hv, first_deg0; simpl; split; auto.
(* Goal: is_vector_space n (@nil (vect n)) *)
(* Goal: decomposable n (decomposek n (first_deg n v) v) v *)
(* Goal: forall _ : not (@Logic.eq (E (vn_eparams n)) v (joinl n (decomposek n (first_deg n v) v))), not (is_decomposable n v) *)
(* Goal: not (is_decomposable n v) *)
intros i [].
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply decomposek_cor; auto.
(* Goal: is_decomposable n v *)
(* Goal: b2Prop (hom n (first_deg n v) v) *)
(* Goal: forall _ : not (@Logic.eq (E (vn_eparams n)) v (joinl n (decomposek n (first_deg n v) v))), not (is_decomposable n v) *)
(* Goal: not (is_decomposable n v) *)
exists (decomposek n (first_deg n v) v).
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
split; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros i H1i; red; rewrite cbl1_hom1_equiv; auto.
(* Goal: b2Prop (hom n (first_deg n v) v) *)
(* Goal: forall _ : not (@Logic.eq (E (vn_eparams n)) v (joinl n (decomposek n (first_deg n v) v))), not (is_decomposable n v) *)
(* Goal: not (is_decomposable n v) *)
assert (F1: hom n (length (decomposek n (first_deg n v) v)) v). 
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite HH at 3; apply (joinl_hom1 n); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite hom_first_deg with (k := length (decomposek n (first_deg n v) v)); auto.
(* Goal: forall _ : not (@Logic.eq (E (vn_eparams n)) v (joinl n (decomposek n (first_deg n v) v))), not (is_decomposable n v) *)
(* Goal: not (is_decomposable n v) *)
intros H1 HH.
(* Goal: False *)
(* Goal: not (is_decomposable n v) *)
case HH; intros l Hl.
(* Goal: False *)
assert (F1: v <> 0).
(* Goal: not (@Logic.eq (vect n) v (E0 (vn_eparams n))) *)
(* Goal: False *)
(* Goal: not (is_decomposable n v) *)
intros H2; case H1.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite H2 at 2; rewrite first_deg0; auto.
(* Goal: False *)
assert (F2: hom n (length l) v).
(* Goal: b2Prop (hom n (@length (E (vn_eparams n)) l) v) *)
(* Goal: False *)
case Hl; intros H2 H3; rewrite H3.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply (joinl_hom1 n); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros; rewrite <-cbl1_hom1_equiv; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply H2; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
case (decomposek_cor n (length l) v); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros; case H1; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite hom_first_deg with (k := length l); auto.
(* Goal: decomposable n (decomposek n (S (S k)) v) v *)
intros H1; case H1; intros l Hl.
(* Goal: False *)
assert (F1: v <> 0).
(* Goal: not (@Logic.eq (vect n) v (E0 (vn_eparams n))) *)
(* Goal: False *)
intros H2; case Hi; intros i.
(* Goal: forall _ : and (@In (vect n) i (decomposek n (first_deg n v) v)) (not (b2Prop (hom n (S O) i))), False *)
(* Goal: False *)
subst; rewrite first_deg0; intros [[] _].
(* Goal: False *)
assert (F2: hom n (length l) v).
(* Goal: b2Prop (hom n (@length (E (vn_eparams n)) l) v) *)
(* Goal: False *)
case Hl; intros H2 H3; rewrite H3.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply (joinl_hom1 n); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros; rewrite <-cbl1_hom1_equiv; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply H2; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
case (decomposek_cor n (length l) v); auto.
(* Goal: forall (_ : is_vector_space n (decomposek n (@length (E (vn_eparams n)) l) v)) (_ : @Logic.eq (E (vn_eparams n)) v (joinl n (decomposek n (@length (E (vn_eparams n)) l) v))), False *)
intros H2.
(* Goal: forall _ : @Logic.eq (E (vn_eparams n)) v (joinl n (decomposek n (@length (E (vn_eparams n)) l) v)), False *)
case Hi; intros i [H1i []].
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite <-cbl1_hom1_equiv; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply H2; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite <-(hom_first_deg n (length l) v); auto.
Qed.

(* Grade definition *)
Definition grade n k x := hom n k x &&  
  if decompose n x then true else false.

Lemma gradeE n k x : 
  grade n k x <->  hom n k x /\
                   exists l, x = joinl n l /\
                             (forall y, In y l -> hom n 1 y).
Proof.
(* Goal: @Logic.eq bool (grade n (S O) x) (hom n (S O) x) *)
unfold grade.
generalize (decompose_cor n x); case decompose; 
(* Goal: @Logic.eq (vect n) (mcontra n (@cons (kn p n) a l) x) (mcontra n l (contra n a x)) *)
  rewrite andb_comm; simpl; auto.
(* Goal: forall (l : list (vect n)) (_ : decomposable n l x), iff (b2Prop (hom n k x)) (and (b2Prop (hom n k x)) (@ex (list (vect n)) (fun l0 : list (vect n) => and (@Logic.eq (vect n) x (joinl n l0)) (forall (y : vect n) (_ : @In (vect n) y l0), b2Prop (hom n (S O) y))))) *)
(* Goal: forall _ : not (is_decomposable n x), iff (b2Prop false) (and (b2Prop (hom n k x)) (@ex (list (vect n)) (fun l : list (vect n) => and (@Logic.eq (vect n) x (joinl n l)) (forall (y : vect n) (_ : @In (vect n) y l), b2Prop (hom n (S O) y))))) *)
intros l (H1,H2); subst.
(* Goal: iff (b2Prop (hom n k (joinl n l))) (and (b2Prop (hom n k (joinl n l))) (@ex (list (vect n)) (fun l0 : list (vect n) => and (@Logic.eq (vect n) (joinl n l) (joinl n l0)) (forall (y : vect n) (_ : @In (vect n) y l0), b2Prop (hom n (S O) y))))) *)
(* Goal: forall _ : not (is_decomposable n x), iff (b2Prop false) (and (b2Prop (hom n k x)) (@ex (list (vect n)) (fun l : list (vect n) => and (@Logic.eq (vect n) x (joinl n l)) (forall (y : vect n) (_ : @In (vect n) y l), b2Prop (hom n (S O) y))))) *)
assert (H4: forall x : vect n, In x l -> hom n 1 x).
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros x H4; rewrite <-cbl1_hom1_equiv; apply H1; auto.
(* Goal: iff (b2Prop (hom n k (joinl n l))) (and (b2Prop (hom n k (joinl n l))) (@ex (list (vect n)) (fun l0 : list (vect n) => and (@Logic.eq (vect n) (joinl n l) (joinl n l0)) (forall (y : vect n) (_ : @In (vect n) y l0), b2Prop (hom n (S O) y))))) *)
(* Goal: forall _ : not (is_decomposable n x), iff (b2Prop false) (and (b2Prop (hom n k x)) (@ex (list (vect n)) (fun l : list (vect n) => and (@Logic.eq (vect n) x (joinl n l)) (forall (y : vect n) (_ : @In (vect n) y l), b2Prop (hom n (S O) y))))) *)
split.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros H3; split; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
exists l; split; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros (HH,_); auto.
(* Goal: iff (b2Prop (hom n k (joinl n l))) (and (b2Prop (hom n k (joinl n l))) (@ex (list (vect n)) (fun l0 : list (vect n) => and (@Logic.eq (vect n) (joinl n l) (joinl n l0)) (forall (y : vect n) (_ : @In (vect n) y l0), b2Prop (hom n (S O) y))))) *)
(* Goal: forall _ : not (is_decomposable n x), iff (b2Prop false) (and (b2Prop (hom n k x)) (@ex (list (vect n)) (fun l : list (vect n) => and (@Logic.eq (vect n) x (joinl n l)) (forall (y : vect n) (_ : @In (vect n) y l), b2Prop (hom n (S O) y))))) *)
intros HH; split.
(* Goal: b2Prop false *)
intros HH1; discriminate.
(* Goal: forall _ : and (b2Prop (hom n k x)) (@ex (list (vect n)) (fun l : list (vect n) => and (@Logic.eq (vect n) x (joinl n l)) (forall (y : vect n) (_ : @In (vect n) y l), b2Prop (hom n (S O) y)))), b2Prop false *)
intros (H1, (l, (H1l,H2l))).
(* Goal: b2Prop false *)
case HH.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
exists l; split; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros u Hu; red; rewrite cbl1_hom1_equiv; auto.
Qed.

Lemma grade0 n k : grade n k 0.
Proof.
(* Goal: b2Prop (andb (hom n n1 (genk n (Field.v0 (K1 p)))) (hom n (Nat.sub (S k1) (S k2)) (one_factor n k2 v))) *)
unfold grade; rewrite homk0.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
generalize (decompose_cor n 0); case decompose; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros []; exists nil; split; auto.
(* Goal: is_vector_space n (@nil (E (vn_eparams n))) *)
intros x1 [].
Qed.

Lemma grade0E n x : grade n 0 x -> x = 0.
Proof.
(* Goal: forall _ : b2Prop (grade n O x), @Logic.eq (vect n) x (E0 (vn_eparams n)) *)
rewrite gradeE.
intros  (Hx, (l, (H1l, H2l))); subst.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
destruct l as [|y l]; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
case (homE n (length (y::l)) 0 (joinl n (y::l))); auto.
(* Goal: b2Prop false *)
intros; discriminate.
Qed.

Lemma grade_hom n k x : grade n k x -> hom n k x.
Proof.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
unfold grade; rewrite andbP; intros (H,_); auto.
Qed.

Lemma grade1_hom n x : grade n 1 x = hom n 1 x.
Proof.
(* Goal: @Logic.eq bool (grade n (S O) x) (hom n (S O) x) *)
unfold grade.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
case_eq (hom n 1 x); auto.
(* Goal: forall _ : @Logic.eq (vect n) (E0 (vn_eparams n)) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (S (Nat.add n (S k2)))) (join n x (meet n y z))), @Logic.eq (vect n) (join n x (meet n y z)) (E0 (vn_eparams n)) *)
intros H.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
generalize (decompose_cor n x); case decompose; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros []; exists (x::nil); split; auto.
(* Goal: is_vector_space n (@cons (vect n) x (@nil (vect n))) *)
intros x1; simpl; intros [[]|[]].
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
red; rewrite cbl1_hom1_equiv, H; auto.
Qed.

Lemma grade_scal n k1 k2 x : grade n k1 x -> grade n k1 (k2 .* x).
Proof.
(* Goal: forall _ : b2Prop (grade n k1 x), b2Prop (grade n k1 (scalE (vn_eparams n) k2 x)) *)
rewrite !gradeE; intros (Hx, (l, (H1l, H2l))).
(* Goal: and (b2Prop (hom n k1 (scalE (vn_eparams n) k2 x))) (@ex (list (vect n)) (fun l : list (vect n) => and (@Logic.eq (vect n) (scalE (vn_eparams n) k2 x) (joinl n l)) (forall (y : vect n) (_ : @In (vect n) y l), b2Prop (hom n (S O) y)))) *)
destruct l as [| y l].
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite H1l; simpl joinl; rewrite scalE0r, <-gradeE, grade0; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
split; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
exists (k2 .* y :: l); repeat split; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite H1l; destruct l as [|z l]; auto.
(* Goal: @Logic.eq (vect n) (scalE (vn_eparams n) k2 (joinl n (@cons (vect n) y (@cons (vect n) z l)))) (joinl n (@cons (E (vn_eparams n)) (scalE (vn_eparams n) k2 y) (@cons (vect n) z l))) *)
(* Goal: forall (y0 : vect n) (_ : @In (vect n) y0 (@cons (E (vn_eparams n)) (scalE (vn_eparams n) k2 y) l)), b2Prop (hom n (S O) y0) *)
rewrite joinlS; try (intros HH; discriminate).
(* Goal: @Logic.eq (vect n) (scalE (vn_eparams n) k2 (joinl n (@cons (vect n) y (@cons (vect n) z l)))) (joinl n (@cons (E (vn_eparams n)) (scalE (vn_eparams n) k2 y) (@cons (vect n) z l))) *)
(* Goal: forall (y0 : vect n) (_ : @In (vect n) y0 (@cons (E (vn_eparams n)) (scalE (vn_eparams n) k2 y) l)), b2Prop (hom n (S O) y0) *)
apply sym_equal; rewrite joinlS; try (intros HH; discriminate).
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite join_scall; auto.
(* Goal: forall (y0 : vect n) (_ : @In (vect n) y0 (@cons (E (vn_eparams n)) (scalE (vn_eparams n) k2 y) l)), b2Prop (hom n (S O) y0) *)
simpl; intros z [[] | Hz]; auto with datatypes.
(* Goal: b2Prop (hom n (S O) (scal n k2 y)) *)
apply scal_hom; auto with datatypes.
Qed.

Lemma grade_join n k1 k2 x y :
   grade n k1 x -> grade n k2 y -> grade n (k1 + k2) (x ∨ y).
Proof.
(* Goal: forall (_ : b2Prop (grade n k1 x)) (_ : b2Prop (grade n k2 y)), b2Prop (grade n (Nat.add k1 k2) (join n x y)) *)
rewrite !gradeE.
(* Goal: forall (_ : and (b2Prop (hom n k1 x)) (@ex (list (vect n)) (fun l : list (vect n) => and (@Logic.eq (vect n) x (joinl n l)) (forall (y : vect n) (_ : @In (vect n) y l), b2Prop (hom n (S O) y))))) (_ : and (b2Prop (hom n k2 y)) (@ex (list (vect n)) (fun l : list (vect n) => and (@Logic.eq (vect n) y (joinl n l)) (forall (y : vect n) (_ : @In (vect n) y l), b2Prop (hom n (S O) y))))), and (b2Prop (hom n (Nat.add k1 k2) (join n x y))) (@ex (list (vect n)) (fun l : list (vect n) => and (@Logic.eq (vect n) (join n x y) (joinl n l)) (forall (y : vect n) (_ : @In (vect n) y l), b2Prop (hom n (S O) y)))) *)
intros (Hx, (l1, (H1l1, H2l1))) (Hy, (l2, (H1l2, H2l2))).
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
split; auto.
(* Goal: @ex (list (vect n)) (fun l : list (vect n) => and (@Logic.eq (vect n) (join n x y) (joinl n l)) (forall (y : vect n) (_ : @In (vect n) y l), b2Prop (hom n (S O) y))) *)
destruct l1 as [|x1 l1].
(* Goal: @ex (list (vect n)) (fun l : list (vect n) => and (@Logic.eq (vect n) (join n x y) (joinl n l)) (forall (y : vect n) (_ : @In (vect n) y l), b2Prop (hom n (S O) y))) *)
(* Goal: @ex (list (vect n)) (fun l : list (vect n) => and (@Logic.eq (vect n) (join n x y) (joinl n l)) (forall (y : vect n) (_ : @In (vect n) y l), b2Prop (hom n (S O) y))) *)
rewrite H1l1; simpl joinl; exists nil; split; Grm0.
(* Goal: @ex (list (vect n)) (fun l : list (vect n) => and (@Logic.eq (vect n) (join n x y) (joinl n l)) (forall (y : vect n) (_ : @In (vect n) y l), b2Prop (hom n (S O) y))) *)
destruct l2 as [|x2 l2].
(* Goal: @ex (list (vect n)) (fun l : list (vect n) => and (@Logic.eq (vect n) (join n x y) (joinl n l)) (forall (y : vect n) (_ : @In (vect n) y l), b2Prop (hom n (S O) y))) *)
(* Goal: @ex (list (vect n)) (fun l : list (vect n) => and (@Logic.eq (vect n) (join n x y) (joinl n l)) (forall (y : vect n) (_ : @In (vect n) y l), b2Prop (hom n (S O) y))) *)
rewrite H1l2; simpl joinl; exists nil; split; Grm0.
(* Goal: iff (b2Prop (hom n k (joinl n l))) (and (b2Prop (hom n k (joinl n l))) (@ex (list (vect n)) (fun l0 : list (vect n) => and (@Logic.eq (vect n) (joinl n l) (joinl n l0)) (forall (y : vect n) (_ : @In (vect n) y l0), b2Prop (hom n (S O) y))))) *)
(* Goal: forall _ : not (is_decomposable n x), iff (b2Prop false) (and (b2Prop (hom n k x)) (@ex (list (vect n)) (fun l : list (vect n) => and (@Logic.eq (vect n) x (joinl n l)) (forall (y : vect n) (_ : @In (vect n) y l), b2Prop (hom n (S O) y))))) *)
exists ((x1::l1) ++ (x2::l2)); repeat split.
(* Goal: b2Prop false *)
rewrite H1l1, H1l2, joinl_app; auto; intros; discriminate.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros z Hz; case (in_app_or _ _ _ Hz); intros H1; auto.
Qed.

(* Hodge Duality *)
Fixpoint dual 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 (dual n1 (y ^_'f), dual n1 x)
  end.
Notation "'@ x " := (dual _ x) (at level 9).

Lemma dual0 n : '@0 = 0 :> vect n.
Proof.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
induction n as  [| n IH]; simpl dual; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
Vfold n; rewrite conj0,!IH; auto.
Qed.

Hint Rewrite dual0: GRm0.

Lemma dual0E n (x: vect n) : '@x = 0 -> x = 0.
Proof.
(* Goal: @Logic.eq (vect n) (k2g n (E0 (Kn.vn_eparams p n))) (E0 (vn_eparams n)) *)
induction n as [| n IH]; simpl; auto.
(* Goal: forall (_ : b2Prop (hom n k1 x)) (_ : not (@Logic.eq nat n k1)), @Logic.eq (vect n) (meet n x (genk n k2)) (E0 (vn_eparams n)) *)
destruct x as [x1 x2]; intros HH; injection HH; intros H1 H2.
rewrite <-(conj_invo n false x2), (IH _ H1), (IH _ H2),
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
       conj0; auto.
Qed.

Lemma dual_hom n k v : hom n k v -> hom n (n - k) '@v.
Proof.
case (Lt.le_or_lt k n).
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
2: intros Hi Hh; rewrite (hom_lt _ _ _ Hi Hh), dual0, homk0; auto.
generalize k v; induction n as  [| n IH]; simpl; auto; clear k v.
intros [| k] (x,y) H; rewrite !andbP; intros (H1,H2).
split; try apply conj_hom.
pattern n at 2; replace n with (n - 0)%nat; auto with arith.
generalize H1; case eq0_spec; intros; [subst | discriminate].
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite dual0, homk0; auto.
assert (H3: k <= n); auto with arith.
generalize (Minus.le_plus_minus _ _ H3).
case (n - k)%nat.
rewrite Plus.plus_0_r; intros; subst.
rewrite (hom_lt k k.+1 y), conj0, dual0, eq0I; auto with arith.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
split; auto.
replace 0%nat with (k - k)%nat; auto with arith.
intros n1 Hn1; split; try apply conj_hom.
replace n1 with (n - S k)%nat; auto with arith.
(* Goal: b2Prop (andb true (hom n (S O) (gen n k))) *)
apply IH; auto with arith.
rewrite Hn1, <-Plus.plus_Snm_nSm; auto with arith.
rewrite Hn1, <-Plus.plus_Snm_nSm; auto with arith.
replace n1.+1 with (n - k)%nat; auto with arith.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite Hn1, Minus.minus_plus; auto.
Qed.

Hint Resolve dual_hom.

Lemma dual_scal n k (v: vect n) : '@(k .* v) = k .* '@v.
Proof.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (dual n (conj n false (genk n k))) (dual n (genk n (v0 (K1 p))))) (@pair (vect n) (vect n) (scal n k (all n)) (scal n k (genk n (v0 (K1 p))))) *)
induction n as  [| n IH]; simpl; auto; Vfold n.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
destruct v; rewrite !conj_scal,!IH; auto.
Qed.

Lemma dual_add n (v1 v2: vect n) : '@(v1 + v2) = '@v1 + '@v2.
Proof.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (dual n (conj n false (genk n k))) (dual n (genk n (v0 (K1 p))))) (@pair (vect n) (vect n) (scal n k (all n)) (scal n k (genk n (v0 (K1 p))))) *)
induction n as  [| n IH]; simpl; auto; Vfold n.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
destruct v1; destruct v2; rewrite !conj_add, !IH; auto.
Qed.

Lemma dual_invo n k (v: vect n): hom n k v ->  '@('@v) = (-(1)) ^(k * n.+1) .* v.
Proof.
(* Goal: forall _ : @In (vect n) v (base n k), or (@Logic.eq (vect n) (join n v (dual n v)) (all n)) (@Logic.eq (vect n) (join n v (dual n v)) (scalE (vn_eparams n) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (all n))) *)
generalize k; clear k.
(* Goal: forall (k1 k2 : nat) (_ : b2Prop (hom n k1 x)) (_ : b2Prop (hom n (S O) y)) (_ : b2Prop (hom n k2 z)), @Logic.eq (vect n) (meet n (join n x y) z) (addE (vn_eparams n) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n (S (Nat.add k1 k2)))) (meet n x (join n y z))) (join n (meet n x z) y)) *)
induction n as [| n IH]; simpl; try Vfold n.
intros [| k]; auto; Krm1.
(* Goal: b2Prop false *)
case eqK_spec; intros; subst; Vrm0; try discriminate.
(* Goal: forall _ : @Logic.eq nat (let (l2, l3) := v in if eq0 n l2 then first_deg n l3 else S (first_deg n l2)) O, b2Prop (let (l2, l3) := v in andb (eq0 n l2) (hom n O l3)) *)
intros [|k]; destruct v.
(* Goal: b2Prop false *)
rewrite andbP; case eq0_spec; intros H1 (H2,H3); subst; try discriminate.
rewrite !dual0, conj0; Vrm0.
rewrite (conjf_hom _ _ _ H3), !dual_scal, (IH _ _ H3).
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
simpl expK; rewrite !scalE1, dual0; auto.
rewrite andbP; intros (H1,H2).
rewrite (conjf_hom _ _ _ H2), !dual_scal, (IH _ _ H2).
assert (H3:= dual_hom _ _ _ H1).
rewrite (conjf_hom _ _ _ H3), dual_scal, (IH _ _ H1).
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply f_equal2 with (f := @pair _ _); auto.
case (Lt.le_or_lt k n); intros Hkn.
2: rewrite hom_lt with (2:= H1); Grm0.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite expKm1_sub, <-!scal_multE, <-!expK_add; auto.
replace ((k.+1 * n .+2)%nat) with (2 + (n + k + k * n.+1))%nat by ring.
(* Goal: @Logic.eq (Field.K (K1 p)) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n (S (Nat.add (S k1) k2)))) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (S (Nat.add n (S (Nat.add (S k1) k2)))))) *)
(* Goal: @Logic.eq (vect n) (meet n x2 (join n y2 (dconj n false z1))) (meet n x2 (dconj n false (join n (conj n false y2) z1))) *)
simpl expK; Krm1.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite <-!scal_multE, <-!expK_add; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
replace (k.+1 + k.+1 * n.+1)%nat with (k.+1 * n .+2)%nat by ring; auto.
Qed.

Lemma dual_invoE n k (v: vect n) : hom n k v ->  v = ((-(1)) ^(k * n.+1)) .* '@('@v).
Proof.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros H; rewrite (dual_invo _ _ _ H), <-scal_multE, expK2m1, scalE1; auto.
Qed.

Lemma dual_all n : '@E = 1 :> vect n.
Proof.
(* Goal: @Logic.eq (vect n) (k2g n (E0 (Kn.vn_eparams p n))) (E0 (vn_eparams n)) *)
induction n as [|n IH]; simpl; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite IH, conj0, dual0; auto.
Qed.

Lemma dual1 n : '@1 =  E :> vect n.
Proof.
(* Goal: @Logic.eq (vect n) (dual n (genk n (v1 (K1 p)))) (all n) *)
induction n as [|n IH]; simpl; Krm1.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (dual n (conj n false (genk n (v1 (K1 p))))) (dual n (genk n (v0 (K1 p))))) (@pair (vect n) (vect n) (all n) (genk n (v0 (K1 p)))) *)
assert (F1: hom n 0 1) by apply hom0K.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (dual n (conj n false (genk n (v1 (K1 p))))) (dual n (genk n (v0 (K1 p))))) (@pair (vect n) (vect n) (all n) (genk n (v0 (K1 p)))) *)
assert (F2: hom n n '@1).
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
  generalize (dual_hom _ _ _ F1); rewrite <-Minus.minus_n_O; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite (conjf_hom _ _ _ F1), dual_scal, IH, scalE1, dual0; auto.
Qed.

Lemma homn_ex n v : hom n n v -> exists k, v = '@[k].
Proof.
(* Goal: forall _ : b2Prop (hom n n v), @ex (Field.K (K1 p)) (fun k : Field.K (K1 p) => @Logic.eq (vect n) v (dual n (genk n k))) *)
rewrite <-cblk_homk_equiv.
(* Goal: forall _ : VectorSpace.cbl (vn_eparams n) (base n n) v, @ex (Field.K (K1 p)) (fun k : Field.K (K1 p) => @Logic.eq (vect n) v (dual n (genk n k))) *)
intros HH; elim HH; clear v HH.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
exists 0%f; rewrite dual0; auto.
(* Goal: forall (v : E (vn_eparams n)) (_ : @In (E (vn_eparams n)) v (base n n)), @ex (Field.K (K1 p)) (fun k : Field.K (K1 p) => @Logic.eq (vect n) v (dual n (genk n k))) *)
(* Goal: forall (x y : E (vn_eparams n)) (_ : VectorSpace.cbl (vn_eparams n) (base n n) x) (_ : @ex (Field.K (K1 p)) (fun k : Field.K (K1 p) => @Logic.eq (vect n) x (dual n (genk n k)))) (_ : VectorSpace.cbl (vn_eparams n) (base n n) y) (_ : @ex (Field.K (K1 p)) (fun k : Field.K (K1 p) => @Logic.eq (vect n) y (dual n (genk n k)))), @ex (Field.K (K1 p)) (fun k : Field.K (K1 p) => @Logic.eq (vect n) (addE (vn_eparams n) x y) (dual n (genk n k))) *)
(* Goal: forall (k : Field.K (stype (vn_eparams n))) (x : E (vn_eparams n)) (_ : VectorSpace.cbl (vn_eparams n) (base n n) x) (_ : @ex (Field.K (K1 p)) (fun k0 : Field.K (K1 p) => @Logic.eq (vect n) x (dual n (genk n k0)))), @ex (Field.K (K1 p)) (fun k0 : Field.K (K1 p) => @Logic.eq (vect n) (scalE (vn_eparams n) k x) (dual n (genk n k0))) *)
intros v Hv; exists 1%f.
(* Goal: @Logic.eq (vect n) v (dual n (genk n (v1 (K1 p)))) *)
(* Goal: forall (x y : E (vn_eparams n)) (_ : VectorSpace.cbl (vn_eparams n) (base n n) x) (_ : @ex (Field.K (K1 p)) (fun k : Field.K (K1 p) => @Logic.eq (vect n) x (dual n (genk n k)))) (_ : VectorSpace.cbl (vn_eparams n) (base n n) y) (_ : @ex (Field.K (K1 p)) (fun k : Field.K (K1 p) => @Logic.eq (vect n) y (dual n (genk n k)))), @ex (Field.K (K1 p)) (fun k : Field.K (K1 p) => @Logic.eq (vect n) (addE (vn_eparams n) x y) (dual n (genk n k))) *)
(* Goal: forall (k : Field.K (stype (vn_eparams n))) (x : E (vn_eparams n)) (_ : VectorSpace.cbl (vn_eparams n) (base n n) x) (_ : @ex (Field.K (K1 p)) (fun k0 : Field.K (K1 p) => @Logic.eq (vect n) x (dual n (genk n k0)))), @ex (Field.K (K1 p)) (fun k0 : Field.K (K1 p) => @Logic.eq (vect n) (scalE (vn_eparams n) k x) (dual n (genk n k0))) *)
rewrite base_n in Hv; simpl in Hv; case Hv; auto; intros [].
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite dual1; auto.
(* Goal: forall (x y : E (vn_eparams n)) (_ : VectorSpace.cbl (vn_eparams n) (base n n) x) (_ : @ex (Field.K (K1 p)) (fun k : Field.K (K1 p) => @Logic.eq (vect n) x (dual n (genk n k)))) (_ : VectorSpace.cbl (vn_eparams n) (base n n) y) (_ : @ex (Field.K (K1 p)) (fun k : Field.K (K1 p) => @Logic.eq (vect n) y (dual n (genk n k)))), @ex (Field.K (K1 p)) (fun k : Field.K (K1 p) => @Logic.eq (vect n) (addE (vn_eparams n) x y) (dual n (genk n k))) *)
(* Goal: forall (k : Field.K (stype (vn_eparams n))) (x : E (vn_eparams n)) (_ : VectorSpace.cbl (vn_eparams n) (base n n) x) (_ : @ex (Field.K (K1 p)) (fun k0 : Field.K (K1 p) => @Logic.eq (vect n) x (dual n (genk n k0)))), @ex (Field.K (K1 p)) (fun k0 : Field.K (K1 p) => @Logic.eq (vect n) (scalE (vn_eparams n) k x) (dual n (genk n k0))) *)
intros x y _ [k1 Hk1] _ [k2 Hk2]; exists (k1 + k2)%f; subst.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite <-dual_add, addk; auto.
intros k1 x _ [k2 Hk2]; exists (k1 * k2)%f; subst.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite <-dual_scal, scalk; auto.
Qed.

Lemma dual_base n k v :
  In v (base n k) -> In '@v (base n (n - k)) \/ In ((-(1)) .* '@v) (base n (n - k)).
Proof.
case (Lt.le_or_lt k n).
(* Goal: @ex nat (fun p1 : nat => and (lt p1 O) (@Logic.eq (vect O) v (gen O p1))) *)
(* Goal: @ex nat (fun p1 : nat => and (lt p1 (S n)) (@Logic.eq (vect (S n)) v (gen (S n) p1))) *)
2: intros H; rewrite base_lt_nil; auto; intros HH; inversion HH.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (dual n (conj n false (genk n k))) (dual n (genk n (v0 (K1 p))))) (@pair (vect n) (vect n) (scal n k (all n)) (scal n k (genk n (v0 (K1 p))))) *)
generalize k; induction n as  [| n IH]; simpl; auto; clear k; try Vfold n.
intros [| k] H; auto with arith.
intros [| k] H; destruct v as [x y].
(* Goal: @Logic.eq (vect (S n)) (dual (S n) (join (S n) v1 v2)) (meet (S n) (dual (S n) v1) (dual (S n) v2)) *)
rewrite base0; simpl; Vfold n.
intros [H1 | []]; injection H1; intros; subst.
rewrite dual0, en_def, conjk, dual1; Vrm0.
left; apply in_or_app; left; rewrite base_n; simpl; auto with datatypes.
assert (H3: k <= n); auto with arith.
generalize (Minus.le_plus_minus _ _ H3).
case (n - k)%nat.
rewrite Plus.plus_0_r; intros Hn H1; subst.
rewrite base_n, base_lt_nil in H1; auto with arith.
simpl in H1; case H1; [intros H2 | intros []].
injection H2; intros; subst.
rewrite conj0, dual0, dual_all.
(* Goal: or (@Logic.eq (vect n) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (joinl n l3))) (joinl n l3)) (@Logic.eq (vect n) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (joinl n l3))) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (joinl n l3))) *)
left.
change (0:vect k, 1: vect k) with (lift k 1).
apply in_map; rewrite base0, en_def; auto with datatypes.
intros k1 Hk1 H1.
assert (H4: k.+1 <= n); auto with arith.
  rewrite Hk1, <-plus_n_Sm; auto with arith.
replace k1.+1 with (n - k)%nat.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
  2: rewrite Hk1, Minus.minus_plus; auto.
replace k1 with (n - k.+1)%nat.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
  2: rewrite Hk1, <-Plus.plus_Snm_nSm, Minus.minus_plus; auto.
case (in_app_or _ _ _ H1).
rewrite in_map_iff; intros [u (H1u,H2u)].
injection H1u; intros Hv1 HV1; subst x y; rewrite conj0, dual0.
Vfold n; Vrm0.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
case (IH _ _ H3 H2u); auto.
intros Hin.
assert (Hh := base_hom _ _ _  (Minus.le_minus _ _) Hin).
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
left; apply in_or_app; right; apply (in_map (lift n)); auto.
(* Goal: @Logic.eq (vect n) (mcontra n (@cons (kn p n) a l) x) (mcontra n l (contra n a x)) *)
right; apply in_or_app; right; apply (in_map (lift n)); simpl; auto.
rewrite in_map_iff; intros [u (H1u,H2u)].
injection H1u; intros Hv1 HV1; subst x y.
rewrite dual0.
Vfold n; Vrm0.
case (IH _ _ H4 H2u); auto; intros Hin;
  rewrite (conjf_hom n k.+1); try apply base_hom; auto;
  rewrite dual_scal;
  case (even_or_odd (k.+1)); intros H2; simpl stype.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite expKm1_even with (2 := H2), scalE1; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
left; apply in_or_app; left; apply (in_map (dlift n)); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite expKm1_odd with (2:= H2); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite <-scal_multE, multK_m1_m1, scalE1; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
right; apply in_or_app; left; apply (in_map (dlift n)); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite expKm1_even with (2 := H2), scalE1; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
right; apply in_or_app; left; apply (in_map (dlift n)); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite expKm1_odd with (2 := H2); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
left; apply in_or_app; left; apply (in_map (dlift n)); auto.
Qed.

(* Ad-hoc conjugate function in order to define the join *)
Fixpoint dconj (n : nat) (b: bool) {struct n} : vect n -> vect n :=
  match n return (vect n -> vect n) with
  | 0%nat => fun a => if b then (- a)%f else a
  | S n1 =>
      fun l1 =>
      let (l2, l3) := l1 in (dconj n1 b l2, dconj n1 (negb b) l3)
  end.

Notation "x ^d_ b" := (dconj _ b x)  (at level 29, left associativity).
Notation "x ^d_'t" := (dconj _ true x)  (at level 29, left associativity).
Notation "x ^d_'f" := (dconj _ false x)  (at level 29, left associativity).

Lemma dconj0 n b : 0 ^d_ b = 0 :> vect n.
Proof.
(* Goal: @Logic.eq (Field.K (K1 p)) (const n (dconj n b x)) (if b then multK (K1 p) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (S n)) (const n x) else multK (K1 p) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) n) (const n x)) *)
generalize b; clear b.
(* Goal: @Logic.eq (vect n) (k2g n (E0 (Kn.vn_eparams p n))) (E0 (vn_eparams n)) *)
induction n as [| n IH]; simpl; auto.
(* Goal: forall b : bool, @Logic.eq (Field.K (K1 p)) (if b then oppK (K1 p) (v0 (K1 p)) else v0 (K1 p)) (v0 (K1 p)) *)
(* Goal: forall b : bool, @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (dconj n b (genk n (v0 (K1 p)))) (dconj n (negb b) (genk n (v0 (K1 p))))) (@pair (vect n) (vect n) (genk n (v0 (K1 p))) (genk n (v0 (K1 p)))) *)
intros []; Krm0.
(* Goal: and (b2Prop (fortho n v0 (conj n (negb b) v1))) (b2Prop (fortho n v0 (conj n b v2))) *)
intros []; rewrite !IH; auto.
Qed.

Hint Rewrite dconj0: GRm0.

Lemma dconj_all n b :
       E ^d_ b = (if b then (-(1)) .* E else E) :> vect n.
Proof.
(* Goal: @Logic.eq (Field.K (K1 p)) (const n (dconj n b x)) (if b then multK (K1 p) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (S n)) (const n x) else multK (K1 p) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) n) (const n x)) *)
generalize b; clear b.
(* Goal: forall (k1 k2 : nat) (_ : b2Prop (hom n k1 x)) (_ : b2Prop (hom n (S O) y)) (_ : b2Prop (hom n k2 z)), @Logic.eq (vect n) (meet n (join n x y) z) (addE (vn_eparams n) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n (S (Nat.add k1 k2)))) (meet n x (join n y z))) (join n (meet n x z) y)) *)
induction n as [| n IH]; simpl; try Vfold n.
(* Goal: forall b : bool, @Logic.eq (Field.K (K1 p)) (if b then oppK (K1 p) x else x) (if b then multK (K1 p) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (v1 (K1 p))) x else multK (K1 p) (v1 (K1 p)) x) *)
(* Goal: forall b : bool, @Logic.eq (Field.K (K1 p)) (let (_, l2) := let (l2, l3) := x in @pair (vect n) (vect n) (dconj n b l2) (dconj n (negb b) l3) in const n l2) (if b then multK (K1 p) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) n))) (let (_, l2) := x in const n l2) else multK (K1 p) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) n)) (let (_, l2) := x in const n l2)) *)
intros []; Krm1.
(* Goal: forall b : bool, @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (dconj n b (all n)) (dconj n (negb b) (E0 (vn_eparams n)))) (if b then @pair (vect n) (vect n) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (all n)) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (E0 (vn_eparams n))) else @pair (vect n) (vect n) (all n) (E0 (vn_eparams n))) *)
intros []; rewrite !IH; Grm0.
Qed.

Lemma dconj_scal n b k (x: vect n) : (k .* x)^d_ b = k .* x ^d_ b.
Proof.
(* Goal: @Logic.eq (Field.K (K1 p)) (const n (dconj n b x)) (if b then multK (K1 p) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (S n)) (const n x) else multK (K1 p) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) n) (const n x)) *)
generalize b; clear b.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
induction n as [| n IH]; simpl;auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros []; auto; intros; rewrite opp_multKr; auto.
(* Goal: and (b2Prop (fortho n v0 (conj n (negb b) v1))) (b2Prop (fortho n v0 (conj n b v2))) *)
intros b; destruct x; Vfold n; rewrite !IH; auto.
Qed.

(* Dual conjugate behave well with the sum *)
Lemma dconj_add n b (x y: vect n) : (x + y) ^d_ b = x ^d_ b + y ^d_ b.
Proof.
(* Goal: @Logic.eq (Field.K (K1 p)) (const n (dconj n b x)) (if b then multK (K1 p) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (S n)) (const n x) else multK (K1 p) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) n) (const n x)) *)
generalize b; clear b.
(* Goal: forall (b : bool) (k : nat) (_ : b2Prop (hom n k x)), b2Prop (hom n k (dconj n b x)) *)
induction n as [| n IH]; simpl.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
  intros b; case b; auto; rewrite opp_addK; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros b; destruct x; destruct y; simpl in IH; rewrite IH, IH; auto.
Qed.

(* Dual conjugate is involutive *)
Lemma dconj_invo n b (v: vect n) : v ^d_ b ^d_ b = v.
Proof.
(* Goal: @Logic.eq (Field.K (K1 p)) (const n (dconj n b x)) (if b then multK (K1 p) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (S n)) (const n x) else multK (K1 p) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) n) (const n x)) *)
generalize b; clear b.
(* Goal: @Logic.eq (vect n) (k2g n (E0 (Kn.vn_eparams p n))) (E0 (vn_eparams n)) *)
induction n as [| n IH]; simpl; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros []; auto; rewrite opp_oppK; auto.
(* Goal: and (b2Prop (fortho n v0 (conj n (negb b) v1))) (b2Prop (fortho n v0 (conj n b v2))) *)
intros b; destruct v; rewrite !IH; auto.
Qed.

Lemma dconj_neg n b (v: vect n) : v ^d_ (negb b) = (-(1)) .*  (v ^d_ b).
Proof.
(* Goal: @Logic.eq (Field.K (K1 p)) (const n (dconj n b x)) (if b then multK (K1 p) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (S n)) (const n x) else multK (K1 p) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) n) (const n x)) *)
generalize b; clear b.
(* Goal: @Logic.eq (vect n) (mcontra n (@cons (kn p n) a l) x) (mcontra n l (contra n a x)) *)
induction n as [| n IH];simpl; auto.
(* Goal: forall b : bool, @Logic.eq (Field.K (K1 p)) (if negb b then oppK (K1 p) v else v) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (if b then oppK (K1 p) v else v)) *)
(* Goal: forall b : bool, @Logic.eq (prod (vect n) (vect n)) (let (l2, l3) := v in @pair (vect n) (vect n) (dconj n (negb b) l2) (dconj n (negb (negb b)) l3)) (let (l2, l3) := let (l2, l3) := v in @pair (vect n) (vect n) (dconj n b l2) (dconj n (negb b) l3) in @pair (vect n) (vect n) (scal n (oppK (K1 p) (v1 (K1 p))) l2) (scal n (oppK (K1 p) (v1 (K1 p))) l3)) *)
intros []; simpl; Krm1.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (let (l2, l3) := v in @pair (vect n) (vect n) (conj n (negb (negb b)) l2) (conj n (negb b) l3)) (let (l2, l3) := let (l2, l3) := v in @pair (vect n) (vect n) (conj n (negb b) l2) (conj n b l3) in @pair (vect n) (vect n) (scal n (oppK (K1 p) (v1 (K1 p))) l2) (scal n (oppK (K1 p) (v1 (K1 p))) l3)) *)
intros b; destruct v; Vfold n.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite negb_involutive, !IH, <-scal_multE; Krm1; rewrite scalE1; auto.
Qed.

Lemma dconjt n (v: vect n) : v ^d_'t = (-(1)) .*  (v ^d_'f).
Proof. rewrite <-dconj_neg; auto. Qed.

Lemma dconjf_hom n k (M: vect n) : 
  hom n k M -> M ^d_'f = (- (1))^(n + k) .* M.
Proof.
(* Goal: forall _ : @In (vect n) v (base n k), or (@Logic.eq (vect n) (join n v (dual n v)) (all n)) (@Logic.eq (vect n) (join n v (dual n v)) (scalE (vn_eparams n) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (all n))) *)
generalize k; clear k.
(* Goal: forall (k : nat) (_ : b2Prop (hom n k M)), @Logic.eq (vect n) (dconj n false M) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n k)) M) *)
induction n as [| n IH];simpl; auto; try Vfold n.
(* Goal: forall (k : nat) (_ : b2Prop match k with | O => true | S n => eqK (K1 p) M (v0 (K1 p)) end), @Logic.eq (Field.K (K1 p)) M (multK (K1 p) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) k) M) *)
(* Goal: forall (k : nat) (_ : b2Prop (let (l2, l3) := M in andb match k with | O => eq0 n l2 | S k1 => hom n k1 l2 end (hom n k l3))), @Logic.eq (prod (vect n) (vect n)) (let (l2, l3) := M in @pair (vect n) (vect n) (dconj n false l2) (dconj n true l3)) (let (l2, l3) := M in @pair (vect n) (vect n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n k))) l2) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n k))) l3)) *)
intros [|k] H; simpl; Krm1.
(* Goal: b2Prop false *)
generalize H; case eqK_spec; intros; subst; Grm0; discriminate.
intros [| k]; destruct M; rewrite andbP; intros (HM1, HM2);
  rewrite dconjt; simpl; Vfold n; Krm1.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
generalize HM1; case eq0_spec; try (intros; discriminate); auto.
(* Goal: forall (_ : @Logic.eq (vect n) v (E0 (vn_eparams n))) (_ : b2Prop true), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (dconj n false v) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (dconj n false v0))) (@pair (vect n) (vect n) (scalE (vn_eparams n) (oppK (K1 p) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n O))) v) (scalE (vn_eparams n) (oppK (K1 p) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n O))) v0)) *)
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (dconj n false v) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (dconj n false v0))) (@pair (vect n) (vect n) (scalE (vn_eparams n) (oppK (K1 p) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S k)))) v) (scalE (vn_eparams n) (oppK (K1 p) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S k)))) v0)) *)
intros H1; rewrite H1, (IH _ _ HM2); simpl; Vfold n; Krm1.
(* Goal: forall _ : b2Prop true, @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (dconj n false (E0 (vn_eparams n))) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (scalE (vn_eparams n) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n O)) v0))) (@pair (vect n) (vect n) (scalE (vn_eparams n) (oppK (K1 p) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n O))) (E0 (vn_eparams n))) (scalE (vn_eparams n) (oppK (K1 p) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n O))) v0)) *)
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (dconj n false v) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (dconj n false v0))) (@pair (vect n) (vect n) (scalE (vn_eparams n) (oppK (K1 p) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S k)))) v) (scalE (vn_eparams n) (oppK (K1 p) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S k)))) v0)) *)
rewrite dconj0, Plus.plus_0_r, <-scal_multE; Krm1; Vrm0.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite IH with (1 := HM1),IH with (1 := HM2); auto.
(* Goal: @Logic.eq (Field.K (K1 p)) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n (S (Nat.add (S k1) k2)))) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (S (Nat.add n (S (Nat.add (S k1) k2)))))) *)
(* Goal: @Logic.eq (vect n) (meet n x2 (join n y2 (dconj n false z1))) (meet n x2 (dconj n false (join n (conj n false y2) z1))) *)
rewrite <-scal_multE, <-plus_n_Sm; simpl expK; Krm1.
Qed.

Lemma dconjt_hom n k (M: vect n) : 
 hom n k M -> M ^d_'t = (- (1))^(n + k).+1 .* M.
Proof.
(* Goal: forall _ : b2Prop (hom n k M), @Logic.eq (vect n) (dconj n true M) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (S (Nat.add n k))) M) *)
intros H1; rewrite dconjt, (dconjf_hom _ _ _ H1).
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite <-scal_multE; auto.
Qed.

Lemma dconj_swap n b1 b2 (x: vect n) : x ^d_ b2 ^d_ b1 = x ^d_ b1 ^d_ b2.
Proof.
(* Goal: @Logic.eq (vect n) (dconj n b1 (conj n b2 x)) (conj n b2 (dconj n b1 x)) *)
generalize b1 b2; clear b1 b2.
(* Goal: @Logic.eq (vect n) (k2g n (E0 (Kn.vn_eparams p n))) (E0 (vn_eparams n)) *)
induction n as [| n IH]; simpl; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros [] []; auto.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (let (x1, y1) := x in @pair (vect n) (vect n) (meet n x1 (E0 (vn_eparams n))) (addE (vn_eparams n) (meet n x1 (genk n (v1 (K1 p)))) (meet n y1 (dconj n false (E0 (vn_eparams n)))))) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (genk n (let (_, l2) := let (x, y) := x in @pair (vect n) (vect n) (dual n (conj n false y)) (dual n x) in const n l2))) *)
intros b1 b2; destruct x.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite (IH _ b2), (IH _ (negb b1)); auto.
Qed.

Lemma dconj_conj_swap n b1 b2 (x: vect n) : (x ^_ b2) ^d_  b1 = x ^d_ b1 ^_ b2.
Proof.
(* Goal: @Logic.eq (vect n) (dconj n b1 (conj n b2 x)) (conj n b2 (dconj n b1 x)) *)
generalize b1 b2; clear b1 b2.
(* Goal: @Logic.eq (vect n) (k2g n (E0 (Kn.vn_eparams p n))) (E0 (vn_eparams n)) *)
induction n as [| n IH]; simpl; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros [] []; auto.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (let (x1, y1) := x in @pair (vect n) (vect n) (meet n x1 (E0 (vn_eparams n))) (addE (vn_eparams n) (meet n x1 (genk n (v1 (K1 p)))) (meet n y1 (dconj n false (E0 (vn_eparams n)))))) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (genk n (let (_, l2) := let (x, y) := x in @pair (vect n) (vect n) (dual n (conj n false y)) (dual n x) in const n l2))) *)
intros b1 b2; destruct x.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite (IH _ b1), (IH _ (negb b1)); auto.
Qed.

Lemma dconj_conj n b (x: vect n) : (x ^_ b) ^d_ b = (-(1))^n .* x.
Proof.
(* Goal: @Logic.eq (Field.K (K1 p)) (const n (dconj n b x)) (if b then multK (K1 p) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (S n)) (const n x) else multK (K1 p) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) n) (const n x)) *)
generalize b; clear b.
(* Goal: @Logic.eq (vect n) (k2g n (E0 (Kn.vn_eparams p n))) (E0 (vn_eparams n)) *)
induction n as [| n IH]; simpl; auto.
(* Goal: forall b : bool, @Logic.eq (Field.K (K1 p)) (if b then oppK (K1 p) x else x) (if b then multK (K1 p) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (v1 (K1 p))) x else multK (K1 p) (v1 (K1 p)) x) *)
(* Goal: forall b : bool, @Logic.eq (Field.K (K1 p)) (let (_, l2) := let (l2, l3) := x in @pair (vect n) (vect n) (dconj n b l2) (dconj n (negb b) l3) in const n l2) (if b then multK (K1 p) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) n))) (let (_, l2) := x in const n l2) else multK (K1 p) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) n)) (let (_, l2) := x in const n l2)) *)
intros []; Krm1.
intros []; destruct x; simpl; Vfold n;
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
  rewrite conjt, dconjt, dconj_scal, !IH, <-!scal_multE; auto.
Qed.

Lemma dconj_hom n b k (x: vect n) : hom n k x -> hom n k (x ^d_ b).
Proof.
(* Goal: forall _ : b2Prop (hom n k x), b2Prop (hom n k (dconj n b x)) *)
generalize b k; clear b k.
(* Goal: forall (b : bool) (k : nat) (_ : b2Prop (hom n k x)), b2Prop (hom n k (dconj n b x)) *)
induction n as [| n IH]; simpl.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
  intros [|] [|k]; auto.
(* Goal: b2Prop false *)
  case eqK_spec; auto; intros HH HH1; try discriminate.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
  rewrite HH, oppK0, eqKI; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros b [|k]; destruct x; rewrite !andbP; intros (H1, H2); split; auto.
(* Goal: b2Prop false *)
generalize H1; case eq0_spec; intros Hx1 HH; try discriminate.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
  rewrite Hx1, dconj0, eq0I; auto.
Qed.

Hint Resolve dconj_hom.

Lemma dconjf_joinl n (x y: vect n) : (x ∨ y) ^d_'f = x ^d_'f ∨ y ^_'f.
Proof.
(* Goal: @Logic.eq (vect n) (dual n (join n v1 v2)) (meet n (dual n v1) (dual n v2)) *)
induction n as [| n IH]; auto.
(* Goal: @Logic.eq (vect (S n)) (dual (S n) (join (S n) v1 v2)) (meet (S n) (dual (S n) v1) (dual (S n) v2)) *)
destruct x; destruct y; simpl; Vfold n.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (dconj n false (addE (vn_eparams n) (join n v v2) (join n (conj n false v0) v1))) (dconj n true (join n v0 v2))) (@pair (vect n) (vect n) (addE (vn_eparams n) (join n (conj n true v) (dconj n true v2)) (join n (conj n false (conj n false v0)) (dconj n false v1))) (join n (conj n false v0) (dconj n true v2))) *)
rewrite !dconjt, IH.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (dconj n false (addE (vn_eparams n) (join n v v2) (join n (conj n false v0) v1))) (scalE (vn_eparams n) (oppK (stype (vn_eparams n)) (Field.v1 (stype (vn_eparams n)))) (join n (dconj n false v0) (conj n false v2)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (join n (dconj n false v) (conj n false v2)) (join n (conj n false (scalE (vn_eparams n) (oppK (stype (vn_eparams n)) (Field.v1 (stype (vn_eparams n)))) (dconj n false v0))) (conj n true v1))) (join n (scalE (vn_eparams n) (oppK (stype (vn_eparams n)) (Field.v1 (stype (vn_eparams n)))) (dconj n false v0)) (conj n false v2))) *)
rewrite dconj_add, !IH, !conjt, join_scall.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply f_equal2 with (f := @pair _ _); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply f_equal2 with (f := addE (vn_eparams n)); auto.
(* Goal: @Logic.eq (E (vn_eparams n)) (join n (dconj n false (conj n false v0)) (conj n false v1)) (join n (conj n false (scalE (vn_eparams n) (oppK (stype (vn_eparams n)) (Field.v1 (stype (vn_eparams n)))) (dconj n false v0))) (scalE (vn_eparams n) (oppK (stype (vn_eparams n)) (Field.v1 (stype (vn_eparams n)))) (conj n false v1))) *)
rewrite conj_scal, !join_scall, !join_scalr, <-scal_multE; Krm1.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite dconj_conj_swap, scalE1; auto.
Qed.

Lemma dconjf_joinr n (x y: vect n) : (x ∨ y) ^d_'f = x ^_'f ∨ y ^d_'f.
Proof.
(* Goal: @Logic.eq (vect n) (dual n (join n v1 v2)) (meet n (dual n v1) (dual n v2)) *)
induction n as [| n IH]; auto.
(* Goal: @Logic.eq (vect (S n)) (dconj (S n) false (join (S n) x y)) (join (S n) (conj (S n) false x) (dconj (S n) false y)) *)
simpl vect.
(* Goal: @Logic.eq (vect (S n)) (dual (S n) (join (S n) v1 v2)) (meet (S n) (dual (S n) v1) (dual (S n) v2)) *)
destruct x; destruct y; simpl; Vfold n.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (dconj n false (addE (vn_eparams n) (join n v v2) (join n (conj n false v0) v1))) (dconj n true (join n v0 v2))) (@pair (vect n) (vect n) (addE (vn_eparams n) (join n (conj n true v) (dconj n true v2)) (join n (conj n false (conj n false v0)) (dconj n false v1))) (join n (conj n false v0) (dconj n true v2))) *)
rewrite !dconjt, IH.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (dconj n false (addE (vn_eparams n) (join n v v2) (join n (conj n false v0) v1))) (scalE (vn_eparams n) (oppK (stype (vn_eparams n)) (Field.v1 (stype (vn_eparams n)))) (join n (conj n false v0) (dconj n false v2)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (join n (conj n true v) (scalE (vn_eparams n) (oppK (stype (vn_eparams n)) (Field.v1 (stype (vn_eparams n)))) (dconj n false v2))) (join n (conj n false (conj n false v0)) (dconj n false v1))) (join n (conj n false v0) (scalE (vn_eparams n) (oppK (stype (vn_eparams n)) (Field.v1 (stype (vn_eparams n)))) (dconj n false v2)))) *)
rewrite dconj_add, !IH, !conjt.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (addE (vn_eparams n) (join n (conj n false v) (dconj n false v2)) (join n (conj n false (conj n false v0)) (dconj n false v1))) (scalE (vn_eparams n) (oppK (stype (vn_eparams n)) (Field.v1 (stype (vn_eparams n)))) (join n (conj n false v0) (dconj n false v2)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (join n (scalE (vn_eparams n) (oppK (stype (vn_eparams n)) (Field.v1 (stype (vn_eparams n)))) (conj n false v)) (scalE (vn_eparams n) (oppK (stype (vn_eparams n)) (Field.v1 (stype (vn_eparams n)))) (dconj n false v2))) (join n (conj n false (conj n false v0)) (dconj n false v1))) (join n (conj n false v0) (scalE (vn_eparams n) (oppK (stype (vn_eparams n)) (Field.v1 (stype (vn_eparams n)))) (dconj n false v2)))) *)
rewrite !join_scall, !join_scalr, <-scal_multE; Krm1.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite scalE1; auto.
Qed.

Lemma conj_dual n b (x: vect n): '@(x ^_ b) = '@x ^d_ b.
Proof.
(* Goal: @Logic.eq (Field.K (K1 p)) (const n (dconj n b x)) (if b then multK (K1 p) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (S n)) (const n x) else multK (K1 p) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) n) (const n x)) *)
generalize b; clear b.
(* Goal: @Logic.eq (vect n) (dual n (join n v1 v2)) (meet n (dual n v1) (dual n v2)) *)
induction n as [| n IH]; auto.
(* Goal: forall b : bool, @Logic.eq (vect (S n)) (dual (S n) (conj (S n) b x)) (dconj (S n) b (dual (S n) x)) *)
simpl; intros b; destruct x; rewrite !IH.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite dconj_swap; auto.
Qed.

Lemma dconj_dual n b (x: vect n) : '@(x ^d_ b) = '@x ^_ b.
Proof.
(* Goal: @Logic.eq (Field.K (K1 p)) (const n (dconj n b x)) (if b then multK (K1 p) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (S n)) (const n x) else multK (K1 p) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) n) (const n x)) *)
generalize b; clear b.
(* Goal: @Logic.eq (vect n) (dual n (join n v1 v2)) (meet n (dual n v1) (dual n v2)) *)
induction n as [| n IH]; auto.
simpl; intros []; destruct x; 
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
  rewrite !IH, !conj_dual, IH, dconj_conj_swap; auto.
Qed.

Lemma dualk n k : '@([k]) = k .* E :> vect n.
Proof.
(* Goal: @Logic.eq (vect n) (k2g n (E0 (Kn.vn_eparams p n))) (E0 (vn_eparams n)) *)
induction n as [| n IH]; simpl; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite multK1r; auto.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (dual n (conj n false (genk n k))) (dual n (genk n (v0 (K1 p))))) (@pair (vect n) (vect n) (scal n k (all n)) (scal n k (genk n (v0 (K1 p))))) *)
Vfold n.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite dual0, scalE0r; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite conj_dual, IH, dconj_scal, dconj_all; auto.
Qed.

Definition dconst n (x: vect n) := 'C['@x].
Notation "'dC[ x ]" := (dconst _ x).

Lemma dconjk n b k :
  [k] ^d_ b = (if b then [(-(1))^n.+1 * k] else [(-(1))^n * k]:vect n).
Proof.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
case b; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite dconjt_hom with (k := 0%nat), Plus.plus_0_r, scalk; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite dconjf_hom with (k := 0%nat), Plus.plus_0_r, scalk; auto.
Qed.

Lemma dconj_const n b (x: vect n) :
  'C[x ^d_ b] = (if b then ((-(1))^n.+1 * 'C[x])%f else ((-(1))^n * 'C[x])%f).
Proof.
(* Goal: @Logic.eq (Field.K (K1 p)) (const n (dconj n b x)) (if b then multK (K1 p) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (S n)) (const n x) else multK (K1 p) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) n) (const n x)) *)
generalize b; clear b.
(* Goal: @Logic.eq (vect n) (k2g n (E0 (Kn.vn_eparams p n))) (E0 (vn_eparams n)) *)
induction n as [|n IH]; simpl; auto.
(* Goal: forall b : bool, @Logic.eq (Field.K (K1 p)) (if b then oppK (K1 p) x else x) (if b then multK (K1 p) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (v1 (K1 p))) x else multK (K1 p) (v1 (K1 p)) x) *)
(* Goal: forall b : bool, @Logic.eq (Field.K (K1 p)) (let (_, l2) := let (l2, l3) := x in @pair (vect n) (vect n) (dconj n b l2) (dconj n (negb b) l3) in const n l2) (if b then multK (K1 p) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) n))) (let (_, l2) := x in const n l2) else multK (K1 p) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) n)) (let (_, l2) := x in const n l2)) *)
intros []; Krm1.
(* Goal: forall b : bool, @Logic.eq (Field.K (K1 p)) (let (_, l2) := let (l2, l3) := x in @pair (vect n) (vect n) (dconj n b l2) (dconj n (negb b) l3) in const n l2) (if b then multK (K1 p) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) n))) (let (_, l2) := x in const n l2) else multK (K1 p) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) n)) (let (_, l2) := x in const n l2)) *)
intros []; destruct x; simpl negb; rewrite IH; Krm1.
Qed.                      

Lemma conj_dconst n b (x: vect n) :
  'dC[x ^_ b] = (if b then ((-(1))^n.+1 * 'dC[x])%f else  ((-(1))^n * 'dC[x])%f).
Proof. unfold dconst; rewrite conj_dual, dconj_const; auto. Qed.

Lemma dconj_dconst n b (x: vect n) :
  'dC[x ^d_ b] = (if b then (- 'dC[x])%f else  'dC[x]).
Proof. unfold dconst; rewrite dconj_dual, conj_const; auto. Qed.

Lemma projn n (x : vect n) : proj n n x = 'dC[x] :: nil.
Proof.
(* Goal: @Logic.eq (vect n) (k2g n (E0 (Kn.vn_eparams p n))) (E0 (vn_eparams n)) *)
induction n as [| n IH]; simpl; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
destruct x; rewrite IH, proj_lt; auto.
Qed.

Lemma dconst_all n : 'dC[(E: vect n)] = 1%f .
Proof. unfold dconst; rewrite dual_all, constk; auto. Qed.

Lemma dconst0 n : 'dC[0:vect n] = 0%f.
Proof. unfold dconst; rewrite dual0, const0; auto. Qed.

Hint Rewrite dconst0: GRm0.

Lemma dconst_scal n k (x: vect n) : 'dC[k .* x] = (k * 'dC[x])%f.
Proof. unfold dconst; rewrite dual_scal, const_scal; auto. Qed.

Lemma dconst_add n (x1 x2 : vect n) : 'dC[x1 + x2] = ('dC[x1] + 'dC[x2])%f.
Proof. unfold dconst; rewrite dual_add, const_add; auto. Qed.

Lemma dconst_hom n k x : hom n k x -> n <> k -> 'dC[x] = 0%f.
Proof.
(* Goal: forall (_ : b2Prop (hom n k1 x)) (_ : not (@Logic.eq nat n k1)), @Logic.eq (vect n) (meet n x (genk n k2)) (E0 (vn_eparams n)) *)
intros H1 H2.
(* Goal: @Logic.eq (Field.K (K1 p)) (dconst n x) (v0 (K1 p)) *)
case (Lt.le_or_lt n k); intros H3.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
case (Lt.le_lt_or_eq _ _ H3); intros H4; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite hom_lt with (2 := H1), dconst0; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
case H2; auto.
(* Goal: @Logic.eq (Field.K (K1 p)) (dconst n x) (v0 (K1 p)) *)
unfold dconst; apply const_hom with (k := (n - k)%nat).
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply dual_hom; auto.
(* Goal: lt O (Nat.sub n k) *)
apply Plus.plus_lt_reg_l with k.
(* Goal: lt (Nat.add n O) (Nat.add n (Nat.sub (Nat.add k1 k2) n)) *)
(* Goal: @Logic.eq (vect n) (join n x y) (join n (meet n x y) (all n)) *)
rewrite Plus.plus_0_r, <-Minus.le_plus_minus; auto with arith.
Qed.

Lemma homn_all n x : hom n n x -> x = 'dC[x] .* E.
Proof.
(* Goal: forall _ : b2Prop (hom n n x), @Logic.eq (vect n) x (scalE (vn_eparams n) (dconst n x) (all n)) *)
unfold dconst.
(* Goal: @Logic.eq (vect n) (meet n x (genk n (v1 (K1 p)))) (genk n (const n (dual n x))) *)
induction n as [|n IH]; simpl; try Vfold n; Krm1.
(* Goal: forall _ : b2Prop (let (l2, l3) := x in andb (hom n n l2) (hom n (S n) l3)), @Logic.eq (prod (vect n) (vect n)) x (@pair (vect n) (vect n) (scalE (vn_eparams n) (let (_, l2) := let (x, y) := x in @pair (vect n) (vect n) (dual n (conj n false y)) (dual n x) in const n l2) (all n)) (scalE (vn_eparams n) (let (_, l2) := let (x, y) := x in @pair (vect n) (vect n) (dual n (conj n false y)) (dual n x) in const n l2) (E0 (vn_eparams n)))) *)
destruct x; rewrite andbP; intros (Hx1,Hx2).
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) v v0) (@pair (vect n) (vect n) (scalE (vn_eparams n) (const n (dual n v)) (all n)) (scalE (vn_eparams n) (const n (dual n v)) (E0 (vn_eparams n)))) *)
rewrite <-(IH _ Hx1); Grm0.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) v v0) (@pair (vect n) (vect n) v (E0 (vn_eparams n))) *)
rewrite hom_lt with (2 := Hx2); Grm0.
Qed.

Lemma const_dual n (x: vect n) : 'C['@x] = 'dC[x].
Proof. auto. Qed.

Lemma dconst_dual n (x: vect n) : 'dC['@x] = 'C[x].
Proof.
(* Goal: @Logic.eq (vect n) (dual n (addE (vn_eparams n) v1 v2)) (addE (vn_eparams n) (dual n v1) (dual n v2)) *)
unfold dconst; induction n as [|n IH]; simpl; auto; Vfold n.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
destruct x; rewrite IH, conj_const; auto.
Qed.

(* Defining the meet *)
Fixpoint meet (n : nat) : vect n -> vect n -> vect n :=
  match n return (vect n -> vect n -> vect n) with
  | 0%nat => fun a b => (a * b)%f
  | S n1 =>
      fun v1 v2 => 
      let (x1, y1) := v1 in
      let (x2, y2) := v2 in (meet n1 x1 x2,
                                meet n1 x1 y2 +
                                meet n1 y1 (x2 ^d_'f))
  end.

(* unicode 2227 *)
Notation "x '∧' y" := (meet _ x y) (at level 45, left associativity).

Lemma meet0l n (x: vect n) : 0 ∧ x = 0.
Proof.
(* Goal: @Logic.eq (vect n) (meet n x (E0 (vn_eparams n))) (E0 (vn_eparams n)) *)
induction n as [| n IH]; simpl; try Vfold n; Krm0.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (addE (vn_eparams n) (E0 (vn_eparams n)) (E0 (vn_eparams n))) (addE (vn_eparams n) (genk n k1) (genk n k2))) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (genk n (addK (K1 p) k1 k2))) *)
destruct x; rewrite !IH; Vrm0.
Qed.

Hint Rewrite meet0l: GRm0.

Lemma meet0r n (x: vect n) : x ∧ 0 = 0.
Proof.
(* Goal: @Logic.eq (vect n) (meet n x (E0 (vn_eparams n))) (E0 (vn_eparams n)) *)
induction n as [| n IH]; simpl; try Vfold n; Krm0.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (let (x1, y1) := x in @pair (vect n) (vect n) (meet n x1 (E0 (vn_eparams n))) (addE (vn_eparams n) (meet n x1 (E0 (vn_eparams n))) (meet n y1 (dconj n false (E0 (vn_eparams n)))))) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (E0 (vn_eparams n))) *)
destruct x; rewrite dconj0, !IH; Vrm0.
Qed.

Hint Rewrite meet0r: GRm0.

Lemma meet1l n (x: vect n) : 1 ∧ x = ['C['@x]].
Proof.
(* Goal: @Logic.eq (vect n) (meet n x (genk n (v1 (K1 p)))) (genk n (const n (dual n x))) *)
induction n as [| n IH]; simpl; try Vfold n; Krm1.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (let (x1, y1) := x in @pair (vect n) (vect n) (meet n x1 (E0 (vn_eparams n))) (addE (vn_eparams n) (meet n x1 (genk n (v1 (K1 p)))) (meet n y1 (dconj n false (E0 (vn_eparams n)))))) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (genk n (let (_, l2) := let (x, y) := x in @pair (vect n) (vect n) (dual n (conj n false y)) (dual n x) in const n l2))) *)
destruct x.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite !meet0l, addE0l, IH,dconj_dual, conj_const; auto.
Qed.

Lemma meet1r n (x: vect n) : x ∧ 1 = ['C['@x]].
Proof.
(* Goal: @Logic.eq (vect n) (meet n x (genk n (v1 (K1 p)))) (genk n (const n (dual n x))) *)
induction n as [| n IH]; simpl; try Vfold n; Krm1.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (let (x1, y1) := x in @pair (vect n) (vect n) (meet n x1 (E0 (vn_eparams n))) (addE (vn_eparams n) (meet n x1 (genk n (v1 (K1 p)))) (meet n y1 (dconj n false (E0 (vn_eparams n)))))) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (genk n (let (_, l2) := let (x, y) := x in @pair (vect n) (vect n) (dual n (conj n false y)) (dual n x) in const n l2))) *)
destruct x.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite !meet0r, dconj0, IH, meet0r, addE0r; auto.
Qed.

(* (k.x) ∧ y = k. (x ∧ y) *)
Lemma meet_scall n k (x y : vect n) : k .* x ∧ y = k .* (x ∧ y).
Proof.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
induction n as [| n IH]; simpl; try Vfold n;auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite multK_assoc; auto.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (let (x1, y1) := x in let (x2, y2) := let (l2, l3) := y in @pair (vect n) (vect n) (scalE (vn_eparams n) k l2) (scalE (vn_eparams n) k l3) in @pair (vect n) (vect n) (meet n x1 x2) (addE (vn_eparams n) (meet n x1 y2) (meet n y1 (dconj n false x2)))) (let (l2, l3) := let (x1, y1) := x in let (x2, y2) := y in @pair (vect n) (vect n) (meet n x1 x2) (addE (vn_eparams n) (meet n x1 y2) (meet n y1 (dconj n false x2))) in @pair (vect n) (vect n) (scalE (vn_eparams n) k l2) (scalE (vn_eparams n) k l3)) *)
destruct x; destruct y.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite scal_addEr, !IH; auto.
Qed.

(* x ∧ (k . y) = k. (x ∧ y) *)
Lemma meet_scalr n k (x y : vect n) : x ∧ k .* y = k .* (x ∧ y).
Proof.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
induction n as [| n IH]; simpl; try Vfold n;auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite <-!multK_assoc, (multK_com _ Hp x); auto.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (let (x1, y1) := x in let (x2, y2) := let (l2, l3) := y in @pair (vect n) (vect n) (scalE (vn_eparams n) k l2) (scalE (vn_eparams n) k l3) in @pair (vect n) (vect n) (meet n x1 x2) (addE (vn_eparams n) (meet n x1 y2) (meet n y1 (dconj n false x2)))) (let (l2, l3) := let (x1, y1) := x in let (x2, y2) := y in @pair (vect n) (vect n) (meet n x1 x2) (addE (vn_eparams n) (meet n x1 y2) (meet n y1 (dconj n false x2))) in @pair (vect n) (vect n) (scalE (vn_eparams n) k l2) (scalE (vn_eparams n) k l3)) *)
destruct x; destruct y.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite dconj_scal, scal_addEr, !IH; auto.
Qed.

Lemma meet0 (v1 v2 : vect 0) : v1 ∧ v2 = (v1 * v2)%f.
Proof. auto. Qed.

Lemma meetS n (x1 x2 y1 y2 : vect n) :
 ((x1,y1): vect n.+1) ∧ (x2,y2) = 
  (x1 ∧ x2, x1 ∧ y2 + y1 ∧ (x2 ^d_'f)).
Proof. auto. Qed.

Lemma dual_meet n (v1 v2 : vect n) : '@(v1 ∧ v2) = '@v1 ∨ '@v2.
Proof.
(* Goal: @Logic.eq (vect n) (dual n (join n v1 v2)) (meet n (dual n v1) (dual n v2)) *)
induction n as [| n IH]; auto.
(* Goal: @Logic.eq (vect (S n)) (dual (S n) (meet (S n) v1 v2)) (join (S n) (dual (S n) v1) (dual (S n) v2)) *)
destruct v1; destruct v2; rewrite meetS.
(* Goal: @Logic.eq (vect (S n)) (dual (S n) (join (S n) v1 v2)) (meet (S n) (dual (S n) v1) (dual (S n) v2)) *)
simpl; Vfold n.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (dual n (conj n false (addE (vn_eparams n) (meet n v v2) (meet n v0 (dconj n false v1))))) (dual n (meet n v v1))) (@pair (vect n) (vect n) (addE (vn_eparams n) (join n (dual n (conj n false v0)) (dual n v1)) (join n (conj n false (dual n v)) (dual n (conj n false v2)))) (join n (dual n v) (dual n v1))) *)
rewrite IH, conj_add, dual_add.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply f_equal2 with (f := @pair _ _); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite addE_com; auto; apply f_equal2 with (f := @addE (vn_eparams n)); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite !conj_dual, IH, dconj_dual, dconjf_joinl, conj_invo; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite !conj_dual, IH, dconjf_joinr; auto.
Qed.

Lemma conjf_meetl n (x y : vect n) : (x ∧ y) ^_'f = x ^_'f ∧ y ^d_'f.
Proof.
(* Goal: @Logic.eq (vect n) (dual n (join n v1 v2)) (meet n (dual n v1) (dual n v2)) *)
induction n as [| n IH]; auto.
(* Goal: @Logic.eq (vect (S n)) (dconj (S n) false (meet (S n) x y)) (meet (S n) (conj (S n) false x) (conj (S n) false y)) *)
destruct x; destruct y; rewrite !meetS.
(* Goal: @Logic.eq (vect (S n)) (conj (S n) false (@pair (vect n) (E (vn_eparams n)) (meet n v v1) (addE (vn_eparams n) (meet n v v2) (meet n v0 (dconj n false v1))))) (meet (S n) (conj (S n) false (@pair (vect n) (vect n) v v0)) (dconj (S n) false (@pair (vect n) (vect n) v1 v2))) *)
simpl dconj; simpl conj; Vfold n; rewrite !conjt, meetS, !IH, meet_scall.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply f_equal2 with (f := @pair _ _); auto.
(* Goal: @Logic.eq ((fix vect (n : nat) : Set := match n with | O => Field.K (K1 p) | S n1 => prod (vect n1) (vect n1) end) n) (conj n false (addE (vn_eparams n) (meet n v v2) (meet n v0 (dconj n false v1)))) (addE (vn_eparams n) (meet n (scalE (vn_eparams n) (oppK (stype (vn_eparams n)) (Field.v1 (stype (vn_eparams n)))) (conj n false v)) (dconj n true v2)) (meet n (conj n false v0) (dconj n false (dconj n false v1)))) *)
rewrite conj_add, !IH.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply f_equal2 with (f := addE (vn_eparams n)); auto.
(* Goal: @Logic.eq (E (vn_eparams n)) (meet n (conj n false v) (dconj n false v2)) (meet n (scalE (vn_eparams n) (oppK (stype (vn_eparams n)) (Field.v1 (stype (vn_eparams n)))) (conj n false v)) (dconj n true v2)) *)
rewrite dconjt, meet_scalr, meet_scall, <-scal_multE; Krm1.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite scalE1; auto.
Qed.

Lemma conjf_meetr n (x y : vect n) : (x ∧ y) ^_'f = x ^d_'f ∧ y ^_'f.
Proof.
(* Goal: @Logic.eq (vect n) (dual n (join n v1 v2)) (meet n (dual n v1) (dual n v2)) *)
induction n as [| n IH]; auto.
(* Goal: @Logic.eq (vect (S n)) (dconj (S n) false (meet (S n) x y)) (meet (S n) (conj (S n) false x) (conj (S n) false y)) *)
destruct x; destruct y; rewrite !meetS.
(* Goal: @Logic.eq (vect (S n)) (conj (S n) false (@pair (vect n) (E (vn_eparams n)) (meet n v v1) (addE (vn_eparams n) (meet n v v2) (meet n v0 (dconj n false v1))))) (meet (S n) (dconj (S n) false (@pair (vect n) (vect n) v v0)) (conj (S n) false (@pair (vect n) (vect n) v1 v2))) *)
simpl dconj; simpl conj; Vfold n; rewrite !conjt, meetS, !IH, meet_scalr.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply f_equal2 with (f := @pair _ _); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite conj_add, !IH; apply f_equal2 with (f := addE (vn_eparams n)); auto.
(* Goal: @Logic.eq (E (vn_eparams n)) (meet n (dconj n false v0) (conj n false (dconj n false v1))) (meet n (dconj n true v0) (dconj n false (scalE (vn_eparams n) (oppK (stype (vn_eparams n)) (Field.v1 (stype (vn_eparams n)))) (conj n false v1)))) *)
rewrite dconjt, dconj_scal, meet_scalr, meet_scall, <-scal_multE; Krm1.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite scalE1, dconj_conj_swap; auto.
Qed.

Lemma dconjf_meet n (x y : vect n) : (x ∧ y) ^d_'f = x ^d_'f ∧ y ^d_'f.
Proof.
(* Goal: @Logic.eq (vect n) (dual n (join n v1 v2)) (meet n (dual n v1) (dual n v2)) *)
induction n as [| n IH]; auto.
(* Goal: @Logic.eq (vect (S n)) (dconj (S n) false (meet (S n) x y)) (meet (S n) (conj (S n) false x) (conj (S n) false y)) *)
destruct x; destruct y; rewrite !meetS.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (dual n (conj n false (genk n k))) (dual n (genk n (v0 (K1 p))))) (@pair (vect n) (vect n) (scal n k (all n)) (scal n k (genk n (v0 (K1 p))))) *)
simpl dconj; rewrite meetS, !IH, !dconj_invo; Vfold n.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply f_equal2 with (f := @pair _ _); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite !dconjt, dconj_add, meet_scall, meet_scalr, <-scal_addEr; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite !IH, dconj_invo; auto.
Qed.
   
Lemma dconjf_meetd n (x y : vect n) : (x ∧ y) ^d_'f = x ^_'f ∧ y ^_'f.
Proof.
(* Goal: @Logic.eq (vect n) (dual n (join n v1 v2)) (meet n (dual n v1) (dual n v2)) *)
induction n as [| n IH]; auto.
(* Goal: @Logic.eq (vect (S n)) (dconj (S n) false (meet (S n) x y)) (meet (S n) (conj (S n) false x) (conj (S n) false y)) *)
destruct x; destruct y; rewrite !meetS.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (dual n (conj n false (genk n k))) (dual n (genk n (v0 (K1 p))))) (@pair (vect n) (vect n) (scal n k (all n)) (scal n k (genk n (v0 (K1 p))))) *)
simpl conj; simpl dconj; rewrite meetS, !conjt, !dconjt; Vfold n.
(* Goal: @Logic.eq (vect (S n)) (@pair (vect n) (vect n) (dconj n false (meet n v v1)) (scalE (vn_eparams n) (oppK (stype (vn_eparams n)) (Field.v1 (stype (vn_eparams n)))) (dconj n false (addE (vn_eparams n) (meet n v v2) (meet n v0 (dconj n false v1)))))) (@pair (vect n) (E (vn_eparams n)) (meet n (scalE (vn_eparams n) (oppK (stype (vn_eparams n)) (Field.v1 (stype (vn_eparams n)))) (conj n false v)) (scalE (vn_eparams n) (oppK (stype (vn_eparams n)) (Field.v1 (stype (vn_eparams n)))) (conj n false v1))) (addE (vn_eparams n) (meet n (scalE (vn_eparams n) (oppK (stype (vn_eparams n)) (Field.v1 (stype (vn_eparams n)))) (conj n false v)) (conj n false v2)) (meet n (conj n false v0) (dconj n false (scalE (vn_eparams n) (oppK (stype (vn_eparams n)) (Field.v1 (stype (vn_eparams n)))) (conj n false v1)))))) *)
rewrite IH, !meet_scall, !meet_scalr, <-!scal_multE, dconj_add; Krm1.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite scalE1; auto; apply f_equal2 with (f := @pair _ _); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite !IH, !dconj_scal, meet_scalr, dconj_conj_swap, scal_addEr; auto.
Qed.

Lemma dconst_meet n (x y: vect n) : 'dC[x ∧ y] = ('dC[x] * 'dC[y])%f.
Proof. unfold dconst; rewrite dual_meet, const_join. auto. Qed.

Lemma dual_join n (v1 v2: vect n) : '@(v1 ∨ v2) = '@v1 ∧ '@v2.
Proof.
(* Goal: @Logic.eq (vect n) (dual n (join n v1 v2)) (meet n (dual n v1) (dual n v2)) *)
induction n as [| n IH]; auto.
(* Goal: @Logic.eq (vect (S n)) (dual (S n) (join (S n) v1 v2)) (meet (S n) (dual (S n) v1) (dual (S n) v2)) *)
simpl; Vfold n.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (let (x, y) := let (x1, x2) := v1 in let (y1, y2) := v2 in @pair (vect n) (vect n) (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) (join n x2 y2) in @pair (vect n) (vect n) (dual n (conj n false y)) (dual n x)) (let (x1, y1) := let (x, y) := v1 in @pair (vect n) (vect n) (dual n (conj n false y)) (dual n x) in let (x2, y2) := let (x, y) := v2 in @pair (vect n) (vect n) (dual n (conj n false y)) (dual n x) in @pair (vect n) (vect n) (meet n x1 x2) (addE (vn_eparams n) (meet n x1 y2) (meet n y1 (dconj n false x2)))) *)
destruct v1; destruct v2.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply f_equal2 with (f := @pair _ _); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite conjf_join, IH; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite dual_add, addE_com; auto; apply f_equal2 with (f := @addE (vn_eparams n)); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite conj_dual, dconj_invo, IH; auto.
Qed.

(* (x + y) ∧ z = (x ∧ z) + (y ∧ z) *)
Lemma meet_addl n (x y z : vect n) : (x + y) ∧ z = x ∧ z + y ∧ z.
Proof.
(* Goal: forall (k1 k2 : nat) (_ : b2Prop (hom n k1 x)) (_ : b2Prop (hom n (S O) y)) (_ : b2Prop (hom n k2 z)), @Logic.eq (vect n) (meet n (join n x y) z) (addE (vn_eparams n) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n (S (Nat.add k1 k2)))) (meet n x (join n y z))) (join n (meet n x z) y)) *)
induction n as [| n IH]; simpl; try Vfold n.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros; apply (add_multKl p); auto.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (let (x1, y1) := let (x1, y1) := x in let (x2, y2) := y in @pair (vect n) (vect n) (meet n x1 x2) (addE (vn_eparams n) (meet n x1 y2) (meet n y1 (dconj n false x2))) in let (x2, y2) := z in @pair (vect n) (vect n) (meet n x1 x2) (addE (vn_eparams n) (meet n x1 y2) (meet n y1 (dconj n false x2)))) (let (x1, y1) := x in let (x2, y2) := let (x2, y2) := y in let (x3, y3) := z in @pair (vect n) (vect n) (meet n x2 x3) (addE (vn_eparams n) (meet n x2 y3) (meet n y2 (dconj n false x3))) in @pair (vect n) (vect n) (meet n x1 x2) (addE (vn_eparams n) (meet n x1 y2) (meet n y1 (dconj n false x2)))) *)
destruct x; destruct y; destruct z.
(* Goal: @Logic.eq (vect n) (meet n (meet n v v1) v3) (meet n v (meet n v1 v3)) *)
(* Goal: @Logic.eq (vect n) (addE (vn_eparams n) (meet n (meet n v v1) v4) (meet n (addE (vn_eparams n) (meet n v v2) (meet n v0 (dconj n false v1))) (dconj n false v3))) (addE (vn_eparams n) (meet n v (addE (vn_eparams n) (meet n v1 v4) (meet n v2 (dconj n false v3)))) (meet n v0 (dconj n false (meet n v1 v3)))) *)
apply f_equal2 with (f := @pair _ _); rewrite IH; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite !addE_assoc; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply f_equal2 with (f := add n); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite IH, addE_com, !addE_assoc; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply f_equal2 with (f := add n); auto.
(* Goal: @Logic.eq (vect n) (addE (vn_eparams n) (meet n v4 (dconj n false v1)) (meet n v3 v2)) (addE (vn_eparams n) (meet n v3 v2) (meet n v4 (dconj n false v1))) *)
rewrite addE_com; auto.
Qed.

(* z ∧ (x + y) = (z ∧ x) + (z ∧ y) *)
Lemma meet_addr n (x y z : vect n) : z ∧ (x + y) = z ∧ x + z ∧ y.
Proof.
(* Goal: forall (k1 k2 : nat) (_ : b2Prop (hom n k1 x)) (_ : b2Prop (hom n (S O) y)) (_ : b2Prop (hom n k2 z)), @Logic.eq (vect n) (meet n (join n x y) z) (addE (vn_eparams n) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n (S (Nat.add k1 k2)))) (meet n x (join n y z))) (join n (meet n x z) y)) *)
induction n as [| n IH]; simpl; try Vfold n.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros; apply (add_multKr p); auto.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (let (x1, y1) := let (x1, y1) := x in let (x2, y2) := y in @pair (vect n) (vect n) (meet n x1 x2) (addE (vn_eparams n) (meet n x1 y2) (meet n y1 (dconj n false x2))) in let (x2, y2) := z in @pair (vect n) (vect n) (meet n x1 x2) (addE (vn_eparams n) (meet n x1 y2) (meet n y1 (dconj n false x2)))) (let (x1, y1) := x in let (x2, y2) := let (x2, y2) := y in let (x3, y3) := z in @pair (vect n) (vect n) (meet n x2 x3) (addE (vn_eparams n) (meet n x2 y3) (meet n y2 (dconj n false x3))) in @pair (vect n) (vect n) (meet n x1 x2) (addE (vn_eparams n) (meet n x1 y2) (meet n y1 (dconj n false x2)))) *)
destruct x; destruct y; destruct z.
(* Goal: @Logic.eq (vect n) (meet n (meet n v v1) v3) (meet n v (meet n v1 v3)) *)
(* Goal: @Logic.eq (vect n) (addE (vn_eparams n) (meet n (meet n v v1) v4) (meet n (addE (vn_eparams n) (meet n v v2) (meet n v0 (dconj n false v1))) (dconj n false v3))) (addE (vn_eparams n) (meet n v (addE (vn_eparams n) (meet n v1 v4) (meet n v2 (dconj n false v3)))) (meet n v0 (dconj n false (meet n v1 v3)))) *)
apply f_equal2 with (f := @pair _ _); rewrite IH; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite !addE_assoc; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply f_equal2 with (f := add n); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite dconj_add, IH, addE_com,!addE_assoc; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply f_equal2 with (f := add n); auto.
(* Goal: @Logic.eq (vect n) (addE (vn_eparams n) (meet n v4 (dconj n false v1)) (meet n v3 v2)) (addE (vn_eparams n) (meet n v3 v2) (meet n v4 (dconj n false v1))) *)
rewrite addE_com; auto.
Qed.

Lemma meet_assoc n (x y z : vect n) : x ∧ y ∧ z = x ∧ (y ∧ z).
Proof.
(* Goal: forall (k1 k2 : nat) (_ : b2Prop (hom n k1 x)) (_ : b2Prop (hom n (S O) y)) (_ : b2Prop (hom n k2 z)), @Logic.eq (vect n) (meet n (join n x y) z) (addE (vn_eparams n) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n (S (Nat.add k1 k2)))) (meet n x (join n y z))) (join n (meet n x z) y)) *)
induction n as [| n IH]; simpl; try Vfold n.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros; rewrite multK_assoc; auto.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (let (x1, y1) := let (x1, y1) := x in let (x2, y2) := y in @pair (vect n) (vect n) (meet n x1 x2) (addE (vn_eparams n) (meet n x1 y2) (meet n y1 (dconj n false x2))) in let (x2, y2) := z in @pair (vect n) (vect n) (meet n x1 x2) (addE (vn_eparams n) (meet n x1 y2) (meet n y1 (dconj n false x2)))) (let (x1, y1) := x in let (x2, y2) := let (x2, y2) := y in let (x3, y3) := z in @pair (vect n) (vect n) (meet n x2 x3) (addE (vn_eparams n) (meet n x2 y3) (meet n y2 (dconj n false x3))) in @pair (vect n) (vect n) (meet n x1 x2) (addE (vn_eparams n) (meet n x1 y2) (meet n y1 (dconj n false x2)))) *)
destruct x; destruct y; destruct z.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
apply f_equal2 with (f := @pair _ _).
(* Goal: @Logic.eq (vect n) (meet n (meet n v v1) v3) (meet n v (meet n v1 v3)) *)
(* Goal: @Logic.eq (vect n) (addE (vn_eparams n) (meet n (meet n v v1) v4) (meet n (addE (vn_eparams n) (meet n v v2) (meet n v0 (dconj n false v1))) (dconj n false v3))) (addE (vn_eparams n) (meet n v (addE (vn_eparams n) (meet n v1 v4) (meet n v2 (dconj n false v3)))) (meet n v0 (dconj n false (meet n v1 v3)))) *)
rewrite IH; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite meet_addr, meet_addl, !addE_assoc; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
repeat apply f_equal2 with (f := add n); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite dconjf_meet, IH; auto.
Qed. 

Lemma meet_alll n (x: vect n) : all n ∧ x = x.
Proof.
(* Goal: forall (k1 k2 : nat) (_ : b2Prop (hom n k1 x)) (_ : b2Prop (hom n (S O) y)) (_ : b2Prop (hom n k2 z)), @Logic.eq (vect n) (meet n (join n x y) z) (addE (vn_eparams n) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n (S (Nat.add k1 k2)))) (meet n x (join n y z))) (join n (meet n x z) y)) *)
induction n as [| n IH]; simpl; try Vfold n.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros; rewrite multK1l; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
destruct x; rewrite !IH, meet0l, addE0r; auto.
Qed.

Lemma meet_allr n (x: vect n) : x ∧ all n = x.
Proof.
(* Goal: forall (k1 k2 : nat) (_ : b2Prop (hom n k1 x)) (_ : b2Prop (hom n (S O) y)) (_ : b2Prop (hom n k2 z)), @Logic.eq (vect n) (meet n (join n x y) z) (addE (vn_eparams n) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n (S (Nat.add k1 k2)))) (meet n x (join n y z))) (join n (meet n x z) y)) *)
induction n as [| n IH]; simpl; try Vfold n.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite multK1r; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
destruct x; rewrite !IH, meet0r, addE0l, dconj_all, IH; auto.
Qed.

(* By duality *)
Lemma meet_small n k1 k2 (x y : vect n) : 
  hom n k1 x -> hom n k2 y -> k1 + k2 < n -> x ∧ y = 0.
Proof.
(* Goal: forall (_ : b2Prop (hom n k1 x)) (_ : b2Prop (hom n (S O) y)) (_ : b2Prop (hom n k2 z)), @Logic.eq (vect n) (meet n (join n x y) z) (addE (vn_eparams n) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n (S (Nat.add k1 k2)))) (meet n x (join n y z))) (join n (meet n x z) y)) *)
generalize k1 k2; clear k1 k2.
(* Goal: forall (k1 k2 : nat) (_ : b2Prop (hom n k1 x)) (_ : b2Prop (hom n (S O) y)) (_ : b2Prop (hom n k2 z)), @Logic.eq (vect n) (meet n (join n x y) z) (addE (vn_eparams n) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n (S (Nat.add k1 k2)))) (meet n x (join n y z))) (join n (meet n x z) y)) *)
induction n as [| n IH]; simpl; try Vfold n.
(* Goal: forall (k1 k2 : nat) (_ : b2Prop match k1 with | O => true | S n => eqK (K1 p) x (v0 (K1 p)) end) (_ : b2Prop match k2 with | O => true | S n => eqK (K1 p) y (v0 (K1 p)) end) (_ : lt (Nat.add k1 k2) O), @Logic.eq (Field.K (K1 p)) (multK (K1 p) x y) (v0 (K1 p)) *)
(* Goal: forall (k1 k2 : nat) (_ : b2Prop (let (l2, l3) := x in andb match k1 with | O => eq0 n l2 | S k3 => hom n k3 l2 end (hom n k1 l3))) (_ : b2Prop (let (l2, l3) := y in andb match k2 with | O => eq0 n l2 | S k3 => hom n k3 l2 end (hom n k2 l3))) (_ : lt (Nat.add k1 k2) (S n)), @Logic.eq (prod (vect n) (vect n)) (let (x1, y1) := x in let (x2, y2) := y in @pair (vect n) (vect n) (meet n x1 x2) (addE (vn_eparams n) (meet n x1 y2) (meet n y1 (dconj n false x2)))) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (E0 (vn_eparams n))) *)
intros k1 k2 _ _ HH; contradict HH; auto with arith.
(* Goal: forall (k1 k2 : nat) (_ : b2Prop (let (l2, l3) := x in andb match k1 with | O => eq0 n l2 | S k3 => hom n k3 l2 end (hom n k1 l3))) (_ : b2Prop (let (l2, l3) := y in andb match k2 with | O => eq0 n l2 | S k3 => hom n k3 l2 end (hom n k2 l3))) (_ : @Logic.eq nat (S n) (Nat.add k1 k2)), @Logic.eq (prod (vect n) (vect n)) (let (x1, y1) := x in let (x2, y2) := y in @pair (vect n) (vect n) (meet n x1 x2) (addE (vn_eparams n) (meet n x1 y2) (meet n y1 (dconj n false x2)))) (@pair (vect n) (vect n) (scalE (vn_eparams n) (let (_, l2) := let (x, y) := let (x1, x2) := x in let (y1, y2) := y in @pair (vect n) (vect n) (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) (join n x2 y2) in @pair (vect n) (vect n) (dual n (conj n false y)) (dual n x) in const n l2) (E0 (vn_eparams n))) (scalE (vn_eparams n) (let (_, l2) := let (x, y) := let (x1, x2) := x in let (y1, y2) := y in @pair (vect n) (vect n) (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) (join n x2 y2) in @pair (vect n) (vect n) (dual n (conj n false y)) (dual n x) in const n l2) (genk n (v1 (K1 p))))) *)
intros [|k1] [|k2]; destruct x as [x1 x2]; destruct y as [y1 y2].
(* Goal: b2Prop false *)
case eq0_spec; auto; intros HH Hx2; subst; try discriminate.
(* Goal: b2Prop false *)
case eq0_spec; auto; intros HH Hy; subst; try discriminate.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n (E0 (vn_eparams n)) y2) (join n (genk n (const n x2)) (genk n (const n y1)))) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n (E0 (vn_eparams n)) y2) (join n (genk n (const n x2)) (genk n (const n y1)))) z2) (addE (vn_eparams n) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n (S (Nat.add O k2)))) (meet n (genk n (const n x2)) (join n y2 (dconj n false z1)))) (join n (meet n (genk n (const n x2)) (dconj n false z1)) y2)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add O (S k2)))))) (meet n (E0 (vn_eparams n)) (addE (vn_eparams n) (join n (genk n (const n y1)) z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n (E0 (vn_eparams n)) z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) z2) (meet n (genk n (const n x2)) (dconj n false z1)))) (genk n (const n y1))))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add O (S k2)))))) (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) (join n y2 z2)) (meet n (genk n (const n x2)) (dconj n false (addE (vn_eparams n) (join n (genk n (const n y1)) z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) z2) (meet n (genk n (const n x2)) (dconj n false z1))) y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (eq0 n z1) (hom n O z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (hom n k2 z1) (hom n (S k2) z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
Grm0.
(* Goal: b2Prop false *)
case eq0_spec; auto; intros HH Hx2; subst; try discriminate.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n (E0 (vn_eparams n)) y2) (join n (genk n (const n x2)) (genk n (const n y1)))) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n (E0 (vn_eparams n)) y2) (join n (genk n (const n x2)) (genk n (const n y1)))) z2) (addE (vn_eparams n) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n (S (Nat.add O k2)))) (meet n (genk n (const n x2)) (join n y2 (dconj n false z1)))) (join n (meet n (genk n (const n x2)) (dconj n false z1)) y2)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add O (S k2)))))) (meet n (E0 (vn_eparams n)) (addE (vn_eparams n) (join n (genk n (const n y1)) z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n (E0 (vn_eparams n)) z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) z2) (meet n (genk n (const n x2)) (dconj n false z1)))) (genk n (const n y1))))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add O (S k2)))))) (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) (join n y2 z2)) (meet n (genk n (const n x2)) (dconj n false (addE (vn_eparams n) (join n (genk n (const n y1)) z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) z2) (meet n (genk n (const n x2)) (dconj n false z1))) y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (eq0 n z1) (hom n O z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (hom n k2 z1) (hom n (S k2) z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
rewrite andbP; intros (Hy1,Hy2) H; rewrite (IH x2 _ 0%nat k2); Grm0.
(* Goal: lt (Nat.add O k2) n *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (eq0 n y1) (hom n O y2))) (_ : lt (Nat.add (S k1) O) (S n)), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n x1 y1) (addE (vn_eparams n) (meet n x1 y2) (meet n x2 (dconj n false y1)))) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (E0 (vn_eparams n))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n k2 y1) (hom n (S k2) y2))) (_ : lt (Nat.add (S k1) (S k2)) (S n)), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n x1 y1) (addE (vn_eparams n) (meet n x1 y2) (meet n x2 (dconj n false y1)))) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (E0 (vn_eparams n))) *)
auto with arith.
(* Goal: forall _ : b2Prop (andb (hom n O x1) (hom n (S O) x2)), @ex (prod (Field.K (K p)) (kn p n)) (fun y : prod (Field.K (K p)) (kn p n) => @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) x1 x2) (let (k, v1) := y in @pair (vect n) (vect n) (genk n k) (k2g n v1))) *)
rewrite andbP; intros (Hx1,Hx2).
(* Goal: b2Prop false *)
case eq0_spec; auto; intros HH Hy2 H; subst; try discriminate.
(* Goal: lt (Nat.add O k2) n *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (eq0 n y1) (hom n O y2))) (_ : lt (Nat.add (S k1) O) (S n)), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n x1 y1) (addE (vn_eparams n) (meet n x1 y2) (meet n x2 (dconj n false y1)))) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (E0 (vn_eparams n))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n k2 y1) (hom n (S k2) y2))) (_ : lt (Nat.add (S k1) (S k2)) (S n)), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n x1 y1) (addE (vn_eparams n) (meet n x1 y2) (meet n x2 (dconj n false y1)))) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (E0 (vn_eparams n))) *)
rewrite (IH x1 y2 k1 0%nat); Grm0; auto with arith.
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n k2 y1) (hom n (S k2) y2))) (_ : lt (Nat.add (S k1) (S k2)) (S n)), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n x1 y1) (addE (vn_eparams n) (meet n x1 y2) (meet n x2 (dconj n false y1)))) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (E0 (vn_eparams n))) *)
rewrite !andbP; intros (Hx1,Hx2) (Hy1,H2) H.
rewrite (IH _ _ k1 k2), (IH _ _ k1 k2.+1), (IH _ _ k1.+1 k2); 
(* Goal: lt (Nat.add O k2) n *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (eq0 n y1) (hom n O y2))) (_ : lt (Nat.add (S k1) O) (S n)), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n x1 y1) (addE (vn_eparams n) (meet n x1 y2) (meet n x2 (dconj n false y1)))) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (E0 (vn_eparams n))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n k2 y1) (hom n (S k2) y2))) (_ : lt (Nat.add (S k1) (S k2)) (S n)), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n x1 y1) (addE (vn_eparams n) (meet n x1 y2) (meet n x2 (dconj n false y1)))) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (E0 (vn_eparams n))) *)
      Grm0; auto with arith.
(* Goal: lt (Nat.add O k2) n *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (eq0 n y1) (hom n O y2))) (_ : lt (Nat.add (S k1) O) (S n)), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n x1 y1) (addE (vn_eparams n) (meet n x1 y2) (meet n x2 (dconj n false y1)))) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (E0 (vn_eparams n))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n k2 y1) (hom n (S k2) y2))) (_ : lt (Nat.add (S k1) (S k2)) (S n)), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n x1 y1) (addE (vn_eparams n) (meet n x1 y2) (meet n x2 (dconj n false y1)))) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (E0 (vn_eparams n))) *)
rewrite <-plus_n_Sm in H; auto with arith.
(* Goal: lt (Nat.add O k2) n *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (eq0 n y1) (hom n O y2))) (_ : lt (Nat.add (S k1) O) (S n)), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n x1 y1) (addE (vn_eparams n) (meet n x1 y2) (meet n x2 (dconj n false y1)))) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (E0 (vn_eparams n))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n k2 y1) (hom n (S k2) y2))) (_ : lt (Nat.add (S k1) (S k2)) (S n)), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n x1 y1) (addE (vn_eparams n) (meet n x1 y2) (meet n x2 (dconj n false y1)))) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (E0 (vn_eparams n))) *)
apply Lt.lt_trans with (k1 + k2).+1; auto with arith.
(* Goal: lt (Nat.add O k2) n *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (eq0 n y1) (hom n O y2))) (_ : lt (Nat.add (S k1) O) (S n)), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n x1 y1) (addE (vn_eparams n) (meet n x1 y2) (meet n x2 (dconj n false y1)))) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (E0 (vn_eparams n))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n k2 y1) (hom n (S k2) y2))) (_ : lt (Nat.add (S k1) (S k2)) (S n)), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n x1 y1) (addE (vn_eparams n) (meet n x1 y2) (meet n x2 (dconj n false y1)))) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (E0 (vn_eparams n))) *)
rewrite <-plus_n_Sm in H; auto with arith.
Qed.

(* By duality *)
Lemma meet_hom n k1 k2 (x y : vect n) : 
  hom n k1 x -> hom n k2 y -> hom n (k1 + k2 - n) (x ∧ y).
Proof.
intros Hx Hy.
case (Lt.le_or_lt k1 n); intros Hk1.
(* Goal: b2Prop (andb true (hom n (S O) (genk n (v0 (K1 p))))) *)
(* Goal: b2Prop (andb true (hom n (S O) (gen n k))) *)
2: rewrite hom_lt with (1 := Hk1)(2:= Hx); Grm0; apply homk0.
case (Lt.le_or_lt k2 n); intros Hk2.
(* Goal: b2Prop (andb true (hom n (S O) (genk n (v0 (K1 p))))) *)
(* Goal: b2Prop (andb true (hom n (S O) (gen n k))) *)
2: rewrite hom_lt with (1 := Hk2)(2:= Hy); Grm0; apply homk0.
case (Lt.le_or_lt n (k1 + k2)); intros Hk1k2.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n (E0 (vn_eparams n)) y2) (join n (genk n (const n x2)) (genk n (const n y1)))) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n (E0 (vn_eparams n)) y2) (join n (genk n (const n x2)) (genk n (const n y1)))) z2) (addE (vn_eparams n) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n (S (Nat.add O k2)))) (meet n (genk n (const n x2)) (join n y2 (dconj n false z1)))) (join n (meet n (genk n (const n x2)) (dconj n false z1)) y2)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add O (S k2)))))) (meet n (E0 (vn_eparams n)) (addE (vn_eparams n) (join n (genk n (const n y1)) z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n (E0 (vn_eparams n)) z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) z2) (meet n (genk n (const n x2)) (dconj n false z1)))) (genk n (const n y1))))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add O (S k2)))))) (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) (join n y2 z2)) (meet n (genk n (const n x2)) (dconj n false (addE (vn_eparams n) (join n (genk n (const n y1)) z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) z2) (meet n (genk n (const n x2)) (dconj n false z1))) y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (eq0 n z1) (hom n O z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (hom n k2 z1) (hom n (S k2) z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
2: rewrite meet_small with (1 := Hx)(2:= Hy); Grm0.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
replace (k1 + k2 - n)%nat with (n - ((n - k1) + (n - k2)))%nat; auto.
rewrite dual_invoE with (1 := Hx), dual_invoE with (1 := Hy).
rewrite meet_scall, meet_scalr, <-dual_join; auto 10.
rewrite Minus.minus_plus_simpl_l_reverse with (p := (k1 + k2)%nat).
rewrite (Plus.plus_comm k1), <-!Plus.plus_assoc, (Plus.plus_assoc k1).
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite <-Minus.le_plus_minus, !Plus.plus_assoc; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite !(Plus.plus_comm k2), <-!Plus.plus_assoc, <-Minus.le_plus_minus; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite Plus.plus_assoc, (Plus.plus_comm (k1 + k2)); auto. 
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite <-Minus.minus_plus_simpl_l_reverse; auto.
Qed.

Hint Resolve meet_hom.

Lemma meetkl0 n k1 k2 x : hom n k1 x -> n <> k1 -> [k2] ∧ x = 0.
Proof.
(* Goal: forall (_ : b2Prop (hom n k1 x)) (_ : not (@Logic.eq nat n k1)), @Logic.eq (vect n) (meet n x (genk n k2)) (E0 (vn_eparams n)) *)
intros H1 H2.
(* Goal: @Logic.eq (vect n) (meet n x (genk n k2)) (E0 (vn_eparams n)) *)
case (Lt.le_or_lt k1 n); intros H3.
(* Goal: @Logic.eq (vect n) (meet n x (genk n k2)) (E0 (vn_eparams n)) *)
(* Goal: @Logic.eq (vect n) (meet n x (genk n k2)) (E0 (vn_eparams n)) *)
case (Lt.le_lt_or_eq _ _ H3); intros H4.
(* Goal: @Logic.eq (vect n) (meet n (genk n k2) x) (E0 (vn_eparams n)) *)
(* Goal: @Logic.eq (vect n) (meet n (genk n k2) x) (E0 (vn_eparams n)) *)
(* Goal: @Logic.eq (vect n) (meet n (genk n k2) x) (E0 (vn_eparams n)) *)
apply meet_small with (k1 := 0%nat) (k2 := k1); auto; apply hom0K.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
case H2; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite hom_lt with (2 := H1); auto; rewrite meet0r; auto.
Qed.

Lemma meetkl n k x : hom n n x -> [k] ∧ x = [k * 'dC[x]].
Proof.
(* Goal: forall _ : @Logic.eq (vect n) (E0 (vn_eparams n)) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (S (Nat.add n (S k2)))) (join n x (meet n y z))), @Logic.eq (vect n) (join n x (meet n y z)) (E0 (vn_eparams n)) *)
intros H.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
pattern x at 1; rewrite (homn_all _ _ H); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite meet_scalr, meet_allr, scalk, multK_com; auto.
Qed.

Lemma meetkr0 n k1 k2 x : hom n k1 x -> n <> k1 -> x ∧ [k2] = 0.
Proof.
(* Goal: forall (_ : b2Prop (hom n k1 x)) (_ : not (@Logic.eq nat n k1)), @Logic.eq (vect n) (meet n x (genk n k2)) (E0 (vn_eparams n)) *)
intros H1 H2.
(* Goal: @Logic.eq (vect n) (meet n x (genk n k2)) (E0 (vn_eparams n)) *)
case (Lt.le_or_lt k1 n); intros H3.
(* Goal: @Logic.eq (vect n) (meet n x (genk n k2)) (E0 (vn_eparams n)) *)
(* Goal: @Logic.eq (vect n) (meet n x (genk n k2)) (E0 (vn_eparams n)) *)
case (Lt.le_lt_or_eq _ _ H3); intros H4.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply meet_small with (k1 := k1) (k2 := 0%nat); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite Plus.plus_0_r; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
case H2; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite hom_lt with (2 := H1); auto; rewrite meet0l; auto.
Qed.

Lemma meetkr n k x : hom n n x -> x ∧ [k] = ['dC[x] * k].
Proof.
(* Goal: forall _ : @Logic.eq (vect n) (E0 (vn_eparams n)) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (S (Nat.add n (S k2)))) (join n x (meet n y z))), @Logic.eq (vect n) (join n x (meet n y z)) (E0 (vn_eparams n)) *)
intros H.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
pattern x at 1; rewrite (homn_all _ _ H); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite meet_scall, meet_alll, scalk; auto.
Qed.


Lemma meet_hom_com n k1 k2 (x y : vect n) :
  hom n k1 x ->
  hom n k2 y -> y ∧ x = ((- (1))^((n + k1) * (n + k2))).* (x ∧ y).
Proof.
intros Hx Hy.
case (Lt.le_or_lt k1 n); intros Hk1.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n (E0 (vn_eparams n)) y2) (join n (genk n (const n x2)) (genk n (const n y1)))) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n (E0 (vn_eparams n)) y2) (join n (genk n (const n x2)) (genk n (const n y1)))) z2) (addE (vn_eparams n) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n (S (Nat.add O k2)))) (meet n (genk n (const n x2)) (join n y2 (dconj n false z1)))) (join n (meet n (genk n (const n x2)) (dconj n false z1)) y2)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add O (S k2)))))) (meet n (E0 (vn_eparams n)) (addE (vn_eparams n) (join n (genk n (const n y1)) z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n (E0 (vn_eparams n)) z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) z2) (meet n (genk n (const n x2)) (dconj n false z1)))) (genk n (const n y1))))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add O (S k2)))))) (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) (join n y2 z2)) (meet n (genk n (const n x2)) (dconj n false (addE (vn_eparams n) (join n (genk n (const n y1)) z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) z2) (meet n (genk n (const n x2)) (dconj n false z1))) y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (eq0 n z1) (hom n O z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (hom n k2 z1) (hom n (S k2) z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
2: rewrite hom_lt with (2 := Hx), meet0l, meet0r; Grm0.
case (Lt.le_or_lt k2 n); intros Hk2.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n (E0 (vn_eparams n)) y2) (join n (genk n (const n x2)) (genk n (const n y1)))) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n (E0 (vn_eparams n)) y2) (join n (genk n (const n x2)) (genk n (const n y1)))) z2) (addE (vn_eparams n) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n (S (Nat.add O k2)))) (meet n (genk n (const n x2)) (join n y2 (dconj n false z1)))) (join n (meet n (genk n (const n x2)) (dconj n false z1)) y2)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add O (S k2)))))) (meet n (E0 (vn_eparams n)) (addE (vn_eparams n) (join n (genk n (const n y1)) z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n (E0 (vn_eparams n)) z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) z2) (meet n (genk n (const n x2)) (dconj n false z1)))) (genk n (const n y1))))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add O (S k2)))))) (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) (join n y2 z2)) (meet n (genk n (const n x2)) (dconj n false (addE (vn_eparams n) (join n (genk n (const n y1)) z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) z2) (meet n (genk n (const n x2)) (dconj n false z1))) y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (eq0 n z1) (hom n O z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (hom n k2 z1) (hom n (S k2) z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
2: rewrite hom_lt with (2 := Hy), meet0r, meet0l; Grm0.
(* Goal: @Logic.eq (vect n) (meet n x x) (E0 (vn_eparams n)) *)
assert (Hdx := dual_hom _ _ _ Hx).
assert (Hdy := dual_hom _ _ _ Hy).
assert (Hxy := meet_hom _ _ _ _ _ Hx Hy).
assert (Hyx := meet_hom _ _ _ _ _ Hy Hx).
rewrite (dual_invoE _ _ _ Hyx), dual_meet, (join_hom_com _ _ _ _ _ Hdx Hdy),
        dual_scal, <-dual_meet, (dual_invo _ _ _ Hxy).
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite <-!scal_multE, <-!expK_add, (Plus.plus_comm k2); auto.
replace ((k1 + k2 - n) * n.+1 + (n - k1) * (n - k2) + (k1 + k2 - n) * n.+1)%nat
  with (2 * ((k1 + k2 - n) * n.+1) + (n - k1) * (n - k2))%nat by ring.
replace ((n + k1) * (n + k2)) with 
        (2 * (2 * k1 *k2 + k1 * (n - k2) + k2 * (n - k1)) + (n - k1) * (n - k2))%nat.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite !expKm1_2E; auto.
pattern n at 5; rewrite (Minus.le_plus_minus _ _ Hk1).
pattern n at 6; rewrite (Minus.le_plus_minus _ _ Hk2); ring.
Qed.

Lemma meet_hom_id n k x : hom n k x -> odd (n - k) ->  x ∧ x = 0.
Proof.
(* Goal: forall (_ : b2Prop (hom n k x)) (_ : odd (Nat.sub n k)), @Logic.eq (vect n) (meet n x x) (E0 (vn_eparams n)) *)
intros Hx Ho.
(* Goal: @Logic.eq (vect n) (meet n x x) (E0 (vn_eparams n)) *)
assert (Hdx := dual_hom _ _ _ Hx).
(* Goal: @Logic.eq (vect n) (meet n x x) (E0 (vn_eparams n)) *)
assert (Hxx := meet_hom _ _ _ _ _ Hx Hx).
(* Goal: @Logic.eq (vect n) (meet n x x) (E0 (vn_eparams n)) *)
rewrite (dual_invoE _ _ _ Hxx), dual_meet.
(* Goal: @Logic.eq (vect n) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.mul (Nat.sub (Nat.add k k) n) (S n))) (dual n (join n (dual n x) (dual n x)))) (E0 (vn_eparams n)) *)
rewrite (join_hom_id _ _ _ Hdx), dual0; Vrm0.
Qed.

Lemma dual_join_compl n k v :
  In v (base n k) -> (v ∨ '@v = all n) \/ v ∨ '@v = (-(1)) .*  all n.
Proof.
(* Goal: forall _ : @In (vect n) v (base n k), or (@Logic.eq (vect n) (join n v (dual n v)) (all n)) (@Logic.eq (vect n) (join n v (dual n v)) (scalE (vn_eparams n) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (all n))) *)
generalize k; clear k.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (dual n (conj n false (genk n k))) (dual n (genk n (v0 (K1 p))))) (@pair (vect n) (vect n) (scal n k (all n)) (scal n k (genk n (v0 (K1 p))))) *)
induction n as [|n IH]; simpl; try Vfold n.
(* Goal: forall (k : nat) (_ : @In (Field.K (K1 p)) v match k with | O => @cons (Field.K (K1 p)) (v1 (K1 p)) (@nil (Field.K (K1 p))) | S n => @nil (Field.K (K1 p)) end), or (@Logic.eq (Field.K (K1 p)) (multK (K1 p) v v) (v1 (K1 p))) (@Logic.eq (Field.K (K1 p)) (multK (K1 p) v v) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (v1 (K1 p)))) *)
(* Goal: forall (k : nat) (_ : @In (prod (vect n) (vect n)) v match k with | O => @map (vect n) (prod (vect n) (vect n)) (lift n) (base n k) | S k1 => @app (prod (vect n) (vect n)) (@map (vect n) (prod (vect n) (vect n)) (dlift n) (base n k1)) (@map (vect n) (prod (vect n) (vect n)) (lift n) (base n k)) end), or (@Logic.eq (prod (vect n) (vect n)) (let (x1, x2) := v in let (y1, y2) := let (x, y) := v in @pair (vect n) (vect n) (dual n (conj n false y)) (dual n x) in @pair (vect n) (vect n) (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) (join n x2 y2)) (@pair (vect n) (vect n) (all n) (E0 (vn_eparams n)))) (@Logic.eq (prod (vect n) (vect n)) (let (x1, x2) := v in let (y1, y2) := let (x, y) := v in @pair (vect n) (vect n) (dual n (conj n false y)) (dual n x) in @pair (vect n) (vect n) (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) (join n x2 y2)) (@pair (vect n) (vect n) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (all n)) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (E0 (vn_eparams n))))) *)
intros [|k]; simpl.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros [[]|[]]; rewrite multK1r; auto.
(* Goal: forall _ : False, or (@Logic.eq (Field.K (K1 p)) (multK (K1 p) v v) (v1 (K1 p))) (@Logic.eq (Field.K (K1 p)) (multK (K1 p) v v) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (v1 (K1 p)))) *)
(* Goal: forall (k : nat) (_ : @In (prod (vect n) (vect n)) v match k with | O => @map (vect n) (prod (vect n) (vect n)) (lift n) (base n k) | S k1 => @app (prod (vect n) (vect n)) (@map (vect n) (prod (vect n) (vect n)) (dlift n) (base n k1)) (@map (vect n) (prod (vect n) (vect n)) (lift n) (base n k)) end), or (@Logic.eq (prod (vect n) (vect n)) (let (x1, x2) := v in let (y1, y2) := let (x, y) := v in @pair (vect n) (vect n) (dual n (conj n false y)) (dual n x) in @pair (vect n) (vect n) (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) (join n x2 y2)) (@pair (vect n) (vect n) (all n) (E0 (vn_eparams n)))) (@Logic.eq (prod (vect n) (vect n)) (let (x1, x2) := v in let (y1, y2) := let (x, y) := v in @pair (vect n) (vect n) (dual n (conj n false y)) (dual n x) in @pair (vect n) (vect n) (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) (join n x2 y2)) (@pair (vect n) (vect n) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (all n)) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (E0 (vn_eparams n))))) *)
intros [].
(* Goal: forall (k : nat) (_ : @In (prod (vect n) (vect n)) v match k with | O => @map (vect n) (prod (vect n) (vect n)) (lift n) (base n k) | S k1 => @app (prod (vect n) (vect n)) (@map (vect n) (prod (vect n) (vect n)) (dlift n) (base n k1)) (@map (vect n) (prod (vect n) (vect n)) (lift n) (base n k)) end), or (@Logic.eq (prod (vect n) (vect n)) (let (x1, x2) := v in let (y1, y2) := let (x, y) := v in @pair (vect n) (vect n) (dual n (conj n false y)) (dual n x) in @pair (vect n) (vect n) (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) (join n x2 y2)) (@pair (vect n) (vect n) (all n) (E0 (vn_eparams n)))) (@Logic.eq (prod (vect n) (vect n)) (let (x1, x2) := v in let (y1, y2) := let (x, y) := v in @pair (vect n) (vect n) (dual n (conj n false y)) (dual n x) in @pair (vect n) (vect n) (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) (join n x2 y2)) (@pair (vect n) (vect n) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (all n)) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (E0 (vn_eparams n))))) *)
intros [|k]; destruct v as [x y]; simpl dual.
(* Goal: forall _ : @In (prod (vect n) (vect n)) (@pair (vect n) (vect n) x y) (@map (vect n) (prod (vect n) (vect n)) (lift n) (base n O)), or (@Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (addE (vn_eparams n) (join n x (dual n x)) (join n (conj n false y) (dual n (conj n false y)))) (join n y (dual n x))) (@pair (vect n) (vect n) (all n) (E0 (vn_eparams n)))) (@Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (addE (vn_eparams n) (join n x (dual n x)) (join n (conj n false y) (dual n (conj n false y)))) (join n y (dual n x))) (@pair (vect n) (vect n) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (all n)) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (E0 (vn_eparams n))))) *)
(* Goal: forall _ : @In (prod (vect n) (vect n)) (@pair (vect n) (vect n) x y) (@app (prod (vect n) (vect n)) (@map (vect n) (prod (vect n) (vect n)) (dlift n) (base n k)) (@map (vect n) (prod (vect n) (vect n)) (lift n) (base n (S k)))), or (@Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (addE (vn_eparams n) (join n x (dual n x)) (join n (conj n false y) (dual n (conj n false y)))) (join n y (dual n x))) (@pair (vect n) (vect n) (all n) (E0 (vn_eparams n)))) (@Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (addE (vn_eparams n) (join n x (dual n x)) (join n (conj n false y) (dual n (conj n false y)))) (join n y (dual n x))) (@pair (vect n) (vect n) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (all n)) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (E0 (vn_eparams n))))) *)
rewrite in_map_iff; intros [z (H1z,H2z)].
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n (E0 (vn_eparams n)) y2) (join n (genk n (const n x2)) (genk n (const n y1)))) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n (E0 (vn_eparams n)) y2) (join n (genk n (const n x2)) (genk n (const n y1)))) z2) (addE (vn_eparams n) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n (S (Nat.add O k2)))) (meet n (genk n (const n x2)) (join n y2 (dconj n false z1)))) (join n (meet n (genk n (const n x2)) (dconj n false z1)) y2)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add O (S k2)))))) (meet n (E0 (vn_eparams n)) (addE (vn_eparams n) (join n (genk n (const n y1)) z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n (E0 (vn_eparams n)) z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) z2) (meet n (genk n (const n x2)) (dconj n false z1)))) (genk n (const n y1))))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add O (S k2)))))) (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) (join n y2 z2)) (meet n (genk n (const n x2)) (dconj n false (addE (vn_eparams n) (join n (genk n (const n y1)) z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) z2) (meet n (genk n (const n x2)) (dconj n false z1))) y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (eq0 n z1) (hom n O z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (hom n k2 z1) (hom n (S k2) z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
injection H1z; intros; subst; rewrite dual0; Grm0.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n (E0 (vn_eparams n)) y2) (join n (genk n (const n x2)) (genk n (const n y1)))) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n (E0 (vn_eparams n)) y2) (join n (genk n (const n x2)) (genk n (const n y1)))) z2) (addE (vn_eparams n) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n (S (Nat.add O k2)))) (meet n (genk n (const n x2)) (join n y2 (dconj n false z1)))) (join n (meet n (genk n (const n x2)) (dconj n false z1)) y2)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add O (S k2)))))) (meet n (E0 (vn_eparams n)) (addE (vn_eparams n) (join n (genk n (const n y1)) z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n (E0 (vn_eparams n)) z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) z2) (meet n (genk n (const n x2)) (dconj n false z1)))) (genk n (const n y1))))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add O (S k2)))))) (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) (join n y2 z2)) (meet n (genk n (const n x2)) (dconj n false (addE (vn_eparams n) (join n (genk n (const n y1)) z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) z2) (meet n (genk n (const n x2)) (dconj n false z1))) y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (eq0 n z1) (hom n O z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (hom n k2 z1) (hom n (S k2) z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
rewrite (conjf_hom n 0), scalE1; simpl; Vfold n; Grm0.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
  case (IH y 0%nat); auto; intros Hu; rewrite Hu; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite <-cblk_homk_equiv; constructor; auto.
(* Goal: forall _ : @In (prod (vect n) (vect n)) (@pair (vect n) (vect n) x y) (@map (vect n) (prod (vect n) (vect n)) (lift n) (base n O)), or (@Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (addE (vn_eparams n) (join n x (dual n x)) (join n (conj n false y) (dual n (conj n false y)))) (join n y (dual n x))) (@pair (vect n) (vect n) (all n) (E0 (vn_eparams n)))) (@Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (addE (vn_eparams n) (join n x (dual n x)) (join n (conj n false y) (dual n (conj n false y)))) (join n y (dual n x))) (@pair (vect n) (vect n) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (all n)) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (E0 (vn_eparams n))))) *)
(* Goal: forall _ : @In (prod (vect n) (vect n)) (@pair (vect n) (vect n) x y) (@app (prod (vect n) (vect n)) (@map (vect n) (prod (vect n) (vect n)) (dlift n) (base n k)) (@map (vect n) (prod (vect n) (vect n)) (lift n) (base n (S k)))), or (@Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (addE (vn_eparams n) (join n x (dual n x)) (join n (conj n false y) (dual n (conj n false y)))) (join n y (dual n x))) (@pair (vect n) (vect n) (all n) (E0 (vn_eparams n)))) (@Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (addE (vn_eparams n) (join n x (dual n x)) (join n (conj n false y) (dual n (conj n false y)))) (join n y (dual n x))) (@pair (vect n) (vect n) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (all n)) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (E0 (vn_eparams n))))) *)
intros H1; case (in_app_or _ _ _ H1); rewrite in_map_iff; intros [z (H1z,H2z)].
(* Goal: or (@Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (addE (vn_eparams n) (join n x (dual n x)) (join n (conj n false y) (dual n (conj n false y)))) (join n y (dual n x))) (@pair (vect n) (vect n) (all n) (E0 (vn_eparams n)))) (@Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (addE (vn_eparams n) (join n x (dual n x)) (join n (conj n false y) (dual n (conj n false y)))) (join n y (dual n x))) (@pair (vect n) (vect n) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (all n)) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (E0 (vn_eparams n))))) *)
(* Goal: or (@Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (addE (vn_eparams n) (join n x (dual n x)) (join n (conj n false y) (dual n (conj n false y)))) (join n y (dual n x))) (@pair (vect n) (vect n) (all n) (E0 (vn_eparams n)))) (@Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (addE (vn_eparams n) (join n x (dual n x)) (join n (conj n false y) (dual n (conj n false y)))) (join n y (dual n x))) (@pair (vect n) (vect n) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (all n)) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (E0 (vn_eparams n))))) *)
injection H1z; intros; subst.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n (E0 (vn_eparams n)) y2) (join n (genk n (const n x2)) (genk n (const n y1)))) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n (E0 (vn_eparams n)) y2) (join n (genk n (const n x2)) (genk n (const n y1)))) z2) (addE (vn_eparams n) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n (S (Nat.add O k2)))) (meet n (genk n (const n x2)) (join n y2 (dconj n false z1)))) (join n (meet n (genk n (const n x2)) (dconj n false z1)) y2)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add O (S k2)))))) (meet n (E0 (vn_eparams n)) (addE (vn_eparams n) (join n (genk n (const n y1)) z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n (E0 (vn_eparams n)) z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) z2) (meet n (genk n (const n x2)) (dconj n false z1)))) (genk n (const n y1))))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add O (S k2)))))) (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) (join n y2 z2)) (meet n (genk n (const n x2)) (dconj n false (addE (vn_eparams n) (join n (genk n (const n y1)) z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) z2) (meet n (genk n (const n x2)) (dconj n false z1))) y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (eq0 n z1) (hom n O z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (hom n k2 z1) (hom n (S k2) z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
  rewrite conj0, dual0; Grm0.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
  case (IH x k); auto; intros Hx; rewrite Hx; auto.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n (E0 (vn_eparams n)) y2) (join n (genk n (const n x2)) (genk n (const n y1)))) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n (E0 (vn_eparams n)) y2) (join n (genk n (const n x2)) (genk n (const n y1)))) z2) (addE (vn_eparams n) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n (S (Nat.add O k2)))) (meet n (genk n (const n x2)) (join n y2 (dconj n false z1)))) (join n (meet n (genk n (const n x2)) (dconj n false z1)) y2)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add O (S k2)))))) (meet n (E0 (vn_eparams n)) (addE (vn_eparams n) (join n (genk n (const n y1)) z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n (E0 (vn_eparams n)) z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) z2) (meet n (genk n (const n x2)) (dconj n false z1)))) (genk n (const n y1))))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add O (S k2)))))) (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) (join n y2 z2)) (meet n (genk n (const n x2)) (dconj n false (addE (vn_eparams n) (join n (genk n (const n y1)) z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) z2) (meet n (genk n (const n x2)) (dconj n false z1))) y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (eq0 n z1) (hom n O z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (hom n k2 z1) (hom n (S k2) z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
injection H1z; intros; subst; rewrite dual0; Grm0.
(* Goal: or (@Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (join n (conj n false y) (dual n (conj n false y))) (E0 (vn_eparams n))) (@pair (vect n) (vect n) (all n) (E0 (vn_eparams n)))) (@Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (join n (conj n false y) (dual n (conj n false y))) (E0 (vn_eparams n))) (@pair (vect n) (vect n) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (all n)) (E0 (vn_eparams n)))) *)
rewrite conjf_hom with (k := S k).
(* Goal: or (@Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (join n (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (S k)) y) (dual n (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (S k)) y))) (E0 (vn_eparams n))) (@pair (vect n) (vect n) (all n) (E0 (vn_eparams n)))) (@Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (join n (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (S k)) y) (dual n (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (S k)) y))) (E0 (vn_eparams n))) (@pair (vect n) (vect n) (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (all n)) (E0 (vn_eparams n)))) *)
(* Goal: b2Prop (hom n (S k) y) *)
case (even_or_odd k.+1); intros He.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite expKm1_even, scalE1; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
case (IH y k.+1); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
 intros Hy; rewrite Hy; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros H; rewrite H; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite expKm1_odd, join_scall; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite dual_scal, join_scalr, <-scal_multE; Krm1; rewrite scalE1; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
case (IH y k.+1); auto; intros Hy; rewrite Hy; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite <-cblk_homk_equiv; constructor; auto.
Qed.

Lemma join01E n x y : hom n 1 x -> hom n 1 y -> 
   x ∨ y = 0 -> exists k, x = k .* y \/ y = k .* x.
Proof.
(* Goal: forall (_ : b2Prop (hom n (S O) x)) (_ : b2Prop (hom n (S O) y)) (_ : @Logic.eq (vect n) (join n x y) (E0 (vn_eparams n))), @ex (Field.K (stype (vn_eparams n))) (fun k : Field.K (stype (vn_eparams n)) => or (@Logic.eq (vect n) x (scalE (vn_eparams n) k y)) (@Logic.eq (vect n) y (scalE (vn_eparams n) k x))) *)
intros H1 H2 H3.
(* Goal: @ex (Field.K (stype (vn_eparams n))) (fun k : Field.K (stype (vn_eparams n)) => or (@Logic.eq (vect n) x (scalE (vn_eparams n) k y)) (@Logic.eq (vect n) y (scalE (vn_eparams n) k x))) *)
case (eqE_spec _ (fn n) y 0); intros Hy; subst.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n (E0 (vn_eparams n)) y2) (join n (genk n (const n x2)) (genk n (const n y1)))) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n (E0 (vn_eparams n)) y2) (join n (genk n (const n x2)) (genk n (const n y1)))) z2) (addE (vn_eparams n) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n (S (Nat.add O k2)))) (meet n (genk n (const n x2)) (join n y2 (dconj n false z1)))) (join n (meet n (genk n (const n x2)) (dconj n false z1)) y2)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add O (S k2)))))) (meet n (E0 (vn_eparams n)) (addE (vn_eparams n) (join n (genk n (const n y1)) z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n (E0 (vn_eparams n)) z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) z2) (meet n (genk n (const n x2)) (dconj n false z1)))) (genk n (const n y1))))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add O (S k2)))))) (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) (join n y2 z2)) (meet n (genk n (const n x2)) (dconj n false (addE (vn_eparams n) (join n (genk n (const n y1)) z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) z2) (meet n (genk n (const n x2)) (dconj n false z1))) y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (eq0 n z1) (hom n O z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (hom n k2 z1) (hom n (S k2) z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
exists 0%f; Grm0.
(* Goal: @ex (Field.K (stype (vn_eparams n))) (fun k : Field.K (stype (vn_eparams n)) => or (@Logic.eq (vect n) x (scalE (vn_eparams n) k y)) (@Logic.eq (vect n) y (scalE (vn_eparams n) k x))) *)
rewrite <-cbl1_hom1_equiv in H1.
(* Goal: @ex (Field.K (stype (vn_eparams n))) (fun k : Field.K (stype (vn_eparams n)) => or (@Logic.eq (vect n) x (scalE (vn_eparams n) k y)) (@Logic.eq (vect n) y (scalE (vn_eparams n) k x))) *)
rewrite (decomp_cbl n y (y::nil) x H1 (hom1_decomposable _ _ H2) Hy) in H3.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
case cbl1 with (2 := H3); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros k Hk; exists k; auto.
Qed. 

Lemma homn_1 n k1 k2 x y : 
  hom n k1 x -> hom n k2 y -> n = (k1 + k2)%nat -> x ∧ y = 'dC[x ∨ y] .* 1.
Proof.
(* Goal: forall (_ : b2Prop (hom n k1 x)) (_ : b2Prop (hom n (S O) y)) (_ : b2Prop (hom n k2 z)), @Logic.eq (vect n) (meet n (join n x y) z) (addE (vn_eparams n) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n (S (Nat.add k1 k2)))) (meet n x (join n y z))) (join n (meet n x z) y)) *)
unfold dconst; generalize k1 k2; clear k1 k2.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (dual n (conj n false (genk n k))) (dual n (genk n (v0 (K1 p))))) (@pair (vect n) (vect n) (scal n k (all n)) (scal n k (genk n (v0 (K1 p))))) *)
induction n as [|n IH]; simpl; try Vfold n.
(* Goal: forall (k1 k2 : nat) (_ : b2Prop match k1 with | O => true | S n => eqK (K1 p) x (v0 (K1 p)) end) (_ : b2Prop match k2 with | O => true | S n => eqK (K1 p) y (v0 (K1 p)) end) (_ : @Logic.eq nat O (Nat.add k1 k2)), @Logic.eq (Field.K (K1 p)) (multK (K1 p) x y) (multK (K1 p) (multK (K1 p) x y) (v1 (K1 p))) *)
(* Goal: forall (k1 k2 : nat) (_ : b2Prop (let (l2, l3) := x in andb match k1 with | O => eq0 n l2 | S k3 => hom n k3 l2 end (hom n k1 l3))) (_ : b2Prop (let (l2, l3) := y in andb match k2 with | O => eq0 n l2 | S k3 => hom n k3 l2 end (hom n k2 l3))) (_ : @Logic.eq nat (S n) (Nat.add k1 k2)), @Logic.eq (prod (vect n) (vect n)) (let (x1, y1) := x in let (x2, y2) := y in @pair (vect n) (vect n) (meet n x1 x2) (addE (vn_eparams n) (meet n x1 y2) (meet n y1 (dconj n false x2)))) (@pair (vect n) (vect n) (scalE (vn_eparams n) (let (_, l2) := let (x, y) := let (x1, x2) := x in let (y1, y2) := y in @pair (vect n) (vect n) (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) (join n x2 y2) in @pair (vect n) (vect n) (dual n (conj n false y)) (dual n x) in const n l2) (E0 (vn_eparams n))) (scalE (vn_eparams n) (let (_, l2) := let (x, y) := let (x1, x2) := x in let (y1, y2) := y in @pair (vect n) (vect n) (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) (join n x2 y2) in @pair (vect n) (vect n) (dual n (conj n false y)) (dual n x) in const n l2) (genk n (v1 (K1 p))))) *)
intros [|k1] [|k2]; Krm1.
(* Goal: forall (k1 k2 : nat) (_ : b2Prop (let (l2, l3) := x in andb match k1 with | O => eq0 n l2 | S k3 => hom n k3 l2 end (hom n k1 l3))) (_ : b2Prop (let (l2, l3) := y in andb match k2 with | O => eq0 n l2 | S k3 => hom n k3 l2 end (hom n k2 l3))) (_ : @Logic.eq nat (S n) (Nat.add k1 k2)), @Logic.eq (prod (vect n) (vect n)) (let (x1, y1) := x in let (x2, y2) := y in @pair (vect n) (vect n) (meet n x1 x2) (addE (vn_eparams n) (meet n x1 y2) (meet n y1 (dconj n false x2)))) (@pair (vect n) (vect n) (scalE (vn_eparams n) (let (_, l2) := let (x, y) := let (x1, x2) := x in let (y1, y2) := y in @pair (vect n) (vect n) (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) (join n x2 y2) in @pair (vect n) (vect n) (dual n (conj n false y)) (dual n x) in const n l2) (E0 (vn_eparams n))) (scalE (vn_eparams n) (let (_, l2) := let (x, y) := let (x1, x2) := x in let (y1, y2) := y in @pair (vect n) (vect n) (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) (join n x2 y2) in @pair (vect n) (vect n) (dual n (conj n false y)) (dual n x) in const n l2) (genk n (v1 (K1 p))))) *)
intros [|k1] [|k2]; destruct x as [x1 x2]; destruct y as [y1 y2].
(* Goal: b2Prop false *)
intros; discriminate.
(* Goal: b2Prop false *)
case eq0_spec; intros HH Hx2; subst; try discriminate.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n (E0 (vn_eparams n)) y2) (join n (genk n (const n x2)) (genk n (const n y1)))) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n (E0 (vn_eparams n)) y2) (join n (genk n (const n x2)) (genk n (const n y1)))) z2) (addE (vn_eparams n) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n (S (Nat.add O k2)))) (meet n (genk n (const n x2)) (join n y2 (dconj n false z1)))) (join n (meet n (genk n (const n x2)) (dconj n false z1)) y2)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add O (S k2)))))) (meet n (E0 (vn_eparams n)) (addE (vn_eparams n) (join n (genk n (const n y1)) z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n (E0 (vn_eparams n)) z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) z2) (meet n (genk n (const n x2)) (dconj n false z1)))) (genk n (const n y1))))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add O (S k2)))))) (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) (join n y2 z2)) (meet n (genk n (const n x2)) (dconj n false (addE (vn_eparams n) (join n (genk n (const n y1)) z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) z2) (meet n (genk n (const n x2)) (dconj n false z1))) y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (eq0 n z1) (hom n O z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (hom n k2 z1) (hom n (S k2) z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
rewrite !meet0l; Grm0.
(* Goal: forall (_ : b2Prop (andb (hom n k2 y1) (hom n (S k2) y2))) (_ : @Logic.eq nat (S n) (Nat.add O (S k2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (meet n x2 (dconj n false y1))) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (scalE (vn_eparams n) (const n (dual n (join n (conj n false x2) y1))) (genk n (v1 (K1 p))))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (eq0 n y1) (hom n O y2))) (_ : @Logic.eq nat (S n) (Nat.add (S k1) O)), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n x1 y1) (addE (vn_eparams n) (meet n x1 y2) (meet n x2 (dconj n false y1)))) (@pair (vect n) (vect n) (scalE (vn_eparams n) (const n (dual n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)))) (E0 (vn_eparams n))) (scalE (vn_eparams n) (const n (dual n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)))) (genk n (v1 (K1 p))))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n k2 y1) (hom n (S k2) y2))) (_ : @Logic.eq nat (S n) (Nat.add (S k1) (S k2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n x1 y1) (addE (vn_eparams n) (meet n x1 y2) (meet n x2 (dconj n false y1)))) (@pair (vect n) (vect n) (scalE (vn_eparams n) (const n (dual n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)))) (E0 (vn_eparams n))) (scalE (vn_eparams n) (const n (dual n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)))) (genk n (v1 (K1 p))))) *)
rewrite andbP; intros (Hy1,Hy2) HH; injection HH; intros HH1; subst.
(* Goal: @Logic.eq (prod (vect (S (Nat.add k1 k2))) (vect (S (Nat.add k1 k2)))) (@pair (vect (S (Nat.add k1 k2))) (vect (S (Nat.add k1 k2))) (E0 (vn_eparams (S (Nat.add k1 k2)))) (addE (vn_eparams (S (Nat.add k1 k2))) (scalE (vn_eparams (S (Nat.add k1 k2))) (const (S (Nat.add k1 k2)) (dual (S (Nat.add k1 k2)) (join (S (Nat.add k1 k2)) x1 y2))) (genk (S (Nat.add k1 k2)) (v1 (K1 p)))) (scalE (vn_eparams (S (Nat.add k1 k2))) (const (S (Nat.add k1 k2)) (dual (S (Nat.add k1 k2)) (join (S (Nat.add k1 k2)) x2 (dconj (S (Nat.add k1 k2)) false y1)))) (genk (S (Nat.add k1 k2)) (v1 (K1 p)))))) (@pair (vect (S (Nat.add k1 k2))) (vect (S (Nat.add k1 k2))) (E0 (vn_eparams (S (Nat.add k1 k2)))) (addE (vn_eparams (S (Nat.add k1 k2))) (scalE (vn_eparams (S (Nat.add k1 k2))) (const (S (Nat.add k1 k2)) (dual (S (Nat.add k1 k2)) (join (S (Nat.add k1 k2)) x1 y2))) (genk (S (Nat.add k1 k2)) (v1 (K1 p)))) (scalE (vn_eparams (S (Nat.add k1 k2))) (const (S (Nat.add k1 k2)) (dual (S (Nat.add k1 k2)) (join (S (Nat.add k1 k2)) (conj (S (Nat.add k1 k2)) false x2) y1))) (genk (S (Nat.add k1 k2)) (v1 (K1 p)))))) *)
rewrite dconjf_hom with (1 := Hy1), conjf_hom with (1 := Hx2).
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite expK_add, expK2m1; simpl expK; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite !scalE1, (IH _ _ 0%nat k2); auto.
(* Goal: forall _ : b2Prop (andb (hom n O x1) (hom n (S O) x2)), @ex (prod (Field.K (K p)) (kn p n)) (fun y : prod (Field.K (K p)) (kn p n) => @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) x1 x2) (let (k, v1) := y in @pair (vect n) (vect n) (genk n k) (k2g n v1))) *)
rewrite andbP; intros (Hx1,Hx2).
(* Goal: b2Prop false *)
case eq0_spec; intros HH Hy2; subst; try discriminate.
(* Goal: forall _ : @Logic.eq nat (S n) (Nat.add (S k1) O), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n x1 (E0 (vn_eparams n))) (addE (vn_eparams n) (meet n x1 y2) (meet n x2 (dconj n false (E0 (vn_eparams n)))))) (@pair (vect n) (vect n) (scalE (vn_eparams n) (const n (dual n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) (E0 (vn_eparams n)))))) (E0 (vn_eparams n))) (scalE (vn_eparams n) (const n (dual n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) (E0 (vn_eparams n)))))) (genk n (v1 (K1 p))))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n k2 y1) (hom n (S k2) y2))) (_ : @Logic.eq nat (S n) (Nat.add (S k1) (S k2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n x1 y1) (addE (vn_eparams n) (meet n x1 y2) (meet n x2 (dconj n false y1)))) (@pair (vect n) (vect n) (scalE (vn_eparams n) (const n (dual n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)))) (E0 (vn_eparams n))) (scalE (vn_eparams n) (const n (dual n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)))) (genk n (v1 (K1 p))))) *)
intros HH; injection HH; intros HH1; subst.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n (E0 (vn_eparams n)) y2) (join n (genk n (const n x2)) (genk n (const n y1)))) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n (E0 (vn_eparams n)) y2) (join n (genk n (const n x2)) (genk n (const n y1)))) z2) (addE (vn_eparams n) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n (S (Nat.add O k2)))) (meet n (genk n (const n x2)) (join n y2 (dconj n false z1)))) (join n (meet n (genk n (const n x2)) (dconj n false z1)) y2)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add O (S k2)))))) (meet n (E0 (vn_eparams n)) (addE (vn_eparams n) (join n (genk n (const n y1)) z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n (E0 (vn_eparams n)) z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) z2) (meet n (genk n (const n x2)) (dconj n false z1)))) (genk n (const n y1))))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add O (S k2)))))) (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) (join n y2 z2)) (meet n (genk n (const n x2)) (dconj n false (addE (vn_eparams n) (join n (genk n (const n y1)) z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) z2) (meet n (genk n (const n x2)) (dconj n false z1))) y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (eq0 n z1) (hom n O z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (hom n k2 z1) (hom n (S k2) z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
rewrite dconj0, !meet0r, IH with (1 := Hx1) (2 := Hy2); Grm0.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n (E0 (vn_eparams n)) y2) (join n (genk n (const n x2)) (genk n (const n y1)))) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n (E0 (vn_eparams n)) y2) (join n (genk n (const n x2)) (genk n (const n y1)))) z2) (addE (vn_eparams n) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n (S (Nat.add O k2)))) (meet n (genk n (const n x2)) (join n y2 (dconj n false z1)))) (join n (meet n (genk n (const n x2)) (dconj n false z1)) y2)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add O (S k2)))))) (meet n (E0 (vn_eparams n)) (addE (vn_eparams n) (join n (genk n (const n y1)) z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n (E0 (vn_eparams n)) z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) z2) (meet n (genk n (const n x2)) (dconj n false z1)))) (genk n (const n y1))))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add O (S k2)))))) (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) (join n y2 z2)) (meet n (genk n (const n x2)) (dconj n false (addE (vn_eparams n) (join n (genk n (const n y1)) z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) z2) (meet n (genk n (const n x2)) (dconj n false z1))) y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (eq0 n z1) (hom n O z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (hom n k2 z1) (hom n (S k2) z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
rewrite !andbP; intros (Hx1,Hx2)( Hy1,Hy2) Hn; Grm0.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n x1 y1) (addE (vn_eparams n) (meet n x1 y2) (meet n x2 (dconj n false y1)))) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (scalE (vn_eparams n) (const n (dual n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)))) (genk n (v1 (K1 p))))) *)
injection Hn; rewrite <-plus_n_Sm; clear Hn; intros Hn; subst.
(* Goal: lt (Nat.add O k2) n *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (eq0 n y1) (hom n O y2))) (_ : lt (Nat.add (S k1) O) (S n)), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n x1 y1) (addE (vn_eparams n) (meet n x1 y2) (meet n x2 (dconj n false y1)))) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (E0 (vn_eparams n))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n k2 y1) (hom n (S k2) y2))) (_ : lt (Nat.add (S k1) (S k2)) (S n)), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n x1 y1) (addE (vn_eparams n) (meet n x1 y2) (meet n x2 (dconj n false y1)))) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (E0 (vn_eparams n))) *)
rewrite meet_small with (1:= Hx1) (2 := Hy1); auto with arith.
rewrite (IH _ _ k1 k2.+1), (IH _ _ k1.+1 k2),
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
        dual_add, const_add, scal_addEl; auto.
(* Goal: @Logic.eq (prod (vect (S (Nat.add k1 k2))) (vect (S (Nat.add k1 k2)))) (@pair (vect (S (Nat.add k1 k2))) (vect (S (Nat.add k1 k2))) (E0 (vn_eparams (S (Nat.add k1 k2)))) (addE (vn_eparams (S (Nat.add k1 k2))) (scalE (vn_eparams (S (Nat.add k1 k2))) (const (S (Nat.add k1 k2)) (dual (S (Nat.add k1 k2)) (join (S (Nat.add k1 k2)) x1 y2))) (genk (S (Nat.add k1 k2)) (v1 (K1 p)))) (scalE (vn_eparams (S (Nat.add k1 k2))) (const (S (Nat.add k1 k2)) (dual (S (Nat.add k1 k2)) (join (S (Nat.add k1 k2)) x2 (dconj (S (Nat.add k1 k2)) false y1)))) (genk (S (Nat.add k1 k2)) (v1 (K1 p)))))) (@pair (vect (S (Nat.add k1 k2))) (vect (S (Nat.add k1 k2))) (E0 (vn_eparams (S (Nat.add k1 k2)))) (addE (vn_eparams (S (Nat.add k1 k2))) (scalE (vn_eparams (S (Nat.add k1 k2))) (const (S (Nat.add k1 k2)) (dual (S (Nat.add k1 k2)) (join (S (Nat.add k1 k2)) x1 y2))) (genk (S (Nat.add k1 k2)) (v1 (K1 p)))) (scalE (vn_eparams (S (Nat.add k1 k2))) (const (S (Nat.add k1 k2)) (dual (S (Nat.add k1 k2)) (join (S (Nat.add k1 k2)) (conj (S (Nat.add k1 k2)) false x2) y1))) (genk (S (Nat.add k1 k2)) (v1 (K1 p)))))) *)
rewrite dconjf_hom with (1 := Hy1), conjf_hom with (1 := Hx2).
replace ((k1 + k2).+1 + k2)%nat with (2 * k2 + k1.+1)%nat by ring.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite expKm1_2E, join_scall, join_scalr; auto.
Qed.

(* One theorem of white  WHITE 1997 p882 and Barnabei Brini Rota p135 *) 
Lemma join2_meetE n k1 k2 (x y : vect n) : 
  hom n k1 x -> hom n k2 y -> n <= k1 + k2 ->  x ∨ y = (x ∧ y) ∨ E.
Proof.
(* Goal: forall (_ : b2Prop (hom n k1 x)) (_ : b2Prop (hom n k2 y)) (_ : le n (Nat.add k1 k2)), @Logic.eq (vect n) (join n x y) (join n (meet n x y) (all n)) *)
intros Hx Hy Hn.
(* Goal: @Logic.eq (vect n) (join n x y) (join n (meet n x y) (all n)) *)
case (Lt.le_lt_or_eq _ _ Hn); clear Hn; intros Hn.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite (hom_lt n (k1 + k2) (x ∨ y)); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite join_allhr with (k := (k1 + k2 - n)%nat); auto.
(* Goal: lt O (Nat.sub (Nat.add k1 k2) n) *)
(* Goal: @Logic.eq (vect n) (join n x y) (join n (meet n x y) (all n)) *)
apply Plus.plus_lt_reg_l with n.
(* Goal: lt (Nat.add n O) (Nat.add n (Nat.sub (Nat.add k1 k2) n)) *)
(* Goal: @Logic.eq (vect n) (join n x y) (join n (meet n x y) (all n)) *)
rewrite Plus.plus_0_r, <-Minus.le_plus_minus; auto with arith.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite homn_1 with (3 := Hn), join_scall, join1l, <-homn_all; subst; auto.
Qed.

(* Barnabei Brini Rota p136 *) 
Lemma join_meet_swap n k1 k2 k3 (x y z : vect n) : 
   hom n k1 x -> hom n k2 y ->  hom n k3 z -> (k1 + k2 + k3 = n)%nat -> 
    x ∧ (y ∨ z) = (x ∨ y) ∧ z.
Proof.
(* Goal: forall (_ : b2Prop (hom n n x)) (_ : b2Prop (hom n k1 y)) (_ : b2Prop (hom n k2 z)) (_ : le n (Nat.add k1 k2)), @Logic.eq (vect n) (meet n x (join n y z)) (join n (meet n (meet n x y) z) (all n)) *)
intros Hx Hy Hz Hn.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite homn_1 with (k1 := k1) (k2 := (k2 + k3)%nat); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite homn_1 with (k1 := (k1 + k2)%nat) (k2 := k3); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite join_assoc; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite Plus.plus_assoc; auto.
Qed.

(* Barnabei Brini Rota p136 *) 
Lemma join3_meetE n k1 k2 (x y z : vect n) : 
  hom n n x -> hom n k1 y -> hom n k2 z ->  n <= k1 + k2 ->  
  x ∧ (y ∨ z) = (x ∧ y ∧ z) ∨ E.
Proof.
(* Goal: forall (_ : b2Prop (hom n n x)) (_ : b2Prop (hom n k1 y)) (_ : b2Prop (hom n k2 z)) (_ : le n (Nat.add k1 k2)), @Logic.eq (vect n) (meet n x (join n y z)) (join n (meet n (meet n x y) z) (all n)) *)
intros Hx Hy Hz Hn.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite homn_all with (1 := Hx), !meet_scall, !meet_alll; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite join_scall, join2_meetE with (k1 := k1) (k2 := k2); auto.
Qed.

Lemma splitlr n k1 k2 x y z : hom n k1 x -> hom n 1 y ->  hom n k2 z ->
  (x ∨ y) ∧ z = (-(1))^(n + (k1 + k2).+1) .* (x ∧ (y ∨ z)) +
                         (x ∧ z) ∨ y.
Proof.
(* Goal: forall (_ : b2Prop (hom n k1 x)) (_ : b2Prop (hom n (S O) y)) (_ : b2Prop (hom n k2 z)), @Logic.eq (vect n) (meet n (join n x y) z) (addE (vn_eparams n) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n (S (Nat.add k1 k2)))) (meet n x (join n y z))) (join n (meet n x z) y)) *)
generalize k1 k2; clear k1 k2.
(* Goal: forall (k1 k2 : nat) (_ : b2Prop (hom n k1 x)) (_ : b2Prop (hom n (S O) y)) (_ : b2Prop (hom n k2 z)), @Logic.eq (vect n) (meet n (join n x y) z) (addE (vn_eparams n) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n (S (Nat.add k1 k2)))) (meet n x (join n y z))) (join n (meet n x z) y)) *)
induction n as [| n IH]; simpl; try Vfold n.
intros [|k1] [|k2]; 
(* Goal: b2Prop false *)
  case eqK_spec; intros; subst; Krm0; try discriminate.
intros [|k1] [|k2]; destruct x as [x1 x2]; destruct y as [y1 y2];
  destruct z as [z1 z2].
(* Goal: b2Prop false *)
case eq0_spec; intros tmp Hx2; subst; try discriminate.
(* Goal: forall (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (eq0 n z1) (hom n O z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n (E0 (vn_eparams n)) y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n (E0 (vn_eparams n)) y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add O O))))) (meet n (E0 (vn_eparams n)) (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n (E0 (vn_eparams n)) z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add O O))))) (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) z2) (meet n x2 (dconj n false z1))) y2))) *)
(* Goal: forall (_ : b2Prop (andb (eq0 n x1) (hom n O x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (hom n k2 z1) (hom n (S k2) z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add O (S k2)))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add O (S k2)))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (eq0 n z1) (hom n O z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (hom n k2 z1) (hom n (S k2) z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
rewrite andbP; intros (Hy1, Hy2).
(* Goal: b2Prop false *)
case eq0_spec; intros tmp Hz2; subst; try discriminate.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n (E0 (vn_eparams n)) y2) (join n (genk n (const n x2)) (genk n (const n y1)))) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n (E0 (vn_eparams n)) y2) (join n (genk n (const n x2)) (genk n (const n y1)))) z2) (addE (vn_eparams n) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n (S (Nat.add O k2)))) (meet n (genk n (const n x2)) (join n y2 (dconj n false z1)))) (join n (meet n (genk n (const n x2)) (dconj n false z1)) y2)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add O (S k2)))))) (meet n (E0 (vn_eparams n)) (addE (vn_eparams n) (join n (genk n (const n y1)) z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n (E0 (vn_eparams n)) z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) z2) (meet n (genk n (const n x2)) (dconj n false z1)))) (genk n (const n y1))))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add O (S k2)))))) (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) (join n y2 z2)) (meet n (genk n (const n x2)) (dconj n false (addE (vn_eparams n) (join n (genk n (const n y1)) z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) z2) (meet n (genk n (const n x2)) (dconj n false z1))) y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (eq0 n z1) (hom n O z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (hom n k2 z1) (hom n (S k2) z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
Grm0.
rewrite (hom0E _ _ Hx2), (hom0E _ _ Hy1), (hom0E _ _ Hz2),
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
        conjk; auto.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (meet n (join n (genk n (const n x2)) (genk n (const n y1))) (genk n (const n z2)))) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add O O))))) (meet n (genk n (const n x2)) (dconj n false (join n (genk n (const n y1)) (genk n (const n z2))))))) *)
(* Goal: forall (_ : b2Prop (andb (eq0 n x1) (hom n O x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (hom n k2 z1) (hom n (S k2) z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add O (S k2)))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add O (S k2)))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (eq0 n z1) (hom n O z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (hom n k2 z1) (hom n (S k2) z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
rewrite dconjf_joinl, conjk, dconjk, !joinkr.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
case (Peano_dec.dec_eq_nat n 0); intros Hn; subst; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
simpl; Krm1; rewrite !multK_assoc, multK_com, !multK_assoc; auto.
rewrite !meet_small with (k1 := 0%nat) (k2 := 0%nat); Grm0;
  try apply scal_hom; try apply hom0K; try (destruct n; auto with arith; fail).
(* Goal: b2Prop false *)
case eq0_spec; intros tmp Hx2; subst; try discriminate.
(* Goal: forall (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (hom n k2 z1) (hom n (S k2) z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n (E0 (vn_eparams n)) y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n (E0 (vn_eparams n)) y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add O (S k2)))))) (meet n (E0 (vn_eparams n)) (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n (E0 (vn_eparams n)) z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add O (S k2)))))) (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) z2) (meet n x2 (dconj n false z1))) y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (eq0 n z1) (hom n O z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (hom n k2 z1) (hom n (S k2) z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
rewrite !andbP; intros (Hy1, Hy2) (Hz1, Hz2).
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite (IH x2 y2 (z1^d_'f) 0%nat k2); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite (hom0E _ _ Hx2), (hom0E _ _ Hy1), conjk; auto.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n (E0 (vn_eparams n)) y2) (join n (genk n (const n x2)) (genk n (const n y1)))) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n (E0 (vn_eparams n)) y2) (join n (genk n (const n x2)) (genk n (const n y1)))) z2) (addE (vn_eparams n) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n (S (Nat.add O k2)))) (meet n (genk n (const n x2)) (join n y2 (dconj n false z1)))) (join n (meet n (genk n (const n x2)) (dconj n false z1)) y2)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add O (S k2)))))) (meet n (E0 (vn_eparams n)) (addE (vn_eparams n) (join n (genk n (const n y1)) z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n (E0 (vn_eparams n)) z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) z2) (meet n (genk n (const n x2)) (dconj n false z1)))) (genk n (const n y1))))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add O (S k2)))))) (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) (join n y2 z2)) (meet n (genk n (const n x2)) (dconj n false (addE (vn_eparams n) (join n (genk n (const n y1)) z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) z2) (meet n (genk n (const n x2)) (dconj n false z1))) y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (eq0 n z1) (hom n O z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (hom n k2 z1) (hom n (S k2) z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
Grm0.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (join n (genk n (const n x2)) (genk n (const n y1))) z1) (addE (vn_eparams n) (meet n (join n (genk n (const n x2)) (genk n (const n y1))) z2) (addE (vn_eparams n) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n (S (Nat.add O k2)))) (meet n (genk n (const n x2)) (join n y2 (dconj n false z1)))) (join n (meet n (genk n (const n x2)) (dconj n false z1)) y2)))) (@pair (vect n) (vect n) (join n (conj n false (meet n (genk n (const n x2)) (dconj n false z1))) (genk n (const n y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add O (S k2)))))) (meet n (genk n (const n x2)) (dconj n false (addE (vn_eparams n) (join n (genk n (const n y1)) z2) (join n (conj n false y2) z1))))) (join n (meet n (genk n (const n x2)) (dconj n false z1)) y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (eq0 n z1) (hom n O z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (hom n k2 z1) (hom n (S k2) z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
rewrite !joink, joinkr.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
apply f_equal2 with (f := @pair _ _).
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite conjf_meetl, dconj_invo, conjk, <-meet_scall, scalk, multK_com; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite <-addE_assoc; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply f_equal2 with (f := add n); auto.
(* Goal: @Logic.eq (vect n) (addE (vn_eparams n) (meet n (genk n (multK (K1 p) (const n x2) (const n y1))) z2) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n (S (Nat.add O k2)))) (meet n (genk n (const n x2)) (join n y2 (dconj n false z1))))) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add O (S k2)))))) (meet n (genk n (const n x2)) (dconj n false (addE (vn_eparams n) (join n (genk n (const n y1)) z2) (join n (conj n false y2) z1))))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (eq0 n z1) (hom n O z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (hom n k2 z1) (hom n (S k2) z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
simpl minus.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite dconj_add, meet_addr, scal_addEr; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply f_equal2 with (f := add n); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite dconjf_joinr, conjk, joinkl, meet_scalr, <-meet_scall, scalk; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite multK_com, dconjf_hom with (1 := Hz2), meet_scalr, <-scal_multE; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite multK_assoc, <-expK_add; auto.
replace (n + (0 + k2.+1).+1 + (n + k2.+1))%nat with (2 * (n + k2.+1) + 1)%nat by ring.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite expKm1_2E; simpl expK; Krm1; rewrite scalE1; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite dconjf_joinr, conj_invo; auto.
(* Goal: @Logic.eq (Field.K (K1 p)) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n (S (Nat.add (S k1) k2)))) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (S (Nat.add n (S (Nat.add (S k1) k2)))))) *)
(* Goal: @Logic.eq (vect n) (meet n x2 (join n y2 (dconj n false z1))) (meet n x2 (dconj n false (join n (conj n false y2) z1))) *)
rewrite <-!plus_n_Sm; simpl expK; Krm1.
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (eq0 n z1) (hom n O z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (hom n k2 z1) (hom n (S k2) z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
case eq0_spec; intros tmp; subst; try (intros; discriminate).
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb true (hom n O z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) (E0 (vn_eparams n))) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false (E0 (vn_eparams n)))))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) (E0 (vn_eparams n)))))) (addE (vn_eparams n) (join n (meet n x1 (E0 (vn_eparams n))) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false (E0 (vn_eparams n)))))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) (E0 (vn_eparams n)))))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false (E0 (vn_eparams n))))) y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (hom n k2 z1) (hom n (S k2) z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
rewrite andbP, andbP; intros (Hx1, Hx2) (Hy1, Hy2) Hz2.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n (E0 (vn_eparams n)) y2) (join n (genk n (const n x2)) (genk n (const n y1)))) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n (E0 (vn_eparams n)) y2) (join n (genk n (const n x2)) (genk n (const n y1)))) z2) (addE (vn_eparams n) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n (S (Nat.add O k2)))) (meet n (genk n (const n x2)) (join n y2 (dconj n false z1)))) (join n (meet n (genk n (const n x2)) (dconj n false z1)) y2)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add O (S k2)))))) (meet n (E0 (vn_eparams n)) (addE (vn_eparams n) (join n (genk n (const n y1)) z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n (E0 (vn_eparams n)) z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) z2) (meet n (genk n (const n x2)) (dconj n false z1)))) (genk n (const n y1))))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add O (S k2)))))) (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) (join n y2 z2)) (meet n (genk n (const n x2)) (dconj n false (addE (vn_eparams n) (join n (genk n (const n y1)) z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) z2) (meet n (genk n (const n x2)) (dconj n false z1))) y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (eq0 n z1) (hom n O z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (hom n k2 z1) (hom n (S k2) z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
rewrite dconj0, !meet0r; Grm0.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
apply f_equal2 with (f := @pair _ _).
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite (hom0E _ _ Hy1), (hom0E _ _ Hz2), !joinkr; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite scalk, multK_com, <-scalk, meet_scalr; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite <-meet_scalr, scalk, multK_com with (x := 'C[z2]); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite conjf_meetr, conjk, <-meet_scalr with (k := 'C[y1]), scalk; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite dconjf_hom with (1 := Hx1), meet_scall, <-scal_addEl; auto.
(* Goal: @Logic.eq (vect n) (E0 (vn_eparams n)) (scalE (vn_eparams n) (addK (stype (vn_eparams n)) (multK (K1 p) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O)))) (oppK (K1 p) (v1 (K1 p)))) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n k1))) (meet n x1 (genk n (multK (stype (vn_eparams n)) (const n y1) (const n z2))))) *)
(* Goal: @Logic.eq (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (join n y1 z2))))) (join n (meet n x1 z2) y2)) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (hom n k2 z1) (hom n (S k2) z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
replace (n + (k1.+1 + 0).+1)%nat with ((n + k1).+2)%nat by ring.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n (E0 (vn_eparams n)) y2) (join n (genk n (const n x2)) (genk n (const n y1)))) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n (E0 (vn_eparams n)) y2) (join n (genk n (const n x2)) (genk n (const n y1)))) z2) (addE (vn_eparams n) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n (S (Nat.add O k2)))) (meet n (genk n (const n x2)) (join n y2 (dconj n false z1)))) (join n (meet n (genk n (const n x2)) (dconj n false z1)) y2)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add O (S k2)))))) (meet n (E0 (vn_eparams n)) (addE (vn_eparams n) (join n (genk n (const n y1)) z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n (E0 (vn_eparams n)) z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) z2) (meet n (genk n (const n x2)) (dconj n false z1)))) (genk n (const n y1))))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add O (S k2)))))) (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) (join n y2 z2)) (meet n (genk n (const n x2)) (dconj n false (addE (vn_eparams n) (join n (genk n (const n y1)) z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) z2) (meet n (genk n (const n x2)) (dconj n false z1))) y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (eq0 n z1) (hom n O z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (hom n k2 z1) (hom n (S k2) z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
simpl expK; Krm1; rewrite oppKl; Grm0.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite meet_addl, IH with (1 := Hx1) (3 := Hz2); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite addE_com, <-!addE_assoc; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply f_equal2 with (f := add n); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite addE_com, scal_addEr; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite (hom0E _ _ Hy1), (hom0E _ _ Hz2), !joinkr; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply f_equal2 with (f := add n); auto.
(* Goal: @Logic.eq (vect n) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n (S (Nat.add k1 O)))) (meet n x1 (scalE (vn_eparams n) (const n z2) y2))) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (meet n x1 (scalE (vn_eparams n) (const n z2) y2))) *)
(* Goal: @Logic.eq (vect n) (meet n (scalE (vn_eparams n) (const n y1) (conj n false x2)) (genk n (const n z2))) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (meet n x2 (dconj n false (scalE (vn_eparams n) (const n z2) (genk n (const n y1)))))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (hom n k2 z1) (hom n (S k2) z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
replace (n + (k1.+1 + 0).+1)%nat with ((n + (k1 + 0).+1).+1)%nat by ring.
(* Goal: @Logic.eq (Field.K (K1 p)) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n (S (Nat.add (S k1) k2)))) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (S (Nat.add n (S (Nat.add (S k1) k2)))))) *)
(* Goal: @Logic.eq (vect n) (meet n x2 (join n y2 (dconj n false z1))) (meet n x2 (dconj n false (join n (conj n false y2) z1))) *)
simpl expK; Krm1.
rewrite conjf_hom with (1 := Hx2), !meet_scall, dconj_scal, 
        dconjk, <-!meet_scalr, !scalk.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite multK_com with (x := 'C[y1]), multK_com with (x := 'C[z2]), <-!multK_assoc; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite multK_assoc, multK_com with (x := 'C[z2]), <- multK_assoc; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
Krm1; rewrite !opp_multKl, <-expKS, <-expK_add; auto.
replace ((n + (k1.+1 + 0).+1).+1 + n)%nat with (2 * (n.+1) + k1.+1)%nat by ring.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite expKm1_2E; auto.
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (hom n k2 z1) (hom n (S k2) z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
rewrite !andbP; intros (Hx1,Hx2) (Hy1,Hy2) (Hz1,Hz2).
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
apply f_equal2 with (f := @pair _ _).
(* Goal: @Logic.eq (vect n) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2)) *)
rewrite meet_addl.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite IH with (1 := Hx1) (3 := Hz1); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite meet_addr, scal_addEr, !addE_assoc; auto.
(* Goal: @Logic.eq (vect n) (addE (vn_eparams n) (meet n v4 (dconj n false v1)) (meet n v3 v2)) (addE (vn_eparams n) (meet n v3 v2) (meet n v4 (dconj n false v1))) *)
apply sym_equal; rewrite addE_com; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite !addE_assoc; auto;  apply f_equal2 with (f := add n); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite conjf_hom with (1 := Hy2), join_scall, meet_scalr; auto.
(* Goal: @Logic.eq (Field.K (K1 p)) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n (S (Nat.add (S k1) k2)))) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (S (Nat.add n (S (Nat.add (S k1) k2)))))) *)
(* Goal: @Logic.eq (vect n) (meet n x2 (join n y2 (dconj n false z1))) (meet n x2 (dconj n false (join n (conj n false y2) z1))) *)
rewrite <-scal_multE; simpl expK; Krm1.
replace (n + (k1 + k2.+1) .+2)%nat with (2 * 1 + (n + (k1 + k2).+1))%nat by ring.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite expKm1_2E; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply f_equal2 with (f := add n); auto.
(* Goal: @Logic.eq (vect n) (addE (vn_eparams n) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (meet n x1 (join n y1 z2)))) (meet n (join n (conj n false x2) y1) z1) *)
(* Goal: @Logic.eq (vect n) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2)) *)
rewrite conj_add, join_addl.
(* Goal: @Logic.eq (vect n) (addE (vn_eparams n) (addE (vn_eparams n) (join n (conj n false (meet n x1 z2)) y1) (join n (conj n false (meet n x2 (dconj n false z1))) y1)) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (meet n x1 (join n y1 z2)))) (meet n (join n (conj n false x2) y1) z1) *)
(* Goal: @Logic.eq (vect n) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2)) *)
rewrite !conjf_meetl, dconj_invo.
(* Goal: @Logic.eq (vect n) (addE (vn_eparams n) (addE (vn_eparams n) (join n (meet n (conj n false x1) (dconj n false z2)) y1) (join n (meet n (conj n false x2) z1) y1)) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (meet n x1 (join n y1 z2)))) (meet n (join n (conj n false x2) y1) z1) *)
(* Goal: @Logic.eq (vect n) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2)) *)
rewrite (hom0E _ _ Hy1), !joinkr, !joinkl.
(* Goal: @Logic.eq (vect n) (addE (vn_eparams n) (addE (vn_eparams n) (scalE (vn_eparams n) (const n y1) (meet n (conj n false x1) (dconj n false z2))) (scalE (vn_eparams n) (const n y1) (meet n (conj n false x2) z1))) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (meet n x1 (scalE (vn_eparams n) (const n y1) z2)))) (meet n (scalE (vn_eparams n) (const n y1) (conj n false x2)) z1) *)
(* Goal: @Logic.eq (vect n) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2)) *)
rewrite meet_scalr, meet_scall.
(* Goal: @Logic.eq (vect n) (addE (vn_eparams n) (addE (vn_eparams n) (scalE (vn_eparams n) (const n y1) (meet n (conj n false x1) (dconj n false z2))) (scalE (vn_eparams n) (const n y1) (meet n (conj n false x2) z1))) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (scalE (vn_eparams n) (const n y1) (meet n x1 z2)))) (scalE (vn_eparams n) (const n y1) (meet n (conj n false x2) z1)) *)
(* Goal: @Logic.eq (vect n) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2)) *)
rewrite conjf_hom with (1 := Hx1).
(* Goal: @Logic.eq (vect n) (meet n (scalE (vn_eparams n) (const n y1) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (S k1)) x2)) z2) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (scalE (vn_eparams n) (const n y1) (meet n x2 (dconj n false z2)))) *)
(* Goal: @Logic.eq (vect n) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n (S (Nat.add (S k1) k2)))) (meet n x2 (join n y2 (dconj n false z1)))) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (meet n x2 (dconj n false (join n (conj n false y2) z1)))) *)
rewrite dconjf_hom with (1 := Hz2).
rewrite addE_com, <-addE_assoc, meet_scalr, meet_scall, <-!scal_multE,
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
        <-scal_addEl; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite multK_com, !multK_assoc, <-add_multKr, <-expK_add; auto.
replace (n + (k1.+1 + k2.+1).+1)%nat with (2 * 1 + (n + k2.+1 + k1))%nat by ring.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n (E0 (vn_eparams n)) y2) (join n (genk n (const n x2)) (genk n (const n y1)))) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n (E0 (vn_eparams n)) y2) (join n (genk n (const n x2)) (genk n (const n y1)))) z2) (addE (vn_eparams n) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n (S (Nat.add O k2)))) (meet n (genk n (const n x2)) (join n y2 (dconj n false z1)))) (join n (meet n (genk n (const n x2)) (dconj n false z1)) y2)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add O (S k2)))))) (meet n (E0 (vn_eparams n)) (addE (vn_eparams n) (join n (genk n (const n y1)) z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n (E0 (vn_eparams n)) z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) z2) (meet n (genk n (const n x2)) (dconj n false z1)))) (genk n (const n y1))))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add O (S k2)))))) (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) (join n y2 z2)) (meet n (genk n (const n x2)) (dconj n false (addE (vn_eparams n) (join n (genk n (const n y1)) z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) z2) (meet n (genk n (const n x2)) (dconj n false z1))) y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (eq0 n z1) (hom n O z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (hom n k2 z1) (hom n (S k2) z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
Krm1; rewrite expKm1_2E, oppKl; Grm0.
(* Goal: @Logic.eq (vect n) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2)) *)
rewrite meet_addl.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite IH with (1 := Hx1) (3 := Hz2); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite !scal_addEr, !addE_assoc; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply f_equal2 with (f := add n); auto.
(* Goal: @Logic.eq (vect n) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n (S (Nat.add k1 (S k2))))) (meet n x1 (join n y2 z2))) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (meet n x1 (join n y2 z2))) *)
(* Goal: @Logic.eq (vect n) (addE (vn_eparams n) (join n (meet n x1 z2) y2) (addE (vn_eparams n) (meet n (join n (conj n false x2) y1) z2) (meet n (join n x2 y2) (dconj n false z1)))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2)) *)
replace (n + (k1.+1 + k2.+1).+1)%nat with (n + (k1 + k2.+1).+1).+1 by ring.
(* Goal: @Logic.eq (Field.K (K1 p)) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n (S (Nat.add (S k1) k2)))) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (S (Nat.add n (S (Nat.add (S k1) k2)))))) *)
(* Goal: @Logic.eq (vect n) (meet n x2 (join n y2 (dconj n false z1))) (meet n x2 (dconj n false (join n (conj n false y2) z1))) *)
simpl expK; Krm1.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply sym_equal; rewrite addE_com, join_addl, !addE_assoc; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply f_equal2 with (f := add n); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite IH with (1 := Hx2) (3 := dconj_hom _ _ _ _ Hz1); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply sym_equal; rewrite <-addE_assoc, addE_com; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply f_equal2 with (f := add n); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite dconj_add, meet_addr, scal_addEr; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply f_equal2 with (f := add n); auto.
(* Goal: @Logic.eq (vect n) (meet n (join n (conj n false x2) y1) z2) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (meet n x2 (dconj n false (join n y1 z2)))) *)
(* Goal: @Logic.eq (vect n) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n (S (Nat.add (S k1) k2)))) (meet n x2 (join n y2 (dconj n false z1)))) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (meet n x2 (dconj n false (join n (conj n false y2) z1)))) *)
rewrite (hom0E _ _ Hy1).
(* Goal: @Logic.eq (vect n) (meet n (join n (conj n false x2) (genk n (const n y1))) z2) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (meet n x2 (dconj n false (join n (genk n (const n y1)) z2)))) *)
(* Goal: @Logic.eq (vect n) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n (S (Nat.add (S k1) k2)))) (meet n x2 (join n y2 (dconj n false z1)))) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (meet n x2 (dconj n false (join n (conj n false y2) z1)))) *)
rewrite joinkl,joinkr,dconj_scal, meet_scalr.
(* Goal: @Logic.eq (vect n) (meet n (scalE (vn_eparams n) (const n y1) (conj n false x2)) z2) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (scalE (vn_eparams n) (const n y1) (meet n x2 (dconj n false z2)))) *)
(* Goal: @Logic.eq (vect n) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n (S (Nat.add (S k1) k2)))) (meet n x2 (join n y2 (dconj n false z1)))) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (meet n x2 (dconj n false (join n (conj n false y2) z1)))) *)
rewrite conjf_hom with (1 := Hx2).
(* Goal: @Logic.eq (vect n) (meet n (scalE (vn_eparams n) (const n y1) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (S k1)) x2)) z2) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (scalE (vn_eparams n) (const n y1) (meet n x2 (dconj n false z2)))) *)
(* Goal: @Logic.eq (vect n) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n (S (Nat.add (S k1) k2)))) (meet n x2 (join n y2 (dconj n false z1)))) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (meet n x2 (dconj n false (join n (conj n false y2) z1)))) *)
rewrite dconjf_hom with (1 := Hz2).
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite !meet_scall, !meet_scalr, <-!scal_multE; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite !multK_assoc, !multK_com with (x := 'C[y1]), <-!multK_assoc; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
Krm1; rewrite !opp_multKl, <-expKS, <-expK_add; auto.
replace ((n + (k1.+1 + k2.+1).+1).+1 + (n + k2.+1))% nat with
        (2 * (n.+1 + k2.+1) + k1.+1)%nat by ring.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite expKm1_2E; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply f_equal2 with (f := scal n); auto.
(* Goal: @Logic.eq (Field.K (K1 p)) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n (S (Nat.add (S k1) k2)))) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) *)
(* Goal: @Logic.eq (vect n) (meet n x2 (join n y2 (dconj n false z1))) (meet n x2 (dconj n false (join n (conj n false y2) z1))) *)
replace (n + (k1.+1 + k2.+1).+1)%nat with (n + (k1.+1 + k2).+1).+1 by ring.
(* Goal: @Logic.eq (Field.K (K1 p)) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n (S (Nat.add (S k1) k2)))) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (S (Nat.add n (S (Nat.add (S k1) k2)))))) *)
(* Goal: @Logic.eq (vect n) (meet n x2 (join n y2 (dconj n false z1))) (meet n x2 (dconj n false (join n (conj n false y2) z1))) *)
simpl expK; Krm1.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite dconjf_joinr, conj_invo; auto.
Qed.

Lemma splitll n k1 k2 x y z : hom n k1 x -> hom n 1 y ->  hom n k2 z ->
  (y ∨ x) ∧ z = (-(1))^(n + k2.+1) .* ((x ∧ (y ∨ z)) - y ∨ (x ∧ z)).
Proof.
(* Goal: forall (_ : b2Prop (hom n k1 x)) (_ : b2Prop (hom n (S O) y)) (_ : b2Prop (hom n k2 z)), @Logic.eq (vect n) (join n y (meet n x z)) (addE (vn_eparams n) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n k2)) (meet n (join n y x) z)) (meet n x (join n y z))) *)
intros Hx Hy Hz.
case (Lt.le_or_lt k1 n); intros Hk1.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
2: rewrite hom_lt with (2 := Hx), sub_add, !meet0l; Grm0; rewrite meet0l; auto.
case (Lt.le_or_lt k2 n); intros Hk2.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n (E0 (vn_eparams n)) y2) (join n (genk n (const n x2)) (genk n (const n y1)))) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n (E0 (vn_eparams n)) y2) (join n (genk n (const n x2)) (genk n (const n y1)))) z2) (addE (vn_eparams n) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n (S (Nat.add O k2)))) (meet n (genk n (const n x2)) (join n y2 (dconj n false z1)))) (join n (meet n (genk n (const n x2)) (dconj n false z1)) y2)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add O (S k2)))))) (meet n (E0 (vn_eparams n)) (addE (vn_eparams n) (join n (genk n (const n y1)) z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n (E0 (vn_eparams n)) z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) z2) (meet n (genk n (const n x2)) (dconj n false z1)))) (genk n (const n y1))))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add O (S k2)))))) (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) (join n y2 z2)) (meet n (genk n (const n x2)) (dconj n false (addE (vn_eparams n) (join n (genk n (const n y1)) z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) z2) (meet n (genk n (const n x2)) (dconj n false z1))) y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (eq0 n z1) (hom n O z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (hom n k2 z1) (hom n (S k2) z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
2: rewrite hom_lt with (2 := Hz), sub_add, !meet0r; Grm0; rewrite meet0r; Grm0.
rewrite join_hom_com with (2 := Hy) (1 := Hx), meet_scall,
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
        splitlr with (k1 := k1) (k2 := k2); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite sub_add, !scal_addEr, <-scal_multE, <-expK_add; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply f_equal2 with (f := add n); auto.
replace (k1 * 1 + (n + (k1 + k2).+1))%nat with (2 * k1 + (n + k2.+1))%nat by ring.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite expKm1_2E; auto.
case (Lt.le_or_lt n (k1 + k2)%nat); intros Hm1.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n (E0 (vn_eparams n)) y2) (join n (genk n (const n x2)) (genk n (const n y1)))) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n (E0 (vn_eparams n)) y2) (join n (genk n (const n x2)) (genk n (const n y1)))) z2) (addE (vn_eparams n) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n (S (Nat.add O k2)))) (meet n (genk n (const n x2)) (join n y2 (dconj n false z1)))) (join n (meet n (genk n (const n x2)) (dconj n false z1)) y2)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add O (S k2)))))) (meet n (E0 (vn_eparams n)) (addE (vn_eparams n) (join n (genk n (const n y1)) z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n (E0 (vn_eparams n)) z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) z2) (meet n (genk n (const n x2)) (dconj n false z1)))) (genk n (const n y1))))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add O (S k2)))))) (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) (join n y2 z2)) (meet n (genk n (const n x2)) (dconj n false (addE (vn_eparams n) (join n (genk n (const n y1)) z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) z2) (meet n (genk n (const n x2)) (dconj n false z1))) y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (eq0 n z1) (hom n O z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (hom n k2 z1) (hom n (S k2) z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
2: rewrite meet_small with (k1 := k1) (k2 := k2); Grm0.
assert (Hxz := meet_hom _ _ _ _ _ Hx Hz).
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite join_hom_com with (1 := Hxz) (2 := Hy), !Mult.mult_1_r; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite <-!scal_multE, expKm1_sub; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
Krm1; rewrite  opp_multKl, <-expKS, <- expK_add; auto.
replace ((n + k2.+1).+1 +(k1 + k2 + n))%nat with
        (2 * (n + k2.+1) + k1)%nat by ring.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite expKm1_2E; auto.
Qed.

Lemma splitrr n k1 k2 x y z : hom n k1 x -> hom n 1 y ->  hom n k2 z ->
  z ∧ (x ∨ y) = (-(1))^(n + k2.+1) .* ((z ∨ y) ∧ x - (z ∧ x) ∨ y).
Proof.
(* Goal: forall (_ : b2Prop (hom n k1 x)) (_ : b2Prop (hom n (S O) y)) (_ : b2Prop (hom n k2 z)), @Logic.eq (vect n) (join n y (meet n x z)) (addE (vn_eparams n) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n k2)) (meet n (join n y x) z)) (meet n x (join n y z))) *)
intros Hx Hy Hz.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite meet_hom_com with (k2 := k2) (k1 := (k1 + 1)%nat); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite splitlr with (k1 := k1) (k2 := k2); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite sub_add, !scal_addEr, <-!scal_multE; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply f_equal2 with (f := add n); auto.
rewrite join_hom_com with (1 := Hz) (2 := Hy), !Mult.mult_1_r, meet_scalr,
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
        <-scal_multE, <-expK_add; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite meet_hom_com with (k1 := k1) (k2 := (k2 + 1)%nat) (x := x); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite <-scal_multE, <-!expK_add; auto.
replace ((n + (k1 + 1)) * (n + k2) + (n + (k1 + k2).+1) + k2)%nat with
        (2* k2 + (n + k2.+1 + (n + k1) * (n + (k2 + 1))))%nat by ring.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite !expKm1_2E; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite meet_hom_com with (k1 := k1) (k2 := k2) (x := x); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
Krm1; rewrite <-expKS, join_scall, <- scal_multE, <-expK_add; auto.
replace ((n + k2.+1).+1 + (n + k1) * (n + k2))%nat with
        (2 * 1 + ((n + (k1 + 1)) * (n + k2)))%nat by ring.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite expKm1_2E; auto.
Qed.

Lemma splitrl n k1 k2 x y z : hom n k1 x -> hom n 1 y ->  hom n k2 z ->
  z ∧ (y ∨ x) = (-(1))^(n + (k1 + k2).+1) .* (z ∨ y) ∧ x + y ∨ (z ∧ x).
Proof.
(* Goal: forall (_ : b2Prop (hom n k1 x)) (_ : b2Prop (hom n (S O) y)) (_ : b2Prop (hom n k2 z)), @Logic.eq (vect n) (join n y (meet n x z)) (addE (vn_eparams n) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n k2)) (meet n (join n y x) z)) (meet n x (join n y z))) *)
intros Hx Hy Hz.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite meet_hom_com with (k2 := k2) (k1 := (1 + k1)%nat); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite splitll with (k1 := k1) (k2 := k2); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite sub_add, !scal_addEr, <-!scal_multE; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply f_equal2 with (f := add n); auto.
rewrite join_hom_com with (1 := Hz) (2 := Hy), !Mult.mult_1_r, meet_scalr,
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
        <-scal_multE, <-expK_add; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite meet_hom_com with (k1 := k1) (k2 := (k2 + 1)%nat) (x := x); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite meet_scalr, <-scal_multE, <-!expK_add; auto.
replace ((n + (1 + k1)) * (n + k2) + (n + k2.+1) + k2)%nat with
        (2 * k2 + (n * n + n * k1 + n * k2 + 2 * n + k1 * k2 + k2 + 1))%nat by ring.
replace ((n + k1) * (n + (k2 + 1)) + (n + (k1 + k2).+1))%nat with
        (2 * k1 + (n * n + n * k1 + n * k2 + 2 * n + k1 * k2 + k2 + 1))%nat by ring.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite !expKm1_2E; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite meet_hom_com with (k1 := k1) (k2 := k2) (x := x); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
Krm1; rewrite opp_multKl, <-expKS, join_scalr, <-!expK_add; auto.
replace (((n + (1 + k1)) * (n + k2)).+1 + (n + k2.+1))%nat with 
        (2 * (n + k2 + 1) + (n + k1) * (n + k2))%nat by ring.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite !expKm1_2E; auto.
Qed.

Lemma inter n k1 k2 x y z : hom n 1 x -> hom n k1 y ->  hom n k2 z ->
  x ∨ y = 0 -> x ∨ z = 0 -> x ∨ (y ∧ z) = 0.
Proof.
(* Goal: forall (_ : b2Prop (hom n (S O) x)) (_ : b2Prop (hom n k1 y)) (_ : b2Prop (hom n k2 z)) (_ : @Logic.eq (vect n) (join n x y) (E0 (vn_eparams n))) (_ : @Logic.eq (vect n) (join n x z) (E0 (vn_eparams n))), @Logic.eq (vect n) (join n x (meet n y z)) (E0 (vn_eparams n)) *)
intros Hx Hy Hz Hxy Hxz.
generalize  (splitll n k1 k2 y x z Hy Hx Hz).
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n (E0 (vn_eparams n)) y2) (join n (genk n (const n x2)) (genk n (const n y1)))) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n (E0 (vn_eparams n)) y2) (join n (genk n (const n x2)) (genk n (const n y1)))) z2) (addE (vn_eparams n) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n (S (Nat.add O k2)))) (meet n (genk n (const n x2)) (join n y2 (dconj n false z1)))) (join n (meet n (genk n (const n x2)) (dconj n false z1)) y2)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add O (S k2)))))) (meet n (E0 (vn_eparams n)) (addE (vn_eparams n) (join n (genk n (const n y1)) z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n (E0 (vn_eparams n)) z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) z2) (meet n (genk n (const n x2)) (dconj n false z1)))) (genk n (const n y1))))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add O (S k2)))))) (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) (join n y2 z2)) (meet n (genk n (const n x2)) (dconj n false (addE (vn_eparams n) (join n (genk n (const n y1)) z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) z2) (meet n (genk n (const n x2)) (dconj n false z1))) y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (eq0 n z1) (hom n O z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (hom n k2 z1) (hom n (S k2) z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
rewrite Hxy, Hxz; Grm0.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite <-scal_multE; Krm1; rewrite <-expKS; auto.
(* Goal: forall _ : @Logic.eq (vect n) (E0 (vn_eparams n)) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (S (Nat.add n (S k2)))) (join n x (meet n y z))), @Logic.eq (vect n) (join n x (meet n y z)) (E0 (vn_eparams n)) *)
intros H.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
case (scalE_integral _ (fn n) _ _ (sym_equal H)); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros HH; contradict HH; apply expKm1_n0; auto.
Qed.

Lemma join_meet_distrl n k1 k2 x y z :
   hom n k1 x -> hom n 1 y ->  hom n k2 z ->
    y ∨ (x ∧ z) = (-(1))^(n + k2) .* ((y ∨ x) ∧ z)  +  x ∧ (y ∨ z).
Proof.
(* Goal: forall (_ : b2Prop (hom n k1 x)) (_ : b2Prop (hom n (S O) y)) (_ : b2Prop (hom n k2 z)), @Logic.eq (vect n) (join n y (meet n x z)) (addE (vn_eparams n) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n k2)) (meet n (join n y x) z)) (meet n x (join n y z))) *)
intros Hx Hy Hz.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite (splitll n k1 k2 x y z), sub_add, !scal_addEr; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite <-!scal_multE, <-expK_add; Krm1; rewrite <-expKS; auto.
replace (n + k2 + (n + k2.+1))%nat with (2 * (n + k2) + 1)%nat by ring.
(* Goal: @Logic.eq (Field.K (K1 p)) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n (S (Nat.add (S k1) k2)))) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (S (Nat.add n (S (Nat.add (S k1) k2)))))) *)
(* Goal: @Logic.eq (vect n) (meet n x2 (join n y2 (dconj n false z1))) (meet n x2 (dconj n false (join n (conj n false y2) z1))) *)
rewrite expKm1_2E, !expKS, expKm1_2E, expKS; simpl expK; Krm1.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n (E0 (vn_eparams n)) y2) (join n (genk n (const n x2)) (genk n (const n y1)))) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n (E0 (vn_eparams n)) y2) (join n (genk n (const n x2)) (genk n (const n y1)))) z2) (addE (vn_eparams n) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n (S (Nat.add O k2)))) (meet n (genk n (const n x2)) (join n y2 (dconj n false z1)))) (join n (meet n (genk n (const n x2)) (dconj n false z1)) y2)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add O (S k2)))))) (meet n (E0 (vn_eparams n)) (addE (vn_eparams n) (join n (genk n (const n y1)) z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n (E0 (vn_eparams n)) z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) z2) (meet n (genk n (const n x2)) (dconj n false z1)))) (genk n (const n y1))))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add O (S k2)))))) (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) (join n y2 z2)) (meet n (genk n (const n x2)) (dconj n false (addE (vn_eparams n) (join n (genk n (const n y1)) z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) z2) (meet n (genk n (const n x2)) (dconj n false z1))) y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (eq0 n z1) (hom n O z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (hom n k2 z1) (hom n (S k2) z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
rewrite addE_com, <-addE_assoc, scalE1, scal_addE0; Grm0.
Qed.

Lemma meet_join_distrl n k1 k2 x y z :
  hom n k1 x -> hom n 1 y ->  hom n k2 z ->
  '@y ∧ (x ∨ z) = (-(1))^k2 .* (('@y ∧ x) ∨ z)  +  x ∨ ('@y ∧ z).
Proof.
(* Goal: forall (_ : b2Prop (hom n k1 x)) (_ : b2Prop (hom n (S O) y)) (_ : b2Prop (hom n k2 z)), @Logic.eq (vect n) (join n y (meet n x z)) (addE (vn_eparams n) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n k2)) (meet n (join n y x) z)) (meet n x (join n y z))) *)
intros Hx Hy Hz.
case (Lt.le_or_lt n 0); intros Hn.
destruct n.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n (E0 (vn_eparams n)) y2) (join n (genk n (const n x2)) (genk n (const n y1)))) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n (E0 (vn_eparams n)) y2) (join n (genk n (const n x2)) (genk n (const n y1)))) z2) (addE (vn_eparams n) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n (S (Nat.add O k2)))) (meet n (genk n (const n x2)) (join n y2 (dconj n false z1)))) (join n (meet n (genk n (const n x2)) (dconj n false z1)) y2)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add O (S k2)))))) (meet n (E0 (vn_eparams n)) (addE (vn_eparams n) (join n (genk n (const n y1)) z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n (E0 (vn_eparams n)) z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) z2) (meet n (genk n (const n x2)) (dconj n false z1)))) (genk n (const n y1))))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add O (S k2)))))) (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) (join n y2 z2)) (meet n (genk n (const n x2)) (dconj n false (addE (vn_eparams n) (join n (genk n (const n y1)) z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) z2) (meet n (genk n (const n x2)) (dconj n false z1))) y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (eq0 n z1) (hom n O z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (hom n k2 z1) (hom n (S k2) z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
rewrite hom_lt with (2 := Hy); Grm0.
(* Goal: lt (Nat.add O k2) n *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (eq0 n y1) (hom n O y2))) (_ : lt (Nat.add (S k1) O) (S n)), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n x1 y1) (addE (vn_eparams n) (meet n x1 y2) (meet n x2 (dconj n false y1)))) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (E0 (vn_eparams n))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n k2 y1) (hom n (S k2) y2))) (_ : lt (Nat.add (S k1) (S k2)) (S n)), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n x1 y1) (addE (vn_eparams n) (meet n x1 y2) (meet n x2 (dconj n false y1)))) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (E0 (vn_eparams n))) *)
contradict Hn; auto with arith.
case (Lt.le_or_lt k1 n); intros Hk1.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n (E0 (vn_eparams n)) y2) (join n (genk n (const n x2)) (genk n (const n y1)))) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n (E0 (vn_eparams n)) y2) (join n (genk n (const n x2)) (genk n (const n y1)))) z2) (addE (vn_eparams n) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n (S (Nat.add O k2)))) (meet n (genk n (const n x2)) (join n y2 (dconj n false z1)))) (join n (meet n (genk n (const n x2)) (dconj n false z1)) y2)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add O (S k2)))))) (meet n (E0 (vn_eparams n)) (addE (vn_eparams n) (join n (genk n (const n y1)) z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n (E0 (vn_eparams n)) z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) z2) (meet n (genk n (const n x2)) (dconj n false z1)))) (genk n (const n y1))))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add O (S k2)))))) (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) (join n y2 z2)) (meet n (genk n (const n x2)) (dconj n false (addE (vn_eparams n) (join n (genk n (const n y1)) z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) z2) (meet n (genk n (const n x2)) (dconj n false z1))) y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (eq0 n z1) (hom n O z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (hom n k2 z1) (hom n (S k2) z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
2: rewrite hom_lt with (2 := Hx); Grm0.
case (Lt.le_or_lt k2 n); intros Hk2.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n (E0 (vn_eparams n)) y2) (join n (genk n (const n x2)) (genk n (const n y1)))) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n (E0 (vn_eparams n)) y2) (join n (genk n (const n x2)) (genk n (const n y1)))) z2) (addE (vn_eparams n) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n (S (Nat.add O k2)))) (meet n (genk n (const n x2)) (join n y2 (dconj n false z1)))) (join n (meet n (genk n (const n x2)) (dconj n false z1)) y2)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add O (S k2)))))) (meet n (E0 (vn_eparams n)) (addE (vn_eparams n) (join n (genk n (const n y1)) z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n (E0 (vn_eparams n)) z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) z2) (meet n (genk n (const n x2)) (dconj n false z1)))) (genk n (const n y1))))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add O (S k2)))))) (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) (join n y2 z2)) (meet n (genk n (const n x2)) (dconj n false (addE (vn_eparams n) (join n (genk n (const n y1)) z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) z2) (meet n (genk n (const n x2)) (dconj n false z1))) y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (eq0 n z1) (hom n O z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (hom n k2 z1) (hom n (S k2) z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
2: rewrite hom_lt with (2 := Hz); Grm0.
pattern x at 1; rewrite dual_invoE with (1 := Hx).
pattern z at 1; rewrite dual_invoE with (1 := Hz).
rewrite !join_scalr, !join_scall, !meet_scalr.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite <-dual_meet, <-dual_join; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite (join_meet_distrl n (n - k1) (n- k2) '@x y '@z); auto.
rewrite dual_add, dual_scal, !dual_meet, !dual_join.
rewrite <-scal_multE, scal_addEr, <-scal_multE, multK_com,
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
        <-multK_assoc, !scal_multE; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite <-join_scall, <-meet_scalr, <-dual_invoE; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite <-join_scalr, <-dual_invoE; auto.
(* Goal: @Logic.eq (vect n) (addE (vn_eparams n) (meet n v4 (dconj n false v1)) (meet n v3 v2)) (addE (vn_eparams n) (meet n v3 v2) (meet n v4 (dconj n false v1))) *)
rewrite addE_com; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite <-join_scall, <-dual_invoE; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite <-join_scalr, <-meet_scalr, <-dual_invoE; auto.
(* Goal: @Logic.eq (vect n) (addE (vn_eparams n) (meet n v4 (dconj n false v1)) (meet n v3 v2)) (addE (vn_eparams n) (meet n v3 v2) (meet n v4 (dconj n false v1))) *)
rewrite addE_com; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite expK_add, expKm1_sub, <-expK_add; auto.
replace (n + (n + k2))%nat with (2 * n + k2)%nat by ring.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite expKm1_2E; auto.
Qed.
 
Lemma grade_dual n k x : k < n -> grade n k x -> grade n (n - k) '@x.
assert (dual_aux: forall n x l, hom n 1 x -> is_vector_space n l ->
 (forall y, In y l -> '@x ∧ y = 0) -> '@x ∧ joinl n l = 0).
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n (E0 (vn_eparams n)) y2) (join n (genk n (const n x2)) (genk n (const n y1)))) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n (E0 (vn_eparams n)) y2) (join n (genk n (const n x2)) (genk n (const n y1)))) z2) (addE (vn_eparams n) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n (S (Nat.add O k2)))) (meet n (genk n (const n x2)) (join n y2 (dconj n false z1)))) (join n (meet n (genk n (const n x2)) (dconj n false z1)) y2)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add O (S k2)))))) (meet n (E0 (vn_eparams n)) (addE (vn_eparams n) (join n (genk n (const n y1)) z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n (E0 (vn_eparams n)) z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) z2) (meet n (genk n (const n x2)) (dconj n false z1)))) (genk n (const n y1))))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add O (S k2)))))) (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) (join n y2 z2)) (meet n (genk n (const n x2)) (dconj n false (addE (vn_eparams n) (join n (genk n (const n y1)) z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) z2) (meet n (genk n (const n x2)) (dconj n false z1))) y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (eq0 n z1) (hom n O z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (hom n k2 z1) (hom n (S k2) z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
intros n1 x1 l Hx; induction l as [|y l IH]; simpl; Vfold n; Grm0.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros Hv Hr; destruct l as [|b l1]; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite meet_join_distrl with (k1 := 1%nat) (k2 := length (b:: l1)); auto.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n (E0 (vn_eparams n)) y2) (join n (genk n (const n x2)) (genk n (const n y1)))) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n (E0 (vn_eparams n)) y2) (join n (genk n (const n x2)) (genk n (const n y1)))) z2) (addE (vn_eparams n) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n (S (Nat.add O k2)))) (meet n (genk n (const n x2)) (join n y2 (dconj n false z1)))) (join n (meet n (genk n (const n x2)) (dconj n false z1)) y2)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add O (S k2)))))) (meet n (E0 (vn_eparams n)) (addE (vn_eparams n) (join n (genk n (const n y1)) z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n (E0 (vn_eparams n)) z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) z2) (meet n (genk n (const n x2)) (dconj n false z1)))) (genk n (const n y1))))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add O (S k2)))))) (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) (join n y2 z2)) (meet n (genk n (const n x2)) (dconj n false (addE (vn_eparams n) (join n (genk n (const n y1)) z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) z2) (meet n (genk n (const n x2)) (dconj n false z1))) y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (eq0 n z1) (hom n O z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (hom n k2 z1) (hom n (S k2) z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
rewrite Hr, IH; Grm0.
intros u Hu; apply Hv; auto with datatypes.
rewrite <-cbl1_hom1_equiv; apply Hv; auto with datatypes.
apply joinl_hom1; intros u Hu.
rewrite <-cbl1_hom1_equiv; apply Hv; auto with datatypes.
assert (dual_aux_rec: forall n x l, hom n 1 x -> is_vector_space n l ->
 '@x ∧ joinl n l = 0  \/ (exists y, In y l /\ '@x ∧ y <> 0)).
intros n1 x1 l H1 H2.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
case (list_dec _ (fun y => '@x1 ∧ y = 0) l); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros y; case (eqE_spec _ (fn n1) ('@x1 ∧ y) 0); auto.
(* Goal: @Logic.eq (vect (S n)) (mcontra (S n) (@map (kn p n) (kn p (S n)) (Kn.lift p n) lfs1) (lift n x)) (lift n (mcontra n lfs1 x)) *)
generalize x; clear x.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
induction k as [|k IH]; auto.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n (E0 (vn_eparams n)) y2) (join n (genk n (const n x2)) (genk n (const n y1)))) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n (E0 (vn_eparams n)) y2) (join n (genk n (const n x2)) (genk n (const n y1)))) z2) (addE (vn_eparams n) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n (S (Nat.add O k2)))) (meet n (genk n (const n x2)) (join n y2 (dconj n false z1)))) (join n (meet n (genk n (const n x2)) (dconj n false z1)) y2)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add O (S k2)))))) (meet n (E0 (vn_eparams n)) (addE (vn_eparams n) (join n (genk n (const n y1)) z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n (E0 (vn_eparams n)) z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) z2) (meet n (genk n (const n x2)) (dconj n false z1)))) (genk n (const n y1))))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add O (S k2)))))) (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) (join n y2 z2)) (meet n (genk n (const n x2)) (dconj n false (addE (vn_eparams n) (join n (genk n (const n y1)) z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) z2) (meet n (genk n (const n x2)) (dconj n false z1))) y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (eq0 n z1) (hom n O z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (hom n k2 z1) (hom n (S k2) z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
intros x Hn Hx; rewrite (grade0E _ _ Hx); Grm0.
apply grade0.
intros x Hn; rewrite !gradeE; intros (Hx, ([|a l], (H1l,H2l))); 
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
  subst; try discriminate; split; auto.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n (E0 (vn_eparams n)) y2) (join n (genk n (const n x2)) (genk n (const n y1)))) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n (E0 (vn_eparams n)) y2) (join n (genk n (const n x2)) (genk n (const n y1)))) z2) (addE (vn_eparams n) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n (S (Nat.add O k2)))) (meet n (genk n (const n x2)) (join n y2 (dconj n false z1)))) (join n (meet n (genk n (const n x2)) (dconj n false z1)) y2)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add O (S k2)))))) (meet n (E0 (vn_eparams n)) (addE (vn_eparams n) (join n (genk n (const n y1)) z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n (E0 (vn_eparams n)) z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) z2) (meet n (genk n (const n x2)) (dconj n false z1)))) (genk n (const n y1))))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add O (S k2)))))) (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) (join n y2 z2)) (meet n (genk n (const n x2)) (dconj n false (addE (vn_eparams n) (join n (genk n (const n y1)) z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) z2) (meet n (genk n (const n x2)) (dconj n false z1))) y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (eq0 n z1) (hom n O z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (hom n k2 z1) (hom n (S k2) z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
exists nil; split; Grm0.
assert (Hn1: 0 < n)
   by (destruct n; auto with arith; contradict Hn; auto with arith).
assert (Ha: hom n 1 a); auto with datatypes.
case (eqE_spec _ (fn n) (joinl n (a :: l)) 0); intros Hal.
rewrite Hal; exists nil; split; Grm0; intros y [].
case (homE _  _ (length (a::l)) _ Hx).
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply joinl_hom1; auto.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n (E0 (vn_eparams n)) y2) (join n (genk n (const n x2)) (genk n (const n y1)))) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n (E0 (vn_eparams n)) y2) (join n (genk n (const n x2)) (genk n (const n y1)))) z2) (addE (vn_eparams n) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n (S (Nat.add O k2)))) (meet n (genk n (const n x2)) (join n y2 (dconj n false z1)))) (join n (meet n (genk n (const n x2)) (dconj n false z1)) y2)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add O (S k2)))))) (meet n (E0 (vn_eparams n)) (addE (vn_eparams n) (join n (genk n (const n y1)) z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n (E0 (vn_eparams n)) z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) z2) (meet n (genk n (const n x2)) (dconj n false z1)))) (genk n (const n y1))))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add O (S k2)))))) (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) (join n y2 z2)) (meet n (genk n (const n x2)) (dconj n false (addE (vn_eparams n) (join n (genk n (const n y1)) z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) z2) (meet n (genk n (const n x2)) (dconj n false z1))) y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (eq0 n z1) (hom n O z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (hom n k2 z1) (hom n (S k2) z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
2: intros HH; rewrite HH; exists nil; Grm0.
2: split; auto; intros y [].
intros HH; injection HH; clear HH; intros Hk.
assert (F1: exists l1, is_vector_space n l1 /\ 
     '@(joinl n (a::l)) = '@a ∧ joinl n l1).
destruct l.
exists (base n 1).
(* Goal: iff (b2Prop (hom n k (joinl n l))) (and (b2Prop (hom n k (joinl n l))) (@ex (list (vect n)) (fun l0 : list (vect n) => and (@Logic.eq (vect n) (joinl n l) (joinl n l0)) (forall (y : vect n) (_ : @In (vect n) y l0), b2Prop (hom n (S O) y))))) *)
(* Goal: forall _ : not (is_decomposable n x), iff (b2Prop false) (and (b2Prop (hom n k x)) (@ex (list (vect n)) (fun l : list (vect n) => and (@Logic.eq (vect n) x (joinl n l)) (forall (y : vect n) (_ : @In (vect n) y l), b2Prop (hom n (S O) y))))) *)
split.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros u Hu; constructor; auto.
(* Goal: lt (Nat.add O k2) n *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (eq0 n y1) (hom n O y2))) (_ : lt (Nat.add (S k1) O) (S n)), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n x1 y1) (addE (vn_eparams n) (meet n x1 y2) (meet n x2 (dconj n false y1)))) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (E0 (vn_eparams n))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n k2 y1) (hom n (S k2) y2))) (_ : lt (Nat.add (S k1) (S k2)) (S n)), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n x1 y1) (addE (vn_eparams n) (meet n x1 y2) (meet n x2 (dconj n false y1)))) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (E0 (vn_eparams n))) *)
rewrite joinl_all, meet_allr; auto with arith.
assert (F1: grade n k  (joinl n (v::l))).
(* Goal: iff (b2Prop (hom n k (joinl n l))) (and (b2Prop (hom n k (joinl n l))) (@ex (list (vect n)) (fun l0 : list (vect n) => and (@Logic.eq (vect n) (joinl n l) (joinl n l0)) (forall (y : vect n) (_ : @In (vect n) y l0), b2Prop (hom n (S O) y))))) *)
(* Goal: forall _ : not (is_decomposable n x), iff (b2Prop false) (and (b2Prop (hom n k x)) (@ex (list (vect n)) (fun l : list (vect n) => and (@Logic.eq (vect n) x (joinl n l)) (forall (y : vect n) (_ : @In (vect n) y l), b2Prop (hom n (S O) y))))) *)
rewrite gradeE; split.
rewrite Hk; apply joinl_hom1; auto with datatypes.
exists (v::l); split; auto with datatypes.
(* Goal: lt (Nat.add O k2) n *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (eq0 n y1) (hom n O y2))) (_ : lt (Nat.add (S k1) O) (S n)), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n x1 y1) (addE (vn_eparams n) (meet n x1 y2) (meet n x2 (dconj n false y1)))) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (E0 (vn_eparams n))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n k2 y1) (hom n (S k2) y2))) (_ : lt (Nat.add (S k1) (S k2)) (S n)), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n x1 y1) (addE (vn_eparams n) (meet n x1 y2) (meet n x2 (dconj n false y1)))) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (E0 (vn_eparams n))) *)
assert (F2: k < n); auto with arith.
generalize (IH _ F2 F1); rewrite gradeE; intros (_,(l1,(H1l1,H2l1))).
(* Goal: iff (b2Prop (hom n k (joinl n l))) (and (b2Prop (hom n k (joinl n l))) (@ex (list (vect n)) (fun l0 : list (vect n) => and (@Logic.eq (vect n) (joinl n l) (joinl n l0)) (forall (y : vect n) (_ : @In (vect n) y l0), b2Prop (hom n (S O) y))))) *)
(* Goal: forall _ : not (is_decomposable n x), iff (b2Prop false) (and (b2Prop (hom n k x)) (@ex (list (vect n)) (fun l : list (vect n) => and (@Logic.eq (vect n) x (joinl n l)) (forall (y : vect n) (_ : @In (vect n) y l), b2Prop (hom n (S O) y))))) *)
exists l1; split.
(* Goal: cbl (vn_eparams n) (base n (S O)) b *)
(* Goal: @ex (Field.K (stype (vn_eparams n))) (fun k : Field.K (stype (vn_eparams n)) => @ex (list (vect n)) (fun l0 : list (vect n) => and (forall (v : vect n) (_ : @In (vect n) v l0), b2Prop (hom n (S O) v)) (@Logic.eq (E (vn_eparams n)) (joinl n (@cons (E (vn_eparams n)) b l)) (scalE (vn_eparams n) k (joinl n (@cons (E (vn_eparams n)) (mprod (vn_eparams n) (@cons (Field.K (stype (vn_eparams n))) a ll) (@cons (E (vn_eparams n)) b l)) l0)))))) *)
intros u Hu; red; rewrite cbl1_hom1_equiv; auto with datatypes.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite joinlS, dual_join, H1l1; auto.
(* Goal: b2Prop false *)
intros HH; discriminate.
case F1; intros l1 (H1l1,H2l1).
rewrite H2l1.
case (dual_aux_rec n a l1); auto with datatypes.
intros HH; rewrite HH.
exists nil; split; auto; intros y [].
intros (b, (H1b,H2b)).
assert (Hb: hom n 1 b) by
  (rewrite <-cbl1_hom1_equiv; apply H1l1; auto with datatypes).
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
case (is_vector_space_swap n b l1); auto.
intros l2 (H1l2,H2l2); rewrite H2l2.
destruct l2 as [|c l2].
assert (F2: hom n 0 '@(joinl n (a :: l))).
rewrite H2l1, H2l2; simpl.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
replace 0%nat with ((n - 1) + 1 - n)%nat; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite Plus.plus_comm, <-Minus.le_plus_minus, <-Minus.minus_n_n; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
case (homE n n k.+1 (joinl n (a :: l))); auto.
rewrite dual_invoE with (1 := Hx).
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
pattern n at 2; replace n with (n - 0)%nat; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite <-Minus.minus_n_O; auto.
(* Goal: lt (Nat.add O k2) n *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (eq0 n y1) (hom n O y2))) (_ : lt (Nat.add (S k1) O) (S n)), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n x1 y1) (addE (vn_eparams n) (meet n x1 y2) (meet n x2 (dconj n false y1)))) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (E0 (vn_eparams n))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n k2 y1) (hom n (S k2) y2))) (_ : lt (Nat.add (S k1) (S k2)) (S n)), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n x1 y1) (addE (vn_eparams n) (meet n x1 y2) (meet n x2 (dconj n false y1)))) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (E0 (vn_eparams n))) *)
intros; subst n; contradict Hn; auto with arith.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros H1a; case Hal; auto.
assert (Hc: hom n 1 c) by
  (rewrite <-cbl1_hom1_equiv; apply H1l2; auto with datatypes).
pose (f := fun x => 'C['@a ∧ x]).
exists (((- (1)) ^ length (c :: l2) * f b) .* (c + (-(1) * f c * (f b)^-1) .* b) ::
        map (fun x => x + (-(1) * f x * (f b)^-1) .* b) l2).
(* Goal: iff (b2Prop (hom n k (joinl n l))) (and (b2Prop (hom n k (joinl n l))) (@ex (list (vect n)) (fun l0 : list (vect n) => and (@Logic.eq (vect n) (joinl n l) (joinl n l0)) (forall (y : vect n) (_ : @In (vect n) y l0), b2Prop (hom n (S O) y))))) *)
(* Goal: forall _ : not (is_decomposable n x), iff (b2Prop false) (and (b2Prop (hom n k x)) (@ex (list (vect n)) (fun l : list (vect n) => and (@Logic.eq (vect n) x (joinl n l)) (forall (y : vect n) (_ : @In (vect n) y l), b2Prop (hom n (S O) y))))) *)
split.
assert (F2: forall y, hom n 1 y -> '@a ∧ y = ['C['@a ∧ y]]).
intros y Hy; apply hom0E.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
replace 0%nat with ((n - 1) + 1 - n)%nat; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite Plus.plus_comm, <-Minus.le_plus_minus, <-Minus.minus_n_n; auto.
replace (joinl n (b :: c :: l2)) with
      (joinl n (b::(c + (-(1) * f c * f b ^-1) .* b)::
             map (fun x : vect n => x + (-(1) * f x * f b ^-1) .* b) l2)).
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite joinlS; auto.
(* Goal: b2Prop false *)
2: intros HH; discriminate.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite (meet_join_distrl n 1 (length (c::l2))); auto.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n (E0 (vn_eparams n)) y2) (join n (genk n (const n x2)) (genk n (const n y1)))) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n (E0 (vn_eparams n)) y2) (join n (genk n (const n x2)) (genk n (const n y1)))) z2) (addE (vn_eparams n) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n (S (Nat.add O k2)))) (meet n (genk n (const n x2)) (join n y2 (dconj n false z1)))) (join n (meet n (genk n (const n x2)) (dconj n false z1)) y2)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add O (S k2)))))) (meet n (E0 (vn_eparams n)) (addE (vn_eparams n) (join n (genk n (const n y1)) z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n (E0 (vn_eparams n)) z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) z2) (meet n (genk n (const n x2)) (dconj n false z1)))) (genk n (const n y1))))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add O (S k2)))))) (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) (join n y2 z2)) (meet n (genk n (const n x2)) (dconj n false (addE (vn_eparams n) (join n (genk n (const n y1)) z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) z2) (meet n (genk n (const n x2)) (dconj n false z1))) y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (eq0 n z1) (hom n O z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (hom n k2 z1) (hom n (S k2) z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
rewrite addE_com, dual_aux; Grm0.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite (F2 b); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite joinkl, !joinl_scal, !scal_multE; auto.
intros y Hy; case in_inv with (1 := Hy).
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros; subst; auto.
red; apply VectorSpace.cbl_add.
apply H1l2; auto with datatypes.
apply VectorSpace.cbl_scal; apply H1l2; auto with datatypes.
rewrite in_map_iff; intros (u, (H1u,H2u)); subst.
red; apply VectorSpace.cbl_add.
apply H1l2; auto with datatypes.
apply VectorSpace.cbl_scal.
apply H1l2; auto with datatypes.
intros y Hy; case in_inv with (1 := Hy).
intros HH; subst.
rewrite meet_addr, !meet_scalr.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite (F2 c), (F2 b); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
unfold f; rewrite !scalk, addk, !multK_assoc; auto.
rewrite invKr, multK1r; Krm1.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite oppKr; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros HH; case H2b; rewrite F2, HH; auto.
rewrite in_map_iff; intros (u, (H1u,H2u)); subst.
rewrite  meet_addr, !meet_scalr.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite (F2 u), (F2 b); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
unfold f; rewrite !scalk, addk, !multK_assoc; auto.
rewrite invKr, multK1r; Krm1.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite oppKr; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros HH; case H2b; rewrite F2, HH; auto.
rewrite <-cbl1_hom1_equiv; apply H1l2; auto with datatypes.
replace (length (c::l2)) with
  (length (c + (-(1) * f c * f b ^-1) .* b
      :: map (fun x : vect n => x + (-(1) * f x * f b ^-1) .* b) l2)).
apply joinl_hom1.
intros y Hy; case in_inv with (1 := Hy).
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros HH; subst; auto.
rewrite in_map_iff; intros (u, (H1u,H2u)); subst.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply add_hom; auto.
rewrite <-cbl1_hom1_equiv; apply H1l2; auto with datatypes.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
simpl; rewrite map_length; auto.
(* Goal: cbl n (@cons (vect n) a (@cons (vect n) b l)) (Nat.pred (@length (vect n) (@cons (vect n) a (@cons (vect n) b l)))) (joinl n (@cons (vect n) a (@cons (vect n) b l))) *)
rewrite joinlS.
(* Goal: cbl n (@cons (vect n) a (@cons (vect n) b l)) (Nat.pred (@length (vect n) (@cons (vect n) a (@cons (vect n) b l)))) (joinl n (@cons (vect n) a (@cons (vect n) b l))) *)
apply sym_equal; rewrite joinlS.
change (c + (-(1) * f c * f b ^-1) .* b
      :: map (fun x : vect n => x + (-(1) * f x * f b ^-1) .* b) l2) with
       (map (fun x : vect n => x + (-(1) * f x * f b ^-1) .* b) (c::l2)).
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply joinl_addmult with (f:= fun b x: vect n => (-(1) * f x * f b ^-1)%f); auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
simpl; intros i [[]|Hi]; auto.
rewrite <-cbl1_hom1_equiv; apply H1l2; auto with datatypes.
(* Goal: b2Prop false *)
intros HH; discriminate.
(* Goal: b2Prop false *)
intros HH; discriminate.
intros y Hy; case in_inv with (1 := Hy).
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
intros; subst; auto.
rewrite in_map_iff; intros (u, (H1u,H2u)); subst.
apply add_hom.
rewrite <-cbl1_hom1_equiv; apply H1l2; auto with datatypes.
apply scal_hom.
rewrite <-cbl1_hom1_equiv; apply H1l2; auto with datatypes.
Qed.

Lemma grade_meet n k1 k2 x y : n < k1 + k2 ->
  grade n k1 x -> grade n k2 y -> grade n (k1 + k2 - n) (x ∧ y).
Proof.
intros Hk1Hk2 Hx Hy.
assert (Hmx: hom n k1 x) by (apply grade_hom; auto).
assert (Hmy: hom n k2 y) by (apply grade_hom; auto).
case (Lt.le_or_lt k1 n); intros Hk1.
2: rewrite hom_lt with (1 := Hk1)(2:= Hmx); Grm0; apply grade0.
case (Lt.le_lt_or_eq _ _ Hk1); intros H1k1; subst.
2: rewrite homn_all with (1 := Hmx), meet_scall, meet_alll.
(* Goal: lt (Nat.add O k2) n *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (eq0 n y1) (hom n O y2))) (_ : lt (Nat.add (S k1) O) (S n)), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n x1 y1) (addE (vn_eparams n) (meet n x1 y2) (meet n x2 (dconj n false y1)))) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (E0 (vn_eparams n))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n k2 y1) (hom n (S k2) y2))) (_ : lt (Nat.add (S k1) (S k2)) (S n)), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n x1 y1) (addE (vn_eparams n) (meet n x1 y2) (meet n x2 (dconj n false y1)))) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (E0 (vn_eparams n))) *)
2: apply grade_scal; rewrite Minus.minus_plus; auto with arith.
case (Lt.le_or_lt k2 n); intros Hk2.
2: rewrite hom_lt with (1 := Hk2)(2:= Hmy); Grm0; apply grade0.
case (Lt.le_lt_or_eq _ _ Hk2); intros H1k2; subst.
2: rewrite homn_all with (1 := Hmy), meet_scalr, meet_allr.
(* Goal: lt (Nat.add O k2) n *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (eq0 n y1) (hom n O y2))) (_ : lt (Nat.add (S k1) O) (S n)), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n x1 y1) (addE (vn_eparams n) (meet n x1 y2) (meet n x2 (dconj n false y1)))) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (E0 (vn_eparams n))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n k2 y1) (hom n (S k2) y2))) (_ : lt (Nat.add (S k1) (S k2)) (S n)), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n x1 y1) (addE (vn_eparams n) (meet n x1 y2) (meet n x2 (dconj n false y1)))) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (E0 (vn_eparams n))) *)
2: apply grade_scal; rewrite Plus.plus_comm, Minus.minus_plus; auto with arith.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
replace (k1 + k2 - n)%nat with (n - ((n - k1) + (n - k2)))%nat; auto.
assert (F1: hom n (k1 + k2 - n) (x ∧ y)) by
  (rewrite gradeE in Hx, Hy; case Hx; case Hy; auto).
rewrite dual_invoE with (1 := F1).
apply grade_scal.
rewrite dual_meet.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply grade_dual; auto.
apply Plus.plus_lt_reg_l with k1.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite Plus.plus_assoc, <-Minus.le_plus_minus, Plus.plus_comm; auto.
apply Plus.plus_lt_compat_r.
apply Plus.plus_lt_reg_l with k2.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite <-Minus.le_plus_minus, Plus.plus_comm; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
apply grade_join; auto; apply grade_dual; auto.
rewrite Minus.minus_plus_simpl_l_reverse with (p := (k1 + k2)%nat).
rewrite (Plus.plus_comm k1), <-!Plus.plus_assoc, (Plus.plus_assoc k1).
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite <-Minus.le_plus_minus, !Plus.plus_assoc; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite !(Plus.plus_comm k2), <-!Plus.plus_assoc, <-Minus.le_plus_minus; auto.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite Plus.plus_assoc, (Plus.plus_comm (k1 + k2)); auto. 
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite <-Minus.minus_plus_simpl_l_reverse; auto.
Qed.

(* Defining the natural injection of Kn in Gn *)

Definition Kn := kn p.

Fixpoint k2g (n: nat) {struct n} : kn n ->  vect n :=
  match n return kn n -> vect n with 
    O => fun k => 0%f
  | S n1 => fun v => let (k, v1) := v in ([k], k2g n1 v1)
  end.

Notation "'v_ x" := (k2g _ x) (at level 9). 
Notation "'kn n" := (vn_eparams p (pred n)) (at level 10).

Lemma k2g0 n : 'v_0 = 0 :> vect n.
Proof.
(* Goal: @Logic.eq (vect n) (k2g n (E0 (Kn.vn_eparams p n))) (E0 (vn_eparams n)) *)
induction n as [|n IH]; simpl; auto.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (genk n (v0 (K p))) (k2g n (Kn.genk p n (v0 (K p))))) (@pair (vect n) (vect n) (genk n (v0 (K1 p))) (genk n (v0 (K1 p)))) *)
simpl in IH; rewrite IH; auto.
Qed.

Lemma k2g_add n x y : 'v_(x + y) = 'v_x + 'v_y :> vect n. 
Proof. 
(* Goal: forall _ : b2Prop (hom n (S O) x), @ex (kn p n) (fun y : kn p n => @Logic.eq (vect n) x (k2g n y)) *)
induction n as [|n IH]; simpl; Krm0.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (let (k, v1) := let (v1, l3) := x in let (v2, l4) := y in @pair (Field.K (K p)) (kn p n) (addK (K p) v1 v2) (Kn.add p n l3 l4) in @pair (vect n) (vect n) (genk n k) (k2g n v1)) (let (l3, l5) := let (k, v1) := x in @pair (vect n) (vect n) (genk n k) (k2g n v1) in let (l4, l6) := let (k, v1) := y in @pair (vect n) (vect n) (genk n k) (k2g n v1) in @pair (vect n) (vect n) (add n l3 l4) (add n l5 l6)) *)
destruct x as [k1 x]; destruct y as [k2 y]; simpl.
generalize (IH x y); simpl; intros HH; rewrite HH.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n (E0 (vn_eparams n)) y2) (join n (genk n (const n x2)) (genk n (const n y1)))) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n (E0 (vn_eparams n)) y2) (join n (genk n (const n x2)) (genk n (const n y1)))) z2) (addE (vn_eparams n) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n (S (Nat.add O k2)))) (meet n (genk n (const n x2)) (join n y2 (dconj n false z1)))) (join n (meet n (genk n (const n x2)) (dconj n false z1)) y2)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add O (S k2)))))) (meet n (E0 (vn_eparams n)) (addE (vn_eparams n) (join n (genk n (const n y1)) z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n (E0 (vn_eparams n)) z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) z2) (meet n (genk n (const n x2)) (dconj n false z1)))) (genk n (const n y1))))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add O (S k2)))))) (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) (join n y2 z2)) (meet n (genk n (const n x2)) (dconj n false (addE (vn_eparams n) (join n (genk n (const n y1)) z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) z2) (meet n (genk n (const n x2)) (dconj n false z1))) y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (eq0 n z1) (hom n O z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (hom n k2 z1) (hom n (S k2) z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
rewrite <-addk; Vfold n; Grm0.
Qed.

Lemma k2g_scal n k x : 'v_(k .* x) = (k: K) .* 'v_x :> vect n.
Proof.
(* Goal: forall _ : b2Prop (hom n (S O) x), @ex (kn p n) (fun y : kn p n => @Logic.eq (vect n) x (k2g n y)) *)
induction n as [|n IH]; simpl; Krm0.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (let (k, v1) := let (v1, l2) := x in @pair (Field.K (K p)) (kn p n) (multK (K p) k v1) (Kn.scal p n k l2) in @pair (vect n) (vect n) (genk n k) (k2g n v1)) (let (l2, l3) := let (k, v1) := x in @pair (vect n) (vect n) (genk n k) (k2g n v1) in @pair (vect n) (vect n) (scal n k l2) (scal n k l3)) *)
destruct x as [k1 x].
generalize (IH k x); simpl; intros HH; rewrite HH.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n (E0 (vn_eparams n)) y2) (join n (genk n (const n x2)) (genk n (const n y1)))) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n (E0 (vn_eparams n)) y2) (join n (genk n (const n x2)) (genk n (const n y1)))) z2) (addE (vn_eparams n) (scalE (vn_eparams n) (expK (stype (vn_eparams n)) (oppK (stype (vn_eparams n)) (v1 (stype (vn_eparams n)))) (Nat.add n (S (Nat.add O k2)))) (meet n (genk n (const n x2)) (join n y2 (dconj n false z1)))) (join n (meet n (genk n (const n x2)) (dconj n false z1)) y2)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add O (S k2)))))) (meet n (E0 (vn_eparams n)) (addE (vn_eparams n) (join n (genk n (const n y1)) z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n (E0 (vn_eparams n)) z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) z2) (meet n (genk n (const n x2)) (dconj n false z1)))) (genk n (const n y1))))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add O (S k2)))))) (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) (join n y2 z2)) (meet n (genk n (const n x2)) (dconj n false (addE (vn_eparams n) (join n (genk n (const n y1)) z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n (E0 (vn_eparams n)) z2) (meet n (genk n (const n x2)) (dconj n false z1))) y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (eq0 n z1) (hom n O z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) O))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n O y1) (hom n (S O) y2))) (_ : b2Prop (andb (hom n k2 z1) (hom n (S k2) z2))), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z1) (addE (vn_eparams n) (meet n (addE (vn_eparams n) (join n x1 y2) (join n (conj n false x2) y1)) z2) (meet n (join n x2 y2) (dconj n false z1)))) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (meet n x1 (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))) (addE (vn_eparams n) (join n (meet n x1 z1) y2) (join n (conj n false (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1)))) y1))) (addE (vn_eparams n) (scalE (vn_eparams n) (multK (K1 p) (oppK (K1 p) (v1 (K1 p))) (expK (K1 p) (oppK (K1 p) (v1 (K1 p))) (Nat.add n (S (Nat.add (S k1) (S k2)))))) (addE (vn_eparams n) (meet n x1 (join n y2 z2)) (meet n x2 (dconj n false (addE (vn_eparams n) (join n y1 z2) (join n (conj n false y2) z1)))))) (join n (addE (vn_eparams n) (meet n x1 z2) (meet n x2 (dconj n false z1))) y2))) *)
rewrite <-scalk; Vfold n; Grm0.
Qed.

Lemma k2g_unit n i : i < n -> 'v_('e_i)%Kn = 'e_i :> vect n.
Proof.
(* Goal: forall _ : lt i n, @Logic.eq (vect n) (k2g n (Kn.gen p n i)) (gen n i) *)
generalize i; clear i.
(* Goal: b2Prop (hom n (S O) (k2g n x)) *)
induction n as [|n IH]; Krm0.
(* Goal: lt (Nat.add O k2) n *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (eq0 n y1) (hom n O y2))) (_ : lt (Nat.add (S k1) O) (S n)), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n x1 y1) (addE (vn_eparams n) (meet n x1 y2) (meet n x2 (dconj n false y1)))) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (E0 (vn_eparams n))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n k2 y1) (hom n (S k2) y2))) (_ : lt (Nat.add (S k1) (S k2)) (S n)), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n x1 y1) (addE (vn_eparams n) (meet n x1 y2) (meet n x2 (dconj n false y1)))) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (E0 (vn_eparams n))) *)
intros i Hi; auto; contradict Hi; auto with arith.
intros [|i] Hi; simpl;
(* Goal: lt (Nat.add O k2) n *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (eq0 n y1) (hom n O y2))) (_ : lt (Nat.add (S k1) O) (S n)), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n x1 y1) (addE (vn_eparams n) (meet n x1 y2) (meet n x2 (dconj n false y1)))) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (E0 (vn_eparams n))) *)
(* Goal: forall (_ : b2Prop (andb (hom n k1 x1) (hom n (S k1) x2))) (_ : b2Prop (andb (hom n k2 y1) (hom n (S k2) y2))) (_ : lt (Nat.add (S k1) (S k2)) (S n)), @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (meet n x1 y1) (addE (vn_eparams n) (meet n x1 y2) (meet n x2 (dconj n false y1)))) (@pair (vect n) (vect n) (E0 (vn_eparams n)) (E0 (vn_eparams n))) *)
  rewrite ?k2g0; rewrite ?IH; auto with arith.
Qed.

Lemma k2g_hom n x : hom n 1 ('v_x).
Proof.
(* Goal: b2Prop (hom n (S O) (k2g n x)) *)
induction n as [|n IH]; Krm0.
(* Goal: forall _ : b2Prop (eqK (K1 p) M (v0 (K1 p))), b2Prop (eqK (K1 p) (v0 (K1 p)) (v0 (K1 p))) *)
(* Goal: forall _ : b2Prop (let (l2, l3) := M in andb (hom n O l2) (hom n (S O) l3)), b2Prop (let (l2, l3) := let (k, lf1) := lf in let (l2, l3) := M in @pair (vect n) (vect n) (scal n (oppK (K1 p) (v1 (K1 p))) (contra n lf1 l2)) (add n (scal n k l2) (contra n lf1 l3)) in andb (eq0 n l2) (hom n O l3)) *)
(* Goal: forall _ : b2Prop (let (l2, l3) := M in andb (hom n (S k1) l2) (hom n (S (S k1)) l3)), b2Prop (let (l2, l3) := let (k, lf1) := lf in let (l2, l3) := M in @pair (vect n) (vect n) (scal n (oppK (K1 p) (v1 (K1 p))) (contra n lf1 l2)) (add n (scal n k l2) (contra n lf1 l3)) in andb (hom n k1 l2) (hom n (S k1) l3)) *)
simpl; rewrite eqKI; auto.
(* Goal: b2Prop (hom (S n) (S O) (k2g (S n) x)) *)
destruct x as [k x]; simpl.
rewrite  hom0K; apply (IH x).
Qed.

Lemma hom1E n x : hom n 1 x -> exists y, x = 'v_y.
Proof.
(* Goal: forall _ : b2Prop (hom n (S O) x), @ex (kn p n) (fun y : kn p n => @Logic.eq (vect n) x (k2g n y)) *)
induction n as [|n IH]; simpl; Krm0.
(* Goal: b2Prop false *)
case eqK_spec; auto; intros; subst; try discriminate.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
exists tt; auto.
(* Goal: forall _ : b2Prop (let (l2, l3) := x in andb (hom n O l2) (hom n (S O) l3)), @ex (prod (Field.K (K p)) (kn p n)) (fun y : prod (Field.K (K p)) (kn p n) => @Logic.eq (prod (vect n) (vect n)) x (let (k, v1) := y in @pair (vect n) (vect n) (genk n k) (k2g n v1))) *)
destruct x as [x1 x2].
(* Goal: forall _ : b2Prop (andb (hom n O x1) (hom n (S O) x2)), @ex (prod (Field.K (K p)) (kn p n)) (fun y : prod (Field.K (K p)) (kn p n) => @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) x1 x2) (let (k, v1) := y in @pair (vect n) (vect n) (genk n k) (k2g n v1))) *)
rewrite andbP; intros (Hx1, Hx2).
(* Goal: @ex (prod (Field.K (K p)) (kn p n)) (fun y : prod (Field.K (K p)) (kn p n) => @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) x1 x2) (let (k, v1) := y in @pair (vect n) (vect n) (genk n k) (k2g n v1))) *)
case (IH _ Hx2); intros y Hy.
(* Goal: @ex (prod (Field.K (K p)) (kn p n)) (fun y : prod (Field.K (K p)) (kn p n) => @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) x1 x2) (let (k, v1) := y in @pair (vect n) (vect n) (genk n k) (k2g n v1))) *)
exists ('C[x1], y).
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite <-(hom0E _ _ Hx1), <-Hy; auto.
Qed.

Lemma k2glift n x : 'v_(Kn.lift p n x) = ('v_x)^'l.
Proof. auto. Qed.

Lemma pscal_join n x y : 'v_x ∨ '@('v_y) =  ((x [.] y)%Kn:K) .* E :> vect n.
Proof.
(* Goal: @Logic.eq (vect n) (join n (k2g n x) (dual n (k2g n y))) (scalE (vn_eparams n) (pscal p n x y : Field.K (K1 p)) (all n)) *)
induction n as [|n IH]; simpl; Krm0; Krm1.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (dual n (conj n false (genk n k))) (dual n (genk n (v0 (K1 p))))) (@pair (vect n) (vect n) (scal n k (all n)) (scal n k (genk n (v0 (K1 p))))) *)
destruct x as [k x]; destruct y as [h y]; Vfold n.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (addE (vn_eparams n) (join n (genk n k) (dual n (genk n h))) (join n (conj n false (k2g n x)) (dual n (conj n false (k2g n y))))) (join n (k2g n x) (dual n (genk n h)))) (@pair (vect n) (vect n) (scalE (vn_eparams n) (addK (K p) (multK (K p) k h) (pscal p n x y)) (all n)) (scalE (vn_eparams n) (addK (K p) (multK (K p) k h) (pscal p n x y)) (E0 (vn_eparams n)))) *)
Vrm0.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (addE (vn_eparams n) (join n (genk n k) (dual n (genk n h))) (join n (conj n false (k2g n x)) (dual n (conj n false (k2g n y))))) (join n (k2g n x) (dual n (genk n h)))) (@pair (vect n) (vect n) (scalE (vn_eparams n) (addK (K p) (multK (K p) k h) (pscal p n x y)) (all n)) (E0 (vn_eparams n))) *)
rewrite !dualk, !joinkl; simpl expK; Grm0; Krm1.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) k (scalE (vn_eparams n) h (all n))) (join n (conj n false (k2g n x)) (dual n (conj n false (k2g n y))))) (join n (k2g n x) (scalE (vn_eparams n) h (all n)))) (@pair (vect n) (vect n) (scalE (vn_eparams n) (addK (K p) (multK (K p) k h) (pscal p n x y)) (all n)) (E0 (vn_eparams n))) *)
rewrite !(conjf_hom _ _ _ (k2g_hom _ _)); simpl expK; Grm0; Krm1.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (addE (vn_eparams n) (scalE (vn_eparams n) k (scalE (vn_eparams n) h (all n))) (join n (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (k2g n x)) (dual n (scalE (vn_eparams n) (oppK (K1 p) (v1 (K1 p))) (k2g n y))))) (join n (k2g n x) (scalE (vn_eparams n) h (all n)))) (@pair (vect n) (vect n) (scalE (vn_eparams n) (addK (K p) (multK (K p) k h) (pscal p n x y)) (all n)) (E0 (vn_eparams n))) *)
rewrite dual_scal, !join_scall, !join_scalr, IH.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite <- scal_multE, (scal_addEl (vn_eparams n)); auto. rewrite <-!scal_multE; Krm1.
(* Goal: @Logic.eq (prod (vect n) (vect n)) (@pair (vect n) (vect n) (addE (vn_eparams n) (join n (genk n k) (dual n (genk n h))) (join n (conj n false (k2g n x)) (dual n (conj n false (k2g n y))))) (join n (k2g n x) (dual n (genk n h)))) (@pair (vect n) (vect n) (scalE (vn_eparams n) (addK (K p) (multK (K p) k h) (pscal p n x y)) (all n)) (scalE (vn_eparams n) (addK (K p) (multK (K p) k h) (pscal p n x y)) (E0 (vn_eparams n)))) *)
rewrite (join_allhr _ _ _ (k2g_hom _ _)); Vrm0.
Qed.

Lemma pscal_meet n x y : 'v_x ∧ '@('v_y) =  ((x [.] y)%Kn:K) .* 1 :> vect n.
Proof.
(* Goal: forall _ : lt O (S n), @Logic.eq (prod (vect n) (vect n)) (joinl (S n) (@app (prod (vect n) (vect n)) (@map (vect n) (prod (vect n) (vect n)) (dlift n) (base n O)) (@map (vect n) (prod (vect n) (vect n)) (lift n) (base n (S O))))) (@pair (vect n) (vect n) (all n) (genk n (v0 (K1 p)))) *)
destruct n as [|n].
simpl; Krm0.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite Kn.pscal_com, <-dual_all, <-dual_scal, <-pscal_join, dual_join; auto.
rewrite dual_invo with (k := 1%nat).
2: apply k2g_hom.
rewrite meet_hom_com with (k2 := 1%nat) (k1 := (n.+1 - 1)%nat).
2: apply dual_hom; apply k2g_hom.
2: apply k2g_hom.
rewrite meet_scalr.
replace ((n.+1 + (n.+1 - 1)) * (n.+1 + 1))%nat with 
        (2 * ((n.+1 -1) * n.+2) +  (1 * n .+2))%nat.
(* Goal: @Logic.eq (vect (S n)) (k2g (S n) (Kn.lift p n x)) (lift n (k2g n x)) *)
rewrite expKm1_2E; auto.
simpl minus; rewrite <-Minus.minus_n_O.
ring.
Qed.

(* This is 0 *)
Definition V0 := genk (dim p) 0.
(* This is 1 *)
Definition V1 := genk (dim p) 1.
Definition Vect := vect p.
(* This is the equality for our vectors *)
Definition Veq: Vect -> Vect -> bool := eq p.
(* This is the addition for our vectors *)
Definition Vadd: Vect -> Vect -> Vect := add p.
(* This is the multiplication for our vectors *)
Definition Vscal: K -> Vect -> Vect := scal (dim p).
(* This is the generator of the base *)
Definition Vgen := gen p.
Definition Vgenk := genk p.
(* This is the ad-hoc conjugate for our vectors (maybe useless) *)
Definition Vconj: bool -> Vect -> Vect := conj (dim p).
(* This is the multiplication for our vectors *)
Definition Vjoin: Vect -> Vect -> Vect := join (dim p).
Definition Vmeet: Vect -> Vect -> Vect := meet (dim p).
Definition Vcontra: Kn -> Vect -> Vect := contra (dim p).
Definition Vdual: Vect -> Vect := dual (dim p).
Definition Vdecompose: Vect -> option (list Vect) := decompose (dim p).
Definition K2G: Kn -> Vect  := k2g p.

Definition v_eparams :=
  Build_eparams Vect K V0 Veq Vadd Vscal.

Definition f: vparamsProp (Kn.v_eparams p) := (Kn.fn p Hp p).

End Vect.

Delimit Scope Gn_scope with Gn.
Notation " 'e_ p" := (gen _  _ p) : Gn_scope.
Notation " [ k ] " := (genk _ _ k) (at level 9) : Gn_scope.

Require Import QArith.

Open Scope Q_scope.

Definition Qparams (n:nat) := Build_params 
   n
  (Build_fparams
  Q 
  0%Q
  1%Q
 Qeq_bool
 Qopp
 Qplus
 Qmult
 Qinv)
.

Module Ex2D.

(* Q in 2 D *)

Local Definition p := Qparams 2.

Notation "[[ X: x , Y: y , X**Y: xy ]]" :=  ((xy,x),(y,0)).

Definition X := (Vgen p 0).
Eval compute in X.
Definition Y := (Vgen p 1).
Eval compute in Y.

Notation "x '∨' y" := (Vjoin p  x y) (at level 40, left associativity).
Notation "x + y" := (Vadd p  x y).
Notation "k .* x" := (Vscal p  k x).
Notation "x '∧' y" := (Vmeet p  x y) (at level 40, left associativity).
Notation "'@  x" := (Vdual p x) (at level 100).

Eval vm_compute in (X ∨ Y) ∧ (X ∨ Y).

Eval vm_compute in '@(X + Y).

Eval vm_compute in (X + Y) ∨ '@(X + Y).

End Ex2D.

Module Ex3D.

(* Q in 3 D *)

Local Definition p := Qparams 3.

Notation "[[ X: x , Y: y ,  Z: z , X**Y: xy , Y**Z: yz  , X**Z: xz , X**Y**Z: xyz ]]" :=
  ((((xyz,xy),(xz,x)), ((yz,y),(z,0)))).

Definition X := (Vgen p 0).
Eval compute in X.
Definition Y := (Vgen p 1).
Eval compute in Y.
Definition Z := (Vgen p 2).
Eval compute in Z.


Notation "x '∨' y" := (Vjoin p  x y) (at level 40, left associativity).
Notation "x + y" := (Vadd p  x y).
Notation "k .* x" := (Vscal p  k x).
Notation "x '∧' y" := (Vmeet p  x y) (at level 40, left associativity).
Notation "'@  x" := (Vdual p x) (at level 100).

Eval vm_compute in '@(Vgen p 3).

Eval vm_compute in (X ∨ Z) ∧ (Y ∨ Z).

Eval vm_compute in '@((X∨Y)∧ ( Z)).

Eval vm_compute in (X + Y) ∨ '@(X + Y).


Eval vm_compute in Vdecompose p ((X ∨ Y) ∧ (Y ∨ Z)).

Eval vm_compute in Vdecompose p ((X + Y) ∨ (X + Z)).

Eval vm_compute in Vdecompose p ((X + Y + Z) ∨ (X + Z) ∨ (X + Y)).

Eval vm_compute in Vdecompose p ((X + Y) ∨ (Y + Z)).

Eval vm_compute in (X + Y) ∨ (X + Z) + 
  (-1#1)%Q .* (((-1#1)%Q .* Y + Z) ∨ ((-1#1)%Q .* (X + Y))).

Eval vm_compute in ((-1#1)%Q .* Y + Z) ∨ (X + Y) ∨ (X + Z).

Eval vm_compute in (X ∨ Y ∨ Z) ∨ (X ∨ Y ∨ Z).
Eval vm_compute in (X + Y + Z) ∨ (X + Y + Z).
Eval vm_compute in Z ∨ Y ∨ X.
Eval vm_compute in X ∨ Z.
Eval vm_compute in Z ∨ X.
Eval vm_compute in X ∨ Y ∨ Z.
Eval vm_compute in Z ∨ X ∨ Y.
Eval vm_compute in Y ∨ X ∨ Z.
Eval vm_compute in Y ∨ X.

End Ex3D.


Module Ex4D.

(* Q in 4 D *)

Local Definition p := Qparams 4.

Notation " '[[' 'X:' x ',' 'Y:' y ','  'Z:' z , 'T:' t ',' 'X**Y:' xy ',' 'X**Z:' xz ',' 'X**T:' xt ',' 'Y**Z:' yz ',' 'Y**T:' yt ',' 'Z**T:' zt ',' 'X**Y**Z:' xyz ',' 'X**Y**T:' xyt ',' 'X**Z**T:' xzt ',' 'Y**Z**T:' yzt ','  'X**Y**Z**T:' xyzt ','  'K:' vv  ']]'" :=
 ((((xyzt, xyz), (xyt, xy)), ((xzt, xz), (xt, x))) , 
  (((yzt, yz), (yt, y)), ((zt,z), (t, vv)))).

Definition X := (Vgen p 0).
Eval compute in X.
Definition Y := (Vgen p 1).
Eval compute in Y.
Definition Z := (Vgen p 2).
Eval compute in Z.
Definition T := (Vgen p 3).
Eval compute in T.

Notation "x '∨' y" := (Vjoin p  x y) (at level 40, left associativity).
Notation "x + y" := (Vadd p  x y).
Notation "k .* x" := (Vscal p  k x).
Notation "x '∧' y" := (Vmeet p  x y) (at level 40, left associativity).
Notation "'@  x" := (Vdual p x) (at level 100).
Notation "#< l , x ># " := (Vcontra p l x).

Eval vm_compute in '@X.

Eval vm_compute in (X + Y) ∨ '@(X + Y).

Definition X' := (1, (0, (0, (0, tt)))).
Definition Y' := (0, (1, (0, (0, tt)))).
Definition Z' := (0, (0, (1, (0, tt)))).
Definition T' := (0, (0, (0, (1, tt)))).


Definition U := (X + Y) ∨ Z.

Eval vm_compute in U.

Definition fxy := #<Y', #< X', U ># >#.
Definition fxz := #<Z', #< X', U ># >#.
Definition fxt := #<T', #< X', U ># >#.
Definition fyz := #<Z', #< Y', U ># >#.
Definition fyt := #<T', #< Y', U ># >#.
Definition fzt := #<T', #< Z', U ># >#.


Eval vm_compute in fxy.


Eval vm_compute in #< Y', X>#.


Eval vm_compute in (X ∨ Y ∨ Z) ∨ (X ∨ Y ∨ Z).

Eval vm_compute in (X + Y + Z) ∨ (X + Y + Z).
Eval vm_compute in Z ∨ Y ∨ X.
Eval vm_compute in X ∨ Z.
Eval vm_compute in Z ∨ X.
Eval vm_compute in X ∨ Y ∨ Z.
Eval vm_compute in Z ∨ X ∨ Y.
Eval vm_compute in Y ∨ X ∨ Z.
Eval vm_compute in Y ∨ X.
Eval vm_compute in X ∨ T.
Eval vm_compute in T ∨ X.

Eval vm_compute in Vconj p false (Z ∨ T) ∨ (X ∨ Y).

Eval vm_compute in (X ∨ Y ∨ Z ∨ T) ∨ (X ∨ Y ∨ Z ∨ T).

End Ex4D.

Module Ex5D.

(* Q in 5 D *)

Local Definition p := Qparams 5.

Notation " [[ X: x , Y: y ,  Z: z , T: t , U: u , X**Y: xy , X**Z: xz , X**T: xt , X**U: xu , Y**Z: yz , Y**T: yt , Y**U: yu , Z**T: zt , Z**U: zu , T**U: tu , X**Y**Z: xyz , X**Y**T: xyt , X**Y**U: xyu , X**Z**T: xzt , X**Z**U: xzu , X**T**U: xtu , Y**Z**T: yzt , Y**Z**U: yzu , Y**T**U: ytu , Z**T**U: ztu , X**Y**Z**T: xyzt , X**Y**Z**U: xyzu , X**Y**T**U: xytu , X**Z**T**U: xztu , Y**Z**T**U: yztu , X**Y**Z**T**U: xyztu , 'K:' vv ]]" :=
(
 ((((xyztu, xyzt), (xyzu, xyz)), ((xytu, xyt), (xyu, xy))) , 
  (((xztu, xzt), (xzu, xz)), ((xtu,xt), (xu, x)))),
 ((((yztu, yzt), (yzu, yz)), ((ytu, yt), (yu, y))) , 
  (((ztu, zt), (zu, z)), ((tu,t), (u, vv))))).

Definition X := (Vgen p 0).
Eval compute in X.
Definition Y := (Vgen p 1).
Eval compute in Y.
Definition Z := (Vgen p 2).
Eval compute in Z.
Definition T := (Vgen p 3).
Eval compute in T.
Definition U := (Vgen p 4).
Eval compute in U.

Notation "x '∨' y" := (Vjoin p  x y) (at level 40, left associativity).
Notation "x + y" := (Vadd p  x y).
Notation "k .* x" := (Vscal p  k x).
Notation "x '∧' y" := (Vmeet p  x y) (at level 40, left associativity).
Notation "'@  x" := (Vdual p x) (at level 100).

Eval vm_compute in Vconj p false (T ∨ U) ∨ (X ∨ Y ∨ Z).
Eval vm_compute in Vconj p false (X ∨ Y ∨ Z ∨ T ∨ U).

End Ex5D.

Module Ex6D.

(* Q in 6 D *)

Local Definition p := Qparams 6.

Definition X := (Vgen p 0).
Eval compute in X.
Definition Y := (Vgen p 1).
Eval compute in Y.
Definition Z := (Vgen p 2).
Eval compute in Z.
Definition T := (Vgen p 3).
Eval compute in T.
Definition U := (Vgen p 4).
Eval compute in U.
Definition K := (Vgen p 5).
Eval compute in K.


Notation "x '∨' y" := (Vjoin p  x y) (at level 40, left associativity).
Notation "x + y" := (Vadd p  x y).
Notation "k .* x" := (Vscal p  k x).
Notation "x '∧' y" := (Vmeet p  x y) (at level 40, left associativity).
Notation "'@  x" := (Vdual p x) (at level 100).

Eval vm_compute in 
  ((X ∨ (Y ∨ Z ∨ T)) + (U ∨ K)) ∨
  ((X ∨ (Y ∨ Z ∨ T)) + (U ∨ K)).

Eval vm_compute in Vconj p false (T ∨ U) ∨ (X ∨ Y ∨ Z).
Eval vm_compute in Vconj p false (X ∨ Y ∨ Z ∨ T ∨ U).

Eval vm_compute in
  ((X ∨ T) + (Y ∨ Z)) ∨ ((X ∨ T) + (Y ∨ Z)).

End Ex6D.

