-- ArkLib/Data/FieldTheory/AdditiveNTT/NovelPolynomialBasis.lean

import ArkLib.Data.Nat.Bitwise

import ArkLib.Data.Polynomial.Frobenius

import ArkLib.Data.Polynomial.MonomialBasis

import Mathlib.LinearAlgebra.StdBasis

import Mathlib.Algebra.Polynomial.Degree.Definitions

open Polynomial FiniteDimensional Finset Module

namespace AdditiveNTT

variable {r : ℕ} [NeZero r]

variable {L : Type u} [Field L] [Fintype L] [DecidableEq L]

variable (𝔽q : Type u) [Field 𝔽q] [Fintype 𝔽q]
  [h_Fq_char_prime : Fact (Nat.Prime (ringChar 𝔽q))] [hF₂ : Fact (Fintype.card 𝔽q = 2)]

variable [Algebra 𝔽q L]

variable (h_dim : Module.finrank 𝔽q L = r)

variable (β : Fin r → L) [hβ_lin_indep : Fact (LinearIndependent 𝔽q β)]

section LinearSubspaces

def U (i : Fin r) : Subspace 𝔽q L := Submodule.span 𝔽q (β '' (Set.Ico 0 i))

noncomputable def W (i : Fin r) : L[X] :=
  ∏ u : U 𝔽q β i, (X - C u.val)

end LinearSubspaces

section LinearityOfSubspaceVanishingPolynomials

@[simps!]
noncomputable def algEquivAevalXSubC {R : Type*} [CommRing R] (t : R) : R[X] ≃ₐ[R] R[X] :=

-- Repository definitions used:
content: def getBit (k n : Nat) : Nat := (n >>> k) &&& 1

-- Repository lemmas used:
content: lemma Fin.lt_succ' (a : Fin r) (h_a_add_1 : a + 1 < r) : a < a + 1

content: lemma Fin.val_add_one' (a : Fin r) (h_a_add_1 : a + 1 < r) : (a + 1).val = a.val + 1

content: lemma Fin.le_succ (a : Fin r) (h_a_add_1 : a + 1 < r) : a ≤ a + 1

content: lemma Fin.le_iff_lt_succ (a b : Fin r) (h_b : b + 1 < r) : a ≤ b ↔ a < b + 1

content: lemma Fin.val_sub_one (a : Fin r) (h_a_sub_1 : a > 0) : (a - 1).val = a.val - 1

content: theorem prod_poly_sub_C_eq_poly_pow_card_sub_poly_in_L
  (p : L[X]) :
  (∏ c ∈ (Finset.univ : Finset Fq), (p - Polynomial.C (algebraMap Fq L c))) =
    p^(Fintype.card Fq) - p

content: theorem prod_X_sub_C_eq_X_pow_card_sub_X_in_L :
  (∏ c ∈ (Finset.univ : Finset Fq), (Polynomial.X - Polynomial.C (algebraMap Fq L c))) =
    Polynomial.X^(Fintype.card Fq) - Polynomial.X

content: theorem prod_X_sub_C_eq_X_pow_card_sub_X :
  (∏ c ∈ (Finset.univ : Finset Fq), (Polynomial.X - Polynomial.C c)) =
    Polynomial.X^(Fintype.card Fq) - Polynomial.X

content: theorem linear_map_of_comp_to_linear_map_of_eval (f : L[X])
  (h_f_linear : IsLinearMap (R := Fq) (M := L[X]) (M₂ := L[X])
    (f := fun inner_p ↦ f.comp inner_p)) :
    IsLinearMap (R := Fq) (M := L) (M₂ := L) (f := fun x ↦ f.eval x)

content: theorem frobenius_identity_in_algebra [Fact (Nat.Prime (ringChar Fq))]
  (f g : L[X]) : (f + g)^(Fintype.card Fq) = f^(Fintype.card Fq) + g^(Fintype.card Fq)

