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

! This file was ported from Lean 3 source module analysis.convex.partition_of_unity
! leanprover-community/mathlib commit f2ce6086713c78a7f880485f7917ea547a215982
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Topology.PartitionOfUnity
import Mathbin.Analysis.Convex.Combination

/-!
# Partition of unity and convex sets

In this file we prove the following lemma, see `exists_continuous_forall_mem_convex_of_local`. Let
`X` be a normal paracompact topological space (e.g., any extended metric space). Let `E` be a
topological real vector space. Let `t : X → set E` be a family of convex sets. Suppose that for each
point `x : X`, there exists a neighborhood `U ∈ 𝓝 X` and a function `g : X → E` that is continuous
on `U` and sends each `y ∈ U` to a point of `t y`. Then there exists a continuous map `g : C(X, E)`
such that `g x ∈ t x` for all `x`.

We also formulate a useful corollary, see `exists_continuous_forall_mem_convex_of_local_const`, that
assumes that local functions `g` are constants.

## Tags

partition of unity
-/

open Set Function

open BigOperators Topology

variable {ι X E : Type _} [TopologicalSpace X] [AddCommGroup E] [Module ℝ E]

theorem PartitionOfUnity.finsum_smul_mem_convex {s : Set X} (f : PartitionOfUnity ι X s)
    {g : ι → X → E} {t : Set E} {x : X} (hx : x ∈ s) (hg : ∀ i, f i x ≠ 0 → g i x ∈ t)
    (ht : Convex ℝ t) : (∑ᶠ i, f i x • g i x) ∈ t :=
  ht.finsum_mem (fun i => f.NonNeg _ _) (f.sum_eq_one hx) hg
#align partition_of_unity.finsum_smul_mem_convex PartitionOfUnity.finsum_smul_mem_convex

variable [NormalSpace X] [ParacompactSpace X] [TopologicalSpace E] [ContinuousAdd E]
  [ContinuousSMul ℝ E] {t : X → Set E}

/-- Let `X` be a normal paracompact topological space (e.g., any extended metric space). Let `E` be
a topological real vector space. Let `t : X → set E` be a family of convex sets. Suppose that for
each point `x : X`, there exists a neighborhood `U ∈ 𝓝 X` and a function `g : X → E` that is
continuous on `U` and sends each `y ∈ U` to a point of `t y`. Then there exists a continuous map
`g : C(X, E)` such that `g x ∈ t x` for all `x`. See also
`exists_continuous_forall_mem_convex_of_local_const`. -/
theorem exists_continuous_forall_mem_convex_of_local (ht : ∀ x, Convex ℝ (t x))
    (H : ∀ x : X, ∃ U ∈ 𝓝 x, ∃ g : X → E, ContinuousOn g U ∧ ∀ y ∈ U, g y ∈ t y) :
    ∃ g : C(X, E), ∀ x, g x ∈ t x :=
  by
  choose U hU g hgc hgt using H
  obtain ⟨f, hf⟩ :=
    PartitionOfUnity.exists_isSubordinate isClosed_univ (fun x => interior (U x))
      (fun x => isOpen_interior) fun x hx => mem_Union.2 ⟨x, mem_interior_iff_mem_nhds.2 (hU x)⟩
  refine'
    ⟨⟨fun x => ∑ᶠ i, f i x • g i x,
        hf.continuous_finsum_smul (fun i => isOpen_interior) fun i => (hgc i).mono interior_subset⟩,
      fun x => f.finsum_smul_mem_convex (mem_univ x) (fun i hi => hgt _ _ _) (ht _)⟩
  exact interior_subset (hf _ <| subset_closure hi)
#align exists_continuous_forall_mem_convex_of_local exists_continuous_forall_mem_convex_of_local

/-- Let `X` be a normal paracompact topological space (e.g., any extended metric space). Let `E` be
a topological real vector space. Let `t : X → set E` be a family of convex sets. Suppose that for
each point `x : X`, there exists a vector `c : E` that belongs to `t y` for all `y` in a
neighborhood of `x`. Then there exists a continuous map `g : C(X, E)` such that `g x ∈ t x` for all
`x`. See also `exists_continuous_forall_mem_convex_of_local`. -/
theorem exists_continuous_forall_mem_convex_of_local_const (ht : ∀ x, Convex ℝ (t x))
    (H : ∀ x : X, ∃ c : E, ∀ᶠ y in 𝓝 x, c ∈ t y) : ∃ g : C(X, E), ∀ x, g x ∈ t x :=
  exists_continuous_forall_mem_convex_of_local ht fun x =>
    let ⟨c, hc⟩ := H x
    ⟨_, hc, fun _ => c, continuousOn_const, fun y => id⟩
#align exists_continuous_forall_mem_convex_of_local_const exists_continuous_forall_mem_convex_of_local_const


import data.fintype.basic
import data.real.basic
import data.matrix.basic
import linear_algebra.matrix
import analysis.calculus.fderiv
import analysis.calculus.deriv

open_locale matrix big_operators complex_conjugate
open fintype finset matrix complex
open_locale topological_space classical nnreal filter asymptotics ennreal
local attribute [instance] real.nondiscrete_normed_field matrix.normed_group matrix.normed_space -- introduce an arbitrary canonical instance of normed_group and normed_space.

noncomputable theory

variable n: ℕ
def mat := matrix (fin n) (fin n) ℝ -- mat n is square matrix of size n
variable A : ℝ -> (mat n) -- A is any map from R to square matrix of size n
def 𝕜 := ℝ -- it's not scaling factor σ (see notation); it's the common semiring of the two modules you are operating.

-- some examples for understanding:
  -- dA / dt, under regular derivative.
  noncomputable def DA [normed_group (mat n)] [normed_space ℝ (mat n)] (x: ℝ): (mat n) := deriv A x

  -- Frechet dA / dt, under arbitrary canonical norm on vector space of matrices.
  noncomputable def DA_fderiv [normed_group (mat n)] [normed_space ℝ (mat n)] (x: ℝ): (mat n) := fderiv ℝ A x (1: ℝ)

  -- Frechet dA / dt == dA / dt as in usual derivative.
  lemma triv [normed_group (mat n)] [normed_space ℝ (mat n)] : DA = DA_fderiv := begin
    sorry
    -- strangely, unable to fold def
  end
  -- we can further prove the deriv corresponds to elementwise derivative from two applications of has_deriv_at_pi
  lemma triv2 [normed_group (mat n)] [normed_space ℝ (mat n)] : ∀x, deriv A x = fderiv ℝ A x (1: ℝ) := begin
    unfold deriv, intro x, refl,
  end

  -- d det A(t) / dt, under arbitrary canonical norm on vector space of matrices.
  noncomputable def DDetA (x: ℝ) := fderiv ℝ (det ∘ A) x

-- Jacobi's Formula: For any differentiable map A, ...
theorem jacobi [normed_group (mat n)] [normed_space ℝ (mat n)]:
  ∀(x: ℝ) , differentiable_at ℝ A x -> deriv (det ∘ A) x = trace (fin n) ℝ ℝ (adjugate(A x) ⬝ (deriv A x)) :=
