/-
Copyright (c) 2020 Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bhavik Mehta
-/
import category_theory.limits.shapes.split_coequalizer
import category_theory.limits.preserves.basic

/-!
# Preserving (co)equalizers

Constructions to relate the notions of preserving (co)equalizers and reflecting (co)equalizers
to concrete (co)forks.

In particular, we show that `equalizer_comparison f g G` is an isomorphism iff `G` preserves
the limit of the parallel pair `f,g`, as well as the dual result.
-/

noncomputable theory

universes v u₁ u₂

open category_theory category_theory.category category_theory.limits

variables {C : Type u₁} [category.{v} C]
variables {D : Type u₂} [category.{v} D]
variables (G : C ⥤ D)

namespace category_theory.limits

section equalizers
variables {X Y Z : C} {f g : X ⟶ Y} {h : Z ⟶ X} (w : h ≫ f = h ≫ g)

/--
The map of a fork is a limit iff the fork consisting of the mapped morphisms is a limit. This
essentially lets us commute `fork.of_ι` with `functor.map_cone`.
-/
def is_limit_map_cone_fork_equiv :
  is_limit (G.map_cone (fork.of_ι h w)) ≃
  is_limit (fork.of_ι (G.map h) (by simp only [←G.map_comp, w]) : fork (G.map f) (G.map g)) :=
(is_limit.postcompose_hom_equiv (diagram_iso_parallel_pair.{v} _) _).symm.trans
  (is_limit.equiv_iso_limit (fork.ext (iso.refl _) (by simp)))

/-- The property of preserving equalizers expressed in terms of forks. -/
def is_limit_fork_map_of_is_limit [preserves_limit (parallel_pair f g) G]
  (l : is_limit (fork.of_ι h w)) :
  is_limit (fork.of_ι (G.map h) (by simp only [←G.map_comp, w]) : fork (G.map f) (G.map g)) :=
is_limit_map_cone_fork_equiv G w (preserves_limit.preserves l)

/-- The property of reflecting equalizers expressed in terms of forks. -/
def is_limit_of_is_limit_fork_map [reflects_limit (parallel_pair f g) G]
  (l : is_limit (fork.of_ι (G.map h) (by simp only [←G.map_comp, w]) : fork (G.map f) (G.map g))) :
  is_limit (fork.of_ι h w) :=
reflects_limit.reflects ((is_limit_map_cone_fork_equiv G w).symm l)

variables (f g) [has_equalizer f g]

/--
If `G` preserves equalizers and `C` has them, then the fork constructed of the mapped morphisms of
a fork is a limit.
-/
def is_limit_of_has_equalizer_of_preserves_limit
  [preserves_limit (parallel_pair f g) G] :
  is_limit (fork.of_ι (G.map (equalizer.ι f g))
                      (by simp only [←G.map_comp, equalizer.condition])) :=
is_limit_fork_map_of_is_limit G _ (equalizer_is_equalizer f g)

variables [has_equalizer (G.map f) (G.map g)]

/--
If the equalizer comparison map for `G` at `(f,g)` is an isomorphism, then `G` preserves the
equalizer of `(f,g)`.
-/
def preserves_equalizer.of_iso_comparison [i : is_iso (equalizer_comparison f g G)] :
  preserves_limit (parallel_pair f g) G :=
begin
  apply preserves_limit_of_preserves_limit_cone (equalizer_is_equalizer f g),
  apply (is_limit_map_cone_fork_equiv _ _).symm _,
  apply is_limit.of_point_iso (limit.is_limit (parallel_pair (G.map f) (G.map g))),
  apply i,
end

variables [preserves_limit (parallel_pair f g) G]
/--
If `G` preserves the equalizer of `(f,g)`, then the equalizer comparison map for `G` at `(f,g)` is
an isomorphism.
-/
def preserves_equalizer.iso :
  G.obj (equalizer f g) ≅ equalizer (G.map f) (G.map g) :=
is_limit.cone_point_unique_up_to_iso
  (is_limit_of_has_equalizer_of_preserves_limit G f g)
  (limit.is_limit _)

@[simp]
lemma preserves_equalizer.iso_hom :
  (preserves_equalizer.iso G f g).hom = equalizer_comparison f g G :=
rfl

instance : is_iso (equalizer_comparison f g G) :=
begin
  rw ← preserves_equalizer.iso_hom,
  apply_instance
end

end equalizers

section coequalizers

variables {X Y Z : C} {f g : X ⟶ Y} {h : Y ⟶ Z} (w : f ≫ h = g ≫ h)

/--
The map of a cofork is a colimit iff the cofork consisting of the mapped morphisms is a colimit.
This essentially lets us commute `cofork.of_π` with `functor.map_cocone`.
-/
def is_colimit_map_cocone_cofork_equiv :
  is_colimit (G.map_cocone (cofork.of_π h w)) ≃
  is_colimit (cofork.of_π (G.map h) (by simp only [←G.map_comp, w]) : cofork (G.map f) (G.map g)) :=
(is_colimit.precompose_inv_equiv (diagram_iso_parallel_pair.{v} _) _).symm.trans
  (is_colimit.equiv_iso_colimit (cofork.ext (iso.refl _) (by { dsimp, simp })))

/-- The property of preserving coequalizers expressed in terms of coforks. -/
def is_colimit_cofork_map_of_is_colimit [preserves_colimit (parallel_pair f g) G]
  (l : is_colimit (cofork.of_π h w)) :
  is_colimit (cofork.of_π (G.map h) (by simp only [←G.map_comp, w]) : cofork (G.map f) (G.map g)) :=
is_colimit_map_cocone_cofork_equiv G w (preserves_colimit.preserves l)

/-- The property of reflecting coequalizers expressed in terms of coforks. -/
def is_colimit_of_is_colimit_cofork_map [reflects_colimit (parallel_pair f g) G]
  (l : is_colimit (cofork.of_π (G.map h) (by simp only [←G.map_comp, w])
                  : cofork (G.map f) (G.map g))) :
  is_colimit (cofork.of_π h w) :=
reflects_colimit.reflects ((is_colimit_map_cocone_cofork_equiv G w).symm l)

variables (f g) [has_coequalizer f g]

/--
If `G` preserves coequalizers and `C` has them, then the cofork constructed of the mapped morphisms
of a cofork is a colimit.
-/
def is_colimit_of_has_coequalizer_of_preserves_colimit
  [preserves_colimit (parallel_pair f g) G] :
  is_colimit (cofork.of_π (G.map (coequalizer.π f g)) _) :=
is_colimit_cofork_map_of_is_colimit G _ (coequalizer_is_coequalizer f g)

variables [has_coequalizer (G.map f) (G.map g)]

/--
If the coequalizer comparison map for `G` at `(f,g)` is an isomorphism, then `G` preserves the
coequalizer of `(f,g)`.
-/
def of_iso_comparison [i : is_iso (coequalizer_comparison f g G)] :
  preserves_colimit (parallel_pair f g) G :=
begin
  apply preserves_colimit_of_preserves_colimit_cocone (coequalizer_is_coequalizer f g),
  apply (is_colimit_map_cocone_cofork_equiv _ _).symm _,
  apply is_colimit.of_point_iso (colimit.is_colimit (parallel_pair (G.map f) (G.map g))),
  apply i,
end

variables [preserves_colimit (parallel_pair f g) G]
/--
If `G` preserves the coequalizer of `(f,g)`, then the coequalizer comparison map for `G` at `(f,g)`
is an isomorphism.
-/
def preserves_coequalizer.iso :
  coequalizer (G.map f) (G.map g) ≅ G.obj (coequalizer f g) :=
is_colimit.cocone_point_unique_up_to_iso
  (colimit.is_colimit _)
  (is_colimit_of_has_coequalizer_of_preserves_colimit G f g)

@[simp]
lemma preserves_coequalizer.iso_hom :
  (preserves_coequalizer.iso G f g).hom = coequalizer_comparison f g G :=
rfl

instance : is_iso (coequalizer_comparison f g G) :=
begin
  rw ← preserves_coequalizer.iso_hom,
  apply_instance
end

/-- Any functor preserves coequalizers of split pairs. -/
@[priority 1]
instance preserves_split_coequalizers (f g : X ⟶ Y) [has_split_coequalizer f g] :
  preserves_colimit (parallel_pair f g) G :=
begin
  apply preserves_colimit_of_preserves_colimit_cocone
            ((has_split_coequalizer.is_split_coequalizer f g).is_coequalizer),
  apply (is_colimit_map_cocone_cofork_equiv G _).symm
            ((has_split_coequalizer.is_split_coequalizer f g).map G).is_coequalizer,
end
end coequalizers

end category_theory.limits


/-
Copyright (c) 2022 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel

! This file was ported from Lean 3 source module analysis.special_functions.gaussian
! leanprover-community/mathlib commit 34d3797325d202bd7250431275bb871133cdb611
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.SpecialFunctions.Gamma
import Mathbin.Analysis.SpecialFunctions.PolarCoord
import Mathbin.Analysis.Convex.Complex
import Mathbin.Analysis.Normed.Group.Basic
import Mathbin.Analysis.Complex.CauchyIntegral
import Mathbin.MeasureTheory.Group.Integration
import Mathbin.Analysis.Fourier.PoissonSummation

/-!
# Gaussian integral

We prove various versions of the formula for the Gaussian integral:
* `integral_gaussian`: for real `b` we have `∫ x:ℝ, exp (-b * x^2) = sqrt (π / b)`.
* `integral_gaussian_complex`: for complex `b` with `0 < re b` we have
  `∫ x:ℝ, exp (-b * x^2) = (π / b) ^ (1 / 2)`.
* `integral_gaussian_Ioi` and `integral_gaussian_complex_Ioi`: variants for integrals over `Ioi 0`.
* `complex.Gamma_one_half_eq`: the formula `Γ (1 / 2) = √π`.

We also prove, more generally, that the Fourier transform of the Gaussian is another Gaussian:

* `integral_cexp_neg_mul_sq_add_const`: for all complex `b` and `c` with `0 < re b` we have
  `∫ (x : ℝ), exp (-b * (x + c) ^ 2) = (π / b) ^ (1 / 2)`.
* `fourier_transform_gaussian`: for all complex `b` and `t` with `0 < re b`, we have
  `∫ x:ℝ, exp (I * t * x) * exp (-b * x^2) = (π / b) ^ (1 / 2) * exp (-t ^ 2 / (4 * b))`.
* `fourier_transform_gaussian_pi`: a variant with `b` and `t` scaled to give a more symmetric
  statement, and formulated in terms of the Fourier transform operator `𝓕`.

As an application, in `real.tsum_exp_neg_mul_int_sq` and `complex.tsum_exp_neg_mul_int_sq`, we use
Poisson summation to prove the identity
`∑' (n : ℤ), exp (-π * a * n ^ 2) = 1 / a ^ (1 / 2) * ∑' (n : ℤ), exp (-π / a * n ^ 2)`
for positive real `a`, or complex `a` with positive real part. (See also
`number_theory.modular_forms.jacobi_theta`.)
-/

noncomputable section

open Real Set MeasureTheory Filter Asymptotics

open Real Topology FourierTransform

open Complex hiding exp continuous_exp abs_of_nonneg sq_abs

-- mathport name: exprcexp
notation "cexp" => Complex.exp

-- mathport name: exprrexp
notation "rexp" => Real.exp

theorem exp_neg_mul_sq_isOCat_exp_neg {b : ℝ} (hb : 0 < b) :
    (fun x : ℝ => exp (-b * x ^ 2)) =o[atTop] fun x : ℝ => exp (-x) :=
  by
  have A : (fun x : ℝ => -x - -b * x ^ 2) = fun x => x * (b * x + -1) :=
    by
    ext x
    ring
  rw [is_o_exp_comp_exp_comp, A]
  apply tendsto.at_top_mul_at_top tendsto_id
  apply tendsto_at_top_add_const_right at_top (-1 : ℝ)
  exact tendsto.const_mul_at_top hb tendsto_id
#align exp_neg_mul_sq_is_o_exp_neg exp_neg_mul_sq_isOCat_exp_neg

theorem rpow_mul_exp_neg_mul_sq_isOCat_exp_neg {b : ℝ} (hb : 0 < b) (s : ℝ) :
    (fun x : ℝ => x ^ s * exp (-b * x ^ 2)) =o[atTop] fun x : ℝ => exp (-(1 / 2) * x) :=
  by
  apply
    ((is_O_refl (fun x : ℝ => x ^ s) at_top).mul_isOCat (exp_neg_mul_sq_isOCat_exp_neg hb)).trans
  convert Gamma_integrand_is_o s
  simp_rw [mul_comm]
#align rpow_mul_exp_neg_mul_sq_is_o_exp_neg rpow_mul_exp_neg_mul_sq_isOCat_exp_neg

theorem integrableOnRpowMulExpNegMulSq {b : ℝ} (hb : 0 < b) {s : ℝ} (hs : -1 < s) :
    IntegrableOn (fun x : ℝ => x ^ s * exp (-b * x ^ 2)) (Ioi 0) :=
  by
  rw [← Ioc_union_Ioi_eq_Ioi (zero_le_one : (0 : ℝ) ≤ 1), integrable_on_union]
  constructor
  · rw [← integrableOn_Icc_iff_integrableOn_Ioc]
    refine' integrable_on.mul_continuous_on _ _ is_compact_Icc
    · refine' (intervalIntegrable_iff_integrable_Icc_of_le zero_le_one).mp _
      exact intervalIntegral.intervalIntegrableRpow' hs
    · exact (continuous_exp.comp (continuous_const.mul (continuous_pow 2))).ContinuousOn
  · have B : (0 : ℝ) < 1 / 2 := by norm_num
    apply integrableOfIsOExpNeg B _ (is_o.is_O (rpow_mul_exp_neg_mul_sq_isOCat_exp_neg hb _))
    intro x hx
    have N : x ≠ 0 := by
      refine' (zero_lt_one.trans_le _).ne'
      exact hx
    apply ((continuous_at_rpow_const _ _ (Or.inl N)).mul _).ContinuousWithinAt
    exact (continuous_exp.comp (continuous_const.mul (continuous_pow 2))).ContinuousAt
#align integrable_on_rpow_mul_exp_neg_mul_sq integrableOnRpowMulExpNegMulSq