-- Local definitions used:
content: def U (i : Fin r) : Subspace 𝔽q L := Submodule.span 𝔽q (β '' (Set.Ico 0 i))

content: noncomputable def W (i : Fin r) : L[X] :=
  ∏ u : U 𝔽q β i, (X - C u.val)

content: @[simps!]
noncomputable def algEquivAevalXSubC {R : Type*} [CommRing R] (t : R) : R[X] ≃ₐ[R] R[X] :=

-- Local lemmas used:
content: lemma βᵢ_not_in_Uᵢ (i : Fin r) :
    β i ∉ U 𝔽q β i

content: omit [Fintype L] [DecidableEq L] [Fintype 𝔽q] h_Fq_char_prime in
theorem root_U_lift_down
  (i : Fin r) (h_i_add_1 : i + 1 < r) (a : L) :
  a ∈ (U 𝔽q β (i+1)) → ∃! x: 𝔽q, a - x • β i ∈ (U 𝔽q β i)

content: omit [Fintype L] [DecidableEq L] [Fintype 𝔽q] h_Fq_char_prime hβ_lin_indep in
theorem root_U_lift_up (i : Fin r) (h_i_add_1 : i + 1 < r) (a : L) (x : 𝔽q) :
  a - x • β i ∈ (U 𝔽q β i) → a ∈ (U 𝔽q β (i+1))

content: lemma W_monic (i : Fin r) : (W 𝔽q β i).Monic

content: omit [DecidableEq L] [Fintype 𝔽q] hβ_lin_indep in
lemma W_ne_zero (i : Fin r) : (W 𝔽q β i) ≠ 0

content: lemma Wᵢ_eval_βᵢ_neq_zero
    (i : Fin r): (W 𝔽q β i).eval (β i) ≠ 0

content: lemma W_splits (i : Fin r) : (W 𝔽q β i).Splits (RingHom.id L)

content: lemma roots_W (i : Fin r) : -- converts root Multiset into (univ: Uᵢ.val.map)
  (W 𝔽q β i).roots = (univ : Finset (U 𝔽q β i)).val.map (fun u => u.val)

content: omit [Fintype L] [DecidableEq L] in
lemma comp_X_sub_C_eq_zero_iff (p : L[X]) (a : L) :
  p.comp (X - C a) = 0 ↔ p = 0

content: lemma rootMultiplicity_comp_X_sub_C (p : L[X]) (a x : L) :
    rootMultiplicity x (p.comp (X - C a)) = rootMultiplicity (x - a) p

content: lemma roots_comp_X_sub_C (p : L[X]) (a : L) :
    (p.comp (X - C a)).roots = p.roots.map (fun r => r + a)

content: omit [DecidableEq L] h_Fq_char_prime hF₂ hβ_lin_indep in
lemma Prod_W_comp_X_sub_C_ne_zero (i : Fin r) :
    (univ : Finset 𝔽q).prod (fun c => (W 𝔽q β i).comp (X - C (c • β i))) ≠ 0

content: lemma rootMultiplicity_W (i : Fin r) (a : L) :
    rootMultiplicity a (W 𝔽q β i) = if a ∈ (U 𝔽q β i : Set L) then 1 else 0

content: omit h_Fq_char_prime hF₂ in
lemma rootMultiplicity_prod_W_comp_X_sub_C
    (i : Fin r) (h_i_add_1 : i + 1 < r) (a : L) :
    rootMultiplicity a ((univ : Finset 𝔽q).prod (fun c => (W 𝔽q β i).comp (X - C (c • β i)))) =
    if a ∈ (U 𝔽q β (i+1) : Set L) then 1 else 0

content: lemma W_prod_comp_decomposition
    (i : Fin r) (hi : i > 0) :
    (W 𝔽q β i) = ∏ c: 𝔽q, (W 𝔽q β (i-1)).comp (X - C (c • β (i-1)))

