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

import measure_theory.measure.regular
import topology.semicontinuous
import measure_theory.integral.bochner
import topology.instances.ereal

/-!
# Vitali-Carathéodory theorem

Vitali-Carathéodory theorem asserts the following. Consider an integrable function `f : α → ℝ` on
a space with a regular measure. Then there exists a function `g : α → ereal` such that `f x < g x`
everywhere, `g` is lower semicontinuous, and the integral of `g` is arbitrarily close to that of
`f`. This theorem is proved in this file, as `exists_lt_lower_semicontinuous_integral_lt`.

Symmetrically, there exists `g < f` which is upper semicontinuous, with integral arbitrarily close
to that of `f`. It follows from the previous statement applied to `-f`. It is formalized under
the name `exists_upper_semicontinuous_lt_integral_gt`.

The most classical version of Vitali-Carathéodory theorem only ensures a large inequality
`f x ≤ g x`. For applications to the fundamental theorem of calculus, though, the strict inequality
`f x < g x` is important. Therefore, we prove the stronger version with strict inequalities in this
file. There is a price to pay: we require that the measure is `σ`-finite, which is not necessary for
the classical Vitali-Carathéodory theorem. Since this is satisfied in all applications, this is
not a real problem.

## Sketch of proof

Decomposing `f` as the difference of its positive and negative parts, it suffices to show that a
positive function can be bounded from above by a lower semicontinuous function, and from below
by an upper semicontinuous function, with integrals close to that of `f`.

For the bound from above, write `f` as a series `∑' n, cₙ * indicator (sₙ)` of simple functions.
Then, approximate `sₙ` by a larger open set `uₙ` with measure very close to that of `sₙ` (this is
possible by regularity of the measure), and set `g = ∑' n, cₙ * indicator (uₙ)`. It is
lower semicontinuous as a series of lower semicontinuous functions, and its integral is arbitrarily
close to that of `f`.

For the bound from below, use finitely many terms in the series, and approximate `sₙ` from inside by
a closed set `Fₙ`. Then `∑ n < N, cₙ * indicator (Fₙ)` is bounded from above by `f`, it is
upper semicontinuous as a finite sum of upper semicontinuous functions, and its integral is
arbitrarily close to that of `f`.

The main pain point in the implementation is that one needs to jump between the spaces `ℝ`, `ℝ≥0`,
`ℝ≥0∞` and `ereal` (and be careful that addition is not well behaved on `ereal`), and between
`lintegral` and `integral`.

We first show the bound from above for simple functions and the nonnegative integral
(this is the main nontrivial mathematical point), then deduce it for general nonnegative functions,
first for the nonnegative integral and then for the Bochner integral.

Then we follow the same steps for the lower bound.

Finally, we glue them together to obtain the main statement
`exists_lt_lower_semicontinuous_integral_lt`.

## Related results

Are you looking for a result on approximation by continuous functions (not just semicontinuous)?
See result `measure_theory.Lp.continuous_map_dense`, in the file
`measure_theory.continuous_map_dense`.

## References

[Rudin, *Real and Complex Analysis* (Theorem 2.24)][rudin2006real]

-/

open_locale ennreal nnreal

open measure_theory measure_theory.measure

variables {α : Type*} [topological_space α] [measurable_space α] [borel_space α] (μ : measure α)
  [weakly_regular μ]

namespace measure_theory

local infixr ` →ₛ `:25 := simple_func

/-! ### Lower semicontinuous upper bound for nonnegative functions -/

/-- Given a simple function `f` with values in `ℝ≥0`, there exists a lower semicontinuous
function `g ≥ f` with integral arbitrarily close to that of `f`. Formulation in terms of
`lintegral`.
Auxiliary lemma for Vitali-Carathéodory theorem `exists_lt_lower_semicontinuous_integral_lt`. -/
lemma simple_func.exists_le_lower_semicontinuous_lintegral_ge (f : α →ₛ ℝ≥0)
  {ε : ℝ≥0∞} (ε0 : ε ≠ 0) :
  ∃ g : α → ℝ≥0, (∀ x, f x ≤ g x) ∧ lower_semicontinuous g ∧
    (∫⁻ x, g x ∂μ ≤ ∫⁻ x, f x ∂μ + ε) :=
begin
  induction f using measure_theory.simple_func.induction with c s hs f₁ f₂ H h₁ h₂ generalizing ε,
  { let f := simple_func.piecewise s hs (simple_func.const α c) (simple_func.const α 0),
    by_cases h : ∫⁻ x, f x ∂μ = ⊤,
    { refine ⟨λ x, c, λ x, _, lower_semicontinuous_const, by simp only [_root_.top_add, le_top, h]⟩,
      simp only [simple_func.coe_const, simple_func.const_zero, simple_func.coe_zero,
        set.piecewise_eq_indicator, simple_func.coe_piecewise],
      exact set.indicator_le_self _ _ _ },
    by_cases hc : c = 0,
    { refine ⟨λ x, 0, _, lower_semicontinuous_const, _⟩,
      { simp only [hc, set.indicator_zero', pi.zero_apply, simple_func.const_zero, implies_true_iff,
          eq_self_iff_true, simple_func.coe_zero, set.piecewise_eq_indicator,
          simple_func.coe_piecewise, le_zero_iff] },
      { simp only [lintegral_const, zero_mul, zero_le, ennreal.coe_zero] } },
    have : μ s < μ s + ε / c,
    { have : (0 : ℝ≥0∞) < ε / c := ennreal.div_pos_iff.2 ⟨ε0, ennreal.coe_ne_top⟩,
      simpa using ennreal.add_lt_add_left _ this,
      simpa only [hs, hc, lt_top_iff_ne_top, true_and, simple_func.coe_const, function.const_apply,
        lintegral_const, ennreal.coe_indicator, set.univ_inter, ennreal.coe_ne_top,
        measurable_set.univ, with_top.mul_eq_top_iff, simple_func.const_zero, or_false,
        lintegral_indicator, ennreal.coe_eq_zero, ne.def, not_false_iff, simple_func.coe_zero,
        set.piecewise_eq_indicator, simple_func.coe_piecewise, false_and, restrict_apply] using h },
    obtain ⟨u, su, u_open, μu⟩ : ∃ u ⊇ s, is_open u ∧ μ u < μ s + ε / c :=
      s.exists_is_open_lt_of_lt _ this,
    refine ⟨set.indicator u (λ x, c), λ x, _, u_open.lower_semicontinuous_indicator (zero_le _), _⟩,
    { simp only [simple_func.coe_const, simple_func.const_zero, simple_func.coe_zero,
        set.piecewise_eq_indicator, simple_func.coe_piecewise],
      exact set.indicator_le_indicator_of_subset su (λ x, zero_le _) _ },
    { suffices : (c : ℝ≥0∞) * μ u ≤ c * μ s + ε, by
        simpa only [hs, u_open.measurable_set, simple_func.coe_const, function.const_apply,
          lintegral_const, ennreal.coe_indicator, set.univ_inter, measurable_set.univ,
          simple_func.const_zero, lintegral_indicator, simple_func.coe_zero,
          set.piecewise_eq_indicator, simple_func.coe_piecewise, restrict_apply],
      calc (c : ℝ≥0∞) * μ u ≤ c * (μ s + ε / c) : mul_le_mul_left' μu.le _
      ... = c * μ s + ε :
        begin
          simp_rw [mul_add],
          rw ennreal.mul_div_cancel' _ ennreal.coe_ne_top,
          simpa using hc,
        end } },
  { rcases h₁ (ennreal.half_pos ε0).ne' with ⟨g₁, f₁_le_g₁, g₁cont, g₁int⟩,
    rcases h₂ (ennreal.half_pos ε0).ne' with ⟨g₂, f₂_le_g₂, g₂cont, g₂int⟩,
    refine ⟨λ x, g₁ x + g₂ x, λ x, add_le_add (f₁_le_g₁ x) (f₂_le_g₂ x), g₁cont.add g₂cont, _⟩,
    simp only [simple_func.coe_add, ennreal.coe_add, pi.add_apply],
    rw [lintegral_add_left f₁.measurable.coe_nnreal_ennreal,
        lintegral_add_left g₁cont.measurable.coe_nnreal_ennreal],
    convert add_le_add g₁int g₂int using 1,
    simp only [],
    conv_lhs { rw ← ennreal.add_halves ε },
    abel }
end

open simple_func (eapprox_diff tsum_eapprox_diff)

/-- Given a measurable function `f` with values in `ℝ≥0`, there exists a lower semicontinuous
function `g ≥ f` with integral arbitrarily close to that of `f`. Formulation in terms of
`lintegral`.
Auxiliary lemma for Vitali-Carathéodory theorem `exists_lt_lower_semicontinuous_integral_lt`. -/
lemma exists_le_lower_semicontinuous_lintegral_ge
  (f : α → ℝ≥0∞) (hf : measurable f) {ε : ℝ≥0∞} (εpos : ε ≠ 0) :
  ∃ g : α → ℝ≥0∞, (∀ x, f x ≤ g x) ∧ lower_semicontinuous g ∧ (∫⁻ x, g x ∂μ ≤ ∫⁻ x, f x ∂μ + ε) :=
