import init.function xenalib.Ellen_Arlt_matrix_rings algebra.module algebra.big_operators data.set.finite analysis.real data.complex.basic algebra.ring xenalib.Keji_permutations_for_matrices

open complex matrix

def Cross_out_column {R : Type} [ring R] {n : nat }
  (A : matrix R (n+1) (n+1)) (m : fin (n+1)) : matrix R n n :=
λ i j,
if j.1 < m.1 then  A (i.1 + 1) j.1 else
  A (i.1 + 1) (j.1 + 1)

def det_laplace {R : Type} [ring R]: Π {n: nat},  matrix R (n+1) (n+1) →  R
| 0 := λ A, A 0 0
| (n + 1) := λ A,
  finset.sum finset.univ (λ k : fin (n+2), (-1 : R)^(k.1) * (A 0 k) *
 det_laplace (Cross_out_column A k))

noncomputable def det {n:ℕ} {R : Type} [comm_ring R] (A : matrix R n n) : R :=
finset.sum (finset.univ : finset (equiv.perm (fin n))) (λ (σ : equiv.perm (fin n)), e σ  * (finset.prod (finset.univ : finset (fin n))
(λ (i:fin n), A (σ.1 i) i)))

def transpose {R : Type} [ring R] {a b:ℕ  }(A:matrix R a b):  matrix R b a:=
λ i j, A j i

postfix `ᵀ`:100 := transpose

def Hermitian_conjugate  [ring ℂ ] {n:ℕ  }(A:matrix ℂ n n):  matrix ℂ n n:=
λ i j, conj (A j i)

postfix `†`:100 := Hermitian_conjugate

def GL (n:ℕ) ( R : Type) [ring R]:= units (matrix R n n)