content: lemma comp_sub_C_of_linear_eval (p : L[X])
  (h_lin : IsLinearMap 𝔽q (f := fun inner_p ↦ p.comp inner_p)) (a : L) :
    p.comp (X - C a) = p - C (eval a p)

content: omit h_Fq_char_prime hF₂ in
lemma inductive_rec_form_W_comp (i : Fin r) (h_i_add_1 : i + 1 < r)
    (h_prev_linear_map : IsLinearMap (R := 𝔽q) (M := L[X]) (M₂ := L[X])
      (f := fun inner_p ↦ (W 𝔽q β i).comp inner_p))
    : ∀ p: L[X], (W 𝔽q β (i + 1)).comp p =
      ((W 𝔽q β i).comp p) ^ Fintype.card 𝔽q -
        C (eval (β i) (W 𝔽q β i)) ^ (Fintype.card 𝔽q - 1) * ((W 𝔽q β i).comp p)

-- Target theorem and proof:
omit hF₂ in
lemma inductive_linear_map_W (i : Fin r) (h_i_add_1 : i + 1 < r)
    (h_prev_linear_map : IsLinearMap 𝔽q (f := fun inner_p ↦ (W 𝔽q β i).comp inner_p))
    : IsLinearMap 𝔽q (f := fun inner_p ↦ (W 𝔽q β (i + 1)).comp inner_p)