begin
  intro x,

  set f'comp := deriv (det ∘ A) with hmh,
  set f'det: mat n →L[ℝ] ℝ := fderiv ℝ det (A x) with f1h,
  set f'A:  ℝ →L[ℝ] (mat n) := fderiv ℝ A x with f2h,

  -- L1
  have L1: f'comp = f'det ∘ f'A := begin
    have hg : has_fderiv_at det (f'det: (matrix (fin n) (fin n) ℝ) →L[ℝ] ℝ) (A x),

  end

end


/-
Copyright (c) 2020 Yury Kudryashov All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov, Heather Macbeth
-/
import analysis.normed_space.operator_norm
import analysis.normed_space.extend
import analysis.convex.cone
import data.complex.is_R_or_C

/-!
# Hahn-Banach theorem

In this file we prove a version of Hahn-Banach theorem for continuous linear
functions on normed spaces over `ℝ` and `ℂ`.

In order to state and prove its corollaries uniformly, we prove the statements for a field `𝕜`
satisfying `is_R_or_C 𝕜`.

In this setting, `exists_dual_vector` states that, for any nonzero `x`, there exists a continuous
linear form `g` of norm `1` with `g x = ∥x∥` (where the norm has to be interpreted as an element
of `𝕜`).

-/

universes u v

/--
The norm of `x` as an element of `𝕜` (a normed algebra over `ℝ`). This is needed in particular to
state equalities of the form `g x = norm' 𝕜 x` when `g` is a linear function.

For the concrete cases of `ℝ` and `ℂ`, this is just `∥x∥` and `↑∥x∥`, respectively.
-/
noncomputable def norm' (𝕜 : Type*) [nondiscrete_normed_field 𝕜] [semi_normed_algebra ℝ 𝕜]
  {E : Type*} [semi_normed_group E] (x : E) : 𝕜 :=
algebra_map ℝ 𝕜 ∥x∥

lemma norm'_def (𝕜 : Type*) [nondiscrete_normed_field 𝕜] [semi_normed_algebra ℝ 𝕜]
  {E : Type*} [semi_normed_group E] (x : E) :
  norm' 𝕜 x = (algebra_map ℝ 𝕜 ∥x∥) := rfl

lemma norm_norm'
  (𝕜 : Type*) [nondiscrete_normed_field 𝕜] [semi_normed_algebra ℝ 𝕜]
  (A : Type*) [semi_normed_group A]
  (x : A) : ∥norm' 𝕜 x∥ = ∥x∥ :=
by rw [norm'_def, norm_algebra_map_eq, norm_norm]

namespace real
variables {E : Type*} [semi_normed_group E] [semi_normed_space ℝ E]

/-- Hahn-Banach theorem for continuous linear functions over `ℝ`. -/
theorem exists_extension_norm_eq (p : subspace ℝ E) (f : p →L[ℝ] ℝ) :
  ∃ g : E →L[ℝ] ℝ, (∀ x : p, g x = f x) ∧ ∥g∥ = ∥f∥ :=
begin
  rcases exists_extension_of_le_sublinear ⟨p, f⟩ (λ x, ∥f∥ * ∥x∥)
    (λ c hc x, by simp only [norm_smul c x, real.norm_eq_abs, abs_of_pos hc, mul_left_comm])
    (λ x y, _) (λ x, le_trans (le_abs_self _) (f.le_op_norm _))
    with ⟨g, g_eq, g_le⟩,
  set g' := g.mk_continuous (∥f∥)
    (λ x, abs_le.2 ⟨neg_le.1 $ g.map_neg x ▸ norm_neg x ▸ g_le (-x), g_le x⟩),
  { refine ⟨g', g_eq, _⟩,
    { apply le_antisymm (g.mk_continuous_norm_le (norm_nonneg f) _),
      refine f.op_norm_le_bound (norm_nonneg _) (λ x, _),
      dsimp at g_eq,
      rw ← g_eq,
      apply g'.le_op_norm } },
  { simp only [← mul_add],
    exact mul_le_mul_of_nonneg_left (norm_add_le x y) (norm_nonneg f) }
end

end real

section is_R_or_C
open is_R_or_C

variables {𝕜 : Type*} [is_R_or_C 𝕜] {F : Type*} [semi_normed_group F] [semi_normed_space 𝕜 F]

/-- Hahn-Banach theorem for continuous linear functions over `𝕜` satisyfing `is_R_or_C 𝕜`. -/
theorem exists_extension_norm_eq (p : subspace 𝕜 F) (f : p →L[𝕜] 𝕜) :
  ∃ g : F →L[𝕜] 𝕜, (∀ x : p, g x = f x) ∧ ∥g∥ = ∥f∥ :=
begin
  letI : module ℝ F := restrict_scalars.module ℝ 𝕜 F,
  letI : is_scalar_tower ℝ 𝕜 F := restrict_scalars.is_scalar_tower _ _ _,
  letI : semi_normed_space ℝ F := semi_normed_space.restrict_scalars _ 𝕜 _,
  -- Let `fr: p →L[ℝ] ℝ` be the real part of `f`.
  let fr := re_clm.comp (f.restrict_scalars ℝ),
  have fr_apply : ∀ x, fr x = re (f x), by { assume x, refl },
  -- Use the real version to get a norm-preserving extension of `fr`, which
  -- we'll call `g : F →L[ℝ] ℝ`.
  rcases real.exists_extension_norm_eq (p.restrict_scalars ℝ) fr with ⟨g, ⟨hextends, hnormeq⟩⟩,
  -- Now `g` can be extended to the `F →L[𝕜] 𝕜` we need.
  use g.extend_to_𝕜,
  -- It is an extension of `f`.
  have h : ∀ x : p, g.extend_to_𝕜 x = f x,
  { assume x,
    rw [continuous_linear_map.extend_to_𝕜_apply, ←submodule.coe_smul, hextends, hextends],
    have : (fr x : 𝕜) - I * ↑(fr (I • x)) = (re (f x) : 𝕜) - (I : 𝕜) * (re (f ((I : 𝕜) • x))),
      by refl,
    rw this,
    apply ext,
    { simp only [add_zero, algebra.id.smul_eq_mul, I_re, of_real_im, add_monoid_hom.map_add,
        zero_sub, I_im', zero_mul, of_real_re, eq_self_iff_true, sub_zero, mul_neg_eq_neg_mul_symm,
        of_real_neg, mul_re, mul_zero, sub_neg_eq_add, continuous_linear_map.map_smul] },
    { simp only [algebra.id.smul_eq_mul, I_re, of_real_im, add_monoid_hom.map_add, zero_sub, I_im',
        zero_mul, of_real_re, mul_neg_eq_neg_mul_symm, mul_im, zero_add, of_real_neg, mul_re,
        sub_neg_eq_add, continuous_linear_map.map_smul] } },
  refine ⟨h, _⟩,
  -- And we derive the equality of the norms by bounding on both sides.
  refine le_antisymm _ _,
  { calc ∥g.extend_to_𝕜∥
        ≤ ∥g∥ : g.extend_to_𝕜.op_norm_le_bound g.op_norm_nonneg (norm_bound _)
    ... = ∥fr∥ : hnormeq
    ... ≤ ∥re_clm∥ * ∥f∥ : continuous_linear_map.op_norm_comp_le _ _
    ... = ∥f∥ : by rw [re_clm_norm, one_mul] },
  { exact f.op_norm_le_bound g.extend_to_𝕜.op_norm_nonneg (λ x, h x ▸ g.extend_to_𝕜.le_op_norm x) },
end

end is_R_or_C

section dual_vector
variables {𝕜 : Type v} [is_R_or_C 𝕜]
variables {E : Type u} [normed_group E] [normed_space 𝕜 E]

open continuous_linear_equiv submodule
open_locale classical

lemma coord_norm' (x : E) (h : x ≠ 0) : ∥norm' 𝕜 x • coord 𝕜 x h∥ = 1 :=
by rw [norm_smul, norm_norm', coord_norm, mul_inv_cancel (mt norm_eq_zero.mp h)]

/-- Corollary of Hahn-Banach.  Given a nonzero element `x` of a normed space, there exists an
    element of the dual space, of norm `1`, whose value on `x` is `∥x∥`. -/
theorem exists_dual_vector (x : E) (h : x ≠ 0) : ∃ g : E →L[𝕜] 𝕜, ∥g∥ = 1 ∧ g x = norm' 𝕜 x :=
begin
  let p : submodule 𝕜 E := 𝕜 ∙ x,
  let f := norm' 𝕜 x • coord 𝕜 x h,
  obtain ⟨g, hg⟩ := exists_extension_norm_eq p f,
  use g, split,
  { rw [hg.2, coord_norm'] },
  { calc g x = g (⟨x, mem_span_singleton_self x⟩ : 𝕜 ∙ x) : by rw coe_mk
    ... = (norm' 𝕜 x • coord 𝕜 x h) (⟨x, mem_span_singleton_self x⟩ : 𝕜 ∙ x) : by rw ← hg.1
    ... = norm' 𝕜 x : by simp }
end

/-- Variant of Hahn-Banach, eliminating the hypothesis that `x` be nonzero, and choosing
    the dual element arbitrarily when `x = 0`. -/
theorem exists_dual_vector' [nontrivial E] (x : E) :
  ∃ g : E →L[𝕜] 𝕜, ∥g∥ = 1 ∧ g x = norm' 𝕜 x :=
begin
  by_cases hx : x = 0,
  { obtain ⟨y, hy⟩ := exists_ne (0 : E),
    obtain ⟨g, hg⟩ : ∃ g : E →L[𝕜] 𝕜, ∥g∥ = 1 ∧ g y = norm' 𝕜 y := exists_dual_vector y hy,
    refine ⟨g, hg.left, _⟩,
    rw [norm'_def, hx, norm_zero, ring_hom.map_zero, continuous_linear_map.map_zero] },
  { exact exists_dual_vector x hx }
end

end dual_vector


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

! This file was ported from Lean 3 source module algebraic_topology.dold_kan.functor_gamma
! leanprover-community/mathlib commit 5b8284148e8149728f4b90624888d98c36284454
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.AlgebraicTopology.DoldKan.SplitSimplicialObject

/-!

# Construction of the inverse functor of the Dold-Kan equivalence

In this file, we construct the functor `Γ₀ : chain_complex C ℕ ⥤ simplicial_object C`
which shall be the inverse functor of the Dold-Kan equivalence in the case of abelian categories,
and more generally pseudoabelian categories.

By definition, when `K` is a chain_complex, `Γ₀.obj K` is a simplicial object which
sends `Δ : simplex_categoryᵒᵖ` to a certain coproduct indexed by the set
`splitting.index_set Δ` whose elements consists of epimorphisms `e : Δ.unop ⟶ Δ'.unop`
(with `Δ' : simplex_categoryᵒᵖ`); the summand attached to such an `e` is `K.X Δ'.unop.len`.
By construction, `Γ₀.obj K` is a split simplicial object whose splitting is `Γ₀.splitting K`.

We also construct `Γ₂ : karoubi (chain_complex C ℕ) ⥤ karoubi (simplicial_object C)`
which shall be an equivalence for any additive category `C`.

-/

noncomputable section

open
  CategoryTheory CategoryTheory.Category CategoryTheory.Limits SimplexCategory SimplicialObject Opposite CategoryTheory.Idempotents

open Simplicial DoldKan

namespace AlgebraicTopology

namespace DoldKan

variable {C : Type _} [Category C] [Preadditive C] (K K' : ChainComplex C ℕ) (f : K ⟶ K')
  {Δ'' Δ' Δ : SimplexCategory} (i' : Δ'' ⟶ Δ') [Mono i'] (i : Δ' ⟶ Δ) [Mono i]

/-- `is_δ₀ i` is a simple condition used to check whether a monomorphism `i` in
`simplex_category` identifies to the coface map `δ 0`. -/
@[nolint unused_arguments]
def Isδ₀ {Δ Δ' : SimplexCategory} (i : Δ' ⟶ Δ) [Mono i] : Prop :=
  Δ.len = Δ'.len + 1 ∧ i.toOrderHom 0 ≠ 0
#align algebraic_topology.dold_kan.is_δ₀ AlgebraicTopology.DoldKan.Isδ₀

namespace Isδ₀

theorem iff {j : ℕ} {i : Fin (j + 2)} : Isδ₀ (SimplexCategory.δ i) ↔ i = 0 :=
  by
  constructor
  · rintro ⟨h₁, h₂⟩
    by_contra
    exact h₂ (Fin.succAbove_ne_zero_zero h)
  · rintro rfl
    exact ⟨rfl, Fin.succ_ne_zero _⟩
#align algebraic_topology.dold_kan.is_δ₀.iff AlgebraicTopology.DoldKan.Isδ₀.iff

theorem eq_δ₀ {n : ℕ} {i : [n] ⟶ [n + 1]} [Mono i] (hi : Isδ₀ i) : i = SimplexCategory.δ 0 :=
  by
  obtain ⟨j, rfl⟩ := SimplexCategory.eq_δ_of_mono i
  rw [Iff] at hi
  rw [hi]
#align algebraic_topology.dold_kan.is_δ₀.eq_δ₀ AlgebraicTopology.DoldKan.Isδ₀.eq_δ₀

end Isδ₀

namespace Γ₀

namespace Obj

/-- In the definition of `(Γ₀.obj K).obj Δ` as a direct sum indexed by `A : splitting.index_set Δ`,
the summand `summand K Δ A` is `K.X A.1.len`. -/
def summand (Δ : SimplexCategoryᵒᵖ) (A : Splitting.IndexSet Δ) : C :=
  K.pt A.1.unop.len
#align algebraic_topology.dold_kan.Γ₀.obj.summand AlgebraicTopology.DoldKan.Γ₀.Obj.summand

/-- The functor `Γ₀` sends a chain complex `K` to the simplicial object which
sends `Δ` to the direct sum of the objects `summand K Δ A` for all `A : splitting.index_set Δ` -/
def obj₂ (K : ChainComplex C ℕ) (Δ : SimplexCategoryᵒᵖ) [HasFiniteCoproducts C] : C :=
  ∐ fun A : Splitting.IndexSet Δ => summand K Δ A
#align algebraic_topology.dold_kan.Γ₀.obj.obj₂ AlgebraicTopology.DoldKan.Γ₀.Obj.obj₂

namespace Termwise

/-- A monomorphism `i : Δ' ⟶ Δ` induces a morphism `K.X Δ.len ⟶ K.X Δ'.len` which
is the identity if `Δ = Δ'`, the differential on the complex `K` if `i = δ 0`, and
zero otherwise. -/
def mapMono (K : ChainComplex C ℕ) {Δ' Δ : SimplexCategory} (i : Δ' ⟶ Δ) [Mono i] :
    K.pt Δ.len ⟶ K.pt Δ'.len := by
  by_cases Δ = Δ'
  · exact eq_to_hom (by congr )
  · by_cases is_δ₀ i
    · exact K.d Δ.len Δ'.len
    · exact 0
#align algebraic_topology.dold_kan.Γ₀.obj.termwise.map_mono AlgebraicTopology.DoldKan.Γ₀.Obj.Termwise.mapMono

variable (Δ)

theorem mapMono_id : mapMono K (𝟙 Δ) = 𝟙 _ :=
  by
  unfold map_mono
  simp only [eq_self_iff_true, eq_to_hom_refl, dite_eq_ite, if_true]
#align algebraic_topology.dold_kan.Γ₀.obj.termwise.map_mono_id AlgebraicTopology.DoldKan.Γ₀.Obj.Termwise.mapMono_id

variable {Δ}

theorem mapMono_δ₀' (hi : Isδ₀ i) : mapMono K i = K.d Δ.len Δ'.len :=
  by
  unfold map_mono
  classical
    rw [dif_neg, dif_pos hi]
    rintro rfl
    simpa only [self_eq_add_right, Nat.one_ne_zero] using hi.1
#align algebraic_topology.dold_kan.Γ₀.obj.termwise.map_mono_δ₀' AlgebraicTopology.DoldKan.Γ₀.Obj.Termwise.mapMono_δ₀'

@[simp]
theorem mapMono_δ₀ {n : ℕ} : mapMono K (δ (0 : Fin (n + 2))) = K.d (n + 1) n :=
  mapMono_δ₀' K _ (by rw [is_δ₀.iff])
#align algebraic_topology.dold_kan.Γ₀.obj.termwise.map_mono_δ₀ AlgebraicTopology.DoldKan.Γ₀.Obj.Termwise.mapMono_δ₀

theorem mapMono_eq_zero (h₁ : Δ ≠ Δ') (h₂ : ¬Isδ₀ i) : mapMono K i = 0 :=
  by
  unfold map_mono
  rw [Ne.def] at h₁
  split_ifs
  rfl
#align algebraic_topology.dold_kan.Γ₀.obj.termwise.map_mono_eq_zero AlgebraicTopology.DoldKan.Γ₀.Obj.Termwise.mapMono_eq_zero

variable {K K'}

@[simp, reassoc.1]
theorem mapMono_naturality : mapMono K i ≫ f.f Δ'.len = f.f Δ.len ≫ mapMono K' i :=
  by
  unfold map_mono
  split_ifs
  · subst h
    simp only [id_comp, eq_to_hom_refl, comp_id]
  · rw [HomologicalComplex.Hom.comm]
  · rw [zero_comp, comp_zero]
#align algebraic_topology.dold_kan.Γ₀.obj.termwise.map_mono_naturality AlgebraicTopology.DoldKan.Γ₀.Obj.Termwise.mapMono_naturality

variable (K)

@[simp, reassoc.1]
theorem mapMono_comp : mapMono K i ≫ mapMono K i' = mapMono K (i' ≫ i) :=
  by
  -- case where i : Δ' ⟶ Δ is the identity
  by_cases h₁ : Δ = Δ'
  · subst h₁
    simp only [SimplexCategory.eq_id_of_mono i, comp_id, id_comp, map_mono_id K, eq_to_hom_refl]
  -- case where i' : Δ'' ⟶ Δ' is the identity
  by_cases h₂ : Δ' = Δ''
  · subst h₂
    simp only [SimplexCategory.eq_id_of_mono i', comp_id, id_comp, map_mono_id K, eq_to_hom_refl]
  -- then the RHS is always zero
  obtain ⟨k, hk⟩ := Nat.exists_eq_add_of_lt (len_lt_of_mono i h₁)
  obtain ⟨k', hk'⟩ := Nat.exists_eq_add_of_lt (len_lt_of_mono i' h₂)
  have eq : Δ.len = Δ''.len + (k + k' + 2) := by linarith
  rw [map_mono_eq_zero K (i' ≫ i) _ _]; rotate_left
  · by_contra
    simpa only [self_eq_add_right, h] using Eq
  · by_contra
    simp only [h.1, add_right_inj] at eq
    linarith
  -- in all cases, the LHS is also zero, either by definition, or because d ≫ d = 0
  by_cases h₃ : is_δ₀ i
  · by_cases h₄ : is_δ₀ i'
    · rw [map_mono_δ₀' K i h₃, map_mono_δ₀' K i' h₄, HomologicalComplex.d_comp_d]
    · simp only [map_mono_eq_zero K i' h₂ h₄, comp_zero]
  · simp only [map_mono_eq_zero K i h₁ h₃, zero_comp]
#align algebraic_topology.dold_kan.Γ₀.obj.termwise.map_mono_comp AlgebraicTopology.DoldKan.Γ₀.Obj.Termwise.mapMono_comp

end Termwise

variable [HasFiniteCoproducts C]

/-- The simplicial morphism on the simplicial object `Γ₀.obj K` induced by
a morphism `Δ' → Δ` in `simplex_category` is defined on each summand
associated to an `A : Γ_index_set Δ` in terms of the epi-mono factorisation
of `θ ≫ A.e`. -/
def map (K : ChainComplex C ℕ) {Δ' Δ : SimplexCategoryᵒᵖ} (θ : Δ ⟶ Δ') : obj₂ K Δ ⟶ obj₂ K Δ' :=
  Sigma.desc fun A =>
    Termwise.mapMono K (image.ι (θ.unop ≫ A.e)) ≫ Sigma.ι (summand K Δ') (A.pull θ)
#align algebraic_topology.dold_kan.Γ₀.obj.map AlgebraicTopology.DoldKan.Γ₀.Obj.map

@[reassoc.1]
theorem map_on_summand₀ {Δ Δ' : SimplexCategoryᵒᵖ} (A : Splitting.IndexSet Δ) {θ : Δ ⟶ Δ'}
    {Δ'' : SimplexCategory} {e : Δ'.unop ⟶ Δ''} {i : Δ'' ⟶ A.1.unop} [Epi e] [Mono i]
    (fac : e ≫ i = θ.unop ≫ A.e) :
    Sigma.ι (summand K Δ) A ≫ map K θ =
      Termwise.mapMono K i ≫ Sigma.ι (summand K Δ') (Splitting.IndexSet.mk e) :=
  by
  simp only [map, colimit.ι_desc, cofan.mk_ι_app]
  have h := SimplexCategory.image_eq fac
  subst h
  congr
  · exact SimplexCategory.image_ι_eq fac
  · dsimp only [SimplicialObject.Splitting.IndexSet.pull]
    congr
    exact SimplexCategory.factorThruImage_eq fac
#align algebraic_topology.dold_kan.Γ₀.obj.map_on_summand₀ AlgebraicTopology.DoldKan.Γ₀.Obj.map_on_summand₀

@[reassoc.1]
theorem map_on_summand₀' {Δ Δ' : SimplexCategoryᵒᵖ} (A : Splitting.IndexSet Δ) (θ : Δ ⟶ Δ') :
    Sigma.ι (summand K Δ) A ≫ map K θ =
      Termwise.mapMono K (image.ι (θ.unop ≫ A.e)) ≫ Sigma.ι (summand K _) (A.pull θ) :=
  map_on_summand₀ K A (A.fac_pull θ)
#align algebraic_topology.dold_kan.Γ₀.obj.map_on_summand₀' AlgebraicTopology.DoldKan.Γ₀.Obj.map_on_summand₀'

end Obj

variable [HasFiniteCoproducts C]

/-- The functor `Γ₀ : chain_complex C ℕ ⥤ simplicial_object C`, on objects. -/
@[simps]
def obj (K : ChainComplex C ℕ) : SimplicialObject C
    where
  obj Δ := Obj.obj₂ K Δ
  map Δ Δ' θ := Obj.map K θ
  map_id' Δ := by
    ext A
    cases A
    have fac : A.e ≫ 𝟙 A.1.unop = (𝟙 Δ).unop ≫ A.e := by rw [unop_id, comp_id, id_comp]
    erw [obj.map_on_summand₀ K A fac, obj.termwise.map_mono_id, id_comp, comp_id]
    rcases A with ⟨Δ', ⟨e, he⟩⟩
    rfl
  map_comp' Δ'' Δ' Δ θ' θ := by
    ext A
    cases A
    have fac : θ.unop ≫ θ'.unop ≫ A.e = (θ' ≫ θ).unop ≫ A.e := by rw [unop_comp, assoc]
    rw [← image.fac (θ'.unop ≫ A.e), ← assoc, ←
      image.fac (θ.unop ≫ factor_thru_image (θ'.unop ≫ A.e)), assoc] at fac
    simpa only [obj.map_on_summand₀'_assoc K A θ', obj.map_on_summand₀' K _ θ,
      obj.termwise.map_mono_comp_assoc, obj.map_on_summand₀ K A fac]
#align algebraic_topology.dold_kan.Γ₀.obj AlgebraicTopology.DoldKan.Γ₀.obj

/- ./././Mathport/Syntax/Translate/Tactic/Builtin.lean:73:14: unsupported tactic `discrete_cases #[] -/
theorem splitting_map_eq_id (Δ : SimplexCategoryᵒᵖ) :
    SimplicialObject.Splitting.map (Γ₀.obj K)
        (fun n : ℕ => Sigma.ι (Γ₀.Obj.summand K (op [n])) (Splitting.IndexSet.id (op [n]))) Δ =
      𝟙 _ :=
  by
  ext A
  trace
    "./././Mathport/Syntax/Translate/Tactic/Builtin.lean:73:14: unsupported tactic `discrete_cases #[]"
  induction Δ using Opposite.rec
  induction' Δ with n
  dsimp
  simp only [colimit.ι_desc, cofan.mk_ι_app, comp_id, Γ₀.obj_map]
  rw [Γ₀.obj.map_on_summand₀ K (SimplicialObject.Splitting.IndexSet.id A.1)
      (show A.e ≫ 𝟙 _ = A.e.op.unop ≫ 𝟙 _ by rfl),
    Γ₀.obj.termwise.map_mono_id, A.ext']
  apply id_comp
#align algebraic_topology.dold_kan.Γ₀.splitting_map_eq_id AlgebraicTopology.DoldKan.Γ₀.splitting_map_eq_id

/-- By construction, the simplicial `Γ₀.obj K` is equipped with a splitting. -/
def splitting (K : ChainComplex C ℕ) : SimplicialObject.Splitting (Γ₀.obj K)
    where
  n n := K.pt n
  ι n := Sigma.ι (Γ₀.Obj.summand K (op [n])) (Splitting.IndexSet.id (op [n]))
  map_is_iso' Δ := by
    rw [Γ₀.splitting_map_eq_id]
    apply is_iso.id
#align algebraic_topology.dold_kan.Γ₀.splitting AlgebraicTopology.DoldKan.Γ₀.splitting

@[simp]
theorem splitting_iso_hom_eq_id (Δ : SimplexCategoryᵒᵖ) : ((splitting K).Iso Δ).Hom = 𝟙 _ :=
  splitting_map_eq_id K Δ
#align algebraic_topology.dold_kan.Γ₀.splitting_iso_hom_eq_id AlgebraicTopology.DoldKan.Γ₀.splitting_iso_hom_eq_id

@[reassoc.1]
theorem obj.map_on_summand {Δ Δ' : SimplexCategoryᵒᵖ} (A : Splitting.IndexSet Δ) (θ : Δ ⟶ Δ')
    {Δ'' : SimplexCategory} {e : Δ'.unop ⟶ Δ''} {i : Δ'' ⟶ A.1.unop} [Epi e] [Mono i]
    (fac : e ≫ i = θ.unop ≫ A.e) :
    (Γ₀.splitting K).ιSummand A ≫ (Γ₀.obj K).map θ =
      Γ₀.Obj.Termwise.mapMono K i ≫ (Γ₀.splitting K).ιSummand (Splitting.IndexSet.mk e) :=
  by
  dsimp only [SimplicialObject.Splitting.ιSummand, SimplicialObject.Splitting.ιCoprod]
  simp only [assoc, Γ₀.splitting_iso_hom_eq_id, id_comp, comp_id]
  exact Γ₀.obj.map_on_summand₀ K A fac
#align algebraic_topology.dold_kan.Γ₀.obj.map_on_summand AlgebraicTopology.DoldKan.Γ₀.obj.map_on_summand

@[reassoc.1]
theorem obj.map_on_summand' {Δ Δ' : SimplexCategoryᵒᵖ} (A : Splitting.IndexSet Δ) (θ : Δ ⟶ Δ') :
    (splitting K).ιSummand A ≫ (obj K).map θ =
      Obj.Termwise.mapMono K (image.ι (θ.unop ≫ A.e)) ≫ (splitting K).ιSummand (A.pull θ) :=
  by
  apply obj.map_on_summand
  apply image.fac
#align algebraic_topology.dold_kan.Γ₀.obj.map_on_summand' AlgebraicTopology.DoldKan.Γ₀.obj.map_on_summand'

@[reassoc.1]
theorem obj.mapMono_on_summand_id {Δ Δ' : SimplexCategory} (i : Δ' ⟶ Δ) [Mono i] :
    (splitting K).ιSummand (Splitting.IndexSet.id (op Δ)) ≫ (obj K).map i.op =
      Obj.Termwise.mapMono K i ≫ (splitting K).ιSummand (Splitting.IndexSet.id (op Δ')) :=
  obj.map_on_summand K (Splitting.IndexSet.id (op Δ)) i.op (rfl : 𝟙 _ ≫ i = i ≫ 𝟙 _)
#align algebraic_topology.dold_kan.Γ₀.obj.map_mono_on_summand_id AlgebraicTopology.DoldKan.Γ₀.obj.mapMono_on_summand_id

@[reassoc.1]
theorem obj.map_epi_on_summand_id {Δ Δ' : SimplexCategory} (e : Δ' ⟶ Δ) [Epi e] :
    (Γ₀.splitting K).ιSummand (Splitting.IndexSet.id (op Δ)) ≫ (Γ₀.obj K).map e.op =
      (Γ₀.splitting K).ιSummand (Splitting.IndexSet.mk e) :=
  by
  simpa only [Γ₀.obj.map_on_summand K (splitting.index_set.id (op Δ)) e.op
      (rfl : e ≫ 𝟙 Δ = e ≫ 𝟙 Δ),
    Γ₀.obj.termwise.map_mono_id] using id_comp _
#align algebraic_topology.dold_kan.Γ₀.obj.map_epi_on_summand_id AlgebraicTopology.DoldKan.Γ₀.obj.map_epi_on_summand_id

/-- The functor `Γ₀ : chain_complex C ℕ ⥤ simplicial_object C`, on morphisms. -/
@[simps]
def map {K K' : ChainComplex C ℕ} (f : K ⟶ K') : obj K ⟶ obj K'
    where
  app Δ := (Γ₀.splitting K).desc Δ fun A => f.f A.1.unop.len ≫ (Γ₀.splitting K').ιSummand A
  naturality' Δ' Δ θ := by
    apply (Γ₀.splitting K).hom_ext'
    intro A
    simp only [(splitting K).ι_desc_assoc, obj.map_on_summand'_assoc K _ θ, (splitting K).ι_desc,
      assoc, obj.map_on_summand' K' _ θ]
    apply obj.termwise.map_mono_naturality_assoc
#align algebraic_topology.dold_kan.Γ₀.map AlgebraicTopology.DoldKan.Γ₀.map

end Γ₀

variable [HasFiniteCoproducts C]

/-- The functor `Γ₀' : chain_complex C ℕ ⥤ simplicial_object.split C`
that induces `Γ₀ : chain_complex C ℕ ⥤ simplicial_object C`, which
shall be the inverse functor of the Dold-Kan equivalence for
abelian or pseudo-abelian categories. -/
@[simps]
def Γ₀' : ChainComplex C ℕ ⥤ SimplicialObject.Split C
    where
  obj K := SimplicialObject.Split.mk' (Γ₀.splitting K)
  map K K' f :=
    { f := Γ₀.map f
      f := f.f
      comm' := fun n => by
        dsimp
        simpa only [← splitting.ι_summand_id, (Γ₀.splitting K).ι_desc] }
#align algebraic_topology.dold_kan.Γ₀' AlgebraicTopology.DoldKan.Γ₀'

/-- The functor `Γ₀ : chain_complex C ℕ ⥤ simplicial_object C`, which is
the inverse functor of the Dold-Kan equivalence when `C` is an abelian
category, or more generally a pseudoabelian category. -/
@[simps]
def Γ₀ : ChainComplex C ℕ ⥤ SimplicialObject C :=
  Γ₀' ⋙ Split.forget _
#align algebraic_topology.dold_kan.Γ₀ AlgebraicTopology.DoldKan.Γ₀

/-- The extension of `Γ₀ : chain_complex C ℕ ⥤ simplicial_object C`
on the idempotent completions. It shall be an equivalence of categories
for any additive category `C`. -/
@[simps]
def Γ₂ : Karoubi (ChainComplex C ℕ) ⥤ Karoubi (SimplicialObject C) :=
  (CategoryTheory.Idempotents.functorExtension₂ _ _).obj Γ₀
#align algebraic_topology.dold_kan.Γ₂ AlgebraicTopology.DoldKan.Γ₂

theorem HigherFacesVanish.on_Γ₀_summand_id (K : ChainComplex C ℕ) (n : ℕ) :
    HigherFacesVanish (n + 1) ((Γ₀.splitting K).ιSummand (Splitting.IndexSet.id (op [n + 1]))) :=
  by
  intro j hj
  have eq := Γ₀.obj.map_mono_on_summand_id K (SimplexCategory.δ j.succ)
  rw [Γ₀.obj.termwise.map_mono_eq_zero K, zero_comp] at eq; rotate_left
  · intro h
    exact (Nat.succ_ne_self n) (congr_arg SimplexCategory.len h)
  · exact fun h => Fin.succ_ne_zero j (by simpa only [is_δ₀.iff] using h)
  exact Eq
#align algebraic_topology.dold_kan.higher_faces_vanish.on_Γ₀_summand_id AlgebraicTopology.DoldKan.HigherFacesVanish.on_Γ₀_summand_id

@[simp, reassoc.1]
theorem pInfty_on_Γ₀_splitting_summand_eq_self (K : ChainComplex C ℕ) {n : ℕ} :
    (Γ₀.splitting K).ιSummand (Splitting.IndexSet.id (op [n])) ≫ (pInfty : K[Γ₀.obj K] ⟶ _).f n =
      (Γ₀.splitting K).ιSummand (Splitting.IndexSet.id (op [n])) :=
  by
  rw [P_infty_f]
  cases n
  · simpa only [P_f_0_eq] using comp_id _
  · exact (higher_faces_vanish.on_Γ₀_summand_id K n).comp_p_eq_self
#align algebraic_topology.dold_kan.P_infty_on_Γ₀_splitting_summand_eq_self AlgebraicTopology.DoldKan.pInfty_on_Γ₀_splitting_summand_eq_self

end DoldKan

end AlgebraicTopology


/-
Copyright © 2019, Oracle and/or its affiliates. All rights reserved.
-/

import analysis.complex.exponential
import ..lib.util

open real

noncomputable
def complexity (ε: ℝ) (δ: ℝ) : ℝ := (log(δ) / log(1 - ε)) - (1: nat)

lemma complexity_enough:
  ∀ ε: nnreal, ∀ δ: nnreal, ∀ n: ℕ,
  ε > (0: nnreal) → ε < (1: nnreal) → δ > (0: nnreal) → δ < (1: nnreal) →
  (n: ℝ) > (complexity ε δ) → ((1 - ε)^(n+1)) ≤ δ :=
begin
  unfold complexity,
  intros,
  have h0: ((1: nnreal) - ε) > 0, by change (0 < 1 - ε);rwa[nnreal.coe_pos, nnreal.coe_sub _ _ (le_of_lt (a_1)), sub_pos,←nnreal.coe_lt],
  rw log_le_log_nnreal ; try {assumption} ; try {exact pow_pos h0 (n + 1)},
  have h2:= log_pow_nnreal (1 - ε) h0 (n+1),
  unfold_coes at *,
  rw ← pow_coe,
  rw h2,
  apply mul_le_of_div_le_of_neg,
  {
    rw ←exp_lt_exp, simp, rw exp_log _,
    {
    rw sub_nnreal,
    cases ε,
    exact sub_lt_self 1 a,
    apply le_of_lt, assumption,
    },
    {
    rw sub_nnreal,
    cases ε,
    exact sub_pos.mpr a_1,
    apply le_of_lt, assumption,
    },
  },
  {
    apply le_of_lt,
    clear h2,
    have nat_cast_1: ∀ x: ℕ, (nat.cast x) + (1:ℝ) = nat.cast(x + 1), exact nat.cast_succ,
    rw ← nat_cast_1,
    have minus_nnreal: ∀ x: nnreal, x < 1 → (1 - x).val = 1 - x.val, assume x h, exact nnreal.coe_sub _ _ (le_of_lt h),
    rw minus_nnreal,
    swap, assumption,
    rw gt_from_lt at a_4,
    have plus_1:= add_lt_add_right a_4 1,
    simp at plus_1,
    simp,
    conv_rhs { rw add_comm, skip,},
    have one_coe: (1: ℝ) = nat.cast 1, by unfold nat.cast; simp,
    conv_rhs {rw one_coe, skip,},
    assumption,
  },
end


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

! This file was ported from Lean 3 source module ring_theory.graded_algebra.homogeneous_localization
! leanprover-community/mathlib commit 831c494092374cfe9f50591ed0ac81a25efc5b86
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.RingTheory.Localization.AtPrime
import Mathbin.RingTheory.GradedAlgebra.Basic

/-!
# Homogeneous Localization

## Notation
- `ι` is a commutative monoid;
- `R` is a commutative semiring;
- `A` is a commutative ring and an `R`-algebra;
- `𝒜 : ι → submodule R A` is the grading of `A`;
- `x : submonoid A` is a submonoid

## Main definitions and results

This file constructs the subring of `Aₓ` where the numerator and denominator have the same grading,
i.e. `{a/b ∈ Aₓ | ∃ (i : ι), a ∈ 𝒜ᵢ ∧ b ∈ 𝒜ᵢ}`.

* `homogeneous_localization.num_denom_same_deg`: a structure with a numerator and denominator field
  where they are required to have the same grading.

However `num_denom_same_deg 𝒜 x` cannot have a ring structure for many reasons, for example if `c`
is a `num_denom_same_deg`, then generally, `c + (-c)` is not necessarily `0` for degree reasons ---
`0` is considered to have grade zero (see `deg_zero`) but `c + (-c)` has the same degree as `c`. To
circumvent this, we quotient `num_denom_same_deg 𝒜 x` by the kernel of `c ↦ c.num / c.denom`.

* `homogeneous_localization.num_denom_same_deg.embedding` : for `x : submonoid A` and any
  `c : num_denom_same_deg 𝒜 x`, or equivalent a numerator and a denominator of the same degree,
  we get an element `c.num / c.denom` of `Aₓ`.
* `homogeneous_localization`: `num_denom_same_deg 𝒜 x` quotiented by kernel of `embedding 𝒜 x`.
* `homogeneous_localization.val`: if `f : homogeneous_localization 𝒜 x`, then `f.val` is an element
  of `Aₓ`. In another word, one can view `homogeneous_localization 𝒜 x` as a subring of `Aₓ`
  through `homogeneous_localization.val`.
* `homogeneous_localization.num`: if `f : homogeneous_localization 𝒜 x`, then `f.num : A` is the
  numerator of `f`.
* `homogeneous_localization.denom`: if `f : homogeneous_localization 𝒜 x`, then `f.denom : A` is the
  denominator of `f`.
* `homogeneous_localization.deg`: if `f : homogeneous_localization 𝒜 x`, then `f.deg : ι` is the
  degree of `f` such that `f.num ∈ 𝒜 f.deg` and `f.denom ∈ 𝒜 f.deg`
  (see `homogeneous_localization.num_mem_deg` and `homogeneous_localization.denom_mem_deg`).
* `homogeneous_localization.num_mem_deg`: if `f : homogeneous_localization 𝒜 x`, then
  `f.num_mem_deg` is a proof that `f.num ∈ 𝒜 f.deg`.
* `homogeneous_localization.denom_mem_deg`: if `f : homogeneous_localization 𝒜 x`, then
  `f.denom_mem_deg` is a proof that `f.denom ∈ 𝒜 f.deg`.
* `homogeneous_localization.eq_num_div_denom`: if `f : homogeneous_localization 𝒜 x`, then
  `f.val : Aₓ` is equal to `f.num / f.denom`.

* `homogeneous_localization.local_ring`: `homogeneous_localization 𝒜 x` is a local ring when `x` is
  the complement of some prime ideals.

## References

* [Robin Hartshorne, *Algebraic Geometry*][Har77]

-/

noncomputable section

open DirectSum BigOperators Pointwise

open DirectSum SetLike

variable {ι R A : Type _}

variable [AddCommMonoid ι] [DecidableEq ι]

variable [CommRing R] [CommRing A] [Algebra R A]

variable (𝒜 : ι → Submodule R A) [GradedAlgebra 𝒜]

variable (x : Submonoid A)

-- mathport name: «exprat »
local notation "at " x => Localization x

namespace HomogeneousLocalization

section

/--
Let `x` be a submonoid of `A`, then `num_denom_same_deg 𝒜 x` is a structure with a numerator and a
denominator with same grading such that the denominator is contained in `x`.
-/
@[nolint has_nonempty_instance]
structure NumDenomSameDeg where
  deg : ι
  (num den : 𝒜 deg)
  denom_mem : (denom : A) ∈ x
#align homogeneous_localization.num_denom_same_deg HomogeneousLocalization.NumDenomSameDeg

end

namespace NumDenomSameDeg

open SetLike.GradedMonoid Submodule

variable {𝒜}

@[ext]
theorem ext {c1 c2 : NumDenomSameDeg 𝒜 x} (hdeg : c1.deg = c2.deg) (hnum : (c1.num : A) = c2.num)
    (hdenom : (c1.den : A) = c2.den) : c1 = c2 :=
  by
  rcases c1 with ⟨i1, ⟨n1, hn1⟩, ⟨d1, hd1⟩, h1⟩
  rcases c2 with ⟨i2, ⟨n2, hn2⟩, ⟨d2, hd2⟩, h2⟩
  dsimp only [Subtype.coe_mk] at *
  simp only; exact ⟨hdeg, by subst hdeg <;> subst hnum, by subst hdeg <;> subst hdenom⟩
#align homogeneous_localization.num_denom_same_deg.ext HomogeneousLocalization.NumDenomSameDeg.ext

instance : One (NumDenomSameDeg 𝒜 x)
    where one :=
    { deg := 0
      num := ⟨1, one_mem⟩
      den := ⟨1, one_mem⟩
      denom_mem := Submonoid.one_mem _ }

@[simp]
theorem deg_one : (1 : NumDenomSameDeg 𝒜 x).deg = 0 :=
  rfl
#align homogeneous_localization.num_denom_same_deg.deg_one HomogeneousLocalization.NumDenomSameDeg.deg_one

@[simp]
theorem num_one : ((1 : NumDenomSameDeg 𝒜 x).num : A) = 1 :=
  rfl
#align homogeneous_localization.num_denom_same_deg.num_one HomogeneousLocalization.NumDenomSameDeg.num_one

@[simp]
theorem denom_one : ((1 : NumDenomSameDeg 𝒜 x).den : A) = 1 :=
  rfl
#align homogeneous_localization.num_denom_same_deg.denom_one HomogeneousLocalization.NumDenomSameDeg.denom_one

instance : Zero (NumDenomSameDeg 𝒜 x) where zero := ⟨0, 0, ⟨1, one_mem⟩, Submonoid.one_mem _⟩

@[simp]
theorem deg_zero : (0 : NumDenomSameDeg 𝒜 x).deg = 0 :=
  rfl
#align homogeneous_localization.num_denom_same_deg.deg_zero HomogeneousLocalization.NumDenomSameDeg.deg_zero

@[simp]
theorem num_zero : (0 : NumDenomSameDeg 𝒜 x).num = 0 :=
  rfl
#align homogeneous_localization.num_denom_same_deg.num_zero HomogeneousLocalization.NumDenomSameDeg.num_zero

@[simp]
theorem denom_zero : ((0 : NumDenomSameDeg 𝒜 x).den : A) = 1 :=
  rfl
#align homogeneous_localization.num_denom_same_deg.denom_zero HomogeneousLocalization.NumDenomSameDeg.denom_zero

instance : Mul (NumDenomSameDeg 𝒜 x)
    where mul p q :=
    { deg := p.deg + q.deg
      num := ⟨p.num * q.num, mul_mem p.num.Prop q.num.Prop⟩
      den := ⟨p.den * q.den, mul_mem p.den.Prop q.den.Prop⟩
      denom_mem := Submonoid.mul_mem _ p.denom_mem q.denom_mem }

@[simp]
theorem deg_mul (c1 c2 : NumDenomSameDeg 𝒜 x) : (c1 * c2).deg = c1.deg + c2.deg :=
  rfl
#align homogeneous_localization.num_denom_same_deg.deg_mul HomogeneousLocalization.NumDenomSameDeg.deg_mul

@[simp]
theorem num_mul (c1 c2 : NumDenomSameDeg 𝒜 x) : ((c1 * c2).num : A) = c1.num * c2.num :=
  rfl
#align homogeneous_localization.num_denom_same_deg.num_mul HomogeneousLocalization.NumDenomSameDeg.num_mul

@[simp]
theorem denom_mul (c1 c2 : NumDenomSameDeg 𝒜 x) : ((c1 * c2).den : A) = c1.den * c2.den :=
  rfl
#align homogeneous_localization.num_denom_same_deg.denom_mul HomogeneousLocalization.NumDenomSameDeg.denom_mul

instance : Add (NumDenomSameDeg 𝒜 x)
    where add c1 c2 :=
    { deg := c1.deg + c2.deg
      num :=
        ⟨c1.den * c2.num + c2.den * c1.num,
          add_mem (mul_mem c1.den.2 c2.num.2) (add_comm c2.deg c1.deg ▸ mul_mem c2.den.2 c1.num.2)⟩
      den := ⟨c1.den * c2.den, mul_mem c1.den.2 c2.den.2⟩
      denom_mem := Submonoid.mul_mem _ c1.denom_mem c2.denom_mem }

@[simp]
theorem deg_add (c1 c2 : NumDenomSameDeg 𝒜 x) : (c1 + c2).deg = c1.deg + c2.deg :=
  rfl
#align homogeneous_localization.num_denom_same_deg.deg_add HomogeneousLocalization.NumDenomSameDeg.deg_add

@[simp]
theorem num_add (c1 c2 : NumDenomSameDeg 𝒜 x) :
    ((c1 + c2).num : A) = c1.den * c2.num + c2.den * c1.num :=
  rfl
#align homogeneous_localization.num_denom_same_deg.num_add HomogeneousLocalization.NumDenomSameDeg.num_add

@[simp]
theorem denom_add (c1 c2 : NumDenomSameDeg 𝒜 x) : ((c1 + c2).den : A) = c1.den * c2.den :=
  rfl
#align homogeneous_localization.num_denom_same_deg.denom_add HomogeneousLocalization.NumDenomSameDeg.denom_add

instance : Neg (NumDenomSameDeg 𝒜 x)
    where neg c := ⟨c.deg, ⟨-c.num, neg_mem c.num.2⟩, c.den, c.denom_mem⟩

@[simp]
theorem deg_neg (c : NumDenomSameDeg 𝒜 x) : (-c).deg = c.deg :=
  rfl
#align homogeneous_localization.num_denom_same_deg.deg_neg HomogeneousLocalization.NumDenomSameDeg.deg_neg

@[simp]
theorem num_neg (c : NumDenomSameDeg 𝒜 x) : ((-c).num : A) = -c.num :=
  rfl
#align homogeneous_localization.num_denom_same_deg.num_neg HomogeneousLocalization.NumDenomSameDeg.num_neg

@[simp]
theorem denom_neg (c : NumDenomSameDeg 𝒜 x) : ((-c).den : A) = c.den :=
  rfl
#align homogeneous_localization.num_denom_same_deg.denom_neg HomogeneousLocalization.NumDenomSameDeg.denom_neg

instance : CommMonoid (NumDenomSameDeg 𝒜 x)
    where
  one := 1
  mul := (· * ·)
  mul_assoc c1 c2 c3 := ext _ (add_assoc _ _ _) (mul_assoc _ _ _) (mul_assoc _ _ _)
  one_mul c := ext _ (zero_add _) (one_mul _) (one_mul _)
  mul_one c := ext _ (add_zero _) (mul_one _) (mul_one _)
  mul_comm c1 c2 := ext _ (add_comm _ _) (mul_comm _ _) (mul_comm _ _)

instance : Pow (NumDenomSameDeg 𝒜 x) ℕ
    where pow c n :=
    ⟨n • c.deg, @GradedMonoid.GMonoid.gnpow _ (fun i => ↥(𝒜 i)) _ _ n _ c.num,
      @GradedMonoid.GMonoid.gnpow _ (fun i => ↥(𝒜 i)) _ _ n _ c.den,
      by
      induction' n with n ih
      · simpa only [coe_gnpow, pow_zero] using Submonoid.one_mem _
      · simpa only [pow_succ', coe_gnpow] using x.mul_mem ih c.denom_mem⟩

@[simp]
theorem deg_pow (c : NumDenomSameDeg 𝒜 x) (n : ℕ) : (c ^ n).deg = n • c.deg :=
  rfl
#align homogeneous_localization.num_denom_same_deg.deg_pow HomogeneousLocalization.NumDenomSameDeg.deg_pow

@[simp]
theorem num_pow (c : NumDenomSameDeg 𝒜 x) (n : ℕ) : ((c ^ n).num : A) = c.num ^ n :=
  rfl
#align homogeneous_localization.num_denom_same_deg.num_pow HomogeneousLocalization.NumDenomSameDeg.num_pow

@[simp]
theorem denom_pow (c : NumDenomSameDeg 𝒜 x) (n : ℕ) : ((c ^ n).den : A) = c.den ^ n :=
  rfl
#align homogeneous_localization.num_denom_same_deg.denom_pow HomogeneousLocalization.NumDenomSameDeg.denom_pow

section SMul

variable {α : Type _} [SMul α R] [SMul α A] [IsScalarTower α R A]

instance : SMul α (NumDenomSameDeg 𝒜 x) where smul m c := ⟨c.deg, m • c.num, c.den, c.denom_mem⟩

@[simp]
theorem deg_smul (c : NumDenomSameDeg 𝒜 x) (m : α) : (m • c).deg = c.deg :=
  rfl
#align homogeneous_localization.num_denom_same_deg.deg_smul HomogeneousLocalization.NumDenomSameDeg.deg_smul

@[simp]
theorem num_smul (c : NumDenomSameDeg 𝒜 x) (m : α) : ((m • c).num : A) = m • c.num :=
  rfl
#align homogeneous_localization.num_denom_same_deg.num_smul HomogeneousLocalization.NumDenomSameDeg.num_smul

@[simp]
theorem denom_smul (c : NumDenomSameDeg 𝒜 x) (m : α) : ((m • c).den : A) = c.den :=
  rfl
#align homogeneous_localization.num_denom_same_deg.denom_smul HomogeneousLocalization.NumDenomSameDeg.denom_smul

end SMul

variable (𝒜)

/-- For `x : prime ideal of A` and any `p : num_denom_same_deg 𝒜 x`, or equivalent a numerator and a
denominator of the same degree, we get an element `p.num / p.denom` of `Aₓ`.
-/
def embedding (p : NumDenomSameDeg 𝒜 x) : at x :=
  Localization.mk p.num ⟨p.den, p.denom_mem⟩
#align homogeneous_localization.num_denom_same_deg.embedding HomogeneousLocalization.NumDenomSameDeg.embedding

end NumDenomSameDeg

end HomogeneousLocalization

/--
For `x : prime ideal of A`, `homogeneous_localization 𝒜 x` is `num_denom_same_deg 𝒜 x` modulo the
kernel of `embedding 𝒜 x`. This is essentially the subring of `Aₓ` where the numerator and
denominator share the same grading.
-/
@[nolint has_nonempty_instance]
def HomogeneousLocalization : Type _ :=
  Quotient (Setoid.ker <| HomogeneousLocalization.NumDenomSameDeg.embedding 𝒜 x)
#align homogeneous_localization HomogeneousLocalization

namespace HomogeneousLocalization

open HomogeneousLocalization HomogeneousLocalization.NumDenomSameDeg

variable {𝒜} {x}

/-- View an element of `homogeneous_localization 𝒜 x` as an element of `Aₓ` by forgetting that the
numerator and denominator are of the same grading.
-/
def val (y : HomogeneousLocalization 𝒜 x) : at x :=
  Quotient.liftOn' y (NumDenomSameDeg.embedding 𝒜 x) fun _ _ => id
#align homogeneous_localization.val HomogeneousLocalization.val

@[simp]
theorem val_mk'' (i : NumDenomSameDeg 𝒜 x) :
    val (Quotient.mk'' i) = Localization.mk i.num ⟨i.den, i.denom_mem⟩ :=
  rfl
#align homogeneous_localization.val_mk' HomogeneousLocalization.val_mk''

variable (x)

theorem val_injective : Function.Injective (@HomogeneousLocalization.val _ _ _ _ _ _ _ _ 𝒜 _ x) :=
  fun a b => Quotient.recOnSubsingleton₂' a b fun a b h => Quotient.sound' h
#align homogeneous_localization.val_injective HomogeneousLocalization.val_injective

instance hasPow : Pow (HomogeneousLocalization 𝒜 x) ℕ
    where pow z n :=
    (Quotient.map' (· ^ n) fun c1 c2 (h : Localization.mk _ _ = Localization.mk _ _) =>
          by
          change Localization.mk _ _ = Localization.mk _ _
          simp only [num_pow, denom_pow]
          convert congr_arg (fun z => z ^ n) h <;> erw [Localization.mk_pow] <;> rfl :
        HomogeneousLocalization 𝒜 x → HomogeneousLocalization 𝒜 x)
      z
#align homogeneous_localization.has_pow HomogeneousLocalization.hasPow

section SMul

variable {α : Type _} [SMul α R] [SMul α A] [IsScalarTower α R A]

variable [IsScalarTower α A A]

instance : SMul α (HomogeneousLocalization 𝒜 x)
    where smul m :=
    Quotient.map' ((· • ·) m) fun c1 c2 (h : Localization.mk _ _ = Localization.mk _ _) =>
      by
      change Localization.mk _ _ = Localization.mk _ _
      simp only [num_smul, denom_smul]
      convert congr_arg (fun z : at x => m • z) h <;> rw [Localization.smul_mk] <;> rfl

@[simp]
theorem smul_val (y : HomogeneousLocalization 𝒜 x) (n : α) : (n • y).val = n • y.val :=
  by
  induction y using Quotient.inductionOn
  unfold HomogeneousLocalization.val SMul.smul
  simp only [Quotient.liftOn₂'_mk, Quotient.liftOn'_mk]
  change Localization.mk _ _ = n • Localization.mk _ _
  dsimp only
  rw [Localization.smul_mk]
  congr 1
#align homogeneous_localization.smul_val HomogeneousLocalization.smul_val

end SMul

instance : Neg (HomogeneousLocalization 𝒜 x)
    where neg :=
    Quotient.map' Neg.neg fun c1 c2 (h : Localization.mk _ _ = Localization.mk _ _) =>
      by
      change Localization.mk _ _ = Localization.mk _ _
      simp only [num_neg, denom_neg, ← Localization.neg_mk]
      exact congr_arg (fun c => -c) h

instance : Add (HomogeneousLocalization 𝒜 x)
    where add :=
    Quotient.map₂' (· + ·)
      fun c1 c2 (h : Localization.mk _ _ = Localization.mk _ _) c3 c4
        (h' : Localization.mk _ _ = Localization.mk _ _) =>
      by
      change Localization.mk _ _ = Localization.mk _ _
      simp only [num_add, denom_add, ← Localization.add_mk]
      convert congr_arg₂ (· + ·) h h' <;> erw [Localization.add_mk] <;> rfl

instance : Sub (HomogeneousLocalization 𝒜 x) where sub z1 z2 := z1 + -z2

instance : Mul (HomogeneousLocalization 𝒜 x)
    where mul :=
    Quotient.map₂' (· * ·)
      fun c1 c2 (h : Localization.mk _ _ = Localization.mk _ _) c3 c4
        (h' : Localization.mk _ _ = Localization.mk _ _) =>
      by
      change Localization.mk _ _ = Localization.mk _ _
      simp only [num_mul, denom_mul]
      convert congr_arg₂ (· * ·) h h' <;> erw [Localization.mk_mul] <;> rfl

instance : One (HomogeneousLocalization 𝒜 x) where one := Quotient.mk'' 1

instance : Zero (HomogeneousLocalization 𝒜 x) where zero := Quotient.mk'' 0

theorem zero_eq : (0 : HomogeneousLocalization 𝒜 x) = Quotient.mk'' 0 :=
  rfl
#align homogeneous_localization.zero_eq HomogeneousLocalization.zero_eq

theorem one_eq : (1 : HomogeneousLocalization 𝒜 x) = Quotient.mk'' 1 :=
  rfl
#align homogeneous_localization.one_eq HomogeneousLocalization.one_eq

variable {x}

theorem zero_val : (0 : HomogeneousLocalization 𝒜 x).val = 0 :=
  Localization.mk_zero _
#align homogeneous_localization.zero_val HomogeneousLocalization.zero_val

theorem one_val : (1 : HomogeneousLocalization 𝒜 x).val = 1 :=
  Localization.mk_one
#align homogeneous_localization.one_val HomogeneousLocalization.one_val

@[simp]
theorem add_val (y1 y2 : HomogeneousLocalization 𝒜 x) : (y1 + y2).val = y1.val + y2.val :=
  by
  induction y1 using Quotient.inductionOn
  induction y2 using Quotient.inductionOn
  unfold HomogeneousLocalization.val Add.add
  simp only [Quotient.liftOn₂'_mk, Quotient.liftOn'_mk]
  change Localization.mk _ _ = Localization.mk _ _ + Localization.mk _ _
  dsimp only
  rw [Localization.add_mk]
  rfl
#align homogeneous_localization.add_val HomogeneousLocalization.add_val

@[simp]
theorem mul_val (y1 y2 : HomogeneousLocalization 𝒜 x) : (y1 * y2).val = y1.val * y2.val :=
  by
  induction y1 using Quotient.inductionOn
  induction y2 using Quotient.inductionOn
  unfold HomogeneousLocalization.val Mul.mul
  simp only [Quotient.liftOn₂'_mk, Quotient.liftOn'_mk]
  change Localization.mk _ _ = Localization.mk _ _ * Localization.mk _ _
  dsimp only
  rw [Localization.mk_mul]
  rfl
#align homogeneous_localization.mul_val HomogeneousLocalization.mul_val

@[simp]
theorem neg_val (y : HomogeneousLocalization 𝒜 x) : (-y).val = -y.val :=
  by
  induction y using Quotient.inductionOn
  unfold HomogeneousLocalization.val Neg.neg
  simp only [Quotient.liftOn₂'_mk, Quotient.liftOn'_mk]
  change Localization.mk _ _ = -Localization.mk _ _
  dsimp only
  rw [Localization.neg_mk]
  rfl
#align homogeneous_localization.neg_val HomogeneousLocalization.neg_val

@[simp]
theorem sub_val (y1 y2 : HomogeneousLocalization 𝒜 x) : (y1 - y2).val = y1.val - y2.val := by
  rw [show y1 - y2 = y1 + -y2 from rfl, add_val, neg_val] <;> rfl
#align homogeneous_localization.sub_val HomogeneousLocalization.sub_val

@[simp]
theorem pow_val (y : HomogeneousLocalization 𝒜 x) (n : ℕ) : (y ^ n).val = y.val ^ n :=
  by
  induction y using Quotient.inductionOn
  unfold HomogeneousLocalization.val Pow.pow
  simp only [Quotient.liftOn₂'_mk, Quotient.liftOn'_mk]
  change Localization.mk _ _ = Localization.mk _ _ ^ n
  rw [Localization.mk_pow]
  dsimp only
  congr 1
#align homogeneous_localization.pow_val HomogeneousLocalization.pow_val

instance : NatCast (HomogeneousLocalization 𝒜 x) :=
  ⟨Nat.unaryCast⟩

instance : IntCast (HomogeneousLocalization 𝒜 x) :=
  ⟨Int.castDef⟩

@[simp]
theorem nat_cast_val (n : ℕ) : (n : HomogeneousLocalization 𝒜 x).val = n :=
  show val (Nat.unaryCast n) = _ by induction n <;> simp [Nat.unaryCast, zero_val, one_val, *]
#align homogeneous_localization.nat_cast_val HomogeneousLocalization.nat_cast_val

@[simp]
theorem int_cast_val (n : ℤ) : (n : HomogeneousLocalization 𝒜 x).val = n :=
  show val (Int.castDef n) = _ by cases n <;> simp [Int.castDef, zero_val, one_val, *]
#align homogeneous_localization.int_cast_val HomogeneousLocalization.int_cast_val

instance homogenousLocalizationCommRing : CommRing (HomogeneousLocalization 𝒜 x) :=
  (HomogeneousLocalization.val_injective x).CommRing _ zero_val one_val add_val mul_val neg_val
    sub_val (fun z n => smul_val x z n) (fun z n => smul_val x z n) pow_val nat_cast_val
    int_cast_val
#align homogeneous_localization.homogenous_localization_comm_ring HomogeneousLocalization.homogenousLocalizationCommRing

instance homogeneousLocalizationAlgebra : Algebra (HomogeneousLocalization 𝒜 x) (Localization x)
    where
  smul p q := p.val * q
  toFun := val
  map_one' := one_val
  map_mul' := mul_val
  map_zero' := zero_val
  map_add' := add_val
  commutes' p q := mul_comm _ _
  smul_def' p q := rfl
#align homogeneous_localization.homogeneous_localization_algebra HomogeneousLocalization.homogeneousLocalizationAlgebra

end HomogeneousLocalization

namespace HomogeneousLocalization

open HomogeneousLocalization HomogeneousLocalization.NumDenomSameDeg

variable {𝒜} {x}

/-- numerator of an element in `homogeneous_localization x`-/
def num (f : HomogeneousLocalization 𝒜 x) : A :=
  (Quotient.out' f).num
#align homogeneous_localization.num HomogeneousLocalization.num

/-- denominator of an element in `homogeneous_localization x`-/
def denom (f : HomogeneousLocalization 𝒜 x) : A :=
  (Quotient.out' f).den
#align homogeneous_localization.denom HomogeneousLocalization.denom

/-- For an element in `homogeneous_localization x`, degree is the natural number `i` such that
  `𝒜 i` contains both numerator and denominator. -/
def deg (f : HomogeneousLocalization 𝒜 x) : ι :=
  (Quotient.out' f).deg
#align homogeneous_localization.deg HomogeneousLocalization.deg

theorem denom_mem (f : HomogeneousLocalization 𝒜 x) : f.den ∈ x :=
  (Quotient.out' f).denom_mem
#align homogeneous_localization.denom_mem HomogeneousLocalization.denom_mem

theorem num_mem_deg (f : HomogeneousLocalization 𝒜 x) : f.num ∈ 𝒜 f.deg :=
  (Quotient.out' f).num.2
#align homogeneous_localization.num_mem_deg HomogeneousLocalization.num_mem_deg

theorem denom_mem_deg (f : HomogeneousLocalization 𝒜 x) : f.den ∈ 𝒜 f.deg :=
  (Quotient.out' f).den.2
#align homogeneous_localization.denom_mem_deg HomogeneousLocalization.denom_mem_deg

theorem eq_num_div_denom (f : HomogeneousLocalization 𝒜 x) :
    f.val = Localization.mk f.num ⟨f.den, f.denom_mem⟩ :=
  by
  have := Quotient.out_eq' f
  apply_fun HomogeneousLocalization.val  at this
  rw [← this]
  unfold HomogeneousLocalization.val
  simp only [Quotient.liftOn'_mk'']
  rfl
#align homogeneous_localization.eq_num_div_denom HomogeneousLocalization.eq_num_div_denom

theorem ext_iff_val (f g : HomogeneousLocalization 𝒜 x) : f = g ↔ f.val = g.val :=
  { mp := fun h => h ▸ rfl
    mpr := fun h => by
      induction f using Quotient.inductionOn
      induction g using Quotient.inductionOn
      rw [Quotient.eq']
      unfold HomogeneousLocalization.val at h
      simpa only [Quotient.liftOn'_mk] using h }
#align homogeneous_localization.ext_iff_val HomogeneousLocalization.ext_iff_val

section

variable (𝒜) (𝔭 : Ideal A) [Ideal.IsPrime 𝔭]

/-- Localizing a ring homogeneously at a prime ideal-/
abbrev AtPrime :=
  HomogeneousLocalization 𝒜 𝔭.primeCompl
#align homogeneous_localization.at_prime HomogeneousLocalization.AtPrime

theorem isUnit_iff_isUnit_val (f : HomogeneousLocalization.AtPrime 𝒜 𝔭) : IsUnit f.val ↔ IsUnit f :=
  ⟨fun h1 => by
    rcases h1 with ⟨⟨a, b, eq0, eq1⟩, eq2 : a = f.val⟩
    rw [eq2] at eq0 eq1
    clear a eq2
    induction' b using Localization.induction_on with data
    rcases data with ⟨a, ⟨b, hb⟩⟩
    dsimp only at eq0 eq1
    have b_f_denom_not_mem : b * f.denom ∈ 𝔭.prime_compl := fun r =>
      Or.elim (Ideal.IsPrime.mem_or_mem inferInstance r) (fun r2 => hb r2) fun r2 => f.denom_mem r2
    rw [f.eq_num_div_denom, Localization.mk_mul,
      show (⟨b, hb⟩ : 𝔭.prime_compl) * ⟨f.denom, _⟩ = ⟨b * f.denom, _⟩ from rfl,
      show (1 : Localization.AtPrime 𝔭) = Localization.mk 1 1 by erw [Localization.mk_self 1],
      Localization.mk_eq_mk', IsLocalization.eq] at eq1
    rcases eq1 with ⟨⟨c, hc⟩, eq1⟩
    simp only [← Subtype.val_eq_coe] at eq1
    change c * (1 * (a * f.num)) = _ at eq1
    simp only [one_mul, mul_one] at eq1
    have mem1 : c * (a * f.num) ∈ 𝔭.prime_compl :=
      eq1.symm ▸ fun r => Or.elim (Ideal.IsPrime.mem_or_mem inferInstance r) (by tauto) (by tauto)
    have mem2 : f.num ∉ 𝔭 := by
      contrapose! mem1
      erw [Classical.not_not]
      exact Ideal.mul_mem_left _ _ (Ideal.mul_mem_left _ _ mem1)
    refine'
            ⟨⟨f, Quotient.mk'' ⟨f.deg, ⟨f.denom, f.denom_mem_deg⟩, ⟨f.num, f.num_mem_deg⟩, mem2⟩, _,
                _⟩,
              rfl⟩ <;>
          simp only [ext_iff_val, mul_val, val_mk', ← Subtype.val_eq_coe, f.eq_num_div_denom,
            Localization.mk_mul, one_val] <;>
        convert Localization.mk_self _ <;>
      simpa only [mul_comm] ,
    fun ⟨⟨_, b, eq1, eq2⟩, rfl⟩ =>
    by
    simp only [ext_iff_val, mul_val, one_val] at eq1 eq2
    exact ⟨⟨f.val, b.val, eq1, eq2⟩, rfl⟩⟩
#align homogeneous_localization.is_unit_iff_is_unit_val HomogeneousLocalization.isUnit_iff_isUnit_val

instance : Nontrivial (HomogeneousLocalization.AtPrime 𝒜 𝔭) :=
  ⟨⟨0, 1, fun r => by simpa [ext_iff_val, zero_val, one_val, zero_ne_one] using r⟩⟩

instance : LocalRing (HomogeneousLocalization.AtPrime 𝒜 𝔭) :=
  LocalRing.of_isUnit_or_isUnit_one_sub_self fun a =>
    by
    simp only [← is_unit_iff_is_unit_val, sub_val, one_val]
    induction a using Quotient.inductionOn'
    simp only [HomogeneousLocalization.val_mk'', ← Subtype.val_eq_coe]
    by_cases mem1 : a.num.1 ∈ 𝔭
    · right
      have : a.denom.1 - a.num.1 ∈ 𝔭.prime_compl := fun h =>
        a.denom_mem (sub_add_cancel a.denom.val a.num.val ▸ Ideal.add_mem _ h mem1 : a.denom.1 ∈ 𝔭)
      apply isUnit_of_mul_eq_one _ (Localization.mk a.denom.1 ⟨a.denom.1 - a.num.1, this⟩)
      simp only [sub_mul, Localization.mk_mul, one_mul, Localization.sub_mk, ← Subtype.val_eq_coe,
        Submonoid.coe_mul]
      convert Localization.mk_self _
      simp only [← Subtype.val_eq_coe, Submonoid.coe_mul]
      ring
    · left
      change _ ∈ 𝔭.prime_compl at mem1
      apply isUnit_of_mul_eq_one _ (Localization.mk a.denom.1 ⟨a.num.1, mem1⟩)
      rw [Localization.mk_mul]
      convert Localization.mk_self _
      simpa only [mul_comm]

end

section

variable (𝒜) (f : A)

/-- Localising away from powers of `f` homogeneously.-/
abbrev Away :=
  HomogeneousLocalization 𝒜 (Submonoid.powers f)
#align homogeneous_localization.away HomogeneousLocalization.Away

end

end HomogeneousLocalization


/-
Copyright (c) 2023 David Loeffler. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: David Loeffler
-/
import analysis.fourier.add_circle
import analysis.fourier.fourier_transform
import analysis.p_series
import analysis.schwartz_space

/-!
# Poisson's summation formula

We prove Poisson's summation formula `∑ (n : ℤ), f n = ∑ (n : ℤ), 𝓕 f n`, where `𝓕 f` is the
Fourier transform of `f`, under the following hypotheses:
* `f` is a continuous function `ℝ → ℂ`.
* The sum `∑ (n : ℤ), 𝓕 f n` is convergent.
* For all compacts `K ⊂ ℝ`, the sum `∑ (n : ℤ), sup { ‖f(x + n)‖ | x ∈ K }` is convergent.
See `real.tsum_eq_tsum_fourier_integral` for this formulation.

These hypotheses are potentially a little awkward to apply, so we also provide the less general but
easier-to-use result `real.tsum_eq_tsum_fourier_integral_of_rpow_decay`, in which we assume `f` and
`𝓕 f` both decay as `|x| ^ (-b)` for some `b > 1`, and the even more specific result
`schwartz_map.tsum_eq_tsum_fourier_integral`, where we assume that both `f` and `𝓕 f` are Schwartz
functions.

## TODO

At the moment `schwartz_map.tsum_eq_tsum_fourier_integral` requires separate proofs that both `f`
and `𝓕 f` are Schwartz functions. In fact, `𝓕 f` is automatically Schwartz if `f` is; and once
we have this lemma in the library, we should adjust the hypotheses here accordingly.
-/

noncomputable theory

open function (hiding comp_apply) complex (hiding abs_of_nonneg) real set (hiding restrict_apply)
  topological_space filter measure_theory asymptotics

open_locale real big_operators filter fourier_transform

local attribute [instance] real.fact_zero_lt_one

open continuous_map

/-- The key lemma for Poisson summation: the `m`-th Fourier coefficient of the periodic function
`∑' n : ℤ, f (x + n)` is the value at `m` of the Fourier transform of `f`. -/
lemma real.fourier_coeff_tsum_comp_add {f : C(ℝ, ℂ)}
  (hf : ∀ (K : compacts ℝ), summable (λ n : ℤ, ‖(f.comp (continuous_map.add_right n)).restrict K‖))
  (m : ℤ) :
  fourier_coeff (periodic.lift $ f.periodic_tsum_comp_add_zsmul 1) m = 𝓕 f m :=
begin
  -- NB: This proof can be shortened somewhat by telescoping together some of the steps in the calc
  -- block, but I think it's more legible this way. We start with preliminaries about the integrand.
  let e : C(ℝ, ℂ) := (fourier (-m)).comp ⟨(coe : ℝ → unit_add_circle), continuous_quotient_mk⟩,
  have neK : ∀ (K : compacts ℝ) (g : C(ℝ, ℂ)), ‖(e * g).restrict K‖ = ‖g.restrict K‖,
  { have : ∀ (x : ℝ), ‖e x‖ = 1, from λ x, abs_coe_circle _,
    intros K g,
    simp_rw [norm_eq_supr_norm, restrict_apply, mul_apply, norm_mul, this, one_mul] },
  have eadd : ∀ (n : ℤ), e.comp (continuous_map.add_right n) = e,
  { intro n, ext1 x,
    have : periodic e 1, from periodic.comp (λ x, add_circle.coe_add_period 1 x) _,
    simpa only [mul_one] using this.int_mul n x },
  -- Now the main argument. First unwind some definitions.
  calc fourier_coeff (periodic.lift $ f.periodic_tsum_comp_add_zsmul 1) m
  = ∫ x in 0..1, e x * (∑' n : ℤ, f.comp (continuous_map.add_right n)) x :
    by simp_rw [fourier_coeff_eq_interval_integral _ m 0, div_one, one_smul, zero_add, comp_apply,
      coe_mk, periodic.lift_coe, zsmul_one, smul_eq_mul]
  -- Transform sum in C(ℝ, ℂ) evaluated at x into pointwise sum of values.
  ... = ∫ x in 0..1, (∑' n : ℤ, (e * f.comp (continuous_map.add_right n)) x) :
    by simp_rw [coe_mul, pi.mul_apply, ←tsum_apply (summable_of_locally_summable_norm hf),
      tsum_mul_left]
  -- Swap sum and integral.
  ... = ∑' n : ℤ, ∫ x in 0..1, (e * f.comp (continuous_map.add_right n)) x :
    begin
      refine (interval_integral.tsum_interval_integral_eq_of_summable_norm _).symm,
      convert hf ⟨uIcc 0 1, is_compact_uIcc⟩,
      exact funext (λ n, neK _ _)
    end
  ... = ∑' n : ℤ, ∫ x in 0..1, (e * f).comp (continuous_map.add_right n) x :
    begin
      simp only [continuous_map.comp_apply, mul_comp] at eadd ⊢,
      simp_rw eadd,
    end
  -- Rearrange sum of interval integrals into an integral over `ℝ`.
  ... = ∫ x, e x * f x :
    begin
      suffices : integrable ⇑(e * f), from this.has_sum_interval_integral_comp_add_int.tsum_eq,
      apply integrable_of_summable_norm_Icc,
      convert hf ⟨Icc 0 1, is_compact_Icc⟩,
      simp_rw [continuous_map.comp_apply, mul_comp] at eadd ⊢,
      simp_rw eadd,
      exact funext (λ n, neK ⟨Icc 0 1, is_compact_Icc⟩ _),
    end
  -- Minor tidying to finish
  ... = 𝓕 f m :
    begin
      rw fourier_integral_eq_integral_exp_smul,
      congr' 1 with x : 1,
      rw [smul_eq_mul, comp_apply, coe_mk, fourier_coe_apply],
      congr' 2,
      push_cast,
      ring
    end
end

/-- **Poisson's summation formula**, most general form. -/
theorem real.tsum_eq_tsum_fourier_integral {f : C(ℝ, ℂ)}
  (h_norm : ∀ (K : compacts ℝ),
    summable (λ n : ℤ, ‖(f.comp $ continuous_map.add_right n).restrict K‖))
  (h_sum : summable (λ n : ℤ, 𝓕 f n)) :
  ∑' (n : ℤ), f n = ∑' (n : ℤ), 𝓕 f n :=
begin
  let F : C(unit_add_circle, ℂ) := ⟨(f.periodic_tsum_comp_add_zsmul 1).lift,
    continuous_coinduced_dom.mpr (map_continuous _)⟩,
  have : summable (fourier_coeff F),
  { convert h_sum,
    exact funext (λ n, real.fourier_coeff_tsum_comp_add h_norm n) },
  convert (has_pointwise_sum_fourier_series_of_summable this 0).tsum_eq.symm using 1,
  { have := (has_sum_apply (summable_of_locally_summable_norm h_norm).has_sum 0).tsum_eq,
    simpa only [coe_mk, ←quotient_add_group.coe_zero, periodic.lift_coe, zsmul_one, comp_apply,
      coe_add_right, zero_add] using this },
  { congr' 1 with n : 1,
    rw [←real.fourier_coeff_tsum_comp_add h_norm n, fourier_eval_zero, smul_eq_mul, mul_one],
    refl },
end

section rpow_decay

variables {E : Type*} [normed_add_comm_group E]

/-- If `f` is `O(x ^ (-b))` at infinity, then so is the function
`λ x, ‖f.restrict (Icc (x + R) (x + S))‖` for any fixed `R` and `S`. -/
lemma is_O_norm_Icc_restrict_at_top {f : C(ℝ, E)} {b : ℝ} (hb : 0 < b)
  (hf : is_O at_top f (λ x : ℝ, |x| ^ (-b))) (R S : ℝ) :
  is_O at_top (λ x : ℝ, ‖f.restrict (Icc (x + R) (x + S))‖) (λ x : ℝ, |x| ^ (-b)) :=
begin
  -- First establish an explicit estimate on decay of inverse powers.
  -- This is logically independent of the rest of the proof, but of no mathematical interest in
  -- itself, so it is proved using `async` rather than being formulated as a separate lemma.
  have claim : ∀ (x : ℝ), max 0 (-2 * R) < x →
    ∀ (y : ℝ), x + R ≤ y → y ^ (-b) ≤ (1 / 2) ^ (-b) * x ^ (-b),
  { intros x hx y hy,
    rw max_lt_iff at hx,
    have hxR : 0 < x + R,
    { rcases le_or_lt 0 R with h|h,
      { exact add_pos_of_pos_of_nonneg hx.1 h },
      { rw [←sub_lt_iff_lt_add, zero_sub],
        refine lt_trans _ hx.2,
        rwa [neg_mul, neg_lt_neg_iff, two_mul, add_lt_iff_neg_left] } },
    have hy' : 0 < y, from hxR.trans_le hy,
    have : y ^ (-b) ≤ (x + R) ^ (-b),
    { rw [rpow_neg hy'.le, rpow_neg hxR.le,
      inv_le_inv (rpow_pos_of_pos hy' _) (rpow_pos_of_pos hxR _)],
    exact rpow_le_rpow hxR.le hy hb.le },
    refine this.trans _,
    rw [←mul_rpow one_half_pos.le hx.1.le, rpow_neg (mul_pos one_half_pos hx.1).le,
      rpow_neg hxR.le],
    refine inv_le_inv_of_le (rpow_pos_of_pos (mul_pos one_half_pos hx.1) _) _,
    exact rpow_le_rpow (mul_pos one_half_pos hx.1).le (by linarith) hb.le },
  -- Now the main proof.
  obtain ⟨c, hc, hc'⟩ := hf.exists_pos,
  simp only [is_O, is_O_with, eventually_at_top] at hc' ⊢,
  obtain ⟨d, hd⟩ := hc',
  refine ⟨c * (1 / 2) ^ (-b), ⟨max (1 + max 0 (-2 * R)) (d - R), λ x hx, _⟩⟩,
  rw [ge_iff_le, max_le_iff] at hx,
  have hx' : max 0 (-2 * R) < x, by linarith,
  rw max_lt_iff at hx',
  rw [norm_norm, continuous_map.norm_le _
    (mul_nonneg (mul_nonneg hc.le $ rpow_nonneg_of_nonneg one_half_pos.le _) (norm_nonneg _))],
  refine λ y, (hd y.1 (by linarith [hx.1, y.2.1])).trans _,
  have A : ∀ (x : ℝ), 0 ≤ |x| ^ (-b), from λ x, by positivity,
  rwa [mul_assoc, mul_le_mul_left hc, norm_of_nonneg (A _), norm_of_nonneg (A _)],
  convert claim x (by linarith only [hx.1]) y.1 y.2.1,
  { apply abs_of_nonneg, linarith [y.2.1] },
  { exact abs_of_pos hx'.1 },
end

lemma is_O_norm_Icc_restrict_at_bot {f : C(ℝ, E)} {b : ℝ} (hb : 0 < b)
  (hf : is_O at_bot f (λ x : ℝ, |x| ^ (-b))) (R S : ℝ) :
  is_O at_bot (λ x : ℝ, ‖f.restrict (Icc (x + R) (x + S))‖) (λ x : ℝ, |x| ^ (-b)) :=
begin
  have h1 : is_O at_top (f.comp (continuous_map.mk _ continuous_neg)) (λ x : ℝ, |x| ^ (-b)),
  { convert hf.comp_tendsto tendsto_neg_at_top_at_bot,
    ext1 x, simp only [function.comp_app, abs_neg] },
  have h2 := (is_O_norm_Icc_restrict_at_top hb h1 (-S) (-R)).comp_tendsto tendsto_neg_at_bot_at_top,
  have : ((λ (x : ℝ), |x| ^ -b) ∘ has_neg.neg) = (λ (x : ℝ), |x| ^ -b),
  { ext1 x, simp only [function.comp_app, abs_neg] },
  rw this at h2,
  refine (is_O_of_le _ (λ x, _)).trans h2, -- equality holds, but less work to prove `≤` alone
  rw [norm_norm, function.comp_app, norm_norm, continuous_map.norm_le _ (norm_nonneg _)],
  rintro ⟨x, hx⟩,
  rw [continuous_map.restrict_apply_mk],
  refine (le_of_eq _).trans (continuous_map.norm_coe_le_norm _ ⟨-x, _⟩),
  { exact ⟨by linarith [hx.2], by linarith [hx.1]⟩ },
  { rw [continuous_map.restrict_apply_mk, continuous_map.comp_apply, continuous_map.coe_mk,
      neg_neg] }
end

lemma is_O_norm_restrict_cocompact (f : C(ℝ, E)) {b : ℝ} (hb : 0 < b)
  (hf : is_O (cocompact ℝ) f (λ x : ℝ, |x| ^ (-b))) (K : compacts ℝ) :
  is_O (cocompact ℝ) (λ x, ‖(f.comp (continuous_map.add_right x)).restrict K‖) (λ x, |x| ^ (-b)) :=
begin
  obtain ⟨r, hr⟩ := K.is_compact.bounded.subset_ball 0,
  rw [closed_ball_eq_Icc, zero_add, zero_sub] at hr,
  have : ∀ (x : ℝ), ‖(f.comp (continuous_map.add_right x)).restrict K‖ ≤
    ‖f.restrict (Icc (x - r) (x + r))‖,
  { intro x,
    rw continuous_map.norm_le _ (norm_nonneg _),
    rintro ⟨y, hy⟩,
    refine (le_of_eq _).trans (continuous_map.norm_coe_le_norm _ ⟨y + x, _⟩),
    exact ⟨by linarith [(hr hy).1], by linarith [(hr hy).2]⟩,
    simp_rw [continuous_map.restrict_apply, continuous_map.comp_apply,
      continuous_map.coe_add_right, subtype.coe_mk] },
  simp_rw [cocompact_eq, is_O_sup] at hf ⊢,
  split,
  { refine (is_O_of_le at_bot _).trans (is_O_norm_Icc_restrict_at_bot hb hf.1 (-r) r),
    simp_rw norm_norm, exact this },
  { refine (is_O_of_le at_top _).trans (is_O_norm_Icc_restrict_at_top hb hf.2 (-r) r),
    simp_rw norm_norm, exact this },
end

/-- **Poisson's summation formula**, assuming that `f` decays as
`|x| ^ (-b)` for some `1 < b` and its Fourier transform is summable. -/
lemma real.tsum_eq_tsum_fourier_integral_of_rpow_decay_of_summable {f : ℝ → ℂ} (hc : continuous f)
  {b : ℝ} (hb : 1 < b) (hf : is_O (cocompact ℝ) f (λ x : ℝ, |x| ^ (-b)))
  (hFf : summable (λ n : ℤ, 𝓕 f n)) :
  ∑' (n : ℤ), f n = ∑' (n : ℤ), 𝓕 f n :=
real.tsum_eq_tsum_fourier_integral
  (λ K, summable_of_is_O (real.summable_abs_int_rpow hb)
    ((is_O_norm_restrict_cocompact (continuous_map.mk _ hc)
    (zero_lt_one.trans hb) hf K).comp_tendsto int.tendsto_coe_cofinite)) hFf

/-- **Poisson's summation formula**, assuming that both `f` and its Fourier transform decay as
`|x| ^ (-b)` for some `1 < b`. (This is the one-dimensional case of Corollary VII.2.6 of Stein and
Weiss, *Introduction to Fourier analysis on Euclidean spaces*.) -/
lemma real.tsum_eq_tsum_fourier_integral_of_rpow_decay {f : ℝ → ℂ} (hc : continuous f)
  {b : ℝ} (hb : 1 < b) (hf : is_O (cocompact ℝ) f (λ x : ℝ, |x| ^ (-b)))
  (hFf : is_O (cocompact ℝ) (𝓕 f) (λ x : ℝ, |x| ^ (-b))) :
  ∑' (n : ℤ), f n = ∑' (n : ℤ), 𝓕 f n :=
real.tsum_eq_tsum_fourier_integral_of_rpow_decay_of_summable hc hb hf
  (summable_of_is_O (real.summable_abs_int_rpow hb) (hFf.comp_tendsto int.tendsto_coe_cofinite))

end rpow_decay

section schwartz

/-- **Poisson's summation formula** for Schwartz functions. -/
lemma schwartz_map.tsum_eq_tsum_fourier_integral
  (f g : schwartz_map ℝ ℂ) (hfg : 𝓕 f = g) :
  ∑' (n : ℤ), f n = ∑' (n : ℤ), g n :=
begin
  -- We know that Schwartz functions are `O(‖x ^ (-b)‖)` for *every* `b`; for this argument we take
  -- `b = 2` and work with that.
  simp_rw ←hfg,
  exact real.tsum_eq_tsum_fourier_integral_of_rpow_decay f.continuous one_lt_two
    (f.is_O_cocompact_rpow (-2)) (by simpa only [hfg] using g.is_O_cocompact_rpow (-2))
end

end schwartz


import data.list.min_max
import analysis.special_functions.pow
import ring_theory.algebraic
import field_theory.minpoly.is_integrally_closed

noncomputable theory

open polynomial

open_locale polynomial

variables {R : Type*} [normed_ring R]

def polynomial.coeffs (p : R[X])  : list R := list.map p.coeff (list.range p.nat_degree)

lemma list.le_max_of_exists_le {α : Type*} [linear_order α] {l : list α} {a x : α} (b : α)
  (hx : x ∈ l) (h : a ≤ x) : a ≤ l.foldr max b :=
begin
  induction l with y l IH,
  { exact absurd hx (list.not_mem_nil _), },
  { obtain rfl | hl := hx,
    simp only [list.foldr, list.foldr_cons],
    { exact le_max_of_le_left h, },
    { exact le_max_of_le_right (IH hl) }}
end

def spectral_value_terms {p : R[X]} (hp : p.monic) : ℕ → ℝ :=
λ (n : ℕ), if n < p.nat_degree then ‖ p.coeff n ‖^(1/(p.nat_degree - n : ℝ)) else 0

lemma spectral_value_terms_of_lt_nat_degree {p : R[X]} (hp : p.monic) {n : ℕ}
  (hn : n < p.nat_degree) : spectral_value_terms hp n = ‖ p.coeff n ‖^(1/(p.nat_degree - n : ℝ)) :=
by simp only [spectral_value_terms, if_pos hn]

lemma spectral_value_terms_of_nat_degree_le {p : R[X]} (hp : p.monic) {n : ℕ}
  (hn : p.nat_degree ≤ n) : spectral_value_terms hp n = 0 :=
by simp only [spectral_value_terms, if_neg (not_lt.mpr hn)]

def spectral_value {p : R[X]} (hp : p.monic) : ℝ := supr (spectral_value_terms hp)

lemma spectral_value_terms_bdd_above {p : R[X]} (hp : p.monic) :
  bdd_above (set.range (spectral_value_terms hp)) :=
begin
  use list.foldr max 0
  (list.map (λ n, ‖ p.coeff n ‖^(1/(p.nat_degree - n : ℝ))) (list.range p.nat_degree)),
  { rw mem_upper_bounds,
    intros r hr,
    obtain ⟨n, hn⟩ := set.mem_range.mpr hr,
    simp only [spectral_value_terms] at hn,

    split_ifs at hn with hd hd,
    { have h : ‖p.coeff n‖ ^ (1 / (p.nat_degree - n : ℝ)) ∈ list.map
        (λ (n : ℕ), ‖p.coeff n‖ ^ (1 / (p.nat_degree - n : ℝ))) (list.range p.nat_degree),
      { simp only [list.mem_map, list.mem_range],
        exact ⟨n, hd, rfl⟩, },
    exact list.le_max_of_exists_le 0 h (ge_of_eq hn), },
    { rw ← hn,
      by_cases hd0 : p.nat_degree = 0,
      { rw [hd0, list.range_zero, list.map_nil, list.foldr_nil], },
      { have h : ‖p.coeff 0‖ ^ (1 / (p.nat_degree - 0 : ℝ)) ∈ list.map
          (λ (n : ℕ), ‖p.coeff n‖ ^ (1 / (p.nat_degree - n : ℝ))) (list.range p.nat_degree),
        { simp only [list.mem_map, list.mem_range],
          exact ⟨0, nat.pos_of_ne_zero hd0, by rw nat.cast_zero⟩,},
      refine list.le_max_of_exists_le 0 h _,
      exact real.rpow_nonneg_of_nonneg (norm_nonneg _) _}}},
end

lemma spectral_value_terms_finite_range {p : R[X]} (hp : p.monic) :
  (set.range (spectral_value_terms hp)).finite :=
begin
  have h_ss : set.range (spectral_value_terms hp) ⊆ set.range (λ (n : fin p.nat_degree),
    ‖ p.coeff n ‖^(1/(p.nat_degree - n : ℝ))) ∪ {(0 : ℝ)},
  { intros x hx,
    obtain ⟨m, hm⟩ := set.mem_range.mpr hx,
    by_cases hm_lt : m < p.nat_degree,
    { simp only [spectral_value_terms_of_lt_nat_degree hp hm_lt] at hm,
      rw ← hm,
      exact set.mem_union_left _ ⟨⟨m, hm_lt⟩, rfl⟩, },
    { simp only [spectral_value_terms_of_nat_degree_le hp (le_of_not_lt hm_lt)] at hm,
      rw hm,
      exact set.mem_union_right _ (set.mem_singleton _), }},
  exact set.finite.subset (set.finite.union (set.finite_range _) (set.finite_singleton _)) h_ss,
end

lemma spectral_value_terms_nonneg {p : R[X]} (hp : p.monic) (n : ℕ) :
  0 ≤ spectral_value_terms hp n :=
begin
  simp only [spectral_value_terms],
  split_ifs with h,
  { exact real.rpow_nonneg_of_nonneg (norm_nonneg _) _ },
  { exact le_refl _ },
end

variable [nontrivial R]

lemma list.max_repeat {α : Type*} {n : ℕ} (a : α) [linear_order α] :
  list.foldr max a (list.repeat a n) = a :=
begin
  induction n with n hn,
  { simp only [list.repeat, list.foldr_nil] },
  { simp only [list.foldr, list.repeat, list.foldr_cons, max_eq_left_iff],
    exact le_of_eq hn, }
end

lemma spectral_value_X_pow (n : ℕ) :
  spectral_value (@polynomial.monic_X_pow R _ n) = 0 :=
begin
  rw spectral_value, rw spectral_value_terms,
  simp_rw [polynomial.coeff_X_pow n, polynomial.nat_degree_X_pow],
  convert csupr_const,
  ext m,
  by_cases hmn : m < n,
  { rw [if_pos hmn, real.rpow_eq_zero_iff_of_nonneg (norm_nonneg _), if_neg (ne_of_lt hmn),
      norm_zero, one_div, ne.def, inv_eq_zero, ← nat.cast_sub (le_of_lt hmn), nat.cast_eq_zero,
      nat.sub_eq_zero_iff_le],
    exact ⟨eq.refl _, not_le_of_lt hmn⟩ },
  { rw if_neg hmn },
  apply_instance,
end

lemma spectral_value_eq_zero_iff [nontrivial R] {p : R[X]} (hp : p.monic) :
  spectral_value hp = 0 ↔ p = polynomial.X^p.nat_degree :=
begin
  refine ⟨λ h, _, λ h, _⟩,
  { rw spectral_value at h,
    ext,
    rw polynomial.coeff_X_pow,
    by_cases hn : n = p.nat_degree,
    { rw [if_pos hn, hn, polynomial.coeff_nat_degree], exact hp, },
    { rw if_neg hn,
      { by_cases hn' : n < p.nat_degree,
        { have h_le : supr (spectral_value_terms hp) ≤ 0 := le_of_eq h,
          have h_exp : 0 < 1 / ((p.nat_degree : ℝ) - n),
          { rw [one_div_pos, ← nat.cast_sub (le_of_lt hn'), nat.cast_pos],
            exact nat.sub_pos_of_lt hn', },
          have h0 : (0 : ℝ) = 0^(1 / ((p.nat_degree : ℝ) - n)),
          { rw real.zero_rpow (ne_of_gt h_exp), },
          rw [supr, cSup_le_iff (spectral_value_terms_bdd_above hp)
            (set.range_nonempty _)] at h_le,
          specialize h_le (spectral_value_terms hp n) ⟨n, rfl⟩,
          simp only [spectral_value_terms, if_pos hn'] at h_le,
          rw [h0, real.rpow_le_rpow_iff (norm_nonneg _) (le_refl _) h_exp] at h_le,
          exact norm_eq_zero.mp (le_antisymm h_le (norm_nonneg _)), },
        { exact polynomial.coeff_eq_zero_of_nat_degree_lt
            (lt_of_le_of_ne (le_of_not_lt hn') (ne_comm.mpr hn)) }}}},
  { convert spectral_value_X_pow p.nat_degree,
    apply_instance }
end

lemma spectral_value_X_sub_C (r : R) :
  spectral_value (@polynomial.monic_X_sub_C _ _ r) = ‖ r ‖ :=
begin
  rw spectral_value, rw spectral_value_terms,
  simp only [polynomial.nat_degree_X_sub_C, nat.lt_one_iff, polynomial.coeff_sub,
    nat.cast_one, one_div],
  suffices : (⨆ (n : ℕ), ite (n = 0) ‖ r ‖ 0) = ‖ r ‖,
  { rw ← this,
    apply congr_arg,
    ext n,
    by_cases hn : n = 0,
    { rw [if_pos hn, if_pos hn, hn, nat.cast_zero, sub_zero, polynomial.coeff_X_zero,
        polynomial.coeff_C_zero, zero_sub, norm_neg, inv_one, real.rpow_one] },
    { rw [if_neg hn, if_neg hn], }},
  { apply csupr_eq_of_forall_le_of_forall_lt_exists_gt,
    { intro n,
      split_ifs,
      exact le_refl _,
      exact norm_nonneg _ },
    { intros x hx, use 0,
      simp only [eq_self_iff_true, if_true, hx], }}
end

section spectral_norm

variables {K : Type*} [normed_field K] {L : Type*} [field L] [algebra K L]
(h_alg : algebra.is_algebraic K L)

-- The spectral norm |y|_sp is the spectral value of the minimal polynomial of y over K.
def spectral_norm (y : L) : ℝ :=
spectral_value (minpoly.monic (is_algebraic_iff_is_integral.mp (h_alg y)))

lemma spectral_norm_zero : spectral_norm h_alg (0 : L) = 0 :=
begin
  have h_lr: list.range 1 = [0] := rfl,
  rw [spectral_norm, spectral_value, spectral_value_terms, minpoly.zero, polynomial.nat_degree_X],
  convert csupr_const,
  ext m,
  by_cases hm : m < 1,
  { rw [if_pos hm, nat.lt_one_iff.mp hm, nat.cast_one, nat.cast_zero, sub_zero,
      div_one, real.rpow_one, polynomial.coeff_X_zero, norm_zero] },
  { rw if_neg hm },
  apply_instance,
end

lemma spectral_norm_nonneg (y : L) : 0 ≤  spectral_norm h_alg y :=
le_csupr_of_le (spectral_value_terms_bdd_above (minpoly.monic
  (is_algebraic_iff_is_integral.mp (h_alg y)))) 0 (spectral_value_terms_nonneg _ 0)

lemma spectral_norm.zero_lt {y : L} (hy : y ≠ 0) : 0 < spectral_norm h_alg y :=
begin
  rw lt_iff_le_and_ne,
  refine ⟨spectral_norm_nonneg _ _, _⟩,
  rw [spectral_norm, ne.def, eq_comm, spectral_value_eq_zero_iff],
  have h0 : polynomial.coeff (minpoly K y) 0 ≠ 0  :=
  minpoly.coeff_zero_ne_zero (is_algebraic_iff_is_integral.mp (h_alg y)) hy,
  intro h,
  have h0' : (minpoly K y).coeff 0 = 0,
  { rw [h, polynomial.coeff_X_pow,
      if_neg (ne_of_lt ( minpoly.nat_degree_pos (is_algebraic_iff_is_integral.mp (h_alg y))))] },
  exact h0 h0',
end

lemma spectral_norm.smul (k : K) (y : L) (hna : ∀ (r s : K), ‖r + s‖ ≤ (max ‖r‖  ‖s‖)) :
  spectral_norm h_alg (k • y) = ‖k‖ * spectral_norm h_alg y :=
sorry

lemma spectral_norm.is_nonarchimedean (hna : ∀ (r s : K), ‖ r + s ‖ ≤ (max ‖r‖ ‖s‖)) (x y : L) :
  spectral_norm h_alg (x + y) ≤ max (spectral_norm h_alg x) (spectral_norm h_alg y)  :=
sorry

lemma spectral_norm.mul (x y : L) (hna : ∀ (r s : K), ‖ r + s ‖ ≤ (max ‖r‖ ‖s‖)) :
  spectral_norm h_alg (x * y) = spectral_norm h_alg x * spectral_norm h_alg y :=
sorry

lemma spectral_norm.extends (k : K) : spectral_norm h_alg (algebra_map K L k) = ‖k‖ :=
begin
  simp_rw [spectral_norm, minpoly.eq_X_sub_C_of_algebra_map_inj _ (algebra_map K L).injective],
  exact spectral_value_X_sub_C k,
end

lemma spectral_norm.aut_isom (σ : L ≃ₐ[K] L) (x : L) :
  spectral_norm h_alg x = spectral_norm h_alg (σ x) :=
sorry

end spectral_norm


lemma and_or_distrib_left (P Q R : Prop) : P ∧ (Q ∨ R) → (P ∧ Q) ∨ (P ∧ R) :=
begin
    intro pqr,
    cases pqr with p qr,
    cases qr with q r,
    {
        left,
        split,
        {
            exact p,
        },
        {
            exact q,
        },
    },
    {
        right,
        split,
        {
            exact p,
        },
        {
            exact r,
        }
    }
end


/-
Copyright (c) 2021 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import analysis.calculus.inverse
import linear_algebra.dual

/-!
# Lagrange multipliers

In this file we formalize the
[Lagrange multipliers](https://en.wikipedia.org/wiki/Lagrange_multiplier) method of solving
conditional extremum problems: if a function `φ` has a local extremum at `x₀` on the set
`f ⁻¹' {f x₀}`, `f x = (f₀ x, ..., fₙ₋₁ x)`, then the differentials of `fₖ` and `φ` are linearly
dependent. First we formulate a geometric version of this theorem which does not rely on the
target space being `ℝⁿ`, then restate it in terms of coordinates.

## TODO

Formalize Karush-Kuhn-Tucker theorem

## Tags

lagrange multiplier, local extremum

-/

open filter set
open_locale topology filter big_operators
variables {E F : Type*} [normed_add_comm_group E] [normed_space ℝ E] [complete_space E]
  [normed_add_comm_group F] [normed_space ℝ F] [complete_space F]
  {f : E → F} {φ : E → ℝ} {x₀ : E} {f' : E →L[ℝ] F} {φ' : E →L[ℝ] ℝ}

/-- Lagrange multipliers theorem: if `φ : E → ℝ` has a local extremum on the set `{x | f x = f x₀}`
at `x₀`, both `f : E → F` and `φ` are strictly differentiable at `x₀`, and the codomain of `f` is
a complete space, then the linear map `x ↦ (f' x, φ' x)` is not surjective. -/
lemma is_local_extr_on.range_ne_top_of_has_strict_fderiv_at
  (hextr : is_local_extr_on φ {x | f x = f x₀} x₀) (hf' : has_strict_fderiv_at f f' x₀)
  (hφ' : has_strict_fderiv_at φ φ' x₀) :
  linear_map.range (f'.prod φ') ≠ ⊤ :=
begin
  intro htop,
  set fφ := λ x, (f x, φ x),
  have A : map φ (𝓝[f ⁻¹' {f x₀}] x₀) = 𝓝 (φ x₀),
  { change map (prod.snd ∘ fφ) (𝓝[fφ ⁻¹' {p | p.1 = f x₀}] x₀) = 𝓝 (φ x₀),
    rw [← map_map, nhds_within, map_inf_principal_preimage,
      (hf'.prod hφ').map_nhds_eq_of_surj htop],
    exact map_snd_nhds_within _ },
  exact hextr.not_nhds_le_map A.ge
end

/-- Lagrange multipliers theorem: if `φ : E → ℝ` has a local extremum on the set `{x | f x = f x₀}`
at `x₀`, both `f : E → F` and `φ` are strictly differentiable at `x₀`, and the codomain of `f` is
a complete space, then there exist `Λ : dual ℝ F` and `Λ₀ : ℝ` such that `(Λ, Λ₀) ≠ 0` and
`Λ (f' x) + Λ₀ • φ' x = 0` for all `x`. -/
lemma is_local_extr_on.exists_linear_map_of_has_strict_fderiv_at
  (hextr : is_local_extr_on φ {x | f x = f x₀} x₀) (hf' : has_strict_fderiv_at f f' x₀)
  (hφ' : has_strict_fderiv_at φ φ' x₀) :
  ∃ (Λ : module.dual ℝ F) (Λ₀ : ℝ), (Λ, Λ₀) ≠ 0 ∧ ∀ x, Λ (f' x) + Λ₀ • φ' x = 0 :=
begin
  rcases submodule.exists_le_ker_of_lt_top _
    (lt_top_iff_ne_top.2 $ hextr.range_ne_top_of_has_strict_fderiv_at hf' hφ') with ⟨Λ', h0, hΛ'⟩,
  set e : ((F →ₗ[ℝ] ℝ) × ℝ) ≃ₗ[ℝ] (F × ℝ →ₗ[ℝ] ℝ) :=
    ((linear_equiv.refl ℝ (F →ₗ[ℝ] ℝ)).prod (linear_map.ring_lmap_equiv_self ℝ ℝ ℝ).symm).trans
      (linear_map.coprod_equiv ℝ),
  rcases e.surjective Λ' with ⟨⟨Λ, Λ₀⟩, rfl⟩,
  refine ⟨Λ, Λ₀, e.map_ne_zero_iff.1 h0, λ x, _⟩,
  convert linear_map.congr_fun (linear_map.range_le_ker_iff.1 hΛ') x using 1,
  -- squeezed `simp [mul_comm]` to speed up elaboration
  simp only [mul_comm, algebra.id.smul_eq_mul, linear_equiv.trans_apply, linear_equiv.prod_apply,
             linear_equiv.refl_apply, linear_map.ring_lmap_equiv_self_symm_apply,
             linear_map.coprod_equiv_apply, continuous_linear_map.to_linear_map_eq_coe,
             continuous_linear_map.coe_prod, linear_map.coprod_comp_prod, linear_map.add_apply,
             linear_map.coe_comp, continuous_linear_map.coe_coe, linear_map.coe_smul_right,
             linear_map.one_apply]
end

/-- Lagrange multipliers theorem: if `φ : E → ℝ` has a local extremum on the set `{x | f x = f x₀}`
at `x₀`, and both `f : E → ℝ` and `φ` are strictly differentiable at `x₀`, then there exist
`a b : ℝ` such that `(a, b) ≠ 0` and `a • f' + b • φ' = 0`. -/
lemma is_local_extr_on.exists_multipliers_of_has_strict_fderiv_at_1d
  {f : E → ℝ} {f' : E →L[ℝ] ℝ}
  (hextr : is_local_extr_on φ {x | f x = f x₀} x₀) (hf' : has_strict_fderiv_at f f' x₀)
  (hφ' : has_strict_fderiv_at φ φ' x₀) :
  ∃ (a b : ℝ), (a, b) ≠ 0 ∧ a • f' + b • φ' = 0 :=
begin
  obtain ⟨Λ, Λ₀, hΛ, hfΛ⟩ := hextr.exists_linear_map_of_has_strict_fderiv_at hf' hφ',
  refine ⟨Λ 1, Λ₀, _, _⟩,
  { contrapose! hΛ,
    simp only [prod.mk_eq_zero] at ⊢ hΛ,
    refine ⟨linear_map.ext (λ x, _), hΛ.2⟩,
    simpa [hΛ.1] using Λ.map_smul x 1 },
  { ext x,
    have H₁ : Λ (f' x) = f' x * Λ 1,
    { simpa only [mul_one, algebra.id.smul_eq_mul] using Λ.map_smul (f' x) 1 },
    have H₂ : f' x * Λ 1  + Λ₀ * φ' x = 0,
    { simpa only [algebra.id.smul_eq_mul, H₁] using hfΛ x },
    simpa [mul_comm] using H₂ }
end

/-- Lagrange multipliers theorem, 1d version. Let `f : ι → E → ℝ` be a finite family of functions.
Suppose that `φ : E → ℝ` has a local extremum on the set `{x | ∀ i, f i x = f i x₀}` at `x₀`.
Suppose that all functions `f i` as well as `φ` are strictly differentiable at `x₀`.
Then the derivatives `f' i : E → L[ℝ] ℝ` and `φ' : E →L[ℝ] ℝ` are linearly dependent:
there exist `Λ : ι → ℝ` and `Λ₀ : ℝ`, `(Λ, Λ₀) ≠ 0`, such that `∑ i, Λ i • f' i + Λ₀ • φ' = 0`.

See also `is_local_extr_on.linear_dependent_of_has_strict_fderiv_at` for a version that
states `¬linear_independent ℝ _` instead of existence of `Λ` and `Λ₀`. -/
lemma is_local_extr_on.exists_multipliers_of_has_strict_fderiv_at {ι : Type*} [fintype ι]
  {f : ι → E → ℝ} {f' : ι → E →L[ℝ] ℝ}
  (hextr : is_local_extr_on φ {x | ∀ i, f i x = f i x₀} x₀)
  (hf' : ∀ i, has_strict_fderiv_at (f i) (f' i) x₀)
  (hφ' : has_strict_fderiv_at φ φ' x₀) :
  ∃ (Λ : ι → ℝ) (Λ₀ : ℝ), (Λ, Λ₀) ≠ 0 ∧ ∑ i, Λ i • f' i + Λ₀ • φ' = 0 :=
begin
  letI := classical.dec_eq ι,
  replace hextr : is_local_extr_on φ {x | (λ i, f i x) = (λ i, f i x₀)} x₀,
    by simpa only [function.funext_iff] using hextr,
  rcases hextr.exists_linear_map_of_has_strict_fderiv_at
    (has_strict_fderiv_at_pi.2 (λ i, hf' i)) hφ'
    with ⟨Λ, Λ₀, h0, hsum⟩,
  rcases (linear_equiv.pi_ring ℝ ℝ ι ℝ).symm.surjective Λ with ⟨Λ, rfl⟩,
  refine ⟨Λ, Λ₀, _, _⟩,
  { simpa only [ne.def, prod.ext_iff, linear_equiv.map_eq_zero_iff, prod.fst_zero] using h0 },
  { ext x, simpa [mul_comm] using hsum x }
end

/-- Lagrange multipliers theorem. Let `f : ι → E → ℝ` be a finite family of functions.
Suppose that `φ : E → ℝ` has a local extremum on the set `{x | ∀ i, f i x = f i x₀}` at `x₀`.
Suppose that all functions `f i` as well as `φ` are strictly differentiable at `x₀`.
Then the derivatives `f' i : E → L[ℝ] ℝ` and `φ' : E →L[ℝ] ℝ` are linearly dependent.

See also `is_local_extr_on.exists_multipliers_of_has_strict_fderiv_at` for a version that
that states existence of Lagrange multipliers `Λ` and `Λ₀` instead of using
`¬linear_independent ℝ _` -/
lemma is_local_extr_on.linear_dependent_of_has_strict_fderiv_at {ι : Type*} [finite ι]
  {f : ι → E → ℝ} {f' : ι → E →L[ℝ] ℝ}
  (hextr : is_local_extr_on φ {x | ∀ i, f i x = f i x₀} x₀)
  (hf' : ∀ i, has_strict_fderiv_at (f i) (f' i) x₀)
  (hφ' : has_strict_fderiv_at φ φ' x₀) :
  ¬linear_independent ℝ (option.elim φ' f' : option ι → E →L[ℝ] ℝ) :=
begin
  casesI nonempty_fintype ι,
  rw [fintype.linear_independent_iff], push_neg,
  rcases hextr.exists_multipliers_of_has_strict_fderiv_at hf' hφ' with ⟨Λ, Λ₀, hΛ, hΛf⟩,
  refine ⟨option.elim Λ₀ Λ, _, _⟩,
  { simpa [add_comm] using hΛf },
  { simpa [function.funext_iff, not_and_distrib, or_comm, option.exists] using hΛ }
end


import topology.basic

open topological_space set filter
localized "notation `𝓝` := nhds" in topological_space
localized "notation `𝓝[` s `] ` x:100 := nhds_within x s" in topological_space

noncomputable theory
open classical

variables {X : Type} [topological_space X] [nonempty X]

class t0_space (X : Type) [topological_space X] : Prop :=
(t0 : ∀ x y, x ≠ y → ∃ (U : set X), is_open U ∧ ((x ∈ U ∧ y ∉ U) ∨ (x ∉ U ∧ y ∈ U)) )

class t1_space (X : Type) [topological_space X] : Prop :=
(t1 : ∀ x y, x ≠ y → ∃ (U : set X), is_open U ∧ x ∈ U ∧ y ∉ U)

instance t1_space.t0_space [t1_space X] : t0_space X :=
begin
  sorry
end

lemma t1_iff_singleton_closed : t1_space X ↔ ∀ x, is_closed ({x} : set X) :=
begin
  sorry
end

class t2_space (X : Type) [topological_space X] : Prop :=
(t2 : ∀ x y, x ≠ y → ∃ (U V: set X) (hU : is_open U) (hV: is_open V) (hUV : U ∩ V = ∅), x ∈ U ∧ y ∈ V)

instance t2_space.t1_space [t2_space X] : t1_space X :=
begin
  sorry
end

variables (f : filter X) (x : X)

def filter_lim (f : filter X) (x : X) := f ≤ 𝓝 x ∧ f ≠ ⊥

def limit_unicity (X : Type) [topological_space X] [nonempty X] :=
      ∀ (x y : X) (f : filter X) (hx : filter_lim f x) (hy : filter_lim f y), x=y

lemma t2_iff_unicity : t2_space X ↔ limit_unicity X :=
begin
  sorry
end

class t2_5_space (X : Type) [topological_space X] : Prop :=
(t2_5 : ∀ x y  (h : x ≠ y), ∃ (U V: set X), is_open U ∧  is_open V ∧
                                            closure U ∩ closure V = ∅ ∧ x ∈ U ∧ y ∈ V)

instance t2_5_space.t2_space [t2_5_space X] : t2_space X :=
begin
  sorry
end

def regular_space (X : Type) [topological_space X] := ∀ (x : X) (F : set X) (hF : is_closed F) (hxF : x ∉ F),
  ∃ (U V : set X) (hU : is_open U) (hV : is_open V) (hUV : U ∩ V = ∅), x ∈ U ∧ F ⊆ V

class t3_space (X : Type) [topological_space X] extends t1_space X : Prop :=
(regular : regular_space X)

instance t3_space.t2_space [t3_space X] : t2_space X :=
begin
  sorry
end

instance t2_space.t2_5_space [t3_space X] : t2_5_space X :=
begin
  sorry
end

lemma inter_is_not_is_empty_intersection {X : Type} {x : X} {U V : set X}
  (hxU : x ∈ U) (hUV : U ∩ V = ∅ ) : x ∉ V := disjoint_left.1 (disjoint_iff_inter_eq_empty.2 hUV) hxU

lemma t3_iff_t0_regular : t3_space X ↔ t0_space X ∧ regular_space X :=
begin
  sorry
end

lemma regular_iff_filter_def : regular_space X ↔ ∀{s:set X} {a}, is_closed s → a ∉ s → ∃t, is_open t ∧ s ⊆ t ∧ 𝓝[t] a = ⊥ :=
begin
  sorry
end

lemma t3_iff_open_closure : t3_space X ↔ t1_space X ∧ (∀ (x : X) (U : set X) (hx : x ∈ U) (hU : is_open U),
    ∃ (V : set X) (hV : is_open V), x ∈ V ∧ closure V ⊆ U) :=
begin
  sorry
end

def normal_space (X : Type) [topological_space X] := ∀ (F T : set X) (hF : is_closed F) (hT : is_closed T) (hFT : F ∩ T = ∅),
        ∃ (U V : set X) (hU : is_open U) (hV : is_open V) (hUV : U ∩ V = ∅), F ⊆ U ∧ T ⊆ V

class t4_space (X : Type) [topological_space X] extends t1_space X : Prop :=
(normal : normal_space X)

instance t4_space.t3_space [t4_space X] : t3_space X :=
begin
  sorry
end

lemma t4_iff_open_closure : t4_space X ↔ t1_space X ∧ (∀ (U K : set X) (hK : is_closed K) (hU : is_open U) (hKU: K ⊆ U),
        ∃ (V : set X) (hV : is_open V), K ⊆ V ∧ closure V ⊆ U) :=
begin
  sorry
end


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Mario Carneiro

! This file was ported from Lean 3 source module topology.instances.nat
! leanprover-community/mathlib commit 620af85adf5cd4282f962eb060e6e562e3e0c0ba
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Topology.Instances.Int

/-!
# Topology on the natural numbers

The structure of a metric space on `ℕ` is introduced in this file, induced from `ℝ`.
-/

noncomputable section

open Metric Set Filter

namespace Nat

noncomputable instance : Dist ℕ :=
  ⟨fun x y => dist (x : ℝ) y⟩

theorem dist_eq (x y : ℕ) : dist x y = |(x : ℝ) - y| := rfl
#align nat.dist_eq Nat.dist_eq

theorem dist_coe_int (x y : ℕ) : dist (x : ℤ) (y : ℤ) = dist x y := rfl
#align nat.dist_coe_int Nat.dist_coe_int

@[norm_cast, simp]
theorem dist_cast_real (x y : ℕ) : dist (x : ℝ) y = dist x y := rfl
#align nat.dist_cast_real Nat.dist_cast_real

theorem pairwise_one_le_dist : Pairwise fun m n : ℕ => 1 ≤ dist m n := fun m n hne =>
  Int.pairwise_one_le_dist <| by exact_mod_cast hne
#align nat.pairwise_one_le_dist Nat.pairwise_one_le_dist

theorem uniformEmbedding_coe_real : UniformEmbedding ((↑) : ℕ → ℝ) :=
  uniformEmbedding_bot_of_pairwise_le_dist zero_lt_one pairwise_one_le_dist
#align nat.uniform_embedding_coe_real Nat.uniformEmbedding_coe_real

theorem closedEmbedding_coe_real : ClosedEmbedding ((↑) : ℕ → ℝ) :=
  closedEmbedding_of_pairwise_le_dist zero_lt_one pairwise_one_le_dist
#align nat.closed_embedding_coe_real Nat.closedEmbedding_coe_real

instance : MetricSpace ℕ := Nat.uniformEmbedding_coe_real.comapMetricSpace _

theorem preimage_ball (x : ℕ) (r : ℝ) : (↑) ⁻¹' ball (x : ℝ) r = ball x r := rfl
#align nat.preimage_ball Nat.preimage_ball

theorem preimage_closedBall (x : ℕ) (r : ℝ) : (↑) ⁻¹' closedBall (x : ℝ) r = closedBall x r := rfl
#align nat.preimage_closed_ball Nat.preimage_closedBall

theorem closedBall_eq_Icc (x : ℕ) (r : ℝ) : closedBall x r = Icc ⌈↑x - r⌉₊ ⌊↑x + r⌋₊ := by
  rcases le_or_lt 0 r with (hr | hr)
  · rw [← preimage_closedBall, Real.closedBall_eq_Icc, preimage_Icc]
    exact add_nonneg (cast_nonneg x) hr
  · rw [closedBall_eq_empty.2 hr, Icc_eq_empty_of_lt]
    calc ⌊(x : ℝ) + r⌋₊ ≤ ⌊(x : ℝ)⌋₊ := floor_mono <| by linarith
    _ < ⌈↑x - r⌉₊ := by
      rw [floor_coe, Nat.lt_ceil]
      linarith
#align nat.closed_ball_eq_Icc Nat.closedBall_eq_Icc

instance : ProperSpace ℕ :=
  ⟨fun x r => by
    rw [closedBall_eq_Icc]
    exact (Set.finite_Icc _ _).isCompact⟩

instance : NoncompactSpace ℕ :=
  noncompactSpace_of_neBot <| by simp [Filter.atTop_neBot]

end Nat


import polyomino.basic
import algebra.group.prod

open polyomino

namespace polyomino.fixed

variables n : ℕ

structure transform :=
(map : equiv.perm (ℤ × ℤ))
(translation : ∀ x y, map (x + y) = map x + y)

namespace transform

  @[ext] lemma ext {x y : transform} : x.map = y.map → x = y :=
  begin
    intros h,
    cases x,
    cases y,
    congr,
    apply h,
  end

  instance : group transform :=
  begin
    refine
    {
      mul := λ x y, ⟨x.map * y.map, _⟩,
      mul_assoc := _,
      one := ⟨1, _⟩,
      one_mul := _,
      mul_one := _,
      inv := λ x, ⟨x.map⁻¹, _⟩,
      mul_left_inv := _,
    },
    {
      simp [x.translation, y.translation],
    },
    {
      simp [mul_assoc],
    },
    {
      simp,
    },
    {
      intros x,
      ext1,
      apply one_mul,
    },
    {
      intros x,
      ext1,
      apply mul_one,
    },
    {
      intros a b,
      apply x.map.injective,
      simp [x.translation],
    },
    {
      intros x,
      ext1,
      apply mul_left_inv,
    },
  end

  @[simp] lemma map_mul (x y : transform) : (x * y).map = x.map * y.map := rfl
  @[simp] lemma map_one : (1 : transform).map = 1 := rfl
  @[simp] lemma map_inv (x : transform) : x⁻¹.map = x.map⁻¹ := rfl

  def of_vector (x : ℤ × ℤ) : transform :=
  begin
    refine ⟨⟨λ y, y + x, λ y, y - x, by intro; simp, by intro; simp⟩, _⟩,
    intros y z,
    dsimp,
    rw [add_assoc y z x, add_assoc y x z, add_comm z x],
  end

  @[simp] lemma of_vector_coe_fn (x y) : ⇑((of_vector (x, y)).map) = λ a, a + (x, y) := rfl

end transform

def equiv (x y : polyomino n) := ∃ t : transform, x.shape.map t.map.to_embedding = y.shape

def setoid {n} : setoid (polyomino n) :=
begin
  use equiv n,
  apply mk_equivalence,
  {
    intros x,
    use 1,
    ext a,
    rw finset.mem_map,
    split,
    {
      rintros ⟨b, b_in_x, b_eq_a⟩,
      rw ← b_eq_a,
      simpa,
    },
    {
      intros a_mem_shape,
      use a,
      split; simp *,
    },
  },
  {
    rintros x y ⟨t, x_equiv_y⟩,
    use t⁻¹,
    ext a,
    rw finset.mem_map,
    rw ← x_equiv_y,
    split,
    {
      rintros ⟨b, b_in_y, b_equiv_a⟩,
      subst a,
      rw finset.mem_map at b_in_y,
      rcases b_in_y with ⟨a, a_in_x, a_equiv_b⟩,
      subst b,
      simpa,
    },
    {
      intros a_in_x,
      use t.map a,
      split,
      {
        rw finset.mem_map,
        use a,
        simpa,
      },
      {
        simp,
      },
    },
  },
  {
    rintros x y z ⟨t, x_equiv_y⟩ ⟨u, y_equiv_z⟩,
    use u * t,
    dsimp,
    ext a,
    rw finset.mem_map,
    split,
    {
      rintros ⟨b, b_in_x, b_equiv_a⟩,
      rw [← y_equiv_z, finset.mem_map],
      use t.map b,
      dsimp at *,
      rw equiv.perm.mul_apply at b_equiv_a,
      refine ⟨_, b_equiv_a⟩,
      rw ← x_equiv_y,
      rw finset.mem_map,
      use b,
      simpa,
    },
    {
      rw [← y_equiv_z, finset.mem_map],
      rintros ⟨b, b_in_y, b_equiv_a⟩,
      use t.map⁻¹ b,
      dsimp at *,
      rw [equiv.perm.mul_apply, equiv.perm.apply_inv_self],
      refine ⟨_, b_equiv_a⟩,
      rw [← x_equiv_y, finset.mem_map] at b_in_y,
      rcases b_in_y with ⟨c, c_in_x, c_equiv_b⟩,
      rw ← c_equiv_b,
      simpa,
    },
  },
end

local attribute [instance] setoid

@[simp] lemma equiv_def (x y : polyomino n) : x ≈ y = ∃ t : transform, x.shape.map t.map.to_embedding = y.shape := rfl

def fixed_polyomino (n) := quotient (@setoid n)

example : fintype (fixed_polyomino 2) :=
begin
  refine ⟨⟨{⟦⟨{⟨0, 0⟩, ⟨0, 1⟩}, by simp, _⟩⟧, ⟦⟨{⟨0, 0⟩, ⟨1, 0⟩}, by simp, _⟩⟧}, _⟩, _⟩,
  {
    apply connected.insert,
    {
      apply finset.mem_singleton_self,
    },
    {
      apply adjacent.up,
    },
    {
      apply connected.singleton,
    },
  },
  {
    apply connected.insert,
    {
      apply finset.mem_singleton_self,
    },
    {
      apply adjacent.right,
    },
    {
      apply connected.singleton,
    },
  },
  {
    apply multiset.coe_nodup.mpr,
    apply list.nodup_cons_of_nodup,
    {
      rw list.mem_singleton,
      rw quotient.eq,
      dsimp,
      rintros ⟨t, contra⟩,
      rw [finset.map_insert, finset.map_singleton, finset.ext_iff] at contra,
      dsimp at contra,
      have contra₁ := (contra ⟨0, 0⟩).mpr (by simp),
      have contra₂ := (contra ⟨1, 0⟩).mpr (by simp),
      clear contra,
      rw [finset.mem_insert, finset.mem_singleton] at *,
      cases contra₁;
      cases contra₂,
      {
        revert contra₂,
        rw ← contra₁,
        exact dec_trivial,
      },
      {
        apply_fun (λ x, x + (0, 1)) at contra₁,
        rw ← t.translation at contra₁,
        simp only [prod.mk_add_mk, zero_add] at contra₁,
        revert contra₂,
        rw ← contra₁,
        exact dec_trivial,
      },
      {
        apply_fun (λ x, x + (0, 1)) at contra₂,
        rw ← t.translation at contra₂,
        simp only [prod.mk_add_mk, zero_add] at contra₂,
        revert contra₂,
        rw ← contra₁,
        exact dec_trivial,
      },
      {
        revert contra₂,
        rw ← contra₁,
        exact dec_trivial,
      },
    },
    {
      apply list.nodup_singleton,
    },
  },
  {
    intros x,
    rw finset.mem_def,
    dsimp,
    rw [multiset.mem_cons, multiset.mem_singleton],
    rw ← quotient.out_eq x,
    cases quotient.out x with s card_s conn_s,
    clear x,
    simp [quotient.eq],
    revert card_s,
    apply connected.induction_on conn_s; clear conn_s s,
    {
      contradiction,
    },
    {
      tidy,
    },
    intros a b s a_not_mem_s b_mem_s adj_a_b ih card_s,
    rw [finset.card_insert_of_not_mem a_not_mem_s, nat.succ_inj', finset.card_eq_one] at card_s,
    cases card_s with c s_eq,
    subst s,
    rw finset.mem_singleton at *,
    subst c,
    cases adj_a_b with x y x y x y x y,
    {
      left,
      use transform.of_vector (-x, -y),
      simp [add_comm],
    },
    {
      left,
      use transform.of_vector (-x, 1 - y),
      simp only [finset.map_insert, finset.map_singleton, equiv.to_embedding_coe_fn, transform.of_vector_coe_fn],
      simp only [prod.mk_add_mk, add_sub_cancel'_right, add_right_neg, add_sub, add_sub_cancel', sub_add_cancel, sub_self],
      exact finset.insert.comm (0, 1) (0, 0) ∅,
    },
    {
      right,
      use transform.of_vector (-x, -y),
      simp [add_comm],
    },
    {
      right,
      use transform.of_vector (1 - x, -y),
      simp only [finset.map_insert, finset.map_singleton, equiv.to_embedding_coe_fn, transform.of_vector_coe_fn],
      simp only [prod.mk_add_mk, add_sub_cancel'_right, add_right_neg, add_sub, add_sub_cancel', sub_add_cancel, sub_self],
      exact finset.insert.comm (1, 0) (0, 0) ∅,
    },
  },
end

end polyomino.fixed


import .global
universe u
local notation `Ring` := CommRing.{u}
local notation `Set` :=  Type u
open CommRing
namespace V_definition
variables (R : Ring)

def V_obj (S : set R)(A : Ring) : Type u := { ζ : ring_hom R A | ∀ x ∈ S, ζ (x)  = 0}

lemma mem_V_obj (R : Ring) (S : set R)(A : Ring)(ζ: ring_hom R A) : (∀ x ∈ S, ζ (x) = 0) →   V_obj(R)(S)(A) :=
begin
  intros h,
  exact {val := ζ, property := h},
end
lemma V_mem (S :set R)(A :Ring)(ζ : V_obj(R)(S)(A)) : ∀ x  ∈ S, ζ.val x = 0 := begin
  exact ζ.property,
end
@[ext]lemma  ext ( R : Ring) (S : set R)(A : Ring)(ζ1 ζ2 : V_obj R S A) : ζ1.val = ζ2.val → ζ1 = ζ2 :=
begin
            intro h,
            cases ζ1,
            cases ζ2,
            congr ; try { assumption },
end

def V_map (S : set R)(A B : Ring) (ψ : A ⟶ B) : V_obj(R)(S)(A) → V_obj(R)(S)(B) := λ ζ, begin
   have Hypx : ∀ x ∈ S, ψ (ζ.val x) = 0,
      intros x h,
      rw V_mem,
      exact ψ.map_zero,
      assumption,
    exact {val :=  (ring_hom.comp ψ ( ζ.val )), property := Hypx},
end
lemma comp_val (S : set R)(A B : Ring) (ψ : A ⟶ B)(ζ : V_obj R S A) :
 ((V_map R S A B ψ) ζ).val = ring_hom.comp ψ ζ.val := rfl
lemma one_val (S : set R)(A : Ring)(ζ : V_obj R S A) : ((V_map R S A A (𝟙A)) ζ).val = ζ.val :=
begin
     rw comp_val,
     ext,
     rw [ring_hom.comp_apply],
     exact rfl,
end
def V (S : set R) : Ring ⥤  Type u := begin
exact {
  obj := λ A : Ring, V_obj R S A,
  map := λ A B : Ring, λ ψ : A ⟶ B, V_map R S A B ψ,
  map_id' := λ A : Ring, begin
     funext,
     ext,
     rw one_val,
     exact rfl,
  end
   }
end
end V_definition