def Orthogornal ( n: ℕ): Type:= {A :GL n ℝ   // mul ℝ  A.1 ( A.1ᵀ)= identity_matrix ℝ  ∧ mul ℝ (A.1ᵀ) A.1 = identity_matrix ℝ  }

def Hermitian ( n: ℕ) : Type:= {A :matrix ℂ n n //  mul ℂ A (A†)= (1 : matrix ℂ n n)}

theorem transpose_of_product ( R : Type) [comm_ring R] {a b c :ℕ}( A :matrix R a b) (B: matrix R b c): (mul R A B)ᵀ  = mul R (Bᵀ ) (Aᵀ) :=
begin
unfold mul,
unfold transpose,
simp[mul_comm],
end

instance GL_group (n:ℕ ) ( R : Type) [ring R]:group (GL n R):=
begin
unfold GL,
apply_instance,
end

lemma matrix_prod_reorder_eq_prod {n : ℕ} {R : Type} [comm_ring R] (A : matrix R n n) (σ : equiv.perm (fin n)) (ρ : equiv.perm (fin n)) :
   (finset.prod (finset.univ : finset (fin n)) (λ (i : fin n), A (σ.1 ( ρ.1 i)) (ρ.1 i) )) =
    (finset.prod (finset.univ : finset (fin n)) (λ (i : fin n), A (σ.1 i) i)) :=
begin
  let t : Π a ∈ (@finset.univ (fin n) _ ), fin n := λ a ha, ρ.1 a,
  rw[finset.prod_bij t],
  { simp },
  { intros,
    simp[t] },
  { intros,
    simp[t] at a,
    have H1 : function.injective ρ.1,
      { exact (equiv.bijective ρ).1 },
    apply H1,
    exact a },
  { intros,
    existsi (ρ.2 b),
    simp,
    simp[t],
    rw[ρ.4] }
end

lemma reorder_with_inv_old_order {n : ℕ} {R : Type} [comm_ring R] (A : matrix R n n) :
finset.sum (finset.univ : finset ( equiv.perm (fin n))) (λ (σ : equiv.perm (fin n)), e σ *
(finset.prod (finset.univ : finset (fin n)) (λ (i : fin n), A (σ.1 (i)) i))) =
finset.sum (finset.univ : finset ( equiv.perm (fin n))) (λ (σ : equiv.perm (fin n)),e σ  *
(finset.prod (finset.univ : finset (fin n)) (λ (i:fin n), A i (σ.symm .1 i)))) :=
begin
  congr,
  funext,
  conv { to_lhs, rw [← matrix_prod_reorder_eq_prod A σ (σ.symm)] },
  congr,
  funext,
  simp[equiv.symm],
  rw[σ .4]
end
lemma det_eq_trans {n : ℕ} {R : Type} [comm_ring R] (A : matrix R n n) : det A = det (Aᵀ) :=
begin
  unfold det,
  unfold transpose,
  rw[reorder_with_inv_old_order],
  have h : finset.sum (finset.univ : finset (equiv.perm (fin n))) (λ (σ : equiv.perm (fin n)), e σ  *
  (finset.prod (finset.univ : finset (fin n)) (λ (i : fin n), A i (σ.symm .1 i)))) = finset.sum (finset.univ :
  finset ( equiv.perm (fin n))) (λ (σ : equiv.perm (fin n)), e σ *
  (finset.prod (finset.univ : finset (fin n)) (λ (i : fin n), A i (σ.1 (i))))),
  { let t : Π a ∈ (@finset.univ ( equiv.perm (fin n)) _ ), equiv.perm (fin n) :=  λ a ha, a.symm,
    rw[finset.sum_bij t],
    { intros,
      simp },
    { intros,
      simp[t],
      rw[e_eq_inv a] },
    { intros,
      simp[t] at a ,
      have H1 : function.left_inverse (equiv.symm : (equiv.perm (fin n)) → (equiv.perm (fin n))) (equiv.symm : (equiv.perm (fin n)) → (equiv.perm (fin n))),
      { unfold function.left_inverse,
        intros,
        show equiv.symm (x.symm) = x,
        simp },
      have H2 : function.right_inverse (equiv.symm : (equiv.perm (fin n)) → (equiv.perm (fin n))) (equiv.symm : (equiv.perm (fin n)) → (equiv.perm (fin n))),
      { unfold function.right_inverse,
        exact H1 },
      have H3: function.has_right_inverse (equiv.symm : (equiv.perm (fin n)) → (equiv.perm (fin n))),
      { unfold function.has_right_inverse,
        existsi  (equiv.symm : (equiv.perm (fin n)) → (equiv.perm (fin n))),
        exact H2 },
      have H41 : function.injective (equiv.symm : (equiv.perm (fin n)) → (equiv.perm (fin n))),
      { exact function.injective_of_left_inverse H1 },
      have H42 : function.surjective (equiv.symm : (equiv.perm (fin n)) → (equiv.perm (fin n))),
      { exact function.surjective_of_has_right_inverse H3 },
      have H4 : function.bijective (equiv.symm : (equiv.perm (fin n)) → (equiv.perm (fin n))),
      { unfold function.bijective,
        split,
        { exact H41 },
        { exact H42 } },
        exact H41 a },
      { intros,
        simp[t],
        existsi (equiv.symm b),
        simp } },
  rw[h]
end

local attribute [instance, priority 0] classical.prop_decidable

lemma col_swap_neg_col {n : ℕ} {R : Type} [comm_ring R] [decidable_eq R] (A : matrix R n n) (ρ : equiv.perm (fin n)) :
finset.sum (finset.univ : finset ( equiv.perm (fin n))) (λ (σ : equiv.perm (fin n)), e σ * (finset.prod (finset.univ : finset (fin n))
(λ (i : fin n), A (σ.1 (i)) (ρ.1 (i))))) = e ρ * det A :=
begin
  have H5:  (ρ.2 ∘ ρ.to_fun) = id,
  { funext,
    simp,
    rw [ρ.3] },
  have H1 : finset.sum (finset.univ : finset ( equiv.perm (fin n))) (λ (σ : equiv.perm (fin n)), e σ *
  (finset.prod (finset.univ : finset (fin n))
  (λ (i : fin n), A (σ.1 (i)) (ρ.1 i)))) =
  finset.sum (finset.univ : finset ( equiv.perm (fin n))) (λ (μ : equiv.perm (fin n)),e (equiv.trans ρ μ ) *
  (finset.prod (finset.univ: finset (fin n))
  (λ (i:fin n), A ((equiv.trans ρ  μ ).1 (i)) ( ρ.1 (i))))),
    unfold equiv.trans,
    simp,
    let t : Π a ∈ (@finset.univ ( equiv.perm (fin n)) _ ),  equiv.perm (fin n)  :=  λ a ha, equiv.trans ρ.symm a ,
    rw[finset.sum_bij t],
    { intros,
      simp[t] },
    {  intros,
      simp[t],
      show _ =  e ( a * (ρ⁻¹ * ρ)) *
      finset.prod finset.univ (λ (x : fin n), A
      (a.1 ((ρ.2 ∘ ρ.to_fun) x)) (ρ.to_fun x)),
      rw[H5],
      simp },
    { intros a₁ a₂,
      intros,
      simp[t] at a,
      rw [equiv.trans] at a,
      rw [equiv.trans] at a,
      have H2: a₁.to_fun ∘ (equiv.symm ρ).to_fun = a₂.to_fun ∘ (equiv.symm ρ).to_fun,
      { by  injection a },
      have H3 : (a₁.to_fun ∘ (equiv.symm ρ).to_fun) ∘ ρ.1 = (a₂.to_fun ∘ (equiv.symm ρ).to_fun) ∘ ρ.1,
      { rw[H2] },
      change  a₁.to_fun ∘ ρ.2 ∘ ρ.to_fun = a₂.to_fun ∘ ρ.2 ∘ ρ.to_fun at H3,
      rw[H5] at H3,
      simp at H3,
      exact equiv.eq_of_to_fun_eq H3 },
    { intros,
      simp[t],
      existsi equiv.trans ρ b,
      apply equiv.ext,
      simp },
    { change _ = finset.sum finset.univ
      (λ (μ : equiv.perm (fin n)),
      e (μ * ρ) *
      finset.prod finset.univ (λ (i : fin n), A ( μ.1 (ρ.1 i)) (ρ.to_fun i))) at H1,
      have H7 :  finset.sum finset.univ
       (λ (μ :  equiv.perm (fin n)),
         e (μ * ρ) *
           finset.prod finset.univ (λ (i : fin n), A (μ.to_fun (ρ.to_fun i)) (ρ.to_fun i)))= finset.sum finset.univ
      (λ (μ :  equiv.perm (fin n)),
         e (μ * ρ) *
           finset.prod finset.univ (λ (i : fin n), A (μ.to_fun i ) i)),
      { congr,
        funext,
        conv { to_rhs, rw [← matrix_prod_reorder_eq_prod A μ ρ ] } },
      rw[H1],
      rw[H7],
      conv in (e ( _ * ρ)) { rw [e_mul μ  ρ] },
      simp only [mul_comm ],
      simp only [_root_.mul_assoc],
      rw[← finset.mul_sum],
      rw[mul_comm (det A)  (e ρ)],
      refl }
end

open finset

lemma disjoint_equiv_classes (α : Type*) [fintype α] [h : setoid α] [decidable_rel h.r] [decidable_eq α]:
∀ x ∈ @finset.univ (quotient h) _, ∀ y ∈ @finset.univ (quotient h) _, x ≠ y →
    (finset.filter (λ b : α, ⟦b⟧ = x) finset.univ) ∩ (finset.filter (λ b : α, ⟦b⟧ = y) finset.univ) = ∅ :=
begin
  intros x hx y hx hxy,
  rw ←filter_and,
  rw ←filter_false,
  congr,funext,
    suffices : ⟦a⟧ = x ∧ ⟦a⟧ = y → false,
    simp [this],
  intro H,cases H with Hx Hy, rw Hx at Hy,apply hxy,exact Hy,
  intro x,show decidable false, refine is_false id
end

lemma sum_equiv_classes {α β : Type*} [add_comm_monoid α] [fintype β] (f : β → α)
  (h : setoid β) [decidable_rel h.r] [decidable_eq β] :
finset.sum (@finset.univ β _) f = finset.sum finset.univ
  (λ (x : quotient h), finset.sum (filter (λ b : β, ⟦b⟧ = x) finset.univ) f) :=
begin
  rw ←finset.sum_bind (disjoint_equiv_classes β),
  congr,symmetry,
  rw eq_univ_iff_forall,
  intro b,
  rw mem_bind,
  existsi ⟦b⟧,
  existsi (mem_univ ⟦b⟧),
  rw mem_filter,
  split,exact mem_univ b,refl
end

-- now let's define the equivalence relation on s by a is related to a and g(a) (and that's it)

definition gbar {β : Type*} {s : finset β} (g : Π a ∈ s, β)
(h₄ : ∀ a ha, g a ha ∈ s) :
(↑s : set β) → (↑s : set β) :=
--λ ⟨a,ha⟩,⟨g a ha,h₄ a ha⟩
λ x,⟨g x.val x.property, h₄ x.val x.property⟩

definition gbar_involution {β : Type*} {s : finset β} (g : Π a ∈ s, β)
(h₄ : ∀ a ha, g a ha ∈ s) (h₅ : ∀ a ha, g (g a ha) (h₄ a ha) = a) :
let gb := gbar g h₄ in
∀ x, gb (gb x) = x :=
begin
  intros gb x,
  apply subtype.eq,
  have H := h₅ x.val x.property,
  rw ←H,refl,
end

private definition eqv {β : Type*} {s : finset β} (g : Π a ∈ s, β)
(h₄ : ∀ a ha, g a ha ∈ s) (h₅ : ∀ a ha, g (g a ha) (h₄ a ha) = a)
(a₁ a₂ : (↑s : set β)) : Prop :=
let gb := gbar g h₄ in a₁ = a₂ ∨ a₁ = gb a₂

private theorem eqv.refl {β : Type*} {s : finset β} (g : Π a ∈ s, β)
(h₄ : ∀ a ha, g a ha ∈ s) (h₅ : ∀ a ha, g (g a ha) (h₄ a ha) = a) :
∀ a : (↑s : set β), eqv g h₄ h₅ a a := λ a, or.inl rfl

private theorem eqv.symm {β : Type*} {s : finset β} (g : Π a ∈ s, β)
(h₄ : ∀ a ha, g a ha ∈ s) (h₅ : ∀ a ha, g (g a ha) (h₄ a ha) = a) :
∀ a₁ a₂ : (↑s : set β), eqv g h₄ h₅ a₁ a₂ → eqv g h₄ h₅ a₂ a₁
| a₁ a₂ (or.inl h) := or.inl h.symm
| a₁ a₂ (or.inr h) := or.inr (by rw h;exact (gbar_involution g h₄ h₅ a₂).symm)

private theorem eqv.trans {β : Type*} {s : finset β} (g : Π a ∈ s, β)
(h₄ : ∀ a ha, g a ha ∈ s) (h₅ : ∀ a ha, g (g a ha) (h₄ a ha) = a) :
∀ a₁ a₂ a₃ : (↑s : set β), eqv g h₄ h₅ a₁ a₂ → eqv g h₄ h₅ a₂ a₃ → eqv g h₄ h₅ a₁ a₃
| a₁ a₂ a₃ (or.inl h12) (or.inl h23) := or.inl (eq.trans h12 h23)
| a₁ a₂ a₃ (or.inl h12) (or.inr h23) := or.inr (h12.symm ▸ h23)
| a₁ a₂ a₃ (or.inr h12) (or.inl h23) := or.inr (h23 ▸ h12)
| a₁ a₂ a₃ (or.inr h12) (or.inr h23) := or.inl (by rw [h12,h23];exact (gbar_involution g h₄ h₅ a₃))

private theorem is_equivalence {β : Type*} {s : finset β} (g : Π a ∈ s, β)
(h₄ : ∀ a ha, g a ha ∈ s) (h₅ : ∀ a ha, g (g a ha) (h₄ a ha) = a)
: equivalence (eqv g h₄ h₅) := ⟨eqv.refl g h₄ h₅,eqv.symm g h₄ h₅,eqv.trans g h₄ h₅⟩

instance {β : Type*} [decidable_eq β] {s : finset β} (g : Π a ∈ s, β)
  (h₄ : ∀ a ha, g a ha ∈ s) (h₅ : ∀ a ha, g (g a ha) (h₄ a ha) = a) : decidable_rel (eqv g h₄ h₅) :=
begin
  intros a₁ a₂,
  by_cases H12 : a₁ = a₂,
    refine is_true (or.inl H12),
  by_cases H12g : a₁ = gbar g h₄ a₂,
    refine is_true (or.inr H12g),
  refine is_false _,
  intro H,cases H,
    apply H12,exact H,
    apply H12g,exact H,
end

lemma sum_zero_of_pair_mem_sum_zero {α β : Type*} [add_comm_monoid α] [decidable_eq β] {f : β → α}
  {s : finset β} (g : Π a ∈ s, β) (h₀ : ∀ a ha, f a + f (g a ha) = 0)
  (h₁ : ∀ a ha, g a ha ≠ a) (h₂ : ∀ a₁ a₂ ha₁ ha₂, g a₁ ha₁ = g a₂ ha₂ → a₁ = a₂)
  (h₃ : ∀ a ∈ s, ∃ b hb, g b hb = a) (h₄ : ∀ a ha, g a ha ∈ s) (h₅ : ∀ a ha, g (g a ha) (h₄ a ha) = a ) :
   s.sum f = 0 :=
begin
  let gb := gbar g h₄,
  let β' := ↥(↑s : set β),
  letI fβ' : fintype β' := by apply_instance,
  let inst_2 : fintype β' := by apply_instance,
  let f' : β' → α := λ b,f b,
  let h : setoid β' := {r := eqv g h₄ h₅,iseqv := is_equivalence g h₄ h₅},
  let inst_4 : decidable_eq β' := by apply_instance,
  let inst_3 : decidable_rel h.r := by apply_instance,
  have H : s.sum f = sum univ f',
  { let g' : β' → β := λ x, x.val,
    let s' : finset β' := finset.univ,
    have Hinj : ∀ x ∈ s', ∀ y ∈ s', g' x = g' y → x = y,
    { intros x Hx y Hy,exact subtype.eq,
    },
    have H2 := @sum_image β α β' f _ _ _ s' g' Hinj,
    have H3 : image g' s' = s,
    { ext,split,
      { rw finset.mem_image,
        intro Ha,
        cases Ha with b Hb,
        cases Hb with Hb Hg',
        rw ←Hg',
        exact b.property,
      },
      intro Ha,
      rw finset.mem_image,
      existsi (⟨a,Ha⟩ : β'),
      existsi (mem_univ _),refl
    },
    rw ←H3,
    rw H2,
    refl
  },
  rw H,
  -- now finally rewrite sum_equiv_classes
  rw @sum_equiv_classes α β' _ fβ' f' h _ _,
  rw ←sum_const_zero,
  congr,funext,
  let b := quotient.out x,
  suffices : (filter (λ (b : β'), ⟦b⟧ = x) univ) = insert b (finset.singleton (gb b)),
  { rw this,
    have H2 : b ∉ finset.singleton (gb b),
      rw mem_singleton,
      intro H3,replace H3 := H3.symm,
      apply h₁ b.val b.property,
      have H4 : (gb b).val = b.val := by rw H3,
      exact H4,
    rw finset.sum_insert H2,
    rw finset.sum_singleton,
    show f b.val + f (g b.val b.property) = 0,
    exact h₀ b.val b.property
  },
  clear H,
  have H : ∀ c : β', ⟦c⟧ = x ↔ c = b ∨ c = gb b,
  { intro c,split,swap,
      intro H2,cases H2,rw H2,simp,
      rw H2,
      suffices : ⟦gb b⟧ = ⟦b⟧, by simp [this],
      rw quotient.eq,
      exact or.inr rfl,
    have H : x = ⟦b⟧ := by simp,
    rw H,rw quotient.eq,
    intro H2, cases H2,left,exact H2,
    right,exact H2,
  },
  ext,
  have H2 : a ∈ insert b (finset.singleton (gb b)) ↔ a = b ∨ a = gb b := by simp,
    rw H2,
    rw ←H a,
    simp,
end
theorem det_eq_zero_of_col_eq {n:ℕ} {R : Type} [comm_ring R] (A: matrix R n n) : (∃ (i j: fin n ),(i ≠ j) ∧  ∀ (x: fin n), A x i = A x j) → det A = 0 :=
  begin
  intros,
  unfold det,
  cases a with i,
  cases a_h with j,
  let g : Π a ∈ (finset.univ: finset( equiv.perm (fin n))),  equiv.perm (fin n) := λ σ  hσ , σ *  (equiv.swap i j),
  rw[sum_zero_of_pair_mem_sum_zero g],
  { intros,
    simp[g] ,
    show e (a) * finset.prod finset.univ (λ (i : fin n), A (a.to_fun i) i) +
    e (a * (equiv.swap i j)) * finset.prod finset.univ (λ (x : fin n), A ((a * equiv.swap i j).to_fun x) x) =
    0,
    rw[e_mul a (equiv.swap i j)],
    have h1 : i ≠ j,
    exact absurd h a_h_h.1,
    rw[e_swap h1],
     rw[mul_comm  (e (a)) (-1 : R) ],
        rw[neg_one_mul],
        rw[add_eq_zero_iff_eq_neg],
        simp,
        rw[eq_comm],
        let t : Π a ∈ (finset.univ: finset( fin n)), fin n:=
        λ a ha, (equiv.swap i j) a,
        rw[finset.prod_bij t],
        { intros,
          simp },
        { intros,
          simp[t],
          by_cases h1 : a_1 =i,
        { rw[h1],
          show A (a ((equiv.swap i j)i)) i = A (a ((equiv.swap i j)i)) ((equiv.swap i j) i),
          rw[equiv.swap_apply_left],
          show A (a.1 j) i = A (a.1 j) j,
          exact a_h_h.2 (a.1 j) },
        by_cases h2 : a_1 =j,
        { rw[h2],
          show A (a ((equiv.swap i j)j)) j = A (a ((equiv.swap i j)j)) ((equiv.swap i j) j),
          rw[equiv.swap_apply_right],
          show A (a.1 i) j = A (a.1 i) i,
          rw[ ← a_h_h.2 (a.1 i)] },
        show A (a ((equiv.swap i j)a_1)) a_1 = A (a ((equiv.swap i j)a_1)) ((equiv.swap i j) a_1),
        rw[equiv.swap_apply_of_ne_of_ne],
        exact h1,
        exact h2 },
        simp[t],
        intros,
        have H2: function.injective (equiv.swap i j).1,
        { exact (equiv.bijective (equiv.swap i j) ).1 },
        existsi ((equiv.swap i j).2 b),
        simp,
        simp[t],
        show _ = (equiv.swap i j).1 ((equiv.swap i j).inv_fun b),
        rw[(equiv.swap i j).4],

  { intros,
    simp[g],
    assume h,
    rw[← _root_.mul_one (a:  equiv.perm (fin n))] at h,
    rw[_root_.mul_assoc] at h,
    rw[ mul_left_inj a] at h,
    simp at h,
    have H3: (equiv.swap i j) i = (1 :  equiv.perm (fin n)) i,
    { rw[h] },
    have H4:(equiv.swap i j) i = j,
    { rw[equiv.swap_apply_left] },
    replace H3 : (equiv.swap i j).1 i = (1 :  equiv.perm (fin n)).1 i := H3,
    replace H4 : (equiv.swap i j).1 i = j := H4,
    rw[eq_comm] at H4,
    have H6: (1 :  equiv.perm (fin n)).to_fun i = j,
    { rw[eq.trans H4 H3] },
    exact a_h_h.1 H6 },
  { intros,
    simp[g] at a,
    exact a },
  { intros,
    simp[g],
    existsi (a * (equiv.swap i j)⁻¹),
    rw[_root_.mul_assoc],
    rw[mul_left_inv],
    simp },
  { intros,
    simp[g],
    rw[_root_.mul_assoc],
    have H7: equiv.swap i j * (equiv.swap i j)⁻¹ = (1:  equiv.perm (fin n)),
    { rw[mul_right_inv] },
    have H8 : (equiv.swap i j)⁻¹ = equiv.swap i j ,
    { refl },
    rw[H8] at H7,
    rw[H7],
    simp },
  { intros,
    simp } },
end

theorem not_bij_not_inj {α : Type* } [s : fintype α ] {f : α  → α} (h: ¬function.bijective f ) : ¬function.injective f:=
begin
intro,
apply h,
exact ⟨a, fintype.injective_iff_surjective.1 a⟩,
end

theorem det_mul {n:ℕ} {R : Type} [comm_ring R] (A: matrix R n n) (B: matrix R n n) :
det(mul R A B) = det A * det B:=
begin
unfold det,
unfold mul,
let t := (λ (a : fin n), (finset.univ: finset (fin n))),
simp only [@finset.prod_sum],
conv {to_lhs, congr,skip,funext,rw finset.mul_sum},
rw[finset.sum_comm],
simp only[finset.prod_mul_distrib],
simp only [mul_comm],
simp only [mul_comm (e ( _ )) _ ],
simp only [_root_.mul_assoc _ _ (e( _ ))],
conv {to_lhs, congr,skip,funext,rw ← finset.mul_sum},
simp only [mul_comm ( _ )  (e ( _ ))  ],
have H1: finset.sum (finset.pi finset.univ (λ (a : fin n), finset.univ))
      (λ (y : Π (a : fin n), a ∈ finset.univ → fin n),
         finset.prod (finset.attach finset.univ) (λ (x : {x // x ∈ finset.univ}), B (y (x.val) _) (x.val)) *
           finset.sum finset.univ
             (λ (x :  equiv.perm (fin n)),
                e (x) *
                  finset.prod (finset.attach finset.univ)
                    (λ (x_1 : {x // x ∈ finset.univ}), A (x.to_fun (x_1.val)) (y (x_1.val) _)))) =
                     finset.sum (finset.univ : finset (fin n → fin n))
      (λ (y : fin n → fin n),
         finset.prod (finset.univ : finset( fin n) ) (λ (x : fin n), B (y x) x) *
           finset.sum finset.univ
             (λ (x :  equiv.perm (fin n)),
                e (x) *
                  finset.prod (finset.univ : finset( fin n) )
                    (λ (x_1 : fin n), A (x.to_fun x_1) (y x_1 )))),

let t' : Π a ∈ (finset.pi (finset.univ :finset(fin n)) (λ (a : fin n), (finset.univ :finset(fin n)))), (fin n → fin n)  :=
 λ a ha, (λ (x: fin n), a x (finset.mem_univ x) ),
rw[finset.sum_bij t'],
intros,
simp,
intros,
let t'' : Π a ∈ (finset.attach (finset.univ : finset (fin n))), fin n:=
λ a ha, a.val,
have H12 : finset.prod (finset.attach (finset.univ : finset (fin n)))
(λ x , B (a x.val (finset.mem_univ _)) (x.val)) =
finset.prod (finset.univ : finset (fin n))
(λ x , B (a x (finset.mem_univ _)) x),
rw[finset.prod_bij t''],
intros,
simp,
intros,
simp,
intros,
simp[t''] at a_1,
rw[subtype.eq a_1],
intros,
existsi ( ⟨ b, (finset.mem_univ _) ⟩ :  {x // x ∈ finset.univ}) ,
refine exists.intro (by simp) _,
refl,
rw[H12],
have H13: finset.sum finset.univ (λ (x :  equiv.perm (fin n)),
           e (x) *
             finset.prod (finset.attach finset.univ)
               (λ (x_1 : {x // x ∈ finset.univ}), A (x.to_fun (x_1.val))
                (a (x_1.val) (finset.mem_univ _))))= finset.sum finset.univ (λ (x :  equiv.perm (fin n)),
           e (x) *
             finset.prod ( finset.univ)
               (λ x_1 , A (x.to_fun x_1)
                (a x_1 (finset.mem_univ _)))),
congr,
funext,
rw [finset.prod_bij t''],
intros,
simp,
intros,
simp,
intros,
simp[t''] at a_1,
rw[subtype.eq a_1],
intros,
existsi ( ⟨ b, (finset.mem_univ _) ⟩ :  {x // x ∈ finset.univ}) ,
refine exists.intro (by simp) _,
refl,
rw[H13],
intros,
simp[t'] at a,
funext,
have := congr_fun a x, exact this,
intros,
refine exists.intro (λ(x: fin n) (h ), b x) _,
simp,
rw[H1],
have H2: (finset.univ : finset (fin n → fin n)) =
(finset.filter (λ f, function.bijective f) (finset.univ : finset (fin n → fin n))) ∪
 (finset.filter (λ f : fin n -> fin n, ¬ function.bijective f )
 (finset.univ : finset (fin n → fin n))),
ext,
simp [classical.em],
rw[H2],
rw[finset.sum_union],
swap 2,
ext,simp,
have H21: finset.sum (finset.filter (λ (f : fin n → fin n), function.bijective f)
   finset.univ)
        (λ (y : fin n → fin n),
           finset.prod finset.univ (λ (x : fin n), B (y x) x) *
             finset.sum finset.univ
               (λ (x :  equiv.perm (fin n)), e (x) * finset.prod finset.univ (λ (x_1 : fin n),
                A (x.to_fun x_1) (y x_1)))) =
        finset.sum (finset.univ : finset ( equiv.perm (fin n)))
        (λ y,
           finset.prod finset.univ (λ (x : fin n), B (y.1 x) x) *
             finset.sum finset.univ
               (λ (x :  equiv.perm (fin n)), e (x) * finset.prod finset.univ (λ (x_1 : fin n),
                A (x.to_fun x_1) (y.1 x_1)))),

let t : Π a ∈ (finset.univ : finset ( equiv.perm (fin n))), fin n → fin n  :=
  λ a ha, a.1,
rw[finset.sum_bij t],
intros,
simp,
simp[t],
exact a.bijective,
intros,
simp,
intros,
simp[t] at a,
exact equiv.eq_of_to_fun_eq a,
intros,
simp[t],
have H22: function.bijective b,
   {exact (finset.mem_filter.1 H).2},
existsi @equiv.of_bijective _ _ b H22,
exact eq.symm (equiv.of_bijective_to_fun H22),
rw[H21],
simp only[col_swap_neg_col],
simp only[mul_comm],
simp only[_root_.mul_assoc],
rw[← finset.mul_sum],
rw[← det],
have H3: finset.sum (finset.filter (λ (f : fin n → fin n), ¬function.bijective f) finset.univ)
        (λ (y : fin n → fin n),
           finset.prod finset.univ (λ (x : fin n), B (y x) x) *
             finset.sum finset.univ
               (λ (x :  equiv.perm (fin n)), e (x) *
               finset.prod finset.univ (λ (x_1 : fin n), A (x.to_fun x_1) (y x_1)))) = 0,
conv
begin
to_rhs,
rw[← @finset.sum_const_zero _ _ (finset.filter (λ (f : fin n → fin n), ¬function.bijective f) finset.univ) _],
end,
refine finset.sum_congr rfl _,
intros,
have H4: finset.sum finset.univ
        (λ (x_1 :  equiv.perm (fin n)),
           e (x_1) * finset.prod finset.univ (λ (x_1_1 : fin n), A (x_1.to_fun x_1_1) (x x_1_1))) =
    0,
    have h1: ¬ function.injective x,
    exact @not_bij_not_inj (fin n) _ x (finset.mem_filter.1 H).2,
    unfold function.injective at h1,
     rw[classical.not_forall] at h1,
    simp only[classical.not_forall] at h1,
    cases h1 with i,
    cases h1_h with j,
    cases h1_h_h with h,
    let W: matrix R n n:= λ i j, A i (x j),
    show finset.sum finset.univ
      (λ (x_1 :  equiv.perm (fin n)), e (x_1) * finset.prod finset.univ (λ (x_1_1 : fin n), W (x_1.to_fun x_1_1)  x_1_1)) =
    0,
    rw[← det],
    rw[det_eq_zero_of_col_eq],
    existsi i,
    existsi  j,
    split,
    exact h1_h_h_h,
    intro,
   simp[W],
   rw[h],
   rw[H4],
   simp,
   rw[H3],
  simp,
  refl,
end


class OfNatSound (α : Type u) [Add α] [(n : Nat) → OfNat α n] : Prop where
  ofNat_add (n m : Nat) : (OfNat.ofNat n : α) + OfNat.ofNat m = OfNat.ofNat (n+m)

export OfNatSound (ofNat_add)

theorem ex1 {α : Type u} [Add α] [(n : Nat) → OfNat α n] [OfNatSound α] : (10000000 : α) + 10000000 = 20000000 :=
  ofNat_add ..

class Zero (α : Type u) where
  zero : α

class One (α : Type u) where
  one : α

instance [Zero α] : OfNat α (nat_lit 0) where
  ofNat := Zero.zero

instance [One α] : OfNat α (nat_lit 1) where
  ofNat := One.one

-- Some example structure
class S (α : Type u) extends Add α, Mul α, Zero α, One α where
  add_assoc (a b c : α)    : a + b + c = a + (b + c)
  add_zero (a : α)         : a + 0 = a
  zero_add (a : α)         : 0 + a = a
  mul_zero (a : α)         : a * 0 = 0
  mul_one (a : α)          : a * 1 = a
  left_distrib (a b c : α) : a * (b + c) = a * b + a * c

-- Very simply default `ofNat` for `S`
protected def S.ofNat (α : Type u) [S α] : Nat → α
  | 0   => 0
  | n+1 => S.ofNat α n + 1

instance [S α] : OfNat α n where
  ofNat := S.ofNat α n

instance [S α] : OfNatSound α where
  ofNat_add n m := by
    induction m with
    | zero => simp [S.ofNat]; erw [S.add_zero]; done
    | succ m ih => simp [OfNat.ofNat, S.ofNat] at *; erw [← ih]; rw [S.add_assoc]

theorem S.ofNat_mul [S α] (n m : Nat) : (OfNat.ofNat n : α) * OfNat.ofNat m = OfNat.ofNat (n * m) := by
  induction m with
  | zero => rw [S.mul_zero, Nat.mul_zero]
  | succ m ih =>
    show OfNat.ofNat (α := α) n * OfNat.ofNat (m + 1) = OfNat.ofNat (n * m.succ)
    rw [Nat.mul_succ, ← ofNat_add, ← ofNat_add, ← ih, left_distrib]
    simp [OfNat.ofNat, S.ofNat]
    erw [S.zero_add, S.mul_one]

theorem ex2 [S α] : (100000000000000000 : α) * 20000000000000000 = 2000000000000000000000000000000000  :=
  S.ofNat_mul ..

#print ex2


/-
Copyright (c) 2020 Anne Baanen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Anne Baanen
-/

import algebra.invertible
import linear_algebra.bilinear_form
import linear_algebra.determinant
import linear_algebra.special_linear_group

/-!
# Quadratic forms

This file defines quadratic forms over a `R`-module `M`.
A quadratic form is a map `Q : M → R` such that
  (`to_fun_smul`) `Q (a • x) = a * a * Q x`
  (`polar_...`) The map `polar Q := λ x y, Q (x + y) - Q x - Q y` is bilinear.
They come with a scalar multiplication, `(a • Q) x = Q (a • x) = a * a * Q x`,
and composition with linear maps `f`, `Q.comp f x = Q (f x)`.

## Main definitions

 * `quadratic_form.associated`: associated bilinear form
 * `quadratic_form.pos_def`: positive definite quadratic forms
 * `quadratic_form.anisotropic`: anisotropic quadratic forms
 * `quadratic_form.discr`: discriminant of a quadratic form

## Main statements

 * `quadratic_form.associated_left_inverse`,
 * `quadratic_form.associated_right_inverse`: in a commutative ring where 2 has
  an inverse, there is a correspondence between quadratic forms and symmetric
  bilinear forms
 * `bilin_form.exists_orthogonal_basis`: There exists an orthogonal basis with
  respect to any nondegenerate, symmetric bilinear form `B`.

## Notation

In this file, the variable `R` is used when a `ring` structure is sufficient and
`R₁` is used when specifically a `comm_ring` is required. This allows us to keep
`[module R M]` and `[module R₁ M]` assumptions in the variables without
confusion between `*` from `ring` and `*` from `comm_ring`.

The variable `S` is used when `R` itself has a `•` action.

## References

 * https://en.wikipedia.org/wiki/Quadratic_form
 * https://en.wikipedia.org/wiki/Discriminant#Quadratic_forms

## Tags

quadratic form, homogeneous polynomial, quadratic polynomial
-/

universes u v w
variables {S : Type*}
variables {R : Type*} {M : Type*} [add_comm_group M] [ring R]
variables {R₁ : Type*} [comm_ring R₁]

namespace quadratic_form
/-- Up to a factor 2, `Q.polar` is the associated bilinear form for a quadratic form `Q`.d

Source of this name: https://en.wikipedia.org/wiki/Quadratic_form#Generalization
-/
def polar (f : M → R) (x y : M) :=
f (x + y) - f x - f y

lemma polar_add (f g : M → R) (x y : M) :
  polar (f + g) x y = polar f x y + polar g x y :=
by { simp only [polar, pi.add_apply], abel }

lemma polar_neg (f : M → R) (x y : M) :
  polar (-f) x y = - polar f x y :=
by { simp only [polar, pi.neg_apply, sub_eq_add_neg, neg_add] }

lemma polar_smul [monoid S] [distrib_mul_action S R] (f : M → R) (s : S) (x y : M) :
  polar (s • f) x y = s • polar f x y :=
by { simp only [polar, pi.smul_apply, smul_sub] }

lemma polar_comm (f : M → R) (x y : M) : polar f x y = polar f y x :=
by rw [polar, polar, add_comm, sub_sub, sub_sub, add_comm (f x) (f y)]

end quadratic_form

variables [module R M] [module R₁ M]

open quadratic_form
/-- A quadratic form over a module. -/
structure quadratic_form (R : Type u) (M : Type v) [ring R] [add_comm_group M] [module R M] :=
(to_fun : M → R)
(to_fun_smul : ∀ (a : R) (x : M), to_fun (a • x) = a * a * to_fun x)
(polar_add_left' : ∀ (x x' y : M), polar to_fun (x + x') y = polar to_fun x y + polar to_fun x' y)
(polar_smul_left' : ∀ (a : R) (x y : M), polar to_fun (a • x) y = a • polar to_fun x y)
(polar_add_right' : ∀ (x y y' : M), polar to_fun x (y + y') = polar to_fun x y + polar to_fun x y')
(polar_smul_right' : ∀ (a : R) (x y : M), polar to_fun x (a • y) = a • polar to_fun x y)

namespace quadratic_form

variables {Q : quadratic_form R M}

instance : has_coe_to_fun (quadratic_form R M) :=
⟨_, to_fun⟩

/-- The `simp` normal form for a quadratic form is `coe_fn`, not `to_fun`. -/
@[simp] lemma to_fun_eq_apply : Q.to_fun = ⇑ Q := rfl

lemma map_smul (a : R) (x : M) : Q (a • x) = a * a * Q x := Q.to_fun_smul a x

lemma map_add_self (x : M) : Q (x + x) = 4 * Q x :=
by { rw [←one_smul R x, ←add_smul, map_smul], norm_num }

@[simp] lemma map_zero : Q 0 = 0 :=
by rw [←@zero_smul R _ _ _ _ (0 : M), map_smul, zero_mul, zero_mul]

@[simp] lemma map_neg (x : M) : Q (-x) = Q x :=
by rw [←@neg_one_smul R _ _ _ _ x, map_smul, neg_one_mul, neg_neg, one_mul]

lemma map_sub (x y : M) : Q (x - y) = Q (y - x) :=
by rw [←neg_sub, map_neg]

@[simp]
lemma polar_zero_left (y : M) : polar Q 0 y = 0 :=
by simp [polar]

@[simp]
lemma polar_add_left (x x' y : M) :
  polar Q (x + x') y = polar Q x y + polar Q x' y :=
Q.polar_add_left' x x' y

@[simp]
lemma polar_smul_left (a : R) (x y : M) :
  polar Q (a • x) y = a * polar Q x y :=
Q.polar_smul_left' a x y

@[simp]
lemma polar_neg_left (x y : M) :
  polar Q (-x) y = -polar Q x y :=
by rw [←neg_one_smul R x, polar_smul_left, neg_one_mul]

@[simp]
lemma polar_sub_left (x x' y : M) :
  polar Q (x - x') y = polar Q x y - polar Q x' y :=
by rw [sub_eq_add_neg, sub_eq_add_neg, polar_add_left, polar_neg_left]

@[simp]
lemma polar_zero_right (y : M) : polar Q y 0 = 0 :=
by simp [polar]

@[simp]
lemma polar_add_right (x y y' : M) :
  polar Q x (y + y') = polar Q x y + polar Q x y' :=
Q.polar_add_right' x y y'

@[simp]
lemma polar_smul_right (a : R) (x y : M) :
  polar Q x (a • y) = a * polar Q x y :=
Q.polar_smul_right' a x y

@[simp]
lemma polar_neg_right (x y : M) :
  polar Q x (-y) = -polar Q x y :=
by rw [←neg_one_smul R y, polar_smul_right, neg_one_mul]

@[simp]
lemma polar_sub_right (x y y' : M) :
  polar Q x (y - y') = polar Q x y - polar Q x y' :=
by rw [sub_eq_add_neg, sub_eq_add_neg, polar_add_right, polar_neg_right]

@[simp]
lemma polar_self (x : M) : polar Q x x = 2 * Q x :=
begin
  rw [polar, map_add_self, sub_sub, sub_eq_iff_eq_add, ←two_mul, ←two_mul, ←mul_assoc],
  norm_num
end

section of_tower

variables [comm_semiring S] [algebra S R] [module S M] [is_scalar_tower S R M]

@[simp]
lemma polar_smul_left_of_tower (a : S) (x y : M) :
  polar Q (a • x) y = a • polar Q x y :=
by rw [←is_scalar_tower.algebra_map_smul R a x, polar_smul_left, algebra.smul_def]

@[simp]
lemma polar_smul_right_of_tower (a : S) (x y : M) :
  polar Q x (a • y) = a • polar Q x y :=
by rw [←is_scalar_tower.algebra_map_smul R a y, polar_smul_right, algebra.smul_def]

end of_tower

variable {Q' : quadratic_form R M}
@[ext] lemma ext (H : ∀ (x : M), Q x = Q' x) : Q = Q' :=
by { cases Q, cases Q', congr, funext, apply H }

instance : has_zero (quadratic_form R M) :=
⟨ { to_fun := λ x, 0,
    to_fun_smul := λ a x, by simp,
    polar_add_left' := λ x x' y, by simp [polar],
    polar_smul_left' := λ a x y, by simp [polar],
    polar_add_right' := λ x y y', by simp [polar],
    polar_smul_right' := λ a x y, by simp [polar] } ⟩

@[simp] lemma coe_fn_zero : ⇑(0 : quadratic_form R M) = 0 := rfl

@[simp] lemma zero_apply (x : M) : (0 : quadratic_form R M) x = 0 := rfl

instance : inhabited (quadratic_form R M) := ⟨0⟩

instance : has_add (quadratic_form R M) :=
⟨ λ Q Q',
  { to_fun := Q + Q',
    to_fun_smul := λ a x,
      by simp only [pi.add_apply, map_smul, mul_add],
    polar_add_left' := λ x x' y,
      by simp only [polar_add, polar_add_left, add_assoc, add_left_comm],
    polar_smul_left' := λ a x y,
      by simp only [polar_add, smul_eq_mul, mul_add, polar_smul_left],
    polar_add_right' := λ x y y',
      by simp only [polar_add, polar_add_right, add_assoc, add_left_comm],
    polar_smul_right' := λ a x y,
      by simp only [polar_add, smul_eq_mul, mul_add, polar_smul_right] } ⟩

@[simp] lemma coe_fn_add (Q Q' : quadratic_form R M) : ⇑(Q + Q') = Q + Q' := rfl

@[simp] lemma add_apply (Q Q' : quadratic_form R M) (x : M) : (Q + Q') x = Q x + Q' x := rfl

instance : has_neg (quadratic_form R M) :=
⟨ λ Q,
  { to_fun := -Q,
  to_fun_smul := λ a x,
    by simp only [pi.neg_apply, map_smul, mul_neg_eq_neg_mul_symm],
  polar_add_left' := λ x x' y,
    by simp only [polar_neg, polar_add_left, neg_add],
  polar_smul_left' := λ a x y,
    by simp only [polar_neg, polar_smul_left, mul_neg_eq_neg_mul_symm, smul_eq_mul],
  polar_add_right' := λ x y y',
    by simp only [polar_neg, polar_add_right, neg_add],
  polar_smul_right' := λ a x y,
    by simp only [polar_neg, polar_smul_right, mul_neg_eq_neg_mul_symm, smul_eq_mul] } ⟩

@[simp] lemma coe_fn_neg (Q : quadratic_form R M) : ⇑(-Q) = -Q := rfl

@[simp] lemma neg_apply (Q : quadratic_form R M) (x : M) : (-Q) x = -Q x := rfl

instance : add_comm_group (quadratic_form R M) :=
{ add := (+),
  zero := 0,
  neg := has_neg.neg,
  add_comm := λ Q Q', by { ext, simp only [add_apply, add_comm] },
  add_assoc := λ Q Q' Q'', by { ext, simp only [add_apply, add_assoc] },
  add_left_neg := λ Q, by { ext, simp only [add_apply, neg_apply, zero_apply, add_left_neg] },
  add_zero := λ Q, by { ext, simp only [zero_apply, add_apply, add_zero] },
  zero_add := λ Q, by { ext, simp only [zero_apply, add_apply, zero_add] } }

@[simp] lemma coe_fn_sub (Q Q' : quadratic_form R M) : ⇑(Q - Q') = Q - Q' :=
by simp [sub_eq_add_neg]

@[simp] lemma sub_apply (Q Q' : quadratic_form R M) (x : M) : (Q - Q') x = Q x - Q' x :=
by simp [sub_eq_add_neg]

/-- `@coe_fn (quadratic_form R M)` as an `add_monoid_hom`.

This API mirrors `add_monoid_hom.coe_fn`. -/
@[simps apply]
def coe_fn_add_monoid_hom : quadratic_form R M →+ (M → R) :=
{ to_fun := coe_fn, map_zero' := coe_fn_zero, map_add' := coe_fn_add }

/-- Evaluation on a particular element of the module `M` is an additive map over quadratic forms. -/
@[simps apply]
def eval_add_monoid_hom (m : M) : quadratic_form R M →+ R :=
(add_monoid_hom.apply _ m).comp coe_fn_add_monoid_hom

section sum

open_locale big_operators

@[simp] lemma coe_fn_sum {ι : Type*} (Q : ι → quadratic_form R M) (s : finset ι) :
  ⇑(∑ i in s, Q i) = ∑ i in s, Q i :=
(coe_fn_add_monoid_hom : _ →+ (M → R)).map_sum Q s

@[simp] lemma sum_apply {ι : Type*} (Q : ι → quadratic_form R M) (s : finset ι) (x : M) :
  (∑ i in s, Q i) x = ∑ i in s, Q i x :=
(eval_add_monoid_hom x : _ →+ R).map_sum Q s

end sum

section has_scalar

variables [comm_semiring S] [algebra S R]

/-- `quadratic_form R M` inherits the scalar action from any algebra over `R`.

When `R` is commutative, this provides an `R`-action via `algebra.id`. -/
instance : has_scalar S (quadratic_form R M) :=
⟨ λ a Q,
  { to_fun := a • Q,
    to_fun_smul := λ b x, by rw [pi.smul_apply, map_smul, pi.smul_apply, algebra.mul_smul_comm],
    polar_add_left' := λ x x' y, by simp only [polar_smul, polar_add_left, smul_add],
    polar_smul_left' := λ b x y, begin
      simp only [polar_smul, polar_smul_left, ←algebra.mul_smul_comm, smul_eq_mul],
    end,
    polar_add_right' := λ x y y', by simp only [polar_smul, polar_add_right, smul_add],
    polar_smul_right' := λ b x y, begin
      simp only [polar_smul, polar_smul_right, ←algebra.mul_smul_comm, smul_eq_mul],
    end } ⟩

@[simp] lemma coe_fn_smul (a : S) (Q : quadratic_form R M) : ⇑(a • Q) = a • Q := rfl

@[simp] lemma smul_apply (a : S) (Q : quadratic_form R M) (x : M) :
  (a • Q) x = a • Q x := rfl

instance : module S (quadratic_form R M) :=
{ mul_smul := λ a b Q, ext (λ x, by
    simp only [smul_apply, mul_left_comm, ←smul_eq_mul, smul_assoc]),
  one_smul := λ Q, ext (λ x, by simp),
  smul_add := λ a Q Q', by { ext, simp only [add_apply, smul_apply, smul_add] },
  smul_zero := λ a, by { ext, simp only [zero_apply, smul_apply, smul_zero] },
  zero_smul := λ Q, by { ext, simp only [zero_apply, smul_apply, zero_smul] },
  add_smul := λ a b Q, by { ext, simp only [add_apply, smul_apply, add_smul] } }

end has_scalar

section comp

variables {N : Type v} [add_comm_group N] [module R N]

/-- Compose the quadratic form with a linear function. -/
def comp (Q : quadratic_form R N) (f : M →ₗ[R] N) :
  quadratic_form R M :=
{ to_fun := λ x, Q (f x),
  to_fun_smul := λ a x, by simp only [map_smul, f.map_smul],
  polar_add_left' := λ x x' y,
    by convert polar_add_left (f x) (f x') (f y) using 1;
      simp only [polar, f.map_add],
  polar_smul_left' := λ a x y,
    by convert polar_smul_left a (f x) (f y) using 1;
      simp only [polar, f.map_smul, f.map_add, smul_eq_mul],
  polar_add_right' := λ x y y',
    by convert polar_add_right (f x) (f y) (f y') using 1;
      simp only [polar, f.map_add],
  polar_smul_right' := λ a x y,
    by convert polar_smul_right a (f x) (f y) using 1;
      simp only [polar, f.map_smul, f.map_add, smul_eq_mul] }

@[simp] lemma comp_apply (Q : quadratic_form R N) (f : M →ₗ[R] N) (x : M) :
  (Q.comp f) x = Q (f x) := rfl

end comp

section comm_ring

/-- Create a quadratic form in a commutative ring by proving only one side of the bilinearity. -/
def mk_left (f : M → R₁)
  (to_fun_smul : ∀ a x, f (a • x) = a * a * f x)
  (polar_add_left : ∀ x x' y, polar f (x + x') y = polar f x y + polar f x' y)
  (polar_smul_left : ∀ a x y, polar f (a • x) y = a * polar f x y) :
  quadratic_form R₁ M :=
{ to_fun := f,
  to_fun_smul := to_fun_smul,
  polar_add_left' := polar_add_left,
  polar_smul_left' := polar_smul_left,
  polar_add_right' :=
    λ x y y', by rw [polar_comm, polar_add_left, polar_comm f y x, polar_comm f y' x],
  polar_smul_right' :=
    λ a x y, by rw [polar_comm, polar_smul_left, polar_comm f y x, smul_eq_mul] }

/-- The product of linear forms is a quadratic form. -/
def lin_mul_lin (f g : M →ₗ[R₁] R₁) : quadratic_form R₁ M :=
mk_left (f * g)
  (λ a x, by { simp, ring })
  (λ x x' y, by { simp [polar], ring })
  (λ a x y, by { simp [polar], ring })

@[simp]
lemma lin_mul_lin_apply (f g : M →ₗ[R₁] R₁) (x) : lin_mul_lin f g x = f x * g x := rfl

@[simp]
lemma add_lin_mul_lin (f g h : M →ₗ[R₁] R₁) :
  lin_mul_lin (f + g) h = lin_mul_lin f h + lin_mul_lin g h :=
ext (λ x, add_mul _ _ _)

@[simp]
lemma lin_mul_lin_add (f g h : M →ₗ[R₁] R₁) :
  lin_mul_lin f (g + h) = lin_mul_lin f g + lin_mul_lin f h :=
ext (λ x, mul_add _ _ _)

variables {N : Type v} [add_comm_group N] [module R₁ N]

@[simp]
lemma lin_mul_lin_comp (f g : M →ₗ[R₁] R₁) (h : N →ₗ[R₁] M) :
  (lin_mul_lin f g).comp h = lin_mul_lin (f.comp h) (g.comp h) :=
rfl

variables {n : Type*}

/-- `proj i j` is the quadratic form mapping the vector `x : n → R₁` to `x i * x j` -/
def proj (i j : n) : quadratic_form R₁ (n → R₁) :=
lin_mul_lin (@linear_map.proj _ _ _ (λ _, R₁) _ _ i) (@linear_map.proj _ _ _ (λ _, R₁) _ _ j)

@[simp]
lemma proj_apply (i j : n) (x : n → R₁) : proj i j x = x i * x j := rfl

end comm_ring

end quadratic_form

/-!
### Associated bilinear forms

Over a commutative ring with an inverse of 2, the theory of quadratic forms is
basically identical to that of symmetric bilinear forms. The map from quadratic
forms to bilinear forms giving this identification is called the `associated`
quadratic form.
-/

variables {B : bilin_form R M}

namespace bilin_form
open quadratic_form

lemma polar_to_quadratic_form (x y : M) : polar (λ x, B x x) x y = B x y + B y x :=
by simp [polar, add_left, add_right, sub_eq_add_neg _ (B y y), add_comm (B y x) _, add_assoc]

/-- A bilinear form gives a quadratic form by applying the argument twice. -/
def to_quadratic_form (B : bilin_form R M) : quadratic_form R M :=
⟨ λ x, B x x,
  λ a x, by simp [smul_left, smul_right, mul_assoc],
  λ x x' y, by simp [polar_to_quadratic_form, add_left, add_right, add_left_comm, add_assoc],
  λ a x y, by simp [polar_to_quadratic_form, smul_left, smul_right, mul_add],
  λ x y y', by simp [polar_to_quadratic_form, add_left, add_right, add_left_comm, add_assoc],
  λ a x y, by simp [polar_to_quadratic_form, smul_left, smul_right, mul_add] ⟩

@[simp] lemma to_quadratic_form_apply (B : bilin_form R M) (x : M) :
  B.to_quadratic_form x = B x x :=
rfl

end bilin_form

namespace quadratic_form
open bilin_form sym_bilin_form

section associated_hom
variables (S) [comm_semiring S] [algebra S R]
variables [invertible (2 : R)] {B₁ : bilin_form R M}

/-- `associated_hom` is the map that sends a quadratic form on a module `M` over `R` to its
associated symmetric bilinear form.  As provided here, this has the structure of an `S`-linear map
where `S` is a commutative subring of `R`.

Over a commutative ring, use `associated`, which gives an `R`-linear map.  Over a general ring with
no nontrivial distinguished commutative subring, use `associated'`, which gives an additive
homomorphism (or more precisely a `ℤ`-linear map.) -/
def associated_hom : quadratic_form R M →ₗ[S] bilin_form R M :=
{ to_fun := λ Q,
  { bilin := λ x y, ⅟2 * polar Q x y,
    bilin_add_left := λ x y z, by rw [← mul_add, polar_add_left],
    bilin_smul_left := λ x y z, begin
      have htwo : x * ⅟2 = ⅟2 * x := (commute.one_right x).bit0_right.inv_of_right,
      simp [polar_smul_left, ← mul_assoc, htwo]
    end,
    bilin_add_right := λ x y z, by rw [← mul_add, polar_add_right],
    bilin_smul_right := λ x y z, begin
      have htwo : x * ⅟2 = ⅟2 * x := (commute.one_right x).bit0_right.inv_of_right,
      simp [polar_smul_left, ← mul_assoc, htwo]
    end },
  map_add' := λ Q Q', by { ext, simp [bilin_form.add_apply, polar_add, mul_add] },
  map_smul' := λ s Q, by { ext, simp [polar_smul, algebra.mul_smul_comm] } }

variables {Q : quadratic_form R M} {S}

@[simp] lemma associated_apply (x y : M) :
  associated_hom S Q x y = ⅟2 * (Q (x + y) - Q x - Q y) := rfl

lemma associated_is_sym : is_sym (associated_hom S Q) :=
λ x y, by simp only [associated_apply, add_comm, add_left_comm, sub_eq_add_neg]

@[simp] lemma associated_comp {N : Type v} [add_comm_group N] [module R N] (f : N →ₗ[R] M) :
  associated_hom S (Q.comp f) = (associated_hom S Q).comp f f :=
by { ext, simp }

lemma associated_to_quadratic_form (B : bilin_form R M) (x y : M) :
  associated_hom S B.to_quadratic_form x y = ⅟2 * (B x y + B y x) :=
by simp [associated_apply, ←polar_to_quadratic_form, polar]

lemma associated_left_inverse (h : is_sym B₁) :
  associated_hom S (B₁.to_quadratic_form) = B₁ :=
bilin_form.ext $ λ x y,
by rw [associated_to_quadratic_form, sym h x y, ←two_mul, ←mul_assoc, inv_of_mul_self, one_mul]

lemma associated_right_inverse : (associated_hom S Q).to_quadratic_form = Q :=
quadratic_form.ext $ λ x,
  calc (associated_hom S Q).to_quadratic_form x
      = ⅟2 * (Q x + Q x) : by simp [map_add_self, bit0, add_mul, add_assoc]
  ... = Q x : by rw [← two_mul (Q x), ←mul_assoc, inv_of_mul_self, one_mul]

lemma associated_eq_self_apply (x : M) : associated_hom S Q x x = Q x :=
begin
  rw [associated_apply, map_add_self],
  suffices : (⅟2) * (2 * Q x) = Q x,
  { convert this,
    simp only [bit0, add_mul, one_mul],
    abel },
  simp [← mul_assoc],
end

/-- `associated'` is the `ℤ`-linear map that sends a quadratic form on a module `M` over `R` to its
associated symmetric bilinear form. -/
abbreviation associated' : quadratic_form R M →ₗ[ℤ] bilin_form R M :=
associated_hom ℤ

/-- There exists a non-null vector with respect to any quadratic form `Q` whose associated
bilinear form is non-degenerate, i.e. there exists `x` such that `Q x ≠ 0`. -/
lemma exists_quadratic_form_neq_zero [nontrivial M]
  {Q : quadratic_form R M} (hB₁ : Q.associated'.nondegenerate) :
  ∃ x, Q x ≠ 0 :=
begin
  rw nondegenerate at hB₁,
  contrapose! hB₁,
  obtain ⟨x, hx⟩ := exists_ne (0 : M),
  refine ⟨x, λ y, _, hx⟩,
  have : Q = 0 := quadratic_form.ext hB₁,
  simp [this]
end

end associated_hom

section associated
variables [invertible (2 : R₁)]

-- Note:  When possible, rather than writing lemmas about `associated`, write a lemma applying to
-- the more general `associated_hom` and place it in the previous section.

/-- `associated` is the linear map that sends a quadratic form over a commutative ring to its
associated symmetric bilinear form. -/
abbreviation associated : quadratic_form R₁ M →ₗ[R₁] bilin_form R₁ M :=
associated_hom R₁

@[simp] lemma associated_lin_mul_lin (f g : M →ₗ[R₁] R₁) :
  (lin_mul_lin f g).associated =
    ⅟(2 : R₁) • (bilin_form.lin_mul_lin f g + bilin_form.lin_mul_lin g f) :=
by { ext, simp [bilin_form.add_apply, bilin_form.smul_apply], ring }

end associated

section anisotropic

/-- An anisotropic quadratic form is zero only on zero vectors. -/
def anisotropic (Q : quadratic_form R M) : Prop := ∀ x, Q x = 0 → x = 0

lemma not_anisotropic_iff_exists (Q : quadratic_form R M) :
  ¬anisotropic Q ↔ ∃ x ≠ 0, Q x = 0 :=
by simp only [anisotropic, not_forall, exists_prop, and_comm]

/-- The associated bilinear form of an anisotropic quadratic form is nondegenerate. -/
lemma nondegenerate_of_anisotropic [invertible (2 : R)] (Q : quadratic_form R M)
  (hB : Q.anisotropic) : Q.associated'.nondegenerate :=
begin
  intros x hx,
  refine hB _ _,
  rw ← hx x,
  exact (associated_eq_self_apply x).symm,
end

end anisotropic

section pos_def

variables {R₂ : Type u} [ordered_ring R₂] [module R₂ M] {Q₂ : quadratic_form R₂ M}

/-- A positive definite quadratic form is positive on nonzero vectors. -/
def pos_def (Q₂ : quadratic_form R₂ M) : Prop := ∀ x ≠ 0, 0 < Q₂ x

lemma pos_def.smul {R} [linear_ordered_comm_ring R] [module R M]
  {Q : quadratic_form R M} (h : pos_def Q) {a : R} (a_pos : 0 < a) : pos_def (a • Q) :=
λ x hx, mul_pos a_pos (h x hx)

variables {n : Type*}

lemma pos_def.add (Q Q' : quadratic_form R₂ M) (hQ : pos_def Q) (hQ' : pos_def Q') :
  pos_def (Q + Q') :=
λ x hx, add_pos (hQ x hx) (hQ' x hx)

lemma lin_mul_lin_self_pos_def {R} [linear_ordered_comm_ring R] [module R M]
  (f : M →ₗ[R] R) (hf : linear_map.ker f = ⊥) :
  pos_def (lin_mul_lin f f) :=
λ x hx, mul_self_pos (λ h, hx (linear_map.ker_eq_bot.mp hf (by rw [h, linear_map.map_zero])))

end pos_def
end quadratic_form

section
/-!
### Quadratic forms and matrices

Connect quadratic forms and matrices, in order to explicitly compute with them.
The convention is twos out, so there might be a factor 2⁻¹ in the entries of the
matrix.
The determinant of the matrix is the discriminant of the quadratic form.
-/

variables {n : Type w} [fintype n] [decidable_eq n]

/-- `M.to_quadratic_form` is the map `λ x, col x ⬝ M ⬝ row x` as a quadratic form. -/
def matrix.to_quadratic_form' (M : matrix n n R₁) :
  quadratic_form R₁ (n → R₁) :=
M.to_bilin'.to_quadratic_form

variables [invertible (2 : R₁)]

/-- A matrix representation of the quadratic form. -/
def quadratic_form.to_matrix' (Q : quadratic_form R₁ (n → R₁)) : matrix n n R₁ :=
Q.associated.to_matrix'

open quadratic_form
lemma quadratic_form.to_matrix'_smul (a : R₁) (Q : quadratic_form R₁ (n → R₁)) :
  (a • Q).to_matrix' = a • Q.to_matrix' :=
by simp only [to_matrix', linear_equiv.map_smul, linear_map.map_smul]

end

namespace quadratic_form

variables {n : Type w} [fintype n]
variables [decidable_eq n] [invertible (2 : R₁)]
variables {m : Type w} [decidable_eq m] [fintype m]
open_locale matrix

@[simp]
lemma to_matrix'_comp (Q : quadratic_form R₁ (m → R₁)) (f : (n → R₁) →ₗ[R₁] (m → R₁)) :
  (Q.comp f).to_matrix' = f.to_matrix'ᵀ ⬝ Q.to_matrix' ⬝ f.to_matrix' :=
by { ext, simp [to_matrix', bilin_form.to_matrix'_comp] }

section discriminant
variables {Q : quadratic_form R₁ (n → R₁)}

/-- The discriminant of a quadratic form generalizes the discriminant of a quadratic polynomial. -/
def discr (Q : quadratic_form R₁ (n → R₁)) : R₁ := Q.to_matrix'.det

lemma discr_smul (a : R₁) : (a • Q).discr = a ^ fintype.card n * Q.discr :=
by simp only [discr, to_matrix'_smul, matrix.det_smul]

lemma discr_comp (f : (n → R₁) →ₗ[R₁] (n → R₁)) :
  (Q.comp f).discr = f.to_matrix'.det * f.to_matrix'.det * Q.discr :=
by simp [discr, mul_left_comm, mul_comm]

end discriminant

end quadratic_form

namespace quadratic_form

variables {M₁ : Type*} {M₂ : Type*} {M₃ : Type*}
variables [add_comm_group M₁] [add_comm_group M₂] [add_comm_group M₃]
variables [module R M₁] [module R M₂] [module R M₃]

/-- An isometry between two quadratic spaces `M₁, Q₁` and `M₂, Q₂` over a ring `R`,
is a linear equivalence between `M₁` and `M₂` that commutes with the quadratic forms. -/
@[nolint has_inhabited_instance] structure isometry
  (Q₁ : quadratic_form R M₁) (Q₂ : quadratic_form R M₂) extends M₁ ≃ₗ[R] M₂ :=
(map_app' : ∀ m, Q₂ (to_fun m) = Q₁ m)

/-- Two quadratic forms over a ring `R` are equivalent
if there exists an isometry between them:
a linear equivalence that transforms one quadratic form into the other. -/
def equivalent (Q₁ : quadratic_form R M₁) (Q₂ : quadratic_form R M₂) := nonempty (Q₁.isometry Q₂)

namespace isometry

variables {Q₁ : quadratic_form R M₁} {Q₂ : quadratic_form R M₂} {Q₃ : quadratic_form R M₃}

instance : has_coe (Q₁.isometry Q₂) (M₁ ≃ₗ[R] M₂) := ⟨isometry.to_linear_equiv⟩

instance : has_coe_to_fun (Q₁.isometry Q₂) :=
{ F := λ _, M₁ → M₂, coe := λ f, ⇑(f : M₁ ≃ₗ[R] M₂) }

@[simp] lemma map_app (f : Q₁.isometry Q₂) (m : M₁) : Q₂ (f m) = Q₁ m := f.map_app' m

/-- The identity isometry from a quadratic form to itself. -/
@[refl]
def refl (Q : quadratic_form R M) : Q.isometry Q :=
{ map_app' := λ m, rfl,
  .. linear_equiv.refl R M }

/-- The inverse isometry of an isometry between two quadratic forms. -/
@[symm]
def symm (f : Q₁.isometry Q₂) : Q₂.isometry Q₁ :=
{ map_app' := by { intro m, rw ← f.map_app, congr, exact f.to_linear_equiv.apply_symm_apply m },
  .. (f : M₁ ≃ₗ[R] M₂).symm }

/-- The composition of two isometries between quadratic forms. -/
@[trans]
def trans (f : Q₁.isometry Q₂) (g : Q₂.isometry Q₃) : Q₁.isometry Q₃ :=
{ map_app' := by { intro m, rw [← f.map_app, ← g.map_app], refl },
  .. (f : M₁ ≃ₗ[R] M₂).trans (g : M₂ ≃ₗ[R] M₃) }

end isometry

namespace equivalent

variables {Q₁ : quadratic_form R M₁} {Q₂ : quadratic_form R M₂} {Q₃ : quadratic_form R M₃}

@[refl]
lemma refl (Q : quadratic_form R M) : Q.equivalent Q := ⟨isometry.refl Q⟩

@[symm]
lemma symm (h : Q₁.equivalent Q₂) : Q₂.equivalent Q₁ := h.elim $ λ f, ⟨f.symm⟩

@[trans]
lemma trans (h : Q₁.equivalent Q₂) (h' : Q₂.equivalent Q₃) : Q₁.equivalent Q₃ :=
h'.elim $ h.elim $ λ f g, ⟨f.trans g⟩

end equivalent

end quadratic_form

namespace bilin_form

/-- A bilinear form is nondegenerate if the quadratic form it is associated with is anisotropic. -/
lemma nondegenerate_of_anisotropic
  {B : bilin_form R M} (hB : B.to_quadratic_form.anisotropic) : B.nondegenerate :=
λ x hx, hB _ (hx x)

/-- There exists a non-null vector with respect to any symmetric, nondegenerate bilinear form `B`
on a nontrivial module `M` over a ring `R` with invertible `2`, i.e. there exists some
`x : M` such that `B x x ≠ 0`. -/
lemma exists_bilin_form_self_neq_zero [htwo : invertible (2 : R)] [nontrivial M]
  {B : bilin_form R M} (hB₁ : B.nondegenerate) (hB₂ : sym_bilin_form.is_sym B) :
  ∃ x, ¬ B.is_ortho x x :=
begin
  have : B.to_quadratic_form.associated'.nondegenerate,
  { simpa [quadratic_form.associated_left_inverse hB₂] using hB₁ },
  obtain ⟨x, hx⟩ := quadratic_form.exists_quadratic_form_neq_zero this,
  refine ⟨x, λ h, hx (B.to_quadratic_form_apply x ▸ h)⟩,
end

open finite_dimensional

variables {V : Type u} {K : Type v} [field K] [add_comm_group V] [module K V]
variable [finite_dimensional K V]

-- We start proving that symmetric nondegenerate bilinear forms are diagonalisable, or equivalently
-- there exists a orthogonal basis with respect to any symmetric nondegenerate bilinear form.

lemma exists_orthogonal_basis' [hK : invertible (2 : K)]
  {B : bilin_form K V} (hB₁ : B.nondegenerate) (hB₂ : sym_bilin_form.is_sym B) :
  ∃ v : fin (finrank K V) → V,
    B.is_Ortho v ∧ is_basis K v ∧ ∀ i, B (v i) (v i) ≠ 0 :=
begin
  tactic.unfreeze_local_instances,
  induction hd : finrank K V with d ih generalizing V,
  { exact ⟨λ _, 0, λ _ _ _, zero_left _, is_basis_of_finrank_zero' hd, fin.elim0⟩ },
  { haveI := finrank_pos_iff.1 (hd.symm ▸ nat.succ_pos d : 0 < finrank K V),
    cases exists_bilin_form_self_neq_zero hB₁ hB₂ with x hx,
    { have hd' := hd,
      rw [← submodule.finrank_add_eq_of_is_compl
            (is_compl_span_singleton_orthogonal hx).symm,
          finrank_span_singleton (ne_zero_of_not_is_ortho_self x hx)] at hd,
      rcases @ih (B.orthogonal $ K ∙ x) _ _ _
        (B.restrict _) (B.restrict_orthogonal_span_singleton_nondegenerate hB₁ hB₂ hx)
        (B.restrict_sym hB₂ _) (nat.succ.inj hd) with ⟨v', hv₁, hv₂, hv₃⟩,
      refine ⟨λ i, if h : i ≠ 0 then coe (v' (i.pred h)) else x, λ i j hij, _, _, _⟩,
      { by_cases hi : i = 0,
        { subst i,
          simp only [eq_self_iff_true, not_true, ne.def, dif_neg,
            not_false_iff, dite_not],
          rw [dif_neg hij.symm, is_ortho, hB₂],
          exact (v' (j.pred hij.symm)).2 _ (submodule.mem_span_singleton_self x) },
        by_cases hj : j = 0,
        { subst j,
          simp only [eq_self_iff_true, not_true, ne.def, dif_neg,
            not_false_iff, dite_not],
          rw dif_neg hi,
          exact (v' (i.pred hi)).2 _ (submodule.mem_span_singleton_self x) },
        { simp_rw [dif_pos hi, dif_pos hj],
          rw [is_ortho, hB₂],
          exact hv₁ (j.pred hj) (i.pred hi) (by simpa using hij.symm) } },
      { refine is_basis_of_linear_independent_of_card_eq_finrank
          (@linear_independent_of_is_Ortho _ _ _ _ _ _ B _ _ _)
          (by rw [hd', fintype.card_fin]),
        { intros i j hij,
          by_cases hi : i = 0,
          { subst hi,
            simp only [eq_self_iff_true, not_true, ne.def, dif_neg,
              not_false_iff, dite_not],
            rw [dif_neg hij.symm, is_ortho, hB₂],
            exact (v' (j.pred hij.symm)).2 _ (submodule.mem_span_singleton_self x) },
          by_cases hj : j = 0,
          { subst j,
            simp only [eq_self_iff_true, not_true, ne.def, dif_neg,
              not_false_iff, dite_not],
            rw dif_neg hi,
            exact (v' (i.pred hi)).2 _ (submodule.mem_span_singleton_self x) },
          { simp_rw [dif_pos hi, dif_pos hj],
            rw [is_ortho, hB₂],
            exact hv₁ (j.pred hj) (i.pred hi) (by simpa using hij.symm) } },
        { intro i,
          by_cases hi : i ≠ 0,
          { rw dif_pos hi,
            exact hv₃ (i.pred hi) },
          { rw dif_neg hi, exact hx } } },
      { intro i,
          by_cases hi : i ≠ 0,
          { rw dif_pos hi,
            exact hv₃ (i.pred hi) },
          { rw dif_neg hi, exact hx } } } }
end .

/-- Given a nondegenerate symmetric bilinear form `B` on some vector space `V` over the
  field `K` with invertible `2`, there exists an orthogonal basis with respect to `B`. -/
theorem exists_orthogonal_basis [hK : invertible (2 : K)]
  {B : bilin_form K V} (hB₁ : B.nondegenerate) (hB₂ : sym_bilin_form.is_sym B) :
  ∃ v : fin (finrank K V) → V, B.is_Ortho v ∧ is_basis K v :=
let ⟨v, hv₁, hv₂, _⟩ := exists_orthogonal_basis' hB₁ hB₂ in ⟨v, hv₁, hv₂⟩

end bilin_form