:= by

  have h_rec_form := inductive_rec_form_W_comp
    (hβ_lin_indep := hβ_lin_indep) (h_prev_linear_map := h_prev_linear_map) (i :=i)

  set q := Fintype.card 𝔽q
  set v := (W 𝔽q β i).eval (β i)

  -- `∀ f(X), f(X) ∈ L[X]`:
  constructor
  · intro f g
    -- 1. Proof flow
    -- `Wᵢ₊₁(f(X)+g(X)) = Wᵢ(f(X)+g(X))² - v • Wᵢ(f(X)+g(X))` -- h_rec_form
    -- `= (Wᵢ(f(X)) + Wᵢ(g(X)))² - v • (Wᵢ(f(X)) + Wᵢ(g(X)))`
    -- `= (Wᵢ(f(X))² + (Wᵢ(g(X)))² - v • Wᵢ(f(X)) - v • Wᵢ(g(X)))` => Freshman's Dream
    -- `= (Wᵢ(f(X))² - v • Wᵢ(f(X))) + (Wᵢ(g(X))² - v • Wᵢ(g(X)))` -- h_rec_form
    -- `= Wᵢ₊₁(f(X)) + Wᵢ₊₁(g(X))` -- Q.E.D.

    -- ⊢ (W 𝔽q β (i + 1)).comp (x + y) = (W 𝔽q β (i + 1)).comp x + (W 𝔽q β (i + 1)).comp y
    calc
      _ = ((W 𝔽q β i).comp (f + g))^q - C v ^ (q - 1) * ((W 𝔽q β i).comp (f + g)) := by
        rw [h_rec_form h_i_add_1]
      _ = ((W 𝔽q β i).comp f)^q + ((W 𝔽q β i).comp g)^q
        - C v ^ (q - 1) * ((W 𝔽q β i).comp f) - C v ^ (q - 1) * ((W 𝔽q β i).comp g) := by
        rw [h_prev_linear_map.map_add]
        rw [Polynomial.frobenius_identity_in_algebra]
        rw [left_distrib]
        unfold q
        abel_nf
      _ = (((W 𝔽q β i).comp f)^q - C v ^ (q - 1) * ((W 𝔽q β i).comp f))
        + (((W 𝔽q β i).comp g)^q - C v ^ (q - 1) * ((W 𝔽q β i).comp g)) := by
        abel_nf
      _ = (W 𝔽q β (i+1)).comp f + (W 𝔽q β (i+1)).comp g := by
        unfold q
        rw [h_rec_form h_i_add_1 f]
        rw [h_rec_form h_i_add_1 g]
  · intro c f
    -- 2. Proof flow
    -- `Wᵢ₊₁(c • f(X)) = Wᵢ(c • f(X))² - v • Wᵢ(c • f(X))` -- h_rec_form
    -- `= c² • Wᵢ(f(X))² - v • c • Wᵢ(f(X))`
    -- `= c • Wᵢ(f(X))² - v • c • Wᵢ(f(X))` via Fermat's Little Theorem (X^q = X)
    -- `= c • (Wᵢ(f(X))² - v • Wᵢ(f(X)))` -- h_rec_form
    -- `= c • Wᵢ₊₁(f(X))` -- Q.E.D.
    have h_c_smul_to_algebraMap_smul: ∀ t: L[X], c • t = (algebraMap 𝔽q L c) • t := by
      exact algebra_compatible_smul L c
    have h_c_smul_to_C_algebraMap_mul: ∀ t: L[X], c • t = C (algebraMap 𝔽q L c) * t := by
      intro t
      rw [h_c_smul_to_algebraMap_smul]
      exact smul_eq_C_mul ((algebraMap 𝔽q L) c)
    -- ⊢ (W 𝔽q β (i + 1)).comp (c • x) = c • (W 𝔽q β (i + 1)).comp x
    calc
      _ = ((W 𝔽q β i).comp (c • f))^q - C v ^ (q - 1) * ((W 𝔽q β i).comp (c • f)) := by
        rw [h_rec_form h_i_add_1 (c • f)]
      _ = (C (algebraMap 𝔽q L c) * (W 𝔽q β i).comp f)^q
        - C v ^ (q - 1) * (C (algebraMap 𝔽q L c) * (W 𝔽q β i).comp f) := by
        rw [h_prev_linear_map.map_smul]
        rw [mul_pow]
        simp_rw [h_c_smul_to_C_algebraMap_mul]
        congr
        rw [mul_pow]
      _ = C (algebraMap 𝔽q L (c^q)) * ((W 𝔽q β i).comp f)^q
        - C v ^ (q - 1) * (C (algebraMap 𝔽q L c) * (W 𝔽q β i).comp f) := by
        rw [mul_pow]
        congr -- ⊢ C ((algebraMap 𝔽q L) c) ^ q = C ((algebraMap 𝔽q L) (c ^ q))
        rw [←C_pow]
        simp_rw [algebraMap.coe_pow c q]
      _ = C (algebraMap 𝔽q L (c^q)) * ((W 𝔽q β i).comp f)^q
        - C v ^ (q - 1) * (C (algebraMap 𝔽q L c) * (W 𝔽q β i).comp f) := by
        -- use Fermat's Little Theorem (X^q = X)
        simp only [map_pow]
      _ = C (algebraMap 𝔽q L (c)) * ((W 𝔽q β i).comp f)^q
        - C v ^ (q - 1) * (C (algebraMap 𝔽q L c) * (W 𝔽q β i).comp f) := by
        rw [FiniteField.pow_card]
      _ = C (algebraMap 𝔽q L c) * (((W 𝔽q β i).comp f)^q
        - C v ^ (q - 1) * (W 𝔽q β i).comp f) := by
        rw [←mul_assoc]
        conv_lhs => rw [mul_comm (a := C v ^ (q - 1)) (b := C (algebraMap 𝔽q L c))]; rw [mul_assoc]
        exact
          Eq.symm
            (mul_sub_left_distrib (C ((algebraMap 𝔽q L) c)) ((W 𝔽q β i).comp f ^ q)
              (C v ^ (q - 1) * (W 𝔽q β i).comp f))
      _ = C (algebraMap 𝔽q L c) * (W 𝔽q β (i + 1)).comp f := by
        rw [h_rec_form h_i_add_1 f]
      _ = _ := by
        rw [h_c_smul_to_C_algebraMap_mul]