/-
Copyright (c) 2016 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Leonardo de Moura, Mario Carneiro
-/
import algebra.hom.ring
import algebra.order.monoid.with_top
import algebra.order.ring.canonical

/-! # Structures involving `*` and `0` on `with_top` and `with_bot`

> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
> Any changes to this file require a corresponding PR to mathlib4.

The main results of this section are `with_top.canonically_ordered_comm_semiring` and
`with_bot.ordered_comm_semiring`.
-/

variables {α : Type*}

namespace with_top

variable [decidable_eq α]

section has_mul

variables [has_zero α] [has_mul α]

instance : mul_zero_class (with_top α) :=
{ zero := 0,
  mul := λ m n, if m = 0 ∨ n = 0 then 0 else option.map₂ (*) m n,
  zero_mul := assume a, if_pos $ or.inl rfl,
  mul_zero := assume a, if_pos $ or.inr rfl }

lemma mul_def {a b : with_top α} : a * b = if a = 0 ∨ b = 0 then 0 else option.map₂ (*) a b := rfl

lemma mul_top' {a : with_top α} : a * ⊤ = if a = 0 then 0 else ⊤ :=
by induction a using with_top.rec_top_coe; simp [mul_def]; refl

@[simp] lemma mul_top {a : with_top α} (h : a ≠ 0) : a * ⊤ = ⊤ := by rw [mul_top', if_neg h]

lemma top_mul' {a : with_top α} : ⊤ * a = if a = 0 then 0 else ⊤ :=
by induction a using with_top.rec_top_coe; simp [mul_def]; refl

@[simp] lemma top_mul {a : with_top α} (h : a ≠ 0) : ⊤ * a = ⊤ := by rw [top_mul', if_neg h]

@[simp] lemma top_mul_top : (⊤ * ⊤ : with_top α) = ⊤ :=
top_mul top_ne_zero

theorem mul_eq_top_iff {a b : with_top α} : a * b = ⊤ ↔ a ≠ 0 ∧ b = ⊤ ∨ a = ⊤ ∧ b ≠ 0 :=
begin
  rw [mul_def, ite_eq_iff, ← none_eq_top, option.map₂_eq_none_iff],
  have ha : a = 0 → a ≠ none := λ h, h.symm ▸ zero_ne_top,
  have hb : b = 0 → b ≠ none := λ h, h.symm ▸ zero_ne_top,
  tauto
end

theorem mul_lt_top' [has_lt α] {a b : with_top α} (ha : a < ⊤) (hb : b < ⊤) : a * b < ⊤ :=
begin
  rw [with_top.lt_top_iff_ne_top] at *,
  simp only [ne.def, mul_eq_top_iff, *, and_false, false_and, false_or, not_false_iff]
end

theorem mul_lt_top [has_lt α] {a b : with_top α} (ha : a ≠ ⊤) (hb : b ≠ ⊤) : a * b < ⊤ :=
  mul_lt_top' (with_top.lt_top_iff_ne_top.2 ha) (with_top.lt_top_iff_ne_top.2 hb)

instance [no_zero_divisors α] : no_zero_divisors (with_top α) :=
begin
  refine ⟨λ a b h₁, decidable.by_contradiction $ λ h₂, _⟩,
  rw [mul_def, if_neg h₂] at h₁,
  rcases option.mem_map₂_iff.1 h₁ with ⟨a, b, (rfl : _ = _), (rfl : _ = _), hab⟩,
  exact h₂ ((eq_zero_or_eq_zero_of_mul_eq_zero hab).imp (congr_arg some) (congr_arg some))
end

end has_mul

section mul_zero_class

variables [mul_zero_class α]

@[simp, norm_cast] lemma coe_mul {a b : α} : (↑(a * b) : with_top α) = a * b :=
decidable.by_cases (assume : a = 0, by simp [this]) $ assume ha,
decidable.by_cases (assume : b = 0, by simp [this]) $ assume hb,
by { simp [*, mul_def] }

lemma mul_coe {b : α} (hb : b ≠ 0) : ∀{a : with_top α}, a * b = a.bind (λa:α, ↑(a * b))
| none     := show (if (⊤:with_top α) = 0 ∨ (b:with_top α) = 0 then 0 else ⊤ : with_top α) = ⊤,
    by simp [hb]
| (some a) := show ↑a * ↑b = ↑(a * b), from coe_mul.symm

@[simp] lemma untop'_zero_mul (a b : with_top α) : (a * b).untop' 0 = a.untop' 0 * b.untop' 0 :=
begin
  by_cases ha : a = 0, { rw [ha, zero_mul, ← coe_zero, untop'_coe, zero_mul] },
  by_cases hb : b = 0, { rw [hb, mul_zero, ← coe_zero, untop'_coe, mul_zero] },
  induction a using with_top.rec_top_coe, { rw [top_mul hb, untop'_top, zero_mul] },
  induction b using with_top.rec_top_coe, { rw [mul_top ha, untop'_top, mul_zero] },
  rw [← coe_mul, untop'_coe, untop'_coe, untop'_coe]
end

end mul_zero_class

/-- `nontrivial α` is needed here as otherwise we have `1 * ⊤ = ⊤` but also `0 * ⊤ = 0`. -/
instance [mul_zero_one_class α] [nontrivial α] : mul_zero_one_class (with_top α) :=
{ mul := (*),
  one := 1,
  zero := 0,
  one_mul := λ a, match a with
  | ⊤       := mul_top (mt coe_eq_coe.1 one_ne_zero)
  | (a : α) := by rw [← coe_one, ← coe_mul, one_mul]
  end,
  mul_one := λ a, match a with
  | ⊤       := top_mul (mt coe_eq_coe.1 one_ne_zero)
  | (a : α) := by rw [← coe_one, ← coe_mul, mul_one]
  end,
  .. with_top.mul_zero_class }

/-- A version of `with_top.map` for `monoid_with_zero_hom`s. -/
@[simps { fully_applied := ff }] protected def _root_.monoid_with_zero_hom.with_top_map
  {R S : Type*} [mul_zero_one_class R] [decidable_eq R] [nontrivial R]
  [mul_zero_one_class S] [decidable_eq S] [nontrivial S] (f : R →*₀ S) (hf : function.injective f) :
  with_top R →*₀ with_top S :=
{ to_fun := with_top.map f,
  map_mul' := λ x y,
    begin
      have : ∀ z, map f z = 0 ↔ z = 0,
        from λ z, (option.map_injective hf).eq_iff' f.to_zero_hom.with_top_map.map_zero,
      rcases decidable.eq_or_ne x 0 with rfl|hx, { simp },
      rcases decidable.eq_or_ne y 0 with rfl|hy, { simp },
      induction x using with_top.rec_top_coe, { simp [hy, this] },
      induction y using with_top.rec_top_coe,
      { have : (f x : with_top S) ≠ 0, by simpa [hf.eq_iff' (map_zero f)] using hx,
        simp [hx, this] },
      simp only [← coe_mul, map_coe, map_mul]
    end,
  .. f.to_zero_hom.with_top_map, .. f.to_monoid_hom.to_one_hom.with_top_map }

instance [semigroup_with_zero α] [no_zero_divisors α] : semigroup_with_zero (with_top α) :=
{ mul := (*),
  zero := 0,
  mul_assoc := λ a b c, begin
    rcases eq_or_ne a 0 with rfl|ha, { simp only [zero_mul] },
    rcases eq_or_ne b 0 with rfl|hb, { simp only [zero_mul, mul_zero] },
    rcases eq_or_ne c 0 with rfl|hc, { simp only [mul_zero] },
    induction a using with_top.rec_top_coe, { simp [hb, hc] },
    induction b using with_top.rec_top_coe, { simp [ha, hc] },
    induction c using with_top.rec_top_coe, { simp [ha, hb] },
    simp only [← coe_mul, mul_assoc]
  end,
  .. with_top.mul_zero_class }

instance [monoid_with_zero α] [no_zero_divisors α] [nontrivial α] : monoid_with_zero (with_top α) :=
{ .. with_top.mul_zero_one_class, .. with_top.semigroup_with_zero }

instance [comm_monoid_with_zero α] [no_zero_divisors α] [nontrivial α] :
  comm_monoid_with_zero (with_top α) :=
{ mul := (*),
  zero := 0,
  mul_comm := λ a b,
    by simp only [or_comm, mul_def, mul_comm, @option.map₂_comm _ _ _ _ a b _ mul_comm],
  .. with_top.monoid_with_zero }

variables [canonically_ordered_comm_semiring α]

private

/-- This instance requires `canonically_ordered_comm_semiring` as it is the smallest class
that derives from both `non_assoc_non_unital_semiring` and `canonically_ordered_add_monoid`, both
of which are required for distributivity. -/
instance [nontrivial α] : comm_semiring (with_top α) :=
{ right_distrib   := distrib',
  left_distrib    := λ a b c, by { rw [mul_comm, distrib', mul_comm b, mul_comm c], refl },
  .. with_top.add_comm_monoid_with_one, .. with_top.comm_monoid_with_zero }

instance [nontrivial α] : canonically_ordered_comm_semiring (with_top α) :=
{ .. with_top.comm_semiring,
  .. with_top.canonically_ordered_add_monoid,
  .. with_top.no_zero_divisors, }

/-- A version of `with_top.map` for `ring_hom`s. -/
@[simps { fully_applied := ff }] protected def _root_.ring_hom.with_top_map
  {R S : Type*} [canonically_ordered_comm_semiring R] [decidable_eq R] [nontrivial R]
  [canonically_ordered_comm_semiring S] [decidable_eq S] [nontrivial S]
  (f : R →+* S) (hf : function.injective f) :
  with_top R →+* with_top S :=
{ to_fun := with_top.map f,
  .. f.to_monoid_with_zero_hom.with_top_map hf, .. f.to_add_monoid_hom.with_top_map }

end with_top

namespace with_bot

variable [decidable_eq α]

section has_mul

variables [has_zero α] [has_mul α]

instance : mul_zero_class (with_bot α) :=
with_top.mul_zero_class

lemma mul_def {a b : with_bot α} :
  a * b = if a = 0 ∨ b = 0 then 0 else option.map₂ (*) a b := rfl

@[simp] lemma mul_bot {a : with_bot α} (h : a ≠ 0) : a * ⊥ = ⊥ :=
with_top.mul_top h

@[simp] lemma bot_mul {a : with_bot α} (h : a ≠ 0) : ⊥ * a = ⊥ :=
with_top.top_mul h

@[simp] lemma bot_mul_bot : (⊥ * ⊥ : with_bot α) = ⊥ :=
with_top.top_mul_top

theorem mul_eq_bot_iff {a b : with_bot α} : a * b = ⊥ ↔ a ≠ 0 ∧ b = ⊥ ∨ a = ⊥ ∧ b ≠ 0 :=
with_top.mul_eq_top_iff

theorem bot_lt_mul' [has_lt α] {a b : with_bot α} (ha : ⊥ < a) (hb : ⊥ < b) : ⊥ < a * b :=
@with_top.mul_lt_top' αᵒᵈ _ _ _ _ _ _ ha hb

theorem bot_lt_mul [has_lt α] {a b : with_bot α} (ha : a ≠ ⊥) (hb : b ≠ ⊥) : ⊥ < a * b :=
@with_top.mul_lt_top αᵒᵈ _ _ _ _ _ _ ha hb

end has_mul

section mul_zero_class

variables [mul_zero_class α]

@[norm_cast] lemma coe_mul {a b : α} : (↑(a * b) : with_bot α) = a * b :=
with_top.coe_mul

lemma mul_coe {b : α} (hb : b ≠ 0) {a : with_bot α} : a * b = a.bind (λa:α, ↑(a * b)) :=
with_top.mul_coe hb

end mul_zero_class

/-- `nontrivial α` is needed here as otherwise we have `1 * ⊥ = ⊥` but also `= 0 * ⊥ = 0`. -/
instance [mul_zero_one_class α] [nontrivial α] : mul_zero_one_class (with_bot α) :=
with_top.mul_zero_one_class

instance [mul_zero_class α] [no_zero_divisors α] : no_zero_divisors (with_bot α) :=
with_top.no_zero_divisors

instance [semigroup_with_zero α] [no_zero_divisors α] : semigroup_with_zero (with_bot α) :=
with_top.semigroup_with_zero

instance [monoid_with_zero α] [no_zero_divisors α] [nontrivial α] : monoid_with_zero (with_bot α) :=
with_top.monoid_with_zero

instance [comm_monoid_with_zero α] [no_zero_divisors α] [nontrivial α] :
  comm_monoid_with_zero (with_bot α) :=
with_top.comm_monoid_with_zero

instance [canonically_ordered_comm_semiring α] [nontrivial α] : comm_semiring (with_bot α) :=
with_top.comm_semiring

instance [mul_zero_class α] [preorder α] [pos_mul_mono α] :
  pos_mul_mono (with_bot α) :=
⟨begin
  rintros ⟨x, x0⟩ a b h, simp only [subtype.coe_mk],
  rcases eq_or_ne x 0 with rfl | x0', { simp, },
  lift x to α, { rintro ⟨rfl⟩, exact (with_bot.bot_lt_coe (0 : α)).not_le x0, },
  induction a using with_bot.rec_bot_coe, { simp_rw [mul_bot x0', bot_le] },
  induction b using with_bot.rec_bot_coe, { exact absurd h (bot_lt_coe a).not_le },
  simp only [← coe_mul, coe_le_coe] at *,
  norm_cast at x0,
  exact mul_le_mul_of_nonneg_left h x0,
end ⟩

instance [mul_zero_class α] [preorder α] [mul_pos_mono α] :
  mul_pos_mono (with_bot α) :=
⟨begin
  rintros ⟨x, x0⟩ a b h, simp only [subtype.coe_mk],
  rcases eq_or_ne x 0 with rfl | x0', { simp, },
  lift x to α, { rintro ⟨rfl⟩, exact (with_bot.bot_lt_coe (0 : α)).not_le x0, },
  induction a using with_bot.rec_bot_coe, { simp_rw [bot_mul x0', bot_le] },
  induction b using with_bot.rec_bot_coe, { exact absurd h (bot_lt_coe a).not_le },
  simp only [← coe_mul, coe_le_coe] at *,
  norm_cast at x0,
  exact mul_le_mul_of_nonneg_right h x0,
end ⟩

instance [mul_zero_class α] [preorder α] [pos_mul_strict_mono α] :
  pos_mul_strict_mono (with_bot α) :=
⟨begin
  rintros ⟨x, x0⟩ a b h, simp only [subtype.coe_mk],
  lift x to α using x0.ne_bot,
  induction b using with_bot.rec_bot_coe, { exact absurd h not_lt_bot, },
  induction a using with_bot.rec_bot_coe, { simp_rw [mul_bot x0.ne.symm, ← coe_mul, bot_lt_coe], },
  simp only [← coe_mul, coe_lt_coe] at *,
  norm_cast at x0,
  exact mul_lt_mul_of_pos_left h x0,
end ⟩

instance [mul_zero_class α] [preorder α] [mul_pos_strict_mono α] :
  mul_pos_strict_mono (with_bot α) :=
⟨begin
  rintros ⟨x, x0⟩ a b h, simp only [subtype.coe_mk],
  lift x to α using x0.ne_bot,
  induction b using with_bot.rec_bot_coe, { exact absurd h not_lt_bot, },
  induction a using with_bot.rec_bot_coe, { simp_rw [bot_mul x0.ne.symm, ← coe_mul, bot_lt_coe], },
  simp only [← coe_mul, coe_lt_coe] at *,
  norm_cast at x0,
  exact mul_lt_mul_of_pos_right h x0,
end ⟩

instance [mul_zero_class α] [preorder α] [pos_mul_reflect_lt α] :
  pos_mul_reflect_lt (with_bot α) :=
⟨begin
  rintros ⟨x, x0⟩ a b h, simp only [subtype.coe_mk] at h,
  rcases eq_or_ne x 0 with rfl | x0', { simpa using h, },
  lift x to α, { rintro ⟨rfl⟩, exact (with_bot.bot_lt_coe (0 : α)).not_le x0, },
  induction b using with_bot.rec_bot_coe, { rw [mul_bot x0'] at h, exact absurd h bot_le.not_lt, },
  induction a using with_bot.rec_bot_coe, { exact with_bot.bot_lt_coe _, },
  simp only [← coe_mul, coe_lt_coe] at *,
  norm_cast at x0,
  exact lt_of_mul_lt_mul_left h x0,
end ⟩

instance [mul_zero_class α] [preorder α] [mul_pos_reflect_lt α] :
  mul_pos_reflect_lt (with_bot α) :=
⟨begin
  rintros ⟨x, x0⟩ a b h, simp only [subtype.coe_mk] at h,
  rcases eq_or_ne x 0 with rfl | x0', { simpa using h, },
  lift x to α, { rintro ⟨rfl⟩, exact (with_bot.bot_lt_coe (0 : α)).not_le x0, },
  induction b using with_bot.rec_bot_coe, { rw [bot_mul x0'] at h, exact absurd h bot_le.not_lt, },
  induction a using with_bot.rec_bot_coe, { exact with_bot.bot_lt_coe _, },
  simp only [← coe_mul, coe_lt_coe] at *,
  norm_cast at x0,
  exact lt_of_mul_lt_mul_right h x0,
end ⟩

instance [mul_zero_class α] [preorder α] [pos_mul_mono_rev α] :
  pos_mul_mono_rev (with_bot α) :=
⟨begin
  rintros ⟨x, x0⟩ a b h, simp only [subtype.coe_mk] at h,
  lift x to α using x0.ne_bot,
  induction a using with_bot.rec_bot_coe, { exact bot_le, },
  induction b using with_bot.rec_bot_coe,
  { rw [mul_bot x0.ne.symm, ← coe_mul] at h, exact absurd h (bot_lt_coe (x * a)).not_le, },
  simp only [← coe_mul, coe_le_coe] at *,
  norm_cast at x0,
  exact le_of_mul_le_mul_left h x0,
end ⟩

instance [mul_zero_class α] [preorder α] [mul_pos_mono_rev α] :
  mul_pos_mono_rev (with_bot α) :=
⟨begin
  rintros ⟨x, x0⟩ a b h, simp only [subtype.coe_mk] at h,
  lift x to α using x0.ne_bot,
  induction a using with_bot.rec_bot_coe, { exact bot_le, },
  induction b using with_bot.rec_bot_coe,
  { rw [bot_mul x0.ne.symm, ← coe_mul] at h, exact absurd h (bot_lt_coe (a * x)).not_le, },
  simp only [← coe_mul, coe_le_coe] at *,
  norm_cast at x0,
  exact le_of_mul_le_mul_right h x0,
end ⟩

instance [canonically_ordered_comm_semiring α] [nontrivial α] :
  ordered_comm_semiring (with_bot α) :=
{ mul_le_mul_of_nonneg_left  := λ _ _ _, mul_le_mul_of_nonneg_left,
  mul_le_mul_of_nonneg_right := λ _ _ _, mul_le_mul_of_nonneg_right,
  .. with_bot.zero_le_one_class,
  .. with_bot.ordered_add_comm_monoid,
  .. with_bot.comm_semiring, }

end with_bot


/-
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

! This file was ported from Lean 3 source module measure_theory.integral.vitali_caratheodory
! leanprover-community/mathlib commit 57ac39bd365c2f80589a700f9fbb664d3a1a30c2
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.MeasureTheory.Measure.Regular
import Mathbin.Topology.Semicontinuous
import Mathbin.MeasureTheory.Integral.Bochner
import Mathbin.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 ENNReal NNReal

open MeasureTheory MeasureTheory.Measure

variable {α : Type _} [TopologicalSpace α] [MeasurableSpace α] [BorelSpace α] (μ : Measure α)
  [WeaklyRegular μ]

namespace MeasureTheory

-- mathport name: «expr →ₛ »
local infixr:25 " →ₛ " => SimpleFunc

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

/- ./././Mathport/Syntax/Translate/Basic.lean:635:2: warning: expanding binder collection (u «expr ⊇ » s) -/
/-- 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`. -/
theorem SimpleFunc.exists_le_lowerSemicontinuous_lintegral_ge (f : α →ₛ ℝ≥0) {ε : ℝ≥0∞}
    (ε0 : ε ≠ 0) :
    ∃ g : α → ℝ≥0, (∀ x, f x ≤ g x) ∧ LowerSemicontinuous g ∧ (∫⁻ x, g x ∂μ) ≤ (∫⁻ x, f x ∂μ) + ε :=
  by
  induction' f using MeasureTheory.SimpleFunc.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'
        ⟨fun x => c, fun x => _, lowerSemicontinuous_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' ⟨fun x => 0, _, lowerSemicontinuous_const, _⟩
      ·
        simp only [hc, Set.indicator_zero', Pi.zero_apply, simple_func.const_zero, imp_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, MulZeroClass.zero_mul, zero_le, ENNReal.coe_zero]
    have : μ s < μ s + ε / c :=
      by
      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_iff, simple_func.coe_const,
        Function.const_apply, lintegral_const, ENNReal.coe_indicator, Set.univ_inter,
        ENNReal.coe_ne_top, MeasurableSet.univ, WithTop.mul_eq_top_iff, simple_func.const_zero,
        or_false_iff, 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_iff,
        restrict_apply] using h
    obtain ⟨u, su, u_open, μu⟩ : ∃ (u : _)(_ : u ⊇ s), IsOpen u ∧ μ u < μ s + ε / c :=
      s.exists_is_open_lt_of_lt _ this
    refine'
      ⟨Set.indicator u fun x => c, fun 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 (fun 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, MeasurableSet.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 + ε := by
          simp_rw [mul_add]
          rw [ENNReal.mul_div_cancel' _ ENNReal.coe_ne_top]
          simpa using hc

  · 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'
      ⟨fun x => g₁ x + g₂ x, fun 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
#align measure_theory.simple_func.exists_le_lower_semicontinuous_lintegral_ge MeasureTheory.SimpleFunc.exists_le_lowerSemicontinuous_lintegral_ge

open SimpleFunc (eapproxDiff tsum_eapproxDiff)

/-- 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`. -/
theorem exists_le_lowerSemicontinuous_lintegral_ge (f : α → ℝ≥0∞) (hf : Measurable f) {ε : ℝ≥0∞}
    (εpos : ε ≠ 0) :
    ∃ g : α → ℝ≥0∞,
      (∀ x, f x ≤ g x) ∧ LowerSemicontinuous g ∧ (∫⁻ x, g x ∂μ) ≤ (∫⁻ x, f x ∂μ) + ε :=
  by
  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) ∧
          LowerSemicontinuous g ∧
            (∫⁻ x, g x ∂μ) ≤ (∫⁻ x, simple_func.eapprox_diff f n x ∂μ) + δ n :=
    fun 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' ⟨fun x => ∑' n, g n x, fun x => _, _, _⟩
  · rw [← tsum_eapprox_diff f hf]
    exact ENNReal.tsum_le_tsum fun n => ENNReal.coe_le_coe.2 (f_le_g n x)
  · apply lowerSemicontinuous_tsum fun n => _
    exact
      ennreal.continuous_coe.comp_lower_semicontinuous (gcont n) fun x y hxy =>
        ENNReal.coe_le_coe.2 hxy
  ·
    calc
      (∫⁻ x, ∑' n : ℕ, g n x ∂μ) = ∑' n, ∫⁻ x, g n x ∂μ := by
        rw [lintegral_tsum fun n => (gcont n).Measurable.coe_nNReal_eNNReal.AeMeasurable]
      _ ≤ ∑' 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 ∂μ) + ε := by
        refine' add_le_add _ hδ.le
        rw [← lintegral_tsum]
        · simp_rw [tsum_eapprox_diff f hf, le_refl]
        · intro n
          exact (simple_func.measurable _).coe_nNReal_eNNReal.AeMeasurable

#align measure_theory.exists_le_lower_semicontinuous_lintegral_ge MeasureTheory.exists_le_lowerSemicontinuous_lintegral_ge

/-- 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`. -/
theorem exists_lt_lowerSemicontinuous_lintegral_ge [SigmaFinite μ] (f : α → ℝ≥0)
    (fmeas : Measurable f) {ε : ℝ≥0∞} (ε0 : ε ≠ 0) :
    ∃ g : α → ℝ≥0∞,
      (∀ x, (f x : ℝ≥0∞) < g x) ∧ LowerSemicontinuous g ∧ (∫⁻ x, g x ∂μ) ≤ (∫⁻ x, f x ∂μ) + ε :=
  by
  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, fun 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]

#align measure_theory.exists_lt_lower_semicontinuous_lintegral_ge MeasureTheory.exists_lt_lowerSemicontinuous_lintegral_ge

/-- 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`. -/
theorem exists_lt_lowerSemicontinuous_lintegral_ge_of_aeMeasurable [SigmaFinite μ] (f : α → ℝ≥0)
    (fmeas : AeMeasurable f μ) {ε : ℝ≥0∞} (ε0 : ε ≠ 0) :
    ∃ g : α → ℝ≥0∞,
      (∀ x, (f x : ℝ≥0∞) < g x) ∧ LowerSemicontinuous g ∧ (∫⁻ x, g x ∂μ) ≤ (∫⁻ x, f x ∂μ) + ε :=
  by
  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 fun x => ∞)
      (measurable_const.indicator smeas) this with
    ⟨g1, le_g1, g1_cont, g1_int⟩
  refine' ⟨fun x => g0 x + g1 x, fun 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) :=
        by
        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, MeasurableSet.univ,
            lintegral_indicator, MulZeroClass.mul_zero, restrict_apply]
      _ = (∫⁻ x, f x ∂μ) + ε := by simp only [add_assoc, ENNReal.add_halves, zero_add]

#align measure_theory.exists_lt_lower_semicontinuous_lintegral_ge_of_ae_measurable MeasureTheory.exists_lt_lowerSemicontinuous_lintegral_ge_of_aeMeasurable

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`. -/
theorem exists_lt_lowerSemicontinuous_integral_gt_nNReal [SigmaFinite μ] (f : α → ℝ≥0)
    (fint : Integrable (fun x => (f x : ℝ)) μ) {ε : ℝ} (εpos : 0 < ε) :
    ∃ g : α → ℝ≥0∞,
      (∀ x, (f x : ℝ≥0∞) < g x) ∧
        LowerSemicontinuous g ∧
          (∀ᵐ x ∂μ, g x < ⊤) ∧
            Integrable (fun x => (g x).toReal) μ ∧ (∫ x, (g x).toReal ∂μ) < (∫ x, f x ∂μ) + ε :=
  by
  have fmeas : AeMeasurable f μ :=
    by
    convert fint.ae_strongly_measurable.real_to_nnreal.ae_measurable
    ext1 x
    simp only [Real.toNNReal_coe]
  lift ε to ℝ≥0 using εpos.le
  obtain ⟨δ, δpos, hδε⟩ : ∃ δ : ℝ≥0, 0 < δ ∧ δ < ε
  exact 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.ofReal (g a).toReal ∂μ) = ∫⁻ a : α, g a ∂μ :=
    by
    apply lintegral_congr_ae
    filter_upwards [g_lt_top]with _ hx
    simp only [hx.ne, ENNReal.ofReal_toReal, 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.toReal_nonneg]
    convert gint_ne.lt_top using 1
  · rw [integral_eq_lintegral_of_nonneg_ae, integral_eq_lintegral_of_nonneg_ae]
    ·
      calc
        ENNReal.toReal (∫⁻ a : α, ENNReal.ofReal (g a).toReal ∂μ) =
            ENNReal.toReal (∫⁻ a : α, g a ∂μ) :=
          by congr 1
        _ ≤ ENNReal.toReal ((∫⁻ a : α, f a ∂μ) + δ) :=
          by
          apply ENNReal.toReal_mono _ gint
          simpa using int_f_ne_top
        _ = ENNReal.toReal (∫⁻ a : α, f a ∂μ) + δ := by
          rw [ENNReal.toReal_add int_f_ne_top ENNReal.coe_ne_top, ENNReal.coe_toReal]
        _ < ENNReal.toReal (∫⁻ a : α, f a ∂μ) + ε := (add_lt_add_left hδε _)
        _ = (∫⁻ a : α, ENNReal.ofReal ↑(f a) ∂μ).toReal + ε := by simp

    · apply Filter.eventually_of_forall fun x => _
      simp
    · exact fmeas.coe_nnreal_real.ae_strongly_measurable
    · apply Filter.eventually_of_forall fun x => _
      simp
    · apply gcont.measurable.ennreal_to_real.ae_measurable.ae_strongly_measurable
#align measure_theory.exists_lt_lower_semicontinuous_integral_gt_nnreal MeasureTheory.exists_lt_lowerSemicontinuous_integral_gt_nNReal

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

/- ./././Mathport/Syntax/Translate/Basic.lean:635:2: warning: expanding binder collection (F «expr ⊆ » s) -/
/-- 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`. -/
theorem SimpleFunc.exists_upperSemicontinuous_le_lintegral_le (f : α →ₛ ℝ≥0)
    (int_f : (∫⁻ x, f x ∂μ) ≠ ∞) {ε : ℝ≥0∞} (ε0 : ε ≠ 0) :
    ∃ g : α → ℝ≥0, (∀ x, g x ≤ f x) ∧ UpperSemicontinuous g ∧ (∫⁻ x, f x ∂μ) ≤ (∫⁻ x, g x ∂μ) + ε :=
  by
  induction' f using MeasureTheory.SimpleFunc.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' ⟨fun x => 0, _, upperSemicontinuous_const, _⟩
      ·
        simp only [hc, Set.indicator_zero', Pi.zero_apply, simple_func.const_zero, imp_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, MulZeroClass.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_iff, simple_func.coe_const, or_false_iff,
        lintegral_const, ENNReal.coe_indicator, Set.univ_inter, ENNReal.coe_ne_top,
        restrict_apply MeasurableSet.univ, WithTop.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_iff] using int_f
    have : (0 : ℝ≥0∞) < ε / c := ENNReal.div_pos_iff.2 ⟨ε0, ENNReal.coe_ne_top⟩
    obtain ⟨F, Fs, F_closed, μF⟩ : ∃ (F : _)(_ : F ⊆ s), IsClosed F ∧ μ s < μ F + ε / c :=
      hs.exists_is_closed_lt_add μs_lt_top.ne this.ne'
    refine'
      ⟨Set.indicator F fun x => c, fun 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 (fun 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, MeasurableSet.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 + ε := by
          simp_rw [mul_add]
          rw [ENNReal.mul_div_cancel' _ ENNReal.coe_ne_top]
          simpa using hc

  · 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'
      ⟨fun x => g₁ x + g₂ x, fun 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
#align measure_theory.simple_func.exists_upper_semicontinuous_le_lintegral_le MeasureTheory.SimpleFunc.exists_upperSemicontinuous_le_lintegral_le

/-- 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`. -/
theorem exists_upperSemicontinuous_le_lintegral_le (f : α → ℝ≥0) (int_f : (∫⁻ x, f x ∂μ) ≠ ∞)
    {ε : ℝ≥0∞} (ε0 : ε ≠ 0) :
    ∃ g : α → ℝ≥0, (∀ x, g x ≤ f x) ∧ UpperSemicontinuous g ∧ (∫⁻ x, f x ∂μ) ≤ (∫⁻ x, g x ∂μ) + ε :=
  by
  obtain ⟨fs, fs_le_f, int_fs⟩ :
    ∃ fs : α →ₛ ℝ≥0, (∀ x, fs x ≤ f x) ∧ (∫⁻ x, f x ∂μ) ≤ (∫⁻ x, fs x ∂μ) + ε / 2 :=
    by
    have := ENNReal.lt_add_right int_f (ENNReal.half_pos ε0).ne'
    conv_rhs at this => rw [lintegral_eq_nnreal (fun x => (f x : ℝ≥0∞)) μ]
    erw [ENNReal.bsupᵢ_add] at this <;> [skip, exact ⟨0, fun x => by simp⟩]
    simp only [lt_supᵢ_iff] at this
    rcases this with ⟨fs, fs_le_f, int_fs⟩
    refine' ⟨fs, fun x => by simpa only [ENNReal.coe_le_coe] using fs_le_f x, _⟩
    convert int_fs.le
    rw [← simple_func.lintegral_eq_lintegral]
    rfl
  have int_fs_lt_top : (∫⁻ x, fs x ∂μ) ≠ ∞ :=
    by
    apply ne_top_of_le_ne_top int_f (lintegral_mono fun 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) ∧ UpperSemicontinuous 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, fun 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]

#align measure_theory.exists_upper_semicontinuous_le_lintegral_le MeasureTheory.exists_upperSemicontinuous_le_lintegral_le

/-- 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`. -/
theorem exists_upperSemicontinuous_le_integral_le (f : α → ℝ≥0)
    (fint : Integrable (fun x => (f x : ℝ)) μ) {ε : ℝ} (εpos : 0 < ε) :
    ∃ g : α → ℝ≥0,
      (∀ x, g x ≤ f x) ∧
        UpperSemicontinuous g ∧
          Integrable (fun x => (g x : ℝ)) μ ∧ (∫ x, (f x : ℝ) ∂μ) - ε ≤ ∫ x, g x ∂μ :=
  by
  lift ε to ℝ≥0 using εpos.le
  rw [NNReal.coe_pos, ← ENNReal.coe_pos] at εpos
  have If : (∫⁻ x, f x ∂μ) < ∞ := has_finite_integral_iff_of_nnreal.1 fint.has_finite_integral
  rcases exists_upper_semicontinuous_le_lintegral_le f If.ne εpos.ne' with ⟨g, gf, gcont, gint⟩
  have Ig : (∫⁻ x, g x ∂μ) < ∞ :=
    by
    apply lt_of_le_of_lt (lintegral_mono fun x => _) If
    simpa using gf x
  refine' ⟨g, gf, gcont, _, _⟩
  · refine'
      integrable.mono fint gcont.measurable.coe_nnreal_real.ae_measurable.ae_strongly_measurable _
    exact Filter.eventually_of_forall fun x => by simp [gf x]
  · rw [integral_eq_lintegral_of_nonneg_ae, integral_eq_lintegral_of_nonneg_ae]
    · rw [sub_le_iff_le_add]
      convert ENNReal.toReal_mono _ gint
      · simp
      · rw [ENNReal.toReal_add Ig.ne ENNReal.coe_ne_top]
        simp
      · simpa using Ig.ne
    · apply Filter.eventually_of_forall
      simp
    · exact gcont.measurable.coe_nnreal_real.ae_measurable.ae_strongly_measurable
    · apply Filter.eventually_of_forall
      simp
    · exact fint.ae_strongly_measurable
#align measure_theory.exists_upper_semicontinuous_le_integral_le MeasureTheory.exists_upperSemicontinuous_le_integral_le

/-! ### 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. -/
theorem exists_lt_lowerSemicontinuous_integral_lt [SigmaFinite μ] (f : α → ℝ) (hf : Integrable f μ)
    {ε : ℝ} (εpos : 0 < ε) :
    ∃ g : α → EReal,
      (∀ x, (f x : EReal) < g x) ∧
        LowerSemicontinuous g ∧
          Integrable (fun x => EReal.toReal (g x)) μ ∧
            (∀ᵐ x ∂μ, g x < ⊤) ∧ (∫ x, EReal.toReal (g x) ∂μ) < (∫ x, f x ∂μ) + ε :=
  by
  let δ : ℝ≥0 := ⟨ε / 2, (half_pos εpos).le⟩
  have δpos : 0 < δ := half_pos εpos
  let fp : α → ℝ≥0 := fun x => Real.toNNReal (f x)
  have int_fp : integrable (fun 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 := fun x => Real.toNNReal (-f x)
  have int_fm : integrable (fun 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 := fun x => (gp x : EReal) - gm x
  have ae_g : ∀ᵐ x ∂μ, (g x).toReal = (gp x : EReal).toReal - (gm x : EReal).toReal :=
    by
    filter_upwards [gp_lt_top]with _ hx
    rw [EReal.toReal_sub] <;> simp [hx.ne]
  refine' ⟨g, _, _, _, _, _⟩
  show integrable (fun x => EReal.toReal (g x)) μ
  · rw [integrable_congr ae_g]
    convert gp_integrable.sub gm_integrable
    ext x
    simp
  show (∫ x : α, (g x).toReal ∂μ) < (∫ x : α, f x ∂μ) + ε
  exact
    calc
      (∫ x : α, (g x).toReal ∂μ) = ∫ x : α, EReal.toReal (gp x) - EReal.toReal (gm x) ∂μ :=
        integral_congr_ae ae_g
      _ = (∫ x : α, EReal.toReal (gp x) ∂μ) - ∫ x : α, gm x ∂μ :=
        by
        simp only [EReal.toReal_coe_ennreal, ENNReal.coe_toReal, coe_coe]
        exact integral_sub gp_integrable gm_integrable
      _ < (∫ x : α, ↑(fp x) ∂μ) + ↑δ - ∫ x : α, gm x ∂μ :=
        by
        apply sub_lt_sub_right
        convert gpint
        simp only [EReal.toReal_coe_ennreal]
      _ ≤ (∫ 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
  · intro x
    rw [EReal.coe_real_ereal_eq_coe_toNNReal_sub_coe_toNNReal (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 LowerSemicontinuous g
  · apply LowerSemicontinuous.add'
    ·
      exact
        continuous_coe_ennreal_ereal.comp_lower_semicontinuous gpcont fun x y hxy =>
          EReal.coe_ennreal_le_coe_ennreal_iff.2 hxy
    · apply
        ereal.continuous_neg.comp_upper_semicontinuous_antitone _ fun x y hxy =>
          EReal.neg_le_neg_iff.2 hxy
      dsimp
      apply
        continuous_coe_ennreal_ereal.comp_upper_semicontinuous _ fun x y hxy =>
          EReal.coe_ennreal_le_coe_ennreal_iff.2 hxy
      exact
        ennreal.continuous_coe.comp_upper_semicontinuous gmcont fun x y hxy =>
          ENNReal.coe_le_coe.2 hxy
    · intro x
      exact EReal.continuousAt_add (by simp) (by simp)
#align measure_theory.exists_lt_lower_semicontinuous_integral_lt MeasureTheory.exists_lt_lowerSemicontinuous_integral_lt

/-- **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. -/
theorem exists_upperSemicontinuous_lt_integral_gt [SigmaFinite μ] (f : α → ℝ) (hf : Integrable f μ)
    {ε : ℝ} (εpos : 0 < ε) :
    ∃ g : α → EReal,
      (∀ x, (g x : EReal) < f x) ∧
        UpperSemicontinuous g ∧
          Integrable (fun x => EReal.toReal (g x)) μ ∧
            (∀ᵐ x ∂μ, ⊥ < g x) ∧ (∫ x, f x ∂μ) < (∫ x, EReal.toReal (g x) ∂μ) + ε :=
  by
  rcases exists_lt_lower_semicontinuous_integral_lt (fun x => -f x) hf.neg εpos with
    ⟨g, g_lt_f, gcont, g_integrable, g_lt_top, gint⟩
  refine' ⟨fun x => -g x, _, _, _, _, _⟩
  · exact fun 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 fun 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
#align measure_theory.exists_upper_semicontinuous_lt_integral_gt MeasureTheory.exists_upperSemicontinuous_lt_integral_gt

end MeasureTheory


import category_theory.limits.limits
import category_theory.limits.shapes
import category_theory.yoneda
import category_theory.opposites
import category_theory.types
import category_theory.limits.types
-- set_option trace.simplify.rewrite true
run_cmd mk_simp_attr `PRODUCT    -----  BOF BOF
meta def PRODUCT_CAT  : tactic unit :=
`[  try {simp only with PRODUCT}]
run_cmd add_interactive [`PRODUCT_CAT]

universes v u
open category_theory
open category_theory.limits
open category_theory.category
open opposite

namespace Product_stuff
open category_theory.limits
notation f ` ⊗ `:20 g :20     := limits.prod.map f g  ---- 20 comprendre les choses ici
notation `T`C :20              := (terminal C)
notation  `T`X : 20            := (terminal.from X)
notation  f ` | `:20 g :20     :=  prod.lift f g
notation  `π1`                 := limits.prod.fst
notation  `π2`                 := limits.prod.snd

variables (C : Type u)
variables [𝒞 : category.{v} C]
variables  [has_binary_products.{v} C][has_terminal.{v} C]
include 𝒞

example  {Y A B : C} (f : Y ⟶ A) (g : Y ⟶ B) : ( f | g) ≫ π1 = f  :=  prod.lift_fst  C f g
/-
     we can type π : A ⨯ B ⟶ B if we need
-/
example  {Y A B : C} (f : Y ⟶ A) (g : Y ⟶ B) : ( f | g) ≫ (π2 : A ⨯ B ⟶ B) = g := prod.lift_snd C f g

example  {A X Y : C} {a b : A ⟶ X ⨯ Y} (h1 : a ≫ π1  = b ≫ π1 ) (h2 : a ≫ π2  = b ≫ π2)  : a = b :=  prod.hom_ext C h1 h2

 lemma Identity (A B : C) : ( π1 | π2 ) = 𝟙 (A ⨯ B) := begin
     apply prod.hom_ext,
     rw id_comp,
     rw prod.lift_fst,
     rw id_comp,
     rw prod.lift_snd,
end
/-!
# h ≫ (f | g)  = (h ≫ f | h ≫ g)
!-/
lemma prod.left_composition {Z' Z A B : C}(h : Z' ⟶ Z)(f : Z ⟶ A)(g : Z ⟶ B)  :
               h ≫ (f | g)  = (h ≫ f | h ≫ g) :=
begin
     apply prod.hom_ext,   --- Le right member is of the form ( | )  composition π1 π2
     slice_lhs 1 3 {
          rw prod.lift_fst,
     },
     rw prod.lift_fst,
     slice_lhs 2 3 {
          rw prod.lift_snd,
     },
     rw prod.lift_snd,
end
lemma prod.map_fst{X Y Z W : C}(f  : X ⟶ Y)(g  : Z ⟶ W) :
      (f ⊗ g) ≫ (π1 : Y ⨯ W ⟶ Y) = π1  ≫ f :=  limit.map_π (map_pair f g) walking_pair.left
lemma prod.map_snd{X Y Z W : C}(f  : X ⟶ Y)(g  : Z ⟶ W) :
(f ⊗ g) ≫ π2 = π2 ≫ g :=   limit.map_π (map_pair f g) walking_pair.right
/-
(f ⊗ g) = ( π1  ≫ f | π2 ≫ g )
-/
lemma  prod.otimes_is_prod {X Y Z W : C}(f  : X ⟶ Y)(g  : Z ⟶ W) :
     (f ⊗ g) = ( π1  ≫ f | π2 ≫ g ) :=
begin
     apply prod.hom_ext,
     rw [prod.map_fst,prod.lift_fst],
     rw [prod.map_snd,prod.lift_snd],
end
/-
(f1 ⊗ g1) = (f2 ⊗ g2) →   π1  ≫ f1 = (π1 : X ⨯ Z ⟶ X)  ≫ f2
-/
lemma prod.map_ext{X Y Z W : C}(f1 f2  : X ⟶ Y)(g1 g2  : Z ⟶ W) :  (f1 ⊗ g1) = (f2 ⊗ g2) →
     π1  ≫ f1 = (π1 : X ⨯ Z ⟶ X)  ≫ f2 :=
     λ certif, begin
     rw ← prod.map_fst C( f1)  (g1),
     rw ← prod.map_fst C (f2)  (g2),
     rw certif,
end
lemma prod.map_eq {X Y Z W : C}(f1 f2  : X ⟶ Y)(g1 g2  : Z ⟶ W) :
 ((π1 : X ⨯ Z ⟶ X) ≫ f1 = (π1 : X ⨯ Z ⟶ X)  ≫ f2) →
 ((π2 : X ⨯ Z ⟶ Z) ≫ g1 = (π2 : X ⨯ Z ⟶ Z)  ≫ g2) → ((f1 ⊗ g1) = (f2 ⊗ g2)) :=
  λ certif1 certif2, begin
     iterate 2 {rw prod.otimes_is_prod},
--     PRODUCT_CAT,
    rw certif1, rw certif2,
end
/-
(f1 | f2) ≫ (g1 ⊗ g2)  = (f1 ≫ g1 | f2 ≫ g2 )
-/
lemma prod.prod_comp_otimes {A1 A2 X1 X2 Z: C} (f1 :  Z ⟶ A1)(f2  : Z ⟶ A2)
(g1 :A1  ⟶  X1 )(g2 : A2 ⟶ X2) :
     (f1 | f2) ≫ (g1 ⊗ g2)  = (f1 ≫ g1 | f2 ≫ g2 ) := begin

     apply prod.hom_ext,
     rw prod.otimes_is_prod,
     iterate 1 {rw prod.lift_fst},
     slice_lhs 2  3{
          rw prod.lift_fst,
     },
     slice_lhs 1 2 {
          rw prod.lift_fst,
     },
     tidy,
     end
end Product_stuff


/-
Copyright (c) 2018 Michael Jendrusch. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Michael Jendrusch, Scott Morrison
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.category_theory.monoidal.of_chosen_finite_products
import Mathlib.category_theory.limits.shapes.finite_products
import Mathlib.category_theory.limits.shapes.types
import Mathlib.PostPort

universes u

namespace Mathlib

/-!
# The category of types is a symmetric monoidal category
-/

namespace category_theory.monoidal

protected instance types_monoidal : monoidal_category (Type u) :=
  monoidal_of_chosen_finite_products limits.types.terminal_limit_cone limits.types.binary_product_limit_cone

protected instance types_symmetric : symmetric_category (Type u) :=
  symmetric_of_chosen_finite_products limits.types.terminal_limit_cone limits.types.binary_product_limit_cone

@[simp] theorem tensor_apply {W : Type u} {X : Type u} {Y : Type u} {Z : Type u} (f : W ⟶ X) (g : Y ⟶ Z) (p : W ⊗ Y) : monoidal_category.tensor_hom f g p = (f (prod.fst p), g (prod.snd p)) :=
  rfl

@[simp] theorem left_unitor_hom_apply {X : Type u} {x : X} {p : PUnit} : iso.hom λ_ (p, x) = x :=
  rfl

@[simp] theorem left_unitor_inv_apply {X : Type u} {x : X} : iso.inv λ_ x = (PUnit.unit, x) :=
  rfl

@[simp] theorem right_unitor_hom_apply {X : Type u} {x : X} {p : PUnit} : iso.hom ρ_ (x, p) = x :=
  rfl

@[simp] theorem right_unitor_inv_apply {X : Type u} {x : X} : iso.inv ρ_ x = (x, PUnit.unit) :=
  rfl

@[simp] theorem associator_hom_apply {X : Type u} {Y : Type u} {Z : Type u} {x : X} {y : Y} {z : Z} : iso.hom α_ ((x, y), z) = (x, y, z) :=
  rfl

@[simp] theorem associator_inv_apply {X : Type u} {Y : Type u} {Z : Type u} {x : X} {y : Y} {z : Z} : iso.inv α_ (x, y, z) = ((x, y), z) :=
  rfl

@[simp] theorem braiding_hom_apply {X : Type u} {Y : Type u} {x : X} {y : Y} : iso.hom β_ (x, y) = (y, x) :=
  rfl

@[simp] theorem braiding_inv_apply {X : Type u} {Y : Type u} {x : X} {y : Y} : iso.inv β_ (y, x) = (x, y) :=
  rfl


/- Author: E.W.Ayers © 2019 -/
import ..equate
import algebra.archimedean
open robot
universe u

variables {R : Type u} [linear_ordered_ring R] [floor_ring R] {x : R}

attribute [equate] int.cast_neg
attribute [equate] floor_coe
attribute [equate] floor_add_int
attribute [equate] floor_sub_int

@[equate] lemma ciel_def : ⌈x⌉ = -⌊-x⌋ := rfl
-- attribute [equate] neg_neg

@[equate] lemma my_ciel_coe (z : ℤ) : z = ⌈(z:R)⌉ :=
by equate

@[equate] theorem my_ceil_add_int (x : R) (z : ℤ) : ⌈x + z⌉ = ⌈x⌉ + z :=
by equate
-- [FIXME] bug where it thinks `0 = x * 0` is a good idea. Should be forbidden.


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

universes u_1 u_2 u

namespace Mathlib

/-!
## Polynomials over finite fields
-/

namespace mv_polynomial

/-- A polynomial over the integers is divisible by `n : ℕ`
if and only if it is zero over `zmod n`. -/
theorem C_dvd_iff_zmod {σ : Type u_1} (n : ℕ) (φ : mv_polynomial σ ℤ) : coe_fn C ↑n ∣ φ ↔ coe_fn (map (int.cast_ring_hom (zmod n))) φ = 0 :=
  C_dvd_iff_map_hom_eq_zero (int.cast_ring_hom (zmod n)) (↑n) (char_p.int_cast_eq_zero_iff (zmod n) n) φ

theorem frobenius_zmod {σ : Type u_1} {p : ℕ} [fact (nat.prime p)] (f : mv_polynomial σ (zmod p)) : coe_fn (frobenius (mv_polynomial σ (zmod p)) p) f = coe_fn (expand p) f := sorry

theorem expand_zmod {σ : Type u_1} {p : ℕ} [fact (nat.prime p)] (f : mv_polynomial σ (zmod p)) : coe_fn (expand p) f = f ^ p :=
  Eq.symm (frobenius_zmod f)

end mv_polynomial

namespace mv_polynomial

def indicator {K : Type u_1} {σ : Type u_2} [field K] [fintype K] [fintype σ] (a : σ → K) : mv_polynomial σ K :=
  finset.prod finset.univ fun (n : σ) => 1 - (X n - coe_fn C (a n)) ^ (fintype.card K - 1)

theorem eval_indicator_apply_eq_one {K : Type u_1} {σ : Type u_2} [field K] [fintype K] [fintype σ] (a : σ → K) : coe_fn (eval a) (indicator a) = 1 := sorry

theorem eval_indicator_apply_eq_zero {K : Type u_1} {σ : Type u_2} [field K] [fintype K] [fintype σ] (a : σ → K) (b : σ → K) (h : a ≠ b) : coe_fn (eval a) (indicator b) = 0 := sorry

theorem degrees_indicator {K : Type u_1} {σ : Type u_2} [field K] [fintype K] [fintype σ] (c : σ → K) : degrees (indicator c) ≤ finset.sum finset.univ fun (s : σ) => (fintype.card K - 1) •ℕ singleton s := sorry

theorem indicator_mem_restrict_degree {K : Type u_1} {σ : Type u_2} [field K] [fintype K] [fintype σ] (c : σ → K) : indicator c ∈ restrict_degree σ K (fintype.card K - 1) := sorry

def evalₗ (K : Type u_1) (σ : Type u_2) [field K] [fintype K] [fintype σ] : linear_map K (mv_polynomial σ K) ((σ → K) → K) :=
  linear_map.mk (fun (p : mv_polynomial σ K) (e : σ → K) => coe_fn (eval e) p) sorry sorry

theorem evalₗ_apply {K : Type u_1} {σ : Type u_2} [field K] [fintype K] [fintype σ] (p : mv_polynomial σ K) (e : σ → K) : coe_fn (evalₗ K σ) p e = coe_fn (eval e) p :=
  rfl

theorem map_restrict_dom_evalₗ {K : Type u_1} {σ : Type u_2} [field K] [fintype K] [fintype σ] : submodule.map (evalₗ K σ) (restrict_degree σ K (fintype.card K - 1)) = ⊤ := sorry

end mv_polynomial

namespace mv_polynomial

def R (σ : Type u) (K : Type u) [fintype σ] [field K] [fintype K] :=
  ↥(restrict_degree σ K (fintype.card K - 1))

protected instance decidable_restrict_degree (σ : Type u) [fintype σ] (m : ℕ) : decidable_pred fun (n : σ →₀ ℕ) => n ∈ set_of fun (n : σ →₀ ℕ) => ∀ (i : σ), coe_fn n i ≤ m :=
  eq.mpr sorry fun (a : σ →₀ ℕ) => fintype.decidable_forall_fintype

theorem dim_R (σ : Type u) (K : Type u) [fintype σ] [field K] [fintype K] : vector_space.dim K (R σ K) = ↑(fintype.card (σ → K)) := sorry

def evalᵢ (σ : Type u) (K : Type u) [fintype σ] [field K] [fintype K] : linear_map K (R σ K) ((σ → K) → K) :=
  linear_map.comp (evalₗ K σ) (submodule.subtype (restrict_degree σ K (fintype.card K - 1)))

theorem range_evalᵢ (σ : Type u) (K : Type u) [fintype σ] [field K] [fintype K] : linear_map.range (evalᵢ σ K) = ⊤ := sorry

theorem ker_evalₗ (σ : Type u) (K : Type u) [fintype σ] [field K] [fintype K] : linear_map.ker (evalᵢ σ K) = ⊥ := sorry

theorem eq_zero_of_eval_eq_zero (σ : Type u) (K : Type u) [fintype σ] [field K] [fintype K] (p : mv_polynomial σ K) (h : ∀ (v : σ → K), coe_fn (eval v) p = 0) (hp : p ∈ restrict_degree σ K (fintype.card K - 1)) : p = 0 := sorry


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

import algebraic_geometry.ringed_space
import algebraic_geometry.stalks
import logic.equiv.transfer_instance

/-!
# The category of locally ringed spaces

We define (bundled) locally ringed spaces (as `SheafedSpace CommRing` along with the fact that the
stalks are local rings), and morphisms between these (morphisms in `SheafedSpace` with
`is_local_ring_hom` on the stalk maps).
-/

universes v u

open category_theory
open Top
open topological_space
open opposite
open category_theory.category category_theory.functor

namespace algebraic_geometry

/-- A `LocallyRingedSpace` is a topological space equipped with a sheaf of commutative rings
such that all the stalks are local rings.

A morphism of locally ringed spaces is a morphism of ringed spaces
such that the morphisms induced on stalks are local ring homomorphisms. -/
@[nolint has_inhabited_instance]
structure LocallyRingedSpace extends SheafedSpace CommRing :=
(local_ring : ∀ x, local_ring (presheaf.stalk x))

attribute [instance] LocallyRingedSpace.local_ring

namespace LocallyRingedSpace

variables (X : LocallyRingedSpace)

/--
An alias for `to_SheafedSpace`, where the result type is a `RingedSpace`.
This allows us to use dot-notation for the `RingedSpace` namespace.
 -/
def to_RingedSpace : RingedSpace := X.to_SheafedSpace

/-- The underlying topological space of a locally ringed space. -/
def to_Top : Top := X.1.carrier

instance : has_coe_to_sort LocallyRingedSpace (Type u) :=
⟨λ X : LocallyRingedSpace, (X.to_Top : Type u)⟩

instance (x : X) : _root_.local_ring (X.to_PresheafedSpace.stalk x) := X.local_ring x

-- PROJECT: how about a typeclass "has_structure_sheaf" to mediate the 𝒪 notation, rather
-- than defining it over and over for PresheafedSpace, LRS, Scheme, etc.

/-- The structure sheaf of a locally ringed space. -/
def 𝒪 : sheaf CommRing X.to_Top := X.to_SheafedSpace.sheaf

/-- A morphism of locally ringed spaces is a morphism of ringed spaces
 such that the morphims induced on stalks are local ring homomorphisms. -/
def hom (X Y : LocallyRingedSpace) : Type* :=
{ f : X.to_SheafedSpace ⟶ Y.to_SheafedSpace //
    ∀ x, is_local_ring_hom (PresheafedSpace.stalk_map f x) }

instance : quiver LocallyRingedSpace := ⟨hom⟩

@[ext] lemma hom_ext {X Y : LocallyRingedSpace} (f g : hom X Y) (w : f.1 = g.1) : f = g :=
subtype.eq w

/--
The stalk of a locally ringed space, just as a `CommRing`.
-/
-- TODO perhaps we should make a bundled `LocalRing` and return one here?
-- TODO define `sheaf.stalk` so we can write `X.𝒪.stalk` here?
noncomputable
def stalk (X : LocallyRingedSpace) (x : X) : CommRing := X.presheaf.stalk x

/--
A morphism of locally ringed spaces `f : X ⟶ Y` induces
a local ring homomorphism from `Y.stalk (f x)` to `X.stalk x` for any `x : X`.
-/
noncomputable
def stalk_map {X Y : LocallyRingedSpace} (f : X ⟶ Y) (x : X) :
  Y.stalk (f.1.1 x) ⟶ X.stalk x :=
PresheafedSpace.stalk_map f.1 x

instance {X Y : LocallyRingedSpace} (f : X ⟶ Y) (x : X) :
  is_local_ring_hom (stalk_map f x) := f.2 x

instance {X Y : LocallyRingedSpace} (f : X ⟶ Y) (x : X) :
   is_local_ring_hom (PresheafedSpace.stalk_map f.1 x) := f.2 x

/-- The identity morphism on a locally ringed space. -/
@[simps]
def id (X : LocallyRingedSpace) : hom X X :=
⟨𝟙 _, λ x, by { erw PresheafedSpace.stalk_map.id, apply is_local_ring_hom_id, }⟩

instance (X : LocallyRingedSpace) : inhabited (hom X X) := ⟨id X⟩

/-- Composition of morphisms of locally ringed spaces. -/
@[simps]
def comp {X Y Z : LocallyRingedSpace} (f : hom X Y) (g : hom Y Z) : hom X Z :=
⟨f.val ≫ g.val, λ x,
begin
  erw PresheafedSpace.stalk_map.comp,
  exact @is_local_ring_hom_comp _ _ _ _ _ _ _ _ (f.2 _) (g.2 _),
end⟩

/-- The category of locally ringed spaces. -/
instance : category LocallyRingedSpace :=
{ hom := hom,
  id := id,
  comp := λ X Y Z f g, comp f g,
  comp_id' := by { intros, ext1, simp, },
  id_comp' := by { intros, ext1, simp, },
  assoc' := by { intros, ext1, simp, }, }.

/-- The forgetful functor from `LocallyRingedSpace` to `SheafedSpace CommRing`. -/
@[simps] def forget_to_SheafedSpace : LocallyRingedSpace ⥤ SheafedSpace CommRing :=
{ obj := λ X, X.to_SheafedSpace,
  map := λ X Y f, f.1, }

instance : faithful forget_to_SheafedSpace := {}

/-- The forgetful functor from `LocallyRingedSpace` to `Top`. -/
@[simps]
def forget_to_Top : LocallyRingedSpace ⥤ Top :=
forget_to_SheafedSpace ⋙ SheafedSpace.forget _

@[simp] lemma comp_val {X Y Z : LocallyRingedSpace} (f : X ⟶ Y) (g : Y ⟶ Z) :
  (f ≫ g).val = f.val ≫ g.val := rfl

@[simp] lemma comp_val_c {X Y Z : LocallyRingedSpace} (f : X ⟶ Y) (g : Y ⟶ Z) :
  (f ≫ g).val.c = g.val.c ≫ (presheaf.pushforward _ g.val.base).map f.val.c := rfl

lemma comp_val_c_app {X Y Z : LocallyRingedSpace} (f : X ⟶ Y) (g : Y ⟶ Z) (U : (opens Z)ᵒᵖ) :
  (f ≫ g).val.c.app U = g.val.c.app U ≫ f.val.c.app (op $ (opens.map g.val.base).obj U.unop) :=
rfl

/--
Given two locally ringed spaces `X` and `Y`, an isomorphism between `X` and `Y` as _sheafed_
spaces can be lifted to a morphism `X ⟶ Y` as locally ringed spaces.

See also `iso_of_SheafedSpace_iso`.
-/
@[simps]
def hom_of_SheafedSpace_hom_of_is_iso {X Y : LocallyRingedSpace}
  (f : X.to_SheafedSpace ⟶ Y.to_SheafedSpace) [is_iso f] : X ⟶ Y :=
subtype.mk f $ λ x,
-- Here we need to see that the stalk maps are really local ring homomorphisms.
-- This can be solved by type class inference, because stalk maps of isomorphisms are isomorphisms
-- and isomorphisms are local ring homomorphisms.
show is_local_ring_hom (PresheafedSpace.stalk_map
  (SheafedSpace.forget_to_PresheafedSpace.map f) x),
by apply_instance

/--
Given two locally ringed spaces `X` and `Y`, an isomorphism between `X` and `Y` as _sheafed_
spaces can be lifted to an isomorphism `X ⟶ Y` as locally ringed spaces.

This is related to the property that the functor `forget_to_SheafedSpace` reflects isomorphisms.
In fact, it is slightly stronger as we do not require `f` to come from a morphism between
_locally_ ringed spaces.
-/
def iso_of_SheafedSpace_iso {X Y : LocallyRingedSpace}
  (f : X.to_SheafedSpace ≅ Y.to_SheafedSpace) : X ≅ Y :=
{ hom := hom_of_SheafedSpace_hom_of_is_iso f.hom,
  inv := hom_of_SheafedSpace_hom_of_is_iso f.inv,
  hom_inv_id' := hom_ext _ _ f.hom_inv_id,
  inv_hom_id' := hom_ext _ _ f.inv_hom_id }

instance : reflects_isomorphisms forget_to_SheafedSpace :=
{ reflects := λ X Y f i,
  { out := by exactI
    ⟨hom_of_SheafedSpace_hom_of_is_iso (category_theory.inv (forget_to_SheafedSpace.map f)),
      hom_ext _ _ (is_iso.hom_inv_id _), hom_ext _ _ (is_iso.inv_hom_id _)⟩ } }

instance is_SheafedSpace_iso {X Y : LocallyRingedSpace} (f : X ⟶ Y) [is_iso f] :
  is_iso f.1 :=
LocallyRingedSpace.forget_to_SheafedSpace.map_is_iso f

/--
The restriction of a locally ringed space along an open embedding.
-/
@[simps]
def restrict {U : Top} (X : LocallyRingedSpace) {f : U ⟶ X.to_Top}
  (h : open_embedding f) : LocallyRingedSpace :=
{ local_ring :=
  begin
    intro x,
    dsimp at *,
    -- We show that the stalk of the restriction is isomorphic to the original stalk,
    apply @ring_equiv.local_ring _ _ _ (X.local_ring (f x)),
    exact (X.to_PresheafedSpace.restrict_stalk_iso h x).symm.CommRing_iso_to_ring_equiv,
  end,
  to_SheafedSpace := X.to_SheafedSpace.restrict h }

/-- The canonical map from the restriction to the supspace. -/
def of_restrict {U : Top} (X : LocallyRingedSpace) {f : U ⟶ X.to_Top}
  (h : open_embedding f) : X.restrict h ⟶ X :=
⟨X.to_PresheafedSpace.of_restrict h, λ x, infer_instance⟩

/--
The restriction of a locally ringed space `X` to the top subspace is isomorphic to `X` itself.
-/
def restrict_top_iso (X : LocallyRingedSpace) :
  X.restrict (opens.open_embedding ⊤) ≅ X :=
@iso_of_SheafedSpace_iso (X.restrict (opens.open_embedding ⊤)) X
  X.to_SheafedSpace.restrict_top_iso

/--
The global sections, notated Gamma.
-/
def Γ : LocallyRingedSpaceᵒᵖ ⥤ CommRing :=
forget_to_SheafedSpace.op ⋙ SheafedSpace.Γ

lemma Γ_def : Γ = forget_to_SheafedSpace.op ⋙ SheafedSpace.Γ := rfl

@[simp] lemma Γ_obj (X : LocallyRingedSpaceᵒᵖ) : Γ.obj X = (unop X).presheaf.obj (op ⊤) := rfl

lemma Γ_obj_op (X : LocallyRingedSpace) : Γ.obj (op X) = X.presheaf.obj (op ⊤) := rfl

@[simp] lemma Γ_map {X Y : LocallyRingedSpaceᵒᵖ} (f : X ⟶ Y) :
  Γ.map f = f.unop.1.c.app (op ⊤) := rfl

lemma Γ_map_op {X Y : LocallyRingedSpace} (f : X ⟶ Y) :
  Γ.map f.op = f.1.c.app (op ⊤) := rfl

lemma preimage_basic_open {X Y : LocallyRingedSpace} (f : X ⟶ Y) {U : opens Y}
  (s : Y.presheaf.obj (op U)) :
  (opens.map f.1.base).obj (Y.to_RingedSpace.basic_open s) =
    @RingedSpace.basic_open X.to_RingedSpace ((opens.map f.1.base).obj U) (f.1.c.app _ s) :=
begin
  ext,
  split,
  { rintros ⟨⟨y, hyU⟩, (hy : is_unit _), (rfl : y = _)⟩,
    erw RingedSpace.mem_basic_open _ _ ⟨x, show x ∈ (opens.map f.1.base).obj U, from hyU⟩,
    rw ← PresheafedSpace.stalk_map_germ_apply,
    exact (PresheafedSpace.stalk_map f.1 _).is_unit_map hy },
  { rintros ⟨y, (hy : is_unit _), rfl⟩,
    erw RingedSpace.mem_basic_open _ _ ⟨f.1.base y.1, y.2⟩,
    rw ← PresheafedSpace.stalk_map_germ_apply at hy,
    exact (is_unit_map_iff (PresheafedSpace.stalk_map f.1 _) _).mp hy }
end

-- This actually holds for all ringed spaces with nontrivial stalks.
@[simp] lemma basic_open_zero (X : LocallyRingedSpace) (U : opens X.carrier) :
  X.to_RingedSpace.basic_open (0 : X.presheaf.obj $ op U) = ∅ :=
begin
  ext,
  simp only [set.mem_empty_eq, topological_space.opens.empty_eq, topological_space.opens.mem_coe,
    opens.coe_bot, iff_false, RingedSpace.basic_open, is_unit_zero_iff, set.mem_set_of_eq,
    map_zero],
  rintro ⟨⟨y, _⟩, h, e⟩,
  exact @zero_ne_one (X.presheaf.stalk y) _ _ h,
end

instance component_nontrivial (X : LocallyRingedSpace) (U : opens X.carrier)
  [hU : nonempty U] : nontrivial (X.presheaf.obj $ op U) :=
(X.to_PresheafedSpace.presheaf.germ hU.some).domain_nontrivial

end LocallyRingedSpace

end algebraic_geometry


universes u
variables {α : Type u}

open nat
open list

theorem nth_le_mem : ∀ (l : list α) n h, nth_le l n h ∈ l
| (a :: l) 0     h := mem_cons_self _ _
| (a :: l) (n+1) h := mem_cons_of_mem _ (nth_le_mem l n _)


/-
Copyright (c) 2020 Markus Himmel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Markus Himmel
-/
import linear_algebra.isomorphisms
import algebra.category.Module.kernels
import algebra.category.Module.limits
import category_theory.abelian.exact

/-!
# The category of left R-modules is abelian.

Additionally, two linear maps are exact in the categorical sense iff `range f = ker g`.
-/

open category_theory
open category_theory.limits

noncomputable theory

universes w v u

namespace Module
variables {R : Type u} [ring R] {M N : Module.{v} R} (f : M ⟶ N)

/-- In the category of modules, every monomorphism is normal. -/
def normal_mono (hf : mono f) : normal_mono f :=
{ Z := of R (N ⧸ f.range),
  g := f.range.mkq,
  w := linear_map.range_mkq_comp _,
  is_limit :=
    is_kernel.iso_kernel _ _ (kernel_is_limit _)
      /- The following [invalid Lean code](https://github.com/leanprover-community/lean/issues/341)
        might help you understand what's going on here:
        ```
        calc
        M   ≃ₗ[R] f.ker.quotient  : (submodule.quot_equiv_of_eq_bot _ (ker_eq_bot_of_mono _)).symm
        ... ≃ₗ[R] f.range         : linear_map.quot_ker_equiv_range f
        ... ≃ₗ[R] r.range.mkq.ker : linear_equiv.of_eq _ _ (submodule.ker_mkq _).symm
        ```
      -/
      (linear_equiv.to_Module_iso'
        ((submodule.quot_equiv_of_eq_bot _ (ker_eq_bot_of_mono _)).symm ≪≫ₗ
          ((linear_map.quot_ker_equiv_range f) ≪≫ₗ
            (linear_equiv.of_eq _ _ (submodule.ker_mkq _).symm)))) $
      by { ext, refl } }

/-- In the category of modules, every epimorphism is normal. -/
def normal_epi (hf : epi f) : normal_epi f :=
{ W := of R f.ker,
  g := f.ker.subtype,
  w := linear_map.comp_ker_subtype _,
  is_colimit :=
    is_cokernel.cokernel_iso _ _ (cokernel_is_colimit _)
      (linear_equiv.to_Module_iso'
      /- The following invalid Lean code might help you understand what's going on here:
        ```
        calc f.ker.subtype.range.quotient
            ≃ₗ[R] f.ker.quotient : submodule.quot_equiv_of_eq _ _ (submodule.range_subtype _)
        ... ≃ₗ[R] f.range        : linear_map.quot_ker_equiv_range f
        ... ≃ₗ[R] N              : linear_equiv.of_top _ (range_eq_top_of_epi _)
        ```
      -/
        (((submodule.quot_equiv_of_eq _ _ (submodule.range_subtype _)) ≪≫ₗ
          (linear_map.quot_ker_equiv_range f)) ≪≫ₗ
          (linear_equiv.of_top _ (range_eq_top_of_epi _)))) $
      by { ext, refl } }

/-- The category of R-modules is abelian. -/
instance abelian : abelian (Module R) :=
{ has_finite_products := ⟨λ n, limits.has_limits_of_shape_of_has_limits⟩,
  has_kernels := limits.has_kernels_of_has_equalizers (Module R),
  has_cokernels := has_cokernels_Module,
  normal_mono_of_mono := λ X Y, normal_mono,
  normal_epi_of_epi := λ X Y, normal_epi }

section reflects_limits
/- We need to put this in this weird spot because we need to know that the category of modules
    is balanced. -/

instance forget_reflects_limits_of_size :
  reflects_limits_of_size.{v v} (forget (Module.{max v w} R)) :=
reflects_limits_of_reflects_isomorphisms

instance forget₂_reflects_limits_of_size :
  reflects_limits_of_size.{v v} (forget₂ (Module.{max v w} R) AddCommGroup.{max v w}) :=
reflects_limits_of_reflects_isomorphisms

instance forget_reflects_limits : reflects_limits (forget (Module.{v} R)) :=
Module.forget_reflects_limits_of_size.{v v}

instance forget₂_reflects_limits : reflects_limits (forget₂ (Module.{v} R) AddCommGroup.{v}) :=
Module.forget₂_reflects_limits_of_size.{v v}

end reflects_limits

variables {O : Module.{v} R} (g : N ⟶ O)

open linear_map
local attribute [instance] preadditive.has_equalizers_of_has_kernels

theorem exact_iff : exact f g ↔ f.range = g.ker :=
begin
  rw abelian.exact_iff' f g (kernel_is_limit _) (cokernel_is_colimit _),
  exact ⟨λ h, le_antisymm (range_le_ker_iff.2 h.1) (ker_le_range_iff.2 h.2),
    λ h, ⟨range_le_ker_iff.1 $ le_of_eq h, ker_le_range_iff.1 $ le_of_eq h.symm⟩⟩
end

end Module


/-
Copyright (c) 2018 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import category_theory.natural_isomorphism
import logic.equiv.defs

/-!
# Full and faithful functors

> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
> Any changes to this file require a corresponding PR to mathlib4.

We define typeclasses `full` and `faithful`, decorating functors.

## Main definitions and results
* Use `F.map_injective` to retrieve the fact that `F.map` is injective when `[faithful F]`.
* Similarly, `F.map_surjective` states that `F.map` is surjective when `[full F]`.
* Use `F.preimage` to obtain preimages of morphisms when `[full F]`.
* We prove some basic "cancellation" lemmas for full and/or faithful functors, as well as a
  construction for "dividing" a functor by a faithful functor, see `faithful.div`.
* `full F` carries data, so definitional properties of the preimage can be used when using
  `F.preimage`. To obtain an instance of `full F` non-constructively, you can use `full_of_exists`
  and `full_of_surjective`.

See `category_theory.equivalence.of_fully_faithful_ess_surj` for the fact that a functor is an
equivalence if and only if it is fully faithful and essentially surjective.

-/

-- declare the `v`'s first; see `category_theory.category` for an explanation
universes v₁ v₂ v₃ u₁ u₂ u₃

namespace category_theory

variables {C : Type u₁} [category.{v₁} C] {D : Type u₂} [category.{v₂} D]

/--
A functor `F : C ⥤ D` is full if for each `X Y : C`, `F.map` is surjective.
In fact, we use a constructive definition, so the `full F` typeclass contains data,
specifying a particular preimage of each `f : F.obj X ⟶ F.obj Y`.

See <https://stacks.math.columbia.edu/tag/001C>.
-/
class full (F : C ⥤ D) :=
(preimage : ∀ {X Y : C} (f : (F.obj X) ⟶ (F.obj Y)), X ⟶ Y)
(witness' : ∀ {X Y : C} (f : (F.obj X) ⟶ (F.obj Y)), F.map (preimage f) = f . obviously)

restate_axiom full.witness'
attribute [simp] full.witness

/--
A functor `F : C ⥤ D` is faithful if for each `X Y : C`, `F.map` is injective.

See <https://stacks.math.columbia.edu/tag/001C>.
-/
class faithful (F : C ⥤ D) : Prop :=
(map_injective' [] : ∀ {X Y : C}, function.injective (@functor.map _ _ _ _ F X Y) . obviously)

restate_axiom faithful.map_injective'

namespace functor
variables {X Y : C}

lemma map_injective (F : C ⥤ D) [faithful F] : function.injective $ @functor.map _ _ _ _ F X Y :=
faithful.map_injective F

lemma map_iso_injective (F : C ⥤ D) [faithful F] :
  function.injective $ @functor.map_iso _ _ _ _ F X Y :=
λ i j h, iso.ext (map_injective F (congr_arg iso.hom h : _))

/-- The specified preimage of a morphism under a full functor. -/
def preimage (F : C ⥤ D) [full F] (f : F.obj X ⟶ F.obj Y) : X ⟶ Y :=
full.preimage.{v₁ v₂} f
@[simp] lemma image_preimage (F : C ⥤ D) [full F] {X Y : C} (f : F.obj X ⟶ F.obj Y) :
  F.map (preimage F f) = f :=
by unfold preimage; obviously

lemma map_surjective (F : C ⥤ D) [full F] : function.surjective (@functor.map _ _ _ _ F X Y) :=
λ f, ⟨F.preimage f, F.image_preimage f⟩

/-- Deduce that `F` is full from the existence of preimages, using choice. -/
noncomputable def full_of_exists (F : C ⥤ D)
  (h : ∀ (X Y : C) (f : F.obj X ⟶ F.obj Y), ∃ p, F.map p = f) : full F :=
by { choose p hp using h, exact ⟨p, hp⟩ }

/-- Deduce that `F` is full from surjectivity of `F.map`, using choice. -/
noncomputable def full_of_surjective (F : C ⥤ D)
  (h : ∀ (X Y : C), function.surjective (@functor.map _ _ _ _ F X Y)) : full F :=
full_of_exists _ h

end functor

section
variables {F : C ⥤ D} [full F] [faithful F] {X Y Z : C}

@[simp] lemma preimage_id : F.preimage (𝟙 (F.obj X)) = 𝟙 X :=
F.map_injective (by simp)
@[simp] lemma preimage_comp (f : F.obj X ⟶ F.obj Y) (g : F.obj Y ⟶ F.obj Z) :
  F.preimage (f ≫ g) = F.preimage f ≫ F.preimage g :=
F.map_injective (by simp)
@[simp] lemma preimage_map (f : X ⟶ Y) :
  F.preimage (F.map f) = f :=
F.map_injective (by simp)

variables (F)

namespace functor

/-- If `F : C ⥤ D` is fully faithful, every isomorphism `F.obj X ≅ F.obj Y` has a preimage. -/
@[simps]
def preimage_iso (f : (F.obj X) ≅ (F.obj Y)) : X ≅ Y :=
{ hom := F.preimage f.hom,
  inv := F.preimage f.inv,
  hom_inv_id' := F.map_injective (by simp),
  inv_hom_id' := F.map_injective (by simp), }

@[simp] lemma preimage_iso_map_iso (f : X ≅ Y) :
  F.preimage_iso (F.map_iso f) = f :=
by { ext, simp, }

end functor

/--
If the image of a morphism under a fully faithful functor in an isomorphism,
then the original morphisms is also an isomorphism.
-/
lemma is_iso_of_fully_faithful (f : X ⟶ Y) [is_iso (F.map f)] : is_iso f :=
⟨⟨F.preimage (inv (F.map f)),
  ⟨F.map_injective (by simp), F.map_injective (by simp)⟩⟩⟩

/-- If `F` is fully faithful, we have an equivalence of hom-sets `X ⟶ Y` and `F X ⟶ F Y`. -/
@[simps]
def equiv_of_fully_faithful {X Y} : (X ⟶ Y) ≃ (F.obj X ⟶ F.obj Y) :=
{ to_fun := λ f, F.map f,
  inv_fun := λ f, F.preimage f,
  left_inv := λ f, by simp,
  right_inv := λ f, by simp }

/-- If `F` is fully faithful, we have an equivalence of iso-sets `X ≅ Y` and `F X ≅ F Y`. -/
@[simps]
def iso_equiv_of_fully_faithful {X Y} : (X ≅ Y) ≃ (F.obj X ≅ F.obj Y) :=
{ to_fun := λ f, F.map_iso f,
  inv_fun := λ f, F.preimage_iso f,
  left_inv := λ f, by simp,
  right_inv := λ f, by { ext, simp, } }

end

section
variables {E : Type*} [category E] {F G : C ⥤ D} (H : D ⥤ E) [full H] [faithful H]

/-- We can construct a natural transformation between functors by constructing a
natural transformation between those functors composed with a fully faithful functor. -/
@[simps]
def nat_trans_of_comp_fully_faithful (α : F ⋙ H ⟶ G ⋙ H) : F ⟶ G :=
{ app := λ X, (equiv_of_fully_faithful H).symm (α.app X),
  naturality' := λ X Y f, by { dsimp, apply H.map_injective, simpa using α.naturality f, } }

/-- We can construct a natural isomorphism between functors by constructing a natural isomorphism
between those functors composed with a fully faithful functor. -/
@[simps]
def nat_iso_of_comp_fully_faithful (i : F ⋙ H ≅ G ⋙ H) : F ≅ G :=
nat_iso.of_components
  (λ X, (iso_equiv_of_fully_faithful H).symm (i.app X))
  (λ X Y f, by { dsimp, apply H.map_injective, simpa using i.hom.naturality f, })

lemma nat_iso_of_comp_fully_faithful_hom (i : F ⋙ H ≅ G ⋙ H) :
  (nat_iso_of_comp_fully_faithful H i).hom = nat_trans_of_comp_fully_faithful H i.hom :=
by { ext, simp [nat_iso_of_comp_fully_faithful], }

lemma nat_iso_of_comp_fully_faithful_inv (i : F ⋙ H ≅ G ⋙ H) :
  (nat_iso_of_comp_fully_faithful H i).inv = nat_trans_of_comp_fully_faithful H i.inv :=
by { ext, simp [←preimage_comp], dsimp, simp, }

/-- Horizontal composition with a fully faithful functor induces a bijection on
natural transformations. -/
@[simps]
def nat_trans.equiv_of_comp_fully_faithful : (F ⟶ G) ≃ (F ⋙ H ⟶ G ⋙ H) :=
{ to_fun := λ α, α ◫ 𝟙 H,
  inv_fun := nat_trans_of_comp_fully_faithful H,
  left_inv := by tidy,
  right_inv := by tidy, }

/-- Horizontal composition with a fully faithful functor induces a bijection on
natural isomorphisms. -/
@[simps]
def nat_iso.equiv_of_comp_fully_faithful : (F ≅ G) ≃ (F ⋙ H ≅ G ⋙ H) :=
{ to_fun := λ e, nat_iso.hcomp e (iso.refl H),
  inv_fun := nat_iso_of_comp_fully_faithful H,
  left_inv := by tidy,
  right_inv := by tidy, }

end

end category_theory

namespace category_theory

variables {C : Type u₁} [category.{v₁} C]

instance full.id : full (𝟭 C) :=
{ preimage := λ _ _ f, f }

instance faithful.id : faithful (𝟭 C) := by obviously

variables {D : Type u₂} [category.{v₂} D] {E : Type u₃} [category.{v₃} E]
variables (F F' : C ⥤ D) (G : D ⥤ E)

instance faithful.comp [faithful F] [faithful G] : faithful (F ⋙ G) :=
{ map_injective' := λ _ _ _ _ p, F.map_injective (G.map_injective p) }

lemma faithful.of_comp [faithful $ F ⋙ G] : faithful F :=
{ map_injective' := λ X Y, (F ⋙ G).map_injective.of_comp }

section
variables {F F'}

/-- If `F` is full, and naturally isomorphic to some `F'`, then `F'` is also full. -/
def full.of_iso [full F] (α : F ≅ F') : full F' :=
{ preimage := λ X Y f, F.preimage ((α.app X).hom ≫ f ≫ (α.app Y).inv),
  witness' := λ X Y f, by simp [←nat_iso.naturality_1 α], }

lemma faithful.of_iso [faithful F] (α : F ≅ F') : faithful F' :=
{ map_injective' := λ X Y f f' h, F.map_injective
  (by rw [←nat_iso.naturality_1 α.symm, h, nat_iso.naturality_1 α.symm]) }
end

variables {F G}

lemma faithful.of_comp_iso {H : C ⥤ E} [ℋ : faithful H] (h : F ⋙ G ≅ H) : faithful F :=
@faithful.of_comp _ _ _ _ _ _ F G (faithful.of_iso h.symm)

alias faithful.of_comp_iso ← _root_.category_theory.iso.faithful_of_comp

-- We could prove this from `faithful.of_comp_iso` using `eq_to_iso`,
-- but that would introduce a cyclic import.
lemma faithful.of_comp_eq {H : C ⥤ E} [ℋ : faithful H] (h : F ⋙ G = H) : faithful F :=
@faithful.of_comp _ _ _ _ _ _ F G (h.symm ▸ ℋ)

alias faithful.of_comp_eq ← _root_.eq.faithful_of_comp

variables (F G)

/-- “Divide” a functor by a faithful functor. -/
protected def faithful.div (F : C ⥤ E) (G : D ⥤ E) [faithful G]
  (obj : C → D) (h_obj : ∀ X, G.obj (obj X) = F.obj X)
  (map : Π {X Y}, (X ⟶ Y) → (obj X ⟶ obj Y))
  (h_map : ∀ {X Y} {f : X ⟶ Y}, G.map (map f) == F.map f) :
  C ⥤ D :=
{ obj := obj,
  map := @map,
  map_id' :=
  begin
    assume X,
    apply G.map_injective,
    apply eq_of_heq,
    transitivity F.map (𝟙 X), from h_map,
    rw [F.map_id, G.map_id, h_obj X]
  end,
  map_comp' :=
  begin
    assume X Y Z f g,
    apply G.map_injective,
    apply eq_of_heq,
    transitivity F.map (f ≫ g), from h_map,
    rw [F.map_comp, G.map_comp],
    congr' 1;
      try { exact (h_obj _).symm };
      exact h_map.symm
  end }

-- This follows immediately from `functor.hext` (`functor.hext h_obj @h_map`),
-- but importing `category_theory.eq_to_hom` causes an import loop:
-- category_theory.eq_to_hom → category_theory.opposites →
-- category_theory.equivalence → category_theory.fully_faithful
lemma faithful.div_comp (F : C ⥤ E) [faithful F] (G : D ⥤ E) [faithful G]
  (obj : C → D) (h_obj : ∀ X, G.obj (obj X) = F.obj X)
  (map : Π {X Y}, (X ⟶ Y) → (obj X ⟶ obj Y))
  (h_map : ∀ {X Y} {f : X ⟶ Y}, G.map (map f) == F.map f) :
  (faithful.div F G obj @h_obj @map @h_map) ⋙ G = F :=
begin
  casesI F with F_obj _ _ _, casesI G with G_obj _ _ _,
  unfold faithful.div functor.comp,
  unfold_projs at h_obj,
  have: F_obj = G_obj ∘ obj := (funext h_obj).symm,
  substI this,
  congr,
  funext,
  exact eq_of_heq h_map
end

lemma faithful.div_faithful (F : C ⥤ E) [faithful F] (G : D ⥤ E) [faithful G]
  (obj : C → D) (h_obj : ∀ X, G.obj (obj X) = F.obj X)
  (map : Π {X Y}, (X ⟶ Y) → (obj X ⟶ obj Y))
  (h_map : ∀ {X Y} {f : X ⟶ Y}, G.map (map f) == F.map f) :
  faithful (faithful.div F G obj @h_obj @map @h_map) :=
(faithful.div_comp F G _ h_obj _ @h_map).faithful_of_comp

instance full.comp [full F] [full G] : full (F ⋙ G) :=
{ preimage := λ _ _ f, F.preimage (G.preimage f) }

/-- If `F ⋙ G` is full and `G` is faithful, then `F` is full. -/
def full.of_comp_faithful [full $ F ⋙ G] [faithful G] : full F :=
{ preimage := λ X Y f, (F ⋙ G).preimage (G.map f),
  witness' := λ X Y f, G.map_injective ((F ⋙ G).image_preimage _) }

/-- If `F ⋙ G` is full and `G` is faithful, then `F` is full. -/
def full.of_comp_faithful_iso {F : C ⥤ D} {G : D ⥤ E} {H : C ⥤ E} [full H] [faithful G]
  (h : F ⋙ G ≅ H) : full F :=
@full.of_comp_faithful _ _ _ _ _ _ F G (full.of_iso h.symm) _

/--
Given a natural isomorphism between `F ⋙ H` and `G ⋙ H` for a fully faithful functor `H`, we
can 'cancel' it to give a natural iso between `F` and `G`.
-/
def fully_faithful_cancel_right {F G : C ⥤ D} (H : D ⥤ E)
  [full H] [faithful H] (comp_iso: F ⋙ H ≅ G ⋙ H) : F ≅ G :=
nat_iso.of_components
  (λ X, H.preimage_iso (comp_iso.app X))
  (λ X Y f, H.map_injective (by simpa using comp_iso.hom.naturality f))

@[simp]
lemma fully_faithful_cancel_right_hom_app {F G : C ⥤ D} {H : D ⥤ E}
  [full H] [faithful H] (comp_iso: F ⋙ H ≅ G ⋙ H) (X : C) :
  (fully_faithful_cancel_right H comp_iso).hom.app X = H.preimage (comp_iso.hom.app X) :=
rfl

@[simp]
lemma fully_faithful_cancel_right_inv_app {F G : C ⥤ D} {H : D ⥤ E}
  [full H] [faithful H] (comp_iso: F ⋙ H ≅ G ⋙ H) (X : C) :
  (fully_faithful_cancel_right H comp_iso).inv.app X = H.preimage (comp_iso.inv.app X) :=
rfl

end category_theory