/-
Copyright (c) 2022 Riccardo Brasca. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Riccardo Brasca

! This file was ported from Lean 3 source module ring_theory.polynomial.eisenstein.is_integral
! leanprover-community/mathlib commit ceb887ddf3344dab425292e497fa2af91498437c
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Nat.Choose.Dvd
import Mathbin.RingTheory.IntegrallyClosed
import Mathbin.RingTheory.Norm
import Mathbin.RingTheory.Polynomial.Cyclotomic.Basic

/-!
# Eisenstein polynomials
In this file we gather more miscellaneous results about Eisenstein polynomials

## Main results
* `mem_adjoin_of_smul_prime_pow_smul_of_minpoly_is_eiseinstein_at`: let `K` be the field of fraction
  of an integrally closed domain `R` and let `L` be a separable extension of `K`, generated by an
  integral power basis `B` such that the minimal polynomial of `B.gen` is Eisenstein at `p`. Given
  `z : L` integral over `R`, if `p ^ n • z ∈ adjoin R {B.gen}`, then `z ∈ adjoin R {B.gen}`.
  Together with `algebra.discr_mul_is_integral_mem_adjoin` this result often allows to compute the
  ring of integers of `L`.

-/

universe u v w z

variable {R : Type u}

open Ideal Algebra Finset

open BigOperators Polynomial

section Cyclotomic

variable (p : ℕ)

-- mathport name: expr𝓟
local notation "𝓟" => Submodule.span ℤ {p}

open Polynomial