begin
  rcases ennreal.exists_pos_sum_of_countable' εpos ℕ with ⟨δ, δpos, hδ⟩,
  have : ∀ n, ∃ g : α → ℝ≥0, (∀ x, simple_func.eapprox_diff f n x ≤ g x) ∧ lower_semicontinuous g ∧
    (∫⁻ x, g x ∂μ ≤ ∫⁻ x, simple_func.eapprox_diff f n x ∂μ + δ n) :=
  λ n, simple_func.exists_le_lower_semicontinuous_lintegral_ge μ
    (simple_func.eapprox_diff f n) (δpos n).ne',
  choose g f_le_g gcont hg using this,
  refine ⟨λ x, (∑' n, g n x), λ x, _, _, _⟩,
  { rw ← tsum_eapprox_diff f hf,
    exact ennreal.tsum_le_tsum (λ n, ennreal.coe_le_coe.2 (f_le_g n x)) },
  { apply lower_semicontinuous_tsum (λ n, _),
    exact ennreal.continuous_coe.comp_lower_semicontinuous (gcont n)
      (λ x y hxy, ennreal.coe_le_coe.2 hxy) },
  { calc ∫⁻ x, ∑' (n : ℕ), g n x ∂μ
    = ∑' n, ∫⁻ x, g n x ∂μ :
      by rw lintegral_tsum (λ n, (gcont n).measurable.coe_nnreal_ennreal.ae_measurable)
    ... ≤ ∑' n, (∫⁻ x, eapprox_diff f n x ∂μ + δ n) : ennreal.tsum_le_tsum hg
    ... = ∑' n, (∫⁻ x, eapprox_diff f n x ∂μ) + ∑' n, δ n : ennreal.tsum_add
    ... ≤ ∫⁻ (x : α), f x ∂μ + ε :
      begin
        refine add_le_add _ hδ.le,
        rw [← lintegral_tsum],
        { simp_rw [tsum_eapprox_diff f hf, le_refl] },
        { assume n, exact (simple_func.measurable _).coe_nnreal_ennreal.ae_measurable }
      end }
end

/-- Given a measurable function `f` with values in `ℝ≥0` in a sigma-finite space, there exists a
lower semicontinuous function `g > f` with integral arbitrarily close to that of `f`.
Formulation in terms of `lintegral`.
Auxiliary lemma for Vitali-Carathéodory theorem `exists_lt_lower_semicontinuous_integral_lt`. -/
lemma exists_lt_lower_semicontinuous_lintegral_ge [sigma_finite μ]
  (f : α → ℝ≥0) (fmeas : measurable f) {ε : ℝ≥0∞} (ε0 : ε ≠ 0) :
  ∃ g : α → ℝ≥0∞, (∀ x, (f x : ℝ≥0∞) < g x) ∧ lower_semicontinuous g ∧
    (∫⁻ x, g x ∂μ ≤ ∫⁻ x, f x ∂μ + ε) :=
begin
  have : ε / 2 ≠ 0 := (ennreal.half_pos ε0).ne',
  rcases exists_pos_lintegral_lt_of_sigma_finite μ this with ⟨w, wpos, wmeas, wint⟩,
  let f' := λ x, ((f x + w x : ℝ≥0) : ℝ≥0∞),
  rcases exists_le_lower_semicontinuous_lintegral_ge μ f' (fmeas.add wmeas).coe_nnreal_ennreal this
    with ⟨g, le_g, gcont, gint⟩,
  refine ⟨g, λ x, _, gcont, _⟩,
  { calc (f x : ℝ≥0∞) < f' x : by simpa [← ennreal.coe_lt_coe] using add_lt_add_left (wpos x) (f x)
    ... ≤ g x : le_g x },
  { calc ∫⁻ (x : α), g x ∂μ
        ≤ ∫⁻ (x : α), f x + w x ∂μ + ε / 2 : gint
    ... = ∫⁻ (x : α), f x ∂ μ + ∫⁻ (x : α), w x ∂ μ + (ε / 2) :
      by rw lintegral_add_right _ wmeas.coe_nnreal_ennreal
    ... ≤ ∫⁻ (x : α), f x ∂ μ + ε / 2 + ε / 2 :
      add_le_add_right (add_le_add_left wint.le _) _
    ... = ∫⁻ (x : α), f x ∂μ + ε : by rw [add_assoc, ennreal.add_halves] },
end

/-- Given an almost everywhere measurable function `f` with values in `ℝ≥0` in a sigma-finite space,
there exists a lower semicontinuous function `g > f` with integral arbitrarily close to that of `f`.
Formulation in terms of `lintegral`.
Auxiliary lemma for Vitali-Carathéodory theorem `exists_lt_lower_semicontinuous_integral_lt`. -/
lemma exists_lt_lower_semicontinuous_lintegral_ge_of_ae_measurable [sigma_finite μ]
  (f : α → ℝ≥0) (fmeas : ae_measurable f μ) {ε : ℝ≥0∞} (ε0 : ε ≠ 0) :
  ∃ g : α → ℝ≥0∞, (∀ x, (f x : ℝ≥0∞) < g x) ∧ lower_semicontinuous g ∧
    (∫⁻ x, g x ∂μ ≤ ∫⁻ x, f x ∂μ + ε) :=
begin
  have : ε / 2 ≠ 0 := (ennreal.half_pos ε0).ne',
  rcases exists_lt_lower_semicontinuous_lintegral_ge μ (fmeas.mk f) fmeas.measurable_mk this
    with ⟨g0, f_lt_g0, g0_cont, g0_int⟩,
  rcases exists_measurable_superset_of_null fmeas.ae_eq_mk with ⟨s, hs, smeas, μs⟩,
  rcases exists_le_lower_semicontinuous_lintegral_ge μ (s.indicator (λ x, ∞))
    (measurable_const.indicator smeas) this
    with ⟨g1, le_g1, g1_cont, g1_int⟩,
  refine ⟨λ x, g0 x + g1 x, λ x, _, g0_cont.add g1_cont, _⟩,
  { by_cases h : x ∈ s,
    { have := le_g1 x,
      simp only [h, set.indicator_of_mem, top_le_iff] at this,
      simp [this] },
    { have : f x = fmeas.mk f x,
        by { rw set.compl_subset_comm at hs, exact hs h },
      rw this,
      exact (f_lt_g0 x).trans_le le_self_add } },
  { calc ∫⁻ x, g0 x + g1 x ∂μ =  ∫⁻ x, g0 x ∂μ + ∫⁻ x, g1 x ∂μ :
      lintegral_add_left g0_cont.measurable _
    ... ≤ (∫⁻ x, f x ∂μ + ε / 2) + (0 + ε / 2) :
      begin
        refine add_le_add _ _,
        { convert g0_int using 2,
          exact lintegral_congr_ae (fmeas.ae_eq_mk.fun_comp _) },
        { convert g1_int,
          simp only [smeas, μs, lintegral_const, set.univ_inter, measurable_set.univ,
            lintegral_indicator, mul_zero, restrict_apply] }
      end
    ... = ∫⁻ x, f x ∂μ + ε : by simp only [add_assoc, ennreal.add_halves, zero_add] }
end

variable {μ}

/-- Given an integrable function `f` with values in `ℝ≥0` in a sigma-finite space, there exists a
lower semicontinuous function `g > f` with integral arbitrarily close to that of `f`.
Formulation in terms of `integral`.
Auxiliary lemma for Vitali-Carathéodory theorem `exists_lt_lower_semicontinuous_integral_lt`. -/
lemma exists_lt_lower_semicontinuous_integral_gt_nnreal [sigma_finite μ] (f : α → ℝ≥0)
  (fint : integrable (λ x, (f x : ℝ)) μ) {ε : ℝ} (εpos : 0 < ε) :
  ∃ g : α → ℝ≥0∞, (∀ x, (f x : ℝ≥0∞) < g x) ∧ lower_semicontinuous g ∧ (∀ᵐ x ∂ μ, g x < ⊤)
  ∧ (integrable (λ x, (g x).to_real) μ) ∧ (∫ x, (g x).to_real ∂μ < ∫ x, f x ∂μ + ε) :=
begin
  have fmeas : ae_measurable f μ,
  by { convert fint.ae_strongly_measurable.real_to_nnreal.ae_measurable, ext1 x,
       simp only [real.to_nnreal_coe] },
  lift ε to ℝ≥0 using εpos.le,
  obtain ⟨δ, δpos, hδε⟩ : ∃ δ : ℝ≥0, 0 < δ ∧ δ < ε, from exists_between εpos,
  have int_f_ne_top : ∫⁻ (a : α), (f a) ∂μ ≠ ∞ :=
    (has_finite_integral_iff_of_nnreal.1 fint.has_finite_integral).ne,
  rcases exists_lt_lower_semicontinuous_lintegral_ge_of_ae_measurable μ f fmeas
    (ennreal.coe_ne_zero.2 δpos.ne')
    with ⟨g, f_lt_g, gcont, gint⟩,
  have gint_ne : ∫⁻ (x : α), g x ∂μ ≠ ∞ := ne_top_of_le_ne_top (by simpa) gint,
  have g_lt_top : ∀ᵐ (x : α) ∂μ, g x < ∞ := ae_lt_top gcont.measurable gint_ne,
  have Ig : ∫⁻ (a : α), ennreal.of_real (g a).to_real ∂μ = ∫⁻ (a : α), g a ∂μ,
  { apply lintegral_congr_ae,
    filter_upwards [g_lt_top] with _ hx,
    simp only [hx.ne, ennreal.of_real_to_real, ne.def, not_false_iff], },
  refine ⟨g, f_lt_g, gcont, g_lt_top, _, _⟩,
  { refine ⟨gcont.measurable.ennreal_to_real.ae_measurable.ae_strongly_measurable, _⟩,
    simp only [has_finite_integral_iff_norm, real.norm_eq_abs,
      abs_of_nonneg ennreal.to_real_nonneg],
    convert gint_ne.lt_top using 1 },
  { rw [integral_eq_lintegral_of_nonneg_ae, integral_eq_lintegral_of_nonneg_ae],
    { calc
      ennreal.to_real (∫⁻ (a : α), ennreal.of_real (g a).to_real ∂μ)
          = ennreal.to_real (∫⁻ (a : α), g a ∂μ) : by congr' 1
      ... ≤ ennreal.to_real (∫⁻ (a : α), f a ∂μ + δ) :
        begin
          apply ennreal.to_real_mono _ gint,
          simpa using int_f_ne_top,
        end
      ... = ennreal.to_real (∫⁻ (a : α), f a ∂μ) + δ :
        by rw [ennreal.to_real_add int_f_ne_top ennreal.coe_ne_top, ennreal.coe_to_real]
      ... < ennreal.to_real (∫⁻ (a : α), f a ∂μ) + ε :
        add_lt_add_left hδε _
      ... = (∫⁻ (a : α), ennreal.of_real ↑(f a) ∂μ).to_real + ε :
        by simp },
    { apply filter.eventually_of_forall (λ x, _), simp },
    { exact fmeas.coe_nnreal_real.ae_strongly_measurable, },
    { apply filter.eventually_of_forall (λ x, _), simp },
    { apply gcont.measurable.ennreal_to_real.ae_measurable.ae_strongly_measurable } }
end

/-! ### Upper semicontinuous lower bound for nonnegative functions -/

/-- Given a simple function `f` with values in `ℝ≥0`, there exists an upper semicontinuous
function `g ≤ f` with integral arbitrarily close to that of `f`. Formulation in terms of
`lintegral`.
Auxiliary lemma for Vitali-Carathéodory theorem `exists_lt_lower_semicontinuous_integral_lt`. -/
lemma simple_func.exists_upper_semicontinuous_le_lintegral_le
  (f : α →ₛ ℝ≥0) (int_f : ∫⁻ x, f x ∂μ ≠ ∞) {ε : ℝ≥0∞} (ε0 : ε ≠ 0) :
  ∃ g : α → ℝ≥0, (∀ x, g x ≤ f x) ∧ upper_semicontinuous g ∧ (∫⁻ x, f x ∂μ ≤ ∫⁻ x, g x ∂μ + ε) :=
begin
  induction f using measure_theory.simple_func.induction with c s hs f₁ f₂ H h₁ h₂ generalizing ε,
  { let f := simple_func.piecewise s hs (simple_func.const α c) (simple_func.const α 0),
    by_cases hc : c = 0,
    { refine ⟨λ x, 0, _, upper_semicontinuous_const, _⟩,
      { simp only [hc, set.indicator_zero', pi.zero_apply, simple_func.const_zero, implies_true_iff,
          eq_self_iff_true, simple_func.coe_zero, set.piecewise_eq_indicator,
          simple_func.coe_piecewise, le_zero_iff] },
      { simp only [hc, set.indicator_zero', lintegral_const, zero_mul, pi.zero_apply,
         simple_func.const_zero, zero_add, zero_le', simple_func.coe_zero,
         set.piecewise_eq_indicator, ennreal.coe_zero, simple_func.coe_piecewise, zero_le] } },
    have μs_lt_top : μ s < ∞,
      by simpa only [hs, hc, lt_top_iff_ne_top, true_and, simple_func.coe_const, or_false,
        lintegral_const, ennreal.coe_indicator, set.univ_inter, ennreal.coe_ne_top, restrict_apply
        measurable_set.univ, with_top.mul_eq_top_iff, simple_func.const_zero, function.const_apply,
        lintegral_indicator, ennreal.coe_eq_zero, ne.def, not_false_iff, simple_func.coe_zero,
        set.piecewise_eq_indicator, simple_func.coe_piecewise, false_and] using int_f,
    have : (0 : ℝ≥0∞) < ε / c := ennreal.div_pos_iff.2 ⟨ε0, ennreal.coe_ne_top⟩,
    obtain ⟨F, Fs, F_closed, μF⟩ : ∃ F ⊆ s, is_closed F ∧ μ s < μ F + ε / c :=
      hs.exists_is_closed_lt_add μs_lt_top.ne this.ne',
    refine ⟨set.indicator F (λ x, c), λ x, _,
      F_closed.upper_semicontinuous_indicator (zero_le _), _⟩,
    { simp only [simple_func.coe_const, simple_func.const_zero, simple_func.coe_zero,
        set.piecewise_eq_indicator, simple_func.coe_piecewise],
      exact set.indicator_le_indicator_of_subset Fs (λ x, zero_le _) _ },
    { suffices : (c : ℝ≥0∞) * μ s ≤ c * μ F + ε,
        by simpa only [hs, F_closed.measurable_set, simple_func.coe_const, function.const_apply,
          lintegral_const, ennreal.coe_indicator, set.univ_inter, measurable_set.univ,
          simple_func.const_zero, lintegral_indicator, simple_func.coe_zero,
          set.piecewise_eq_indicator, simple_func.coe_piecewise, restrict_apply],
      calc (c : ℝ≥0∞) * μ s ≤ c * (μ F + ε / c) : mul_le_mul_left' μF.le _
      ... = c * μ F + ε :
        begin
          simp_rw [mul_add],
          rw ennreal.mul_div_cancel' _ ennreal.coe_ne_top,
          simpa using hc,
        end } },
  { have A : ∫⁻ (x : α), f₁ x ∂μ + ∫⁻ (x : α), f₂ x ∂μ ≠ ⊤,
      by rwa ← lintegral_add_left f₁.measurable.coe_nnreal_ennreal,
    rcases h₁ (ennreal.add_ne_top.1 A).1 (ennreal.half_pos ε0).ne'
      with ⟨g₁, f₁_le_g₁, g₁cont, g₁int⟩,
    rcases h₂ (ennreal.add_ne_top.1 A).2 (ennreal.half_pos ε0).ne'
      with ⟨g₂, f₂_le_g₂, g₂cont, g₂int⟩,
    refine ⟨λ x, g₁ x + g₂ x, λ x, add_le_add (f₁_le_g₁ x) (f₂_le_g₂ x), g₁cont.add g₂cont, _⟩,
    simp only [simple_func.coe_add, ennreal.coe_add, pi.add_apply],
    rw [lintegral_add_left f₁.measurable.coe_nnreal_ennreal,
        lintegral_add_left g₁cont.measurable.coe_nnreal_ennreal],
    convert add_le_add g₁int g₂int using 1,
    simp only [],
    conv_lhs { rw ← ennreal.add_halves ε },
    abel }
end

/-- Given an integrable function `f` with values in `ℝ≥0`, there exists an upper semicontinuous
function `g ≤ f` with integral arbitrarily close to that of `f`. Formulation in terms of
`lintegral`.
Auxiliary lemma for Vitali-Carathéodory theorem `exists_lt_lower_semicontinuous_integral_lt`. -/
lemma exists_upper_semicontinuous_le_lintegral_le
  (f : α → ℝ≥0) (int_f : ∫⁻ x, f x ∂μ ≠ ∞) {ε : ℝ≥0∞} (ε0 : ε ≠ 0) :
  ∃ g : α → ℝ≥0, (∀ x, g x ≤ f x) ∧ upper_semicontinuous g ∧ (∫⁻ x, f x ∂μ ≤ ∫⁻ x, g x ∂μ + ε) :=
begin
  obtain ⟨fs, fs_le_f, int_fs⟩ : ∃ (fs : α →ₛ ℝ≥0), (∀ x, fs x ≤ f x) ∧
    (∫⁻ x, f x ∂μ ≤ ∫⁻ x, fs x ∂μ + ε/2) :=
  begin
    have := ennreal.lt_add_right int_f (ennreal.half_pos ε0).ne',
    conv_rhs at this { rw lintegral_eq_nnreal (λ x, (f x : ℝ≥0∞)) μ },
    erw ennreal.bsupr_add at this; [skip, exact ⟨0, λ x, by simp⟩],
    simp only [lt_supr_iff] at this,
    rcases this with ⟨fs, fs_le_f, int_fs⟩,
    refine ⟨fs, λ x, by simpa only [ennreal.coe_le_coe] using fs_le_f x, _⟩,
    convert int_fs.le,
    rw ← simple_func.lintegral_eq_lintegral,
    refl
  end,
  have int_fs_lt_top : ∫⁻ x, fs x ∂μ ≠ ∞,
  { apply ne_top_of_le_ne_top int_f (lintegral_mono (λ x, _)),
    simpa only [ennreal.coe_le_coe] using fs_le_f x },
  obtain ⟨g, g_le_fs, gcont, gint⟩ : ∃ g : α → ℝ≥0,
    (∀ x, g x ≤ fs x) ∧ upper_semicontinuous g ∧ (∫⁻ x, fs x ∂μ ≤ ∫⁻ x, g x ∂μ + ε/2) :=
  fs.exists_upper_semicontinuous_le_lintegral_le int_fs_lt_top (ennreal.half_pos ε0).ne',
  refine ⟨g, λ x, (g_le_fs x).trans (fs_le_f x), gcont, _⟩,
  calc ∫⁻ x, f x ∂μ ≤ ∫⁻ x, fs x ∂μ + ε / 2 : int_fs
  ... ≤ (∫⁻ x, g x ∂μ + ε / 2) + ε / 2 : add_le_add gint le_rfl
  ... = ∫⁻ x, g x ∂μ + ε : by rw [add_assoc, ennreal.add_halves]
end

/-- Given an integrable function `f` with values in `ℝ≥0`, there exists an upper semicontinuous
function `g ≤ f` with integral arbitrarily close to that of `f`. Formulation in terms of
`integral`.
Auxiliary lemma for Vitali-Carathéodory theorem `exists_lt_lower_semicontinuous_integral_lt`. -/

/-! ### Vitali-Carathéodory theorem -/

/-- **Vitali-Carathéodory Theorem**: given an integrable real function `f`, there exists an
integrable function `g > f` which is lower semicontinuous, with integral arbitrarily close
to that of `f`. This function has to be `ereal`-valued in general. -/
lemma exists_lt_lower_semicontinuous_integral_lt [sigma_finite μ]
  (f : α → ℝ) (hf : integrable f μ) {ε : ℝ} (εpos : 0 < ε) :
  ∃ g : α → ereal, (∀ x, (f x : ereal) < g x) ∧ lower_semicontinuous g ∧
  (integrable (λ x, ereal.to_real (g x)) μ) ∧ (∀ᵐ x ∂ μ, g x < ⊤) ∧
  (∫ x, ereal.to_real (g x) ∂μ < ∫ x, f x ∂μ + ε) :=
begin
  let δ : ℝ≥0 := ⟨ε/2, (half_pos εpos).le⟩,
  have δpos : 0 < δ := half_pos εpos,
  let fp : α → ℝ≥0 := λ x, real.to_nnreal (f x),
  have int_fp : integrable (λ x, (fp x : ℝ)) μ := hf.real_to_nnreal,
  rcases exists_lt_lower_semicontinuous_integral_gt_nnreal fp int_fp δpos
    with ⟨gp, fp_lt_gp, gpcont, gp_lt_top, gp_integrable, gpint⟩,
  let fm : α → ℝ≥0 := λ x, real.to_nnreal (-f x),
  have int_fm : integrable (λ x, (fm x : ℝ)) μ := hf.neg.real_to_nnreal,
  rcases exists_upper_semicontinuous_le_integral_le fm int_fm δpos
    with ⟨gm, gm_le_fm, gmcont, gm_integrable, gmint⟩,
  let g : α → ereal := λ x, (gp x : ereal) - (gm x),
  have ae_g : ∀ᵐ x ∂ μ, (g x).to_real = (gp x : ereal).to_real - (gm x : ereal).to_real,
  { filter_upwards [gp_lt_top] with _ hx,
    rw ereal.to_real_sub;
    simp [hx.ne], },
  refine ⟨g, _, _, _, _, _⟩,
  show integrable (λ x, ereal.to_real (g x)) μ,
  { rw integrable_congr ae_g,
    convert gp_integrable.sub gm_integrable,
    ext x,
    simp },
  show ∫ (x : α), (g x).to_real ∂μ < ∫ (x : α), f x ∂μ + ε, from calc
    ∫ (x : α), (g x).to_real ∂μ = ∫ (x : α), ereal.to_real (gp x) - ereal.to_real (gm x) ∂μ :
      integral_congr_ae ae_g
    ... = ∫ (x : α), ereal.to_real (gp x) ∂ μ - ∫ (x : α), gm x ∂μ :
      begin
        simp only [ereal.to_real_coe_ennreal, ennreal.coe_to_real, coe_coe],
        exact integral_sub gp_integrable gm_integrable,
      end
    ... < ∫ (x : α), ↑(fp x) ∂μ + ↑δ - ∫ (x : α), gm x ∂μ :
      begin
        apply sub_lt_sub_right,
        convert gpint,
        simp only [ereal.to_real_coe_ennreal],
      end
    ... ≤ ∫ (x : α), ↑(fp x) ∂μ + ↑δ - (∫ (x : α), fm x ∂μ - δ) :
      sub_le_sub_left gmint _
    ... = ∫ (x : α), f x ∂μ + 2 * δ :
      by { simp_rw [integral_eq_integral_pos_part_sub_integral_neg_part hf, fp, fm], ring }
    ... = ∫ (x : α), f x ∂μ + ε :
      by { congr' 1, field_simp [δ, mul_comm] },
  show ∀ᵐ (x : α) ∂μ, g x < ⊤,
  { filter_upwards [gp_lt_top] with _ hx,
    simp only [g, sub_eq_add_neg, coe_coe, ne.def, (ereal.add_lt_top _ _).ne, lt_top_iff_ne_top,
      lt_top_iff_ne_top.1 hx, ereal.coe_ennreal_eq_top_iff, not_false_iff, ereal.neg_eq_top_iff,
      ereal.coe_ennreal_ne_bot] },
  show ∀ x, (f x : ereal) < g x,
  { assume x,
    rw ereal.coe_real_ereal_eq_coe_to_nnreal_sub_coe_to_nnreal (f x),
    refine ereal.sub_lt_sub_of_lt_of_le _ _ _ _,
    { simp only [ereal.coe_ennreal_lt_coe_ennreal_iff, coe_coe], exact (fp_lt_gp x) },
    { simp only [ennreal.coe_le_coe, ereal.coe_ennreal_le_coe_ennreal_iff, coe_coe],
      exact (gm_le_fm x) },
    { simp only [ereal.coe_ennreal_ne_bot, ne.def, not_false_iff, coe_coe] },
    { simp only [ereal.coe_nnreal_ne_top, ne.def, not_false_iff, coe_coe] } },
  show lower_semicontinuous g,
  { apply lower_semicontinuous.add',
    { exact continuous_coe_ennreal_ereal.comp_lower_semicontinuous gpcont
        (λ x y hxy, ereal.coe_ennreal_le_coe_ennreal_iff.2 hxy) },
    { apply ereal.continuous_neg.comp_upper_semicontinuous_antitone _
        (λ x y hxy, ereal.neg_le_neg_iff.2 hxy),
      dsimp,
      apply continuous_coe_ennreal_ereal.comp_upper_semicontinuous _
        (λ x y hxy, ereal.coe_ennreal_le_coe_ennreal_iff.2 hxy),
      exact ennreal.continuous_coe.comp_upper_semicontinuous gmcont
        (λ x y hxy, ennreal.coe_le_coe.2 hxy) },
    { assume x,
      exact ereal.continuous_at_add (by simp) (by simp) } }
end

/-- **Vitali-Carathéodory Theorem**: given an integrable real function `f`, there exists an
integrable function `g < f` which is upper semicontinuous, with integral arbitrarily close to that
of `f`. This function has to be `ereal`-valued in general. -/
lemma exists_upper_semicontinuous_lt_integral_gt [sigma_finite μ]
  (f : α → ℝ) (hf : integrable f μ) {ε : ℝ} (εpos : 0 < ε) :
  ∃ g : α → ereal, (∀ x, (g x : ereal) < f x) ∧ upper_semicontinuous g ∧
  (integrable (λ x, ereal.to_real (g x)) μ) ∧ (∀ᵐ x ∂μ, ⊥ < g x) ∧
  (∫ x, f x ∂μ < ∫ x, ereal.to_real (g x) ∂μ + ε) :=
begin
  rcases exists_lt_lower_semicontinuous_integral_lt (λ x, - f x) hf.neg εpos
    with ⟨g, g_lt_f, gcont, g_integrable, g_lt_top, gint⟩,
  refine ⟨λ x, - g x, _, _, _, _, _⟩,
  { exact  λ x, ereal.neg_lt_iff_neg_lt.1 (by simpa only [ereal.coe_neg] using g_lt_f x) },
  { exact ereal.continuous_neg.comp_lower_semicontinuous_antitone gcont
      (λ x y hxy, ereal.neg_le_neg_iff.2 hxy) },
  { convert g_integrable.neg,
    ext x,
    simp },
  { simpa [bot_lt_iff_ne_bot, lt_top_iff_ne_top] using g_lt_top },
  { simp_rw [integral_neg, lt_neg_add_iff_add_lt] at gint,
    rw add_comm at gint,
    simpa [integral_neg] using gint }
end

end measure_theory


/-
Copyright (c) 2018 Robert Y. Lewis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Robert Y. Lewis

! This file was ported from Lean 3 source module number_theory.padics.hensel
! leanprover-community/mathlib commit f2ce6086713c78a7f880485f7917ea547a215982
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.SpecificLimits.Basic
import Mathbin.Data.Polynomial.Identities
import Mathbin.NumberTheory.Padics.PadicIntegers
import Mathbin.Topology.Algebra.Polynomial
import Mathbin.Topology.MetricSpace.CauSeqFilter

/-!
# Hensel's lemma on ℤ_p

This file proves Hensel's lemma on ℤ_p, roughly following Keith Conrad's writeup:
<http://www.math.uconn.edu/~kconrad/blurbs/gradnumthy/hensel.pdf>

Hensel's lemma gives a simple condition for the existence of a root of a polynomial.

The proof and motivation are described in the paper
[R. Y. Lewis, *A formal proof of Hensel's lemma over the p-adic integers*][lewis2019].

## References

* <http://www.math.uconn.edu/~kconrad/blurbs/gradnumthy/hensel.pdf>
* [R. Y. Lewis, *A formal proof of Hensel's lemma over the p-adic integers*][lewis2019]
* <https://en.wikipedia.org/wiki/Hensel%27s_lemma>

## Tags

p-adic, p adic, padic, p-adic integer
-/

noncomputable section

open Classical Topology

-- We begin with some general lemmas that are used below in the computation.
theorem padic_polynomial_dist {p : ℕ} [Fact p.Prime] (F : Polynomial ℤ_[p]) (x y : ℤ_[p]) :
    ‖F.eval x - F.eval y‖ ≤ ‖x - y‖ :=
  let ⟨z, hz⟩ := F.evalSubFactor x y
  calc
    ‖F.eval x - F.eval y‖ = ‖z‖ * ‖x - y‖ := by simp [hz]
    _ ≤ 1 * ‖x - y‖ := (mul_le_mul_of_nonneg_right (PadicInt.norm_le_one _) (norm_nonneg _))
    _ = ‖x - y‖ := by simp

#align padic_polynomial_dist padic_polynomial_dist

open Filter Metric

private theorem comp_tendsto_lim {p : ℕ} [Fact p.Prime] {F : Polynomial ℤ_[p]}
    (ncs : CauSeq ℤ_[p] norm) : Tendsto (fun i => F.eval (ncs i)) atTop (𝓝 (F.eval ncs.limUnder)) :=
  F.ContinuousAt.Tendsto.comp ncs.tendsto_limit
#align comp_tendsto_lim comp_tendsto_lim

section

parameter
  {p :
    ℕ}[Fact
      p.Prime]{ncs :
    CauSeq ℤ_[p]
      norm}{F :
    Polynomial
      ℤ_[p]}{a : ℤ_[p]}(ncs_der_val : ∀ n, ‖F.derivative.eval (ncs n)‖ = ‖F.derivative.eval a‖)

include ncs_der_val

private theorem ncs_tendsto_const :
    Tendsto (fun i => ‖F.derivative.eval (ncs i)‖) atTop (𝓝 ‖F.derivative.eval a‖) := by
  convert tendsto_const_nhds <;> ext <;> rw [ncs_der_val]
#align ncs_tendsto_const ncs_tendsto_const

private theorem ncs_tendsto_lim :
    Tendsto (fun i => ‖F.derivative.eval (ncs i)‖) atTop (𝓝 ‖F.derivative.eval ncs.limUnder‖) :=
  Tendsto.comp (continuous_iff_continuousAt.1 continuous_norm _) (comp_tendsto_lim _)
#align ncs_tendsto_lim ncs_tendsto_lim

private theorem norm_deriv_eq : ‖F.derivative.eval ncs.limUnder‖ = ‖F.derivative.eval a‖ :=
  tendsto_nhds_unique ncs_tendsto_lim ncs_tendsto_const
#align norm_deriv_eq norm_deriv_eq

end

section

parameter
  {p :
    ℕ}[Fact
      p.Prime]{ncs :
    CauSeq ℤ_[p]
      norm}{F : Polynomial ℤ_[p]}(hnorm : Tendsto (fun i => ‖F.eval (ncs i)‖) atTop (𝓝 0))

include hnorm

private theorem tendsto_zero_of_norm_tendsto_zero : Tendsto (fun i => F.eval (ncs i)) atTop (𝓝 0) :=
  tendsto_iff_norm_tendsto_zero.2 (by simpa using hnorm)
#align tendsto_zero_of_norm_tendsto_zero tendsto_zero_of_norm_tendsto_zero

theorem limit_zero_of_norm_tendsto_zero : F.eval ncs.limUnder = 0 :=
  tendsto_nhds_unique (comp_tendsto_lim _) tendsto_zero_of_norm_tendsto_zero
#align limit_zero_of_norm_tendsto_zero limit_zero_of_norm_tendsto_zero

end

section Hensel

open Nat

parameter
  {p :
    ℕ}[Fact
      p.Prime]{F :
    Polynomial
      ℤ_[p]}{a : ℤ_[p]}(hnorm : ‖F.eval a‖ < ‖F.derivative.eval a‖ ^ 2)(hnsol : F.eval a ≠ 0)

include hnorm

/-- `T` is an auxiliary value that is used to control the behavior of the polynomial `F`. -/
private def T : ℝ :=
  ‖(F.eval a / F.derivative.eval a ^ 2 : ℚ_[p])‖
#align T T

private theorem deriv_sq_norm_pos : 0 < ‖F.derivative.eval a‖ ^ 2 :=
  lt_of_le_of_lt (norm_nonneg _) hnorm
#align deriv_sq_norm_pos deriv_sq_norm_pos

private theorem deriv_sq_norm_ne_zero : ‖F.derivative.eval a‖ ^ 2 ≠ 0 :=
  ne_of_gt deriv_sq_norm_pos
#align deriv_sq_norm_ne_zero deriv_sq_norm_ne_zero

private theorem deriv_norm_ne_zero : ‖F.derivative.eval a‖ ≠ 0 := fun h =>
  deriv_sq_norm_ne_zero (by simp [*, sq])
#align deriv_norm_ne_zero deriv_norm_ne_zero

private theorem deriv_norm_pos : 0 < ‖F.derivative.eval a‖ :=
  lt_of_le_of_ne (norm_nonneg _) (Ne.symm deriv_norm_ne_zero)
#align deriv_norm_pos deriv_norm_pos

private theorem deriv_ne_zero : F.derivative.eval a ≠ 0 :=
  mt norm_eq_zero.2 deriv_norm_ne_zero
#align deriv_ne_zero deriv_ne_zero

private theorem T_def : T = ‖F.eval a‖ / ‖F.derivative.eval a‖ ^ 2 := by
  simp [T, ← PadicInt.norm_def]
#align T_def T_def

private theorem T_lt_one : T < 1 :=
  by
  let h := (div_lt_one deriv_sq_norm_pos).2 hnorm
  rw [T_def] <;> apply h
#align T_lt_one T_lt_one

private theorem T_nonneg : 0 ≤ T :=
  norm_nonneg _
#align T_nonneg T_nonneg

private theorem T_pow_nonneg (n : ℕ) : 0 ≤ T ^ n :=
  pow_nonneg T_nonneg _
#align T_pow_nonneg T_pow_nonneg

private theorem T_pow {n : ℕ} (hn : n ≠ 0) : T ^ n < 1 :=
  pow_lt_one T_nonneg T_lt_one hn
#align T_pow T_pow

private theorem T_pow' (n : ℕ) : T ^ 2 ^ n < 1 :=
  T_pow (pow_ne_zero _ two_ne_zero)
#align T_pow' T_pow'

/-- We will construct a sequence of elements of ℤ_p satisfying successive values of `ih`. -/
private def ih (n : ℕ) (z : ℤ_[p]) : Prop :=
  ‖F.derivative.eval z‖ = ‖F.derivative.eval a‖ ∧ ‖F.eval z‖ ≤ ‖F.derivative.eval a‖ ^ 2 * T ^ 2 ^ n
#align ih ih

private theorem ih_0 : ih 0 a :=
  ⟨rfl, by simp [T_def, mul_div_cancel' _ (ne_of_gt (deriv_sq_norm_pos hnorm))]⟩
#align ih_0 ih_0

private theorem calc_norm_le_one {n : ℕ} {z : ℤ_[p]} (hz : ih n z) :
    ‖(↑(F.eval z) : ℚ_[p]) / ↑(F.derivative.eval z)‖ ≤ 1 :=
  calc
    ‖(↑(F.eval z) : ℚ_[p]) / ↑(F.derivative.eval z)‖ =
        ‖(↑(F.eval z) : ℚ_[p])‖ / ‖(↑(F.derivative.eval z) : ℚ_[p])‖ :=
      norm_div _ _
    _ = ‖F.eval z‖ / ‖F.derivative.eval a‖ := by simp [hz.1]
    _ ≤ ‖F.derivative.eval a‖ ^ 2 * T ^ 2 ^ n / ‖F.derivative.eval a‖ :=
      ((div_le_div_right deriv_norm_pos).2 hz.2)
    _ = ‖F.derivative.eval a‖ * T ^ 2 ^ n := (div_sq_cancel _ _)
    _ ≤ 1 := mul_le_one (PadicInt.norm_le_one _) (T_pow_nonneg _) (le_of_lt (T_pow' _))

#align calc_norm_le_one calc_norm_le_one

private theorem calc_deriv_dist {z z' z1 : ℤ_[p]} (hz' : z' = z - z1)
    (hz1 : ‖z1‖ = ‖F.eval z‖ / ‖F.derivative.eval a‖) {n} (hz : ih n z) :
    ‖F.derivative.eval z' - F.derivative.eval z‖ < ‖F.derivative.eval a‖ :=
  calc
    ‖F.derivative.eval z' - F.derivative.eval z‖ ≤ ‖z' - z‖ := padic_polynomial_dist _ _ _
    _ = ‖z1‖ := by simp only [sub_eq_add_neg, add_assoc, hz', add_add_neg_cancel'_right, norm_neg]
    _ = ‖F.eval z‖ / ‖F.derivative.eval a‖ := hz1
    _ ≤ ‖F.derivative.eval a‖ ^ 2 * T ^ 2 ^ n / ‖F.derivative.eval a‖ :=
      ((div_le_div_right deriv_norm_pos).2 hz.2)
    _ = ‖F.derivative.eval a‖ * T ^ 2 ^ n := (div_sq_cancel _ _)
    _ < ‖F.derivative.eval a‖ := (mul_lt_iff_lt_one_right deriv_norm_pos).2 (T_pow' _)

#align calc_deriv_dist calc_deriv_dist

private def calc_eval_z' {z z' z1 : ℤ_[p]} (hz' : z' = z - z1) {n} (hz : ih n z)
    (h1 : ‖(↑(F.eval z) : ℚ_[p]) / ↑(F.derivative.eval z)‖ ≤ 1) (hzeq : z1 = ⟨_, h1⟩) :
    { q : ℤ_[p] // F.eval z' = q * z1 ^ 2 } :=
  by
  have hdzne : F.derivative.eval z ≠ 0 :=
    mt norm_eq_zero.2 (by rw [hz.1] <;> apply deriv_norm_ne_zero <;> assumption)
  have hdzne' : (↑(F.derivative.eval z) : ℚ_[p]) ≠ 0 := fun h => hdzne (Subtype.ext_iff_val.2 h)
  obtain ⟨q, hq⟩ := F.binom_expansion z (-z1)
  have : ‖(↑(F.derivative.eval z) * (↑(F.eval z) / ↑(F.derivative.eval z)) : ℚ_[p])‖ ≤ 1 :=
    by
    rw [padicNormE.mul]
    exact mul_le_one (PadicInt.norm_le_one _) (norm_nonneg _) h1
  have : F.derivative.eval z * -z1 = -F.eval z := by
    calc
      F.derivative.eval z * -z1 =
          F.derivative.eval z * -⟨↑(F.eval z) / ↑(F.derivative.eval z), h1⟩ :=
        by rw [hzeq]
      _ = -(F.derivative.eval z * ⟨↑(F.eval z) / ↑(F.derivative.eval z), h1⟩) := (mul_neg _ _)
      _ = -⟨↑(F.derivative.eval z) * (↑(F.eval z) / ↑(F.derivative.eval z)), this⟩ :=
        (Subtype.ext <| by simp only [PadicInt.coe_neg, PadicInt.coe_mul, Subtype.coe_mk])
      _ = -F.eval z := by simp only [mul_div_cancel' _ hdzne', Subtype.coe_eta]

  exact ⟨q, by simpa only [sub_eq_add_neg, this, hz', add_right_neg, neg_sq, zero_add] using hq⟩
#align calc_eval_z' calc_eval_z'

private def calc_eval_z'_norm {z z' z1 : ℤ_[p]} {n} (hz : ih n z) {q} (heq : F.eval z' = q * z1 ^ 2)
    (h1 : ‖(↑(F.eval z) : ℚ_[p]) / ↑(F.derivative.eval z)‖ ≤ 1) (hzeq : z1 = ⟨_, h1⟩) :
    ‖F.eval z'‖ ≤ ‖F.derivative.eval a‖ ^ 2 * T ^ 2 ^ (n + 1) :=
  calc
    ‖F.eval z'‖ = ‖q‖ * ‖z1‖ ^ 2 := by simp [HEq]
    _ ≤ 1 * ‖z1‖ ^ 2 :=
      (mul_le_mul_of_nonneg_right (PadicInt.norm_le_one _) (pow_nonneg (norm_nonneg _) _))
    _ = ‖F.eval z‖ ^ 2 / ‖F.derivative.eval a‖ ^ 2 := by simp [hzeq, hz.1, div_pow]
    _ ≤ (‖F.derivative.eval a‖ ^ 2 * T ^ 2 ^ n) ^ 2 / ‖F.derivative.eval a‖ ^ 2 :=
      ((div_le_div_right deriv_sq_norm_pos).2 (pow_le_pow_of_le_left (norm_nonneg _) hz.2 _))
    _ = (‖F.derivative.eval a‖ ^ 2) ^ 2 * (T ^ 2 ^ n) ^ 2 / ‖F.derivative.eval a‖ ^ 2 := by
      simp only [mul_pow]
    _ = ‖F.derivative.eval a‖ ^ 2 * (T ^ 2 ^ n) ^ 2 := (div_sq_cancel _ _)
    _ = ‖F.derivative.eval a‖ ^ 2 * T ^ 2 ^ (n + 1) := by rw [← pow_mul, pow_succ' 2]

#align calc_eval_z'_norm calc_eval_z'_norm

/- ./././Mathport/Syntax/Translate/Basic.lean:334:40: warning: unsupported option eqn_compiler.zeta -/
set_option eqn_compiler.zeta true

/-- Given `z : ℤ_[p]` satisfying `ih n z`, construct `z' : ℤ_[p]` satisfying `ih (n+1) z'`. We need
the hypothesis `ih n z`, since otherwise `z'` is not necessarily an integer. -/
private def ih_n {n : ℕ} {z : ℤ_[p]} (hz : ih n z) : { z' : ℤ_[p] // ih (n + 1) z' } :=
  have h1 : ‖(↑(F.eval z) : ℚ_[p]) / ↑(F.derivative.eval z)‖ ≤ 1 := calc_norm_le_one hz
  let z1 : ℤ_[p] := ⟨_, h1⟩
  let z' : ℤ_[p] := z - z1
  ⟨z',
    have hdist : ‖F.derivative.eval z' - F.derivative.eval z‖ < ‖F.derivative.eval a‖ :=
      calc_deriv_dist rfl (by simp [z1, hz.1]) hz
    have hfeq : ‖F.derivative.eval z'‖ = ‖F.derivative.eval a‖ :=
      by
      rw [sub_eq_add_neg, ← hz.1, ← norm_neg (F.derivative.eval z)] at hdist
      have := PadicInt.norm_eq_of_norm_add_lt_right hdist
      rwa [norm_neg, hz.1] at this
    let ⟨q, HEq⟩ := calc_eval_z' rfl hz h1 rfl
    have hnle : ‖F.eval z'‖ ≤ ‖F.derivative.eval a‖ ^ 2 * T ^ 2 ^ (n + 1) :=
      calc_eval_z'_norm hz HEq h1 rfl
    ⟨hfeq, hnle⟩⟩
#align ih_n ih_n

/- ./././Mathport/Syntax/Translate/Basic.lean:334:40: warning: unsupported option eqn_compiler.zeta -/
set_option eqn_compiler.zeta false

-- why doesn't "noncomputable theory" stick here?
private noncomputable def newton_seq_aux : ∀ n : ℕ, { z : ℤ_[p] // ih n z }
  | 0 => ⟨a, ih_0⟩
  | k + 1 => ih_n (newton_seq_aux k).2
#align newton_seq_aux newton_seq_aux

private def newton_seq (n : ℕ) : ℤ_[p] :=
  (newton_seq_aux n).1
#align newton_seq newton_seq

private theorem newton_seq_deriv_norm (n : ℕ) :
    ‖F.derivative.eval (newton_seq n)‖ = ‖F.derivative.eval a‖ :=
  (newton_seq_aux n).2.1
#align newton_seq_deriv_norm newton_seq_deriv_norm

private theorem newton_seq_norm_le (n : ℕ) :
    ‖F.eval (newton_seq n)‖ ≤ ‖F.derivative.eval a‖ ^ 2 * T ^ 2 ^ n :=
  (newton_seq_aux n).2.2
#align newton_seq_norm_le newton_seq_norm_le

private theorem newton_seq_norm_eq (n : ℕ) :
    ‖newton_seq (n + 1) - newton_seq n‖ =
      ‖F.eval (newton_seq n)‖ / ‖F.derivative.eval (newton_seq n)‖ :=
  by simp [newton_seq, newton_seq_aux, ih_n, sub_eq_add_neg, add_comm]
#align newton_seq_norm_eq newton_seq_norm_eq

private theorem newton_seq_succ_dist (n : ℕ) :
    ‖newton_seq (n + 1) - newton_seq n‖ ≤ ‖F.derivative.eval a‖ * T ^ 2 ^ n :=
  calc
    ‖newton_seq (n + 1) - newton_seq n‖ =
        ‖F.eval (newton_seq n)‖ / ‖F.derivative.eval (newton_seq n)‖ :=
      newton_seq_norm_eq _
    _ = ‖F.eval (newton_seq n)‖ / ‖F.derivative.eval a‖ := by rw [newton_seq_deriv_norm]
    _ ≤ ‖F.derivative.eval a‖ ^ 2 * T ^ 2 ^ n / ‖F.derivative.eval a‖ :=
      ((div_le_div_right deriv_norm_pos).2 (newton_seq_norm_le _))
    _ = ‖F.derivative.eval a‖ * T ^ 2 ^ n := div_sq_cancel _ _

#align newton_seq_succ_dist newton_seq_succ_dist

include hnsol

private theorem T_pos : T > 0 := by
  rw [T_def]
  exact div_pos (norm_pos_iff.2 hnsol) (deriv_sq_norm_pos hnorm)
#align T_pos T_pos

private theorem newton_seq_succ_dist_weak (n : ℕ) :
    ‖newton_seq (n + 2) - newton_seq (n + 1)‖ < ‖F.eval a‖ / ‖F.derivative.eval a‖ :=
  have : 2 ≤ 2 ^ (n + 1) :=
    by
    have := pow_le_pow (by norm_num : 1 ≤ 2) (Nat.le_add_left _ _ : 1 ≤ n + 1)
    simpa using this
  calc
    ‖newton_seq (n + 2) - newton_seq (n + 1)‖ ≤ ‖F.derivative.eval a‖ * T ^ 2 ^ (n + 1) :=
      newton_seq_succ_dist _
    _ ≤ ‖F.derivative.eval a‖ * T ^ 2 :=
      (mul_le_mul_of_nonneg_left (pow_le_pow_of_le_one (norm_nonneg _) (le_of_lt T_lt_one) this)
        (norm_nonneg _))
    _ < ‖F.derivative.eval a‖ * T ^ 1 :=
      (mul_lt_mul_of_pos_left (pow_lt_pow_of_lt_one T_pos T_lt_one (by norm_num)) deriv_norm_pos)
    _ = ‖F.eval a‖ / ‖F.derivative.eval a‖ :=
      by
      rw [T, sq, pow_one, norm_div, ← mul_div_assoc, padicNormE.mul]
      apply mul_div_mul_left
      apply deriv_norm_ne_zero <;> assumption

#align newton_seq_succ_dist_weak newton_seq_succ_dist_weak

private theorem newton_seq_dist_aux (n : ℕ) :
    ∀ k : ℕ, ‖newton_seq (n + k) - newton_seq n‖ ≤ ‖F.derivative.eval a‖ * T ^ 2 ^ n
  | 0 => by simp [T_pow_nonneg hnorm, mul_nonneg]
  | k + 1 =>
    have : 2 ^ n ≤ 2 ^ (n + k) := by
      apply pow_le_pow
      norm_num
      apply Nat.le_add_right
    calc
      ‖newton_seq (n + (k + 1)) - newton_seq n‖ = ‖newton_seq (n + k + 1) - newton_seq n‖ := by
        rw [add_assoc]
      _ = ‖newton_seq (n + k + 1) - newton_seq (n + k) + (newton_seq (n + k) - newton_seq n)‖ := by
        rw [← sub_add_sub_cancel]
      _ ≤ max ‖newton_seq (n + k + 1) - newton_seq (n + k)‖ ‖newton_seq (n + k) - newton_seq n‖ :=
        (PadicInt.nonarchimedean _ _)
      _ ≤ max (‖F.derivative.eval a‖ * T ^ 2 ^ (n + k)) (‖F.derivative.eval a‖ * T ^ 2 ^ n) :=
        (max_le_max (newton_seq_succ_dist _) (newton_seq_dist_aux _))
      _ = ‖F.derivative.eval a‖ * T ^ 2 ^ n :=
        max_eq_right <|
          mul_le_mul_of_nonneg_left (pow_le_pow_of_le_one (norm_nonneg _) (le_of_lt T_lt_one) this)
            (norm_nonneg _)

#align newton_seq_dist_aux newton_seq_dist_aux

private theorem newton_seq_dist {n k : ℕ} (hnk : n ≤ k) :
    ‖newton_seq k - newton_seq n‖ ≤ ‖F.derivative.eval a‖ * T ^ 2 ^ n :=
  by
  have hex : ∃ m, k = n + m := exists_eq_add_of_le hnk
  let ⟨_, hex'⟩ := hex
  rw [hex'] <;> apply newton_seq_dist_aux <;> assumption
#align newton_seq_dist newton_seq_dist

private theorem newton_seq_dist_to_a :
    ∀ n : ℕ, 0 < n → ‖newton_seq n - a‖ = ‖F.eval a‖ / ‖F.derivative.eval a‖
  | 1, h => by simp [sub_eq_add_neg, add_assoc, newton_seq, newton_seq_aux, ih_n]
  | k + 2, h =>
    have hlt : ‖newton_seq (k + 2) - newton_seq (k + 1)‖ < ‖newton_seq (k + 1) - a‖ := by
      rw [newton_seq_dist_to_a (k + 1) (succ_pos _)] <;> apply newton_seq_succ_dist_weak <;>
        assumption
    have hne' : ‖newton_seq (k + 2) - newton_seq (k + 1)‖ ≠ ‖newton_seq (k + 1) - a‖ := ne_of_lt hlt
    calc
      ‖newton_seq (k + 2) - a‖ =
          ‖newton_seq (k + 2) - newton_seq (k + 1) + (newton_seq (k + 1) - a)‖ :=
        by rw [← sub_add_sub_cancel]
      _ = max ‖newton_seq (k + 2) - newton_seq (k + 1)‖ ‖newton_seq (k + 1) - a‖ :=
        (PadicInt.norm_add_eq_max_of_ne hne')
      _ = ‖newton_seq (k + 1) - a‖ := (max_eq_right_of_lt hlt)
      _ = ‖Polynomial.eval a F‖ / ‖Polynomial.eval a (Polynomial.derivative F)‖ :=
        newton_seq_dist_to_a (k + 1) (succ_pos _)

#align newton_seq_dist_to_a newton_seq_dist_to_a

private theorem bound' : Tendsto (fun n : ℕ => ‖F.derivative.eval a‖ * T ^ 2 ^ n) atTop (𝓝 0) :=
  by
  rw [← MulZeroClass.mul_zero ‖F.derivative.eval a‖]
  exact
    tendsto_const_nhds.mul
      (tendsto.comp (tendsto_pow_atTop_nhds_0_of_lt_1 (norm_nonneg _) (T_lt_one hnorm))
        (Nat.tendsto_pow_atTop_atTop_of_one_lt (by norm_num)))
#align bound' bound'

private theorem bound :
    ∀ {ε}, ε > 0 → ∃ N : ℕ, ∀ {n}, n ≥ N → ‖F.derivative.eval a‖ * T ^ 2 ^ n < ε :=
  by
  have := bound' hnorm hnsol
  simp [tendsto, nhds] at this
  intro ε hε
  cases' this (ball 0 ε) (mem_ball_self hε) is_open_ball with N hN
  exists N; intro n hn
  simpa [abs_of_nonneg (T_nonneg _)] using hN _ hn
#align bound bound

private theorem bound'_sq :
    Tendsto (fun n : ℕ => ‖F.derivative.eval a‖ ^ 2 * T ^ 2 ^ n) atTop (𝓝 0) :=
  by
  rw [← MulZeroClass.mul_zero ‖F.derivative.eval a‖, sq]
  simp only [mul_assoc]
  apply tendsto.mul
  · apply tendsto_const_nhds
  · apply bound'
    assumption
#align bound'_sq bound'_sq

private theorem newton_seq_is_cauchy : IsCauSeq norm newton_seq :=
  by
  intro ε hε
  cases' bound hnorm hnsol hε with N hN
  exists N
  intro j hj
  apply lt_of_le_of_lt
  · apply newton_seq_dist _ _ hj
    assumption
  · apply hN
    exact le_rfl
#align newton_seq_is_cauchy newton_seq_is_cauchy

private def newton_cau_seq : CauSeq ℤ_[p] norm :=
  ⟨_, newton_seq_is_cauchy⟩
#align newton_cau_seq newton_cau_seq

private def soln : ℤ_[p] :=
  newton_cau_seq.limUnder
#align soln soln

private theorem soln_spec {ε : ℝ} (hε : ε > 0) :
    ∃ N : ℕ, ∀ {i : ℕ}, i ≥ N → ‖soln - newton_cau_seq i‖ < ε :=
  Setoid.symm (CauSeq.equiv_lim newton_cau_seq) _ hε
#align soln_spec soln_spec

private theorem soln_deriv_norm : ‖F.derivative.eval soln‖ = ‖F.derivative.eval a‖ :=
  norm_deriv_eq newton_seq_deriv_norm
#align soln_deriv_norm soln_deriv_norm

private theorem newton_seq_norm_tendsto_zero :
    Tendsto (fun i => ‖F.eval (newton_cau_seq i)‖) atTop (𝓝 0) :=
  squeeze_zero (fun _ => norm_nonneg _) newton_seq_norm_le bound'_sq
#align newton_seq_norm_tendsto_zero newton_seq_norm_tendsto_zero

private theorem newton_seq_dist_tendsto :
    Tendsto (fun n => ‖newton_cau_seq n - a‖) atTop (𝓝 (‖F.eval a‖ / ‖F.derivative.eval a‖)) :=
  tendsto_const_nhds.congr' <| eventually_atTop.2 ⟨1, fun _ hx => (newton_seq_dist_to_a _ hx).symm⟩
#align newton_seq_dist_tendsto newton_seq_dist_tendsto

private theorem newton_seq_dist_tendsto' :
    Tendsto (fun n => ‖newton_cau_seq n - a‖) atTop (𝓝 ‖soln - a‖) :=
  (continuous_norm.Tendsto _).comp (newton_cau_seq.tendsto_limit.sub tendsto_const_nhds)
#align newton_seq_dist_tendsto' newton_seq_dist_tendsto'

private theorem soln_dist_to_a : ‖soln - a‖ = ‖F.eval a‖ / ‖F.derivative.eval a‖ :=
  tendsto_nhds_unique newton_seq_dist_tendsto' newton_seq_dist_tendsto
#align soln_dist_to_a soln_dist_to_a

private theorem soln_dist_to_a_lt_deriv : ‖soln - a‖ < ‖F.derivative.eval a‖ :=
  by
  rw [soln_dist_to_a, div_lt_iff]
  · rwa [sq] at hnorm
  · apply deriv_norm_pos
    assumption
#align soln_dist_to_a_lt_deriv soln_dist_to_a_lt_deriv

private theorem eval_soln : F.eval soln = 0 :=
  limit_zero_of_norm_tendsto_zero newton_seq_norm_tendsto_zero
#align eval_soln eval_soln

private theorem soln_unique (z : ℤ_[p]) (hev : F.eval z = 0)
    (hnlt : ‖z - a‖ < ‖F.derivative.eval a‖) : z = soln :=
  have soln_dist : ‖z - soln‖ < ‖F.derivative.eval a‖ :=
    calc
      ‖z - soln‖ = ‖z - a + (a - soln)‖ := by rw [sub_add_sub_cancel]
      _ ≤ max ‖z - a‖ ‖a - soln‖ := (PadicInt.nonarchimedean _ _)
      _ < ‖F.derivative.eval a‖ := max_lt hnlt (norm_sub_rev soln a ▸ soln_dist_to_a_lt_deriv)

  let h := z - soln
  let ⟨q, hq⟩ := F.binomExpansion soln h
  have : (F.derivative.eval soln + q * h) * h = 0 :=
    Eq.symm
      (calc
        0 = F.eval (soln + h) := by simp [hev, h]
        _ = F.derivative.eval soln * h + q * h ^ 2 := by rw [hq, eval_soln, zero_add]
        _ = (F.derivative.eval soln + q * h) * h := by rw [sq, right_distrib, mul_assoc]
        )
  have : h = 0 :=
    by_contradiction fun hne =>
      have : F.derivative.eval soln + q * h = 0 :=
        (eq_zero_or_eq_zero_of_mul_eq_zero this).resolve_right hne
      have : F.derivative.eval soln = -q * h := by simpa using eq_neg_of_add_eq_zero_left this
      lt_irrefl ‖F.derivative.eval soln‖
        (calc
          ‖F.derivative.eval soln‖ = ‖-q * h‖ := by rw [this]
          _ ≤ 1 * ‖h‖ := by
            rw [PadicInt.norm_mul]
            exact mul_le_mul_of_nonneg_right (PadicInt.norm_le_one _) (norm_nonneg _)
          _ = ‖z - soln‖ := by simp [h]
          _ < ‖F.derivative.eval soln‖ := by rw [soln_deriv_norm] <;> apply soln_dist
          )
  eq_of_sub_eq_zero (by rw [← this] <;> rfl)
#align soln_unique soln_unique

end Hensel

variable {p : ℕ} [Fact p.Prime] {F : Polynomial ℤ_[p]} {a : ℤ_[p]}

private theorem a_soln_is_unique (ha : F.eval a = 0) (z' : ℤ_[p]) (hz' : F.eval z' = 0)
    (hnormz' : ‖z' - a‖ < ‖F.derivative.eval a‖) : z' = a :=
  let h := z' - a
  let ⟨q, hq⟩ := F.binomExpansion a h
  have : (F.derivative.eval a + q * h) * h = 0 :=
    Eq.symm
      (calc
        0 = F.eval (a + h) := show 0 = F.eval (a + (z' - a)) by rw [add_comm] <;> simp [hz']
        _ = F.derivative.eval a * h + q * h ^ 2 := by rw [hq, ha, zero_add]
        _ = (F.derivative.eval a + q * h) * h := by rw [sq, right_distrib, mul_assoc]
        )
  have : h = 0 :=
    by_contradiction fun hne =>
      have : F.derivative.eval a + q * h = 0 :=
        (eq_zero_or_eq_zero_of_mul_eq_zero this).resolve_right hne
      have : F.derivative.eval a = -q * h := by simpa using eq_neg_of_add_eq_zero_left this
      lt_irrefl ‖F.derivative.eval a‖
        (calc
          ‖F.derivative.eval a‖ = ‖q‖ * ‖h‖ := by simp [this]
          _ ≤ 1 * ‖h‖ := (mul_le_mul_of_nonneg_right (PadicInt.norm_le_one _) (norm_nonneg _))
          _ < ‖F.derivative.eval a‖ := by simpa [h]
          )
  eq_of_sub_eq_zero (by rw [← this] <;> rfl)
#align a_soln_is_unique a_soln_is_unique

variable (hnorm : ‖F.eval a‖ < ‖F.derivative.eval a‖ ^ 2)

include hnorm

private theorem a_is_soln (ha : F.eval a = 0) :
    F.eval a = 0 ∧
      ‖a - a‖ < ‖F.derivative.eval a‖ ∧
        ‖F.derivative.eval a‖ = ‖F.derivative.eval a‖ ∧
          ∀ z', F.eval z' = 0 → ‖z' - a‖ < ‖F.derivative.eval a‖ → z' = a :=
  ⟨ha, by simp [deriv_ne_zero hnorm], rfl, a_soln_is_unique ha⟩
#align a_is_soln a_is_soln

theorem hensels_lemma :
    ∃ z : ℤ_[p],
      F.eval z = 0 ∧
        ‖z - a‖ < ‖F.derivative.eval a‖ ∧
          ‖F.derivative.eval z‖ = ‖F.derivative.eval a‖ ∧
            ∀ z', F.eval z' = 0 → ‖z' - a‖ < ‖F.derivative.eval a‖ → z' = z :=
  if ha : F.eval a = 0 then ⟨a, a_is_soln hnorm ha⟩
  else by
    refine'
        ⟨soln _ _, eval_soln _ _, soln_dist_to_a_lt_deriv _ _, soln_deriv_norm _ _,
          soln_unique _ _⟩ <;>
      assumption
#align hensels_lemma hensels_lemma


/-
Copyright (c) 2019 Reid Barton. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Patrick Massot, Sébastien Gouëzel, Zhouhang Zhou, Reid Barton

! This file was ported from Lean 3 source module topology.homeomorph
! leanprover-community/mathlib commit 3b267e70a936eebb21ab546f49a8df34dd300b25
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Logic.Equiv.Fin
import Mathlib.Topology.DenseEmbedding
import Mathlib.Topology.Support

/-!
# Homeomorphisms

This file defines homeomorphisms between two topological spaces. They are bijections with both
directions continuous. We denote homeomorphisms with the notation `≃ₜ`.

# Main definitions

* `Homeomorph α β`: The type of homeomorphisms from `α` to `β`.
  This type can be denoted using the following notation: `α ≃ₜ β`.

# Main results

* Pretty much every topological property is preserved under homeomorphisms.
* `Homeomorph.homeomorphOfContinuousOpen`: A continuous bijection that is
  an open map is a homeomorphism.

-/

open Set Filter

open Topology

variable {α : Type _} {β : Type _} {γ : Type _} {δ : Type _}

-- not all spaces are homeomorphic to each other
/-- Homeomorphism between `α` and `β`, also called topological isomorphism -/
structure Homeomorph (α : Type _) (β : Type _) [TopologicalSpace α] [TopologicalSpace β]
    extends α ≃ β where
  /-- The forward map of a homeomorphism is a continuous function. -/
  continuous_toFun : Continuous toFun := by continuity
  /-- The inverse map of a homeomorphism is a continuous function. -/
  continuous_invFun : Continuous invFun := by continuity
#align homeomorph Homeomorph

@[inherit_doc]
infixl:25 " ≃ₜ " => Homeomorph

namespace Homeomorph

variable [TopologicalSpace α] [TopologicalSpace β] [TopologicalSpace γ] [TopologicalSpace δ]

theorem toEquiv_injective : Function.Injective (toEquiv : α ≃ₜ β → α ≃ β)
  | ⟨_, _, _⟩, ⟨_, _, _⟩, rfl => rfl
#align homeomorph.to_equiv_injective Homeomorph.toEquiv_injective

instance : EquivLike (α ≃ₜ β) α β where
  coe := fun h => h.toEquiv
  inv := fun h => h.toEquiv.symm
  left_inv := fun h => h.left_inv
  right_inv := fun h => h.right_inv
  coe_injective' := fun _ _ H _ => toEquiv_injective <| FunLike.ext' H

instance : CoeFun (α ≃ₜ β) fun _ ↦ α → β := ⟨FunLike.coe⟩

@[simp]
theorem homeomorph_mk_coe (a : Equiv α β) (b c) : (Homeomorph.mk a b c : α → β) = a :=
  rfl
#align homeomorph.homeomorph_mk_coe Homeomorph.homeomorph_mk_coe

/-- Inverse of a homeomorphism. -/
protected def symm (h : α ≃ₜ β) : β ≃ₜ α where
  continuous_toFun := h.continuous_invFun
  continuous_invFun := h.continuous_toFun
  toEquiv := h.toEquiv.symm
#align homeomorph.symm Homeomorph.symm

@[simp] theorem symm_symm (h : α ≃ₜ β) : h.symm.symm = h := rfl
#align homeomorph.symm_symm Homeomorph.symm_symm

/-- See Note [custom simps projection] -/
def Simps.symm_apply (h : α ≃ₜ β) : β → α :=
  h.symm
#align homeomorph.simps.symm_apply Homeomorph.Simps.symm_apply

initialize_simps_projections Homeomorph (toFun → apply, invFun → symm_apply)

@[simp]
theorem coe_toEquiv (h : α ≃ₜ β) : ⇑h.toEquiv = h :=
  rfl
#align homeomorph.coe_to_equiv Homeomorph.coe_toEquiv

@[simp]
theorem coe_symm_toEquiv (h : α ≃ₜ β) : ⇑h.toEquiv.symm = h.symm :=
  rfl
#align homeomorph.coe_symm_to_equiv Homeomorph.coe_symm_toEquiv

@[ext]
theorem ext {h h' : α ≃ₜ β} (H : ∀ x, h x = h' x) : h = h' :=
  FunLike.ext _ _ H
#align homeomorph.ext Homeomorph.ext

/-- Identity map as a homeomorphism. -/
@[simps! (config := { fullyApplied := false }) apply]
protected def refl (α : Type _) [TopologicalSpace α] : α ≃ₜ α where
  continuous_toFun := continuous_id
  continuous_invFun := continuous_id
  toEquiv := Equiv.refl α
#align homeomorph.refl Homeomorph.refl

/-- Composition of two homeomorphisms. -/
protected def trans (h₁ : α ≃ₜ β) (h₂ : β ≃ₜ γ) : α ≃ₜ γ where
  continuous_toFun := h₂.continuous_toFun.comp h₁.continuous_toFun
  continuous_invFun := h₁.continuous_invFun.comp h₂.continuous_invFun
  toEquiv := Equiv.trans h₁.toEquiv h₂.toEquiv
#align homeomorph.trans Homeomorph.trans

@[simp]
theorem trans_apply (h₁ : α ≃ₜ β) (h₂ : β ≃ₜ γ) (a : α) : h₁.trans h₂ a = h₂ (h₁ a) :=
  rfl
#align homeomorph.trans_apply Homeomorph.trans_apply

@[simp]
theorem homeomorph_mk_coe_symm (a : Equiv α β) (b c) :
    ((Homeomorph.mk a b c).symm : β → α) = a.symm :=
  rfl
#align homeomorph.homeomorph_mk_coe_symm Homeomorph.homeomorph_mk_coe_symm

@[simp]
theorem refl_symm : (Homeomorph.refl α).symm = Homeomorph.refl α :=
  rfl
#align homeomorph.refl_symm Homeomorph.refl_symm

@[continuity]
protected theorem continuous (h : α ≃ₜ β) : Continuous h :=
  h.continuous_toFun
#align homeomorph.continuous Homeomorph.continuous

-- otherwise `by continuity` can't prove continuity of `h.to_equiv.symm`
@[continuity]
protected theorem continuous_symm (h : α ≃ₜ β) : Continuous h.symm :=
  h.continuous_invFun
#align homeomorph.continuous_symm Homeomorph.continuous_symm

@[simp]
theorem apply_symm_apply (h : α ≃ₜ β) (x : β) : h (h.symm x) = x :=
  h.toEquiv.apply_symm_apply x
#align homeomorph.apply_symm_apply Homeomorph.apply_symm_apply

@[simp]
theorem symm_apply_apply (h : α ≃ₜ β) (x : α) : h.symm (h x) = x :=
  h.toEquiv.symm_apply_apply x
#align homeomorph.symm_apply_apply Homeomorph.symm_apply_apply

@[simp]
theorem self_trans_symm (h : α ≃ₜ β) : h.trans h.symm = Homeomorph.refl α := by
  ext
  apply symm_apply_apply
#align homeomorph.self_trans_symm Homeomorph.self_trans_symm

@[simp]
theorem symm_trans_self (h : α ≃ₜ β) : h.symm.trans h = Homeomorph.refl β := by
  ext
  apply apply_symm_apply
#align homeomorph.symm_trans_self Homeomorph.symm_trans_self

protected theorem bijective (h : α ≃ₜ β) : Function.Bijective h :=
  h.toEquiv.bijective
#align homeomorph.bijective Homeomorph.bijective

protected theorem injective (h : α ≃ₜ β) : Function.Injective h :=
  h.toEquiv.injective
#align homeomorph.injective Homeomorph.injective

protected theorem surjective (h : α ≃ₜ β) : Function.Surjective h :=
  h.toEquiv.surjective
#align homeomorph.surjective Homeomorph.surjective

/-- Change the homeomorphism `f` to make the inverse function definitionally equal to `g`. -/
def changeInv (f : α ≃ₜ β) (g : β → α) (hg : Function.RightInverse g f) : α ≃ₜ β :=
  haveI : g = f.symm := (f.left_inv.eq_rightInverse hg).symm
  { toFun := f
    invFun := g
    left_inv := by convert f.left_inv
    right_inv := by convert f.right_inv using 1
    continuous_toFun := f.continuous
    continuous_invFun := by convert f.symm.continuous }
#align homeomorph.change_inv Homeomorph.changeInv

@[simp]
theorem symm_comp_self (h : α ≃ₜ β) : h.symm ∘ h = id :=
  funext h.symm_apply_apply
#align homeomorph.symm_comp_self Homeomorph.symm_comp_self

@[simp]
theorem self_comp_symm (h : α ≃ₜ β) : h ∘ h.symm = id :=
  funext h.apply_symm_apply
#align homeomorph.self_comp_symm Homeomorph.self_comp_symm

@[simp]
theorem range_coe (h : α ≃ₜ β) : range h = univ :=
  h.surjective.range_eq
#align homeomorph.range_coe Homeomorph.range_coe

theorem image_symm (h : α ≃ₜ β) : image h.symm = preimage h :=
  funext h.symm.toEquiv.image_eq_preimage
#align homeomorph.image_symm Homeomorph.image_symm

theorem preimage_symm (h : α ≃ₜ β) : preimage h.symm = image h :=
  (funext h.toEquiv.image_eq_preimage).symm
#align homeomorph.preimage_symm Homeomorph.preimage_symm

@[simp]
theorem image_preimage (h : α ≃ₜ β) (s : Set β) : h '' (h ⁻¹' s) = s :=
  h.toEquiv.image_preimage s
#align homeomorph.image_preimage Homeomorph.image_preimage

@[simp]
theorem preimage_image (h : α ≃ₜ β) (s : Set α) : h ⁻¹' (h '' s) = s :=
  h.toEquiv.preimage_image s
#align homeomorph.preimage_image Homeomorph.preimage_image

protected theorem inducing (h : α ≃ₜ β) : Inducing h :=
  inducing_of_inducing_compose h.continuous h.symm.continuous <| by
    simp only [symm_comp_self, inducing_id]
#align homeomorph.inducing Homeomorph.inducing

theorem induced_eq (h : α ≃ₜ β) : TopologicalSpace.induced h ‹_› = ‹_› :=
  h.inducing.1.symm
#align homeomorph.induced_eq Homeomorph.induced_eq

protected theorem quotientMap (h : α ≃ₜ β) : QuotientMap h :=
  QuotientMap.of_quotientMap_compose h.symm.continuous h.continuous <| by
    simp only [self_comp_symm, QuotientMap.id]
#align homeomorph.quotient_map Homeomorph.quotientMap

theorem coinduced_eq (h : α ≃ₜ β) : TopologicalSpace.coinduced h ‹_› = ‹_› :=
  h.quotientMap.2.symm
#align homeomorph.coinduced_eq Homeomorph.coinduced_eq

protected theorem embedding (h : α ≃ₜ β) : Embedding h :=
  ⟨h.inducing, h.injective⟩
#align homeomorph.embedding Homeomorph.embedding

/-- Homeomorphism given an embedding. -/
noncomputable def ofEmbedding (f : α → β) (hf : Embedding f) : α ≃ₜ Set.range f where
  continuous_toFun := hf.continuous.subtype_mk _
  continuous_invFun := hf.continuous_iff.2 <| by simp [continuous_subtype_val]
  toEquiv := Equiv.ofInjective f hf.inj
#align homeomorph.of_embedding Homeomorph.ofEmbedding

protected theorem secondCountableTopology [TopologicalSpace.SecondCountableTopology β]
    (h : α ≃ₜ β) : TopologicalSpace.SecondCountableTopology α :=
  h.inducing.secondCountableTopology
#align homeomorph.second_countable_topology Homeomorph.secondCountableTopology

theorem isCompact_image {s : Set α} (h : α ≃ₜ β) : IsCompact (h '' s) ↔ IsCompact s :=
  h.embedding.isCompact_iff_isCompact_image.symm
#align homeomorph.is_compact_image Homeomorph.isCompact_image

theorem isCompact_preimage {s : Set β} (h : α ≃ₜ β) : IsCompact (h ⁻¹' s) ↔ IsCompact s := by
  rw [← image_symm]; exact h.symm.isCompact_image
#align homeomorph.is_compact_preimage Homeomorph.isCompact_preimage

@[simp]
theorem comap_cocompact (h : α ≃ₜ β) : comap h (cocompact β) = cocompact α :=
  (comap_cocompact_le h.continuous).antisymm <|
    (hasBasis_cocompact.le_basis_iff (hasBasis_cocompact.comap h)).2 fun K hK =>
      ⟨h ⁻¹' K, h.isCompact_preimage.2 hK, Subset.rfl⟩
#align homeomorph.comap_cocompact Homeomorph.comap_cocompact

@[simp]
theorem map_cocompact (h : α ≃ₜ β) : map h (cocompact α) = cocompact β := by
  rw [← h.comap_cocompact, map_comap_of_surjective h.surjective]
#align homeomorph.map_cocompact Homeomorph.map_cocompact

protected theorem compactSpace [CompactSpace α] (h : α ≃ₜ β) : CompactSpace β where
  isCompact_univ := h.symm.isCompact_preimage.2 isCompact_univ
#align homeomorph.compact_space Homeomorph.compactSpace

protected theorem t0Space [T0Space α] (h : α ≃ₜ β) : T0Space β :=
  h.symm.embedding.t0Space
#align homeomorph.t0_space Homeomorph.t0Space

protected theorem t1Space [T1Space α] (h : α ≃ₜ β) : T1Space β :=
  h.symm.embedding.t1Space
#align homeomorph.t1_space Homeomorph.t1Space

protected theorem t2Space [T2Space α] (h : α ≃ₜ β) : T2Space β :=
  h.symm.embedding.t2Space
#align homeomorph.t2_space Homeomorph.t2Space

protected theorem t3Space [T3Space α] (h : α ≃ₜ β) : T3Space β :=
  h.symm.embedding.t3Space
#align homeomorph.t3_space Homeomorph.t3Space

protected theorem denseEmbedding (h : α ≃ₜ β) : DenseEmbedding h :=
  { h.embedding with dense := h.surjective.denseRange }
#align homeomorph.dense_embedding Homeomorph.denseEmbedding

@[simp]
theorem isOpen_preimage (h : α ≃ₜ β) {s : Set β} : IsOpen (h ⁻¹' s) ↔ IsOpen s :=
  h.quotientMap.isOpen_preimage
#align homeomorph.is_open_preimage Homeomorph.isOpen_preimage

@[simp]
theorem isOpen_image (h : α ≃ₜ β) {s : Set α} : IsOpen (h '' s) ↔ IsOpen s := by
  rw [← preimage_symm, isOpen_preimage]
#align homeomorph.is_open_image Homeomorph.isOpen_image

protected theorem isOpenMap (h : α ≃ₜ β) : IsOpenMap h := fun _ => h.isOpen_image.2
#align homeomorph.is_open_map Homeomorph.isOpenMap

@[simp]
theorem isClosed_preimage (h : α ≃ₜ β) {s : Set β} : IsClosed (h ⁻¹' s) ↔ IsClosed s := by
  simp only [← isOpen_compl_iff, ← preimage_compl, isOpen_preimage]
#align homeomorph.is_closed_preimage Homeomorph.isClosed_preimage

@[simp]
theorem isClosed_image (h : α ≃ₜ β) {s : Set α} : IsClosed (h '' s) ↔ IsClosed s := by
  rw [← preimage_symm, isClosed_preimage]
#align homeomorph.is_closed_image Homeomorph.isClosed_image

protected theorem isClosedMap (h : α ≃ₜ β) : IsClosedMap h := fun _ => h.isClosed_image.2
#align homeomorph.is_closed_map Homeomorph.isClosedMap

protected theorem openEmbedding (h : α ≃ₜ β) : OpenEmbedding h :=
  openEmbedding_of_embedding_open h.embedding h.isOpenMap
#align homeomorph.open_embedding Homeomorph.openEmbedding

protected theorem closedEmbedding (h : α ≃ₜ β) : ClosedEmbedding h :=
  closedEmbedding_of_embedding_closed h.embedding h.isClosedMap
#align homeomorph.closed_embedding Homeomorph.closedEmbedding

protected theorem normalSpace [NormalSpace α] (h : α ≃ₜ β) : NormalSpace β :=
  h.symm.closedEmbedding.normalSpace
#align homeomorph.normal_space Homeomorph.normalSpace

theorem preimage_closure (h : α ≃ₜ β) (s : Set β) : h ⁻¹' closure s = closure (h ⁻¹' s) :=
  h.isOpenMap.preimage_closure_eq_closure_preimage h.continuous _
#align homeomorph.preimage_closure Homeomorph.preimage_closure

theorem image_closure (h : α ≃ₜ β) (s : Set α) : h '' closure s = closure (h '' s) := by
  rw [← preimage_symm, preimage_closure]
#align homeomorph.image_closure Homeomorph.image_closure

theorem image_interior (h : α ≃ₜ β) (s : Set α) : h '' interior s = interior (h '' s) := by
  rw [← preimage_symm, preimage_interior]
#align homeomorph.image_interior Homeomorph.image_interior

theorem preimage_frontier (h : α ≃ₜ β) (s : Set β) : h ⁻¹' frontier s = frontier (h ⁻¹' s) :=
  h.isOpenMap.preimage_frontier_eq_frontier_preimage h.continuous _
#align homeomorph.preimage_frontier Homeomorph.preimage_frontier

theorem image_frontier (h : α ≃ₜ β) (s : Set α) : h '' frontier s = frontier (h '' s) := by
  rw [← preimage_symm, preimage_frontier]
#align homeomorph.image_frontier Homeomorph.image_frontier

@[to_additive]
theorem _root_.HasCompactMulSupport.comp_homeomorph {M} [One M] {f : β → M}
    (hf : HasCompactMulSupport f) (φ : α ≃ₜ β) : HasCompactMulSupport (f ∘ φ) :=
  hf.comp_closedEmbedding φ.closedEmbedding
#align has_compact_mul_support.comp_homeomorph HasCompactMulSupport.comp_homeomorph
#align has_compact_support.comp_homeomorph HasCompactSupport.comp_homeomorph

@[simp]
theorem map_nhds_eq (h : α ≃ₜ β) (x : α) : map h (𝓝 x) = 𝓝 (h x) :=
  h.embedding.map_nhds_of_mem _ (by simp)
#align homeomorph.map_nhds_eq Homeomorph.map_nhds_eq

theorem symm_map_nhds_eq (h : α ≃ₜ β) (x : α) : map h.symm (𝓝 (h x)) = 𝓝 x := by
  rw [h.symm.map_nhds_eq, h.symm_apply_apply]
#align homeomorph.symm_map_nhds_eq Homeomorph.symm_map_nhds_eq

theorem nhds_eq_comap (h : α ≃ₜ β) (x : α) : 𝓝 x = comap h (𝓝 (h x)) :=
  h.inducing.nhds_eq_comap x
#align homeomorph.nhds_eq_comap Homeomorph.nhds_eq_comap

@[simp]
theorem comap_nhds_eq (h : α ≃ₜ β) (y : β) : comap h (𝓝 y) = 𝓝 (h.symm y) := by
  rw [h.nhds_eq_comap, h.apply_symm_apply]
#align homeomorph.comap_nhds_eq Homeomorph.comap_nhds_eq

/-- If an bijective map `e : α ≃ β` is continuous and open, then it is a homeomorphism. -/
def homeomorphOfContinuousOpen (e : α ≃ β) (h₁ : Continuous e) (h₂ : IsOpenMap e) : α ≃ₜ β where
  continuous_toFun := h₁
  continuous_invFun := by
    rw [continuous_def]
    intro s hs
    convert ← h₂ s hs using 1
    apply e.image_eq_preimage
  toEquiv := e
#align homeomorph.homeomorph_of_continuous_open Homeomorph.homeomorphOfContinuousOpen

@[simp]
theorem comp_continuousOn_iff (h : α ≃ₜ β) (f : γ → α) (s : Set γ) :
    ContinuousOn (h ∘ f) s ↔ ContinuousOn f s :=
  h.inducing.continuousOn_iff.symm
#align homeomorph.comp_continuous_on_iff Homeomorph.comp_continuousOn_iff

@[simp]
theorem comp_continuous_iff (h : α ≃ₜ β) {f : γ → α} : Continuous (h ∘ f) ↔ Continuous f :=
  h.inducing.continuous_iff.symm
#align homeomorph.comp_continuous_iff Homeomorph.comp_continuous_iff

@[simp]
theorem comp_continuous_iff' (h : α ≃ₜ β) {f : β → γ} : Continuous (f ∘ h) ↔ Continuous f :=
  h.quotientMap.continuous_iff.symm
#align homeomorph.comp_continuous_iff' Homeomorph.comp_continuous_iff'

theorem comp_continuousAt_iff (h : α ≃ₜ β) (f : γ → α) (x : γ) :
    ContinuousAt (h ∘ f) x ↔ ContinuousAt f x :=
  h.inducing.continuousAt_iff.symm
#align homeomorph.comp_continuous_at_iff Homeomorph.comp_continuousAt_iff

theorem comp_continuousAt_iff' (h : α ≃ₜ β) (f : β → γ) (x : α) :
    ContinuousAt (f ∘ h) x ↔ ContinuousAt f (h x) :=
  h.inducing.continuousAt_iff' (by simp)
#align homeomorph.comp_continuous_at_iff' Homeomorph.comp_continuousAt_iff'

theorem comp_continuousWithinAt_iff (h : α ≃ₜ β) (f : γ → α) (s : Set γ) (x : γ) :
    ContinuousWithinAt f s x ↔ ContinuousWithinAt (h ∘ f) s x :=
  h.inducing.continuousWithinAt_iff
#align homeomorph.comp_continuous_within_at_iff Homeomorph.comp_continuousWithinAt_iff

@[simp]
theorem comp_isOpenMap_iff (h : α ≃ₜ β) {f : γ → α} : IsOpenMap (h ∘ f) ↔ IsOpenMap f := by
  refine' ⟨_, fun hf => h.isOpenMap.comp hf⟩
  intro hf
  rw [← Function.comp.left_id f, ← h.symm_comp_self, Function.comp.assoc]
  exact h.symm.isOpenMap.comp hf
#align homeomorph.comp_is_open_map_iff Homeomorph.comp_isOpenMap_iff

@[simp]
theorem comp_isOpenMap_iff' (h : α ≃ₜ β) {f : β → γ} : IsOpenMap (f ∘ h) ↔ IsOpenMap f := by
  refine' ⟨_, fun hf => hf.comp h.isOpenMap⟩
  intro hf
  rw [← Function.comp.right_id f, ← h.self_comp_symm, ← Function.comp.assoc]
  exact hf.comp h.symm.isOpenMap
#align homeomorph.comp_is_open_map_iff' Homeomorph.comp_isOpenMap_iff'

/-- If two sets are equal, then they are homeomorphic. -/
def setCongr {s t : Set α} (h : s = t) : s ≃ₜ t
    where
  continuous_toFun := continuous_inclusion h.subset
  continuous_invFun := continuous_inclusion h.symm.subset
  toEquiv := Equiv.setCongr h
#align homeomorph.set_congr Homeomorph.setCongr

/-- Sum of two homeomorphisms. -/
def sumCongr (h₁ : α ≃ₜ β) (h₂ : γ ≃ₜ δ) : Sum α γ ≃ₜ Sum β δ where
  continuous_toFun := h₁.continuous.sum_map h₂.continuous
  continuous_invFun := h₁.symm.continuous.sum_map h₂.symm.continuous
  toEquiv := h₁.toEquiv.sumCongr h₂.toEquiv
#align homeomorph.sum_congr Homeomorph.sumCongr

/-- Product of two homeomorphisms. -/
def prodCongr (h₁ : α ≃ₜ β) (h₂ : γ ≃ₜ δ) : α × γ ≃ₜ β × δ where
  continuous_toFun := h₁.continuous.prod_map h₂.continuous
  continuous_invFun := h₁.symm.continuous.prod_map h₂.symm.continuous
  toEquiv := h₁.toEquiv.prodCongr h₂.toEquiv
#align homeomorph.prod_congr Homeomorph.prodCongr

@[simp]
theorem prodCongr_symm (h₁ : α ≃ₜ β) (h₂ : γ ≃ₜ δ) :
    (h₁.prodCongr h₂).symm = h₁.symm.prodCongr h₂.symm :=
  rfl
#align homeomorph.prod_congr_symm Homeomorph.prodCongr_symm

@[simp]
theorem coe_prodCongr (h₁ : α ≃ₜ β) (h₂ : γ ≃ₜ δ) : ⇑(h₁.prodCongr h₂) = Prod.map h₁ h₂ :=
  rfl
#align homeomorph.coe_prod_congr Homeomorph.coe_prodCongr

section

variable (α β γ)

/-- `α × β` is homeomorphic to `β × α`. -/
def prodComm : α × β ≃ₜ β × α where
  continuous_toFun := continuous_snd.prod_mk continuous_fst
  continuous_invFun := continuous_snd.prod_mk continuous_fst
  toEquiv := Equiv.prodComm α β
#align homeomorph.prod_comm Homeomorph.prodComm

@[simp]
theorem prodComm_symm : (prodComm α β).symm = prodComm β α :=
  rfl
#align homeomorph.prod_comm_symm Homeomorph.prodComm_symm

@[simp]
theorem coe_prodComm : ⇑(prodComm α β) = Prod.swap :=
  rfl
#align homeomorph.coe_prod_comm Homeomorph.coe_prodComm

/-- `(α × β) × γ` is homeomorphic to `α × (β × γ)`. -/
def prodAssoc : (α × β) × γ ≃ₜ α × β × γ where
  continuous_toFun := continuous_fst.fst.prod_mk (continuous_fst.snd.prod_mk continuous_snd)
  continuous_invFun := (continuous_fst.prod_mk continuous_snd.fst).prod_mk continuous_snd.snd
  toEquiv := Equiv.prodAssoc α β γ
#align homeomorph.prod_assoc Homeomorph.prodAssoc

/-- `α × {*}` is homeomorphic to `α`. -/
@[simps! (config := { fullyApplied := false }) apply]
def prodPunit : α × PUnit ≃ₜ α where
  toEquiv := Equiv.prodPUnit α
  continuous_toFun := continuous_fst
  continuous_invFun := continuous_id.prod_mk continuous_const
#align homeomorph.prod_punit Homeomorph.prodPunit

/-- `{*} × α` is homeomorphic to `α`. -/
def punitProd : PUnit × α ≃ₜ α :=
  (prodComm _ _).trans (prodPunit _)
#align homeomorph.punit_prod Homeomorph.punitProd

@[simp] theorem coe_punitProd : ⇑(punitProd α) = Prod.snd := rfl
#align homeomorph.coe_punit_prod Homeomorph.coe_punitProd

/-- If both `α` and `β` have a unique element, then `α ≃ₜ β`. -/
@[simps!]
def homeomorphOfUnique [Unique α] [Unique β] : α ≃ₜ β :=
  { Equiv.equivOfUnique α β with
    continuous_toFun := continuous_const
    continuous_invFun := continuous_const }
#align homeomorph.homeomorph_of_unique Homeomorph.homeomorphOfUnique

end

/-- If each `β₁ i` is homeomorphic to `β₂ i`, then `Π i, β₁ i` is homeomorphic to `Π i, β₂ i`. -/
@[simps! apply toEquiv]
def piCongrRight {ι : Type _} {β₁ β₂ : ι → Type _} [∀ i, TopologicalSpace (β₁ i)]
    [∀ i, TopologicalSpace (β₂ i)] (F : ∀ i, β₁ i ≃ₜ β₂ i) : (∀ i, β₁ i) ≃ₜ ∀ i, β₂ i where
  continuous_toFun := continuous_pi fun i => (F i).continuous.comp <| continuous_apply i
  continuous_invFun := continuous_pi fun i => (F i).symm.continuous.comp <| continuous_apply i
  toEquiv := Equiv.piCongrRight fun i => (F i).toEquiv
#align homeomorph.Pi_congr_right Homeomorph.piCongrRight

@[simp]
theorem piCongrRight_symm {ι : Type _} {β₁ β₂ : ι → Type _} [∀ i, TopologicalSpace (β₁ i)]
    [∀ i, TopologicalSpace (β₂ i)] (F : ∀ i, β₁ i ≃ₜ β₂ i) :
    (piCongrRight F).symm = piCongrRight fun i => (F i).symm :=
  rfl
#align homeomorph.Pi_congr_right_symm Homeomorph.piCongrRight_symm

-- porting note: TODO: align the order of universes with `Equiv.ulift`
/-- `ULift α` is homeomorphic to `α`. -/
def ulift.{u, v} {α : Type u} [TopologicalSpace α] : ULift.{v, u} α ≃ₜ α where
  continuous_toFun := continuous_uLift_down
  continuous_invFun := continuous_uLift_up
  toEquiv := Equiv.ulift
#align homeomorph.ulift Homeomorph.ulift

section Distrib

/-- `(α ⊕ β) × γ` is homeomorphic to `α × γ ⊕ β × γ`. -/
def sumProdDistrib : Sum α β × γ ≃ₜ Sum (α × γ) (β × γ) :=
  Homeomorph.symm <|
    homeomorphOfContinuousOpen (Equiv.sumProdDistrib α β γ).symm
        ((continuous_inl.prod_map continuous_id).sum_elim
          (continuous_inr.prod_map continuous_id)) <|
      (isOpenMap_inl.prod IsOpenMap.id).sum_elim (isOpenMap_inr.prod IsOpenMap.id)
#align homeomorph.sum_prod_distrib Homeomorph.sumProdDistrib

/-- `α × (β ⊕ γ)` is homeomorphic to `α × β ⊕ α × γ`. -/
def prodSumDistrib : α × Sum β γ ≃ₜ Sum (α × β) (α × γ) :=
  (prodComm _ _).trans <| sumProdDistrib.trans <| sumCongr (prodComm _ _) (prodComm _ _)
#align homeomorph.prod_sum_distrib Homeomorph.prodSumDistrib

variable {ι : Type _} {σ : ι → Type _} [∀ i, TopologicalSpace (σ i)]

/-- `(Σ i, σ i) × β` is homeomorphic to `Σ i, (σ i × β)`. -/
def sigmaProdDistrib : (Σi, σ i) × β ≃ₜ Σi, σ i × β :=
  Homeomorph.symm <|
    homeomorphOfContinuousOpen (Equiv.sigmaProdDistrib σ β).symm
      (continuous_sigma fun _ => continuous_sigmaMk.fst'.prod_mk continuous_snd)
      (isOpenMap_sigma.2 fun _ => isOpenMap_sigmaMk.prod IsOpenMap.id)
#align homeomorph.sigma_prod_distrib Homeomorph.sigmaProdDistrib

end Distrib

/-- If `ι` has a unique element, then `ι → α` is homeomorphic to `α`. -/
@[simps! (config := { fullyApplied := false })]
def funUnique (ι α : Type _) [Unique ι] [TopologicalSpace α] : (ι → α) ≃ₜ α
    where
  toEquiv := Equiv.funUnique ι α
  continuous_toFun := continuous_apply _
  continuous_invFun := continuous_pi fun _ => continuous_id
#align homeomorph.fun_unique Homeomorph.funUnique

/-- Homeomorphism between dependent functions `Π i : Fin 2, α i` and `α 0 × α 1`. -/
@[simps! (config := { fullyApplied := false })]
def piFinTwo.{u} (α : Fin 2 → Type u) [∀ i, TopologicalSpace (α i)] : (∀ i, α i) ≃ₜ α 0 × α 1
    where
  toEquiv := piFinTwoEquiv α
  continuous_toFun := (continuous_apply 0).prod_mk (continuous_apply 1)
  continuous_invFun := continuous_pi <| Fin.forall_fin_two.2 ⟨continuous_fst, continuous_snd⟩
#align homeomorph.pi_fin_two Homeomorph.piFinTwo

/-- Homeomorphism between `α² = Fin 2 → α` and `α × α`. -/
@[simps! (config := { fullyApplied := false })]
def finTwoArrow : (Fin 2 → α) ≃ₜ α × α :=
  { piFinTwo fun _ => α with toEquiv := finTwoArrowEquiv α }
#align homeomorph.fin_two_arrow Homeomorph.finTwoArrow

/-- A subset of a topological space is homeomorphic to its image under a homeomorphism.
-/
@[simps!]
def image (e : α ≃ₜ β) (s : Set α) : s ≃ₜ e '' s where
  -- porting note: todo: by continuity!
  continuous_toFun := e.continuous.continuousOn.restrict_mapsTo (mapsTo_image _ _)
  continuous_invFun := (e.symm.continuous.comp continuous_subtype_val).codRestrict _
  toEquiv := e.toEquiv.image s
#align homeomorph.image Homeomorph.image

/-- `Set.univ α` is homeomorphic to `α`. -/
@[simps! (config := { fullyApplied := false })]
def Set.univ (α : Type _) [TopologicalSpace α] : (univ : Set α) ≃ₜ α where
  toEquiv := Equiv.Set.univ α
  continuous_toFun := continuous_subtype_val
  continuous_invFun := continuous_id.subtype_mk _
#align homeomorph.set.univ Homeomorph.Set.univ

/-- `s ×ˢ t` is homeomorphic to `s × t`. -/
@[simps!]
def Set.prod (s : Set α) (t : Set β) : ↥(s ×ˢ t) ≃ₜ s × t where
  toEquiv := Equiv.Set.prod s t
  continuous_toFun :=
    (continuous_subtype_val.fst.subtype_mk _).prod_mk (continuous_subtype_val.snd.subtype_mk _)
  continuous_invFun :=
    (continuous_subtype_val.fst'.prod_mk continuous_subtype_val.snd').subtype_mk _
#align homeomorph.set.prod Homeomorph.Set.prod

section

variable {ι : Type _}

/-- The topological space `Π i, β i` can be split as a product by separating the indices in ι
  depending on whether they satisfy a predicate p or not.-/
@[simps!]
def piEquivPiSubtypeProd (p : ι → Prop) (β : ι → Type _) [∀ i, TopologicalSpace (β i)]
    [DecidablePred p] : (∀ i, β i) ≃ₜ (∀ i : { x // p x }, β i) × ∀ i : { x // ¬p x }, β i
    where
  toEquiv := Equiv.piEquivPiSubtypeProd p β
  continuous_toFun := by
    apply Continuous.prod_mk <;> exact continuous_pi fun j => continuous_apply j.1
  continuous_invFun :=
    continuous_pi fun j => by
      dsimp only [Equiv.piEquivPiSubtypeProd]; split_ifs
      exacts [(continuous_apply _).comp continuous_fst, (continuous_apply _).comp continuous_snd]
#align homeomorph.pi_equiv_pi_subtype_prod Homeomorph.piEquivPiSubtypeProd

variable [DecidableEq ι] (i : ι)

/-- A product of topological spaces can be split as the binary product of one of the spaces and
  the product of all the remaining spaces. -/
@[simps!]
def piSplitAt (β : ι → Type _) [∀ j, TopologicalSpace (β j)] :
    (∀ j, β j) ≃ₜ β i × ∀ j : { j // j ≠ i }, β j
    where
  toEquiv := Equiv.piSplitAt i β
  continuous_toFun := (continuous_apply i).prod_mk (continuous_pi fun j => continuous_apply j.1)
  continuous_invFun :=
    continuous_pi fun j => by
      dsimp only [Equiv.piSplitAt]
      split_ifs with h
      subst h
      exacts [continuous_fst, (continuous_apply _).comp continuous_snd]
#align homeomorph.pi_split_at Homeomorph.piSplitAt

/-- A product of copies of a topological space can be split as the binary product of one copy and
  the product of all the remaining copies. -/
@[simps!]
def funSplitAt : (ι → β) ≃ₜ β × ({ j // j ≠ i } → β) :=
  piSplitAt i _
#align homeomorph.fun_split_at Homeomorph.funSplitAt

end

end Homeomorph

/-- An inducing equiv between topological spaces is a homeomorphism. -/
@[simps toEquiv] -- porting note: TODO: was `@[simps]`
def Equiv.toHomeomorphOfInducing [TopologicalSpace α] [TopologicalSpace β] (f : α ≃ β)
    (hf : Inducing f) : α ≃ₜ β :=
  { f with
    continuous_toFun := hf.continuous
    continuous_invFun := hf.continuous_iff.2 <| by simpa using continuous_id }
#align equiv.to_homeomorph_of_inducing Equiv.toHomeomorphOfInducing

namespace Continuous

variable [TopologicalSpace α] [TopologicalSpace β]

theorem continuous_symm_of_equiv_compact_to_t2 [CompactSpace α] [T2Space β] {f : α ≃ β}
    (hf : Continuous f) : Continuous f.symm := by
  rw [continuous_iff_isClosed]
  intro C hC
  have hC' : IsClosed (f '' C) := (hC.isCompact.image hf).isClosed
  rwa [Equiv.image_eq_preimage] at hC'
#align continuous.continuous_symm_of_equiv_compact_to_t2 Continuous.continuous_symm_of_equiv_compact_to_t2

/-- Continuous equivalences from a compact space to a T2 space are homeomorphisms.

This is not true when T2 is weakened to T1
(see `continuous.homeo_of_equiv_compact_to_t2.t1_counterexample`). -/
@[simps toEquiv] -- porting note: was `@[simps]`
def homeoOfEquivCompactToT2 [CompactSpace α] [T2Space β] {f : α ≃ β} (hf : Continuous f) : α ≃ₜ β :=
  { f with
    continuous_toFun := hf
    continuous_invFun := hf.continuous_symm_of_equiv_compact_to_t2 }
#align continuous.homeo_of_equiv_compact_to_t2 Continuous.homeoOfEquivCompactToT2

end Continuous


/-
Copyright (c) 2018 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro, Chris Hughes
-/
import algebra.associated algebra.euclidean_domain ring_theory.ideals
noncomputable theory
local attribute [instance] classical.dec
open euclidean_domain set ideal

theorem span_gcd {α} [euclidean_domain α] (x y : α) :
  span ({gcd x y} : set α) = span ({x, y} : set α) :=
begin
  apply le_antisymm; refine span_le.1 _,
  { simp [submodule.span_span, mem_span_pair, submodule.le_def', mem_span_singleton'],
    assume a b ha,
    exact ⟨b * gcd_a x y, b * gcd_b x y, by rw [← ha, gcd_eq_gcd_ab x y];
      simp [mul_add, mul_comm, mul_left_comm]⟩ },
  { assume z ,
    simp [mem_span_singleton, euclidean_domain.gcd_dvd_left, mem_span_pair,
      @eq_comm _ _ z] {contextual := tt},
    assume a b h,
    exact dvd_add (dvd_mul_of_dvd_right (gcd_dvd_left _ _) _)
      (dvd_mul_of_dvd_right (gcd_dvd_right _ _) _) }
end

theorem gcd_is_unit_iff {α} [euclidean_domain α] {x y : α} :
  is_unit (gcd x y) ↔ is_coprime x y :=
by rw [← span_singleton_eq_top, span_gcd, is_coprime]

theorem is_coprime_of_dvd {α} [euclidean_domain α] {x y : α}
  (z : ¬ (x = 0 ∧ y = 0)) (H : ∀ z ∈ nonunits α, z ≠ 0 → z ∣ x → ¬ z ∣ y) :
  is_coprime x y :=
begin
  rw [← gcd_is_unit_iff],
  by_contra h,
  refine H _ h _ (gcd_dvd_left _ _) (gcd_dvd_right _ _),
  rwa [ne, euclidean_domain.gcd_eq_zero_iff]
end

theorem dvd_or_coprime {α} [euclidean_domain α] (x y : α)
  (h : irreducible x) : x ∣ y ∨ is_coprime x y :=
begin
  refine or_iff_not_imp_left.2 (λ h', _),
  unfreezeI, apply is_coprime_of_dvd,
  { rintro ⟨rfl, rfl⟩, simpa using h },
  { rintro z nu nz ⟨w, rfl⟩ dy,
    refine h' (dvd.trans _ dy),
    simpa using mul_dvd_mul_left z (is_unit_iff_dvd_one.1 $
      (of_irreducible_mul h).resolve_left nu) }
end


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

import category_theory.idempotents.karoubi
import category_theory.additive.basic

/-!

# Biproducts in the idempotent completion of a preadditive category

In this file, we define an instance expressing that if `C` is an additive category,
then `karoubi C` is also an additive category.

We also obtain that for all `P : karoubi C` where `C` is a preadditive category `C`, there
is a canonical isomorphism `P ⊞ P.complement ≅ (to_karoubi C).obj P.X` in the category
`karoubi C` where `P.complement` is the formal direct factor of `P.X` corresponding to
the idempotent endomorphism `𝟙 P.X - P.p`.

-/

noncomputable theory

open category_theory.category
open category_theory.limits
open category_theory.preadditive

universes v

namespace category_theory

namespace idempotents

namespace karoubi

variables {C : Type*} [category.{v} C] [preadditive C]

namespace biproducts

/-- The `bicone` used in order to obtain the existence of
the biproduct of a functor `J ⥤ karoubi C` when the category `C` is additive. -/
@[simps]
def bicone [has_finite_biproducts C] {J : Type v} [fintype J]
  (F : J → karoubi C) : bicone F :=
{ X :=
  { X := biproduct (λ j, (F j).X),
    p := biproduct.map (λ j, (F j).p),
    idem := begin
      ext j,
      simp only [biproduct.ι_map_assoc, biproduct.ι_map],
      slice_lhs 1 2 { rw (F j).idem, },
    end, },
  π := λ j,
    { f := biproduct.map (λ j, (F j).p) ≫ bicone.π _ j,
      comm := by simp only [assoc, biproduct.bicone_π, biproduct.map_π,
        biproduct.map_π_assoc, (F j).idem], },
  ι := λ j,
    { f := (by exact bicone.ι _ j) ≫ biproduct.map (λ j, (F j).p),
      comm := by rw [biproduct.ι_map, ← assoc, ← assoc, (F j).idem,
        assoc, biproduct.ι_map, ← assoc, (F j).idem], },
  ι_π := λ j j', begin
    split_ifs,
    { subst h,
      simp only [biproduct.bicone_ι, biproduct.ι_map, biproduct.bicone_π,
        biproduct.ι_π_self_assoc, comp, category.assoc, eq_to_hom_refl, id_eq,
        biproduct.map_π, (F j).idem], },
    { simpa only [hom_ext, biproduct.ι_π_ne_assoc _ h, assoc,
        biproduct.map_π, biproduct.map_π_assoc, zero_comp, comp], },
  end, }

end biproducts

lemma karoubi_has_finite_biproducts [has_finite_biproducts C] :
  has_finite_biproducts (karoubi C) :=
{ has_biproducts_of_shape := λ J hJ,
  { has_biproduct := λ F, begin
      classical,
      letI := hJ,
      apply has_biproduct_of_total (biproducts.bicone F),
      ext1, ext1,
      simp only [id_eq, comp_id, biproducts.bicone_X_p, biproduct.ι_map],
      rw [sum_hom, comp_sum, finset.sum_eq_single j], rotate,
      { intros j' h1 h2,
        simp only [biproduct.ι_map, biproducts.bicone_ι_f, biproducts.bicone_π_f,
          assoc, comp, biproduct.map_π],
        slice_lhs 1 2 { rw biproduct.ι_π, },
        split_ifs,
        { exfalso, exact h2 h.symm, },
        { simp only [zero_comp], } },
      { intro h,
        exfalso,
        simpa only [finset.mem_univ, not_true] using h, },
      { simp only [biproducts.bicone_π_f, comp,
          biproduct.ι_map, assoc, biproducts.bicone_ι_f, biproduct.map_π],
        slice_lhs 1 2 { rw biproduct.ι_π, },
        split_ifs, swap, { exfalso, exact h rfl, },
        simp only [eq_to_hom_refl, id_comp, (F j).idem], },
    end, } }

instance {D : Type*} [category D] [additive_category D] : additive_category (karoubi D) :=
{ to_preadditive := infer_instance,
  to_has_finite_biproducts := karoubi_has_finite_biproducts }

/-- `P.complement` is the formal direct factor of `P.X` given by the idempotent
endomorphism `𝟙 P.X - P.p` -/
@[simps]
def complement (P : karoubi C) : karoubi C :=
{ X := P.X,
  p := 𝟙 _ - P.p,
  idem := idem_of_id_sub_idem P.p P.idem, }

instance (P : karoubi C) : has_binary_biproduct P P.complement :=
has_binary_biproduct_of_total
{ X := P.X,
  fst := P.decomp_id_p,
  snd := P.complement.decomp_id_p,
  inl := P.decomp_id_i,
  inr := P.complement.decomp_id_i,
  inl_fst' := P.decomp_id.symm,
  inl_snd' := begin
    simp only [decomp_id_i_f, decomp_id_p_f, complement_p, comp_sub, comp,
      hom_ext, quiver.hom.add_comm_group_zero_f, P.idem],
    erw [comp_id, sub_self],
  end,
  inr_fst' := begin
    simp only [decomp_id_i_f, complement_p, decomp_id_p_f, sub_comp, comp,
      hom_ext, quiver.hom.add_comm_group_zero_f, P.idem],
    erw [id_comp, sub_self],
  end,
  inr_snd' := P.complement.decomp_id.symm, }
(by simp only [hom_ext, ← decomp_p, quiver.hom.add_comm_group_add_f,
  to_karoubi_map_f, id_eq, coe_p, complement_p, add_sub_cancel'_right])

/-- A formal direct factor `P : karoubi C` of an object `P.X : C` in a
preadditive category is actually a direct factor of the image `(to_karoubi C).obj P.X`
of `P.X` in the category `karoubi C` -/
def decomposition (P : karoubi C) : P ⊞ P.complement ≅ (to_karoubi _).obj P.X :=
{ hom := biprod.desc P.decomp_id_i P.complement.decomp_id_i,
  inv := biprod.lift P.decomp_id_p P.complement.decomp_id_p,
  hom_inv_id' := begin
    ext1,
    { simp only [← assoc, biprod.inl_desc, comp_id, biprod.lift_eq, comp_add,
        ← decomp_id, id_comp, add_right_eq_self],
      convert zero_comp,
      ext,
      simp only [decomp_id_i_f, decomp_id_p_f, complement_p, comp_sub, comp,
        quiver.hom.add_comm_group_zero_f, P.idem],
      erw [comp_id, sub_self], },
    { simp only [← assoc, biprod.inr_desc, biprod.lift_eq, comp_add,
        ← decomp_id, comp_id, id_comp, add_left_eq_self],
      convert zero_comp,
      ext,
      simp only [decomp_id_i_f, decomp_id_p_f, complement_p, sub_comp, comp,
        quiver.hom.add_comm_group_zero_f, P.idem],
      erw [id_comp, sub_self], }
  end,
  inv_hom_id' := begin
    rw biprod.lift_desc,
    simp only [← decomp_p],
    ext,
    dsimp only [complement, to_karoubi],
    simp only [quiver.hom.add_comm_group_add_f, add_sub_cancel'_right, id_eq],
  end, }

end karoubi

end idempotents

end category_theory


import data.real.basic

def fn_ub (f : ℝ → ℝ) (a : ℝ) : Prop := ∀ x, f x ≤ a
def fn_has_ub (f : ℝ → ℝ) := ∃ a, fn_ub f a

open_locale classical

variable (f : ℝ → ℝ)

-- BEGIN
example (h : ¬ monotone f) : ∃ x y, x ≤ y ∧ f y < f x :=
begin
  simp only [monotone] at h,
  sorry,
end

/- The rw tactic also unpacks a definition, which is equivalent to
'simp only' -/
example : ¬ monotone (λ x : ℝ, -x) :=
begin
  rw monotone,
  sorry,
end
-- END


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

! This file was ported from Lean 3 source module algebra.homology.short_exact.preadditive
! leanprover-community/mathlib commit 14b69e9f3c16630440a2cbd46f1ddad0d561dee7
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.Homology.Exact
import Mathbin.CategoryTheory.Preadditive.AdditiveFunctor

/-!
# Short exact sequences, and splittings.

`short_exact f g` is the proposition that `0 ⟶ A -f⟶ B -g⟶ C ⟶ 0` is an exact sequence.

We define when a short exact sequence is left-split, right-split, and split.

## See also
In `algebra.homology.short_exact.abelian` we show that in an abelian category
a left-split short exact sequences admits a splitting.
-/

noncomputable section

open CategoryTheory CategoryTheory.Limits CategoryTheory.Preadditive

variable {𝒜 : Type _} [Category 𝒜]

namespace CategoryTheory

variable {A B C A' B' C' : 𝒜} (f : A ⟶ B) (g : B ⟶ C) (f' : A' ⟶ B') (g' : B' ⟶ C')

section HasZeroMorphisms

variable [HasZeroMorphisms 𝒜] [HasKernels 𝒜] [HasImages 𝒜]

/-- If `f : A ⟶ B` and `g : B ⟶ C` then `short_exact f g` is the proposition saying
  the resulting diagram `0 ⟶ A ⟶ B ⟶ C ⟶ 0` is an exact sequence. -/
structure ShortExact : Prop where
  [Mono : Mono f]
  [Epi : Epi g]
  exact : Exact f g
#align category_theory.short_exact CategoryTheory.ShortExact

/-- An exact sequence `A -f⟶ B -g⟶ C` is *left split*
if there exists a morphism `φ : B ⟶ A` such that `f ≫ φ = 𝟙 A` and `g` is epi.

Such a sequence is automatically short exact (i.e., `f` is mono). -/
structure LeftSplit : Prop where
  LeftSplit : ∃ φ : B ⟶ A, f ≫ φ = 𝟙 A
  [Epi : Epi g]
  exact : Exact f g
#align category_theory.left_split CategoryTheory.LeftSplit

theorem LeftSplit.shortExact {f : A ⟶ B} {g : B ⟶ C} (h : LeftSplit f g) : ShortExact f g :=
  { Mono := by
      obtain ⟨φ, hφ⟩ := h.left_split
      haveI : mono (f ≫ φ) := by
        rw [hφ]
        infer_instance
      exact mono_of_mono f φ
    Epi := h.Epi
    exact := h.exact }
#align category_theory.left_split.short_exact CategoryTheory.LeftSplit.shortExact

/-- An exact sequence `A -f⟶ B -g⟶ C` is *right split*
if there exists a morphism `φ : C ⟶ B` such that `f ≫ φ = 𝟙 A` and `f` is mono.

Such a sequence is automatically short exact (i.e., `g` is epi). -/
structure RightSplit : Prop where
  RightSplit : ∃ χ : C ⟶ B, χ ≫ g = 𝟙 C
  [Mono : Mono f]
  exact : Exact f g
#align category_theory.right_split CategoryTheory.RightSplit

theorem RightSplit.shortExact {f : A ⟶ B} {g : B ⟶ C} (h : RightSplit f g) : ShortExact f g :=
  { Epi := by
      obtain ⟨χ, hχ⟩ := h.right_split
      haveI : epi (χ ≫ g) := by
        rw [hχ]
        infer_instance
      exact epi_of_epi χ g
    Mono := h.Mono
    exact := h.exact }
#align category_theory.right_split.short_exact CategoryTheory.RightSplit.shortExact

end HasZeroMorphisms

section Preadditive

variable [Preadditive 𝒜]

/-- An exact sequence `A -f⟶ B -g⟶ C` is *split* if there exist
`φ : B ⟶ A` and `χ : C ⟶ B` such that:
* `f ≫ φ = 𝟙 A`
* `χ ≫ g = 𝟙 C`
* `f ≫ g = 0`
* `χ ≫ φ = 0`
* `φ ≫ f + g ≫ χ = 𝟙 B`

Such a sequence is automatically short exact (i.e., `f` is mono and `g` is epi). -/
structure Split : Prop where
  split :
    ∃ (φ : B ⟶ A)(χ : C ⟶ B),
      f ≫ φ = 𝟙 A ∧ χ ≫ g = 𝟙 C ∧ f ≫ g = 0 ∧ χ ≫ φ = 0 ∧ φ ≫ f + g ≫ χ = 𝟙 B
#align category_theory.split CategoryTheory.Split

variable [HasKernels 𝒜] [HasImages 𝒜]

theorem exact_of_split {A B C : 𝒜} {f : A ⟶ B} {g : B ⟶ C} {χ : C ⟶ B} {φ : B ⟶ A} (hfg : f ≫ g = 0)
    (H : φ ≫ f + g ≫ χ = 𝟙 B) : Exact f g :=
  { w := hfg
    Epi :=
      by
      let ψ : (kernel_subobject g : 𝒜) ⟶ image_subobject f :=
        subobject.arrow _ ≫ φ ≫ factor_thru_image_subobject f
      suffices ψ ≫ imageToKernel f g hfg = 𝟙 _
        by
        convert epi_of_epi ψ _
        rw [this]
        infer_instance
      rw [← cancel_mono (subobject.arrow _)]
      swap
      · infer_instance
      simp only [imageToKernel_arrow, image_subobject_arrow_comp, category.id_comp, category.assoc]
      calc
        (kernel_subobject g).arrow ≫ φ ≫ f = (kernel_subobject g).arrow ≫ 𝟙 B := _
        _ = (kernel_subobject g).arrow := category.comp_id _

      rw [← H, preadditive.comp_add]
      simp only [add_zero, zero_comp, kernel_subobject_arrow_comp_assoc] }
#align category_theory.exact_of_split CategoryTheory.exact_of_split

section

variable {f g}

theorem Split.exact (h : Split f g) : Exact f g :=
  by
  obtain ⟨φ, χ, -, -, h1, -, h2⟩ := h
  exact exact_of_split h1 h2
#align category_theory.split.exact CategoryTheory.Split.exact

theorem Split.leftSplit (h : Split f g) : LeftSplit f g :=
  { LeftSplit := by
      obtain ⟨φ, χ, h1, -⟩ := h
      exact ⟨φ, h1⟩
    Epi := by
      obtain ⟨φ, χ, -, h2, -⟩ := h
      have : epi (χ ≫ g) := by
        rw [h2]
        infer_instance
      exact epi_of_epi χ g
    exact := h.exact }
#align category_theory.split.left_split CategoryTheory.Split.leftSplit

theorem Split.rightSplit (h : Split f g) : RightSplit f g :=
  { RightSplit := by
      obtain ⟨φ, χ, -, h1, -⟩ := h
      exact ⟨χ, h1⟩
    Mono := by
      obtain ⟨φ, χ, h1, -⟩ := h
      have : mono (f ≫ φ) := by
        rw [h1]
        infer_instance
      exact mono_of_mono f φ
    exact := h.exact }
#align category_theory.split.right_split CategoryTheory.Split.rightSplit

theorem Split.shortExact (h : Split f g) : ShortExact f g :=
  h.LeftSplit.ShortExact
#align category_theory.split.short_exact CategoryTheory.Split.shortExact

end

theorem Split.map {𝒜 ℬ : Type _} [Category 𝒜] [Preadditive 𝒜] [Category ℬ] [Preadditive ℬ]
    (F : 𝒜 ⥤ ℬ) [Functor.Additive F] {A B C : 𝒜} {f : A ⟶ B} {g : B ⟶ C} (h : Split f g) :
    Split (F.map f) (F.map g) :=
  by
  obtain ⟨φ, χ, h1, h2, h3, h4, h5⟩ := h
  refine' ⟨⟨F.map φ, F.map χ, _⟩⟩
  simp only [← F.map_comp, ← F.map_id, ← F.map_add, F.map_zero, *, eq_self_iff_true, and_true_iff]
#align category_theory.split.map CategoryTheory.Split.map

/-- The sequence `A ⟶ A ⊞ B ⟶ B` is exact. -/
theorem exact_inl_snd [HasBinaryBiproducts 𝒜] (A B : 𝒜) :
    Exact (biprod.inl : A ⟶ A ⊞ B) biprod.snd :=
  exact_of_split biprod.inl_snd biprod.total
#align category_theory.exact_inl_snd CategoryTheory.exact_inl_snd

/-- The sequence `B ⟶ A ⊞ B ⟶ A` is exact. -/
theorem exact_inr_fst [HasBinaryBiproducts 𝒜] (A B : 𝒜) :
    Exact (biprod.inr : B ⟶ A ⊞ B) biprod.fst :=
  exact_of_split biprod.inr_fst ((add_comm _ _).trans biprod.total)
#align category_theory.exact_inr_fst CategoryTheory.exact_inr_fst

end Preadditive

/-- A *splitting* of a sequence `A -f⟶ B -g⟶ C` is an isomorphism
to the short exact sequence `0 ⟶ A ⟶ A ⊞ C ⟶ C ⟶ 0` such that
the vertical maps on the left and the right are the identity. -/
@[nolint has_nonempty_instance]
structure Splitting [HasZeroMorphisms 𝒜] [HasBinaryBiproducts 𝒜] where
  Iso : B ≅ A ⊞ C
  comp_iso_eq_inl : f ≫ iso.Hom = biprod.inl
  iso_comp_snd_eq : iso.Hom ≫ biprod.snd = g
#align category_theory.splitting CategoryTheory.Splitting

variable {f g}

namespace Splitting

section HasZeroMorphisms

variable [HasZeroMorphisms 𝒜] [HasBinaryBiproducts 𝒜]

attribute [simp, reassoc.1] comp_iso_eq_inl iso_comp_snd_eq

variable (h : Splitting f g)

@[simp, reassoc.1]
theorem inl_comp_iso_eq : biprod.inl ≫ h.Iso.inv = f := by rw [iso.comp_inv_eq, h.comp_iso_eq_inl]
#align category_theory.splitting.inl_comp_iso_eq CategoryTheory.Splitting.inl_comp_iso_eq

@[simp, reassoc.1]
theorem iso_comp_eq_snd : h.Iso.inv ≫ g = biprod.snd := by rw [iso.inv_comp_eq, h.iso_comp_snd_eq]
#align category_theory.splitting.iso_comp_eq_snd CategoryTheory.Splitting.iso_comp_eq_snd

/-- If `h` is a splitting of `A -f⟶ B -g⟶ C`,
then `h.section : C ⟶ B` is the morphism satisfying `h.section ≫ g = 𝟙 C`. -/
def CategoryTheory.Splitting.section : C ⟶ B :=
  biprod.inr ≫ h.Iso.inv
#align category_theory.splitting.section CategoryTheory.Splitting.section

/-- If `h` is a splitting of `A -f⟶ B -g⟶ C`,
then `h.retraction : B ⟶ A` is the morphism satisfying `f ≫ h.retraction = 𝟙 A`. -/
def retraction : B ⟶ A :=
  h.Iso.Hom ≫ biprod.fst
#align category_theory.splitting.retraction CategoryTheory.Splitting.retraction

@[simp, reassoc.1]
theorem section_π : h.section ≫ g = 𝟙 C :=
  by
  delta splitting.section
  simp
#align category_theory.splitting.section_π CategoryTheory.Splitting.section_π

@[simp, reassoc.1]
theorem ι_retraction : f ≫ h.retraction = 𝟙 A :=
  by
  delta retraction
  simp
#align category_theory.splitting.ι_retraction CategoryTheory.Splitting.ι_retraction

@[simp, reassoc.1]
theorem section_retraction : h.section ≫ h.retraction = 0 :=
  by
  delta splitting.section retraction
  simp
#align category_theory.splitting.section_retraction CategoryTheory.Splitting.section_retraction

/-- The retraction in a splitting is a split mono. -/
protected def splitMono : SplitMono f :=
  ⟨h.retraction, by simp⟩
#align category_theory.splitting.split_mono CategoryTheory.Splitting.splitMono

/-- The section in a splitting is a split epi. -/
protected def splitEpi : SplitEpi g :=
  ⟨h.section, by simp⟩
#align category_theory.splitting.split_epi CategoryTheory.Splitting.splitEpi

@[simp, reassoc.1]
theorem inr_iso_inv : biprod.inr ≫ h.Iso.inv = h.section :=
  rfl
#align category_theory.splitting.inr_iso_inv CategoryTheory.Splitting.inr_iso_inv

@[simp, reassoc.1]
theorem iso_hom_fst : h.Iso.Hom ≫ biprod.fst = h.retraction :=
  rfl
#align category_theory.splitting.iso_hom_fst CategoryTheory.Splitting.iso_hom_fst

/-- A short exact sequence of the form `X -f⟶ Y -0⟶ Z` where `f` is an iso and `Z` is zero
has a splitting. -/
def splittingOfIsIsoZero {X Y Z : 𝒜} (f : X ⟶ Y) [IsIso f] (hZ : IsZero Z) :
    Splitting f (0 : Y ⟶ Z) :=
  ⟨(asIso f).symm ≪≫ isoBiprodZero hZ, by simp [hZ.eq_of_tgt _ 0], by simp⟩
#align category_theory.splitting.splitting_of_is_iso_zero CategoryTheory.Splitting.splittingOfIsIsoZero

include h

protected theorem mono : Mono f :=
  by
  apply mono_of_mono _ h.retraction
  rw [h.ι_retraction]
  infer_instance
#align category_theory.splitting.mono CategoryTheory.Splitting.mono

protected theorem epi : Epi g :=
  by
  apply (config := { instances := false }) epi_of_epi h.section
  rw [h.section_π]
  infer_instance
#align category_theory.splitting.epi CategoryTheory.Splitting.epi

instance : Mono h.section := by
  delta splitting.section
  infer_instance

instance : Epi h.retraction := by
  delta retraction
  apply epi_comp

end HasZeroMorphisms

section Preadditive

variable [Preadditive 𝒜] [HasBinaryBiproducts 𝒜]

variable (h : Splitting f g)

theorem split_add : h.retraction ≫ f + g ≫ h.section = 𝟙 _ :=
  by
  delta splitting.section retraction
  rw [← cancel_mono h.iso.hom, ← cancel_epi h.iso.inv]
  simp only [category.comp_id, category.id_comp, category.assoc, iso.inv_hom_id_assoc,
    iso.inv_hom_id, limits.biprod.total, preadditive.comp_add, preadditive.add_comp,
    splitting.comp_iso_eq_inl, splitting.iso_comp_eq_snd_assoc]
#align category_theory.splitting.split_add CategoryTheory.Splitting.split_add

@[reassoc.1]
theorem retraction_ι_eq_id_sub : h.retraction ≫ f = 𝟙 _ - g ≫ h.section :=
  eq_sub_iff_add_eq.mpr h.split_add
#align category_theory.splitting.retraction_ι_eq_id_sub CategoryTheory.Splitting.retraction_ι_eq_id_sub

@[reassoc.1]
theorem π_section_eq_id_sub : g ≫ h.section = 𝟙 _ - h.retraction ≫ f :=
  eq_sub_iff_add_eq.mpr ((add_comm _ _).trans h.split_add)
#align category_theory.splitting.π_section_eq_id_sub CategoryTheory.Splitting.π_section_eq_id_sub

theorem splittings_comm (h h' : Splitting f g) :
    h'.section ≫ h.retraction = -h.section ≫ h'.retraction :=
  by
  haveI := h.mono
  rw [← cancel_mono f]
  simp [retraction_ι_eq_id_sub]
#align category_theory.splitting.splittings_comm CategoryTheory.Splitting.splittings_comm

include h

theorem split : Split f g := by
  let φ := h.iso.hom ≫ biprod.fst
  let χ := biprod.inr ≫ h.iso.inv
  refine'
    ⟨⟨h.retraction, h.section, h.ι_retraction, h.section_π, _, h.section_retraction, h.split_add⟩⟩
  rw [← h.inl_comp_iso_eq, category.assoc, h.iso_comp_eq_snd, biprod.inl_snd]
#align category_theory.splitting.split CategoryTheory.Splitting.split

@[reassoc.1]
theorem comp_eq_zero : f ≫ g = 0 :=
  h.split.1.choose_spec.choose_spec.2.2.1
#align category_theory.splitting.comp_eq_zero CategoryTheory.Splitting.comp_eq_zero

variable [HasKernels 𝒜] [HasImages 𝒜] [HasZeroObject 𝒜] [HasCokernels 𝒜]

protected theorem exact : Exact f g :=
  by
  rw [exact_iff_exact_of_iso f g (biprod.inl : A ⟶ A ⊞ C) (biprod.snd : A ⊞ C ⟶ C) _ _ _]
  · exact exact_inl_snd _ _
  · refine' arrow.iso_mk (iso.refl _) h.iso _
    simp only [iso.refl_hom, arrow.mk_hom, category.id_comp, comp_iso_eq_inl]
  · refine' arrow.iso_mk h.iso (iso.refl _) _
    dsimp
    simp
  · rfl
#align category_theory.splitting.exact CategoryTheory.Splitting.exact

protected theorem shortExact : ShortExact f g :=
  { Mono := h.Mono
    Epi := h.Epi
    exact := h.exact }
#align category_theory.splitting.short_exact CategoryTheory.Splitting.shortExact

end Preadditive

end Splitting

end CategoryTheory