import algebra.ring data.complex.basic data.zmod.basic
import data.nat.prime data.int.gcd data.nat.choose algebra.gcd_monoid.basic data.finsupp
import data.list.min_max data.polynomial
import data.nat.square_free
import ring_theory.integral_domain
import tactic.ring tactic.squeeze
namespace sec_elements

universes u₀ u₁
variables {A : Type u₀} [comm_ring A] {B : Type u₁} [comm_ring B]
variable (f : A →+* B)

/- -------------------------------------------------------- -/
/- defn-el-props -/

def inverse (a : A) := {b : A // a * b = 1}

def is_invertible (a : A) := nonempty (inverse a)

noncomputable def inv (a : A) (h : is_invertible a) :=
 classical.choice h

def is_regular (a : A) : Prop := ∀ (x : A) (e : a * x = 0), x = 0

def is_zero_divisor (a : A) := ¬ (is_regular a)

def nilpotent_witness (a : A) := {n : ℕ // a ^ n = 0}

def is_nilpotent (a : A) := nonempty (nilpotent_witness a)

def is_jacobian (a : A) := ∀ (b : A), is_invertible (1 - a * b)

def is_idempotent (a : A) := a ^ 2 = a

lemma is_idempotent' (a : A) : is_idempotent a ↔ a * (1 - a) = 0 :=
by { dsimp[is_idempotent],
 rw[pow_two,mul_sub,mul_one,sub_eq_zero],
 split; intro e; exact e.symm}

def inverse_hom {a : A} (u : inverse a) : inverse (f a) :=
 ⟨f u.val,by { rw[← f.map_mul,u.property, f.map_one]}⟩

lemma is_invertible_hom {a : A} (h : is_invertible a) : is_invertible (f a) :=
 by { apply nonempty.elim h, intro u, use inverse_hom f u }

def nilpotent_witness_hom {a : A} (n : nilpotent_witness a) : nilpotent_witness (f a) :=
 ⟨n.val, by { rw[← f.map_pow a n.val, n.property, f.map_zero] } ⟩

lemma is_nilpotent_hom {a : A} (h : is_nilpotent a) : is_nilpotent (f a) :=
 by { apply nonempty.elim h, intro n, use nilpotent_witness_hom f n }

lemma is_idempotent_hom {a : A} (h : is_idempotent a) : is_idempotent (f a) :=
 by { change a ^ 2 = a at h, change (f a) ^ 2 = f a, rw[← f.map_pow, h] }

/- -------------------------------------------------------- -/
/- prop-inv-unique -/

instance inverse_unique (a : A) : subsingleton (inverse a) :=
 ⟨λ ⟨b₀,h₀⟩ ⟨b₁,h₁⟩ , begin apply subtype.eq, change b₀ = b₁,
  rw[← mul_one b₀,← h₁,← mul_assoc,mul_comm b₀,h₀,one_mul],
 end ⟩

/- -------------------------------------------------------- -/
/- eg-C-el-props -/

namespace integral_domain

variables {D : Type*} [comm_ring D] [is_domain D] (a : D)

lemma is_regular_iff : (is_regular a ↔ a ≠ 0) :=
begin
 split,
 {rintro h_reg a_eq_0, exact zero_ne_one (h_reg 1 (a_eq_0.symm ▸ (zero_mul 1))).symm},
 {intros a_ne_0 b e,
  rcases eq_zero_or_eq_zero_of_mul_eq_zero e with ha | hb,
  {exact (a_ne_0 ha).elim},{exact hb}}
end

lemma is_nilpotent_iff : (is_nilpotent a ↔ a = 0) :=
begin
 split,
 {rintro ⟨⟨n,e⟩⟩,induction n with n ih,
  {rw[pow_zero] at e,exact (zero_ne_one e.symm).elim},
  {rw[pow_succ] at e,rcases eq_zero_or_eq_zero_of_mul_eq_zero e with h | h,
   {exact h},{exact ih h}
  }
 },{
  intro h,rw[h],exact ⟨⟨1,pow_one 0⟩⟩
 }
end

lemma is_idempotent_iff : (is_idempotent a ↔ a = 0 ∨ a = 1) :=
begin
 rw[is_idempotent'],split,
 {intro e,rcases eq_zero_or_eq_zero_of_mul_eq_zero e with h0 | h1,
  {exact or.inl h0},
  {exact or.inr (sub_eq_zero.mp h1).symm,}
 },{
  rintro (h | h); rw[h],rw[zero_mul],rw[sub_self,mul_zero],
 }
end

end integral_domain

namespace field

variables {F : Type*} [field F] (a : F)

lemma is_invertible_iff : (is_invertible a ↔ a ≠ 0) :=
begin
 split,
 {rintro ⟨⟨ai,ai_prop⟩⟩ a_eq_0,rw[a_eq_0,zero_mul] at ai_prop,
  exact zero_ne_one ai_prop
 },{intro a_ne_0,use a⁻¹,exact mul_inv_cancel a_ne_0,}
end

lemma is_regular_iff : (is_regular a ↔ a ≠ 0) :=
begin
 split,
 {rintro h_reg a_eq_0, exact zero_ne_one (h_reg 1 (a_eq_0.symm ▸ (zero_mul 1))).symm},
 {intros a_ne_0 b e,exact calc
   b = 1 * b : (one_mul b).symm
   ... = 0 : by rw[← inv_mul_cancel a_ne_0,mul_assoc,e,mul_zero],}
end

end field

namespace C_el_props

lemma ℂ_el_props (z : ℂ) :
 (is_invertible z ↔ z ≠ 0) ∧
 (is_regular z ↔ z ≠ 0) ∧
 (is_nilpotent z ↔ z = 0) ∧
 (is_idempotent z ↔ (z = 0 ∨ z = 1)) :=
begin
 split,exact field.is_invertible_iff z,
 split,exact integral_domain.is_regular_iff z,
 split,exact integral_domain.is_nilpotent_iff z,
       exact integral_domain.is_idempotent_iff z,
end

end C_el_props

/- -------------------------------------------------------- -/
/- eg-Zn-el-props -/

namespace zmod_el_props

variables (n : ℕ) [fact (n > 0)]

namespace int

def gcd_a (x y : ℤ) : ℤ :=
 x.sign * (nat.gcd_a x.nat_abs y.nat_abs)

def gcd_b (x y : ℤ) : ℤ :=
 y.sign * (nat.gcd_b x.nat_abs y.nat_abs)

lemma nat_abs_eq_sign_mul_self : ∀ (x : ℤ),
 (x.nat_abs : ℤ) = x.sign * x
| (0 : ℕ) := rfl
| ((n + 1) : ℕ) := by {rw[int.nat_abs_of_nat,int.sign,_root_.one_mul],}
| (-[1+ m]) := by {rw[int.nat_abs,int.sign,← neg_eq_neg_one_mul],refl}

lemma gcd_eq_gcd_ab (x y : ℤ) :
 (gcd x y) = x * (gcd_a x y) + y * (gcd_b x y) :=
begin
 let d := nat.gcd x.nat_abs y.nat_abs,
 let a := nat.gcd_a x.nat_abs y.nat_abs,
 let b := nat.gcd_b x.nat_abs y.nat_abs,
 change (d : ℤ) = x * (x.sign * a) + y * (y.sign * b),
 let h : (d : ℤ) = x.nat_abs * a + y.nat_abs * b:=
  by {dsimp[d,a,b],exact nat.gcd_eq_gcd_ab x.nat_abs y.nat_abs},
 rw[← _root_.mul_assoc,← _root_.mul_assoc,mul_comm x,mul_comm y],
 rw[← nat_abs_eq_sign_mul_self x,← nat_abs_eq_sign_mul_self y],
 exact h,
end

end int

namespace nat

def sup_monoid : add_comm_monoid ℕ := {
  zero := 0,
  add := λ (a b : ℕ), ite (a ≤ b) b a,
  add_zero := λ a, by
   {dsimp[has_add.add],split_ifs,exact (nat.eq_zero_of_le_zero h).symm,refl},
  zero_add := λ a, by
   {dsimp[has_add.add],split_ifs,refl,exact (h (nat.zero_le a)).elim},
  add_comm := λ a b, by
   {change ℕ at a,
     dsimp[has_add.add],split_ifs with hab hba,
    {exact le_antisymm hba hab},{refl},{refl},
     {exact (h (le_of_lt (lt_of_not_ge hab))).elim},
   },
  add_assoc := λ a b c, by {
    dsimp[has_add.add],split_ifs with hab hbc hac hac hbc; try {refl},
    {exact (hac (le_trans hab hbc)).elim},
    {replace hbc := lt_of_not_ge hbc,
     replace hab := lt_of_not_ge hab,
     exact (not_le_of_gt (lt_trans hbc hab) hac).elim,
    }
  },
}

end nat

lemma is_invertible_iff (a : ℤ) :
 (is_invertible (a : zmod n)) ↔ gcd a n = 1 :=
begin
 let en : ((n : ℕ) : ℤ) = n := rfl,
 split,
 {
  rintro ⟨b₀,hab⟩,
  let d := gcd a n,change d = 1,
  have : d = d.nat_abs :=
   ((int.coe_nat_abs_eq_normalize d).trans (normalize_gcd a n)).symm,
  rw[this,← int.coe_nat_one],congr,
  let b : ℤ := b₀.val,
  have : (b : zmod n) = b₀ := by {rw[int.cast_coe_nat,b₀.nat_cast_zmod_val],},
  rw[← this,← int.cast_mul] at hab,
  have : (((a * b - 1) : ℤ) : (zmod n)) = 0 :=
   by {rw[int.cast_sub,hab,int.cast_one,sub_self],},
  rcases (zmod.int_coe_zmod_eq_zero_iff_dvd (a * b - 1) n).mp this with ⟨c,e⟩,
  change a * b - 1 = n * c at e,
  replace e : a * b = n * c + 1 := by {rw[← e,sub_add,sub_self,sub_zero],},
  let ha : d ∣ a := by {dsimp[d],rw[en], exact gcd_dvd_left a n},
  let hn : d ∣ n := by {dsimp[d],rw[en], exact gcd_dvd_right a n},
  let hab : d ∣ (n * c + 1) := e ▸ (dvd_mul_of_dvd_left ha b),
  rcases ((dvd_add_iff_right (dvd_mul_of_dvd_left hn c)).mpr hab) with ⟨u,eu⟩,
  replace eu := congr_arg int.nat_abs eu,
  change 1 = (d * u).nat_abs at eu,rw[int.nat_abs_mul] at eu,
  exact (nat.mul_eq_one_iff.mp eu.symm).left,
 },{
  let d := gcd a n,
  let b := int.gcd_a a n,
  let q := int.gcd_b a n,
  have e : d = a * b + n * q := int.gcd_eq_gcd_ab a n,
  intro h, change d = 1 at h,rw[e,← en] at h,
  replace h := eq_sub_of_add_eq h,
  have : (a : zmod n) * (b : zmod n) = 1 :=
  by {rw[← int.cast_mul,h,int.cast_sub,int.cast_mul,int.cast_coe_nat],
      rw[zmod.nat_cast_self,zero_mul,sub_zero,int.cast_one],},
  exact ⟨⟨(b : zmod n),this⟩⟩
 }
end

lemma is_invertible_iff' (a : ℕ) :
 (is_invertible (a : zmod n)) ↔
  (∀ (p : ℕ), (nat.prime p) → (p ∣ n) → ¬ (p ∣ a)) :=
begin
 rw[← int.cast_coe_nat,is_invertible_iff],
 dsimp[gcd,int.gcd],rw[← int.coe_nat_one,int.coe_nat_inj'],
 split,
 {intros h p p_prime p_dvd_n p_dvd_a,
  have : p ∣ 1 := h ▸ (nat.dvd_gcd p_dvd_a p_dvd_n),
  exact nat.prime.not_dvd_one p_prime this,
 },
 {intro h,by_contradiction h',
  let d := nat.gcd a n,
  let p := nat.min_fac d,
  let p_prime : p.prime := nat.min_fac_prime h',
  let p_dvd_d : p ∣ d := nat.min_fac_dvd d,
  let p_dvd_a : p ∣ a := dvd_trans p_dvd_d (nat.gcd_dvd_left a n),
  let p_dvd_n : p ∣ n := dvd_trans p_dvd_d (nat.gcd_dvd_right a n),
  exact h p p_prime p_dvd_n p_dvd_a,
 }
end

lemma is_regular_iff (a : ℕ) :
 (is_regular (a : zmod n)) ↔ (is_invertible (a : zmod n)) :=
begin
 split,
 {intro h,
  let f : (zmod n) → (zmod n) := λ x, a * x,
  have : function.injective f := λ x₁ x₂ e,
   by {rw[← sub_eq_zero] at e ⊢,
    dsimp[f] at e,rw[← mul_sub] at e,
    exact h _ e
   },
  rcases (fintype.injective_iff_surjective.mp this 1) with ⟨b,e⟩,
  dsimp[f] at e,exact ⟨⟨b,e⟩⟩,
 },{
  rintros ⟨⟨b,eab⟩⟩ x eax,rw[mul_comm] at eab,
  exact calc
   x = 1 * x : (one_mul x).symm
    ... = 0 : by rw[← eab,mul_assoc,eax,mul_zero b],
 }
end

lemma is_nilpotent_iff (a : ℕ) :
 (is_nilpotent (a : zmod n)) ↔
  (∀ (p : ℕ), (nat.prime p) → (p ∣ n) → (p ∣ a)) :=
begin
 split,
 {rintro ⟨⟨k,e⟩⟩ p p_prime p_dvd_n,
  rw[← nat.cast_pow] at e,
  replace e := dvd_trans p_dvd_n ((zmod.nat_coe_zmod_eq_zero_iff_dvd _ _).mp e) ,
  exact nat.prime.dvd_of_dvd_pow p_prime e,
 },{
  have hn : n > 0 := fact.elim (by { apply_instance }),
  rcases nat.dvd_square_free_radical (ne_of_gt hn) with ⟨k,⟨q,hq⟩⟩,
  intro h,
  rcases (nat.square_free_radical_dvd_iff (ne_of_gt hn) a).mpr h with ⟨r,hr⟩,
  have ha : a ^ k = n * (q * r ^ k) :=
    by { rw[hr,mul_pow,hq,mul_assoc] },
  have hz : (n : zmod n) = 0 := zmod.nat_cast_self n,
  have := calc
   (a : zmod n) ^ k = (((a ^ k) : ℕ) : zmod n) : by rw[nat.cast_pow]
  ... = 0 : by {rw[ha,nat.cast_mul,nat.cast_mul,nat.cast_pow,hz,zero_mul]},
  exact ⟨⟨k,this⟩⟩,
 }
end

end zmod_el_props

/- -------------------------------------------------------- -/
/- prop-inv-prod -/

variable (A)
def inverse_one : inverse (1 : A) := ⟨1,mul_one 1⟩
variable {A}

def inverse_prod_equiv (a b : A) :
 inverse (a * b) ≃ ((inverse b) × (inverse a)) := {
  to_fun := λ ⟨u,e⟩, ⟨⟨a * u,by {rw[← e],ring}⟩,
                     ⟨b * u,by {rw[← e],ring}⟩⟩ ,
  inv_fun := λ ⟨⟨v,ev⟩,⟨u,eu⟩⟩,
   ⟨v * u, calc (a * b) * (v * u) = (a * u) * (b * v) : by ring
           ... = 1 : by rw[eu,ev,mul_one],
   ⟩,
  left_inv := λ u, by {apply subsingleton.elim},
  right_inv := λ ⟨v,u⟩, by {apply prod.ext;apply subsingleton.elim},
}

def inverse_inv (a : A) (u : inverse a) : inverse u.val :=
 ⟨a,by {rw[mul_comm,u.property]}⟩

variable (A)
lemma is_invertible_one : is_invertible (1 : A) :=
 ⟨inverse_one A⟩
variable {A}

lemma is_invertible_mul_iff (a b : A) :
 is_invertible (a * b) ↔ (is_invertible a) ∧ (is_invertible b) :=
begin
 split,
 {rintro ⟨uv⟩,let uv' := (inverse_prod_equiv a b).to_fun uv,
  exact ⟨⟨uv'.2⟩,⟨uv'.1⟩⟩},
 {rintro ⟨⟨u⟩,⟨v⟩⟩, exact ⟨(inverse_prod_equiv a b).inv_fun ⟨v,u⟩⟩,}
end

/- -------------------------------------------------------- -/
/- prop-regular-prod -/

variable (A)
def is_regular_one : is_regular (1 : A) :=
 λ x h, by {rw[one_mul] at h, exact h}
variable {A}

def is_regular_mul_iff {a b : A} :
  is_regular (a * b) ↔ (is_regular a) ∧ (is_regular b) :=
begin
 split,
 {intro hab,split,
  {intros x e,
   have e' : (a * b) * x = b * (a * x) := by ring,
   rw[e,mul_zero] at e',exact hab _ e',},
  {intros x e,
   have e' : (a * b) * x = a * (b * x) := by ring,
   rw[e,mul_zero] at e',exact hab _ e',},
  },
  {rintro ⟨ha,hb⟩ x e,rw[mul_assoc] at e,
   replace e := ha (b * x) e,replace e := hb x e,exact e,
  }
end

def is_regular_of_invertible {a : A} : is_invertible a → is_regular a :=
 λ ⟨u⟩ x e, calc
   x = (1 : A) * x : (one_mul x).symm
   ... = (a * u.val) * x : by rw[u.property]
   ... = u.val * (a * x) : by ring
   ... = 0 : by rw[e,mul_zero]

/- -------------------------------------------------------- -/
/- prop-finite-regular -/

lemma invertible_of_regular_of_finite [fintype A]
 {a : A} : (is_regular a) → (is_invertible a) :=
begin
 intro ha,
 let f : A → A := λ x, a * x,
 have hf : function.injective f :=
  λ x₀ x₁ e, begin
   let e' := calc
    a * (x₀ - x₁) = (a * x₀) - (a * x₁) : mul_sub _ _ _
    ... = (f x₀) - (f x₁) : rfl
    ... = 0 : by rw[e,sub_self],
   exact sub_eq_zero.mp (ha _ e')
  end,
  let hf' := fintype.injective_iff_surjective.mp hf,
  rcases (hf' 1) with ⟨u,hu⟩,
  exact ⟨⟨u,hu⟩⟩
end

/- -------------------------------------------------------- -/
/- prop-nilpotent-sum -/

lemma is_nilpotent_zero : is_nilpotent (0 : A) :=
 ⟨⟨1,pow_one 0⟩⟩

lemma is_nilpotent_add {a b : A} :
 is_nilpotent a → is_nilpotent b → is_nilpotent (a + b) :=
begin
 intros ha hb,
 rcases ha with ⟨_|n,ea⟩,
 {exact ⟨⟨0,by {rw[pow_zero] at ea ⊢,exact ea} ⟩⟩},
 rcases hb with ⟨_|m,eb⟩,
 {exact ⟨⟨0,by {rw[pow_zero] at eb ⊢,exact eb} ⟩⟩},
 constructor,
 use n + m + 1,rw[add_pow],
 rw[← @finset.sum_const_zero A ℕ (finset.range (n + m + 1).succ)],
 congr,ext i,
 by_cases hi : i ≥ n + 1,
 {rw[← nat.add_sub_of_le hi,pow_add,ea],repeat {rw[zero_mul]},},
 {change ¬ (i > n) at hi,
  replace hi := le_of_not_gt hi,
  have := nat.add_sub_of_le hi,
  have : n + m + 1 - i = (m + 1) + (n - i) := by {
   rw[← this,add_comm i,add_assoc,nat.add_sub_cancel],
   rw[add_assoc,add_comm i,← add_assoc,nat.add_sub_cancel,add_comm],
  },
  rw[this,pow_add,eb,zero_mul,mul_zero,zero_mul],
 }
end

lemma is_nilpotent_smul (a : A) {b : A} :
 is_nilpotent b → is_nilpotent (a * b) :=
λ ⟨⟨n,e⟩⟩, by {
 have e' : (a * b) ^ n = 0 := by { rw[mul_pow,e,mul_zero],},
 exact ⟨⟨n,e'⟩⟩
}

lemma is_nilpotent_neg {b : A} :
 is_nilpotent b → is_nilpotent (-b) :=
  λ h, by {rw[neg_eq_neg_one_mul],exact is_nilpotent_smul (-1) h}

lemma is_nilpotent_sub {a b : A} :
 is_nilpotent a → is_nilpotent b → is_nilpotent (a - b) :=
  λ ha hb, by {rw[sub_eq_add_neg],apply is_nilpotent_add,
              exact ha,apply is_nilpotent_neg,exact hb}

/- -------------------------------------------------------- -/
/- prop-nilpotent-inv -/

def geometric_series (a : A) (n : ℕ) :=
 (finset.range n).sum (λ i, a ^ i)

lemma geometric_sum (a : A) (n : ℕ) :
 (1 - a) * (geometric_series a n) = 1 - a ^ n :=
begin
 induction n with n ih,
 {change (1 - a) * 0 = 1 - a ^ 0,rw[mul_zero,pow_zero,sub_self],},
 {have : geometric_series a n.succ = a ^ n + geometric_series a n :=
   by {dsimp[geometric_series],rw[finset.sum_range_succ,add_comm]},
  rw[this,mul_add,ih,nat.succ_eq_add_one,pow_add,pow_one],
  rw[sub_mul,one_mul,mul_comm a],
  repeat {rw[sub_eq_add_neg]},
  rw[add_comm,add_assoc,← add_assoc (- (a^n)),neg_add_self,zero_add],
 }
end

def one_add_nilp_inv {a : A} :
 ∀ (h : nilpotent_witness a), inverse (1 + a)
| ⟨n,e⟩ := ⟨geometric_series (-a) n, by {
 let u := geometric_series (-a) n, change (1 + a) * u = 1,
 let e' : (1 - (- a)) * u = 1 - (- a) ^ n :=
  by {dsimp[u],exact geometric_sum (- a) n},
 rw[sub_neg_eq_add,neg_eq_neg_one_mul,mul_pow,e,mul_zero,sub_zero] at e',
 exact e'
} ⟩

lemma one_add_nilp_inv' {a : A} :
 is_nilpotent a → is_invertible (1 + a) :=
λ ⟨h⟩, ⟨one_add_nilp_inv h⟩

/- -------------------------------------------------------- -/

lemma is_jacobian_zero : is_jacobian (0 : A) := λ b,
begin
 rw[zero_mul, sub_zero], exact is_invertible_one A
end

lemma is_jacobian_add {a b : A}
 (ha : is_jacobian a) (hb : is_jacobian b) : is_jacobian (a + b) :=
begin
 intro x,
 rcases (ha x) with ⟨u,hu⟩,
 rcases (hb (x * u)) with ⟨v,hv⟩,
 use u * v,
 rw[add_mul, sub_mul, add_mul, one_mul, ← sub_sub, mul_assoc, mul_assoc],
 have hu' : ((1 - a * x) * u) * v = 1 * v := congr_arg (λ t, t * v) hu,
 rw [one_mul, sub_mul, one_mul, sub_mul, mul_assoc, mul_assoc] at hu',
 rw [sub_mul, one_mul, mul_assoc, mul_assoc] at hv,
 rw[hu', hv],
end

lemma is_jacobian_smul (a : A) {b : A} (hb : is_jacobian b) :
 is_jacobian (a * b) :=
begin
 rw[mul_comm],
 intro x, rw[mul_assoc], exact hb (a * x)
end

lemma is_jacobian_of_nilpotent {a : A} (ha : is_nilpotent a) :
 is_jacobian a :=
begin
 intro x,
 rw [sub_eq_add_neg],
 apply one_add_nilp_inv',
 rw[mul_comm, ← neg_mul],
 exact is_nilpotent_smul (-x) ha,
end

/- -------------------------------------------------------- -/
/- cor-nilp-inv -/

lemma inv_add_nilp_inv {u a : A} :
 is_invertible u → is_nilpotent a → is_invertible (u + a) :=
λ ⟨⟨v,euv⟩⟩ ea,
begin
 have : u + a = u * (1 + v * a) :=
  by { rw[mul_add,← mul_assoc,euv,mul_one,one_mul], },
 rw[this,is_invertible_mul_iff],
 split,
 {exact ⟨⟨v,euv⟩⟩},
 {exact one_add_nilp_inv' (is_nilpotent_smul v ea)}
end

/- -------------------------------------------------------- -/
/- prop-idempotent-ops -/

namespace idempotent
variable (A)

lemma zero_mem : is_idempotent (0 : A) :=
 by {dsimp[is_idempotent],rw[pow_two,mul_zero]}

lemma one_mem : is_idempotent (1 : A) :=
 by {dsimp[is_idempotent],rw[pow_two,mul_one]}

variable {A}

lemma pow_eq_self {a : A} (h : is_idempotent a) (n : ℕ) :
 a ^ n.succ = a :=
begin
 induction n with n ih,
 { rw[pow_one] },
 { rw[pow_succ, ih, ← pow_two], exact h }
end

lemma mul_self {a : A} (h : is_idempotent a) : a * a = a :=
  by { rw[← pow_two], exact h }

def not (a : A) := 1 - a
def and (a b : A) := a * b
def or  (a b : A) := a + b - a * b
def xor (a b : A) := a + b - 2 * a * b

lemma one_sub_mem {a : A} :
 is_idempotent a → is_idempotent (1 - a) :=
by {
 dsimp[is_idempotent],rw[pow_two,pow_two],intro e,
 rw[mul_sub,mul_one,sub_mul,one_mul,e,sub_self,sub_zero],
}

lemma mul_mem {a b : A} :
 is_idempotent a → is_idempotent b → is_idempotent (a * b) :=
by {
 intros ea eb, dsimp[is_idempotent] at *,
 rw[pow_two] at *,
 rw[mul_assoc,mul_comm b,mul_assoc a,eb,← mul_assoc,ea],
}

lemma add_sub_mul_mem {a b : A} :
 is_idempotent a → is_idempotent b → is_idempotent (a + b - a * b) :=
by {
 intros ea eb,
 have : a + b - a * b = 1 - (1 - a) * (1 - b) := by ring,
 rw[this],
 apply one_sub_mem, apply mul_mem; apply one_sub_mem; assumption,
}

def invol (a : A) := 1 - 2 * a

lemma invol_square {a : A} (ha : is_idempotent a) :
 (invol a) ^ 2 = 1 :=
begin
 dsimp[invol,is_idempotent] at ha,
 have : (1 - 2 * a) ^ 2 = 1 - 4 * (a - a ^ 2) :=
  by {rw[pow_two,pow_two],ring},
 rw[ha,sub_self,mul_zero,sub_zero] at this,
 exact this,
end

lemma eq_of_sub_nilp {e₀ e₁ : A}
 (h₀ : is_idempotent e₀) (h₁ : is_idempotent e₁)
  (h : is_nilpotent (e₀ - e₁)) : e₀ = e₁ :=
begin
 dsimp[is_idempotent] at h₀ h₁,rw[pow_two] at h₀ h₁,
 let x := e₀ - e₁,
 let u := 1 - 2 * e₀,
 let v := 1 + u * x,
 have hv : is_invertible v := one_add_nilp_inv' (is_nilpotent_smul u h),
 have hvx := calc
  v * x = (e₀ * e₀ - e₀) * (4 * e₁ - 2 * e₀ - 1) +
          (e₁ * e₁ - e₁) * (1 - 2 * e₀) :
    by {dsimp[v,u,x],ring}
   ... = 0 : by {rw[h₀,h₁,sub_self,sub_self,zero_mul,zero_mul,zero_add],},
 have hx : x = 0 := (is_regular_of_invertible hv) x hvx,
 rw[← sub_eq_zero],
 exact hx,
end

def lift : ∀ (e : A) (h : nilpotent_witness (e * (1 - e))), A :=
 λ e ⟨n,hx⟩, e ^ (n + 2) * geometric_series (1 - e ^ (n + 2) - (1 - e) ^ (n + 2)) n

def lift_spec (e : A) (h : nilpotent_witness (e * (1 - e))) :
 pprod (is_idempotent (lift e h)) (nilpotent_witness ((lift e h) - e)) :=
begin
 rcases h with ⟨n,hx⟩,
 let x := e * (1 - e), change x ^ n = 0 at hx,
 let y := 1 - e ^ (n + 2) - (1 - e) ^ (n + 2),
 let u := geometric_series y n,
 let e₁ := e ^ (n + 2) * u,
 have : lift e ⟨n,hx⟩ = e₁ := rfl,
 rw[this],
 let f := λ (i : ℕ), e ^ i * (1 - e) ^ (n + 2 - i) * nat.choose (n + 2) i,
 let z := (finset.range (n + 1)).sum
            (λ j, e ^ j * (1 - e) ^ (n - j) * (nat.choose (n + 2) (j + 1))),
 let xz := (finset.range (n + 1)).sum (f ∘ nat.succ),
 have hxz : x * z = xz := by {
   dsimp[xz,x],rw[finset.mul_sum],apply finset.sum_congr rfl,intros i hi,
   replace hi : i ≤ n := nat.le_of_lt_succ (finset.mem_range.mp hi),
   have : (f ∘ nat.succ) i = f (i + 1) := rfl, rw[this], dsimp[f],
   have : n + 2 - (i + 1) = (n - i) + 1 := calc
    n + 2 - (i + 1) = n + 1 - i : by {rw[nat.succ_sub_succ]}
    ... = (i + (n - i)) + 1 - i : by {rw[nat.add_sub_of_le hi]}
    ... = (n - i) + 1 : by {simp only [add_comm,add_assoc,nat.add_sub_cancel_left],},
   rw[this,pow_succ,pow_succ],repeat {rw[mul_assoc]},congr' 1,
   repeat {rw[← mul_assoc]},rw[mul_comm (1 - e) (e ^ i)],
 },
 have hf₀ : f 0 = (1 - e) ^ (n + 2) :=
  by {dsimp[f],rw[nat.choose,nat.cast_one,mul_one,pow_zero,one_mul],},
 have hf₁ : f (n + 2) = e ^ (n + 2) :=
  by {dsimp[f],rw[nat.choose_self,nat.cast_one,nat.sub_self,pow_zero,mul_one,mul_one],},
 dsimp[f] at hf₀ hf₁,
 have := calc
  (1 : A) = (1 : A) ^ (n + 2) : (one_pow (n + 2)).symm
  ... = (e + (1 - e)) ^ (n + 2) :
   by {congr,rw[add_sub,add_comm,add_sub_cancel]}
  ... = (finset.range (n + 2).succ).sum f : add_pow e (1 - e) (n + 2)
  ... = e ^ (n + 2) + (finset.range (n + 2)).sum f :
         by {rw[finset.sum_range_succ,hf₁,add_comm],}
  ... = e ^ (n + 2) + (xz + (1 - e) ^ (n + 2)) :
         by { congr' 1,rw[finset.sum_range_succ'],
              change xz + _ = _,congr' 1}
  ... = e ^ (n + 2) + (x * z + (1 - e) ^ (n + 2)) : by {rw[hxz]},
 have hxyz := calc
  y = 1 - e ^ (n + 2) - (1 - e) ^ (n + 2) : rfl
  ... = (e ^ (n + 2) + (x * z + (1 - e) ^ (n + 2))) - e ^ (n + 2) - (1 - e) ^ (n + 2) :
   by {congr' 2}
  ... = x * z : by {simp only [sub_eq_add_neg,add_comm,add_left_comm,
                               add_neg_cancel_left,add_neg_cancel_right],},
 have hy : y ^ n = 0 := by {rw[hxyz,mul_pow,hx,zero_mul],},
 have hu : (1 - y) * u = 1 := by {rw[geometric_sum y n,hy,sub_zero]},
 have : 1 - y = e ^ (n + 2) + (1 - e) ^ (n + 2) :=
  calc 1 - y = 1 - (1 - e ^ (n + 2) - (1 - e) ^ (n + 2)) : by {simp only [y]}
   ... = e ^ (n + 2) + (1 - e) ^ (n + 2) : by rw[sub_sub,sub_sub_cancel],
 let hu' := hu, rw[this] at hu',
 have := calc
  1 - e₁ = (e ^ (n + 2) + (1 - e) ^ (n + 2)) * u - e₁ : by {rw[hu'],}
  ... = e ^ (n + 2) * u + (1 - e) ^ (n + 2) * u - e ^ (n + 2) * u :
   by {rw[add_mul],}
  ... = (1 - e) ^ (n + 2) * u : by {rw[add_comm,add_sub_cancel]},
 have := calc
  e₁ * (1 - e₁) = (e ^ (n + 2) * u) * (1 - e₁) : rfl
  ... = u * (e ^ (n + 2) * (1 - e₁)) : by {rw[mul_comm (e ^ (n + 2))],rw[← mul_assoc],}
  ... = u * (e ^ (n + 2) * (1 - e) ^ (n + 2) * u) : by {rw[this,mul_assoc]}
  ... = u * (x ^ (n + 2) * u) : by {rw[mul_pow,pow_add],}
  ... = 0 : by {rw[pow_add,hx,zero_mul,zero_mul,mul_zero],},
 split, exact (is_idempotent' e₁).mpr this,
 let w := geometric_series e (n + 1),
 have hw : x * w = e - e ^ (n + 2) := calc
  x * w = e * ((1 - e) * w) : by {dsimp[x],rw[mul_assoc]}
  ... = e * (1 - e ^ (n + 1)) : by {rw[geometric_sum e (n + 1)],}
  ... = e - e ^ (n + 2) : by {rw[mul_sub,mul_one,pow_succ e (n + 1)],},
 have hu'' : u = 1 + x * z * u := by {
   rw[sub_mul,hxyz,one_mul] at hu,rw[← hu,sub_add_cancel],
 },
 have := calc
  e₁ - e = e ^ (n + 2) * u - e : rfl
  ... = e ^ (n + 2) * (1 + x * z * u) - e : by {congr' 2}
  ... = (e ^ (n + 2) * (x * z * u) + e ^ (n + 2)) - e :
         by {rw[mul_add,mul_one,add_comm],}
  ... = x * (e ^ (n + 2) * z * u) - (e - e ^ (n + 2)) :
         by {rw[← sub_add,sub_eq_add_neg,sub_eq_add_neg],
             rw[← mul_assoc,← mul_assoc,mul_comm (e ^ (n + 2))],
             repeat {rw[add_assoc]},rw[add_comm (e ^ (n + 2))],
             repeat {rw[mul_assoc]},}
  ... = x * (e ^ (n + 2) * z * u - w) : by {rw[mul_sub,hw],},
 have : (e₁ - e) ^ n = 0 := by {rw[this,mul_pow,hx,zero_mul],},
 exact ⟨n,this⟩,
end

lemma lift_unique (e e₁ : A)
 (h : nilpotent_witness (e * (1 - e))) (hi : is_idempotent e₁)
 (hn : is_nilpotent (e₁ - e)) : e₁ = lift e h :=
begin
 rcases lift_spec e h with ⟨hi',hn'⟩,
 apply eq_of_sub_nilp hi hi',
 have : e₁ - lift e h = (e₁ - e) - (lift e h - e) :=
  by {rw[sub_sub_sub_cancel_right],},
 rw[this],apply is_nilpotent_sub hn ⟨hn'⟩
end

/- -------------------------------------------------------- -/
/- rem-lifting -/

def lift' : ∀ (e : A) (h : nilpotent_witness (e * (1 - e))), A :=
 λ e ⟨n,hx⟩,
  let x := e * (1 - e) in
   let b := (finset.range n).sum (λ k, ((x ^ k) * nat.choose (2 * k + 1) k)) in
    e + (2 * e - 1) * b * x

/-
lemma lift_eq (e : A) (h : nilpotent_witness (e * (1 - e))) :
 lift' e h = lift e h := sorry
-/

end idempotent

/- -------------------------------------------------------- -/
/- prop-poly-el-props -/

namespace poly_el_props
open polynomial

variables [decidable_eq A] (p : polynomial A)

lemma leading_mul {p q : polynomial A} {n m : ℕ}
 (hp : ∀ i, i > n → p.coeff i = 0) (hq : ∀ j, j > m → q.coeff j = 0) :
  (∀ k, k > n + m → (p * q).coeff k = 0) ∧
   (p * q).coeff (n + m) = (p.coeff n) * (q.coeff m) :=
begin
 split,
 { intros k hk,
   rw[coeff_mul], apply finset.sum_eq_zero,
   rintro ⟨i,j⟩ hij,
   replace hij : i + j = k := finset.nat.mem_antidiagonal.mp hij,
   change p.coeff i * q.coeff j = 0,
   by_cases hi : i > n,
   { rw[hp i hi, zero_mul] },
   { replace hi : i ≤ n := le_of_not_gt hi,
     have hj : j > m := begin
      apply lt_of_not_ge, intro hj',
      have := lt_of_le_of_lt (add_le_add hi hj') hk,
      rw[hij] at this, exact lt_irrefl k this,
     end,
     rw[hq j hj, mul_zero],
   }
 },{
  rw[coeff_mul],
  let nm : ℕ × ℕ := ⟨n,m⟩,
  have hnm : nm ∈ finset.nat.antidiagonal (n + m) :=
    finset.nat.mem_antidiagonal.mpr rfl,
  have h_single : ∀ (x : ℕ × ℕ) (hx₀ : x ∈ finset.nat.antidiagonal (n + m))
    (hx₁ : x ≠ nm), (p.coeff x.1) * (q.coeff x.2) = 0 :=
  begin
    intros,
    replace hx₁ : x.1 ≠ n := λ e, hx₁ ((finset.nat.antidiagonal_congr hx₀ hnm).mpr e),
    replace hx₀ : x.1 + x.2 = n + m := finset.nat.mem_antidiagonal.mp hx₀,
    by_cases hx₂ : x.1 ≥ n,
    { rw[hp x.1 (lt_of_le_of_ne hx₂ hx₁.symm), zero_mul] },
    { have : x.2 > m := lt_of_not_ge (λ hk, by {
       have := add_lt_add_of_lt_of_le (lt_of_not_ge hx₂) hk,
       rw[hx₀] at this, exact lt_irrefl (n + m) this
      }),
      rw[hq x.2 this, mul_zero]
    }
   end,
   rw[finset.sum_eq_single_of_mem nm hnm h_single]
 }
end

lemma trailing_mul {p q : polynomial A} {n m : ℕ}
 (hp : ∀ i, i < n → p.coeff i = 0) (hq : ∀ j, j < m → q.coeff j = 0) :
  (∀ k, k < n + m → (p * q).coeff k = 0) ∧
   (p * q).coeff (n + m) = (p.coeff n) * (q.coeff m) :=
begin
 split,
 { intros k hk,
   rw[coeff_mul], apply finset.sum_eq_zero,
   rintro ⟨i,j⟩ hij,
   replace hij : i + j = k := finset.nat.mem_antidiagonal.mp hij,
   change p.coeff i * q.coeff j = 0,
   by_cases hi : i < n,
   { rw[hp i hi, zero_mul] },
   { replace hi : n ≤ i := le_of_not_gt hi,
     have hj : j < m := begin
      apply lt_of_not_ge, intro hj',
      have := lt_of_lt_of_le hk (add_le_add hi hj'),
      rw[hij] at this, exact lt_irrefl k this,
     end,
     rw[hq j hj, mul_zero],
   }
 },{
  rw[coeff_mul],
  let nm : ℕ × ℕ := ⟨n,m⟩,
  have hnm : nm ∈ finset.nat.antidiagonal (n + m) :=
    finset.nat.mem_antidiagonal.mpr rfl,
  have h_single : ∀ (x : ℕ × ℕ) (hx₀ : x ∈ finset.nat.antidiagonal (n + m))
    (hx₁ : x ≠ nm), (p.coeff x.1) * (q.coeff x.2) = 0 :=
  begin
    intros,
    replace hx₁ : x.1 ≠ n := λ e, hx₁ ((finset.nat.antidiagonal_congr hx₀ hnm).mpr e),
    replace hx₀ : x.1 + x.2 = n + m := finset.nat.mem_antidiagonal.mp hx₀,
    by_cases hx₂ : x.1 ≤ n,
    { rw[hp x.1 (lt_of_le_of_ne hx₂ hx₁), zero_mul] },
    { have : x.2 < m := lt_of_not_ge (λ hk, by {
       have := add_lt_add_of_lt_of_le (lt_of_not_ge hx₂) hk,
       rw[hx₀] at this, exact lt_irrefl (n + m) this
      }),
      rw[hq x.2 this, mul_zero]
    }
   end,
   rw[finset.sum_eq_single_of_mem nm hnm h_single]
 }
end

lemma nat_degree_spec (p : polynomial A) :
 (∀ (i : ℕ), i > p.nat_degree → p.coeff i = 0) ∧
  (p = 0 ∨ p.coeff p.nat_degree ≠ 0) :=
begin
 by_cases hp : p = 0,
 { split,
   { intros i hi, rw[hp, coeff_zero], },
   { left, exact hp }
 },
 { split,
  { intros i hi,
    by_cases hc : p.coeff i = 0, { assumption },
    exfalso,
    exact lt_irrefl i (lt_of_le_of_lt (le_nat_degree_of_ne_zero hc) hi)
  },
  { exact or.inr (leading_coeff_ne_zero.mpr hp) }
 }
end

noncomputable def div_X_aux : ℕ → polynomial A
| 0 := 0
| (n + 1) := monomial n 1

noncomputable def div_X (f : polynomial A) : polynomial A :=
 div_by_monic f X

lemma div_X_prop (f : polynomial A) : f = C (coeff f 0) + X * (div_X f) :=
begin
 have := mod_by_monic_X_sub_C_eq_C_eval f 0,
 rw[C.map_zero,sub_zero,← coeff_zero_eq_eval_zero] at this,
 rw[← this], symmetry,
 exact mod_by_monic_add_div f monic_X
end

lemma div_X_deg {f : polynomial A} {n : ℕ} (h : f.nat_degree ≤ n.succ) :
 (div_X f).nat_degree ≤ n :=
begin
 nontriviality A,
 have := nat_degree_div_by_monic f monic_X,
 rw[nat_degree_X] at this,
 change (div_X f).nat_degree = f.nat_degree.pred at this,
 rw[this],
 exact nat.pred_le_iff.mpr h
end

example (a b c d : ℕ) (h1 : a ≤ b) (h2 : c < d) : a + c < b + d := by library_search

lemma is_regular_bot (n : ℕ)
 (h₀ : ∀ i, i < n → coeff p i = 0) (h₁ : is_regular (coeff p n)) :
  is_regular p :=
begin
  intros q hpq,
  ext k, rw[coeff_zero],
  induction k using nat.strong_induction_on with k ih,
  change ∀ (m : ℕ), m < k → q.coeff m = 0 at ih,
  have := (trailing_mul h₀ ih).2,
  rw[hpq, coeff_zero] at this,
  exact h₁ (q.coeff k) this.symm
end

lemma is_regular_top (h : is_regular (leading_coeff p)) : is_regular p :=
begin
  intros q hpq,
  by_cases hq : q = 0, {assumption}, exfalso,
  have hq' := leading_coeff_ne_zero.mpr hq,
  have hpq' : p.leading_coeff * q.leading_coeff ≠ 0 := begin
   intro e,
   exact hq' (h q.leading_coeff e),
  end,
  have hpq'' := leading_coeff_mul' hpq',
  rw[← hpq'', hpq, leading_coeff_zero] at hpq',
  exact hpq' rfl,
end

lemma is_nilpotent_iff :
 is_nilpotent p ↔ (∀ n, is_nilpotent (coeff p n)) :=
begin
 let ev : polynomial A →+* A := eval_ring_hom 0,
 have h₀ : ∀ (q : polynomial A), is_nilpotent q → is_nilpotent (q.coeff 0) :=
  by { intros q hq, rw[coeff_zero_eq_eval_zero], exact is_nilpotent_hom ev hq},
 have h₁ : ∀ (a : A), is_nilpotent a ↔ is_nilpotent (C a) := λ a, by {
  split; intro h, { exact is_nilpotent_hom C h },
  { have := h₀ (C a) h, rw[coeff_C_zero] at this, exact this }
 },
 have h₂ : ∀ (d : ℕ) (q : polynomial A) (hq : q.nat_degree ≤ d),
  is_nilpotent q ↔ (∀ n, is_nilpotent (coeff q n)) :=
 begin
  intro d, induction d with d hd; intros q hq;
  have hq' := nat_degree_le_iff_coeff_eq_zero.mp hq,
  { let c := q.coeff 0,
    have hc : q = C c := by {
      ext, cases n,
      { rw[coeff_C_zero] },
      { rw[hq' n.succ,coeff_C,if_neg (n.succ_ne_zero)], exact n.zero_lt_succ }
    },
    split,
    { intros h n, rw[hc, ← h₁] at h, cases n,
      { exact h },
      { rw[hq' n.succ n.succ_pos], exact is_nilpotent_zero }
    },
    { intro h, replace h := h 0, change is_nilpotent c at h,
      rw[hc, ← h₁ c], exact h
    }
  },
  { let r := div_X q,
    let c := q.coeff 0,
    have hrc : q = (C c) + X * r := div_X_prop q,
    have hr : r.nat_degree ≤ d := div_X_deg hq,
    have hr' := nat_degree_le_iff_coeff_eq_zero.mp hr,
    have hrq : ∀ (n : ℕ), r.coeff n = q.coeff n.succ :=
     λ n, by
      rw[hrc,coeff_add,coeff_C_ne_zero n.succ_ne_zero,zero_add,coeff_X_mul],
    split,
    { intros hnq n, cases n,
      { exact h₀ q hnq },
      { rw[← hrq n],
        have : is_nilpotent (C c) := is_nilpotent_hom C (h₀ q hnq),
        have := is_nilpotent_sub hnq this,
        rw[hrc, add_comm, add_sub_cancel] at this,
        rcases this with ⟨m,hm⟩,
        rw[mul_pow] at hm,
        have hnr : is_nilpotent r :=
         by { use m, exact (monic_X_pow m).mul_right_eq_zero_iff.mp hm},
        exact (hd r hr).mp hnr n,
      }
    },{
     intro hnq,
     rw[hrc],
     have hnc : is_nilpotent (C c) := is_nilpotent_hom C (hnq 0),
     have hnr : is_nilpotent r := (hd r hr).mpr (λ n, by { rw[hrq n], exact hnq n.succ, }),
     exact is_nilpotent_add hnc (is_nilpotent_smul X hnr),
    }
  }
 end,
 exact h₂ p.nat_degree p (le_refl _),
end

/-
lemma is_invertible_iff :
 is_invertible p ↔
  (is_invertible (coeff p 0)) ∧ (∀ n : ℕ, (is_nilpotent (coeff p n.succ))) :=
sorry
-/

lemma is_idempotent_aux {p : polynomial A} (h₀ : p.coeff 0 = 0) (h₁ : is_idempotent p) : p = 0 :=
begin
 replace h₁ := idempotent.mul_self h₁,
 ext n, rw[coeff_zero],
 induction n using nat.strong_induction_on with n ih,
 cases n,
 { exact h₀ },
 { rw[← h₁, coeff_mul],
   apply finset.sum_eq_zero,
   rintro ⟨i,j⟩ hij,
   replace hij : i + j = n.succ := finset.nat.mem_antidiagonal.mp hij,
   change p.coeff i * p.coeff j = 0,
   cases j,
   { rw[h₀, mul_zero] },
   { replace hij : i + j = n :=  nat.succ_inj'.mp hij,
     have : i < (i + j).succ := lt_of_le_of_lt le_self_add (i + j).lt_succ_self,
     rw[hij] at this,
     rw[ih i this, zero_mul]
   }
 }
end

lemma is_idempotent_iff :
 is_idempotent p ↔
  (is_idempotent (coeff p 0)) ∧ (p = C (p.coeff 0)) :=
begin
 split,
 { let e := coeff p 0,
   intro hp,
   have he : is_idempotent (eval 0 p) :=
    is_idempotent_hom (eval_ring_hom (0 : A)) hp,
   rw [← coeff_zero_eq_eval_zero p] at he,
   change is_idempotent e at he,
   let q := (C (1 - e)) * p,
   have hq : is_idempotent q :=
    idempotent.mul_mem (is_idempotent_hom C (idempotent.one_sub_mem he)) hp,
   have hqc : coeff q 0 = 0 := begin
    dsimp[q], rw[coeff_zero_eq_eval_zero, eval_C_mul, mul_comm, ← coeff_zero_eq_eval_zero],
    exact (is_idempotent' e).mp he,
   end,
   have hqz : q = 0 := is_idempotent_aux hqc hq,
   dsimp[q] at hqz,
   rw[ring_hom.map_sub, ring_hom.map_one, sub_mul, one_mul] at hqz,
   replace hqz := eq_of_sub_eq_zero hqz,
   let r := (C e) - p,
   have hr : is_idempotent r := begin
     change r ^ 2 = r,
     dsimp[r],
     rw[pow_two, mul_sub, sub_mul, sub_mul, mul_comm p],
     rw[← hqz, idempotent.mul_self hp, sub_self, sub_zero],
     rw[← ring_hom.map_mul, idempotent.mul_self he],
   end,
   have hr' : r.coeff 0 = 0 := by rw[coeff_sub, coeff_C_zero, sub_self],
   exact ⟨he,(eq_of_sub_eq_zero (is_idempotent_aux hr' hr)).symm⟩,
 },
 { rintro ⟨h₀,h₁⟩,
   rw[h₁],
   exact is_idempotent_hom C h₀,
 }
end

end poly_el_props

/- -------------------------------------------------------- -/
/- prop-idempotent-splitting -/

namespace idempotent

variables {e : A} (he : is_idempotent e)
include he

def axis := {b : A // b * e = b}

namespace axis

def mk (b : A) (hb : b * e = b) : axis he := ⟨b,hb⟩

instance : has_zero (axis he) := ⟨⟨(0 : A),zero_mul e⟩⟩

instance : has_one (axis he) := ⟨⟨e,by {rw[← pow_two],exact he}⟩⟩

instance : has_neg (axis he) :=
 ⟨λ b, axis.mk he (- b.val) (by {rw[← neg_mul_eq_neg_mul,b.property]})⟩

instance : has_add (axis he) :=
 ⟨λ b₁ b₂, axis.mk he (b₁.val + b₂.val) (by {rw[add_mul,b₁.property,b₂.property]})⟩

instance : has_mul (axis he) :=
 ⟨λ b₁ b₂, axis.mk he (b₁.val * b₂.val) (by {rw[mul_assoc,b₂.property]})⟩

@[simp] lemma val_zero : (0 : axis he).val = 0 := rfl

@[simp] lemma val_one : (1 : axis he).val = e := rfl

@[simp] lemma val_neg (b : axis he) : (- b).val = - (b.val) := rfl

@[simp] lemma val_add (b₁ b₂ : axis he) : (b₁ + b₂).val = b₁.val + b₂.val := rfl

@[simp] lemma val_mul (b₁ b₂ : axis he) : (b₁ * b₂).val = b₁.val * b₂.val := rfl

instance : comm_ring (axis he) := {
  zero := has_zero.zero,
  one  := has_one.one,
  mul  := has_mul.mul,
  add  := has_add.add,
  neg  := has_neg.neg,
  zero_add := λ a, subtype.eq $ by {rw[val_add,val_zero,zero_add]},
  add_zero := λ a, subtype.eq $ by {rw[val_add,val_zero,add_zero]},
  add_left_neg := λ a, subtype.eq $ by {rw[val_add,val_neg,add_left_neg,val_zero]},
  add_comm := λ a b, subtype.eq $ by {rw[val_add,val_add,add_comm]},
  add_assoc := λ a b c, subtype.eq $ by {repeat {rw[val_add]},apply add_assoc},
  one_mul := λ a, subtype.eq $ by {rw[val_mul,val_one,mul_comm,a.property]},
  mul_one := λ a, subtype.eq $ by {rw[val_mul,val_one,a.property]},
  mul_comm := λ a b, subtype.eq $ by {rw[val_mul,val_mul,mul_comm]},
  mul_assoc := λ a b c, subtype.eq $ by {repeat {rw[val_mul]},apply mul_assoc},
  left_distrib := λ a b c, subtype.eq $ by {rw[val_mul,val_add,val_add,val_mul,val_mul,left_distrib]},
  right_distrib := λ a b c, subtype.eq $ by {rw[val_mul,val_add,val_add,val_mul,val_mul,right_distrib]},
 }

def proj : A →+* axis he := {
 to_fun :=  λ a, ⟨a * e,by {dsimp[is_idempotent] at he, rw[mul_assoc,← pow_two,he]}⟩,
 map_zero' := subtype.eq $ by { change 0 * e = 0, rw[zero_mul] },
 map_add' := λ a b, by { apply subtype.eq,
                         change (a + b) * e = a * e + b * e,
                         rw[add_mul]},
 map_one' := subtype.eq $ by { change 1 * e = e, rw[one_mul] },
 map_mul' := λ a b, by { dsimp[is_idempotent] at he, rw[pow_two] at he,
                         apply subtype.eq,
                         change (a * b) * e = (a * e) * (b * e),
                         rw[mul_assoc a e,← mul_assoc e b e,mul_comm e b,
                           mul_assoc b e,he,mul_assoc]}
}

def split : A →+* (axis he) × (axis (one_sub_mem he)) := {
 to_fun := λ a, ⟨(proj he a),(proj (one_sub_mem he) a)⟩,
 map_zero' := by { ext1, exact (proj _).map_zero, exact (proj _).map_zero},
 map_one'  := by { ext1, exact (proj _).map_one, exact (proj _).map_one},
 map_add' := λ a b, by { ext1, exact (proj _).map_add _ _, exact (proj _).map_add _ _},
 map_mul' := λ a b, by { ext1, exact (proj _).map_mul _ _, exact (proj _).map_mul _ _}
}

lemma mul_eq_zero (b : axis he) (c : axis (one_sub_mem he)) :
 b.val * c.val = 0 := by {
  rcases b with ⟨b,hb⟩,
  rcases c with ⟨c,hc⟩,
  change b * c = 0,
  exact calc
   b * c = (b * e) * (c * (1 - e)) : by rw[hb,hc]
   ... = b * (e * (1 - e)) * c : by {rw[mul_comm c,mul_assoc,mul_assoc,mul_assoc]}
   ... = 0 : by {rw[(is_idempotent' e).mp he,mul_zero,zero_mul]}
}

def combine : (axis he) × (axis (one_sub_mem he)) →+* A := {
 to_fun := λ bc, bc.1.val + bc.2.val,
 map_zero' := zero_add _,
 map_one' := by {change e + (1 - e) = 1,rw[add_sub_cancel'_right]},
 map_add' := λ bc₁ bc₂, by {
  rcases bc₁ with ⟨⟨b₁,hb₁⟩,⟨c₁,hc₁⟩⟩,
  rcases bc₂ with ⟨⟨b₂,hb₂⟩,⟨c₂,hc₂⟩⟩,
  change (b₁ + b₂) + (c₁ + c₂) = (b₁ + c₁) + (b₂ + c₂),
  rw[add_assoc,← add_assoc b₂,add_comm b₂ c₁,add_assoc,add_assoc],
 },
 map_mul' := λ bc₁ bc₂, by {
  rcases bc₁ with ⟨⟨b₁,hb₁⟩,⟨c₁,hc₁⟩⟩,
  rcases bc₂ with ⟨⟨b₂,hb₂⟩,⟨c₂,hc₂⟩⟩,
  change (b₁ * b₂) + (c₁ * c₂) = (b₁ + c₁) * (b₂ + c₂),
  have ebc : b₁ * c₂ = 0 := mul_eq_zero he ⟨b₁,hb₁⟩ ⟨c₂,hc₂⟩,
  have ecb : b₂ * c₁ = 0 := mul_eq_zero he ⟨b₂,hb₂⟩ ⟨c₁,hc₁⟩,
  rw[mul_comm] at ecb,
  rw[mul_add,add_mul,add_mul,ebc,ecb,zero_add,add_zero],
 }
}

lemma combine_split (a : A) : combine he (split he a) = a :=
by { change a * e + a * (1 - e) = a,
     rw[mul_sub,mul_one,add_sub_cancel'_right]}

lemma split_combine (bc : (axis he) × (axis (one_sub_mem he))) :
 split he (combine he bc) = bc :=
by {
 have he' : e * (1 - e) = 0 := (is_idempotent' e).mp he,
 rcases bc with ⟨⟨b,hb⟩,⟨c,hc⟩⟩,
 ext1; apply subtype.eq,
 {change (b + c) * e = b,
  rw[← hc,add_mul,hb,mul_assoc,mul_comm (1 - e),he',mul_zero,add_zero],},
 {change (b + c) * (1 - e) = c,
  rw[← hb,add_mul,hc,mul_assoc,he',mul_zero,zero_add],}
}

end axis

end idempotent

end sec_elements


import tactic
import data.nat.prime
import data.int.basic
open classical
-- HUMAN PROOF 1:
--Claim: Let n > 1. If n has no positive PRIME factor less ≤ sqrt(n), then n is prime
-- Proof by Contradiction:
-- Suppose n is not prime. Then n has atleast two positive prime factors p1 and p2 such that
-- n = p1p2*k for some positive integer k. By hypothesis p1 and p2 are > sqrt(n). Then
-- n = p1p2*k ≥ p1p2 > n, and so n > n. Contradiction

-- HUMAN PROOF 2:
-- Claim: Let n > 1. If n has no positive PROPER factor less ≤ sqrt(n), then n is prime
-- Proof my Contrapositive:
-- Suppose that n is composite. Then n = a*b where a ≤ b and b < n. Hence a^2 ≤ ab = n.
-- Hence a ≤ sqrt(n).

--Important theorems adapted from the Natural Number Game------------------------------
theorem ge_iff_exists_add (a b: ℕ): a ≥ b ↔ ∃ (c: ℕ), a = b + c :=
begin
    apply le_iff_exists_add,  -- Ok, maybe this theorem was a little bit silly :)
end

def greater (a b: ℕ): Prop := a ≥ b ∧ a ≠ b

--axiom zero (a : ℕ): a < 1 ↔ a =0

lemma zero (a : ℕ): a < 1 ↔ a =0 :=
begin
    split,

--    by library_search,
    exact nat.sub_eq_zero_of_le,

    intros h,
    linarith,
end

--axiom zero2 (a u : ℕ): u + a = u ↔ a = 0

lemma zero2 (a u : ℕ): u + a = u ↔ a = 0 :=
begin
    split,

    intros h,

--    by library_search,
    exact (add_left_inj u).mp h,

    intros h1,
--    by library_search,
    exact eq.trans (congr_arg (has_add.add u) h1) rfl,
end

theorem g_iff_exists_add (a b: ℕ): greater a b ↔ ∃ (c: ℕ), a = b + c ∧ c ≥ 1:=
begin                             --Perhaps a little bit overkill
    rw greater,
    rw ge_iff_exists_add,
    rw ne_from_not_eq,

    split,

    { intro h,
        have h_left: ∃ (c : ℕ), a = b + c, from and.left h,
        have h_right: ¬a = b, from and.right h,

        cases h_left with u hu,
        use u,

        split,
        apply hu,

        by_contradiction,
        push_neg at a_1,
        rw zero at a_1,
        subst a_1,
        rw add_zero at hu,

--        have h_right: a ≠ b, from and.right h,
        exact h_right hu,
    },
    {  intro h2,

        cases h2 with u hu,
        have hu_left: a = b+u, from and.left hu,
        split,
        use u,
        apply hu_left,

        by_contradiction,
        subst hu_left,
        rw zero2 at a_1,
        rw ← zero at a_1,
        have hu_right: u ≥ 1, from and.right hu,
        linarith,  -- Thanks Olu :)
    }

end

theorem my_simp (u v a : ℕ): u*v + (a*a + u*a) = a*u + (u*v + a*a):=
begin
    rw ← add_assoc,
    rw ← add_assoc,
    rw add_comm,
    simp,
    rw mul_comm,
end
-----------------------------------------------------------------------------------------
def dvd (m n: ℕ): Prop := ∃ k, n = m * k
def prime (p : ℕ) : Prop := p ≥ 2 ∧ ∀ n, dvd n p → n = 1 ∨ n = p
def composite (d : ℕ): Prop:= ∃ (a b: ℕ), d = a*b ∧ a ≤ b ∧ b < d

lemma greater_than_not_zero (n : ℕ)(n ≥ 2): n ≠ 0:=
begin
    exact lattice.ne_bot_of_gt H,
end

lemma dvd_n_less_than_n (u n : ℕ) (ha: dvd u n) (hb: u ≠ 1) (hc: u ≠ n) (hn : n ≠ 0) : u < n :=
begin
  refine lt_of_le_of_ne _ hc,
  rcases ha with ⟨k, rfl⟩,
  simpa using nat.mul_le_mul_left _ (_:1≤_),
  refine nat.pos_iff_ne_zero.2 (mt _ hn),
  rintro rfl, refl,
end

--- The grand unification lemma ----
lemma either_prime_or_composite (n:ℕ ) (ge: n≥ 2): (¬ (prime n) ↔ composite n) :=
begin
    split,
    {
        intros h,
        rw prime at h,
        rw composite,

        push_neg at h,

        cases h,
        {
            linarith,
        } ,
        {
            cases h with u hu,
           let hu_left:= hu.1,
           rw dvd at hu_left,
           cases hu_left with k hk,

           have u_g_k : (u≤ k)∨ (u>k),
           {
--               by library_search,
                exact le_or_lt u k,
           },
           cases u_g_k,
            {
                use u,
                use k,
                split,
                exact hk,
                split,
                exact u_g_k,

                let hu_mid:= hu.2.1,

                have u_ge_1 : (u≥ 1),
                {
                    by_contradiction,
                    have u_zero: u=0,
                    {
                        linarith,
                    },
                    have n_zero: n=0,
                    {
                        subst u_zero,
                        simp at hk,
                        exact hk,
                    },
                    linarith,
                },
                have u_ge_2 : (u≥ 2),
                {
                    by_contradiction,
                    have u_less_2 : u<2,
                    {
                        linarith,
                    },
                    have u_eq_1: u=1,
                    {
                        linarith,
                    },
--                    by library_search,
                    exact hu_mid u_eq_1,
                },
                by_contradiction,

                have k_ge_n: k≥ n,
                {
                    linarith,
                },
                have uk_ge_2n: u*k≥ 2* n,
                {
--                    by library_search,
                    exact canonically_ordered_semiring.mul_le_mul u_ge_2 k_ge_n,
                },
                have n_ge_2n: n≥ 2*n,
                {
                    linarith,
                },
                have twon_gt_n: 2*n > n,
                {
                    linarith,
                },
                linarith,

            },
            {
                use k,
                use u,
                split,
                rw mul_comm at hk,
                exact hk,
                split,
                --exact u_g_k,

                let hu_mid:= hu.2.1,

                have u_ge_1 : (u≥ 1),
                {
                    by_contradiction,
                    have u_zero: u=0,
                    {
                        linarith,
                    },
                    have n_zero: n=0,
                    {
                        subst u_zero,
                        simp at hk,
                        exact hk,
                    },
                    linarith,
                },
                have u_ge_2 : (u≥ 2),
                {
                    by_contradiction,
                    have u_less_2 : u<2,
                    {
                        linarith,
                    },
                    have u_eq_1: u=1,
                    {
                        linarith,
                    },
--                    by library_search,
                    exact hu_mid u_eq_1,
                },
                by_contradiction,

                have k_ge_n: k≥ n,
                {
                    linarith,
                },
                have uk_ge_2n: u*k≥ 2* n,
                {
--                    by library_search,
                    exact canonically_ordered_semiring.mul_le_mul u_ge_2 k_ge_n,
                },
                have n_ge_2n: n≥ 2*n,
                {
                    linarith,
                },
                have twon_gt_n: 2*n > n,
                {
                    linarith,
                },
                linarith,

                have ha: dvd u n, from and.left hu,
                have h2: u ≠ 1 ∧ u ≠ n, from and.right hu,
                have hc: u ≠ n, from and.right h2,
                have hb: u ≠ 1, from and.left h2,
                have hn: n ≠ 0,
                {
                    exact lattice.ne_bot_of_gt ge,
                },

                apply dvd_n_less_than_n,
                have h4: dvd u n, from and.left hu,
                apply h4,
                apply hb,
                apply hc,
                apply hn,
            },

        }

    },
    {
      intros h,
      rw composite at h,
      by_contradiction,
      rw prime at a,

      cases h with a1 ha1,
      cases ha1 with b hb,

      have h1: n = a1*b, from and.left hb,
      have temp: a1 ≤ b ∧ b < n, from and.right hb,
      have h2: a1 ≤ b, from and.left temp,
      have h3: b < n, from and.right temp,

      have hc := a.right b,

      have b_isnt_one: b ≠ 1,
      {
        by_contradiction,
        push_neg at a_1,
        subst a_1,
        rw mul_one at h1,
        linarith,
      },

      have b_divides_n: dvd b n,
      {
          rw dvd,
          rw mul_comm at h1,
          use a1,
          rw h1,
      },

      have b_is_trivial: b = 1 ∨ b = n,
      {
        exact hc b_divides_n,
      },

      cases b_is_trivial,
      {
          exact b_isnt_one b_is_trivial,
      },
      {
          linarith,
      },

    },
end

theorem ge_refl(x : ℕ) : x ≥ x :=
begin
    linarith,

--
end

theorem ge_cancel (a b : ℕ) (ha : a*b ≥ a) (hb: a ≥ 1) : b ≥ 1 :=
begin
    by library_search,
--exact (le_mul_iff_one_le_right hb).mp ha,

end

theorem example1 (a b c :ℕ) (hba: b ≥ a) (hca: c ≥ a) : b*c ≥ a*a :=
begin
    exact canonically_ordered_semiring.mul_le_mul hba hca,
--    by library_search,
/-

-/
end

-- Adapted from the Natural Number Game---
lemma one_eq_succ_zero: 1 = nat.succ(0) :=
begin
    refl,   -- OK maybe a little bit silly :)
end

lemma succ_eq_add_one (n : ℕ) : nat.succ n = n + 1 :=
begin
    exact rfl,
--    by library_search,

--
end
----------------------------------------------------------------------
lemma x_plus_stuff_plus_one_ge_x (x d : ℕ) : x + d + 1 ≥ x :=
-- Helps to prove my_lemma_helper
begin
    linarith,
/-

-/
end

lemma my_lemma_helper (x y: ℕ) : y+x ≥ x :=
begin
    linarith,
/-
-/
end

lemma my_lemma (c x : ℕ) (hab: c >= 1): c * x >= x :=
begin
    exact nat.le_mul_of_pos_left hab,
--    by library_search,
/-

-/
end

theorem example2 (a b c : ℕ) (hba: c ≥ 1): a*b*c ≥ a*b :=
begin
    exact nat.le_mul_of_pos_right hba,
--    by library_search,
/-

-/
end

theorem example3 (a:ℕ) : ¬ a < a :=
begin
    linarith,
/-

-/
end

lemma another_helper (u v : ℕ) : v ≤ u ↔ v*v ≤ v*u :=
begin
    cases v,

  { split,
    { intro h,
      simp,
    },
    intro,

    linarith,
--    exact zero_le u,
  },
  {
    symmetry,
    apply mul_le_mul_left,
    simp,
  }
end

theorem square_root_prime2 (n : ℕ) (h1: composite n): ∃ (c d : ℕ), n = c*d ∧ c*c ≤ n :=
-- HUMAN PROOF 2 in Code :)
begin
    rw composite at h1,
    cases h1 with v hv,
    cases hv with u hu,
    use v,
    use u,
    have hl: n = v*u, from and.left hu,
    rw hl,

    have hmr: v ≤ u ∧ u < n, from and.right hu,
    have hr: u < n, from and.right hmr,
    have hm: v ≤ u, from and.left hmr,

    rw another_helper at hm,

    split,
    refl,
    apply hm,

end


import data.nat.gcd
import algebra.big_operators

import data.zmod.basic

def divides (d n: ℤ):=  ∃l:ℤ, n = d*l
def is_congruent_mod_n (a b n: ℤ) := divides n (b-a)
def relatively_prime(a b:ℤ) := ∀l:ℤ, ¬(divides l a) ∨ ¬(divides l b)

theorem relatively_prime_sum_to_one (a b : ℤ) (h : relatively_prime a b) :
∃ m n: ℤ, m* a + n * b = 1 := sorry

--helper theorem that is not true :(--
-- the iff is not true, but I can't use it without it--
theorem divides_in_product (a b c: ℤ): a*b = c ↔ divides a c:= sorry

--Generalized Euclid Lemma --
theorem divides_product_coprime_and_not_coprime (a b n:ℤ) (c: divides n (a*b))
(d: relatively_prime a n):
divides n b:=
begin
  -- cases breaks down existential qualifiers
  cases c with l k,
  cases relatively_prime_sum_to_one a n d with m h,
  cases h with q manb_eq_one,

  -- multiplies both sides by b
  have := congr_arg (has_mul.mul b) manb_eq_one, -- does not work if I covert to naturals
  rw [mul_one] at this,
  -- this : b * (m * a + q * n) = b

  -- order-changing
  rw [mul_add] at this,
  rw [mul_comm] at this,
  rw [mul_assoc] at this,
  rw k at this,
  rw [mul_comm] at this,
  rw [mul_assoc] at this,
  rw [add_comm] at this,
  rw [mul_comm] at this,
  rw [mul_assoc] at this,
  rw [mul_left_comm] at this,
  rw <- mul_add at this,

  rw divides_in_product n (q*b+l*m) b at this, -- can use "apply" instead and get rid of iff
  apply this,

end

theorem cancel_out_mod_n (a b c n: ℤ) (p: is_congruent_mod_n (a*b) (a*c) n)
(q: relatively_prime a n) : is_congruent_mod_n b c n :=

begin
  cases p with j k,
  rw <-mul_sub at k,  --does not work if I convert to naturals
  rw eq_comm at k,
  rw divides_in_product n j (a*(c-b)) at k,  -- cannot use "apply" and get rid of iff
  apply divides_product_coprime_and_not_coprime a (c-b) n,
  {
    apply k,
  },
  {
    apply q,
  },

end

-- residue class --
def reduced_residue_class (n : nat) : finset nat :=
(finset.range n).filter $ assume k, k.coprime n

def prod_rsc (n) : nat := (reduced_residue_class n).prod id

def Euler_phi (n) : nat := (reduced_residue_class n).sum $ λ k, 1

-- not scaled :( --
 def scaled_residue_class (a n: nat): finset nat :=
 (reduced_residue_class n).map $ λ k, k*a

-- def prod_scaled_rsc (a n: nat): nat := (scaled_residue_class a n).prod id

--congruence of residue classes --
-- theorem congruent_residue_classes (a n: nat) (c:a.coprime n):
-- is_congruent_mod_n (prod_rsc n)(prod_scaled_rsc a n) n:= sorry

R ≃+* R

-- mult by a is automorphism
theorem mult_by_a_is_auto (a n : nat) (c:a.coprime n):
∃ inv : (reduced_residue_class n) → (reduced_residue_class n),
(inv ∘ (λ k, a * k) = id) ∧
((λ k, a * k) ∘ inv  = id)
:=
begin
sorry,
end

--Zulip proof of Bézout
lemma bezout (a : ℕ) (b : ℕ) (ha : a ≥ 1) (hb : b ≥ 1) (h : nat.gcd a b = 1) :
    ∃ x : ℕ, ∃ y : ℕ, a*x + 1 = b*y :=
begin
  let k := max (int.nat_abs (nat.gcd_a a b)) (int.nat_abs (nat.gcd_b a b)) + 1,
  let x : ℤ := b*k - nat.gcd_a a b,
  let y : ℤ := a*k + nat.gcd_b a b,
  refine ⟨int.to_nat x, int.to_nat y, int.coe_nat_inj _⟩,
  suffices : (a * int.to_nat x + 1 : ℤ) = b * int.to_nat y, {simpa},
  have k1 : 1 ≤ k := nat.le_add_left _ _,
  have ha' : (1:ℤ) ≤ a := int.coe_nat_le.2 ha,
  have hb' : (1:ℤ) ≤ b := int.coe_nat_le.2 hb,
  have x0 : 0 ≤ x,
  { refine sub_nonneg.2 _,
    have := mul_le_mul_of_nonneg_right hb' (int.coe_nat_nonneg k),
    rw one_mul at this,
    refine le_trans (le_trans int.le_nat_abs _) this,
    refine int.coe_nat_le.2 _,
    exact nat.le_succ_of_le (le_max_left _ _) },
  have y0 : 0 ≤ y,
  { refine sub_le_iff_le_add.1 _,
    rw zero_sub,
    have := mul_le_mul_of_nonneg_right ha' (int.coe_nat_nonneg k),
    rw one_mul at this,
    refine le_trans (le_trans int.le_nat_abs _) this,
    rw [int.nat_abs_neg, int.coe_nat_le],
    exact nat.le_succ_of_le (le_max_right _ _) },
  rw [int.to_nat_of_nonneg x0, int.to_nat_of_nonneg y0],
  have := nat.gcd_eq_gcd_ab a b,
  rw [h, int.coe_nat_one] at this,
  rw [this, mul_sub, ← add_assoc, sub_add_cancel, mul_left_comm, ← mul_add],
end

-- alternative definitions of residue classes --

-- lean definition for residue class --
example (n : ℕ+) : units (zmod n) ≃ {x : zmod n // nat.coprime x.val n} :=
zmod.units_equiv_coprime

-- lean doesn't know if this is finite
def rsc (n: nat) := {k: nat| k<n ∧ k.coprime n}

#print units


/-
Copyright (c) 2019 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin
-/

import data.mv_polynomial
import field_theory.finite.basic

/-!
# The Chevalley–Warning theorem

This file contains a proof of the Chevalley–Warning theorem.
Throughout most of this file, `K` denotes a finite field
and `q` is notation for the cardinality of `K`.

## Main results

1. Let `f` be a multivariate polynomial in finitely many variables (`X s`, `s : σ`)
   such that the total degree of `f` is less than `(q-1)` times the cardinality of `σ`.
   Then the evaluation of `f` on all points of `σ → K` (aka `K^σ`) sums to `0`.
   (`sum_mv_polynomial_eq_zero`)
2. The Chevalley–Warning theorem (`char_dvd_card_solutions`).
   Let `f i` be a finite family of multivariate polynomials
   in finitely many variables (`X s`, `s : σ`) such that
   the sum of the total degrees of the `f i` is less than the cardinality of `σ`.
   Then the number of common solutions of the `f i`
   is divisible by the characteristic of `K`.

## Notation

- `K` is a finite field
- `q` is notation for the cardinality of `K`
- `σ` is the indexing type for the variables of a multivariate polynomial ring over `K`

-/

universes u v

open_locale big_operators

section finite_field
open mv_polynomial function (hiding eval) finset finite_field

variables {K : Type*} {σ : Type*} [fintype K] [field K] [fintype σ]
local notation `q` := fintype.card K

lemma mv_polynomial.sum_mv_polynomial_eq_zero [decidable_eq σ] (f : mv_polynomial σ K)
  (h : f.total_degree < (q - 1) * fintype.card σ) :
  (∑ x, eval x f) = 0 :=
begin
  haveI : decidable_eq K := classical.dec_eq K,
  calc (∑ x, eval x f)
        = ∑ x : σ → K, ∑ d in f.support, f.coeff d * ∏ i, x i ^ d i : by simp only [eval_eq']
    ... = ∑ d in f.support, ∑ x : σ → K, f.coeff d * ∏ i, x i ^ d i : sum_comm
    ... = 0 : sum_eq_zero _,
  intros d hd,
  obtain ⟨i, hi⟩ : ∃ i, d i < q - 1, from f.exists_degree_lt (q - 1) h hd,
  calc (∑ x : σ → K, f.coeff d * ∏ i, x i ^ d i)
        = f.coeff d * (∑ x : σ → K, ∏ i, x i ^ d i) : mul_sum.symm
    ... = 0                                         : (mul_eq_zero.mpr ∘ or.inr) _,
  calc (∑ x : σ → K, ∏ i, x i ^ d i)
        = ∑ (x₀ : {j // j ≠ i} → K) (x : {x : σ → K // x ∘ coe = x₀}), ∏ j, (x : σ → K) j ^ d j :
              (fintype.sum_fiberwise _ _).symm
    ... = 0 : fintype.sum_eq_zero _ _,
  intros x₀,
  let e : K ≃ {x // x ∘ coe = x₀} := (equiv.subtype_equiv_codomain _).symm,
  calc (∑ x : {x : σ → K // x ∘ coe = x₀}, ∏ j, (x : σ → K) j ^ d j)
        = ∑ a : K, ∏ j : σ, (e a : σ → K) j ^ d j : (e.sum_comp _).symm
    ... = ∑ a : K, (∏ j, x₀ j ^ d j) * a ^ d i    : fintype.sum_congr _ _ _
    ... = (∏ j, x₀ j ^ d j) * ∑ a : K, a ^ d i    : by rw mul_sum
    ... = 0                                       : by rw [sum_pow_lt_card_sub_one _ hi, mul_zero],
  intros a,
  let e' : {j // j = i} ⊕ {j // j ≠ i} ≃ σ := equiv.sum_compl _,
  letI : unique {j // j = i} :=
  { default := ⟨i, rfl⟩, uniq := λ ⟨j, h⟩, subtype.val_injective h },
  calc (∏ j : σ, (e a : σ → K) j ^ d j)
        = (e a : σ → K) i ^ d i * (∏ (j : {j // j ≠ i}), (e a : σ → K) j ^ d j) :
        by { rw [← e'.prod_comp, fintype.prod_sum_type, univ_unique, prod_singleton], refl }
    ... = a ^ d i * (∏ (j : {j // j ≠ i}), (e a : σ → K) j ^ d j) :
        by rw equiv.subtype_equiv_codomain_symm_apply_eq
    ... = a ^ d i * (∏ j, x₀ j ^ d j) : congr_arg _ (fintype.prod_congr _ _ _) -- see below
    ... = (∏ j, x₀ j ^ d j) * a ^ d i : mul_comm _ _,
  { -- the remaining step of the calculation above
    rintros ⟨j, hj⟩,
    show (e a : σ → K) j ^ d j = x₀ ⟨j, hj⟩ ^ d j,
    rw equiv.subtype_equiv_codomain_symm_apply_ne, }
end

variables [decidable_eq K] [decidable_eq σ]

/-- The Chevalley–Warning theorem.
Let `(f i)` be a finite family of multivariate polynomials
in finitely many variables (`X s`, `s : σ`) over a finite field of characteristic `p`.
Assume that the sum of the total degrees of the `f i` is less than the cardinality of `σ`.
Then the number of common solutions of the `f i` is divisible by `p`. -/
theorem char_dvd_card_solutions_family (p : ℕ) [char_p K p]
  {ι : Type*} {s : finset ι} {f : ι → mv_polynomial σ K}
  (h : (∑ i in s, (f i).total_degree) < fintype.card σ) :
  p ∣ fintype.card {x : σ → K // ∀ i ∈ s, eval x (f i) = 0} :=
begin
  have hq : 0 < q - 1, { rw [← card_units, fintype.card_pos_iff], exact ⟨1⟩ },
  let S : finset (σ → K) := { x ∈ univ | ∀ i ∈ s, eval x (f i) = 0 },
  have hS : ∀ (x : σ → K), x ∈ S ↔ ∀ (i : ι), i ∈ s → eval x (f i) = 0,
  { intros x, simp only [S, true_and, sep_def, mem_filter, mem_univ], },
  /- The polynomial `F = ∏ i in s, (1 - (f i)^(q - 1))` has the nice property
  that it takes the value `1` on elements of `{x : σ → K // ∀ i ∈ s, (f i).eval x = 0}`
  while it is `0` outside that locus.
  Hence the sum of its values is equal to the cardinality of
  `{x : σ → K // ∀ i ∈ s, (f i).eval x = 0}` modulo `p`. -/
  let F : mv_polynomial σ K := ∏ i in s, (1 - (f i)^(q - 1)),
  have hF : ∀ x, eval x F = if x ∈ S then 1 else 0,
  { intro x,
    calc eval x F = ∏ i in s, eval x (1 - f i ^ (q - 1)) : eval_prod s _ x
              ... = if x ∈ S then 1 else 0 : _,
    simp only [(eval x).map_sub, (eval x).map_pow, (eval x).map_one],
    split_ifs with hx hx,
    { apply finset.prod_eq_one,
      intros i hi,
      rw hS at hx,
      rw [hx i hi, zero_pow hq, sub_zero], },
    { obtain ⟨i, hi, hx⟩ : ∃ (i : ι), i ∈ s ∧ eval x (f i) ≠ 0,
      { simpa only [hS, not_forall, not_imp] using hx },
      apply finset.prod_eq_zero hi,
      rw [pow_card_sub_one_eq_one (eval x (f i)) hx, sub_self], } },
  -- In particular, we can now show:
  have key : ∑ x, eval x F = fintype.card {x : σ → K // ∀ i ∈ s, eval x (f i) = 0},
  rw [fintype.card_of_subtype S hS, card_eq_sum_ones, sum_nat_cast, nat.cast_one,
      ← fintype.sum_extend_by_zero S, sum_congr rfl (λ x hx, hF x)],
  -- With these preparations under our belt, we will approach the main goal.
  show p ∣ fintype.card {x // ∀ (i : ι), i ∈ s → eval x (f i) = 0},
  rw [← char_p.cast_eq_zero_iff K, ← key],
  show ∑ x, eval x F = 0,
  -- We are now ready to apply the main machine, proven before.
  apply F.sum_mv_polynomial_eq_zero,
  -- It remains to verify the crucial assumption of this machine
  show F.total_degree < (q - 1) * fintype.card σ,
  calc F.total_degree ≤ ∑ i in s, (1 - (f i)^(q - 1)).total_degree : total_degree_finset_prod s _
                  ... ≤ ∑ i in s, (q - 1) * (f i).total_degree     : sum_le_sum $ λ i hi, _ -- see ↓
                  ... = (q - 1) * (∑ i in s, (f i).total_degree)   : mul_sum.symm
                  ... < (q - 1) * (fintype.card σ)                 : by rwa mul_lt_mul_left hq,
  -- Now we prove the remaining step from the preceding calculation
  show (1 - f i ^ (q - 1)).total_degree ≤ (q - 1) * (f i).total_degree,
  calc (1 - f i ^ (q - 1)).total_degree
        ≤ max (1 : mv_polynomial σ K).total_degree (f i ^ (q - 1)).total_degree :
        total_degree_sub _ _
    ... ≤ (f i ^ (q - 1)).total_degree : by simp only [max_eq_right, nat.zero_le, total_degree_one]
    ... ≤ (q - 1) * (f i).total_degree : total_degree_pow _ _
end

/-- The Chevalley–Warning theorem.
Let `f` be a multivariate polynomial in finitely many variables (`X s`, `s : σ`)
over a finite field of characteristic `p`.
Assume that the total degree of `f` is less than the cardinality of `σ`.
Then the number of solutions of `f` is divisible by `p`.
See `char_dvd_card_solutions_family` for a version that takes a family of polynomials `f i`. -/
theorem char_dvd_card_solutions (p : ℕ) [char_p K p]
  {f : mv_polynomial σ K} (h : f.total_degree < fintype.card σ) :
  p ∣ fintype.card {x : σ → K // eval x f = 0} :=
begin
  let F : unit → mv_polynomial σ K := λ _, f,
  have : ∑ i : unit, (F i).total_degree < fintype.card σ,
  { simpa only [fintype.univ_punit, sum_singleton] using h, },
  have key := char_dvd_card_solutions_family p this,
  simp only [F, fintype.univ_punit, forall_eq, mem_singleton] at key,
  convert key,
end

end finite_field


section
  variable A : Type
  variable f : A → A
  variable P : A → Prop
  variable h : ∀ x, P x → P (f x)

  -- Show the following:
  example : ∀ y, P y → P (f (f y)) :=
  assume y,
  have h1 : P y → P (f y), from h y,
  have h2 : P (f y) → P (f (f y)), from h (f y),
  show P y → P (f (f y)), from
    assume h4 : P y,
    have h5 : P (f y), from h1 h4,
    show P (f (f y)), from h2 h5
end

section
  variable U : Type
  variables A B : U → Prop

  example : (∀ x, A x ∧ B x) → ∀ x, A x :=
  assume h1 : ∀ x, A x ∧ B x,
  assume y,
  have h2 : A y ∧ B y, from h1 y,
  show A y, from h2.left
end

section
  variable U : Type
  variables A B C : U → Prop

  variable h1 : ∀ x, A x ∨ B x
  variable h2 : ∀ x, A x → C x
  variable h3 : ∀ x, B x → C x

  example : ∀ x, C x :=
  assume y,
  show C y, from
    have h4 : A y ∨ B y, from h1 y,
    or.elim h4
      (assume h5 : A y,
      have h6 : A y → C y, from h2 y,
      show C y, from h6 h5)
      (assume h5 : B y,
      have h6 : B y → C y, from h3 y,
      show C y, from h6 h5)
end

open classical   -- not needed, but you can use it

-- This is an exercise from Chapter 4. Use it as an axiom here.
axiom not_iff_not_self (P : Prop) : ¬ (P ↔ ¬ P)

example (Q : Prop) : ¬ (Q ↔ ¬ Q) :=
not_iff_not_self Q

section
  variable Person : Type
  variable shaves : Person → Person → Prop
  variable barber : Person
  variable h : ∀ x, shaves barber x ↔ ¬ shaves x x

  -- Show the following:
  example : false :=
  have h3 : shaves barber barber ↔ ¬ shaves barber barber, from h barber,
  have h2 : ¬ shaves barber barber, from
    assume h4 : shaves barber barber,
    have h5 : ¬ shaves barber barber, from iff.elim_left h3 h4,
    show false, from h5 h4,
  have h1 : shaves barber barber, from iff.elim_right h3 h2,
  show false, from h2 h1
end

section
  variable U : Type
  variables A B : U → Prop

  example : (∃ x, A x) → ∃ x, A x ∨ B x :=
  assume h1 : ∃ x, A x,
  show ∃ x, A x ∨ B x, from exists.elim h1
    (assume y (h2 : A y),
    have h3 : A y ∨ B y, from or.inl h2,
    show ∃ x, A x ∨ B x, from exists.intro y h3)
end

section
  variable U : Type
  variables A B : U → Prop

  variable h1 : ∀ x, A x → B x
  variable h2 : ∃ x, A x

  example : ∃ x, B x :=
  show ∃ x, B x, from exists.elim h2
    (assume y (h3 : A y),
    have h4 : A y → B y, from h1 y,
    have h5 : B y, from h4 h3,
    show ∃ x, B x, from exists.intro y h5)
end

section
  variable  U : Type
  variables A B C : U → Prop

  example (h1 : ∃ x, A x ∧ B x) (h2 : ∀ x, B x → C x) :
  ∃ x, A x ∧ C x :=
    exists.elim h1
      (assume y (h3 : A y ∧ B y),
      have h4 : A y, from h3.left,
      have h5 : B y, from h3.right,
      have h6 : B y → C y, from h2 y,
      have h7 : C y, from h6 h5,
      have h8 : A y ∧ C y, from and.intro h4 h7,
      exists.intro y h8)
end

github-repos/lean/lucasresck-Discrete-Mathematics/Discrete-Mathematics-0a08081c5f393e5765259d3f1253c3a6dd043dac/Exercises/9. First Order Logic in Lean.lean


variables p q : Prop

theorem and_swap : p ∧ q ↔ q ∧ p :=
  ⟨λ h, ⟨h.right, h.left⟩, λ h, ⟨h.right, h.left⟩⟩

example (h : p ∧ q) : q ∧ p := (and_swap p q).mp h


/-
Fill in the sorry.

section
  variable U : Type
  variables A B : U → Prop

  variable h1 : ∀ x, A x → B x
  variable h2 : ∃ x, A x

  example : ∃ x, B x :=
  sorry
end
-/

section
  variable U : Type
  variables A B : U → Prop

  variable h1 : ∀ x, A x → B x
  variable h2 : ∃ x, A x

  example : ∃ x, B x :=
  exists.elim(h2) $
  assume (x: U) (hAx: A(x)),
  have hBx: B(x), from h1 x hAx,
  show ∃ x, B x, from exists.intro(x)(hBx)
end


/-
Copyright (c) 2020 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import linear_algebra.quotient
import linear_algebra.prod

/-!
# Projection to a subspace

In this file we define
* `linear_proj_of_is_compl (p q : submodule R E) (h : is_compl p q)`: the projection of a module `E`
  to a submodule `p` along its complement `q`; it is the unique linear map `f : E → p` such that
  `f x = x` for `x ∈ p` and `f x = 0` for `x ∈ q`.
* `is_compl_equiv_proj p`: equivalence between submodules `q` such that `is_compl p q` and
  projections `f : E → p`, `∀ x ∈ p, f x = x`.

We also provide some lemmas justifying correctness of our definitions.

## Tags

projection, complement subspace
-/

variables {R : Type*} [ring R] {E : Type*} [add_comm_group E] [module R E]
  {F : Type*} [add_comm_group F] [module R F]
  {G : Type*} [add_comm_group G] [module R G] (p q : submodule R E)

noncomputable theory

namespace linear_map

variable {p}

open submodule

lemma ker_id_sub_eq_of_proj {f : E →ₗ[R] p} (hf : ∀ x : p, f x = x) :
  ker (id - p.subtype.comp f) = p :=
begin
  ext x,
  simp only [comp_apply, mem_ker, subtype_apply, sub_apply, id_apply, sub_eq_zero],
  exact ⟨λ h, h.symm ▸ submodule.coe_mem _, λ hx, by erw [hf ⟨x, hx⟩, subtype.coe_mk]⟩
end

lemma range_eq_of_proj {f : E →ₗ[R] p} (hf : ∀ x : p, f x = x) :
  range f = ⊤ :=
range_eq_top.2 $ λ x, ⟨x, hf x⟩

lemma is_compl_of_proj {f : E →ₗ[R] p} (hf : ∀ x : p, f x = x) :
  is_compl p f.ker :=
begin
  split,
  { rintros x ⟨hpx, hfx⟩,
    erw [set_like.mem_coe, mem_ker, hf ⟨x, hpx⟩, mk_eq_zero] at hfx,
    simp only [hfx, set_like.mem_coe, zero_mem] },
  { intros x hx,
    rw [mem_sup'],
    refine ⟨f x, ⟨x - f x, _⟩, add_sub_cancel'_right _ _⟩,
    rw [mem_ker, linear_map.map_sub, hf, sub_self] }
end

end linear_map

namespace submodule

open linear_map

/-- If `q` is a complement of `p`, then `M/p ≃ q`. -/
def quotient_equiv_of_is_compl (h : is_compl p q) : (E ⧸ p) ≃ₗ[R] q :=
linear_equiv.symm $ linear_equiv.of_bijective (p.mkq.comp q.subtype)
  (by simp only [← ker_eq_bot, ker_comp, ker_mkq, disjoint_iff_comap_eq_bot.1 h.symm.disjoint])
  (by simp only [← range_eq_top, range_comp, range_subtype, map_mkq_eq_top, h.sup_eq_top])

@[simp] lemma quotient_equiv_of_is_compl_symm_apply (h : is_compl p q) (x : q) :
  (quotient_equiv_of_is_compl p q h).symm x = quotient.mk x := rfl

@[simp] lemma quotient_equiv_of_is_compl_apply_mk_coe (h : is_compl p q) (x : q) :
  quotient_equiv_of_is_compl p q h (quotient.mk x) = x :=
(quotient_equiv_of_is_compl p q h).apply_symm_apply x

@[simp] lemma mk_quotient_equiv_of_is_compl_apply (h : is_compl p q) (x : E ⧸ p) :
  (quotient.mk (quotient_equiv_of_is_compl p q h x) : E ⧸ p) = x :=
(quotient_equiv_of_is_compl p q h).symm_apply_apply x

/-- If `q` is a complement of `p`, then `p × q` is isomorphic to `E`. It is the unique
linear map `f : E → p` such that `f x = x` for `x ∈ p` and `f x = 0` for `x ∈ q`. -/
def prod_equiv_of_is_compl (h : is_compl p q) : (p × q) ≃ₗ[R] E :=
begin
  apply linear_equiv.of_bijective (p.subtype.coprod q.subtype),
  { simp only [←ker_eq_bot, ker_eq_bot', prod.forall, subtype_apply, prod.mk_eq_zero, coprod_apply],
    -- TODO: if I add `submodule.forall`, it unfolds the outer `∀` but not the inner one.
    rintros ⟨x, hx⟩ ⟨y, hy⟩,
    simp only [coe_mk, mk_eq_zero, ← eq_neg_iff_add_eq_zero],
    rintro rfl,
    rw [neg_mem_iff] at hx,
    simp [disjoint_def.1 h.disjoint y hx hy] },
  { rw [← range_eq_top, ← sup_eq_range, h.sup_eq_top] }
end

@[simp] lemma coe_prod_equiv_of_is_compl (h : is_compl p q) :
  (prod_equiv_of_is_compl p q h : (p × q) →ₗ[R] E) = p.subtype.coprod q.subtype := rfl

@[simp] lemma coe_prod_equiv_of_is_compl' (h : is_compl p q) (x : p × q) :
  prod_equiv_of_is_compl p q h x = x.1 + x.2 := rfl

@[simp] lemma prod_equiv_of_is_compl_symm_apply_left (h : is_compl p q) (x : p) :
  (prod_equiv_of_is_compl p q h).symm x = (x, 0) :=
(prod_equiv_of_is_compl p q h).symm_apply_eq.2 $ by simp

@[simp] lemma prod_equiv_of_is_compl_symm_apply_right (h : is_compl p q) (x : q) :
  (prod_equiv_of_is_compl p q h).symm x = (0, x) :=
(prod_equiv_of_is_compl p q h).symm_apply_eq.2 $ by simp

@[simp] lemma prod_equiv_of_is_compl_symm_apply_fst_eq_zero (h : is_compl p q) {x : E} :
  ((prod_equiv_of_is_compl p q h).symm x).1 = 0 ↔ x ∈ q :=
begin
  conv_rhs { rw [← (prod_equiv_of_is_compl p q h).apply_symm_apply x] },
  rw [coe_prod_equiv_of_is_compl', submodule.add_mem_iff_left _ (submodule.coe_mem _),
    mem_right_iff_eq_zero_of_disjoint h.disjoint]
end

@[simp] lemma prod_equiv_of_is_compl_symm_apply_snd_eq_zero (h : is_compl p q) {x : E} :
  ((prod_equiv_of_is_compl p q h).symm x).2 = 0 ↔ x ∈ p :=
begin
  conv_rhs { rw [← (prod_equiv_of_is_compl p q h).apply_symm_apply x] },
  rw [coe_prod_equiv_of_is_compl', submodule.add_mem_iff_right _ (submodule.coe_mem _),
    mem_left_iff_eq_zero_of_disjoint h.disjoint]
end

/-- Projection to a submodule along its complement. -/
def linear_proj_of_is_compl (h : is_compl p q) :
  E →ₗ[R] p :=
(linear_map.fst R p q) ∘ₗ ↑(prod_equiv_of_is_compl p q h).symm

variables {p q}

@[simp] lemma linear_proj_of_is_compl_apply_left (h : is_compl p q) (x : p) :
  linear_proj_of_is_compl p q h x = x :=
by simp [linear_proj_of_is_compl]

@[simp] lemma linear_proj_of_is_compl_range (h : is_compl p q) :
  (linear_proj_of_is_compl p q h).range = ⊤ :=
range_eq_of_proj (linear_proj_of_is_compl_apply_left h)

@[simp] lemma linear_proj_of_is_compl_apply_eq_zero_iff (h : is_compl p q) {x : E} :
  linear_proj_of_is_compl p q h x = 0 ↔ x ∈ q:=
by simp [linear_proj_of_is_compl]

lemma linear_proj_of_is_compl_apply_right' (h : is_compl p q) (x : E) (hx : x ∈ q) :
  linear_proj_of_is_compl p q h x = 0 :=
(linear_proj_of_is_compl_apply_eq_zero_iff h).2 hx

@[simp] lemma linear_proj_of_is_compl_apply_right (h : is_compl p q) (x : q) :
  linear_proj_of_is_compl p q h x = 0 :=
linear_proj_of_is_compl_apply_right' h x x.2

@[simp] lemma linear_proj_of_is_compl_ker (h : is_compl p q) :
  (linear_proj_of_is_compl p q h).ker = q :=
ext $ λ x, mem_ker.trans (linear_proj_of_is_compl_apply_eq_zero_iff h)

lemma linear_proj_of_is_compl_comp_subtype (h : is_compl p q) :
  (linear_proj_of_is_compl p q h).comp p.subtype = id :=
linear_map.ext $ linear_proj_of_is_compl_apply_left h

lemma linear_proj_of_is_compl_idempotent (h : is_compl p q) (x : E) :
  linear_proj_of_is_compl p q h (linear_proj_of_is_compl p q h x) =
    linear_proj_of_is_compl p q h x :=
linear_proj_of_is_compl_apply_left h _

lemma exists_unique_add_of_is_compl_prod (hc : is_compl p q) (x : E) :
  ∃! (u : p × q), (u.fst : E) + u.snd = x :=
(prod_equiv_of_is_compl _ _ hc).to_equiv.bijective.exists_unique _

lemma exists_unique_add_of_is_compl (hc : is_compl p q) (x : E) :
  ∃ (u : p) (v : q), ((u : E) + v = x ∧ ∀ (r : p) (s : q),
    (r : E) + s = x → r = u ∧ s = v) :=
let ⟨u, hu₁, hu₂⟩ := exists_unique_add_of_is_compl_prod hc x in
  ⟨u.1, u.2, hu₁, λ r s hrs, prod.eq_iff_fst_eq_snd_eq.1 (hu₂ ⟨r, s⟩ hrs)⟩

end submodule

namespace linear_map

open submodule

/-- Given linear maps `φ` and `ψ` from complement submodules, `of_is_compl` is
the induced linear map over the entire module. -/
def of_is_compl {p q : submodule R E} (h : is_compl p q)
  (φ : p →ₗ[R] F) (ψ : q →ₗ[R] F) : E →ₗ[R] F :=
(linear_map.coprod φ ψ) ∘ₗ ↑(submodule.prod_equiv_of_is_compl _ _ h).symm

variables {p q}

@[simp] lemma of_is_compl_left_apply
  (h : is_compl p q) {φ : p →ₗ[R] F} {ψ : q →ₗ[R] F} (u : p) :
  of_is_compl h φ ψ (u : E) = φ u := by simp [of_is_compl]

@[simp] lemma of_is_compl_right_apply
  (h : is_compl p q) {φ : p →ₗ[R] F} {ψ : q →ₗ[R] F} (v : q) :
  of_is_compl h φ ψ (v : E) = ψ v := by simp [of_is_compl]

lemma of_is_compl_eq (h : is_compl p q)
  {φ : p →ₗ[R] F} {ψ : q →ₗ[R] F} {χ : E →ₗ[R] F}
  (hφ : ∀ u, φ u = χ u) (hψ : ∀ u, ψ u = χ u) :
  of_is_compl h φ ψ = χ :=
begin
  ext x,
  obtain ⟨_, _, rfl, _⟩ := exists_unique_add_of_is_compl h x,
  simp [of_is_compl, hφ, hψ]
end

lemma of_is_compl_eq' (h : is_compl p q)
  {φ : p →ₗ[R] F} {ψ : q →ₗ[R] F} {χ : E →ₗ[R] F}
  (hφ : φ = χ.comp p.subtype) (hψ : ψ = χ.comp q.subtype) :
  of_is_compl h φ ψ = χ :=
of_is_compl_eq h (λ _, hφ.symm ▸ rfl) (λ _, hψ.symm ▸ rfl)

@[simp] lemma of_is_compl_zero (h : is_compl p q) :
  (of_is_compl h 0 0 : E →ₗ[R] F) = 0 :=
of_is_compl_eq _ (λ _, rfl) (λ _, rfl)

@[simp] lemma of_is_compl_add (h : is_compl p q)
  {φ₁ φ₂ : p →ₗ[R] F} {ψ₁ ψ₂ : q →ₗ[R] F} :
  of_is_compl h (φ₁ + φ₂) (ψ₁ + ψ₂) = of_is_compl h φ₁ ψ₁ + of_is_compl h φ₂ ψ₂ :=
of_is_compl_eq _ (by simp) (by simp)

@[simp] lemma of_is_compl_smul
  {R : Type*} [comm_ring R] {E : Type*} [add_comm_group E] [module R E]
  {F : Type*} [add_comm_group F] [module R F] {p q : submodule R E}
  (h : is_compl p q) {φ : p →ₗ[R] F} {ψ : q →ₗ[R] F} (c : R) :
  of_is_compl h (c • φ) (c • ψ) = c • of_is_compl h φ ψ :=
of_is_compl_eq _ (by simp) (by simp)

section

variables {R₁ : Type*} [comm_ring R₁] [module R₁ E] [module R₁ F]

/-- The linear map from `(p →ₗ[R₁] F) × (q →ₗ[R₁] F)` to `E →ₗ[R₁] F`. -/
def of_is_compl_prod {p q : submodule R₁ E} (h : is_compl p q) :
  ((p →ₗ[R₁] F) × (q →ₗ[R₁] F)) →ₗ[R₁] (E →ₗ[R₁] F) :=
{ to_fun := λ φ, of_is_compl h φ.1 φ.2,
  map_add' := by { intros φ ψ, rw [prod.snd_add, prod.fst_add, of_is_compl_add] },
  map_smul' := by { intros c φ, simp [prod.smul_snd, prod.smul_fst, of_is_compl_smul] } }

@[simp] lemma of_is_compl_prod_apply {p q : submodule R₁ E} (h : is_compl p q)
  (φ : (p →ₗ[R₁] F) × (q →ₗ[R₁] F)) : of_is_compl_prod h φ = of_is_compl h φ.1 φ.2 := rfl

/-- The natural linear equivalence between `(p →ₗ[R₁] F) × (q →ₗ[R₁] F)` and `E →ₗ[R₁] F`. -/
def of_is_compl_prod_equiv {p q : submodule R₁ E} (h : is_compl p q) :
  ((p →ₗ[R₁] F) × (q →ₗ[R₁] F)) ≃ₗ[R₁] (E →ₗ[R₁] F) :=
{ inv_fun := λ φ, ⟨φ.dom_restrict p, φ.dom_restrict q⟩,
  left_inv :=
    begin
      intros φ, ext,
      { exact of_is_compl_left_apply h x },
      { exact of_is_compl_right_apply h x }
    end,
  right_inv :=
    begin
      intro φ, ext,
      obtain ⟨a, b, hab, _⟩ := exists_unique_add_of_is_compl h x,
      rw [← hab], simp,
    end, .. of_is_compl_prod h }

end

@[simp] lemma linear_proj_of_is_compl_of_proj (f : E →ₗ[R] p) (hf : ∀ x : p, f x = x) :
  p.linear_proj_of_is_compl f.ker (is_compl_of_proj hf) = f :=
begin
  ext x,
  have : x ∈ p ⊔ f.ker,
  { simp only [(is_compl_of_proj hf).sup_eq_top, mem_top] },
  rcases mem_sup'.1 this with ⟨x, y, rfl⟩,
  simp [hf]
end

/-- If `f : E →ₗ[R] F` and `g : E →ₗ[R] G` are two surjective linear maps and
their kernels are complement of each other, then `x ↦ (f x, g x)` defines
a linear equivalence `E ≃ₗ[R] F × G`. -/
def equiv_prod_of_surjective_of_is_compl (f : E →ₗ[R] F) (g : E →ₗ[R] G) (hf : f.range = ⊤)
  (hg : g.range = ⊤) (hfg : is_compl f.ker g.ker) :
  E ≃ₗ[R] F × G :=
linear_equiv.of_bijective (f.prod g) (by simp [← ker_eq_bot, hfg.inf_eq_bot])
  (by simp [← range_eq_top, range_prod_eq hfg.sup_eq_top, *])

@[simp] lemma coe_equiv_prod_of_surjective_of_is_compl {f : E →ₗ[R] F} {g : E →ₗ[R] G}
  (hf : f.range = ⊤) (hg : g.range = ⊤) (hfg : is_compl f.ker g.ker) :
  (equiv_prod_of_surjective_of_is_compl f g hf hg hfg : E →ₗ[R] F × G) = f.prod g :=
rfl

@[simp] lemma equiv_prod_of_surjective_of_is_compl_apply {f : E →ₗ[R] F} {g : E →ₗ[R] G}
  (hf : f.range = ⊤) (hg : g.range = ⊤) (hfg : is_compl f.ker g.ker) (x : E):
  equiv_prod_of_surjective_of_is_compl f g hf hg hfg x = (f x, g x) :=
rfl

end linear_map

namespace submodule

open linear_map

/-- Equivalence between submodules `q` such that `is_compl p q` and linear maps `f : E →ₗ[R] p`
such that `∀ x : p, f x = x`. -/
def is_compl_equiv_proj :
  {q // is_compl p q} ≃ {f : E →ₗ[R] p // ∀ x : p, f x = x} :=
{ to_fun := λ q, ⟨linear_proj_of_is_compl p q q.2, linear_proj_of_is_compl_apply_left q.2⟩,
  inv_fun := λ f, ⟨(f : E →ₗ[R] p).ker, is_compl_of_proj f.2⟩,
  left_inv := λ ⟨q, hq⟩, by simp only [linear_proj_of_is_compl_ker, subtype.coe_mk],
  right_inv := λ ⟨f, hf⟩, subtype.eq $ f.linear_proj_of_is_compl_of_proj hf }

@[simp] lemma coe_is_compl_equiv_proj_apply (q : {q // is_compl p q}) :
  (p.is_compl_equiv_proj q : E →ₗ[R] p) = linear_proj_of_is_compl p q q.2 := rfl

@[simp] lemma coe_is_compl_equiv_proj_symm_apply (f : {f : E →ₗ[R] p // ∀ x : p, f x = x}) :
  (p.is_compl_equiv_proj.symm f : submodule R E) = (f : E →ₗ[R] p).ker := rfl

end submodule


/-
Copyright (c) 2019 Neil Strickland. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Neil Strickland
-/
import data.pnat.prime
import data.multiset.sort

/-!
# Prime factors of nonzero naturals

This file defines the factorization of a nonzero natural number `n` as a multiset of primes,
the multiplicity of `p` in this factors multiset being the p-adic valuation of `n`.

## Main declarations

* `prime_multiset`: Type of multisets of prime numbers.
* `factor_multiset n`: Multiset of prime factors of `n`.
-/

/-- The type of multisets of prime numbers.  Unique factorization
 gives an equivalence between this set and ℕ+, as we will formalize
 below. -/
 @[derive [inhabited, has_repr, canonically_ordered_add_monoid, distrib_lattice,
  semilattice_sup, order_bot, has_sub, has_ordered_sub]]
def prime_multiset := multiset nat.primes

namespace prime_multiset

/-- The multiset consisting of a single prime -/
def of_prime (p : nat.primes) : prime_multiset := ({p} : multiset nat.primes)

theorem card_of_prime (p : nat.primes) : multiset.card (of_prime p) = 1 := rfl

/-- We can forget the primality property and regard a multiset
 of primes as just a multiset of positive integers, or a multiset
 of natural numbers.  In the opposite direction, if we have a
 multiset of positive integers or natural numbers, together with
 a proof that all the elements are prime, then we can regard it
 as a multiset of primes.  The next block of results records
 obvious properties of these coercions.
-/
def to_nat_multiset : prime_multiset → multiset ℕ :=
λ v, v.map (λ p, (p : ℕ))

instance coe_nat : has_coe prime_multiset (multiset ℕ) := ⟨to_nat_multiset⟩

/-- `prime_multiset.coe`, the coercion from a multiset of primes to a multiset of
naturals, promoted to an `add_monoid_hom`. -/
def coe_nat_monoid_hom : prime_multiset →+ multiset ℕ :=
{ to_fun := coe,
  .. multiset.map_add_monoid_hom coe }

@[simp] lemma coe_coe_nat_monoid_hom :
  (coe_nat_monoid_hom : prime_multiset → multiset ℕ) = coe := rfl

theorem coe_nat_injective : function.injective (coe : prime_multiset → multiset ℕ) :=
multiset.map_injective nat.primes.coe_nat_inj

theorem coe_nat_of_prime (p : nat.primes) :
((of_prime p) : multiset ℕ) = {p} := rfl

theorem coe_nat_prime (v : prime_multiset)
(p : ℕ) (h : p ∈ (v : multiset ℕ)) : p.prime :=
by { rcases multiset.mem_map.mp h with ⟨⟨p', hp'⟩, ⟨h_mem, h_eq⟩⟩,
     exact h_eq ▸ hp' }

/-- Converts a `prime_multiset` to a `multiset ℕ+`. -/
def to_pnat_multiset : prime_multiset → multiset ℕ+ :=
λ v, v.map (λ p, (p : ℕ+))

instance coe_pnat : has_coe prime_multiset (multiset ℕ+) := ⟨to_pnat_multiset⟩

/-- `coe_pnat`, the coercion from a multiset of primes to a multiset of positive
naturals, regarded as an `add_monoid_hom`. -/
def coe_pnat_monoid_hom : prime_multiset →+ multiset ℕ+ :=
{ to_fun := coe,
  .. multiset.map_add_monoid_hom coe }

@[simp] lemma coe_coe_pnat_monoid_hom :
  (coe_pnat_monoid_hom : prime_multiset → multiset ℕ+) = coe := rfl

theorem coe_pnat_injective : function.injective (coe : prime_multiset → multiset ℕ+) :=
multiset.map_injective nat.primes.coe_pnat_inj

theorem coe_pnat_of_prime (p : nat.primes) :
((of_prime p) : multiset ℕ+) = {(p : ℕ+)} := rfl

theorem coe_pnat_prime (v : prime_multiset)
  (p : ℕ+) (h : p ∈ (v : multiset ℕ+)) : p.prime :=
by { rcases multiset.mem_map.mp h with ⟨⟨p', hp'⟩, ⟨h_mem, h_eq⟩⟩,
     exact h_eq ▸ hp' }

instance coe_multiset_pnat_nat : has_coe (multiset ℕ+) (multiset ℕ) :=
⟨λ v, v.map (λ n, (n : ℕ))⟩

theorem coe_pnat_nat (v : prime_multiset) :
  ((v : (multiset ℕ+)) : (multiset ℕ)) = (v : multiset ℕ) :=
by { change (v.map (coe : nat.primes → ℕ+)).map subtype.val = v.map subtype.val,
     rw [multiset.map_map], congr }

/-- The product of a `prime_multiset`, as a `ℕ+`. -/
def prod (v : prime_multiset) : ℕ+ := (v : multiset pnat).prod

theorem coe_prod (v : prime_multiset) : (v.prod : ℕ) = (v : multiset ℕ).prod :=
begin
  let h : (v.prod : ℕ) = ((v.map coe).map coe).prod :=
    (pnat.coe_monoid_hom.map_multiset_prod v.to_pnat_multiset),
  rw [multiset.map_map] at h,
  have : (coe : ℕ+ → ℕ) ∘ (coe : nat.primes → ℕ+) = coe := funext (λ p, rfl),
  rw[this] at h, exact h,
end

theorem prod_of_prime (p : nat.primes) : (of_prime p).prod = (p : ℕ+) :=
multiset.prod_singleton _

/-- If a `multiset ℕ` consists only of primes, it can be recast as a `prime_multiset`. -/
def of_nat_multiset
  (v : multiset ℕ) (h : ∀ (p : ℕ), p ∈ v → p.prime) : prime_multiset :=
@multiset.pmap ℕ nat.primes nat.prime (λ p hp, ⟨p, hp⟩) v h

theorem to_of_nat_multiset (v : multiset ℕ) (h) :
  ((of_nat_multiset v h) : multiset ℕ) = v :=
begin
  unfold_coes,
  dsimp [of_nat_multiset, to_nat_multiset],
  have : (λ (p : ℕ) (h : p.prime), ((⟨p, h⟩ : nat.primes) : ℕ)) = (λ p h, id p) :=
    by {funext p h, refl},
  rw [multiset.map_pmap, this, multiset.pmap_eq_map, multiset.map_id]
end

theorem prod_of_nat_multiset (v : multiset ℕ) (h) :
  ((of_nat_multiset v h).prod : ℕ) = (v.prod : ℕ) :=
by rw[coe_prod, to_of_nat_multiset]

/-- If a `multiset ℕ+` consists only of primes, it can be recast as a `prime_multiset`. -/
def of_pnat_multiset
  (v : multiset ℕ+) (h : ∀ (p : ℕ+), p ∈ v → p.prime) : prime_multiset :=
@multiset.pmap ℕ+ nat.primes pnat.prime (λ p hp, ⟨(p : ℕ), hp⟩) v h

theorem to_of_pnat_multiset (v : multiset ℕ+) (h) :
 ((of_pnat_multiset v h) : multiset ℕ+) = v :=
begin
  unfold_coes, dsimp[of_pnat_multiset, to_pnat_multiset],
  have : (λ (p : ℕ+) (h : p.prime), ((coe : nat.primes → ℕ+) ⟨p, h⟩)) = (λ p h, id p) :=
    by {funext p h, apply subtype.eq, refl},
  rw[multiset.map_pmap, this, multiset.pmap_eq_map, multiset.map_id]
end

theorem prod_of_pnat_multiset (v : multiset ℕ+) (h) :
 ((of_pnat_multiset v h).prod : ℕ+) = v.prod :=
by { dsimp [prod], rw [to_of_pnat_multiset] }

/-- Lists can be coerced to multisets; here we have some results
about how this interacts with our constructions on multisets. -/
def of_nat_list (l : list ℕ) (h : ∀ (p : ℕ), p ∈ l → p.prime) : prime_multiset :=
of_nat_multiset (l : multiset ℕ) h

theorem prod_of_nat_list (l : list ℕ) (h) : ((of_nat_list l h).prod : ℕ) = l.prod :=
by { have := prod_of_nat_multiset (l : multiset ℕ) h,
     rw [multiset.coe_prod] at this, exact this }

/-- If a `list ℕ+` consists only of primes, it can be recast as a `prime_multiset` with
the coercion from lists to multisets. -/
def of_pnat_list (l : list ℕ+) (h : ∀ (p : ℕ+), p ∈ l → p.prime) : prime_multiset :=
of_pnat_multiset (l : multiset ℕ+) h

theorem prod_of_pnat_list (l : list ℕ+) (h) : (of_pnat_list l h).prod = l.prod :=
by { have := prod_of_pnat_multiset (l : multiset ℕ+) h,
     rw [multiset.coe_prod] at this, exact this }

/-- The product map gives a homomorphism from the additive monoid
of multisets to the multiplicative monoid ℕ+. -/
theorem prod_zero : (0 : prime_multiset).prod = 1 :=
by { dsimp [prod], exact multiset.prod_zero }

theorem prod_add (u v : prime_multiset) : (u + v).prod = u.prod * v.prod :=
begin
  change (coe_pnat_monoid_hom (u + v)).prod = _,
  rw coe_pnat_monoid_hom.map_add,
  exact multiset.prod_add _ _,
end

end prime_multiset

namespace pnat

/-- The prime factors of n, regarded as a multiset -/
def factor_multiset (n : ℕ+) : prime_multiset :=
prime_multiset.of_nat_list (nat.factors n) (@nat.prime_of_mem_factors n)

/-- The product of the factors is the original number -/
theorem prod_factor_multiset (n : ℕ+) : (factor_multiset n).prod = n :=
eq $ by { dsimp [factor_multiset],
          rw [prime_multiset.prod_of_nat_list],
          exact nat.prod_factors n.pos }

theorem coe_nat_factor_multiset (n : ℕ+) :
  ((factor_multiset n) : (multiset ℕ)) = ((nat.factors n) : multiset ℕ) :=
prime_multiset.to_of_nat_multiset (nat.factors n) (@nat.prime_of_mem_factors n)

end pnat

namespace prime_multiset

/-- If we start with a multiset of primes, take the product and
 then factor it, we get back the original multiset. -/
theorem factor_multiset_prod (v : prime_multiset) :
  v.prod.factor_multiset = v :=
begin
  apply prime_multiset.coe_nat_injective,
  rw [v.prod.coe_nat_factor_multiset, prime_multiset.coe_prod],
  rcases v with ⟨l⟩,
  unfold_coes,
  dsimp [prime_multiset.to_nat_multiset],
  rw [multiset.coe_prod],
  let l' := l.map (coe : nat.primes → ℕ),
  have : ∀ (p : ℕ), p ∈ l' → p.prime :=
    λ p hp, by {rcases list.mem_map.mp hp with ⟨⟨p', hp'⟩, ⟨h_mem, h_eq⟩⟩,
                exact h_eq ▸ hp'},
  exact multiset.coe_eq_coe.mpr (@nat.factors_unique _ l' rfl this).symm,
end

end prime_multiset

namespace pnat

/-- Positive integers biject with multisets of primes. -/
def factor_multiset_equiv : ℕ+ ≃ prime_multiset :=
{ to_fun    := factor_multiset,
  inv_fun   := prime_multiset.prod,
  left_inv  := prod_factor_multiset,
  right_inv := prime_multiset.factor_multiset_prod }

/-- Factoring gives a homomorphism from the multiplicative
 monoid ℕ+ to the additive monoid of multisets. -/
theorem factor_multiset_one : factor_multiset 1 = 0 :=
by simp [factor_multiset, prime_multiset.of_nat_list, prime_multiset.of_nat_multiset]

theorem factor_multiset_mul (n m : ℕ+) :
  factor_multiset (n * m) = (factor_multiset n) + (factor_multiset m) :=
begin
  let u := factor_multiset n,
  let v := factor_multiset m,
  have : n = u.prod := (prod_factor_multiset n).symm, rw[this],
  have : m = v.prod := (prod_factor_multiset m).symm, rw[this],
  rw[← prime_multiset.prod_add],
  repeat {rw[prime_multiset.factor_multiset_prod]},
end

theorem factor_multiset_pow (n : ℕ+) (m : ℕ) :
  factor_multiset (n ^ m) = m • (factor_multiset n) :=
begin
  let u := factor_multiset n,
  have : n = u.prod := (prod_factor_multiset n).symm,
  rw[this, ← prime_multiset.prod_smul],
  repeat {rw[prime_multiset.factor_multiset_prod]},
end

/-- Factoring a prime gives the corresponding one-element multiset. -/
theorem factor_multiset_of_prime (p : nat.primes) :
  (p : ℕ+).factor_multiset = prime_multiset.of_prime p :=
begin
  apply factor_multiset_equiv.symm.injective,
  change (p : ℕ+).factor_multiset.prod = (prime_multiset.of_prime p).prod,
  rw[(p : ℕ+).prod_factor_multiset, prime_multiset.prod_of_prime],
end

/-- We now have four different results that all encode the
 idea that inequality of multisets corresponds to divisibility
 of positive integers. -/
theorem factor_multiset_le_iff {m n : ℕ+} :
  factor_multiset m ≤ factor_multiset n ↔ m ∣ n :=
begin
  split,
  { intro h,
    rw [← prod_factor_multiset m, ← prod_factor_multiset m],
    apply dvd.intro (n.factor_multiset - m.factor_multiset).prod,
    rw [← prime_multiset.prod_add, prime_multiset.factor_multiset_prod,
        add_tsub_cancel_of_le h, prod_factor_multiset] },
  { intro  h,
    rw [← mul_div_exact h, factor_multiset_mul],
    exact le_self_add }
end

theorem factor_multiset_le_iff' {m : ℕ+} {v : prime_multiset}:
 factor_multiset m ≤ v ↔ m ∣ v.prod :=
by { let h := @factor_multiset_le_iff m v.prod,
     rw [v.factor_multiset_prod] at h, exact h }

end pnat

namespace prime_multiset

theorem prod_dvd_iff {u v : prime_multiset} : u.prod ∣ v.prod ↔ u ≤ v :=
by { let h := @pnat.factor_multiset_le_iff' u.prod v,
     rw [u.factor_multiset_prod] at h, exact h.symm }

theorem prod_dvd_iff' {u : prime_multiset} {n : ℕ+} : u.prod ∣ n ↔ u ≤ n.factor_multiset :=
by { let h := @prod_dvd_iff u n.factor_multiset,
     rw [n.prod_factor_multiset] at h, exact h }

end prime_multiset

namespace pnat

/-- The gcd and lcm operations on positive integers correspond
 to the inf and sup operations on multisets. -/
theorem factor_multiset_gcd (m n : ℕ+) :
 factor_multiset (gcd m n) = (factor_multiset m) ⊓ (factor_multiset n) :=
begin
  apply le_antisymm,
  { apply le_inf_iff.mpr; split; apply factor_multiset_le_iff.mpr,
    exact gcd_dvd_left m n, exact gcd_dvd_right m n},
  { rw[← prime_multiset.prod_dvd_iff, prod_factor_multiset],
    apply dvd_gcd; rw[prime_multiset.prod_dvd_iff'],
    exact inf_le_left, exact inf_le_right}
end

theorem factor_multiset_lcm (m n : ℕ+) :
 factor_multiset (lcm m n) = (factor_multiset m) ⊔ (factor_multiset n) :=
begin
  apply le_antisymm,
  { rw[← prime_multiset.prod_dvd_iff, prod_factor_multiset],
    apply lcm_dvd; rw[← factor_multiset_le_iff'],
    exact le_sup_left, exact le_sup_right},
  { apply sup_le_iff.mpr; split; apply factor_multiset_le_iff.mpr,
    exact dvd_lcm_left m n, exact dvd_lcm_right m n },
end

/-- The number of occurrences of p in the factor multiset of m
 is the same as the p-adic valuation of m. -/
theorem count_factor_multiset (m : ℕ+) (p : nat.primes) (k : ℕ) :
 (p : ℕ+) ^ k ∣ m ↔ k ≤ m.factor_multiset.count p :=
begin
  intros,
  rw [multiset.le_count_iff_repeat_le],
  rw [← factor_multiset_le_iff, factor_multiset_pow, factor_multiset_of_prime],
  congr' 2,
  apply multiset.eq_repeat.mpr,
  split,
  { rw [multiset.card_nsmul, prime_multiset.card_of_prime, mul_one] },
  { intros q h, rw [prime_multiset.of_prime, multiset.nsmul_singleton _ k] at h,
    exact multiset.eq_of_mem_repeat h }
end

end pnat

namespace prime_multiset

theorem prod_inf (u v : prime_multiset) :
 (u ⊓ v).prod = pnat.gcd u.prod v.prod :=
begin
  let n := u.prod,
  let m := v.prod,
  change (u ⊓ v).prod = pnat.gcd n m,
  have : u = n.factor_multiset := u.factor_multiset_prod.symm, rw [this],
  have : v = m.factor_multiset := v.factor_multiset_prod.symm, rw [this],
  rw [← pnat.factor_multiset_gcd n m, pnat.prod_factor_multiset]
end

theorem prod_sup (u v : prime_multiset) :
 (u ⊔ v).prod = pnat.lcm u.prod v.prod :=
begin
  let n := u.prod,
  let m := v.prod,
  change (u ⊔ v).prod = pnat.lcm n m,
  have : u = n.factor_multiset := u.factor_multiset_prod.symm, rw [this],
  have : v = m.factor_multiset := v.factor_multiset_prod.symm, rw [this],
  rw[← pnat.factor_multiset_lcm n m, pnat.prod_factor_multiset]
end

end prime_multiset


import order.succ_pred.basic
import tactic

open finset
open_locale big_operators

---------------------------------------------------
-- Missing lemmas (`sketch/integrate.lean`)
lemma nat.Icc_succ_right {m n : ℕ} (h : m ≤ n): Icc m n.succ = has_insert.insert n.succ (Icc m n) :=
begin
  ext,
  have : (m ≤ a ∧ a = n.succ) = (a = n.succ),
  { rw eq_iff_iff,
    split,
    { exact and.right, },
    { intro h₁, rw h₁, exact ⟨nat.le_succ_of_le h, eq.refl n.succ⟩, }, },
  simp_rw [mem_insert, mem_Icc, nat.le_add_one_iff, and_or_distrib_left, this, or.comm],
end
---------------------------------------------------

-- Elementary definitions of subset sums
namespace set

variable (A : set ℕ)

-- Property indicating a number which is the sum of distinct elements of A
def summable (x : ℕ) : Prop := ∃ (S : finset ℕ) (hS : ↑S ⊆ A), (∑ s in S, id s) = x

-- The set of subset sums is numbers which is the sum of distinct elements of A
-- Obviously we can just take finite sets
def subset_sums : set ℕ := { x : ℕ | summable A x }

-- complete sequences: if eventually every number is a sum of distinct elements of A
def complete : Prop := ∃ (N : ℕ), ∀ (n : ℕ) (hn : N ≤ n), summable A n

-- entire complete sqeuences: if every number is a sum of distinct elements of A
def entirely_complete : Prop := ∀ (n : ℕ), summable A n

theorem summable_zero : summable A 0 := ⟨∅, ⟨empty_subset A, sum_empty⟩⟩

-- entire completeness implies completeness
theorem complete_of_entirely_complete : entirely_complete A → complete A :=
begin
  intro h,
  use 0,
  simp_rw [zero_le', forall_true_left],
  exact h,
end

end set

-- Alternative definitions with sequences
namespace seq

variables (f : ℕ → ℕ)

-- Property indicating a number which is the sum of subsequence of f
def summable (x : ℕ) : Prop := ∃ S, (∑ s in S, f s) = x

-- The set of subset sums is numbers which is the sum of subsequence of f
def subset_sums : set ℕ := { x : ℕ | summable f x }

-- Complete sequences: if eventually every number is a sum of subsequence of f
def complete : Prop := ∃ (N : ℕ), ∀ (n : ℕ) (hn : N ≤ n), summable f n

-- Entirely complete sqeuences: if every number is a sum of distinct elements of A
-- Zero is the sum of empty set
def entirely_complete : Prop := ∀ (n : ℕ), summable f n

theorem summable_zero : summable f 0 := ⟨∅, sum_empty⟩

-- Entire completeness implies completeness
theorem complete_of_entirely_complete : entirely_complete f → complete f :=
begin
  intro h,
  use 0,
  simp_rw [zero_le', forall_true_left],
  exact h,
end

-- For a monotone sequence, this is a necessary and sufficient condition to be entirely complete
theorem entirely_complete_iff (f : ℕ → ℕ) (hf : monotone f) :
entirely_complete f ↔ summable f 1 ∧ ∀ n : ℕ, f (n + 1) ≤ 1 + ∑ i in Icc 0 n, f i :=
begin
  split,
  {
    intro h,
    split,
    { exact h 1, },
    { by_contradiction h',
      push_neg at h',
      cases h' with k hk,
      apply imp_false.2 _ h,
      simp_rw [entirely_complete, summable],
      push_neg,
      use 1 + ∑ i in Icc 0 k, f i,
      -- Prove that 1 + ∑ i in Icc 0 k, f i is not sum of distinct elements
      sorry,
    },
  },
  {
    intro h,
    -- By induction, prove that f 0 to f k covers [0, 1 + ∑ i in Icc 0 k, f i]
    -- Then adding f (k + 1) shifts the interval
    sorry,
  }
end

-- Basic examples
namespace examples

-- 2^n is entirely complete
example : entirely_complete (pow 2) :=
begin
  rw entirely_complete_iff (pow 2) (pow_mono one_le_two),
  split,
  { use {0}, rw [sum_singleton, pow_zero], },
  { intro n,
    induction n with k hk,
    { simp, },
    { rw [nat.Icc_succ_right k.zero_le, sum_insert, ← add_assoc, pow_add, pow_one, mul_two,
          add_comm 1 _, add_assoc],
      apply nat.add_le_add_left hk,
      simp only [mem_Icc, zero_le', true_and, not_le, nat.lt_succ_self k], }, },
end

end examples

end seq
-- characterises complete sequences