theorem cyclotomic_comp_x_add_one_isEisensteinAt [hp : Fact p.Prime] :
    ((cyclotomic p ℤ).comp (X + 1)).IsEisensteinAt 𝓟 :=
  by
  refine'
    monic.is_eisenstein_at_of_mem_of_not_mem _
      (Ideal.IsPrime.ne_top <|
        (Ideal.span_singleton_prime (by exact_mod_cast hp.out.ne_zero)).2 <|
          Nat.prime_iff_prime_int.1 hp.out)
      (fun i hi => _) _
  · rw [show (X + 1 : ℤ[X]) = X + C 1 by simp]
    refine' (cyclotomic.monic p ℤ).comp (monic_X_add_C 1) fun h => _
    rw [nat_degree_X_add_C] at h
    exact zero_ne_one h.symm
  · rw [cyclotomic_prime, geom_sum_X_comp_X_add_one_eq_sum, ← lcoeff_apply, LinearMap.map_sum]
    conv =>
      congr
      congr
      skip
      ext
      rw [lcoeff_apply, ← C_eq_nat_cast, C_mul_X_pow_eq_monomial, coeff_monomial]
    rw [nat_degree_comp, show (X + 1 : ℤ[X]) = X + C 1 by simp, nat_degree_X_add_C, mul_one,
      nat_degree_cyclotomic, Nat.totient_prime hp.out] at hi
    simp only [hi.trans_le (Nat.sub_le _ _), sum_ite_eq', mem_range, if_true,
      Ideal.submodule_span_eq, Ideal.mem_span_singleton, Int.coe_nat_dvd]
    exact hp.out.dvd_choose_self i.succ_ne_zero (lt_tsub_iff_right.1 hi)
  · rw [coeff_zero_eq_eval_zero, eval_comp, cyclotomic_prime, eval_add, eval_X, eval_one, zero_add,
      eval_geom_sum, one_geom_sum, Ideal.submodule_span_eq, Ideal.span_singleton_pow,
      Ideal.mem_span_singleton]
    intro h
    obtain ⟨k, hk⟩ := Int.coe_nat_dvd.1 h
    rw [← mul_assoc, mul_one, mul_assoc] at hk
    nth_rw 1 [← Nat.mul_one p] at hk
    rw [mul_right_inj' hp.out.ne_zero] at hk
    exact Nat.Prime.not_dvd_one hp.out (Dvd.intro k hk.symm)
#align cyclotomic_comp_X_add_one_is_eisenstein_at cyclotomic_comp_x_add_one_isEisensteinAt

theorem cyclotomic_prime_pow_comp_x_add_one_isEisensteinAt [hp : Fact p.Prime] (n : ℕ) :
    ((cyclotomic (p ^ (n + 1)) ℤ).comp (X + 1)).IsEisensteinAt 𝓟 :=
  by
  refine'
    monic.is_eisenstein_at_of_mem_of_not_mem _
      (Ideal.IsPrime.ne_top <|
        (Ideal.span_singleton_prime (by exact_mod_cast hp.out.ne_zero)).2 <|
          Nat.prime_iff_prime_int.1 hp.out)
      _ _
  · rw [show (X + 1 : ℤ[X]) = X + C 1 by simp]
    refine' (cyclotomic.monic _ ℤ).comp (monic_X_add_C 1) fun h => _
    rw [nat_degree_X_add_C] at h
    exact zero_ne_one h.symm
  · induction' n with n hn
    · intro i hi
      rw [zero_add, pow_one] at hi⊢
      exact (cyclotomic_comp_x_add_one_isEisensteinAt p).Mem hi
    · intro i hi
      rw [Ideal.submodule_span_eq, Ideal.mem_span_singleton, ← ZMod.int_cast_zmod_eq_zero_iff_dvd, ←
        Int.coe_castRingHom, ← coeff_map, map_comp, map_cyclotomic, Polynomial.map_add, map_X,
        Polynomial.map_one, pow_add, pow_one, cyclotomic_mul_prime_dvd_eq_pow, pow_comp, ←
        ZMod.expand_card, coeff_expand hp.out.pos]
      · simp only [ite_eq_right_iff]
        rintro ⟨k, hk⟩
        rw [nat_degree_comp, show (X + 1 : ℤ[X]) = X + C 1 by simp, nat_degree_X_add_C, mul_one,
          nat_degree_cyclotomic, Nat.totient_prime_pow hp.out (Nat.succ_pos _), Nat.succ_sub_one] at
          hn hi
        rw [hk, pow_succ, mul_assoc] at hi
        rw [hk, mul_comm, Nat.mul_div_cancel _ hp.out.pos]
        replace hn := hn (lt_of_mul_lt_mul_left' hi)
        rw [Ideal.submodule_span_eq, Ideal.mem_span_singleton, ← ZMod.int_cast_zmod_eq_zero_iff_dvd,
          ← Int.coe_castRingHom, ← coeff_map] at hn
        simpa [map_comp] using hn
      · exact ⟨p ^ n, by rw [pow_succ]⟩
  · rw [coeff_zero_eq_eval_zero, eval_comp, cyclotomic_prime_pow_eq_geom_sum hp.out, eval_add,
      eval_X, eval_one, zero_add, eval_finset_sum]
    simp only [eval_pow, eval_X, one_pow, sum_const, card_range, Nat.smul_one_eq_coe,
      submodule_span_eq, Ideal.submodule_span_eq, Ideal.span_singleton_pow,
      Ideal.mem_span_singleton]
    intro h
    obtain ⟨k, hk⟩ := Int.coe_nat_dvd.1 h
    rw [← mul_assoc, mul_one, mul_assoc] at hk
    nth_rw 1 [← Nat.mul_one p] at hk
    rw [mul_right_inj' hp.out.ne_zero] at hk
    exact Nat.Prime.not_dvd_one hp.out (Dvd.intro k hk.symm)
#align cyclotomic_prime_pow_comp_X_add_one_is_eisenstein_at cyclotomic_prime_pow_comp_x_add_one_isEisensteinAt

end Cyclotomic

section IsIntegral

variable {K : Type v} {L : Type z} {p : R} [CommRing R] [Field K] [Field L]

variable [Algebra K L] [Algebra R L] [Algebra R K] [IsScalarTower R K L] [IsSeparable K L]

variable [IsDomain R] [IsFractionRing R K] [IsIntegrallyClosed R]

-- mathport name: expr𝓟
local notation "𝓟" => Submodule.span R {p}

open IsIntegrallyClosed PowerBasis Nat Polynomial IsScalarTower

/-- Let `K` be the field of fraction of an integrally closed domain `R` and let `L` be a separable
extension of `K`, generated by an integral power basis `B` such that the minimal polynomial of
`B.gen` is Eisenstein at `p`. Given `z : L` integral over `R`, if `Q : R[X]` is such that
`aeval B.gen Q = p • z`, then `p ∣ Q.coeff 0`. -/
theorem dvd_coeff_zero_of_aeval_eq_prime_smul_of_minpoly_is_eiseinstein_at {B : PowerBasis K L}
    (hp : Prime p) (hBint : IsIntegral R B.gen) {z : L} {Q : R[X]} (hQ : aeval B.gen Q = p • z)
    (hzint : IsIntegral R z) (hei : (minpoly R B.gen).IsEisensteinAt 𝓟) : p ∣ Q.coeff 0 :=
  by
  -- First define some abbreviations.
  letI := B.finite_dimensional
  let P := minpoly R B.gen
  obtain ⟨n, hn⟩ := Nat.exists_eq_succ_of_ne_zero B.dim_pos.ne'
  have finrank_K_L : FiniteDimensional.finrank K L = B.dim := B.finrank
  have deg_K_P : (minpoly K B.gen).natDegree = B.dim := B.nat_degree_minpoly
  have deg_R_P : P.nat_degree = B.dim := by
    rw [← deg_K_P, minpoly.isIntegrallyClosed_eq_field_fractions' K hBint,
      (minpoly.monic hBint).natDegree_map (algebraMap R K)]
  choose! f hf using
    hei.is_weakly_eisenstein_at.exists_mem_adjoin_mul_eq_pow_nat_degree_le (minpoly.aeval R B.gen)
      (minpoly.monic hBint)
  simp only [(minpoly.monic hBint).natDegree_map, deg_R_P] at hf
  -- The Eisenstein condition shows that `p` divides `Q.coeff 0`
  -- if `p^n.succ` divides the following multiple of `Q.coeff 0^n.succ`:
  suffices p ^ n.succ ∣ Q.coeff 0 ^ n.succ * ((-1) ^ (n.succ * n) * (minpoly R B.gen).coeff 0 ^ n)
    by
    have hndiv : ¬p ^ 2 ∣ (minpoly R B.gen).coeff 0 := fun h =>
      hei.not_mem ((span_singleton_pow p 2).symm ▸ Ideal.mem_span_singleton.2 h)
    refine' Prime.dvd_of_pow_dvd_pow_mul_pow_of_square_not_dvd hp (_ : _ ^ n.succ ∣ _) hndiv
    convert(IsUnit.dvd_mul_right ⟨(-1) ^ (n.succ * n), rfl⟩).mpr this using 1
    push_cast
    ring_nf
    simp [pow_right_comm _ _ 2]
  -- We claim the quotient of `Q^n * _` by `p^n` is the following `r`:
  have aux : ∀ i ∈ (range (Q.nat_degree + 1)).eraseₓ 0, B.dim ≤ i + n :=
    by
    intro i hi
    simp only [mem_range, mem_erase] at hi
    rw [hn]
    exact le_add_pred_of_pos _ hi.1
  have hintsum :
    IsIntegral R
      (z * B.gen ^ n - ∑ x : ℕ in (range (Q.nat_degree + 1)).eraseₓ 0, Q.coeff x • f (x + n)) :=
    by
    refine'
      isIntegral_sub (isIntegral_mul hzint (IsIntegral.pow hBint _))
        (IsIntegral.sum _ fun i hi => isIntegral_smul _ _)
    exact adjoin_le_integralClosure hBint (hf _ (aux i hi)).1
  obtain ⟨r, hr⟩ := is_integral_iff.1 (is_integral_norm K hintsum)
  use r
  -- Do the computation in `K` so we can work in terms of `z` instead of `r`.
  apply IsFractionRing.injective R K
  simp only [_root_.map_mul, _root_.map_pow, _root_.map_neg, _root_.map_one]
  -- Both sides are actually norms:
  calc
    _ = norm K (Q.coeff 0 • B.gen ^ n) := _
    _ =
        norm K
          (p • (z * B.gen ^ n) -
            ∑ x : ℕ in (range (Q.nat_degree + 1)).eraseₓ 0, p • Q.coeff x • f (x + n)) :=
      (congr_arg (norm K) (eq_sub_of_add_eq _))
    _ = _ := _

  · simp only [Algebra.smul_def, algebra_map_apply R K L, Algebra.norm_algebraMap, _root_.map_mul,
      _root_.map_pow, finrank_K_L, power_basis.norm_gen_eq_coeff_zero_minpoly,
      minpoly.isIntegrallyClosed_eq_field_fractions' K hBint, coeff_map, ← hn]
    ring
  swap
  ·
    simp_rw [← smul_sum, ← smul_sub, Algebra.smul_def p, algebra_map_apply R K L, _root_.map_mul,
      Algebra.norm_algebraMap, finrank_K_L, hr, ← hn]
  calc
    _ =
        (Q.coeff 0 • 1 + ∑ x : ℕ in (range (Q.nat_degree + 1)).eraseₓ 0, Q.coeff x • B.gen ^ x) *
          B.gen ^ n :=
      _
    _ =
        (Q.coeff 0 • B.gen ^ 0 +
            ∑ x : ℕ in (range (Q.nat_degree + 1)).eraseₓ 0, Q.coeff x • B.gen ^ x) *
          B.gen ^ n :=
      by rw [pow_zero]
    _ = aeval B.gen Q * B.gen ^ n := _
    _ = _ := by rw [hQ, Algebra.smul_mul_assoc]

  · have :
      ∀ i ∈ (range (Q.nat_degree + 1)).eraseₓ 0,
        Q.coeff i • (B.gen ^ i * B.gen ^ n) = p • Q.coeff i • f (i + n) :=
      by
      intro i hi
      rw [← pow_add, ← (hf _ (aux i hi)).2, ← Algebra.smul_def, smul_smul, mul_comm _ p, smul_smul]
    simp only [add_mul, smul_mul_assoc, one_mul, sum_mul, sum_congr rfl this]
  · rw [aeval_eq_sum_range,
      Finset.add_sum_erase (range (Q.nat_degree + 1)) fun i => Q.coeff i • B.gen ^ i]
    simp
#align dvd_coeff_zero_of_aeval_eq_prime_smul_of_minpoly_is_eiseinstein_at dvd_coeff_zero_of_aeval_eq_prime_smul_of_minpoly_is_eiseinstein_at

theorem mem_adjoin_of_dvd_coeff_of_dvd_aeval {A B : Type _} [CommSemiring A] [CommRing B]
    [Algebra A B] [NoZeroSMulDivisors A B] {Q : A[X]} {p : A} {x z : B} (hp : p ≠ 0)
    (hQ : ∀ i ∈ range (Q.natDegree + 1), p ∣ Q.coeff i) (hz : aeval x Q = p • z) :
    z ∈ adjoin A ({x} : Set B) := by
  choose! f hf using hQ
  rw [aeval_eq_sum_range, sum_range] at hz
  conv_lhs at hz =>
    congr
    skip
    ext
    rw [hf i (mem_range.2 (Fin.is_lt i)), ← smul_smul]
  rw [← smul_sum] at hz
  rw [← smul_right_injective _ hp hz]
  exact
    Subalgebra.sum_mem _ fun _ _ =>
      Subalgebra.smul_mem _ (Subalgebra.pow_mem _ (subset_adjoin (Set.mem_singleton _)) _) _
#align mem_adjoin_of_dvd_coeff_of_dvd_aeval mem_adjoin_of_dvd_coeff_of_dvd_aeval

/-- Let `K` be the field of fraction of an integrally closed domain `R` and let `L` be a separable
extension of `K`, generated by an integral power basis `B` such that the minimal polynomial of
`B.gen` is Eisenstein at `p`. Given `z : L` integral over `R`, if `p • z ∈ adjoin R {B.gen}`, then
`z ∈ adjoin R {B.gen}`. -/
theorem mem_adjoin_of_smul_prime_smul_of_minpoly_is_eiseinstein_at {B : PowerBasis K L}
    (hp : Prime p) (hBint : IsIntegral R B.gen) {z : L} (hzint : IsIntegral R z)
    (hz : p • z ∈ adjoin R ({B.gen} : Set L)) (hei : (minpoly R B.gen).IsEisensteinAt 𝓟) :
    z ∈ adjoin R ({B.gen} : Set L) :=
  by
  -- First define some abbreviations.
  have hndiv : ¬p ^ 2 ∣ (minpoly R B.gen).coeff 0 := fun h =>
    hei.not_mem ((span_singleton_pow p 2).symm ▸ Ideal.mem_span_singleton.2 h)
  letI := FiniteDimensional B
  set P := minpoly R B.gen with hP
  obtain ⟨n, hn⟩ := Nat.exists_eq_succ_of_ne_zero B.dim_pos.ne'
  haveI : NoZeroSMulDivisors R L := NoZeroSMulDivisors.trans R K L
  let P₁ := P.map (algebraMap R L)
  -- There is a polynomial `Q` such that `p • z = aeval B.gen Q`. We can assume that
  -- `Q.degree < P.degree` and `Q ≠ 0`.
  rw [adjoin_singleton_eq_range_aeval] at hz
  obtain ⟨Q₁, hQ⟩ := hz
  set Q := Q₁ %ₘ P with hQ₁
  replace hQ : aeval B.gen Q = p • z
  · rw [← mod_by_monic_add_div Q₁ (minpoly.monic hBint)] at hQ
    simpa using hQ
  by_cases hQzero : Q = 0
  · simp only [hQzero, Algebra.smul_def, zero_eq_mul, aeval_zero] at hQ
    cases' hQ with H H₁
    · have : Function.Injective (algebraMap R L) :=
        by
        rw [algebra_map_eq R K L]
        exact (algebraMap K L).Injective.comp (IsFractionRing.injective R K)
      exfalso
      exact hp.ne_zero ((injective_iff_map_eq_zero _).1 this _ H)
    · rw [H₁]
      exact Subalgebra.zero_mem _
  -- It is enough to prove that all coefficients of `Q` are divisible by `p`, by induction.
  -- The base case is `dvd_coeff_zero_of_aeval_eq_prime_smul_of_minpoly_is_eiseinstein_at`.
  refine' mem_adjoin_of_dvd_coeff_of_dvd_aeval hp.ne_zero (fun i => _) hQ
  refine' Nat.case_strong_induction_on i _ fun j hind => _
  · intro H
    exact dvd_coeff_zero_of_aeval_eq_prime_smul_of_minpoly_is_eiseinstein_at hp hBint hQ hzint hei
  · intro hj
    refine' hp.dvd_of_pow_dvd_pow_mul_pow_of_square_not_dvd _ hndiv
    exact n
    -- Two technical results we will need about `P.nat_degree` and `Q.nat_degree`.
    have H := degree_mod_by_monic_lt Q₁ (minpoly.monic hBint)
    rw [← hQ₁, ← hP] at H
    replace H :=
      Nat.lt_iff_add_one_le.1
        (lt_of_lt_of_le
          (lt_of_le_of_lt (Nat.lt_iff_add_one_le.1 (Nat.lt_of_succ_lt_succ (mem_range.1 hj)))
            (lt_succ_self _))
          (Nat.lt_iff_add_one_le.1 ((nat_degree_lt_nat_degree_iff hQzero).2 H)))
    rw [add_assoc] at H
    have Hj : Q.nat_degree + 1 = j + 1 + (Q.nat_degree - j) := by
      rw [← add_comm 1, ← add_comm 1, add_assoc, add_right_inj, ←
        Nat.add_sub_assoc (Nat.lt_of_succ_lt_succ (mem_range.1 hj)).le, add_comm,
        Nat.add_sub_cancel]
    -- By induction hypothesis we can find `g : ℕ → R` such that
    -- `k ∈ range (j + 1) → Q.coeff k • B.gen ^ k = (algebra_map R L) p * g k • B.gen ^ k`-
    choose! g hg using hind
    replace hg : ∀ k ∈ range (j + 1), Q.coeff k • B.gen ^ k = algebraMap R L p * g k • B.gen ^ k
    · intro k hk
      rw [hg k (mem_range_succ_iff.1 hk)
          (mem_range_succ_iff.2
            (le_trans (mem_range_succ_iff.1 hk) (succ_le_iff.1 (mem_range_succ_iff.1 hj)).le)),
        Algebra.smul_def, Algebra.smul_def, RingHom.map_mul, mul_assoc]
    -- Since `minpoly R B.gen` is Eiseinstein, we can find `f : ℕ → L` such that
    -- `(map (algebra_map R L) (minpoly R B.gen)).nat_degree ≤ i` implies `f i ∈ adjoin R {B.gen}`
    -- and `(algebra_map R L) p * f i = B.gen ^ i`. We will also need `hf₁`, a reformulation of this
    -- property.
    choose! f hf using
      is_weakly_eisenstein_at.exists_mem_adjoin_mul_eq_pow_nat_degree_le (minpoly.aeval R B.gen)
        (minpoly.monic hBint) hei.is_weakly_eisenstein_at
    have hf₁ :
      ∀ k ∈ (range (Q.nat_degree - j)).eraseₓ 0,
        Q.coeff (j + 1 + k) • B.gen ^ (j + 1 + k) * B.gen ^ (P.nat_degree - (j + 2)) =
          (algebraMap R L) p * Q.coeff (j + 1 + k) • f (k + P.nat_degree - 1) :=
      by
      intro k hk
      rw [smul_mul_assoc, ← pow_add, ← Nat.add_sub_assoc H, ← add_assoc j 1 1, add_comm (j + 1) 1,
        add_assoc (j + 1), add_comm _ (k + P.nat_degree), Nat.add_sub_add_right, ←
        (hf (k + P.nat_degree - 1) _).2, mul_smul_comm]
      rw [(minpoly.monic hBint).natDegree_map, add_comm, Nat.add_sub_assoc, le_add_iff_nonneg_right]
      · exact Nat.zero_le _
      · refine' one_le_iff_ne_zero.2 fun h => _
        rw [h] at hk
        simpa using hk
      · infer_instance
    -- The Eisenstein condition shows that `p` divides `Q.coeff j`
    -- if `p^n.succ` divides the following multiple of `Q.coeff (succ j)^n.succ`:
    suffices
      p ^ n.succ ∣
        Q.coeff (succ j) ^ n.succ * (minpoly R B.gen).coeff 0 ^ (succ j + (P.nat_degree - (j + 2)))
      by
      convert this
      rw [Nat.succ_eq_add_one, add_assoc, ← Nat.add_sub_assoc H, ← add_assoc, add_comm (j + 1),
        Nat.add_sub_add_left, ← Nat.add_sub_assoc, Nat.add_sub_add_left, hP, ←
        (minpoly.monic hBint).natDegree_map (algebraMap R K), ←
        minpoly.isIntegrallyClosed_eq_field_fractions' K hBint, nat_degree_minpoly, hn, Nat.sub_one,
        Nat.pred_succ]
      linarith
    -- Using `hQ : aeval B.gen Q = p • z`, we write `p • z` as a sum of terms of degree less than
    -- `j+1`, that are multiples of `p` by induction, and terms of degree at least `j+1`.
    rw [aeval_eq_sum_range, Hj, range_add, sum_union (disjoint_range_add_left_embedding _ _),
      sum_congr rfl hg, add_comm] at hQ
    -- We multiply this equality by `B.gen ^ (P.nat_degree-(j+2))`, so we can use `hf₁` on the terms
    -- we didn't know were multiples of `p`, and we take the norm on both sides.
    replace hQ := congr_arg (fun x => x * B.gen ^ (P.nat_degree - (j + 2))) hQ
    simp_rw [sum_map, addLeftEmbedding_apply, add_mul, sum_mul, mul_assoc] at hQ
    rw [←
      insert_erase (mem_range.2 (tsub_pos_iff_lt.2 <| Nat.lt_of_succ_lt_succ <| mem_range.1 hj)),
      sum_insert (not_mem_erase 0 _), add_zero, sum_congr rfl hf₁, ← mul_sum, ← mul_sum, add_assoc,
      ← mul_add, smul_mul_assoc, ← pow_add, Algebra.smul_def] at hQ
    replace hQ := congr_arg (norm K) (eq_sub_of_add_eq hQ)
    -- We obtain an equality of elements of `K`, but everything is integral, so we can move to `R`
    -- and simplify `hQ`.
    have hintsum :
      IsIntegral R
        (z * B.gen ^ (P.nat_degree - (j + 2)) -
          ((∑ x : ℕ in (range (Q.nat_degree - j)).eraseₓ 0,
              Q.coeff (j + 1 + x) • f (x + P.nat_degree - 1)) +
            ∑ x : ℕ in range (j + 1), g x • B.gen ^ x * B.gen ^ (P.nat_degree - (j + 2)))) :=
      by
      refine'
        isIntegral_sub (isIntegral_mul hzint (IsIntegral.pow hBint _))
          (isIntegral_add (IsIntegral.sum _ fun k hk => isIntegral_smul _ _)
            (IsIntegral.sum _ fun k hk =>
              isIntegral_mul (isIntegral_smul _ (IsIntegral.pow hBint _)) (IsIntegral.pow hBint _)))
      refine' adjoin_le_integralClosure hBint (hf _ _).1
      rw [(minpoly.monic hBint).natDegree_map (algebraMap R L)]
      rw [add_comm, Nat.add_sub_assoc, le_add_iff_nonneg_right]
      · exact zero_le _
      · refine' one_le_iff_ne_zero.2 fun h => _
        rw [h] at hk
        simpa using hk
    obtain ⟨r, hr⟩ := is_integral_iff.1 (is_integral_norm K hintsum)
    rw [Algebra.smul_def, mul_assoc, ← mul_sub, _root_.map_mul, algebra_map_apply R K L, map_pow,
      Algebra.norm_algebraMap, _root_.map_mul, algebra_map_apply R K L, Algebra.norm_algebraMap,
      finrank B, ← hr, power_basis.norm_gen_eq_coeff_zero_minpoly,
      minpoly.isIntegrallyClosed_eq_field_fractions' K hBint, coeff_map,
      show (-1 : K) = algebraMap R K (-1) by simp, ← map_pow, ← map_pow, ← _root_.map_mul, ←
      map_pow, ← _root_.map_mul, ← map_pow, ← _root_.map_mul] at hQ
    -- We can now finish the proof.
    have hppdiv : p ^ B.dim ∣ p ^ B.dim * r := dvd_mul_of_dvd_left dvd_rfl _
    rwa [← IsFractionRing.injective R K hQ, mul_comm, ← Units.coe_neg_one, mul_pow, ←
      Units.val_pow_eq_pow_val, ← Units.val_pow_eq_pow_val, mul_assoc,
      IsUnit.dvd_mul_left _ _ _ ⟨_, rfl⟩, mul_comm, ← Nat.succ_eq_add_one, hn] at hppdiv
#align mem_adjoin_of_smul_prime_smul_of_minpoly_is_eiseinstein_at mem_adjoin_of_smul_prime_smul_of_minpoly_is_eiseinstein_at

/-- Let `K` be the field of fraction of an integrally closed domain `R` and let `L` be a separable
extension of `K`, generated by an integral power basis `B` such that the minimal polynomial of
`B.gen` is Eisenstein at `p`. Given `z : L` integral over `R`, if `p ^ n • z ∈ adjoin R {B.gen}`,
then `z ∈ adjoin R {B.gen}`. Together with `algebra.discr_mul_is_integral_mem_adjoin` this result
often allows to compute the ring of integers of `L`. -/
theorem mem_adjoin_of_smul_prime_pow_smul_of_minpoly_is_eiseinstein_at {B : PowerBasis K L}
    (hp : Prime p) (hBint : IsIntegral R B.gen) {n : ℕ} {z : L} (hzint : IsIntegral R z)
    (hz : p ^ n • z ∈ adjoin R ({B.gen} : Set L)) (hei : (minpoly R B.gen).IsEisensteinAt 𝓟) :
    z ∈ adjoin R ({B.gen} : Set L) := by
  induction' n with n hn
  · simpa using hz
  · rw [pow_succ, mul_smul] at hz
    exact
      hn
        (mem_adjoin_of_smul_prime_smul_of_minpoly_is_eiseinstein_at hp hBint
          (isIntegral_smul _ hzint) hz hei)
#align mem_adjoin_of_smul_prime_pow_smul_of_minpoly_is_eiseinstein_at mem_adjoin_of_smul_prime_pow_smul_of_minpoly_is_eiseinstein_at

end IsIntegral


/-
Copyright (c) 2022 Heather Macbeth. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Heather Macbeth

! This file was ported from Lean 3 source module order.complete_lattice_intervals
! leanprover-community/mathlib commit 207cfac9fcd06138865b5d04f7091e46d9320432
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Order.ConditionallyCompleteLattice.Basic
import Mathlib.Data.Set.Intervals.OrdConnected

/-! # Subtypes of conditionally complete linear orders

In this file we give conditions on a subset of a conditionally complete linear order, to ensure that
the subtype is itself conditionally complete.

We check that an `OrdConnected` set satisfies these conditions.

## TODO

Add appropriate instances for all `Set.Ixx`. This requires a refactor that will allow different
default values for `supₛ` and `infₛ`.
-/

open Classical

open Set

variable {α : Type _} (s : Set α)

section SupSet

variable [SupSet α]

/-- `SupSet` structure on a nonempty subset `s` of an object with `SupSet`. This definition is
non-canonical (it uses `default s`); it should be used only as here, as an auxiliary instance in the
construction of the `ConditionallyCompleteLinearOrder` structure. -/
noncomputable def subsetSupSet [Inhabited s] : SupSet s where
  supₛ t :=
    if ht : supₛ ((↑) '' t : Set α) ∈ s
    then ⟨supₛ ((↑) '' t : Set α), ht⟩
    else default
#align subset_has_Sup subsetSupSet

attribute [local instance] subsetSupSet

@[simp]
theorem subset_supₛ_def [Inhabited s] :
    @supₛ s _ = fun t =>
      if ht : supₛ ((↑) '' t : Set α) ∈ s
      then ⟨supₛ ((↑) '' t : Set α), ht⟩
      else default :=
  rfl
#align subset_Sup_def subset_supₛ_def

theorem subset_supₛ_of_within [Inhabited s] {t : Set s} (h : supₛ ((↑) '' t : Set α) ∈ s) :
    supₛ ((↑) '' t : Set α) = (@supₛ s _ t : α) := by simp [dif_pos h]
#align subset_Sup_of_within subset_supₛ_of_within

end SupSet

section InfSet

variable [InfSet α]

/-- `InfSet` structure on a nonempty subset `s` of an object with `InfSet`. This definition is
non-canonical (it uses `default s`); it should be used only as here, as an auxiliary instance in the
construction of the `ConditionallyCompleteLinearOrder` structure. -/
noncomputable def subsetInfSet [Inhabited s] : InfSet s where
  infₛ t :=
    if ht : infₛ ((↑) '' t : Set α) ∈ s
    then ⟨infₛ ((↑) '' t : Set α), ht⟩
    else default
#align subset_has_Inf subsetInfSet

attribute [local instance] subsetInfSet

@[simp]
theorem subset_infₛ_def [Inhabited s] :
    @infₛ s _ = fun t =>
      if ht : infₛ ((↑) '' t : Set α) ∈ s
      then ⟨infₛ ((↑) '' t : Set α), ht⟩ else
      default :=
  rfl
#align subset_Inf_def subset_infₛ_def

theorem subset_infₛ_of_within [Inhabited s] {t : Set s} (h : infₛ ((↑) '' t : Set α) ∈ s) :
    infₛ ((↑) '' t : Set α) = (@infₛ s _ t : α) := by simp [dif_pos h]
#align subset_Inf_of_within subset_infₛ_of_within

end InfSet

variable [ConditionallyCompleteLinearOrder α]

attribute [local instance] subsetSupSet

attribute [local instance] subsetInfSet

/-- For a nonempty subset of a conditionally complete linear order to be a conditionally complete
linear order, it suffices that it contain the `supₛ` of all its nonempty bounded-above subsets, and
the `infₛ` of all its nonempty bounded-below subsets.
See note [reducible non-instances]. -/
@[reducible]
noncomputable def subsetConditionallyCompleteLinearOrder [Inhabited s]
    (h_Sup : ∀ {t : Set s} (_ : t.Nonempty) (_h_bdd : BddAbove t), supₛ ((↑) '' t : Set α) ∈ s)
    (h_Inf : ∀ {t : Set s} (_ : t.Nonempty) (_h_bdd : BddBelow t), infₛ ((↑) '' t : Set α) ∈ s) :
    ConditionallyCompleteLinearOrder s :=
  { -- The following would be a more natural way to finish, but gives a "deep recursion" error:
      -- simpa [subset_Sup_of_within (h_Sup t)] using
      --   (strict_mono_coe s).monotone.le_cSup_image hct h_bdd,
    subsetSupSet s, subsetInfSet s, DistribLattice.toLattice, (inferInstance : LinearOrder s) with
    le_csupₛ := by
      rintro t c h_bdd hct
      rw [← Subtype.coe_le_coe, ← subset_supₛ_of_within s (h_Sup ⟨c, hct⟩ h_bdd)]
      exact (Subtype.mono_coe _).le_csupₛ_image hct h_bdd
    csupₛ_le := by
      rintro t B ht hB
      rw [← Subtype.coe_le_coe, ← subset_supₛ_of_within s (h_Sup ht ⟨B, hB⟩)]
      exact (Subtype.mono_coe s).csupₛ_image_le ht hB
    le_cinfₛ := by
      intro t B ht hB
      rw [← Subtype.coe_le_coe, ← subset_infₛ_of_within s (h_Inf ht ⟨B, hB⟩)]
      exact (Subtype.mono_coe s).le_cinfₛ_image ht hB
    cinfₛ_le := by
      rintro t c h_bdd hct
      rw [← Subtype.coe_le_coe, ← subset_infₛ_of_within s (h_Inf ⟨c, hct⟩ h_bdd)]
      exact (Subtype.mono_coe s).cinfₛ_image_le hct h_bdd }
#align subset_conditionally_complete_linear_order subsetConditionallyCompleteLinearOrder

section OrdConnected

/-- The `supₛ` function on a nonempty `OrdConnected` set `s` in a conditionally complete linear
order takes values within `s`, for all nonempty bounded-above subsets of `s`. -/
theorem supₛ_within_of_ordConnected {s : Set α} [hs : OrdConnected s] ⦃t : Set s⦄ (ht : t.Nonempty)
    (h_bdd : BddAbove t) : supₛ ((↑) '' t : Set α) ∈ s := by
  obtain ⟨c, hct⟩ : ∃ c, c ∈ t := ht
  obtain ⟨B, hB⟩ : ∃ B, B ∈ upperBounds t := h_bdd
  refine' hs.out c.2 B.2 ⟨_, _⟩
  · exact (Subtype.mono_coe s).le_csupₛ_image hct ⟨B, hB⟩
  · exact (Subtype.mono_coe s).csupₛ_image_le ⟨c, hct⟩ hB
#align Sup_within_of_ord_connected supₛ_within_of_ordConnected

/-- The `infₛ` function on a nonempty `OrdConnected` set `s` in a conditionally complete linear
order takes values within `s`, for all nonempty bounded-below subsets of `s`. -/
theorem infₛ_within_of_ordConnected {s : Set α} [hs : OrdConnected s] ⦃t : Set s⦄ (ht : t.Nonempty)
    (h_bdd : BddBelow t) : infₛ ((↑) '' t : Set α) ∈ s := by
  obtain ⟨c, hct⟩ : ∃ c, c ∈ t := ht
  obtain ⟨B, hB⟩ : ∃ B, B ∈ lowerBounds t := h_bdd
  refine' hs.out B.2 c.2 ⟨_, _⟩
  · exact (Subtype.mono_coe s).le_cinfₛ_image ⟨c, hct⟩ hB
  · exact (Subtype.mono_coe s).cinfₛ_image_le hct ⟨B, hB⟩
#align Inf_within_of_ord_connected infₛ_within_of_ordConnected

/-- A nonempty `OrdConnected` set in a conditionally complete linear order is naturally a
conditionally complete linear order. -/
noncomputable instance ordConnectedSubsetConditionallyCompleteLinearOrder [Inhabited s]
    [OrdConnected s] : ConditionallyCompleteLinearOrder s :=
  subsetConditionallyCompleteLinearOrder s
    (fun h => supₛ_within_of_ordConnected h)
    (fun h => infₛ_within_of_ordConnected h)
#align ord_connected_subset_conditionally_complete_linear_order ordConnectedSubsetConditionallyCompleteLinearOrder

end OrdConnected


/-
Copyright (c) 2020 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Alexander Bentkamp, Yury Kudryashov

! This file was ported from Lean 3 source module analysis.convex.topology
! leanprover-community/mathlib commit 0e3aacdc98d25e0afe035c452d876d28cbffaa7e
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.Convex.Combination
import Mathbin.Analysis.Convex.Strict
import Mathbin.Topology.PathConnected
import Mathbin.Topology.Algebra.Affine
import Mathbin.Topology.Algebra.Module.Basic

/-!
# Topological properties of convex sets

We prove the following facts:

* `convex.interior` : interior of a convex set is convex;
* `convex.closure` : closure of a convex set is convex;
* `set.finite.compact_convex_hull` : convex hull of a finite set is compact;
* `set.finite.is_closed_convex_hull` : convex hull of a finite set is closed.
-/

assert_not_exists Norm

open Metric Set

open Pointwise Convex

variable {ι 𝕜 E : Type _}

theorem Real.convex_iff_isPreconnected {s : Set ℝ} : Convex ℝ s ↔ IsPreconnected s :=
  convex_iff_ordConnected.trans isPreconnected_iff_ordConnected.symm
#align real.convex_iff_is_preconnected Real.convex_iff_isPreconnected

alias Real.convex_iff_isPreconnected ↔ _ IsPreconnected.convex
#align is_preconnected.convex IsPreconnected.convex

/-! ### Standard simplex -/

section stdSimplex

variable [Fintype ι]

/-- Every vector in `std_simplex 𝕜 ι` has `max`-norm at most `1`. -/
theorem stdSimplex_subset_closedBall : stdSimplex ℝ ι ⊆ Metric.closedBall 0 1 :=
  by
  intro f hf
  rw [Metric.mem_closedBall, dist_pi_le_iff zero_le_one]
  intro x
  rw [Pi.zero_apply, Real.dist_0_eq_abs, abs_of_nonneg <| hf.1 x]
  exact (mem_Icc_of_mem_stdSimplex hf x).2
#align std_simplex_subset_closed_ball stdSimplex_subset_closedBall

variable (ι)

/-- `std_simplex ℝ ι` is bounded. -/
theorem bounded_stdSimplex : Metric.Bounded (stdSimplex ℝ ι) :=
  (Metric.bounded_iff_subset_ball 0).2 ⟨1, stdSimplex_subset_closedBall⟩
#align bounded_std_simplex bounded_stdSimplex

/-- `std_simplex ℝ ι` is closed. -/
theorem isClosed_stdSimplex : IsClosed (stdSimplex ℝ ι) :=
  (stdSimplex_eq_inter ℝ ι).symm ▸
    IsClosed.inter (isClosed_interᵢ fun i => isClosed_le continuous_const (continuous_apply i))
      (isClosed_eq (continuous_finset_sum _ fun x _ => continuous_apply x) continuous_const)
#align is_closed_std_simplex isClosed_stdSimplex

/-- `std_simplex ℝ ι` is compact. -/
theorem isCompact_stdSimplex : IsCompact (stdSimplex ℝ ι) :=
  Metric.isCompact_iff_isClosed_bounded.2 ⟨isClosed_stdSimplex ι, bounded_stdSimplex ι⟩
#align is_compact_std_simplex isCompact_stdSimplex

end stdSimplex

/-! ### Topological vector space -/

section TopologicalSpace

variable [LinearOrderedRing 𝕜] [DenselyOrdered 𝕜] [TopologicalSpace 𝕜] [OrderTopology 𝕜]
  [AddCommGroup E] [TopologicalSpace E] [ContinuousAdd E] [Module 𝕜 E] [ContinuousSMul 𝕜 E]
  {x y : E}

theorem segment_subset_closure_openSegment : [x -[𝕜] y] ⊆ closure (openSegment 𝕜 x y) :=
  by
  rw [segment_eq_image, openSegment_eq_image, ← closure_Ioo (zero_ne_one' 𝕜)]
  exact image_closure_subset_closure_image (by continuity)
#align segment_subset_closure_open_segment segment_subset_closure_openSegment

end TopologicalSpace

section PseudoMetricSpace

variable [LinearOrderedRing 𝕜] [DenselyOrdered 𝕜] [PseudoMetricSpace 𝕜] [OrderTopology 𝕜]
  [ProperSpace 𝕜] [CompactIccSpace 𝕜] [AddCommGroup E] [TopologicalSpace E] [T2Space E]
  [ContinuousAdd E] [Module 𝕜 E] [ContinuousSMul 𝕜 E]

@[simp]
theorem closure_openSegment (x y : E) : closure (openSegment 𝕜 x y) = [x -[𝕜] y] :=
  by
  rw [segment_eq_image, openSegment_eq_image, ← closure_Ioo (zero_ne_one' 𝕜)]
  exact
    (image_closure_of_isCompact (bounded_Ioo _ _).isCompact_closure <|
        Continuous.continuousOn <| by continuity).symm
#align closure_open_segment closure_openSegment

end PseudoMetricSpace

section ContinuousConstSMul

variable [LinearOrderedField 𝕜] [AddCommGroup E] [Module 𝕜 E] [TopologicalSpace E]
  [TopologicalAddGroup E] [ContinuousConstSMul 𝕜 E]

/-- If `s` is a convex set, then `a • interior s + b • closure s ⊆ interior s` for all `0 < a`,
`0 ≤ b`, `a + b = 1`. See also `convex.combo_interior_self_subset_interior` for a weaker version. -/
theorem Convex.combo_interior_closure_subset_interior {s : Set E} (hs : Convex 𝕜 s) {a b : 𝕜}
    (ha : 0 < a) (hb : 0 ≤ b) (hab : a + b = 1) : a • interior s + b • closure s ⊆ interior s :=
  interior_smul₀ ha.ne' s ▸
    calc
      interior (a • s) + b • closure s ⊆ interior (a • s) + closure (b • s) :=
        add_subset_add Subset.rfl (smul_closure_subset b s)
      _ = interior (a • s) + b • s := by rw [is_open_interior.add_closure (b • s)]
      _ ⊆ interior (a • s + b • s) := subset_interior_add_left
      _ ⊆ interior s := interior_mono <| hs.set_combo_subset ha.le hb hab

#align convex.combo_interior_closure_subset_interior Convex.combo_interior_closure_subset_interior

/-- If `s` is a convex set, then `a • interior s + b • s ⊆ interior s` for all `0 < a`, `0 ≤ b`,
`a + b = 1`. See also `convex.combo_interior_closure_subset_interior` for a stronger version. -/
theorem Convex.combo_interior_self_subset_interior {s : Set E} (hs : Convex 𝕜 s) {a b : 𝕜}
    (ha : 0 < a) (hb : 0 ≤ b) (hab : a + b = 1) : a • interior s + b • s ⊆ interior s :=
  calc
    a • interior s + b • s ⊆ a • interior s + b • closure s :=
      add_subset_add Subset.rfl <| image_subset _ subset_closure
    _ ⊆ interior s := hs.combo_interior_closure_subset_interior ha hb hab

#align convex.combo_interior_self_subset_interior Convex.combo_interior_self_subset_interior

/-- If `s` is a convex set, then `a • closure s + b • interior s ⊆ interior s` for all `0 ≤ a`,
`0 < b`, `a + b = 1`. See also `convex.combo_self_interior_subset_interior` for a weaker version. -/
theorem Convex.combo_closure_interior_subset_interior {s : Set E} (hs : Convex 𝕜 s) {a b : 𝕜}
    (ha : 0 ≤ a) (hb : 0 < b) (hab : a + b = 1) : a • closure s + b • interior s ⊆ interior s :=
  by
  rw [add_comm]
  exact hs.combo_interior_closure_subset_interior hb ha (add_comm a b ▸ hab)
#align convex.combo_closure_interior_subset_interior Convex.combo_closure_interior_subset_interior

/-- If `s` is a convex set, then `a • s + b • interior s ⊆ interior s` for all `0 ≤ a`, `0 < b`,
`a + b = 1`. See also `convex.combo_closure_interior_subset_interior` for a stronger version. -/
theorem Convex.combo_self_interior_subset_interior {s : Set E} (hs : Convex 𝕜 s) {a b : 𝕜}
    (ha : 0 ≤ a) (hb : 0 < b) (hab : a + b = 1) : a • s + b • interior s ⊆ interior s :=
  by
  rw [add_comm]
  exact hs.combo_interior_self_subset_interior hb ha (add_comm a b ▸ hab)
#align convex.combo_self_interior_subset_interior Convex.combo_self_interior_subset_interior

theorem Convex.combo_interior_closure_mem_interior {s : Set E} (hs : Convex 𝕜 s) {x y : E}
    (hx : x ∈ interior s) (hy : y ∈ closure s) {a b : 𝕜} (ha : 0 < a) (hb : 0 ≤ b)
    (hab : a + b = 1) : a • x + b • y ∈ interior s :=
  hs.combo_interior_closure_subset_interior ha hb hab <|
    add_mem_add (smul_mem_smul_set hx) (smul_mem_smul_set hy)
#align convex.combo_interior_closure_mem_interior Convex.combo_interior_closure_mem_interior

theorem Convex.combo_interior_self_mem_interior {s : Set E} (hs : Convex 𝕜 s) {x y : E}
    (hx : x ∈ interior s) (hy : y ∈ s) {a b : 𝕜} (ha : 0 < a) (hb : 0 ≤ b) (hab : a + b = 1) :
    a • x + b • y ∈ interior s :=
  hs.combo_interior_closure_mem_interior hx (subset_closure hy) ha hb hab
#align convex.combo_interior_self_mem_interior Convex.combo_interior_self_mem_interior

theorem Convex.combo_closure_interior_mem_interior {s : Set E} (hs : Convex 𝕜 s) {x y : E}
    (hx : x ∈ closure s) (hy : y ∈ interior s) {a b : 𝕜} (ha : 0 ≤ a) (hb : 0 < b)
    (hab : a + b = 1) : a • x + b • y ∈ interior s :=
  hs.combo_closure_interior_subset_interior ha hb hab <|
    add_mem_add (smul_mem_smul_set hx) (smul_mem_smul_set hy)
#align convex.combo_closure_interior_mem_interior Convex.combo_closure_interior_mem_interior

theorem Convex.combo_self_interior_mem_interior {s : Set E} (hs : Convex 𝕜 s) {x y : E} (hx : x ∈ s)
    (hy : y ∈ interior s) {a b : 𝕜} (ha : 0 ≤ a) (hb : 0 < b) (hab : a + b = 1) :
    a • x + b • y ∈ interior s :=
  hs.combo_closure_interior_mem_interior (subset_closure hx) hy ha hb hab
#align convex.combo_self_interior_mem_interior Convex.combo_self_interior_mem_interior

theorem Convex.openSegment_interior_closure_subset_interior {s : Set E} (hs : Convex 𝕜 s) {x y : E}
    (hx : x ∈ interior s) (hy : y ∈ closure s) : openSegment 𝕜 x y ⊆ interior s :=
  by
  rintro _ ⟨a, b, ha, hb, hab, rfl⟩
  exact hs.combo_interior_closure_mem_interior hx hy ha hb.le hab
#align convex.open_segment_interior_closure_subset_interior Convex.openSegment_interior_closure_subset_interior

theorem Convex.openSegment_interior_self_subset_interior {s : Set E} (hs : Convex 𝕜 s) {x y : E}
    (hx : x ∈ interior s) (hy : y ∈ s) : openSegment 𝕜 x y ⊆ interior s :=
  hs.openSegment_interior_closure_subset_interior hx (subset_closure hy)
#align convex.open_segment_interior_self_subset_interior Convex.openSegment_interior_self_subset_interior

theorem Convex.openSegment_closure_interior_subset_interior {s : Set E} (hs : Convex 𝕜 s) {x y : E}
    (hx : x ∈ closure s) (hy : y ∈ interior s) : openSegment 𝕜 x y ⊆ interior s :=
  by
  rintro _ ⟨a, b, ha, hb, hab, rfl⟩
  exact hs.combo_closure_interior_mem_interior hx hy ha.le hb hab
#align convex.open_segment_closure_interior_subset_interior Convex.openSegment_closure_interior_subset_interior

theorem Convex.openSegment_self_interior_subset_interior {s : Set E} (hs : Convex 𝕜 s) {x y : E}
    (hx : x ∈ s) (hy : y ∈ interior s) : openSegment 𝕜 x y ⊆ interior s :=
  hs.openSegment_closure_interior_subset_interior (subset_closure hx) hy
#align convex.open_segment_self_interior_subset_interior Convex.openSegment_self_interior_subset_interior

/-- If `x ∈ closure s` and `y ∈ interior s`, then the segment `(x, y]` is included in `interior s`.
-/
theorem Convex.add_smul_sub_mem_interior' {s : Set E} (hs : Convex 𝕜 s) {x y : E}
    (hx : x ∈ closure s) (hy : y ∈ interior s) {t : 𝕜} (ht : t ∈ Ioc (0 : 𝕜) 1) :
    x + t • (y - x) ∈ interior s := by
  simpa only [sub_smul, smul_sub, one_smul, add_sub, add_comm] using
    hs.combo_interior_closure_mem_interior hy hx ht.1 (sub_nonneg.mpr ht.2)
      (add_sub_cancel'_right _ _)
#align convex.add_smul_sub_mem_interior' Convex.add_smul_sub_mem_interior'

/-- If `x ∈ s` and `y ∈ interior s`, then the segment `(x, y]` is included in `interior s`. -/
theorem Convex.add_smul_sub_mem_interior {s : Set E} (hs : Convex 𝕜 s) {x y : E} (hx : x ∈ s)
    (hy : y ∈ interior s) {t : 𝕜} (ht : t ∈ Ioc (0 : 𝕜) 1) : x + t • (y - x) ∈ interior s :=
  hs.add_smul_sub_mem_interior' (subset_closure hx) hy ht
#align convex.add_smul_sub_mem_interior Convex.add_smul_sub_mem_interior

/-- If `x ∈ closure s` and `x + y ∈ interior s`, then `x + t y ∈ interior s` for `t ∈ (0, 1]`. -/
theorem Convex.add_smul_mem_interior' {s : Set E} (hs : Convex 𝕜 s) {x y : E} (hx : x ∈ closure s)
    (hy : x + y ∈ interior s) {t : 𝕜} (ht : t ∈ Ioc (0 : 𝕜) 1) : x + t • y ∈ interior s := by
  simpa only [add_sub_cancel'] using hs.add_smul_sub_mem_interior' hx hy ht
#align convex.add_smul_mem_interior' Convex.add_smul_mem_interior'

/-- If `x ∈ s` and `x + y ∈ interior s`, then `x + t y ∈ interior s` for `t ∈ (0, 1]`. -/
theorem Convex.add_smul_mem_interior {s : Set E} (hs : Convex 𝕜 s) {x y : E} (hx : x ∈ s)
    (hy : x + y ∈ interior s) {t : 𝕜} (ht : t ∈ Ioc (0 : 𝕜) 1) : x + t • y ∈ interior s :=
  hs.add_smul_mem_interior' (subset_closure hx) hy ht
#align convex.add_smul_mem_interior Convex.add_smul_mem_interior

/-- In a topological vector space, the interior of a convex set is convex. -/
protected theorem Convex.interior {s : Set E} (hs : Convex 𝕜 s) : Convex 𝕜 (interior s) :=
  convex_iff_openSegment_subset.mpr fun x hx y hy =>
    hs.openSegment_closure_interior_subset_interior (interior_subset_closure hx) hy
#align convex.interior Convex.interior

/-- In a topological vector space, the closure of a convex set is convex. -/
protected theorem Convex.closure {s : Set E} (hs : Convex 𝕜 s) : Convex 𝕜 (closure s) :=
  fun x hx y hy a b ha hb hab =>
  let f : E → E → E := fun x' y' => a • x' + b • y'
  have hf : Continuous (Function.uncurry f) :=
    (continuous_fst.const_smul _).add (continuous_snd.const_smul _)
  show f x y ∈ closure s from map_mem_closure₂ hf hx hy fun x' hx' y' hy' => hs hx' hy' ha hb hab
#align convex.closure Convex.closure

open AffineMap

/-- A convex set `s` is strictly convex provided that for any two distinct points of
`s \ interior s`, the line passing through these points has nonempty intersection with
`interior s`. -/
protected theorem Convex.strict_convex' {s : Set E} (hs : Convex 𝕜 s)
    (h : (s \ interior s).Pairwise fun x y => ∃ c : 𝕜, lineMap x y c ∈ interior s) :
    StrictConvex 𝕜 s := by
  refine' strictConvex_iff_openSegment_subset.2 _
  intro x hx y hy hne
  by_cases hx' : x ∈ interior s; · exact hs.open_segment_interior_self_subset_interior hx' hy
  by_cases hy' : y ∈ interior s; · exact hs.open_segment_self_interior_subset_interior hx hy'
  rcases h ⟨hx, hx'⟩ ⟨hy, hy'⟩ hne with ⟨c, hc⟩
  refine' (openSegment_subset_union x y ⟨c, rfl⟩).trans (insert_subset.2 ⟨hc, union_subset _ _⟩)
  exacts[hs.open_segment_self_interior_subset_interior hx hc,
    hs.open_segment_interior_self_subset_interior hc hy]
#align convex.strict_convex' Convex.strict_convex'

/-- A convex set `s` is strictly convex provided that for any two distinct points `x`, `y` of
`s \ interior s`, the segment with endpoints `x`, `y` has nonempty intersection with
`interior s`. -/
protected theorem Convex.strictConvex {s : Set E} (hs : Convex 𝕜 s)
    (h : (s \ interior s).Pairwise fun x y => ([x -[𝕜] y] \ frontier s).Nonempty) :
    StrictConvex 𝕜 s :=
  by
  refine' hs.strict_convex' <| h.imp_on fun x hx y hy hne => _
  simp only [segment_eq_image_lineMap, ← self_diff_frontier]
  rintro ⟨_, ⟨⟨c, hc, rfl⟩, hcs⟩⟩
  refine' ⟨c, hs.segment_subset hx.1 hy.1 _, hcs⟩
  exact (segment_eq_image_lineMap 𝕜 x y).symm ▸ mem_image_of_mem _ hc
#align convex.strict_convex Convex.strictConvex

end ContinuousConstSMul

section ContinuousSMul

variable [AddCommGroup E] [Module ℝ E] [TopologicalSpace E] [TopologicalAddGroup E]
  [ContinuousSMul ℝ E]

/-- Convex hull of a finite set is compact. -/
theorem Set.Finite.compact_convexHull {s : Set E} (hs : s.Finite) : IsCompact (convexHull ℝ s) :=
  by
  rw [hs.convex_hull_eq_image]
  apply (isCompact_stdSimplex _).image
  haveI := hs.fintype
  apply LinearMap.continuous_on_pi
#align set.finite.compact_convex_hull Set.Finite.compact_convexHull

/-- Convex hull of a finite set is closed. -/
theorem Set.Finite.isClosed_convexHull [T2Space E] {s : Set E} (hs : s.Finite) :
    IsClosed (convexHull ℝ s) :=
  hs.compact_convexHull.IsClosed
#align set.finite.is_closed_convex_hull Set.Finite.isClosed_convexHull

open AffineMap

/-- If we dilate the interior of a convex set about a point in its interior by a scale `t > 1`,
the result includes the closure of the original set.

TODO Generalise this from convex sets to sets that are balanced / star-shaped about `x`. -/
theorem Convex.closure_subset_image_homothety_interior_of_one_lt {s : Set E} (hs : Convex ℝ s)
    {x : E} (hx : x ∈ interior s) (t : ℝ) (ht : 1 < t) : closure s ⊆ homothety x t '' interior s :=
  by
  intro y hy
  have hne : t ≠ 0 := (one_pos.trans ht).ne'
  refine'
    ⟨homothety x t⁻¹ y, hs.open_segment_interior_closure_subset_interior hx hy _,
      (AffineEquiv.homothetyUnitsMulHom x (Units.mk0 t hne)).apply_symm_apply y⟩
  rw [openSegment_eq_image_lineMap, ← inv_one, ← inv_Ioi (zero_lt_one' ℝ), ← image_inv, image_image,
    homothety_eq_line_map]
  exact mem_image_of_mem _ ht
#align convex.closure_subset_image_homothety_interior_of_one_lt Convex.closure_subset_image_homothety_interior_of_one_lt

/-- If we dilate a convex set about a point in its interior by a scale `t > 1`, the interior of
the result includes the closure of the original set.

TODO Generalise this from convex sets to sets that are balanced / star-shaped about `x`. -/
theorem Convex.closure_subset_interior_image_homothety_of_one_lt {s : Set E} (hs : Convex ℝ s)
    {x : E} (hx : x ∈ interior s) (t : ℝ) (ht : 1 < t) :
    closure s ⊆ interior (homothety x t '' s) :=
  (hs.closure_subset_image_homothety_interior_of_one_lt hx t ht).trans <|
    (homothety_isOpenMap x t (one_pos.trans ht).ne').image_interior_subset _
#align convex.closure_subset_interior_image_homothety_of_one_lt Convex.closure_subset_interior_image_homothety_of_one_lt

/-- If we dilate a convex set about a point in its interior by a scale `t > 1`, the interior of
the result includes the closure of the original set.

TODO Generalise this from convex sets to sets that are balanced / star-shaped about `x`. -/
theorem Convex.subset_interior_image_homothety_of_one_lt {s : Set E} (hs : Convex ℝ s) {x : E}
    (hx : x ∈ interior s) (t : ℝ) (ht : 1 < t) : s ⊆ interior (homothety x t '' s) :=
  subset_closure.trans <| hs.closure_subset_interior_image_homothety_of_one_lt hx t ht
#align convex.subset_interior_image_homothety_of_one_lt Convex.subset_interior_image_homothety_of_one_lt

/-- A nonempty convex set is path connected. -/
protected theorem Convex.isPathConnected {s : Set E} (hconv : Convex ℝ s) (hne : s.Nonempty) :
    IsPathConnected s := by
  refine' is_path_connected_iff.mpr ⟨hne, _⟩
  intro x x_in y y_in
  have H := hconv.segment_subset x_in y_in
  rw [segment_eq_image_lineMap] at H
  exact
    JoinedIn.ofLine affine_map.line_map_continuous.continuous_on (line_map_apply_zero _ _)
      (line_map_apply_one _ _) H
#align convex.is_path_connected Convex.isPathConnected

/-- A nonempty convex set is connected. -/
protected theorem Convex.isConnected {s : Set E} (h : Convex ℝ s) (hne : s.Nonempty) :
    IsConnected s :=
  (h.IsPathConnected hne).IsConnected
#align convex.is_connected Convex.isConnected

/-- A convex set is preconnected. -/
protected theorem Convex.isPreconnected {s : Set E} (h : Convex ℝ s) : IsPreconnected s :=
  s.eq_empty_or_nonempty.elim (fun h => h.symm ▸ isPreconnected_empty) fun hne =>
    (h.IsConnected hne).IsPreconnected
#align convex.is_preconnected Convex.isPreconnected

/-- Every topological vector space over ℝ is path connected.

Not an instance, because it creates enormous TC subproblems (turn on `pp.all`).
-/
protected theorem TopologicalAddGroup.path_connected : PathConnectedSpace E :=
  pathConnectedSpace_iff_univ.mpr <| convex_univ.IsPathConnected ⟨(0 : E), trivial⟩
#align topological_add_group.path_connected TopologicalAddGroup.path_connected

end ContinuousSMul


/-
Copyright (c) 2022 Jireh Loreaux. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jireh Loreaux

! This file was ported from Lean 3 source module analysis.normed_space.star.spectrum
! leanprover-community/mathlib commit 1e3201306d4d9eb1fd54c60d7c4510ad5126f6f9
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.NormedSpace.Star.Basic
import Mathbin.Analysis.NormedSpace.Spectrum
import Mathbin.Analysis.NormedSpace.Star.Exponential
import Mathbin.Analysis.SpecialFunctions.Exponential
import Mathbin.Algebra.Star.StarAlgHom

/-! # Spectral properties in C⋆-algebras
In this file, we establish various properties related to the spectrum of elements in C⋆-algebras.
-/

-- mathport name: «expr ⋆»
local postfix:max "⋆" => star

section

open Topology ENNReal

open Filter ENNReal spectrum CstarRing

section UnitarySpectrum

variable {𝕜 : Type _} [NormedField 𝕜] {E : Type _} [NormedRing E] [StarRing E] [CstarRing E]
  [NormedAlgebra 𝕜 E] [CompleteSpace E]

theorem unitary.spectrum_subset_circle (u : unitary E) : spectrum 𝕜 (u : E) ⊆ Metric.sphere 0 1 :=
  by
  nontriviality E
  refine' fun k hk => mem_sphere_zero_iff_norm.mpr (le_antisymm _ _)
  · simpa only [CstarRing.norm_coe_unitary u] using norm_le_norm_of_mem hk
  · rw [← unitary.coe_toUnits_apply u] at hk
    have hnk := ne_zero_of_mem_of_unit hk
    rw [← inv_inv (unitary.toUnits u), ← spectrum.map_inv, Set.mem_inv] at hk
    have : ‖k‖⁻¹ ≤ ‖↑(unitary.toUnits u)⁻¹‖
    simpa only [norm_inv] using norm_le_norm_of_mem hk
    simpa using inv_le_of_inv_le (norm_pos_iff.mpr hnk) this
#align unitary.spectrum_subset_circle unitary.spectrum_subset_circle

theorem spectrum.subset_circle_of_unitary {u : E} (h : u ∈ unitary E) :
    spectrum 𝕜 u ⊆ Metric.sphere 0 1 :=
  unitary.spectrum_subset_circle ⟨u, h⟩
#align spectrum.subset_circle_of_unitary spectrum.subset_circle_of_unitary

end UnitarySpectrum

section ComplexScalars

open Complex

variable {A : Type _} [NormedRing A] [NormedAlgebra ℂ A] [CompleteSpace A] [StarRing A]
  [CstarRing A]

-- mathport name: «expr↑ₐ»
local notation "↑ₐ" => algebraMap ℂ A

theorem IsSelfAdjoint.spectralRadius_eq_nnnorm {a : A} (ha : IsSelfAdjoint a) :
    spectralRadius ℂ a = ‖a‖₊ :=
  by
  have hconst : tendsto (fun n : ℕ => (‖a‖₊ : ℝ≥0∞)) at_top _ := tendsto_const_nhds
  refine' tendsto_nhds_unique _ hconst
  convert(spectrum.pow_nnnorm_pow_one_div_tendsto_nhds_spectralRadius (a : A)).comp
      (Nat.tendsto_pow_atTop_atTop_of_one_lt one_lt_two)
  refine' funext fun n => _
  rw [Function.comp_apply, ha.nnnorm_pow_two_pow, ENNReal.coe_pow, ← rpow_nat_cast, ← rpow_mul]
  simp
#align is_self_adjoint.spectral_radius_eq_nnnorm IsSelfAdjoint.spectralRadius_eq_nnnorm

theorem IsStarNormal.spectralRadius_eq_nnnorm (a : A) [IsStarNormal a] :
    spectralRadius ℂ a = ‖a‖₊ :=
  by
  refine' (ENNReal.pow_strictMono two_ne_zero).Injective _
  have heq :
    (fun n : ℕ => (‖(a⋆ * a) ^ n‖₊ ^ (1 / n : ℝ) : ℝ≥0∞)) =
      (fun x => x ^ 2) ∘ fun n : ℕ => (‖a ^ n‖₊ ^ (1 / n : ℝ) : ℝ≥0∞) :=
    by
    funext
    rw [Function.comp_apply, ← rpow_nat_cast, ← rpow_mul, mul_comm, rpow_mul, rpow_nat_cast, ←
      coe_pow, sq, ← nnnorm_star_mul_self, Commute.mul_pow (star_comm_self' a), star_pow]
  have h₂ :=
    ((ENNReal.continuous_pow 2).Tendsto (spectralRadius ℂ a)).comp
      (spectrum.pow_nnnorm_pow_one_div_tendsto_nhds_spectralRadius a)
  rw [← HEq] at h₂
  convert tendsto_nhds_unique h₂ (pow_nnnorm_pow_one_div_tendsto_nhds_spectral_radius (a⋆ * a))
  rw [(IsSelfAdjoint.star_mul_self a).spectralRadius_eq_nnnorm, sq, nnnorm_star_mul_self, coe_mul]
#align is_star_normal.spectral_radius_eq_nnnorm IsStarNormal.spectralRadius_eq_nnnorm

/-- Any element of the spectrum of a selfadjoint is real. -/
theorem IsSelfAdjoint.mem_spectrum_eq_re [StarModule ℂ A] {a : A} (ha : IsSelfAdjoint a) {z : ℂ}
    (hz : z ∈ spectrum ℂ a) : z = z.re :=
  by
  have hu := exp_mem_unitary_of_mem_skewAdjoint ℂ (ha.smul_mem_skew_adjoint conj_I)
  let Iu := Units.mk0 I I_ne_zero
  have : exp ℂ (I • z) ∈ spectrum ℂ (exp ℂ (I • a)) := by
    simpa only [Units.smul_def, Units.val_mk0] using
      spectrum.exp_mem_exp (Iu • a) (smul_mem_smul_iff.mpr hz)
  exact
    Complex.ext (of_real_re _)
      (by
        simpa only [← Complex.exp_eq_exp_ℂ, mem_sphere_zero_iff_norm, norm_eq_abs, abs_exp,
          Real.exp_eq_one_iff, smul_eq_mul, I_mul, neg_eq_zero] using
          spectrum.subset_circle_of_unitary hu this)
#align is_self_adjoint.mem_spectrum_eq_re IsSelfAdjoint.mem_spectrum_eq_re

/-- Any element of the spectrum of a selfadjoint is real. -/
theorem selfAdjoint.mem_spectrum_eq_re [StarModule ℂ A] (a : selfAdjoint A) {z : ℂ}
    (hz : z ∈ spectrum ℂ (a : A)) : z = z.re :=
  a.Prop.mem_spectrum_eq_re hz
#align self_adjoint.mem_spectrum_eq_re selfAdjoint.mem_spectrum_eq_re

/-- The spectrum of a selfadjoint is real -/
theorem IsSelfAdjoint.coe_re_map_spectrum [StarModule ℂ A] {a : A} (ha : IsSelfAdjoint a) :
    spectrum ℂ a = (coe ∘ re '' spectrum ℂ a : Set ℂ) :=
  le_antisymm (fun z hz => ⟨z, hz, (ha.mem_spectrum_eq_re hz).symm⟩) fun z =>
    by
    rintro ⟨z, hz, rfl⟩
    simpa only [(ha.mem_spectrum_eq_re hz).symm, Function.comp_apply] using hz
#align is_self_adjoint.coe_re_map_spectrum IsSelfAdjoint.coe_re_map_spectrum

/-- The spectrum of a selfadjoint is real -/
theorem selfAdjoint.coe_re_map_spectrum [StarModule ℂ A] (a : selfAdjoint A) :
    spectrum ℂ (a : A) = (coe ∘ re '' spectrum ℂ (a : A) : Set ℂ) :=
  a.property.coe_re_map_spectrum
#align self_adjoint.coe_re_map_spectrum selfAdjoint.coe_re_map_spectrum

end ComplexScalars

namespace StarAlgHom

variable {F A B : Type _} [NormedRing A] [NormedAlgebra ℂ A] [CompleteSpace A] [StarRing A]
  [CstarRing A] [NormedRing B] [NormedAlgebra ℂ B] [CompleteSpace B] [StarRing B] [CstarRing B]
  [hF : StarAlgHomClass F ℂ A B] (φ : F)

include hF

/-- A star algebra homomorphism of complex C⋆-algebras is norm contractive. -/
theorem nnnorm_apply_le (a : A) : ‖(φ a : B)‖₊ ≤ ‖a‖₊ :=
  by
  suffices ∀ s : A, IsSelfAdjoint s → ‖φ s‖₊ ≤ ‖s‖₊ by
    exact
      nonneg_le_nonneg_of_sq_le_sq zero_le'
        (by
          simpa only [nnnorm_star_mul_self, map_star, map_mul] using
            this _ (IsSelfAdjoint.star_mul_self a))
  · intro s hs
    simpa only [hs.spectral_radius_eq_nnnorm, (hs.star_hom_apply φ).spectralRadius_eq_nnnorm,
      coe_le_coe] using
      show spectralRadius ℂ (φ s) ≤ spectralRadius ℂ s from
        supᵢ_le_supᵢ_of_subset (AlgHom.spectrum_apply_subset φ s)
#align star_alg_hom.nnnorm_apply_le StarAlgHom.nnnorm_apply_le

/-- A star algebra homomorphism of complex C⋆-algebras is norm contractive. -/
theorem norm_apply_le (a : A) : ‖(φ a : B)‖ ≤ ‖a‖ :=
  nnnorm_apply_le φ a
#align star_alg_hom.norm_apply_le StarAlgHom.norm_apply_le

/-- Star algebra homomorphisms between C⋆-algebras are continuous linear maps.
See note [lower instance priority] -/
noncomputable instance (priority := 100) : ContinuousLinearMapClass F ℂ A B :=
  { AlgHomClass.linearMapClass with
    map_continuous := fun φ =>
      AddMonoidHomClass.continuous_of_bound φ 1 (by simpa only [one_mul] using nnnorm_apply_le φ) }

end StarAlgHom

end

namespace WeakDual

open ContinuousMap Complex

open ComplexStarModule

variable {F A : Type _} [NormedRing A] [NormedAlgebra ℂ A] [CompleteSpace A] [StarRing A]
  [CstarRing A] [StarModule ℂ A] [hF : AlgHomClass F ℂ A ℂ]

include hF

/-- This instance is provided instead of `star_alg_hom_class` to avoid type class inference loops.
See note [lower instance priority] -/
noncomputable instance (priority := 100) : StarHomClass F A ℂ
    where
  coe φ := φ
  coe_injective' := FunLike.coe_injective'
  map_star φ a := by
    suffices hsa : ∀ s : selfAdjoint A, (φ s)⋆ = φ s
    · rw [← realPart_add_i_smul_imaginaryPart a]
      simp only [map_add, map_smul, star_add, star_smul, hsa, selfAdjoint.star_val_eq]
    · intro s
      have := AlgHom.apply_mem_spectrum φ (s : A)
      rw [selfAdjoint.coe_re_map_spectrum s] at this
      rcases this with ⟨⟨_, _⟩, _, heq⟩
      rw [← HEq, IsROrC.star_def, IsROrC.conj_of_real]

/-- This is not an instance to avoid type class inference loops. See
`weak_dual.complex.star_hom_class`. -/
noncomputable def AlgHomClass.starAlgHomClass : StarAlgHomClass F ℂ A ℂ :=
  { WeakDual.Complex.starHomClass, hF with coe := fun f => f }
#align alg_hom_class.star_alg_hom_class AlgHomClass.starAlgHomClass

omit hF

namespace CharacterSpace

noncomputable instance : StarAlgHomClass (characterSpace ℂ A) ℂ A ℂ :=
  { AlgHomClass.starAlgHomClass with coe := fun f => f }

end CharacterSpace

end WeakDual


/-
Copyright (c) 2020 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.mv_polynomial.default
import Mathlib.data.fintype.card
import Mathlib.PostPort

universes u_1 u_3 u_2

namespace Mathlib

/-!
# Homogeneous polynomials

A multivariate polynomial `φ` is homogeneous of degree `n`
if all monomials occuring in `φ` have degree `n`.

## Main definitions/lemmas

* `is_homogeneous φ n`: a predicate that asserts that `φ` is homogeneous of degree `n`.
* `homogeneous_component n`: the additive morphism that projects polynomials onto
  their summand that is homogeneous of degree `n`.
* `sum_homogeneous_component`: every polynomial is the sum of its homogeneous components

-/

namespace mv_polynomial

/-
TODO
* create definition for `∑ i in d.support, d i`
* define graded rings, and show that mv_polynomial is an example
-/

/-- A multivariate polynomial `φ` is homogeneous of degree `n`
if all monomials occuring in `φ` have degree `n`. -/
def is_homogeneous {σ : Type u_1} {R : Type u_3} [comm_semiring R] (φ : mv_polynomial σ R) (n : ℕ) :=
  ∀ {d : σ →₀ ℕ}, coeff d φ ≠ 0 → (finset.sum (finsupp.support d) fun (i : σ) => coe_fn d i) = n

theorem is_homogeneous_monomial {σ : Type u_1} {R : Type u_3} [comm_semiring R] (d : σ →₀ ℕ) (r : R) (n : ℕ) (hn : (finset.sum (finsupp.support d) fun (i : σ) => coe_fn d i) = n) : is_homogeneous (monomial d r) n := sorry

theorem is_homogeneous_C (σ : Type u_1) {R : Type u_3} [comm_semiring R] (r : R) : is_homogeneous (coe_fn C r) 0 := sorry

theorem is_homogeneous_zero (σ : Type u_1) (R : Type u_3) [comm_semiring R] (n : ℕ) : is_homogeneous 0 n :=
  fun (d : σ →₀ ℕ) (hd : coeff d 0 ≠ 0) => false.elim (hd (coeff_zero d))

theorem is_homogeneous_one (σ : Type u_1) (R : Type u_3) [comm_semiring R] : is_homogeneous 1 0 :=
  is_homogeneous_C σ 1

theorem is_homogeneous_X {σ : Type u_1} (R : Type u_3) [comm_semiring R] (i : σ) : is_homogeneous (X i) 1 := sorry

namespace is_homogeneous

theorem coeff_eq_zero {σ : Type u_1} {R : Type u_3} [comm_semiring R] {φ : mv_polynomial σ R} {n : ℕ} (hφ : is_homogeneous φ n) (d : σ →₀ ℕ) (hd : (finset.sum (finsupp.support d) fun (i : σ) => coe_fn d i) ≠ n) : coeff d φ = 0 :=
  eq.mp (Eq._oldrec (Eq.refl (¬coeff d φ ≠ 0)) (propext not_not)) (mt hφ hd)

theorem inj_right {σ : Type u_1} {R : Type u_3} [comm_semiring R] {φ : mv_polynomial σ R} {m : ℕ} {n : ℕ} (hm : is_homogeneous φ m) (hn : is_homogeneous φ n) (hφ : φ ≠ 0) : m = n := sorry

theorem add {σ : Type u_1} {R : Type u_3} [comm_semiring R] {φ : mv_polynomial σ R} {ψ : mv_polynomial σ R} {n : ℕ} (hφ : is_homogeneous φ n) (hψ : is_homogeneous ψ n) : is_homogeneous (φ + ψ) n := sorry

theorem sum {σ : Type u_1} {R : Type u_3} [comm_semiring R] {ι : Type u_2} (s : finset ι) (φ : ι → mv_polynomial σ R) (n : ℕ) (h : ∀ (i : ι), i ∈ s → is_homogeneous (φ i) n) : is_homogeneous (finset.sum s fun (i : ι) => φ i) n := sorry

theorem mul {σ : Type u_1} {R : Type u_3} [comm_semiring R] {φ : mv_polynomial σ R} {ψ : mv_polynomial σ R} {m : ℕ} {n : ℕ} (hφ : is_homogeneous φ m) (hψ : is_homogeneous ψ n) : is_homogeneous (φ * ψ) (m + n) := sorry

theorem prod {σ : Type u_1} {R : Type u_3} [comm_semiring R] {ι : Type u_2} (s : finset ι) (φ : ι → mv_polynomial σ R) (n : ι → ℕ) (h : ∀ (i : ι), i ∈ s → is_homogeneous (φ i) (n i)) : is_homogeneous (finset.prod s fun (i : ι) => φ i) (finset.sum s fun (i : ι) => n i) := sorry

theorem total_degree {σ : Type u_1} {R : Type u_3} [comm_semiring R] {φ : mv_polynomial σ R} {n : ℕ} (hφ : is_homogeneous φ n) (h : φ ≠ 0) : total_degree φ = n := sorry

end is_homogeneous

/-- `homogeneous_component n φ` is the part of `φ` that is homogeneous of degree `n`.
See `sum_homogeneous_component` for the statement that `φ` is equal to the sum
of all its homogeneous components. -/
def homogeneous_component {σ : Type u_1} {R : Type u_3} [comm_semiring R] (n : ℕ) : linear_map R (mv_polynomial σ R) (mv_polynomial σ R) :=
  linear_map.comp
    (submodule.subtype
      (finsupp.supported R R (set_of fun (d : σ →₀ ℕ) => (finset.sum (finsupp.support d) fun (i : σ) => coe_fn d i) = n)))
    (finsupp.restrict_dom R R (set_of fun (d : σ →₀ ℕ) => (finset.sum (finsupp.support d) fun (i : σ) => coe_fn d i) = n))

theorem coeff_homogeneous_component {σ : Type u_1} {R : Type u_3} [comm_semiring R] (n : ℕ) (φ : mv_polynomial σ R) (d : σ →₀ ℕ) : coeff d (coe_fn (homogeneous_component n) φ) =
  ite ((finset.sum (finsupp.support d) fun (i : σ) => coe_fn d i) = n) (coeff d φ) 0 := sorry

theorem homogeneous_component_apply {σ : Type u_1} {R : Type u_3} [comm_semiring R] (n : ℕ) (φ : mv_polynomial σ R) : coe_fn (homogeneous_component n) φ =
  finset.sum
    (finset.filter (fun (d : σ →₀ ℕ) => (finset.sum (finsupp.support d) fun (i : σ) => coe_fn d i) = n)
      (finsupp.support φ))
    fun (d : σ →₀ ℕ) => monomial d (coeff d φ) := sorry

theorem homogeneous_component_is_homogeneous {σ : Type u_1} {R : Type u_3} [comm_semiring R] (n : ℕ) (φ : mv_polynomial σ R) : is_homogeneous (coe_fn (homogeneous_component n) φ) n := sorry

theorem homogeneous_component_zero {σ : Type u_1} {R : Type u_3} [comm_semiring R] (φ : mv_polynomial σ R) : coe_fn (homogeneous_component 0) φ = coe_fn C (coeff 0 φ) := sorry

theorem homogeneous_component_eq_zero' {σ : Type u_1} {R : Type u_3} [comm_semiring R] (n : ℕ) (φ : mv_polynomial σ R) (h : ∀ (d : σ →₀ ℕ), d ∈ finsupp.support φ → (finset.sum (finsupp.support d) fun (i : σ) => coe_fn d i) ≠ n) : coe_fn (homogeneous_component n) φ = 0 := sorry

theorem homogeneous_component_eq_zero {σ : Type u_1} {R : Type u_3} [comm_semiring R] (n : ℕ) (φ : mv_polynomial σ R) (h : total_degree φ < n) : coe_fn (homogeneous_component n) φ = 0 := sorry

theorem sum_homogeneous_component {σ : Type u_1} {R : Type u_3} [comm_semiring R] (φ : mv_polynomial σ R) : (finset.sum (finset.range (total_degree φ + 1)) fun (i : ℕ) => coe_fn (homogeneous_component i) φ) = φ := sorry


/-
Copyright (c) 2022 Eric Wieser. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Wieser

! This file was ported from Lean 3 source module linear_algebra.clifford_algebra.fold
! leanprover-community/mathlib commit 446eb51ce0a90f8385f260d2b52e760e2004246b
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.LinearAlgebra.CliffordAlgebra.Conjugation

/-!
# Recursive computation rules for the Clifford algebra

This file provides API for a special case `clifford_algebra.foldr` of the universal property
`clifford_algebra.lift` with `A = module.End R N` for some arbitrary module `N`. This specialization
resembles the `list.foldr` operation, allowing a bilinear map to be "folded" along the generators.

For convenience, this file also provides `clifford_algebra.foldl`, implemented via
`clifford_algebra.reverse`

## Main definitions

* `clifford_algebra.foldr`: a computation rule for building linear maps out of the clifford
  algebra starting on the right, analogous to using `list.foldr` on the generators.
* `clifford_algebra.foldl`: a computation rule for building linear maps out of the clifford
  algebra starting on the left, analogous to using `list.foldl` on the generators.

## Main statements

* `clifford_algebra.right_induction`: an induction rule that adds generators from the right.
* `clifford_algebra.left_induction`: an induction rule that adds generators from the left.
-/

universe u1 u2 u3

variable {R M N : Type _}

variable [CommRing R] [AddCommGroup M] [AddCommGroup N]

variable [Module R M] [Module R N]

variable (Q : QuadraticForm R M)

namespace CliffordAlgebra

section Foldr

/-- Fold a bilinear map along the generators of a term of the clifford algebra, with the rule
given by `foldr Q f hf n (ι Q m * x) = f m (foldr Q f hf n x)`.

For example, `foldr f hf n (r • ι R u + ι R v * ι R w) = r • f u n + f v (f w n)`. -/
def foldr (f : M →ₗ[R] N →ₗ[R] N) (hf : ∀ m x, f m (f m x) = Q m • x) :
    N →ₗ[R] CliffordAlgebra Q →ₗ[R] N :=
  (CliffordAlgebra.lift Q ⟨f, fun v => LinearMap.ext <| hf v⟩).toLinearMap.flip
#align clifford_algebra.foldr CliffordAlgebra.foldr

@[simp]
theorem foldr_ι (f : M →ₗ[R] N →ₗ[R] N) (hf) (n : N) (m : M) : foldr Q f hf n (ι Q m) = f m n :=
  LinearMap.congr_fun (lift_ι_apply _ _ _) n
#align clifford_algebra.foldr_ι CliffordAlgebra.foldr_ι

@[simp]
theorem foldr_algebraMap (f : M →ₗ[R] N →ₗ[R] N) (hf) (n : N) (r : R) :
    foldr Q f hf n (algebraMap R _ r) = r • n :=
  LinearMap.congr_fun (AlgHom.commutes _ r) n
#align clifford_algebra.foldr_algebra_map CliffordAlgebra.foldr_algebraMap

@[simp]
theorem foldr_one (f : M →ₗ[R] N →ₗ[R] N) (hf) (n : N) : foldr Q f hf n 1 = n :=
  LinearMap.congr_fun (AlgHom.map_one _) n
#align clifford_algebra.foldr_one CliffordAlgebra.foldr_one

@[simp]
theorem foldr_mul (f : M →ₗ[R] N →ₗ[R] N) (hf) (n : N) (a b : CliffordAlgebra Q) :
    foldr Q f hf n (a * b) = foldr Q f hf (foldr Q f hf n b) a :=
  LinearMap.congr_fun (AlgHom.map_mul _ _ _) n
#align clifford_algebra.foldr_mul CliffordAlgebra.foldr_mul

/-- This lemma demonstrates the origin of the `foldr` name. -/
theorem foldr_prod_map_ι (l : List M) (f : M →ₗ[R] N →ₗ[R] N) (hf) (n : N) :
    foldr Q f hf n (l.map <| ι Q).Prod = List.foldr (fun m n => f m n) n l :=
  by
  induction' l with hd tl ih
  · rw [List.map_nil, List.prod_nil, List.foldr_nil, foldr_one]
  · rw [List.map_cons, List.prod_cons, List.foldr_cons, foldr_mul, foldr_ι, ih]
#align clifford_algebra.foldr_prod_map_ι CliffordAlgebra.foldr_prod_map_ι

end Foldr

section Foldl

/-- Fold a bilinear map along the generators of a term of the clifford algebra, with the rule
given by `foldl Q f hf n (ι Q m * x) = f m (foldl Q f hf n x)`.

For example, `foldl f hf n (r • ι R u + ι R v * ι R w) = r • f u n + f v (f w n)`. -/
def foldl (f : M →ₗ[R] N →ₗ[R] N) (hf : ∀ m x, f m (f m x) = Q m • x) :
    N →ₗ[R] CliffordAlgebra Q →ₗ[R] N :=
  LinearMap.compl₂ (foldr Q f hf) reverse
#align clifford_algebra.foldl CliffordAlgebra.foldl

@[simp]
theorem foldl_reverse (f : M →ₗ[R] N →ₗ[R] N) (hf) (n : N) (x : CliffordAlgebra Q) :
    foldl Q f hf n (reverse x) = foldr Q f hf n x :=
  FunLike.congr_arg (foldr Q f hf n) <| reverse_reverse _
#align clifford_algebra.foldl_reverse CliffordAlgebra.foldl_reverse

@[simp]
theorem foldr_reverse (f : M →ₗ[R] N →ₗ[R] N) (hf) (n : N) (x : CliffordAlgebra Q) :
    foldr Q f hf n (reverse x) = foldl Q f hf n x :=
  rfl
#align clifford_algebra.foldr_reverse CliffordAlgebra.foldr_reverse

@[simp]
theorem foldl_ι (f : M →ₗ[R] N →ₗ[R] N) (hf) (n : N) (m : M) : foldl Q f hf n (ι Q m) = f m n := by
  rw [← foldr_reverse, reverse_ι, foldr_ι]
#align clifford_algebra.foldl_ι CliffordAlgebra.foldl_ι

@[simp]
theorem foldl_algebraMap (f : M →ₗ[R] N →ₗ[R] N) (hf) (n : N) (r : R) :
    foldl Q f hf n (algebraMap R _ r) = r • n := by
  rw [← foldr_reverse, reverse.commutes, foldr_algebra_map]
#align clifford_algebra.foldl_algebra_map CliffordAlgebra.foldl_algebraMap

@[simp]
theorem foldl_one (f : M →ₗ[R] N →ₗ[R] N) (hf) (n : N) : foldl Q f hf n 1 = n := by
  rw [← foldr_reverse, reverse.map_one, foldr_one]
#align clifford_algebra.foldl_one CliffordAlgebra.foldl_one

@[simp]
theorem foldl_mul (f : M →ₗ[R] N →ₗ[R] N) (hf) (n : N) (a b : CliffordAlgebra Q) :
    foldl Q f hf n (a * b) = foldl Q f hf (foldl Q f hf n a) b := by
  rw [← foldr_reverse, ← foldr_reverse, ← foldr_reverse, reverse.map_mul, foldr_mul]
#align clifford_algebra.foldl_mul CliffordAlgebra.foldl_mul

/-- This lemma demonstrates the origin of the `foldl` name. -/
theorem foldl_prod_map_ι (l : List M) (f : M →ₗ[R] N →ₗ[R] N) (hf) (n : N) :
    foldl Q f hf n (l.map <| ι Q).Prod = List.foldl (fun m n => f n m) n l := by
  rw [← foldr_reverse, reverse_prod_map_ι, ← List.map_reverse, foldr_prod_map_ι, List.foldr_reverse]
#align clifford_algebra.foldl_prod_map_ι CliffordAlgebra.foldl_prod_map_ι

end Foldl

theorem rightInduction {P : CliffordAlgebra Q → Prop} (hr : ∀ r : R, P (algebraMap _ _ r))
    (h_add : ∀ x y, P x → P y → P (x + y)) (h_ι_mul : ∀ m x, P x → P (x * ι Q m)) : ∀ x, P x :=
  by
  /- It would be neat if we could prove this via `foldr` like how we prove
    `clifford_algebra.induction`, but going via the grading seems easier. -/
  intro x
  have : x ∈ ⊤ := Submodule.mem_top
  rw [← supr_ι_range_eq_top] at this
  apply Submodule.supᵢ_induction _ this (fun i x hx => _) _ h_add
  · refine' Submodule.pow_induction_on_right _ hr h_add (fun x px m => _) hx
    rintro ⟨m, rfl⟩
    exact h_ι_mul _ _ px
  · simpa only [map_zero] using hr 0
#align clifford_algebra.right_induction CliffordAlgebra.rightInduction

theorem leftInduction {P : CliffordAlgebra Q → Prop} (hr : ∀ r : R, P (algebraMap _ _ r))
    (h_add : ∀ x y, P x → P y → P (x + y)) (h_mul_ι : ∀ x m, P x → P (ι Q m * x)) : ∀ x, P x :=
  by
  refine' reverse_involutive.surjective.forall.2 _
  intro x
  induction' x using CliffordAlgebra.rightInduction with r x y hx hy m x hx
  · simpa only [reverse.commutes] using hr r
  · simpa only [map_add] using h_add _ _ hx hy
  · simpa only [reverse.map_mul, reverse_ι] using h_mul_ι _ _ hx
#align clifford_algebra.left_induction CliffordAlgebra.leftInduction

/-! ### Versions with extra state -/

/-- Auxiliary definition for `clifford_algebra.foldr'` -/
def foldr'Aux (f : M →ₗ[R] CliffordAlgebra Q × N →ₗ[R] N) :
    M →ₗ[R] Module.End R (CliffordAlgebra Q × N) :=
  by
  have v_mul := (LinearMap.Algebra.lmul R (CliffordAlgebra Q)).toLinearMap ∘ₗ ι Q
  have l := v_mul.compl₂ (LinearMap.fst _ _ N)
  exact
    { toFun := fun m => (l m).Prod (f m)
      map_add' := fun v₂ v₂ =>
        LinearMap.ext fun x =>
          Prod.ext (LinearMap.congr_fun (l.map_add _ _) x) (LinearMap.congr_fun (f.map_add _ _) x)
      map_smul' := fun c v =>
        LinearMap.ext fun x =>
          Prod.ext (LinearMap.congr_fun (l.map_smul _ _) x)
            (LinearMap.congr_fun (f.map_smul _ _) x) }
#align clifford_algebra.foldr'_aux CliffordAlgebra.foldr'Aux

theorem foldr'Aux_apply_apply (f : M →ₗ[R] CliffordAlgebra Q × N →ₗ[R] N) (m : M) (x_fx) :
    foldr'Aux Q f m x_fx = (ι Q m * x_fx.1, f m x_fx) :=
  rfl
#align clifford_algebra.foldr'_aux_apply_apply CliffordAlgebra.foldr'Aux_apply_apply

theorem foldr'Aux_foldr'Aux (f : M →ₗ[R] CliffordAlgebra Q × N →ₗ[R] N)
    (hf : ∀ m x fx, f m (ι Q m * x, f m (x, fx)) = Q m • fx) (v : M) (x_fx) :
    foldr'Aux Q f v (foldr'Aux Q f v x_fx) = Q v • x_fx :=
  by
  cases' x_fx with x fx
  simp only [foldr'_aux_apply_apply]
  rw [← mul_assoc, ι_sq_scalar, ← Algebra.smul_def, hf, Prod.smul_mk]
#align clifford_algebra.foldr'_aux_foldr'_aux CliffordAlgebra.foldr'Aux_foldr'Aux

/-- Fold a bilinear map along the generators of a term of the clifford algebra, with the rule
given by `foldr' Q f hf n (ι Q m * x) = f m (x, foldr' Q f hf n x)`.
Note this is like `clifford_algebra.foldr`, but with an extra `x` argument.
Implement the recursion scheme `F[n0](m * x) = f(m, (x, F[n0](x)))`. -/
def foldr' (f : M →ₗ[R] CliffordAlgebra Q × N →ₗ[R] N)
    (hf : ∀ m x fx, f m (ι Q m * x, f m (x, fx)) = Q m • fx) (n : N) : CliffordAlgebra Q →ₗ[R] N :=
  LinearMap.snd _ _ _ ∘ₗ foldr Q (foldr'Aux Q f) (foldr'Aux_foldr'Aux Q _ hf) (1, n)
#align clifford_algebra.foldr' CliffordAlgebra.foldr'

theorem foldr'_algebraMap (f : M →ₗ[R] CliffordAlgebra Q × N →ₗ[R] N)
    (hf : ∀ m x fx, f m (ι Q m * x, f m (x, fx)) = Q m • fx) (n r) :
    foldr' Q f hf n (algebraMap R _ r) = r • n :=
  congr_arg Prod.snd (foldr_algebraMap _ _ _ _ _)
#align clifford_algebra.foldr'_algebra_map CliffordAlgebra.foldr'_algebraMap

theorem foldr'_ι (f : M →ₗ[R] CliffordAlgebra Q × N →ₗ[R] N)
    (hf : ∀ m x fx, f m (ι Q m * x, f m (x, fx)) = Q m • fx) (n m) :
    foldr' Q f hf n (ι Q m) = f m (1, n) :=
  congr_arg Prod.snd (foldr_ι _ _ _ _ _)
#align clifford_algebra.foldr'_ι CliffordAlgebra.foldr'_ι

theorem foldr'_ι_mul (f : M →ₗ[R] CliffordAlgebra Q × N →ₗ[R] N)
    (hf : ∀ m x fx, f m (ι Q m * x, f m (x, fx)) = Q m • fx) (n m) (x) :
    foldr' Q f hf n (ι Q m * x) = f m (x, foldr' Q f hf n x) :=
  by
  dsimp [foldr']
  rw [foldr_mul, foldr_ι, foldr'_aux_apply_apply]
  refine' congr_arg (f m) (prod.mk.eta.symm.trans _)
  congr 1
  induction' x using CliffordAlgebra.leftInduction with r x y hx hy m x hx
  · simp_rw [foldr_algebra_map, Prod.smul_mk, Algebra.algebraMap_eq_smul_one]
  · rw [map_add, Prod.fst_add, hx, hy]
  · rw [foldr_mul, foldr_ι, foldr'_aux_apply_apply, hx]
#align clifford_algebra.foldr'_ι_mul CliffordAlgebra.foldr'_ι_mul

end CliffordAlgebra


import IMO2020.N5.additive_map extra.number_theory.ord_compl_zmod

/-!
# `p`-regular maps

Fix a commutative additive monoid `M` and a prime `p`.
Given `(c, χ) : M × (additive (zmod p)ˣ →+ M)`, the **regular map** `regular_map M p (c, χ)` is the
  additive map given by `p^k t ↦ k • c + χ(t : (zmod p)ˣ)` for any `k ≥ 1` and `t` coprime with `p`.
We will show that map `regular_map M p` is additive and injective with `regular_map M p 0 = 0`.
Then, we construct `regular_hom M p` as a bundled homomorphism version of `regular_map M p`.

We also define the predicate `is_regular_map M p` and prove an equivalent condition:
  an additive map is regular iff `f(t) = f(t % p)` for any `t` coprime with `p`.
Lastly, we prove that `is_regular_map M p f` and `is_regular_map M q f` for `p ≠ q` yields `f = 0`.
-/

namespace IMOSL
namespace IMO2020N5

open extra additive

/-- `p`-regular maps -/
def regular_map (M : Type*) [add_comm_monoid M] (p : ℕ) [fact p.prime]
  (pair : M × (additive (zmod p)ˣ →+ M)) : additive_map M :=
{ to_fun := λ n, ite (n = 0) 0
    (padic_val_nat p n • pair.1 + pair.2 (of_mul $ zmod.ord_compl p n)),
  map_zero' := if_pos rfl,
  map_one' := by rw [if_neg (nat.succ_ne_zero 0), padic_val_nat.one, zero_nsmul,
    zero_add, zmod.ord_compl.map_one, of_mul_one, add_monoid_hom.map_zero],
  map_mul' := λ x y hx hy, by rw [if_neg (mul_ne_zero hx hy), if_neg hx, if_neg hy,
    add_add_add_comm, ← add_smul, ← @padic_val_nat.mul p x y _inst_2 hx hy,
    ← add_monoid_hom.map_add, ← of_mul_mul, zmod.ord_compl.map_mul hx hy] }

namespace regular_map

variables {M : Type*} [add_comm_monoid M] {p : ℕ} [fact p.prime]
  (pair pair' : M × (additive (zmod p)ˣ →+ M))

theorem map_def (n : ℕ) : regular_map M p pair n =
  ite (n = 0) 0 (padic_val_nat p n • pair.1 + pair.2 (of_mul (zmod.ord_compl p n))) := rfl

@[simp] theorem map_zero : regular_map M p pair 0 = 0 := rfl

@[simp] theorem map_ne_zero {n : ℕ} (hn : n ≠ 0) :
  regular_map M p pair n = padic_val_nat p n • pair.1 + pair.2 (of_mul (zmod.ord_compl p n)) :=
  if_neg hn

@[simp] theorem map_one : regular_map M p pair 1 = 0 :=
  additive_map.map_one (regular_map M p pair)

@[simp] theorem map_mul {m n : ℕ} (hm : m ≠ 0) (hn : n ≠ 0) :
  regular_map M p pair (m * n) = regular_map M p pair m + regular_map M p pair n :=
  additive_map.map_mul (regular_map M p pair) hm hn

@[simp] theorem map_pow (m k : ℕ) : regular_map M p pair (m ^ k) = k • regular_map M p pair m :=
  additive_map.map_pow (regular_map M p pair) m k

theorem map_p : regular_map M p pair p = pair.1 :=
  by rw [map_ne_zero pair (fact.out p.prime).ne_zero, padic_val_nat_self, one_nsmul,
    zmod.ord_compl.map_self, of_mul_one, add_monoid_hom.map_zero, add_zero]

theorem map_coprime' {t : ℕ} (h : t.coprime p) :
  regular_map M p pair t = pair.2 (of_mul $ zmod.ord_compl p t) :=
begin
  have h0 : ¬p ∣ t := by rwa [← nat.prime.coprime_iff_not_dvd (fact.out p.prime), nat.coprime_comm],
  rw [map_ne_zero, padic_val_nat.eq_zero_of_not_dvd h0, zero_nsmul, zero_add],
  rintros rfl; exact h0 (dvd_zero p)
end

theorem map_coprime {t : ℕ} (h : t.coprime p) :
  regular_map M p pair t = pair.2 (of_mul $ zmod.unit_of_coprime t h) :=
  by rw [map_coprime' pair h, zmod.ord_compl.map_coprime h]

theorem map_coprime_mod_p_eq {t : ℕ} (h : t.coprime p) :
  regular_map M p pair t = regular_map M p pair (t % p) :=
begin
  rw [map_coprime' pair h, zmod.ord_compl.map_coprime_mod_p h, map_coprime' pair],
  rwa [nat.coprime, ← nat.gcd_rec, nat.gcd_comm]
end

theorem map_zmod_unit_val (x : (zmod p)ˣ) : regular_map M p pair (x : zmod p).val = pair.2 x :=
  by rw [map_coprime' pair (zmod.val_coe_unit_coprime x), zmod.ord_compl.map_zmod_unit_val]; refl

theorem map_pair_add : regular_map M p (pair + pair') = regular_map M p pair + regular_map M p pair' :=
begin
  ext x; rcases eq_or_ne x 0 with rfl | h,
  rw [additive_map.map_zero, additive_map.map_zero],
  rw [map_ne_zero _ h, additive_map.add_apply, map_ne_zero _ h, map_ne_zero _ h],
  rw [add_add_add_comm, ← add_monoid_hom.add_apply, ← nsmul_add, prod.fst_add, prod.snd_add]
end

theorem map_pair_zero : regular_map M p 0 = 0 :=
  additive_map.ext (λ x, by rw [map_def, prod.fst_zero, nsmul_zero, zero_add,
    prod.snd_zero, add_monoid_hom.zero_apply, additive_map.zero_apply, if_t_t])

theorem injective : function.injective (regular_map M p) :=
begin
  rintros ⟨c, χ⟩ ⟨d, ρ⟩ h,
  rw additive_map.ext_iff at h,
  rw prod.mk.inj_iff; split,
  replace h := h p; rwa [map_p, map_p] at h,
  refine add_monoid_hom.ext (λ x, _),
  replace h := h (to_mul x : zmod p).val,
  rwa [map_zmod_unit_val, map_zmod_unit_val] at h
end

theorem inj : regular_map M p pair = regular_map M p pair' ↔ pair = pair' :=
  ⟨λ h, injective h, congr_arg _⟩

theorem fst_eq_iff : pair.1 = pair'.1 ↔ regular_map M p pair p = regular_map M p pair' p :=
  by rw [map_p, map_p]

theorem fst_eq_zero_iff : pair.1 = 0 ↔ regular_map M p pair p = 0 := by rw map_p

theorem snd_eq_iff : pair.2 = pair'.2 ↔
  ∀ k : ℕ, k ≠ 0 → k < p → regular_map M p pair k = regular_map M p pair' k :=
begin
  refine ⟨λ h k h0 h1, _, λ h, _⟩,
  { replace h1 := nat.not_dvd_of_pos_of_lt (zero_lt_iff.mpr h0) h1,
    rwa [← (fact.out p.prime).coprime_iff_not_dvd, nat.coprime_comm] at h1,
    rw [map_coprime pair h1, map_coprime pair' h1, h] },
  { refine add_monoid_hom.ext (λ x, _),
    have h0 : (to_mul x : zmod p).val ≠ 0 :=
      by rw [ne.def, zmod.val_eq_zero]; exact (to_mul x).ne_zero,
    replace h := h (to_mul x : zmod p).val h0 (to_mul x : zmod p).val_lt,
    rwa [map_zmod_unit_val, map_zmod_unit_val] at h }
end

theorem snd_eq_zero_iff : pair.2 = 0 ↔ ∀ k : ℕ, k ≠ 0 → k < p → regular_map M p pair k = 0 :=
  by change pair.snd = (0 : M × (additive (zmod p)ˣ →+ M)).snd ↔ _;
    rw [snd_eq_iff, map_pair_zero]; refl

theorem eq_iff : pair = pair' ↔
  ∀ k : ℕ, k ≠ 0 → k ≤ p → regular_map M p pair k = regular_map M p pair' k :=
begin
  rw [prod.ext_iff, fst_eq_iff, snd_eq_iff],
  refine ⟨λ h k h1 h2, _,
    λ h, ⟨h p (fact.out p.prime).ne_zero (le_refl p), λ k h0 h1, h k h0 (le_of_lt h1)⟩⟩,
  rw le_iff_eq_or_lt at h2; rcases h2 with h2 | h2,
  rw [h2, h.1],
  exact h.2 k h1 h2
end

end regular_map

open regular_map

/-- `p`-regular mapping as a homomorphism -/
def regular_hom (M : Type*) [add_comm_monoid M] (p : ℕ) [fact p.prime] :
  M × (additive (zmod p)ˣ →+ M) →+ additive_map M :=
⟨regular_map M p, map_pair_zero, map_pair_add⟩

/-- `p`-regularity predicate -/
def is_regular_map (M : Type*) [add_comm_monoid M] (p : ℕ) [fact p.prime] (f : additive_map M) :=
  ∃ pair : M × (additive (zmod p)ˣ →+ M), f = regular_map M p pair

namespace is_regular_map

variables {M : Type*} [add_comm_monoid M] {p q : ℕ} [fact p.prime] [fact q.prime]

/-- The zero additive map is `p`-regular -/
theorem zero : is_regular_map M p 0 := ⟨0, map_pair_zero.symm⟩

/-- An equivalent condition for `p`-regularity -/
theorem iff (f : additive_map M) : is_regular_map M p f ↔ ∀ t : ℕ, t.coprime p → f t = f (t % p) :=
begin
  refine ⟨λ h t h0, _, λ h, ⟨⟨f p, ⟨λ x, f (to_mul x : zmod p).val, _, λ x y, _⟩⟩, _⟩⟩,
  rcases h with ⟨pair, rfl⟩; exact map_coprime_mod_p_eq pair h0,
  rw [to_mul_zero, units.coe_one, zmod.val_one, additive_map.map_one],
  { have h0 := λ x : (zmod p)ˣ, zmod.val_coe_unit_coprime (to_mul x),
    suffices : ∀ x : ℕ, x.coprime p → x ≠ 0,
      rw [to_mul_add, units.coe_mul, zmod.val_mul, ← h _ ((h0 x).mul $ h0 y),
          additive_map.map_mul _ (this _ $ h0 x) (this _ $ h0 y)],
    rintros x h1 rfl,
    rw [nat.coprime_comm, (fact.out p.prime).coprime_iff_not_dvd] at h1,
    exact h1 (dvd_zero p) },
  { refine additive_map.ext (λ n, _),
    rcases eq_or_ne n 0 with rfl | h0,
    rw [additive_map.map_zero, regular_map.map_zero],
    rw regular_map.map_ne_zero _ h0,
    nth_rewrite 0 ← nat.ord_proj_mul_ord_compl_eq_self n p,
    have hp := fact.out p.prime,
    rw [f.map_mul (pow_ne_zero _ hp.ne_zero) (ne_of_gt $ p.ord_compl_pos h0),
        additive_map.map_pow, add_monoid_hom.coe_mk, to_mul_of_mul,
        ← nat.factorization_def _ hp, zmod.ord_compl.map_ne_zero_val h0, ← h],
    rw nat.coprime_comm; exact nat.coprime_ord_compl hp h0 }
end

/-- Condition for two `p`-regular maps to be equal -/
theorem ext_iff_at_le_p {f g : additive_map M}
  (hf : is_regular_map M p f) (hg : is_regular_map M p g) :
  f = g ↔ ∀ k : ℕ, k ≠ 0 → k ≤ p → f k = g k :=
begin
  rcases hf with ⟨⟨c, χ⟩, rfl⟩,
  rcases hg with ⟨⟨c', χ'⟩, rfl⟩,
  rw [regular_map.inj, regular_map.eq_iff]
end

/-- Condition for a `p`-regular map to be zero -/
theorem zero_iff_at_le_p {f : additive_map M} (hf : is_regular_map M p f) :
  f = 0 ↔ ∀ k : ℕ, k ≠ 0 → k ≤ p → f k = 0 :=
  by rw ext_iff_at_le_p hf zero; refl

/-- (Private) small lemma for values of `p`-regular map at two `nat` congruent modulo `p` -/
private lemma map_modeq_coprime {f : additive_map M} (hf : is_regular_map M p f)
  {m n : ℕ} (h : m % p = n % p) (h0 : n.coprime p) :
  f m = f n :=
begin
  rw iff at hf,
  rw [hf n h0, ← h, ← hf],
  unfold nat.coprime at h0 ⊢,
  rw ← nat.modeq at h,
  rw [nat.modeq.gcd_eq_of_modeq h, h0]
end

/-- Distinction between `p`-regular and `q`-regular for `p < q` -/
private lemma distinction' {f : additive_map M}
  (hpf : is_regular_map M p f) (hqf : is_regular_map M q f) (h : p < q) :
  f = 0 :=
begin
  have hp := fact.out p.prime,
  have hq := fact.out q.prime,
  have hpq := (nat.coprime_primes hp hq).mpr (ne_of_lt h),
  rw zero_iff_at_le_p hpf,
  suffices : ∃ c : M, f p + c = 0,
  { cases this with c h0,
    replace hpf : ∀ k : ℕ, f (q + k * p) = f q :=
      λ k, map_modeq_coprime hpf (by rw nat.add_mul_mod_self_right) hpq.symm,
    suffices : ∀ k : ℕ, k ≠ 0 → k ≤ p → f q = f k + f p,
    { intros k h1 h2,
      rw [← add_zero (f k), ← h0, ← add_assoc, ← this k h1 h2,
          this 1 one_ne_zero (le_of_lt hp.one_lt), additive_map.map_one, zero_add] },
    intros k h1 h2,
    rw [← hpf k, ← additive_map.map_mul f h1 hp.ne_zero],
    apply map_modeq_coprime hqf,
    rw nat.add_mod_left,
    refine nat.coprime.mul _ hpq,
    rw [nat.coprime_comm, hq.coprime_iff_not_dvd],
    exact nat.not_dvd_of_pos_of_lt (zero_lt_iff.mpr h1) (lt_of_le_of_lt h2 h) },

  obtain ⟨n, h0⟩ := nat.exists_mul_mod_eq_one_of_coprime hpq hq.one_lt,
  use f n,
  rw ← nat.mod_eq_of_lt hq.one_lt at h0,
  rw [← additive_map.map_mul f hp.ne_zero, map_modeq_coprime hqf h0 q.coprime_one_left],
  exact f.map_one,
  rintros rfl,
  rw [mul_zero, nat.zero_mod, nat.mod_eq_of_lt hq.one_lt] at h0,
  revert h0; exact zero_ne_one
end

/-- Distinction between `p`-regular and `q`-regular for `p ≠ q` -/
theorem distinction {f : additive_map M}
  (h : is_regular_map M p f) (h0 : is_regular_map M q f) (h1 : p ≠ q) :
  f = 0 :=
begin
  rw ne_iff_lt_or_gt at h1; cases h1 with h1 h1,
  exacts [distinction' h h0 h1, distinction' h0 h h1]
end

end is_regular_map

end IMO2020N5
end IMOSL