theorem integrableRpowMulExpNegMulSq {b : ℝ} (hb : 0 < b) {s : ℝ} (hs : -1 < s) :
    Integrable fun x : ℝ => x ^ s * exp (-b * x ^ 2) :=
  by
  rw [← integrable_on_univ, ← @Iio_union_Ici _ _ (0 : ℝ), integrable_on_union,
    integrableOn_Ici_iff_integrableOn_Ioi]
  refine' ⟨_, integrableOnRpowMulExpNegMulSq hb hs⟩
  rw [←
    (measure.measure_preserving_neg (volume : Measure ℝ)).integrableOn_comp_preimage
      (Homeomorph.neg ℝ).toMeasurableEquiv.MeasurableEmbedding]
  simp only [Function.comp, neg_sq, neg_preimage, preimage_neg_Iio, neg_neg, neg_zero]
  apply integrable.mono' (integrableOnRpowMulExpNegMulSq hb hs)
  · apply Measurable.aeStronglyMeasurable
    exact
      (measurable_id'.neg.pow measurable_const).mul
        ((measurable_id'.pow measurable_const).const_mul (-b)).exp
  · have : MeasurableSet (Ioi (0 : ℝ)) := measurableSet_Ioi
    filter_upwards [ae_restrict_mem this]with x hx
    have h'x : 0 ≤ x := le_of_lt hx
    rw [Real.norm_eq_abs, abs_mul, abs_of_nonneg (exp_pos _).le]
    apply mul_le_mul_of_nonneg_right _ (exp_pos _).le
    simpa [abs_of_nonneg h'x] using abs_rpow_le_abs_rpow (-x) s
#align integrable_rpow_mul_exp_neg_mul_sq integrableRpowMulExpNegMulSq

theorem integrableExpNegMulSq {b : ℝ} (hb : 0 < b) : Integrable fun x : ℝ => exp (-b * x ^ 2) := by
  simpa using integrableRpowMulExpNegMulSq hb (by norm_num : (-1 : ℝ) < 0)
#align integrable_exp_neg_mul_sq integrableExpNegMulSq

theorem integrableOn_Ioi_exp_neg_mul_sq_iff {b : ℝ} :
    IntegrableOn (fun x : ℝ => exp (-b * x ^ 2)) (Ioi 0) ↔ 0 < b :=
  by
  refine' ⟨fun h => _, fun h => (integrableExpNegMulSq h).IntegrableOn⟩
  by_contra' hb
  have : (∫⁻ x : ℝ in Ioi 0, 1) ≤ ∫⁻ x : ℝ in Ioi 0, ‖exp (-b * x ^ 2)‖₊ :=
    by
    apply lintegral_mono fun x => _
    simp only [neg_mul, ENNReal.one_le_coe_iff, ← to_nnreal_one, to_nnreal_le_iff_le_coe,
      Real.norm_of_nonneg (exp_pos _).le, coe_nnnorm, one_le_exp_iff, Right.nonneg_neg_iff]
    exact mul_nonpos_of_nonpos_of_nonneg hb (sq_nonneg _)
  simpa using this.trans_lt h.2
#align integrable_on_Ioi_exp_neg_mul_sq_iff integrableOn_Ioi_exp_neg_mul_sq_iff

theorem integrable_exp_neg_mul_sq_iff {b : ℝ} :
    (Integrable fun x : ℝ => exp (-b * x ^ 2)) ↔ 0 < b :=
  ⟨fun h => integrableOn_Ioi_exp_neg_mul_sq_iff.mp h.IntegrableOn, integrableExpNegMulSq⟩
#align integrable_exp_neg_mul_sq_iff integrable_exp_neg_mul_sq_iff

theorem integrableMulExpNegMulSq {b : ℝ} (hb : 0 < b) :
    Integrable fun x : ℝ => x * exp (-b * x ^ 2) := by
  simpa using integrableRpowMulExpNegMulSq hb (by norm_num : (-1 : ℝ) < 1)
#align integrable_mul_exp_neg_mul_sq integrableMulExpNegMulSq

theorem norm_cexp_neg_mul_sq (b : ℂ) (x : ℝ) : ‖Complex.exp (-b * x ^ 2)‖ = exp (-b.re * x ^ 2) :=
  by
  rw [Complex.norm_eq_abs, Complex.abs_exp, ← of_real_pow, mul_comm (-b) _, of_real_mul_re, neg_re,
    mul_comm]
#align norm_cexp_neg_mul_sq norm_cexp_neg_mul_sq

theorem integrableCexpNegMulSq {b : ℂ} (hb : 0 < b.re) :
    Integrable fun x : ℝ => cexp (-b * x ^ 2) :=
  by
  refine'
    ⟨(complex.continuous_exp.comp
          (continuous_const.mul (continuous_of_real.pow 2))).AeStronglyMeasurable,
      _⟩
  rw [← has_finite_integral_norm_iff]
  simp_rw [norm_cexp_neg_mul_sq]
  exact (integrableExpNegMulSq hb).2
#align integrable_cexp_neg_mul_sq integrableCexpNegMulSq

theorem integrableMulCexpNegMulSq {b : ℂ} (hb : 0 < b.re) :
    Integrable fun x : ℝ => ↑x * cexp (-b * x ^ 2) :=
  by
  refine' ⟨(continuous_of_real.mul (complex.continuous_exp.comp _)).AeStronglyMeasurable, _⟩
  · exact continuous_const.mul (continuous_of_real.pow 2)
  have := (integrableMulExpNegMulSq hb).HasFiniteIntegral
  rw [← has_finite_integral_norm_iff] at this⊢
  convert this
  ext1 x
  rw [norm_mul, norm_mul, norm_cexp_neg_mul_sq b, Complex.norm_eq_abs, abs_of_real,
    Real.norm_eq_abs, norm_of_nonneg (exp_pos _).le]
#align integrable_mul_cexp_neg_mul_sq integrableMulCexpNegMulSq

theorem integral_mul_cexp_neg_mul_sq {b : ℂ} (hb : 0 < b.re) :
    (∫ r : ℝ in Ioi 0, (r : ℂ) * cexp (-b * r ^ 2)) = (2 * b)⁻¹ :=
  by
  have hb' : b ≠ 0 := by
    contrapose! hb
    rw [hb, zero_re]
  refine'
    tendsto_nhds_unique
      (interval_integral_tendsto_integral_Ioi _ (integrableMulCexpNegMulSq hb).IntegrableOn
        Filter.tendsto_id)
      _
  have A :
    ∀ x : ℂ, HasDerivAt (fun x => -(2 * b)⁻¹ * cexp (-b * x ^ 2)) (x * cexp (-b * x ^ 2)) x :=
    by
    intro x
    convert((hasDerivAt_pow 2 x).const_mul (-b)).cexp.const_mul (-(2 * b)⁻¹) using 1
    field_simp [hb']
    ring
  have :
    ∀ y : ℝ,
      (∫ x in 0 ..id y, ↑x * cexp (-b * x ^ 2)) =
        -(2 * b)⁻¹ * cexp (-b * y ^ 2) - -(2 * b)⁻¹ * cexp (-b * 0 ^ 2) :=
    fun y =>
    intervalIntegral.integral_eq_sub_of_hasDerivAt (fun x hx => (A x).comp_of_real)
      (integrableMulCexpNegMulSq hb).IntervalIntegrable
  simp_rw [this]
  have L :
    tendsto (fun x : ℝ => (2 * b)⁻¹ - (2 * b)⁻¹ * cexp (-b * x ^ 2)) at_top
      (𝓝 ((2 * b)⁻¹ - (2 * b)⁻¹ * 0)) :=
    by
    refine' tendsto_const_nhds.sub (tendsto.const_mul _ <| tendsto_zero_iff_norm_tendsto_zero.mpr _)
    simp_rw [norm_cexp_neg_mul_sq b]
    exact
      tendsto_exp_at_bot.comp
        (tendsto.neg_const_mul_at_top (neg_lt_zero.2 hb) (tendsto_pow_at_top two_ne_zero))
  simpa using L
#align integral_mul_cexp_neg_mul_sq integral_mul_cexp_neg_mul_sq

/-- The *square* of the Gaussian integral `∫ x:ℝ, exp (-b * x^2)` is equal to `π / b`. -/
theorem integral_gaussian_sq_complex {b : ℂ} (hb : 0 < b.re) :
    (∫ x : ℝ, cexp (-b * x ^ 2)) ^ 2 = π / b :=
  by/- We compute `(∫ exp (-b x^2))^2` as an integral over `ℝ^2`, and then make a polar change
    of coordinates. We are left with `∫ r * exp (-b r^2)`, which has been computed in
    `integral_mul_cexp_neg_mul_sq` using the fact that this function has an obvious primitive. -/
  calc
    (∫ x : ℝ, cexp (-b * (x : ℂ) ^ 2)) ^ 2 =
        ∫ p : ℝ × ℝ, cexp (-b * (p.1 : ℂ) ^ 2) * cexp (-b * (p.2 : ℂ) ^ 2) :=
      by
      rw [pow_two, ← integral_prod_mul]
      rfl
    _ = ∫ p : ℝ × ℝ, cexp (-b * (p.1 ^ 2 + p.2 ^ 2)) :=
      by
      congr
      ext1 p
      rw [← Complex.exp_add, mul_add]
    _ = ∫ p in polar_coord.target, p.1 • cexp (-b * ((p.1 * cos p.2) ^ 2 + (p.1 * sin p.2) ^ 2)) :=
      by
      rw [← integral_comp_polarCoord_symm]
      simp only [polarCoord_symm_apply, of_real_mul, of_real_cos, of_real_sin]
    _ = (∫ r in Ioi (0 : ℝ), r * cexp (-b * r ^ 2)) * ∫ θ in Ioo (-π) π, 1 :=
      by
      rw [← set_integral_prod_mul]
      congr with p : 1
      rw [mul_one]
      congr
      conv_rhs => rw [← one_mul ((p.1 : ℂ) ^ 2), ← sin_sq_add_cos_sq (p.2 : ℂ)]
      ring
    _ = ↑π / b := by
      have : 0 ≤ π + π := by linarith [Real.pi_pos]
      simp only [integral_const, measure.restrict_apply', measurableSet_Ioo, univ_inter, volume_Ioo,
        sub_neg_eq_add, ENNReal.toReal_ofReal, this]
      rw [← two_mul, real_smul, mul_one, of_real_mul, of_real_bit0, of_real_one,
        integral_mul_cexp_neg_mul_sq hb]
      field_simp [(by
          contrapose! hb
          rw [hb, zero_re] : b ≠ 0)]
      ring

#align integral_gaussian_sq_complex integral_gaussian_sq_complex

theorem integral_gaussian (b : ℝ) : (∫ x, exp (-b * x ^ 2)) = sqrt (π / b) :=
  by
  -- First we deal with the crazy case where `b ≤ 0`: then both sides vanish.
  rcases le_or_lt b 0 with (hb | hb)
  · rw [integral_undef, sqrt_eq_zero_of_nonpos]
    · exact div_nonpos_of_nonneg_of_nonpos pi_pos.le hb
    · simpa only [not_lt, integrable_exp_neg_mul_sq_iff] using hb
  -- Assume now `b > 0`. Then both sides are non-negative and their squares agree.
  refine' (sq_eq_sq _ (sqrt_nonneg _)).1 _
  · exact integral_nonneg fun x => (exp_pos _).le
  rw [← of_real_inj, of_real_pow, ← integral_of_real, sq_sqrt (div_pos pi_pos hb).le, of_real_div]
  convert integral_gaussian_sq_complex (by rwa [of_real_re] : 0 < (b : ℂ).re)
  ext1 x
  rw [of_real_exp, of_real_mul, of_real_pow, of_real_neg]
#align integral_gaussian integral_gaussian

theorem continuousAt_gaussian_integral (b : ℂ) (hb : 0 < re b) :
    ContinuousAt (fun c : ℂ => ∫ x : ℝ, cexp (-c * x ^ 2)) b :=
  by
  let f : ℂ → ℝ → ℂ := fun (c : ℂ) (x : ℝ) => cexp (-c * x ^ 2)
  obtain ⟨d, hd, hd'⟩ := exists_between hb
  have f_meas : ∀ c : ℂ, ae_strongly_measurable (f c) volume := fun c =>
    by
    apply Continuous.aeStronglyMeasurable
    exact complex.continuous_exp.comp (continuous_const.mul (continuous_of_real.pow 2))
  have f_int : integrable (f b) volume :=
    by
    simp_rw [← integrable_norm_iff (f_meas b), norm_cexp_neg_mul_sq b]
    exact integrableExpNegMulSq hb
  have f_cts : ∀ x : ℝ, ContinuousAt (fun c => f c x) b := fun x =>
    (complex.continuous_exp.comp (continuous_id'.neg.mul continuous_const)).ContinuousAt
  have f_le_bd : ∀ᶠ c : ℂ in 𝓝 b, ∀ᵐ x : ℝ, ‖f c x‖ ≤ exp (-d * x ^ 2) :=
    by
    refine' eventually_of_mem ((continuous_re.is_open_preimage _ isOpen_Ioi).mem_nhds hd') _
    refine' fun c hc => ae_of_all _ fun x => _
    rw [norm_cexp_neg_mul_sq, exp_le_exp]
    exact mul_le_mul_of_nonneg_right (neg_le_neg (le_of_lt hc)) (sq_nonneg _)
  exact
    continuous_at_of_dominated (eventually_of_forall f_meas) f_le_bd (integrableExpNegMulSq hd)
      (ae_of_all _ f_cts)
#align continuous_at_gaussian_integral continuousAt_gaussian_integral

theorem integral_gaussian_complex {b : ℂ} (hb : 0 < re b) :
    (∫ x : ℝ, cexp (-b * x ^ 2)) = (π / b) ^ (1 / 2 : ℂ) :=
  by
  have nv : ∀ {b : ℂ}, 0 < re b → b ≠ 0 := by
    intro b hb
    contrapose! hb
    rw [hb]
    simp
  refine'
    (convex_halfspace_re_gt 0).IsPreconnected.eq_of_sq_eq _ _ (fun c hc => _) (fun c hc => _)
      (by simp : 0 < re (1 : ℂ)) _ hb
  ·-- integral is continuous
    exact ContinuousAt.continuousOn continuousAt_gaussian_integral
  · -- `(π / b) ^ (1 / 2 : ℂ)` is continuous
    refine'
      ContinuousAt.continuousOn fun b hb =>
        (continuousAt_cpow_const (Or.inl _)).comp (continuous_at_const.div continuousAt_id (nv hb))
    rw [div_re, of_real_im, of_real_re, MulZeroClass.zero_mul, zero_div, add_zero]
    exact div_pos (mul_pos pi_pos hb) (norm_sq_pos.mpr (nv hb))
  · -- squares of both sides agree
    dsimp only [Pi.pow_apply]
    rw [integral_gaussian_sq_complex hc, sq]
    conv_lhs => rw [← cpow_one (↑π / c)]
    rw [← cpow_add _ _ (div_ne_zero (of_real_ne_zero.mpr pi_ne_zero) (nv hc))]
    norm_num
  · -- RHS doesn't vanish
    rw [Ne.def, cpow_eq_zero_iff, not_and_or]
    exact Or.inl (div_ne_zero (of_real_ne_zero.mpr pi_ne_zero) (nv hc))
  · -- equality at 1
    have : ∀ x : ℝ, cexp (-1 * x ^ 2) = exp (-1 * x ^ 2) :=
      by
      intro x
      simp only [of_real_exp, neg_mul, one_mul, of_real_neg, of_real_pow]
    simp_rw [this, integral_of_real]
    conv_rhs =>
      congr
      rw [← of_real_one, ← of_real_div]
      skip
      rw [← of_real_one, ← of_real_bit0, ← of_real_div]
    rw [← of_real_cpow, of_real_inj]
    convert integral_gaussian (1 : ℝ)
    · rwa [sqrt_eq_rpow]
    · rw [div_one]
      exact pi_pos.le
#align integral_gaussian_complex integral_gaussian_complex

-- The Gaussian integral on the half-line, `∫ x in Ioi 0, exp (-b * x^2)`, for complex `b`.
theorem integral_gaussian_complex_Ioi {b : ℂ} (hb : 0 < re b) :
    (∫ x : ℝ in Ioi 0, cexp (-b * x ^ 2)) = (π / b) ^ (1 / 2 : ℂ) / 2 :=
  by
  have full_integral := integral_gaussian_complex hb
  have : MeasurableSet (Ioi (0 : ℝ)) := measurableSet_Ioi
  rw [← integral_add_compl this (integrableCexpNegMulSq hb), compl_Ioi] at full_integral
  suffices (∫ x : ℝ in Iic 0, cexp (-b * x ^ 2)) = ∫ x : ℝ in Ioi 0, cexp (-b * x ^ 2)
    by
    rw [this, ← mul_two] at full_integral
    rwa [eq_div_iff]
    exact two_ne_zero
  have : ∀ c : ℝ, (∫ x in 0 ..c, cexp (-b * x ^ 2)) = ∫ x in -c..0, cexp (-b * x ^ 2) :=
    by
    intro c
    have := @intervalIntegral.integral_comp_sub_left _ _ _ _ 0 c (fun x => cexp (-b * x ^ 2)) 0
    simpa [zero_sub, neg_sq, neg_zero] using this
  have t1 :=
    interval_integral_tendsto_integral_Ioi _ (integrableCexpNegMulSq hb).IntegrableOn tendsto_id
  have t2 :
    tendsto (fun c : ℝ => ∫ x : ℝ in 0 ..c, cexp (-b * x ^ 2)) at_top
      (𝓝 (∫ x : ℝ in Iic 0, cexp (-b * x ^ 2))) :=
    by
    simp_rw [this]
    refine' interval_integral_tendsto_integral_Iic _ _ tendsto_neg_at_top_at_bot
    apply (integrableCexpNegMulSq hb).IntegrableOn
  exact tendsto_nhds_unique t2 t1
#align integral_gaussian_complex_Ioi integral_gaussian_complex_Ioi

-- The Gaussian integral on the half-line, `∫ x in Ioi 0, exp (-b * x^2)`, for real `b`.
theorem integral_gaussian_Ioi (b : ℝ) : (∫ x in Ioi 0, exp (-b * x ^ 2)) = sqrt (π / b) / 2 :=
  by
  rcases le_or_lt b 0 with (hb | hb)
  · rw [integral_undef, sqrt_eq_zero_of_nonpos, zero_div]
    exact div_nonpos_of_nonneg_of_nonpos pi_pos.le hb
    rwa [← integrable_on, integrableOn_Ioi_exp_neg_mul_sq_iff, not_lt]
  rw [← of_real_inj, ← integral_of_real]
  convert integral_gaussian_complex_Ioi (by rwa [of_real_re] : 0 < (b : ℂ).re)
  · ext1 x
    simp
  · rw [sqrt_eq_rpow, ← of_real_div, of_real_div, of_real_cpow]
    norm_num
    exact (div_pos pi_pos hb).le
#align integral_gaussian_Ioi integral_gaussian_Ioi

/-- The special-value formula `Γ(1/2) = √π`, which is equivalent to the Gaussian integral. -/
theorem Real.gamma_one_half_eq : Real.gamma (1 / 2) = sqrt π :=
  by
  rw [Gamma_eq_integral one_half_pos, ← integral_comp_rpow_Ioi_of_pos zero_lt_two]
  convert congr_arg (fun x : ℝ => 2 * x) (integral_gaussian_Ioi 1)
  · rw [← integral_mul_left]
    refine' set_integral_congr measurableSet_Ioi fun x hx => _
    dsimp only
    have : (x ^ (2 : ℝ)) ^ (1 / (2 : ℝ) - 1) = x⁻¹ :=
      by
      rw [← rpow_mul (le_of_lt hx)]
      norm_num
      rw [rpow_neg (le_of_lt hx), rpow_one]
    rw [smul_eq_mul, this]
    field_simp [(ne_of_lt hx).symm]
    norm_num
    ring
  · rw [div_one, ← mul_div_assoc, mul_comm, mul_div_cancel _ (two_ne_zero' ℝ)]
#align real.Gamma_one_half_eq Real.gamma_one_half_eq

/-- The special-value formula `Γ(1/2) = √π`, which is equivalent to the Gaussian integral. -/
theorem Complex.gamma_one_half_eq : Complex.gamma (1 / 2) = π ^ (1 / 2 : ℂ) :=
  by
  convert congr_arg coe Real.gamma_one_half_eq
  · simpa only [one_div, of_real_inv, of_real_bit0] using Gamma_of_real (1 / 2)
  · rw [sqrt_eq_rpow, of_real_cpow pi_pos.le, of_real_div, of_real_bit0, of_real_one]
#align complex.Gamma_one_half_eq Complex.gamma_one_half_eq

namespace GaussianFourier

/-! ## Fourier transform of the Gaussian integral
-/

open intervalIntegral

open Real

variable {b : ℂ}

/-- The integral of the Gaussian function over the vertical edges of a rectangle
with vertices at `(±T, 0)` and `(±T, c)`.  -/
def verticalIntegral (b : ℂ) (c T : ℝ) : ℂ :=
  ∫ y : ℝ in 0 ..c, I * (cexp (-b * (T + y * I) ^ 2) - cexp (-b * (T - y * I) ^ 2))
#align gaussian_fourier.vertical_integral GaussianFourier.verticalIntegral

/-- Explicit formula for the norm of the Gaussian function along the vertical
edges. -/
theorem norm_cexp_neg_mul_sq_add_mul_i (b : ℂ) (c T : ℝ) :
    ‖cexp (-b * (T + c * I) ^ 2)‖ = exp (-(b.re * T ^ 2 - 2 * b.im * c * T - b.re * c ^ 2)) :=
  by
  rw [Complex.norm_eq_abs, Complex.abs_exp, neg_mul, neg_re, ← re_add_im b]
  simp only [sq, re_add_im, mul_re, mul_im, add_re, add_im, of_real_re, of_real_im, I_re, I_im]
  ring_nf
#align gaussian_fourier.norm_cexp_neg_mul_sq_add_mul_I GaussianFourier.norm_cexp_neg_mul_sq_add_mul_i

theorem norm_cexp_neg_mul_sq_add_mul_I' (hb : b.re ≠ 0) (c T : ℝ) :
    ‖cexp (-b * (T + c * I) ^ 2)‖ =
      exp (-(b.re * (T - b.im * c / b.re) ^ 2 - c ^ 2 * (b.im ^ 2 / b.re + b.re))) :=
  by
  have :
    b.re * T ^ 2 - 2 * b.im * c * T - b.re * c ^ 2 =
      b.re * (T - b.im * c / b.re) ^ 2 - c ^ 2 * (b.im ^ 2 / b.re + b.re) :=
    by
    field_simp
    ring
  rw [norm_cexp_neg_mul_sq_add_mul_I, this]
#align gaussian_fourier.norm_cexp_neg_mul_sq_add_mul_I' GaussianFourier.norm_cexp_neg_mul_sq_add_mul_I'

theorem verticalIntegral_norm_le (hb : 0 < b.re) (c : ℝ) {T : ℝ} (hT : 0 ≤ T) :
    ‖verticalIntegral b c T‖ ≤
      2 * |c| * exp (-(b.re * T ^ 2 - 2 * |b.im| * |c| * T - b.re * c ^ 2)) :=
  by
  -- first get uniform bound for integrand
  have vert_norm_bound :
    ∀ {T : ℝ},
      0 ≤ T →
        ∀ {c y : ℝ},
          |y| ≤ |c| →
            ‖cexp (-b * (T + y * I) ^ 2)‖ ≤
              exp (-(b.re * T ^ 2 - 2 * |b.im| * |c| * T - b.re * c ^ 2)) :=
    by
    intro T hT c y hy
    rw [norm_cexp_neg_mul_sq_add_mul_I b, exp_le_exp, neg_le_neg_iff]
    refine' sub_le_sub (sub_le_sub (le_refl _) (mul_le_mul_of_nonneg_right _ hT)) _
    · conv_lhs => rw [mul_assoc]
      conv_rhs => rw [mul_assoc]
      refine' mul_le_mul_of_nonneg_left ((le_abs_self _).trans _) zero_le_two
      rw [abs_mul]
      exact mul_le_mul_of_nonneg_left hy (abs_nonneg _)
    · refine' mul_le_mul_of_nonneg_left _ hb.le
      rwa [sq_le_sq]
  -- now main proof
  refine' (intervalIntegral.norm_integral_le_of_norm_le_const _).trans _
  pick_goal 3
  · rw [sub_zero]
    conv_lhs => rw [mul_comm]
    conv_rhs =>
      conv =>
        congr
        rw [mul_comm]
      rw [mul_assoc]
  · intro y hy
    have absy : |y| ≤ |c| := by
      rcases le_or_lt 0 c with ⟨⟩
      · rw [uIoc_of_le h] at hy
        rw [abs_of_nonneg h, abs_of_pos hy.1]
        exact hy.2
      · rw [uIoc_of_lt h] at hy
        rw [abs_of_neg h, abs_of_nonpos hy.2, neg_le_neg_iff]
        exact hy.1.le
    rw [norm_mul, Complex.norm_eq_abs, abs_I, one_mul, two_mul]
    refine' (norm_sub_le _ _).trans (add_le_add (vert_norm_bound hT absy) _)
    rw [← abs_neg y] at absy
    simpa only [neg_mul, of_real_neg] using vert_norm_bound hT absy
#align gaussian_fourier.vertical_integral_norm_le GaussianFourier.verticalIntegral_norm_le

theorem tendsto_verticalIntegral (hb : 0 < b.re) (c : ℝ) :
    Tendsto (verticalIntegral b c) atTop (𝓝 0) :=
  by
  -- complete proof using squeeze theorem:
  rw [tendsto_zero_iff_norm_tendsto_zero]
  refine'
    tendsto_of_tendsto_of_tendsto_of_le_of_le' tendsto_const_nhds _
      (eventually_of_forall fun _ => norm_nonneg _)
      ((eventually_ge_at_top (0 : ℝ)).mp
        (eventually_of_forall fun T hT => vertical_integral_norm_le hb c hT))
  rw [(by ring : 0 = 2 * |c| * 0)]
  refine' (tendsto_exp_at_bot.comp (tendsto_neg_at_top_at_bot.comp _)).const_mul _
  apply tendsto_at_top_add_const_right
  simp_rw [sq, ← mul_assoc, ← sub_mul]
  refine' tendsto.at_top_mul_at_top (tendsto_at_top_add_const_right _ _ _) tendsto_id
  exact (tendsto_const_mul_at_top_of_pos hb).mpr tendsto_id
#align gaussian_fourier.tendsto_vertical_integral GaussianFourier.tendsto_verticalIntegral

theorem integrableCexpNegMulSqAddRealMulI (hb : 0 < b.re) (c : ℝ) :
    Integrable fun x : ℝ => cexp (-b * (x + c * I) ^ 2) :=
  by
  refine'
    ⟨(complex.continuous_exp.comp
          (continuous_const.mul
            ((continuous_of_real.add continuous_const).pow 2))).AeStronglyMeasurable,
      _⟩
  rw [← has_finite_integral_norm_iff]
  simp_rw [norm_cexp_neg_mul_sq_add_mul_I' hb.ne', neg_sub _ (c ^ 2 * _),
    sub_eq_add_neg _ (b.re * _), Real.exp_add]
  suffices integrable fun x : ℝ => exp (-(b.re * x ^ 2)) by
    exact (integrable.comp_sub_right this (b.im * c / b.re)).HasFiniteIntegral.const_mul _
  simp_rw [← neg_mul]
  apply integrableExpNegMulSq hb
#align gaussian_fourier.integrable_cexp_neg_mul_sq_add_real_mul_I GaussianFourier.integrableCexpNegMulSqAddRealMulI

theorem integral_cexp_neg_mul_sq_add_real_mul_i (hb : 0 < b.re) (c : ℝ) :
    (∫ x : ℝ, cexp (-b * (x + c * I) ^ 2)) = (π / b) ^ (1 / 2 : ℂ) :=
  by
  refine'
    tendsto_nhds_unique
      (interval_integral_tendsto_integral (integrable_cexp_neg_mul_sq_add_real_mul_I hb c)
        tendsto_neg_at_top_at_bot tendsto_id)
      _
  set I₁ := fun T => ∫ x : ℝ in -T..T, cexp (-b * (x + c * I) ^ 2) with HI₁
  let I₂ := fun T : ℝ => ∫ x : ℝ in -T..T, cexp (-b * x ^ 2)
  let I₄ := fun T : ℝ => ∫ y : ℝ in 0 ..c, cexp (-b * (T + y * I) ^ 2)
  let I₅ := fun T : ℝ => ∫ y : ℝ in 0 ..c, cexp (-b * (-T + y * I) ^ 2)
  have C : ∀ T : ℝ, I₂ T - I₁ T + I * I₄ T - I * I₅ T = 0 :=
    by
    intro T
    have :=
      integral_boundary_rect_eq_zero_of_differentiable_on (fun z => cexp (-b * z ^ 2)) (-T)
        (T + c * I)
        (by
          refine' Differentiable.differentiableOn (Differentiable.const_mul _ _).cexp
          exact differentiable_pow 2)
    simpa only [neg_im, of_real_im, neg_zero, of_real_zero, MulZeroClass.zero_mul, add_zero, neg_re,
      of_real_re, add_re, mul_re, I_re, MulZeroClass.mul_zero, I_im, tsub_zero, add_im, mul_im,
      mul_one, zero_add, Algebra.id.smul_eq_mul, of_real_neg] using this
  simp_rw [id.def, ← HI₁]
  have : I₁ = fun T : ℝ => I₂ T + vertical_integral b c T :=
    by
    ext1 T
    specialize C T
    rw [sub_eq_zero] at C
    unfold vertical_integral
    rw [integral_const_mul, intervalIntegral.integral_sub]
    · simp_rw [(fun a b => by
          rw [sq]
          ring_nf : ∀ a b : ℂ, (a - b * I) ^ 2 = (-a + b * I) ^ 2)]
      change I₁ T = I₂ T + I * (I₄ T - I₅ T)
      rw [mul_sub, ← C]
      abel
    all_goals apply Continuous.intervalIntegrable; continuity
  rw [this, ← add_zero ((π / b : ℂ) ^ (1 / 2 : ℂ)), ← integral_gaussian_complex hb]
  refine' tendsto.add _ (tendsto_vertical_integral hb c)
  exact
    interval_integral_tendsto_integral (integrableCexpNegMulSq hb) tendsto_neg_at_top_at_bot
      tendsto_id
#align gaussian_fourier.integral_cexp_neg_mul_sq_add_real_mul_I GaussianFourier.integral_cexp_neg_mul_sq_add_real_mul_i

theorem integral_cexp_neg_mul_sq_add_const (hb : 0 < b.re) (c : ℂ) :
    (∫ x : ℝ, cexp (-b * (x + c) ^ 2)) = (π / b) ^ (1 / 2 : ℂ) :=
  by
  rw [← re_add_im c]
  simp_rw [← add_assoc, ← of_real_add]
  rw [integral_add_right_eq_self fun x : ℝ => cexp (-b * (↑x + ↑c.im * I) ^ 2)]
  · apply integral_cexp_neg_mul_sq_add_real_mul_I hb
  · infer_instance
#align integral_cexp_neg_mul_sq_add_const integral_cexp_neg_mul_sq_add_const

theorem fourier_transform_gaussian (hb : 0 < b.re) (t : ℂ) :
    (∫ x : ℝ, cexp (I * t * x) * cexp (-b * x ^ 2)) =
      cexp (-t ^ 2 / (4 * b)) * (π / b) ^ (1 / 2 : ℂ) :=
  by
  have : b ≠ 0 := by
    contrapose! hb
    rw [hb, zero_re]
  simp_rw [← Complex.exp_add]
  have : ∀ x : ℂ, I * t * x + -b * x ^ 2 = -t ^ 2 / (4 * b) + -b * (x + -I * t / 2 / b) ^ 2 :=
    by
    intro x
    ring_nf
    rw [I_sq]
    field_simp
    ring
  simp_rw [this, Complex.exp_add, integral_mul_left, integral_cexp_neg_mul_sq_add_const hb]
#align fourier_transform_gaussian fourier_transform_gaussian

theorem fourier_transform_gaussian_pi (hb : 0 < b.re) :
    (𝓕 fun x : ℝ => cexp (-π * b * x ^ 2)) = fun t : ℝ =>
      1 / b ^ (1 / 2 : ℂ) * cexp (-π / b * t ^ 2) :=
  by
  ext1 t
  simp_rw [fourier_integral_eq_integral_exp_smul, smul_eq_mul]
  have h1 : 0 < re (π * b) := by
    rw [of_real_mul_re]
    exact mul_pos pi_pos hb
  have h2 : b ≠ 0 := by
    contrapose! hb
    rw [hb, zero_re]
  convert _root_.fourier_transform_gaussian h1 (-2 * π * t) using 1
  · congr 1 with x : 1
    congr 2
    all_goals push_cast ; ring
  · conv_lhs => rw [mul_comm]
    congr 2
    · field_simp [of_real_ne_zero.mpr pi_ne_zero]
      ring
    · rw [← div_div, div_self (of_real_ne_zero.mpr pi_ne_zero), one_div, one_div b, inv_cpow]
      rw [Ne.def, arg_eq_pi_iff, not_and_or, not_lt]
      exact Or.inl hb.le
#align fourier_transform_gaussian_pi fourier_transform_gaussian_pi

end GaussianFourier

section GaussianPoisson

/-! ## Poisson summation applied to the Gaussian -/

variable {E : Type _} [NormedAddCommGroup E]

theorem tendsto_rpow_abs_mul_exp_neg_mul_sq_cocompact {a : ℝ} (ha : 0 < a) (s : ℝ) :
    Tendsto (fun x : ℝ => |x| ^ s * rexp (-a * x ^ 2)) (cocompact ℝ) (𝓝 0) :=
  by
  conv in rexp _ => rw [← sq_abs]
  rw [cocompact_eq, ← comap_abs_at_top,
    @tendsto_comap'_iff _ _ _ (fun y => y ^ s * rexp (-a * y ^ 2)) _ _ _
      (mem_at_top_sets.mpr ⟨0, fun b hb => ⟨b, abs_of_nonneg hb⟩⟩)]
  exact
    (rpow_mul_exp_neg_mul_sq_isOCat_exp_neg ha s).tendsto_zero_of_tendsto
      (tendsto_exp_at_bot.comp <| tendsto_id.neg_const_mul_at_top (neg_lt_zero.mpr one_half_pos))
#align tendsto_rpow_abs_mul_exp_neg_mul_sq_cocompact tendsto_rpow_abs_mul_exp_neg_mul_sq_cocompact

theorem isOCat_exp_neg_mul_sq_cocompact {a : ℂ} (ha : 0 < a.re) (s : ℝ) :
    (fun x : ℝ => Complex.exp (-a * x ^ 2)) =o[cocompact ℝ] fun x : ℝ => |x| ^ s :=
  by
  rw [← is_o_norm_left]
  simp_rw [norm_cexp_neg_mul_sq]
  apply is_o_of_tendsto'
  · refine' eventually.filter_mono cocompact_le_cofinite _
    refine' (eventually_cofinite_ne 0).mp (eventually_of_forall fun x hx h => _)
    exact ((rpow_pos_of_pos (abs_pos.mpr hx) _).ne' h).elim
  · refine'
      tendsto.congr' (eventually.filter_mono cocompact_le_cofinite _)
        (tendsto_zero_iff_norm_tendsto_zero.mp <|
          tendsto_rpow_abs_mul_exp_neg_mul_sq_cocompact ha (-s))
    refine' (eventually_cofinite_ne 0).mp (eventually_of_forall fun x hx => _)
    rw [norm_mul, norm_of_nonneg (rpow_nonneg_of_nonneg (abs_nonneg _) _), mul_comm,
      rpow_neg (abs_nonneg x), div_eq_mul_inv, norm_of_nonneg (exp_pos _).le]
#align is_o_exp_neg_mul_sq_cocompact isOCat_exp_neg_mul_sq_cocompact

theorem Complex.tsum_exp_neg_mul_int_sq {a : ℂ} (ha : 0 < a.re) :
    (∑' n : ℤ, cexp (-π * a * n ^ 2)) = 1 / a ^ (1 / 2 : ℂ) * ∑' n : ℤ, cexp (-π / a * n ^ 2) :=
  by
  let f := fun x : ℝ => cexp (-π * a * x ^ 2)
  have h1 : 0 < (↑π * a).re := by
    rw [of_real_mul_re]
    exact mul_pos pi_pos ha
  have h2 : 0 < (↑π / a).re :=
    by
    rw [div_eq_mul_inv, of_real_mul_re, inv_re]
    refine' mul_pos pi_pos (div_pos ha <| norm_sq_pos.mpr _)
    contrapose! ha
    rw [ha, zero_re]
  have f_bd : f =O[cocompact ℝ] fun x => |x| ^ (-2 : ℝ) :=
    by
    convert(isOCat_exp_neg_mul_sq_cocompact h1 _).IsO
    ext1 x
    dsimp only [f]
    congr 1
    ring
  have Ff_bd : 𝓕 f =O[cocompact ℝ] fun x => |x| ^ (-2 : ℝ) :=
    by
    rw [fourier_transform_gaussian_pi ha]
    convert(isOCat_exp_neg_mul_sq_cocompact h2 _).IsO.const_mul_left _
    ext1 x
    congr 1
    ring_nf
  simpa only [fourier_transform_gaussian_pi ha, tsum_mul_left] using
    Real.tsum_eq_tsum_fourierIntegral_of_rpow_decay
      (complex.continuous_exp.comp (continuous_const.mul (continuous_of_real.pow 2)) : Continuous f)
      one_lt_two f_bd Ff_bd
#align complex.tsum_exp_neg_mul_int_sq Complex.tsum_exp_neg_mul_int_sq

theorem Real.tsum_exp_neg_mul_int_sq {a : ℝ} (ha : 0 < a) :
    (∑' n : ℤ, exp (-π * a * n ^ 2)) = 1 / a ^ (1 / 2 : ℝ) * ∑' n : ℤ, exp (-π / a * n ^ 2) := by
  simpa only [← of_real_inj, of_real_mul, of_real_tsum, of_real_exp, of_real_div, of_real_pow,
    of_real_int_cast, of_real_neg, of_real_cpow ha.le, of_real_bit0, of_real_one] using
    Complex.tsum_exp_neg_mul_int_sq (by rwa [of_real_re] : 0 < (a : ℂ).re)
#align real.tsum_exp_neg_mul_int_sq Real.tsum_exp_neg_mul_int_sq

end GaussianPoisson


class Vec (X : Type u)

class IsLin {X Y} [Vec X] [Vec Y] (f : X → Y)

structure ℝ where
  value : Float

instance instFoo1 {X : Type u} {Y : Type v} [Vec X] [Vec Y] : Vec (X × Y) := sorry
instance instProblem {α : Type u} {X : Type v} [Vec X] : Vec (α → X) := sorry

instance (priority := mid+1) instFoo2 : Vec ℝ := sorry

--------------

instance comp_is_lin {X Y Z : Type} [Vec X] [Vec Y] [Vec Z]
  (f : Y → Z) (g : X → Y) [IsLin f] [IsLin g]
  : IsLin (λ x => f (g x)) := sorry

----------------

class Trait (X : Type u) where
  R : Type v

attribute [reducible] Trait.R

class SemiInner (X : Type u) (R : Type v) where
  semiInner : X → X → R

@[reducible] instance (X) (R : Type u) [SemiInner X R] : Trait X := ⟨R⟩

class SemiHilbert (X) (R : Type u) [Vec R] extends Vec X, SemiInner X R

@[inferTCGoalsRL]
instance (X R) [Trait X] [Vec R] [SemiHilbert X R] (ι : Type v) : SemiHilbert (ι → X) R := sorry
instance : SemiHilbert ℝ ℝ := sorry

--------------

def norm {X} [Trait X] [inst : SemiInner X (Trait.R X)] (x : X) : Trait.R X := sorry
def sum {n} (f : Fin n → ℝ) : ℝ := sorry

variable (n m : Nat)

-- these all should work
example : Trait (Fin n → Fin m → ℝ) := by infer_instance
example : SemiInner ℝ (Trait.R ℝ) := by infer_instance
example : SemiHilbert (Fin n → ℝ) ℝ := by infer_instance
example : SemiHilbert (Fin n → ℝ) (Trait.R ℝ) := by infer_instance
example : Trait (Fin n → Fin m → (Trait.R ℝ)) := by infer_instance
example : SemiHilbert (Trait.R ℝ) ℝ := by infer_instance

-- set_option synthInstance.maxHeartbeats 50 in
-- set_option pp.explicit true in
-- set_option trace.Meta.synthInstance true in

-- This should not timeout but failt in finite number of steps like in Lean 3
example : IsLin  (λ (x : ℝ) => sum λ i : Fin n => norm x) := by infer_instance


import analysis.special_functions.pow
import analysis.specific_limits.basic
import analysis.normed_space.basic
import analysis.mean_inequalities_pow
import category_theory.Fintype

import pseudo_normed_group.basic
import pseudo_normed_group.category

import for_mathlib.nnreal
import for_mathlib.real

/-

# Real measures

If `p : ℝ≥0` and `S : Fintype` then `real_measures p S` is just the functions
from `S` to `ℝ`, equipped with its `ℓᵖ` norm.
-/
universe u

noncomputable theory
open_locale big_operators nnreal classical

/-- `real_measures p S` is the vector space of maps `S → ℝ` equipped with the `ℓᵖ` norm,
which gives it the structure of a `CompHausl`y-filtered normed group.  -/
@[nolint unused_arguments, derive add_comm_group]
def real_measures (p : ℝ≥0) (S : Fintype) := S → ℝ

variables {p : ℝ≥0} {S S' : Fintype.{u}}

local notation `ℳ` := real_measures
local notation `ϖ` := Fintype.of punit

namespace real_measures

@[simp] lemma zero_apply (s : S) : (0 : ℳ p S) s = 0 := rfl

@[simp] lemma add_apply (F G : ℳ p S) (s : S) : (F + G) s = F s + G s := rfl

@[simp] lemma neg_apply (F : ℳ p S) (s : S) : (-F) s = - (F s) := rfl

@[simp] lemma sub_apply (F G : ℳ p S) (s : S) : (F - G) s = F s - G s := rfl

instance : has_norm (ℳ p S) := ⟨λ F, ∑ s, ∥F s∥ ^ (p:ℝ)⟩

lemma norm_def (F : ℳ p S) : ∥F∥ = ∑ s, ∥F s∥ ^ (p:ℝ) := rfl

instance : has_nnnorm (ℳ p S) := ⟨λ F, ∑ s, ∥F s∥₊ ^ (p:ℝ)⟩

lemma nnnorm_def (F : ℳ p S) : ∥F∥₊ = ∑ s, ∥F s∥₊ ^ (p:ℝ) := rfl

@[simp] protected lemma coe_nnnorm (F : ℳ p S) : (∥F∥₊ : ℝ) = ∥F∥ :=
by simp only [norm_def, nnnorm_def, nnreal.coe_sum, nnreal.coe_rpow, coe_nnnorm]

lemma real_measures.norm_nonneg (F : ℳ p S) : 0 ≤ ∥ F ∥ := by {rw [← F.coe_nnnorm], from ∥ F ∥₊.2}

@[simp] protected lemma nnnorm_zero [hp : fact (0 < p)] : ∥(0 : ℳ p S)∥₊ = 0 :=
begin
  rw [nnnorm_def, finset.sum_eq_zero],
  rintro s -,
  rw [zero_apply, nnnorm_zero, nnreal.zero_rpow],
  exact_mod_cast hp.out.ne',
end

protected lemma nnnorm_add [h0p : fact (0 < p)] [hp1 : fact (p ≤ 1)]
  (F G : ℳ p S) : ∥F + G∥₊ ≤ ∥F∥₊ + ∥G∥₊ :=
begin
  dsimp [nnnorm_def],
  rw ← finset.sum_add_distrib,
  apply finset.sum_le_sum,
  intros s hs,
  have h0p' : (0 : ℝ) < p, exact_mod_cast h0p.out,
  have hp1' : (p : ℝ) ≤ 1, exact_mod_cast hp1.out,
  exact (nnreal.rpow_le_rpow (nnnorm_add_le _ _) h0p'.le).trans
    (@nnreal.rpow_add_le_add_rpow p (∥F s∥₊) (∥G s∥₊) h0p' hp1'),
end

--needed? [FAE] Yes!
instance png_real_measures [fact (0 < p)] [fact (p ≤ 1)] : pseudo_normed_group (ℳ p S) :=
{ filtration := λ c, { F | ∥F∥₊ ≤ c },
  filtration_mono := λ c₁ c₂ h F hF, by {dsimp at *, exact le_trans hF h},
  zero_mem_filtration := λ c, by simp only [real_measures.nnnorm_zero, zero_le', set.mem_set_of_eq],
  neg_mem_filtration := λ c F h, by { dsimp [nnnorm_def] at *, simp only [h, nnnorm_neg] },
  add_mem_filtration := λ c₁ c₂ F₁ F₂ h₁ h₂,
    (real_measures.nnnorm_add _ _).trans (add_le_add h₁ h₂) }

lemma mem_filtration_iff [fact (0 < p)] [fact (p ≤ 1)] (F : ℳ p S) (c : ℝ≥0) :
  F ∈ pseudo_normed_group.filtration (ℳ p S) c ↔ ∥F∥₊ ≤ c := iff.rfl

def map (f : S ⟶ S') : ℳ p S → ℳ p S' :=
λ F s', ∑ s in finset.univ.filter (λ t, f t = s'), F s

@[simp]
lemma map_apply (f : S ⟶ S') (F : ℳ p S) (s' : S') :
  map f F s' = ∑ s in finset.univ.filter (λ t, f t = s'), F s := rfl

@[simp]
lemma map_id : (map (𝟙 S) : ℳ p S → ℳ p S) = id :=
begin
  ext F s,
  rw [map_apply, finset.sum_filter, id.def],
  simp only [Fintype.id_apply, finset.sum_ite_eq', finset.mem_univ, if_true],
end

@[simp]
lemma map_comp {S'' : Fintype.{u}} (f : S ⟶ S') (g : S' ⟶ S'') :
  (map (f ≫ g) : ℳ p S → ℳ p S'') = map g ∘ map f :=
begin
  ext F s,
  simp only [function.comp_app, map_apply],
  convert finset.sum_bUnion _ using 1, swap 2, { classical, apply_instance },
  { apply finset.sum_congr,
    { change finset.univ.filter (λ t, g (f t) = s) = _,
      ext i,
      simp only [true_and, exists_prop, finset.mem_univ, finset.mem_bUnion,
        exists_eq_right', finset.mem_filter] },
    { intros, refl } },
  { intros i hi j hj h k hk,
    refine h _,
    simp only [true_and, finset.inf_eq_inter, finset.mem_univ,
      finset.mem_filter, finset.mem_inter] at hk,
    rw [← hk.1, ← hk.2] }
end

lemma map_bound [h0p : fact (0 < p)] [hp1 : fact (p ≤ 1)] (f : S ⟶ S') (F : ℳ p S) :
  ∥map f F∥₊ ≤ ∥F∥₊ :=
begin
  calc ∑ s', ∥∑ s in finset.univ.filter (λ t, f t = s'), F s∥₊ ^ (p:ℝ)
      ≤ ∑ s' : S', ∑ s in finset.univ.filter (λ t, f t = s'), ∥F s∥₊ ^ (p:ℝ) : _
  ... = ∑ s, ∥F s∥₊ ^ (p:ℝ) : _,
  { apply finset.sum_le_sum,
    rintros s' -,
    have h0p' : (0 : ℝ) < p, exact_mod_cast h0p.out,
    have hp1' : (p : ℝ) ≤ 1, exact_mod_cast hp1.out,
    exact (nnreal.rpow_le_rpow (nnnorm_sum_le _ _) h0p'.le).trans
      (nnreal.rpow_sum_le_sum_rpow _ _ h0p' hp1'), },
  { rw ← finset.sum_bUnion,
    { refine finset.sum_congr _ _,
      { ext s,
        simp only [true_and, finset.mem_univ, finset.mem_bUnion, iff_true,
          exists_true_left, finset.mem_filter],
        refine ⟨_, rfl⟩, },
      { intros, refl } },
    { rintro x - y - h i hi,
      apply h,
      simp only [true_and, finset.inf_eq_inter, finset.mem_univ,
        finset.mem_filter, finset.mem_inter] at hi,
      rw [← hi.1, ← hi.2] } },
end

def seval_ℳ {r : ℝ≥0} (S : Fintype) (s : S): (real_measures r S) →
  (real_measures r (Fintype.of punit)) := λ F, (λ _, F s)

variables [fact (0 < p)] [fact (p ≤ 1)]

open pseudo_normed_group (filtration)

instance topological_space (c : ℝ≥0) : topological_space (filtration (ℳ p S) c) :=
@subtype.topological_space _ _ Pi.topological_space

instance t2_space (c : ℝ≥0) : t2_space (filtration (ℳ p S) c) :=
@subtype.t2_space _ _ Pi.topological_space _

lemma nnnorm_apply_le_of_nnnorm_le (F : ℳ p S) (s : S) (c : ℝ≥0) (h : ∥F∥₊ ≤ c) :
  ∥F s∥₊ ≤ c ^ (p⁻¹ : ℝ) :=
begin
  calc ∥F s∥₊ = (∥F s∥₊ ^ (p:ℝ)) ^ (p⁻¹ : ℝ) : _
  ... ≤ c ^ (p⁻¹ : ℝ) : _,
  { rw_mod_cast [← nnreal.rpow_mul, mul_inv_cancel, nnreal.rpow_one],
    exact ne_of_gt (‹fact (0 < p)›.out) },
  { apply nnreal.rpow_le_rpow _ (inv_pos.mpr _).le,
    { refine le_trans _ h,
      have aux := finset.sum_pi_single' s (∥F s∥₊ ^ (p:ℝ)) finset.univ,
      simp only [finset.mem_univ, if_true] at aux,
      rw ← aux,
      apply finset.sum_le_sum,
      rintro t -,
      split_ifs, { subst t }, { exact zero_le' } },
    { norm_cast, exact ‹fact (0 < p)›.out } }
end

lemma apply_mem_Icc_of_nnnorm_le (F : ℳ p S) (s : S) (c : ℝ≥0) (h : ∥F∥₊ ≤ c) :
  F s ∈ set.Icc (-c ^ (p⁻¹ : ℝ) : ℝ) (c ^ (p⁻¹ : ℝ) : ℝ) :=
begin
  have := @set.mem_Icc_iff_abs_le ℝ _ 0 (F s) (c ^ (p:ℝ)⁻¹),
  simp only [zero_sub, abs_neg, zero_add, ← real.norm_eq_abs, ← coe_nnnorm, nnnorm_neg] at this,
  rw ← this,
  norm_cast,
  exact nnnorm_apply_le_of_nnnorm_le F s c h
end

-- move me
lemma continuous.sum {ι X A : Type*} [topological_space X]
  [topological_space A] [add_comm_monoid A] [has_continuous_add A]
  (s : finset ι) (f : ι → X → A) (hf : ∀ i ∈ s, continuous (f i)) :
  continuous (∑ i in s, f i) :=
begin
  induction s using finset.induction_on with i s his IH,
  { simp only [finset.sum_empty], exact @continuous_zero X A _ _ _ },
  { simp only [his, finset.sum_insert, not_false_iff],
    refine (hf i $ s.mem_insert_self i).add (IH $ λ i hi, hf i $ finset.mem_insert_of_mem hi), }
end

-- move me
lemma continuous.sum' {ι X A : Type*} [topological_space X]
  [topological_space A] [add_comm_monoid A] [has_continuous_add A]
  (s : finset ι) (f : ι → X → A) (hf : ∀ i ∈ s, continuous (f i)) :
  continuous (λ x, ∑ i in s, f i x) :=
begin
  induction s using finset.induction_on with i s his IH,
  { simp only [finset.sum_empty], exact @continuous_zero X A _ _ _ },
  { simp only [his, finset.sum_insert, not_false_iff],
    refine (hf i $ s.mem_insert_self i).add (IH $ λ i hi, hf i $ finset.mem_insert_of_mem hi), }
end

instance compact_space (c : ℝ≥0) : compact_space (filtration (ℳ p S) c) :=
begin
  constructor,
  rw [← embedding_subtype_coe.to_inducing.is_compact_iff],
  simp only [set.image_univ, subtype.range_coe_subtype, set.set_of_mem_eq],
  let d : ℝ := c ^ (p⁻¹ : ℝ),
  let T : set (S → ℝ) := {x | ∀ s, x s ∈ set.Icc (-d) d},
  have hT : is_compact T := is_compact_pi_infinite (λ s, is_compact_Icc),
  refine compact_of_is_closed_subset hT _ (λ F hF s, apply_mem_Icc_of_nnnorm_le F s c hF),
  refine is_closed_le (continuous.sum' _ _ _) continuous_const,
  rintro s -,
  have h0p : 0 ≤ (p : ℝ), { norm_cast, exact fact.out _ },
  exact (nnreal.continuous_rpow_const h0p).comp (continuous_nnnorm.comp (continuous_apply s)),
end

open metric

def equiv_filtration_ϖ_ball (c : ℝ≥0) : filtration (ℳ p ϖ) c ≃ closed_ball (0 : ℝ)
  (c ^ (p⁻¹ : ℝ) : ℝ≥0):=
{ to_fun := λ f, ⟨f.1 punit.star, begin
    simp only [mem_closed_ball_zero_iff],
    have hf := (mem_filtration_iff f.1 c).mp f.2,
    simp only [← nnreal.coe_le_coe, real_measures.coe_nnnorm, nnnorm_def, fintype.univ_punit, finset.sum_singleton, norm_def]
      at hf,
    have := @nnreal.rpow_le_rpow_iff (∥f.1 punit.star∥₊) (c ^ (p⁻¹ : ℝ)) p _,
    rw [← nnreal.rpow_mul, inv_mul_cancel, nnreal.rpow_one] at this,
    exact this.mp hf,
    exact (nnreal.coe_ne_zero.mpr (ne_of_gt (fact.out _))),
    rw ← nnreal.coe_zero,
    exact nnreal.coe_lt_coe.mpr (fact.out _),
  end⟩,
  inv_fun := λ x, ⟨λ _, x, begin
    have := @real.rpow_le_rpow_iff (|↑x| : ℝ) (c ^ (p⁻¹ : ℝ)) p _ _ _,
    rw [← real.rpow_mul, inv_mul_cancel, real.rpow_one] at this,
    have hx := x.2,
    simp only [mem_filtration_iff, subtype.val_eq_coe, nnnorm, fintype.univ_punit,
      finset.sum_singleton, ← nnreal.coe_le_coe, nnreal.coe_rpow, subtype.coe_mk, real.norm_eq_abs,
      this, abs_le, mem_closed_ball_zero_iff] at hx ⊢,
    exact hx,
    { rw nnreal.coe_ne_zero,
      exact ne_of_gt (fact.out _) },
    { exact c.2 },
    { exact abs_nonneg x },
    { rw ← nnreal.coe_rpow,
     exact (c ^ (p⁻¹ : ℝ)).2 },
    { rw [← nnreal.coe_zero, nnreal.coe_lt_coe],
      exact fact.out _ }
  end⟩,
  left_inv := begin
    intro,
      ext,
      simp only [subtype.val_eq_coe, subtype.coe_mk],
      apply congr_arg,
      simp only [eq_iff_true_of_subsingleton]
  end,
  right_inv := begin
    intro,
    simp only [subtype.coe_eta]
  end }

def homeo_filtration_ϖ_ball (c : ℝ≥0) : filtration (ℳ p ϖ) c ≃ₜ closed_ball (0 : ℝ)
  (c ^ (p⁻¹ : ℝ) : ℝ≥0) :=
{ to_equiv := equiv_filtration_ϖ_ball c,
  continuous_to_fun := begin
    refine continuous_subtype_mk (λ (x : {F // ∥F∥₊ ≤ c}), equiv_filtration_ϖ_ball._proof_1 c x) _,
    exact continuous.comp (continuous_apply punit.star) continuous_subtype_coe,
  end,
  continuous_inv_fun := begin
    simp only [equiv_filtration_ϖ_ball],
    continuity,
  end
}

lemma real_measures.dist_eq {c : ℝ≥0} (F G : filtration (ℳ p ϖ) c) : ∥ F.1 - G.1 ∥ ^ (p⁻¹ : ℝ) =
  | ((homeo_filtration_ϖ_ball c F) - (homeo_filtration_ϖ_ball c G) : ℝ)| :=
begin
  have hp : (p : ℝ) ≠ 0,
  { rw ← nnreal.coe_zero,
    exact (ne_of_gt (nnreal.coe_lt_coe.mpr (fact.out _))) },
  simp only [norm_def, fintype.univ_punit, subtype.val_eq_coe, sub_apply, finset.sum_singleton,
    ← real.rpow_mul (norm_nonneg _), mul_inv_cancel hp],
  simpa only [real.rpow_one, real.norm_eq_abs],
end

instance {c : ℝ≥0} : has_zero (closed_ball (0 : ℝ) c):=
  { zero := ⟨0, by {simp only [mem_closed_ball_zero_iff, norm_zero, nnreal.zero_le_coe]}⟩}

lemma homeo_filtration_ϖ_ball_preimage {c ε: ℝ≥0} (h : ε ^ (p : ℝ) ≤ c) :
  (homeo_filtration_ϖ_ball c)⁻¹' (closed_ball 0 ε) =
  (set.range (set.inclusion (@pseudo_normed_group.filtration_mono (ℳ p ϖ) _ _ _ h))) :=
begin
  ext ⟨x, hx⟩,
  simp only [homeo_filtration_ϖ_ball, equiv_filtration_ϖ_ball, subtype.val_eq_coe, subtype.coe_mk,
    homeomorph.homeomorph_mk_coe, equiv.coe_fn_mk, set.mem_preimage, mem_closed_ball, dist_le_coe,
    set.range_inclusion, set.mem_set_of_eq],
  change _ ↔ ∑ s : punit, ∥x s∥₊ ^ (p:ℝ) ≤ _,
  simp only [fintype.univ_punit, finset.sum_singleton],
  rw nnreal.rpow_le_rpow_iff,
  { convert iff.rfl,
    convert (sub_zero _).symm },
  { norm_cast, exact fact.elim infer_instance },
end

-- **[FAE]** The following ones with `_Icc_` might be useless

-- def equiv_filtration_ϖ_Icc (c : ℝ≥0) : filtration (ℳ p ϖ) c ≃ set.Icc ((- c ^ (p⁻¹ : ℝ)) : ℝ)
--   (c ^ (p⁻¹ : ℝ)):=
-- begin
--   fconstructor,
--   { intro f,
--     exact ⟨f.1 punit.star, apply_mem_Icc_of_nnnorm_le _ _ _ f.2⟩ },
--   { intro x,
--     use (λ _, x),
--     have := @real.rpow_le_rpow_iff (|↑x| : ℝ) (c ^ (p⁻¹ : ℝ)) p _ _ _,
--     rw [← real.rpow_mul, inv_mul_cancel, real.rpow_one] at this,
--     have hx := x.2,
--     simpa only [mem_filtration_iff, subtype.val_eq_coe, set.mem_Icc, nnnorm, fintype.univ_punit,
--       finset.sum_singleton, ← nnreal.coe_le_coe, nnreal.coe_rpow, subtype.coe_mk, real.norm_eq_abs,
--       this, abs_le],
--     { rw nnreal.coe_ne_zero,
--       exact ne_of_gt (fact.out _) },
--     { exact c.2 },
--     { exact abs_nonneg x },
--     { rw ← nnreal.coe_rpow,
--      exact (c ^ (p⁻¹ : ℝ)).2 },
--     { rw [← nnreal.coe_zero, nnreal.coe_lt_coe],
--       exact fact.out _ } },
--     { intro f,
--       ext s,
--       simp only [subtype.val_eq_coe, subtype.coe_mk],
--       apply congr_arg,
--       simp only [eq_iff_true_of_subsingleton] },
--     { intro x,
--       simp only [subtype.coe_eta] },
-- end

-- def homeo_filtration_ϖ_Icc (c : ℝ≥0) : filtration (ℳ p ϖ) c ≃ₜ set.Icc ((- c ^ (p⁻¹ : ℝ)) : ℝ)
--   (c ^ (p⁻¹ : ℝ)) :=
-- { to_equiv := equiv_filtration_ϖ_Icc c,
--   continuous_to_fun := admit,
--   continuous_inv_fun := admit
-- }

-- lemma homeo_filtration_ϖ_Icc_apply (c c': ℝ≥0) (h : c ≤ c') :
-- (homeo_filtration_ϖ_Icc c').to_fun '' (set.range (set.inclusion (@pseudo_normed_group.filtration_mono (ℳ p ϖ) _ _ _ h)))
--   = ⊥ := --set.Icc ((- c ^ (p⁻¹ : ℝ)) : ℝ) ((c ^ (p⁻¹ : ℝ) : ℝ)) :=
-- begin
--   admit,
-- end

instance chpng_real_measures : comphaus_filtered_pseudo_normed_group (ℳ p S) :=
{ continuous_add' := begin
    intros c₁ c₂,
    apply continuous_induced_rng,
    simp only [function.comp, pseudo_normed_group.add'_eq],
    exact (continuous_subtype_val.comp continuous_fst).add
          (continuous_subtype_val.comp continuous_snd),
  end,
  continuous_neg' := begin
    intros c,
    apply continuous_induced_rng,
    simp only [function.comp, pseudo_normed_group.neg'_eq],
    exact continuous_subtype_val.neg,
  end,
  continuous_cast_le := begin
    introsI c₁ c₂ h,
    apply continuous_induced_rng,
    simp only [function.comp, pseudo_normed_group.coe_cast_le],
    exact continuous_subtype_val,
  end,
  ..(infer_instance : (pseudo_normed_group (ℳ p S))) }

variable {α : Type*}

open pseudo_normed_group comphaus_filtered_pseudo_normed_group

@[simps]
def map_hom [fact (0 < p)] (f : S ⟶ S') :
  strict_comphaus_filtered_pseudo_normed_group_hom (ℳ p S) (ℳ p S') :=
{ to_fun := map f,
  map_zero' := by { ext F s i, simp only [map_apply, finset.sum_const_zero, zero_apply], },
  map_add' := λ F G, by { ext s i, simp only [finset.sum_add_distrib, add_apply, map_apply], },
  strict' := λ c F hF, (map_bound _ _).trans hF,
  continuous' := λ c, begin
    refine continuous_induced_rng (continuous_pi _),
    intro s',
    simp only [function.comp, map_apply],
    refine continuous.sum' _ _ _,
    rintro s -,
    exact (continuous_apply s).comp continuous_subtype_val,
  end }

@[simps]
def functor (p : ℝ≥0) [fact (0 < p)] [fact (p ≤ 1)] : Fintype.{u} ⥤ CompHausFiltPseuNormGrp₁.{u} :=
{ obj := λ S, ⟨ℳ p S, λ F, ⟨∥F∥₊, (mem_filtration_iff _ _).mpr le_rfl⟩⟩,
  map := λ S T f, map_hom f,
  map_id' := λ S, by { ext1, rw [map_hom_to_fun, map_id], refl, },
  map_comp' := λ S S' S'' f g, by { ext1, simp only [map_hom_to_fun, map_comp], refl } }

end real_measures


universe u

def f {α : Type u} [BEq α] (xs : List α) (y : α) : α := do
for x in xs do
  if x == y then
    return x
return y

structure S :=
(key val : Nat)

instance : BEq S :=
⟨fun a b => a.key == b.key⟩

theorem ex1 : f (α := S) [⟨1, 2⟩, ⟨3, 4⟩, ⟨5, 6⟩] ⟨3, 0⟩ = ⟨3, 4⟩ :=
rfl

theorem ex2 : f (α := S) [⟨1, 2⟩, ⟨3, 4⟩, ⟨5, 6⟩] ⟨4, 10⟩ = ⟨4, 10⟩ :=
rfl


/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bhavik Mehta

! This file was ported from Lean 3 source module data.int.cast.field
! leanprover-community/mathlib commit acee671f47b8e7972a1eb6f4eed74b4b3abce829
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Int.Cast.Lemmas
import Mathlib.Algebra.Field.Defs
import Mathlib.Algebra.GroupWithZero.Units.Lemmas

/-!
# Cast of integers into fields

This file concerns the canonical homomorphism `ℤ → F`, where `F` is a field.

## Main results

 * `Int.cast_div`: if `n` divides `m`, then `↑(m / n) = ↑m / ↑n`
-/

namespace Int

open Nat

variable {α : Type _}

/-- Auxiliary lemma for norm_cast to move the cast `-↑n` upwards to `↑-↑n`.

(The restriction to `DivisionRing` is necessary, otherwise this would also apply in the case where
`R = ℤ` and cause nontermination.)
-/
@[norm_cast]
theorem cast_neg_natCast {R} [DivisionRing R] (n : ℕ) : ((-n : ℤ) : R) = -n := by simp
#align int.cast_neg_nat_cast Int.cast_neg_natCast

@[simp]
theorem cast_div [DivisionRing α] {m n : ℤ} (n_dvd : n ∣ m) (n_nonzero : (n : α) ≠ 0) :
    ((m / n : ℤ) : α) = m / n := by
  rcases n_dvd with ⟨k, rfl⟩
  have : n ≠ 0 := by
    rintro rfl
    simp at n_nonzero
  rw [Int.mul_ediv_cancel_left _ this, mul_comm n k, Int.cast_mul, mul_div_cancel _ n_nonzero]
#align int.cast_div Int.cast_div

end Int


/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.int.cast
import Mathlib.algebra.char_zero
import Mathlib.PostPort

universes u_1

namespace Mathlib

/-!
# Injectivity of `int.cast` into characteristic zero rings.

-/

namespace int

@[simp] theorem cast_eq_zero {α : Type u_1} [add_group α] [HasOne α] [char_zero α] {n : ℤ} :
    ↑n = 0 ↔ n = 0 :=
  sorry

@[simp] theorem cast_inj {α : Type u_1} [add_group α] [HasOne α] [char_zero α] {m : ℤ} {n : ℤ} :
    ↑m = ↑n ↔ m = n :=
  sorry

theorem cast_injective {α : Type u_1} [add_group α] [HasOne α] [char_zero α] :
    function.injective coe :=
  fun {a₁ a₂ : ℤ} => idRhs (↑a₁ = ↑a₂ → a₁ = a₂) (iff.mp cast_inj)

theorem cast_ne_zero {α : Type u_1} [add_group α] [HasOne α] [char_zero α] {n : ℤ} :
    ↑n ≠ 0 ↔ n ≠ 0 :=
  not_congr cast_eq_zero

end Mathlib


import algebra.category.Group.limits
import category_theory.preadditive.functor_category
import topology.sheaves.sheaf
import topology.sheaves.sheaf_condition.unique_gluing

import sheaves_of_modules.defs

noncomputable theory

open category_theory category_theory.limits

namespace Top.presheaf

section

universe u

variables {X : Top.{u}}

open topological_space Top opposite

/--
The inclusion `U ⟶ X`
-/
@[simps] def emb (U : opens X) : Top.of U ⟶ X :=
{ to_fun := (coe : U → X),
  continuous_to_fun := continuous_subtype_val }

/--
If `U` is open, then any open subset `V` is also an open subset of `X`.
-/
def emb.to_global_subset {U : opens X} (V : opens (Top.of U)) : opens X :=
⟨subtype.val '' V.1, (is_open.open_embedding_subtype_coe U.2).is_open_map _ V.2⟩

/--
If `U ⊆ V` are open sets in `X` and `W ⊆ U` is open in `U` then `W` is open in `V`.
-/
def emb.of_subset {U V : opens X} (inc : U ⟶ V) (W : opens (Top.of U)) : opens (Top.of V) :=
{ val := (λ p, ⟨p.1, le_of_hom inc p.2⟩ : U → V) '' W.1,
  property := let ⟨O, hO1, hO2⟩ := is_open_induced_iff.mp W.2 in
    is_open_induced_iff.mpr ⟨subtype.val '' W.1,
    begin
      apply_fun set.image subtype.val at hO2,
      rw ←hO2,
      apply (is_open.open_embedding_subtype_coe U.2).is_open_map,
      apply is_open.preimage,
      continuity,
    end, begin
      ext ⟨x, hx⟩, split,
      { rintros ⟨p, hp1, hp2⟩,
        rw set.mem_image,
        refine ⟨p, hp1, subtype.ext_iff_val.mpr hp2⟩, },
      { rintros ⟨p, hp1, hp2⟩,
        rw [←hp2, set.mem_preimage, set.mem_image],
        refine ⟨p, hp1, rfl⟩, },
    end⟩ }

/--
If `U ⊆ V` are open sets in `X` and `W₁ ⊆ W₂ ⊆ U` is open in `U` then
`W₁ ⊆ W₂` is open in `V`.
-/
def emb.of_subset_hom {U V : opens X} (inc : U ⟶ V)
  {W₁ W₂ : opens (Top.of U)} (i : W₁ ⟶ W₂) :
  emb.of_subset inc W₁ ⟶ emb.of_subset inc W₂ :=
hom_of_le $ λ _ ⟨q, hq1, hq2⟩, ⟨q, le_of_hom i hq1, hq2⟩

lemma emb.of_subset_id (U : opens X) (W : opens (Top.of U)) :
  emb.of_subset (𝟙 U) W = W :=
begin
  ext x, split,
  { rintros ⟨p, hp, rfl⟩, dsimp, erw opens.mem_coe at hp, convert hp, ext, refl, },
  { intros h, rw opens.mem_coe at h, refine ⟨x, h, _⟩, ext, refl, },
end

lemma emb.of_subset_comp
  {U V W : opens X} (iUV : U ⟶ V) (iVW : V ⟶ W) (W : opens (Top.of U)) :
  emb.of_subset (iUV ≫ iVW) W = emb.of_subset iVW (emb.of_subset iUV W) :=
begin
  ext x, split,
  { rintros ⟨p, hp, rfl⟩, exact ⟨⟨p, le_of_hom iUV p.2⟩, ⟨p, hp, rfl⟩, rfl⟩, },
  { rintros ⟨p, ⟨q, hq, rfl⟩, rfl⟩, exact ⟨q, hq, rfl⟩, },
end

lemma emb.open_embedding (U : opens X) : open_embedding (emb U) :=
is_open.open_embedding_subtype_coe U.2

/--
Let `F` is a presheaf of abelian groups on `X` and `U ⊆ X` is open, this is
`F |_ V`, i.e. `(F |_ V)(W) = F(W)`
-/
@[simps] def restrict' (F : presheaf AddCommGroup.{u} X) (U : opens X) :
  presheaf AddCommGroup (Top.of U) :=
(emb.open_embedding U).is_open_map.functor.op ⋙ F

localized "infix `|_`:40 := Top.presheaf.restrict'" in sheaf

/--
any presheaf morphism `F |_ U ⟶ G |_ U` gives a group morphism `F(U) ⟶ G(U)`
by taking gloabal sections.
-/
@[simps] def sections_map_from_restrict' {F G : presheaf AddCommGroup.{u} X} {U : opens X}
  (α : F |_ U ⟶  G |_ U) :
  F.obj (op U) ⟶ G.obj (op U) :=
F.map (hom_of_le $ by { rintros _ ⟨x, hx, rfl⟩, exact x.2 } :
  (emb.open_embedding U).is_open_map.functor.obj ⊤ ⟶ U).op ≫ α.app (op ⊤) ≫
  G.map (hom_of_le $ λ x hx, ⟨⟨x, hx⟩, ⟨⟩, rfl⟩ :
    U ⟶ (emb.open_embedding U).is_open_map.functor.obj ⊤).op

/--
restriction is functorial.
-/
@[simps] def restrict_functor (U : opens X) :
  presheaf AddCommGroup.{u} X ⥤ presheaf AddCommGroup (Top.of U) :=
{ obj := λ F, F |_ U,
  map := λ F G α,
  { app := λ V, α.app _,
    naturality' := λ V W inc,
    begin
      ext x,
      erw [restrict'_map, α.naturality, restrict'_map, comp_apply],
    end },
  map_id' := λ F,
  begin
    ext U x,
    simp only [nat_trans.id_app, id_apply],
  end,
  map_comp' := λ F G H α β,
  begin
    ext U x,
    simp only [nat_trans.comp_app],
  end }

/--
Some glue: if `W ⊆ U ⊆ V` are open sets of `X`, then
`(F |_ U)(W) ≅ (F |_ V)(W)`
-/
@[reducible] def restrict_subset_sections
  (F : presheaf AddCommGroup.{u} X) {U V : opens X} (inc : U ⟶ V)
  (W : opens (Top.of U)) :
  (F |_ U).obj (op W) ≅ (F |_ V).obj (op $ emb.of_subset inc W) :=
{ hom := F.map (quiver.hom.op $ hom_of_le
    begin
      rintros p ⟨⟨q, hq1⟩, ⟨x, hx1, hx2⟩, rfl⟩,
      dsimp only at hx2,
      refine ⟨x, hx1, _⟩,
      rw ←hx2,
      refl,
    end : op ((emb.open_embedding U).is_open_map.functor.obj W) ⟶
      op ((emb.open_embedding V).is_open_map.functor.obj (emb.of_subset inc W))),
  inv := F.map (quiver.hom.op $ hom_of_le
    begin
      rintros p ⟨q, hq, rfl⟩,
      refine ⟨⟨q.1, le_of_hom inc q.2⟩, ⟨q, hq, rfl⟩, rfl⟩,
    end : op ((emb.open_embedding V).is_open_map.functor.obj (emb.of_subset inc W)) ⟶
      op ((emb.open_embedding U).is_open_map.functor.obj W)),
  hom_inv_id' := by { rw [←F.map_comp, ←op_comp], convert F.map_id _ },
  inv_hom_id' := by { rw [←F.map_comp, ←op_comp], convert F.map_id _ } }

/--
Auxiliary for:
If `U ⊆ V` are open sets, then any presheaf morphism `F |_ V ⟶ G |_ V` induces
a morphism `F |_ U ⟶ F |_ V`
-/
@[simps] def restrict_subset_sections_map.app {F G : presheaf AddCommGroup.{u} X}
  {U V : opens X} (inc : U ⟶ V)
  (α : F |_ V ⟶ G |_ V) (W : opens (Top.of U)):
  (F |_ U).obj (op W) ⟶ (G |_ U).obj (op W) :=
{ to_fun := λ s, (restrict_subset_sections G inc W).inv $ α.app _ $
      (restrict_subset_sections F inc W).hom s,
  map_zero' := by rw [map_zero, map_zero, map_zero],
  map_add' := λ x y, by rw [map_add, map_add, map_add] }

/--
Auxiliary for:
If `U ⊆ V` are open sets, then any presheaf morphism `F |_ V ⟶ G |_ V` induces
a morphism `F |_ U ⟶ F |_ V`
-/
lemma restrict_subset_sections_map.naturality {F G : presheaf AddCommGroup.{u} X}
  {U V : opens X} (inc : U ⟶ V)
  (α : restrict' F V ⟶ restrict' G V)
  (W₁ W₂ : (opens (Top.of U)))
  (i : W₁ ⟶ W₂) :
  (restrict' F U).map i.op ≫ restrict_subset_sections_map.app inc α W₁ =
    restrict_subset_sections_map.app inc α W₂ ≫ (restrict' G U).map i.op :=
begin
  ext x,
  simp only [restrict'_map, quiver.hom.unop_op, restrict_subset_sections_map.app, comp_apply,
    add_monoid_hom.coe_mk],
  simp only [←comp_apply],
  simp only [←comp_apply, ←F.map_comp, ←op_comp],
  generalize_proofs h1 h2 h3 h4 h5 h6,
  rw [show hom_of_le h3 ≫ h1.functor.map i = h2.functor.map (emb.of_subset_hom inc i) ≫
    hom_of_le h5, from rfl, op_comp, F.map_comp, category.assoc _ _ (α.app _)],
  have := α.naturality (emb.of_subset_hom inc i).op,
  dsimp at this,
  erw this,
  simp only [category.assoc],
  congr' 3,
  rw [←G.map_comp, ←G.map_comp, ←op_comp, ←op_comp],
  congr' 1,
end

/--
If `U ⊆ V` are open sets, then any presheaf morphism `F |_ V ⟶ G |_ V` induces
a morphism `F |_ U ⟶ F |_ V`
-/
@[simps] def restrict_subset_sections_map {F G : presheaf AddCommGroup.{u} X}
  {U V : opens X} (inc : U ⟶ V)
  (α : F |_ V ⟶ G |_ V) :
  F |_ U ⟶ G |_ U :=
{ app := λ W, restrict_subset_sections_map.app inc α W.unop,
  naturality' := λ W₁ W₂ i, restrict_subset_sections_map.naturality inc α _ _ i.unop }

/--
The morphsisms between restricted presheaves form an abelian group.
-/
instance (F G : presheaf AddCommGroup.{u} X) (U : opens X) :
  add_comm_group (F |_ U ⟶ G |_ U) :=
begin
  haveI i1 : preadditive (presheaf AddCommGroup (Top.of U)) :=
    category_theory.functor_category_preadditive,
  exactI i1.1 (restrict' F U) (restrict' G U),
end

@[simp] lemma sections_map_from_restrict'_zero {F G : presheaf AddCommGroup.{u} X} {U : opens X} :
  sections_map_from_restrict' (0 : F |_ U ⟶ G |_ U) = 0 :=
by ext; simp

lemma sections_map_from_restrict'_add {F G : presheaf AddCommGroup.{u} X} {U : opens X}
  (α β : F |_ U ⟶ G |_ U) :
  sections_map_from_restrict' (α + β) =
  sections_map_from_restrict' α +
  sections_map_from_restrict' β :=
by ext; simp

/--
The group homomorphism from `Hom_{Psh}(F |_ U, G |_ U)` to `Hom_{Ab}(F U, G U)`
-/
@[simps] def sections_map_from_restrict'_add_monoid_hom (F G : presheaf AddCommGroup.{u} X) (U : opens X) :
  AddCommGroup.of (F |_ U ⟶ G |_ U) ⟶
  AddCommGroup.of (F.obj (op U) ⟶ G.obj (op U)) :=
{ to_fun := sections_map_from_restrict',
  map_zero' := sections_map_from_restrict'_zero,
  map_add' := sections_map_from_restrict'_add }

lemma restrict_subset_sections_map_zero {F G : presheaf AddCommGroup.{u} X}
  {U V : opens X} (inc : U ⟶ V) :
  restrict_subset_sections_map inc (0 : restrict' F V ⟶ restrict' G V) = 0 :=
by { ext, simp }

lemma restrict_subset_sections_map_add {F G : presheaf AddCommGroup.{u} X}
  {U V : opens X} (inc : U ⟶ V) (α β : restrict' F V ⟶ restrict' G V) :
  restrict_subset_sections_map inc (α + β) = restrict_subset_sections_map inc α +
  restrict_subset_sections_map inc β :=
by { ext, simp }

lemma restrict_subset_sections_map_id {F G : presheaf AddCommGroup.{u} X} (U : opens X)
  (α : F |_ U ⟶ G |_ U) :
  restrict_subset_sections_map (𝟙 U) α = α :=
begin
  ext W x,
  simp only [restrict_subset_sections_map_app, restrict_subset_sections_map.app_apply],
  erw [←comp_apply, ←comp_apply, ←α.naturality],
  swap,
  { refine eq_to_hom _,
    rw emb.of_subset_id U W.unop,
    refl, },
  dsimp,
  rw [←category.assoc, ←F.map_comp, ←op_comp],
  congr' 1,
  convert category.id_comp _,
  convert F.map_id _,
end

lemma restrict_subset_sections_map_comp {F G : presheaf AddCommGroup.{u} X} {U V W : opens X}
  (iUV : U ⟶ V) (iVW : V ⟶ W)
  (α : F |_ W ⟶ G |_ W) :
  restrict_subset_sections_map (iUV ≫ iVW) α =
  restrict_subset_sections_map iUV (restrict_subset_sections_map iVW α) :=
begin
  ext O x,
  simp only [restrict_subset_sections_map_app, restrict_subset_sections_map.app_apply],
  simp only [←comp_apply, category.assoc, ←G.map_comp, ←op_comp],
  rw [←category.assoc _ _ (α.app _ ≫ _), ←F.map_comp, ←op_comp],
  congr' 1,
  change _ = _ ≫ α.app (op (emb.of_subset iVW (emb.of_subset iUV _))) ≫ _,
  generalize_proofs h1 h2 h3 h4 h5 h6 h7 h8 h9,
  rw [show α.app (op (emb.of_subset iVW (emb.of_subset iUV O.unop))) =
    F.map ((emb.open_embedding W).is_open_map.functor.op.map (eq_to_hom _)) ≫
      α.app (op (emb.of_subset (iUV ≫ iVW) O.unop)) ≫
      G.map ((emb.open_embedding W).is_open_map.functor.op.map (eq_to_hom _)),
    from _, category.assoc, category.assoc, ←G.map_comp, ←category.assoc (F.map _) (F.map _),
    ←F.map_comp],
  congr' 1,
  { rw emb.of_subset_comp, },
  { rw emb.of_subset_comp, },
  { erw [←category.assoc, α.naturality, category.assoc, ←G.map_comp],
    symmetry,
    convert category.comp_id _,
    convert G.map_id _, },
end

namespace monoidal

/--
The internal hom between `F, G` is defined to be:

* obj level: `U ↦ Hom_{Psh}(F |_ U, G |_ U)`
* map level: if `U ⊆ V` and `α : F |_ V ⟶ F |_U`, use `restrict_subset_sections_map`.
-/
@[simps] def ihom_obj (F G : presheaf AddCommGroup.{u} X) : presheaf AddCommGroup.{u} X :=
{ obj := λ U, AddCommGroup.of (F |_ U.unop ⟶ G |_ U.unop),
  map := λ U V inc,
  { to_fun := λ α, restrict_subset_sections_map inc.unop α,
    map_zero' := restrict_subset_sections_map_zero inc.unop,
    map_add' := λ α β, restrict_subset_sections_map_add inc.unop α β },
  map_id' := λ U,
  begin
    ext1,
    rw [add_monoid_hom.coe_mk, unop_id, restrict_subset_sections_map_id, id_apply],
  end,
  map_comp' := λ U V W iUV iVW,
  begin
    ext1 α,
    rw [add_monoid_hom.coe_mk, comp_apply, add_monoid_hom.coe_mk, add_monoid_hom.coe_mk],
    convert restrict_subset_sections_map_comp iVW.unop iUV.unop α,
  end }
-- 𝓗𝓸𝓶
-- ℋℴ𝓂
localized "notation `⟦` F, G`⟧` := Top.presheaf.monoidal.ihom_obj F G" in sheaf

/--
If `F, G₁, G₂` are presheaves and `γ : G₁ ⟶ G₂` and `f : F |_ U ⟶ G₁ |_ U`:
`γ` gives a map `G₁ |_ U ⟶ G₂ |_ U`, composing it with `f` to get `F |_ U ⟶ G₂ |_ U`
-/
@[simps] def ihom_map' (F G₁ G₂ : presheaf AddCommGroup.{u} X) (γ : G₁ ⟶ G₂)
  (U : opens X) (f : F |_ U ⟶ G₁ |_ U) :
  F |_ U ⟶ G₂ |_ U :=
f ≫ (restrict_functor U).map γ

lemma ihom_map'_zero (F G₁ G₂ : presheaf AddCommGroup.{u} X) (γ : G₁ ⟶ G₂) (U : opens X) :
  ihom_map' F G₁ G₂ γ U 0 = 0 :=
by ext; simp

lemma ihom_map'_add (F G₁ G₂ : presheaf AddCommGroup.{u} X) (γ : G₁ ⟶ G₂) (U : opens X)
  (α β : restrict' F U ⟶ restrict' G₁ U) :
  ihom_map' F G₁ G₂ γ U (α + β) = ihom_map' F G₁ G₂ γ U α + ihom_map' F _ _ γ U β :=
by ext; simp

lemma ihom_map'_naturality (F G₁ G₂ : presheaf AddCommGroup.{u} X)
  (γ : G₁ ⟶ G₂) (U : opens X) (α : F |_ U ⟶ G₁ |_ U)
  {W₁ W₂ : opens (Top.of U)} (inc : W₁ ⟶ W₂) :
  (F |_ U).map inc.op ≫ (ihom_map' F G₁ G₂ γ U α).app (op W₁) =
  (ihom_map' F G₁ G₂ γ U α).app (op W₂) ≫ (G₂ |_ U).map inc.op :=
begin
  ext x,
  simp only [restrict'_map, quiver.hom.unop_op, comp_apply, ihom_map'_app_apply],
  simp only [←comp_apply, category.assoc, ←G₂.map_comp],
  erw [←γ.naturality,
    ←category.assoc (α.app _), ←α.naturality],
  congr,
  exact inc.op,
end

/--
internal presheaf hom is functorial
-/
@[simps] def ihom_map_app (F G₁ G₂ : presheaf AddCommGroup.{u} X) (γ : G₁ ⟶ G₂) (U : opens X) :
  ⟦F, G₁⟧.obj (op U) ⟶ ⟦F, G₂⟧.obj (op U) :=
{ to_fun := λ α,
  { app := λ W, (ihom_map' F G₁ G₂ γ U α).app W,
    naturality' := λ W₁ W₂ inc,
    by convert ihom_map'_naturality F G₁ G₂ γ U α inc.unop },
  map_zero' :=
  begin
    ext W x,
    simp_rw ihom_map'_zero F G₁ G₂ γ U,
  end,
  map_add' := λ _ _,
  begin
    ext W x,
    simp_rw ihom_map'_add F G₁ G₂ γ U,
    rw [nat_trans.app_add, nat_trans.app_add],
  end }

/--
internal presheaf hom is functorial
-/
lemma ihom_map_naturality (F G₁ G₂ : presheaf AddCommGroup.{u} X) (γ : G₁ ⟶ G₂)
  {U V : opens X} (iUV : U ⟶ V) :
  ⟦F, G₁⟧.map iUV.op ≫ ihom_map_app F G₁ G₂ γ U =
  ihom_map_app F G₁ G₂ γ V ≫ (ihom_obj F G₂).map iUV.op :=
begin
  ext f W x,
  simp only [comp_apply, ihom_obj_map_apply, quiver.hom.unop_op, ihom_map_app_apply_app,
    ihom_map'_app_apply, restrict_subset_sections_map_app, restrict_subset_sections_map.app_apply],
  simp only [←comp_apply, category.assoc],
  rw [←γ.naturality],
  congr' 1,
end

/--
internal presheaf hom is functorial
-/
@[simps] def ihom_map (F G₁ G₂ : presheaf AddCommGroup.{u} X) (γ : G₁ ⟶ G₂) :
  ⟦F, G₁⟧ ⟶ ⟦F, G₂⟧ :=
{ app := λ U, ihom_map_app F G₁ G₂ γ U.unop,
  naturality' := λ U V iUV, by convert ihom_map_naturality F G₁ G₂ γ iUV.unop }

lemma ihom_map_id (F G : presheaf AddCommGroup.{u} X) :
  ihom_map F G G (𝟙 G) = 𝟙 _ :=
begin
  ext f U W x,
  simp only [ihom_map_app_2, ihom_map_app_apply_app, ihom_map'_app_apply, nat_trans.id_app,
    id_apply],
end

lemma ihom_map_comp (F G₁ G₂ G₃ : presheaf AddCommGroup.{u} X) (g₁₂ : G₁ ⟶ G₂) (g₂₃ : G₂ ⟶ G₃) :
  ihom_map F _ _ (g₁₂ ≫ g₂₃) = ihom_map F _ _ g₁₂ ≫ ihom_map F _ _ g₂₃ :=
begin
  ext f U W x,
  simp only [ihom_map_app_2, ihom_map_app_apply_app, ihom_map'_app_apply, nat_trans.comp_app,
    comp_apply],
end

/--
internal presheaf hom with source `F` is functorial

* obj level : `G ↦ ihom F G`
* map level : `α : G₁ ⟶ G₂`, a map `ihom F G₁ ⟶ ihom F G₂` is obtained by
  `U ↦ (f ↦ f ≫ α |_ U) `
-/
@[simps] def ihom (F : presheaf AddCommGroup.{u} X) :
  presheaf AddCommGroup.{u} X ⥤ presheaf AddCommGroup.{u} X :=
{ obj := ihom_obj F,
  map := ihom_map F,
  map_id' := ihom_map_id F,
  map_comp' := λ _ _ _, ihom_map_comp F _ _ _ }

end monoidal

end

end Top.presheaf

namespace Top.sheaf

open Top Top.presheaf topological_space
open category_theory category_theory.limits

universe u

variables {X : Top.{u}}

alias presheaf.monoidal.ihom_obj ← presheaf.ihom_obj

open_locale sheaf

lemma restrict_is_sheaf {F : Top.presheaf AddCommGroup.{u} X}
  (hF : is_sheaf F) (U : opens X) :
  is_sheaf (F |_ U) :=
is_sheaf_of_open_embedding (Top.presheaf.emb.open_embedding U) hF

def sheaf_restrict (F : sheaf AddCommGroup.{u} X) (U : opens X) :
  sheaf AddCommGroup.{u} (Top.of U) :=
⟨_, restrict_is_sheaf F.cond U⟩

localized "infix (name := sheaf_restrict) `|_`:40 := Top.sheaf.sheaf_restrict" in sheaf

namespace monoidal

open opposite

lemma ihom_obj_is_sheaf_of_is_sheaf {F G : Top.presheaf AddCommGroup.{u} X}
  (hF : is_sheaf F) (hG : is_sheaf G) : is_sheaf ⟦F, G⟧ :=
sorry

open category_theory.grothendieck_topology

@[simps] def ihom_obj (F G : sheaf AddCommGroup.{u} X) : sheaf AddCommGroup.{u} X :=
{ val := ⟦F.val, G.val⟧,
  cond := ihom_obj_is_sheaf_of_is_sheaf F.cond G.cond }

localized "notation (name := sheaf_ihom_obj) `⟦`F, G`⟧` :=
  Top.sheaf.monoidal.ihom_obj F G" in sheaf

@[simps] def ihom (F : sheaf AddCommGroup.{u} X) :
  sheaf AddCommGroup.{u} X ⥤ sheaf AddCommGroup.{u} X :=
{ obj := λ G, ⟦F, G⟧,
  map := λ G₁ G₂ α, ⟨presheaf.monoidal.ihom_map _ _ _ α.val⟩,
  map_id' := λ G,
  begin
    ext U x y z,
    simp only [Sheaf.category_theory.category_id_val, presheaf.monoidal.ihom_map_app_2,
      presheaf.monoidal.ihom_map_app_apply_app, presheaf.monoidal.ihom_map'_app_apply,
      nat_trans.id_app, id_apply],
  end,
  map_comp' := λ G₁ G₂ G₃ α β,
  begin
    ext U x y z,
    simp only [Sheaf.category_theory.category_comp_val, presheaf.monoidal.ihom_map_app_2,
      presheaf.monoidal.ihom_map_app_apply_app, presheaf.monoidal.ihom_map'_app_apply,
      nat_trans.comp_app, comp_apply],
  end }

end monoidal

end Top.sheaf

namespace SHEAF_OF_MODULES

open topological_space opposite

variables {X : RINGED_SPACE} (M1 M2 : SHEAF_OF_MODULES X)

namespace monoidal

open Top.sheaf.monoidal

local attribute [instance] SHEAF_OF_MODULES.module_structure

@[simps] def smul_ihom_obj (U : (opens (↑X : TOP))ᵒᵖ) (r : X.presheaf.obj U)
  (s : (ihom_obj M1.ab_sheaf M2.ab_sheaf).1.obj U) :
  (ihom_obj M1.ab_sheaf M2.ab_sheaf).1.obj U :=
{ app := λ V,
      show M1.ab_sheaf.val.obj
            (op ((Top.presheaf.emb.open_embedding U.unop).is_open_map.functor.obj V.unop)) ⟶
          M2.ab_sheaf.val.obj
            (op ((Top.presheaf.emb.open_embedding U.unop).is_open_map.functor.obj V.unop)),
      from let r' : X.presheaf.obj
        (op ((Top.presheaf.emb.open_embedding U.unop).is_open_map.functor.obj V.unop)) :=
        X.presheaf.map (hom_of_le
          begin
            rintros _ ⟨x, -, rfl⟩, exact x.2,
          end : (Top.presheaf.emb.open_embedding U.unop).is_open_map.functor.obj V.unop ⟶ U.unop).op r in
      r' • s.app V,
    naturality' := λ V V' i,
    begin
      dsimp,
      ext : 1,
      simp only [comp_apply, add_monoid_hom.smul_apply],
      erw [←comp_apply, s.naturality],
      erw M2.compatibility_bit,
      congr,
      rw [←comp_apply, ←X.presheaf.map_comp],
      refl,
    end }

instance has_smul_ihom_obj (U : (opens (↑X : TOP))ᵒᵖ) :
  has_smul (X.presheaf.obj U) $ (ihom_obj M1.ab_sheaf M2.ab_sheaf).1.obj U :=
{ smul := smul_ihom_obj M1 M2 U }

lemma smul_ihom_obj.one_smul (U : (opens (↑X : TOP))ᵒᵖ)
  (s : (ihom_obj M1.ab_sheaf M2.ab_sheaf).1.obj U) :
  smul_ihom_obj M1 M2 U 1 s = s :=
by ext; simp

lemma smul_ihom_obj.mul_smul (U : (opens (↑X : TOP))ᵒᵖ)
    (r r' : (X.presheaf.obj U))
  (s : (ihom_obj M1.ab_sheaf M2.ab_sheaf).1.obj U) :
  smul_ihom_obj _ _ _ (r * r') s =
  smul_ihom_obj _ _ _ r (smul_ihom_obj _ _ _ r' s) :=
by ext V t; simp [mul_smul]

instance mul_action_ihom_obj (U : (opens (↑X : TOP))ᵒᵖ) :
  mul_action (X.presheaf.obj U) $ (ihom_obj M1.ab_sheaf M2.ab_sheaf).1.obj U :=
{ one_smul := smul_ihom_obj.one_smul _ _ _,
  mul_smul := smul_ihom_obj.mul_smul _ _ _,
  ..SHEAF_OF_MODULES.monoidal.has_smul_ihom_obj M1 M2 U}

lemma smul_ihom_obj.smul_zero (U : (opens (↑X : TOP))ᵒᵖ)
  (r : X.presheaf.obj U) :
  smul_ihom_obj M1 M2 U r 0 = 0 :=
by ext; simp

lemma smul_ihom_obj.smul_add (U : (opens (↑X : TOP))ᵒᵖ)
  (r : X.presheaf.obj U)
  (x y : (ihom_obj M1.ab_sheaf M2.ab_sheaf).1.obj U) :
  smul_ihom_obj M1 M2 U r (x + y) =
  smul_ihom_obj M1 M2 U r x +
  smul_ihom_obj M1 M2 U r y :=
by ext; simp [smul_add]

instance distrib_mul_action_ihom_obj (U : (opens (↑X : TOP))ᵒᵖ) :
  distrib_mul_action (X.presheaf.obj U) $ (ihom_obj M1.ab_sheaf M2.ab_sheaf).1.obj U :=
{ smul_zero := smul_ihom_obj.smul_zero _ _ _,
  smul_add := smul_ihom_obj.smul_add _ _ _,
  ..SHEAF_OF_MODULES.monoidal.mul_action_ihom_obj M1 M2 U}

lemma smul_ihom_obj.add_smul (U : (opens (↑X : TOP))ᵒᵖ)
  (r r' : X.presheaf.obj U)
  (x : (ihom_obj M1.ab_sheaf M2.ab_sheaf).1.obj U) :
  smul_ihom_obj M1 M2 U (r + r') x =
  smul_ihom_obj M1 M2 U r x +
  smul_ihom_obj M1 M2 U r' x :=
by ext; simp [add_smul]

lemma smul_ihom_obj.zero_smul (U : (opens (↑X : TOP))ᵒᵖ)
  (x : (ihom_obj M1.ab_sheaf M2.ab_sheaf).1.obj U) :
  smul_ihom_obj M1 M2 U 0 x = 0 :=
by ext; simp

instance module_ihom_obj (U : (opens (↑X : TOP))ᵒᵖ) :
  module (X.presheaf.obj U) $ (ihom_obj M1.ab_sheaf M2.ab_sheaf).1.obj U :=
{ add_smul := smul_ihom_obj.add_smul _ _ _,
  zero_smul := smul_ihom_obj.zero_smul _ _ _,
  ..SHEAF_OF_MODULES.monoidal.distrib_mul_action_ihom_obj M1 M2 U}

lemma smul_ihom_obj_def (U : (opens (↑X : TOP))ᵒᵖ)
  (r : X.presheaf.obj U)
  (x : (ihom_obj M1.ab_sheaf M2.ab_sheaf).1.obj U) :
  r • x = smul_ihom_obj _ _ _ r x := rfl

def ihom_obj : SHEAF_OF_MODULES X :=
{ ab_sheaf := ihom_obj M1.ab_sheaf M2.ab_sheaf,
  module_structure := SHEAF_OF_MODULES.monoidal.module_ihom_obj _ _,
  compatibility_bit := λ U V i r x,
  begin
    delta ihom_obj,
    ext W s,
    dsimp only [smul_ihom_obj_def, smul_ihom_obj_app],
    rw [add_monoid_hom.smul_apply, Top.presheaf.monoidal.ihom_obj_map_apply,
      Top.presheaf.restrict_subset_sections_map_app,
      Top.presheaf.restrict_subset_sections_map.app_apply,
      smul_ihom_obj_app],
    dsimp,
    conv_rhs { rw [←comp_apply, ←X.presheaf.map_comp], },
    erw M2.compatibility_bit,
    rw [←comp_apply, ←X.presheaf.map_comp],
    refl,
  end }

@[simps] def ihom_map (F G₁ G₂ : SHEAF_OF_MODULES X) (α : G₁ ⟶ G₂) :
  ihom_obj F G₁ ⟶ ihom_obj F G₂ :=
{ ab_sheaf := (Top.sheaf.monoidal.ihom F.ab_sheaf).map α.ab_sheaf,
  map_smul := λ U r x,
  begin
    ext V s,
    dsimp [Top.presheaf.monoidal.ihom_map', smul_ihom_obj_def],
    rw [comp_apply, add_monoid_hom.smul_apply, comp_apply, ←α.map_smul],
  end }

@[simps] def ihom (F : SHEAF_OF_MODULES X) :
  SHEAF_OF_MODULES X ⥤ SHEAF_OF_MODULES X :=
{ obj := ihom_obj F,
  map := ihom_map F,
  map_id' := λ G,
  begin
    ext1,
    exact (Top.sheaf.monoidal.ihom F.ab_sheaf).map_id _,
  end,
  map_comp' := λ G₀ G₁ G₂ α β,
  begin
    ext1,
     exact (Top.sheaf.monoidal.ihom F.ab_sheaf).map_comp _ _,
  end }

end monoidal

end SHEAF_OF_MODULES


/-
Copyright (c) 2020 Oliver Nash. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Oliver Nash
-/
import tactic.abel

namespace tactic
namespace interactive

/-- A tactic for simplifying identities in not-necessarily-commutative rings.

An example:
```lean
example {R : Type*} [ring R] (a b c : R) : a * (b + c + c - b) = 2*a*c :=
by noncomm_ring
```
-/
meta def noncomm_ring :=
`[simp only [-- Expand everything out.
             add_mul, mul_add, sub_eq_add_neg,
             -- Right associate all products.
             mul_assoc,
             -- Expand powers to numerals.
             pow_bit0, pow_bit1, pow_one,
             -- Replace multiplication by numerals with `zsmul`.
             bit0_mul, mul_bit0, bit1_mul, mul_bit1, one_mul, mul_one, zero_mul, mul_zero,
             -- Pull `zsmul n` out the front so `abel` can see them.
             mul_smul_comm, smul_mul_assoc,
             -- Pull out negations.
             neg_mul, mul_neg] {fail_if_unchanged := ff};
  abel]

add_tactic_doc
{ name       := "noncomm_ring",
  category   := doc_category.tactic,
  decl_names := [`tactic.interactive.noncomm_ring],
  tags       := ["arithmetic", "simplification", "decision procedure"] }

end interactive
end tactic


/-
Copyright (c) 2020 Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bhavik Mehta
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.category_theory.limits.shapes.split_coequalizer
import Mathlib.category_theory.limits.preserves.basic
import Mathlib.PostPort

universes u₁ u₂ v

namespace Mathlib

/-!
# Preserving (co)equalizers

Constructions to relate the notions of preserving (co)equalizers and reflecting (co)equalizers
to concrete (co)forks.

In particular, we show that `equalizer_comparison G f` is an isomorphism iff `G` preserves
the limit of `f` as well as the dual.
-/

namespace category_theory.limits

/--
The map of a fork is a limit iff the fork consisting of the mapped morphisms is a limit. This
essentially lets us commute `fork.of_ι` with `functor.map_cone`.
-/
def is_limit_map_cone_fork_equiv {C : Type u₁} [category C] {D : Type u₂} [category D] (G : C ⥤ D)
    {X : C} {Y : C} {Z : C} {f : X ⟶ Y} {g : X ⟶ Y} {h : Z ⟶ X} (w : h ≫ f = h ≫ g) :
    is_limit (functor.map_cone G (fork.of_ι h w)) ≃
        is_limit (fork.of_ι (functor.map G h) (is_limit_map_cone_fork_equiv._proof_1 G w)) :=
  equiv.trans
    (equiv.symm
      (is_limit.postcompose_hom_equiv (diagram_iso_parallel_pair (parallel_pair f g ⋙ G))
        (functor.map_cone G (fork.of_ι h w))))
    (is_limit.equiv_iso_limit
      (fork.ext
        (iso.refl
          (cone.X
            (functor.obj
              (cones.postcompose (iso.hom (diagram_iso_parallel_pair (parallel_pair f g ⋙ G))))
              (functor.map_cone G (fork.of_ι h w)))))
        sorry))

/-- The property of preserving equalizers expressed in terms of forks. -/
def is_limit_fork_map_of_is_limit {C : Type u₁} [category C] {D : Type u₂} [category D] (G : C ⥤ D)
    {X : C} {Y : C} {Z : C} {f : X ⟶ Y} {g : X ⟶ Y} {h : Z ⟶ X} (w : h ≫ f = h ≫ g)
    [preserves_limit (parallel_pair f g) G] (l : is_limit (fork.of_ι h w)) :
    is_limit (fork.of_ι (functor.map G h) (is_limit_map_cone_fork_equiv._proof_1 G w)) :=
  coe_fn (is_limit_map_cone_fork_equiv G w) (preserves_limit.preserves l)

/-- The property of reflecting equalizers expressed in terms of forks. -/
def is_limit_of_is_limit_fork_map {C : Type u₁} [category C] {D : Type u₂} [category D] (G : C ⥤ D)
    {X : C} {Y : C} {Z : C} {f : X ⟶ Y} {g : X ⟶ Y} {h : Z ⟶ X} (w : h ≫ f = h ≫ g)
    [reflects_limit (parallel_pair f g) G]
    (l : is_limit (fork.of_ι (functor.map G h) (is_limit_of_is_limit_fork_map._proof_1 G w))) :
    is_limit (fork.of_ι h w) :=
  reflects_limit.reflects (coe_fn (equiv.symm (is_limit_map_cone_fork_equiv G w)) l)

/--
If `G` preserves equalizers and `C` has them, then the fork constructed of the mapped morphisms of
a fork is a limit.
-/
def is_limit_of_has_equalizer_of_preserves_limit {C : Type u₁} [category C] {D : Type u₂}
    [category D] (G : C ⥤ D) {X : C} {Y : C} (f : X ⟶ Y) (g : X ⟶ Y) [has_equalizer f g]
    [preserves_limit (parallel_pair f g) G] :
    is_limit
        (fork.of_ι (functor.map G (equalizer.ι f g))
          (is_limit_of_has_equalizer_of_preserves_limit._proof_1 G f g)) :=
  is_limit_fork_map_of_is_limit G (equalizer.condition f g) (equalizer_is_equalizer f g)

/--
If the equalizer comparison map for `G` at `(f,g)` is an isomorphism, then `G` preserves the
equalizer of `(f,g)`.
-/
def preserves_equalizer.of_iso_comparison {C : Type u₁} [category C] {D : Type u₂} [category D]
    (G : C ⥤ D) {X : C} {Y : C} (f : X ⟶ Y) (g : X ⟶ Y) [has_equalizer f g]
    [has_equalizer (functor.map G f) (functor.map G g)] [i : is_iso (equalizer_comparison f g G)] :
    preserves_limit (parallel_pair f g) G :=
  preserves_limit_of_preserves_limit_cone (equalizer_is_equalizer f g)
    (coe_fn (equiv.symm (is_limit_map_cone_fork_equiv G (equalizer.condition f g)))
      (is_limit.of_point_iso (limit.is_limit (parallel_pair (functor.map G f) (functor.map G g)))))

/--
If `G` preserves the equalizer of `(f,g)`, then the equalizer comparison map for `G` at `(f,g)` is
an isomorphism.
-/
def preserves_equalizer.iso {C : Type u₁} [category C] {D : Type u₂} [category D] (G : C ⥤ D)
    {X : C} {Y : C} (f : X ⟶ Y) (g : X ⟶ Y) [has_equalizer f g]
    [has_equalizer (functor.map G f) (functor.map G g)] [preserves_limit (parallel_pair f g) G] :
    functor.obj G (equalizer f g) ≅ equalizer (functor.map G f) (functor.map G g) :=
  is_limit.cone_point_unique_up_to_iso (is_limit_of_has_equalizer_of_preserves_limit G f g)
    (limit.is_limit (parallel_pair (functor.map G f) (functor.map G g)))

@[simp] theorem preserves_equalizer.iso_hom {C : Type u₁} [category C] {D : Type u₂} [category D]
    (G : C ⥤ D) {X : C} {Y : C} (f : X ⟶ Y) (g : X ⟶ Y) [has_equalizer f g]
    [has_equalizer (functor.map G f) (functor.map G g)] [preserves_limit (parallel_pair f g) G] :
    iso.hom (preserves_equalizer.iso G f g) = equalizer_comparison f g G :=
  rfl

protected instance equalizer_comparison.category_theory.is_iso {C : Type u₁} [category C]
    {D : Type u₂} [category D] (G : C ⥤ D) {X : C} {Y : C} (f : X ⟶ Y) (g : X ⟶ Y)
    [has_equalizer f g] [has_equalizer (functor.map G f) (functor.map G g)]
    [preserves_limit (parallel_pair f g) G] : is_iso (equalizer_comparison f g G) :=
  eq.mpr sorry (is_iso.of_iso (preserves_equalizer.iso G f g))

/--
The map of a cofork is a colimit iff the cofork consisting of the mapped morphisms is a colimit.
This essentially lets us commute `cofork.of_π` with `functor.map_cocone`.
-/
def is_colimit_map_cocone_cofork_equiv {C : Type u₁} [category C] {D : Type u₂} [category D]
    (G : C ⥤ D) {X : C} {Y : C} {Z : C} {f : X ⟶ Y} {g : X ⟶ Y} {h : Y ⟶ Z} (w : f ≫ h = g ≫ h) :
    is_colimit (functor.map_cocone G (cofork.of_π h w)) ≃
        is_colimit
          (cofork.of_π (functor.map G h) (is_colimit_map_cocone_cofork_equiv._proof_1 G w)) :=
  equiv.trans
    (equiv.symm
      (is_colimit.precompose_inv_equiv (diagram_iso_parallel_pair (parallel_pair f g ⋙ G))
        (functor.map_cocone G (cofork.of_π h w))))
    (is_colimit.equiv_iso_colimit
      (cofork.ext
        (iso.refl
          (cocone.X
            (functor.obj
              (cocones.precompose (iso.inv (diagram_iso_parallel_pair (parallel_pair f g ⋙ G))))
              (functor.map_cocone G (cofork.of_π h w)))))
        sorry))

/-- The property of preserving coequalizers expressed in terms of coforks. -/
def is_colimit_cofork_map_of_is_colimit {C : Type u₁} [category C] {D : Type u₂} [category D]
    (G : C ⥤ D) {X : C} {Y : C} {Z : C} {f : X ⟶ Y} {g : X ⟶ Y} {h : Y ⟶ Z} (w : f ≫ h = g ≫ h)
    [preserves_colimit (parallel_pair f g) G] (l : is_colimit (cofork.of_π h w)) :
    is_colimit (cofork.of_π (functor.map G h) (is_colimit_map_cocone_cofork_equiv._proof_1 G w)) :=
  coe_fn (is_colimit_map_cocone_cofork_equiv G w) (preserves_colimit.preserves l)

/-- The property of reflecting coequalizers expressed in terms of coforks. -/
def is_colimit_of_is_colimit_cofork_map {C : Type u₁} [category C] {D : Type u₂} [category D]
    (G : C ⥤ D) {X : C} {Y : C} {Z : C} {f : X ⟶ Y} {g : X ⟶ Y} {h : Y ⟶ Z} (w : f ≫ h = g ≫ h)
    [reflects_colimit (parallel_pair f g) G]
    (l :
      is_colimit
        (cofork.of_π (functor.map G h) (is_colimit_of_is_colimit_cofork_map._proof_1 G w))) :
    is_colimit (cofork.of_π h w) :=
  reflects_colimit.reflects (coe_fn (equiv.symm (is_colimit_map_cocone_cofork_equiv G w)) l)

/--
If `G` preserves coequalizers and `C` has them, then the cofork constructed of the mapped morphisms
of a cofork is a colimit.
-/
def is_colimit_of_has_coequalizer_of_preserves_colimit {C : Type u₁} [category C] {D : Type u₂}
    [category D] (G : C ⥤ D) {X : C} {Y : C} (f : X ⟶ Y) (g : X ⟶ Y) [has_coequalizer f g]
    [preserves_colimit (parallel_pair f g) G] :
    is_colimit
        (cofork.of_π (functor.map G (coequalizer.π f g))
          (is_colimit_of_has_coequalizer_of_preserves_colimit._proof_1 G f g)) :=
  is_colimit_cofork_map_of_is_colimit G (coequalizer.condition f g) (coequalizer_is_coequalizer f g)

/--
If the coequalizer comparison map for `G` at `(f,g)` is an isomorphism, then `G` preserves the
coequalizer of `(f,g)`.
-/
def of_iso_comparison {C : Type u₁} [category C] {D : Type u₂} [category D] (G : C ⥤ D) {X : C}
    {Y : C} (f : X ⟶ Y) (g : X ⟶ Y) [has_coequalizer f g]
    [has_coequalizer (functor.map G f) (functor.map G g)]
    [i : is_iso (coequalizer_comparison f g G)] : preserves_colimit (parallel_pair f g) G :=
  preserves_colimit_of_preserves_colimit_cocone (coequalizer_is_coequalizer f g)
    (coe_fn (equiv.symm (is_colimit_map_cocone_cofork_equiv G (coequalizer.condition f g)))
      (is_colimit.of_point_iso
        (colimit.is_colimit (parallel_pair (functor.map G f) (functor.map G g)))))

/--
If `G` preserves the coequalizer of `(f,g)`, then the coequalizer comparison map for `G` at `(f,g)`
is an isomorphism.
-/
def preserves_coequalizer.iso {C : Type u₁} [category C] {D : Type u₂} [category D] (G : C ⥤ D)
    {X : C} {Y : C} (f : X ⟶ Y) (g : X ⟶ Y) [has_coequalizer f g]
    [has_coequalizer (functor.map G f) (functor.map G g)]
    [preserves_colimit (parallel_pair f g) G] :
    coequalizer (functor.map G f) (functor.map G g) ≅ functor.obj G (coequalizer f g) :=
  is_colimit.cocone_point_unique_up_to_iso
    (colimit.is_colimit (parallel_pair (functor.map G f) (functor.map G g)))
    (is_colimit_of_has_coequalizer_of_preserves_colimit G f g)

@[simp] theorem preserves_coequalizer.iso_hom {C : Type u₁} [category C] {D : Type u₂} [category D]
    (G : C ⥤ D) {X : C} {Y : C} (f : X ⟶ Y) (g : X ⟶ Y) [has_coequalizer f g]
    [has_coequalizer (functor.map G f) (functor.map G g)]
    [preserves_colimit (parallel_pair f g) G] :
    iso.hom (preserves_coequalizer.iso G f g) = coequalizer_comparison f g G :=
  rfl

protected instance coequalizer_comparison.category_theory.is_iso {C : Type u₁} [category C]
    {D : Type u₂} [category D] (G : C ⥤ D) {X : C} {Y : C} (f : X ⟶ Y) (g : X ⟶ Y)
    [has_coequalizer f g] [has_coequalizer (functor.map G f) (functor.map G g)]
    [preserves_colimit (parallel_pair f g) G] : is_iso (coequalizer_comparison f g G) :=
  eq.mpr sorry (is_iso.of_iso (preserves_coequalizer.iso G f g))

/-- Any functor preserves coequalizers of split pairs. -/
protected instance preserves_split_coequalizers {C : Type u₁} [category C] {D : Type u₂}
    [category D] (G : C ⥤ D) {X : C} {Y : C} (f : X ⟶ Y) (g : X ⟶ Y) [has_split_coequalizer f g] :
    preserves_colimit (parallel_pair f g) G :=
  preserves_colimit_of_preserves_colimit_cocone
    (is_split_coequalizer.is_coequalizer (has_split_coequalizer.is_split_coequalizer f g))
    (coe_fn (equiv.symm (is_colimit_map_cocone_cofork_equiv G sorry))
      (is_split_coequalizer.is_coequalizer
        (is_split_coequalizer.map (has_split_coequalizer.is_split_coequalizer f g) G)))

end Mathlib


import field_theory.algebraic_closure
import data.zmod.basic
import Rings.ToMathlib.char_p

namespace is_alg_closed

open polynomial

lemma of_exists_root_nat_degree {k : Type*} [field k] (H : ∀ p : polynomial k, p.monic → irreducible p → nat_degree p ≠ 0 → ∃ x, p.eval x = 0) :
  is_alg_closed k :=
begin
  apply of_exists_root,
  intros p hmonic hirr,
  by_cases hdeg : nat_degree p = 0,
  {
    rw monic.degree_eq_zero_iff_eq_one hmonic at hdeg,
    rw hdeg at hirr,
    exfalso,
    apply hirr.1,
    exact ⟨ 1 , rfl ⟩,
  },
  apply H p hmonic hirr hdeg,
end

lemma of_nat_degree_ne_zero_exists_root {k : Type*} [field k]
  (H : ∀ p : polynomial k, nat_degree p ≠ 0 → ∃ x, p.eval x = 0) :
  is_alg_closed k :=
of_exists_root_nat_degree $ λ _ _ hdeg, H _

end is_alg_closed

section zmod

variables (p : ℕ) [hp : fact (nat.prime p)]

include hp

/-- lift zmod up to any universe -/
def ulift_zmod := ulift (zmod p)

instance ulift_zmod.field : field (ulift_zmod p) := equiv.ulift.field

lemma down_nat_coe_ulift_of_zmod :
  Π {n : ℕ}, (n : ulift_zmod p).down = (n : zmod p)
| nat.zero := rfl
| (nat.succ n) :=
begin
  simp only [nat.cast_succ],
  rw ← down_nat_coe_ulift_of_zmod,
  refl,
end

lemma ulift_zmod.char_p : char_p (ulift_zmod p) p :=
begin
  split,
  intro n,
  rw ← (zmod.char_p p).cast_eq_zero_iff,
  split,
  {
    intro hn,
    have hn' := congr_arg ulift.down hn,
    convert hn',
    rw down_nat_coe_ulift_of_zmod,
  },
  {
    intro hn,
    rw ← ulift.up_down ↑n,
    rw ← ulift.up_down 0,
    apply congr_arg ulift.up,
    convert hn,
    rw down_nat_coe_ulift_of_zmod,
  },
end

end zmod

namespace algebraic_closure

section zmod

variables (p : ℕ) [hp : fact (nat.prime p)]

include hp

/-- algebraic closure of finite fields with char p lifted to any universe -/
@[reducible] def of_ulift_zmod := algebraic_closure (ulift_zmod p)

-- noncomputable instance fields : field (of_zmod p) := by apply_instance

universe u

-- noncomputable instance :
--  algebra (ulift_zmod.{u} p) (of_ulift_zmod.{u} p) := by apply_instance

/-- algebraic closure of zmod is still characteristic p -/
lemma of_ulift_zmod.char_p : char_p (of_ulift_zmod.{u} p) p :=
(ring_hom.char_p_iff_char_p (algebra_map (ulift_zmod.{u} p) (of_ulift_zmod.{u} p)) p).1 $ ulift_zmod.char_p p

-- @[reducible] def ulift_of_zmod : Type* := ulift (of_zmod p)

-- noncomputable instance of_zmod.field : field (ulift (of_zmod p)) := equiv.ulift.field

-- #check equiv.iff

-- lemma difjsij {α β : Type*} (hequiv : α ≃ β) (p : Type* → Prop) :
--   p α ↔ p β :=
-- by library_search

instance of_zmod.is_alg_closed : is_alg_closed (of_ulift_zmod p) :=
by apply_instance

-- lemma down_nat_coe_ulift_of_zmod :
--   Π {n : ℕ}, (n : ulift_of_zmod p).down = (n : of_zmod p)
-- | nat.zero := rfl
-- | (nat.succ n) :=
-- begin
--   simp only [nat.cast_succ],
--   rw ← down_nat_coe_ulift_of_zmod,
--   refl,
-- end

-- lemma ulift_of_zmod.char_p :
--   char_p (ulift_of_zmod p) p :=
-- begin
--   split,
--   intro n,
--   rw ← (of_zmod.char_p p).cast_eq_zero_iff,
--   split,
--   {
--     intro hn,
--     have hn' := congr_arg ulift.down hn,
--     convert hn',
--     rw down_nat_coe_ulift_of_zmod,
--   },
--   {
--     intro hn,
--     rw ← ulift.up_down ↑n,
--     rw ← ulift.up_down 0,
--     apply congr_arg ulift.up,
--     convert hn,
--     rw down_nat_coe_ulift_of_zmod,
--   },
-- end

end zmod

end algebraic_closure